From: Frank Duncan Date: Tue, 19 Apr 2016 13:52:05 +0000 (-0500) Subject: Torus topography v1 - fd works X-Git-Tag: v0.1.0~61 X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?p=clnl;a=commitdiff_plain;h=75a961089cba4b6aa4a3e947616ee4026ec3b057 Torus topography v1 - fd works --- diff --git a/resources/empty.nlogo b/resources/empty.nlogo index 7777839..5506350 100644 --- a/resources/empty.nlogo +++ b/resources/empty.nlogo @@ -4,8 +4,8 @@ GRAPHICS-WINDOW 10 649 470 -1 -1 +-1 +-1 13.0 1 10 diff --git a/src/main/clnl.asd b/src/main/clnl.asd index 29e33cc..d03aee3 100644 --- a/src/main/clnl.asd +++ b/src/main/clnl.asd @@ -7,10 +7,13 @@ (:file "model") (:file "lex") (:file "parse") - (:file "nvm") + (:file "nvm/base") + (:file "nvm/utils") + (:file "nvm/nvm") + (:file "nvm/topology") (:file "transpile") (:file "random") (:file "interface") (:file "cli") (:file "main")) - :depends-on #-travis (:cl-ppcre :mt19937 :cl-opengl :cl-glut :cl-charms :strictmath) #+travis nil) + :depends-on #-travis(:cl-ppcre :mt19937 :cl-opengl :cl-glut :cl-charms :ieee-floats :strictmath) #+travis nil) diff --git a/src/main/lex.lisp b/src/main/lex.lisp index d39ab59..bea4f5a 100644 --- a/src/main/lex.lisp +++ b/src/main/lex.lisp @@ -104,7 +104,7 @@ DESCRIPTION: (let ((*readtable* (copy-readtable nil)) (*read-eval* nil)) - (read-from-string text)))) + (read-from-string (format nil "~Ad0" text))))) (if (numberp num?) num? (error "Invalid number"))))) (deflex :initial (format nil "~A*" *identifier-char*) #'as-symbol) diff --git a/src/main/nvm.lisp b/src/main/nvm.lisp deleted file mode 100644 index 018ce7e..0000000 --- a/src/main/nvm.lisp +++ /dev/null @@ -1,292 +0,0 @@ -(in-package #:clnl-nvm) - -(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 - -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 () - (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 => 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) - "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. - - 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))))) - -(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 (strictmath:sin (strictmath:to-radians (turtle-heading *self*)))))) - (setf - (turtle-ycor *self*) - (+ (turtle-ycor *self*) (* n (strictmath:cos (strictmath:to-radians (turtle-heading *self*))))))) - -(defun create-turtles (n) - "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 (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))) - ; 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") - (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") - (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\",~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") - (format nil "~{~A~^~%~}" (export-patches)) - "" - (format nil "~S" "LINKS") - "\"end1\",\"end2\",\"color\",\"label\",\"label-color\",\"hidden?\",\"breed\",\"thickness\",\"shape\",\"tie-mode\"" - ""))) diff --git a/src/main/nvm/base.lisp b/src/main/nvm/base.lisp new file mode 100644 index 0000000..ea427fa --- /dev/null +++ b/src/main/nvm/base.lisp @@ -0,0 +1,11 @@ +(in-package #:clnl-nvm) + +(defvar *current-id* 0) + +(defvar *turtles* nil) +(defvar *myself* nil) +(defvar *self* nil) +(defvar *model* nil) +(defvar *topology* :torus) + +(defstruct turtle who color heading xcor ycor) diff --git a/src/main/nvm/nvm.lisp b/src/main/nvm/nvm.lisp new file mode 100644 index 0000000..b18faf1 --- /dev/null +++ b/src/main/nvm/nvm.lisp @@ -0,0 +1,296 @@ +(in-package #:clnl-nvm) + +; Implementations of all the things the nvm can do. + +(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 () + (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 => 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) + "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. + + 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))))) + +(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 jump (n) + (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude (~A)" *self*)) + (setf + (turtle-xcor *self*) + (wrap-x *topology* + (+ (turtle-xcor *self*) (* n (strictmath:sin (strictmath:to-radians (turtle-heading *self*))))))) + (setf + (turtle-ycor *self*) + (wrap-y *topology* + (+ (turtle-ycor *self*) (* n (strictmath:cos (strictmath:to-radians (turtle-heading *self*)))))))) + +(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*)) + (labels + ((internal (i) + (cond + ((< (abs i) 3.2e-15) nil) + ((< (abs i) 1d0) (jump i)) + (t (jump (if (> i 0d0) 1d0 -1d0)) (internal (- i (if (> i 0d0) 1d0 -1d0))))))) + (internal n))) + +(defun create-turtles (n) + "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 (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))) + ; 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") + (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 "~S" "TURTLES") + (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\",~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") + (format nil "~{~A~^~%~}" (export-patches)) + "" + (format nil "~S" "LINKS") + "\"end1\",\"end2\",\"color\",\"label\",\"label-color\",\"hidden?\",\"breed\",\"thickness\",\"shape\",\"tie-mode\"" + ""))) diff --git a/src/main/nvm/topology.lisp b/src/main/nvm/topology.lisp new file mode 100644 index 0000000..d5fa64d --- /dev/null +++ b/src/main/nvm/topology.lisp @@ -0,0 +1,20 @@ +(in-package #:clnl-nvm) + +(defun wrap (pos min max) + (cond + ((>= pos max) (+ min (mod (- pos max) (- max min)))) + ((< pos min) + (let + ((res (- max (mod (- min pos) (- max min))))) + (if (< res max) res min))) ; If d is infinitesimal, may return max, which would be bad :( + (t pos))) + +(defgeneric wrap-x (topology x)) +(defgeneric wrap-y (topology y)) + +; Torus implementations +(defmethod wrap-x ((topology (eql :torus)) x) + (wrap x (- (min-pxcor) 0.5d0) (+ (max-pxcor) 0.5d0))) + +(defmethod wrap-y ((topology (eql :torus)) y) + (wrap y (- (min-pycor) 0.5d0) (+ (max-pycor) 0.5d0))) diff --git a/src/main/nvm/utils.lisp b/src/main/nvm/utils.lisp new file mode 100644 index 0000000..06941f5 --- /dev/null +++ b/src/main/nvm/utils.lisp @@ -0,0 +1,6 @@ +(in-package #:clnl-nvm) + +(defun min-pxcor () (getf (clnl-model:world-dimensions *model*) :xmin)) +(defun max-pxcor () (getf (clnl-model:world-dimensions *model*) :xmax)) +(defun min-pycor () (getf (clnl-model:world-dimensions *model*) :ymin)) +(defun max-pycor () (getf (clnl-model:world-dimensions *model*) :ymax)) diff --git a/src/main/package.lisp b/src/main/package.lisp index 73202aa..207fc87 100644 --- a/src/main/package.lisp +++ b/src/main/package.lisp @@ -91,7 +91,7 @@ a command line interface program with a view for display purposes only, this is where all the features that the traditional NetLogo UI lives.")) (defpackage #:clnl-model - (:use :common-lisp :cl-charms/low-level) + (:use :common-lisp) (:export #:default-model #:read-from-nlogo #:world-dimensions) (:documentation "CLNL Model diff --git a/src/test/clnl-test.asd b/src/test/clnl-test.asd index abb713d..8e0a9dd 100644 --- a/src/test/clnl-test.asd +++ b/src/test/clnl-test.asd @@ -1,10 +1,10 @@ (asdf:defsystem clnl-test - :name "Experiment Tests" - :maintainer "Frank Duncan (frank@kank.com)" - :author "Frank Duncan (frank@kank.com)" - :serial t - :components ((:file "package") - (:file "main") - (:file "simpletests") - (:file "viewtests")) - :depends-on (#-travis :ironclad :clnl)) + :name "Experiment Tests" + :maintainer "Frank Duncan (frank@kank.com)" + :author "Frank Duncan (frank@kank.com)" + :serial t + :components ((:file "package") + (:file "main") + (:file "simpletests") + (:file "viewtests")) + :depends-on (#-travis :ironclad :clnl)) diff --git a/src/test/simpletests.lisp b/src/test/simpletests.lisp index 68b460d..406df86 100644 --- a/src/test/simpletests.lisp +++ b/src/test/simpletests.lisp @@ -9,13 +9,23 @@ (defsimplecommandtest "Simple crt 2" "crt 5" "9FE588C2749CD9CE66CB0EA451EFB80476E881FB") +(defsimplecommandtest "Simple crt and fd random" "crt 30 ask turtles [ fd random-float 1 ]" + "DED34D1D6492244E9E3813DE8DBF258F96636879") + (defsimplecommandtest "Simple crt and fd" "crt 5 ask turtles [ fd 1 ]" "BEB43404EDC7852985A9A7FC312481785FE553A0") -(defsimplecommandtest "Simple crt and fd random" "crt 5 ask turtles [ fd random-float 1 ]" - "F7AC3B3492CDFD01D1FB5BD69FAAA67E06D3A870") -;(defsimplecommandtest "Simple crt and fd random 2" "crt 30 ask turtles [ fd random-float 1 ]" -; "F7AC3B3492CDFD01D1FB5BD69FAAA67E06D3A870") ; we start getting floating errors, cool! +(defsimplecommandtest "Wrapping 1" "crt 5 ask turtles [ fd 5 ]" + "1098A56973DA04E7AEA7659C40E3FF3EC7862B02") + +(defsimplecommandtest "Wrapping 2" "crt 5 ask turtles [ fd random-float 5 ]" + "1419DFA66EFB7F08FB30C7B63B256547212EB915") + +(defsimplecommandtest "Wrapping 3" "crt 10 ask turtles [ fd -5 ]" + "53E4ECBD3C49FC8D3466563641CFCD7DCB5CD2AF") + +(defsimplecommandtest "Wrapping 4" "crt 10 ask turtles [ fd random-float -5 ]" + "1258CE9CC93B52367E797F4C497BF95760EC7175") (defsimplereportertest "Random 1" "random-float 5" "4.244088516651127" "17D1BF7FF7BF2C7F3F5F7DD7CF67CFF2772CFFFC")