(*
 * LANGUAGE    : ANS Forth
 * PROJECT     : Forth Environments
 * DESCRIPTION : Mandelbrot fractal, total view
 * CATEGORY    : Graphic example
 * AUTHOR      : Marcel Hendrix 
 * LAST CHANGE : Tuesday, December 30, 2003 9:09 PM, Marcel Hendrix 
 *)



        NEEDS -miscutil
	NEEDS -graphics

        REVISION -mantot "ÄÄÄ Mandelbrot Total    Version 1.00 ÄÄÄ"

	PRIVATES


DOC
(*
 Mandelbrot fractal, total view
*)
ENDDOC

-- Parameters 
-0.65e FVALUE Aa
   0e  FVALUE Bb
  1.7e FVALUE delH
  1.5e FVALUE delV
    9   VALUE amp

-- 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 FLOCALS| yy xx |
		xx Aa F+ yy Bb F+ 0e 0e 0e FLOCALS| ww vv uu b1 a1 |
		a1 FSQR  b1 FSQR F+  4e F* TO uu
		uu  a1 F2* F-  0.25e F+    TO vv
		uu a1 8e F* F+ [ 15e 4e F/ ] FLITERAL F+ 
		 F0< IF  @XY 0 SET-MDOT  EXIT  ENDIF
		vv vv FSQRT F-  a1 F2* F+  0.5e F- 
		F0< IF  @XY 0 SET-MDOT   EXIT  ENDIF
		a1 TO xx  b1 TO yy
		#100 1 DO  xx FSQR TO uu  yy FSQR TO vv  xx yy F* F2* TO ww
			   uu vv F- a1 F+ TO xx
			   ww 	    b1 F+ TO yy
			   uu vv F+ 16e F> IF  I COLORIZE LEAVE  ENDIF
		     LOOP ;P

: COMPUTE	TEXTMODE? DUP >R IF GRAPHICS ENDIF  
		0 0 Xmax Ymax  delH FNEGATE delV FNEGATE delH delV SET-GWINDOW GCLEAR 
		#100 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 Mandelbot fractal."
		CR
		CR ."  1.4e TO delH  1.4e TO delV -- zoom picture "
		CR ."  9 TO amp  COMPUTE          -- influence contrast " 
		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 "
		CR 
		CR ." 0.0125e TO delH 0.01e  TO delV -0.75e  TO Aa -0.1e TO Bb COMPUTE " 
		CR ." 0.005e  TO delH 0.005e TO delV -0.765e TO Aa -0.1e TO Bb COMPUTE " ;


                .ABOUT -mantot CR
		DEPRIVE

                              (* End of Source *)