1 2(********************************************************************) 3(* *) 4(* mandelbr.sd7 Display the Mandelbrot set *) 5(* Copyright (C) 2007 Thomas Mertes *) 6(* *) 7(* This program is free software; you can redistribute it and/or *) 8(* modify it under the terms of the GNU General Public License as *) 9(* published by the Free Software Foundation; either version 2 of *) 10(* the License, or (at your option) any later version. *) 11(* *) 12(* This program is distributed in the hope that it will be useful, *) 13(* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 14(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 15(* GNU General Public License for more details. *) 16(* *) 17(* You should have received a copy of the GNU General Public *) 18(* License along with this program; if not, write to the *) 19(* Free Software Foundation, Inc., 51 Franklin Street, *) 20(* Fifth Floor, Boston, MA 02110-1301, USA. *) 21(* *) 22(********************************************************************) 23 24 25$ include "seed7_05.s7i"; 26 include "float.s7i"; 27 include "complex.s7i"; 28 include "draw.s7i"; 29 include "pixmap_file.s7i"; 30 include "stdfont8.s7i"; 31 include "keybd.s7i"; 32 33# Display the Mandelbrot set, that are points z[0] in the complex plane 34# for which the sequence z[n+1] := z[n] ** 2 + z[0] (n >= 0) is bounded. 35# Since this program is computing intensive it should be compiled with 36# s7c -O2 mandelbr 37 38 39const integer: pix is 200; 40const integer: max_iter is 256; 41var float: startZoom is 1.3 / flt(pix); 42var complex: startCenter is complex(-0.75, 0.0); 43 44var float: zoom is startZoom; 45var complex: center is startCenter; 46var array color: colorTable is max_iter times black; 47var text: screen is STD_NULL; 48var PRIMITIVE_WINDOW: startWindow is PRIMITIVE_WINDOW.value; 49 50 51const func integer: iterate (in complex: z0) is func 52 result 53 var integer: iter is 1; 54 local 55 var complex: z is complex.value; 56 begin 57 z := z0; 58 while sqrAbs(z) < 4.0 and # not diverged 59 iter < max_iter do # not converged 60 z *:= z; 61 z +:= z0; 62 incr(iter); 63 end while; 64 end func; 65 66 67const proc: displayMandelbrotSet (in complex: center, in float: zoom) is func 68 local 69 var integer: x is 0; 70 var integer: y is 0; 71 var complex: z0 is complex.value; 72 begin 73 for x range -pix to pix do 74 for y range -pix to pix do 75 z0 := center + complex(flt(x) * zoom, flt(y) * zoom); 76 point(x + pix, y + pix, colorTable[iterate(z0)]); 77 end for; 78 end for; 79 end func; 80 81 82const proc: showHelp is func 83 begin 84 put(0, 0, startWindow); 85 setPosXY(screen, 282, 126); 86 writeln(screen, "HELP"); 87 setPosXY(screen, 252, 142); 88 color(screen, light_cyan, black); 89 writeln(screen, "Left mouse key:"); 90 setPosXY(screen, 234, 158); 91 color(screen, white, black); 92 writeln(screen, "Select a new center"); 93 setPosXY(screen, 222, 174); 94 writeln(screen, "and magnify by factor 2."); 95 setPosXY(screen, 246, 190); 96 color(screen, light_cyan, black); 97 writeln(screen, "Middle mouse key:"); 98 setPosXY(screen, 234, 206); 99 color(screen, white, black); 100 writeln(screen, "Select a new center."); 101 setPosXY(screen, 252, 222); 102 color(screen, light_cyan, black); 103 writeln(screen, "Right mouse key:"); 104 setPosXY(screen, 228, 238); 105 color(screen, white, black); 106 writeln(screen, "Scale down by factor 2."); 107 setPosXY(screen, 276, 254); 108 color(screen, light_cyan, black); 109 writeln(screen, "H:"); 110 setPosXY(screen, 294, 254); 111 color(screen, white, black); 112 writeln(screen, "Help"); 113 setPosXY(screen, 276, 270); 114 color(screen, light_cyan, black); 115 writeln(screen, "R:"); 116 setPosXY(screen, 294, 270); 117 color(screen, white, black); 118 writeln(screen, "Restart"); 119 setPosXY(screen, 276, 286); 120 color(screen, light_cyan, black); 121 writeln(screen, "Q:"); 122 setPosXY(screen, 294, 286); 123 color(screen, white, black); 124 writeln(screen, "Quit"); 125 setPosXY(screen, 156, 174); 126 writeln(screen, "to"); 127 setPosXY(screen, 133, 190); 128 writeln(screen, "leave help"); 129 setPosXY(screen, 138, 206); 130 writeln(screen, "press any"); 131 setPosXY(screen, 156, 222); 132 writeln(screen, "key"); 133 end func; 134 135 136const proc: doCommand (inout char: ch) is func 137 local 138 var PRIMITIVE_WINDOW: savedWindow is PRIMITIVE_WINDOW.value; 139 begin 140 case upper(ch) of 141 when {KEY_MOUSE1}: 142 center := complex(center.re + zoom * flt(getxpos(KEYBOARD) - pix), 143 center.im + zoom * flt(getypos(KEYBOARD) - pix)); 144 zoom := zoom / 2.0; 145 when {KEY_MOUSE2}: 146 center := complex(center.re + zoom * flt(getxpos(KEYBOARD) - pix), 147 center.im + zoom * flt(getypos(KEYBOARD) - pix)); 148 when {KEY_MOUSE3}: 149 zoom := zoom * 2.0; 150 when {'R'}: 151 zoom := startZoom; 152 center := startCenter; 153 put(0, 0, startWindow); 154 ch := getc(KEYBOARD); 155 doCommand(ch); 156 when {'H'}: 157 savedWindow := getPixmap(curr_win); 158 showHelp; 159 ch := getc(KEYBOARD); 160 if ch not in {'q', 'Q', KEY_ESC, KEY_CLOSE} then 161 put(0, 0, savedWindow); 162 ch := getc(KEYBOARD); 163 doCommand(ch); 164 end if; 165 end case; 166 end func; 167 168 169const proc: main is func 170 local 171 const integer: num_pix is 2 * pix + 1; 172 var char: ch is ' '; 173 var integer: col is 0; 174 begin 175 screen(num_pix, num_pix); 176 selectInput(curr_win, KEY_CLOSE, TRUE); 177 clear(curr_win, black); 178 screen := openPixmapFontFile(curr_win); 179 setFont(screen, stdFont8); 180 KEYBOARD := GRAPH_KEYBOARD; 181 for col range 1 to pred(max_iter) do 182 colorTable[col] := color(65535 - (col * 5003) mod 65535, 183 (col * 257) mod 65535, 184 (col * 2609) mod 65535); 185 end for; 186 displayMandelbrotSet(center, zoom); 187 startWindow := getPixmap(curr_win); 188 setPosXY(screen, 252, 126); 189 writeln(screen, "M A N D E L B R"); 190 setPosXY(screen, 240, 142); 191 writeln(screen, "Copyright (C) 2007"); 192 setPosXY(screen, 258, 158); 193 writeln(screen, "Thomas Mertes"); 194 setPosXY(screen, 210, 174); 195 writeln(screen, "This program is free soft-"); 196 setPosXY(screen, 210, 190); 197 writeln(screen, "ware under the terms of"); 198 setPosXY(screen, 210, 206); 199 writeln(screen, "the GNU General Public"); 200 setPosXY(screen, 210, 222); 201 writeln(screen, "License. Mandelbr is wri-"); 202 setPosXY(screen, 210, 238); 203 writeln(screen, "tten in the Seed7 program-"); 204 setPosXY(screen, 222, 254); 205 writeln(screen, "ming language. Homepage:"); 206 setPosXY(screen, 234, 270); 207 writeln(screen, "seed7.sourceforge.net"); 208 setPosXY(screen, 150, 190); 209 writeln(screen, "press"); 210 setPosXY(screen, 162, 206); 211 writeln(screen, "H"); 212 setPosXY(screen, 138, 222); 213 writeln(screen, "for help"); 214 flushGraphic; 215 ch := getc(KEYBOARD); 216 if upper(ch) = 'H' then 217 showHelp; 218 ch := getc(KEYBOARD); 219 end if; 220 if ch not in {'q', 'Q', KEY_ESC, KEY_CLOSE} then 221 if ch not in {KEY_MOUSE1, KEY_MOUSE2, KEY_MOUSE3} then 222 put(0, 0, startWindow); 223 ch := getc(KEYBOARD); 224 end if; 225 doCommand(ch); 226 while ch not in {'q', 'Q', KEY_ESC, KEY_CLOSE} do 227 if ch in {'r', 'R', KEY_MOUSE1, KEY_MOUSE2, KEY_MOUSE3} then 228 displayMandelbrotSet(center, zoom); 229 flushGraphic; 230 end if; 231 ch := getc(KEYBOARD); 232 doCommand(ch); 233 end while; 234 end if; 235 end func; 236