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 create-turtle ()
28 :color (coerce (+ 5 (* 10 (clnl-random:next-int 14))) 'double-float)
29 :heading (coerce (clnl-random:next-int 360) 'double-float)
35 "TURTLES => ALL-TURTLES
39 ALL-TURTLES: a NetLogo agentset, all turtles
43 Reports the agentset consisting of all the turtles.
45 This agentset is special in that it represents the living turtles
46 each time it's used, so changes depending on the state of the engine.
48 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtles"
51 (defun ask (agent-set fn)
52 "ASK AGENT-SET FN => RESULT
56 AGENT-SET: a NetLogo agentset
57 FN: a function, run on each agent
58 RESULT: undefined, commands don't return
62 ASK is equivalent to ask in NetLogo.
64 The specified AGENT-SET runs the given FN. The order in which the agents
65 are run is random each time, and only agents that are in the set at the
66 beginning of the call.
68 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#ask"
70 ((iter (shufflerator agent-set)))
72 :for agent := (funcall iter)
74 :do (let ((*myself* *self*) (*self* agent)) (funcall fn)))))
76 (defun shufflerator (agent-set)
78 ((copy (copy-list agent-set))
84 ((idx (when (< i (1- (length copy))) (+ i (clnl-random:next-int (- (length copy) i))))))
85 (when idx (setf agent (nth idx copy)))
86 (when idx (setf (nth idx copy) (nth i copy)))
88 (fetch) ; we pre-fetch because netlogo does, rng sync hype!
91 ((> i (length copy)) nil)
92 ((= i (length copy)) (incf i) (car (last copy)))
93 (t (let ((result agent)) (fetch) result)))))))
95 (defun random-float (n)
96 "RANDOM-FLOAT N => RANDOM-NUMBER
100 N: a double, the upper bound of the random float
101 RANDOM-NUMBER: a double, the random result
105 Returns a random number strictly closer to zero than N.
107 If number is positive, returns a random floating point number greater than
108 or equal to 0 but strictly less than number.
110 If number is negative, returns a random floating point number less than or equal
111 to 0, but strictly greater than number.
113 If number is zero, the result is always 0.
115 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-float"
116 (clnl-random:next-double n))
119 (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude (~A)" *self*))
123 (+ (turtle-xcor *self*) (* n (strictmath:sin (strictmath:to-radians (turtle-heading *self*)))))))
127 (+ (turtle-ycor *self*) (* n (strictmath:cos (strictmath:to-radians (turtle-heading *self*))))))))
132 ARGUMENTS AND VALUES:
134 N: a double, the amount the turtle moves forward
139 Moves the current turtle forward N steps, one step at a time.
141 This moves forward one at a time in order to make the view updates look
142 good in the case of a purposefully slow running instance. If the number
143 is negative, the turtle moves backward.
145 If the current agent is not a turtle, it raises an error.
147 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#forward"
148 (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude (~A)" *self*))
152 ((< (abs i) 3.2e-15) nil)
153 ((< (abs i) 1d0) (jump i))
154 (t (jump (if (> i 0d0) 1d0 -1d0)) (internal (- i (if (> i 0d0) 1d0 -1d0)))))))
157 (defun create-turtles (n)
158 "CREATE-TURTLES N => RESULT
160 ARGUMENTS AND VALUES:
162 N: an integer, the numbers of turtles to create
167 Creates number new turtles at the origin.
169 New turtles have random integer headings and the color is randomly selected
170 from the 14 primary colors. If commands are supplied, the new turtles
171 immediately run them (unimplemented).
173 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles"
174 (loop :for i :from 1 :to n :do (create-turtle)))
176 (defun create-world (&key dims)
177 "CREATE-WORLD &key DIMS => RESULT
179 DIMS: (:xmin XMIN :xmax XMAX :ymin YMIN :ymax YMAX)
181 ARGUMENTS AND VALUES:
184 XMIN: An integer representing the minimum patch coord in X
185 XMAX: An integer representing the maximum patch coord in X
186 YMIN: An integer representing the minimum patch coord in Y
187 YMAX: An integer representing the maximum patch coord in Y
191 Initializes the world in the NVM.
193 This should be called before using the engine in any real capacity. If
194 called when an engine is already running, it may do somethign weird."
195 (setf *dimensions* dims)
197 (setf *current-id* 0))
199 ; These match netlogo's dump
200 (defgeneric dump-object (o))
202 (defmethod dump-object ((n double-float))
203 (multiple-value-bind (int rem) (floor n)
205 (format nil "~A" int)
207 ((output (format nil "~D" n)))
208 ; Someday we'll have d<posint>, but this is not that day!
209 (cl-ppcre:regex-replace "d-" (cl-ppcre:regex-replace "d0" output "") "E-")))))
211 (defmethod dump-object ((o string)) o)
213 (defmethod dump-object ((o (eql t))) "true")
214 (defmethod dump-object ((o (eql nil))) "false")
216 (defun current-state ()
217 "CURRENT-STATE => WORLD-STATE
219 ARGUMENTS AND VALUES:
221 WORLD-STATE: A list, the current state of the whole world
225 Dumps out the state of the world.
227 This is useful for visualizations and also storing in a common lisp
228 data structure for easy usage in a common lisp instance. It's preferable
229 to use this when working with the nvm than the output done by export-world.
231 Currently this only dumps out turtle information.
233 This is called CURRENT-STATE because export-world is an actual primitive
238 :color (turtle-color turtle)
239 :xcor (turtle-xcor turtle)
240 :ycor (turtle-ycor turtle)
241 :heading (turtle-heading turtle)))
244 (defun export-patches ()
246 "\"pxcor\",\"pycor\",\"pcolor\",\"plabel\",\"plabel-color\""
247 "\"-1\",\"1\",\"0\",\"\"\"\"\"\",\"9.9\""
248 "\"0\",\"1\",\"0\",\"\"\"\"\"\",\"9.9\""
249 "\"1\",\"1\",\"0\",\"\"\"\"\"\",\"9.9\""
250 "\"-1\",\"0\",\"0\",\"\"\"\"\"\",\"9.9\""
251 "\"0\",\"0\",\"0\",\"\"\"\"\"\",\"9.9\""
252 "\"1\",\"0\",\"0\",\"\"\"\"\"\",\"9.9\""
253 "\"-1\",\"-1\",\"0\",\"\"\"\"\"\",\"9.9\""
254 "\"0\",\"-1\",\"0\",\"\"\"\"\"\",\"9.9\""
255 "\"1\",\"-1\",\"0\",\"\"\"\"\"\",\"9.9\""))
257 (defun export-world ()
258 "EXPORT-WORLD => WORLD-CSV
260 ARGUMENTS AND VALUES:
262 WORLD-CSV: A string, the csv of the world
266 Dumps out a csv matching NetLogo's export world.
268 This is useful for serializing the current state of the engine in order
269 to compare against NetLogo or to reimport later. Contains everything needed
270 to boot up a NetLogo instance in the exact same state."
271 (format nil "~{~A~%~}"
273 (format nil "~S" "RANDOM STATE")
274 (format nil "~S" (clnl-random:export))
276 (format nil "~S" "GLOBALS")
278 "\"min-pxcor\",\"max-pxcor\",\"min-pycor\",\"max-pycor\",\"perspective\",\"subject\","
279 "\"nextIndex\",\"directed-links\",\"ticks\",")
280 (format nil "\"~A\",\"~A\",\"~A\",\"~A\",\"0\",\"nobody\",\"~A\",\"\"\"NEITHER\"\"\",\"-1\""
281 (min-pxcor) (max-pxcor) (min-pycor) (max-pycor) *current-id*)
283 (format nil "~S" "TURTLES")
285 "\"who\",\"color\",\"heading\",\"xcor\",\"ycor\",\"shape\",\"label\",\"label-color\","
286 "\"breed\",\"hidden?\",\"size\",\"pen-size\",\"pen-mode\"")
287 (format nil "~{~A~%~}"
291 "\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",~A"
293 (dump-object (turtle-color turtle))
294 (dump-object (turtle-heading turtle))
295 (dump-object (turtle-xcor turtle))
296 (dump-object (turtle-ycor turtle))
297 "\"\"\"default\"\"\",\"\"\"\"\"\",\"9.9\",\"{all-turtles}\",\"false\",\"1\",\"1\",\"\"\"up\"\"\""))
299 (format nil "~S" "PATCHES")
300 (format nil "~{~A~^~%~}" (export-patches))
302 (format nil "~S" "LINKS")
303 "\"end1\",\"end2\",\"color\",\"label\",\"label-color\",\"hidden?\",\"breed\",\"thickness\",\"shape\",\"tie-mode\""