(*
 * LANGUAGE    : ANS Forth
 * PROJECT     : Forth Environments
 * DESCRIPTION : Julia Sets
 * CATEGORY    : Graphic example
 * AUTHOR      : Marcel Hendrix 
 * LAST CHANGE : Thursday, January 01, 2004 11:48 PM, Marcel Hendrix 
 *)



        NEEDS -miscutil
	NEEDS -graphics

        REVISION -jul1a "ÄÄÄ Julia Set           Version 1.00 ÄÄÄ"

	PRIVATES


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


-- Parameters 
       0.1e FVALUE Aa
       0.3e FVALUE Bb
       1.5e FVALUE delH
       1.5e FVALUE delV
         9   VALUE amp
	 0   VALUE pcol

-- Globals
       0.   DVALUE @XY    PRIVATE

: COLORIZE ( ix -- ) 
		3 * palette + 
		C@+ amp * >S
		C@+ amp * >< S> OR >S
		C@  amp * #16 LSHIFT S> OR >S
		@XY S> SET-MDOT ;

: INNERLOOP ( x y -- ) 
		2DUP TO @XY UNSCALE? DROP 0e 0e FLOCALS| y1 x1 yy xx |
		#200 1 DO  
		 	   xx FSQR yy FSQR F- Aa F+ TO x1
			   xx yy F* F2*       Bb F+ TO y1
			   xx FSQR yy FSQR F+ 		    1e3  F> IF  I COLORIZE LEAVE  ENDIF
			   xx x1 F- FSQR  yy y1 F- FSQR F+  1e-3 F< IF  I COLORIZE LEAVE  ENDIF
			   x1 TO xx  y1 TO yy
		     LOOP ;P

: COMPUTE	TEXTMODE? DUP >R IF GRAPHICS ENDIF  
		0 0 Xmax Ymax  delH FNEGATE delV FNEGATE delH delV SET-GWINDOW GCLEAR 
		#200 RANDOMPALETTE
		  #100 0 DO   	RESET-MDOTS Xmax 0 ?DO  Ymax 0 ?DO  J I INNERLOOP  LOOP  LOOP FLUSH-MDOTS
				0.05e +TO Bb  0.01e +TO Aa 
				WAIT? ?LEAVE
		       LOOP
		R> IF  TEXT  ENDIF ;

:ABOUT		CR ." Type COMPUTE for a filled Julia fractal." 
		CR ." XOR! gives a special effect, default is PUT!" 
		CR
		CR ."  1.4e TO delH  1.4e TO delV -- zoom picture "
		CR ."  9 TO amp  COMPUTE          -- influence contrast " 
		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 -jul1a CR
		DEPRIVE  PUT!

                              (* End of Source *)