Update bunny, spheres, demo-support to use delegation
parent
f3d63e34ac
commit
8d311fbf76
|
@ -7,28 +7,23 @@ opengl.demo-support multiline ui.gestures bunny.fixed-pipeline
|
||||||
bunny.cel-shaded bunny.outlined bunny.model accessors destructors ;
|
bunny.cel-shaded bunny.outlined bunny.model accessors destructors ;
|
||||||
IN: bunny
|
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> ( -- bunny-gadget )
|
: <bunny-gadget> ( -- bunny-gadget )
|
||||||
0.0 0.0 0.375 <demo-gadget>
|
0.0 0.0 0.375 bunny-gadget new-demo-gadget
|
||||||
maybe-download read-model {
|
maybe-download read-model >>model-triangles ;
|
||||||
set-delegate
|
|
||||||
(>>model)
|
|
||||||
} bunny-gadget construct ;
|
|
||||||
|
|
||||||
: bunny-gadget-draw ( gadget -- draw )
|
: bunny-gadget-draw ( gadget -- draw )
|
||||||
{ draw-n>> draw-seq>> }
|
[ draw-n>> ] [ draw-seq>> ] bi nth ;
|
||||||
get-slots nth ;
|
|
||||||
|
|
||||||
: bunny-gadget-next-draw ( gadget -- )
|
: bunny-gadget-next-draw ( gadget -- )
|
||||||
dup { draw-seq>> draw-n>> }
|
dup [ draw-seq>> ] [ draw-n>> ] bi
|
||||||
get-slots
|
|
||||||
1+ swap length mod
|
1+ swap length mod
|
||||||
>>draw-n relayout-1 ;
|
>>draw-n relayout-1 ;
|
||||||
|
|
||||||
M: bunny-gadget graft* ( gadget -- )
|
M: bunny-gadget graft* ( gadget -- )
|
||||||
GL_DEPTH_TEST glEnable
|
GL_DEPTH_TEST glEnable
|
||||||
dup model>> <bunny-geom> >>geom
|
dup model-triangles>> <bunny-geom> >>geom
|
||||||
dup
|
dup
|
||||||
[ <bunny-fixed-pipeline> ]
|
[ <bunny-fixed-pipeline> ]
|
||||||
[ <bunny-cel-shaded> ]
|
[ <bunny-cel-shaded> ]
|
||||||
|
@ -48,8 +43,7 @@ M: bunny-gadget draw-gadget* ( gadget -- )
|
||||||
dup demo-gadget-set-matrices
|
dup demo-gadget-set-matrices
|
||||||
GL_MODELVIEW glMatrixMode
|
GL_MODELVIEW glMatrixMode
|
||||||
0.02 -0.105 0.0 glTranslatef
|
0.02 -0.105 0.0 glTranslatef
|
||||||
{ geom>> bunny-gadget-draw } get-slots
|
[ geom>> ] [ bunny-gadget-draw ] bi draw-bunny
|
||||||
draw-bunny
|
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
M: bunny-gadget pref-dim* ( gadget -- dim )
|
M: bunny-gadget pref-dim* ( gadget -- dim )
|
||||||
|
|
|
@ -9,10 +9,10 @@ IN: opengl.demo-support
|
||||||
|
|
||||||
SYMBOL: last-drag-loc
|
SYMBOL: last-drag-loc
|
||||||
|
|
||||||
TUPLE: demo-gadget yaw pitch distance ;
|
TUPLE: demo-gadget < gadget yaw pitch distance ;
|
||||||
|
|
||||||
: <demo-gadget> ( yaw pitch distance -- gadget )
|
: new-demo-gadget ( yaw pitch distance class -- gadget )
|
||||||
demo-gadget construct-gadget
|
new-gadget
|
||||||
swap >>distance
|
swap >>distance
|
||||||
swap >>pitch
|
swap >>pitch
|
||||||
swap >>yaw ;
|
swap >>yaw ;
|
||||||
|
@ -31,19 +31,19 @@ M: demo-gadget distance-step ( gadget -- dz )
|
||||||
: fov-ratio ( gadget -- fov ) dim>> dup first2 min v/n ;
|
: fov-ratio ( gadget -- fov ) dim>> dup first2 min v/n ;
|
||||||
|
|
||||||
: yaw-demo-gadget ( yaw gadget -- )
|
: 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 -- )
|
: 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 -- )
|
: 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 )
|
M: demo-gadget pref-dim* ( gadget -- dim )
|
||||||
drop { 640 480 } ;
|
drop { 640 480 } ;
|
||||||
|
|
||||||
: -+ ( x -- -x x )
|
: -+ ( x -- -x x )
|
||||||
dup neg swap ;
|
[ neg ] keep ;
|
||||||
|
|
||||||
: demo-gadget-frustum ( gadget -- -x x -y y near far )
|
: demo-gadget-frustum ( gadget -- -x x -y y near far )
|
||||||
[ near-plane ] [ far-plane ] [ fov-ratio ] tri [
|
[ near-plane ] [ far-plane ] [ fov-ratio ] tri [
|
||||||
|
|
|
@ -99,14 +99,13 @@ main()
|
||||||
}
|
}
|
||||||
;
|
;
|
||||||
|
|
||||||
TUPLE: spheres-gadget
|
TUPLE: spheres-gadget < demo-gadget
|
||||||
plane-program solid-sphere-program texture-sphere-program
|
plane-program solid-sphere-program texture-sphere-program
|
||||||
reflection-framebuffer reflection-depthbuffer
|
reflection-framebuffer reflection-depthbuffer
|
||||||
reflection-texture ;
|
reflection-texture ;
|
||||||
|
|
||||||
: <spheres-gadget> ( -- gadget )
|
: <spheres-gadget> ( -- gadget )
|
||||||
20.0 10.0 20.0 <demo-gadget>
|
20.0 10.0 20.0 spheres-gadget new-demo-gadget ;
|
||||||
{ set-delegate } spheres-gadget construct ;
|
|
||||||
|
|
||||||
M: spheres-gadget near-plane ( gadget -- z )
|
M: spheres-gadget near-plane ( gadget -- z )
|
||||||
drop 1.0 ;
|
drop 1.0 ;
|
||||||
|
|
Loading…
Reference in New Issue