[ALLY] New improved Mandelbrot script

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