1 (in-package #:clnl-nvm)
3 (defun create-turtles (n &optional breed fn)
4 "CREATE-TURTLES N &optional BREED FN => RESULT
8 N: an integer, the numbers of turtles to create
10 FN: A function, applied to each turtle after creation
15 Creates N new turtles at the origin.
17 New turtles have random integer headings and the color is randomly selected
18 from the 14 primary colors. If FN is supplied, the new turtles immediately
19 run it. If a BREED is supplied, that is the breed the new turtles are set
22 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles"
24 ((new-turtles (loop :repeat n :collect (create-turtle breed))))
25 (when fn (ask (list->agentset new-turtles :turtles) fn))))
32 RESULT: undefined, commands don't return
36 The turtle or link dies
38 A dead agent ceases to exist. The effects of this include:
39 - The agent will not execute any further code.
40 - The agent will disappear from any agentsets it was in, reducing the size of those agentsets by one.
41 - Any variable that was storing the agent will now instead have nobody in it.
42 - If the dead agent was a turtle, every link connected to it also dies.
43 - If the observer was watching or following the agent, the observer's perspective resets.
45 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#die"
46 (when (not (turtle-p *self*)) (error "Gotta call die in turtle scope, dude (~A)" *self*))
47 (setf (turtle-who *self*) -1)
48 (setf *turtles* (remove *self* *turtles*))
50 ((patch (patch-at (turtle-xcor *self*) (turtle-ycor *self*))))
51 (setf (patch-turtles patch) (remove *self* (patch-turtles patch))))
52 (error (make-condition 'death)))
54 (defun hatch (n &optional fn)
55 "HATCH N &optional FN => RESULT
59 N: an integer, the numbers of turtles to hatch
60 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))))
81 N: a double, the amount the turtle moves forward
86 Moves the current turtle forward N steps, one step at a time.
88 This moves forward one at a time in order to make the view updates look
89 good in the case of a purposefully slow running instance. If the number
90 is negative, the turtle moves backward.
92 If the current agent is not a turtle, it raises an error.
94 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#forward"
95 (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude (~A)" *self*))
99 ((< (abs i) 3.2e-15) nil)
100 ((< (abs i) 1d0) (jump i))
101 (t (jump (if (> i 0d0) 1d0 -1d0)) (internal (- i (if (> i 0d0) 1d0 -1d0)))))))
105 (when (not (turtle-p *self*)) (error "Gotta call jump in turtle scope, dude (~A)" *self*))
106 (with-patch-update *self*
110 (+ (turtle-xcor *self*) (* n (using-cached-sin (turtle-heading *self*))))))
114 (+ (turtle-ycor *self*) (* n (using-cached-cos (turtle-heading *self*))))))))
116 (defun random-xcor ()
117 "RANDOM-XCOR => RANDOM-NUMBER
119 ARGUMENTS AND VALUES:
121 RANDOM-NUMBER: a float, the random result
125 Returns a random floating point number in the allowable range of turtle
126 coordinates along the x axis.
128 These range from min-pxcor - 0.5 (inclusive) to max-pxcor + 0.5 (exclusive)
130 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-cor"
132 ((min (- (min-pxcor) 0.5d0))
133 (max (+ (max-pxcor) 0.5d0)))
134 (+ min (clnl-random:next-double (- max min)))))
136 (defun random-ycor ()
137 "RANDOM-YCOR => RANDOM-NUMBER
139 ARGUMENTS AND VALUES:
141 RANDOM-NUMBER: a float, the random result
145 Returns a random floating point number in the allowable range of turtle
146 coordinates along the y axis.
148 These range from min-pycor - 0.5 (inclusive) to max-pycor + 0.5 (exclusive)
150 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-cor"
152 ((min (- (min-pycor) 0.5d0))
153 (max (+ (max-pycor) 0.5d0)))
154 (+ min (clnl-random:next-double (- max min)))))
156 (defun set-default-shape (breed shape)
157 "SET-DEFAULT-SHAPE BREED SHAPE => RESULT
159 ARGUMENTS AND VALUES:
167 Specifies a default initial shape for a BREED. When a turtle, or it changes breeds,
168 its shape is set to the given shape.
170 SET-DEFAULT-SHAPE doesn't affect existing agents, only agents you create afterwards.
172 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#set-default-shape"
173 (when (not (breed-p breed)) (error "Need a valid breed"))
174 (setf (breed-default-shape breed) shape))
179 ARGUMENTS AND VALUES:
187 Sets the x-coordinate and y-coordinate for the turle. Equivalent to
188 set xcor x set ycor y, except it happens in one step inside of two.
190 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#setxy"
191 (when (not (turtle-p *self*)) (error "Gotta call setxy in turtle scope, dude (~A)" *self*))
192 (setf (turtle-xcor *self*) (wrap-x *topology* x))
193 (setf (turtle-ycor *self*) (wrap-y *topology* y)))
195 (defun turtles-here (&optional breed)
196 "TURTLES-HERE => TURTLES
198 ARGUMENTS AND VALUES:
204 Returns the agentset consisting of all the turtles sharing the patch
205 with the agent in by *self*
207 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtles-here"
208 (when (not (turtle-p *self*)) (error "Gotta call turtles-here with a turtle"))
210 ((patch-turtles (patch-turtles (patch-at (turtle-xcor *self*) (turtle-ycor *self*)))))
212 (if breed (remove breed patch-turtles :key #'turtle-breed :test-not #'eql) patch-turtles)
213 (or breed :turtles))))
215 (defun turn-right (n)
216 "TURN-RIGHT N => RESULT
218 ARGUMENTS AND VALUES:
220 N: a double, the amount the turtle turns
225 The turtle turns right by number degrees. (If number is negative, it turns left.)
227 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#right"
228 (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude (~A)" *self*))
230 ((new-heading (+ (turtle-heading *self*) n)))
231 (setf (turtle-heading *self*)
233 ((< new-heading 0) (+ (mod new-heading -360) 360))
234 ((>= new-heading 360) (mod new-heading 360))
238 "TURN-LEFT N => RESULT
240 ARGUMENTS AND VALUES:
242 N: a double, the amount the turtle turns
247 The turtle turns left by number degrees. (If number is negative, it turns right.)
249 See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#right"