diff --git a/extra/bunny/bunny.factor b/extra/bunny/bunny.factor index 43b9edcd00..6efa739677 100755 --- a/extra/bunny/bunny.factor +++ b/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 - over { - [ ] - [ ] - [ ] - } map-call-with [ ] subset - 0 - roll { - set-bunny-gadget-geom - set-bunny-gadget-draw-seq - set-bunny-gadget-draw-n - } set-slots ; + dup model>> >>geom + dup + [ ] + [ ] + [ ] tri 3array + [ ] subset >>draw-seq + 0 >>draw-n + drop ; M: bunny-gadget ungraft* ( gadget -- ) - { bunny-gadget-geom bunny-gadget-draw-seq } get-slots - [ [ dispose ] when* ] each - [ dispose ] when* ; + [ geom>> [ dispose ] when* ] + [ draw-seq>> [ [ dispose ] when* ] each ] bi ; 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 ) diff --git a/extra/bunny/outlined/outlined.factor b/extra/bunny/outlined/outlined.factor index 6a2f54cceb..85202e4185 100755 --- a/extra/bunny/outlined/outlined.factor +++ b/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 - [ (pass1) ] keep (pass2) ; + [ remake-framebuffer-if-needed ] + [ (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 ] - } cleave ; + [ bunny-outlined-pass1-program [ delete-gl-program ] when* ] + [ bunny-outlined-pass2-program [ delete-gl-program ] when* ] + [ dispose-framebuffer ] tri diff --git a/extra/opengl/demo-support/demo-support.factor b/extra/opengl/demo-support/demo-support.factor index 84515305c8..524567b5bd 100755 --- a/extra/opengl/demo-support/demo-support.factor +++ b/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 ) - FOV-RATIO NEAR-PLANE FOV / v*n - first2 [ -+ ] bi@ NEAR-PLANE FAR-PLANE ; +: demo-gadget-frustum ( gadget -- -x x -y y near far ) + [ near-plane ] [ far-plane ] bi [ + drop FOV-RATIO swap FOV / v*n + first2 [ -+ ] bi@ + ] 2keep ; : demo-gadget-set-matrices ( gadget -- ) - 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 ; + [ + GL_PROJECTION glMatrixMode + glLoadIdentity + demo-gadget-frustum glFrustum + ] [ + 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 + ] 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 "-" } [ KEY-DISTANCE-STEP swap zoom-demo-gadget ] } + { T{ key-down f f "=" } [ dup distance-step neg 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