-
Notifications
You must be signed in to change notification settings - Fork 7
/
Copy pathdragon.fs
304 lines (272 loc) · 9.76 KB
/
dragon.fs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
\ 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