1 (in-package #:clnl-nvm)
3 (defvar *current-id* 0)
5 (defstruct turtle who color heading xcor ycor)
15 VALUE: a NetLogo value
20 A command that prints the given NetLogo value to the command center.
22 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#show"
23 (format t "Showing: ~A~%" (dump-object value)))
25 (defun create-turtle ()
33 :color (coerce (+ 5 (* 10 (clnl-random:next-int 14))) 'double-float)
34 :heading (coerce (clnl-random:next-int 360) 'double-float)
40 "TURTLES => ALL-TURTLES
44 ALL-TURTLES: a NetLogo agentset, all turtles
48 Reports the agentset consisting of all the turtles.
50 This agentset is special in that it represents the living turtles
51 each time it's used, so changes depending on the state of the engine.
53 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtles"
56 (defun ask (agent-set fn)
57 "ASK AGENT-SET FN => RESULT
61 AGENT-SET: a NetLogo agentset
62 FN: a function, run on each agent
63 RESULT: undefined, commands don't return
67 ASK is equivalent to ask in NetLogo.
69 The specified AGENT-SET runs the given FN. The order in which the agents
70 are run is random each time, and only agents that are in the set at the
71 beginning of the call.
73 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#ask"
75 ((iter (shufflerator agent-set)))
77 :for agent := (funcall iter)
79 :do (let ((*myself* *self*) (*self* agent)) (funcall fn)))))
81 (defun shufflerator (agent-set)
83 ((copy (copy-list agent-set))
89 ((idx (when (< i (1- (length copy))) (+ i (clnl-random:next-int (- (length copy) i))))))
90 (when idx (setf agent (nth idx copy)))
91 (when idx (setf (nth idx copy) (nth i copy)))
93 (fetch) ; we pre-fetch because netlogo does, rng sync hype!
96 ((> i (length copy)) nil)
97 ((= i (length copy)) (incf i) (car (last copy)))
98 (t (let ((result agent)) (fetch) result)))))))
100 (defun random-float (n)
101 "RANDOM-FLOAT N => RANDOM-NUMBER
103 ARGUMENTS AND VALUES:
105 N: a double, the upper bound of the random float
106 RANDOM-NUMBER: a double, the random result
110 Returns a random number strictly closer to zero than N.
112 If number is positive, returns a random floating point number greater than
113 or equal to 0 but strictly less than number.
115 If number is negative, returns a random floating point number less than or equal
116 to 0, but strictly greater than number.
118 If number is zero, the result is always 0.
120 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-float"
121 (clnl-random:next-double n))
126 ARGUMENTS AND VALUES:
128 N: a double, the amount the turtle moves forward
133 Moves the current turtle forward N steps, one step at a time.
135 This moves forward one at a time in order to make the view updates look
136 good in the case of a purposefully slow running instance. If the number
137 is negative, the turtle moves backward.
139 If the current agent is not a turtle, it raises an error.
141 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#forward"
142 (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude (~A)" *self*))
143 (setf (turtle-xcor *self*) (+ (turtle-xcor *self*) (* n (sin (* pi (/ (turtle-heading *self*) 180))))))
144 (setf (turtle-ycor *self*) (+ (turtle-ycor *self*) (* n (cos (* pi (/ (turtle-heading *self*) 180)))))))
146 (defun create-turtles (n)
147 "CREATE-TURTLES N => RESULT
149 ARGUMENTS AND VALUES:
151 N: an integer, the numbers of turtles to create
156 Creates number new turtles at the origin.
158 New turtles have random integer headings and the color is randomly selected
159 from the 14 primary colors. If commands are supplied, the new turtles
160 immediately run them (unimplemented).
162 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles"
163 (loop :for i :from 1 :to n :do (create-turtle)))
165 (defun create-world ()
166 "CREATE-WORLD => RESULT
168 ARGUMENTS AND VALUES:
174 Initializes the world in the NVM.
176 This should be called before using the engine in any real capacity. If
177 called when an engine is already running, it may do somethign weird."
179 (setf *current-id* 0))
181 ; These match netlogo's dump
182 (defgeneric dump-object (o))
184 (defmethod dump-object ((n double-float))
185 (multiple-value-bind (int rem) (floor n)
187 (format nil "~A" int)
189 ((output (format nil "~D" n)))
190 ; Someday we'll have d<posint>, but this is not that day!
191 (cl-ppcre:regex-replace "d-" (cl-ppcre:regex-replace "d0" output "") "E-")))))
193 (defmethod dump-object ((o string)) o)
195 (defun current-state ()
196 "CURRENT-STATE => WORLD-STATE
198 ARGUMENTS AND VALUES:
200 WORLD-STATE: A list, the current state of the whole world
204 Dumps out the state of the world.
206 This is useful for visualizations and also storing in a common lisp
207 data structure for easy usage in a common lisp instance. It's preferable
208 to use this when working with the nvm than the output done by export-world.
210 Currently this only dumps out turtle information.
212 This is called CURRENT-STATE because export-world is an actual primitive
217 :color (turtle-color turtle)
218 :xcor (turtle-xcor turtle)
219 :ycor (turtle-ycor turtle)
220 :heading (turtle-heading turtle)))
223 (defun export-patches ()
225 "\"pxcor\",\"pycor\",\"pcolor\",\"plabel\",\"plabel-color\""
226 "\"-1\",\"1\",\"0\",\"\"\"\"\"\",\"9.9\""
227 "\"0\",\"1\",\"0\",\"\"\"\"\"\",\"9.9\""
228 "\"1\",\"1\",\"0\",\"\"\"\"\"\",\"9.9\""
229 "\"-1\",\"0\",\"0\",\"\"\"\"\"\",\"9.9\""
230 "\"0\",\"0\",\"0\",\"\"\"\"\"\",\"9.9\""
231 "\"1\",\"0\",\"0\",\"\"\"\"\"\",\"9.9\""
232 "\"-1\",\"-1\",\"0\",\"\"\"\"\"\",\"9.9\""
233 "\"0\",\"-1\",\"0\",\"\"\"\"\"\",\"9.9\""
234 "\"1\",\"-1\",\"0\",\"\"\"\"\"\",\"9.9\""))
236 (defun export-world ()
237 "EXPORT-WORLD => WORLD-CSV
239 ARGUMENTS AND VALUES:
241 WORLD-CSV: A string, the csv of the world
245 Dumps out a csv matching NetLogo's export world.
247 This is useful for serializing the current state of the engine in order
248 to compare against NetLogo or to reimport later. Contains everything needed
249 to boot up a NetLogo instance in the exact same state."
250 (format nil "~{~A~%~}"
252 (format nil "~S" "RANDOM STATE")
253 (format nil "~S" (clnl-random:export))
255 (format nil "~S" "GLOBALS")
257 "\"min-pxcor\",\"max-pxcor\",\"min-pycor\",\"max-pycor\",\"perspective\",\"subject\","
258 "\"nextIndex\",\"directed-links\",\"ticks\",")
259 (format nil "\"-1\",\"1\",\"-1\",\"1\",\"0\",\"nobody\",\"~A\",\"\"\"NEITHER\"\"\",\"-1\"" *current-id*)
261 (format nil "~S" "TURTLES")
263 "\"who\",\"color\",\"heading\",\"xcor\",\"ycor\",\"shape\",\"label\",\"label-color\","
264 "\"breed\",\"hidden?\",\"size\",\"pen-size\",\"pen-mode\"")
265 (format nil "~{~A~%~}"
269 "\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",~A"
271 (dump-object (turtle-color turtle))
272 (dump-object (turtle-heading turtle))
273 (dump-object (turtle-xcor turtle))
274 (dump-object (turtle-ycor turtle))
275 "\"\"\"default\"\"\",\"\"\"\"\"\",\"9.9\",\"{all-turtles}\",\"false\",\"1\",\"1\",\"\"\"up\"\"\""))
277 (format nil "~S" "PATCHES")
278 (format nil "~{~A~^~%~}" (export-patches))
280 (format nil "~S" "LINKS")
281 "\"end1\",\"end2\",\"color\",\"label\",\"label-color\",\"hidden?\",\"breed\",\"thickness\",\"shape\",\"tie-mode\""