Generating the illustration for Damerau-Levenshtein explained

This Perl script creates the illustration for Damerau-Levenshtein Edit Distance Explained.

#!/home/ben/software/install/bin/perl
use warnings;
use strict;
use utf8;
use FindBin '$Bin';
use Cairo;

my $unit = 40;
my $margin = $unit/10;

make_table ("levdist", "a cat", "an act");
make_table ("restricted-edit", "a cat", "an act");

my @d = qw!
0       1       2       3       4       5       
1       0       1       2       3       4       
2       1       1       2       2       3       
3       2       1       2       2       3       
4       3       2       2       3       2
!;

my @sp = ([2,2,'#99ccff'], [5,4,'#ffad33'], [6,5,'#ffff4d']); 

make_table ("damlev-edit", "a cat", "a abct", \@d, \@sp);

sub make_table
{
    my ($title, $left, $top, $m, $sp) = @_;
    my @left = split //, $left;
    my @top = split //, $top;
    my $l = scalar (@left);
    my $t = scalar (@top);
    my $nleft = $l + 2;
    my $ntop = $t + 2;
    my $ysize = $unit * $nleft + $margin*2;
    my $xsize = $unit * $ntop + $margin*2;
    my $surface = Cairo::ImageSurface->create ('argb32', $xsize, $ysize);
    my $cr = Cairo::Context->create ($surface);
    for my $co ([0,0],[0,1],[1,0]) {
        fill ($cr, @$co, [0.4, 0.4, 0.4]);
    }
    $cr->set_source_rgb (0, 0, 0);
    $cr->set_line_width (1);
    for my $i (0..$ntop) {
        my $t = $unit * $i + $margin;
        $cr->move_to ($t, $margin);
        $cr->line_to ($t, $ysize - $margin);
        $cr->stroke ();
        if ($i > 1) {
            my $c = $top[$i-2];
            if (defined $c) {
                letter ($cr, $c, $i, 0);
            }
        }
    }
    for my $i (0..$nleft) {
        my $r = $unit * $i + $margin;
        $cr->move_to ($margin, $r);
        $cr->line_to ($xsize - $margin, $r);
        $cr->stroke ();
        if ($i > 1) {
            my $c = $left[$i-2];
            if (defined $c) {
                letter ($cr, $c, 0, $i);
            }
        }
    }
    if ($sp) {
        for my $e (@$sp) {
            my ($x, $y, $c) = @$e;
            if ($c =~ /#([0-9A-F]{2})([0-9A-F]{2})([0-9A-F]{2})/i) {
            my ($r, $g, $b) = (hex($1)/255, hex($2)/255, hex($3)/255);
            fill ($cr, $x+1, $y+1, [$r, $g, $b]);
        }
            else {
                warn "$c invalid";
            }
        }
    }
    if ($m) {
        for my $x (0..$t) {
            number ($cr, $x, $x+1, 1);
        }
        for my $y (1..$l) {
            number ($cr, $y, 1, $y+1);
        }
        for my $x (0..$t-1) {
            for my $y (0..$l-1) {
                number ($cr, $m->[$x+$t*$y], $x+2, $y+2);
            }
        }
    }
    my $png = "$title-new.png";
    $surface->write_to_png ($png);
}

sub fill
{
    my ($cr, $x, $y, $col) = @_;
    $cr->set_source_rgb (@$col);
    $x*=$unit;
    $y*=$unit;
    $x+=$margin;
    $y+=$margin;
    $cr->rectangle ($x, $y, $unit, $unit);
    $cr->fill();
}

sub letter
{
    my ($cr, $text, $x, $y) = @_;
    fill ($cr, $x, $y, [(0.7)x3]);
    $cr->select_font_face ('Courier', 'normal', 'bold');
    $cr->set_font_size ($unit);
    put_text ($cr, $text, $x, $y);
}

sub number
{
    my ($cr, $text, $x, $y) = @_;
    my $size = $unit;
    $cr->select_font_face ('Courier', 'normal', 'normal');
    $cr->set_font_size ($unit*0.75);
    put_text ($cr, $text, $x, $y);
}

sub put_text
{
    my ($cr, $text, $x, $y) = @_;
    $cr->set_source_rgb (0,0,0);
    # Get the size of the text. This is a hash reference.
    my $extents = $cr->text_extents ($text);
    # Centre the text in the x direction.
    my $xc = $unit*0.55 - $extents->{width}/2 - $extents->{x_bearing}/2;
    # Go down all of y_bearing, then back up half the height to centre the
    # text in the y direction.
    my $yc = 0.9*$unit+$extents->{y_bearing}+$extents->{height};
    $cr->move_to ($xc+$x*$unit, $yc+$y*$unit);
    $cr->show_text ($text);
    $cr->fill ();
}

(download)