#! perl -slw
use strict;
use vars qw[$T $S];

sub promptfor{
    my ($rv, $prompt, $match) = ('',@_);
    do{
        printf $prompt;
    } until ($rv = <STDIN>) =~ m[^$match$];
    chomp($rv);
    return $rv;
}

my (@tops, @sides);
if( $S ) {
    @sides = split ' ', $S;
}
else {
    my $count = promptfor 'How many side pairs? ', '\d';
    push @sides, promptfor 'Enter side pair ( xx ): ', '\w{2}' while $
+count--;
}

if( $T ) {
    @tops = split ' ', $T;
}
else {
    my $count = promptfor 'How many top pairs? ', '\d';
    push @tops, promptfor 'Enter top pair ( xx ): ', '\w{2}' while $co
+unt--;
}

printf '    ' . '  %2s  ' x @tops . $/, @tops;

for my $side ( @sides ) {
    printf ' %2s ' . ' %2s%2s ' x @tops . $/, $side, map{ $side, $_ } 
+@tops;
}

__END__
D:\Perl\test>258302
How many side pairs? 4
Enter side pair ( xx ): AC
Enter side pair ( xx ): Ac
Enter side pair ( xx ): aC
Enter side pair ( xx ): ac
How many top pairs? 4
Enter top pair ( xx ): CA
Enter top pair ( xx ): Ca
Enter top pair ( xx ): cA
Enter top pair ( xx ): ca
      CA    Ca    cA    ca
 AC  ACCA  ACCa  ACcA  ACca
 Ac  AcCA  AcCa  AccA  Acca
 aC  aCCA  aCCa  aCcA  aCca
 ac  acCA  acCa  accA  acca

D:\Perl\test>258302 -T="AC Ac aC ac" -S="AC Ac aC ac"
      AC    Ac    aC    ac
 AC  ACAC  ACAc  ACaC  ACac
 Ac  AcAC  AcAc  AcaC  Acac
 aC  aCAC  aCAc  aCaC  aCac
 ac  acAC  acAc  acaC  acac
[download]