Add examples/mandelbrot.pl demo

examples/mandelbrot.pl

@@ -0,0 +1,90 @@
+#!/usr/bin/env perl
+# A small demo of PDL::IO::GD - produces three sample images:
+#   sunset.png         - truecolor RGB gradient (write_true_png)
+#   mandelbrot.png     - indexed PNG with custom rainbow LUT (write_png)
+#   mandelbrot.jpg     - same Mandelbrot via the OO interface (write_Jpeg)
+#
+# Run with: perl examples/mandelbrot.pl
+# Output files are written to the current directory.
+#
+# PDL image convention: arrays are (W, H) for greyscale or (W, H, 3) for RGB.
+# The fastest-varying dim is X (width). xvals/yvals work the same way:
+# xvals(W, H) gives X coordinates, yvals(W, H) gives Y coordinates.
+
+use strict;
+use warnings;
+use PDL;
+use PDL::IO::GD;
+
+# --- 1. A truecolor RGB sunset gradient (640 x 360) ---
+my ($W1, $H1) = (640, 360);
+my $x = xvals($W1, $H1) / ($W1 - 1);                    # 0..1 across (dim 0)
+my $y = yvals($W1, $H1) / ($H1 - 1);                    # 0..1 down  (dim 1)
+my $r = (255 * (1 - $y * 0.6))->byte;                   # red
+my $g = (180 * (1 - $y) + 80 * $x * (1 - $y))->byte;    # green
+my $b = (255 * $y * (1 - $x * 0.3))->byte;              # blue
+my $rgb = $r->cat($g, $b);                              # (W, H, 3)
+write_true_png($rgb, 'sunset.png');
+print "Wrote sunset.png       (", -s 'sunset.png', " bytes)\n";
+
+# --- 2. The Mandelbrot set with a rainbow LUT (800 x 600) ---
+my ($W, $H) = (800, 600);
+my $cx = (xvals($W, $H) - $W * 0.65) * 3.0 / $W;        # complex plane x
+my $cy = (yvals($W, $H) - $H * 0.5)  * 2.0 / $H;        # complex plane y
+my $zx = zeroes($W, $H);
+my $zy = zeroes($W, $H);
+my $iter = zeroes(byte, $W, $H);
+my $max_iter = 200;
+my $live = ones(byte, $W, $H);
+for my $n (1..$max_iter) {
+    my $zx2 = $zx * $zx;
+    my $zy2 = $zy * $zy;
+    my $escape = ($zx2 + $zy2) > 4;
+    my $just_escaped = $live & $escape;
+    # Log scaling for a prettier colour spread (linear gives mostly the
+    # iter=1 colour because most points escape immediately).
+    $iter->where($just_escaped) .= int(255 * log($n + 1) / log($max_iter + 1));
+    $live &= ~$escape;
+    last if $live->sum == 0;
+    my $zx_new = $zx2 - $zy2 + $cx;
+    $zy = 2 * $zx * $zy + $cy;
+    $zx = $zx_new;
+}
+
+# Build a 256-entry rainbow LUT through HSV space (vectorised).
+my $idx  = sequence(256);
+my $hue6 = $idx / 255 * 6;
+my $hi   = floor($hue6)->long;
+my $f    = $hue6 - $hi;
+my $val  = ones(256) * 0.95;
+my $p    = zeroes(256);
+my $q    = $val * (1 - $f);
+my $t    = $val * $f;
+my @r_per = ($val,  $q,    $p,    $p,    $t,    $val);
+my @g_per = ($t,    $val,  $val,  $q,    $p,    $p);
+my @b_per = ($p,    $p,    $t,    $val,  $val,  $q);
+my $r_lut = zeroes(256);
+my $g_lut = zeroes(256);
+my $b_lut = zeroes(256);
+for my $sec (0..5) {
+    my $mask = ($hi == $sec);
+    $r_lut->where($mask) .= $r_per[$sec]->where($mask);
+    $g_lut->where($mask) .= $g_per[$sec]->where($mask);
+    $b_lut->where($mask) .= $b_per[$sec]->where($mask);
+}
+my $lut = ($r_lut->cat($g_lut, $b_lut)->mv(-1, 0) * 255)->byte;  # (3, 256)
+$lut->slice(':,0') .= 0;              # iter=0 (inside the set) → black
+
+write_png($iter, $lut, 'mandelbrot.png');
+print "Wrote mandelbrot.png   (", -s 'mandelbrot.png', " bytes)\n";
+
+# --- 3. Same Mandelbrot as JPEG via the OO interface ---
+# Look up RGB for each iter value, reshape to a (3, W, H) truecolor image,
+# move the colour axis to the end for write_Jpeg.
+my $tc = $lut->dice_axis(1, $iter->flat)->reshape(3, $W, $H)->mv(0, -1);
+my $img = PDL::IO::GD->new({pdl => $tc});
+$img->write_Jpeg('mandelbrot.jpg', 90);
+print "Wrote mandelbrot.jpg   (", -s 'mandelbrot.jpg', " bytes)\n";
+
+print "\nOpen the resulting files to view:\n";
+print "  open sunset.png mandelbrot.png mandelbrot.jpg\n";