X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=blobdiff_plain;f=src%2Fmain%2Fnvm.lisp;h=bf8981a2f6e359b01ab8c61787a610792c023633;hb=5c8699f151207953f4029e0fc6c488afce99f756;hp=091bfe44c7244bb1dfe79eff23da52655e9de380;hpb=4a9ed570e6d2c79ac7cac0a6a84d414ee658cd3e;p=clnl

diff --git a/src/main/nvm.lisp b/src/main/nvm.lisp
index 091bfe4..bf8981a 100644
--- a/src/main/nvm.lisp
+++ b/src/main/nvm.lisp
@@ -1,6 +1,4 @@
-(in-package #:cl-nl.nvm)
-
-; This is the engine.  Yay.
+(in-package #:clnl-nvm)
 
 (defvar *current-id* 0)
 
@@ -9,96 +7,276 @@
 (defvar *myself* nil)
 (defvar *self* nil)
 
-(defun show (n)
- (format t "Showing: ~A~%" n))
+(defun show (value)
+ "SHOW VALUE => RESULT
+
+ARGUMENTS AND VALUES:
+
+  VALUE: a NetLogo value
+  RESULT: undefined
+
+DESCRIPTION:
+
+  A command that prints the given NetLogo value to the command center.
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#show"
+ (format t "Showing: ~A~%" (dump-object value)))
 
 (defun create-turtle ()
- (push
-  (make-turtle :who *current-id*
-               :color (coerce (+ 5 (* 10 (cl-nl.random:next-int 14))) 'double-float)
-               :heading (coerce (cl-nl.random:next-int 360) 'double-float)
-               :xcor 0d0
-               :ycor 0d0)
-  *turtles*)
+ (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*))
 
-(defun turtles () *turtles*)
+(defun turtles ()
+ "TURTLES => ALL-TURTLES
+
+ARGUMENTS AND VALUES:
+
+  ALL-TURTLES: a NetLogo agentset, all turtles
+
+DESCRIPTION:
+
+  Reports the agentset consisting of all the turtles.
+
+  This agentset is special in that it represents the living 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*)
 
 (defun ask (agent-set fn)
- (mapcar
-  (lambda (agent)
-   (let
-    ((*myself* *self*)
-     (*self* agent))
-    (funcall fn)))
-  (shuffle agent-set)))
+ "ASK AGENT-SET FN => RESULT
+
+ARGUMENTS AND VALUES:
+
+  AGENT-SET: a NetLogo agentset
+  FN: a function, run on each agent
+  RESULT: undefined, commands don't return
+
+DESCRIPTION:
 
-(defun shuffle (agent-set)
+  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.
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#ask"
  (let
-  ((copy (copy-list agent-set)))
-  (append
-   (loop for i to (- (length copy) 2)
-         for idx = (+ i (cl-nl.random:next-int (- (length copy) i)))
-         for next = (nth idx copy)
-         do (setf (nth idx copy) (nth i copy))
-         collect next)
-   (last copy))))
-
-(defun fd (n)
- (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude"))
- (setf (turtle-xcor *self*) (+ (turtle-xcor *self*) (sin (* pi (/ (turtle-heading *self*) 180)))))
- (setf (turtle-ycor *self*) (+ (turtle-ycor *self*) (cos (* pi (/ (turtle-heading *self*) 180))))))
+  ((iter (shufflerator agent-set)))
+  (loop
+   :for agent := (funcall iter)
+   :while agent
+   :do (let ((*myself* *self*) (*self* agent)) (funcall fn)))))
+
+(defun shufflerator (agent-set)
+ (let
+  ((copy (copy-list agent-set))
+   (i 0)
+   (agent nil))
+  (flet
+   ((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))))
+   (fetch) ; we pre-fetch because netlogo does, rng sync hype!
+   (lambda ()
+    (cond
+     ((> i (length copy)) nil)
+     ((= i (length copy)) (incf i) (car (last copy)))
+     (t (let ((result agent)) (fetch) result)))))))
+
+(defun random-float (n)
+ "RANDOM-FLOAT N => RANDOM-NUMBER
+
+ARGUMENTS AND VALUES:
+
+  N: a double, the upper bound of the random float
+  RANDOM-NUMBER: a double, the random result
+
+DESCRIPTION:
+
+  Returns a random number strictly closer to zero than N.
+
+  If number is positive, returns a random floating point number greater than
+  or equal to 0 but strictly less than number.
+
+  If number is negative, returns a random floating point number 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-float"
+ (clnl-random:next-double n))
+
+(defun forward (n)
+ "FORWARD N => RESULT
+
+ARGUMENTS AND VALUES:
+
+  N: a double, the amount the turtle moves forward
+  RESULT: undefined
+
+DESCRIPTION:
+
+  Moves the current turtle forward N steps, one step at a time.
+
+  This moves forward one at a time in order to make the view updates look
+  good in the case of a purposefully slow running instance.  If the number
+  is negative, the turtle moves backward.
+
+  If the current agent is not a turtle, it raises an error.
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#forward"
+ (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude (~A)" *self*))
+ (setf (turtle-xcor *self*) (+ (turtle-xcor *self*) (* n (sin (* pi (/ (turtle-heading *self*) 180))))))
+ (setf (turtle-ycor *self*) (+ (turtle-ycor *self*) (* n (cos (* pi (/ (turtle-heading *self*) 180)))))))
 
 (defun create-turtles (n)
- (loop for i from 1 to n do (create-turtle)))
+ "CREATE-TURTLES N => RESULT
+
+ARGUMENTS AND VALUES:
+
+  N: an integer, the numbers of turtles to create
+  RESULT: undefined
+
+DESCRIPTION:
+
+  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).
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles"
+ (loop :for i :from 1 :to n :do (create-turtle)))
 
 (defun create-world ()
+ "CREATE-WORLD => RESULT
+
+ARGUMENTS AND VALUES:
+
+  RESULT: undefined
+
+DESCRIPTION:
+
+  Initializes the world in the NVM.
+
+  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* nil)
  (setf *current-id* 0))
 
-(defun format-num (n)
+; These match netlogo's dump
+(defgeneric dump-object (o))
+
+(defmethod dump-object ((n double-float))
  (multiple-value-bind (int rem) (floor n)
   (if (eql 0d0 rem)
-      (format nil "~A" int)
-      (format nil "~F" n))))
+   (format nil "~A" int)
+   (let
+    ((output (format nil "~D" n)))
+    ; 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)
+
+(defun current-state ()
+ "CURRENT-STATE => WORLD-STATE
+
+ARGUMENTS AND VALUES:
+
+  WORLD-STATE: A list, the current state of the whole world
+
+DESCRIPTION:
+
+  Dumps out the state of the world.
+
+  This is useful for visualizations and also storing in a common lisp
+  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.
+
+  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*))
+
+(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\""))
 
 (defun export-world ()
+ "EXPORT-WORLD => WORLD-CSV
+
+ARGUMENTS AND VALUES:
+
+  WORLD-CSV: A string, the csv of the world
+
+DESCRIPTION:
+
+  Dumps out a csv matching NetLogo's export world.
+
+  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" (cl-nl.random:export))
+   (format nil "~S" (clnl-random:export))
    ""
    (format nil "~S" "GLOBALS")
-   "\"min-pxcor\",\"max-pxcor\",\"min-pycor\",\"max-pycor\",\"perspective\",\"subject\",\"nextIndex\",\"directed-links\",\"ticks\","
+   (format nil "~A~A"
+    "\"min-pxcor\",\"max-pxcor\",\"min-pycor\",\"max-pycor\",\"perspective\",\"subject\","
+    "\"nextIndex\",\"directed-links\",\"ticks\",")
    (format nil "\"-1\",\"1\",\"-1\",\"1\",\"0\",\"nobody\",\"~A\",\"\"\"NEITHER\"\"\",\"-1\"" *current-id*)
    ""
    (format nil "~S" "TURTLES")
-   "\"who\",\"color\",\"heading\",\"xcor\",\"ycor\",\"shape\",\"label\",\"label-color\",\"breed\",\"hidden?\",\"size\",\"pen-size\",\"pen-mode\""
+   (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\",\"\"\"default\"\"\",\"\"\"\"\"\",\"9.9\",\"{all-turtles}\",\"false\",\"1\",\"1\",\"\"\"up\"\"\""
+       "\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",~A"
        (turtle-who turtle)
-       (format-num (turtle-color turtle))
-       (format-num (turtle-heading turtle))
-       (format-num (turtle-xcor turtle))
-       (format-num (turtle-ycor turtle))
-       ))
-     (reverse *turtles*)))
+       (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")
-   "\"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\""
+   (format nil "~{~A~^~%~}" (export-patches))
    ""
    (format nil "~S" "LINKS")
    "\"end1\",\"end2\",\"color\",\"label\",\"label-color\",\"hidden?\",\"breed\",\"thickness\",\"shape\",\"tie-mode\""
-   ""
-   )))
+   "")))