# HG changeset patch # User Steve Losh # Date 1469363666 0 # Node ID 6b92f156e83bc91d4ad763d091fc0082b9f643c8 # Parent e088b8f6a98de567b55e121f237af3b2b79cdd2c Episode 41: Isometric 3D Part 1 diff -r e088b8f6a98d -r 6b92f156e83b package.lisp --- a/package.lisp Sat Jul 23 12:43:03 2016 +0000 +++ b/package.lisp Sun Jul 24 12:34:26 2016 +0000 @@ -287,6 +287,7 @@ (defpackage #:coding-math.3d.demo (:use #:cl + #:iterate #:sketch #:coding-math.quickutils #:coding-math.utils @@ -298,5 +299,7 @@ ) (:import-from :sb-cga :vec) + (:shadowing-import-from #:iterate + #:in) (:shadow #:point)) diff -r e088b8f6a98d -r 6b92f156e83b src/2d/demo.lisp --- a/src/2d/demo.lisp Sat Jul 23 12:43:03 2016 +0000 +++ b/src/2d/demo.lisp Sun Jul 24 12:34:26 2016 +0000 @@ -143,12 +143,8 @@ (with-setup (in-context - (with-pen black-pen - (in-context - (translate (- *center-x* 40) 0) - (draw-pytree 80 py-angle 5))) - (with-pen red-pen - (draw-tree p0 p1 branch-angle-a branch-angle-b trunk-ratio 8)) + (translate *center-x* *center-y*) + )) ;; diff -r e088b8f6a98d -r 6b92f156e83b src/3d/demo.lisp --- a/src/3d/demo.lisp Sat Jul 23 12:43:03 2016 +0000 +++ b/src/3d/demo.lisp Sun Jul 24 12:34:26 2016 +0000 @@ -2,7 +2,7 @@ ;;;; Config -(setf *bypass-cache* t) +(setf *bypass-cache* nil) (defparameter *width* 600) (defparameter *height* 400) @@ -16,6 +16,10 @@ (defvar *option* nil) +(defvar *tile-width* 100) +(defvar *tile-height* 50) + + ;;;; Utils (defmacro with-centered-coords (&body body) `(in-context @@ -28,113 +32,125 @@ (with-centered-coords ,@body))) +(defun real-time () + (/ (get-internal-real-time) internal-time-units-per-second)) + ;;;; Draw (defun draw-point (screen size) (circle (vec-x screen) (vec-y screen) size)) - -;;;; Structs -(defstruct (point (:constructor make-point (world &optional screen))) - world screen) - - -;;;; Functions -(defun rotate-x (angle points) - (let ((s (sin angle)) - (c (cos angle))) - (map nil (lambda (p) - (with-vec (p (point-world p)) - (psetf p.y (- (* p.y c) (* p.z s)) - p.z (+ (* p.z c) (* p.y s))))) - points))) +(defun draw-tile (x y pen) + ;; 0 0 + ;; h + ;; a wwwwww b + ;; + ;; c + (in-context + (let* ((w (/ *tile-width* 2)) + (h (/ *tile-height* 2)) + (ax (- w)) + (ay (- h)) + (bx (+ w)) + (by (- h)) + (cx 0) + (cy (- *tile-height*))) + (translate (* (- x y) w) + (* -1 (+ x y) h)) + (with-pen pen + (polygon 0 0 ax ay cx cy bx by))))) -(defun rotate-y (angle points) - (let ((s (sin angle)) - (c (cos angle))) - (map nil (lambda (p) - (with-vec (p (point-world p)) - (psetf p.x (- (* p.x c) (* p.z s)) - p.z (+ (* p.z c) (* p.x s))))) - points))) - -(defun rotate-z (angle points) - (let ((s (sin angle)) - (c (cos angle))) - (map nil (lambda (p) - (with-vec (p (point-world p)) - (psetf p.x (- (* p.x c) (* p.y s)) - p.y (+ (* p.y c) (* p.x s))))) - points))) +(defun draw-block (x y z) + ;; a + ;; h + ;; b wwwwww c + ;; + ;; d + ;; + ;; + ;; + ;; O + ;; + ;; e g + ;; + ;; f + (in-context + (let* ((ww *tile-width*) + (hh *tile-height*) + (w (/ ww 2.0)) + (h (/ hh 2.0)) + (ax 0.0) + (ay (* z hh)) + (bx (- w)) + (by (- ay h)) + (cx (+ w)) + (cy (- ay h)) + (dx 0.0) + (dy (- ay hh)) + (ex (- w)) + (ey (- h)) + (gx (+ w)) + (gy (- h)) + (fx 0.0) + (fy (- hh)) + ) + (translate (* (- x y) w) + (* -1 (+ x y) h)) + (with-pen (make-pen :fill (rgb 0 0 1.0)) + (polygon ax ay bx by dx dy cx cy)) + (with-pen (make-pen :fill (rgb 0 0 0.6)) + (polygon bx by dx dy fx fy ex ey)) + (with-pen (make-pen :fill (rgb 0 0 0.3)) + (polygon dx dy cx cy gx gy fx fy))))) ;;;; Sketch -(defun project (points focal-length center-z) - (map nil - (lambda (p) - (with-vecs ((screen (point-screen p)) - (world (point-world p))) - (let ((scale (/ focal-length (+ focal-length world.z center-z)))) - (setf screen.x (* scale world.x) - screen.y (* scale world.y))))) - points)) - -(defun translate-model (points x y z) - (map nil (lambda (p) - (with-vec (p (point-world p)) - (incf p.x x) - (incf p.y y) - (incf p.z z))) - points)) - - (defsketch demo - ((width *width*) (height *height*) (y-axis :up) (title "Coding Math") + ((width *width*) (height *height*) (y-axis :up) (title "Coding Math 3D") + (copy-pixels nil) (mouse (cons 0 0)) - ;; variables - (fl 300.0) - (r 200.0) - (center-z 1500.0) - (points - (make-array 8 - :initial-contents - (list - (make-point (vec (- r) (- r) r) (zero-vec)) - (make-point (vec r (- r) r) (zero-vec)) - (make-point (vec r (- r) (- r)) (zero-vec)) - (make-point (vec (- r) (- r) (- r)) (zero-vec)) - (make-point (vec (- r) r r) (zero-vec)) - (make-point (vec r r r) (zero-vec)) - (make-point (vec r r (- r)) (zero-vec)) - (make-point (vec (- r) r (- r)) (zero-vec))))) + (frame 0) + (start-time (real-time)) + (current-time 0) + (previous-time 0) + (total-time 0) + ;; data + (h 0.1) + (tiles (iterate + tiles + (for x :from 0 :below 10) + (iterate (for y :from 0 :below 10) + (in tiles + (collect (list x y (make-pen :fill (gray (random-range 0.2 0.8))))))))) + (blocks (iterate + blocks + (for x :from 0 :below 4) + (iterate (for y :from 0 :below 4) + (in blocks + (collect (list (+ 3 x) + (+ 3 y) + (random-range 1 4))))))) ;; pens - (simple-pen (make-pen :fill (gray 0.1))) - (line-pen (make-pen :stroke (gray 0.1) :weight 1)) - ) + (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))) + (setf previous-time current-time + current-time (real-time)) + (incf total-time (- current-time previous-time)) + (incf frame) (with-setup - (flet - ((draw-line (&rest vertices) - (loop :for (a b) ; lame way to close the loop... - :in (n-grams 2 (append vertices (list (car vertices)))) - :do (with-vecs ((a (point-screen (aref points a))) - (b (point-screen (aref points b)))) - (line a.x a.y b.x b.y))))) - (project points fl center-z) - (when *shift* (text "shift!" 100 100)) - (when *control* (text "control!" 100 120)) - (with-pen simple-pen - ; (loop :for p :across points - ; :do (draw-point (point-screen p) 5)) - nil) - (with-pen line-pen - (draw-line 0 1 2 3) - (draw-line 0 3 7 4) - (draw-line 1 2 6 5) - (draw-line 6 5 4 7) - nil - )) ;; - )) + (incf h 0.02) + (wrapf h 0.1 2.5) + (in-context + (translate 0 (- *center-y* 20)) + (iterate (for (x y pen) :in tiles) + (draw-tile x y pen)) + (iterate (for (x y z) :in blocks) + (draw-block x y z)) + (draw-block 3 7 h) + ))) ;;;; Mouse @@ -192,24 +208,6 @@ (:scancode-lgui (setf *command* t)) (:scancode-lalt (setf *option* t)) ;; - (:scancode-left (if *shift* - (rotate-y -0.05 (demo-points instance)) - (translate-model (slot-value instance 'points) -15 0 0))) - (:scancode-right (if *shift* - (rotate-y 0.05 (demo-points instance)) - (translate-model (slot-value instance 'points) 15 0 0))) - (:scancode-up (if *shift* - (rotate-x -0.05 (demo-points instance)) - (translate-model (slot-value instance 'points) 0 15 0))) - (:scancode-down (if *shift* - (rotate-x 0.05 (demo-points instance)) - (translate-model (slot-value instance 'points) 0 -15 0))) - (:scancode-s (if *shift* - (rotate-z -0.05 (demo-points instance)) - (translate-model (slot-value instance 'points) 0 0 -15))) - (:scancode-w (if *shift* - (rotate-z 0.05 (demo-points instance)) - (translate-model (slot-value instance 'points) 0 0 15))) ;; ))