Modernize some code in the bunny demo

extra/bunny/bunny.factor

@@ -4,7 +4,7 @@ opengl.glu shuffle http.client vectors namespaces ui.gadgets
 ui.gadgets.canvas ui.render ui splitting combinators tools.time
 system combinators.lib float-arrays continuations
 opengl.demo-support multiline ui.gestures bunny.fixed-pipeline
-bunny.cel-shaded bunny.outlined bunny.model ;
+bunny.cel-shaded bunny.outlined bunny.model accessors ;
 IN: bunny
 
 TUPLE: bunny-gadget model geom draw-seq draw-n ;
@@ -17,34 +17,29 @@ TUPLE: bunny-gadget model geom draw-seq draw-n ;
     } bunny-gadget construct ;
 
 : bunny-gadget-draw ( gadget -- draw )
-    { bunny-gadget-draw-n bunny-gadget-draw-seq }
+    { draw-n>> draw-seq>> }
     get-slots nth ;
 
 : bunny-gadget-next-draw ( gadget -- )
-    dup { bunny-gadget-draw-seq bunny-gadget-draw-n }
+    dup { draw-seq>> draw-n>> }
     get-slots
     1+ swap length mod
-    swap [ set-bunny-gadget-draw-n ] keep relayout-1 ;
+    >>draw-n relayout-1 ;
 
 M: bunny-gadget graft* ( gadget -- )
     GL_DEPTH_TEST glEnable
-    dup bunny-gadget-model <bunny-geom>
+    dup model>> <bunny-geom> >>geom
-    over {
+    dup
     [ <bunny-fixed-pipeline> ]
     [ <bunny-cel-shaded> ]
-        [ <bunny-outlined> ]
+    [ <bunny-outlined> ] tri 3array
-    } map-call-with [ ] subset
+    [ ] subset >>draw-seq
-    0
+    0 >>draw-n
-    roll {
+    drop ;
-        set-bunny-gadget-geom
-        set-bunny-gadget-draw-seq
-        set-bunny-gadget-draw-n
-    } set-slots ;
 
 M: bunny-gadget ungraft* ( gadget -- )
-    { bunny-gadget-geom bunny-gadget-draw-seq } get-slots
+    [ geom>> [ dispose ] when* ]
-    [ [ dispose ] when* ] each
+    [ draw-seq>> [ [ dispose ] when* ] each ] bi ;
-    [ dispose ] when* ;
 
 M: bunny-gadget draw-gadget* ( gadget -- )
     0.15 0.15 0.15 1.0 glClearColor
@@ -52,7 +47,7 @@ M: bunny-gadget draw-gadget* ( gadget -- )
     dup demo-gadget-set-matrices
     GL_MODELVIEW glMatrixMode
     0.02 -0.105 0.0 glTranslatef
-    { bunny-gadget-geom bunny-gadget-draw } get-slots
+    { geom>> bunny-gadget-draw } get-slots
     draw-bunny ;
 
 M: bunny-gadget pref-dim* ( gadget -- dim )

extra/bunny/outlined/outlined.factor

@@ -183,8 +183,7 @@ TUPLE: bunny-outlined
     dup bunny-outlined-gadget rect-dim
     over bunny-outlined-framebuffer-dim
     over =
-    [ 2drop ]
+    [ 2drop ] [
-    [
         swap dup dispose-framebuffer >r
         dup GL_RGBA16F_ARB GL_RGBA (framebuffer-texture)
         swap dup GL_RGBA16F_ARB GL_RGBA (framebuffer-texture)
@@ -228,12 +227,11 @@ TUPLE: bunny-outlined
     } [ { -1.0 -1.0 } { 1.0 1.0 } rect-vertices ] with-gl-program ;
 
 M: bunny-outlined draw-bunny
-    dup remake-framebuffer-if-needed
+    [ remake-framebuffer-if-needed ]
-    [ (pass1) ] keep (pass2) ;
+    [ (pass1) ]
+    [ (pass2) ] tri ;
 
 M: bunny-outlined dispose
-    {
     [ bunny-outlined-pass1-program [ delete-gl-program ] when* ]
     [ bunny-outlined-pass2-program [ delete-gl-program ] when* ]
-        [ dispose-framebuffer ]
+    [ dispose-framebuffer ] tri
-    } cleave ;

extra/opengl/demo-support/demo-support.factor

@@ -2,13 +2,9 @@ USING: arrays combinators.lib kernel math math.functions math.vectors namespaces
        opengl opengl.gl sequences ui ui.gadgets ui.gestures ui.render ;
 IN: opengl.demo-support
 
-: NEAR-PLANE 1.0 64.0 / ; inline
-: FAR-PLANE 4.0 ; inline
 : FOV 2.0 sqrt 1+ ; inline
 : MOUSE-MOTION-SCALE 0.5 ; inline
-: MOUSE-DISTANCE-SCALE 1.0 64.0 / ; inline
 : KEY-ROTATE-STEP 1.0 ; inline
-: KEY-DISTANCE-STEP 1.0 64.0 / ; inline
 : DIMS { 640 480 } ; inline
 
 : FOV-RATIO ( -- fov ) DIMS dup first2 min v/n ;
@@ -21,6 +17,17 @@ TUPLE: demo-gadget yaw pitch distance ;
     demo-gadget construct-gadget 
     [ { set-demo-gadget-yaw set-demo-gadget-pitch set-demo-gadget-distance } set-slots ] keep ;
 
+GENERIC: far-plane ( gadget -- z )
+GENERIC: near-plane ( gadget -- z )
+GENERIC: distance-step ( gadget -- dz )
+
+M: demo-gadget far-plane ( gadget -- z )
+    drop 4.0 ;
+M: demo-gadget near-plane ( gadget -- z )
+    drop 1.0 64.0 / ;
+M: demo-gadget distance-step ( gadget -- dz )
+    drop 1.0 64.0 / ;
+
 : yaw-demo-gadget ( yaw gadget -- )
     [ [ demo-gadget-yaw + ] keep set-demo-gadget-yaw ] keep relayout-1 ;
 
@@ -36,21 +43,26 @@ M: demo-gadget pref-dim* ( gadget -- dim )
 : -+ ( x -- -x x )
     dup neg swap ;
 
-: demo-gadget-frustum ( -- -x x -y y near far )
+: demo-gadget-frustum ( gadget -- -x x -y y near far )
-    FOV-RATIO NEAR-PLANE FOV / v*n
+    [ near-plane ] [ far-plane ] bi [
-    first2 [ -+ ] bi@ NEAR-PLANE FAR-PLANE ;
+        drop FOV-RATIO swap FOV / v*n
+        first2 [ -+ ] bi@
+    ] 2keep ;
 
 : demo-gadget-set-matrices ( gadget -- )
+    GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
+    [
         GL_PROJECTION glMatrixMode
         glLoadIdentity
         demo-gadget-frustum glFrustum
-    GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
+    ] [
         GL_MODELVIEW glMatrixMode
         glLoadIdentity
         [ >r 0.0 0.0 r> demo-gadget-distance neg glTranslatef ]
         [ demo-gadget-pitch 1.0 0.0 0.0 glRotatef ]
         [ demo-gadget-yaw   0.0 1.0 0.0 glRotatef ]
-    tri ;
+        tri
+    ] bi ;
 
 : reset-last-drag-rel ( -- )
     { 0 0 } last-drag-loc set-global ;
@@ -65,11 +77,11 @@ demo-gadget H{
     { T{ key-down f f "RIGHT" } [ KEY-ROTATE-STEP     swap yaw-demo-gadget ] }
     { T{ key-down f f "DOWN"  } [ KEY-ROTATE-STEP neg swap pitch-demo-gadget ] }
     { T{ key-down f f "UP"    } [ KEY-ROTATE-STEP     swap pitch-demo-gadget ] }
-    { T{ key-down f f "="     } [ KEY-DISTANCE-STEP neg swap zoom-demo-gadget ] }
+    { T{ key-down f f "="     } [ dup distance-step neg swap zoom-demo-gadget ] }
-    { T{ key-down f f "-"     } [ KEY-DISTANCE-STEP     swap zoom-demo-gadget ] }
+    { T{ key-down f f "-"     } [ dup distance-step     swap zoom-demo-gadget ] }
     
     { T{ button-down f f 1 }    [ drop reset-last-drag-rel ] }
     { T{ drag f 1 }             [ drag-yaw-pitch rot [ pitch-demo-gadget ] keep yaw-demo-gadget ] }
-    { T{ mouse-scroll }         [ scroll-direction get second MOUSE-DISTANCE-SCALE * swap zoom-demo-gadget ] }
+    { T{ mouse-scroll }         [ scroll-direction get second over distance-step * swap zoom-demo-gadget ] }
 } set-gestures