Dat zou natuurlijk het lekkerste zijn. Eventueel het perl script van Darin aanpassen.
#!/usr/bin/perl # # PBN to HTML # # Converts PBN 1.0 files to HTML files. It converts # lines in the order it sees them, and you can display # a token more than once per game, even with different # values. The last value of an appropriate token is # saved. The hands are displayed every time the Hidden # token is used, or before the Auction or Play if it hasn't # been displayed earlier, or at the game end if not # previously displayed. It obviously does not require # export format PBN files, but if you stray too much from # export PBN standard, weird stuff might happen. # # Comments are displayed only if the preceding token is # displayed, or if the comment occurs before any tokens. # # If you use it, drop me a line. Suggestions for # improvements or feature requests welcome. If you want # to improve it yourself, go for it. Just drop me a line # if you do, so I can see the improvements myself. # # Darin Takemoto (takemoto@thecia.net) # # Version history: # # 14 August 1998 Version 0.1 First public release. # # 19 August 1998 Version 0.2 Prints comments in play and # auction, and now really prints comments before tokens. # Improves handling of export format EOLs. Fixes a couple # of bugs. # # 23 August 1998 Version 0.3 Prints the final contract # and result of play ended by a * token. Minor cosmetic # and performance improvements. # # 28 August 1998 Version 0.4 Reworked how result of play # is displayed. Bug fixes. # # The PBN standard is available at the PBN homepage: # http://www.IAEhv.nl/users/veugent/pbn.html # # user defined constants $savename = "output.html"; $title = "Converted PBN File"; $email = "takemoto\@thecia.net"; $export = 0; # set to 1 if EOLs are CRLF. Set to 0 if EOLs are \n. $starends = 1; # If set to 1 the * token means the play/auction has # been completed. If set to 0 the * token does not # necessarily mean that the play/auction has been # completed; it could be stopped without completion. if ($export) { $/ = "\xD\xA"; } $savename = join '', ">",$savename; open (STDOUT, $savename); &htmlheader; $null = "#"; $trick = $hidewest = $hidenorth = $hideeast = $hidesouth = $displayhands = 0; $iscomment = $hashand = $playcount = $callcount = $isresult = $isresultdef = 0; $endauct = $endplay = $iscontract = $ktemp = $passcount = 0; $display = 1; LINE: while (<>) { if ($export) { s/\xD\xA//; } else { chomp($_); } $allcomment = $endline = $tagsplit = $firstrow = 0; if ($_ =~ /^%/) { shift(@_); next LINE; } unless ($play || $auction) { # comments in play and auction handled separately if ($_ =~ /^\{/) { $display = 1; $iscomment = 1; print '<PRE>'; if ($_ =~ /^\{$/) { print "\n"; shift(@_); next LINE; } $_ = substr($_, 1); } } if ($iscomment) { # continuing braced comment if ($_ =~ /^$/) { print "\n"; shift(@_); next LINE; } &bracecomment; $tagsplit = 1; if ($endline) { next LINE; } } s/( |\t)+/ /g; #remove excess whitespace from tags if (!$tagsplit) { @tags = split (/ /); } if ($play) { # parses play $display = 1; unless ($inittable || $cardcomment) { print '<TR>'; } @cards = @tags; CARD: foreach $card (@cards) { if ($allcomment) { $card = &suitcomment($card); print " $card"; shift(@tags); next CARD; } elsif ($iscomment) { $card = &suitcomment($card); shift(@tags); if ($card =~ /\}/) { $iscomment = 0; $cardcomment = 1; $inittable = 1; chop($card); print " $card </PRE>"; next CARD; } print " $card"; next CARD; } elsif ($card =~ /\{/) { $iscomment = 1; $card = substr($card, 1); if ($cardcomment) { print "<PRE>"; } elsif (!$playcount) { print "</TR></TABLE><PRE>"; } else { print "</TD></TR></TABLE><PRE>"; } $card = &suitcomment($card); shift(@tags); if ($card =~ /\}/) { $iscomment = 0; chop($card); $cardcomment = 1; $inittable = 1; print " $card </PRE>"; next CARD; } print " $card"; next CARD; } elsif ($card =~ /;/) { $allcomment = 1; $card = substr($card, 1); if ($playcount) { print "</TD>"; } print "<TD><I>"; $card = &suitcomment($card); print $card; shift(@tags); next CARD; } elsif ($card =~ /\$(\d+)/) { if ($1 == 7) { print '!'; } elsif ($1 == 8) { print '?'; } elsif ($1 == 9) { print '!!'; } elsif ($1 == 10) { print '??'; } elsif ($1 == 11) { print '!?'; } elsif ($1 == 12) { print '?!'; } shift(@tags); next CARD; } elsif ($card =~ /=(\d+)=/) { print '<small><sup> '; print $1; print '</sup></small>'; shift(@tags); next CARD; } elsif ($card =~ /(!|\?)/) { print $card; shift(@tags); next CARD; } elsif ($card =~ /\^L/) { $loot = 1; shift(@tags); next CARD; } elsif ($card =~ /\^R/) { $revoke = 1; shift(@tags); next CARD; } if ($inittable) { print "<P><TABLE CELLPADDING=0 CELLSPACING=0>\n"; $firstrow = 1; $inittable = 0; print '<TR><TD WIDTH=100>'; unless ($playcount == 0) { for ($i = 0; $i < $playcount; $i++) { print '</TD><TD WIDTH=100>'; } } } else { if (!$playcount) { print '<TD'; } else { print '</TD><TD'; } if ($firstrow) { print ' WIDTH=100'; } print '>'; } $cardcomment = 0; if ($card =~ /-/) { print '-'; shift(@tags); $playcount++; next CARD; } elsif ($card =~ /\*/) { # end of play token print '*'; shift(@tags); $endplay = 1; next CARD; } else { @playchars = split (//,$card); if ($loot || $revoke) { print '<I>'; if ($loot) { print '(lead) '; } else { print '(rev.) '; } } if ($playchars[0] =~ /S/i) { &ssym; } elsif ($playchars[0] =~ /H/i) { &hsym; } elsif ($playchars[0] =~ /D/i) { &dsym; } elsif ($playchars[0] =~ /C/i) { &csym; } print $playchars[1]; if ($loot || $revoke) { print '</I>'; $loot = $revoke = 0; } $playcount++; shift(@tags); next CARD; } } if ($playcount > 3) { $playcount = 0; $trick++; } if ($trick > 12 || $endplay) { $play = 0; } if ($iscomment || $cardcomment) { $inittable = 1; } else { if ($allcomment) { print '</I>'; } print '</TD></TR>'; if ($trick > 12 || $endplay) { print '</TABLE><P>'; } } print "\n"; next LINE; } elsif ($auction) { #parses auction $display = 1; unless ($inittable || $callcomment) { print '<TR>'; } @calls = @tags; CALL: foreach $call (@calls) { if ($allcomment) { $call = &suitcomment($call); print " $call"; shift(@tags); next CALL; } elsif ($iscomment) { $call = &suitcomment($call); shift(@tags); if ($call =~ /\}/) { $iscomment = 0; chop($call); $callcomment = 1; $inittable = 1; print " $call </PRE>"; next CALL; } print " $call"; next CALL; } elsif ($call =~ /\{/) { $iscomment = 1; $call = substr($call, 1); if ($callcomment) { print "<PRE>"; } elsif (!$callcount) { print "</TR></TABLE><PRE>"; } else { print "</TD></TR></TABLE><PRE>"; } $call = &suitcomment($call); shift(@tags); if ($call =~ /\}/) { $iscomment = 0; chop($call); $callcomment = 1; $inittable = 1; print "$call </PRE>"; next CALL; } print $call; next CALL; } elsif ($call =~ /;/) { $allcomment = 1; $call = substr($call, 1); if ($callcount) { print '</TD>'; } print '<TD><I>'; $call = &suitcomment($call); print " $call"; shift(@tags); next CALL; } elsif ($call =~ /\$(\d+)/) { if ($1 == 1) { print '!'; } elsif ($1 == 2) { print '?'; } elsif ($1 == 3) { print '!!'; } elsif ($1 == 4) { print '??'; } elsif ($1 == 5) { print '!?'; } elsif ($1 == 6) { print '?!'; } shift(@tags); next CALL; } elsif ($call =~ /=(\d+)=/) { print '<small><sup> '; print $1; print '</sup></small>'; shift(@tags); next CALL; } elsif ($call =~ /(!|\?)/) { print $call; shift(@tags); next CALL; } elsif ($call =~ /\^I/) { $inscall = 1; shift(@tags); next CALL; } elsif ($inittable) { print "<P><TABLE CELLPADDING=0 CELLSPACING=0>\n"; $firstrow = 1; $inittable = 0; print '<TR><TD WIDTH=100>'; unless ($callcount == 0) { for ($i = 0; $i < $callcount; $i++) { print '</TD><TD WIDTH=100>'; } } } else { if (!$callcount) { print '<TD'; } else { print '</TD><TD'; } if ($firstrow) { print ' WIDTH=100'; } print '>'; } $callcomment = 0; if ($call =~ /AP/) { print "All Pass"; $passcount = 3; shift(@tags); next CALL; } elsif ($call =~ /\^S/) { print '<I>Skip</I>'; shift(@tags); $callcount++; next CALL; } elsif ($call =~ /-/) { print '-'; shift(@tags); $callcount++; next CALL; } elsif ($call =~ /XX/) { print 'Redouble'; $risktemp = "Redoubled"; shift(@tags); $callcount++; $passcount = 0; next CALL; } elsif ($call =~ /X/) { print 'Double'; $risktemp = "Doubled"; shift(@tags); $callcount++; $passcount = 0; next CALL; } elsif ($call =~ /P/) { print 'Pass'; shift(@tags); $callcount++; $passcount++; next CALL; } elsif ($call =~ /\*/) { print '*'; shift(@tags); $passcount = 3; $endauct = 1; next CALL; } else { @auctchars = split (//,$call); $ktemp = $auctchars[0]; if ($inscall) { print '<I>(ins.) </I>'; $inscall = 0; } if ($auctchars[1] =~ /N/i) { print "$ktemp NT"; $denomtemp = "NT"; $callcount++; $passcount = 0; shift(@tags); next CALL; } else { print $ktemp; if ($auctchars[1] =~ /S/i) { &ssym; $denomtemp = "S"; } elsif ($auctchars[1] =~ /H/i) { &hsym; $denomtemp = "H"; } elsif ($auctchars[1] =~ /D/i) { &dsym; $denomtemp = "D"; } elsif ($auctchars[1] =~ /C/i) { &csym; $denomtemp = "C"; } $callcount++; $passcount = 0; shift(@tags); next CALL; } } } if ($passcount > 2) { $auction = 0; &setcontract; } if ($callcount > 3) { $callcount = 0; } if ($iscomment || $callcomment) { $inittable = 1; } else { if ($allcomment) { print '</I>'; } print '</TD></TR>'; if ($passcount > 2) { print '</TABLE><P>'; } } print "\n"; next LINE; } else { $inittable = 0; $auction = 0; $play = 0; $passcount = 0; if ($trick > 12 || ($starends && $endplay)) { if ($isresult) { &printresult; } elsif ($isresultdef) { $result = 13 - $resultdef; &printresult; } } $trick = 0; $endplay = 0; if ($endauct) { $endauct = 0; &printcontract; } } if (!$tags[0]) { # empty line means end of current game if (!$displayhands && $hashand) { &printhands; } $oldevent = $event; # save appropriate flags for future use $oldsite = $site; $oldyear = $year; $oldmonth = $month; $olddate = $date; $oldwest = $west; $oldnorth = $north; $oldeast = $east; $oldsouth = $south; $oldbsns = $bsns; $oldbsew = $bsew; $oldwna = $wna; $oldnna = $nna; $oldena = $ena; $oldsna = $sna; $oldwt = $wt; $oldnt = $nt; $oldet = $et; $oldst = $st; $oldeyear = $eyear; $oldemonth = $emonth; $oldedate = $edate; $oldeventspons = $eventspons; $oldhometeam = $hometeam; $oldround = $round; $oldsection = $section; $oldstage = $stage; $oldvisitteam = $visitteam; $oldutcdate = $utcdate; $oldnrgames = $nrgames; $oldnrmin = $nrmin; $oldtimecall = $timecall; $oldtimecard = $timecard; $oldannotator = $annotator; $oldana = $ana; $oldmode = $mode; $board = $west = $north = $east = $south = $dealer = $vul = $declarer = ""; $ktemp = $denomtemp = $risktemp = $result = $resultdef = $first = ""; $k = $denom = $risk = $firstcall = $note = $notenum = $firstplay = ""; $nhand = $ehand = $shand = $whand = $irrdeclarer = $irrresult = $irrresultdef = 0; $isresult = $isresultdef = $displayhands = $iscomment = $allcomment = 0; $hidewest = $hidenorth = $hideeast = $hidesouth = $hashand = $playcount = 0; $callcount = $cardcomment = $callcomment = $iscontract = 0; $display = 1; print "<HR>\n"; next LINE; } if ($tags[0] =~ /^\[Event$/i) { $display = 1; $event = &normtag($oldevent); print '<P><B>Event: </B>'; print $event; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /^\[Site/i) { $display = 1; $site = &normtag($oldsite); print '<P><B>Site: </B>'; print $site; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /^\[Date/i) { $display = 1; if ($tags[1] =~ /"#"/) { # inherited tag $year = $oldyear; $month = $oldmonth; $date = $olddate; shift(@tags); $formdate = join '.', $year,$month,$date; # Can be modified to taste. } elsif ($tags[1] =~ /"(....)\.(..)\.(..)"/) { $year = $1; $month = $2; $date = $3; shift(@tags); $formdate = join '.', $year,$month,$date; } else { $formdate = &normtag($null); warn "Invalid date format\n"; } print '<P><B>Date: </B>'; print $formdate; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /^\[Board/i) { $display = 0; if ($tags[1] =~ /"(\d+)"/) { $board = $1; shift(@tags); } else { $board = &normtag($null); warn "Invalid board number\n"; } shift(@tags); &checkcomment; next LINE; } elsif ($tags[0] =~ /^\[West$/i) { $display = 0; $west = &normtag($oldwest); shift(@tags); &checkcomment; next LINE; } elsif ($tags[0] =~ /^\[North$/i) { $display = 0; $north = &normtag($oldnorth); shift(@tags); &checkcomment; next LINE; } elsif ($tags[0] =~ /^\[East$/i) { $display = 0; $east = &normtag($oldeast); shift(@tags); &checkcomment; next LINE; } elsif ($tags[0] =~ /^\[South$/i) { $display = 0; $south = &normtag($oldsouth); shift(@tags); &checkcomment; next LINE; } elsif ($tags[0] =~ /^\[Dealer/i) { $display = 0; shift(@tags); if ($tags[0] =~ /(W|West)/i) { $dealer = "W"; } elsif ($tags[0] =~ /(N|North)/i) { $dealer = "N"; } elsif ($tags[0] =~ /(E|East)/i) { $dealer = "E"; } elsif ($tags[0] =~ /(S|South)/i) { $dealer = "S"; } shift(@tags); &checkcomment; next LINE; } elsif ($tags[0] =~ /^\[Vulnerable/i) { $display = 0; shift(@tags); if ($tags[0] =~ /(None|Love|-)/i) { $vul = "None"; } elsif ($tags[0] =~ /NS/i) { $vul = "NS"; } elsif ($tags[0] =~ /EW/i) { $vul = "EW"; } elsif ($tags[0] =~ /(All|Both)/i) { $vul = "Both"; } shift(@tags); &checkcomment; next LINE; } elsif ($tags[0] =~ /^\[Deal/i) { $display = 0; shift(@tags); ($first, $firsthand) = split(/:/,$tags[0]); unless ($firsthand =~ /-/) { &hand2suits($firsthand); } &advancesuit; shift(@tags); unless ($tags[0] =~ /-/) { &hand2suits($tags[0]); } &advancesuit; shift(@tags); unless ($tags[0] =~ /-/) { &hand2suits($tags[0]); } &advancesuit; shift(@tags); chop($tags[0]); chop($tags[0]); unless ($tags[0] =~ /-/) { &hand2suits($tags[0]); } shift(@tags); &checkcomment; $hashand = 1; next LINE; } elsif ($tags[0] =~ /^\[Declarer/i) { $display = 0; shift(@tags); if ($tags[0] =~ /(W|West)/i) { $declarer = "West"; } elsif ($tags[0] =~ /(N|North)/i) { $declarer = "North"; } elsif ($tags[0] =~ /(E|East)/i) { $declarer = "East"; } elsif ($tags[0] =~ /(S|South)/i) { $declarer = "South"; } else { $declarer = ""; } $irrdeclarer = &checkirr($tags[0]); shift(@tags); &checkcomment; next LINE; } elsif ($tags[0] =~ /^\[Contract/i) { $display = 0; $iscontract = 1; shift(@tags); @conchars = split('',$tags[0]); if ($conchars[1] =~ /P/i) { $denom = "Pass"; } else { $k = $conchars[1]; if ($conchars[2] =~ /N/i) { $denom = "NT"; shift(@conchars); } elsif ($conchars[2] =~ /S/i) { $denom = "S"; } elsif ($conchars[2] =~ /H/i) { $denom = "H"; } elsif ($conchars[2] =~ /D/i) { $denom = "D"; } elsif ($conchars[2] =~ /C/i) { $denom = "C"; } if ($conchars[3] =~ /X/) { if ($conchars[4] =~ /X/) { $risk = "Redoubled"; } else { $risk = "Doubled"; } } else { $risk = ""; } } shift(@tags); &checkcomment; next LINE; } elsif ($tags[0] =~ /^\[Result/i) { $display = 0; shift(@tags); if ($tags[0] =~ /(\d+)/) { $result = $1; $isresult = 1; $irrresult = &checkirr($tags[0]); } elsif ($tags[0] =~ /NS/i) { if ($declarer =~ /(N|S)/) { $result = &getnum($tags[1]); $isresult = 1; $irrresult = &checkirr($tags[1]); } else { $resultdef = &getnum($tags[1]); $isresultdef = 1; $irrresultdef = &checkirr($tags[1]); } shift(@tags); if ($tags[1] =~ /EW/i) { if ($declarer =~ /(N|S)/) { $resultdef = &getnum($tags[2]); $isresultdef = 1; $irrresultdef = &checkirr($tags[2]); } else { $result = &getnum($tags[2]); $isresult = 1; $irrresult = &checkirr($tags[2]); } shift(@tags); shift(@tags); } } elsif ($tags[0] =~ /EW/i) { if ($declarer =~ /(E|W)/) { $result = &getnum($tags[1]); $isresult = 1; $irrresult = &checkirr($tags[1]); } else { $resultdef = &getnum($tags[1]); $isresultdef = 1; $irrresultdef = &checkirr($tags[1]); } shift(@tags); if ($tags[1] =~ /NS/i) { if ($declarer =~ /(E|W)/) { $resultdef = &getnum($tags[2]); $isresultdef = 1; $irrresultdef = &checkirr($tags[2]); } else { $result = &getnum($tags[2]); $isresult = 1; $irrresult = &checkirr($tags[2]); } shift(@tags); shift(@tags); } } shift(@tags); &checkcomment; next LINE; } elsif ($tags[0] =~ /^\[Auction/i) { $inittable = 0; $display = 0; if (!$displayhands && $hashand) { &printhands; } $auction = 1; shift(@tags); if ($tags[0] =~ /"(\w+)"/) { $firstcall = $1; } else { die "Illegal auction token"; } shift(@tags); &tablehead($firstcall); &checkcomment; next LINE; } elsif ($tags[0] =~ /\[Note/) { $display = 1; @note1 = split(/:/,$tags[1]); if ($note1[0] =~ /"(\d+)"/) { $notenum = $1; } #tweede quote toegevoegd shift(@note1); $tags[1] = join ':', @note1; $tags[1] = join '', '"',$tags[1]; $note = &normtag($null); print '<B>'; print "$notenum"; print ': </B>'; print "$note"; print "<BR>"; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /\[Play/i) { $inittable = 0; $display = 0; if (!$displayhands && $hashand) { &printhands; } $play = 1; shift(@tags); if ($tags[0] =~ /"(\w+)"/) { $firstplay = $1; } else { die "Illegal play token"; } shift(@tags); &tablehead($firstplay); &checkcomment; next LINE; } elsif ($tags[0] =~ /\[Competition/i) { $display = 1; $comp = &normtag($null); print '<P><B>Competition: </B>'; print $comp; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /\[Description/i) { $display = 1; $desc = &normtag($null); print '<P><B>Description: </B>'; print $desc; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /\[FrenchMP/i) { $display = 1; shift(@tags); if ($tags[0] =~ /"(\w+)"/) { $fmp = $1; } print '<P><B>FrenchMP: </B>'; print $fmp; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /\[Generator/i) { $display = 1; $gen = &normtag($null); print '<P><B>Generator: </B>'; print $gen; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /\[Hidden/i) { $display = 0; shift(@tags); $hidewest = $hidenorth = $hideeast = $hidesouth = 0; if ($tags[0] =~ /W/i) { $hidewest = 1; } if ($tags[0] =~ /N/i) { $hidenorth = 1; } if ($tags[0] =~ /E/i) { $hideeast = 1; } if ($tags[0] =~ /S/i) { $hidesouth = 1; } shift(@tags); if ($hashand) { &printhands; } &checkcomment; next LINE; } elsif ($tags[0] =~ /\[Room/i) { $display = 1; shift(@tags); if ($tags[0] =~ /"(\w+)"/) { $room = $1; } if ($room =~ /Open/i) { $room = "Open"; } if ($room =~ /Closed/i) { $room = "Closed"; } print '<P>'; print "$room room"; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /\[Score$/i) { $display = 1; print '<P><B>Score: </B>'; if ($tags[1] =~ /"(.+)"/ ) { $score = $1; if ($declarer =~ /(N|S)/i) { print "NS $score"; } else { print "EW $score"; } shift(@tags); } else { $score = &normtag($null); print "$score"; } shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /\[ScoreIMP/i) { $display = 1; $scoreimp = &normtag($null); print "<P><B>Score (IMP):</B> $scoreimp"; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /\[ScorePercentage/i) { $display = 1; print '<P><B>Score (%): </B>'; if ($tags[1] =~ /"(.+)"/) { $scoreper = $1; if ($declarer =~ /(N|S)/i) { print "NS $scoreper"; } else { print "EW $scoreper \n"; } shift(@tags); } else { $scoreper = &normtag($null); print "$scoreper"; } shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /\[ScoreRubber/i) { $display = 1; print '<P><B>Score (Rubber): </B>'; if ($tags[1] =~ /"(.+)"/) { @scorerub = split('/',$1); if ($declarer =~ /(N|S)/i) { print "NS $scorerub[0] Above, $scorerub[1] Below"; } else { print "EW $scorerub[0] Above, $scorerub[1] Below"; } } else { shift(@tags); @temp = split('',$tags[0]); shift(@temp); $tags[0] = join '',@temp; if ($tags[1] =~ /"\]/) { chop($tags[1]); chop($tags[1]); @scorerub = split('/',$tags[1]); print "$tags[0] $scorerub[0] Above, $scorerub[1] Below"; } else { @scorerub = split('/',$tags[1]); print "$tags[0] $scorerub[0] Above, $scorerub[1] Below "; shift(@tags); shift(@tags); chop($tags[1]); chop($tags[1]); @scorerub = split('/',$tags[1]); print "$tags[0] $scorerub[0] Above, $scorerub[1] Below"; } } shift(@tags); shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /\[Scoring/i) { $display = 1; $scoring = &normtag($null); print "<P><B>Scoring:</B> $scoring"; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /\[Termination/i) { $display = 1; $term = &normtag($null); print "<P><B>Termination:</B> $term"; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /\[BidSystemNS/i) { $display = 1; $bsns = &normtag($oldbsns); print "<P><B> NS Bidding System:</B> $bsns"; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /\[BidSystemEW/i) { $display = 1; $bsew = &normtag($oldbsew); print "<P><B> EW Bidding System:</B> $bsew"; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /\[WestNA/i) { $display = 1; $wna = &normtag($oldwna); print '<P><B>'; if ($west) { print $west; } else { print 'West'; } print ' e-mail: </B><a href = "mailto:'; print $wna; print '">'; print $wna; print "</a>"; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /\[NorthNA/i) { $display = 1; $nna = &normtag($oldnna); print '<P><B>'; if ($north) { print $north; } else { print 'North'; } print ' e-mail: </B><a href = "mailto:'; print $nna; print '">'; print $nna; print "</a>"; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /\[EastNA/i) { $display = 1; $ena = &normtag($oldena); print '<P><B>'; if ($east) { print $east; } else { print 'East'; } print ' e-mail: </B><a href = "mailto:'; print $ena; print '">'; print $ena; print "</a>"; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /\[SouthNA/i) { $display = 1; $sna = &normtag($oldsna); print '<P><B>'; if ($south) { print $south; } else { print 'South'; } print ' e-mail: </B><a href = "mailto:'; print $sna; print '">'; print $sna; print "</a>"; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /\[WestType/i) { $display = 1; $wt = &normtag($oldwt); print "<P><B>West Player Type:</B> $wt"; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /\[NorthType/i) { $display = 1; $nt = &normtag($oldnt); print "<P><B>North Player Type:</B> $nt"; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /\[EastType/i) { $display = 1; $et = &normtag($oldet); print "<P><B>East Player Type:</B> $et"; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /\[SouthType/i) { $display = 1; $st = &normtag($oldst); print "<P><B>South Player Type:</B> $st"; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /^\[EventDate/i) { $display = 1; if ($tags[1] =~ /"#"/) { # inherited tag $eyear = $oldeyear; $emonth = $oldemonth; $edate = $oldedate; shift(@tags); $formdate = join '.', $year,$month,$date; # Can be modified to taste. } elsif ($tags[1] =~ /"(....)\.(..)\.(..)"/) { $eyear = $1; $emonth = $2; $edate = $3; shift(@tags); $formdate = join '.', $year,$month,$date; } else { $formdate = &normtag($null); warn "Invalid date format\n"; } print '<P><B>Event Start Date: </B>'; print $formdate; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /^\[EventSponsor/i) { $display = 1; $eventspons = &normtag($oldeventspons); print '<P><B>Event Sponsor: </B>'; print $eventspons; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /^\[HomeTeam/i) { $display = 1; $hometeam = &normtag($oldhometeam); print '<P><B>Home Team: </B>'; print $hometeam; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /^\[Round/i) { $display = 1; $round = &normtag($oldround); print '<P><B>Round: </B>'; print $round; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /^\[Section/i) { $display = 1; $section = &normtag($oldsection); print '<P><B>Section: </B>'; print $section; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /^\[Stage/i) { $display = 1; $stage = &normtag($oldstage); print '<P><B>Stage: </B>'; print $stage; shift(@tags); print "\n"; next LINE; } elsif ($tags[0] =~ /^\[Table/i) { $display = 1; $table = &normtag($null); print '<P><B>Table: </B>'; print $table; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /^\[VisitTeam/i) { $display = 1; $visitteam = &normtag($oldvisitteam); print '<P><B>Visiting Team: </B>'; print $visitteam; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /^\[Time$/i) { $display = 1; $time = &normtag($null); print '<P><B>Time: </B>'; print $time; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /^\[UTCDate/i) { $display = 1; $utcdate = &normtag($oldutcdate); print '<P><B>Date (UTC): </B>'; print $utcdate; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /^\[UTCTime/i) { $display = 1; $utctime = &normtag($null); print '<P><B>Time (UTC): </B>'; print $utctime; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /\[TimeControl/i) { $display = 1; shift(@tags); if ($tags[0] =~ /#/) { $nrgames = $oldnrgames; $nrmin = $oldnrmin; } elsif ($tags[0] =~ m|"(\d+)/(\d+)|) { $nrgames = $1; $nrmin = $2; } print '<P><B>Time Control: </B>'; print "$nrgames Hands in $nrmin Minutes"; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /^\[TimeCall/i) { $display = 1; $timecall = &normtag($oldtimecall); print '<P><B>Time to make a call: </B>'; print $timecall; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /^\[TimeCard/i) { $display = 1; $timecard = &normtag($oldtimecard); print '<P><B>Time to play a card: </B>'; print $timecard; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /^\[Annotator$/i) { $display = 1; $annotator = &normtag($oldannotator); print '<P><B>Annotator: </B>'; print $annotator; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /\[AnnotatorNA/i) { $display = 1; $ana = &normtag($oldana); print '<P><B>'; if ($annotator) { print $annotator; } else { print 'Annotator'; } print ' e-mail: </B><a href = "mailto:'; print $ana; print '">'; print $ana; print "</a>"; shift(@tags); &checkcomment; print "\n"; next LINE; } elsif ($tags[0] =~ /^\[Mode/i) { $display = 1; $mode = &normtag($oldmode); print '<P><B>Mode: </B>'; print $mode; shift(@tags); &checkcomment; print "\n"; next LINE; } } if (!$displayhands && $hashand) { &printhands; } if ($trick > 12 || ($starends && $endplay)) { if ($isresult) { &printresult; } elsif ($isresultdef) { $result = 13 - $resultdef; &printresult; } } if ($endauct) { &printcontract; } &htmlfooter; close (STDOUT); exit 0; # Prints a html header sub htmlheader { print "<HTML>\n"; print '<HEAD><TITLE>'; print "$title"; print "</TITLE></HEAD>\n"; print "<BODY>\n"; print '<CENTER><H3>'; print "$title"; print "</H3></CENTER>\n"; } # Prints a spade symbol sub ssym { print '<IMG SRC=s.gif ALT=S>'; } # Prints a heart symbol sub hsym { print '<IMG SRC=h.gif ALT=H>'; } # Prints a diamond symbol sub dsym { print '<IMG SRC=d.gif ALT=D>'; } # Prints a club symbol sub csym { print '<IMG SRC=c.gif ALT=C>'; } # Handles a normal text tag sub normtag { $oldtemp = shift; shift(@tags); if ($tags[0] =~ /"#"/) { # inherited tag return $oldtemp; } elsif ($tags[0] =~ /"(.*)"\]/) { #one word event return $1; } else { $tags[0] = substr($tags[0], 1); $normtemp = $tags[0]; shift(@tags); @temps = @tags; TEMP: foreach $temp (@temps) { unless ($temp =~ /"\]/) { $normtemp = join ' ', $normtemp,$temp; shift(@tags); next TEMP; } $temp = substr($temp, 0, -2); $normtemp = join ' ', $normtemp,$temp; last; } return $normtemp; } } # Converts a PBN hand to suits # sub hand2suits { $hand = shift; @suits = split (/\./, $hand); if ($first =~ /W/i) { $ws = &isvoid($suits[0]); $wh = &isvoid($suits[1]); $wd = &isvoid($suits[2]); $wc = &isvoid($suits[3]); $whand = 1; } elsif ($first =~ /N/i) { $ns = &isvoid($suits[0]); $nh = &isvoid($suits[1]); $nd = &isvoid($suits[2]); $nc = &isvoid($suits[3]); $nhand = 1; } elsif ($first =~ /E/i) { $es = &isvoid($suits[0]); $eh = &isvoid($suits[1]); $ed = &isvoid($suits[2]); $ec = &isvoid($suits[3]); $ehand = 1; } elsif ($first =~ /S/i) { $ss = &isvoid($suits[0]); $sh = &isvoid($suits[1]); $sd = &isvoid($suits[2]); $sc = &isvoid($suits[3]); $shand = 1; } return; } # Advances the suit clockwise sub advancesuit { if ($first =~ /W/i) { $first = "N"; } elsif ($first =~ /N/i) { $first = "E"; } elsif ($first =~ /E/i) { $first = "S"; } elsif ($first =~ /S/i) { $first = "W"; } } # Replaces "" with - # sub isvoid { $suit = shift; if ($suit) { return $suit; } else { return "-"; } } # Checks for irregularity. Returns 1 if there # is an irregularity, otherwise it returns 0. sub checkirr { $check = shift; if ($check =~ /\^/) { return 1; } else { return 0; } } # Gets a number from a token sub getnum { $token = shift; if ($token =~ /(\d+)/) { return $1; } else { warn "No number in token"; return ""; } } # Prints out result tag sub printresult { print '<P>'; if ($irrresult || $irrresultdef) { print "<I>(irr.) </I>"; } if ($k) { if (($result - 6) >= $k) { print "Contract made"; $ot = $result - 6 - $k; if ($ot > 1) { print " with $ot overtricks"; } elsif ($ot) { print " with 1 overtrick"; } $ot = 0; } else { $ut = $k - $result + 6; if ($ut > 1) { print "Contract was set $ut tricks"; } else { print "Contract was set 1 trick"; } $ut = 0; } } else { print "Declarer made $result tricks"; } print "<BR>\n"; } # Prints the final contract if the auction ends with a * token. sub printcontract { if ($denom =~ /Pass/) { print "<P>The hand was passed out<BR>\n"; } elsif ($k) { print "<P>The final contract was $k"; if ($denom =~ /N/i) { print " NT"; } elsif ($denom =~ /S/i) { &ssym; } elsif ($denom =~ /H/i) { &hsym; } elsif ($denom =~ /D/i) { &dsym; } else { &csym; } if ($risk) { print " $risk"; } if ($declarer) { print " by $declarer"; } print "<BR>\n"; } } # Checks whether there is a current contract. If not, sets # the contract to the last calls of the auction. sub setcontract { if (!$iscontract) { if (!$ktemp) { $denom = "Pass"; } else { $k = $ktemp; $denom = $denomtemp; $risk = $risktemp; } } } # Prints a hand diagram sub printhands { $displayhands++; $br = 0; print "<P><TABLE CELLPADDING=0 CELLSPACING=0>\n"; print "<TR VALIGN=TOP><TD width=140>\n"; if (!$board) { $br++; } else { print "Board $board"; print "<BR>\n"; } if (!$vul) { $br++; } else { print "$vul Vul.<BR>\n"; } if (!$dealer) { $br++; } else { print "Dealer $dealer"; print "<BR>\n"; } print "<BR>\n"; while ($br > 0) { print '<BR>'; $br--; } if ($whand && !$hidewest) { if (!$west) { print 'West'; } else { print "$west"; } } print "\n"; print "</TD><TD width=140>\n"; if ($nhand && !$hidenorth) { if (!$north) { print 'North'; } else { print "$north"; } } print "<BR>\n"; if ($nhand && !$hidenorth) { &printhand($ns,$nh,$nd,$nc); } else { print '<BR><BR><BR>'; } print "\n"; print "</TD><TD width=140><BR><BR><BR><BR>\n"; if ($ehand && !$hideeast) { if (!$east) { print 'East'; } else { print "$east"; } } print "\n"; print "</TD></TR><TR VALIGN=TOP><TD>\n"; if ($whand && !$hidewest) { &printhand($ws,$wh,$wd,$wc); } else { print '<BR><BR><BR>'; } print "</TD>\n"; print '<TD><BR><BR><BR>'; if ($shand && !$hidesouth) { if (!$south) { print 'South'; } else { print "$south"; } } print "</TD>\n"; print '<TD>'; if ($ehand && !$hideeast) { &printhand($es,$eh,$ed,$ec); } else { print '<BR><BR><BR>'; } print "\n"; print "</TD></TR><TR><TD></TD><TD>\n"; if ($shand && !$hidesouth) { &printhand($ss,$sh,$sd,$sc); } else { print '<BR><BR><BR>'; } print "</TD><TD></TD></TR></TABLE><P>\n"; } # Prints a single hand sub printhand { $suit = shift; @temp = split('',$suit); $suit = join ' ', @temp; &ssym; print ' '; print $suit; print "<BR>\n"; $suit = shift; @temp = split('',$suit); $suit = join ' ', @temp; &hsym; print ' '; print $suit; print "<BR>\n"; $suit = shift; @temp = split('',$suit); $suit = join ' ', @temp; &dsym; print ' '; print $suit; print "<BR>\n"; $suit = shift; @temp = split('',$suit); $suit = join ' ', @temp; &csym; print ' '; print $suit; } # Prints an auction header sub tablehead { print "<P><TABLE CELLPADDING=0 CELLSPACING=0>\n"; print '<TR>'; $temp = shift; for ($i = 0; $i < 4; $i++) { if ($temp =~ /W|West/i) { print '<TD WIDTH=100>West</TD>'; $temp = "N"; } elsif ($temp =~ /N|North/i) { print '<TD WIDTH=100>North</TD>'; $temp = "E"; } elsif ($temp =~ /E|East/i) { print '<TD WIDTH=100>East</TD>'; $temp = "S"; } elsif ($temp =~ /S|South/i) { print '<TD WIDTH=100>South</TD>'; $temp = "W"; } } print "</TR>\n"; print '<TR>'; for ($i = 0; $i < 4; $i++) { print '<TD>'; if ($temp =~ /W|West/i) { print $west; $temp = "N"; } elsif ($temp =~ /N|North/i) { print $north; $temp = "E"; } elsif ($temp =~ /E|East/i) { print $east; $temp = "S"; } elsif ($temp =~ /S|South/i) { print $south; $temp = "W"; } print '</TD>'; } print "</TR>\n"; } # Checks for comments sub checkcomment { $comment = ""; if ($tags[0]) { if ($tags[0] =~ /\{/) { $iscomment = 1; if ($display) { print '<PRE>'; $comment = substr($tags[0], 1); shift(@tags); if ($comment =~ /\}/) { chop($comment); $comment = &suitcomment($comment); print "$comment </PRE>"; $iscomment = 0; $inittable = 1; if (!$tags[0]) { $endline = 1; } else { &checkcomment; } return; } @comtemps = @tags; foreach $comtemp (@comtemps) { $comment = join ' ', $comment,$comtemp; shift(@tags); if ($comtemp =~ /\}/) { chop($comment); print "$comment </PRE>"; $iscomment = 0; $inittable = 1; if (!$tags[0]) { $endline = 1; } else { &checkcomment; } return; } } $comment = &suitcomment($comment); print "$comment"; } else { @comtemps = @tags; foreach $comtemp (@comtemps) { shift(@tags); if ($comtemp =~ /\}/) { $iscomment = 0; if (!$tags[0]) { $endline = 1; } else { &checkcomment; } return; } } } $endline = 1; return; } if ($tags[0] =~ /;/) { if ($display) { $comment = substr($tags[0], 1); shift(@tags); @comtemps = @tags; foreach $comtemp (@comtemps) { $comment = join ' ', $comment,$comtemp; shift(@tags); } $comment = &suitcomment($comment); print "<I> $comment </I><BR>"; } else { @comtemps = @tags; foreach $comtemp (@comtemps) { shift(@tags); } } } return; } } # Continues a braced comment sub bracecomment { $comment = ""; @tags = split (/ /); if ($display) { if ($tags[0] =~ /\}/) { chop($tags[0]); $tags[0] = &suitcomment($tags[0]); print "$tags[0] </PRE>"; $iscomment = 0; $inittable = 1; shift(@tags); if (!$tags[0]) { $endline = 1; } else { &checkcomment; } return; } @comtemps = @tags; foreach $comtemp (@comtemps) { $comment = join ' ', $comment,$comtemp; shift(@tags); if ($comtemp =~ /\}/) { chop($comment); $comment = &suitcomment($comment); print "$comment </PRE>"; $iscomment = 0; $inittable = 1; if (!$tags[0]) { $endline = 1; } else { &checkcomment; } return; } } $comment = &suitcomment($comment); print "$comment \n"; } else { @comtemps = @tags; foreach $comtemp (@comtemps) { shift(@tags); if ($comtemp =~ /\}/) { $iscomment = 0; if (!$tags[0]) { $endline = 1; } else { &checkcomment; } return; } } } $endline = 1; return; } # Adds suit symbols to comments sub suitcomment { $temp = shift; $temp =~ s/\\S/<IMG SRC=s.gif ALT=S>/gi; $temp =~ s/\\H/<IMG SRC=h.gif ALT=H>/gi; $temp =~ s/\\D/<IMG SRC=d.gif ALT=D>/gi; $temp =~ s/\\C/<IMG SRC=c.gif ALT=C>/gi; return $temp; } # Prints a html footer sub htmlfooter { print "<HR>\n"; print '<a href = "mailto:'; print $email; print '">'; print $email; print "</a>\n"; print '</BODY></HTML>'; }