view src/indyvon/demo.clj @ 155:c3782e84486f

Reverted some of the changes in 9997ac717c3c.
author Mikhail Kryshen <mikhail@kryshen.net>
date Tue, 15 Apr 2014 23:45:14 +0400
parents ed36fcf061de
children dc13cacf3a43
line source
1 ;;
2 ;; Copyright 2010-2014 Mikhail Kryshen <mikhail@kryshen.net>
3 ;;
4 ;; This file is part of Indyvon.
5 ;;
6 ;; Indyvon is free software: you can redistribute it and/or modify it
7 ;; under the terms of the GNU Lesser General Public License version 3
8 ;; only, as published by the Free Software Foundation.
9 ;;
10 ;; Indyvon is distributed in the hope that it will be useful, but
11 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 ;; Lesser General Public License for more details.
14 ;;
15 ;; You should have received a copy of the GNU Lesser General Public
16 ;; License along with Indyvon. If not, see
17 ;; <http://www.gnu.org/licenses/>.
18 ;;
20 (ns indyvon.demo
21 "Indyvon demo and experiments."
22 (:gen-class)
23 (:use
24 (indyvon core views viewport component))
25 (:import
26 (java.awt Color)
27 (javax.swing JFrame)))
29 (defn draw-button!
30 "Draws a button immediately (but uses callback for the action unlike
31 IMGUI)."
32 [id content callback & args]
33 (with-handlers id
34 (let [shadow-offset 2
35 padding 4
36 border-width 1
37 offset (if (picked? id) (/ shadow-offset 2) 0)
38 ^Color color (:alt-back-color *theme*)
39 color (if (hovered? id) (.brighter color) color)
40 width (- *width* shadow-offset)
41 height (- *height* shadow-offset)]
42 (with-color (:shadow-color *theme*)
43 (.fillRect *graphics* shadow-offset shadow-offset width height))
44 (with-color color
45 (.fillRect *graphics* offset offset width height))
46 (draw! (border border-width padding content)
47 offset offset width height))
48 ;; Event handlers
49 (:mouse-entered _ (repaint))
50 (:mouse-exited _ (repaint))
51 (:mouse-pressed _ (repaint))
52 (:mouse-released _ (repaint))
53 (:mouse-clicked _ (apply callback args))))
55 (defn combine-colors
56 "Returns color between color1 and color2. When c (0 <= c <= 1.0) is
57 closer to 0 the returned сolor is closer to color1."
58 [^Color color1 ^Color color2 c]
59 (case c
60 0.0 color1
61 1.0 color2
62 (let [rgb1 (.getRGBComponents color1 nil)
63 rgb2 (.getRGBComponents color2 nil)
64 rgb (float-array (map #(+ (* (- 1 c) %1) (* c %2)) rgb1 rgb2))]
65 (Color. (aget rgb 0) (aget rgb 1) (aget rgb 2) (aget rgb 3)))))
67 (defn animate
68 "Changes the value of atom according to the specified range, speed,
69 and current frame interval. Invokes repaint if change happens."
70 [atom from to speed]
71 (let [prev @atom
72 state (cond
73 (zero? speed) :stop
74 (= prev from) (if (pos? speed) :start :stop)
75 (= prev to) (if (neg? speed) :start :stop)
76 :default :continue)]
77 (if (= state :stop)
78 prev
79 (let [interval (if (= state :start) 1 *interval*)
80 step (* speed interval 1E-9)
81 val (swap! atom #(-> % (+ step) (max from) (min to)))]
82 (repaint)
83 val))))
85 (defn animated-button
86 "Creates an animated button."
87 [content callback & args]
88 (let [padding 4
89 border-width 1
90 shadow-offset 2
91 face (border padding border-width content)
92 highlight (atom 0)
93 animation-speed (atom 0)]
94 (interval-view
95 (reify
96 View
97 (render! [button]
98 (with-handlers button
99 (let [hovered (hovered? button)
100 offset (if (picked? button) (/ shadow-offset 2) 0)
101 color (combine-colors
102 (:alt-back-color *theme*) Color/WHITE
103 (animate highlight 0.0 1.0 @animation-speed))
104 width (- *width* shadow-offset)
105 height (- *height* shadow-offset)]
106 (with-color (:shadow-color *theme*)
107 (.fillRect *graphics*
108 shadow-offset shadow-offset
109 width height))
110 (with-color color
111 (.fillRect *graphics* offset offset width height))
112 (draw! (border border-width padding content)
113 offset offset width height))
114 ;; Event handlers
115 (:mouse-entered _
116 (reset! animation-speed 4)
117 (repaint))
118 (:mouse-exited _
119 (reset! animation-speed -2)
120 (repaint))
121 (:mouse-pressed _ (repaint))
122 (:mouse-released _ (repaint))
123 (:mouse-clicked _ (apply callback args))))
124 (geometry [button]
125 (let [face-geom (geometry face)]
126 (->Size (+ (width face-geom) shadow-offset)
127 (+ (height face-geom) shadow-offset))))))))
129 (def button1 (animated-button (label "Animated button 1")
130 println "Animated button 1 clicked"))
132 (def button2 (animated-button (label "Animated button 2")
133 println "Animated button 2 clicked"))
135 (def test-view1
136 (reify
137 View
138 (render! [view]
139 (with-handlers view
140 (with-color (if (hovered? view) Color/ORANGE Color/RED)
141 (.fillRect *graphics* 0 0 *width* *height*))
142 (:mouse-entered e
143 (repaint)
144 (println e))
145 (:mouse-exited e
146 (repaint)
147 (println e))
148 (:mouse-moved e
149 (println e))))
150 (geometry [view]
151 (->Size 30 20))))
153 (def test-view1b (border 2 3 test-view1))
155 (def test-view2
156 (reify
157 View
158 (render! [view]
159 (doto *graphics*
160 (.setColor Color/YELLOW)
161 (.fillRect 0 0 *width* *height*))
162 (with-rotate 0.5 0 0
163 (draw! test-view1b 30 25))
164 (draw! test-view1 55 5))
165 (geometry [view]
166 (->Size 70 65))))
168 (def test-view2m (miniature 30 30 test-view2))
170 (def test-view3 (border (label :right :bottom "Sample\ntext")))
172 (def root
173 (reify
174 View
175 (render! [view]
176 ;;(repaint)
177 (doto *graphics*
178 (.drawLine 0 0 *width* *height*)
179 (.drawLine *width* 0 0 *height*)
180 ;; Random color to see when repaint happens.
181 (.setColor (rand-nth [Color/BLACK Color/BLUE Color/RED]))
182 (.fillOval 5 5 20 20))
183 (draw! test-view2 30 20)
184 (draw! test-view2m 120 50)
185 (draw! test-view3 100 100 80 50)
186 (draw! button1 50 160)
187 (with-rotate (/ Math/PI 6) 250 200
188 (draw! button1 210 140))
189 (draw! button2 100 200)
190 (with-bounds 180 240 140 30
191 (draw-button! :button
192 (label :center :center "Immediate button")
193 #(println "Button clicked!"))))
194 (geometry [view]
195 (->Size 400 300))))
197 ;; Main viewport
198 (def vp (viewport root))
200 ;; Miniature (rendered asynchronously)
201 (def vp-miniature (->> vp (viewport-miniature 100 75) border shadow))
203 ;; Main scene
204 (def scene
205 (fps-view
206 (decorate-view vp [_]
207 (draw! vp)
208 (draw-aligned!
209 (label (str "Drag mouse to pan," \newline
210 "use mouse wheel to zoom."))
211 :left :bottom 5 (- *height* 5))
212 (draw! vp-miniature (- *width* 105) 5))))
214 (defn show-frame [view]
215 (doto (make-jframe "Test" view)
216 (.setDefaultCloseOperation JFrame/DISPOSE_ON_CLOSE)
217 (.setVisible true)))
219 (defn -main []
220 (show-frame scene))
222 (comment
223 (show-frame (viewport-miniature 200 150 vp)))