\ gl test window dos also memory also \needs glconst | import glconst ' noop alias debug-points \needs 3d-turtle include 3d-turtle.fs float also glconst also opengl also [IFUNDEF] debug-points Variable maxpoints [THEN] pi f2/ FConstant pi/2 pi/2 f2/ FConstant pi/4 Create .white .7e sf, .7e sf, .7e sf, 1e sf, Create .green 0e sf, .8e sf, .2e sf, 1e sf, Create .brown .4e sf, .2e sf, .0e sf, 1e sf, Create .sky .3e sf, .6e sf, .8e sf, 1e sf, : .color ( addr -- ) GL_FRONT GL_AMBIENT_AND_DIFFUSE rot glMaterialfv ; : .text ( n -- ) ?texture [IF] GL_TEXTURE_2D swap glBindTexture [ELSE] drop .green .color [THEN] ; : !text ( n flag -- ) IF .text ELSE drop THEN ; Variable tail-time : time' ( -- 0..tau ) tail-time @ [ #24 #60 #30 * * ] Literal um* drop 0 d>f [ !$2'-8 pi f* ] FLiteral f* ; : tail-wag ( n -- f ) >r pi r@ 1 + fm* .2e f* time' f+ fsin r> 2+ dup * 1+ fm/ 30e f* ; 3d-turtle with F : dragon-segment ( ri ro n -- ) { f: ri f: ro | next-round ro set-r ri .1e set-rp dphi sf@ phi sf@ f+ phi sf! 1 DO ri set-r LOOP tau phi sf! ro set-r 0e phi sf! } ; F : tail-compensate ( n -- f ) 0e 0 DO I 2+ tail-wag f+ [ 1.1e 1/f ] Fliteral f* LOOP [ 1.1e 20e f** ] Fliteral f* fnegate ; F : dragon-tail ( ri r+ h n -- ri h ) zphi2-texture { f: ri f: r+ f: h n | [ 1.05e -20e f** ] Fliteral [ 1.1e -20e f** ] Fliteral 1e scale-xyz h -#15 fm* #20 tail-compensate h -#25 fm* forward-xyz n 1+ 0 DO add LOOP 20 0 DO 0e i 2+ tail-wag h forward-xyz [ pi #90 fm/ ] Fliteral up ri fdup I 1 and 0= IF r+ f+ THEN n dragon-segment 1.05e 1.1e 1e scale-xyz .025e ri f+ to ri LOOP ri r+ h } ; F : dragon-wamp ( ri r+ h ri+ n -- ri' ) { f: ri f: r+ f: h f: ri+ n | 8 0 DO h forward ri fdup I 1 and 0= IF r+ f+ THEN n dragon-segment ri+ ri f+ to ri -0.02e ri+ f+ to ri+ LOOP ri ri+ .02e f+ f- } ; F : dragon-neck-part ( ri r+ h factor angle n m -- ri' ) swap { f: ri f: r+ f: h f: factor f: angle n | 0 ?DO h forward angle left [ pi #30 fm/ ] Fliteral angle f0< IF time' fsin .02e f* f+ down ELSE time' fsin -.02e f* f+ down THEN factor ri f* to ri ri fdup I 1 and 0= IF r+ f+ THEN n dragon-segment LOOP ri } ; F : dragon-neck ( ri r+ h angle n -- ) { f: r+ f: h f: angle n | r+ h .82e angle n 4 dragon-neck-part r+ h .92e angle f2/ fnegate n 6 dragon-neck-part fdrop close-path } ; Create head-xy 0.28e sf, 0.0e sf, 0.30e sf, 0.5e sf, 0.25e sf, 0.6e sf, 0.05e sf, 0.6e sf, 0.00e sf, 0.5e sf, -.05e sf, 0.6e sf, -.10e sf, 0.6e sf, -.15e sf, 0.5e sf, -.05e sf, 0.0e sf, F : dragon-head ( t1 shade -- ) !text zphi-texture .66e z-off sf! pi 6 fm/ down 1.2e .4e .4e scale-xyz -.65e forward .5e x-text sf! 18 start-path 6 0 DO I 5 = IF .25e ELSE I 0= IF 0e ELSE .35e THEN THEN forward >matrix pi 0.1e f* I 2* 5 - fm* fcos fdup .5e f+ 1e scale-xyz next-round head-xy 18 cells bounds DO I sf@ I cell+ sf@ set-xy 2 cells +LOOP head-xy dup 16 cells + DO I sf@ I cell+ sf@ 1e-6 f+ fnegate set-xy -2 cells +LOOP matrix> LOOP 1e x-text sf! close-path zphi2-texture ; F : wing-step { f: f2 f: f3 | next-round 0e f3 .05e f* f2 f- set-xy f3 .1e f* f2 fnegate set-xy f3 f2/ f2 fnegate set-xy f3 f3 .125e f* set-xy f3 .001e f- f3 .125e f* .001e f+ set-xy f3 f2/ 0e set-xy f3 .1e f* 0e set-xy 0e f3 .05e f* set-xy } ; F : wing-fold ( f1 f2 -- ) time' [ pi 5 fm/ ] FLiteral f- fcos f+ f* down ; F : wing ( -- ) .9e scale 8 start-path .02e 1.2e wing-step .3e forward pi #10 fm/ down pi #8 fm/ roll-left time' fsin 1.2e f* right .02e 1e wing-step pi 5 fm/ up pi #10 fm/ right 1e forward pi 5 fm/ down pi #20 fm/ left time' fcos -.25e f* .5e f- roll-left time' fcos [ pi 6 fm/ ] FLiteral f* down [ pi 5 fm/ ] FLiteral up .02e .8e wing-step [ pi 5 fm/ ] FLiteral down time' 1e f- fcos 1e f+ [ pi 8 fm/ ] Fliteral f* right pi -.3333e f* -1.0e wing-fold pi #10 fm/ left 1e forward pi .21e f* -.8e wing-fold pi .2e f* up 9 0 DO I 4 mod 2 < IF pi #60 fm/ ELSE pi #30 fm/ THEN 1.2e wing-fold pi #30 fm/ right .01e forward .2e z-off sf@ f+ z-off sf! .02e 1.8e .2e I fm* f+ I 4 mod 2 <> IF 1.1e f* THEN I 4 mod 0= IF 1.3e f* ELSE time' fcos .1e f* roll-right THEN wing-step I 4 mod IF time' fcos .1e f* roll-left THEN LOOP 0e [ 1.8e .2e 6 fm* f+ 1.5e f* ] FLiteral wing-step close-path ; F : right-wing ( h -- ) pi/4 roll-right pi/2 right 2e f* forward pi .3e f* roll-left zp-texture .1e y-text sf! wing ; F : leg ( -- ) pi/4 set-dphi 9 start-path 9 -8 DO 64 I dup * - s>f fsqrt !$.06 f* fdup 8 dragon-segment I 8+ $F over - min 2 > IF 4 !$.6 ELSE 1 !$.18 THEN forward +LOOP close-path ; F : claw ( fn -- ) scale 2over !text pi roll-left pi 3 fm/ set-dphi 7 start-path .01e fdup 3e f* 6 dragon-segment 8 FOR .01e I fm* fdup 3e f* 6 dragon-segment [ pi .075e f* ] Fliteral up .2e forward [ pi .075e f* ] Fliteral up NEXT close-path 2dup !text ; F : right-leg ( text-claw flag text flag rel -- ) { f: rel | 2dup !text -.25e .45e -1.2e forward-xyz pi .05e f* right time' rel f+ fsin .033e f* down 1.5e 1e 1e scale-xyz leg -.05e forward pi/2 down .05e forward pi .45e f* down time' rel f+ fsin -.033e f* down .5e .5e 1.33e scale-xyz leg -.15e forward pi .7e f* up time' rel f+ fsin .1e f* down -.15e forward .5e 1.5e .5e scale-xyz leg -.3e forward pi .3e f* up >matrix [ pi .2e f* ] Fliteral roll-left >matrix pi/2 down .4e .4e .2e scale-xyz leg matrix> -.1e 0e 0e forward-xyz .66e claw matrix@ >matrix pi/2 down .6e .6e .3e scale-xyz leg matrix> -.2e 0e 0e forward-xyz 1e claw matrix> pi .2e f* roll-right >matrix pi/2 down .4e .4e .2e scale-xyz leg matrix> -.1e 0e 0e forward-xyz .66e claw } ; F : dragon-body ( t0 s t3 s t1 s t3 s t2 s t4 s n -- ) >r !text time' fsin .1e f* 0e 0e forward-xyz pi f2* .2e f- r@ 1- fm/ set-dphi r@ 4 + open-path .1e .3e .2e r@ dragon-tail r> { f: ri f: r+ f: h n | ri r+ h .06e n dragon-wamp fdrop >turtle ri r+ h [ 10e grad>rad ] Fliteral n dragon-neck 2dup dragon-head 2swap !text turtle> >matrix ri r+ h [ -10e grad>rad ] Fliteral n dragon-neck dragon-head matrix> h 2e f* forward 5 pick 5 pick !text >turtle h right-wing turtle> >turtle h -6e f* forward 0e right-leg turtle> 1e -1e 1e scale-xyz flip-clock 5 pick 5 pick !text >turtle h right-wing turtle> >turtle h -6e f* forward pi/4 right-leg turtle> flip-clock 2drop 2drop 2drop } ; endwith Variable foo 4 foo ! : switch-text ( t0 t1 t2 t3 n -- tn ) \ foo @ 2/ 4 u< IF drop foo @ 2/ THEN pick >r 2drop 2drop r> ; -1 Value test-list Create front_shininess 60.0e sf, Create front_specular .7e f>fs dup , dup , , #1 , 3d-turtle with F : no-smooth smooth off ; Create shades T] textured triangles lines points no-smooth textured-poly poly [ endwith : draw-dragon ( o alx aly alz pitch bend roll zoom shade sx sy sz t0 t1 t2 t3 t4 -- ) { alx aly alz alp alb alr zoom speed shade sx sy sz t0 t1 t2 t3 t4 | glcanvas with .sky sf@+ sf@+ sf@+ sf@ glClearColor 2.8e 200e w @ h @ 3d-turtle new 3d-turtle with speed tail-time ! GL_BLEND glEnable GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glBlendFunc GL_FOG_COLOR .sky glFogfv GL_FRONT_AND_BACK GL_SHININESS front_shininess glMaterialfv GL_FRONT_AND_BACK GL_SPECULAR front_specular glMaterialfv shade $F0 and 4 >> .01e fm* set-fog smooth on shade 7 and cells shades + perform shade 7 and dup 0<> swap 5 <> and IF .green .color ELSE .white .color 1 foo +! THEN 0 5e -5e -10e get-xyz GL_POSITION 0 set-light 8e forward zoom 0.02e fm* scale pi #180 fm/ fdup alx fm* x-left fdup aly fm* y-left fdup alz fm* z-left fdup alp fm* left fdup alb fm* up alr fm* roll-left .01e sx fm* .01e sy fm* .01e sz fm* scale-xyz t3 shade 7 and 0= t4 over t0 over t1 over t2 over t1 over test-list 0< IF 1 glGenLists TO test-list THEN shade 8 and IF test-list GL_COMPILE glNewList THEN shade 8 >> dragon-body shade 8 and IF glEndList \ cr .time test-list glCallList \ .time test-list 1 glDeleteLists THEN turtle> endwith } ; previous previous previous previous previous