(*
 * LANGUAGE    : ANS Forth
 * PROJECT     : Forth Environments
 * DESCRIPTION : Julia fractal of z*(c+(1-c)/z^6)
 * CATEGORY    : Graphic example
 * AUTHOR      : Marcel Hendrix 
 * LAST CHANGE : Tuesday, December 30, 2003 4:56 PM, Marcel Hendrix 
 *)



        NEEDS -miscutil
	NEEDS -graphics

        REVISION -julrot2 "ÄÄÄ Julia z(c+(1-c)/z^6 Version 1.00 ÄÄÄ"

	PRIVATES


DOC
(*
 Julia fractal of z*(c+(1-c)/z^6).
*)
ENDDOC

-- Parameters 
 0.8e     FVALUE Aa
 0.0e     FVALUE Bb
 1.0e     FVALUE delH
 1.0e	  FVALUE delV
   9       VALUE amp

-- Globals
       0. DVALUE @XY    PRIVATE
    1000e FCONSTANT c1	PRIVATE	-- escape bounds
    1e-4  FCONSTANT c2	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 FLOCALS| yy xx |
		0e 0e 0e 0e 0e 0e FLOCALS| x6 y6 x4 y4 x2 y2 |
		0e 0e 0e 0e 0e FLOCALS| den xnum ynum x0 y0 |
		#40  1 DO  xx FSQR   yy FSQR F- TO x2
			   xx yy F* F2*         TO y2
			   x2 FSQR   y2 FSQR F- TO x4
			   x2 y2 F* F2*         TO y4
			   x2 x4 F* y2 y4 F* F- TO x6
			   x2 y4 F* y2 x4 F* F+ TO y6
			   x6 F1- FSQR y6 FSQR F+ c2 F< 
			   IF  I COLORIZE  LEAVE  ENDIF
			   x6 FSQR y6 FSQR F+ c2 F+ TO den
			   x6 	      den F/ TO xnum  
			   y6 FNEGATE den F/ TO ynum
			   1e xnum F- Aa F*  ynum Bb F* F+  xnum F+ TO x0
			   1e xnum F- Bb F*  ynum Aa F* F-  ynum F+ TO y0
			   x0 xx F*  y0 yy F* F- ( x') 
			   y0 xx F*  x0 yy F* F+ ( x' y') TO yy TO xx
		     LOOP ;P

: COMPUTE	TEXTMODE? DUP >R IF GRAPHICS ENDIF  
		0 0 Xmax Ymax  delH FNEGATE delV FNEGATE delH delV  SET-GWINDOW	GCLEAR 
		#40 RANDOMPALETTE
		RESET-MDOTS
		  Xmax 0 ?DO  Ymax 0 ?DO  J I INNERLOOP  LOOP  LOOP
		FLUSH-MDOTS
		R> IF  TEXT  ENDIF ;

:ABOUT		CR ." Type COMPUTE for a Julia fractal."
		CR
		CR ."  1.4e TO delH  1.4e TO delV -- zoom picture "
		CR ."  9 TO amp  COMPUTE          -- influence contrast "
		CR
		CR ." Example parameters: "
		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 -julrot2 CR
		DEPRIVE

                              (* End of Source *)