( 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 ;