See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#show"
(format t "Showing: ~A~%" (dump-object value)))
+(defun lookup-color (color)
+ "LOOKUP-COLOR COLOR => COLOR-NUMBER
+
+ARGUMENTS AND VALUES:
+
+ COLOR: a symbol representing a color
+ COLOR-NUMBER: the NetLogo color integer
+
+DESCRIPTION:
+
+ Returns the number used to represent colors in NetLogo.
+
+ See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#Constants"
+ (case color
+ (:black 0d0)
+ (:gray 5d0)
+ (:white 9.9d0)
+ (:red 15d0)
+ (:orange 25d0)
+ (:brown 35d0)
+ (:yellow 45d0)
+ (:green 55d0)
+ (:lime 65d0)
+ (:turquoise 75d0)
+ (:cyan 85d0)
+ (:sky 95d0)
+ (:blue 105d0)
+ (:violet 115d0)
+ (:magenta 125d0)
+ (:pink 135d0)))
+
(defun create-turtle ()
(setf
*turtles*
*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
:ycor 0d0))))
(incf *current-id*))
+(defun die ()
+ "DIE => RESULT
+
+ARGUMENTS AND VALUES:
+
+ RESULT: undefined, commands don't return
+
+DESCRIPTION:
+
+ The turtle or link dies
+
+ A dead agent ceases to exist. The effects of this include:
+ - The agent will not execute any further code.
+ - The agent will disappear from any agentsets it was in, reducing the size of those agentsets by one.
+ - Any variable that was storing the agent will now instead have nobody in it.
+ - If the dead agent was a turtle, every link connected to it also dies.
+ - If the observer was watching or following the agent, the observer's perspective resets.
+
+ See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#die"
+ (when (not (turtle-p *self*)) (error "Gotta call die in turtle scope, dude (~A)" *self*))
+ (setf (turtle-who *self*) -1)
+ (setf *turtles* (remove *self* *turtles*)))
+
(defun turtles ()
"TURTLES => ALL-TURTLES
: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))
(setf
(turtle-xcor *self*)
(wrap-x *topology*
- (+ (turtle-xcor *self*) (* n (strictmath:sin (strictmath:to-radians (turtle-heading *self*)))))))
+ (+ (turtle-xcor *self*) (* n (using-cached-sin (turtle-heading *self*))))))
(setf
(turtle-ycor *self*)
(wrap-y *topology*
- (+ (turtle-ycor *self*) (* n (strictmath:cos (strictmath:to-radians (turtle-heading *self*))))))))
+ (+ (turtle-ycor *self*) (* n (using-cached-cos (turtle-heading *self*)))))))
(defun forward (n)
"FORWARD N => RESULT
(t (jump (if (> i 0d0) 1d0 -1d0)) (internal (- i (if (> i 0d0) 1d0 -1d0)))))))
(internal n)))
+(defun turn-right (n)
+ "TURN-RIGHT N => RESULT
+
+ARGUMENTS AND VALUES:
+
+ N: a double, the amount the turtle turns
+ RESULT: undefined
+
+DESCRIPTION:
+
+ The turtle turns right by number degrees. (If number is negative, it turns left.)
+
+ See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#right"
+ (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude (~A)" *self*))
+ (let
+ ((new-heading (+ (turtle-heading *self*) n)))
+ (setf (turtle-heading *self*)
+ (cond
+ ((< new-heading 0) (+ (mod new-heading -360) 360))
+ ((>= new-heading 360) (mod new-heading 360))
+ (t new-heading)))))
+
+(defun turn-left (n)
+ "TURN-LEFT N => RESULT
+
+ARGUMENTS AND VALUES:
+
+ N: a double, the amount the turtle turns
+ RESULT: undefined
+
+DESCRIPTION:
+
+ The turtle turns left by number degrees. (If number is negative, it turns right.)
+
+ See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#right"
+ (turn-right (- n)))
+
(defun create-turtles (n)
"CREATE-TURTLES N => RESULT
See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles"
(loop :for i :from 1 :to n :do (create-turtle)))
-(defun create-world (model)
- "CREATE-WORLD MODEL => RESULT
+(defun reset-ticks ()
+ "RESET-TICKS => RESULT
ARGUMENTS AND VALUES:
- MODEL: A clnl-model:model to use to initialize the vm
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
+
+ DIMS: (:xmin XMIN :xmax XMAX :ymin YMIN :ymax YMAX)
+
+ARGUMENTS AND VALUES:
+
+ RESULT: undefined
+ XMIN: An integer representing the minimum patch coord in X
+ 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
+
DESCRIPTION:
Initializes the world in the NVM.
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 *model* model)
+ (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))
(defmethod dump-object ((o string)) o)
+(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
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
(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")
projects / clnl / blobdiff