1 USING: arrays kernel math math.functions math.order math.vectors
2 namespaces opengl opengl.gl sequences ui ui.gadgets ui.gestures
3 ui.render accessors combinators ;
4 IN: opengl.demo-support
6 : FOV ( -- x ) 2.0 sqrt 1+ ; inline
7 : MOUSE-MOTION-SCALE 0.5 ; inline
8 : KEY-ROTATE-STEP 10.0 ; inline
12 TUPLE: demo-gadget < gadget yaw pitch distance ;
14 : new-demo-gadget ( yaw pitch distance class -- gadget )
20 GENERIC: far-plane ( gadget -- z )
21 GENERIC: near-plane ( gadget -- z )
22 GENERIC: distance-step ( gadget -- dz )
24 M: demo-gadget far-plane ( gadget -- z )
26 M: demo-gadget near-plane ( gadget -- z )
28 M: demo-gadget distance-step ( gadget -- dz )
31 : fov-ratio ( gadget -- fov ) dim>> dup first2 min v/n ;
33 : yaw-demo-gadget ( yaw gadget -- )
34 [ + ] with change-yaw relayout-1 ;
36 : pitch-demo-gadget ( pitch gadget -- )
37 [ + ] with change-pitch relayout-1 ;
39 : zoom-demo-gadget ( distance gadget -- )
40 [ + ] with change-distance relayout-1 ;
42 M: demo-gadget pref-dim* ( gadget -- dim )
48 : demo-gadget-frustum ( gadget -- -x x -y y near far )
49 [ near-plane ] [ far-plane ] [ fov-ratio ] tri [
54 : demo-gadget-set-matrices ( gadget -- )
55 GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
57 GL_PROJECTION glMatrixMode
59 demo-gadget-frustum glFrustum
61 GL_MODELVIEW glMatrixMode
63 [ [ 0.0 0.0 ] dip distance>> neg glTranslatef ]
64 [ pitch>> 1.0 0.0 0.0 glRotatef ]
65 [ yaw>> 0.0 1.0 0.0 glRotatef ]
69 : reset-last-drag-rel ( -- )
70 { 0 0 } last-drag-loc set-global ;
71 : last-drag-rel ( -- rel )
72 drag-loc [ last-drag-loc get v- ] keep last-drag-loc set-global ;
74 : drag-yaw-pitch ( -- yaw pitch )
75 last-drag-rel MOUSE-MOTION-SCALE v*n first2 ;
77 : gl-vertex ( point -- )
79 { 2 [ first2 glVertex2d ] }
80 { 3 [ first3 glVertex3d ] }
81 { 4 [ first4 glVertex4d ] }
84 : gl-normal ( normal -- ) first3 glNormal3d ;
86 : do-state ( mode quot -- )
87 swap glBegin call glEnd ; inline
89 : rect-vertices ( lower-left upper-right -- )
91 over first2 glVertex2d
92 dup first pick second glVertex2d
94 swap first swap second glVertex2d
98 { T{ key-down f f "LEFT" } [ KEY-ROTATE-STEP neg swap yaw-demo-gadget ] }
99 { T{ key-down f f "RIGHT" } [ KEY-ROTATE-STEP swap yaw-demo-gadget ] }
100 { T{ key-down f f "DOWN" } [ KEY-ROTATE-STEP neg swap pitch-demo-gadget ] }
101 { T{ key-down f f "UP" } [ KEY-ROTATE-STEP swap pitch-demo-gadget ] }
102 { T{ key-down f f "=" } [ dup distance-step neg swap zoom-demo-gadget ] }
103 { T{ key-down f f "-" } [ dup distance-step swap zoom-demo-gadget ] }
105 { T{ button-down f f 1 } [ drop reset-last-drag-rel ] }
106 { T{ drag f 1 } [ drag-yaw-pitch rot [ pitch-demo-gadget ] keep yaw-demo-gadget ] }
107 { T{ mouse-scroll } [ scroll-direction get second over distance-step * swap zoom-demo-gadget ] }