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
: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 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
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))
(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