Prims - Implement with

[clnl] / src / main / nvm / nvm.lisp

diff --git a/src/main/nvm/nvm.lisp b/src/main/nvm/nvm.lisp
index b7e0087634c49ed84323f99217cfc46861b390ed..67b3ec4855117f4b5d7e904c3335d1fae0908d28 100644 (file)
--- a/src/main/nvm/nvm.lisp
+++ b/src/main/nvm/nvm.lisp
@@ -17,19 +17,48 @@ DESCRIPTION:
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#show"
  (format t "Showing: ~A~%" (dump-object value)))
 
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#show"
  (format t "Showing: ~A~%" (dump-object value)))
 

+(defun lookup-color (color)
+ "LOOKUP-COLOR COLOR => COLOR-NUMBER
+
+ARGUMENTS AND VALUES:
+
+  COLOR: a symbol representing a color
+  COLOR-NUMBER: the NetLogo color integer
+
+DESCRIPTION:
+
+  Returns the number used to represent colors in NetLogo.
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#Constants"
+ (case color
+  (:black 0d0)
+  (:gray 5d0)
+  (:white 9.9d0)
+  (:red 15d0)
+  (:orange 25d0)
+  (:brown 35d0)
+  (:yellow 45d0)
+  (:green 55d0)
+  (:lime 65d0)
+  (:turquoise 75d0)
+  (:cyan 85d0)
+  (:sky 95d0)
+  (:blue 105d0)
+  (:violet 115d0)
+  (:magenta 125d0)
+  (:pink 135d0)))
+

 (defun create-turtle ()
 (defun create-turtle ()

- (setf
-  *turtles*
-  (nconc
-   *turtles*
-   (list
-    (make-turtle
-     :who *current-id*
-     :color (coerce (+ 5 (* 10 (clnl-random:next-int 14))) 'double-float)
-     :heading (coerce (clnl-random:next-int 360) 'double-float)
-     :xcor 0d0
-     :ycor 0d0))))
- (incf *current-id*))
+ (let
+  ((new-turtle (make-turtle
+                :who (coerce *current-id* 'double-float)
+                :color (coerce (+ 5 (* 10 (clnl-random:next-int 14))) 'double-float)
+                :heading (coerce (clnl-random:next-int 360) 'double-float)
+                :xcor 0d0
+                :ycor 0d0)))
+  (setf *turtles* (nconc *turtles* (list new-turtle)))
+  (incf *current-id*)
+  new-turtle))

 
 (defun die ()
  "DIE => RESULT
 
 (defun die ()
  "DIE => RESULT


@@ -54,6 +83,23 @@ DESCRIPTION:
  (setf (turtle-who *self*) -1)
  (setf *turtles* (remove *self* *turtles*)))
 
  (setf (turtle-who *self*) -1)
  (setf *turtles* (remove *self* *turtles*)))
 

+(defun patches ()
+ "PATCHES => ALL-PATCHES
+
+ARGUMENTS AND VALUES:
+
+  ALL-PATCHES: a NetLogo agentset, all patches
+
+DESCRIPTION:
+
+  Reports the agentset consisting of all the patches.
+
+  This agentset is special in that it represents the living patches
+  each time it's used, so changes depending on the state of the engine.
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#patches"
+ :patches)
+

 (defun turtles ()
  "TURTLES => ALL-TURTLES
 
 (defun turtles ()
  "TURTLES => ALL-TURTLES
 


@@ -69,36 +115,124 @@ DESCRIPTION:
   each time it's used, so changes depending on the state of the engine.
 
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtles"
   each time it's used, so changes depending on the state of the engine.
 
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtles"

- *turtles*)
+ :turtles)

 
 

-(defun ask (agent-set fn)
- "ASK AGENT-SET FN => RESULT
+(defun ask (agent-or-agentset fn)
+ "ASK AGENT-OR-AGENTSET FN => RESULT
+
+  AGENT-OR-AGENTSET: AGENT | AGENTSET

 
 ARGUMENTS AND VALUES:
 
 
 ARGUMENTS AND VALUES:
 

-  AGENT-SET: a NetLogo agentset

   FN: a function, run on each agent
   RESULT: undefined, commands don't return
   FN: a function, run on each agent
   RESULT: undefined, commands don't return

+  AGENT: a NetLogo agent
+  AGENTSET: a NetLogo agentset

 
 DESCRIPTION:
 
   ASK is equivalent to ask in NetLogo.
 
 
 DESCRIPTION:
 
   ASK is equivalent to ask in NetLogo.
 

-  The specified AGENT-SET runs the given FN.  The order in which the agents
-  are run is random each time, and only agents that are in the set at the
-  beginning of the call.
+  The specified AGENTSET or AGENT runs the given FN.  In the case of an
+  AGENTSET, the order in which the agents are run is random each time,
+  and only agents that are in the set at the beginning of the call.

 
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#ask"
 
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#ask"

- (let
-  ((iter (shufflerator agent-set)))
-  (loop
-   :for agent := (funcall iter)
-   :while agent
-   :do (let ((*myself* *self*) (*self* agent)) (funcall fn)))))
+ (cond
+  ((agentset-p agent-or-agentset)
+   (let
+    ((iter (shufflerator (agentset-list agent-or-agentset))))
+    (loop
+     :for agent := (funcall iter)
+     :while agent
+     :do (let ((*myself* *self*) (*self* agent)) (funcall fn)))))
+  ((agent-p agent-or-agentset)
+   (let ((*myself* *self*) (*self* agent-or-agentset)) (funcall fn)))
+  (t
+   (error "Ask requires an agentset or agent but got: ~A" agent-or-agentset))))
+
+(defun count (agentset)
+ "COUNT AGENTSET => N
+
+ARGUMENTS AND VALUES:
+
+  AGENTSET: a NetLogo agentset
+  N: a number
+
+DESCRIPTION:
+
+  COUNT is equivalent to count in NetLogo.  Returns N, the number of
+  agents in AGENTSET.
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#count"
+ (coerce (length (agentset-list agentset)) 'double-float))
+
+(defun of (fn agent-or-agentset)
+ "OF FN AGENT-OR-AGENTSET => RESULT
+
+  AGENT-OR-AGENTSET: AGENT | AGENTSET
+  RESULT: RESULT-LIST | RESULT-VALUE

 
 

-(defun shufflerator (agent-set)
+ARGUMENTS AND VALUES:
+
+  FN: a function, run on each agent
+  AGENT: a NetLogo agent
+  AGENTSET: a NetLogo agentset
+  RESULT-LIST: a list
+  RESULT-VALUE: a single value
+
+DESCRIPTION:
+
+  OF is equivalent to of in NetLogo.
+
+  The specified AGENTSET or AGENT runs the given FN.  In the case of an
+  AGENTSET, the order in which the agents are run is random each time,
+  and only agents that are in the set at the beginning of the call.
+
+  RESULT-LIST is returned when the input is an AGENTSET, but RESULT-VALUE
+  is returned when only passed an AGENT.
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#of"
+ (cond
+  ((agentset-p agent-or-agentset)
+   (let
+    ((iter (shufflerator (agentset-list agent-or-agentset))))
+    (loop
+     :for agent := (funcall iter)
+     :while agent
+     :collect (let ((*myself* *self*) (*self* agent)) (funcall fn)))))
+  ((agent-p agent-or-agentset)
+   (let ((*myself* *self*) (*self* agent-or-agentset)) (funcall fn)))
+  (t
+   (error "Of requires an agentset or agent but got: ~A" agent-or-agentset))))
+
+(defun with (agentset fn)
+ "WITH AGENTSET FN => RESULT-AGENTSET
+
+ARGUMENTS AND VALUES:
+
+  AGENTSET: a NetLogo agentset
+  FN: a boolean function, run on each agent to determine if included
+  RESULT-AGENTSET: an agentset of valid agents
+
+DESCRIPTION:
+
+  WITH is equivalent to with in NetLogo.
+
+  Returns a new agentset containing only those agents that reported true
+  when FN is called.
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#with"
+ (list->agentset
+  (remove-if-not
+   (lambda (agent)
+    (let ((*myself* *self*) (*self* agent)) (funcall fn)))
+   (agentset-list agentset))
+  (agentset-breed agentset)))
+
+(defun shufflerator (agentset-list)

  (let
  (let

-  ((copy (copy-list agent-set))
+  ((copy (copy-list agentset-list))

    (i 0)
    (agent nil))
   (flet
    (i 0)
    (agent nil))
   (flet


@@ -138,16 +272,131 @@ DESCRIPTION:
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-float"
  (clnl-random:next-double n))
 
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-float"
  (clnl-random:next-double n))
 

+(defun random (n)
+ "RANDOM N => RANDOM-NUMBER
+
+ARGUMENTS AND VALUES:
+
+  N: an integer, the upper bound of the random
+  RANDOM-NUMBER: an integer, the random result
+
+DESCRIPTION:
+
+  Returns a random number strictly closer to zero than N.
+
+  If number is positive, returns a random integer greater than or equal to 0,
+  but strictly less than number.
+
+  If number is negative, returns a random integer less than or equal to 0,
+  but strictly greater than number.
+
+  If number is zero, the result is always 0.
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random"
+ (coerce (clnl-random:next-long (truncate n)) 'double-float))
+
+(defun random-xcor ()
+ "RANDOM-XCOR => RANDOM-NUMBER
+
+ARGUMENTS AND VALUES:
+
+  RANDOM-NUMBER: a float, the random result
+
+DESCRIPTION:
+
+  Returns a random floating point number in the allowable range of turtle
+  coordinates along the x axis.
+
+  These range from min-pxcor - 0.5 (inclusive) to max-pxcor + 0.5 (exclusive)
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-cor"
+ (let
+  ((min (- (min-pxcor) 0.5d0))
+   (max (+ (max-pxcor) 0.5d0)))
+  (+ min (clnl-random:next-double (- max min)))))
+
+(defun random-ycor ()
+ "RANDOM-YCOR => RANDOM-NUMBER
+
+ARGUMENTS AND VALUES:
+
+  RANDOM-NUMBER: a float, the random result
+
+DESCRIPTION:
+
+  Returns a random floating point number in the allowable range of turtle
+  coordinates along the y axis.
+
+  These range from min-pycor - 0.5 (inclusive) to max-pycor + 0.5 (exclusive)
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-cor"
+ (let
+  ((min (- (min-pycor) 0.5d0))
+   (max (+ (max-pycor) 0.5d0)))
+  (+ min (clnl-random:next-double (- max min)))))
+
+(defun one-of (list-or-agentset)
+ "ONE-OF LIST-OR-AGENTSET => RESULT
+
+  LIST-OR-AGENTSET: LIST | AGENTSET
+  RESULT: RANDOM-VALUE | RANDOM-AGENT | :nobody
+
+ARGUMENTS AND VALUES:
+
+  LIST: A list
+  AGENTSET: An agent set
+  RANDOM-VALUE: a value in LIST
+  RANDOM-AGENT: an agent if AGENTSET is non empty
+
+DESCRIPTION:
+
+  From an AGENTSET, returns a RANDOM-AGENT. If the agentset is empty, returns :nobody.
+  From a list, returns a RANDOM-VALUE.  If the list is empty, an error occurs.
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#one-of"
+ (cond
+  ((agentset-p list-or-agentset)
+   (let*
+    ((agentset-list (agentset-list list-or-agentset))
+     (length (length agentset-list)))
+    (if (zerop length) :nobody (nth (clnl-random:next-int length) agentset-list))))
+  ((listp list-or-agentset)
+   (let*
+    ((length (length list-or-agentset)))
+    (if (zerop length)
+     (error "one-of requires a nonempty list")
+     (nth (clnl-random:next-int length) list-or-agentset))))
+  (t (error "one-of requires a list or agentset"))))
+

 (defun jump (n)
 (defun jump (n)

- (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude (~A)" *self*))
+ (when (not (turtle-p *self*)) (error "Gotta call jump in turtle scope, dude (~A)" *self*))

  (setf
   (turtle-xcor *self*)
   (wrap-x *topology*
  (setf
   (turtle-xcor *self*)
   (wrap-x *topology*

-   (+ (turtle-xcor *self*) (* n (strictmath:sin (strictmath:to-radians (turtle-heading *self*)))))))
+   (+ (turtle-xcor *self*) (* n (using-cached-sin (turtle-heading *self*))))))

  (setf
   (turtle-ycor *self*)
   (wrap-y *topology*
  (setf
   (turtle-ycor *self*)
   (wrap-y *topology*

-   (+ (turtle-ycor *self*) (* n (strictmath:cos (strictmath:to-radians (turtle-heading *self*))))))))
+   (+ (turtle-ycor *self*) (* n (using-cached-cos (turtle-heading *self*)))))))
+
+(defun setxy (x y)
+ "SETXY X Y => RESULT
+
+ARGUMENTS AND VALUES:
+
+  X: a double
+  Y: a double
+  RESULT: undefined
+
+DESCRIPTION:
+
+  Sets the x-coordinate and y-coordinate for the turle.  Equivalent to
+  set xcor x set ycor y, except it happens in one step inside of two.
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#setxy"
+ (when (not (turtle-p *self*)) (error "Gotta call setxy in turtle scope, dude (~A)" *self*))
+ (setf (turtle-xcor *self*) (wrap-x *topology* x))
+ (setf (turtle-ycor *self*) (wrap-y *topology* y)))

 
 (defun forward (n)
  "FORWARD N => RESULT
 
 (defun forward (n)
  "FORWARD N => RESULT


@@ -177,12 +426,50 @@ DESCRIPTION:
      (t (jump (if (> i 0d0) 1d0 -1d0)) (internal (- i (if (> i 0d0) 1d0 -1d0)))))))
   (internal n)))
 
      (t (jump (if (> i 0d0) 1d0 -1d0)) (internal (- i (if (> i 0d0) 1d0 -1d0)))))))
   (internal n)))
 

-(defun create-turtles (n)
- "CREATE-TURTLES N => RESULT
+(defun turn-right (n)
+ "TURN-RIGHT N => RESULT
+
+ARGUMENTS AND VALUES:
+
+  N: a double, the amount the turtle turns
+  RESULT: undefined
+
+DESCRIPTION:
+
+  The turtle turns right by number degrees. (If number is negative, it turns left.)
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#right"
+ (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude (~A)" *self*))
+ (let
+  ((new-heading (+ (turtle-heading *self*) n)))
+  (setf (turtle-heading *self*)
+   (cond
+    ((< new-heading 0) (+ (mod new-heading -360) 360))
+    ((>= new-heading 360) (mod new-heading 360))
+    (t new-heading)))))
+
+(defun turn-left (n)
+ "TURN-LEFT N => RESULT
+
+ARGUMENTS AND VALUES:
+
+  N: a double, the amount the turtle turns
+  RESULT: undefined
+
+DESCRIPTION:
+
+  The turtle turns left by number degrees. (If number is negative, it turns right.)
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#right"
+ (turn-right (- n)))
+
+(defun create-turtles (n &optional fn)
+ "CREATE-TURTLES N &optional FN => RESULT

 
 ARGUMENTS AND VALUES:
 
   N: an integer, the numbers of turtles to create
 
 ARGUMENTS AND VALUES:
 
   N: an integer, the numbers of turtles to create

+  FN: A function, applied to each turtle after creation

   RESULT: undefined
 
 DESCRIPTION:
   RESULT: undefined
 
 DESCRIPTION:


@@ -190,11 +477,62 @@ DESCRIPTION:
   Creates number new turtles at the origin.
 
   New turtles have random integer headings and the color is randomly selected
   Creates number new turtles at the origin.
 
   New turtles have random integer headings and the color is randomly selected

-  from the 14 primary colors.  If commands are supplied, the new turtles
-  immediately run them (unimplemented).
+  from the 14 primary colors.  If a function is supplied, the new turtles
+  immediately run it.

 
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles"
 
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles"

- (loop :for i :from 1 :to n :do (create-turtle)))
+ (let
+  ((new-turtles (loop :repeat n :collect (create-turtle))))
+  (when fn (ask (list->agentset new-turtles :turtles) fn))))
+
+(defun reset-ticks ()
+ "RESET-TICKS => RESULT
+
+ARGUMENTS AND VALUES:
+
+  RESULT: undefined
+
+DESCRIPTION:
+
+  Resets the tick counter to zero, sets up all plots, then updates all plots.
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#reset-ticks"
+ (setf *ticks* 0d0))
+
+(defun tick ()
+ "RESET-TICKS => RESULT
+
+ARGUMENTS AND VALUES:
+
+  RESULT: undefined
+
+DESCRIPTION:
+
+  Advances the tick counter by one and updates all plots.
+
+  If the tick counter has not been started yet with reset-ticks, an error results.
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#tick"
+
+ (when (not *ticks*) (error "reset-ticks must be called"))
+ (incf *ticks*))
+
+(defun ticks ()
+ "TICKS => CURRENT-TICKS
+
+ARGUMENTS AND VALUES:
+
+  CURRENT-TICKS: A positiv double, representing the current number of ticks
+
+DESCRIPTION:
+
+  Reports the current value of the tick counter. The result is always a number and never negative.
+
+  If the tick counter has not been started yet with reset-ticks, an error results.
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#ticks"
+ (when (not *ticks*) (error "reset-ticks must be called"))
+ *ticks*)

 
 (defun create-world (&key dims)
  "CREATE-WORLD &key DIMS => RESULT
 
 (defun create-world (&key dims)
  "CREATE-WORLD &key DIMS => RESULT


@@ -216,6 +554,16 @@ DESCRIPTION:
   This should be called before using the engine in any real capacity.  If
   called when an engine is already running, it may do somethign weird."
  (setf *dimensions* dims)
   This should be called before using the engine in any real capacity.  If
   called when an engine is already running, it may do somethign weird."
  (setf *dimensions* dims)

+ (setf
+  *patches*
+  (loop
+   :for y :from (max-pycor) :downto (min-pycor)
+   :append (loop
+            :for x :from (min-pxcor) :to (max-pxcor)
+            :collect (make-patch
+                      :xcor (coerce x 'double-float)
+                      :ycor (coerce y 'double-float)
+                      :color 0d0))))

  (setf *turtles* nil)
  (setf *current-id* 0))
 
  (setf *turtles* nil)
  (setf *current-id* 0))
 


@@ -231,11 +579,22 @@ DESCRIPTION:
     ; Someday we'll have d<posint>, but this is not that day!
     (cl-ppcre:regex-replace "d-" (cl-ppcre:regex-replace "d0" output "") "E-")))))
 
     ; Someday we'll have d<posint>, but this is not that day!
     (cl-ppcre:regex-replace "d-" (cl-ppcre:regex-replace "d0" output "") "E-")))))
 

-(defmethod dump-object ((o string)) o)
+(defmethod dump-object ((o string)) (format nil "~A" (cl-ppcre:regex-replace-all "\"" (format nil "~S" o) "\"\"")))

 
 (defmethod dump-object ((o (eql t))) "true")
 (defmethod dump-object ((o (eql nil))) "false")
 
 
 (defmethod dump-object ((o (eql t))) "true")
 (defmethod dump-object ((o (eql nil))) "false")
 

+(defmethod dump-object ((o list))
+ (cond
+  ((agentset-p o) (format nil "(agentset, ~A ~A)" (dump-object (count o)) (string-downcase (agentset-breed o))))
+  (t (format nil "[~{~A~^ ~}]" (mapcar #'dump-object o)))))
+
+(defmethod dump-object ((o patch))
+ (format nil "(patch ~A ~A)" (dump-object (patch-xcor o)) (dump-object (patch-ycor o))))
+
+(defmethod dump-object ((o turtle)) (format nil "(turtle ~A)" (dump-object (turtle-who o))))
+(defmethod dump-object ((o (eql :nobody))) (format nil "nobody"))
+

 (defun current-state ()
  "CURRENT-STATE => WORLD-STATE
 
 (defun current-state ()
  "CURRENT-STATE => WORLD-STATE
 


@@ -251,31 +610,63 @@ DESCRIPTION:
   data structure for easy usage in a common lisp instance.  It's preferable
   to use this when working with the nvm than the output done by export-world.
 
   data structure for easy usage in a common lisp instance.  It's preferable
   to use this when working with the nvm than the output done by export-world.
 

-  Currently this only dumps out turtle information.
+  Currently this only dumps out turtle and patch information.

 
   This is called CURRENT-STATE because export-world is an actual primitive
   used by NetLogo."
 
   This is called CURRENT-STATE because export-world is an actual primitive
   used by NetLogo."

- (mapcar
-  (lambda (turtle)
-   (list
-    :color (turtle-color turtle)
-    :xcor (turtle-xcor turtle)
-    :ycor (turtle-ycor turtle)
-    :heading (turtle-heading turtle)))
-  *turtles*))
+ (list
+  (mapcar
+   (lambda (turtle)
+    (list
+     :color (turtle-color turtle)
+     :xcor (turtle-xcor turtle)
+     :ycor (turtle-ycor turtle)
+     :heading (turtle-heading turtle)
+     :size (turtle-size turtle)))
+   *turtles*)
+  (mapcar
+   (lambda (patch)
+    (list
+     :color (patch-color patch)
+     :xcor (patch-xcor patch)
+     :ycor (patch-ycor patch)))
+   *patches*)))
+
+(defun export-turtles ()
+ (append
+  (list
+   "\"TURTLES\""
+   (format nil "~A~A"
+    "\"who\",\"color\",\"heading\",\"xcor\",\"ycor\",\"shape\",\"label\",\"label-color\","
+    "\"breed\",\"hidden?\",\"size\",\"pen-size\",\"pen-mode\""))
+  (mapcar
+   (lambda (turtle)
+    (format nil
+     "\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"\"\"default\"\"\",\"~A\",\"~A\",\"{all-turtles}\",\"false\",\"~A\",~A"
+     (dump-object (turtle-who turtle))
+     (dump-object (turtle-color turtle))
+     (dump-object (turtle-heading turtle))
+     (dump-object (turtle-xcor turtle))
+     (dump-object (turtle-ycor turtle))
+     (dump-object (turtle-label turtle))
+     (dump-object (turtle-label-color turtle))
+     (dump-object (turtle-size turtle))
+     "\"1\",\"\"\"up\"\"\""))
+   *turtles*)))

 
 (defun export-patches ()
 
 (defun export-patches ()

- (list
-  "\"pxcor\",\"pycor\",\"pcolor\",\"plabel\",\"plabel-color\""
-  "\"-1\",\"1\",\"0\",\"\"\"\"\"\",\"9.9\""
-  "\"0\",\"1\",\"0\",\"\"\"\"\"\",\"9.9\""
-  "\"1\",\"1\",\"0\",\"\"\"\"\"\",\"9.9\""
-  "\"-1\",\"0\",\"0\",\"\"\"\"\"\",\"9.9\""
-  "\"0\",\"0\",\"0\",\"\"\"\"\"\",\"9.9\""
-  "\"1\",\"0\",\"0\",\"\"\"\"\"\",\"9.9\""
-  "\"-1\",\"-1\",\"0\",\"\"\"\"\"\",\"9.9\""
-  "\"0\",\"-1\",\"0\",\"\"\"\"\"\",\"9.9\""
-  "\"1\",\"-1\",\"0\",\"\"\"\"\"\",\"9.9\""))
+ (append
+  (list
+   "\"PATCHES\""
+   "\"pxcor\",\"pycor\",\"pcolor\",\"plabel\",\"plabel-color\"")
+  (mapcar
+   (lambda (patch)
+    (format nil
+     "\"~A\",\"~A\",\"~A\",\"\"\"\"\"\",\"9.9\""
+     (dump-object (patch-xcor patch))
+     (dump-object (patch-ycor patch))
+     (dump-object (patch-color patch))))
+   *patches*)))

 
 (defun export-world ()
  "EXPORT-WORLD => WORLD-CSV
 
 (defun export-world ()
  "EXPORT-WORLD => WORLD-CSV


@@ -303,23 +694,8 @@ DESCRIPTION:
    (format nil "\"~A\",\"~A\",\"~A\",\"~A\",\"0\",\"nobody\",\"~A\",\"\"\"NEITHER\"\"\",\"-1\""
     (min-pxcor) (max-pxcor) (min-pycor) (max-pycor) *current-id*)
    ""
    (format nil "\"~A\",\"~A\",\"~A\",\"~A\",\"0\",\"nobody\",\"~A\",\"\"\"NEITHER\"\"\",\"-1\""
     (min-pxcor) (max-pxcor) (min-pycor) (max-pycor) *current-id*)
    ""

-   (format nil "~S" "TURTLES")
-   (format nil "~A~A"
-    "\"who\",\"color\",\"heading\",\"xcor\",\"ycor\",\"shape\",\"label\",\"label-color\","
-    "\"breed\",\"hidden?\",\"size\",\"pen-size\",\"pen-mode\"")
-   (format nil "~{~A~%~}"
-    (mapcar
-     (lambda (turtle)
-      (format nil
-       "\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",~A"
-       (turtle-who turtle)
-       (dump-object (turtle-color turtle))
-       (dump-object (turtle-heading turtle))
-       (dump-object (turtle-xcor turtle))
-       (dump-object (turtle-ycor turtle))
-       "\"\"\"default\"\"\",\"\"\"\"\"\",\"9.9\",\"{all-turtles}\",\"false\",\"1\",\"1\",\"\"\"up\"\"\""))
-     *turtles*))
-   (format nil "~S" "PATCHES")
+   (format nil "~{~A~^~%~}" (export-turtles))
+   ""

    (format nil "~{~A~^~%~}" (export-patches))
    ""
    (format nil "~S" "LINKS")
    (format nil "~{~A~^~%~}" (export-patches))
    ""
    (format nil "~S" "LINKS")