code.consxy.com Git - clnl/blob - src/main/nvm/utils.lisp

   1 (in-package #:clnl-nvm)
   2
   3 (defun min-pxcor () (getf *dimensions* :xmin))
   4 (defun max-pxcor () (getf *dimensions* :xmax))
   5 (defun min-pycor () (getf *dimensions* :ymin))
   6 (defun max-pycor () (getf *dimensions* :ymax))
   7
   8 (defvar *cached-sins*
   9  (loop
  10   :for i :from 0 :to 360
  11   :collect
  12   (let
  13    ((potential-sin (strictmath:sin (strictmath:to-radians i))))
  14    (if (< (abs potential-sin) 3.2d-15) 0d0 potential-sin))))
  15
  16 (defun using-cached-sin (n)
  17  (if (= (floor n) n) (nth (floor n) *cached-sins*) (strictmath:sin (strictmath:to-radians n))))
  18
  19 (defvar *cached-coses*
  20  (loop
  21   :for i :from 0 :to 360
  22   :collect
  23   (let
  24    ((potential-cos (strictmath:cos (strictmath:to-radians i))))
  25    (if (< (abs potential-cos) 3.2d-15) 0d0 potential-cos))))
  26
  27 (defun using-cached-cos (n)
  28  (if (= (floor n) n) (nth (floor n) *cached-coses*) (strictmath:cos (strictmath:to-radians n))))
  29
  30 (defun patch-at (xcor ycor)
  31  (flet
  32   ((rnd (d) (truncate (if (< d 0) (- d 0.5d0) (+ d 0.5d0)))))
  33   (or
  34    (find-if
  35     (lambda (patch)
  36      (and (equalp (patch-xcor patch) (rnd xcor)) (equalp (patch-ycor patch) (rnd ycor))))
  37     *patches*)
  38    (error "This shouldn't be possible: ~S ~S ~S" (rnd xcor) (rnd ycor) *patches*))))
  39
  40 (defmacro with-patch-update (turtle &rest forms)
  41  (let
  42   ((patch (gensym)) (new-patch (gensym)) (retn (gensym)))
  43   `(let
  44     ((,patch (patch-at (turtle-xcor ,turtle) (turtle-ycor ,turtle)))
  45      (,retn (progn ,@forms)))
  46     (let
  47      ((,new-patch (patch-at (turtle-xcor ,turtle) (turtle-ycor ,turtle))))
  48      (when (not (eql ,patch ,new-patch))
  49       (setf (patch-turtles ,patch) (remove ,turtle (patch-turtles ,patch)))
  50       (setf (patch-turtles ,new-patch) (nconc (patch-turtles ,new-patch) (list ,turtle))))
  51      ,retn))))