Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100755 437 lines (397 sloc) 10.606 kb
13e94c1 @colomon Simple working Gtk-based graphic Mandelbrot code.
authored
1 use v6;
2
6e4bdd6 @colomon Clean up a tad.
authored
3 my $size = @*ARGS[0] // 321;
4 $size = +$size;
13e94c1 @colomon Simple working Gtk-based graphic Mandelbrot code.
authored
5 my $max_iterations = 50;
6
7 my $upper-right = -2 + (5/4)i;
8 my $lower-left = 1/2 - (5/4)i;
9
10 my @color_map = (
11 "0 0 0",
12 "0 0 252",
13 "64 0 252",
14 "124 0 252",
15 "188 0 252",
16 "252 0 252",
17 "252 0 188",
18 "252 0 124",
19 "252 0 64",
20 "252 0 0",
21 "252 64 0",
22 "252 124 0",
23 "252 188 0",
24 "252 252 0",
25 "188 252 0",
26 "124 252 0",
27 "64 252 0",
28 "0 252 0",
29 "0 252 64",
30 "0 252 124",
31 "0 252 188",
32 "0 252 252",
33 "0 188 252",
34 "0 124 252",
35 "0 64 252",
36 "124 124 252",
37 "156 124 252",
38 "188 124 252",
39 "220 124 252",
40 "252 124 252",
41 "252 124 220",
42 "252 124 188",
43 "252 124 156",
44 "252 124 124",
45 "252 156 124",
46 "252 188 124",
47 "252 220 124",
48 "252 252 124",
49 "220 252 124",
50 "188 252 124",
51 "156 252 124",
52 "124 252 124",
53 "124 252 156",
54 "124 252 188",
55 "124 252 220",
56 "124 252 252",
57 "124 220 252",
58 "124 188 252",
59 "124 156 252",
60 "180 180 252",
61 "196 180 252",
62 "216 180 252",
63 "232 180 252",
64 "252 180 252",
65 "252 180 232",
66 "252 180 216",
67 "252 180 196",
68 "252 180 180",
69 "252 196 180",
70 "252 216 180",
71 "252 232 180",
72 "252 252 180",
73 "232 252 180",
74 "216 252 180",
75 "196 252 180",
76 "180 252 180",
77 "180 252 196",
78 "180 252 216",
79 "180 252 232",
80 "180 252 252",
81 "180 232 252",
82 "180 216 252",
83 "180 196 252",
84 "0 0 112",
85 "28 0 112",
86 "56 0 112",
87 "84 0 112",
88 "112 0 112",
89 "112 0 84",
90 "112 0 56",
91 "112 0 28",
92 "112 0 0",
93 "112 28 0",
94 "112 56 0",
95 "112 84 0",
96 "112 112 0",
97 "84 112 0",
98 "56 112 0",
99 "28 112 0",
100 "0 112 0",
101 "0 112 28",
102 "0 112 56",
103 "0 112 84",
104 "0 112 112",
105 "0 84 112",
106 "0 56 112",
107 "0 28 112",
108 "56 56 112",
109 "68 56 112",
110 "84 56 112",
111 "96 56 112",
112 "112 56 112",
113 "112 56 96",
114 "112 56 84",
115 "112 56 68",
116 "112 56 56",
117 "112 68 56",
118 "112 84 56",
119 "112 96 56",
120 "112 112 56",
121 "96 112 56",
122 "84 112 56",
123 "68 112 56",
124 "56 112 56",
125 "56 112 68",
126 "56 112 84",
127 "56 112 96",
128 "56 112 112",
129 "56 96 112",
130 "56 84 112",
131 "56 68 112",
132 "80 80 112",
133 "88 80 112",
134 "96 80 112",
135 "104 80 112",
136 "112 80 112",
137 "112 80 104",
138 "112 80 96",
139 "112 80 88",
140 "112 80 80",
141 "112 88 80",
142 "112 96 80",
143 "112 104 80",
144 "112 112 80",
145 "104 112 80",
146 "96 112 80",
147 "88 112 80",
148 "80 112 80",
149 "80 112 88",
150 "80 112 96",
151 "80 112 104",
152 "80 112 112",
153 "80 104 112",
154 "80 96 112",
155 "80 88 112",
156 "0 0 64",
157 "16 0 64",
158 "32 0 64",
159 "48 0 64",
160 "64 0 64",
161 "64 0 48",
162 "64 0 32",
163 "64 0 16",
164 "64 0 0",
165 "64 16 0",
166 "64 32 0",
167 "64 48 0",
168 "64 64 0",
169 "48 64 0",
170 "32 64 0",
171 "16 64 0",
172 "0 64 0",
173 "0 64 16",
174 "0 64 32",
175 "0 64 48",
176 "0 64 64",
177 "0 48 64",
178 "0 32 64",
179 "0 16 64",
180 "32 32 64",
181 "40 32 64",
182 "48 32 64",
183 "56 32 64",
184 "64 32 64",
185 "64 32 56",
186 "64 32 48",
187 "64 32 40",
188 "64 32 32",
189 "64 40 32",
190 "64 48 32",
191 "64 56 32",
192 "64 64 32",
193 "56 64 32",
194 "48 64 32",
195 "40 64 32",
196 "32 64 32",
197 "32 64 40",
198 "32 64 48",
199 "32 64 56",
200 "32 64 64",
201 "32 56 64",
202 "32 48 64",
203 "32 40 64",
204 "44 44 64",
205 "48 44 64",
206 "52 44 64",
207 "60 44 64",
208 "64 44 64",
209 "64 44 60",
210 "64 44 52",
211 "64 44 48",
212 "64 44 44",
213 "64 48 44",
214 "64 52 44",
215 "64 60 44",
216 "64 64 44",
217 "60 64 44",
218 "52 64 44",
219 "48 64 44",
220 "44 64 44",
221 "44 64 48",
222 "44 64 52",
223 "44 64 60",
224 "44 64 64",
225 "44 60 64",
226 "44 52 64",
227 "44 48 64",
228 );
229
230 constant $GTK = "gtk-sharp, Version=2.12.0.0, Culture=neutral, PublicKeyToken=35e10195dab3c99f";
231 constant $GDK = "gdk-sharp, Version=2.12.0.0, Culture=neutral, PublicKeyToken=35e10195dab3c99f";
232
233 constant Application = CLR::("Gtk.Application,$GTK");
234 constant Window = CLR::("Gtk.Window,$GTK");
235 constant GdkCairoHelper = CLR::("Gdk.CairoHelper,$GDK");
236 constant GdkGC = CLR::("Gdk.GC,$GDK");
2528f02 @colomon Switch to DrawRgbImage to display, loop instead of for.
authored
237 constant GdkRgb = CLR::("Gdk.Rgb,$GDK");
238 constant GdkRgbDither = CLR::("Gdk.RgbDither,$GDK");
13e94c1 @colomon Simple working Gtk-based graphic Mandelbrot code.
authored
239 constant GdkColor = CLR::("Gdk.Color,$GDK");
240 constant GtkDrawingArea = CLR::("Gtk.DrawingArea,$GTK");
df3638a @colomon Now understands mouse button presses!
authored
241 constant GtkEventBox = CLR::("Gtk.EventBox,$GTK");
13e94c1 @colomon Simple working Gtk-based graphic Mandelbrot code.
authored
242 constant SystemByte = CLR::("System.Byte");
11d17c1 @colomon In the midst of major refactor, prepping for the ability to have differe...
authored
243 constant SystemIntPtr = CLR::("System.IntPtr");
2528f02 @colomon Switch to DrawRgbImage to display, loop instead of for.
authored
244 constant ByteArray = CLR::("System.Byte[]");
13e94c1 @colomon Simple working Gtk-based graphic Mandelbrot code.
authored
245
246 my @red = @color_map.map({ SystemByte.Parse($_.comb(/\d+/)[0]) });
247 my @green = @color_map.map({ SystemByte.Parse($_.comb(/\d+/)[1]) });
248 my @blue = @color_map.map({ SystemByte.Parse($_.comb(/\d+/)[2]) });
249
11d17c1 @colomon In the midst of major refactor, prepping for the ability to have differe...
authored
250 my @windows;
251
252 class FractalSet {
253 has Bool $.is-julia;
254 has Complex $.upper-right;
255 has Real $.delta;
256 has Int $.width;
257 has Int $.height;
258 has Complex $.c;
259 has $.stored-byte-array;
203ffc8 @colomon First stab at mandelbrot zooming. Clearly something is still wrong with...
authored
260 has $.new-upper-right;
11d17c1 @colomon In the midst of major refactor, prepping for the ability to have differe...
authored
261
203ffc8 @colomon First stab at mandelbrot zooming. Clearly something is still wrong with...
authored
262 method resize($width, $height) {
263 $.delta *= $.height / $height;
264 $.width = $width;
265 $.height = $height;
266 $.stored-byte-array = Any;
267 }
268
269 method xy-to-c($x, $y) {
270 $.upper-right + $x * $.delta - $y * $.delta * i;
271 }
272
273 method RememberNewUpperRight($x, $y) {
274 $.new-upper-right = self.xy-to-c($x, $y);
275 }
276
277 method ForgetNewUpperRight() {
278 $.new-upper-right = Complex;
279 }
280
11d17c1 @colomon In the midst of major refactor, prepping for the ability to have differe...
authored
281 method GetByteArray() {
b85a4bf @colomon Fix the julia / zoom generation bug that meant everything was being gene...
authored
282 say "Upper: " ~ $.upper-right;
283 say "Delta: " ~ $.delta;
11d17c1 @colomon In the midst of major refactor, prepping for the ability to have differe...
authored
284 unless $.stored-byte-array {
285 my $start-time = time;
286
287 $.stored-byte-array = ByteArray.new($.width * 3 * $.height);
288
289 my $counter = 0;
290 my ($x, $y);
291 loop ($y = 0; $y < $.height; $y++) {
39ab24e @colomon Trigger Julia set creation on right click.
authored
292 my $c = $.upper-right - $y * $.delta * i;
11d17c1 @colomon In the midst of major refactor, prepping for the ability to have differe...
authored
293 loop ($x = 0; $x < $.width; $x++) {
294 my $value = $.is-julia ?? julia($.c, $c) !! mandel($c);
295 $.stored-byte-array.Set($counter++, @red[$value]);
296 $.stored-byte-array.Set($counter++, @green[$value]);
297 $.stored-byte-array.Set($counter++, @blue[$value]);
298 $c += $.delta;
299 }
300 }
301
302 my $elapsed = time - $start-time;
303 say "$elapsed seconds";
304 }
305 $.stored-byte-array;
306 }
307
308 method BuildWindow()
309 {
310 my $index = +@windows;
311 @windows.push(self);
312
b85a4bf @colomon Fix the julia / zoom generation bug that meant everything was being gene...
authored
313 my $window = Window.new($.is-julia ?? "julia $index" !! "mandelbrot $index");
11d17c1 @colomon In the midst of major refactor, prepping for the ability to have differe...
authored
314 $window.Resize($.width, $.height); # TODO: resize at runtime NYI
315
316 my $event-box = GtkEventBox.new;
b85a4bf @colomon Fix the julia / zoom generation bug that meant everything was being gene...
authored
317 $event-box.SetData("Id", SystemIntPtr.new($index));
203ffc8 @colomon First stab at mandelbrot zooming. Clearly something is still wrong with...
authored
318 $event-box.add_ButtonPressEvent(&ButtonPressEvent);
319 $event-box.add_ButtonReleaseEvent(&ButtonReleaseEvent);
11d17c1 @colomon In the midst of major refactor, prepping for the ability to have differe...
authored
320
321 my $drawingarea = GtkDrawingArea.new;
322 $drawingarea.SetData("Id", SystemIntPtr.new($index));
323 $drawingarea.add_ExposeEvent(&ExposeEvent);
324 $window.add_DeleteEvent(&DeleteEvent);
325 $event-box.Add($drawingarea);
326
327 $window.Add($event-box);
328 $window.ShowAll;
329 }
330
331 }
4b036a1 @colomon Put my %bitmaps in a more sensible place.
authored
332
13e94c1 @colomon Simple working Gtk-based graphic Mandelbrot code.
authored
333 Application.Init;
2528f02 @colomon Switch to DrawRgbImage to display, loop instead of for.
authored
334 GdkRgb.Init;
df3638a @colomon Now understands mouse button presses!
authored
335
052878f @colomon Better use of FractalSet.new.
authored
336 FractalSet.new(is-julia => False,
337 upper-right => $upper-right,
338 delta => ($lower-left.re - $upper-right.re) / $size,
339 width => $size,
340 height => $size).BuildWindow;
df3638a @colomon Now understands mouse button presses!
authored
341
13e94c1 @colomon Simple working Gtk-based graphic Mandelbrot code.
authored
342 Application.Run; # end of main program, it's all over when this returns
343
203ffc8 @colomon First stab at mandelbrot zooming. Clearly something is still wrong with...
authored
344 sub ButtonPressEvent($obj, $args) { #OK not used
345 my $index = $obj.GetData("Id").ToInt32();
346 my $set = @windows[$index];
347
348 given $args.Event.Button {
349 when 1 {
350 $set.RememberNewUpperRight($args.Event.X, $args.Event.Y);
351 }
352 }
353 }
354
355
356
357 sub ButtonReleaseEvent($obj, $args) { #OK not used
39ab24e @colomon Trigger Julia set creation on right click.
authored
358 my $index = $obj.GetData("Id").ToInt32();
359 my $set = @windows[$index];
360
11d17c1 @colomon In the midst of major refactor, prepping for the ability to have differe...
authored
361 given $args.Event.Button {
203ffc8 @colomon First stab at mandelbrot zooming. Clearly something is still wrong with...
authored
362 when 1 {
363 if $set.new-upper-right {
b85a4bf @colomon Fix the julia / zoom generation bug that meant everything was being gene...
authored
364 # my $upper-right = -2 + (5/4)i;
365 # my $lower-left = 1/2 - (5/4)i;
366
367 my $c1 = $set.new-upper-right;
368 my $c2 = $set.xy-to-c($args.Event.X, $args.Event.Y);
369 my $upper-right = ($c1.re min $c2.re) + ($c1.im max $c2.im)i;
370 my $lower-left = ($c1.re max $c2.re) + ($c1.im min $c2.im)i;
203ffc8 @colomon First stab at mandelbrot zooming. Clearly something is still wrong with...
authored
371 my $height-ratio = ($upper-right.im - $lower-left.im) / ($lower-left.re - $upper-right.re);
372 FractalSet.new(is-julia => False,
373 upper-right => $upper-right,
374 delta => ($lower-left.re - $upper-right.re) / $size,
375 width => ($size / $height-ratio).Int,
376 height => $size).BuildWindow;
377 }
378 }
39ab24e @colomon Trigger Julia set creation on right click.
authored
379 when 3 {
380 FractalSet.new(is-julia => True,
381 upper-right => -5/4 + (5/4)i,
382 delta => (5 / 2) / $size,
383 width => $size,
384 height => $size,
203ffc8 @colomon First stab at mandelbrot zooming. Clearly something is still wrong with...
authored
385 c => $set.xy-to-c($args.Event.X, $args.Event.Y)).BuildWindow;
39ab24e @colomon Trigger Julia set creation on right click.
authored
386 }
11d17c1 @colomon In the midst of major refactor, prepping for the ability to have differe...
authored
387 }
203ffc8 @colomon First stab at mandelbrot zooming. Clearly something is still wrong with...
authored
388
389 $set.ForgetNewUpperRight;
df3638a @colomon Now understands mouse button presses!
authored
390 }
391
13e94c1 @colomon Simple working Gtk-based graphic Mandelbrot code.
authored
392 sub DeleteEvent($obj, $args) { #OK not used
393 Application.Quit;
394 };
395
396 sub ExposeEvent($obj, $args)
397 {
398 $args; # suppress "declared but not used" "Potential difficulties"
11d17c1 @colomon In the midst of major refactor, prepping for the ability to have differe...
authored
399 my $index = $obj.GetData("Id").ToInt32();
400 my $set = @windows[$index];
13e94c1 @colomon Simple working Gtk-based graphic Mandelbrot code.
authored
401
3c71b6e @colomon Replace repeated calls to $obj.GdkWindow with $window, for slight time s...
authored
402 my $window = $obj.GdkWindow;
11d17c1 @colomon In the midst of major refactor, prepping for the ability to have differe...
authored
403 my $windowX=0; my $windowY=0; my $windowWidth=0; my $windowHeight=0; my $windowDepth=0;
3c71b6e @colomon Replace repeated calls to $obj.GdkWindow with $window, for slight time s...
authored
404 $window.GetGeometry($windowX, $windowY, $windowWidth, $windowHeight, $windowDepth);
11d17c1 @colomon In the midst of major refactor, prepping for the ability to have differe...
authored
405 if $windowHeight != $set.height || $windowWidth != $set.width {
406 $set.resize($windowWidth, $windowHeight);
13e94c1 @colomon Simple working Gtk-based graphic Mandelbrot code.
authored
407 }
2528f02 @colomon Switch to DrawRgbImage to display, loop instead of for.
authored
408
409 my $gc = GdkGC.new($window);
410 $window.DrawRgbImage($gc, $windowX, $windowY, $windowWidth, $windowHeight,
11d17c1 @colomon In the midst of major refactor, prepping for the ability to have differe...
authored
411 GdkRgbDither.Normal, $set.GetByteArray, $windowWidth * 3);
13e94c1 @colomon Simple working Gtk-based graphic Mandelbrot code.
authored
412 };
413
414 sub mandel(Complex $c) {
415 my $z = 0i;
416 my $i;
417 loop ($i = 0; $i < $max_iterations; $i++) {
c750a25 @colomon Remove unneeded parens.
authored
418 if $z.abs > 2 {
13e94c1 @colomon Simple working Gtk-based graphic Mandelbrot code.
authored
419 return $i + 1;
420 }
421 $z = $z * $z + $c;
422 }
423 return 0;
424 }
11d17c1 @colomon In the midst of major refactor, prepping for the ability to have differe...
authored
425
426 sub julia(Complex $c, Complex $z0) {
427 my $z = $z0;
428 my $i;
429 loop ($i = 0; $i < $max_iterations; $i++) {
430 if $z.abs > 2 {
431 return $i + 1;
432 }
433 $z = $z * $z + $c;
434 }
435 return 0;
436 }
Something went wrong with that request. Please try again.