X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=blobdiff_plain;f=src%2Fmain%2Fnvm%2Fnvm.lisp;h=482498c9a1d403029ae9da83cea5f6fb2da86355;hb=82888b4;hp=47f5467ac35ece66adf49521293d0ba2a08f8ee7;hpb=399b297b01fe363c6ea8c2108de5df82c2ba3921;p=clnl diff --git a/src/main/nvm/nvm.lisp b/src/main/nvm/nvm.lisp index 47f5467..482498c 100644 --- a/src/main/nvm/nvm.lisp +++ b/src/main/nvm/nvm.lisp @@ -55,7 +55,7 @@ DESCRIPTION: *turtles* (list (make-turtle - :who *current-id* + :who (coerce *current-id* 'double-float) :color (coerce (+ 5 (* 10 (clnl-random:next-int 14))) 'double-float) :heading (coerce (clnl-random:next-int 360) 'double-float) :xcor 0d0 @@ -127,6 +127,32 @@ DESCRIPTION: :while agent :do (let ((*myself* *self*) (*self* agent)) (funcall fn))))) +(defun of (fn agent-set) + "OF FN AGENT-SET => RESULT + +ARGUMENTS AND VALUES: + + FN: a function, run on each agent + AGENT-SET: a NetLogo agentset + RESULT: a list + +DESCRIPTION: + + OF is equivalent to of in NetLogo. + + The specified AGENT-SET runs the given FN. The order in which the agents + are run is random each time, and only agents that are in the set at the + beginning of the call. A list is returned of the returned valuse of + FN. + + See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#of" + (let + ((iter (shufflerator agent-set))) + (loop + :for agent := (funcall iter) + :while agent + :collect (let ((*myself* *self*) (*self* agent)) (funcall fn))))) + (defun shufflerator (agent-set) (let ((copy (copy-list agent-set)) @@ -264,6 +290,55 @@ DESCRIPTION: See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles" (loop :for i :from 1 :to n :do (create-turtle))) +(defun reset-ticks () + "RESET-TICKS => RESULT + +ARGUMENTS AND VALUES: + + RESULT: undefined + +DESCRIPTION: + + Resets the tick counter to zero, sets up all plots, then updates all plots. + + See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#reset-ticks" + (setf *ticks* 0d0)) + +(defun tick () + "RESET-TICKS => RESULT + +ARGUMENTS AND VALUES: + + RESULT: undefined + +DESCRIPTION: + + Advances the tick counter by one and updates all plots. + + If the tick counter has not been started yet with reset-ticks, an error results. + + See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#tick" + + (when (not *ticks*) (error "reset-ticks must be called")) + (incf *ticks*)) + +(defun ticks () + "TICKS => CURRENT-TICKS + +ARGUMENTS AND VALUES: + + CURRENT-TICKS: A positiv double, representing the current number of ticks + +DESCRIPTION: + + Reports the current value of the tick counter. The result is always a number and never negative. + + If the tick counter has not been started yet with reset-ticks, an error results. + + See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#ticks" + (when (not *ticks*) (error "reset-ticks must be called")) + *ticks*) + (defun create-world (&key dims) "CREATE-WORLD &key DIMS => RESULT @@ -284,6 +359,16 @@ 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 *dimensions* dims) + (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)) @@ -304,6 +389,8 @@ DESCRIPTION: (defmethod dump-object ((o (eql t))) "true") (defmethod dump-object ((o (eql nil))) "false") +(defmethod dump-object ((o list)) (format nil "[~{~A~^ ~}]" (mapcar #'dump-object o))) + (defun current-state () "CURRENT-STATE => WORLD-STATE @@ -319,31 +406,59 @@ DESCRIPTION: data structure for easy usage in a common lisp instance. It's preferable to use this when working with the nvm than the output done by export-world. - Currently this only dumps out turtle information. + Currently this only dumps out turtle and patch information. This is called CURRENT-STATE because export-world is an actual primitive used by NetLogo." - (mapcar - (lambda (turtle) - (list - :color (turtle-color turtle) - :xcor (turtle-xcor turtle) - :ycor (turtle-ycor turtle) - :heading (turtle-heading turtle))) - *turtles*)) + (list + (mapcar + (lambda (turtle) + (list + :color (turtle-color turtle) + :xcor (turtle-xcor turtle) + :ycor (turtle-ycor turtle) + :heading (turtle-heading turtle))) + *turtles*) + (mapcar + (lambda (patch) + (list + :color (patch-color patch) + :xcor (patch-xcor patch) + :ycor (patch-ycor patch))) + *patches*))) + +(defun export-turtles () + (append + (list + "\"TURTLES\"" + (format nil "~A~A" + "\"who\",\"color\",\"heading\",\"xcor\",\"ycor\",\"shape\",\"label\",\"label-color\"," + "\"breed\",\"hidden?\",\"size\",\"pen-size\",\"pen-mode\"")) + (mapcar + (lambda (turtle) + (format nil + "\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",~A" + (dump-object (turtle-who turtle)) + (dump-object (turtle-color turtle)) + (dump-object (turtle-heading turtle)) + (dump-object (turtle-xcor turtle)) + (dump-object (turtle-ycor turtle)) + "\"\"\"default\"\"\",\"\"\"\"\"\",\"9.9\",\"{all-turtles}\",\"false\",\"1\",\"1\",\"\"\"up\"\"\"")) + *turtles*))) (defun export-patches () - (list - "\"pxcor\",\"pycor\",\"pcolor\",\"plabel\",\"plabel-color\"" - "\"-1\",\"1\",\"0\",\"\"\"\"\"\",\"9.9\"" - "\"0\",\"1\",\"0\",\"\"\"\"\"\",\"9.9\"" - "\"1\",\"1\",\"0\",\"\"\"\"\"\",\"9.9\"" - "\"-1\",\"0\",\"0\",\"\"\"\"\"\",\"9.9\"" - "\"0\",\"0\",\"0\",\"\"\"\"\"\",\"9.9\"" - "\"1\",\"0\",\"0\",\"\"\"\"\"\",\"9.9\"" - "\"-1\",\"-1\",\"0\",\"\"\"\"\"\",\"9.9\"" - "\"0\",\"-1\",\"0\",\"\"\"\"\"\",\"9.9\"" - "\"1\",\"-1\",\"0\",\"\"\"\"\"\",\"9.9\"")) + (append + (list + "\"PATCHES\"" + "\"pxcor\",\"pycor\",\"pcolor\",\"plabel\",\"plabel-color\"") + (mapcar + (lambda (patch) + (format nil + "\"~A\",\"~A\",\"~A\",\"\"\"\"\"\",\"9.9\"" + (dump-object (patch-xcor patch)) + (dump-object (patch-ycor patch)) + (dump-object (patch-color patch)))) + *patches*))) (defun export-world () "EXPORT-WORLD => WORLD-CSV @@ -371,23 +486,8 @@ DESCRIPTION: (format nil "\"~A\",\"~A\",\"~A\",\"~A\",\"0\",\"nobody\",\"~A\",\"\"\"NEITHER\"\"\",\"-1\"" (min-pxcor) (max-pxcor) (min-pycor) (max-pycor) *current-id*) "" - (format nil "~S" "TURTLES") - (format nil "~A~A" - "\"who\",\"color\",\"heading\",\"xcor\",\"ycor\",\"shape\",\"label\",\"label-color\"," - "\"breed\",\"hidden?\",\"size\",\"pen-size\",\"pen-mode\"") - (format nil "~{~A~%~}" - (mapcar - (lambda (turtle) - (format nil - "\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",~A" - (turtle-who turtle) - (dump-object (turtle-color turtle)) - (dump-object (turtle-heading turtle)) - (dump-object (turtle-xcor turtle)) - (dump-object (turtle-ycor turtle)) - "\"\"\"default\"\"\",\"\"\"\"\"\",\"9.9\",\"{all-turtles}\",\"false\",\"1\",\"1\",\"\"\"up\"\"\"")) - *turtles*)) - (format nil "~S" "PATCHES") + (format nil "~{~A~^~%~}" (export-turtles)) + "" (format nil "~{~A~^~%~}" (export-patches)) "" (format nil "~S" "LINKS")