X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=blobdiff_plain;ds=sidebyside;f=src%2Fmain%2Fnvm.lisp;h=37df1cb5de69985fea895d25ee1d4486e70ed372;hb=213ed30b45140af3f34b7e003aa60394178d524c;hp=2c2cdbd65a0491b7bb0d94df61f677fd55dc751c;hpb=c34fdd7f3b9920b2feaf1dec70d2dd21ddbbadf2;p=clnl diff --git a/src/main/nvm.lisp b/src/main/nvm.lisp index 2c2cdbd..37df1cb 100644 --- a/src/main/nvm.lisp +++ b/src/main/nvm.lisp @@ -1,19 +1,27 @@ (in-package #:clnl-nvm) -; This is the engine. Yay. - (defvar *current-id* 0) (defstruct turtle who color heading xcor ycor) (defvar *turtles* nil) (defvar *myself* nil) (defvar *self* nil) +(defvar *model* nil) + +(defun show (value) + "SHOW VALUE => RESULT + +ARGUMENTS AND VALUES: + + VALUE: a NetLogo value + RESULT: undefined -(defun show (n) - "Prints value in the Command Center, preceded by this agent, and followed by a carriage return. +DESCRIPTION: -See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#show" - (format t "Showing: ~A~%" (dump-object n))) + 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 () (setf @@ -21,28 +29,55 @@ See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#show" (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)))) + (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 () -"Reports the agentset consisting of all turtles. + "TURTLES => ALL-TURTLES + +ARGUMENTS AND VALUES: + + ALL-TURTLES: a NetLogo agentset, all turtles -See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#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) -"The specified agent or agentset runs the given commands. + "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: + + ASK is equivalent to ask in NetLogo. -See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#ask" + 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 ((iter (shufflerator agent-set))) - (loop for agent = (funcall iter) - while agent - do (let ((*myself* *self*) (*self* agent)) (funcall fn))))) + (loop + :for agent := (funcall iter) + :while agent + :do (let ((*myself* *self*) (*self* agent)) (funcall fn))))) (defun shufflerator (agent-set) (let @@ -64,84 +99,190 @@ See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#ask" (t (let ((result agent)) (fetch) result))))))) (defun random-float (n) -"If number is positive, returns a random floating point number greater than or equal to 0 but strictly less than number. + "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: -If number is negative, returns a random floating point number less than or equal to 0, but strictly greater than number. + Returns a random number strictly closer to zero than N. -If number is zero, the result is always 0. + If number is positive, returns a random floating point number greater than + or equal to 0 but strictly less than number. -See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-float" + 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) -"The turtle moves forward by number steps, one step at a time. (If number is negative, the turtle moves backward.) + "FORWARD N => RESULT + +ARGUMENTS AND VALUES: -See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#forward" + 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) -"Creates number new turtles at the origin. New turtles have random integer -headings and the color is randomly selected from the 14 primary colors. + "CREATE-TURTLES N => RESULT + +ARGUMENTS AND VALUES: -If commands are supplied, the new turtles immediately run them. + N: an integer, the numbers of turtles to create + RESULT: undefined -See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles" - (loop for i from 1 to n do (create-turtle))) +DESCRIPTION: -(defun create-world () + 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 (model) + "CREATE-WORLD MODEL => RESULT + +ARGUMENTS AND VALUES: + + MODEL: A clnl-model:model to use to initialize the vm + 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 *model* model) (setf *turtles* nil) (setf *current-id* 0)) ; 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) - (let - ((output (format nil "~D" n))) - (cl-ppcre:regex-replace "d-" (cl-ppcre:regex-replace "d0" output "") "E-"))))) ; Someday we'll have d, but this is not that day! + (format nil "~A" int) + (let + ((output (format nil "~D" n))) + ; Someday we'll have d, 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" (clnl-random:export)) "" (format nil "~S" "GLOBALS") - "\"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 "~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\"" + (getf (clnl-model:world-dimensions *model*) :xmin) (getf (clnl-model:world-dimensions *model*) :xmax) + (getf (clnl-model:world-dimensions *model*) :ymin) (getf (clnl-model:world-dimensions *model*) :ymax) + *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) (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\"" - "" - ))) + "")))