Move from github, collapse gltk and strictmath, add candle

[clnl] / src / main / clnl / nvm / controlflow.lisp

diff --git a/src/main/clnl/nvm/controlflow.lisp b/src/main/clnl/nvm/controlflow.lisp
new file mode 100644 (file)
index 0000000..b4368fd
--- /dev/null
+++ b/src/main/clnl/nvm/controlflow.lisp
@@ -0,0 +1,50 @@
+(in-package #:clnl-nvm)
+
+(defcommand ask (agent-or-agentset fn)
+ "ASK AGENT-OR-AGENTSET FN => RESULT
+
+  AGENT-OR-AGENTSET: AGENT | AGENTSET
+  RESULT: :undefined
+
+ARGUMENTS AND VALUES:
+
+  FN: a function, run on each agent
+  AGENT: a NetLogo agent
+  AGENTSET: a NetLogo agentset
+
+DESCRIPTION:
+
+  ASK is equivalent to ask in NetLogo.
+
+  The specified AGENTSET or AGENT runs the given FN.  In the case of an
+  AGENTSET, 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"
+ (cond
+  ((agentset-p agent-or-agentset)
+   (let
+    ((iter (shufflerator (agentset-list agent-or-agentset))))
+    (loop
+     :for agent := (funcall iter)
+     :while agent
+     :do (when (not (and (turtle-p agent) (= -1 (turtle-who agent))))
+          (let ((*myself* *self*) (*self* agent)) (with-stop-and-death-handler (funcall fn)))))))
+  ((agent-p agent-or-agentset)
+   (let ((*myself* *self*) (*self* agent-or-agentset)) (with-stop-and-death-handler (funcall fn))))
+  (t
+   (error "Ask requires an agentset or agent but got: ~A" agent-or-agentset))))
+
+(defcommand stop ()
+ "STOP => RESULT
+
+  RESULT: :undefined
+
+DESCRIPTION:
+
+  Returns from the current stop block, which will halt the currently running
+  thing, be that the program, current ask block, or procedure.  Stop has odd
+  semantics that are best gleaned from the actual NetLogo manual.
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#stop"
+ (error (make-condition 'stop)))