From: Frank Duncan <frank@kank.net>
Date: Sun, 24 Apr 2016 06:14:04 +0000 (-0500)
Subject: Prims - Implement rt, lt
X-Git-Tag: v0.1.0~43
X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=commitdiff_plain;h=2c338ef0bdabd1e327bbf474221239c2eead88e4;p=clnl

Prims - Implement rt, lt
---

diff --git a/src/main/nvm/nvm.lisp b/src/main/nvm/nvm.lisp
index b7e0087..c5f0865 100644
--- a/src/main/nvm/nvm.lisp
+++ b/src/main/nvm/nvm.lisp
@@ -143,11 +143,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 +177,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
 
diff --git a/src/main/nvm/utils.lisp b/src/main/nvm/utils.lisp
index 22242f5..a656df3 100644
--- a/src/main/nvm/utils.lisp
+++ b/src/main/nvm/utils.lisp
@@ -4,3 +4,25 @@
 (defun max-pxcor () (getf *dimensions* :xmax))
 (defun min-pycor () (getf *dimensions* :ymin))
 (defun max-pycor () (getf *dimensions* :ymax))
+
+(defvar *cached-sins*
+ (loop
+  :for i :from 0 :to 360
+  :collect
+  (let
+   ((potential-sin (strictmath:sin (strictmath:to-radians i))))
+   (if (< (abs potential-sin) 3.2d-15) 0d0 potential-sin))))
+
+(defun using-cached-sin (n)
+ (if (= (floor n) n) (nth (floor n) *cached-sins*) (strictmath:sin (strictmath:to-radians n))))
+
+(defvar *cached-coses*
+ (loop
+  :for i :from 0 :to 360
+  :collect
+  (let
+   ((potential-cos (strictmath:cos (strictmath:to-radians i))))
+   (if (< (abs potential-cos) 3.2d-15) 0d0 potential-cos))))
+
+(defun using-cached-cos (n)
+ (if (= (floor n) n) (nth (floor n) *cached-coses*) (strictmath:cos (strictmath:to-radians n))))
diff --git a/src/main/package.lisp b/src/main/package.lisp
index 503af62..392d92b 100644
--- a/src/main/package.lisp
+++ b/src/main/package.lisp
@@ -72,7 +72,8 @@ into an ast that can be transpiled later."))
   #:forward
   #:random-float
   #:show
-  #:turtles)
+  #:turtles
+  #:turn-right #:turn-left)
  (:documentation
   "CLNL NVM
 
diff --git a/src/main/transpile.lisp b/src/main/transpile.lisp
index a7172fb..4a6a5a0 100644
--- a/src/main/transpile.lisp
+++ b/src/main/transpile.lisp
@@ -89,6 +89,8 @@ DESCRIPTION:
 (defsimpleprim :crt :command clnl-nvm:create-turtles)
 (defsimpleprim :die :command clnl-nvm:die)
 (defsimpleprim :fd :command clnl-nvm:forward)
+(defsimpleprim :lt :command clnl-nvm:turn-left)
 (defsimpleprim :random-float :reporter clnl-nvm:random-float)
+(defsimpleprim :rt :command clnl-nvm:turn-right)
 (defsimpleprim :show :command clnl-nvm:show)
 (defsimpleprim :turtles :reporter clnl-nvm:turtles)
diff --git a/src/test/simpletests.lisp b/src/test/simpletests.lisp
index 614c511..9feaf8d 100644
--- a/src/test/simpletests.lisp
+++ b/src/test/simpletests.lisp
@@ -107,3 +107,15 @@
 
 (defreportertestwithsetup "any? 3" "crt 10 ask turtles [ die ]" "any? turtles" "false"
  "A665C1BF95E1F9CAAE9B9F8B2FBE3DAA45453136")
+
+(defsimplecommandtest "rt 1" "crt 100 ask turtles [ fd random-float 5 rt random-float 180 fd random-float 4 ]"
+ "186B05DEFF6771BE791D54AB36A36874EC6E04FE")
+
+(defsimplecommandtest "rt 2" "crt 100 ask turtles [ fd random-float 5 rt random-float 1080 fd random-float 4 ]"
+ "154C05DF7810C0FF5D7DDE51B76E1012FFB2C0E1")
+
+(defsimplecommandtest "lt 1" "crt 100 ask turtles [ fd random-float 5 lt random-float 180 fd random-float 4 ]"
+ "D4B3844FE453C05E57537D6BA94C4B42C84655C6")
+
+(defsimplecommandtest "lt 2" "crt 100 ask turtles [ fd random-float 5 lt random-float 1080 fd random-float 4 ]"
+ "07DEB6F4F007DB86CD8F2C2E10BD4E35CAD2B0CE")
diff --git a/src/test/viewtests.lisp b/src/test/viewtests.lisp
index d3d45db..a5ccd6f 100644
--- a/src/test/viewtests.lisp
+++ b/src/test/viewtests.lisp
@@ -14,3 +14,9 @@
 
 (defviewtest "Die" "crt 10 ask turtles [ fd 1 ] ask turtles [ die ]"
  "1AF55686BD9B18D1CCE6AAF6BF18E81E6957F466")
+
+(defviewtest "rt" "crt 20 ask turtles [ fd 2 rt 100 fd 2 ]"
+ '("32CBE504D9BE79DD62163ECD684DAA54901C8DA2" "7DF601FF1857672EBFADC8414C0744AA2841E117"))
+
+(defviewtest "lt" "crt 20 ask turtles [ fd 2 lt 100 fd 2 ]"
+ '("B3DC43E676A804A5C42200E688D5AA6921DF95F2" "236B06E6383BC75B7C9E1E7BBF4B7D416AE72411"))