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

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