]> gitweb.factorcode.org Git - factor.git/blob - extra/bunny/bunny.factor
Fix deploy tests
[factor.git] / extra / bunny / bunny.factor
1 USING: alien alien.c-types arrays sequences math math.vectors
2 math.matrices math.parser io io.files kernel opengl opengl.gl
3 opengl.glu shuffle http.client vectors namespaces ui.gadgets
4 ui.gadgets.canvas ui.render ui splitting combinators
5 system combinators.lib float-arrays continuations
6 opengl.demo-support multiline ui.gestures bunny.fixed-pipeline
7 bunny.cel-shaded bunny.outlined bunny.model accessors destructors ;
8 IN: bunny
9
10 TUPLE: bunny-gadget model geom draw-seq draw-n ;
11
12 : <bunny-gadget> ( -- bunny-gadget )
13     0.0 0.0 0.375 <demo-gadget>
14     maybe-download read-model {
15         set-delegate
16         (>>model)
17     } bunny-gadget construct ;
18
19 : bunny-gadget-draw ( gadget -- draw )
20     { draw-n>> draw-seq>> }
21     get-slots nth ;
22
23 : bunny-gadget-next-draw ( gadget -- )
24     dup { draw-seq>> draw-n>> }
25     get-slots
26     1+ swap length mod
27     >>draw-n relayout-1 ;
28
29 M: bunny-gadget graft* ( gadget -- )
30     GL_DEPTH_TEST glEnable
31     dup model>> <bunny-geom> >>geom
32     dup
33     [ <bunny-fixed-pipeline> ]
34     [ <bunny-cel-shaded> ]
35     [ <bunny-outlined> ] tri 3array
36     sift >>draw-seq
37     0 >>draw-n
38     drop ;
39
40 M: bunny-gadget ungraft* ( gadget -- )
41     [ geom>> [ dispose ] when* ]
42     [ draw-seq>> [ [ dispose ] when* ] each ] bi ;
43
44 M: bunny-gadget draw-gadget* ( gadget -- )
45     dup draw-seq>> empty? [ drop ] [
46         0.15 0.15 0.15 1.0 glClearColor
47         GL_DEPTH_BUFFER_BIT GL_COLOR_BUFFER_BIT bitor glClear
48         dup demo-gadget-set-matrices
49         GL_MODELVIEW glMatrixMode
50         0.02 -0.105 0.0 glTranslatef
51         { geom>> bunny-gadget-draw } get-slots
52         draw-bunny
53     ] if ;
54
55 M: bunny-gadget pref-dim* ( gadget -- dim )
56     drop { 640 480 } ;
57     
58 bunny-gadget H{
59     { T{ key-down f f "TAB" } [ bunny-gadget-next-draw ] }
60 } set-gestures
61
62 : bunny-window ( -- )
63     [ <bunny-gadget> "Bunny" open-window ] with-ui ;
64
65 MAIN: bunny-window