Hollerith punch card emulator for an MMH 2016 puzzle

#!/usr/bin/perl
#                                               Robert Munafo
#                                        Test Solution Please Ignore
#                                         MIT IAP Mystery Hunt, 2016
#      MMH 2016 "Huntception" (aka "Muttstery Hunt") : Randolph Carter : The Gibbous, Non-Euclidean Program

my @cardrows = ();

sub clearcard
{
  my($c) = @_;
  for ($i=0; $i<12; $i++) {
    $cardrows[$i] = ("0" x 80);
  }
  $col = $c;
  $page = $page << 1;
}

# $page starts at 1, then 2 then 4.
# we punch by ORing in the current page bit
# if the same char appears in the same position on two pages
# the holes in that column will have the page values ORd together
# if a hole is 7, all three pages' cards have a hole in that position.
sub newpage
{
  my($c) = @_;
  $col = $c;
  $page = $page << 1;
}

# show the card as 3-bit values 01234567
sub display
{
  my($i);
  for ($i=0; $i<12; $i++) {
    print "$cardrows[$i]\n";
  }
}

# don't show 0's
sub disp1
{
  my($i, $t);
  for ($i=0; $i<12; $i++) {
    $t = $cardrows[$i];
    $t =~ s/0/./g;
    print "$t\n";
  }
}

# show only the 7's
sub disp2
{
  my($i, $t);
  for ($i=0; $i<12; $i++) {
    $t = $cardrows[$i];
    $t =~ s/[0-6]/./g;
    print "$t\n";
  }
}

# punch a hole at the gven column and row
sub punch_col_row
{
  my($c, $r) = @_;
  my (@dots);
  my($t);
  @dots = split(//, $cardrows[$r]);
  $t = @dots[$c];
  $t = ord($t) - ord('0');
  $t |= $page;
  @dots[$c] = chr(ord('0') + $t);
  $cardrows[$r] = join('', @dots);
}

# IBM Hollerith code
# from homepage.cs.uiowa.edu/~jones/cards/codes.html
#   "The IBM model 029 keypunch, introduced around 1964, was the most
#   common keypunch of the late 1960's and early 1970's"
%hcodes = (
  "0" => "..O.........",
  "1" => "...O........",
  "2" => "....O.......",
  "3" => ".....O......",
  "4" => "......O.....",
  "5" => ".......O....",
  "6" => "........O...",
  "7" => ".........O..",
  "8" => "..........O.",
  "9" => "...........O",
  "A" => "O..O........",
  "B" => "O...O.......",
  "C" => "O....O......",
  "D" => "O.....O.....",
  "E" => "O......O....",
  "F" => "O.......O...",
  "G" => "O........O..",
  "H" => "O.........O.",
  "I" => "O..........O",
  "J" => ".O.O........",
  "K" => ".O..O.......",
  "L" => ".O...O......",
  "M" => ".O....O.....",
  "N" => ".O.....O....",
  "O" => ".O......O...",
  "P" => ".O.......O..",
  "Q" => ".O........O.",
  "R" => ".O.........O",
  "/" => "..OO........",
  "S" => "..O.O.......",
  "T" => "..O..O......",
  "U" => "..O...O.....",
  "V" => "..O....O....",
  "W" => "..O.....O...",
  "X" => "..O......O..",
  "Y" => "..O.......O.",
  "Z" => "..O........O",
);

# Punch a character at the current column $col (a global)
sub pchar
{
  my($c) = @_;
  my(@dots);
  my($j);
  # print "pchar('$c')\n";
  if ($hcodes{$c} ne '') {
    @dots = split(//, $hcodes{$c});
    # print "$c -> $dots[0] $dots[1] $dots[2] ...\n";
    for($j=0; $j<12; $j++) {
      if ($dots[$j] eq 'O') {
        &punch_col_row($col, $j);
      }
    }
  } else {
    die "need to know how to punch a '$c'\n";
  }
}

# First interpretation of "OVERPUNCH TYPOS AND CORRECTIONS, THEN OVERLAY"
# Punch the typo and its correction into whatever column it appears in the
# source text. Overlay the 3 cards on top of each other. For light to get
# through there has to be a hole in the same position on all 3 cards.
open ($IN, "errata.txt");
&clearcard(0);
$page = 1;
while($l = <$IN>) {
  chomp $l;
  if ($l =~ m/eject/) {
    # We're done punching this card
    &disp1();
    &newpage(0);
  } else {
    ($col, $fr, $to) = split(/\t/, $l);
    &pchar($fr);
    &pchar($to);
    print sprintf("%2d   $fr   $to\n", $col);
  }
}
&disp2();
close($IN);

# In this version we ignore what columns the typos occurred in, and instead
# just punch the first typo/correction onto column 1, the next onto col 2, etc.
open ($IN, "errata.txt");
&clearcard(6);
$page = 1;
while($l = <$IN>) {
  chomp $l;
  if ($l =~ m/eject/) {
    # We're done punching this card
    &disp1();
    &newpage(6);
  } else {
    ($x, $fr, $to) = split(/\t/, $l);
    &pchar($fr);
    &pchar($to);
    $col++;
    print sprintf("%2d   $fr   $to\n", $x);
  }
}
close($IN);

# Display just the spots where light could shine through all 3 cards.
print "\n";
&disp2();

# Now display these again along with the lines they are laid over.
print "\n";
open ($IN, "v2.f");
$i = 0; $active = 0;
while ($l = <$IN>) {
  if ($l =~ m/JET=FFOS/) {
    $active = 1;
  }
  if ($active && ($i < 12)) {
    $t = $cardrows[$i];
    $t =~ s/[0-6]/./g;
    print "$t\n";
    print "$l\n";
    $i++;
  }
}
close $IN;