code.consxy.com Git - clnl/blob - src/main/nvm/nvm.lisp

   1 (in-package #:clnl-nvm)
   2
   3 ; Implementations of all the things the nvm can do.
   4
   5 (defun show (value)
   6  "SHOW VALUE => RESULT
   7
   8 ARGUMENTS AND VALUES:
   9
  10   VALUE: a NetLogo value
  11   RESULT: undefined
  12
  13 DESCRIPTION:
  14
  15   A command that prints the given NetLogo value to the command center.
  16
  17   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#show"
  18  (format t "Showing: ~A~%" (dump-object value)))
  19
  20 (defun lookup-color (color)
  21  "LOOKUP-COLOR COLOR => COLOR-NUMBER
  22
  23 ARGUMENTS AND VALUES:
  24
  25   COLOR: a symbol representing a color
  26   COLOR-NUMBER: the NetLogo color integer
  27
  28 DESCRIPTION:
  29
  30   Returns the number used to represent colors in NetLogo.
  31
  32   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#Constants"
  33  (case color
  34   (:black 0d0)
  35   (:gray 5d0)
  36   (:white 9.9d0)
  37   (:red 15d0)
  38   (:orange 25d0)
  39   (:brown 35d0)
  40   (:yellow 45d0)
  41   (:green 55d0)
  42   (:lime 65d0)
  43   (:turquoise 75d0)
  44   (:cyan 85d0)
  45   (:sky 95d0)
  46   (:blue 105d0)
  47   (:violet 115d0)
  48   (:magenta 125d0)
  49   (:pink 135d0)))
  50
  51 (defun create-turtle ()
  52  (let
  53   ((new-turtle (make-turtle
  54                 :who (coerce *current-id* 'double-float)
  55                 :color (coerce (+ 5 (* 10 (clnl-random:next-int 14))) 'double-float)
  56                 :heading (coerce (clnl-random:next-int 360) 'double-float)
  57                 :xcor 0d0
  58                 :ycor 0d0)))
  59   (setf *turtles* (nconc *turtles* (list new-turtle)))
  60   (incf *current-id*)
  61   new-turtle))
  62
  63 (defun die ()
  64  "DIE => RESULT
  65
  66 ARGUMENTS AND VALUES:
  67
  68   RESULT: undefined, commands don't return
  69
  70 DESCRIPTION:
  71
  72   The turtle or link dies
  73
  74   A dead agent ceases to exist. The effects of this include:
  75   - The agent will not execute any further code.
  76   - The agent will disappear from any agentsets it was in, reducing the size of those agentsets by one.
  77   - Any variable that was storing the agent will now instead have nobody in it.
  78   - If the dead agent was a turtle, every link connected to it also dies.
  79   - If the observer was watching or following the agent, the observer's perspective resets.
  80
  81   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#die"
  82  (when (not (turtle-p *self*)) (error "Gotta call die in turtle scope, dude (~A)" *self*))
  83  (setf (turtle-who *self*) -1)
  84  (setf *turtles* (remove *self* *turtles*)))
  85
  86 (defun patches ()
  87  "PATCHES => ALL-PATCHES
  88
  89 ARGUMENTS AND VALUES:
  90
  91   ALL-PATCHES: a NetLogo agentset, all patches
  92
  93 DESCRIPTION:
  94
  95   Reports the agentset consisting of all the patches.
  96
  97   This agentset is special in that it represents the living patches
  98   each time it's used, so changes depending on the state of the engine.
  99
 100   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#patches"
 101  :patches)
 102
 103 (defun turtles ()
 104  "TURTLES => ALL-TURTLES
 105
 106 ARGUMENTS AND VALUES:
 107
 108   ALL-TURTLES: a NetLogo agentset, all turtles
 109
 110 DESCRIPTION:
 111
 112   Reports the agentset consisting of all the turtles.
 113
 114   This agentset is special in that it represents the living turtles
 115   each time it's used, so changes depending on the state of the engine.
 116
 117   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtles"
 118  :turtles)
 119
 120 (defun ask (agent-or-agentset fn)
 121  "ASK AGENT-OR-AGENTSET FN => RESULT
 122
 123   AGENT-OR-AGENTSET: AGENT | AGENTSET
 124
 125 ARGUMENTS AND VALUES:
 126
 127   FN: a function, run on each agent
 128   RESULT: undefined, commands don't return
 129   AGENT: a NetLogo agent
 130   AGENTSET: a NetLogo agentset
 131
 132 DESCRIPTION:
 133
 134   ASK is equivalent to ask in NetLogo.
 135
 136   The specified AGENTSET or AGENT runs the given FN.  In the case of an
 137   AGENTSET, the order in which the agents are run is random each time,
 138   and only agents that are in the set at the beginning of the call.
 139
 140   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#ask"
 141  (cond
 142   ((agentset-p agent-or-agentset)
 143    (let
 144     ((iter (shufflerator (agentset-list agent-or-agentset))))
 145     (loop
 146      :for agent := (funcall iter)
 147      :while agent
 148      :do (let ((*myself* *self*) (*self* agent)) (funcall fn)))))
 149   ((agent-p agent-or-agentset)
 150    (let ((*myself* *self*) (*self* agent-or-agentset)) (funcall fn)))
 151   (t
 152    (error "Ask requires an agentset or agent but got: ~A" agent-or-agentset))))
 153
 154 (defun count (agentset)
 155  "COUNT AGENTSET => N
 156
 157 ARGUMENTS AND VALUES:
 158
 159   AGENTSET: a NetLogo agentset
 160   N: a number
 161
 162 DESCRIPTION:
 163
 164   COUNT is equivalent to count in NetLogo.  Returns N, the number of
 165   agents in AGENTSET.
 166
 167   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#count"
 168  (coerce (length (agentset-list agentset)) 'double-float))
 169
 170 (defun of (fn agent-or-agentset)
 171  "OF FN AGENT-OR-AGENTSET => RESULT
 172
 173   AGENT-OR-AGENTSET: AGENT | AGENTSET
 174   RESULT: RESULT-LIST | RESULT-VALUE
 175
 176 ARGUMENTS AND VALUES:
 177
 178   FN: a function, run on each agent
 179   AGENT: a NetLogo agent
 180   AGENTSET: a NetLogo agentset
 181   RESULT-LIST: a list
 182   RESULT-VALUE: a single value
 183
 184 DESCRIPTION:
 185
 186   OF is equivalent to of in NetLogo.
 187
 188   The specified AGENTSET or AGENT runs the given FN.  In the case of an
 189   AGENTSET, the order in which the agents are run is random each time,
 190   and only agents that are in the set at the beginning of the call.
 191
 192   RESULT-LIST is returned when the input is an AGENTSET, but RESULT-VALUE
 193   is returned when only passed an AGENT.
 194
 195   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#of"
 196  (cond
 197   ((agentset-p agent-or-agentset)
 198    (let
 199     ((iter (shufflerator (agentset-list agent-or-agentset))))
 200     (loop
 201      :for agent := (funcall iter)
 202      :while agent
 203      :collect (let ((*myself* *self*) (*self* agent)) (funcall fn)))))
 204   ((agent-p agent-or-agentset)
 205    (let ((*myself* *self*) (*self* agent-or-agentset)) (funcall fn)))
 206   (t
 207    (error "Of requires an agentset or agent but got: ~A" agent-or-agentset))))
 208
 209 (defun with (agentset fn)
 210  "WITH AGENTSET FN => RESULT-AGENTSET
 211
 212 ARGUMENTS AND VALUES:
 213
 214   AGENTSET: a NetLogo agentset
 215   FN: a boolean function, run on each agent to determine if included
 216   RESULT-AGENTSET: an agentset of valid agents
 217
 218 DESCRIPTION:
 219
 220   WITH is equivalent to with in NetLogo.
 221
 222   Returns a new agentset containing only those agents that reported true
 223   when FN is called.
 224
 225   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#with"
 226  (list->agentset
 227   (remove-if-not
 228    (lambda (agent)
 229     (let ((*myself* *self*) (*self* agent)) (funcall fn)))
 230    (agentset-list agentset))
 231   (agentset-breed agentset)))
 232
 233 (defun shufflerator (agentset-list)
 234  (let
 235   ((copy (copy-list agentset-list))
 236    (i 0)
 237    (agent nil))
 238   (flet
 239    ((fetch ()
 240      (let
 241       ((idx (when (< i (1- (length copy))) (+ i (clnl-random:next-int (- (length copy) i))))))
 242       (when idx (setf agent (nth idx copy)))
 243       (when idx (setf (nth idx copy) (nth i copy)))
 244       (incf i))))
 245    (fetch) ; we pre-fetch because netlogo does, rng sync hype!
 246    (lambda ()
 247     (cond
 248      ((> i (length copy)) nil)
 249      ((= i (length copy)) (incf i) (car (last copy)))
 250      (t (let ((result agent)) (fetch) result)))))))
 251
 252 (defun random-float (n)
 253  "RANDOM-FLOAT N => RANDOM-NUMBER
 254
 255 ARGUMENTS AND VALUES:
 256
 257   N: a double, the upper bound of the random float
 258   RANDOM-NUMBER: a double, the random result
 259
 260 DESCRIPTION:
 261
 262   Returns a random number strictly closer to zero than N.
 263
 264   If number is positive, returns a random floating point number greater than
 265   or equal to 0 but strictly less than number.
 266
 267   If number is negative, returns a random floating point number less than or equal
 268   to 0, but strictly greater than number.
 269
 270   If number is zero, the result is always 0.
 271
 272   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-float"
 273  (clnl-random:next-double n))
 274
 275 (defun random (n)
 276  "RANDOM N => RANDOM-NUMBER
 277
 278 ARGUMENTS AND VALUES:
 279
 280   N: an integer, the upper bound of the random
 281   RANDOM-NUMBER: an integer, the random result
 282
 283 DESCRIPTION:
 284
 285   Returns a random number strictly closer to zero than N.
 286
 287   If number is positive, returns a random integer greater than or equal to 0,
 288   but strictly less than number.
 289
 290   If number is negative, returns a random integer less than or equal to 0,
 291   but strictly greater than number.
 292
 293   If number is zero, the result is always 0.
 294
 295   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random"
 296  (coerce (clnl-random:next-long (truncate n)) 'double-float))
 297
 298 (defun random-xcor ()
 299  "RANDOM-XCOR => RANDOM-NUMBER
 300
 301 ARGUMENTS AND VALUES:
 302
 303   RANDOM-NUMBER: a float, the random result
 304
 305 DESCRIPTION:
 306
 307   Returns a random floating point number in the allowable range of turtle
 308   coordinates along the x axis.
 309
 310   These range from min-pxcor - 0.5 (inclusive) to max-pxcor + 0.5 (exclusive)
 311
 312   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-cor"
 313  (let
 314   ((min (- (min-pxcor) 0.5d0))
 315    (max (+ (max-pxcor) 0.5d0)))
 316   (+ min (clnl-random:next-double (- max min)))))
 317
 318 (defun random-ycor ()
 319  "RANDOM-YCOR => RANDOM-NUMBER
 320
 321 ARGUMENTS AND VALUES:
 322
 323   RANDOM-NUMBER: a float, the random result
 324
 325 DESCRIPTION:
 326
 327   Returns a random floating point number in the allowable range of turtle
 328   coordinates along the y axis.
 329
 330   These range from min-pycor - 0.5 (inclusive) to max-pycor + 0.5 (exclusive)
 331
 332   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-cor"
 333  (let
 334   ((min (- (min-pycor) 0.5d0))
 335    (max (+ (max-pycor) 0.5d0)))
 336   (+ min (clnl-random:next-double (- max min)))))
 337
 338 (defun one-of (list-or-agentset)
 339  "ONE-OF LIST-OR-AGENTSET => RESULT
 340
 341   LIST-OR-AGENTSET: LIST | AGENTSET
 342   RESULT: RANDOM-VALUE | RANDOM-AGENT | :nobody
 343
 344 ARGUMENTS AND VALUES:
 345
 346   LIST: A list
 347   AGENTSET: An agent set
 348   RANDOM-VALUE: a value in LIST
 349   RANDOM-AGENT: an agent if AGENTSET is non empty
 350
 351 DESCRIPTION:
 352
 353   From an AGENTSET, returns a RANDOM-AGENT. If the agentset is empty, returns :nobody.
 354   From a list, returns a RANDOM-VALUE.  If the list is empty, an error occurs.
 355
 356   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#one-of"
 357  (cond
 358   ((agentset-p list-or-agentset)
 359    (let*
 360     ((agentset-list (agentset-list list-or-agentset))
 361      (length (length agentset-list)))
 362     (if (zerop length) :nobody (nth (clnl-random:next-int length) agentset-list))))
 363   ((listp list-or-agentset)
 364    (let*
 365     ((length (length list-or-agentset)))
 366     (if (zerop length)
 367      (error "one-of requires a nonempty list")
 368      (nth (clnl-random:next-int length) list-or-agentset))))
 369   (t (error "one-of requires a list or agentset"))))
 370
 371 (defun jump (n)
 372  (when (not (turtle-p *self*)) (error "Gotta call jump in turtle scope, dude (~A)" *self*))
 373  (setf
 374   (turtle-xcor *self*)
 375   (wrap-x *topology*
 376    (+ (turtle-xcor *self*) (* n (using-cached-sin (turtle-heading *self*))))))
 377  (setf
 378   (turtle-ycor *self*)
 379   (wrap-y *topology*
 380    (+ (turtle-ycor *self*) (* n (using-cached-cos (turtle-heading *self*)))))))
 381
 382 (defun setxy (x y)
 383  "SETXY X Y => RESULT
 384
 385 ARGUMENTS AND VALUES:
 386
 387   X: a double
 388   Y: a double
 389   RESULT: undefined
 390
 391 DESCRIPTION:
 392
 393   Sets the x-coordinate and y-coordinate for the turle.  Equivalent to
 394   set xcor x set ycor y, except it happens in one step inside of two.
 395
 396   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#setxy"
 397  (when (not (turtle-p *self*)) (error "Gotta call setxy in turtle scope, dude (~A)" *self*))
 398  (setf (turtle-xcor *self*) (wrap-x *topology* x))
 399  (setf (turtle-ycor *self*) (wrap-y *topology* y)))
 400
 401 (defun forward (n)
 402  "FORWARD N => RESULT
 403
 404 ARGUMENTS AND VALUES:
 405
 406   N: a double, the amount the turtle moves forward
 407   RESULT: undefined
 408
 409 DESCRIPTION:
 410
 411   Moves the current turtle forward N steps, one step at a time.
 412
 413   This moves forward one at a time in order to make the view updates look
 414   good in the case of a purposefully slow running instance.  If the number
 415   is negative, the turtle moves backward.
 416
 417   If the current agent is not a turtle, it raises an error.
 418
 419   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#forward"
 420  (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude (~A)" *self*))
 421  (labels
 422   ((internal (i)
 423     (cond
 424      ((< (abs i) 3.2e-15) nil)
 425      ((< (abs i) 1d0) (jump i))
 426      (t (jump (if (> i 0d0) 1d0 -1d0)) (internal (- i (if (> i 0d0) 1d0 -1d0)))))))
 427   (internal n)))
 428
 429 (defun turn-right (n)
 430  "TURN-RIGHT N => RESULT
 431
 432 ARGUMENTS AND VALUES:
 433
 434   N: a double, the amount the turtle turns
 435   RESULT: undefined
 436
 437 DESCRIPTION:
 438
 439   The turtle turns right by number degrees. (If number is negative, it turns left.)
 440
 441   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#right"
 442  (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude (~A)" *self*))
 443  (let
 444   ((new-heading (+ (turtle-heading *self*) n)))
 445   (setf (turtle-heading *self*)
 446    (cond
 447     ((< new-heading 0) (+ (mod new-heading -360) 360))
 448     ((>= new-heading 360) (mod new-heading 360))
 449     (t new-heading)))))
 450
 451 (defun turn-left (n)
 452  "TURN-LEFT N => RESULT
 453
 454 ARGUMENTS AND VALUES:
 455
 456   N: a double, the amount the turtle turns
 457   RESULT: undefined
 458
 459 DESCRIPTION:
 460
 461   The turtle turns left by number degrees. (If number is negative, it turns right.)
 462
 463   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#right"
 464  (turn-right (- n)))
 465
 466 (defun create-turtles (n &optional fn)
 467  "CREATE-TURTLES N &optional FN => RESULT
 468
 469 ARGUMENTS AND VALUES:
 470
 471   N: an integer, the numbers of turtles to create
 472   FN: A function, applied to each turtle after creation
 473   RESULT: undefined
 474
 475 DESCRIPTION:
 476
 477   Creates number new turtles at the origin.
 478
 479   New turtles have random integer headings and the color is randomly selected
 480   from the 14 primary colors.  If a function is supplied, the new turtles
 481   immediately run it.
 482
 483   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles"
 484  (let
 485   ((new-turtles (loop :repeat n :collect (create-turtle))))
 486   (when fn (ask (list->agentset new-turtles :turtles) fn))))
 487
 488 (defun reset-ticks ()
 489  "RESET-TICKS => RESULT
 490
 491 ARGUMENTS AND VALUES:
 492
 493   RESULT: undefined
 494
 495 DESCRIPTION:
 496
 497   Resets the tick counter to zero, sets up all plots, then updates all plots.
 498
 499   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#reset-ticks"
 500  (setf *ticks* 0d0))
 501
 502 (defun tick ()
 503  "RESET-TICKS => RESULT
 504
 505 ARGUMENTS AND VALUES:
 506
 507   RESULT: undefined
 508
 509 DESCRIPTION:
 510
 511   Advances the tick counter by one and updates all plots.
 512
 513   If the tick counter has not been started yet with reset-ticks, an error results.
 514
 515   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#tick"
 516
 517  (when (not *ticks*) (error "reset-ticks must be called"))
 518  (incf *ticks*))
 519
 520 (defun ticks ()
 521  "TICKS => CURRENT-TICKS
 522
 523 ARGUMENTS AND VALUES:
 524
 525   CURRENT-TICKS: A positiv double, representing the current number of ticks
 526
 527 DESCRIPTION:
 528
 529   Reports the current value of the tick counter. The result is always a number and never negative.
 530
 531   If the tick counter has not been started yet with reset-ticks, an error results.
 532
 533   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#ticks"
 534  (when (not *ticks*) (error "reset-ticks must be called"))
 535  *ticks*)
 536
 537 (defun create-world (&key dims)
 538  "CREATE-WORLD &key DIMS => RESULT
 539
 540   DIMS: (:xmin XMIN :xmax XMAX :ymin YMIN :ymax YMAX)
 541
 542 ARGUMENTS AND VALUES:
 543
 544   RESULT: undefined
 545   XMIN: An integer representing the minimum patch coord in X
 546   XMAX: An integer representing the maximum patch coord in X
 547   YMIN: An integer representing the minimum patch coord in Y
 548   YMAX: An integer representing the maximum patch coord in Y
 549
 550 DESCRIPTION:
 551
 552   Initializes the world in the NVM.
 553
 554   This should be called before using the engine in any real capacity.  If
 555   called when an engine is already running, it may do somethign weird."
 556  (setf *dimensions* dims)
 557  (setf
 558   *patches*
 559   (loop
 560    :for y :from (max-pycor) :downto (min-pycor)
 561    :append (loop
 562             :for x :from (min-pxcor) :to (max-pxcor)
 563             :collect (make-patch
 564                       :xcor (coerce x 'double-float)
 565                       :ycor (coerce y 'double-float)
 566                       :color 0d0))))
 567  (setf *turtles* nil)
 568  (setf *current-id* 0))
 569
 570 ; These match netlogo's dump
 571 (defgeneric dump-object (o))
 572
 573 (defmethod dump-object ((n double-float))
 574  (multiple-value-bind (int rem) (floor n)
 575   (if (eql 0d0 rem)
 576    (format nil "~A" int)
 577    (let
 578     ((output (format nil "~D" n)))
 579     ; Someday we'll have d<posint>, but this is not that day!
 580     (cl-ppcre:regex-replace "d-" (cl-ppcre:regex-replace "d0" output "") "E-")))))
 581
 582 (defmethod dump-object ((o string)) (format nil "~A" (cl-ppcre:regex-replace-all "\"" (format nil "~S" o) "\"\"")))
 583
 584 (defmethod dump-object ((o (eql t))) "true")
 585 (defmethod dump-object ((o (eql nil))) "false")
 586
 587 (defmethod dump-object ((o list))
 588  (cond
 589   ((agentset-p o) (format nil "(agentset, ~A ~A)" (dump-object (count o)) (string-downcase (agentset-breed o))))
 590   (t (format nil "[~{~A~^ ~}]" (mapcar #'dump-object o)))))
 591
 592 (defmethod dump-object ((o patch))
 593  (format nil "(patch ~A ~A)" (dump-object (patch-xcor o)) (dump-object (patch-ycor o))))
 594
 595 (defmethod dump-object ((o turtle)) (format nil "(turtle ~A)" (dump-object (turtle-who o))))
 596 (defmethod dump-object ((o (eql :nobody))) (format nil "nobody"))
 597
 598 (defun current-state ()
 599  "CURRENT-STATE => WORLD-STATE
 600
 601 ARGUMENTS AND VALUES:
 602
 603   WORLD-STATE: A list, the current state of the whole world
 604
 605 DESCRIPTION:
 606
 607   Dumps out the state of the world.
 608
 609   This is useful for visualizations and also storing in a common lisp
 610   data structure for easy usage in a common lisp instance.  It's preferable
 611   to use this when working with the nvm than the output done by export-world.
 612
 613   Currently this only dumps out turtle and patch information.
 614
 615   This is called CURRENT-STATE because export-world is an actual primitive
 616   used by NetLogo."
 617  (list
 618   (mapcar
 619    (lambda (turtle)
 620     (list
 621      :color (turtle-color turtle)
 622      :xcor (turtle-xcor turtle)
 623      :ycor (turtle-ycor turtle)
 624      :heading (turtle-heading turtle)
 625      :size (turtle-size turtle)))
 626    *turtles*)
 627   (mapcar
 628    (lambda (patch)
 629     (list
 630      :color (patch-color patch)
 631      :xcor (patch-xcor patch)
 632      :ycor (patch-ycor patch)))
 633    *patches*)))
 634
 635 (defun export-turtles ()
 636  (append
 637   (list
 638    "\"TURTLES\""
 639    (format nil "~A~A"
 640     "\"who\",\"color\",\"heading\",\"xcor\",\"ycor\",\"shape\",\"label\",\"label-color\","
 641     "\"breed\",\"hidden?\",\"size\",\"pen-size\",\"pen-mode\""))
 642   (mapcar
 643    (lambda (turtle)
 644     (format nil
 645      "\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"\"\"default\"\"\",\"~A\",\"~A\",\"{all-turtles}\",\"false\",\"~A\",~A"
 646      (dump-object (turtle-who turtle))
 647      (dump-object (turtle-color turtle))
 648      (dump-object (turtle-heading turtle))
 649      (dump-object (turtle-xcor turtle))
 650      (dump-object (turtle-ycor turtle))
 651      (dump-object (turtle-label turtle))
 652      (dump-object (turtle-label-color turtle))
 653      (dump-object (turtle-size turtle))
 654      "\"1\",\"\"\"up\"\"\""))
 655    *turtles*)))
 656
 657 (defun export-patches ()
 658  (append
 659   (list
 660    "\"PATCHES\""
 661    "\"pxcor\",\"pycor\",\"pcolor\",\"plabel\",\"plabel-color\"")
 662   (mapcar
 663    (lambda (patch)
 664     (format nil
 665      "\"~A\",\"~A\",\"~A\",\"\"\"\"\"\",\"9.9\""
 666      (dump-object (patch-xcor patch))
 667      (dump-object (patch-ycor patch))
 668      (dump-object (patch-color patch))))
 669    *patches*)))
 670
 671 (defun export-world ()
 672  "EXPORT-WORLD => WORLD-CSV
 673
 674 ARGUMENTS AND VALUES:
 675
 676   WORLD-CSV: A string, the csv of the world
 677
 678 DESCRIPTION:
 679
 680   Dumps out a csv matching NetLogo's export world.
 681
 682   This is useful for serializing the current state of the engine in order
 683   to compare against NetLogo or to reimport later.  Contains everything needed
 684   to boot up a NetLogo instance in the exact same state."
 685  (format nil "~{~A~%~}"
 686   (list
 687    (format nil "~S" "RANDOM STATE")
 688    (format nil "~S" (clnl-random:export))
 689    ""
 690    (format nil "~S" "GLOBALS")
 691    (format nil "~A~A"
 692     "\"min-pxcor\",\"max-pxcor\",\"min-pycor\",\"max-pycor\",\"perspective\",\"subject\","
 693     "\"nextIndex\",\"directed-links\",\"ticks\",")
 694    (format nil "\"~A\",\"~A\",\"~A\",\"~A\",\"0\",\"nobody\",\"~A\",\"\"\"NEITHER\"\"\",\"-1\""
 695     (min-pxcor) (max-pxcor) (min-pycor) (max-pycor) *current-id*)
 696    ""
 697    (format nil "~{~A~^~%~}" (export-turtles))
 698    ""
 699    (format nil "~{~A~^~%~}" (export-patches))
 700    ""
 701    (format nil "~S" "LINKS")
 702    "\"end1\",\"end2\",\"color\",\"label\",\"label-color\",\"hidden?\",\"breed\",\"thickness\",\"shape\",\"tie-mode\""
 703    "")))