X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?p=clnl;a=blobdiff_plain;f=src%2Fmain%2Fnvm%2Fnvm.lisp;h=dcba15148fee16839967859fd016dea94fb50a6c;hp=3c7c6d6974a85201d8067f48b75a3775927383cf;hb=97c390f3cee5094fa6795acd4b25b7598d5dd1bd;hpb=9eef8ecae4fad1e01413807ebc80ae45b5990706 diff --git a/src/main/nvm/nvm.lisp b/src/main/nvm/nvm.lisp index 3c7c6d6..dcba151 100644 --- a/src/main/nvm/nvm.lisp +++ b/src/main/nvm/nvm.lisp @@ -150,9 +150,9 @@ DESCRIPTION: (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) - (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)))) @@ -172,6 +172,53 @@ DESCRIPTION: See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#count" (coerce (length (agentset-list agentset)) 'double-float)) +(defun clear-all () + "CLEAR-ALL => RESULT + +ARGUMENTS AND VALUES: + + RESULT: undefined + +DESCRIPTION: + + Clears ticks, turtles, patches, globals (unimplemented). + + See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#clear-all" + (clear-turtles) + (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 @@ -581,10 +628,32 @@ DESCRIPTION: (when (not *ticks*) (error "reset-ticks must be called")) *ticks*) -(defun create-world (&key dims) - "CREATE-WORLD &key DIMS => RESULT +(defun clear-patches () + (setf + *patches* + (loop + :for y :from (max-pycor) :downto (min-pycor) + :append (loop + :for x :from (min-pxcor) :to (max-pxcor) + :collect (make-patch + :xcor (coerce x 'double-float) + :ycor (coerce y 'double-float) + :color 0d0))))) + +(defun clear-turtles () + (setf *turtles* nil) + (setf *current-id* 0)) + +(defun clear-ticks () + (setf *ticks* nil)) + +(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) + GLOBALS: GLOBAL* + TURTLES-OWN-VARS: TURTLES-OWN-VAR* + GLOBAL: (GLOBAL-NAME GLOBAL-ACCESS-FUNC) ARGUMENTS AND VALUES: @@ -593,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 + 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: @@ -600,20 +672,13 @@ 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." + (setf *turtles-own-vars* turtles-own-vars) (setf *dimensions* dims) + (setf *globals* globals) (setf *breeds* (list (list :turtles "default"))) - (setf - *patches* - (loop - :for y :from (max-pycor) :downto (min-pycor) - :append (loop - :for x :from (min-pxcor) :to (max-pxcor) - :collect (make-patch - :xcor (coerce x 'double-float) - :ycor (coerce y 'double-float) - :color 0d0)))) - (setf *turtles* nil) - (setf *current-id* 0)) + (clear-ticks) + (clear-patches) + (clear-turtles)) ; These match netlogo's dump (defgeneric dump-object (o)) @@ -684,13 +749,14 @@ DESCRIPTION: (append (list "\"TURTLES\"" - (format nil "~A~A" + (format nil "~A~A~{,\"~A\"~}" "\"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 - "\"~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)) @@ -700,7 +766,8 @@ DESCRIPTION: (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 () @@ -737,11 +804,13 @@ DESCRIPTION: (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\"," - "\"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)) ""