# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1462828146 0
# Node ID d4f4d410ba4c568f5a7b8d2a70c4dc17981cb630
# Parent  bf847793a69aa8dffe6ceb7cd084b77014312d0e
Episode 22: 3D Postcards in Space

diff -r bf847793a69a -r d4f4d410ba4c .lispwords
--- a/.lispwords	Mon May 09 20:25:10 2016 +0000
+++ b/.lispwords	Mon May 09 21:09:06 2016 +0000
@@ -3,3 +3,4 @@
 (2 with-vals)
 (2 with-vec)
 (1 with-vecs)
+(1 with-setup)
diff -r bf847793a69a -r d4f4d410ba4c coding-math.asd
--- a/coding-math.asd	Mon May 09 20:25:10 2016 +0000
+++ b/coding-math.asd	Mon May 09 21:09:06 2016 +0000
@@ -34,5 +34,5 @@
                                (:file "ballistics")))
                  (:module "3d"
                   :serial t
-                  :components ())))))
+                  :components ((:file "demo")))))))
 
diff -r bf847793a69a -r d4f4d410ba4c package.lisp
--- a/package.lisp	Mon May 09 20:25:10 2016 +0000
+++ b/package.lisp	Mon May 09 21:09:06 2016 +0000
@@ -86,6 +86,24 @@
     #:with-vecs
     ))
 
+(defpackage #:coding-math.2d.hitboxes
+  (:use
+    #:cl
+    #:sketch
+    #:coding-math.math
+    #:coding-math.quickutils
+    #:coding-math.utils)
+  (:export
+    #:hitbox-x
+    #:hitbox-y
+    #:hitbox-radius
+    #:hitbox-width
+    #:hitbox-height
+    #:circles-collide-p
+    #:circle-point-collide-p
+    #:rect-point-collide-p
+    #:rects-collide-p))
+
 (defpackage #:coding-math.2d.particles
   (:use
     #:cl
@@ -136,23 +154,6 @@
     #:multicurve
     ))
 
-(defpackage #:coding-math.2d.hitboxes
-  (:use
-    #:cl
-    #:sketch
-    #:coding-math.math
-    #:coding-math.quickutils
-    #:coding-math.utils)
-  (:export
-    #:hitbox-x
-    #:hitbox-y
-    #:hitbox-radius
-    #:hitbox-width
-    #:hitbox-height
-    #:circles-collide-p
-    #:circle-point-collide-p
-    #:rect-point-collide-p
-    #:rects-collide-p))
 
 (defpackage #:coding-math.2d.demo
   (:use
@@ -179,3 +180,13 @@
 
 
 ;;;; 3D stuff
+(defpackage #:coding-math.3d.demo
+  (:use
+    #:cl
+    #:sketch
+    #:coding-math.quickutils
+    #:coding-math.utils
+    #:coding-math.fps
+    #:coding-math.math
+    ))
+
diff -r bf847793a69a -r d4f4d410ba4c src/3d/demo.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/3d/demo.lisp	Mon May 09 21:09:06 2016 +0000
@@ -0,0 +1,107 @@
+(in-package #:coding-math.3d.demo)
+
+
+;;;; Config
+(defparameter *width* 600)
+(defparameter *height* 400)
+
+(defparameter *center-x* (/ *width* 2))
+(defparameter *center-y* (/ *height* 2))
+
+;;;; Utils
+(defmacro with-centered-coords (&body body)
+  `(in-context
+     (translate *center-x* *center-y*)
+     ,@body))
+
+(defmacro with-setup (ready-form &body body)
+  `(with-fps
+    (background (gray 1))
+    (when ,ready-form
+      (with-centered-coords
+        ,@body))))
+
+;;;; Draw
+(defun draw-shape (shape focal-length size)
+  (destructuring-bind (x y z) shape
+    (let ((perspective (/ focal-length (+ focal-length z))))
+      (in-context
+        (translate (* x perspective)
+                   (* y perspective))
+        (scale perspective)
+        (circle 0 0 size)))))
+
+;;;; Sketch
+(defsketch demo (:width *width*
+                 :height *height*
+                 :debug :scancode-d)
+    ((ready)
+     (mouse)
+     (fl 300)
+     (shapes)
+     (simple-pen (make-pen :fill (gray 0.2)))
+     )
+  (with-setup ready
+    ;;
+    (with-pen simple-pen
+      (loop :for shape :in shapes :do
+            (incf (caddr shape) -50)
+            (wrapf (caddr shape) 0 10000))
+      ; (setf shapes (sort shapes #'> :key #'caddr))
+      (mapc (rcurry #'draw-shape fl 30)
+            shapes)
+      )
+    ;;
+    ))
+
+(defun make-demo ()
+  (make-sketch 'demo
+    (mouse nil)))
+
+
+(defun reset (game)
+  (setf (slot-value game 'ready) nil)
+  (setf
+    (slot-value game 'shapes)
+    (loop :repeat 200
+          :collect (list (random-range -500 500)
+                         (random-range -400 400)
+                         (random-range 0 10000))))
+  (setf (slot-value game 'ready) t))
+
+
+
+;;;; Mouse
+(defmethod kit.sdl2:mousemotion-event ((window demo) ts b x y xrel yrel)
+  (declare (ignore ts b xrel yrel))
+  (with-slots (mouse) window
+    (setf (slot-value window 'mouse) ; todo fix
+          (list x y))
+    ;;
+    ;;
+    ))
+
+
+;;;; Keyboard
+(defun keydown (instance scancode)
+  (declare (ignorable instance))
+  (scancode-case scancode
+    (:scancode-space (reset instance))))
+
+(defun keyup (instance scancode)
+  (declare (ignorable instance))
+  (scancode-case scancode
+    (:scancode-space
+     nil)))
+
+
+(defmethod kit.sdl2:keyboard-event ((instance demo) state timestamp repeatp keysym)
+  (declare (ignore timestamp repeatp))
+  (cond
+    ((eql state :keyup) (keyup instance (sdl2:scancode-value keysym)))
+    ((eql state :keydown) (keydown instance (sdl2:scancode-value keysym)))
+    (t nil)))
+
+
+;;;; Run
+; (defparameter *demo* (make-demo))