changeset 80:880ae8e03408

Measure time intervals between repaints. Experiments.
author Mikhail Kryshen <mikhail@kryshen.net>
date Wed, 01 Sep 2010 22:25:55 +0400
parents 5fd50e400124
children 5d2153e8a28d
files src/net/kryshen/indyvon/demo.clj src/net/kryshen/indyvon/layers.clj
diffstat 2 files changed, 170 insertions(+), 30 deletions(-) [+]
line wrap: on
line diff
--- a/src/net/kryshen/indyvon/demo.clj	Wed Sep 01 22:24:17 2010 +0400
+++ b/src/net/kryshen/indyvon/demo.clj	Wed Sep 01 22:25:55 2010 +0400
@@ -26,6 +26,110 @@
    (java.awt Color)
    (javax.swing JFrame)))
 
+(defn draw-button!
+  "Draws button immediately (but uses callback for button action
+   unlike IMGUI)."
+  [id content callback & args]
+  (with-handlers id
+    (let [shadow-offset 2
+          padding 4
+          border-width 1
+          offset (if (picked? id) (/ shadow-offset 2) 0)
+          ^Color color (:alt-back-color *theme*)
+          color (if (hovered? id) (.brighter color) color)
+          width (- *width* shadow-offset)
+          height (- *height* shadow-offset)]
+      (with-color Color/BLACK
+        (.fillRect *graphics* shadow-offset shadow-offset width height))
+      (with-color color
+        (.fillRect *graphics* offset offset width height))
+      (draw! (border content border-width padding)
+             offset offset width height))
+    ;; Event handlers
+    (:mouse-entered _ (repaint))
+    (:mouse-exited _ (repaint))
+    (:mouse-pressed _ (repaint))
+    (:mouse-released _ (repaint))
+    (:mouse-clicked _ (apply callback args))))
+
+(defn combine-colors [^Color color1 ^Color color2 c]
+  (case c
+    0.0 color1
+    1.0 color2
+    (let [rgb1 (.getRGBComponents color1 nil)
+          rgb2 (.getRGBComponents color2 nil)
+          rgb (float-array (map #(+ (* (- 1 c) %1) (* c %2)) rgb1 rgb2))]
+      (Color. (aget rgb 0) (aget rgb 1) (aget rgb 2) (aget rgb 3)))))
+
+(defn animate
+  "Changes atom value according to specified range, speed, and current
+   frame interval. Invokes repaint if change happens."
+  [atom from to speed]
+  (let [prev @atom
+        state (cond
+               (zero? speed) :stop
+               (= prev from) (if (pos? speed) :start :stop)               
+               (= prev to) (if (neg? speed) :start :stop)
+               :default :continue)]
+    ;;(println prev from to speed state *interval*)
+    (if (= state :stop)
+       prev
+       (let [interval (if (= state :start) 1 *interval*)
+             step (* speed interval 1E-9)
+             val (swap! atom #(-> % (+ step) (max from) (min to)))]
+         (repaint)
+         val))))
+
+(defn button
+  "Create animated button layer."
+  [content callback & args]
+  (let [padding 4
+        border-width 1
+        shadow-offset 2
+        face (border content padding border-width)
+        highlight (atom 0)
+        animation-speed (atom 0)]
+    (interval-layer
+     (reify
+      Layer
+      (render! [button]
+        (with-handlers button
+          (let [hovered (hovered? button)
+                offset (if (picked? button) (/ shadow-offset 2) 0)
+                color (combine-colors
+                       (:alt-back-color *theme*) Color/WHITE
+                       (animate highlight 0.0 1.0 @animation-speed))
+                width (- *width* shadow-offset)
+                height (- *height* shadow-offset)]
+            (with-color Color/BLACK
+              (.fillRect *graphics*
+                         shadow-offset shadow-offset
+                         width height))
+            (with-color color
+              (.fillRect *graphics* offset offset width height))
+            (draw! (border content border-width padding)
+                   offset offset width height))
+          ;; Event handlers
+          (:mouse-entered _
+            (reset! animation-speed 4)
+            (repaint))
+          (:mouse-exited _
+            (reset! animation-speed -2)
+            (repaint))
+          (:mouse-pressed _ (repaint))
+          (:mouse-released _ (repaint))
+          (:mouse-clicked _ (apply callback args))))
+     (layer-size [button]
+        (let [face-size (layer-size face)]
+          (Size. (+ (:width face-size) shadow-offset)
+                 (+ (:height face-size) shadow-offset))))))))
+
+(def button1 (button (label "Animated button 1")
+                     println "Animated button 1 clicked"))
+
+(def button2 (button (label "Animated button 2")
+                     println "Animated button 2 clicked"))
+
 (def layer1
   (reify
    Layer
@@ -68,6 +172,7 @@
    Layer
    (render! [layer]
       ;;(repaint)
+      ;;(println (format "%.3f" (/ *interval* 1E9)))
       (doto *graphics*
         ;; Random color to see when repaint happens.
         (.setColor (rand-nth [Color/BLACK Color/BLUE Color/RED]))
@@ -75,13 +180,30 @@
         (.drawLine *width* 0 0 *height*))
       (draw! layer2 15 20)
       (draw! layer2m 120 50)
-      (draw! layer3 100 100 80 50))
+      (draw! layer3 100 100 80 50)
+      (draw! button1 50 160)
+      (with-rotate (/ Math/PI 6) 250 200
+        (draw! button1 200 160))
+      (draw! button2 50 250)
+      (with-bounds 100 200 140 30
+        (draw-button! :button
+         (label "Immediate button" :center :center)
+         #(println "Button clicked!"))))
    (layer-size [layer]
       (Size. 400 300))))
 
+;; Main viewport
 (def vp (viewport layer))
 
-(def root (fps-layer vp))
+;; Miniature (rendered asynchronously)
+(def vp-miniature (border (viewport-miniature vp 100 75)))
+
+;; Main scene
+(def scene
+  (fps-layer
+   (decorate-layer vp [_]
+     (draw! vp)
+     (draw! vp-miniature (- *width* 105) 5))))
 
 (defn show-frame [layer]
   (doto (make-jframe "Test" layer)
@@ -90,5 +212,4 @@
 
 (defn -main []
   (println "Try to drag the viewport.")
-  (show-frame root)
-  (show-frame (fps-layer (viewport-miniature vp 80 60))))
+  (show-frame scene))
--- a/src/net/kryshen/indyvon/layers.clj	Wed Sep 01 22:24:17 2010 +0400
+++ b/src/net/kryshen/indyvon/layers.clj	Wed Sep 01 22:25:55 2010 +0400
@@ -284,32 +284,6 @@
           (.drawRect *graphics* x y w h))))
    width height))
 
-(defn- fps-label [text]
-  (padding (label text :right :bottom) 5))
-
-(defn fps-layer
-  "Creates layer that draws content and displays
-   the frames per seconds rate." 
-  [content]
-  (let [update-interval 2E8 ; 0.2 s in nanoseconds
-        frames (ref 0)
-        prev-time (ref nil)
-        display (ref (fps-label "fps n/a"))]
-    (decorate-layer content [_]
-       (draw! content)
-       (draw!
-        (dosync
-         (alter frames inc)
-         (if @prev-time
-           (let [elapsed (- *time* @prev-time)]
-             (when (> elapsed update-interval)
-               (let [fps (/ @frames (/ elapsed 1E9))]
-                 (ref-set display (fps-label (format "%.1f" fps)))
-                 (ref-set frames 0)
-                 (ref-set prev-time *time*))))
-           (ref-set prev-time *time*))
-         @display)))))
-
 ;;
 ;; Layer context decorators.
 ;;
@@ -338,3 +312,48 @@
      (anchor [t xa ya]
         (with-theme theme
           (anchor layer xa ya))))))
+
+;;
+;; Measuring time
+;;
+
+(def *interval*)
+
+(defn interval-layer
+  "Creates layer that measures time between repaints ant draws it's
+   content with the *interval* var bound to the measured time."
+  [content]
+  (let [last-time (atom nil)]
+    (decorate-layer content [_]
+      (compare-and-set! last-time nil *time*)
+      (let [lt @last-time]
+        (binding [*interval* (if (compare-and-set! last-time lt *time*)
+                               (- *time* lt)
+                               0)] ; already measured on parallel thread
+          (render! content))))))
+
+(defn- fps-label [text]
+  (padding (label text :right :bottom) 5))
+
+(defn fps-layer
+  "Creates layer that draws content and displays
+   the frames per seconds rate." 
+  [content]
+  (let [update-interval 2E8 ; 0.2 s in nanoseconds
+        frames (ref 0)
+        prev-time (ref nil)
+        display (ref (fps-label "fps n/a"))]
+    (decorate-layer content [_]
+      (draw! content)
+      (draw!
+       (dosync
+        (alter frames inc)
+        (if @prev-time
+          (let [elapsed (- *time* @prev-time)]
+            (when (> elapsed update-interval)
+              (let [fps (/ @frames (/ elapsed 1E9))]
+                (ref-set display (fps-label (format "%.1f" fps)))
+                (ref-set frames 0)
+                (ref-set prev-time *time*))))
+          (ref-set prev-time *time*))
+        @display)))))