CLI Extension - Button press

[clnl] / src / main / model.lisp

diff --git a/src/main/model.lisp b/src/main/model.lisp
index 33f90aa588327b040c5b87a02b1f85efb21223b5..5d7e9e3eb49b9bf04de7cae19ac65d88559f7114 100644 (file)
--- a/src/main/model.lisp
+++ b/src/main/model.lisp
@@ -27,8 +27,9 @@ DESCRIPTION:
 
   Returns the default startup model."
  (make-model
+  :code ""
   :interface (list
-              (make-view :min-pxcor -5 :max-pxcor 5 :min-pycor -5 :max-pycor 5))))
+              (make-view :min-pxcor -5 :max-pxcor 5 :min-pycor -5 :max-pycor 5 :patch-size 13d0))))
 
 (defun read-from-nlogo (str)
  "READ-FROM-NLOGO STR => MODEL
@@ -54,15 +55,7 @@ DESCRIPTION:
           (read-sections (append section (list line))))))))
      (read-sections))))
   (make-model
-   :code (clnl-code-parser:parse
-          (clnl-lexer:lex (format nil "~{~A~^~%~}" (nth 0 sections)))
-          (remove nil
-           (mapcar
-            (lambda (widget)
-             (typecase widget
-              (slider (intern (string-upcase (slider-varname widget)) (find-package :keyword)))
-              (switch (intern (string-upcase (switch-varname widget)) (find-package :keyword)))))
-            (parse-interface (nth 1 sections)))))
+   :code (format nil "~{~A~^~%~}" (nth 0 sections))
    :interface (parse-interface (nth 1 sections))
    :info (nth 2 sections)
    :turtle-shapes (nth 3 sections)
@@ -203,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)
@@ -228,35 +244,43 @@ DESCRIPTION:
    :xmin (view-min-pxcor view)
    :xmax (view-max-pxcor view)
    :ymin (view-min-pycor view)
-   :ymax (view-max-pycor view))))
+   :ymax (view-max-pycor view)
+   :patch-size (view-patch-size view))))
 
-; For now, we keep the code hidden in this package
-(defun globals (model)
- "GLOBALS MODEL => GLOBALS
+(defun widget-globals (model)
+ "WIDGET-GLOBALS MODEL => GLOBALS
 
   GLOBALS: GLOBAL*
+  GLOBAL: (NAME DEFAULT)
+
+ARGUMENTS AND VALUES:
+
+  MODEL: A valid model
+  NAME: A symbol interned in the keyworkd package
+  DEFAULT: The widget default value
+
+DESCRIPTION:
+
+  Returns the globals that get declared in the model from widgets.
+  They are interned in the keyword package package set for clnl, so
+  that they can later be used for multiple purposes."
+ (remove nil
+  (mapcar
+   (lambda (widget)
+    (typecase widget
+     (slider (list (intern (string-upcase (slider-varname widget)) :keyword) (slider-default widget)))
+     (switch (list (intern (string-upcase (switch-varname widget)) :keyword) (switch-on widget)))))
+   (model-interface model))))
+
+(defun code (model)
+ "CODE MODEL => CODE
 
 ARGUMENTS AND VALUES:
 
   MODEL: A valid model
-  GLOBAL: A symbol interned in clnl:*model-package*
+  CODE: The string representing the netlogo code in this model
 
 DESCRIPTION:
 
-  Returns the globals that get declared in the model, from widgets or
-  from code.  They are interned in the package set for clnl, so
-  that they can later be used by functions in that package."
- (mapcar
-  (lambda (pair)
-   (list
-    (intern (string-upcase (car pair)) clnl:*model-package*)
-    (cadr pair)))
-  (append
-   (clnl-code-parser:globals (model-code model))
-   (remove nil
-    (mapcar
-     (lambda (widget)
-      (typecase widget
-       (slider (list (slider-varname widget) (slider-default widget)))
-       (switch (list (switch-varname widget) (switch-on widget)))))
-     (model-interface model))))))
+  Returns the code from the model."
+ (model-code model))