From: Frank Duncan <frank@kank.net>
Date: Fri, 29 Apr 2016 13:52:40 +0000 (-0500)
Subject: Prims - Implement patches, pcolor, set
X-Git-Tag: v0.1.0~36
X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=commitdiff_plain;h=f00d5c7;p=clnl

Prims - Implement patches, pcolor, set
---

diff --git a/src/main/nvm/agent.lisp b/src/main/nvm/agent.lisp
index 93da162..c52ca3a 100644
--- 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 482498c..ecbcfd9 100644
--- 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 964001c..bf12c26 100644
--- 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 0227fe4..8364e58 100644
--- 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 5bdb498..0c571e8 100644
--- 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 630280c..ac39a15 100644
--- 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")