User:Ilmari Karonen/ahnentafel2.pl

This is the

}}). You can use it to make more if you want.

See User:Ilmari Karonen/ahnentafel.pl for a version that produces more readable but much less efficient output.

#!/usr/bin/perl -w
use strict;

my $depth = shift or die "Usage: $0 <depth>\n";

my $nbsp = qq(<div style="width: 0.5em; height: 0.5em;"><span style="font: 1px/1px serif;"> </span></div>);

sub box {
    my ($n, $col) = @_;
    print STDERR "*";
    my (@row1, @row2);
    push @row1, ($n & 1 ? qq(<td style="border-left: 1px solid black; border-bottom: 1px solid black;">) : qq(<td>)) . qq($nbsp</td>) if $col > 1;
    push @row2, (!($n & 1) ? qq(<td style="border-left: 1px solid black; border-top: 1px solid black;">) : qq(<td>)) . qq($nbsp</td>) if $col > 1;

    push @row1, qq(<td rowspan="2" style="border:{{{border_$col|{{{border|2}}}}}}px solid black;padding:0 0.2em;{{{boxstyle|}}};{{{boxstyle_$col|}}}">{{{$n}}}</td>);

    push @row1, qq(<td style="border-bottom: 1px solid black;">$nbsp</td>) if $col < $depth;
    push @row2, qq(<td>$nbsp</td>) if $col < $depth;

    return (join("\n", @row1, ""), join("\n", @row2, ""));
}

sub gap {
    my ($rows, $odd, $col) = @_;
    my $char = ($odd ? " " : "-");
    print STDERR $char x $rows;
    return unless $rows;
    $rows *= 2;
    my $cols = ($col == 1 || $col == $depth ? 2 : 3);
    my $style = (!$odd ? ' style="border-left: 1px solid black;"' : '');
    return (qq(<td colspan="$cols" rowspan="$rows"$style>$nbsp</td>\n), ("") x ($rows-1));
}

my @table;
for my $col (1 .. $depth) {
    my @col;
    my $step = 1 << ($depth - $col);

    push @col, gap($step-1, 1, $col);

    for my $n ( 1<<($col-1) .. (1<<$col)-2 ) {
	push @col, box($n, $col), gap(2*$step-1, $n & 1, $col);
    }

    push @col, box((1<<$col)-1, $col), gap($step-1, 1, $col);

    print STDERR "\n";
    push @table, \@col;
}

print '<table cellspacing="0" cellpadding="0" border="0" style="{{{style|}}}">' . "\n";
for my $row (0 .. $#{$table[-1]}) {
    print '<tr align="center">' . "\n";
    for my $col (0 .. $#table) {
	print $table[$col][$row];
    }
    print "</tr>\n";
}
print "</table>\n";

__END__