REBOL [
    Title: "Mandelbrot"
    File:  %mandelbrot.r
	Author: {Larry Palmiter Collin Olson}
	Email: larry@ecotope.com
    Date:  31-Oct-2000
	Version: 0.2.8
	Purpose: {Plot the Mandelbrot set}
	History: [
		0.1.0 [07-Oct-2000 {Created with one color gradient}] 
 	    0.1.5 [14-Oct-2000 {Modified to create color maps}]
 	    0.2.0 [19-Oct-2000 {Added gallery and color bar}]
		0.2.5 [29-Oct-2000 {Simplified user interface, added 
			"stuv" colors, backdrop and timer}
		]
		0.2.6 [31-Oct-2000 {Fixed indexing problem, added Julia sets}]
 	    0.2.7 [09-Apr-2001 {Modified for View 1.0, change read-via to
			load-thru/binary, change subtitle3 to vh3 250.215.0}
		0.2.8 [23-Oct-2005 {changed to-image --> make image to make it work in View 1.3} {Allen Kamp}]
		]
	]
	Comment: {The color map "stuvs" works extremely well for
		the Mandelbrot set, esp. for deeper views. The Julia set mode
		draws the Julia set corresponding to the Center X and Y values.
		The Julia sets calculate much more quickly. The parameters, colors, etc.
		can be edited in the same way as for the Mandelbrot set.
	}
	Category: [View VID 3]
	Note: {Larry has given permission for us to modify this script to make use of rebcode}
	Type: 	'graphic
	Purpose: "Standard mandelbrot set calculations"
]


mandelbrot-obj: make object! [ ;just a wrapper to protect the global context

;; gallery code

; Some nice views. On a 450Mz PC the slowest take about 5 minutes at size 200x200.
; The maps are from "Beauty of Fractals" by Peitgen and Richter.

gallery: [
	"Default" [-.5 0 3 30] "Mini-mandelbrot" [-1.75 0 .1 100]
	"Scepter Valley" [-1.4 .005 .1 100] "Trifurcation" [0 .75 .02 200]
 	"Elephant Valley" [.275 0 .05 200] "Triple Spiral Valley" [-.065 .684 .1 100]
	"Quad Spiral Valley" [.3 .482 .1 100] "Seahorse" [-.725 .25 .025 400]
    "Seahorse Valley" [-.76 .11 .05 200] "Map 27" [-.16437 1.040935 .06966 200]
	"Map 29" [-.916665 .266665 .06667 200] "Map 30" [-.5606 .603225 .3048 200]
	"Map 33" [-1.7725 .0065 .017 200] "Map 36" [-.74502 .110235 .01024 600]
	"Map 38" [-.74691 .10725 .00134 1000] "Map 40" [-.7464595 .107626 .000163 1000]
	"Map 42" [-.745195 .112676 .00143 400] "Map 44" [-.745296 .1130585 .000484 600]
	"Map 45" [-.7454265 .113009 .000083 600] "Map 48" [-.74542855 .1130088 .0000141 600]
	"Map 49" [-.7454295 .11300805 .0000012 1000] "Map 58" [-1.2534425 .0466885 .001163 400]
	"Interlocked Spirals" [-.745429 .113008 .00009 400]
]

get-keys: func [b [block!]/local out][
	out: copy []
	foreach item b [if string? item [append out item]]
	out
]

set-params: func [key /local p][
	p: select gallery key
	xo/text: p/1  yo/text: p/2 mi/text: p/4
	sc/text: either julia [4.0][p/3]  
	show main
]

;; color map and colorbar code

color-table: [#"k" 0.0.0 #"r" 255.0.0 #"o" 255.128.0 #"y" 255.255.0
	#"w" 255.255.255 #"g" 0.255.0 #"c" 0.255.255 #"b" 0.0.255 #"m" 255.0.255
	#"s" 0.0.133 #"t" 255.255.245 #"u" 255.202.0 #"v" 144.0.0
]

make-color-map: func [spec [string!] steps [integer!] /local cmap a b d1 d2 d3][
	cmap: make block! steps * length? spec
	while [not tail? next spec][
		a: any [select color-table spec/1 black]
		b: any [select color-table spec/2 black]
		spec: next spec
		d1: to-integer (b/1 - a/1 / steps)
		d2: to-integer (b/2 - a/2 / steps)
		d3: to-integer (b/3 - a/3 / steps)
		loop steps [
			append cmap a
			a/1: a/1 + d1
			a/2: a/2 + d2
			a/3: a/3 + d3
		]
	]
	while [(length? cmap) < maxits][append cmap cmap]
	cmap
]

shift-cmap: func [steps] [
	either positive? steps [
		insert cmap copy skip tail cmap (- steps)
		remove/part skip tail cmap (- steps) steps
	][
		append cmap copy/part cmap (- steps)
		remove/part cmap (- steps)
	]
	cmap: head cmap
]

fill-colors: func [/local num][
	repeat j size * size [
		num: pick cnts j
		if num < maxits [poke im j pick cmap num]
	]
]

fill-cbar: func [ /local cmap-used][
	; clip color map to actual values in image and make color bar 
	cmap-used: copy/part at cmap min-c skip cmap max-c
	;cbar-im: to-image to-pair reduce [length? cmap-used 1]
    cbar-im: make image! to-pair reduce [length? cmap-used 1]

	repeat j length? cmap-used [poke cbar-im j pick cmap-used j]
]

show-colors: does [fill-cbar cbar/image: cbar-im show cbar fill-colors show img]

;; the Mandelbrot calculation

iter: rebcode [
    ca [decimal! integer!]
    cb [decimal! integer!]
    xo [decimal! integer!]
    yo [decimal! integer!]
    num [integer!]
    
    /local b olda a2 b2 cnt sum
] [
    to-dec ca
    to-dec cb
    to-dec xo
    to-dec yo
    gett julia
    either [
        set a ca
        set b cb
        set ca xo
        set cb yo
    ] [
        set a 0.0
        set b 0.0
    ]
    set olda 0.0
    set a2 0.0
    set b2 0.0
    repeat cnt num [
        set.d olda a
        mul.d a a
        set.d b2 b
        mul.d b2 b2
        set.d sum a
        add.d sum b2
        gt.d sum 4.0
        braf cont
        return cnt
        label cont
        sub.d a b2
        add.d a ca
        mul.d b 2.0
        mul.d b olda
        add.d b cb
    ]
    return num
]

nsteps: maxits: cmap-str: cmap: size: im: cnts: max-c: min-c:
	cbar-im: etime: julia: none  ; shared vars
 
calcset-loop: rebcode [
    cmapi xo yo x-off [decimal!] y-off [decimal!] sc [decimal!] size [decimal!]
    /local i x y j cnt index max-c min-c c
] [
    set i 1.0
    set x 0.0
    set y 0.0
    set cnt 1
    set j 1.0
    set index 1
    set max-c 1
    set min-c maxits
    while [lteq.d i size] [
        set.d x i
        div.d x size
        add.i cnt 1
        gt.i cnt 20
        braf no-show
        do dummy [
            prog/data: x
            show prog
        ]
        set.i cnt 1
        label no-show
        sub.d x 0.5
        mul.d x sc
        add.d x x-off
        set.d j 1.0
        while [lteq.d j size] [
            set.d y j
            div.d y size
            sub.d y 0.5
            mul.d y sc
            add.d y y-off
            apply num iter [x y xo yo maxits]
            max.i max-c num
            min.i min-c num
            lt.i num maxits
            braf no-poke
            set index size
            sub.d index j
            mul.d index size
            add.d index i
            to-int index
            pick c cmapi num
            poke im index c
            poke cnts index num
            label no-poke
            add.d j 1.0
        ]
        add.d i 1.0
    ]
]
calcset: func [sc xo yo /local x y x-off y-off index num cmapi] [
	etime: now/precise
	nsteps: 16
	maxits: to-integer mi/text
	cmap-str: "rygcbmr"
	max-c: 1 min-c: maxits
	cmap: make-color-map cmap-str nsteps
    cmapi: make image! as-pair length? cmap 1
    foreach color cmap [change cmapi color cmapi: next cmapi]
    cmapi: head cmapi
	size: to-integer sz/text
	im: make image! to-pair size
	cnts: array/initial reduce [size * size] maxits
	either julia [x-off: y-off: 0][x-off: xo y-off: yo]
    calcset-loop cmapi xo yo to decimal! x-off to decimal! y-off to decimal! sc to decimal! size in prog 'data
	fill-cbar
	prog/data: 0 show prog
	etime: difference now/precise etime
	im 
]

;; the user interface

img: cbar: sh: ns: cm: file: none  ; make named faces shared vars in M-obj

show-im: func [][
	view/new layout [
		style lbl label yellow bold 100
		style a-left arrow left orange 24x24
		style a-right arrow right orange 24x24
		backdrop bg-im effect [tile]
		img: image im ibevel
		cbar: image cbar-im to-pair reduce [size 15] ibevel
		across lbl "Shift Colors" 
		a-left [shift-cmap negate to-integer sh/text show-colors]
		sh: field 38 to-string nsteps 255.255.230
		a-right [shift-cmap to-integer sh/text show-colors] return
		lbl "Steps per color" ns: field 38 to-string nsteps 255.255.230 return
		lbl "Color Map" cm: field copy cmap-str 100 255.255.230 return
		lbl "Calc. Time" lbl form etime return
		button "Redraw" [
			nsteps: to-integer ns/text
		    sh/text: to-string nsteps show sh
			cmap: make-color-map cm/text nsteps show-colors
		]
		button "Save Image" [
			if file: request-file/title/filter "Save Image as png" "Save" "*.png"
				[save/png first file im]
		]
	]
]

mi: sz: xo: yo: sc: here: bg-im: none

if error? try [bg-im: load-thru/binary http://www.nwlink.com/~ecotope1/reb/bg6e.png][
	bg-im: 'none
]

view main: layout [
	style fld field 100 255.255.230
	style lbl label 70 yellow bold
	backdrop bg-im effect [tile]
   	banner "The Mandelbrot Set"
	vh3 "Enter parameters or choose from gallery" 250.215.0
   	across lbl "Maxits" mi: fld "30" here: at return
   	lbl "Image size" sz: fld "200" return
	lbl "Center X" xo: fld "-0.5" return
	lbl "Center Y" yo: fld "0.0" return
	lbl "XY size" sc: fld "3.0" return
	at :here
	text-list 150x152 black 255.255.230 data get-keys gallery [set-params value]
	below across
	lbl "Mode" toggle "Mandelbrot" "Julia set" [julia: face/data sc/text: "4.0" show sc]
   	button "Calculate" [
		calcset to-decimal sc/text to-decimal xo/text to-decimal yo/text
		show-im
	] return
   	prog: progress
]
] ;end mandelbrot-obj