Replaced defclass-std with defrefactor-with-def

18 files changed, 189 insertions, 131 deletions

diff --git a/src/application.lisp b/src/application.lisp
index 62849c9..f33bb9f 100644
--- a/src/application.lisp
+++ b/src/application.lisp
@@ -2,38 +2,38 @@
 
 (in-package #:wheelwork)
 
-(defclass/std application (region interactive)
-  ((title :with :ri :std "Wheelwork App")
-   (asset-root :ri :std #P"./" :doc "Directory under which assets are stored.")
-   (asset-classifiers
-    :std '(("png" png) ("ttf" font))
-    :doc "ALIST of (EXT CLASS). EXT is a string, file estension. CLASS is a symbol, class name.")
-   (assets :with :a :std (make-hash-table :test 'equal)
-           :doc "maps asset names to asset instances.")
-   (scale :with :std 1.0
-                :doc "Scale factor applied before all
-                rendering. Affects sizes of all object as well as the
-                coordinates of mouse events.")
-   (width height :with :std 800 :doc "Window dimensions in real pixels.")
-   (projection :with :a :doc "The projection matrix for the scene. Orthographic by default.")
-   (window :with :a)
-   (refocus-on-mousedown-p
-    :std t
-    :doc "When T, clicking on a visible object will set the
-    application focus to that object.")
-   (mouse-button-events-bubble-p
-    mouse-motion-events-bubble-p
-    :std nil
-    :doc "determines whether the search for event handlers stops at
-    the first visible unit under the xy position of the mouse or
-    not. ")
-   (scene focus last-motion-target :with :a)
-   (fps :std 30 :doc "Frames Per Second")
-   (frame-wait :r))
-  (:documentation "The application contains the information and data
-  structures necessary for creating a window, adding display units to
-  it, handling events, and loading resources.  You should sublcass
-  this and write your own BOOT method."))
+(def:class application (region interactive)
+  (title :prefix :ro :type string :initform "Wheelwork App")
+  ((asset-root "Directory underwhich assets are stored.")
+   :ro :type pathname :initform #P"./")
+  ((asset-classifiers "ALIST of (FILE-EXTENSION CLASS-NAME) pairs.")
+   :initform '(("png" png) ("ttf" font)))
+  ((assets "Map of asset names to asset instances")
+   :prefix :noarg :initform (make-hash-table :test 'equal))
+  ((scale "Scale factor applied to all rendering and to all event targeting.")
+   :prefix :type float :initform 1.0)
+  ((width "pixel width")
+   (height "pixel height")
+   :prefix :type fixnum :initform 800)
+  ((projection "Scene projection matrix. Orthographic by default.")
+   :prefix :noarg)
+  ((window "SDL2 application window.")
+   :prefix :noarg)
+  ((refocus-on-mousedown-p "Clicking a visbile unit will set focus to that unit.")
+   :type boolean :initform t)
+  (mouse-button-events-bubble-p
+   mouse-motion-events-bubble-p
+   :type boolean :initform nil
+   :documentation "If T, handler search doesn't stop at first visble event target.")
+  ((scene "Vector of objects to be displayed")
+   :prefix :noarg :type (vector unit))
+  ((focus "Unit with current focus.")
+   (last-motion-target "Unit that last receved a mouse motion event.")
+   :prefix :noarg :type (or null unit) :initform nil)
+  ((fps "Frames per second")
+   :type fixnum :initform 30)
+  ((frame-wait "Pause between frames, in seconds")
+   :type number :ro :noarg))
 
 (defun can-set-projection-p (app)
   (and (slot-boundp app 'width)
diff --git a/src/assets/asset.lisp b/src/assets/asset.lisp
index 5f847da..e1b4f57 100644
--- a/src/assets/asset.lisp
+++ b/src/assets/asset.lisp
@@ -2,9 +2,10 @@
 
 (in-package #:wheelwork)
 
-(defclass/std asset ()
-  ((path :with :ri :std (error "An asset requires a path"))
-   (loadedp :with :a)))
+(def:class asset ()
+  ((path "Path to asset") :required :ro :prefix
+   :type (or pathname string))
+  (loadedp :prefix :type boolean :initform nil))
 
 (defmethod cleanup :around ((asset asset))
   (when (asset-loadedp asset)
diff --git a/src/assets/font.lisp b/src/assets/font.lisp
index 3ff29d5..3017572 100644
--- a/src/assets/font.lisp
+++ b/src/assets/font.lisp
@@ -6,10 +6,13 @@
   " 
 ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890\".,!?-'"  )
 
-(defclass/std font (asset)
-  ((characters :i :std +standard-font-chars+)
-   (oversample :i :doc "ovesampling factor to pass to cl-fond:make-font")
-   (object :with :r :doc "The font as returned from cl-fond:make-font")))
+(def:class font (asset)
+  ((characters "The characters renderable with this font")
+   :prefix :type string :initform +standard-font-chars+)
+  ((oversample "Oversampling factor")
+   :prefix :type (or null number) :initform nil)
+  ((object "Stored font returned by cl-fond")
+   :prefix :ro :type cl-fond::font))
 
 (defmethod ensure-loaded ((font font))
   (with-slots (path characters oversample object) font
diff --git a/src/assets/png.lisp b/src/assets/png.lisp
index aa259f0..4408d02 100644
--- a/src/assets/png.lisp
+++ b/src/assets/png.lisp
@@ -2,7 +2,7 @@
 
 (in-package #:wheelwork)
 
-(defclass/std png (asset texture) ())
+(def:class png (asset texture))
 
 (defmethod ensure-loaded ((png png))
   (with-slots
@@ -27,5 +27,6 @@
                        :unsigned-byte
                        (pngload:data data))
       (gl:bind-texture :texture-2d 0)
+      ;; what does this do?
       (when (texture-mipmap png)
         (gl:generate-mipmap :texture-2d)))))
diff --git a/src/canvas-language.lisp b/src/canvas-language.lisp
index b90e22d..1a8b12e 100644
--- a/src/canvas-language.lisp
+++ b/src/canvas-language.lisp
@@ -216,6 +216,11 @@ last points in PATH)."
       (apply-pen-at x y)))
   (setf *current-pen-position* (list left bottom)))
 
+(defun fill-region (region)
+  (with-slots (left bottom right top) region
+    (fill-rect left bottom right top)))
+
+
 (defun fill-rel-rect (dx dy)
   "Fills in a rectangle relative to current position."
   (destructuring-bind (sx sy) *current-pen-position*
diff --git a/src/core/unit.lisp b/src/core/unit.lisp
index 1102f20..308b715 100644
--- a/src/core/unit.lisp
+++ b/src/core/unit.lisp
@@ -2,15 +2,34 @@
 
 (in-package #:wheelwork)
 
-(defclass/std unit ()
-  ((cached-model cached-projected-matrix cached-rectangle :a)
-   (visiblep :with :std t)
-   (in-scene-p :with :a :std nil)
-   (region :with :std *application*
-                 :doc "The screen region where the unit will be visible.")
-   (base-width base-height :r :std 1.0 :doc "Determined by content.")
-   (scale-x scale-y :std 1.0)
-   (rotation x y :std 0.0)))
+(def:class unit ()
+  (cached-model cached-projected-matrix cached-rectangle
+   :initform nil :documentation "internal caches")
+
+  ((visiblep "Whether or not to render unit")
+   :prefix :type boolean :initform t)
+
+  ((in-scene-p "Indicates if unit is considered for display & events")
+   :prefix :type boolean :initform nil)
+
+  ((region "The screen region where this unit will be visible.")
+   :prefix :type region :initform *application*)
+
+  ((base-height "Content's base height")
+   (base-width "Content's base width")
+   :ro :type float :initform 1.0)
+
+  ((scale-x "Factor by which to resize base-width")
+   (scale-y "Factor by which to resize base-heght")
+   :type float :initform 1.0)
+
+  ((rotation "Rotation in radians about objects' bounding box center")
+   (x "X position, → is positive direction")
+   (y "Y position, ↑ is positive direction")
+   :type float :initform 0.0)
+  
+  :documentation "Fundamental display unit")
+
 
 (defmethod render :around ((unit unit))
   (when (unit-visiblep unit)
diff --git a/src/events/event-handler.lisp b/src/events/event-handler.lisp
index e9a26cd..62d8f54 100644
--- a/src/events/event-handler.lisp
+++ b/src/events/event-handler.lisp
@@ -2,10 +2,15 @@
 
 (in-package #:wheelwork)
 
-
-(defclass/std event-handler ()
-  ((event-type handler-function tag :ri))
-  (:metaclass closer-mop:funcallable-standard-class))
+;; TODO: make event-type a type
+(def:class event-handler ()
+  ((event-type "A symbol naming the sort of event this function handles")
+   :required :ro)
+  ((tag "A tag identifying this handler uniquely. Used to remove anonymous handlers")
+   :ro :type (or null string) :initform nil)
+  ((handler-function "The actual function this handler calls")
+   :required :ro :type function)
+  :metaclass closer-mop:funcallable-standard-class)
 
 (defmethod initialize-instance :after ((eh event-handler) &key)
   (with-slots (handler-function) eh
diff --git a/src/events/listener.lisp b/src/events/listener.lisp
index e66afe2..75a1e1b 100644
--- a/src/events/listener.lisp
+++ b/src/events/listener.lisp
@@ -2,32 +2,31 @@
 
 (in-package #:wheelwork)
 
-(defclass/std listener ()
-  ((keydown
-    keyup
-    mousedown
-    mouseup
-    mousemotion
-    mousewheel
-    focus
-    blur
-    perframe
-    :r :with :type (or null event-handler) :std nil)
-   (keydown-table
-    keyup-table
-    mousedown-table
-    mouseup-table
-    mousemotion-table
-    mousewheel-table
-    focus-table
-    blur-table
-    perframe-table
-    :static
-    :std (make-hash-table :synchronized t)
-    :doc "Keyed by DISPLAY-UNIT instance, holds an EVENT-HANDLER if
+(def:class listener ()
+  (keydown
+   keyup
+   mousedown
+   mouseup
+   mousemotion
+   mousewheel
+   focus
+   blur
+   perframe
+   :ro :prefix :type (or null event-handler) :initform nil)
+  (keydown-table
+   keyup-table
+   mousedown-table
+   mouseup-table
+   mousemotion-table
+   mousewheel-table
+   focus-table
+   blur-table
+   perframe-table
+   :noarg 
+   :allocation :class
+   :initform (make-hash-table :synchronized t :test #'eq)
+   :documentation "Keyed by DISPLAY-UNIT instance, holds an EVENT-HANDLER if
     handler is defined for unit."))
-  (:documentation "Event handlers per object. The static hash tables
-  are keyed by UNIT and hold Event-Handler instances."))
 
 (defun listener-table-for (listener event-type)
   (ecase event-type
diff --git a/src/gl/texture.lisp b/src/gl/texture.lisp
index 0aa698f..2b555a6 100644
--- a/src/gl/texture.lisp
+++ b/src/gl/texture.lisp
@@ -2,11 +2,17 @@
 
 (in-package #:wheelwork)
 
-(defclass/std texture ()
-  ((width height id mipmap :with :r :i)
-   (internal-format image-format :ri :with :std :rgba)
-   (wrap-s wrap-t :ri :with :std :repeat)
-   (min-filter mag-filter :ri :with :std :nearest)))
+;; TODO: make deftypes for keyword valued slots
+(def:class texture ()
+  (width height :prefix :ro :type float)
+  ((id "Texture id assigned by gl:gen-texture")
+   :prefix :ro :type (unsigned-byte 32))
+  ((mipmap "Whether to generate mipmap")
+   :prefix :ro :type boolean :initform nil)
+  (internal-format image-format :ro :prefix :type keyword :initform :rgba)
+  (wrap-s wrap-t :prefix :ro :type keyword :initform :repeat)
+  (min-filter mag-filter :prefix :ro :type keyword :initform :nearest))
+
 
 (defmethod cleanup ((texture texture))
   (gl:delete-texture (texture-id texture)))
diff --git a/src/grid-geometry.lisp b/src/grid-geometry.lisp
index 3597e75..f66a41f 100644
--- a/src/grid-geometry.lisp
+++ b/src/grid-geometry.lisp
@@ -86,8 +86,8 @@ top right corners of the bounding box for POLY "
                      ,interior-clause))))))
 
 (defmacro with-grid-rect ((x y) (left bottom right top) &body body)
-  `(loop for ,x from ,left to ,right do
-    (loop for ,y from ,bottom to ,top do ,@body )))
+  `(loop for ,x from (floor ,left) to (floor ,right) do
+    (loop for ,y from (floor ,bottom) to (floor ,top) do ,@body )))
 
 (defmacro with-grid-circle
     ((x y) (cx cy radius &key interiorp) &body body)
diff --git a/src/interactive/canvas.lisp b/src/interactive/canvas.lisp
index af54634..f4b2b74 100644
--- a/src/interactive/canvas.lisp
+++ b/src/interactive/canvas.lisp
@@ -2,9 +2,11 @@
 
 (in-package #:wheelwork)
 
-(defclass/std pixels ()
-  ((pixel-width pixel-height :std (error "pixel-width and pixel-height are required"))
-   (data :a :with :doc "Array of RGBA data representing an image of pixel-width X pixel-height")))
+(def:class pixels ()
+  (pixel-width pixel-height :required :type fixnum)
+  (data :prefix
+        :type (vector (unsigned-byte 8))
+        :documentation "Array of RGBA data"))
 
 (defmethod initialize-instance :after ((pixels pixels) &key)
   (with-slots (pixel-width pixel-height data) pixels
@@ -145,14 +147,15 @@ e.g., drawing a line in a particular color."
                        (gl:delete-vertex-arrays (list *canvas-render-vao*)))
                      (when *canvas-shader-program*
                        (gl:delete-program *canvas-shader-program*))
-                     (setf-many *canvas-fbo-vao*
-                                *canvas-render-vao*
+                     (setf-many *canvas-render-vao*
                                 *canvas-shader-program*
                                 nil)))))
 
-(defclass/std canvas (unit interactive pixels)
-  ((fbo :with :r :doc "framebuffer object for use in off-screen-rendering of this canvas to a texture")
-   (texture :with :a :doc "texture instance")))
+(def:class canvas (unit interactive pixels)
+  ((fbo "framebuffer object for use in off-screen rendering of this canvas to a texture")
+   :prefix :ro)
+  ((texture "the texture where the pixles are rendered")
+   :prefix))
 
 (defmethod cleanup ((canvas canvas))
   (cleanup (canvas-texture canvas))
diff --git a/src/interactive/frameset.lisp b/src/interactive/frameset.lisp
index c866d04..65762c7 100644
--- a/src/interactive/frameset.lisp
+++ b/src/interactive/frameset.lisp
@@ -2,12 +2,20 @@
 
 (in-package #:wheelwork)
 
-(defclass/std frameset (unit interactive)
-  ((frames :with :doc "an array of renderable frames")
-   (sequence :with :doc "an array of indices into frames")
-   (runningp  :std t)
-   (wait-time :std (/ 1000.0 2) :with :doc "milliseconds between frames")
-   (count index next-time :with :std 0 :a)))
+;; TODO: be more specific about vector types 
+(def:class frameset (unit interactive)
+  ((frames "Vector of renderable frames.") 
+   :prefix :type vector)
+  ((sequence "Vector of indicies into the frame controlling order of display")
+   :prefix :type vector)
+  ((runningp "Whether this set is animating by cycling through frames")
+   :type boolean :initform t)
+  ((wait-time "Milliseconds between frames")
+   :prefix :initform (/ 1000.0 2))
+  ((count "")
+   (index "")
+   (next-time "")
+   :prefix :initform 0))
 
 (defmethod (setf fps) (newval (fs frameset))
   (setf (frameset-wait-time fs) (/ 1000.0 newval)))
diff --git a/src/interactive/image.lisp b/src/interactive/image.lisp
index 644c06e..a0fce09 100644
--- a/src/interactive/image.lisp
+++ b/src/interactive/image.lisp
@@ -4,11 +4,12 @@
 
 (defvar *image-shader-program* nil
   "Cached for later cleanup.")
+
 (defvar *image-vao* nil)
 
-(defclass/std image (unit interactive)
-  ((texture :ri :std (error "A image requires a texture."))
-   (alpha :std 1.0)))
+(def:class image (unit interactive)
+  (texture :required :ro :type texture)
+  (alpha :type float :initform 1.0))
 
 (defun make-shared-image-gpu-objects ()
   (unless *image-shader-program*
diff --git a/src/interactive/interactive.lisp b/src/interactive/interactive.lisp
index 11bc5ca..74a22d1 100644
--- a/src/interactive/interactive.lisp
+++ b/src/interactive/interactive.lisp
@@ -2,10 +2,13 @@
 
 (in-package #:wheelwork)
 
-(defclass/std interactive ()
-  ((listener :type (or null listener) :std nil :a)
-   (focusablep :std t :doc "Whether or not this object can receive application focus."))
-  (:documentation "Supplies an object with a listener slot."))
+(def:class interactive ()
+  (listener :type (or null listener) :initform nil)
+
+  ((focusablep "Whether or not this object can receive application focus")
+   :type boolean :initform nil)
+
+  :documentation "Supplies an object with an event listener")
 
 (defun remove-all-handlers (interactive)
   (loop
diff --git a/src/interactive/sprite.lisp b/src/interactive/sprite.lisp
index 68f8a8d..dd9b2a1 100644
--- a/src/interactive/sprite.lisp
+++ b/src/interactive/sprite.lisp
@@ -2,9 +2,11 @@
 
 (in-package #:wheelwork)
 
-(defclass/std sprite (unit interactive)
-  ((framesets :with :doc "A PLIST whose values are framesets.")
-   (frameset-key :with :doc "The current name of the frameset being displayed.")))
+(def:class sprite (unit interactive)
+  ((framesets "A PLIST whose values are framesets")
+   :required :prefix)
+  ((frameset-key "The name of the current frameset being displayed")
+   :required :prefix))
 
 (defun current-frameset (sprite)
   "Returns the current FRAMESET instance being displayed on SRPITE."
diff --git a/src/interactive/text.lisp b/src/interactive/text.lisp
index d79f7bf..73e25e4 100644
--- a/src/interactive/text.lisp
+++ b/src/interactive/text.lisp
@@ -2,13 +2,13 @@
 
 (in-package #:wheelwork)
 
-(defclass/std text (unit interactive)
-  ((font :with :ri :std (error "A font is required") :type font)
-   (content :with :ri :std "")
-   (color :with :std #(1.0 1.0 1.0 1.0))
-   (vao elem-count newlines :r)
-   (shader :with :static :r)))
-
+(def:class text (unit interactive)
+  (font :prefix :ro :required :type font)
+  (content :prefix :ro :type string :initform "")
+  ((color "RGBA values")
+   :prefix :type (vector float 4) :initform (vector 1.0 1.0 1.0 1.0))
+  (vao elem-count newlines :ro :type (unsigned-byte 32))
+  (shader :prefix :ro :allocation :class))
 
 (defmethod model-matrix ((text text))
   (let ((m (mat:meye 4)))
@@ -19,20 +19,23 @@
               (* newlines text-height))
              (rotation-baseline-offset
                (* 2 newlines text-height )))
-        (mat:nmtranslate m (vec:vec x
-                                    (+ y
-                                       (*
-                                        scale-y
-                                        baseline-offset))
-                                    0.0))
+        (mat:nmtranslate
+         m (vec:vec x
+                    (+ y
+                       (*
+                        scale-y
+                        baseline-offset))
+                    0.0))
 
-        (mat:nmtranslate m (vec:v* 0.5 (vec:vec (* scale-x base-width)
-                                                (* scale-y (- base-height rotation-baseline-offset) )
-                                                0.0)))
+        (mat:nmtranslate
+         m (vec:v* 0.5 (vec:vec (* scale-x base-width)
+                                (* scale-y (- base-height rotation-baseline-offset) )
+                                0.0)))
         (mat:nmrotate  m vec:+vz+ rotation)
-        (mat:nmtranslate m (vec:v* -0.5 (vec:vec (* scale-x base-width )
-                                                 (* scale-y (- base-height rotation-baseline-offset))
-                                                 0.0))))
+        (mat:nmtranslate
+         m (vec:v* -0.5 (vec:vec (* scale-x base-width )
+                                 (* scale-y (- base-height rotation-baseline-offset))
+                                 0.0))))
       
       (mat:nmscale m (vec:vec scale-x scale-y 1.0))
       m)))
diff --git a/src/package.lisp b/src/package.lisp
index f0bf462..6e873e9 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -5,7 +5,6 @@
   (:nicknames #:ww)
   (:local-nicknames (#:mat #:3d-matrices)
                     (#:vec #:3d-vectors))
-  (:import-from #:defclass-std #:defclass/std)
   (:import-from #:alexandria-2
                 #:when-let #:when-let* #:if-let #:with-gensyms)
   (:export
diff --git a/src/region.lisp b/src/region.lisp
index 4f22763..4b86aeb 100644
--- a/src/region.lisp
+++ b/src/region.lisp
@@ -2,8 +2,8 @@
 
 (in-package :wheelwork)
 
-(defclass/std region ()
-  ((left bottom top right :with :std 0)))
+(def:class region ()
+  (left bottom top right :prefix :initform 0))
 
 (defmethod width ((region region))
   (- (region-right region) (region-left region)))