adams@hpfelg.HP.COM (John Adams) (12/30/89)
Here is (another) Fractal generator. This uses two programs, the
first parses the parameters and loops thru all the display pixels
positions (for speed). It in turn calls a second program (specified
in the parameter) to calculate if the pixels needs to be turn on or
off. I have supplied a Generator for calculating Mandelbrot sets.
Someday I'll write a Julia or strange attractor Generator (or someone
else could..nudge nudge wink wink). It takes about 1 hour to generate
a picture. To create the ever-popular Mandelbrot set type:
(-2.5,-2.5)
5
'Mandelbrot'
Fractal
NOTE: Could someone post this the the list server. I cannot ftp
outside.
John Adams
-----------------------------------------------------------------------
Fractal [F483] (x,y) length Generator
(x1,y1) (x2,y2) Generator
<<
IF 2 PICK TYPE 0 ; Check if 2nd parm is a simple number
== ;
THEN SWAP DUP 4 ; If so convert to double coord notation
PICK C->R ROT + ROT ; (x,y) + length -> (x+length,y+length)
ROT + SWAP R->C SWAP ;
END ROT C->R 4 ROLL ; Split (x1,y1) (x2,y2) -> x1,y1,x2,y2
C->R 100 1 FS? -> prog ; Store generator x1,y1 x2,y2 maximum #
xs ys xe ye maxl fs ; # iterations and current flag #1
<< CLLCD xs ys R->C ; Clear display, store (x1,y1) -> PMIN
PMIN xe ye R->C PMAX ; (x2,y2) -> PMAX
xe xs - 137 / ye ys ; Calculate the x increment needed for 137 steps
- 32 / -> xd yd ; Due the same for 32 y steps.
<< xs xe ;
FOR xx ys ye ; Loop thru all 32 y points
FOR yy xx yy ; Loop thru all 137 x points
maxl ; Stack = xx yy maxl
IF prog ; Call generator function
EVAL ; if returns TRUE turn on pixel @ xx,yy
THEN xx yy ;
R->C PIXEL ;
END yd ;
STEP xd ; End-of-x-loop
STEP 1 ; End-of-y-loop
IF fs ; Restore #1 flag to original value
THEN SF ;
ELSE CF ;
END ;
>> ;
>> DGTIZ ;
>> ;
Mandelbrot [91DD] <max iterations>
<< 0 0 0 -> a b maxl x ; Save initial x,y,maxl -> a,b,maxl
y i ; Initiaize x,y,i to 0
<< 1 CF ; Clear flag 1
WHILE i maxl < 1 ; While current iteration < maximum
FC? AND ; and flag 1 is clear (solution not found)
REPEAT i 1 + 'i' ; Kick up the iteration # and calc new point
STO x SQ y SQ - a + ; x^2 - y^2 + a -> x
2 x * y * b + 'y' ; 2*x + y*b -> y
STO 'x' STO ;
IF x SQ y SQ + ; If (0,0) (x,y) length >= 2 break
4 >= ;
THEN 1 SF ;
END ;
END i 1 FC? + 2 ; Calculate pixel 'color'
/ FP ; (iterations+!soln_fnd) / 2
>> ;
>> ;