# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1470316320 0
# Node ID ab25b62d3f1dd4624fec316f8cc18608ce3e7e1a
# Parent  175fccc805fc4376173f677cf10efd5d78300f7d
Add sketch to my sandbox

diff -r 175fccc805fc -r ab25b62d3f1d package.lisp
--- a/package.lisp	Sat Jul 23 19:07:55 2016 +0000
+++ b/package.lisp	Thu Aug 04 13:12:00 2016 +0000
@@ -79,3 +79,14 @@
         #:cl-arrows
         #:sand.quickutils
         #:sand.utils))
+
+
+(defpackage #:sand.sketch
+  (:use
+    #:cl
+    #:sketch
+    #:iterate
+    #:sand.quickutils
+    #:sand.utils)
+  (:shadowing-import-from #:iterate
+    #:in))
diff -r 175fccc805fc -r ab25b62d3f1d sand.asd
--- a/sand.asd	Sat Jul 23 19:07:55 2016 +0000
+++ b/sand.asd	Thu Aug 04 13:12:00 2016 +0000
@@ -11,7 +11,8 @@
                #:iterate
                #:cl-arrows
                #:cl-fad
-               #:parenscript)
+               #:parenscript
+               #:sketch)
 
   :serial t
   :components
@@ -22,6 +23,7 @@
     :components ((:file "utils")
                  (:file "random-numbers")
                  (:file "ascii")
+                 (:file "sketch")
                  (:module "parenscript"
                   :serial t
                   :components ((:file "compiler")))))))
diff -r 175fccc805fc -r ab25b62d3f1d src/sketch.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/sketch.lisp	Thu Aug 04 13:12:00 2016 +0000
@@ -0,0 +1,143 @@
+(in-package #:sand.sketch)
+
+;;;; Config
+(setf *bypass-cache* t)
+(defparameter *width* 600)
+(defparameter *height* 400)
+
+
+(defparameter *center-x* (/ *width* 2))
+(defparameter *center-y* (/ *height* 2))
+
+
+(defvar *shift* nil)
+(defvar *control* nil)
+(defvar *command* nil)
+(defvar *option* nil)
+
+
+;;;; Utils
+(defmacro with-setup (&body body)
+  `(progn
+    (background (gray 1))
+    ,@body))
+
+
+(defmacro in-context (&body body)
+  `(prog1
+    (push-matrix)
+    (progn ,@body)
+    (pop-matrix)))
+
+
+(defmacro scancode-case (scancode-form &rest pairs)
+  (with-gensyms (scancode)
+    `(let ((,scancode ,scancode-form))
+      (cond
+        ,@(mapcar (lambda (pair)
+                    (destructuring-bind (key-scancode &rest body) pair
+                      `((sdl2:scancode= ,scancode ,key-scancode)
+                        ,@body)))
+           pairs)))))
+
+
+;;;; Sketch
+(defsketch demo
+    ((width *width*) (height *height*) (y-axis :up) (title "Sketch")
+     (copy-pixels nil)
+     (mouse (list 0 0))
+     (frame 0)
+     ;; Data
+     ;; Pens
+     (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))
+     )
+  (incf frame)
+  ;;
+  (with-setup
+    )
+  ;;
+
+  )
+
+
+;;;; Mouse
+(defun mousemove (instance x y)
+  (with-slots (mouse) instance
+    (setf mouse (list x (- *height* y)))
+    ;;
+    ;;
+    )
+  )
+
+
+(defun mousedown-left (instance x y)
+  (declare (ignorable instance x y))
+  )
+
+(defun mousedown-right (instance x y)
+  (declare (ignorable instance x y))
+  )
+
+(defun mouseup-left (instance x y)
+  (declare (ignorable instance x y))
+  )
+
+(defun mouseup-right (instance x y)
+  (declare (ignorable instance x y))
+  )
+
+
+(defmethod kit.sdl2:mousemotion-event ((window demo) ts b x y xrel yrel)
+  (declare (ignore ts b xrel yrel))
+  (mousemove window x y))
+
+(defmethod kit.sdl2:mousebutton-event ((window demo) state ts button x y)
+  (declare (ignore ts))
+  (funcall (case state
+             (:mousebuttondown
+              (case button
+                (1 #'mousedown-left)
+                (3 #'mousedown-right)))
+             (:mousebuttonup
+              (case button
+                (1 #'mouseup-left)
+                (3 #'mouseup-right))))
+           window x y))
+
+
+;;;; Keyboard
+(defun keydown (instance scancode)
+  (declare (ignorable instance))
+  (scancode-case scancode
+    (:scancode-space (sketch::prepare instance))
+    (:scancode-lshift (setf *shift* t))
+    (:scancode-lctrl (setf *control* t))
+    (:scancode-lgui (setf *command* t))
+    (:scancode-lalt (setf *option* t))
+    ;;
+    ;;
+    ))
+
+(defun keyup (instance scancode)
+  (declare (ignorable instance))
+  (scancode-case scancode
+    (:scancode-lshift (setf *shift* nil))
+    (:scancode-lctrl (setf *control* nil))
+    (:scancode-lgui (setf *command* nil))
+    (:scancode-lalt (setf *option* nil))
+    (: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-instance 'demo))