1 USING: arrays kernel math math.functions math.order math.vectors
2 namespaces opengl opengl.gl sequences ui ui.gadgets ui.gestures
3 ui.gadgets.worlds ui.render accessors combinators literals ;
4 IN: opengl.demo-support
6 CONSTANT: FOV $[ 2.0 sqrt 1 + ]
7 CONSTANT: MOUSE-MOTION-SCALE 0.5
8 CONSTANT: KEY-ROTATE-STEP 10.0
12 TUPLE: demo-world < world yaw pitch distance ;
14 : set-demo-orientation ( world yaw pitch distance -- world )
15 [ >>yaw ] [ >>pitch ] [ >>distance ] tri* ;
17 GENERIC: far-plane ( gadget -- z )
18 GENERIC: near-plane ( gadget -- z )
19 GENERIC: distance-step ( gadget -- dz )
21 M: demo-world far-plane ( gadget -- z )
23 M: demo-world near-plane ( gadget -- z )
25 M: demo-world distance-step ( gadget -- dz )
28 : fov-ratio ( gadget -- fov ) dim>> dup first2 min v/n ;
30 : yaw-demo-world ( yaw gadget -- )
31 [ + ] with change-yaw relayout-1 ;
33 : pitch-demo-world ( pitch gadget -- )
34 [ + ] with change-pitch relayout-1 ;
36 : zoom-demo-world ( distance gadget -- )
37 [ + ] with change-distance relayout-1 ;
39 M: demo-world pref-dim* ( gadget -- dim )
45 : demo-world-frustum ( world -- -x x -y y near far )
46 [ near-plane ] [ far-plane ] [ fov-ratio ] tri [
51 M: demo-world resize-world
52 GL_PROJECTION glMatrixMode
54 [ [ { 0 0 } ] dip dim>> gl-viewport ]
55 [ demo-world-frustum glFrustum ] bi ;
57 : demo-world-set-matrix ( gadget -- )
58 GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
59 GL_MODELVIEW glMatrixMode
61 [ [ 0.0 0.0 ] dip distance>> neg glTranslatef ]
62 [ pitch>> 1.0 0.0 0.0 glRotatef ]
63 [ yaw>> 0.0 1.0 0.0 glRotatef ]
66 : reset-last-drag-rel ( -- )
67 { 0 0 } last-drag-loc set-global ;
68 : last-drag-rel ( -- rel )
69 drag-loc [ last-drag-loc get v- ] keep last-drag-loc set-global ;
71 : drag-yaw-pitch ( -- yaw pitch )
72 last-drag-rel MOUSE-MOTION-SCALE v*n first2 ;
74 : gl-vertex ( point -- )
76 { 2 [ first2 glVertex2d ] }
77 { 3 [ first3 glVertex3d ] }
78 { 4 [ first4 glVertex4d ] }
81 : gl-normal ( normal -- ) first3 glNormal3d ;
83 : do-state ( mode quot -- )
84 swap glBegin call glEnd ; inline
86 : rect-vertices ( lower-left upper-right -- )
88 over first2 glVertex2d
89 dup first pick second glVertex2d
91 swap first swap second glVertex2d
95 { T{ key-down f f "LEFT" } [ KEY-ROTATE-STEP neg swap yaw-demo-world ] }
96 { T{ key-down f f "RIGHT" } [ KEY-ROTATE-STEP swap yaw-demo-world ] }
97 { T{ key-down f f "DOWN" } [ KEY-ROTATE-STEP neg swap pitch-demo-world ] }
98 { T{ key-down f f "UP" } [ KEY-ROTATE-STEP swap pitch-demo-world ] }
99 { T{ key-down f f "=" } [ dup distance-step neg swap zoom-demo-world ] }
100 { T{ key-down f f "-" } [ dup distance-step swap zoom-demo-world ] }
102 { T{ button-down f f 1 } [ drop reset-last-drag-rel ] }
103 { T{ drag f 1 } [ drag-yaw-pitch rot [ pitch-demo-world ] keep yaw-demo-world ] }
104 { mouse-scroll [ scroll-direction get second over distance-step * swap zoom-demo-world ] }