#!/usr/bin/perl
########################################################################
#    ddd2HMTL - Read a Dvorak Deck Definition File which looks almost 
#               entirely like a CSS.
#               Output an HTML page that can be printed.
#    Version 1.0   Tue 4-12-2001 
#    May be freely distributed and improved upon.
#    Copyright 2001 by Dion Nicolaas.
#
#    History:
#    1.0    4/12/2001   Dion Nicolaas   Started
########################################################################
use strict;
no strict 'refs';
# the lexical analyser
my $tagre = "[a-zA-Z0-9\Q_\:-.\E]+";
my $varre = "[a-zA-Z0-9_-]+";
my $valuere = "\"[^\"]*\"|[^;}\n]+";
my $wsre = "\\s+";
my $commentstartre = "/\\*";
my $commentendre = "\\*/";
# legal attributes and their default values
my %defaults = (
    "name" => "",            
    "card-background-picture" => "",
    "card-background-colour" => "#ffffff",
    "title-colour" => "#000000",        
    "text-background-picture" => "",
    "text-background-colour" => "#cccccc",
    "text-colour" => "#000000",         
    "bar-background-colour" => "#666666",       
    "bar-background-picture" => "",      
    "bar-text-colour" => "#ffffff",             
    "picture" => "",
    "acknowledgement" => "",     
    "text" => "",
    "parent" => "",              
    "count" => 1,               
);
my $state = 0;          # Holds what we expect to read
my $syntaxerr = 0;      # Number of errors so far
my $symbolerr = 0;      # Number of attribute errors so far
my $incomment = 0;      # Keeps track of in/outside comments
my $tag = "";           # the current tag, e.g. "deck", "action"
my $var = "";           # the current variable, e.g. "text-colour"
my $value = "";         # the current value, e.g. "#ffffff"

my %tags;               # keep track of which tags we read
my %categories;         # keep track of which tags are categories

# the parser
while (<>) { 
    # skip whitespace
    s/^$wsre//;
    # and comments
    if (s/^$commentstartre//) {
        $incomment = 1;
    }
    while ($incomment) {
        if (s/^$commentendre//) {
            $incomment = 0;
        } else {
            s/.//;
        }
        # next line if nothing left
        last if (m/^$/);
        # skip more on this line
        next;
    }
    # anything left?
    if (m/^$/) {
        next;
    }
    # check for valid characters
    if (not m/^($tagre|$varre|$valuere|[{}:;])/) {
        s/^(.)//;
        print STDERR "$ARGV($.): skipping invalid character ``$1''\n";
        $syntaxerr++;
    }
    # read tag
    elsif ($state == 0) {
        if (s/^($tagre)//) {
            $tag = $1;
            $state = 1;
        } else {
            print STDERR "$ARGV($.): tag expected\n";
            $syntaxerr++;
            $state = 1;
        }
    }
    #read {
    elsif ($state == 1) {
        if (s/^{//) {
            $state = 2;
        } else {
            print STDERR "$ARGV($.): ``{'' expected\n";
            $syntaxerr++;
            $state = 2;
        }
    }
    # read var or }
    elsif ($state == 2) {
        if (s/^}//) {
            $state = 0;
        } elsif (s/^($varre)//) {
            $var = $1;
            $state = 3;
        } else {
            print STDERR "$ARGV($.): variable expected\n";
            $syntaxerr++;
            $state = 3;
        }
    }
    # read :
    elsif ($state == 3) {
        if (s/^://) {
            $state = 4;
        } else {
            print STDERR "$ARGV($.): ``:'' expected\n";
            $syntaxerr++;
            $state = 4;
        }
    }
    # read value
    elsif ($state == 4) {
        if (s/^($valuere)//) {
            $value = $1;
            $value =~ s/^"(.*)"$/$1/;
            $state = 5;
        } else {
            print STDERR "$ARGV($.): value expected\n";
            $syntaxerr++;
            $state = 5;
        }
    }
    # read ; or }
    elsif ($state == 5) {
        if (s/^}//) {
            $state = 0;
        } elsif (s/^;//) {
            $state = 2;
        } else {
            print STDERR "$ARGV($.): ``;'' expected\n";
            $syntaxerr++;
            $state = 2;
        }
        # Here we have tag, var, value, go and do something.
        # the "symboltable"
        if (defined($defaults{$var})) {
            # don't store if errors
            if (!$syntaxerr && !$symbolerr) {
                # %deck = { text-color => green } etc.
                $$tag{$var} = $value;
                # %tags = {deck => 1} etc. to keep track of which
                # tags we read.
                $tags{$tag} = 1;
            }
        } else {
            print STDERR "$ARGV($.): unknown attribute: ``$var''\n";
            $symbolerr++;
        }
    # unknown state
    } else {
        die "program in disorder (state = $state)";
    }
    redo;
}
if ($syntaxerr or $symbolerr) {
    my $errors = $syntaxerr + $symbolerr;
    print STDERR "$ARGV: $errors error(s)\n";
    exit(1);
}
# Loop over array to complete records
# In the meantime find which nodes are leaves (noone's parent)
foreach my $tag (keys %tags) {
    my $anc;
    foreach my $att (keys %defaults) {
        my $value = $$tag{$att};
        # find parents' att if our's is empty
        if (!$value) {
            $anc = $tag;
            while (($anc = $$anc{"parent"})) {
                $value = $$anc{$att};
                if ($value) {
                    last;
                }
            }
        }
        if (!$value) {
            #print STDERR "$ARGV: $tag: no value for attribute ``$att'': using default\n";
            #$warning++;
            $$tag{$att} = $defaults{$att};
        }
        else {
            $$tag{$att} = $value;
        }
    }
    # More symboltable: %categories = { $tag => 1 } etc, to tell
    # categories from cards (leaves)
    if ($anc = $$tag{"parent"}) {
        $categories{$anc} = 1;
    }
}

# now that all records are completed, loop over them again to replace
# ^ with parent's field
foreach my $tag (keys %tags) {
    foreach my $att (keys %defaults) {
        $$tag{$att} =~ s/\^/$$tag{"parent"}{$att}/;
    }
}


# Set these to your likings
# Actually the cardface width
my $cardheight = 7.0;
my $cardwidth = 5.5;

# This is exactly three lines
my $topheight = 1.9;

# These follow from the previous
my $bottomheight = $cardheight - $topheight;
my $descwidth = $cardwidth - 0.2;

my $cardbackground;


print <<EOF;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<title>Printable Dvorak deck: ${'deck'}{"name"}</title>
<style>
    table.page {
        page-break-before: always;
    }
    td.page {
        border: 1px solid black;
    }
    table.card {
        background: ${'deck'}{"card-background-colour"};
        background-image: url(\"${'deck'}{"card-background-picture"}\");
    }
    td.cardtop {
        text-align: center;
    }
    td.cardbottom {
        text-align: center;
        vertical-align: bottom;
        height: $bottomheight\Qcm\E;
    }
    td.cardname {
        vertical-align: top;
        width: $cardwidth\Qcm\E;
        height: $topheight\Qcm\E;
        color: ${'deck'}{"title-colour"};
        font-weight: bold;
        text-align: center;
    }
    td.cardpict {
        text-align: center;
    }
    td.carddesc {
        width: $descwidth\Qcm\E;
        border: 1px solid black;
        color: ${'deck'}{"text-colour"};
        background: ${'deck'}{"text-background-colour"};
        background-image: url(\"${'deck'}{"text-background-picture"}\");
    }
    td.cardattr {
        font-size: xx-small;
        text-align: right;
        height: 12;
    }
    .textaction {
        color: #660000;
        font-weight: bold;
    }
    .textthing {
        color: #000066;
        font-weight: bold;
    }
EOF
foreach my $category (keys %categories) {
    print <<EOF;
    td.$category {
        height: 15;
        font-size: x-small;
        background: $$category{"bar-background-colour"};
        background-image: url(\"$$category{"bar-background-picture"}\");
        color: $$category{"bar-text-colour"};
        border: 1px solid $$category{"bar-background-colour"};
        text-align: center;
    }
EOF
}
print <<EOF;
</style>
</head>
<body bgcolor="#ffffff">
<table cellpadding="6" cellspacing="0" class="page" border="0">
<tr>
EOF
my $card = 0;
my %count;      # count all cards
foreach my $tag (keys %tags) {
    if ($categories{$tag}) {
        next;
    }
    for (my $ct = 0; $ct < $$tag{"count"}; $ct++) {
        $card++;
        my $parent = $$tag{"parent"};
        my $cat = $$parent{"name"};
        $count{$parent}++;
        # set very large descriptions in smaller font
        if (length($$tag{"text"}) > 300) {
            $$tag{"text"} = "<font size=\"-1\">" 
                            . $$tag{"text"} 
                            . "</font>";
        } elsif (length($$tag{"text"}) > 450) { 
            $$tag{"text"} = "<font size=\"-2\">" 
                            . $$tag{"text"} 
                            . "</font>";
        }
        # TODO highlight the words "Action" and "Thing" (or any category...)
        my $imagetag = "";
        if ($$tag{"picture"}) {
            $imagetag = "<img src=\"" . $$tag{"picture"} . "\">";
        }
        print <<EOF;

<td class="page">
    <table border="0" class="card" cellpadding="0" cellspacing="6">
        <tr>
            <td class="cardtop">
                <table border="0" cellpadding="0" cellspacing="0">
                    <tr>
                        <td class="cardname">$$tag{"name"}</td>
                    </tr>
                    <tr>
                        <td class="$parent">$cat</td>
                    </tr>
                </table>
            </td>
        </tr>
        <tr>
            <td class="cardbottom">
                <table cellpadding="4" cellspacing="0">
                    <tr>
                        <td class="cardpict">
                            $imagetag
                        </td>
                    </tr>
                    <tr>
                        <td class="carddesc">$$tag{"text"}</td>
                    </tr>
                </table>
            </td>
        </tr>
        <tr>
            <td class="cardattr">$$tag{"acknowledgement"}</td>
        </tr>
    </table>
</td>
EOF
        if (($card % 3) == 0) {
            print <<EOF;
    </tr>
EOF
        }
        if (($card % 9) == 0) {
            print <<EOF;
    </table>
    <table cellpadding="6" cellspacing="0" class="page" border="0">
EOF
        }
        if (($card % 3) == 0) {
            print <<EOF;
    <tr>
EOF
        }
    }
}
print <<EOF;
</tr>
</table>
<hr>
<p>
$card cards<br>
EOF
foreach my $tag (keys %categories) {
    if ($count{$tag}) {
        print $count{$tag};
        print " ";
        print $$tag{"name"};
        print "<br>\n";
    }
}

print <<EOF;
</p>
</body>
</html>
EOF