From: Frank Duncan Date: Sun, 1 May 2016 19:39:11 +0000 (-0500) Subject: Prims - Implement clear-all, ca X-Git-Tag: v0.1.0~23 X-Git-Url: https://code.consxy.com/gitweb/?a=commitdiff_plain;h=7a82368afef8428c46d83d7afce51532cb7eb855;p=clnl Prims - Implement clear-all, ca --- diff --git a/src/main/nvm/nvm.lisp b/src/main/nvm/nvm.lisp index 3c7c6d6..c98616a 100644 --- a/src/main/nvm/nvm.lisp +++ b/src/main/nvm/nvm.lisp @@ -172,6 +172,22 @@ DESCRIPTION: See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#count" (coerce (length (agentset-list agentset)) 'double-float)) +(defun clear-all () + "CLEAR-ALL => RESULT + +ARGUMENTS AND VALUES: + + RESULT: undefined + +DESCRIPTION: + + Clears ticks, turtles, patches, globals (unimplemented). + + See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#clear-all" + (clear-turtles) + (clear-patches) + (clear-ticks)) + (defun of (fn agent-or-agentset) "OF FN AGENT-OR-AGENTSET => RESULT @@ -581,6 +597,25 @@ DESCRIPTION: (when (not *ticks*) (error "reset-ticks must be called")) *ticks*) +(defun clear-patches () + (setf + *patches* + (loop + :for y :from (max-pycor) :downto (min-pycor) + :append (loop + :for x :from (min-pxcor) :to (max-pxcor) + :collect (make-patch + :xcor (coerce x 'double-float) + :ycor (coerce y 'double-float) + :color 0d0))))) + +(defun clear-turtles () + (setf *turtles* nil) + (setf *current-id* 0)) + +(defun clear-ticks () + (setf *ticks* nil)) + (defun create-world (&key dims) "CREATE-WORLD &key DIMS => RESULT @@ -602,18 +637,9 @@ DESCRIPTION: called when an engine is already running, it may do somethign weird." (setf *dimensions* dims) (setf *breeds* (list (list :turtles "default"))) - (setf - *patches* - (loop - :for y :from (max-pycor) :downto (min-pycor) - :append (loop - :for x :from (min-pxcor) :to (max-pxcor) - :collect (make-patch - :xcor (coerce x 'double-float) - :ycor (coerce y 'double-float) - :color 0d0)))) - (setf *turtles* nil) - (setf *current-id* 0)) + (clear-ticks) + (clear-patches) + (clear-turtles)) ; These match netlogo's dump (defgeneric dump-object (o)) diff --git a/src/main/package.lisp b/src/main/package.lisp index b1c4a27..f1f5392 100644 --- a/src/main/package.lisp +++ b/src/main/package.lisp @@ -69,6 +69,7 @@ into an ast that can be transpiled later.")) ; API as used by transpiled NetLogo programs #:agent-value #:ask + #:clear-all #:count #:create-turtles #:die diff --git a/src/main/parse.lisp b/src/main/parse.lisp index 957d177..914e0dc 100644 --- a/src/main/parse.lisp +++ b/src/main/parse.lisp @@ -246,6 +246,7 @@ DESCRIPTION: (defprim :<= (:number :number) :infix) (defprim :any? (:agentset)) (defprim :ask (:agentset :command-block)) +(defprim :ca ()) (defprim :clear-all ()) (defprim :crt (:number (:command-block :optional))) (defprim :color ()) diff --git a/src/main/transpile.lisp b/src/main/transpile.lisp index c2a2087..554e0cd 100644 --- a/src/main/transpile.lisp +++ b/src/main/transpile.lisp @@ -13,9 +13,9 @@ (defun find-prim (symb) (when symb - (or - (find symb *prims* :key #'prim-name) - (find-prim (getf (find symb *prim-aliases* :key #'prim-name) :real-symb))))) + (find-if + (lambda (prim-name) (or (eql symb prim-name) (and (listp prim-name) (find symb prim-name)))) + *prims* :key #'prim-name))) ; Let this grow, slowly but surely, eventually taking on calling context, etc. ; For now, it's just a @@ -143,18 +143,19 @@ DESCRIPTION: (defprim :any? :reporter (lambda (agentset) `(> (clnl-nvm:count ,agentset) 0))) (defsimpleprim :ask :command clnl-nvm:ask) (defagentvalueprim :color) +(defsimpleprim '(:clear-all :ca) :command clnl-nvm:clear-all) (defsimpleprim :count :reporter clnl-nvm:count) (defsimpleprim :crt :command clnl-nvm:create-turtles) (defsimpleprim :die :command clnl-nvm:die) (defsimpleprim :fd :command clnl-nvm:forward) (defsimpleprim :hatch :command clnl-nvm:hatch) (defprim :if :command (lambda (pred a) `(when ,pred ,@(make-command-block-inline a)))) -(defprim :ifelse :command (lambda (pred a b) - `(if ,pred - ,@(make-command-block-inline a) - ,@(make-command-block-inline b)))) +(defprim '(:ifelse :if-else) + :command (lambda (pred a b) + `(if ,pred + ,@(make-command-block-inline a) + ,@(make-command-block-inline b)))) -(defprim-alias :if-else :ifelse) (defagentvalueprim :label) (defagentvalueprim :label-color) (defsimpleprim :lt :command clnl-nvm:turn-left) diff --git a/src/test/simpletests.lisp b/src/test/simpletests.lisp index f4ac4f9..d85675d 100644 --- a/src/test/simpletests.lisp +++ b/src/test/simpletests.lisp @@ -250,3 +250,6 @@ (defsimplereportertest "round 3" "round 2.5" "3" "E1DE30F072D785E0D0B59F28B0F7853E3D3E0D8B") + +(defsimplecommandtest "clear-all 1" "crt 10 ask patches [ set pcolor random 100 ] clear-all" + "7B5DF28923D7FD72158018A876DE8ED02CFB0882")