# HG changeset patch # User Steve Losh # Date 1471299779 0 # Node ID 28dc985f4d510bc25166560e271f49bbdcdcf7ac # Parent c72435d307d7296e9769bb5ec053ae9768a94ab4 Update cl-losh diff -r c72435d307d7 -r 28dc985f4d51 package.lisp --- 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 diff -r c72435d307d7 -r 28dc985f4d51 src/2d/demo.lisp --- 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))))) diff -r c72435d307d7 -r 28dc985f4d51 src/2d/particles.lisp --- 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) diff -r c72435d307d7 -r 28dc985f4d51 src/math.lisp --- 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) diff -r c72435d307d7 -r 28dc985f4d51 src/utils.lisp --- 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))