CLI Extension - Button press

diff --git a/src/main/extensions.lisp b/src/main/extensions.lisp
index 6755d50c105f7b548b1d42a5e94d4a7bdbffe832..fda37888a1e0ca967b24837eb38f6e662f15a286 100644 (file)
--- a/src/main/extensions.lisp
+++ b/src/main/extensions.lisp
@@ -1,5 +1,27 @@
 (in-package #:clnl-extensions)
 
+(defgeneric prims (extension)
+ (:documentation
+  "PRIMS EXTENSION => PRIMS
+
+  PRIMS: PRIM*
+  PRIM: (:name NAME :type TYPE :args ARGS :func FUNC)
+  TYPE: :command | :reporter
+  ARGS: ARG*
+
+ARGUMENTS AND VALUES:
+
+  EXTENSION: a symbol in the keyword package representing this extension
+  NAME: a symbol in the keyword package
+  FUNC: the function to call
+  ARG: a list of symbols denoting the type of argument
+
+DESCRIPTION:
+
+  PRIMS returns the primitives used in the extension passed in.
+
+  See CLNL-PARSER:PARSE for more information on the PRIM returned."))
+
 (defun load-extension (extension)
  "LOAD-EXTENSION EXTENSION => PRIMS
 
@@ -22,28 +44,25 @@ DESCRIPTION:
   (let
    ((pkg (find-package name)))
    (when (or (not pkg)) (error "Can't find package with extension name: ~A" name))
-   (multiple-value-bind (symb status) (find-symbol "PRIMS" pkg)
-    (when (not symb) (error "Can't find PRIMS function within extension: ~A" name))
-    (when (not (eql status :external)) (error "PRIMS function is not external in extension: ~A" name))
-    (when (not (and (fboundp symb) (not (macro-function symb)) (not (special-operator-p symb))))
-     (error "PRIMS is not a function in ~A" name))
-    (mapcar
-     (lambda (prim)
-      (when (not (getf prim :name)) (error "Prim requires a name: ~A ~A" name prim))
-      (let
-       ((type (getf prim :type)))
-       (when (or (not type) (not (find type '(:reporter :command))))
-        (error "Prim type invalid, needs to be :reporter or :command: ~A ~A ~A" name prim type)))
-      (when (not (getf prim :func))
-       (error "Prim needs a func: ~A ~A" name prim))
-      (list
-       :name (intern
-              (format nil "~A:~A"
-               (if (eql extension :cli) "" (string-upcase extension))
-               (string-upcase (getf prim :name)))
-              :keyword)
-       :type (getf prim :type)
-       :precedence (or (getf prim :precedence) (if (eql :reporter (getf prim :type)) 10 0))
-       :args (getf prim :args)
-       :func (getf prim :func)))
-     (funcall (symbol-function symb)))))))
+   (when (not (compute-applicable-methods #'prims (list extension)))
+    (error "Can't find implemented PRIMS method within extension: ~A" name))
+   (mapcar
+    (lambda (prim)
+     (when (not (getf prim :name)) (error "Prim requires a name: ~A ~A" name prim))
+     (let
+      ((type (getf prim :type)))
+      (when (or (not type) (not (find type '(:reporter :command))))
+       (error "Prim type invalid, needs to be :reporter or :command: ~A ~A ~A" name prim type)))
+     (when (not (getf prim :func))
+      (error "Prim needs a func: ~A ~A" name prim))
+     (list
+      :name (intern
+             (format nil "~A:~A"
+              (if (eql extension :cli) "" (string-upcase extension))
+              (string-upcase (getf prim :name)))
+             :keyword)
+      :type (getf prim :type)
+      :precedence (or (getf prim :precedence) (if (eql :reporter (getf prim :type)) 10 0))
+      :args (getf prim :args)
+      :func (getf prim :func)))
+    (prims extension)))))

diff --git a/src/main/extensions/cli/cli.lisp b/src/main/extensions/cli/cli.lisp
index 4a445467a019b822ee485da4885a696812290c13..9faddaaed1c76286dca40facfa93358ea38d7a32 100644 (file)
--- a/src/main/extensions/cli/cli.lisp
+++ b/src/main/extensions/cli/cli.lisp
@@ -1,19 +1,13 @@
 (in-package #:clnl-extension-cli)
 
-(defun prims ()
- "PRIMS => PRIMS
-
-ARGUMENTS AND VALUES:
-
-  PRIMS: Primitives defined for this extension
-
-DESCRIPTION:
-
-  PRIMS returns the primitives used in the CLI extension."
+(defmethod clnl-extensions:prims ((extension (eql :cli)))
  (list
   (list :name :q :type :command :func #'shut-down)
   (list :name :load :type :command :args '(t) :func #'load-file)
-  (list :name :help :type :command :args '((:token :optional)) :precedence 20 :func #'help)))
+  (list :name :help :type :command :args '((:token :optional)) :precedence 20 :func #'help)
+  (list
+   :name :button :type :command :args '(:string (:optional :number))
+   :precedence 20 :func #'clnl-model:execute-button)))
 
 (defun shut-down ()
  (sb-ext:exit :abort t))

diff --git a/src/main/extensions/cli/package.lisp b/src/main/extensions/cli/package.lisp
index 00873dcc5301486f8bb7697395a49d6d50e8fe95..486affb3d3aa2ffc14c006ae2f9ebecd6b47e591 100644 (file)
--- a/src/main/extensions/cli/package.lisp
+++ b/src/main/extensions/cli/package.lisp
@@ -1,6 +1,5 @@
 (defpackage #:clnl-extension-cli
  (:use :common-lisp)
- (:export #:prims)
  (:documentation
   "CLI Extension
 

diff --git a/src/main/model.lisp b/src/main/model.lisp
index 5e0dde7bf806531009e9ce2e170d7ba01da63878..5d7e9e3eb49b9bf04de7cae19ac65d88559f7114 100644 (file)
--- a/src/main/model.lisp
+++ b/src/main/model.lisp
@@ -196,6 +196,29 @@ DESCRIPTION:
       (when parser (funcall (cadr parser) widget-as-strings))))
     widgets-as-strings))))
 
+; With authoring, idx here needs to be looked at again.
+(defun execute-button (name &optional (idx 0))
+ "EXECUTE-BUTTON NAME &optional IDX => RESULT
+
+ARGUMENTS AND VALUES:
+
+  NAME: the name of the button
+  IDX: the instance of the button, defaults to 0
+  RESULT: undefined
+
+DESCRIPTION:
+
+  Executes the code in the button referenced by NAME and IDX.
+
+  NAME refers to the display name for the button, which is usually
+  set by the model, but sometimes defaults to the code inside.
+
+  Because NAME is not guaranteed to be unique, IDX is available
+  as a specifier.  The index is in the order that the buttons are
+  loaded, and cannot be guaranteed to be stable from run to run."
+ (declare (ignore name idx))
+ nil)
+
 ;; INFORMATION ABOUT MODEL
 
 (defun world-dimensions (model)

diff --git a/src/main/package.lisp b/src/main/package.lisp
index 2f2c5c662f3d4656b7a49caafb7ff66541899312..d750125b46af48f65b4217dcc1092ce233331f39 100644 (file)
--- a/src/main/package.lisp
+++ b/src/main/package.lisp
@@ -85,7 +85,7 @@ components."))
 
 (defpackage #:clnl-model
  (:use :common-lisp)
- (:export #:default-model #:read-from-nlogo #:world-dimensions #:widget-globals #:code)
+ (:export #:execute-button #:default-model #:read-from-nlogo #:world-dimensions #:widget-globals #:code)
  (:documentation
   "CLNL Model
 
@@ -96,7 +96,7 @@ as clnl runs."))
 
 (defpackage #:clnl-extensions
  (:use :common-lisp)
- (:export #:load-extension)
+ (:export #:load-extension #:prims)
  (:documentation
   "CLNL Extensions
 

diff --git a/src/main/parse.lisp b/src/main/parse.lisp
index 6197d30191752aed9451c5e90d681e3722b7bc0d..196b63bc35bf70484a12f3edab04ec82af632917 100644 (file)
--- a/src/main/parse.lisp
+++ b/src/main/parse.lisp
@@ -68,7 +68,8 @@ DESCRIPTION:
   lowest precedence, and all reporters should have 10 as the precedence.
 
   The possible values for ARG are :agentset, :boolean, :number, :command-block,
-  or t for wildcard.
+  :string, or t for wildcard.  For optional arguments, ARG can be a list of the form
+  (ARG :optional) where ARG is one of the aforementioned values.
 
   The need for a parser between the lexer and the transpiler is because NetLogo
   needs two passes to turn into something that can be used.  This is the only entry