Prims - Implement patches, pcolor, set

diff --git a/src/main/nvm/agent.lisp b/src/main/nvm/agent.lisp
index 93da162c7c312a00346be2ae2c28d49947dc6b62..c52ca3a3dcb38f95d4ed56e14a27c309d9627781 100644 (file)
--- a/src/main/nvm/agent.lisp
+++ b/src/main/nvm/agent.lisp
@@ -19,6 +19,22 @@ DESCRIPTION:
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html for builtins"
  (agent-value-inner agent (intern (string-upcase var) :keyword)))
 
+(defsetf agent-value (var &optional (agent '*self*)) (new-value)
+ `(set-agent-value-inner ,agent ,var ,new-value))
+
+(defgeneric set-agent-value-inner (agent var new-value))
 (defgeneric agent-value-inner (agent var))
 
-(defmethod agent-value-inner ((agent turtle) (var (eql :who))) (turtle-who agent))
+(defmacro defagent-value (type symb &optional accessor)
+ (let
+  ((accessor (or accessor (intern (format nil "~A-~A" type symb))))
+   (agent (gensym))
+   (var (gensym))
+   (new-val (gensym)))
+  `(progn
+    (defmethod agent-value-inner ((,agent ,type) (,var (eql ,symb))) (,accessor ,agent))
+    (defmethod set-agent-value-inner ((,agent ,type) (,var (eql ,symb)) ,new-val) (setf (,accessor ,agent) ,new-val)))))
+
+(defagent-value turtle :who)
+
+(defagent-value patch :pcolor patch-color)

diff --git a/src/main/nvm/nvm.lisp b/src/main/nvm/nvm.lisp
index 482498c9a1d403029ae9da83cea5f6fb2da86355..ecbcfd9f492c0854e9626ebe264da05ca064fc87 100644 (file)
--- a/src/main/nvm/nvm.lisp
+++ b/src/main/nvm/nvm.lisp
@@ -85,6 +85,23 @@ DESCRIPTION:
  (setf (turtle-who *self*) -1)
  (setf *turtles* (remove *self* *turtles*)))
 
+(defun patches ()
+ "PATCHES => ALL-PATCHES
+
+ARGUMENTS AND VALUES:
+
+  ALL-PATCHES: a NetLogo agentset, all patches
+
+DESCRIPTION:
+
+  Reports the agentset consisting of all the patches.
+
+  This agentset is special in that it represents the living patches
+  each time it's used, so changes depending on the state of the engine.
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#patches"
+ *patches*)
+
 (defun turtles ()
  "TURTLES => ALL-TURTLES
 

diff --git a/src/main/package.lisp b/src/main/package.lisp
index 964001c62c46bd55a05516c9aab4de247383af56..bf12c26612a0df187131f47773c22d2ebd0c653e 100644 (file)
--- a/src/main/package.lisp
+++ b/src/main/package.lisp
@@ -73,6 +73,7 @@ into an ast that can be transpiled later."))
   #:of
   #:forward
   #:lookup-color
+  #:patches
   #:reset-ticks
   #:random-float
   #:show

diff --git a/src/main/transpile.lisp b/src/main/transpile.lisp
index 0227fe4144ea9394937f8bdd1e77a5309b667015..8364e58b0ba74baa9f20a945923d83400247f85e 100644 (file)
--- a/src/main/transpile.lisp
+++ b/src/main/transpile.lisp
@@ -105,9 +105,9 @@ DESCRIPTION:
  `(lambda () ,@(transpile-commands-inner (cdr block))))
 
 (defun transpile-reporter-block (block)
- ;(when (/= (length block) 1) (error "Reporter block invalid ~S" block))
+ (when (/= (length block) 2) (error "Reporter block invalid ~S" block))
  `(lambda ()
-   ,@(transpile-reporter (cadr block))))
+   ,(transpile-reporter (cadr block))))
 
 ; Undoes the previous function :)
 (defun make-command-block-inline (block)
@@ -126,7 +126,7 @@ DESCRIPTION:
  `(push (list :name ,name :real-symb ,real-symb) *prim-aliases*))
 
 (defmacro defagentvalueprim (name)
- `(defsimpleprim ,name :reporter (clnl-nvm:agent-value ,name)))
+ `(defprim ,name :reporter (lambda () `(clnl-nvm:agent-value ,,name))))
 
 ; We count on the parser to handle arguemnts for us, when collating things.
 
@@ -153,10 +153,13 @@ DESCRIPTION:
 (defsimpleprim :lt :command clnl-nvm:turn-left)
 (defkeywordprim :nobody)
 (defsimpleprim :of :reporter clnl-nvm:of)
+(defsimpleprim :patches :reporter clnl-nvm:patches)
+(defagentvalueprim :pcolor)
 (defsimpleprim :reset-ticks :command clnl-nvm:reset-ticks)
 (defsimpleprim :random-float :reporter clnl-nvm:random-float)
 (defsimpleprim :rt :command clnl-nvm:turn-right)
 (defsimpleprim :show :command clnl-nvm:show)
+(defsimpleprim :set :command cl:setf)
 (defsimpleprim :tick :command clnl-nvm:tick)
 (defsimpleprim :ticks :reporter clnl-nvm:ticks)
 (defsimpleprim :turtles :reporter clnl-nvm:turtles)

diff --git a/src/test/simpletests.lisp b/src/test/simpletests.lisp
index 5bdb498e337a355b090c702a86f4e81f640e486d..0c571e890a66b2f0a60c33a899cd894e8a1dcf9b 100644 (file)
--- a/src/test/simpletests.lisp
+++ b/src/test/simpletests.lisp
@@ -152,3 +152,7 @@
 
 (defreportertestwithsetup "of / who 1" "crt 10" "[ who ] of turtles" "[5 9 4 3 7 0 1 2 6 8]"
  "3F39BD2D8D5A1B2333E6C0DB665DBE3DCD5A75CE")
+
+(defreportertestwithsetup "set / pcolor" "ask patches [ set pcolor green ]" "[ pcolor ] of patches"
+ "[55 55 55 55 55 55 55 55 55]"
+ "3E246C518581E004BC65EFB074A09BA2EEBB2910")

diff --git a/src/test/viewtests.lisp b/src/test/viewtests.lisp
index 630280c81f23787cceab29d6298e97c959ee8b2a..ac39a155fbbaac72d5b7318aef9dc2d207e17448 100644 (file)
--- a/src/test/viewtests.lisp
+++ b/src/test/viewtests.lisp
@@ -20,3 +20,6 @@
 
 (defviewtest "lt" "crt 20 ask turtles [ fd 2 lt 100 fd 2 ]"
  '("BF49775097BBFAE12E42D6F13FAFC93090B7ACAC" "ABAEAF8DDD68E7F0FED6CB243F27DB312588A1E8"))
+
+(defviewtest "pcolor green" "ask patches [ set pcolor green ]"
+ "90F5F4870955B9FF02224F00E3C9814B8A6F766E")