Prims - Implement colors, nobody

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

diff --git a/src/main/nvm/nvm.lisp b/src/main/nvm/nvm.lisp
index b7e0087634c49ed84323f99217cfc46861b390ed..47f5467ac35ece66adf49521293d0ba2a08f8ee7 100644 (file)
--- a/src/main/nvm/nvm.lisp
+++ b/src/main/nvm/nvm.lisp
@@ -17,6 +17,37 @@ DESCRIPTION:
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#show"
  (format t "Showing: ~A~%" (dump-object value)))
 
+(defun lookup-color (color)
+ "LOOKUP-COLOR COLOR => COLOR-NUMBER
+
+ARGUMENTS AND VALUES:
+
+  COLOR: a symbol representing a color
+  COLOR-NUMBER: the NetLogo color integer
+
+DESCRIPTION:
+
+  Returns the number used to represent colors in NetLogo.
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#Constants"
+ (case color
+  (:black 0d0)
+  (:gray 5d0)
+  (:white 9.9d0)
+  (:red 15d0)
+  (:orange 25d0)
+  (:brown 35d0)
+  (:yellow 45d0)
+  (:green 55d0)
+  (:lime 65d0)
+  (:turquoise 75d0)
+  (:cyan 85d0)
+  (:sky 95d0)
+  (:blue 105d0)
+  (:violet 115d0)
+  (:magenta 125d0)
+  (:pink 135d0)))
+
 (defun create-turtle ()
  (setf
   *turtles*
@@ -143,11 +174,11 @@ DESCRIPTION:
  (setf
   (turtle-xcor *self*)
   (wrap-x *topology*
-   (+ (turtle-xcor *self*) (* n (strictmath:sin (strictmath:to-radians (turtle-heading *self*)))))))
+   (+ (turtle-xcor *self*) (* n (using-cached-sin (turtle-heading *self*))))))
  (setf
   (turtle-ycor *self*)
   (wrap-y *topology*
-   (+ (turtle-ycor *self*) (* n (strictmath:cos (strictmath:to-radians (turtle-heading *self*))))))))
+   (+ (turtle-ycor *self*) (* n (using-cached-cos (turtle-heading *self*)))))))
 
 (defun forward (n)
  "FORWARD N => RESULT
@@ -177,6 +208,43 @@ DESCRIPTION:
      (t (jump (if (> i 0d0) 1d0 -1d0)) (internal (- i (if (> i 0d0) 1d0 -1d0)))))))
   (internal n)))
 
+(defun turn-right (n)
+ "TURN-RIGHT N => RESULT
+
+ARGUMENTS AND VALUES:
+
+  N: a double, the amount the turtle turns
+  RESULT: undefined
+
+DESCRIPTION:
+
+  The turtle turns right by number degrees. (If number is negative, it turns left.)
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#right"
+ (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude (~A)" *self*))
+ (let
+  ((new-heading (+ (turtle-heading *self*) n)))
+  (setf (turtle-heading *self*)
+   (cond
+    ((< new-heading 0) (+ (mod new-heading -360) 360))
+    ((>= new-heading 360) (mod new-heading 360))
+    (t new-heading)))))
+
+(defun turn-left (n)
+ "TURN-LEFT N => RESULT
+
+ARGUMENTS AND VALUES:
+
+  N: a double, the amount the turtle turns
+  RESULT: undefined
+
+DESCRIPTION:
+
+  The turtle turns left by number degrees. (If number is negative, it turns right.)
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#right"
+ (turn-right (- n)))
+
 (defun create-turtles (n)
  "CREATE-TURTLES N => RESULT