(*
 * LANGUAGE    : ANS Forth
 * PROJECT     : Forth Environments
 * DESCRIPTION : Julia Set
 * CATEGORY    : Graphic example
 * AUTHOR      : Marcel Hendrix 
 * LAST CHANGE : April 6, 1994, Marcel Hendrix 
 * LAST CHANGE : Saturday, December 27, 2003 12:38 PM, Marcel Hendrix 
 *)



        NEEDS -miscutil
	NEEDS -graphics

        REVISION -juliaf2 "ÄÄÄ Julia Set [floats]  Version 1.01 ÄÄÄ"

	PRIVATES


DOC
(*
 Normal Julia Fractal of z:=z^2+c.
*)
ENDDOC

    0 VALUE Xm	PRIVATE
    0 VALUE Ym	PRIVATE

    0 VALUE n1	PRIVATE	
    0 VALUE n2	PRIVATE	

    0 VALUE i1  PRIVATE	
    0 VALUE i2  PRIVATE	
    0 VALUE j1  PRIVATE	
    0 VALUE j2  PRIVATE	

   0e FVALUE Xx	PRIVATE
   0e FVALUE Yy	PRIVATE	

-- Parameters 

 0.1e FVALUE Aa
 0.5e FVALUE Bb

  1.5e FCONSTANT p1 PRIVATE
  1.5e FCONSTANT p2 PRIVATE

#10000 VALUE cc

: COLORIZE	>S i1 j1 S  SET-DOT		 \ <col-index> --- <>
		   i2 j2 S> SET-DOT ; PRIVATE

: INNERLOOP	0e FLOCAL x1  0e FLOCAL y1	\ <> --- <>
		0 LOCAL tmp
		#250 0 
		  DO 
		     Xx FSQR  Yy FSQR F- Aa F+ TO x1
		     	   Xx Yy F* F2*  Bb F+ TO y1
		     Xx FSQR  Yy FSQR  F+ 
		     ( fdup FSQRT f>s TO tmp )
		     1e3   F> IF I tmp + cc * COLORIZE UNLOOP EXIT ENDIF
		     Xx x1 F- FSQR  Yy y1 F- FSQR  F+  
		     1e-4  F< IF I tmp + COLORIZE UNLOOP EXIT ENDIF
		     x1 TO Xx  y1 TO Yy
		LOOP 
		black COLORIZE ; PRIVATE

: OUTERLOOP	n1 1+ 0 ?DO			\ <> --- <>
			   n2 NEGATE n2
			    ?DO
				Xm J + TO i1  Xm J - TO i2  
				J S>F p1 F* n1 S>F F/ TO Xx
				Ym I - TO j1  Ym I + TO j2  
				I S>F p2 F* n2 S>F F/ TO Yy
				INNERLOOP
			   -1 +LOOP
			   EKEY? ?LEAVE 
		       LOOP ; PRIVATE

: COMPUTE	TEXTMODE? IF GRAPHICS ENDIF GCLEAR
		Xmax 2/ TO Xm
		Ymax 2/ TO Ym
		Xmax 2/ TO n1 
		n1 S>F p1 F* p2 F/ F>S TO n2
		100 0 DO OUTERLOOP 0.05e +TO Bb  0.01e +TO Aa
			 WAIT? ?LEAVE 
		    LOOP 
		TEXT ;

:ABOUT		CR ." Type COMPUTE for a normal Julia fractal (floats)." 
		CR ." XOR! gives a special effect, default is PUT!"
		CR
		CR ." -1.754878e TO Aa  0e        TO Bb COMPUTE "
		CR ." -1.543689e TO Aa  0e        TO Bb COMPUTE " 
		CR ." 5e 4e F/   TO Aa  0e        TO Bb COMPUTE " 
		CR ." -1e        TO Aa  0e        TO Bb COMPUTE " 
		CR ." -0.75e     TO Aa  0e        TO Bb COMPUTE " 
		CR ."  0.25e     TO Aa  0e        TO Bb COMPUTE " 
		CR ."  0.3e      TO Aa  0e        TO Bb COMPUTE "
		CR ." -0.122561e TO Aa  0.744862e TO Bb COMPUTE "
		CR ." -0.101096e TO Aa  0.956287e TO Bb COMPUTE "
		CR ."  0.11e     TO Aa  0.67e     TO Bb COMPUTE " 
		CR ."  0.25e     TO Aa  0.25e     TO Bb COMPUTE "
		CR ." -0.318472e TO Aa  0.041257e TO Bb COMPUTE " ;


                .ABOUT -juliaf2 CR
		DEPRIVE  PUT!

                              (* End of Source *)