diff --git a/examples/mandelbrot.pl b/examples/mandelbrot.pl new file mode 100755 index 0000000..04b75d1 --- /dev/null +++ b/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";