[add] alpha support to image class

4 files changed, 13 insertions, 158 deletions

diff --git a/examples/02-image-transforms-and-events.lisp b/examples/02-image-transforms-and-events.lisp
index edc9000..9e4710f 100644
--- a/examples/02-image-transforms-and-events.lisp
+++ b/examples/02-image-transforms-and-events.lisp
@@ -106,7 +106,8 @@
                          :texture (ww::get-asset "Fezghoul.png")))
         (bm2
           (make-instance 'ww::image
-                         :texture (ww::get-asset "GelatinousCube.png"))))
+                         :texture (ww::get-asset "GelatinousCube.png")
+                         :alpha 0.5)))
 
     (ww::add-handler app #'wheelie)
 
diff --git a/examples/02-moving-bitmp.lisp b/examples/02-moving-bitmp.lisp
deleted file mode 100644
index edc9000..0000000
--- a/examples/02-moving-bitmp.lisp
+++ /dev/null
@@ -1,143 +0,0 @@
-;;; 01-image-transforms-and-events.lisp
-
-(defpackage #:ww.examples/2
-  (:use #:cl)
-  (:export #:start))
-
-(in-package :ww.examples/2)
-
-(defclass image-transforms-etc (ww::application ) ())
-
-(defvar *shared-anim-table* (make-hash-table :synchronized t))
-
-(ww::defhandler move-thing
-    (ww::on-keydown ()
-      "Move the target around, grow and shrink it. Print out its
-       position no matter what happens."
-      (case scancode
-        (:scancode-left (decf (ww::x target) 4))
-        (:scancode-right (incf (ww::x target) 4))
-        (:scancode-down (decf (ww::y target) 4))
-        (:scancode-up (incf (ww::y target) 4))
-        (:scancode-w (incf (ww::width target) 20))
-        (:scancode-r (incf (ww::rotation target) (/ pi 3)))
-        (:scancode-l (decf (ww::rotation target) (/ pi 3)))
-        (:scancode-equals
-         (when (or (member :lshift modifiers) (member :rshift modifiers))
-           (ww::scale-by target 1.10)))
-        (:scancode-minus
-         (ww::scale-by target 0.9)))
-      (format t "ghoul pos: ~a,~a~%"
-              (ww::x target) (ww::y target))))
-
-(ww::defhandler animate-move-thing
-    (ww::on-keydown ()
-      "If the target is not already involved in an animation, add a
-       perframe handler to the target that animates it to a new position."
-      (when (member scancode '(:scancode-left :scancode-right :scancode-down :scancode-up)) 
-        (unless (gethash target *shared-anim-table*)
-          (setf (gethash target *shared-anim-table*) t)
-          (let* ((tx (ww::x target))
-                 (ty (ww::y target))
-                 (destx tx)
-                 (desty ty)
-                 (dx 0)
-                 (dy 0))
-            (case scancode
-              (:scancode-down (setf dy -1 desty (- ty (ww::height target))))
-              (:scancode-up (setf dy 1 desty (+ ty (ww::height target))))
-              (:scancode-left (setf dx -1 destx (- tx (ww::width target))))
-              (:scancode-right (setf dx 1 destx (+ tx (ww::width target)))))
-            (ww::add-handler
-             target
-             (ww::on-perframe ()
-               (with-accessors ((cx ww::x) (cy ww::y)) target 
-                 (if (and (= cx destx) (= cy desty))
-                     (progn
-                       (remhash target *shared-anim-table*)
-                       (ww::remove-handler target 'ww::perframe))
-                     (setf cx (+ cx dx)
-                           cy (+ cy dy)))))))))))
-
-
-(ww::defhandler thing-clicked
-    (ww::on-mousedown ()
-      (format t "~a was clicked at ~a,~a!~%" target x y)))
-
-(ww::defhandler flip-on-click
-    (ww::on-mousedown ()
-      (incf (ww::rotation target) (ww::radians 180) )))
-
-(ww::defhandler twirl-on-click
-    (ww::on-mousedown ()
-      (unless (gethash target *shared-anim-table*) 
-        (let ((rot 0))
-          (setf (gethash target *shared-anim-table*) t)
-          (ww::add-handler
-           target
-           (ww::on-perframe ()
-             (if (< rot (* 8 pi))
-                 (setf rot (+ 0.3 rot)
-                       (ww::rotation target) rot)
-                 (progn
-                   (setf (ww::rotation target) 0.0)
-                   (ww::remove-handler target 'ww::perframe)
-                   (remhash target *shared-anim-table*)))))))))
-
-(ww::defhandler mouse-over
-    (ww::on-mousemotion ()
-      (print (list target x y xrel yrel state))))
-
-(ww::defhandler look-at-me 
-  (ww::on-focus ()
-    (format t "~a got focus~%" target)))
-
-(ww::defhandler look-away 
-  (ww::on-blur ()
-    (format t "~a lost focus~%" target)))
-
-(ww::defhandler wheelie
-    (ww::on-mousewheel ()
-      (print (list :mousewheel horiz vert dir))))
-
-(defmethod ww::boot ((app image-transforms-etc))
-  (let ((bm
-          (make-instance 'ww::image
-                         :texture (ww::get-asset "Fezghoul.png")))
-        (bm2
-          (make-instance 'ww::image
-                         :texture (ww::get-asset "GelatinousCube.png"))))
-
-    (ww::add-handler app #'wheelie)
-
-    ;; first 
-    (ww::refocus-on bm)
-    (ww::add-handler bm #'animate-move-thing )
-    (ww::add-handler bm #'thing-clicked)
-    (ww::add-handler bm #'mouse-over)
-    
-    ;;second
-    (setf (ww::x bm2) 90
-          (ww::y bm2) 90)
-    (ww::add-handler bm2 #'move-thing)
-    (ww::add-handler bm2 #'twirl-on-click )
-    (ww::add-handler bm2 #'look-at-me)
-    (ww::add-handler bm2 #'look-away)
-    (ww::add-handler bm2 #'wheelie)
-
-    (ww::add-unit bm)
-    (ww::add-unit bm2)))
-
-
-(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)))))
-
-
-
diff --git a/src/application.lisp b/src/application.lisp
index 6869a56..3b531c9 100644
--- a/src/application.lisp
+++ b/src/application.lisp
@@ -116,7 +116,7 @@ those objects are currently part of the scene tree."
   (gl:clear :color-buffer-bit)
   (gl:enable :blend)
   (gl:blend-func :src-alpha :one-minus-src-alpha )
-  (dolist (unit (application-scene app))
+  (dolist (unit (reverse (application-scene app)))
     (render unit))
   (sdl2:gl-swap-window (application-window app))
   (sleep (frame-wait app)))
diff --git a/src/interactive/image.lisp b/src/interactive/image.lisp
index 1b3a817..644c06e 100644
--- a/src/interactive/image.lisp
+++ b/src/interactive/image.lisp
@@ -6,18 +6,9 @@
   "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*)
-    ))
-
 (defclass/std image (unit interactive)
-  ((texture :ri :std (error "A image requires a texture."))))
+  ((texture :ri :std (error "A image requires a texture."))
+   (alpha :std 1.0)))
 
 (defun make-shared-image-gpu-objects ()
   (unless *image-shader-program*
@@ -31,8 +22,10 @@ count and destroys shader-program if necessary."
                vert))) ;color
            '(:fragment
              ((tc :vec2))
-             ((tex :sampler-2d))
+             ((tex :sampler-2d)
+              (alpha :float))
              ((let ((frag  (vari:texture tex tc)))
+                (setf (aref frag 3) (vari:clamp 0 (* alpha (aref frag 3)) 1))
                 (if (< (aref frag 3) 0.01)
                     (vari:discard)
                     frag))))))
@@ -77,7 +70,7 @@ count and destroys shader-program if necessary."
     (make-shared-image-gpu-objects)))
 
 (defmethod render ((image image))
-  (with-slots (texture) image
+  (with-slots (texture alpha) image
     (gl:active-texture 0)
     (gl:bind-texture :texture-2d (texture-id texture))
     (gl:use-program *image-shader-program*)
@@ -85,6 +78,10 @@ count and destroys shader-program if necessary."
      *image-shader-program*
      (gl:get-uniform-location *image-shader-program* "TRANSFORM")
      (projected-matrix image))
+    (gl:program-uniformf
+     *image-shader-program*
+     (gl:get-uniform-location *image-shader-program* "ALPHA")
+     alpha)
     (gl:bind-vertex-array *image-vao*)    
     (gl:draw-arrays :triangles 0 6)
     (gl:bind-vertex-array 0)))