# This is a simple program to convert from # Matt's OKbridge hand records to an HTML # hand record. Why? # Version 0.1 Dec. 19, 1995 # initial implementation # Version 0.2 Dec. 20, 1995 # documented a little # keep blank lines in
blocks # Handles match points # Version 0.3 Dec. 21, 1995 # Old style hands (without time of play) # ensure "West" begins with capital # handle bidding beginning with south, north, or east # fixed bugs in (all pass) stuff # Version 0.4 Feb. 28, 1996 # put , etc. directives # added title capability # -t words produces a title for document, # otherwise the default "OKBridge Match Record" is used. # We are going to use the bridge macro package print "\n"; # for each line in the file # I'm using while (1) instead of while (<>) # because I'm doing inhomogenous line grabbing. # Hands are expected to have as first token # "IMPs" or "Match"; that begins hand parsing. # Hands end with a blank line. All stuff outside # of these delimiters are considered comments and # are spit out verbatim with the following exceptions: # lines of just hyphens are ignored # blank lines are ignored # lines of just equal signs are ignored # Control L is ignored # process arguments require "getopts.pl"; &Getopts('t:'); # some constants $title = "OKBridge Match Record"; $webname = "Jeff Goldsmith"; $webpage = "http://muggy.caltech.edu/~jeff/"; $email = "jeff@tintin.jpl.nasa.gov"; # title as command line argument if ($opt_t) {$title = $opt_t;} &htmlheader; while (1) { # look for first token being "IMPs" or "Match" $eof = 1; # if exit next loop without matching hand $printing = 0; # are we printing interhand goop? $matchpoints = 0; while (<>) { $save = $_; # keep a pristine copy s/^\s+//; # since we can't back up, we'll do the first # line of hand parsing here, as well as find the # first token. ($form,$npos,$set,$junk2,$number,$junk3) = split; #is line beginning of a hand record? if ($form eq "IMPs") {$eof = 0; last;} if ($form eq "Match") { # skip "Points" $form = "Match Points"; $npos = $set; $set = $junk2; $number = $junk3; $matchpoints = 1; #flag for later $eof = 0; last; } # is it okb separators? $form =~ tr/-=\s//d; if ($form eq "") { if ($printing) {print "\n";} next; } # otherwise print it as preformatted text if ($printing == 0) {print "\n";} print $save; $printing = 1; } if ($printing) {print "\n
\n";} if ($eof == 1) {&htmltrailer; exit;} # we have found a hand # get header info # line contains (Formofscoring, "north", label, "Board", number); &getline; ($junk,$dealer) = split; # start parsing hand. # the hands are ($ns,$nh,$nd,$nc) for north's spades, etc. # and es, ws, ss, etc. &getline; ($junk,$vul,$junk,$ns,$pos1,$pos2,$pos3,$pos4) = split; unless (&issuit($ns)) { $pos4 = $pos3; $pos3 = $pos2; $pos2 = $pos1; $pos1 = $ns; $ns = "---"; } &getline; s/^\s+//; ($junk,$nh,$west,$north,$east,$south) = split; unless (&issuit($nh)) # check for void { ($west,$north,$east,$south) = ($nh,$west,$north,$east); $nh = "---"; } &getline; ($junk,$nd) = split; unless (&issuit($nd)) {$nd = "---";} # check for void &getline; ($junk,$nc,@bids) = split; unless (&issuit($nc)) # check for void { unshift(@bids,$nc); $nc = "---"; } $firstbids = @bids; # number in 1st line &getline; ($wpos,$epos,@hold) = split; @bids = (@bids,@hold); &getline; ($junk,$junk,@hold) = split; @bids = (@bids,@hold); &getline; ($junk,$ws,$junk2,$es,@hold) = split; unless (&issuit($ws)) # check for void { unshift(@hold,$es); $es = $junk2; $ws = "---"; } unless (&issuit($es)) # check for void { unshift(@hold,$es); $es = "---"; } @bids = (@bids,@hold); &getline; ($junk,$wh,$junk2,$eh,@hold) = split; unless (&issuit($wh)) # check for void { unshift(@hold,$eh); $eh = $junk2; $wh = "---"; } unless (&issuit($eh)) # check for void { unshift(@hold,$eh); $eh = "---"; } @bids = (@bids,@hold); &getline; ($junk,$wd,$junk2,$ed,@hold) = split; unless (&issuit($wd)) # check for void { unshift(@hold,$ed); $ed = $junk2; $wd = "---"; } unless (&issuit($ed)) # check for void { unshift(@hold,$ed); $ed = "---"; } @bids = (@bids,@hold); &getline; ($junk,$wc,$junk2,$ec,@hold) = split; unless (&issuit($wc)) # check for void { unshift(@hold,$ec); $ec = $junk2; $wc = "---"; } unless (&issuit($ec)) # check for void { unshift(@hold,$ec); $ec = "---"; } @bids = (@bids,@hold); &getline; @hold = split; $spos = $hold[0]; shift(@hold); @bids = (@bids,@hold); &getline; @hold = split; shift(@hold); @bids = (@bids,@hold); &getline; ($junk,$ss,@hold) = split; unless (&issuit($ss)) # check for void { unshift(@hold,$ss); $ss = "---"; } @bids = (@bids,@hold); &getline; ($junk,$sh,@hold) = split; unless (&issuit($sh)) # check for void { unshift(@hold,$sh); $sh = "---"; } @bids = (@bids,@hold); &getline; ($junk,$sd,@hold) = split; unless (&issuit($sd)) # check for void { unshift(@hold,$sd); $sd = "---"; } @bids = (@bids,@hold); &getline; ($junk,$sc,@hold) = split; unless (&issuit($sc)) # check for void { unshift(@hold,$sc); $sc = "---"; } @bids = (@bids,@hold); # grab rest of tokens until blank line while (1) { &getline; #look for blank line if ($_ ne "") { @bids = (@bids,split);} else {last;} } # at this point, $ns,$nh, etc. have the cards for each # hand's suits. Useful info is held in named variables. # @bids contains all the remaining tokens. I've removed # all the noise formating tokens, so all that's left is # a list of the bids made, followed by some result info, # followed by the card play record. # print out hand record # print header print "$set: Board $number
$form
Dealer: $dealer
Vul: $vul\n"; # print the hand diagram if ($npos =~ m/^east$/i) { print "HAND(VHAND($ws,$wh,$wd,$wc),\n"; print " VHAND($ss,$sh,$sd,$sc),\n"; print " VHAND($ns,$nh,$nd,$nc),\n"; print " VHAND($es,$eh,$ed,$ec))\n"; } elsif ($npos =~ m/^south$/i) { print "HAND(VHAND($ss,$sh,$sd,$sc),\n"; print " VHAND($es,$eh,$ed,$ec),\n"; print " VHAND($ws,$wh,$wd,$wc),\n"; print " VHAND($ns,$nh,$nd,$nc))\n"; } elsif ($npos =~ m/^west$/i) { print "HAND(VHAND($es,$eh,$ed,$ec),\n"; print " VHAND($ns,$nh,$nd,$nc),\n"; print " VHAND($ss,$sh,$sd,$sc),\n"; print " VHAND($ws,$wh,$wd,$wc))\n"; } else { print "HAND(VHAND($ns,$nh,$nd,$nc),\n"; print " VHAND($ws,$wh,$wd,$wc),\n"; print " VHAND($es,$eh,$ed,$ec),\n"; print " VHAND($ss,$sh,$sd,$sc))\n"; } # print bidding sequence $allpassproc = 0; print "BID4HEAD(\u$pos1,\u$pos2,\u$pos3,\u$pos4)\n"; print "BID4ROUND($west,$north,$east,$south)\n"; # check for passed out hand...a real pain if ($bids[0] eq "passed") { print "\n"; print "BID4END\n"; print " passed out
\n"; next; } # correct for west's not dealing if ($firstbids == 1) { &cardreplace($bids[0]); print "BID4ROUND(,,,$bids[0])\n"; shift(@bids); } elsif ($firstbids == 2) { &cardreplace($bids[0]); &cardreplace($bids[1]); print "BID4ROUND(,,$bids[0],$bids[1])\n"; shift(@bids); shift(@bids); } elsif ($firstbids == 3) { if ($bids[1] eq "(all") { # how can I tell if it's --- bid (all pass) # or bid (all pass) ---? # check $allpass for location 42 unless (substr($allpass,41,1) eq " ") { # it's "bid (all pass) ---" &cardreplace($bids[0]); print "BID4ROUND($bids[0],pass,pass,pass)\n"; shift(@bids); } else { # it's --- bid (all pass) &cardreplace($bids[0]); print "\n"; shift(@bids); } $allpassproc = 1; } else { &cardreplace($bids[0]); &cardreplace($bids[1]); &cardreplace($bids[2]); print "BID4ROUND(,$bids[0],$bids[1],$bids[2])\n"; shift(@bids); shift(@bids); shift(@bids); } } elsif ($firstbids == 4) { if ($bids[2] eq "(all") { &cardreplace($bids[0]); &cardreplace($bids[1]); print " $bids[0] All Pass \n"; shift(@bids); shift(@bids); $allpassproc = 1; } else { &cardreplace($bids[0]); &cardreplace($bids[1]); &cardreplace($bids[2]); &cardreplace($bids[3]); print "BID4ROUND($bids[0],$bids[1],$bids[2],$bids[3])\n"; shift(@bids); shift(@bids); shift(@bids); shift(@bids); } } # do the rest of the bidding until we reach an "(all" token, # which is expected to end the bidding. unless ($allpassproc) { $count = 0; foreach (@bids) { if ($_ eq "(all") {last;} if ($count == 0) {print "BID4ROUND(";} &cardreplace($_); print; if ($count == 3) {print ")\n"; $count = 0;} else {print ","; $count++;} } if ($count == 1) { print "pass,pass,pass)\n"; } elsif ($count == 2) { print "pass,pass)\n"; print "BID4ROUND(pass)\n"; } elsif ($count == 3) { print "pass)\n"; print "BID4ROUND(pass,pass)\n"; } elsif ($count == 0) { print "BID4ROUND(pass,pass,pass)\n"; } } print "BID4END\n"; # clean up token list while ($bids[0] ne "pass)") {shift(@bids);} # blow up "pass)" token shift(@bids); # next in the token list is misc info $lead = $bids[2]; $result = $bids[4]; $score = $bids[6]; $score1 = $bids[7]; if ($matchpoints) { $score1 = "Match Points"; shift(@bids); } $score2 = $bids[8]; # old versions didn't have playing time if (@bids[9] eq "Playing") { $time = $bids[11]; @bids = @bids[12..$#bids]; $oldstyle = 0; } else { @bids = @bids[9..$#bids]; $oldstyle = 1; } &cardreplace($lead); print "Opening Lead: $lead $bids[0] $bids[1] All Pass
\n"; print "Result: $result
\n"; print "Score: $score $score1 $score2
\n"; unless ($oldstyle) {print "Playing Time: $time
\n";} # Parse play record print "Play Record:
\n"; print "
"; until ($bids[0] =~ m|^[NSEW]$|) { print " | $bids[0] | "; shift(@bids); } print "
W | "; shift(@bids); until ($bids[0] =~ m|^[NSEW]$|) { &cardreplace($bids[0]); print "$bids[0] | "; shift(@bids); } print "
N | "; shift(@bids); until ($bids[0] =~ m|^[NSEW]$|) {&cardreplace($bids[0]); print "$bids[0] | "; shift(@bids);} print "
E | "; shift(@bids); until ($bids[0] =~ m|^[NSEW]$|) {&cardreplace($bids[0]); print "$bids[0] | "; shift(@bids);} print "
S | "; shift(@bids); foreach (@bids) {&cardreplace($_); print "$_ | "; } print "