1 (in-package #:clnl-nvm)
3 (defcommand create-turtles (n &optional breed fn)
4 "CREATE-TURTLES N &optional BREED FN => RESULT
10 N: an integer, the numbers of turtles to create
12 FN: A function, applied to each turtle after creation
16 Creates N new turtles at the origin.
18 New turtles have random integer headings and the color is randomly selected
19 from the 14 primary colors. If FN is supplied, the new turtles immediately
20 run it. If a BREED is supplied, that is the breed the new turtles are set
23 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles"
25 ((new-turtles (loop :repeat n :collect (create-turtle breed))))
26 (when fn (ask (list->agentset new-turtles :turtles) fn))))
35 The turtle or link dies
37 A dead agent ceases to exist. The effects of this include:
38 - The agent will not execute any further code.
39 - The agent will disappear from any agentsets it was in, reducing the size of those agentsets by one.
40 - Any variable that was storing the agent will now instead have nobody in it.
41 - If the dead agent was a turtle, every link connected to it also dies.
42 - If the observer was watching or following the agent, the observer's perspective resets.
44 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#die"
45 (when (not (turtle-p *self*)) (error "Gotta call die in turtle scope, dude (~A)" *self*))
46 (setf (turtle-who *self*) -1)
47 (setf *turtles* (remove *self* *turtles*))
49 ((patch (patch-at (turtle-xcor *self*) (turtle-ycor *self*))))
50 (setf (patch-turtles patch) (remove *self* (patch-turtles patch))))
51 (error (make-condition 'death)))
53 (defcommand hatch (n &optional fn)
54 "HATCH N &optional FN => RESULT
60 N: an integer, the numbers of turtles to hatch
61 FN: A function, applied to each turtle after creation
65 The turtle in *self* creates N new turtles. Each new turtle inherits of all its
66 variables, including its location, from self.
68 If FN is supplied, the new turtles immediately run it.
70 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#hatch"
71 (when (not (turtle-p *self*)) (error "Can only hatch from turtle scope"))
73 ((new-turtles (loop :repeat n :collect (create-turtle nil *self*))))
74 (when fn (ask (list->agentset new-turtles :turtles) fn))))
76 (defcommand forward (n)
83 N: a double, the amount the turtle moves forward
87 Moves the current turtle forward N steps, one step at a time.
89 This moves forward one at a time in order to make the view updates look
90 good in the case of a purposefully slow running instance. If the number
91 is negative, the turtle moves backward.
93 If the current agent is not a turtle, it raises an error.
95 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#forward"
96 (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude (~A)" *self*))
100 ((< (abs i) 3.2e-15) nil)
101 ((< (abs i) 1d0) (jump i))
102 (t (jump (if (> i 0d0) 1d0 -1d0)) (internal (- i (if (> i 0d0) 1d0 -1d0)))))))
106 (when (not (turtle-p *self*)) (error "Gotta call jump in turtle scope, dude (~A)" *self*))
107 (with-patch-update *self*
111 (+ (turtle-xcor *self*) (* n (using-cached-sin (turtle-heading *self*))))))
115 (+ (turtle-ycor *self*) (* n (using-cached-cos (turtle-heading *self*))))))))
117 (defun random-xcor ()
118 "RANDOM-XCOR => RANDOM-NUMBER
120 ARGUMENTS AND VALUES:
122 RANDOM-NUMBER: a float, the random result
126 Returns a random floating point number in the allowable range of turtle
127 coordinates along the x axis.
129 These range from min-pxcor - 0.5 (inclusive) to max-pxcor + 0.5 (exclusive)
131 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-cor"
133 ((min (- (min-pxcor) 0.5d0))
134 (max (+ (max-pxcor) 0.5d0)))
135 (+ min (clnl-random:next-double (- max min)))))
137 (defun random-ycor ()
138 "RANDOM-YCOR => RANDOM-NUMBER
140 ARGUMENTS AND VALUES:
142 RANDOM-NUMBER: a float, the random result
146 Returns a random floating point number in the allowable range of turtle
147 coordinates along the y axis.
149 These range from min-pycor - 0.5 (inclusive) to max-pycor + 0.5 (exclusive)
151 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-cor"
153 ((min (- (min-pycor) 0.5d0))
154 (max (+ (max-pycor) 0.5d0)))
155 (+ min (clnl-random:next-double (- max min)))))
157 (defcommand set-default-shape (breed shape)
158 "SET-DEFAULT-SHAPE BREED SHAPE => RESULT
162 ARGUMENTS AND VALUES:
169 Specifies a default initial shape for a BREED. When a turtle, or it changes breeds,
170 its shape is set to the given shape.
172 SET-DEFAULT-SHAPE doesn't affect existing agents, only agents you create afterwards.
174 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#set-default-shape"
175 (when (not (breed-p breed)) (error "Need a valid breed"))
176 (setf (breed-default-shape breed) shape))
178 (defcommand setxy (x y)
183 ARGUMENTS AND VALUES:
190 Sets the x-coordinate and y-coordinate for the turle. Equivalent to
191 set xcor x set ycor y, except it happens in one step inside of two.
193 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#setxy"
194 (when (not (turtle-p *self*)) (error "Gotta call setxy in turtle scope, dude (~A)" *self*))
195 (setf (turtle-xcor *self*) (wrap-x *topology* x))
196 (setf (turtle-ycor *self*) (wrap-y *topology* y)))
198 (defun turtles-here (&optional breed)
199 "TURTLES-HERE => TURTLES
201 ARGUMENTS AND VALUES:
207 Returns the agentset consisting of all the turtles sharing the patch
208 with the agent in by *self*
210 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtles-here"
211 (when (not (turtle-p *self*)) (error "Gotta call turtles-here with a turtle"))
213 ((patch-turtles (patch-turtles (patch-at (turtle-xcor *self*) (turtle-ycor *self*)))))
215 (if breed (remove breed patch-turtles :key #'turtle-breed :test-not #'eql) patch-turtles)
216 (or breed :turtles))))
218 (defcommand turn-right (n)
219 "TURN-RIGHT N => RESULT
223 ARGUMENTS AND VALUES:
225 N: a double, the amount the turtle turns
229 The turtle turns right by number degrees. (If number is negative, it turns left.)
231 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#right"
232 (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude (~A)" *self*))
234 ((new-heading (+ (turtle-heading *self*) n)))
235 (setf (turtle-heading *self*)
237 ((< new-heading 0) (+ (mod new-heading -360) 360))
238 ((>= new-heading 360) (mod new-heading 360))
241 (defcommand turn-left (n)
242 "TURN-LEFT N => RESULT
246 ARGUMENTS AND VALUES:
248 N: a double, the amount the turtle turns
252 The turtle turns left by number degrees. (If number is negative, it turns right.)
254 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#right"