1 (in-package #:clnl-nvm)
3 ; Implementations of all the things the nvm can do.
10 VALUE: a NetLogo value
15 A command that prints the given NetLogo value to the command center.
17 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#show"
18 (format t "Showing: ~A~%" (dump-object value)))
20 (defun lookup-color (color)
21 "LOOKUP-COLOR COLOR => COLOR-NUMBER
25 COLOR: a symbol representing a color
26 COLOR-NUMBER: the NetLogo color integer
30 Returns the number used to represent colors in NetLogo.
32 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#Constants"
51 (defun create-turtle ()
58 :who (coerce *current-id* 'double-float)
59 :color (coerce (+ 5 (* 10 (clnl-random:next-int 14))) 'double-float)
60 :heading (coerce (clnl-random:next-int 360) 'double-float)
70 RESULT: undefined, commands don't return
74 The turtle or link dies
76 A dead agent ceases to exist. The effects of this include:
77 - The agent will not execute any further code.
78 - The agent will disappear from any agentsets it was in, reducing the size of those agentsets by one.
79 - Any variable that was storing the agent will now instead have nobody in it.
80 - If the dead agent was a turtle, every link connected to it also dies.
81 - If the observer was watching or following the agent, the observer's perspective resets.
83 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#die"
84 (when (not (turtle-p *self*)) (error "Gotta call die in turtle scope, dude (~A)" *self*))
85 (setf (turtle-who *self*) -1)
86 (setf *turtles* (remove *self* *turtles*)))
89 "TURTLES => ALL-TURTLES
93 ALL-TURTLES: a NetLogo agentset, all turtles
97 Reports the agentset consisting of all the turtles.
99 This agentset is special in that it represents the living turtles
100 each time it's used, so changes depending on the state of the engine.
102 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtles"
105 (defun ask (agent-set fn)
106 "ASK AGENT-SET FN => RESULT
108 ARGUMENTS AND VALUES:
110 AGENT-SET: a NetLogo agentset
111 FN: a function, run on each agent
112 RESULT: undefined, commands don't return
116 ASK is equivalent to ask in NetLogo.
118 The specified AGENT-SET runs the given FN. The order in which the agents
119 are run is random each time, and only agents that are in the set at the
120 beginning of the call.
122 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#ask"
124 ((iter (shufflerator agent-set)))
126 :for agent := (funcall iter)
128 :do (let ((*myself* *self*) (*self* agent)) (funcall fn)))))
130 (defun of (fn agent-set)
131 "OF FN AGENT-SET => RESULT
133 ARGUMENTS AND VALUES:
135 FN: a function, run on each agent
136 AGENT-SET: a NetLogo agentset
141 OF is equivalent to of in NetLogo.
143 The specified AGENT-SET runs the given FN. The order in which the agents
144 are run is random each time, and only agents that are in the set at the
145 beginning of the call. A list is returned of the returned valuse of
148 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#of"
150 ((iter (shufflerator agent-set)))
152 :for agent := (funcall iter)
154 :collect (let ((*myself* *self*) (*self* agent)) (funcall fn)))))
156 (defun shufflerator (agent-set)
158 ((copy (copy-list agent-set))
164 ((idx (when (< i (1- (length copy))) (+ i (clnl-random:next-int (- (length copy) i))))))
165 (when idx (setf agent (nth idx copy)))
166 (when idx (setf (nth idx copy) (nth i copy)))
168 (fetch) ; we pre-fetch because netlogo does, rng sync hype!
171 ((> i (length copy)) nil)
172 ((= i (length copy)) (incf i) (car (last copy)))
173 (t (let ((result agent)) (fetch) result)))))))
175 (defun random-float (n)
176 "RANDOM-FLOAT N => RANDOM-NUMBER
178 ARGUMENTS AND VALUES:
180 N: a double, the upper bound of the random float
181 RANDOM-NUMBER: a double, the random result
185 Returns a random number strictly closer to zero than N.
187 If number is positive, returns a random floating point number greater than
188 or equal to 0 but strictly less than number.
190 If number is negative, returns a random floating point number less than or equal
191 to 0, but strictly greater than number.
193 If number is zero, the result is always 0.
195 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-float"
196 (clnl-random:next-double n))
199 (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude (~A)" *self*))
203 (+ (turtle-xcor *self*) (* n (using-cached-sin (turtle-heading *self*))))))
207 (+ (turtle-ycor *self*) (* n (using-cached-cos (turtle-heading *self*)))))))
212 ARGUMENTS AND VALUES:
214 N: a double, the amount the turtle moves forward
219 Moves the current turtle forward N steps, one step at a time.
221 This moves forward one at a time in order to make the view updates look
222 good in the case of a purposefully slow running instance. If the number
223 is negative, the turtle moves backward.
225 If the current agent is not a turtle, it raises an error.
227 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#forward"
228 (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude (~A)" *self*))
232 ((< (abs i) 3.2e-15) nil)
233 ((< (abs i) 1d0) (jump i))
234 (t (jump (if (> i 0d0) 1d0 -1d0)) (internal (- i (if (> i 0d0) 1d0 -1d0)))))))
237 (defun turn-right (n)
238 "TURN-RIGHT N => RESULT
240 ARGUMENTS AND VALUES:
242 N: a double, the amount the turtle turns
247 The turtle turns right by number degrees. (If number is negative, it turns left.)
249 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#right"
250 (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude (~A)" *self*))
252 ((new-heading (+ (turtle-heading *self*) n)))
253 (setf (turtle-heading *self*)
255 ((< new-heading 0) (+ (mod new-heading -360) 360))
256 ((>= new-heading 360) (mod new-heading 360))
260 "TURN-LEFT N => RESULT
262 ARGUMENTS AND VALUES:
264 N: a double, the amount the turtle turns
269 The turtle turns left by number degrees. (If number is negative, it turns right.)
271 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#right"
274 (defun create-turtles (n)
275 "CREATE-TURTLES N => RESULT
277 ARGUMENTS AND VALUES:
279 N: an integer, the numbers of turtles to create
284 Creates number new turtles at the origin.
286 New turtles have random integer headings and the color is randomly selected
287 from the 14 primary colors. If commands are supplied, the new turtles
288 immediately run them (unimplemented).
290 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles"
291 (loop :for i :from 1 :to n :do (create-turtle)))
293 (defun reset-ticks ()
294 "RESET-TICKS => RESULT
296 ARGUMENTS AND VALUES:
302 Resets the tick counter to zero, sets up all plots, then updates all plots.
304 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#reset-ticks"
308 "RESET-TICKS => RESULT
310 ARGUMENTS AND VALUES:
316 Advances the tick counter by one and updates all plots.
318 If the tick counter has not been started yet with reset-ticks, an error results.
320 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#tick"
322 (when (not *ticks*) (error "reset-ticks must be called"))
326 "TICKS => CURRENT-TICKS
328 ARGUMENTS AND VALUES:
330 CURRENT-TICKS: A positiv double, representing the current number of ticks
334 Reports the current value of the tick counter. The result is always a number and never negative.
336 If the tick counter has not been started yet with reset-ticks, an error results.
338 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#ticks"
339 (when (not *ticks*) (error "reset-ticks must be called"))
342 (defun create-world (&key dims)
343 "CREATE-WORLD &key DIMS => RESULT
345 DIMS: (:xmin XMIN :xmax XMAX :ymin YMIN :ymax YMAX)
347 ARGUMENTS AND VALUES:
350 XMIN: An integer representing the minimum patch coord in X
351 XMAX: An integer representing the maximum patch coord in X
352 YMIN: An integer representing the minimum patch coord in Y
353 YMAX: An integer representing the maximum patch coord in Y
357 Initializes the world in the NVM.
359 This should be called before using the engine in any real capacity. If
360 called when an engine is already running, it may do somethign weird."
361 (setf *dimensions* dims)
365 :for y :from (max-pycor) :downto (min-pycor)
367 :for x :from (min-pxcor) :to (max-pxcor)
369 :xcor (coerce x 'double-float)
370 :ycor (coerce y 'double-float)
373 (setf *current-id* 0))
375 ; These match netlogo's dump
376 (defgeneric dump-object (o))
378 (defmethod dump-object ((n double-float))
379 (multiple-value-bind (int rem) (floor n)
381 (format nil "~A" int)
383 ((output (format nil "~D" n)))
384 ; Someday we'll have d<posint>, but this is not that day!
385 (cl-ppcre:regex-replace "d-" (cl-ppcre:regex-replace "d0" output "") "E-")))))
387 (defmethod dump-object ((o string)) o)
389 (defmethod dump-object ((o (eql t))) "true")
390 (defmethod dump-object ((o (eql nil))) "false")
392 (defmethod dump-object ((o list)) (format nil "[~{~A~^ ~}]" (mapcar #'dump-object o)))
394 (defun current-state ()
395 "CURRENT-STATE => WORLD-STATE
397 ARGUMENTS AND VALUES:
399 WORLD-STATE: A list, the current state of the whole world
403 Dumps out the state of the world.
405 This is useful for visualizations and also storing in a common lisp
406 data structure for easy usage in a common lisp instance. It's preferable
407 to use this when working with the nvm than the output done by export-world.
409 Currently this only dumps out turtle and patch information.
411 This is called CURRENT-STATE because export-world is an actual primitive
417 :color (turtle-color turtle)
418 :xcor (turtle-xcor turtle)
419 :ycor (turtle-ycor turtle)
420 :heading (turtle-heading turtle)))
425 :color (patch-color patch)
426 :xcor (patch-xcor patch)
427 :ycor (patch-ycor patch)))
430 (defun export-turtles ()
435 "\"who\",\"color\",\"heading\",\"xcor\",\"ycor\",\"shape\",\"label\",\"label-color\","
436 "\"breed\",\"hidden?\",\"size\",\"pen-size\",\"pen-mode\""))
440 "\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",~A"
441 (dump-object (turtle-who turtle))
442 (dump-object (turtle-color turtle))
443 (dump-object (turtle-heading turtle))
444 (dump-object (turtle-xcor turtle))
445 (dump-object (turtle-ycor turtle))
446 "\"\"\"default\"\"\",\"\"\"\"\"\",\"9.9\",\"{all-turtles}\",\"false\",\"1\",\"1\",\"\"\"up\"\"\""))
449 (defun export-patches ()
453 "\"pxcor\",\"pycor\",\"pcolor\",\"plabel\",\"plabel-color\"")
457 "\"~A\",\"~A\",\"~A\",\"\"\"\"\"\",\"9.9\""
458 (dump-object (patch-xcor patch))
459 (dump-object (patch-ycor patch))
460 (dump-object (patch-color patch))))
463 (defun export-world ()
464 "EXPORT-WORLD => WORLD-CSV
466 ARGUMENTS AND VALUES:
468 WORLD-CSV: A string, the csv of the world
472 Dumps out a csv matching NetLogo's export world.
474 This is useful for serializing the current state of the engine in order
475 to compare against NetLogo or to reimport later. Contains everything needed
476 to boot up a NetLogo instance in the exact same state."
477 (format nil "~{~A~%~}"
479 (format nil "~S" "RANDOM STATE")
480 (format nil "~S" (clnl-random:export))
482 (format nil "~S" "GLOBALS")
484 "\"min-pxcor\",\"max-pxcor\",\"min-pycor\",\"max-pycor\",\"perspective\",\"subject\","
485 "\"nextIndex\",\"directed-links\",\"ticks\",")
486 (format nil "\"~A\",\"~A\",\"~A\",\"~A\",\"0\",\"nobody\",\"~A\",\"\"\"NEITHER\"\"\",\"-1\""
487 (min-pxcor) (max-pxcor) (min-pycor) (max-pycor) *current-id*)
489 (format nil "~{~A~^~%~}" (export-turtles))
491 (format nil "~{~A~^~%~}" (export-patches))
493 (format nil "~S" "LINKS")
494 "\"end1\",\"end2\",\"color\",\"label\",\"label-color\",\"hidden?\",\"breed\",\"thickness\",\"shape\",\"tie-mode\""