--- 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))
--- 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")))))))
--- /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))