mirror of
https://github.com/A2osX/A2osX.git
synced 2024-09-10 07:54:37 +00:00
85 lines
1.7 KiB
Plaintext
85 lines
1.7 KiB
Plaintext
NEW
|
||
AUTO 3,1
|
||
#!/bin/forth
|
||
\ Setup constants to remove magic numbers to allow
|
||
\ for greater zoom with different scale factors.
|
||
20 CONSTANT MAXITER
|
||
-39 CONSTANT MINVAL
|
||
40 CONSTANT MAXVAL
|
||
20 32 * CONSTANT RESCALE
|
||
RESCALE 4 * CONSTANT S_ESCAPE
|
||
|
||
\ These variables hold values during the escape calculation.
|
||
0 VARIABLE CREAL
|
||
0 VARIABLE CIMAG
|
||
0 VARIABLE ZREAL
|
||
0 VARIABLE ZIMAG
|
||
0 VARIABLE COUNT
|
||
|
||
\ Compute squares, but rescale to remove extra scaling factor.
|
||
: ZR_SQ ZREAL @ DUP RESCALE */ ;
|
||
: ZI_SQ ZIMAG @ DUP RESCALE */ ;
|
||
|
||
\ Translate escape count to ascii greyscale.
|
||
: .CHAR
|
||
S" ..,'~!^:;[/<&?oxOX# "
|
||
DROP + 1
|
||
TYPE ;
|
||
|
||
\ Numbers above 4 will always escape, so compare to a scaled value.
|
||
: ESCAPES?
|
||
S_ESCAPE > ;
|
||
|
||
\ Increment count and compare to max iterations.
|
||
: COUNT_AND_TEST?
|
||
COUNT @ 1+ DUP COUNT !
|
||
MAXITER > ;
|
||
|
||
\ stores the row column values from the stack for the escape calculation.
|
||
: INIT_VARS
|
||
32 * DUP CREAL ! ZREAL !
|
||
32 * DUP CIMAG ! ZIMAG !
|
||
1 COUNT ! ;
|
||
|
||
\ Performs a single iteration of the escape calculation.
|
||
: DOESCAPE
|
||
ZR_SQ ZI_SQ 2DUP +
|
||
ESCAPES? IF
|
||
DROP DROP 1
|
||
ELSE
|
||
- CREAL @ + \ leave result on stack
|
||
ZREAL @ ZIMAG @ RESCALE */ 2 *
|
||
CIMAG @ + ZIMAG !
|
||
ZREAL ! \ Store stack item into ZREAL
|
||
COUNT_AND_TEST?
|
||
ENDIF ;
|
||
|
||
\ Iterates on a single cell to compute its escape factor.
|
||
: DOCELL
|
||
INIT_VARS
|
||
BEGIN
|
||
DOESCAPE
|
||
UNTIL
|
||
COUNT @
|
||
.CHAR ;
|
||
|
||
\ For each cell in a row.
|
||
: DOROW
|
||
MAXVAL MINVAL DO
|
||
DUP I
|
||
DOCELL
|
||
LOOP
|
||
DROP ;
|
||
|
||
\ For each row in the set.
|
||
: MANDELBROT
|
||
CR
|
||
MAXVAL MINVAL DO
|
||
I DOROW CR
|
||
LOOP ;
|
||
|
||
\ Run the computation.
|
||
MANDELBROT
|
||
MAN
|
||
TEXT root/mandelbrot.f
|