1 (in-package #:clnl-nvm)
3 (defvar *current-id* 0)
5 (defstruct turtle who color heading xcor ycor)
16 VALUE: a NetLogo value
21 A command that prints the given NetLogo value to the command center.
23 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#show"
24 (format t "Showing: ~A~%" (dump-object value)))
26 (defun create-turtle ()
34 :color (coerce (+ 5 (* 10 (clnl-random:next-int 14))) 'double-float)
35 :heading (coerce (clnl-random:next-int 360) 'double-float)
41 "TURTLES => ALL-TURTLES
45 ALL-TURTLES: a NetLogo agentset, all turtles
49 Reports the agentset consisting of all the turtles.
51 This agentset is special in that it represents the living turtles
52 each time it's used, so changes depending on the state of the engine.
54 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtles"
57 (defun ask (agent-set fn)
58 "ASK AGENT-SET FN => RESULT
62 AGENT-SET: a NetLogo agentset
63 FN: a function, run on each agent
64 RESULT: undefined, commands don't return
68 ASK is equivalent to ask in NetLogo.
70 The specified AGENT-SET runs the given FN. The order in which the agents
71 are run is random each time, and only agents that are in the set at the
72 beginning of the call.
74 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#ask"
76 ((iter (shufflerator agent-set)))
78 :for agent := (funcall iter)
80 :do (let ((*myself* *self*) (*self* agent)) (funcall fn)))))
82 (defun shufflerator (agent-set)
84 ((copy (copy-list agent-set))
90 ((idx (when (< i (1- (length copy))) (+ i (clnl-random:next-int (- (length copy) i))))))
91 (when idx (setf agent (nth idx copy)))
92 (when idx (setf (nth idx copy) (nth i copy)))
94 (fetch) ; we pre-fetch because netlogo does, rng sync hype!
97 ((> i (length copy)) nil)
98 ((= i (length copy)) (incf i) (car (last copy)))
99 (t (let ((result agent)) (fetch) result)))))))
101 (defun random-float (n)
102 "RANDOM-FLOAT N => RANDOM-NUMBER
104 ARGUMENTS AND VALUES:
106 N: a double, the upper bound of the random float
107 RANDOM-NUMBER: a double, the random result
111 Returns a random number strictly closer to zero than N.
113 If number is positive, returns a random floating point number greater than
114 or equal to 0 but strictly less than number.
116 If number is negative, returns a random floating point number less than or equal
117 to 0, but strictly greater than number.
119 If number is zero, the result is always 0.
121 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-float"
122 (clnl-random:next-double n))
127 ARGUMENTS AND VALUES:
129 N: a double, the amount the turtle moves forward
134 Moves the current turtle forward N steps, one step at a time.
136 This moves forward one at a time in order to make the view updates look
137 good in the case of a purposefully slow running instance. If the number
138 is negative, the turtle moves backward.
140 If the current agent is not a turtle, it raises an error.
142 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#forward"
143 (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude (~A)" *self*))
146 (+ (turtle-xcor *self*) (* n (strictmath:sin (strictmath:to-radians (turtle-heading *self*))))))
149 (+ (turtle-ycor *self*) (* n (strictmath:cos (strictmath:to-radians (turtle-heading *self*)))))))
151 (defun create-turtles (n)
152 "CREATE-TURTLES N => RESULT
154 ARGUMENTS AND VALUES:
156 N: an integer, the numbers of turtles to create
161 Creates number new turtles at the origin.
163 New turtles have random integer headings and the color is randomly selected
164 from the 14 primary colors. If commands are supplied, the new turtles
165 immediately run them (unimplemented).
167 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles"
168 (loop :for i :from 1 :to n :do (create-turtle)))
170 (defun create-world (model)
171 "CREATE-WORLD MODEL => RESULT
173 ARGUMENTS AND VALUES:
175 MODEL: A clnl-model:model to use to initialize the vm
180 Initializes the world in the NVM.
182 This should be called before using the engine in any real capacity. If
183 called when an engine is already running, it may do somethign weird."
186 (setf *current-id* 0))
188 ; These match netlogo's dump
189 (defgeneric dump-object (o))
191 (defmethod dump-object ((n double-float))
192 (multiple-value-bind (int rem) (floor n)
194 (format nil "~A" int)
196 ((output (format nil "~D" n)))
197 ; Someday we'll have d<posint>, but this is not that day!
198 (cl-ppcre:regex-replace "d-" (cl-ppcre:regex-replace "d0" output "") "E-")))))
200 (defmethod dump-object ((o string)) o)
202 (defun current-state ()
203 "CURRENT-STATE => WORLD-STATE
205 ARGUMENTS AND VALUES:
207 WORLD-STATE: A list, the current state of the whole world
211 Dumps out the state of the world.
213 This is useful for visualizations and also storing in a common lisp
214 data structure for easy usage in a common lisp instance. It's preferable
215 to use this when working with the nvm than the output done by export-world.
217 Currently this only dumps out turtle information.
219 This is called CURRENT-STATE because export-world is an actual primitive
224 :color (turtle-color turtle)
225 :xcor (turtle-xcor turtle)
226 :ycor (turtle-ycor turtle)
227 :heading (turtle-heading turtle)))
230 (defun export-patches ()
232 "\"pxcor\",\"pycor\",\"pcolor\",\"plabel\",\"plabel-color\""
233 "\"-1\",\"1\",\"0\",\"\"\"\"\"\",\"9.9\""
234 "\"0\",\"1\",\"0\",\"\"\"\"\"\",\"9.9\""
235 "\"1\",\"1\",\"0\",\"\"\"\"\"\",\"9.9\""
236 "\"-1\",\"0\",\"0\",\"\"\"\"\"\",\"9.9\""
237 "\"0\",\"0\",\"0\",\"\"\"\"\"\",\"9.9\""
238 "\"1\",\"0\",\"0\",\"\"\"\"\"\",\"9.9\""
239 "\"-1\",\"-1\",\"0\",\"\"\"\"\"\",\"9.9\""
240 "\"0\",\"-1\",\"0\",\"\"\"\"\"\",\"9.9\""
241 "\"1\",\"-1\",\"0\",\"\"\"\"\"\",\"9.9\""))
243 (defun export-world ()
244 "EXPORT-WORLD => WORLD-CSV
246 ARGUMENTS AND VALUES:
248 WORLD-CSV: A string, the csv of the world
252 Dumps out a csv matching NetLogo's export world.
254 This is useful for serializing the current state of the engine in order
255 to compare against NetLogo or to reimport later. Contains everything needed
256 to boot up a NetLogo instance in the exact same state."
257 (format nil "~{~A~%~}"
259 (format nil "~S" "RANDOM STATE")
260 (format nil "~S" (clnl-random:export))
262 (format nil "~S" "GLOBALS")
264 "\"min-pxcor\",\"max-pxcor\",\"min-pycor\",\"max-pycor\",\"perspective\",\"subject\","
265 "\"nextIndex\",\"directed-links\",\"ticks\",")
266 (format nil "\"~A\",\"~A\",\"~A\",\"~A\",\"0\",\"nobody\",\"~A\",\"\"\"NEITHER\"\"\",\"-1\""
267 (getf (clnl-model:world-dimensions *model*) :xmin) (getf (clnl-model:world-dimensions *model*) :xmax)
268 (getf (clnl-model:world-dimensions *model*) :ymin) (getf (clnl-model:world-dimensions *model*) :ymax)
271 (format nil "~S" "TURTLES")
273 "\"who\",\"color\",\"heading\",\"xcor\",\"ycor\",\"shape\",\"label\",\"label-color\","
274 "\"breed\",\"hidden?\",\"size\",\"pen-size\",\"pen-mode\"")
275 (format nil "~{~A~%~}"
279 "\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",~A"
281 (dump-object (turtle-color turtle))
282 (dump-object (turtle-heading turtle))
283 (dump-object (turtle-xcor turtle))
284 (dump-object (turtle-ycor turtle))
285 "\"\"\"default\"\"\",\"\"\"\"\"\",\"9.9\",\"{all-turtles}\",\"false\",\"1\",\"1\",\"\"\"up\"\"\""))
287 (format nil "~S" "PATCHES")
288 (format nil "~{~A~^~%~}" (export-patches))
290 (format nil "~S" "LINKS")
291 "\"end1\",\"end2\",\"color\",\"label\",\"label-color\",\"hidden?\",\"breed\",\"thickness\",\"shape\",\"tie-mode\""