diff options
28 files changed, 289 insertions, 213 deletions
diff --git a/examples/02-image-transforms-and-events.lisp b/examples/02-image-transforms-and-events.lisp index 9e4710f..b81f788 100644 --- a/examples/02-image-transforms-and-events.lisp +++ b/examples/02-image-transforms-and-events.lisp @@ -131,14 +131,15 @@ (defun start () - (ww::start (make-instance 'image-transforms-etc - :scale 2.0 - :fps 60 - :width 800 - :height 600 - :asset-root (merge-pathnames - "examples/" - (asdf:system-source-directory :wheelwork))))) + (ww::start + (make-instance 'image-transforms-etc + :scale 2.0 + :fps 60 + :width 800 + :height 600 + :asset-root (merge-pathnames + "examples/" + (asdf:system-source-directory :wheelwork))))) diff --git a/examples/03-font-render.lisp b/examples/03-font-render.lisp index de3c487..ba575ca 100644 --- a/examples/03-font-render.lisp +++ b/examples/03-font-render.lisp @@ -44,21 +44,18 @@ (remhash target *spin-table*)))))) (ww::defhandler twirl-on-click - (ww::on-mousedown () - (ww::add-handler target #'spin))) + (ww::on-mousedown () + (ww::add-handler target #'spin))) (defmethod ww::boot ((app font-display)) (let ((hello - (make-instance - 'ww::text - ;:content "Hell! Oh World ..." - :content (format nil "Hell!~%Oh World...") - :font (ww::get-asset "Ticketing.ttf" :asset-args '(:oversample 2)))) + (make-instance 'ww::text + :content (format nil "Hell!~%Oh World...") + :font (ww::get-asset "Ticketing.ttf" :asset-args '(:oversample 2)))) (instructions - (make-instance - 'ww::text - :content "Click to spin. Press any key to change color." - :font (ww::get-asset "Ticketing.ttf")))) + (make-instance 'ww::text + :content "Click to spin. Press any key to change color." + :font (ww::get-asset "Ticketing.ttf")))) (ww::scale-by hello 3.0) (setf @@ -77,16 +74,16 @@ (defun start () - (ww::start (make-instance - 'font-display - :fps 60 - :refocus-on-mousedown-p nil - :width 800 - :height 600 - :title "Wheelwork Example: Font display" - :asset-root (merge-pathnames - "examples/" - (asdf:system-source-directory :wheelwork))))) + (ww::start + (make-instance 'font-display + :fps 60 + :refocus-on-mousedown-p nil + :width 800 + :height 600 + :title "Wheelwork Example: Font display" + :asset-root (merge-pathnames + "examples/" + (asdf:system-source-directory :wheelwork))))) diff --git a/examples/08-pong.lisp b/examples/08-pong.lisp index 574eacd..ecc529b 100644 --- a/examples/08-pong.lisp +++ b/examples/08-pong.lisp @@ -2,21 +2,30 @@ (defpackage #:ww.examples/8 (:use #:cl) - (:export #:start) - (:import-from #:defclass-std #:defclass/std)) + (:export #:start)) (in-package #:ww.examples/8) ;;; CLASSES -(defclass/std solo-pong (ww::application) - ((paddle ball game-over intro-text))) +(def:class solo-pong (ww::application) + (paddle ball game-over intro-text)) -(defclass/std mobile () - ((dx dy dr :std 0))) +;; (defclass/std solo-pong (ww::application) +;; ((paddle ball game-over intro-text))) -(defclass/std paddle (ww::image mobile) ()) -(defclass/std ball (ww::image mobile) ()) +(def:class mobile () + (dx dy dr :initform 0)) + + +;; (defclass/std mobile () +;; ((dx dy dr :std 0))) + +(def:class paddle (ww:image mobile)) +(def:class ball (ww:image mobile)) + +;; (defclass/std paddle (ww::image mobile) ()) +;; (defclass/std ball (ww::image mobile) ()) ;;; UTILITY FUNCTIONS diff --git a/examples/09-ghoulspree.lisp b/examples/09-ghoulspree.lisp index 33a5423..04b1043 100644 --- a/examples/09-ghoulspree.lisp +++ b/examples/09-ghoulspree.lisp @@ -2,20 +2,20 @@ (defpackage #:ww.examples/9 (:use #:cl) - (:export #:start) - (:import-from #:defclass-std #:defclass/std)) + (:export #:start)) (in-package #:ww.examples/9) ;;; CLASSES -(defclass/std ghoulspree (ww::application) - ((ghouls-per-click :std 20) - (collision-on-p :std t) - (gravity-on-p :std nil))) +(def:class ghoulspree (ww:application) + (ghouls-per-click :type fixnum :initform 20) + (collision-on-p :type boolean :initform t) + (gravity-on-p :type boolean :initform nil)) + +(def:class ghoul (ww:image) + (dx dy dr :type fixnum :initform 0)) -(defclass/std ghoul (ww:image) - ((dx dy dr :std))) ;;; UTILITY FUNCTIONS diff --git a/examples/10-canvas-sneks.lisp b/examples/10-canvas-sneks.lisp index ef5d1d5..52c71fd 100644 --- a/examples/10-canvas-sneks.lisp +++ b/examples/10-canvas-sneks.lisp @@ -2,25 +2,24 @@ (defpackage #:ww.examples/10 (:use #:cl) - (:export #:start) - (:import-from #:defclass-std #:defclass/std)) + (:export #:start)) (in-package #:ww.examples/10) ;;; CLASSES -(defclass/std sneking (ww:application) - ((sneks snek-pit) - (population :std 10))) - -(defclass/std snek () - ((x y) - (dx dy :std 1) - (brain :std 0.0) - (bod :std (list)) - (len :std 4) - (color :std (list 255 255 255)) - (home :std (list 0 0 100 100)))) +(def:class sneking (ww:application) + (sneks snek-pit :initform nil) + (population :initform 10)) + +(def:class snek () + (x y dx dy :initform 1) + (brain :initform 0.0) + (bod :initform (list)) + (len :initform 4) + (color :initform (list 255 255 255)) + (home :initform (list 0 0 100 100)) + :documentation "A SNEK is a contiguous chain of virtual pixels (i.e. square blocks of color), all the same coloor") (defun snek-is-home-p (snek) (with-slots (x y home) snek diff --git a/examples/12-canvas-drawing-language.lisp b/examples/12-canvas-drawing-language.lisp index a727f7b..7c71dea 100644 --- a/examples/12-canvas-drawing-language.lisp +++ b/examples/12-canvas-drawing-language.lisp @@ -1,4 +1,4 @@ -;;;; examples/13-canvas-drawing-language.lisp +;;;; examples/12-canvas-drawing-language.lisp (defpackage #:ww.examples/12 (:use #:cl) diff --git a/gui/button.lisp b/gui/button.lisp index b4a41e9..bebea08 100644 --- a/gui/button.lisp +++ b/gui/button.lisp @@ -2,14 +2,21 @@ (in-package #:wheelwork) -(defclass/std button (unit interactive) - ((up down :with - :std (error "UP and DOWN lots are required") - :doc "Any affine renderable unit") - (bg :with) - (on-press on-release :with :doc "Function accepting the button.")) - (:documentation "A basic button class. The UP and DOWN slots should - be filled with renderable objects having the same size.")) +(def:class button (unit interactive) + ((up "Image when button is up") + (down "Image when button is down") + :required :prefix :type unit) + ((bg "optional background image") + :prefix + :type (or null unit) + :initform nil) + (on-press + on-release + :prefix + :type function + :documentation "Function accepting the BUTTON instance.") + + :documentation "Basic button. UP and DOWN should be the same size.") (defhandler button-released (on-mouseup () diff --git a/gui/menus.lisp b/gui/menus.lisp index 25abd7b..a477dd9 100644 --- a/gui/menus.lisp +++ b/gui/menus.lisp @@ -2,12 +2,13 @@ (in-package :wheelwork) -(defclass/std menu (unit interactive) - ((items :with :std nil - :doc "A list of interactive units") - (focus :with :std nil - :doc "The item that is focused in this menu, if any.") - (region :std (error "Menus require an explicit region")))) +(def:class menu (unit interactive) + ((items "list of interactive units in the menu") + :prefix :type list :initform nil) + ((focus "Object of menu with current focus.") + :prefix :type (or null unit) :initform nil) + ((region "Region where menu is displayed.") + :required :type region)) (defmethod cleanup :after ((menu menu)) (loop for item in (menu-items menu) do (cleanup item))) @@ -85,10 +86,13 @@ (render o))) -(defclass/std vscroller (menu) - ((scroll-speed :std 1) - (vert-scroll :std 0 - :doc "Vertical distance items have been displaced."))) +(def:class vscroller (menu) + (scroll-speed :type fixnum :initform 1) + (vert-scroll + :type fixnum + :initform 0 + :documentation "Vertical distance items have been displaced.")) + (defmethod (setf vert-scroll) :after (val (vs vscroller)) (loop 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))) diff --git a/wheelwork-examples.asd b/wheelwork-examples.asd index 3243831..2834c20 100644 --- a/wheelwork-examples.asd +++ b/wheelwork-examples.asd @@ -4,7 +4,7 @@ :license "GPL-3.0" :version "0.0.1" :serial t - :depends-on (#:wheelwork #:wheelwork-gui) + :depends-on (#:wheelwork #:wheelwork-gui #:def) :pathname "examples/" :components ((:file "01-click-and-drag-image") (:file "02-image-transforms-and-events") diff --git a/wheelwork.asd b/wheelwork.asd index c2fa044..a5626df 100644 --- a/wheelwork.asd +++ b/wheelwork.asd @@ -4,17 +4,18 @@ :description "A sprite system for games and GUIs" :author "colin <colin@cicadas.surf>" :license "GPL-3.0" - :version "0.0.2" + :version "0.1.0" :serial t :depends-on (#:cl-opengl #:sdl2 #:varjo - #:defclass-std #:3d-vectors #:3d-matrices #:pngload #:closer-mop - #:cl-fond) + #:cl-fond + #:def + #:flatbind) :pathname "src/" :components ((:file "package") (:file "protocol") |