2 files changed, 83 insertions(+), 106 deletions(-)

M example.lisp
M fairy.lisp

@@ 1,6 1,17 @@
 (ql:quickload :fairy)
 
-; dealing with trivial-gamekit application initialization
+;; First, we create a description of our scene
+(defvar *root* (make-instance 'fairy:layer :scale 2))
+
+(defvar *rec* (make-instance 'fairy:rectangle
+                             :origin (gamekit:vec2 5 5)
+                             :width 100
+                             :height 150
+                             :color (gamekit:vec4 1 0.3 0 1)))
+
+(fairy:add-child *root* *rec*)
+
+;; Then, we create a trivial-gamekit application.
 (gamekit:defgame app () ()
                  (:viewport-width 800)
                  (:viewport-height 600))


@@ 9,17 20,13 @@
   (gamekit:bind-button :mouse-left :released
                        (lambda () (gamekit:stop))))
 
-(defvar *root* (fairy:init-root))
-
 (defmethod gamekit:draw ((app app))
   (fairy:draw *root*))
 
 (gamekit:start 'app)
 
-; first, we create the element of our scene, starting with the fairy root
-(defvar *test-layer* (fairy:new-layer 70 0))
-(defvar *test-rec* (fairy:new-rectangle 5 5 100 150 (gamekit:vec4 0 0 0 1)))
-
-; then, we put everything together
-(fairy:layer-add-child *test-layer* *test-rec*)
-(fairy:root-add-child *root* *test-layer*)
+;; It is possible to update the scene description, and it will update the
+;; screen.
+(setf (fairy:width *rec*) 200)
+(setf (fairy:origin *rec*) (gamekit:vec2 230 20))
+(setf (fairy:boundary *root*) (gamekit:vec2 240 50))

@@ 1,105 1,75 @@
 (defpackage :fairy
   (:use :cl)
   (:export draw
-
-           init-root
-           root-add-child
-           root-delete-child
-
+           element
+           origin
+           scale
            rectangle
-           new-rectangle
-           rectangle-origin
-           rectangle-width
-           rectangle-height
-           rectangle-color
-
+           width
+           height
            layer
-           layer-add-child
-           layer-delete-child
-           new-layer
-           layer-origin
-
-           surface
-           surface-add-child
-           surface-delete-child
-           new-surface
-           surface-origin
-           surface-width
-           surface-height))
-
-(cl:in-package :fairy)
+           boundary
+           add-child
+           delete-child))
 
 (defgeneric draw (element)
-  (:documentation "Draw a new element on the screen"))
-
-(defstruct surface origin width height elements)
-
-(defun new-surface (x y width height)
-  (make-surface :origin (gamekit:vec2 x y)
-                :width width
-                :height height
-                :elements nil))
-
-(defmethod draw ((element surface))
-  (gamekit:with-pushed-canvas ()
-    (ge.vg:scissors (surface-origin element) (surface-width element) (surface-height element))
-    (gamekit:translate-canvas (gamekit:x (surface-origin element))
-                              (gamekit:y (surface-origin element)))
-    (dolist (el (surface-elements element))
-      (draw el))))
-
-(defun surface-add-child (surface element)
-  (setf (surface-elements surface)
-        (cons element (surface-elements surface))))
-
-(defun surface-delete-child (surface element)
-  (setf (surface-elements surface) (delete element (surface-elements surface))))
-
-(defstruct layer origin elements)
+  (:documentation "Draw the element on the screen"))
 
-(defun new-layer (x y)
-  (make-layer :origin (gamekit:vec2 x y)
-              :elements nil))
-
-(defmethod draw ((element layer))
-  (gamekit:with-pushed-canvas ()
-    (gamekit:translate-canvas (gamekit:x (layer-origin element))
-                              (gamekit:y (layer-origin element)))
-    (dolist (el (layer-elements element))
-      (draw el))))
-
-(defun layer-add-child (layer element)
-  (setf (layer-elements layer) (cons element (layer-elements layer))))
-
-(defun layer-delete-child (layer element)
-  (setf (layer-elements layer) (delete element (layer-elements layer))))
-
-(defstruct rectangle origin width height color)
-
-(defun new-rectangle (x y width height color)
-  (make-rectangle :origin (gamekit:vec2 x y)
-                  :width width
-                  :height height
-                  :color color))
-
-(defmethod draw ((element rectangle))
-  (gamekit:draw-rect (rectangle-origin element)
-                     (rectangle-width element)
-                     (rectangle-height element)
-                     :fill-paint (rectangle-color element)))
-
-(defstruct root elements)
-
-(defun root-add-child (root element)
-  (setf (root-elements root)
-        (cons element (root-elements root))))
-
-(defun root-delete-child (root element)
-  (setf (root-elements layer) (delete element (root-elements layer))))
-
-(defmethod draw ((element root))
-  (dolist (el (root-elements element))
-    (draw el)))
+(cl:in-package :fairy)
 
-(defun init-root ()
-  (make-root :elements nil))
+(defclass element ()
+  ((origin :initarg :origin
+           :initform (gamekit:vec2 0 0)
+           :accessor origin)
+   (scale :initarg :scale
+          :initform nil
+          :accessor :scale)))
+
+(defmacro defdraw ((el class) &rest body)
+  `(defmethod draw ((,el ,class))
+     (with-slots (origin scale) ,el
+       (gamekit:with-pushed-canvas ()
+         (when scale (gamekit:scale-canvas scale scale))
+         (gamekit:translate-canvas (gamekit:x origin)
+                                   (gamekit:y origin))
+         ,@body))))
+
+(defclass rectangle (element)
+  ((width :initarg :width
+          :initform (error "Must supply a width")
+          :accessor width)
+   (height :initarg :height
+           :initform (error "Must supply a height")
+           :accessor height)
+   (color :initarg :color
+          :initform (gamekit:vec4 0 0 0 1)
+          :accessor color)))
+
+(defdraw (el rectangle)
+    (with-slots (width height color) el
+      (gamekit:draw-rect (gamekit:vec2 0 0)
+                         width
+                         height
+                         :fill-paint color)))
+
+(defclass layer (element)
+  ((children :initarg :children
+             :initform nil
+             :accessor children)
+   (boundary :initarg :boundary
+             :initform nil
+             :accessor boundary)))
+
+(defdraw (el layer)
+    (with-slots (boundary children) el
+      (when boundary
+        (ge.vg:scissors (gamekit:vec2 0 0)
+                        (gamekit:x boundary) (gamekit:y boundary)))
+      (dolist (e children)
+        (draw e))))
+
+(defmethod add-child ((el layer) child)
+  (setf (children el) (cons child (children el))))
+
+(defmethod delete-child ((el layer) child)
+  (setf (children el) (delete child (children el))))