# HG changeset patch # User Steve Losh # Date 1471698741 0 # Node ID 94393b5cd67eb3614cd9177fc7b49e89603c3dbc # Parent a5b56cd9bbcf2837ee76383e0445e455d214a3fc Episode 50: IFS Fractals diff -r a5b56cd9bbcf -r 94393b5cd67e .lispwords --- a/.lispwords Sat Aug 20 12:17:19 2016 +0000 +++ b/.lispwords Sat Aug 20 13:12:21 2016 +0000 @@ -9,3 +9,4 @@ (1 tween-places!) (1 with-normalized-time) (1 with-arm with-iks) +(1 just-once) diff -r a5b56cd9bbcf -r 94393b5cd67e src/2d/demo.lisp --- a/src/2d/demo.lisp Sat Aug 20 12:17:19 2016 +0000 +++ b/src/2d/demo.lisp Sat Aug 20 13:12:21 2016 +0000 @@ -3,7 +3,7 @@ ;;;; Config (setf *bypass-cache* t) (defparameter *width* 600) -(defparameter *height* 400) +(defparameter *height* 600) (defparameter *center-x* (/ *width* 2)) (defparameter *center-y* (/ *height* 2)) @@ -33,91 +33,13 @@ (vec2 (random-range (- *center-x*) *center-x*) (random-range (- *center-y*) *center-y*))) - -;;;; Episode -(defparameter *arm-pen* (make-pen :weight 10 :stroke (gray 0.1))) - -(defstruct (arm (:constructor make-arm (pos length angle &optional parent))) - pos length angle parent) - -(define-with-macro arm - pos length angle parent) - - -(defun arm-end (arm) - (with-arm (arm) - (vec2-add pos (vec2-magdir length angle)))) - -(defun draw-arm (arm &optional (pen *arm-pen*)) - (with-pen pen (draw-line (arm-pos arm) (arm-end arm)))) - -(defun arm-point-at (arm target) - (with-arm (arm) - (setf angle (-<> target - (vec2-sub <> pos) - vec2-angle)))) - -(defun arm-drag (arm target) - (arm-point-at arm target) - (with-arm (arm) - (setf pos (vec2-sub target - (vec2-magdir length angle))) - (when parent - (arm-drag parent pos)))) - - -(defun vector-last (vector) - (let ((l (length vector))) - (if (zerop l) - nil - (aref vector (1- l))))) +(defmacro just-once (dirty-place &body body) + `(when ,dirty-place + (setf ,dirty-place nil) + ,@body)) -(defclass inverse-kinematic-system () - ((origin :initarg :origin - :accessor iks-origin) - (arms :initform (make-array 10 :fill-pointer 0) - :accessor iks-arms))) - -(define-with-macro iks origin arms) - - -(defun make-iks (origin) - (make-instance 'inverse-kinematic-system :origin origin)) - -(defun iks-last-arm (iks) - (vector-last (iks-arms iks))) - -(defun iks-add-arm (iks length) - (with-iks (iks) - (let ((parent (iks-last-arm iks))) - (vector-push-extend (make-arm (if parent - (arm-pos parent) - origin) - length 0 parent) - arms)))) - -(defun draw-iks (iks) - (map nil #'draw-arm (iks-arms iks))) - -(defun iks-drag (iks target) - (let ((arm (iks-last-arm iks))) - (when arm - (arm-drag arm target)))) - -(defun iks-correct (iks) - (iterate - (for arm :in-vector (iks-arms iks)) - (for parent = (arm-parent arm)) - (setf (arm-pos arm) - (if parent - (arm-end parent) - (iks-origin iks))))) - -(defun iks-reach (iks target) - (iks-drag iks target) - (iks-correct iks)) - +;;;; Episode ;;;; Sketch (defun draw-particle (p) @@ -159,7 +81,7 @@ (defsketch demo ((width *width*) (height *height*) (y-axis :up) (title "Coding Math 2D") - (copy-pixels nil) + (copy-pixels t) (mouse (vec2 0 0)) (frame 0) (start-time (real-time)) @@ -167,70 +89,56 @@ (previous-time 0) (total-time 0) ;; Data - (iks1 (make-iks (vec2 (- 150) (- *center-y*)))) - (iks2 (make-iks (vec2 (+ 150) (- *center-y*)))) - (ball (make-particle 0 0 - :speed (random-around 20 2.0) - :direction (random tau) - :mass 10.0 - :radius 10 - :gravity 0.0)) - (lol (progn - (iterate (repeat 6) - (iks-add-arm iks1 (random-around 50 30))) - (iterate (repeat 6) - (iks-add-arm iks2 (random-around 50 30))) - )) + (transforms + (list (sb-cga::matrix 0.85 0.04 0.00 0.00 + -0.04 0.85 0.00 1.60 + 0.00 0.00 0.00 0.00 + 0.00 0.00 0.00 1.00) + (sb-cga::matrix -0.15 0.28 0.00 0.00 + 0.26 0.24 0.00 0.44 + 0.00 0.00 0.00 0.00 + 0.00 0.00 0.00 1.00) + (sb-cga::matrix 0.20 -0.26 0.00 0.00 + 0.23 0.22 0.00 1.60 + 0.00 0.00 0.00 0.00 + 0.00 0.00 0.00 1.00) + (sb-cga::matrix 0.00 0.00 0.00 0.00 + 0.00 0.16 0.00 0.00 + 0.00 0.00 0.00 0.00 + 0.00 0.00 0.00 1.00))) + (weights (list 0.85 0.07 0.07 0.01)) + (wl (make-weightlist transforms weights)) + (point (sb-cga::vec (random 1.0) (random 1.0) 0.0)) + (dirty t) ;; Pens (particle-pen (make-pen :fill (gray 0.9) :stroke (gray 0.4))) (black-pen (make-pen :stroke (rgb 0 0 0) :fill (rgb 0.4 0.4 0.4) :weight 1 :curve-steps 50)) (red-pen (make-pen :stroke (rgb 0.6 0 0) :fill (rgb 0.9 0 0) :weight 1 :curve-steps 50)) (green-pen (make-pen :stroke (rgb 0 0.6 0) :fill (rgb 0 0.9 0) :weight 1 :curve-steps 50)) (blue-pen (make-pen :stroke (rgb 0 0 0.6) :fill (rgb 0 0 0.9) :weight 1 :curve-steps 50)) + (black-fill-pen (make-pen :fill (gray 0) :weight 0)) ) (setf previous-time current-time current-time (real-time)) (incf total-time (- current-time previous-time)) (incf frame) ;; - (with-setup - (in-context - (translate *center-x* *center-y*) - (draw-axes *width* *height*) - - (particle-update! ball) - - ;; Garbage wrapping code because I don't feel like rewriting the particle - ;; system to use the new vectors and centered coordinates. - (let ((x (particle-x ball)) - (y (particle-y ball))) - (when (not (< (- *center-x*) x *center-x*)) - (negatef (coding-math.2d.vectors::vec-x (particle-vel ball))) - (setf - (particle-x ball) (max (- *center-x*) x) - (particle-x ball) (min (+ *center-x*) x) + (just-once dirty + (background (gray 1.0))) + (in-context + (translate *center-x* 0) + (iterate + (repeat 100) + (with-pen black-fill-pen + #+no (sketch:point (* 50 (aref point 0)) + (* 50 (aref point 1))) + (sketch:rect (* 50 (aref point 0)) + (* 50 (aref point 1)) + 0.5 + 0.5)) + (zapf point (sb-cga::transform-point % (weightlist-random wl)))) - (coding-math.2d.vectors::vec-magnitude (particle-vel ball)) - (* 0.95 (coding-math.2d.vectors::vec-magnitude (particle-vel ball))))) - (when (not (< (- *center-y*) y *center-y*)) - (negatef (coding-math.2d.vectors::vec-y (particle-vel ball))) - (setf - (particle-x ball) (max (- *center-x*) x) - (particle-x ball) (min (+ *center-x*) x) - - (coding-math.2d.vectors::vec-magnitude (particle-vel ball)) - (* 0.95 (coding-math.2d.vectors::vec-magnitude (particle-vel ball)))))) - - (draw-particle ball) - - (let ((target (vec2 (particle-x ball) - (particle-y ball)))) - (iks-reach iks1 target) - (draw-iks iks1) - (iks-reach iks2 target) - (draw-iks iks2)) - - )) + ) ;; )