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



        NEEDS -miscutil
	NEEDS -graphics

        REVISION -julcub "ÄÄÄ Julia z^3-3a^2 z+b  Version 1.00 ÄÄÄ"

	PRIVATES


DOC
(*
 Julia fractal of z^3 - 3*a^2 z + b
*)
ENDDOC

-- Parameters 
-0.57695e FVALUE Ar	-0.49e  TO Ar
 0.175e   FVALUE Ai	 0e	TO Ai
 0.8e     FVALUE Br	 0e 	TO Br
 0.0e     FVALUE Bi	 0e 	TO Bi
 1.7e     FVALUE delH
 1.2e	  FVALUE delV
 -0.14e   FVALUE Xc
 0.0e     FVALUE Yc
   9       VALUE amp

-- Globals
       0. DVALUE @XY    PRIVATE
       0e FVALUE A1	PRIVATE
       0e FVALUE A2	PRIVATE
       0e FVALUE B1	PRIVATE
       0e FVALUE B2	PRIVATE

: A1A2B1B2	Ar FSQR Ai FSQR F-  3e F* TO A1
		Ar Ai F* 6e F* 		  TO A2
		Br 			  TO B1
		Bi 			  TO B2 ;P

: 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 FLOCALS| x3 y3 |
		#100 1 DO  xx FSQR yy FSQR F+  
			   1000e F> IF  I COLORIZE  LEAVE  ENDIF
			   xx FSQR  yy FSQR 3e F* F-  xx F*  A1 xx F*  A2 yy F* F+  B1 F+  F- TO x3
			   xx FSQR 3e F*  yy FSQR F-  yy F*  A1 yy F*  A2 xx F* F-  B2 F+  F- TO y3
			   xx x3 F- FSQR  yy y3 F- FSQR F+  
			   1e-4 F<  IF  I COLORIZE  LEAVE  ENDIF
			   x3 TO xx  y3 TO yy
		     LOOP ;P

: COMPUTE	TEXTMODE? DUP >R IF GRAPHICS ENDIF  
		0 0 Xmax Ymax  
		delH FNEGATE Xc F+  delV FNEGATE Yc F+
		delH         Xc F+  delV         Yc F+ SET-GWINDOW GCLEAR 
		#40 RANDOMPALETTE
		A1A2B1B2
		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 -julcub CR
		DEPRIVE

                              (* End of Source *)