(:magenta 125d0)
(:pink 135d0)))
-(defun create-turtle ()
+(defun create-turtle (&optional base-turtle)
(let
((new-turtle (make-turtle
:who (coerce *current-id* 'double-float)
- :color (coerce (+ 5 (* 10 (clnl-random:next-int 14))) 'double-float)
- :heading (coerce (clnl-random:next-int 360) 'double-float)
- :xcor 0d0
- :ycor 0d0)))
+ :color (if base-turtle
+ (turtle-color base-turtle)
+ (coerce (+ 5 (* 10 (clnl-random:next-int 14))) 'double-float))
+ :heading (if base-turtle
+ (turtle-heading base-turtle)
+ (coerce (clnl-random:next-int 360) 'double-float))
+ :shape (breed-default-shape :turtles)
+ :xcor (if base-turtle (turtle-xcor base-turtle) 0d0)
+ :ycor (if base-turtle (turtle-ycor base-turtle) 0d0))))
(setf *turtles* (nconc *turtles* (list new-turtle)))
(incf *current-id*)
new-turtle))
(setf (turtle-xcor *self*) (wrap-x *topology* x))
(setf (turtle-ycor *self*) (wrap-y *topology* y)))
+(defun set-default-shape (breed shape)
+ "SET-DEFAULT-SHAPE BREED SHAPE => RESULT
+
+ARGUMENTS AND VALUES:
+
+ BREED: a valid breed
+ SHAPE: a string
+ RESULT: undefined
+
+DESCRIPTION:
+
+ Specifies a default initial shape for a BREED. When a turtle, or it changes breeds,
+ its shape is set to the given shape.
+
+ SET-DEFAULT-SHAPE doesn't affect existing agents, only agents you create afterwards.
+
+ See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#set-default-shape"
+ (when (not (breed-p breed)) (error "Need a valid breed"))
+ (setf (breed-default-shape breed) shape))
+
(defun forward (n)
"FORWARD N => RESULT
((new-turtles (loop :repeat n :collect (create-turtle))))
(when fn (ask (list->agentset new-turtles :turtles) fn))))
+(defun hatch (n &optional fn)
+ "HATCH N &optional FN => RESULT
+
+ARGUMENTS AND VALUES:
+
+ N: an integer, the numbers of turtles to hatch
+ FN: A function, applied to each turtle after creation
+ RESULT: undefined
+
+DESCRIPTION:
+
+ The turtle in *self* creates N new turtles. Each new turtle inherits of all its
+ variables, including its location, from self.
+
+ If FN is supplied, the new turtles immediately run it.
+
+ See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#hatch"
+ (when (not (turtle-p *self*)) (error "Can only hatch from turtle scope"))
+ (let
+ ((new-turtles (loop :repeat n :collect (create-turtle *self*))))
+ (when fn (ask (list->agentset new-turtles :turtles) fn))))
+
(defun reset-ticks ()
"RESET-TICKS => RESULT
This should be called before using the engine in any real capacity. If
called when an engine is already running, it may do somethign weird."
(setf *dimensions* dims)
+ (setf *breeds* (list (list :turtles "default")))
(setf
*patches*
(loop
(mapcar
(lambda (turtle)
(format nil
- "\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"\"\"default\"\"\",\"~A\",\"~A\",\"{all-turtles}\",\"false\",\"~A\",~A"
+ "\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"{all-turtles}\",\"false\",\"~A\",~A"
(dump-object (turtle-who turtle))
(dump-object (turtle-color turtle))
(dump-object (turtle-heading turtle))
(dump-object (turtle-xcor turtle))
(dump-object (turtle-ycor turtle))
+ (dump-object (turtle-shape turtle))
(dump-object (turtle-label turtle))
(dump-object (turtle-label-color turtle))
(dump-object (turtle-size turtle))