From 3c1df8b7807f772887dc3d85725059c4dbe75cca Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Tue, 19 Jul 2022 06:45:16 -0500 Subject: [rename] bitmap/image --- README.org | 4 +- examples/01-click-and-drag-bitmap.lisp | 51 -------------------- examples/01-click-and-drag-image.lisp | 51 ++++++++++++++++++++ examples/02-moving-bitmp.lisp | 12 ++--- examples/07-renderarea.lisp | 2 +- examples/08-pong.lisp | 4 +- examples/09-ghoulspree.lisp | 2 +- examples/README.txt | 4 +- src/interactive/bitmap.lisp | 86 ---------------------------------- src/interactive/button.lisp | 4 +- src/interactive/frameset.lisp | 2 +- src/interactive/image.lisp | 86 ++++++++++++++++++++++++++++++++++ src/package.lisp | 2 +- wheelwork-examples.asd | 2 +- wheelwork.asd | 2 +- 15 files changed, 157 insertions(+), 157 deletions(-) delete mode 100644 examples/01-click-and-drag-bitmap.lisp create mode 100644 examples/01-click-and-drag-image.lisp delete mode 100644 src/interactive/bitmap.lisp create mode 100644 src/interactive/image.lisp diff --git a/README.org b/README.org index 1deaeca..f266ef9 100644 --- a/README.org +++ b/README.org @@ -142,7 +142,7 @@ There are a few convenience functions also defined that use the above functions The affine units are things like: -+ ~bitmap~: display an image that has been loaded from a file asset (currently only png is supported) ++ ~image~: display an image that has been loaded from a file asset (currently only png is supported) + ~text~: display text + ~frameset~: display an animated sequence of images + ~sprite~: display a "bundle" of framesets @@ -264,7 +264,7 @@ Assets are resources loaded from disk. The application's ~asset-classifiers~ l Every asset has a "key", which is just a string path name that is relative to the application's ~asset-root~. These keys are used by ~get-asset~ to fetch assets, possibly loading them for the first time if they have not been previously fetched. -Some classes (like ~text~ or ~bitmap~) require an instance of an asset class to fill one of their instance slots (like ~font~ or ~texture~) in order to work properly. +Some classes (like ~text~ or ~image~) require an instance of an asset class to fill one of their instance slots (like ~font~ or ~texture~) in order to work properly. E.g. In ~examples/03-font-render.lisp~ you see diff --git a/examples/01-click-and-drag-bitmap.lisp b/examples/01-click-and-drag-bitmap.lisp deleted file mode 100644 index 4bcdba8..0000000 --- a/examples/01-click-and-drag-bitmap.lisp +++ /dev/null @@ -1,51 +0,0 @@ -;;; 01-bitmap-display.lisp - -(defpackage #:ww.examples/1 - (:use #:cl) - (:export #:start)) - -(in-package :ww.examples/1) - -(defclass bitmap-display (ww::application ) ()) - -(ww::defhandler dragging-unit - (ww::on-mousemotion (app x y) - (let ((unit - (first (ww:container-units app)))) - (setf (ww:x unit) x - (ww:y unit) y)))) - -(ww:defhandler start-drag - (ww:on-mousedown (target) - (ww::add-handler - (ww::unit-container target) - #'dragging-unit))) - -(ww:defhandler stop-drag - (ww::on-mouseup (app) - (ww::remove-handler app #'dragging-unit))) - - -(defmethod ww::boot ((app bitmap-display)) - (let ((bm - (make-instance 'ww::bitmap - :texture (ww::get-asset "Fezghoul.png")))) - (describe (ww::model-matrix bm)) - (describe bm) - (describe app) - (ww::add-unit app bm) - (ww::add-handler bm #'start-drag) - (ww::add-handler app #'stop-drag) - (format t "CLICK AND DRAG THE GHOUL~%") - )) - - -(defun start () - (ww::start - (make-instance - 'bitmap-display - :mouse-button-events-bubble-p t - :mouse-motion-events-bubble-p t - :asset-root (merge-pathnames - "examples/" - (asdf:system-source-directory :wheelwork))))) diff --git a/examples/01-click-and-drag-image.lisp b/examples/01-click-and-drag-image.lisp new file mode 100644 index 0000000..d13bce3 --- /dev/null +++ b/examples/01-click-and-drag-image.lisp @@ -0,0 +1,51 @@ +;;; 01-image-display.lisp + +(defpackage #:ww.examples/1 + (:use #:cl) + (:export #:start)) + +(in-package :ww.examples/1) + +(defclass image-display (ww::application ) ()) + +(ww::defhandler dragging-unit + (ww::on-mousemotion (app x y) + (let ((unit + (first (ww:container-units app)))) + (setf (ww:x unit) x + (ww:y unit) y)))) + +(ww:defhandler start-drag + (ww:on-mousedown (target) + (ww::add-handler + (ww::unit-container target) + #'dragging-unit))) + +(ww:defhandler stop-drag + (ww::on-mouseup (app) + (ww::remove-handler app #'dragging-unit))) + + +(defmethod ww::boot ((app image-display)) + (let ((bm + (make-instance 'ww::image + :texture (ww::get-asset "Fezghoul.png")))) + (describe (ww::model-matrix bm)) + (describe bm) + (describe app) + (ww::add-unit app bm) + (ww::add-handler bm #'start-drag) + (ww::add-handler app #'stop-drag) + (format t "CLICK AND DRAG THE GHOUL~%") + )) + + +(defun start () + (ww::start + (make-instance + 'image-display + :mouse-button-events-bubble-p t + :mouse-motion-events-bubble-p t + :asset-root (merge-pathnames + "examples/" + (asdf:system-source-directory :wheelwork))))) diff --git a/examples/02-moving-bitmp.lisp b/examples/02-moving-bitmp.lisp index b07f1aa..d0a5598 100644 --- a/examples/02-moving-bitmp.lisp +++ b/examples/02-moving-bitmp.lisp @@ -1,4 +1,4 @@ -;;; 01-bitmap-display.lisp +;;; 01-image-display.lisp (defpackage #:ww.examples/2 (:use #:cl) @@ -6,7 +6,7 @@ (in-package :ww.examples/2) -(defclass bitmap-display (ww::application ) ()) +(defclass image-display (ww::application ) ()) (defvar *shared-anim-table* (make-hash-table :synchronized t)) @@ -100,12 +100,12 @@ (ww::on-mousewheel () (print (list :mousewheel horiz vert dir)))) -(defmethod ww::boot ((app bitmap-display)) +(defmethod ww::boot ((app image-display)) (let ((bm - (make-instance 'ww::bitmap + (make-instance 'ww::image :texture (ww::get-asset "Fezghoul.png"))) (bm2 - (make-instance 'ww::bitmap + (make-instance 'ww::image :texture (ww::get-asset "GelatinousCube.png")))) (ww::add-handler app #'wheelie) @@ -130,7 +130,7 @@ (defun start () - (ww::start (make-instance 'bitmap-display + (ww::start (make-instance 'image-display :scale 2.0 :fps 60 :width 800 diff --git a/examples/07-renderarea.lisp b/examples/07-renderarea.lisp index 78d116b..95a6e9d 100644 --- a/examples/07-renderarea.lisp +++ b/examples/07-renderarea.lisp @@ -32,7 +32,7 @@ (defmethod ww::boot ((app scrollarea-example)) (let ((cube (make-instance - 'ww::bitmap + 'ww::image :texture (ww::get-asset "GelatinousCube.png"))) (cube-container (make-instance diff --git a/examples/08-pong.lisp b/examples/08-pong.lisp index 6fc9faa..f40e66d 100644 --- a/examples/08-pong.lisp +++ b/examples/08-pong.lisp @@ -15,8 +15,8 @@ (defclass/std mobile () ((dx dy dr :std 0))) -(defclass/std paddle (ww::bitmap mobile) ()) -(defclass/std ball (ww::bitmap 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 463eb89..cf18e31 100644 --- a/examples/09-ghoulspree.lisp +++ b/examples/09-ghoulspree.lisp @@ -14,7 +14,7 @@ (collision-on-p :std t) (gravity-on-p :std nil))) -(defclass/std ghoul (ww:bitmap) +(defclass/std ghoul (ww:image) ((dx dy dr :std))) ;;; UTILITY FUNCTIONS diff --git a/examples/README.txt b/examples/README.txt index 30d8891..ac2d40f 100644 --- a/examples/README.txt +++ b/examples/README.txt @@ -1,13 +1,13 @@ EXAMPLES +---------------------------------- -| 01-clck-and-drag-bitmap.lisp +| 01-clck-and-drag-image.lisp This is the "sanity check" example. It ensures that basic things can happen like "loading textures from disk" and "displaying textures". It also shows off mousevent bubbling to some extent by letting you click -and drag the bitmap. +and drag the image. +---------------------------------- | 02-moving-bitmp.lisp diff --git a/src/interactive/bitmap.lisp b/src/interactive/bitmap.lisp deleted file mode 100644 index 96d8e07..0000000 --- a/src/interactive/bitmap.lisp +++ /dev/null @@ -1,86 +0,0 @@ -;;;; bitmap.lisp - -(in-package #:wheelwork) - -(defvar *bitmap-shader-program* nil - "Cached for later cleanup.") -(defvar *bitmap-vao* nil) - -(defvar *bitmap-count* 0 - "Used by finalizers to determin if the shader should be destroyed.") - -(defun bitmap-finalizer () - "executed after a bitmap has been reclaimed by gc. decrements bitmap -count and destroys shader-program if necessary." - (decf *bitmap-count*) - (unless (plusp *bitmap-count*) - (when *bitmap-vao* - (gl:delete-vertex-arrays (list *bitmap-vao*)) - (setf *bitmap-vao* nil)) - (when *bitmap-shader-program* - (gl:delete-program *bitmap-shader-program*) - (setf *bitmap-shader-program* nil)))) - -(defclass/std bitmap (affine interactive) - ((texture :ri :std (error "A bitmap requires a texture.")))) - -(defmethod initialize-instance :after ((bitmap bitmap) &key) - (incf *bitmap-count*) - (trivial-garbage:finalize bitmap #'bitmap-finalizer) - (with-slots (base-width base-height texture) bitmap - (setf base-height (texture-height texture) - base-width (texture-width texture)) - (unless *bitmap-shader-program* - (setf *bitmap-shader-program* - (create-shader - '(:vertex - ((vert :vec2)) - ((transform :mat4)) - ((values - (* transform (vari:vec4 vert 0.0 1.0)) - vert))) ;color - '(:fragment - ((tc :vec2)) - ((tex :sampler-2d)) - ((let ((frag (vari:texture tex tc))) - (if (< (aref frag 3) 0.01) - (vari:discard) - frag)))))) - (gl:program-uniformi - *bitmap-shader-program* - (gl:get-uniform-location *bitmap-shader-program* "TEX") - 0)) - (unless *bitmap-vao* - (setf *bitmap-vao* (gl:gen-vertex-array)) - (gl:bind-vertex-array *bitmap-vao*) - (let ((vbo (gl:gen-buffer))) - (with-gl-array (verts :float - 0.0 1.0 - 1.0 0.0 - 0.0 0.0 - - 0.0 1.0 - 1.0 1.0 - 1.0 0.0 ) - (gl:bind-buffer :array-buffer vbo) - (gl:buffer-data :array-buffer :static-draw verts))) - (gl:enable-vertex-attrib-array 0) - (gl:vertex-attrib-pointer 0 2 :float 0 (* +float-size+ 2) 0) - (gl:bind-buffer :array-buffer 0) - (gl:bind-vertex-array 0)))) - -(defmethod cleanup ((bitmap bitmap)) - (bitmap-finalizer)) - -(defmethod render ((bitmap bitmap)) - (with-slots (texture) bitmap - (gl:active-texture 0) - (gl:bind-texture :texture-2d (texture-id texture)) - (gl:use-program *bitmap-shader-program*) - (gl:program-uniform-matrix-4fv - *bitmap-shader-program* - (gl:get-uniform-location *bitmap-shader-program* "TRANSFORM") - (projected-matrix bitmap)) - (gl:bind-vertex-array *bitmap-vao*) - (gl:draw-arrays :triangles 0 6) - (gl:bind-vertex-array 0))) diff --git a/src/interactive/button.lisp b/src/interactive/button.lisp index 0a15d79..7c94663 100644 --- a/src/interactive/button.lisp +++ b/src/interactive/button.lisp @@ -88,8 +88,8 @@ (make-instance 'button :on-press pressed :on-release released - :up (make-instance 'bitmap :texture (get-asset up)) - :down (make-instance 'bitmap :texture (get-asset down)))) + :up (make-instance 'image :texture (get-asset up)) + :down (make-instance 'image :texture (get-asset down)))) (defun make-text-button (font up down diff --git a/src/interactive/frameset.lisp b/src/interactive/frameset.lisp index a8ba079..86f445d 100644 --- a/src/interactive/frameset.lisp +++ b/src/interactive/frameset.lisp @@ -77,7 +77,7 @@ (loop for name in asset-names collect (make-instance - 'bitmap + 'image :texture (get-asset name :asset-args asset-args)))) (sequence (loop for name in sequenced-assets diff --git a/src/interactive/image.lisp b/src/interactive/image.lisp new file mode 100644 index 0000000..7c84df3 --- /dev/null +++ b/src/interactive/image.lisp @@ -0,0 +1,86 @@ +;;;; image.lisp + +(in-package #:wheelwork) + +(defvar *image-shader-program* nil + "Cached for later cleanup.") +(defvar *image-vao* nil) + +(defvar *image-count* 0 + "Used by finalizers to determin if the shader should be destroyed.") + +(defun image-finalizer () + "executed after a image has been reclaimed by gc. decrements image +count and destroys shader-program if necessary." + (decf *image-count*) + (unless (plusp *image-count*) + (when *image-vao* + (gl:delete-vertex-arrays (list *image-vao*)) + (setf *image-vao* nil)) + (when *image-shader-program* + (gl:delete-program *image-shader-program*) + (setf *image-shader-program* nil)))) + +(defclass/std image (affine interactive) + ((texture :ri :std (error "A image requires a texture.")))) + +(defmethod initialize-instance :after ((image image) &key) + (incf *image-count*) + (trivial-garbage:finalize image #'image-finalizer) + (with-slots (base-width base-height texture) image + (setf base-height (texture-height texture) + base-width (texture-width texture)) + (unless *image-shader-program* + (setf *image-shader-program* + (create-shader + '(:vertex + ((vert :vec2)) + ((transform :mat4)) + ((values + (* transform (vari:vec4 vert 0.0 1.0)) + vert))) ;color + '(:fragment + ((tc :vec2)) + ((tex :sampler-2d)) + ((let ((frag (vari:texture tex tc))) + (if (< (aref frag 3) 0.01) + (vari:discard) + frag)))))) + (gl:program-uniformi + *image-shader-program* + (gl:get-uniform-location *image-shader-program* "TEX") + 0)) + (unless *image-vao* + (setf *image-vao* (gl:gen-vertex-array)) + (gl:bind-vertex-array *image-vao*) + (let ((vbo (gl:gen-buffer))) + (with-gl-array (verts :float + 0.0 1.0 + 1.0 0.0 + 0.0 0.0 + + 0.0 1.0 + 1.0 1.0 + 1.0 0.0 ) + (gl:bind-buffer :array-buffer vbo) + (gl:buffer-data :array-buffer :static-draw verts))) + (gl:enable-vertex-attrib-array 0) + (gl:vertex-attrib-pointer 0 2 :float 0 (* +float-size+ 2) 0) + (gl:bind-buffer :array-buffer 0) + (gl:bind-vertex-array 0)))) + +(defmethod cleanup ((image image)) + (image-finalizer)) + +(defmethod render ((image image)) + (with-slots (texture) image + (gl:active-texture 0) + (gl:bind-texture :texture-2d (texture-id texture)) + (gl:use-program *image-shader-program*) + (gl:program-uniform-matrix-4fv + *image-shader-program* + (gl:get-uniform-location *image-shader-program* "TRANSFORM") + (projected-matrix image)) + (gl:bind-vertex-array *image-vao*) + (gl:draw-arrays :triangles 0 6) + (gl:bind-vertex-array 0))) diff --git a/src/package.lisp b/src/package.lisp index eef6173..7487af8 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -85,7 +85,7 @@ #:unit-visbilep ;; Specific Unit Classes and APIs - #:bitmap + #:image #:button #:button-bg diff --git a/wheelwork-examples.asd b/wheelwork-examples.asd index 47f0e82..9ba1aaa 100644 --- a/wheelwork-examples.asd +++ b/wheelwork-examples.asd @@ -6,7 +6,7 @@ :serial t :depends-on (#:wheelwork) :pathname "examples/" - :components ((:file "01-click-and-drag-bitmap") + :components ((:file "01-click-and-drag-image") (:file "02-moving-bitmp") (:file "03-font-render") (:file "04-a-button") diff --git a/wheelwork.asd b/wheelwork.asd index 086c1c7..c982e92 100644 --- a/wheelwork.asd +++ b/wheelwork.asd @@ -37,7 +37,7 @@ (:file "listener"))) (:module "interactive" :components ((:file "interactive") - (:file "bitmap") + (:file "image") (:file "text") (:file "button") (:file "frameset") -- cgit v1.2.3