28dc985f4d51

Update cl-losh
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Mon, 15 Aug 2016 22:22:59 +0000
parents c72435d307d7
children b9ba5d3627e3
branches/tags (none)
files package.lisp src/2d/demo.lisp src/2d/particles.lisp src/math.lisp src/utils.lisp

Changes

--- a/package.lisp	Sun Aug 14 22:37:23 2016 +0000
+++ b/package.lisp	Mon Aug 15 22:22:59 2016 +0000
@@ -9,7 +9,6 @@
   (:shadowing-import-from #:iterate
     #:in)
   (:export
-    #:define-with-macro
     #:in-context
     #:scancode-case
     #:with-vals
@@ -28,19 +27,10 @@
     #:coding-math.quickutils
     #:coding-math.utils)
   (:export
-    #:tau
-    #:mulf
-    #:dividesp
-    #:square
     #:distance
     #:random-range
     #:random-around
     #:random-dist
-    #:norm
-    #:lerp
-    #:precise-lerp
-    #:map-range
-    #:clamp
     #:wrap-zero
     #:wrap-range
     #:wrapf
--- a/src/2d/demo.lisp	Sun Aug 14 22:37:23 2016 +0000
+++ b/src/2d/demo.lisp	Mon Aug 15 22:22:59 2016 +0000
@@ -45,11 +45,12 @@
              :rotation-range rotation-range
              :phase-offset phase-offset))
 
-(define-with-macro arm pos length angle parent center-angle rotation-range phase-offset)
+(define-with-macro arm
+  pos length angle parent center-angle rotation-range phase-offset)
 
 
 (defun arm-set-phase (arm phase)
-  (with-arm arm
+  (with-arm (arm)
     (setf angle (+ center-angle (* rotation-range (sin (+ phase-offset phase)))))))
 
 (defun arm-total-angle (arm)
@@ -58,13 +59,13 @@
         :sum (arm-angle a)))
 
 (defun arm-end (arm)
-  (with-arm arm
+  (with-arm (arm)
     (vec2-add pos (vec2-magdir length (arm-total-angle arm)))))
 
 (defparameter *arm-pen* (make-pen :stroke (gray 0.1) :weight 5))
 
 (defun draw-arm (arm &optional (pen *arm-pen*))
-  (with-arm arm
+  (with-arm (arm)
     (with-pen pen (draw-line pos (arm-end arm)))))
 
 
--- a/src/2d/particles.lisp	Sun Aug 14 22:37:23 2016 +0000
+++ b/src/2d/particles.lisp	Mon Aug 15 22:22:59 2016 +0000
@@ -90,8 +90,8 @@
   (push target (particle-gravitations particle)))
 
 (defun particle-gravitate-remove! (particle target)
-  (zap% (particle-gravitations particle)
-        #'remove target %))
+  (zapf (particle-gravitations particle)
+        (remove target %)))
 
 (defun particle-gravitate-to! (particle attractor-particle)
   (let ((distance (particle-distance-to particle attractor-particle)))
@@ -115,8 +115,8 @@
         (particle-springs particle)))
 
 (defun particle-spring-remove! (particle target)
-  (zap% (particle-springs particle)
-        #'remove target % :key #'spring-target))
+  (zapf (particle-springs particle)
+        (remove target % :key #'spring-target)))
 
 
 (defun particle-update! (particle)
--- a/src/math.lisp	Sun Aug 14 22:37:23 2016 +0000
+++ b/src/math.lisp	Mon Aug 15 22:22:59 2016 +0000
@@ -1,26 +1,9 @@
 (in-package #:coding-math.math)
 
-(declaim (inline square outsidep insidep wrap-zero wrap-range
+(declaim (inline outsidep insidep wrap-zero wrap-range
                  norm lerp clamp distance))
 
 
-;;;; Constants
-(defparameter tau (coerce (* pi 2) 'single-float))
-
-
-;; Basics
-(defun dividesp (n divisor)
-  "Return whether `n` is evenly divisible by `divisor`."
-  (zerop (mod n divisor)))
-
-(defun square (n)
-  "Return the square of `n`."
-  (* n n))
-
-(defmacro mulf (place n)
-  "Multiply `place` by `n` in-place."
-  `(zap% ,place #'* % ,n))
-
 
 ;; Geometry
 (defun distance (x0 y0 x1 y1)
@@ -42,45 +25,6 @@
         :finally (return (/ total iterations))))
 
 
-;;;; Number range mapping
-(defun norm (min max val)
-  (/ (- val min)
-     (- max min)))
-
-(defun lerp (from to n)
-  "Lerp together `from` and `to` by factor `n`.
-
-  Note that you might want `precise-lerp` instead.
-
-  "
-  (+ from
-     (* n (- to from))))
-
-(defun precise-lerp (from to n)
-  "Lerp together `from` and `to` by factor `n`, precisely.
-
-  Vanilla lerp does not guarantee `(lerp from to 0.0)` will return exactly
-  `from` due to floating-point errors.  This version will return exactly `from`
-  when given a `n` of `0.0`, at the cost of an extra multiplication.
-
-  "
-  (+ (* (- 1 n) from)
-     (* n to)))
-
-(defun map-range (source-from source-to dest-from dest-to source-val)
-  "Map `source-val` from the source range to the destination range."
-  (lerp dest-from dest-to
-        (norm source-from source-to source-val)))
-
-(defun clamp (from to n)
-  (let ((max (max from to))
-        (min (min from to)))
-    (cond
-      ((> n max) max)
-      ((< n min) min)
-      (t n))))
-
-
 ;;;; Wrapping
 (defun wrap-zero (max val)
   "Wrap `val` around the range [0, max)."
@@ -93,7 +37,7 @@
           (- max min))))
 
 (defmacro wrapf (place min max)
-  `(zap% ,place #'wrap-range ,min ,max %))
+  `(zapf ,place (wrap-range ,min ,max %)))
 
 
 (defun insidep (from to val)
--- a/src/utils.lisp	Sun Aug 14 22:37:23 2016 +0000
+++ b/src/utils.lisp	Mon Aug 15 22:22:59 2016 +0000
@@ -36,41 +36,6 @@
               :append (list slot val)))))
 
 
-(defmacro define-with-macro (type &rest slots)
-  "Define a with-`type` macro for the given `type` and `slots`.
-
-  This new macro wraps `with-accessors` so you don't have to type `type-`
-  a billion times.
-
-  The given `type` must be a symbol naming a struct or class.  It must have the
-  appropriate accessors with names exactly of the form `type-slot`.
-
-  There's a lot of magic here, but it cuts down on boilerplate for simple things
-  quite a lot.
-
-  Example:
-
-    (defstruct foo x y)
-    (define-with-macro foo x y)
-
-    (with-foo (make-foo :x 10 :y 20)
-      (setf x 88)
-      (print x)
-      (print y))
-    =>
-    88
-    20
-
-  "
-  (with-gensyms (body)
-    `(defmacro ,(symbolize 'with- type) (,type &body ,body)
-      `(with-accessors
-        ,',(loop :for slot :in slots
-                 :collect `(,slot ,(symbolize type '- slot)))
-        ,,type
-        ,@,body))))
-
-
 ;;;; Handy drawing functions
 (defparameter axis-pen (make-pen :stroke (gray 0.7) :weight 2))