[ALLY] New improved Mandelbrot script
From: larry::ecotope::com at: 20-Oct-2000 12:16
Hi allies
I have just posted a new, much improved version of the Mandelbrot script to
the Ecotope rebsite. Or just
do http://www.nwlink.com/~ecotope1/mandelbrot.r
The user interface is written entirely in VID. WARNING: no error checking
for input fields.
I added the following new features:
1) A gallery of parameters which give nice views of the Mandelbrot set. You
can preview thumbnails on the rebsite. (thumbs.png)
2) User defined chromatic color maps and a colorbar, which can be cycled and
modified on the fly.
3) Because REBOL is rather slow doing the Mandelbrot iteration, I changed
the program to store the iteration results. The coloring is then very fast.
On my 450 MHz PC using an image size of 200x200, the default map draws in 8
seconds, the slowest gallery map ( map 49) takes almost 5 minutes.
Recoloring of 200x200 is only a fraction of a second. The maps with maxits
of 100 or less are pretty fast. I set the default maxits for some of the
maps at a high enough level to show the same features as the illustrations
in "Beauty of Fractals" by Peitgen and Richter. In many cases, reducing
maxits will still give nice pictures (although the deepest parts will be
black).
For slower machines, just let it run over coffee or lunch break.
Comments welcome.
Enjoy!
-Larry
PS I have attached the script, but do not know if new rebol mail-list server
handles attachments .
-- Attached file included as plaintext by Listar --
-- File: mandelbrot.r
REBOL [
Title: "Mandelbrot"
File: %mandelbrot.r
Author: {Larry Palmiter Collin Olson}
Email: [larry--ecotope--com]
Date: 07-Oct-2000
Version: 0.2.0
Purpose: {Plot the Mandelbrot set}
Comment: {
07-Oct-2000 Created.
14-Oct-2000 Modified to create color maps.
19-Oct-2000 Added gallery and color bar.
}
Category: [View VID 2]
]
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] "Trifuration" [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
sc/text: p/3 mi/text: p/4
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
]
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]
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: func [ca cb num /local a b olda a2 b2] [
a: b: 0.0
repeat cnt num [
olda: a
a2: a * a
b2: b * b
if (a2 + b2) > 4.0 [return cnt]
a: a2 - b2 + ca
b: 2 * olda * b + cb
]
return num
]
nsteps: maxits: cmap-str: cmap: size: im: cnts: max-c: min-c:
cbar-im: none ; shared vars
calcset: func [sc xo yo /local x y index num] [
nsteps: 16
maxits: to-integer mi/text
cmap-str: "rygcbmr"
cmap: make-color-map cmap-str nsteps
size: to-integer sz/text
im: make image! to-pair size
cnts: array/initial reduce [size * size] maxits
max-c: 1 min-c: maxits
repeat i size [
prog/data: i / size
show prog
repeat j size [
x: sc * ( i / size - .5 ) + xo
y: sc * ( j / size - .5 ) - yo
num: iter x y maxits
max-c: max num max-c
min-c: min num min-c
if num < maxits [
index: (j - 1) * size + i
poke im index pick cmap num
poke cnts index num
]
]
] fill-cbar
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
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
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: gal: none
view main: layout [
style fld field 100 255.255.230
style lbl label 70 yellow bold
title "The Mandelbrot Set"
across lbl "Maxits" mi: fld "30"
lbl "Image size" sz: fld "200"
return
lbl "Center X" xo: fld "-0.5"
lbl "Center Y" yo: fld "0.0"
return
lbl "XY size" sc: fld "3.0" return
button "Gallery" [gal: view/new layout [
text-list 150 black 255.255.230 data get-keys gallery
[set-params value unview/only gal]
]
]
button "Calculate" [
calcset to-decimal sc/text to-decimal xo/text to-decimal yo/text
show-im
]
below prog: progress 208
]
] ;end mandelbrot-obj
