#!/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;