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

   1 (in-package #:clnl-nvm)
   2
   3 (defun export-turtles ()
   4  (append
   5   (list
   6    "\"TURTLES\""
   7    (format nil "~A~A~{,\"~A\"~}"
   8     "\"who\",\"color\",\"heading\",\"xcor\",\"ycor\",\"shape\",\"label\",\"label-color\","
   9     "\"breed\",\"hidden?\",\"size\",\"pen-size\",\"pen-mode\""
  10     (mapcar #'string-downcase *turtles-own-vars*)))
  11   (mapcar
  12    (lambda (turtle)
  13     (format nil
  14      "\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"false\",\"~A\",~A~{,\"~A\"~}"
  15      (dump-object (turtle-who turtle))
  16      (dump-object (turtle-color turtle))
  17      (dump-object (turtle-heading turtle))
  18      (dump-object (turtle-xcor turtle))
  19      (dump-object (turtle-ycor turtle))
  20      (dump-object (turtle-shape turtle))
  21      (dump-object (turtle-label turtle))
  22      (dump-object (turtle-label-color turtle))
  23      (dump-object (turtle-breed turtle))
  24      (dump-object (turtle-size turtle))
  25      "\"1\",\"\"\"up\"\"\""
  26      (mapcar #'dump-object (mapcar (lambda (var) (agent-value-inner turtle var)) *turtles-own-vars*))))
  27    *turtles*)))
  28
  29 (defun export-patches ()
  30  (append
  31   (list
  32    "\"PATCHES\""
  33    (format nil "\"pxcor\",\"pycor\",\"pcolor\",\"plabel\",\"plabel-color\"~{,\"~A\"~}"
  34     (mapcar #'string-downcase *patches-own-vars*)))
  35   (mapcar
  36    (lambda (patch)
  37     (format nil
  38      "\"~A\",\"~A\",\"~A\",\"\"\"\"\"\",\"9.9\"~{,\"~A\"~}"
  39      (dump-object (patch-xcor patch))
  40      (dump-object (patch-ycor patch))
  41      (dump-object (patch-color patch))
  42      (mapcar #'dump-object (mapcar (lambda (var) (agent-value-inner patch var)) *patches-own-vars*))))
  43    *patches*)))
  44
  45 (defun export-world ()
  46  "EXPORT-WORLD => WORLD-CSV
  47
  48 ARGUMENTS AND VALUES:
  49
  50   WORLD-CSV: A string, the csv of the world
  51
  52 DESCRIPTION:
  53
  54   Dumps out a csv matching NetLogo's export world.
  55
  56   This is useful for serializing the current state of the engine in order
  57   to compare against NetLogo or to reimport later.  Contains everything needed
  58   to boot up a NetLogo instance in the exact same state."
  59  (let
  60   ((ordered-globals (sort (copy-list *globals*) #'string< :key (lambda (global) (symbol-name (car global))))))
  61   (format nil "~{~A~%~}"
  62    (list
  63     (format nil "~S" "RANDOM STATE")
  64     (format nil "~S" (clnl-random:export))
  65     ""
  66     (format nil "~S" "GLOBALS")
  67     (format nil "~A~A~{\"~A\"~^,~}"
  68      "\"min-pxcor\",\"max-pxcor\",\"min-pycor\",\"max-pycor\",\"perspective\",\"subject\","
  69      "\"nextIndex\",\"directed-links\",\"ticks\","
  70      (mapcar #'string-downcase (mapcar #'car ordered-globals)))
  71     (format nil "\"~A\",\"~A\",\"~A\",\"~A\",\"0\",\"nobody\",\"~A\",\"\"\"NEITHER\"\"\",\"~A\"~{,\"~A\"~}"
  72      (min-pxcor) (max-pxcor) (min-pycor) (max-pycor) *current-id* (dump-object (or *ticks* -1d0))
  73      (mapcar #'dump-object (mapcar #'funcall (mapcar #'cadr ordered-globals))))
  74     ""
  75     (format nil "~{~A~^~%~}" (export-turtles))
  76     ""
  77     (format nil "~{~A~^~%~}" (export-patches))
  78     ""
  79     (format nil "~S" "LINKS")
  80     "\"end1\",\"end2\",\"color\",\"label\",\"label-color\",\"hidden?\",\"breed\",\"thickness\",\"shape\",\"tie-mode\""
  81     ""))))
  82
  83 (defcommand show (value)
  84  "SHOW VALUE => RESULT
  85
  86   RESULT: :undefined
  87
  88 ARGUMENTS AND VALUES:
  89
  90   VALUE: a NetLogo value
  91
  92 DESCRIPTION:
  93
  94   A command that prints the given NetLogo value to the command center.
  95
  96   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#show"
  97  (format t "Showing: ~A~%" (dump-object value)))