Code - turtles-own

[clnl] / src / main / nvm / nvm.lisp

diff --git a/src/main/nvm/nvm.lisp b/src/main/nvm/nvm.lisp
index c98616aeeddcfb53a4cfcdb82abfaa1a0b70b178..dcba15148fee16839967859fd016dea94fb50a6c 100644 (file)
--- a/src/main/nvm/nvm.lisp
+++ b/src/main/nvm/nvm.lisp
@@ -150,9 +150,9 @@ DESCRIPTION:
     (loop
      :for agent := (funcall iter)
      :while agent
     (loop
      :for agent := (funcall iter)
      :while agent

-     :do (let ((*myself* *self*) (*self* agent)) (funcall fn)))))
+     :do (let ((*myself* *self*) (*self* agent)) (with-stop-handler (funcall fn))))))

   ((agent-p agent-or-agentset)
   ((agent-p agent-or-agentset)

-   (let ((*myself* *self*) (*self* agent-or-agentset)) (funcall fn)))
+   (let ((*myself* *self*) (*self* agent-or-agentset)) (with-stop-handler (funcall fn))))

   (t
    (error "Ask requires an agentset or agent but got: ~A" agent-or-agentset))))
 
   (t
    (error "Ask requires an agentset or agent but got: ~A" agent-or-agentset))))
 


@@ -188,6 +188,37 @@ DESCRIPTION:
  (clear-patches)
  (clear-ticks))
 
  (clear-patches)
  (clear-ticks))
 

+(defun display ()
+ "DISPLAY => RESULT
+
+ARGUMENTS AND VALUES:
+
+  RESULT: undefined
+
+DESCRIPTION:
+
+  As of yet, this does nothing.  A placeholder method for forced dipslay
+  updates from the engine.
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#display"
+ nil)
+
+(defun stop ()
+ "STOP => RESULT
+
+ARGUMENTS AND VALUES:
+
+  RESULT: undefined
+
+DESCRIPTION:
+
+  Returns from the current stop block, which will halt the currently running
+  thing, be that the program, current ask block, or procedure.  Stop has odd
+  semantics that are best gleaned from the actual NetLogo manual.
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#stop"
+ (error (make-condition 'stop)))
+

 (defun of (fn agent-or-agentset)
  "OF FN AGENT-OR-AGENTSET => RESULT
 
 (defun of (fn agent-or-agentset)
  "OF FN AGENT-OR-AGENTSET => RESULT
 


@@ -616,10 +647,13 @@ DESCRIPTION:
 (defun clear-ticks ()
  (setf *ticks* nil))
 
 (defun clear-ticks ()
  (setf *ticks* nil))
 

-(defun create-world (&key dims)
- "CREATE-WORLD &key DIMS => RESULT
+(defun create-world (&key dims globals turtles-own-vars)
+ "CREATE-WORLD &key DIMS GLOBALS TURTLES-OWN-VARS => RESULT

 
   DIMS: (:xmin XMIN :xmax XMAX :ymin YMIN :ymax YMAX)
 
   DIMS: (:xmin XMIN :xmax XMAX :ymin YMIN :ymax YMAX)

+  GLOBALS: GLOBAL*
+  TURTLES-OWN-VARS: TURTLES-OWN-VAR*
+  GLOBAL: (GLOBAL-NAME GLOBAL-ACCESS-FUNC)

 
 ARGUMENTS AND VALUES:
 
 
 ARGUMENTS AND VALUES:
 


@@ -628,6 +662,9 @@ ARGUMENTS AND VALUES:
   XMAX: An integer representing the maximum patch coord in X
   YMIN: An integer representing the minimum patch coord in Y
   YMAX: An integer representing the maximum patch coord in Y
   XMAX: An integer representing the maximum patch coord in X
   YMIN: An integer representing the minimum patch coord in Y
   YMAX: An integer representing the maximum patch coord in Y

+  TURTLES-OWN-VAR: Symbol for the turtles own variable in the keyword package
+  GLOBAL-NAME: Symbol for the global in the keyword package
+  GLOBAL-ACCESS-FUNC: Function to get the value of the global

 
 DESCRIPTION:
 
 
 DESCRIPTION:
 


@@ -635,7 +672,9 @@ DESCRIPTION:
 
   This should be called before using the engine in any real capacity.  If
   called when an engine is already running, it may do somethign weird."
 
   This should be called before using the engine in any real capacity.  If
   called when an engine is already running, it may do somethign weird."

+ (setf *turtles-own-vars* turtles-own-vars)

  (setf *dimensions* dims)
  (setf *dimensions* dims)

+ (setf *globals* globals)

  (setf *breeds* (list (list :turtles "default")))
  (clear-ticks)
  (clear-patches)
  (setf *breeds* (list (list :turtles "default")))
  (clear-ticks)
  (clear-patches)


@@ -710,13 +749,14 @@ DESCRIPTION:
  (append
   (list
    "\"TURTLES\""
  (append
   (list
    "\"TURTLES\""

-   (format nil "~A~A"
+   (format nil "~A~A~{,\"~A\"~}"

     "\"who\",\"color\",\"heading\",\"xcor\",\"ycor\",\"shape\",\"label\",\"label-color\","
     "\"who\",\"color\",\"heading\",\"xcor\",\"ycor\",\"shape\",\"label\",\"label-color\","

-    "\"breed\",\"hidden?\",\"size\",\"pen-size\",\"pen-mode\""))
+    "\"breed\",\"hidden?\",\"size\",\"pen-size\",\"pen-mode\""
+    (mapcar #'string-downcase *turtles-own-vars*)))

   (mapcar
    (lambda (turtle)
     (format nil
   (mapcar
    (lambda (turtle)
     (format nil

-     "\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"{all-turtles}\",\"false\",\"~A\",~A"
+     "\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"{all-turtles}\",\"false\",\"~A\",~A~{,\"~A\"~}"

      (dump-object (turtle-who turtle))
      (dump-object (turtle-color turtle))
      (dump-object (turtle-heading turtle))
      (dump-object (turtle-who turtle))
      (dump-object (turtle-color turtle))
      (dump-object (turtle-heading turtle))


@@ -726,7 +766,8 @@ DESCRIPTION:
      (dump-object (turtle-label turtle))
      (dump-object (turtle-label-color turtle))
      (dump-object (turtle-size turtle))
      (dump-object (turtle-label turtle))
      (dump-object (turtle-label-color turtle))
      (dump-object (turtle-size turtle))

-     "\"1\",\"\"\"up\"\"\""))
+     "\"1\",\"\"\"up\"\"\""
+     (mapcar #'dump-object (mapcar (lambda (var) (agent-value-inner turtle var)) *turtles-own-vars*))))

    *turtles*)))
 
 (defun export-patches ()
    *turtles*)))
 
 (defun export-patches ()


@@ -763,11 +804,13 @@ DESCRIPTION:
    (format nil "~S" (clnl-random:export))
    ""
    (format nil "~S" "GLOBALS")
    (format nil "~S" (clnl-random:export))
    ""
    (format nil "~S" "GLOBALS")

-   (format nil "~A~A"
+   (format nil "~A~A~{\"~A\"~^,~}"

     "\"min-pxcor\",\"max-pxcor\",\"min-pycor\",\"max-pycor\",\"perspective\",\"subject\","
     "\"min-pxcor\",\"max-pxcor\",\"min-pycor\",\"max-pycor\",\"perspective\",\"subject\","

-    "\"nextIndex\",\"directed-links\",\"ticks\",")
-   (format nil "\"~A\",\"~A\",\"~A\",\"~A\",\"0\",\"nobody\",\"~A\",\"\"\"NEITHER\"\"\",\"-1\""
-    (min-pxcor) (max-pxcor) (min-pycor) (max-pycor) *current-id*)
+    "\"nextIndex\",\"directed-links\",\"ticks\","
+    (mapcar #'string-downcase (mapcar #'car *globals*)))
+   (format nil "\"~A\",\"~A\",\"~A\",\"~A\",\"0\",\"nobody\",\"~A\",\"\"\"NEITHER\"\"\",\"~A\"~{,\"~A\"~}"
+    (min-pxcor) (max-pxcor) (min-pycor) (max-pycor) *current-id* (dump-object (or *ticks* -1d0))
+    (mapcar #'dump-object (mapcar #'funcall (mapcar #'cadr *globals*))))

    ""
    (format nil "~{~A~^~%~}" (export-turtles))
    ""
    ""
    (format nil "~{~A~^~%~}" (export-turtles))
    ""