"; print "$title"; print "

#!/usr/bin/perl # 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 "passed out\n";
	print "BID4END\n";
	print "\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 "$bids[0]All Pass\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]$bids[1]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
\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 "\n";
    print "";
    until ($bids[0] =~ m|^[NSEW]$|)
	{
	print ""; 
	shift(@bids);
	}
    print "\n";
    print "";
    print ""; shift(@bids);
    until ($bids[0] =~ m|^[NSEW]$|)
        {
	&cardreplace($bids[0]); 
	print ""; 
	shift(@bids);
	}
    print "\n";
    print "";
    print ""; shift(@bids);
    until ($bids[0] =~ m|^[NSEW]$|)
	{&cardreplace($bids[0]); print ""; shift(@bids);}
    print "\n";
    print "";
    print ""; shift(@bids);
    until ($bids[0] =~ m|^[NSEW]$|)
	{&cardreplace($bids[0]); print ""; shift(@bids);}
    print "\n";
    print "";
    shift(@bids);
    foreach (@bids)
        {&cardreplace($_); print ""; }
    print "\n";
    print " $bids[0]
W $bids[0]
N $bids[0]
E $bids[0]
S $_\n";
    print "\n";
    } # end main while loop

#--------------------------------------------------
   
# getline does some simple translation on the
# input line.  It keeps track of the line in the
# hand with the "(all pass)" string, removes initial
# whitespace, and handles hyphen strings.  Hyphens are
# converted to " -" because the card play records run
# together and are harder to parse without doing so.
sub getline
    {
    $_ = <>;
    s/^\s+//; s|N-S|North/South|; s|E-W|East/West|; s/-/ -/g;
    if (m|\(all|) {$allpass = $_;}	# save this, we'll need it
    $_;
    }

# Replaces suit/bid text abbreviations with .bml macros
sub cardreplace
    {
    $_[0] =~ s/C/CLUB{}/;
    $_[0] =~ s/D/DIAMOND{}/;
    $_[0] =~ s/H/HEART{}/;
    $_[0] =~ s/S/SPADE{}/;
    $_[0] =~ s/XX/Rdbl/;
    $_[0] =~ s/X/Dbl/;
    }

# Is this cards or other goop?  It's used to check for voids.
sub issuit
    {
    $_[0] =~ m/^[AKQJT2-9]*$/;
    }

sub htmlheader
    {
    print "\n";
    print "\n";
    print "";
    print "$title";
    print "\n";
    print "\n";
    print "\n";
    print "$title\n";
    print "\n";
    }

sub htmltrailer
    {
    print "\n";
    print "\n";
    print '';
    print $webname;
    print ",\n";
    print '';
    print $email;
    print ",\n";
    &printdate;
    print "\n";
    print "\n";
    print "\n";
    print "\n";
    }

sub printdate
    {
    $_ = `date`;
    split;
    print "$_[1]. $_[2], $_[5]\n";
    }