From 2340c1a09895502667c9ba75c3db73b555ef40aa Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Mon, 27 Jun 2022 15:06:12 -0500 Subject: [modify] unit model-matrix [add] text model-matrix [add] scale funs --- examples/03-font-render.lisp | 32 +++++++++------ wheelwork.lisp | 92 ++++++++++++++++++++++++++++++++++++-------- 2 files changed, 95 insertions(+), 29 deletions(-) diff --git a/examples/03-font-render.lisp b/examples/03-font-render.lisp index a854843..3a3d659 100644 --- a/examples/03-font-render.lisp +++ b/examples/03-font-render.lisp @@ -15,37 +15,45 @@ (ww::on-keydown () "Press any key to change the color of the text" (format t "Pressed a key, changing the color~%") - (setf (ww::text-color target) (random-text-color)))) + (setf (ww::text-color target) (random-text-color)) + + (with-accessors ((x ww::unit-x) (y ww::unit-y) (w ww::unit-width) (h ww::unit-height)) target + (format t "x:~a,y:~a,width:~a,height:~a~%" x y w h)))) (ww::defhandler marquee (ww::on-perframe () (when (< 900 (ww::unit-x target)) (setf (ww::unit-x target) -800)) - (incf (ww::unit-x target) 5))) + ;(incf (ww::unit-x target) 5) + )) (defmethod ww::boot ((app font-display)) (let ((hello (make-instance 'ww::text + ;:content "Yom" :content "Hell! Oh World..." :font (ww::get-asset "Ticketing.ttf" :asset-args '(:oversample 2))))) - (setf (ww::unit-width hello) - (* 5 (ww::unit-width hello)) - - (ww::unit-height hello) - (* 5 (ww::unit-height hello)) - - (ww::unit-x hello) 100 - - (ww::unit-y hello) 400) + + (ww::set-height-preserve-aspect hello 100) + (setf + (ww::unit-x hello) 100 + + (ww::unit-y hello) 400) + (ww::add-handler hello #'marquee) (ww::add-handler hello #'change-text-color) + (ww::add-handler hello (ww::on-mousedown () (format t "I Was Clicked at ~a,~a!~%" + x y))) (ww::refocus-on hello) - (ww::add-unit app hello))) + (describe hello) + + (ww::add-unit app hello) + )) (defun start () diff --git a/wheelwork.lisp b/wheelwork.lisp index 16eccad..5807f30 100644 --- a/wheelwork.lisp +++ b/wheelwork.lisp @@ -8,14 +8,47 @@ (defclass/std unit () ((cached-model cached-projected-matrix :a) (container :with :a) - (width height :with :std 1.0) + (base-width base-height :r :std 1.0 :doc "Determined by content.") + (scale-x scale-y :with :std 1.0) (rotation x y :with :std 0.0) (opacity :std 1.0 :doc "0.0 indicates it will not be rendred."))) +(defgeneric unit-width (unit)) +(defgeneric unit-height (unit)) +(defgeneric (setf unit-width) (newval unit)) +(defgeneric (setf unit-height) (newval unit)) + +(defun scale-by (unit amount) + (with-slots (scale-x scale-y) unit + (setf scale-x (* amount scale-x) + scale-y (* amount scale-y)))) + +(defun set-width-preserve-aspect (unit new-width) + (scale-by unit (/ new-width (unit-width unit)))) + +(defun set-height-preserve-aspect (unit new-height) + (scale-by unit (/ new-height (unit-height unit) ))) + +(defmethod unit-width ((unit unit)) + (with-slots (scale-x base-width) unit + (* scale-x base-width))) + +(defmethod unit-height ((unit unit)) + (with-slots (scale-y base-height) unit + (* scale-y base-height))) + +(defmethod (setf unit-width) (newval (unit unit)) + (with-slots (scale-x base-width) unit + (setf scale-x (coerce (/ newval base-width) 'single-float)))) + +(defmethod (setf unit-height) (newval (unit unit)) + (with-slots (scale-y base-height) unit + (setf scale-y (coerce (/ newval base-height) 'single-float)))) + (defmethod (setf closer-mop:slot-value-using-class) :after (newval class (unit unit) slot) (case (closer-mop:slot-definition-name slot) - ((x y width height rotation ) + ((x y scale-x scale-y rotation) (setf (cached-model unit) nil (cached-projected-matrix unit) nil)))) @@ -296,18 +329,24 @@ necessary." (:documentation "Returns the raw array of the model matrix after it has been prjected by the application's projecion matrix")) -(defmethod model-matrix ((u unit)) +(defmethod model-matrix :around ((u unit)) (or (cached-model u) (setf (cached-model u) - (let ((m (mat:meye 4))) - (mat:nmtranslate m (vec:vec (unit-x u) (unit-y u) 0.0)) + (call-next-method)))) - (mat:nmtranslate m (vec:v* 0.5 (vec:vec (unit-width u) (unit-height u) 0.0))) - (mat:nmrotate m vec:+vz+ (unit-rotation u)) - (mat:nmtranslate m (vec:v* -0.5 (vec:vec (unit-width u) (unit-height u) 0.0))) - - (mat:nmscale m (vec:vec (unit-width u) (unit-height u) 1.0)) - m)))) +(defmethod model-matrix ((u unit)) + (let ((m (mat:meye 4))) + (with-slots (x y base-width scale-x base-height scale-y rotation) u + (let ((uw (* base-width scale-x)) + (uh (* base-height scale-y))) + (mat:nmtranslate m (vec:vec x y 0.0)) + + (mat:nmtranslate m (vec:v* 0.5 (vec:vec uw uh 0.0))) + (mat:nmrotate m vec:+vz+ rotation) + (mat:nmtranslate m (vec:v* -0.5 (vec:vec uw uh 0.0))) + + (mat:nmscale m (vec:vec uw uh 1.0)))) + m)) (defmethod projected-matrix ((thing unit)) (or (cached-projected-matrix thing) @@ -400,7 +439,7 @@ TARGET is FOCUSABLEP" (sdl2:mod-keywords (sdl2:mod-value sdl-keysym)))))) (defun contains-point-p (unit px py) - (with-slots (x y width height) unit + (with-accessors ((x unit-x) (y unit-y) (width unit-width) (height unit-height)) unit (and (<= x px (+ x width)) (<= y py (+ y height))))) @@ -548,9 +587,9 @@ give focus to whatever was clicked." (cffi:foreign-type-size :float)) (defmethod initialize-instance :after ((bitmap bitmap) &key) - (with-slots (vao shader width height texture) bitmap - (setf height (texture-height texture) - width (texture-width texture)) + (with-slots (vao shader base-width base-height texture) bitmap + (setf base-height (texture-height texture) + base-width (texture-width texture)) (unless shader (setf shader (create-shader @@ -647,8 +686,24 @@ ASSET-ARGS is a plist to pass to make-instance for the given resource. (vao elem-count :r) (shader :with :static :r))) +(defmethod model-matrix ((text text)) + (let ((m (mat:meye 4))) + (with-slots (x y base-width base-height scale-x scale-y rotation) text + (mat:nmtranslate m (vec:vec x y 0.0)) + + (mat:nmtranslate m (vec:v* 0.5 (vec:vec (* scale-x base-width) + (* scale-y base-height) + 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) + 0.0))) + + (mat:nmscale m (vec:vec scale-x scale-y 1.0))) + m)) + (defmethod initialize-instance :after ((text text) &key) - (with-slots (content font vao elem-count shader) text + (with-slots (content font vao elem-count shader base-width base-height scale-x scale-y) text (unless shader (setf shader (create-shader @@ -665,7 +720,10 @@ ASSET-ARGS is a plist to pass to make-instance for the given resource. ((* color (aref (vari:texture tex tc) 0))))))) (multiple-value-bind (vao% count%) (cl-fond:compute-text (font-object font) content) (setf vao vao% - elem-count count%)))) + elem-count count%)) + (hq:with-plist (l r (top t) b) (cl-fond:compute-extent (font-object font) content) + (setf base-width ((- r l)) + base-height (+ top b))))) (defmethod cleanup ((text text)) (with-slots (vao shader) text -- cgit v1.2.3