diff --git a/extra/bunny/bunny.factor b/extra/bunny/bunny.factor index b4cefbc5bd..06959c91c2 100755 --- a/extra/bunny/bunny.factor +++ b/extra/bunny/bunny.factor @@ -7,28 +7,23 @@ opengl.demo-support multiline ui.gestures bunny.fixed-pipeline bunny.cel-shaded bunny.outlined bunny.model accessors destructors ; IN: bunny -TUPLE: bunny-gadget model geom draw-seq draw-n ; +TUPLE: bunny-gadget < demo-gadget model-triangles geom draw-seq draw-n ; : ( -- bunny-gadget ) - 0.0 0.0 0.375 - maybe-download read-model { - set-delegate - (>>model) - } bunny-gadget construct ; + 0.0 0.0 0.375 bunny-gadget new-demo-gadget + maybe-download read-model >>model-triangles ; : bunny-gadget-draw ( gadget -- draw ) - { draw-n>> draw-seq>> } - get-slots nth ; + [ draw-n>> ] [ draw-seq>> ] bi nth ; : bunny-gadget-next-draw ( gadget -- ) - dup { draw-seq>> draw-n>> } - get-slots + dup [ draw-seq>> ] [ draw-n>> ] bi 1+ swap length mod >>draw-n relayout-1 ; M: bunny-gadget graft* ( gadget -- ) GL_DEPTH_TEST glEnable - dup model>> >>geom + dup model-triangles>> >>geom dup [ ] [ ] @@ -48,8 +43,7 @@ M: bunny-gadget draw-gadget* ( gadget -- ) dup demo-gadget-set-matrices GL_MODELVIEW glMatrixMode 0.02 -0.105 0.0 glTranslatef - { geom>> bunny-gadget-draw } get-slots - draw-bunny + [ geom>> ] [ bunny-gadget-draw ] bi draw-bunny ] if ; M: bunny-gadget pref-dim* ( gadget -- dim ) diff --git a/extra/opengl/demo-support/demo-support.factor b/extra/opengl/demo-support/demo-support.factor index 5dcbd526f2..2bf2abae95 100755 --- a/extra/opengl/demo-support/demo-support.factor +++ b/extra/opengl/demo-support/demo-support.factor @@ -9,10 +9,10 @@ IN: opengl.demo-support SYMBOL: last-drag-loc -TUPLE: demo-gadget yaw pitch distance ; +TUPLE: demo-gadget < gadget yaw pitch distance ; -: ( yaw pitch distance -- gadget ) - demo-gadget construct-gadget +: new-demo-gadget ( yaw pitch distance class -- gadget ) + new-gadget swap >>distance swap >>pitch swap >>yaw ; @@ -31,19 +31,19 @@ M: demo-gadget distance-step ( gadget -- dz ) : fov-ratio ( gadget -- fov ) dim>> dup first2 min v/n ; : yaw-demo-gadget ( yaw gadget -- ) - [ [ demo-gadget-yaw + ] keep set-demo-gadget-yaw ] keep relayout-1 ; + [ + ] with change-yaw relayout-1 ; : pitch-demo-gadget ( pitch gadget -- ) - [ [ demo-gadget-pitch + ] keep set-demo-gadget-pitch ] keep relayout-1 ; + [ + ] with change-pitch relayout-1 ; : zoom-demo-gadget ( distance gadget -- ) - [ [ demo-gadget-distance + ] keep set-demo-gadget-distance ] keep relayout-1 ; + [ + ] with change-distance relayout-1 ; M: demo-gadget pref-dim* ( gadget -- dim ) drop { 640 480 } ; : -+ ( x -- -x x ) - dup neg swap ; + [ neg ] keep ; : demo-gadget-frustum ( gadget -- -x x -y y near far ) [ near-plane ] [ far-plane ] [ fov-ratio ] tri [ diff --git a/extra/spheres/spheres.factor b/extra/spheres/spheres.factor index dff7313eec..9607f6d201 100755 --- a/extra/spheres/spheres.factor +++ b/extra/spheres/spheres.factor @@ -99,14 +99,13 @@ main() } ; -TUPLE: spheres-gadget +TUPLE: spheres-gadget < demo-gadget plane-program solid-sphere-program texture-sphere-program reflection-framebuffer reflection-depthbuffer reflection-texture ; : ( -- gadget ) - 20.0 10.0 20.0 - { set-delegate } spheres-gadget construct ; + 20.0 10.0 20.0 spheres-gadget new-demo-gadget ; M: spheres-gadget near-plane ( gadget -- z ) drop 1.0 ;