(*
 * LANGUAGE    : ANS Forth
 * PROJECT     : Forth Environments
 * DESCRIPTION : Julia Fractal of z^2+c
 * CATEGORY    : Graphic example
 * AUTHOR      : Marcel Hendrix 
 * LAST CHANGE : April 8, 1994, Marcel Hendrix 
 *)



        NEEDS -miscutil
	NEEDS -graphics

        REVISION -juliaf4 "ÄÄÄ Julia Fractal z^2+c Version 1.01 ÄÄÄ"

	PRIVATES


DOC
(*
 Julia Fractal described by mu*z+(1-mu)*z^2 with given eigenvalue.
*)
ENDDOC

    0 VALUE n1   PRIVATE
    0 VALUE n2   PRIVATE
    0 VALUE i1   PRIVATE	
    0 VALUE j1   PRIVATE
    0 VALUE Xm	 PRIVATE
    0 VALUE Ym	 PRIVATE

   0e FVALUE Xc	 PRIVATE
   0e FVALUE Yc	 PRIVATE	
   0e FVALUE Xx  PRIVATE
   0e FVALUE Yy	 PRIVATE	

   0e FVALUE Aa	 PRIVATE
   0e FVALUE Bb	 PRIVATE	
   0e FVALUE Den PRIVATE

-- Parameters 

          1.03e FVALUE Rr
 PI 8e F* 5e F/ FVALUE Phi
	  1.2e  FVALUE Del

 
#128 VALUE cc

: COLORIZE	cc * >S				( col-index -- )
		Xm i1 +  Ym j1 -  S  SET-DOT	
		Xm i1 -  Ym j1 +  S> SET-DOT ; PRIVATE


0e FVALUE x2  PRIVATE  0e FVALUE y2 PRIVATE
0e FVALUE x1  PRIVATE  0e FVALUE y1 PRIVATE
0e FVALUE u1  PRIVATE  0e FVALUE v1 PRIVATE
		
: INNERLOOP	0 LOCAL tmp			( -- )
		#250 1	 	
		  DO 
		     Xx FSQR  Yy FSQR  F+ 
		     FDUP FSQRT F>S TO tmp
		     1e3 F> IF  I 5 > IF I tmp + COLORIZE ENDIF UNLOOP EXIT
			 ENDIF
		     Xx FSQR   Yy FSQR   F- TO x2
		     Xx Yy F*  F2* 	    TO y2
		     Aa Xx F*  Bb Yy F*  F- TO x1
		     Aa Yy F*  Bb Xx F*  F+ TO y1
		     x1 1e Aa F- x2 F* F+  Bb y2 F* F+ TO u1
		     y1 1e Aa F- y2 F* F+  Bb x2 F* F- TO v1
		     u1 Xx F- FSQR   v1 Yy F- FSQR  F+
		     FDUP 1/F FSQRT F>S TO tmp 
		     1e-4  F< IF I tmp + 8 LSHIFT COLORIZE UNLOOP EXIT ENDIF
		     v1 TO Yy  u1 TO Xx
		LOOP 
		0 COLORIZE ; PRIVATE

: OUTERLOOP	n1 1+ 0				( -- )
		       ?DO 
			   I TO i1
			   n2 NEGATE n2
			    ?DO 
				I TO j1
				J S>F Del F* n1 S>F F/  Xc F+ TO Xx
				I S>F Del F* n2 S>F F/  Yc F+ TO Yy
				INNERLOOP
			   -1 +LOOP
			   EKEY? ?LEAVE 
		       LOOP ; PRIVATE

: COMPUTE	TEXTMODE? DUP >R IF GRAPHICS ENDIF
		GCLEAR PUT!
		Rr Phi FCOS F* TO Aa
		Rr Phi FSIN F* TO Bb
		Aa 1e F- FSQR  Bb FSQR  F+ F2* TO Den
		Aa FSQR  Bb FSQR F+ Aa F-  Den F/ TO Xc
  		Bb FNEGATE Den F/ TO Yc
		Xmax 2/   TO n1 
		n1 3 4 */ TO n2
		Xmax 2/ TO Xm  
		Ymax 2/ TO Ym
		OUTERLOOP 
		R> IF  TEXT  ENDIF ;

:ABOUT		CR ." Type COMPUTE for a Julia fractal." ;

                .ABOUT -juliaf4 CR
		DEPRIVE

                              (* End of Source *)