Wolf sheep works in tests
[clnl] / src / main / nvm / nvm.lisp
index 6fdc812964cb72e5f4c0a73b58d955615bcd3b52..5540caea05bad45b54cb49f30cd6e8f9138c4004 100644 (file)
@@ -48,9 +48,10 @@ DESCRIPTION:
   (:magenta 125d0)
   (:pink 135d0)))
 
   (:magenta 125d0)
   (:pink 135d0)))
 
-(defun create-turtle (&optional base-turtle)
- (let
-  ((new-turtle (make-turtle
+(defun create-turtle (breed &optional base-turtle)
+ (let*
+  ((breed (or breed (and base-turtle (turtle-breed base-turtle)) :turtles))
+   (new-turtle (make-turtle
                 :who (coerce *current-id* 'double-float)
                 :color (if base-turtle
                         (turtle-color base-turtle)
                 :who (coerce *current-id* 'double-float)
                 :color (if base-turtle
                         (turtle-color base-turtle)
@@ -58,8 +59,16 @@ DESCRIPTION:
                 :heading (if base-turtle
                           (turtle-heading base-turtle)
                           (coerce (clnl-random:next-int 360) 'double-float))
                 :heading (if base-turtle
                           (turtle-heading base-turtle)
                           (coerce (clnl-random:next-int 360) 'double-float))
+                :label-color (if base-turtle (turtle-label-color base-turtle) 9.9d0)
+                :size (if base-turtle (turtle-size base-turtle) 1d0)
+                :breed breed
+                :shape (breed-default-shape breed)
                 :xcor (if base-turtle (turtle-xcor base-turtle) 0d0)
                 :xcor (if base-turtle (turtle-xcor base-turtle) 0d0)
-                :ycor (if base-turtle (turtle-ycor base-turtle) 0d0))))
+                :ycor (if base-turtle (turtle-ycor base-turtle) 0d0)
+                :own-vars (when base-turtle (copy-list (turtle-own-vars base-turtle))))))
+  (let
+   ((patch (patch-at (turtle-xcor new-turtle) (turtle-ycor new-turtle))))
+   (setf (patch-turtles patch) (nconc (patch-turtles patch) (list new-turtle))))
   (setf *turtles* (nconc *turtles* (list new-turtle)))
   (incf *current-id*)
   new-turtle))
   (setf *turtles* (nconc *turtles* (list new-turtle)))
   (incf *current-id*)
   new-turtle))
@@ -85,7 +94,11 @@ DESCRIPTION:
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#die"
  (when (not (turtle-p *self*)) (error "Gotta call die in turtle scope, dude (~A)" *self*))
  (setf (turtle-who *self*) -1)
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#die"
  (when (not (turtle-p *self*)) (error "Gotta call die in turtle scope, dude (~A)" *self*))
  (setf (turtle-who *self*) -1)
- (setf *turtles* (remove *self* *turtles*)))
+ (setf *turtles* (remove *self* *turtles*))
+ (let
+  ((patch (patch-at (turtle-xcor *self*) (turtle-ycor *self*))))
+  (setf (patch-turtles patch) (remove *self* (patch-turtles patch))))
+ (error (make-condition 'death)))
 
 (defun patches ()
  "PATCHES => ALL-PATCHES
 
 (defun patches ()
  "PATCHES => ALL-PATCHES
@@ -121,6 +134,26 @@ DESCRIPTION:
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtles"
  :turtles)
 
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtles"
  :turtles)
 
+(defun turtles-here (&optional breed)
+ "TURTLES-HERE => TURTLES
+
+ARGUMENTS AND VALUES:
+
+  TURTLES: an agentset
+
+DESCRIPTION:
+
+  Returns the agentset consisting of all the turtles sharing the patch
+  with the agent in by *self*
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtles-here"
+ (when (not (turtle-p *self*)) (error "Gotta call turtles-here with a turtle"))
+ (let
+  ((patch-turtles (patch-turtles (patch-at (turtle-xcor *self*) (turtle-ycor *self*)))))
+  (list->agentset
+   (if breed (remove breed patch-turtles :key #'turtle-breed :test-not #'eql) patch-turtles)
+   (or breed :turtles))))
+
 (defun ask (agent-or-agentset fn)
  "ASK AGENT-OR-AGENTSET FN => RESULT
 
 (defun ask (agent-or-agentset fn)
  "ASK AGENT-OR-AGENTSET FN => RESULT
 
@@ -149,9 +182,10 @@ DESCRIPTION:
     (loop
      :for agent := (funcall iter)
      :while agent
     (loop
      :for agent := (funcall iter)
      :while agent
-     :do (let ((*myself* *self*) (*self* agent)) (funcall fn)))))
+     :do (when (not (and (turtle-p agent) (= -1 (turtle-who agent))))
+          (let ((*myself* *self*) (*self* agent)) (with-stop-and-death-handler (funcall fn)))))))
   ((agent-p agent-or-agentset)
   ((agent-p agent-or-agentset)
-   (let ((*myself* *self*) (*self* agent-or-agentset)) (funcall fn)))
+   (let ((*myself* *self*) (*self* agent-or-agentset)) (with-stop-and-death-handler (funcall fn))))
   (t
    (error "Ask requires an agentset or agent but got: ~A" agent-or-agentset))))
 
   (t
    (error "Ask requires an agentset or agent but got: ~A" agent-or-agentset))))
 
@@ -171,6 +205,53 @@ DESCRIPTION:
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#count"
  (coerce (length (agentset-list agentset)) 'double-float))
 
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#count"
  (coerce (length (agentset-list agentset)) 'double-float))
 
+(defun clear-all ()
+ "CLEAR-ALL => RESULT
+
+ARGUMENTS AND VALUES:
+
+  RESULT: undefined
+
+DESCRIPTION:
+
+  Clears ticks, turtles, patches, globals (unimplemented).
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#clear-all"
+ (clear-turtles)
+ (clear-patches)
+ (clear-ticks))
+
+(defun display ()
+ "DISPLAY => RESULT
+
+ARGUMENTS AND VALUES:
+
+  RESULT: undefined
+
+DESCRIPTION:
+
+  As of yet, this does nothing.  A placeholder method for forced dipslay
+  updates from the engine.
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#display"
+ nil)
+
+(defun stop ()
+ "STOP => RESULT
+
+ARGUMENTS AND VALUES:
+
+  RESULT: undefined
+
+DESCRIPTION:
+
+  Returns from the current stop block, which will halt the currently running
+  thing, be that the program, current ask block, or procedure.  Stop has odd
+  semantics that are best gleaned from the actual NetLogo manual.
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#stop"
+ (error (make-condition 'stop)))
+
 (defun of (fn agent-or-agentset)
  "OF FN AGENT-OR-AGENTSET => RESULT
 
 (defun of (fn agent-or-agentset)
  "OF FN AGENT-OR-AGENTSET => RESULT
 
@@ -239,13 +320,14 @@ DESCRIPTION:
   ((copy (copy-list agentset-list))
    (i 0)
    (agent nil))
   ((copy (copy-list agentset-list))
    (i 0)
    (agent nil))
-  (flet
+  (labels
    ((fetch ()
      (let
       ((idx (when (< i (1- (length copy))) (+ i (clnl-random:next-int (- (length copy) i))))))
       (when idx (setf agent (nth idx copy)))
       (when idx (setf (nth idx copy) (nth i copy)))
    ((fetch ()
      (let
       ((idx (when (< i (1- (length copy))) (+ i (clnl-random:next-int (- (length copy) i))))))
       (when idx (setf agent (nth idx copy)))
       (when idx (setf (nth idx copy) (nth i copy)))
-      (incf i))))
+      (incf i)
+      (when (and (<= i (length copy)) (turtle-p agent) (= -1 (turtle-who agent))) (fetch)))))
    (fetch) ; we pre-fetch because netlogo does, rng sync hype!
    (lambda ()
     (cond
    (fetch) ; we pre-fetch because netlogo does, rng sync hype!
    (lambda ()
     (cond
@@ -374,14 +456,15 @@ DESCRIPTION:
 
 (defun jump (n)
  (when (not (turtle-p *self*)) (error "Gotta call jump in turtle scope, dude (~A)" *self*))
 
 (defun jump (n)
  (when (not (turtle-p *self*)) (error "Gotta call jump in turtle scope, dude (~A)" *self*))
- (setf
-  (turtle-xcor *self*)
-  (wrap-x *topology*
-   (+ (turtle-xcor *self*) (* n (using-cached-sin (turtle-heading *self*))))))
- (setf
-  (turtle-ycor *self*)
-  (wrap-y *topology*
-   (+ (turtle-ycor *self*) (* n (using-cached-cos (turtle-heading *self*)))))))
+ (with-patch-update *self*
+  (setf
+   (turtle-xcor *self*)
+   (wrap-x *topology*
+    (+ (turtle-xcor *self*) (* n (using-cached-sin (turtle-heading *self*))))))
+  (setf
+   (turtle-ycor *self*)
+   (wrap-y *topology*
+    (+ (turtle-ycor *self*) (* n (using-cached-cos (turtle-heading *self*))))))))
 
 (defun setxy (x y)
  "SETXY X Y => RESULT
 
 (defun setxy (x y)
  "SETXY X Y => RESULT
@@ -402,6 +485,26 @@ DESCRIPTION:
  (setf (turtle-xcor *self*) (wrap-x *topology* x))
  (setf (turtle-ycor *self*) (wrap-y *topology* y)))
 
  (setf (turtle-xcor *self*) (wrap-x *topology* x))
  (setf (turtle-ycor *self*) (wrap-y *topology* y)))
 
+(defun set-default-shape (breed shape)
+ "SET-DEFAULT-SHAPE BREED SHAPE => RESULT
+
+ARGUMENTS AND VALUES:
+
+  BREED: a valid breed
+  SHAPE: a string
+  RESULT: undefined
+
+DESCRIPTION:
+
+  Specifies a default initial shape for a BREED. When a turtle, or it changes breeds,
+  its shape is set to the given shape.
+
+  SET-DEFAULT-SHAPE doesn't affect existing agents, only agents you create afterwards.
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#set-default-shape"
+ (when (not (breed-p breed)) (error "Need a valid breed"))
+ (setf (breed-default-shape breed) shape))
+
 (defun forward (n)
  "FORWARD N => RESULT
 
 (defun forward (n)
  "FORWARD N => RESULT
 
@@ -467,26 +570,28 @@ DESCRIPTION:
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#right"
  (turn-right (- n)))
 
   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
+(defun create-turtles (n &optional breed fn)
+ "CREATE-TURTLES N &optional BREED 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
+  BREED: a breed
   FN: A function, applied to each turtle after creation
   RESULT: undefined
 
 DESCRIPTION:
 
   FN: A function, applied to each turtle after creation
   RESULT: undefined
 
 DESCRIPTION:
 
-  Creates number new turtles at the origin.
+  Creates N new turtles at the origin.
 
   New turtles have random integer headings and the color is randomly selected
 
   New turtles have random integer headings and the color is randomly selected
-  from the 14 primary colors.  If a function is supplied, the new turtles
-  immediately run it.
+  from the 14 primary colors.  If FN is supplied, the new turtles immediately
+  run it.  If a BREED is supplied, that is the breed the new turtles are set
+  to.
 
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles"
  (let
 
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles"
  (let
-  ((new-turtles (loop :repeat n :collect (create-turtle))))
+  ((new-turtles (loop :repeat n :collect (create-turtle breed))))
   (when fn (ask (list->agentset new-turtles :turtles) fn))))
 
 (defun hatch (n &optional fn)
   (when fn (ask (list->agentset new-turtles :turtles) fn))))
 
 (defun hatch (n &optional fn)
@@ -508,7 +613,7 @@ DESCRIPTION:
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#hatch"
  (when (not (turtle-p *self*)) (error "Can only hatch from turtle scope"))
  (let
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#hatch"
  (when (not (turtle-p *self*)) (error "Can only hatch from turtle scope"))
  (let
-  ((new-turtles (loop :repeat n :collect (create-turtle *self*))))
+  ((new-turtles (loop :repeat n :collect (create-turtle nil *self*))))
   (when fn (ask (list->agentset new-turtles :turtles) fn))))
 
 (defun reset-ticks ()
   (when fn (ask (list->agentset new-turtles :turtles) fn))))
 
 (defun reset-ticks ()
@@ -560,10 +665,34 @@ DESCRIPTION:
  (when (not *ticks*) (error "reset-ticks must be called"))
  *ticks*)
 
  (when (not *ticks*) (error "reset-ticks must be called"))
  *ticks*)
 
-(defun create-world (&key dims)
- "CREATE-WORLD &key DIMS => RESULT
+(defun clear-patches ()
+ (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)))))
+
+(defun clear-turtles ()
+ (setf *turtles* nil)
+ (setf *current-id* 0))
+
+(defun clear-ticks ()
+ (setf *ticks* nil))
+
+(defun create-world (&key dims globals turtles-own-vars patches-own-vars breeds)
+ "CREATE-WORLD &key DIMS GLOBALS TURTLES-OWN-VARS PATCHES-OWN-VARS BREEDS => RESULT
 
   DIMS: (:xmin XMIN :xmax XMAX :ymin YMIN :ymax YMAX)
 
   DIMS: (:xmin XMIN :xmax XMAX :ymin YMIN :ymax YMAX)
+  GLOBALS: GLOBAL*
+  TURTLES-OWN-VARS: TURTLES-OWN-VAR*
+  PATCHES-OWN-VARS: PATCHES-OWN-VAR*
+  BREEDS: BREED*
+  GLOBAL: (GLOBAL-NAME GLOBAL-ACCESS-FUNC)
 
 ARGUMENTS AND VALUES:
 
 
 ARGUMENTS AND VALUES:
 
@@ -572,6 +701,11 @@ ARGUMENTS AND VALUES:
   XMAX: An integer representing the maximum patch coord in X
   YMIN: An integer representing the minimum patch coord in Y
   YMAX: An integer representing the maximum patch coord in Y
   XMAX: An integer representing the maximum patch coord in X
   YMIN: An integer representing the minimum patch coord in Y
   YMAX: An integer representing the maximum patch coord in Y
+  TURTLES-OWN-VAR: Symbol for the turtles own variable in the keyword package
+  PATCHES-OWN-VAR: Symbol for the patches own variable in the keyword package
+  BREED: A list of symbols representing the possible preeds
+  GLOBAL-NAME: Symbol for the global in the keyword package
+  GLOBAL-ACCESS-FUNC: Function to get the value of the global
 
 DESCRIPTION:
 
 
 DESCRIPTION:
 
@@ -579,19 +713,17 @@ 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."
 
   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 *turtles-own-vars* turtles-own-vars)
+ (setf *patches-own-vars* patches-own-vars)
  (setf *dimensions* dims)
  (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 *globals* globals)
+ (setf *breeds*
+  (append
+   (list (list :turtles "default"))
+   (mapcar (lambda (breed) (list breed "default")) breeds)))
+ (clear-ticks)
+ (clear-patches)
+ (clear-turtles))
 
 ; These match netlogo's dump
 (defgeneric dump-object (o))
 
 ; These match netlogo's dump
 (defgeneric dump-object (o))
@@ -620,6 +752,11 @@ DESCRIPTION:
 
 (defmethod dump-object ((o turtle)) (format nil "(turtle ~A)" (dump-object (turtle-who o))))
 (defmethod dump-object ((o (eql :nobody))) (format nil "nobody"))
 
 (defmethod dump-object ((o turtle)) (format nil "(turtle ~A)" (dump-object (turtle-who o))))
 (defmethod dump-object ((o (eql :nobody))) (format nil "nobody"))
+(defmethod dump-object ((o (eql :turtles))) (format nil "{all-turtles}"))
+(defmethod dump-object ((o symbol))
+ (cond
+  ((find o *breeds* :key #'car) (format nil "{breed ~(~A~)}" o))
+  (t (error "Keyword unrecognized by dump object: ~A" o))))
 
 (defun current-state ()
  "CURRENT-STATE => WORLD-STATE
 
 (defun current-state ()
  "CURRENT-STATE => WORLD-STATE
@@ -662,36 +799,42 @@ DESCRIPTION:
  (append
   (list
    "\"TURTLES\""
  (append
   (list
    "\"TURTLES\""
-   (format nil "~A~A"
+   (format nil "~A~A~{,\"~A\"~}"
     "\"who\",\"color\",\"heading\",\"xcor\",\"ycor\",\"shape\",\"label\",\"label-color\","
     "\"who\",\"color\",\"heading\",\"xcor\",\"ycor\",\"shape\",\"label\",\"label-color\","
-    "\"breed\",\"hidden?\",\"size\",\"pen-size\",\"pen-mode\""))
+    "\"breed\",\"hidden?\",\"size\",\"pen-size\",\"pen-mode\""
+    (mapcar #'string-downcase *turtles-own-vars*)))
   (mapcar
    (lambda (turtle)
     (format nil
   (mapcar
    (lambda (turtle)
     (format nil
-     "\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"\"\"default\"\"\",\"~A\",\"~A\",\"{all-turtles}\",\"false\",\"~A\",~A"
+     "\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"false\",\"~A\",~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-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-shape turtle))
      (dump-object (turtle-label turtle))
      (dump-object (turtle-label-color turtle))
      (dump-object (turtle-label turtle))
      (dump-object (turtle-label-color turtle))
+     (dump-object (turtle-breed turtle))
      (dump-object (turtle-size turtle))
      (dump-object (turtle-size turtle))
-     "\"1\",\"\"\"up\"\"\""))
+     "\"1\",\"\"\"up\"\"\""
+     (mapcar #'dump-object (mapcar (lambda (var) (agent-value-inner turtle var)) *turtles-own-vars*))))
    *turtles*)))
 
 (defun export-patches ()
  (append
   (list
    "\"PATCHES\""
    *turtles*)))
 
 (defun export-patches ()
  (append
   (list
    "\"PATCHES\""
-   "\"pxcor\",\"pycor\",\"pcolor\",\"plabel\",\"plabel-color\"")
+   (format nil "\"pxcor\",\"pycor\",\"pcolor\",\"plabel\",\"plabel-color\"~{,\"~A\"~}"
+    (mapcar #'string-downcase *patches-own-vars*)))
   (mapcar
    (lambda (patch)
     (format nil
   (mapcar
    (lambda (patch)
     (format nil
-     "\"~A\",\"~A\",\"~A\",\"\"\"\"\"\",\"9.9\""
+     "\"~A\",\"~A\",\"~A\",\"\"\"\"\"\",\"9.9\"~{,\"~A\"~}"
      (dump-object (patch-xcor patch))
      (dump-object (patch-ycor patch))
      (dump-object (patch-xcor patch))
      (dump-object (patch-ycor patch))
-     (dump-object (patch-color patch))))
+     (dump-object (patch-color patch))
+     (mapcar #'dump-object (mapcar (lambda (var) (agent-value-inner patch var)) *patches-own-vars*))))
    *patches*)))
 
 (defun export-world ()
    *patches*)))
 
 (defun export-world ()
@@ -708,22 +851,26 @@ DESCRIPTION:
   This is useful for serializing the current state of the engine in order
   to compare against NetLogo or to reimport later.  Contains everything needed
   to boot up a NetLogo instance in the exact same state."
   This is useful for serializing the current state of the engine in order
   to compare against NetLogo or to reimport later.  Contains everything needed
   to boot up a NetLogo instance in the exact same state."
- (format nil "~{~A~%~}"
-  (list
-   (format nil "~S" "RANDOM STATE")
-   (format nil "~S" (clnl-random:export))
-   ""
-   (format nil "~S" "GLOBALS")
-   (format nil "~A~A"
-    "\"min-pxcor\",\"max-pxcor\",\"min-pycor\",\"max-pycor\",\"perspective\",\"subject\","
-    "\"nextIndex\",\"directed-links\",\"ticks\",")
-   (format nil "\"~A\",\"~A\",\"~A\",\"~A\",\"0\",\"nobody\",\"~A\",\"\"\"NEITHER\"\"\",\"-1\""
-    (min-pxcor) (max-pxcor) (min-pycor) (max-pycor) *current-id*)
-   ""
-   (format nil "~{~A~^~%~}" (export-turtles))
-   ""
-   (format nil "~{~A~^~%~}" (export-patches))
-   ""
-   (format nil "~S" "LINKS")
-   "\"end1\",\"end2\",\"color\",\"label\",\"label-color\",\"hidden?\",\"breed\",\"thickness\",\"shape\",\"tie-mode\""
-   "")))
+ (let
+  ((ordered-globals (sort (copy-list *globals*) #'string< :key (lambda (global) (symbol-name (car global))))))
+  (format nil "~{~A~%~}"
+   (list
+    (format nil "~S" "RANDOM STATE")
+    (format nil "~S" (clnl-random:export))
+    ""
+    (format nil "~S" "GLOBALS")
+    (format nil "~A~A~{\"~A\"~^,~}"
+     "\"min-pxcor\",\"max-pxcor\",\"min-pycor\",\"max-pycor\",\"perspective\",\"subject\","
+     "\"nextIndex\",\"directed-links\",\"ticks\","
+     (mapcar #'string-downcase (mapcar #'car ordered-globals)))
+    (format nil "\"~A\",\"~A\",\"~A\",\"~A\",\"0\",\"nobody\",\"~A\",\"\"\"NEITHER\"\"\",\"~A\"~{,\"~A\"~}"
+     (min-pxcor) (max-pxcor) (min-pycor) (max-pycor) *current-id* (dump-object (or *ticks* -1d0))
+     (mapcar #'dump-object (mapcar #'funcall (mapcar #'cadr ordered-globals))))
+    ""
+    (format nil "~{~A~^~%~}" (export-turtles))
+    ""
+    (format nil "~{~A~^~%~}" (export-patches))
+    ""
+    (format nil "~S" "LINKS")
+    "\"end1\",\"end2\",\"color\",\"label\",\"label-color\",\"hidden?\",\"breed\",\"thickness\",\"shape\",\"tie-mode\""
+    ""))))