X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?p=clnl;a=blobdiff_plain;f=src%2Fmain%2Fnvm%2Futils.lisp;h=0a5f60486a61cee023770b7cddd5332d3e046b62;hp=06941f562ecc3bfb85b12ee2ad0d27253b88772d;hb=89cb3482de1fefc2d8e5f67e1e04a0790e8cd243;hpb=75a961089cba4b6aa4a3e947616ee4026ec3b057

diff --git a/src/main/nvm/utils.lisp b/src/main/nvm/utils.lisp
index 06941f5..0a5f604 100644
--- a/src/main/nvm/utils.lisp
+++ b/src/main/nvm/utils.lisp
@@ -1,6 +1,51 @@
 (in-package #:clnl-nvm)
 
-(defun min-pxcor () (getf (clnl-model:world-dimensions *model*) :xmin))
-(defun max-pxcor () (getf (clnl-model:world-dimensions *model*) :xmax))
-(defun min-pycor () (getf (clnl-model:world-dimensions *model*) :ymin))
-(defun max-pycor () (getf (clnl-model:world-dimensions *model*) :ymax))
+(defun min-pxcor () (getf *dimensions* :xmin))
+(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))))
+
+(defun patch-at (xcor ycor)
+ (flet
+  ((rnd (d) (truncate (if (< d 0) (- d 0.5d0) (+ d 0.5d0)))))
+  (or
+   (find-if
+    (lambda (patch)
+     (and (equalp (patch-xcor patch) (rnd xcor)) (equalp (patch-ycor patch) (rnd ycor))))
+    *patches*)
+   (error "This shouldn't be possible: ~S ~S ~S" (rnd xcor) (rnd ycor) *patches*))))
+
+(defmacro with-patch-update (turtle &rest forms)
+ (let
+  ((patch (gensym)) (new-patch (gensym)) (retn (gensym)))
+  `(let
+    ((,patch (patch-at (turtle-xcor ,turtle) (turtle-ycor ,turtle)))
+     (,retn (progn ,@forms)))
+    (let
+     ((,new-patch (patch-at (turtle-xcor ,turtle) (turtle-ycor ,turtle))))
+     (when (not (eql ,patch ,new-patch))
+      (setf (patch-turtles ,patch) (remove ,turtle (patch-turtles ,patch)))
+      (setf (patch-turtles ,new-patch) (nconc (patch-turtles ,new-patch) (list ,turtle))))
+     ,retn))))