diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/application.lisp | 64 | ||||
| -rw-r--r-- | src/assets/asset.lisp | 7 | ||||
| -rw-r--r-- | src/assets/font.lisp | 11 | ||||
| -rw-r--r-- | src/assets/png.lisp | 3 | ||||
| -rw-r--r-- | src/core/unit.lisp | 37 | ||||
| -rw-r--r-- | src/events/event-handler.lisp | 13 | ||||
| -rw-r--r-- | src/events/listener.lisp | 49 | ||||
| -rw-r--r-- | src/gl/texture.lisp | 16 | ||||
| -rw-r--r-- | src/interactive/canvas.lisp | 19 | ||||
| -rw-r--r-- | src/interactive/frameset.lisp | 20 | ||||
| -rw-r--r-- | src/interactive/image.lisp | 7 | ||||
| -rw-r--r-- | src/interactive/interactive.lisp | 11 | ||||
| -rw-r--r-- | src/interactive/sprite.lisp | 8 | ||||
| -rw-r--r-- | src/interactive/text.lisp | 41 | ||||
| -rw-r--r-- | src/package.lisp | 1 | ||||
| -rw-r--r-- | src/region.lisp | 4 |
16 files changed, 182 insertions, 129 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/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/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))) |