File: fract.fs

package info (click to toggle)
openbios-sparc 1.0%2Bsvn640-1
  • links: PTS
  • area: main
  • in suites: squeeze
  • size: 4,412 kB
  • ctags: 12,091
  • sloc: ansic: 57,249; asm: 2,680; xml: 1,335; cpp: 414; makefile: 224; sh: 190
file content (35 lines) | stat: -rw-r--r-- 783 bytes parent folder | download | duplicates (17) 
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
;