blob: 39c984056bbe0dbb99be3c502358534558e92dd9 (
plain)
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
|
\ tag: forth fractal example
\
\ Copyright (C) 2002, 2003 Volker Poplawski <volker@poplawski.de>
\ Stefan Reinauer
\ This example even fits in a signature ;-)
\ hex 4666 dup negate do i 4000 dup 2* negate do 2a 0 dup 2dup 1e 0 do
\ 2swap * d >>a 4 pick + -rot - j + dup dup * e >>a rot dup dup * e >>a
\ rot swap 2dup + 10000 > if 3drop 2drop 20 0 dup 2dup leave then loop
\ 2drop 2drop type 268 +loop cr drop 5de +loop
: fract
4666 dup negate
do
i 4000 dup 2* negate
do
2a 0 dup 2dup 1e 0
do
2swap * d >>a 4 pick +
-rot - j +
dup dup * e >>a rot
dup dup * e >>a rot
swap
2dup + 10000 > if
3drop 2drop 20 0 dup 2dup leave
then
loop
2drop 2drop
emit
268 +loop
cr drop
5de +loop
;
|