#!/usr/bin/perl 
#
# macros.pl
#
# This converts bml (Bridge Macro Language) code
# into HTML.  It is somewhat patterned after a version
# done in m4 in early 1996.  This one doesn't do all
# the same things and has different problems, but is
# much more portable.
#
# Version: 0.1
#    April 11, 1996, initial write
# Version: 0.2
#    April 17, 1996
#	Added escaped parentheses
# Version: 0.3
#    January 5, 1998
#       Many changes, including sizes for pips, Smileys, more.
# Version: 0.4
#    April 14, 1998
#       Fixed missing quotes
# Version: 0.5
#    September 8, 1998
#	Added SPADE, HEART, DIAMOND, CLUB macros
#	for Tom Carmichael.
# Version: 0.6
#    Unknown date
#       VOID
#       13-card hand counter
# Version: 0.7
#    October 24, 2002
#       VOID
#       Improved panelist
#       Table tool
# Version: 0.8
#    January 29, 2003
#       HEADER and FOOTER
# Version: 0.9
#    October 29, 2014
#       HHAND14
#       Fixed shebang line
# Version: 0.10
#    February 26, 2020
#       Replace smart quotes
#
# Macros:
#    CARD(text)
#	changes 1S or SA to what you expect.
#    HHAND(s,h,d,c)
#       prints a hand horizontally
#    HHAND14(s,h,d,c)
#       allows non-13-card-hands
#    VHAND(s,h,d,c)
#       prints a hand vertically
#    HAND(north,west,east,south)
#       prints a hand diagram
#    BIDDING(player1,player2,bid,bid,bid,...)
#       draws a bidding sequence between two players
#    BID4(p1,p2,p3,p4,bid,bid,bid,...)
#       draws a bidding sequence among all four players
#    SUIT(north,south)
#       draws a simple single-dummy suit combination
#    FOOTNOTE(text)
#       draws footnote markers
#    PANELIST(text)
#       draws panelist headers in small caps
#    OBIDDING,OBID4
#       similar to old macros; doesn't consider
#       its arguments to be bids; you have to say CARD() 
#       of everything.  Somewhat helpful when you have
#       very complex things with stuff inside the bids.
#    SMILEY
#	obvious
#    SPADE, HEART, DIAMOND, CLUB
#	expand to suit symbols; same as CARD(S), CARD(H), etc.
#    DASH or VOID
#	-> — an em dash
#    MAKETABLE
#    TABLEROW
#    ENDTABLE
#       convenient for vote tabulations
#    HEADER(title)
#    FOOTER()
#
# Known problems:
#    It doesn't handle nested parentheses right.
#	Escaping parens helps: \( and \) are
#	handled fine, although FOO(BAR()) might
#       not be.  The precedence rules are pretty
#	good about that, though.
#    It doesn't do the old line-by-line bidding macros.
#	It doesn't really need them.
#
# Improvements over m4 version:
#    No quoting "shift" needed.
#    No include line needed.
#    Unlimited number of arguments in bidding macros,
#        which will mostly make the line-by-line macros obsolete.
#    Can handle doubles and redoubles in CARD
#    Way fast.
#
# Unknown problems:
#    If I knew them, they would be known problems, silly!

#require "ctime.pl";
use Time::localtime;

$simg = 'gifs/s.gif';
$himg = 'gifs/h.gif';
$dimg = 'gifs/d.gif';
$cimg = 'gifs/c.gif';
$swidth = 13;  # width of pips (hardcoded)
$sheight = 11; # height of pips (hardcoded)
$smiley = 'gifs/smiley.gif';
$tmarker = 'gifs/table11.gif';

@_ = <>;
$_ = join("",@_);
# remove escaped parens
&hide_parens($_);
&bridge_trans($_);
&bridge_trans($_);
&bridge_trans($_);
&bridge_trans($_);
&bridge_trans($_);
&replace_parens($_);
print $_;

# Bridge formatting stuff

# hide_parens converts \( and \) into QUOTED_PAREN and QUOTED_THESIS
sub hide_parens
    {
    $_[0] =~ s/\\\(/_QUOTED_PAREN_/g;
    $_[0] =~ s/\\\)/_QUOTED_THESIS_/g;
    }

# replace_parens reverses above and removes escapes
sub replace_parens
    {
    $_[0] =~ s/_QUOTED_PAREN_/(/g;
    $_[0] =~ s/_QUOTED_THESIS_/)/g;
    }

# this takes a string and does replacement
sub bridge_trans
    {
    $_[0] =~ s/{}FOOTNOTE\(([^)]*)\)/&footnote($1)/ge;
    $_[0] =~ s/{}CARD\(([^)]*)\)/&card($1)/ge;
    $_[0] =~ s/{}HHAND\(([^)]*)\)/&hhand($1)/ge;
    $_[0] =~ s/{}HHAND14\(([^)]*)\)/&hhand14($1)/ge;
    $_[0] =~ s/{}OBIDDING\(([^)]*)\)/&old_bidding($1)/ge;
    $_[0] =~ s/{}OBID4\(([^)]*)\)/&old_bid4($1)/ge;
    $_[0] =~ s/{}BIDDING\(([^)]*)\)/&bidding($1)/ge;
    $_[0] =~ s/{}BID4\(([^)]*)\)/&bid4($1)/ge;
    $_[0] =~ s/{}VHAND\(([^)]*)\)/&vhand($1)/ge;
    $_[0] =~ s/{}HAND\(([^)]*)\)/&hand($1)/ge;
    $_[0] =~ s/{}SUIT\(([^)]*)\)/&suit($1)/ge;
    $_[0] =~ s/{}PANELIST\(([^)]*)\)/&panelist($1)/ge;
    $_[0] =~ s/{}SMILEY/\<img src = \"$smiley\"\ alt = \":)\">/g;
    $_[0] =~ s/{}SPADE/\<IMG SRC = \"$simg\" width = 13 height = 11 border = 0 ALT = \"S:\"\>/g;
    $_[0] =~ s/{}HEART/\<IMG SRC = \"$himg\" width = 13 height = 11 border = 0 ALT = \"H:\"\>/g;
    $_[0] =~ s/{}DIAMOND/\<IMG SRC = \"$dimg\" width = 13 height = 11 border = 0 ALT = \"D:\"\>/g;
    $_[0] =~ s/{}CLUB/\<IMG SRC = \"$cimg\" width = 13 height = 11 border = 0 ALT = \"C:\"\>/g;
    $_[0] =~ s/{}DASH/\&#151;/g;
    $_[0] =~ s/{}VOID/\&#151;/g;
    $_[0] =~ s/{}MAKETABLE\(([^)]*)\)/&maketable($1)/ge;
    $_[0] =~ s/{}TABLEROW\(([^)]*)\)/&tablerow($1)/ge;
    $_[0] =~ s/{}ENDTABLE\(([^)]*)\)/&endtable($1)/ge;
    $_[0] =~ s/{}HEADER\(([^)]*)\)/&header($1)/ge;
    $_[0] =~ s/{}FOOTER\(([^)]*)\)/&footer($1)/ge;
    $_[0] =~ s/FOOTNOTE\(([^)]*)\)/&footnote($1)/ge;
    $_[0] =~ s/CARD\(([^)]*)\)/&card($1)/ge;
    $_[0] =~ s/HHAND\(([^)]*)\)/&hhand($1)/ge;
    $_[0] =~ s/HHAND14\(([^)]*)\)/&hhand14($1)/ge;
    $_[0] =~ s/OBIDDING\(([^)]*)\)/&old_bidding($1)/ge;
    $_[0] =~ s/OBID4\(([^)]*)\)/&old_bid4($1)/ge;
    $_[0] =~ s/BIDDING\(([^)]*)\)/&bidding($1)/ge;
    $_[0] =~ s/BID4\(([^)]*)\)/&bid4($1)/ge;
    $_[0] =~ s/VHAND\(([^)]*)\)/&vhand($1)/ge;
    $_[0] =~ s/HAND\(([^)]*)\)/&hand($1)/ge;
    $_[0] =~ s/SUIT\(([^)]*)\)/&suit($1)/ge;
    $_[0] =~ s/PANELIST\(([^)]*)\)/&panelist($1)/ge;
    $_[0] =~ s/SMILEY/\<img src = \"$smiley\"\>/g;
    $_[0] =~ s/SPADE/\<IMG SRC = \"$simg\" width = 13 height = 11 border = 0 ALT = \"S:\"\>/g;
    $_[0] =~ s/HEART/\<IMG SRC = \"$himg\" width = 13 height = 11 border = 0 ALT = \"H:\"\>/g;
    $_[0] =~ s/DIAMOND/\<IMG SRC = \"$dimg\" width = 13 height = 11 border = 0 ALT = \"D:\"\>/g;
    $_[0] =~ s/CLUB/\<IMG SRC = \"$cimg\" width = 13 height = 11 border = 0 ALT = \"C:\"\>/g;
    $_[0] =~ s/DASH/\&#151;/g;
    $_[0] =~ s/VOID/\&#151;/g;
    $_[0] =~ s/MAKETABLE\(([^)]*)\)/&maketable($1)/ge;
    $_[0] =~ s/TABLEROW\(([^)]*)\)/&tablerow($1)/ge;
    $_[0] =~ s/ENDTABLE\(([^)]*)\)/&endtable($1)/ge;
    $_[0] =~ s/HEADER\(([^)]*)\)/&header($1)/ge;
    $_[0] =~ s/FOOTER\(([^)]*)\)/&footer($1)/ge;
    $_[0] =~ s/\\'/'/g;
    # get rid of nasty smart quotes
    $_[0] =~ s/‘/&lsquo;/g;
    $_[0] =~ s/’/&rsquo;/g;
    $_[0] =~ s/“/&ldquo;/g;
    $_[0] =~ s/”/&rdquo;/g;
    }

# this replaces 1H, 2S, CA, etc. with appropriate stuff
sub card
    {
    $_ = $_[0];
    if    (/Dbl/i || /Pass/i)      
	{
	$_;
	}
    elsif (/^S/i)
	{
	s/^.//;
	'<nobr><IMG SRC = "'.$simg.'" width = 13 height = 11 border = 0 ALT = "S:">'.$_.'</nobr>';
	}
    elsif (/^H/i)
	{
	s/^.//;
	'<nobr><IMG SRC = "'.$himg.'" width = 13 height = 11 border = 0 ALT = "H:">'.$_.'</nobr>';
	}
    elsif (/^D/i)
	{
	s/^.//;
	'<nobr><IMG SRC = "'.$dimg.'" width = 13 height = 11 border = 0 ALT = "D:">'.$_.'</nobr>';
	}
    elsif (/^C/i)
	{
	s/^.//;
	'<nobr><IMG SRC = "'.$cimg.'" width = 13 height = 11 border = 0 ALT = "C:">'.$_.'</nobr>';
	}
    elsif (/S$/i)
	{
	s/.$//;
	'<nobr>'.$_.'<IMG SRC = "'.$simg.'" width = 13 height = 11 border = 0 ALT = "S:"></nobr>';
	}
    elsif (/H$/i)
	{
	s/.$//;
	'<nobr>'.$_.'<IMG SRC = "'.$himg.'" width = 13 height = 11 border = 0 ALT = "H:"></nobr>';
	}
    elsif (/D$/i)
	{
	s/.$//;
	'<nobr>'.$_.'<IMG SRC = "'.$dimg.'" width = 13 height = 11 border = 0 ALT = "D:"></nobr>';
	}
    elsif (/C$/i)
	{
	s/.$//;
	'<nobr>'.$_.'<IMG SRC = "'.$cimg.'" width = 13 height = 11 border = 0 ALT = "C:"></nobr>';
	}
    elsif (/Sx$/i)
	{
	s/..$//;
	'<nobr>'.$_.'<IMG SRC = "'.$simg.'" width = 13 height = 11 border = 0 ALT = "S:">x</nobr>';
	}
    elsif (/Hx$/i)
	{
	s/..$//;
	'<nobr>'.$_.'<IMG SRC = "'.$himg.'" width = 13 height = 11 border = 0 ALT = "H:">x</nobr>';
	}
    elsif (/Dx$/i)
	{
	s/..$//;
	'<nobr>'.$_.'<IMG SRC = "'.$dimg.'" width = 13 height = 11 border = 0 ALT = "D:">x</nobr>';
	}
    elsif (/Cx$/i)
	{
	s/..$//;
	'<nobr>'.$_.'<IMG SRC = "'.$cimg.'" width = 13 height = 11 border = 0 ALT = "C:">x</nobr>';
	}
    elsif (/Sxx$/i)
	{
	s/...$//;
	'<nobr>'.$_.'<IMG SRC = "'.$simg.'" width = 13 height = 11 border = 0 ALT = "S:">xx</nobr>';
	}
    elsif (/Hxx$/i)
	{
	s/...$//;
	'<nobr>'.$_.'<IMG SRC = "'.$himg.'" width = 13 height = 11 border = 0 ALT = "H:">xx</nobr>';
	}
    elsif (/Dxx$/i)
	{
	s/...$//;
	'<nobr>'.$_.'<IMG SRC = "'.$dimg.'" width = 13 height = 11 border = 0 ALT = "D:">xx</nobr>';
	}
    elsif (/Cxx$/i)
	{
	s/...$//;
	'<nobr>'.$_.'<IMG SRC = "'.$cimg.'" width = 13 height = 11 border = 0 ALT = "C:">xx</nobr>';
	}
    else
	{
	$_;
	}
    }
	

# hhand draws a horizontal hand
# it takes four arguments: spades, hearts, diamonds, clubs
# the reason to start with a space is that some versions of
# netscape have a bug vertically aligning images and text
# on the same line when the image comes first.
sub hhand
    {
    $ncards = &handsize($_[0]);
    @args = split(/,/,$_[0]);
    $result = 
    '<nobr>&#160;<IMG SRC = '.$simg.' border = 0 ALT = "S:">'.$args[0].
                ' <IMG SRC = '.$himg.' border = 0 ALT = "H:">'.$args[1].
                ' <IMG SRC = '.$dimg.' border = 0 ALT = "D:">'.$args[2].
                ' <IMG SRC = '.$cimg.' border = 0 ALT = "C:">'.$args[3].'</nobr>';
    if (!($ncards == 13)) {$result .= " <font color=red> &lt;-- hand has $ncards cards. </font> ";}
    $result;
    }

# this version allows non-13-card hands
sub hhand14
    {
    $ncards = &handsize($_[0]);
    @args = split(/,/,$_[0]);
    $result = 
    '<nobr>&#160;<IMG SRC = '.$simg.' border = 0 ALT = "S:">'.$args[0].
                ' <IMG SRC = '.$himg.' border = 0 ALT = "H:">'.$args[1].
                ' <IMG SRC = '.$dimg.' border = 0 ALT = "D:">'.$args[2].
                ' <IMG SRC = '.$cimg.' border = 0 ALT = "C:">'.$args[3].'</nobr>';
    $result;
    }

# vhand draws a vertical hand
# it takes four arguments: spades, hearts, diamonds, clubs
sub vhand
    {
    @args = split(/,/,$_[0]);
    '<IMG SRC = "'.$simg.'" width = 13 height = 11 border = 0 ALT = "S:"> '.$args[0].'<br>'.
    '<IMG SRC = "'.$himg.'" width = 13 height = 11 border = 0 ALT = "H:"> '.$args[1].'<br>'.
    '<IMG SRC = "'.$dimg.'" width = 13 height = 11 border = 0 ALT = "D:"> '.$args[2].'<br>'.
    '<IMG SRC = "'.$cimg.'" width = 13 height = 11 border = 0 ALT = "C:"> '.$args[3];
    }

# hand draws a full hand diagram
# it takes four arguments, North, West, East, South
sub hand
    {
    @args = split(/,/,$_[0]);
    "<table>\n".
    "<tr><td></td><td>".$args[0]."</td><td></td></tr>\n".
    "<tr><td>".$args[1]."</td><td><img src = \"".$tmarker.
    "\" width = 60 height = 60></td><td>".$args[2]."</td></tr>\n".
    "<tr><td></td><td>".$args[3]."</td><td></td></tr>\n".
    "</table>\n";
    }

# Two player bidding

sub bidding
    {
    @args = split(/,/,$_[0]);
    
    $output = "<table>\n";
    # first two args are players
    $output .= '<tr><td><b>';
    $output .= $args[0];
    $output .= '</b></td><td><b>';
    $output .= $args[1];
    $output .= "</b></td></tr>\n";

    # remaining args are bids
    for ($i=2;$i<$#args+1;$i+=2)
	{
	$output .= '<tr><td>'.&card(@args[$i]).
		   '</td><td>'.&card(@args[$i+1])."</td></tr>\n";
	}
    
    $output .= "</table>\n";
    $output;
    }

sub old_bidding
    {
    @args = split(/,/,$_[0]);
    
    $output = "<table>\n";
    # first two args are players
    $output .= '<tr><td><b>';
    $output .= $args[0];
    $output .= '</b></td><td><b>';
    $output .= $args[1];
    $output .= "</b></td></tr>\n";

    # remaining args are bids
    for ($i=2;$i<$#args+1;$i+=2)
	{
	$output .= '<tr><td>'.@args[$i].
		   '</td><td>'.@args[$i+1]."</td></tr>\n";
	}
    
    $output .= "</table>\n";
    $output;
    }


# four player bidding

sub bid4
    {
    local($td1,$td2,$td3);
    @args = split(/,/,$_[0]);
   
    $output = "<table>\n";
    # first four args are players
    $output .= '<tr><td><b>';
    $output .= $args[0];
    $output .= '</b></td><td><b>';
    $output .= $args[1];
    $output .= '</b></td><td><b>';
    $output .= $args[2];
    $output .= '</b></td><td><b>';
    $output .= $args[3];
    $output .= "</b></td></tr>\n";

    $td1 = "td";
    $td2 = "td";
    $td3 = "td";
    # remaining args are bids
    for ($i=4;$i<$#args+3;$i+=4)
        {
        # handle "All pass" well.
        if ($args[$i  ] =~ /All\s*Pass/i) {$td1 = "td colspan = 4";}
        if ($args[$i+1] =~ /All\s*Pass/i) {$td2 = "td colspan = 3";}
        if ($args[$i+2] =~ /All\s*Pass/i) {$td3 = "td colspan = 2";}
        $output .= "<tr><$td1>". &card($args[$i]).
                   "</td><$td2>".&card($args[$i+1]).
                   "</td><$td3>".&card($args[$i+2]).
                   "</td><td>".&card($args[$i+3]).
                   "</td></tr>\n";
        }

    $output .= "</table>\n";
    $output;
    }

sub old_bid4
    {
    @args = split(/,/,$_[0]);
    
    $output = "<table>\n";
    # first four args are players
    $output .= '<tr><td><b>';
    $output .= $args[0];
    $output .= '</b></td><td><b>';
    $output .= $args[1];
    $output .= '</b></td><td><b>';
    $output .= $args[2];
    $output .= '</b></td><td><b>';
    $output .= $args[3];
    $output .= "</b></td></tr>\n";

    # remaining args are bids
    for ($i=4;$i<$#args+3;$i+=4)
	{
	$output .= '<tr><td>'. @args[$i].
		   '</td><td>'.@args[$i+1].
		   '</td><td>'.@args[$i+2].
		   '</td><td>'.@args[$i+3].
		   "</td></tr>\n";
	}
    
    $output .= "</table>\n";
    $output;
    }

# suit draws a two-player suit combination
sub suit
    {
    @args = split(/,/,$_[0]);

    "<table>\n".
    "<tr><td><i>Dummy</i></td></tr>\n".
    "<tr><td>".$args[0]."</td></tr>\n".
    "<tr><td></td></tr>\n".
    "<tr><td><i>Declarer</i></td></tr>\n".
    "<tr><td>".$args[1]."</td></tr>\n".
    "</table>\n";
    }

# Footnote draws superscripts
sub footnote
    {
    "<sup><font size = 1>".$_[0]."</sup></font>";
    }


# Panelist is strange: all caps, but different size fonts
sub panelist
    {
    $param = $_[0];
    $param =~ tr/a-z/A-Z/;  # upcase
    # upcase anything after a space or carat (and remove the carat)
    @chars = split(//,$param);
    $result = "<dt>";
    $currently = 1;  # big
    for ($i=0;$i<$#chars+1;$i++)
      {
      $big = 0;
      # is it big or little?
      if    ($i == 0)           {$big = 1;}
      elsif ($chars[$i] eq '^') {$i++; $big = 1;}
      elsif ($chars[$i] eq ' ') {$i++; $result .= ' '; $big = 1;}
      if ($currently != $big)
        {
        if ($big) {$result .= "</font>";}
        else      {$result .= "<font size=-2>";}
        }
      $result .= $chars[$i];

      $currently = $big;
      }
    # if it is small, add an end font
    if (!$currently) {$result .= "</font>";}
    $result .= "<dd>";
    $result;
    }

# Start table and do header row 
sub maketable
    {
    $result  = "<table border=0 cellspacing=0 cellpadding=0 bgcolor=black>\n";
    $result .= "<tr><td>\n";
    $result .= "<table border=0 cellspacing=1 cellpadding=1>\n";
    $result .= "<tr bgcolor='#FFCC55'>\n";
    @params = split(/,/,$_[0]);
    for ($i=0;$i<=$#params;$i++) {$result .= "<th>".$params[$i]."</th>"; }
    $result .= "</tr>\n";
    $result;
    }

# add a row to a table
sub tablerow
    {
    $result = "<tr bgcolor=white>";
    @params = split(/,/,$_[0]);
    for ($i=0;$i<=$#params;$i++) 
      {
      if ($params[$i] =~ /^\*/) 
        {$result .= "<td align=left>".substr($params[$i],1)."</td>";}
      elsif ($params[$i] =~ /^\=/) # push right
        {$result .= "<td align=right>".substr($params[$i],1)."</td>";}
      else
        {$result .= "<td align=center>".$params[$i]."</td>";}
      }
    $result .= "</tr>\n";
    $result;
    }

# end table
sub endtable
    {
    $result  = "</table>";
    $result .= "</td></tr></table>";
    $result;
    }

# How many cards in the hand?  It knows about 10 and T and VOID
sub handsize
    {
    $cards=$_[0];
    $cards =~ s/,//g;
    $cards =~ s/ //g;
    $cards =~ s/VOID//g;
    $cards =~ s/10/T/g;
    length($cards);
    }

# header
sub header
  {
  $result = "<html><head><title>".$_[0]."</title></head><body>".
     "<h3>".$_[0]."</h3>";
  $result;
  }

# footer
sub footer
  {
  $result = "<hr>";
  if ($_[0] ne "")
    {$result .= "<A href = \"".$_[0]."\"><i><b>Answers</b></i></a><hr>";}
  $result .= "<ADDRESS> <a href = \"http://www.jeff-goldsmith.org/\">Jeff Goldsmith</a>, ";
  $result .= &okDate;
  $result .= "</ADDRESS></body></html>"; 
  $result;
  }

# reasonable date
sub okDate
  {
  $date = &ctime(time);
  ($weekday,$month,$day,$time,$year) = split(/\s+/,$date);
  $month." ".$day.", ".$year;
  }