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

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