94393b5cd67e

Episode 50: IFS Fractals
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sat, 20 Aug 2016 13:12:21 +0000
parents a5b56cd9bbcf
children 692ae0d92fa1
branches/tags (none)
files .lispwords src/2d/demo.lisp

Changes

--- 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)
--- 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))
-
-      ))
+    )
   ;;
 
   )