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 (breed &optional base-turtle)
53 ((breed (or breed (and base-turtle (turtle-breed base-turtle)) :turtles))
54 (new-turtle (make-turtle
55 :who (coerce *current-id* 'double-float)
56 :color (if base-turtle
57 (turtle-color base-turtle)
58 (coerce (+ 5 (* 10 (clnl-random:next-int 14))) 'double-float))
59 :heading (if base-turtle
60 (turtle-heading base-turtle)
61 (coerce (clnl-random:next-int 360) 'double-float))
62 :label-color (if base-turtle (turtle-label-color base-turtle) 9.9d0)
63 :size (if base-turtle (turtle-size base-turtle) 1d0)
65 :shape (breed-default-shape breed)
66 :xcor (if base-turtle (turtle-xcor base-turtle) 0d0)
67 :ycor (if base-turtle (turtle-ycor base-turtle) 0d0)
68 :own-vars (when base-turtle (copy-list (turtle-own-vars base-turtle))))))
70 ((patch (patch-at (turtle-xcor new-turtle) (turtle-ycor new-turtle))))
71 (setf (patch-turtles patch) (nconc (patch-turtles patch) (list new-turtle))))
72 (setf *turtles* (nconc *turtles* (list new-turtle)))
81 RESULT: undefined, commands don't return
85 The turtle or link dies
87 A dead agent ceases to exist. The effects of this include:
88 - The agent will not execute any further code.
89 - The agent will disappear from any agentsets it was in, reducing the size of those agentsets by one.
90 - Any variable that was storing the agent will now instead have nobody in it.
91 - If the dead agent was a turtle, every link connected to it also dies.
92 - If the observer was watching or following the agent, the observer's perspective resets.
94 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#die"
95 (when (not (turtle-p *self*)) (error "Gotta call die in turtle scope, dude (~A)" *self*))
96 (setf (turtle-who *self*) -1)
97 (setf *turtles* (remove *self* *turtles*))
99 ((patch (patch-at (turtle-xcor *self*) (turtle-ycor *self*))))
100 (setf (patch-turtles patch) (remove *self* (patch-turtles patch))))
101 (error (make-condition 'death)))
104 "PATCHES => ALL-PATCHES
106 ARGUMENTS AND VALUES:
108 ALL-PATCHES: a NetLogo agentset, all patches
112 Reports the agentset consisting of all the patches.
114 This agentset is special in that it represents the living patches
115 each time it's used, so changes depending on the state of the engine.
117 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#patches"
121 "TURTLES => ALL-TURTLES
123 ARGUMENTS AND VALUES:
125 ALL-TURTLES: a NetLogo agentset, all turtles
129 Reports the agentset consisting of all the turtles.
131 This agentset is special in that it represents the living turtles
132 each time it's used, so changes depending on the state of the engine.
134 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtles"
137 (defun turtles-here (&optional breed)
138 "TURTLES-HERE => TURTLES
140 ARGUMENTS AND VALUES:
146 Returns the agentset consisting of all the turtles sharing the patch
147 with the agent in by *self*
149 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtles-here"
150 (when (not (turtle-p *self*)) (error "Gotta call turtles-here with a turtle"))
152 ((patch-turtles (patch-turtles (patch-at (turtle-xcor *self*) (turtle-ycor *self*)))))
154 (if breed (remove breed patch-turtles :key #'turtle-breed :test-not #'eql) patch-turtles)
155 (or breed :turtles))))
157 (defun ask (agent-or-agentset fn)
158 "ASK AGENT-OR-AGENTSET FN => RESULT
160 AGENT-OR-AGENTSET: AGENT | AGENTSET
162 ARGUMENTS AND VALUES:
164 FN: a function, run on each agent
165 RESULT: undefined, commands don't return
166 AGENT: a NetLogo agent
167 AGENTSET: a NetLogo agentset
171 ASK is equivalent to ask in NetLogo.
173 The specified AGENTSET or AGENT runs the given FN. In the case of an
174 AGENTSET, the order in which the agents are run is random each time,
175 and only agents that are in the set at the beginning of the call.
177 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#ask"
179 ((agentset-p agent-or-agentset)
181 ((iter (shufflerator (agentset-list agent-or-agentset))))
183 :for agent := (funcall iter)
185 :do (when (not (and (turtle-p agent) (= -1 (turtle-who agent))))
186 (let ((*myself* *self*) (*self* agent)) (with-stop-and-death-handler (funcall fn)))))))
187 ((agent-p agent-or-agentset)
188 (let ((*myself* *self*) (*self* agent-or-agentset)) (with-stop-and-death-handler (funcall fn))))
190 (error "Ask requires an agentset or agent but got: ~A" agent-or-agentset))))
192 (defun count (agentset)
195 ARGUMENTS AND VALUES:
197 AGENTSET: a NetLogo agentset
202 COUNT is equivalent to count in NetLogo. Returns N, the number of
205 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#count"
206 (coerce (length (agentset-list agentset)) 'double-float))
211 ARGUMENTS AND VALUES:
217 Clears ticks, turtles, patches, globals (unimplemented).
219 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#clear-all"
227 ARGUMENTS AND VALUES:
233 As of yet, this does nothing. A placeholder method for forced dipslay
234 updates from the engine.
236 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#display"
242 ARGUMENTS AND VALUES:
248 Returns from the current stop block, which will halt the currently running
249 thing, be that the program, current ask block, or procedure. Stop has odd
250 semantics that are best gleaned from the actual NetLogo manual.
252 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#stop"
253 (error (make-condition 'stop)))
255 (defun of (fn agent-or-agentset)
256 "OF FN AGENT-OR-AGENTSET => RESULT
258 AGENT-OR-AGENTSET: AGENT | AGENTSET
259 RESULT: RESULT-LIST | RESULT-VALUE
261 ARGUMENTS AND VALUES:
263 FN: a function, run on each agent
264 AGENT: a NetLogo agent
265 AGENTSET: a NetLogo agentset
267 RESULT-VALUE: a single value
271 OF is equivalent to of in NetLogo.
273 The specified AGENTSET or AGENT runs the given FN. In the case of an
274 AGENTSET, the order in which the agents are run is random each time,
275 and only agents that are in the set at the beginning of the call.
277 RESULT-LIST is returned when the input is an AGENTSET, but RESULT-VALUE
278 is returned when only passed an AGENT.
280 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#of"
282 ((agentset-p agent-or-agentset)
284 ((iter (shufflerator (agentset-list agent-or-agentset))))
286 :for agent := (funcall iter)
288 :collect (let ((*myself* *self*) (*self* agent)) (funcall fn)))))
289 ((agent-p agent-or-agentset)
290 (let ((*myself* *self*) (*self* agent-or-agentset)) (funcall fn)))
292 (error "Of requires an agentset or agent but got: ~A" agent-or-agentset))))
294 (defun with (agentset fn)
295 "WITH AGENTSET FN => RESULT-AGENTSET
297 ARGUMENTS AND VALUES:
299 AGENTSET: a NetLogo agentset
300 FN: a boolean function, run on each agent to determine if included
301 RESULT-AGENTSET: an agentset of valid agents
305 WITH is equivalent to with in NetLogo.
307 Returns a new agentset containing only those agents that reported true
310 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#with"
314 (let ((*myself* *self*) (*self* agent)) (funcall fn)))
315 (agentset-list agentset))
316 (agentset-breed agentset)))
318 (defun shufflerator (agentset-list)
320 ((copy (copy-list agentset-list))
326 ((idx (when (< i (1- (length copy))) (+ i (clnl-random:next-int (- (length copy) i))))))
327 (when idx (setf agent (nth idx copy)))
328 (when idx (setf (nth idx copy) (nth i copy)))
330 (when (and (<= i (length copy)) (turtle-p agent) (= -1 (turtle-who agent))) (fetch)))))
331 (fetch) ; we pre-fetch because netlogo does, rng sync hype!
334 ((> i (length copy)) nil)
335 ((= i (length copy)) (incf i) (car (last copy)))
336 (t (let ((result agent)) (fetch) result)))))))
338 (defun random-float (n)
339 "RANDOM-FLOAT N => RANDOM-NUMBER
341 ARGUMENTS AND VALUES:
343 N: a double, the upper bound of the random float
344 RANDOM-NUMBER: a double, the random result
348 Returns a random number strictly closer to zero than N.
350 If number is positive, returns a random floating point number greater than
351 or equal to 0 but strictly less than number.
353 If number is negative, returns a random floating point number less than or equal
354 to 0, but strictly greater than number.
356 If number is zero, the result is always 0.
358 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-float"
359 (clnl-random:next-double n))
362 "RANDOM N => RANDOM-NUMBER
364 ARGUMENTS AND VALUES:
366 N: an integer, the upper bound of the random
367 RANDOM-NUMBER: an integer, the random result
371 Returns a random number strictly closer to zero than N.
373 If number is positive, returns a random integer greater than or equal to 0,
374 but strictly less than number.
376 If number is negative, returns a random integer less than or equal to 0,
377 but strictly greater than number.
379 If number is zero, the result is always 0.
381 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random"
382 (coerce (clnl-random:next-long (truncate n)) 'double-float))
384 (defun random-xcor ()
385 "RANDOM-XCOR => RANDOM-NUMBER
387 ARGUMENTS AND VALUES:
389 RANDOM-NUMBER: a float, the random result
393 Returns a random floating point number in the allowable range of turtle
394 coordinates along the x axis.
396 These range from min-pxcor - 0.5 (inclusive) to max-pxcor + 0.5 (exclusive)
398 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-cor"
400 ((min (- (min-pxcor) 0.5d0))
401 (max (+ (max-pxcor) 0.5d0)))
402 (+ min (clnl-random:next-double (- max min)))))
404 (defun random-ycor ()
405 "RANDOM-YCOR => RANDOM-NUMBER
407 ARGUMENTS AND VALUES:
409 RANDOM-NUMBER: a float, the random result
413 Returns a random floating point number in the allowable range of turtle
414 coordinates along the y axis.
416 These range from min-pycor - 0.5 (inclusive) to max-pycor + 0.5 (exclusive)
418 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-cor"
420 ((min (- (min-pycor) 0.5d0))
421 (max (+ (max-pycor) 0.5d0)))
422 (+ min (clnl-random:next-double (- max min)))))
424 (defun one-of (list-or-agentset)
425 "ONE-OF LIST-OR-AGENTSET => RESULT
427 LIST-OR-AGENTSET: LIST | AGENTSET
428 RESULT: RANDOM-VALUE | RANDOM-AGENT | :nobody
430 ARGUMENTS AND VALUES:
433 AGENTSET: An agent set
434 RANDOM-VALUE: a value in LIST
435 RANDOM-AGENT: an agent if AGENTSET is non empty
439 From an AGENTSET, returns a RANDOM-AGENT. If the agentset is empty, returns :nobody.
440 From a list, returns a RANDOM-VALUE. If the list is empty, an error occurs.
442 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#one-of"
444 ((agentset-p list-or-agentset)
446 ((agentset-list (agentset-list list-or-agentset))
447 (length (length agentset-list)))
448 (if (zerop length) :nobody (nth (clnl-random:next-int length) agentset-list))))
449 ((listp list-or-agentset)
451 ((length (length list-or-agentset)))
453 (error "one-of requires a nonempty list")
454 (nth (clnl-random:next-int length) list-or-agentset))))
455 (t (error "one-of requires a list or agentset"))))
458 (when (not (turtle-p *self*)) (error "Gotta call jump in turtle scope, dude (~A)" *self*))
459 (with-patch-update *self*
463 (+ (turtle-xcor *self*) (* n (using-cached-sin (turtle-heading *self*))))))
467 (+ (turtle-ycor *self*) (* n (using-cached-cos (turtle-heading *self*))))))))
472 ARGUMENTS AND VALUES:
480 Sets the x-coordinate and y-coordinate for the turle. Equivalent to
481 set xcor x set ycor y, except it happens in one step inside of two.
483 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#setxy"
484 (when (not (turtle-p *self*)) (error "Gotta call setxy in turtle scope, dude (~A)" *self*))
485 (setf (turtle-xcor *self*) (wrap-x *topology* x))
486 (setf (turtle-ycor *self*) (wrap-y *topology* y)))
488 (defun set-default-shape (breed shape)
489 "SET-DEFAULT-SHAPE BREED SHAPE => RESULT
491 ARGUMENTS AND VALUES:
499 Specifies a default initial shape for a BREED. When a turtle, or it changes breeds,
500 its shape is set to the given shape.
502 SET-DEFAULT-SHAPE doesn't affect existing agents, only agents you create afterwards.
504 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#set-default-shape"
505 (when (not (breed-p breed)) (error "Need a valid breed"))
506 (setf (breed-default-shape breed) shape))
511 ARGUMENTS AND VALUES:
513 N: a double, the amount the turtle moves forward
518 Moves the current turtle forward N steps, one step at a time.
520 This moves forward one at a time in order to make the view updates look
521 good in the case of a purposefully slow running instance. If the number
522 is negative, the turtle moves backward.
524 If the current agent is not a turtle, it raises an error.
526 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#forward"
527 (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude (~A)" *self*))
531 ((< (abs i) 3.2e-15) nil)
532 ((< (abs i) 1d0) (jump i))
533 (t (jump (if (> i 0d0) 1d0 -1d0)) (internal (- i (if (> i 0d0) 1d0 -1d0)))))))
536 (defun turn-right (n)
537 "TURN-RIGHT N => RESULT
539 ARGUMENTS AND VALUES:
541 N: a double, the amount the turtle turns
546 The turtle turns right by number degrees. (If number is negative, it turns left.)
548 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#right"
549 (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude (~A)" *self*))
551 ((new-heading (+ (turtle-heading *self*) n)))
552 (setf (turtle-heading *self*)
554 ((< new-heading 0) (+ (mod new-heading -360) 360))
555 ((>= new-heading 360) (mod new-heading 360))
559 "TURN-LEFT N => RESULT
561 ARGUMENTS AND VALUES:
563 N: a double, the amount the turtle turns
568 The turtle turns left by number degrees. (If number is negative, it turns right.)
570 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#right"
573 (defun create-turtles (n &optional breed fn)
574 "CREATE-TURTLES N &optional BREED FN => RESULT
576 ARGUMENTS AND VALUES:
578 N: an integer, the numbers of turtles to create
580 FN: A function, applied to each turtle after creation
585 Creates N new turtles at the origin.
587 New turtles have random integer headings and the color is randomly selected
588 from the 14 primary colors. If FN is supplied, the new turtles immediately
589 run it. If a BREED is supplied, that is the breed the new turtles are set
592 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles"
594 ((new-turtles (loop :repeat n :collect (create-turtle breed))))
595 (when fn (ask (list->agentset new-turtles :turtles) fn))))
597 (defun hatch (n &optional fn)
598 "HATCH N &optional FN => RESULT
600 ARGUMENTS AND VALUES:
602 N: an integer, the numbers of turtles to hatch
603 FN: A function, applied to each turtle after creation
608 The turtle in *self* creates N new turtles. Each new turtle inherits of all its
609 variables, including its location, from self.
611 If FN is supplied, the new turtles immediately run it.
613 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#hatch"
614 (when (not (turtle-p *self*)) (error "Can only hatch from turtle scope"))
616 ((new-turtles (loop :repeat n :collect (create-turtle nil *self*))))
617 (when fn (ask (list->agentset new-turtles :turtles) fn))))
619 (defun reset-ticks ()
620 "RESET-TICKS => RESULT
622 ARGUMENTS AND VALUES:
628 Resets the tick counter to zero, sets up all plots, then updates all plots.
630 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#reset-ticks"
634 "RESET-TICKS => RESULT
636 ARGUMENTS AND VALUES:
642 Advances the tick counter by one and updates all plots.
644 If the tick counter has not been started yet with reset-ticks, an error results.
646 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#tick"
648 (when (not *ticks*) (error "reset-ticks must be called"))
652 "TICKS => CURRENT-TICKS
654 ARGUMENTS AND VALUES:
656 CURRENT-TICKS: A positiv double, representing the current number of ticks
660 Reports the current value of the tick counter. The result is always a number and never negative.
662 If the tick counter has not been started yet with reset-ticks, an error results.
664 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#ticks"
665 (when (not *ticks*) (error "reset-ticks must be called"))
668 (defun clear-patches ()
672 :for y :from (max-pycor) :downto (min-pycor)
674 :for x :from (min-pxcor) :to (max-pxcor)
676 :xcor (coerce x 'double-float)
677 :ycor (coerce y 'double-float)
680 (defun clear-turtles ()
682 (setf *current-id* 0))
684 (defun clear-ticks ()
687 (defun create-world (&key dims globals turtles-own-vars patches-own-vars breeds)
688 "CREATE-WORLD &key DIMS GLOBALS TURTLES-OWN-VARS PATCHES-OWN-VARS BREEDS => RESULT
690 DIMS: (:xmin XMIN :xmax XMAX :ymin YMIN :ymax YMAX)
692 TURTLES-OWN-VARS: TURTLES-OWN-VAR*
693 PATCHES-OWN-VARS: PATCHES-OWN-VAR*
695 GLOBAL: (GLOBAL-NAME GLOBAL-ACCESS-FUNC)
697 ARGUMENTS AND VALUES:
700 XMIN: An integer representing the minimum patch coord in X
701 XMAX: An integer representing the maximum patch coord in X
702 YMIN: An integer representing the minimum patch coord in Y
703 YMAX: An integer representing the maximum patch coord in Y
704 TURTLES-OWN-VAR: Symbol for the turtles own variable in the keyword package
705 PATCHES-OWN-VAR: Symbol for the patches own variable in the keyword package
706 BREED: A list of symbols representing the possible preeds
707 GLOBAL-NAME: Symbol for the global in the keyword package
708 GLOBAL-ACCESS-FUNC: Function to get the value of the global
712 Initializes the world in the NVM.
714 This should be called before using the engine in any real capacity. If
715 called when an engine is already running, it may do somethign weird."
716 (setf *turtles-own-vars* turtles-own-vars)
717 (setf *patches-own-vars* patches-own-vars)
718 (setf *dimensions* dims)
719 (setf *globals* globals)
722 (list (list :turtles "default"))
723 (mapcar (lambda (breed) (list breed "default")) breeds)))
728 ; These match netlogo's dump
729 (defgeneric dump-object (o))
731 (defmethod dump-object ((n double-float))
732 (multiple-value-bind (int rem) (floor n)
734 (format nil "~A" int)
736 ((output (format nil "~D" n)))
737 ; Someday we'll have d<posint>, but this is not that day!
738 (cl-ppcre:regex-replace "d-" (cl-ppcre:regex-replace "d0" output "") "E-")))))
740 (defmethod dump-object ((o string)) (format nil "~A" (cl-ppcre:regex-replace-all "\"" (format nil "~S" o) "\"\"")))
742 (defmethod dump-object ((o (eql t))) "true")
743 (defmethod dump-object ((o (eql nil))) "false")
745 (defmethod dump-object ((o list))
747 ((agentset-p o) (format nil "(agentset, ~A ~A)" (dump-object (count o)) (string-downcase (agentset-breed o))))
748 (t (format nil "[~{~A~^ ~}]" (mapcar #'dump-object o)))))
750 (defmethod dump-object ((o patch))
751 (format nil "(patch ~A ~A)" (dump-object (patch-xcor o)) (dump-object (patch-ycor o))))
753 (defmethod dump-object ((o turtle)) (format nil "(turtle ~A)" (dump-object (turtle-who o))))
754 (defmethod dump-object ((o (eql :nobody))) (format nil "nobody"))
755 (defmethod dump-object ((o (eql :turtles))) (format nil "{all-turtles}"))
756 (defmethod dump-object ((o symbol))
758 ((find o *breeds* :key #'car) (format nil "{breed ~(~A~)}" o))
759 (t (error "Keyword unrecognized by dump object: ~A" o))))
761 (defun current-state ()
762 "CURRENT-STATE => WORLD-STATE
764 ARGUMENTS AND VALUES:
766 WORLD-STATE: A list, the current state of the whole world
770 Dumps out the state of the world.
772 This is useful for visualizations and also storing in a common lisp
773 data structure for easy usage in a common lisp instance. It's preferable
774 to use this when working with the nvm than the output done by export-world.
776 Currently this only dumps out turtle and patch information.
778 This is called CURRENT-STATE because export-world is an actual primitive
784 :color (turtle-color turtle)
785 :xcor (turtle-xcor turtle)
786 :ycor (turtle-ycor turtle)
787 :heading (turtle-heading turtle)
788 :shape (turtle-shape turtle)
789 :size (turtle-size turtle)))
794 :color (patch-color patch)
795 :xcor (patch-xcor patch)
796 :ycor (patch-ycor patch)))
799 (defun export-turtles ()
803 (format nil "~A~A~{,\"~A\"~}"
804 "\"who\",\"color\",\"heading\",\"xcor\",\"ycor\",\"shape\",\"label\",\"label-color\","
805 "\"breed\",\"hidden?\",\"size\",\"pen-size\",\"pen-mode\""
806 (mapcar #'string-downcase *turtles-own-vars*)))
810 "\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"false\",\"~A\",~A~{,\"~A\"~}"
811 (dump-object (turtle-who turtle))
812 (dump-object (turtle-color turtle))
813 (dump-object (turtle-heading turtle))
814 (dump-object (turtle-xcor turtle))
815 (dump-object (turtle-ycor turtle))
816 (dump-object (turtle-shape turtle))
817 (dump-object (turtle-label turtle))
818 (dump-object (turtle-label-color turtle))
819 (dump-object (turtle-breed turtle))
820 (dump-object (turtle-size turtle))
821 "\"1\",\"\"\"up\"\"\""
822 (mapcar #'dump-object (mapcar (lambda (var) (agent-value-inner turtle var)) *turtles-own-vars*))))
825 (defun export-patches ()
829 (format nil "\"pxcor\",\"pycor\",\"pcolor\",\"plabel\",\"plabel-color\"~{,\"~A\"~}"
830 (mapcar #'string-downcase *patches-own-vars*)))
834 "\"~A\",\"~A\",\"~A\",\"\"\"\"\"\",\"9.9\"~{,\"~A\"~}"
835 (dump-object (patch-xcor patch))
836 (dump-object (patch-ycor patch))
837 (dump-object (patch-color patch))
838 (mapcar #'dump-object (mapcar (lambda (var) (agent-value-inner patch var)) *patches-own-vars*))))
841 (defun export-world ()
842 "EXPORT-WORLD => WORLD-CSV
844 ARGUMENTS AND VALUES:
846 WORLD-CSV: A string, the csv of the world
850 Dumps out a csv matching NetLogo's export world.
852 This is useful for serializing the current state of the engine in order
853 to compare against NetLogo or to reimport later. Contains everything needed
854 to boot up a NetLogo instance in the exact same state."
856 ((ordered-globals (sort (copy-list *globals*) #'string< :key (lambda (global) (symbol-name (car global))))))
857 (format nil "~{~A~%~}"
859 (format nil "~S" "RANDOM STATE")
860 (format nil "~S" (clnl-random:export))
862 (format nil "~S" "GLOBALS")
863 (format nil "~A~A~{\"~A\"~^,~}"
864 "\"min-pxcor\",\"max-pxcor\",\"min-pycor\",\"max-pycor\",\"perspective\",\"subject\","
865 "\"nextIndex\",\"directed-links\",\"ticks\","
866 (mapcar #'string-downcase (mapcar #'car ordered-globals)))
867 (format nil "\"~A\",\"~A\",\"~A\",\"~A\",\"0\",\"nobody\",\"~A\",\"\"\"NEITHER\"\"\",\"~A\"~{,\"~A\"~}"
868 (min-pxcor) (max-pxcor) (min-pycor) (max-pycor) *current-id* (dump-object (or *ticks* -1d0))
869 (mapcar #'dump-object (mapcar #'funcall (mapcar #'cadr ordered-globals))))
871 (format nil "~{~A~^~%~}" (export-turtles))
873 (format nil "~{~A~^~%~}" (export-patches))
875 (format nil "~S" "LINKS")
876 "\"end1\",\"end2\",\"color\",\"label\",\"label-color\",\"hidden?\",\"breed\",\"thickness\",\"shape\",\"tie-mode\""