( The following is two routines -- MAND -- and JULIA -- written in UCC Forth.
They are essentially the same as the C code in Jan/Feb '88
MicroCornucopia, but they use the modulus value to determine the plot
color rather than the loop count. This gives pictures much closer to
those in Peitgen & Richter.
The default iteration count is 20 rather than 1000, as this gives
faster plotting, and pictures which are quite reasonable. A new value of
iteration count can be entered on the command line -- 1000 MAND --.
I have not added "refinements" such as the ability to drop out with
ctr-C or whatever -- or ability to interactively insert fresh parameters
by locating cross-hairs. Saving and loading images is also omitted.
Was interesting while it lasted (!!) but half a day for a reasonable
picture ( iteration count 120) is too much for me. )
( forget new
: new ; )
off printload
: sqr ,dup f* ;
640 const maxcol ( for EGA card)
350 const maxrow
7 const maxcolr ( forget high intensity colours - not used anyway)
2 block mincol ( to be bumped between multiple passes)
2 block minrow ( likewise)
0 mincol !
0 minrow !
2 block maxit ( max number of iterations - entered on command line)
20 maxit ! ( just in case)
4.0 ,const maxsiz ( double precision -- equals 2 squared)
2 block colr ( single precision variables)
2 block row
2 block col
4 block P ( floating point variables)
4 block Q
4 block modulus
4 block deltaP
4 block deltaQ
4 block Xcur
4 block Xlast
4 block Ycur
4 block Ylast
4 block deltaX
4 block deltaY
4 block Pmax
4 block Pmin
4 block Qmax
4 block Qmin
4 block Xmax
4 block Xmin
4 block Ymax
4 block Ymin
-2.00 Pmin ,! ( alternative values can be loaded from file)
0.5 Pmax ,!
-1.25 Qmin ,!
1.25 Qmax ,!
: fred ( loop to evaluate z = z**2 + c )
repeat modulus ,@ maxsiz ,< colr @ maxit @ < and
while
xlast ,@ sqr ylast ,@ sqr f- P ,@ f+ xcur ,!
xlast ,@ 2.0 f* ylast ,@ f* Q ,@ f+ ycur ,!
colr @ 1+ colr ! ( needed ONLY for 'while' limit above)
xcur ,@ xlast ,!
ycur ,@ ylast ,!
xcur ,@ sqr ycur ,@ sqr f+ modulus ,!
endwhile
modulus ,@ integer single ( convert modulus to color value)
case of[ 1 THRU 4 ] drop 1 colr ! endof
of[ 4 THRU 6 ] drop 2 colr ! endof
of[ 6 THRU 8 ] drop 3 colr ! endof
of[ 8 THRU 10 ] drop 4 colr ! endof
of[ 10 THRU 20 ] drop 5 colr ! endof
of[ 20 THRU 30 ] drop 6 colr ! endof
of[ 30 THRU 1000 ] drop 0 colr ! endof
drop 0 colr ! endcase ;
: draw ( symmetrical draw about horizontal axis )
3 pick maxrow 4 pick - 2 + 3 pick ( mirror parameters)
mincol @ if egadot else eganib then ( draw bottom to centre)
mincol @ if egadot else eganib then ; ( draw top to centre)
( egadot draws one pixel - eganib draws 4 in a row)
: mandd
maxcol mincol @ do ( col is j is P row is i is Q )
maxrow 2 / 1+ minrow @ do ( calculate half screen only)
Pmin ,@ j double float deltaP ,@ f* f+ P ,!
Qmin ,@ i double float deltaQ ,@ f* f+ Q ,!
0.0 xlast ,! 0.0 ylast ,! 0.0 modulus ,! 0 colr ! fred
j i colr @ dup if draw else 3 kill then
( no need to draw black pixels)
8 +loop
8 +loop ; ( draw coarse pattern rapidly - then fill in with multiple passes)
: mand depth 0= if 20 then maxit ! ( enter parameter on command line)
( or use 20 as default)
egam ( set EGA card to 640 x 350 and blank screen)
Pmax ,@ Pmin ,@ f- maxcol double float 1.0 f- f/ deltap ,!
Qmax ,@ Qmin ,@ f- maxrow double float 1.0 f- f/ deltaq ,!
8 0 do ( multiple staggered passes of mandd loop)
7 0 do mandd
minrow @ 1 + minrow ! 1 +loop
mincol @ dup 0= if 4 + else 1+ then mincol ! 0 minrow ! 1 +loop ;
-1.8 Xmin ,!
1.8 Xmax ,!
-1.8 Ymin ,!
1.8 Ymax ,!
-0.74543 P ,!
0.11301 Q ,!
: jul
maxcol mincol @ do ( col is j is P row is i is Q )
maxrow minrow @ do
0.0 modulus ,! 0 colr !
Xmin ,@ j double float deltaX ,@ f* f+ Xlast ,!
Ymin ,@ i double float deltaY ,@ f* f+ Ylast ,!
fred
j i colr @ dup if
mincol @ if egadot else eganib then
else 3 kill then
8 +loop
8 +loop ;
: julia depth 0= if 20 then maxit ! egam
Xmax ,@ Xmin ,@ f- maxcol double float 1.0 f- f/ deltax ,!
Ymax ,@ Ymin ,@ f- maxrow double float 1.0 f- f/ deltay ,!
8 0 do
7 0 do jul
minrow @ 1 + minrow ! 1 +loop
mincol @ dup 0= if 4 + else 1+ then mincol ! 0 minrow ! 1 +loop ;
: aaa 20 mand ;