#! /usr/pkg/bin/perl

# $Id: htmlgen.cgi,v 1.26 2002/12/11 23:58:49 ksulliva Exp $
#
# My translation of the following license: "Use this wherever and
# however you want, just be sure to give me credit.  And if it breaks
# something, don't blame me."  It's basically the BSD license.
#
# Copyright (C) 2000 Kevin Sullivan.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
#
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. Neither the name of the project nor the names of its contributors
#    may be used to endorse or promote products derived from this software
#    without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE PROJECT AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE PROJECT OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.

# Include all of the modules we'll need
use FileHandle;
use CGI qw/:standard/;
use CGI::Carp;
use Text::Wrap;
use MIME::Base64;
use Digest::SHA1 qw(sha1 sha1_hex sha1_base64);

# Global tables.

# Table for physical/easy skills.  Skill level is -1 or -2 for medium
# and hard skills
$physical_table = {
    0 => -4,
    0.5 => -1,
    1 => 0,
    2 => 1,
    4 => 2,
    8 => 3,
    16 => 4,
    24 => 5,
    32 => 6,
    40 => 7,
};

# Table for mental/easy skills.  Skill level is -1 or -2 for medium
# and hard skills.  Treat very-hard as hard with 1/2 the points.
$mental_table = {
    0 => -4,
    0.5 => -1,
    1 => 0,
    2 => 1,
    4 => 2,
    6 => 3,
    8 => 4,
    10 => 5,
    12 => 6,
    14 => 7,
    16 => 8,
    18 => 9,
    20 => 10,
    22 => 11,
    24 => 12,
    26 => 13,
    28 => 14,
    30 => 15,
    32 => 16,
    34 => 17,
    36 => 18,
    38 => 19,
    40 => 20,
};

# Damage per ST.  This is an array of pointers to arrays.
# $damage_table[ST][0] is thrust, $damage_table[ST][1] is swing.
@damage_table = (
  [ "0" , "0" ],	# ST = 0
  [ "0" , "0" ],	# ST = 1
  [ "0" , "0" ],	# ST = 2
  [ "0" , "0" ],	# ST = 3
  [ "0" , "0" ],	# ST = 4
  [ "1d-5" , "1d-5" ],	# ST = 5
  [ "1d-4" , "1d-4" ],	# ST = 6
  [ "1d-3" , "1d-3" ],	# ST = 7
  [ "1d-3" , "1d-2" ],	# ST = 8
  [ "1d-2" , "1d-1" ],	# ST = 9
  [ "1d-2" , "1d"   ],	# ST = 10
  [ "1d-1" , "1d+1" ],	# ST = 11
  [ "1d-1" , "1d+2" ],	# ST = 12
  [ "1d"   , "2d-1" ],	# ST = 13
  [ "1d"   , "2d"   ],	# ST = 14
  [ "1d+1" , "2d+1" ],	# ST = 15
  [ "1d+1" , "2d+2" ],	# ST = 16
  [ "1d+2" , "3d-1" ],	# ST = 17
  [ "1d+2" , "3d"   ],	# ST = 18
  [ "2d-1" , "3d+1" ],	# ST = 19
  [ "2d-1" , "3d+2" ]	# ST = 20
);

# Here is where the program really begins.

$cgi = new CGI;
@names = $cgi->param;
#$hilite = '#E0E0FF';
# Errlist is a global list of problems.
@errlist = ();

if ($filename = $cgi->param('upfile')) {
    # The file is being provided by the client
    $fh = $cgi->upload('upfile');
} elsif ($filename = $cgi->param('local')) {
    # The file is local to this machine
    $oldfilename = $filename;
    $filename =~ s/[^-\w.]//g;
#    $filename =~ tr/[-A-Za-z0-9_.]//dc;
    $fh = new FileHandle($filename, "r");
}

# Read in the character info
$char = &read_char($filename, $fh);

# Is there an embedded image?
&handle_image($char);

# Calculate all of the info we can
&calcstuff($char);

# Save a copy of the character if "save: yes"
&save_char($char);

# Print out the page
print $cgi->header;
&print_page($char);

exit;

# read_char(filename, filehandle):  Read in a character.
sub read_char {
    my ($filename, $fh) = @_;
    my ($char) = {};
    my ($key, $value, @values);
    my (@template);

    unless (defined $fh) {
	$fh = new FileHandle($filename, "r");
    }

    while (defined($_ = <$fh>)) {
	chomp;
	push(@template, $_);
	s/\s+$//;
	# Skip comment and blank lines
	next if /^#/;
	next if /^$/;
	# Clear out stuff in curly braces
	s/\{.*?\}//g;

	if (/^\@([\w\s]+):\s*(.*)$/) {
	    # form:  @key: data1 / data2 ...
	    ($key, $value) = ($1, $2);
	    $key =~ s/\s+//g;
	    $key = lc($key);
	    $char->{$key} = [] unless $char->{$key};
	    push(@{$char->{$key}}, [ split(m!\s*\/\s*!, $value) ]);
	} elsif (/^\$([\w\s]+):\s*(.*)$/) {
	    # form:  $key:
	    #        data
	    #        data
	    #        $
	    $key = $1;
	    $key =~ s/\s+//g;
	    $key = lc($key);
	    $value = '';
	    while (defined($_ = <$fh>)) {
		chomp;
		push(@template, $_);
		last if $_ =~ /\$\s*$/;
		$value .= "\n" . $_;
	    }
	    $value =~ s/\r?\n\r?\n/<BR><BR>/g;
	    $value =~ s/\s+/ /g;
	    $char->{$key} = $value;
	} elsif (/^([\w\s]+):\s*(.*)$/) {
	    # form: key: data1 / data2 ...
	    ($key, $value) = ($1, $2);
	    $key =~ s/\s+//g;
	    $key = lc($key);
	    $char->{$key} = [ split(m!\s*\/\s*!, $value) ];
	}
    }
    # Store the filename and the template data for later use
    $char->{'filename'} = $filename;
    $char->{'template'} = \@template;
    return $char;
}

# print_page(char): Top-level routine for printing the page
sub print_page {
    my ($char) = @_;
    my ($date) = scalar(localtime(time));
    my ($version) = ('$Revision: 1.26 $' =~ /Revision: (.*)\$/);

# header
    print <<"EOT";
<html>
<head>
  <title>$char->{'name'}[0]</title>
  <base target="_top">
  <STYLE>
    <!--
    a {text-decoration : none}
    .b {font-weight: bold}
    .big {font-size: 110%}
    .bbig {font-size: 110%; font-weight: bold}
     BR.breakhere {page-break-before: always}
    -->
  </STYLE>
</head>

<BODY BGCOLOR="white" TEXT="#000000" LINK="#009E00" VLINK="#285CFF" ALINK="#CF0000">
<!-- Generated from $char->{'filename'} '$oldfilename' on $date -->
<!-- Generated by HTMLGen version $version -->
<!-- Template file:
@{ [ &print_char($char)] }
-->

<center>

<table cellpadding="15" cellspacing="0" valign="top" border="0" width="100%">

<td colspan="2" align="center" valign="top">
<FONT size="+2">$char->{'name'}[0]</FONT>
</td>
</tr>


<tr>
<td align="left" valign="top" width=40%>
    @{ [&nametable($char)] }
<BR>
    @{ [&stattable($char)] }
<BR>
    @{ [&movetable($char)] }
<BR>
    @{ [&damagetable($char)] }
<BR>
    @{ [&defensetable($char, 'pd')] }
<BR>
    @{ [&defensetable($char, 'dr')] }
<BR>
    @{ [&advantagetable($char, 'a')] }
<BR>
    @{ [&advantagetable($char, 'd')] }
</td>

<td align="left" valign="top" width=60%>
    @{ [&personaltable($char)] }
<BR>

  <table cellpadding="0" cellspacing="0" valign="top" border="0" width="100%">
    <tr>
      <td align="left" valign="top">
	  @{ [&encumbrancetable($char)] }
<BR>
          @{ [&defensetable($char, 'ad')] }
      </td>
      <td width=30>&nbsp;</td>
      <td>
	  @{ [&trackingtable($char)] }
      </td>
    </tr>
  </table>

<BR>
    @{ [&weapontable($char)] }
<BR>
    @{ [&missiletable($char)] }
<BR>
    @{ [&advantagetable($char, 'q')] }
<BR>
    @{ [&summarytable($char)] }
</td>
</tr>
</TABLE>

<BR class="breakhere" />
<table cellpadding="15" cellspacing="0" valign="top" border="0" width="100%">
  <TR>
    <TD width="48%" valign=top>
	@{ [&tableborder(&possesstable($char))] }
        <BR>
	<P CLASS="bbig">Character's background</P>
        @{ [wrap('', '', $char->{'background'} . " ")] }</P>
	<P CLASS="bbig">Character's appearance</P>
        @{ [wrap('', '', $char->{'appearance'} . " ")] }</P>
    </TD>
    <TD width="4%">&nbsp;</TD>
    <TD width="48%" valign=top>
	@{ [&tableborder(&skilltable($char))] }
    </TD>
  </TR>
</TABLE>

<BR class="breakhere" />

<table cellpadding="15" cellspacing="0" valign="top" border="0" width="100%">
  <TR>
    <TD width="100%" valign=top>
      @{ [&spelltable($char)] }
    </TD>
  </TR>
</TABLE>

<!-- @errlist -->

EOT
}

# nametable: Print the player's name, the race, and the profession
sub nametable {
    my ($char) = @_;

    return table({-border=>0,-width=>"100%",-cellspacing=>0,-cellpadding=>0},
		Tr(
		   td({-align=>'left'}, i('Player:')),
		   td({-align=>'right'}, $char->{'player'}[0]),
		   ), "\n",
		Tr(
		   td({-align=>'left'}, i('Race:')),
		   td({-align=>'right'}, $char->{'race'}[0]),
		   ), "\n",
		Tr(
		   td({-align=>'left'}, i('Profession:')),
		   td({-align=>'right'}, $char->{'profession'}[0]),
		   ), "\n",
		 );
}

# stattable: Print the stats and senses
sub stattable {
    my ($char) = @_;

    return table( {-border=>0,-width=>'100%',-cellspacing=>0,-cellpadding=>0},
		 Tr(
		    td({-align=>'left',-class=>'bbig'}, 'ST:'),
		    td({-align=>'right',-class=>'big'}, $char->{'st'}[0]),
		    td({-align=>'left',-width=>'30%'}, '&nbsp;'),
		    td({-align=>'left'}, i('Vision:')),
		    td({-align=>'right'}, $char->{'vision'}[0])
		    ), "\n",
		 Tr(
		    td({-align=>'left',-class=>'bbig'}, 'DX:'),
		    td({-align=>'right',-class=>'big'}, $char->{'dx'}[0]),
		    td({-align=>'left'}, '&nbsp;'),
		    td({-align=>'left'}, i('Hearing:')),
		    td({-align=>'right'}, $char->{'hearing'}[0])
		    ), "\n",
		 Tr(
		    td({-align=>'left',-class=>'bbig'}, 'IQ:'),
		    td({-align=>'right',-class=>'big'}, $char->{'iq'}[0]),
		    td({-align=>'left'}, '&nbsp;'),
		    td({-align=>'left'}, i('Smell:')),
		    td({-align=>'right'}, $char->{'smell'}[0])
		    ), "\n",
		 Tr(
		    td({-align=>'left',-class=>'bbig'}, 'HT'),
		    td({-align=>'right',-class=>'big'}, $char->{'ht'}[0]),
		    td({-align=>'left'}, '&nbsp;'),
		    td({-align=>'left'}, i('Will:')),
		    td({-align=>'right'}, $char->{'will'}[0])
		    ), "\n"
		  );
}

# movetable: print speed and move
sub movetable {
    my ($char) = @_;

    return table({-border=>0,-width=>"100%",-cellspacing=>0,-cellpadding=>0},
		 Tr(
		    td(i('Basic Speed')),
		    td({-align=>"right"}, $char->{'basicspeed'}[0])
		    ), "\n",
		 Tr(
		    td(i('Move')),
		    td({-align=>"right"}, $char->{'move'}[0])
		    ), "\n"
		 );
}

# damagetable: print basic damage
sub damagetable {
    my ($char) = @_;

    return table({-border=>0,-width=>'100%',-cellspacing=>0,-cellpadding=>0},
		 Tr(
		    td(i('Thrust damage:')),
		    td({-align=>'right'}, $char->{'thrust'}[0])
		    ), "\n",
		 Tr(
		    td(i('Swing damage:')),
		    td({-align=>'right'}, $char->{'swing'}[0])
		    ), "\n"
		 );
};

# defensetable: print AD, PD, or DR.  This should probably be 3
# different routines.  I'm not sure why I did it this way initially.
sub defensetable {
    my($char, $type) = @_;
    if ($type eq 'pd') {
	return table ({-width => '100%',-cellspacing=>0,-cellpadding=>0},
		      '<FONT SIZE="+1">',
		      Tr(
			 td({-align=>'left',-colspan=>2,-class=>'bbig'}, 'Passive defense:'),
			 td({-align=>"right",-class=>'big'}, $char->{'pd'}[0]),
			 ), '</FONT>', "\n",
		      Tr(
			 td({-align=>'left'}, i('Armor:')),
			 td({-align=>'left'}, $char->{'armorpd'}[1]),
			 td({-align=>"right"}, $char->{'armorpd'}[0]),
			 ), "\n",
		      Tr(
			 td({-align=>'left'}, i('Shield:')),
			 td({-align=>'left'}, $char->{'shieldpd'}[1]),
			 td({-align=>"right"}, $char->{'shieldpd'}[0]),
			 ), "\n",
		      Tr(
			 td({-align=>'left'}, i('Other:')),
			 td({-align=>'left'}, $char->{'otherpd'}[1]),
			 td({-align=>"right"}, $char->{'otherpd'}[0]),
			 ), "\n"
		      );
    }
    if ($type eq 'dr') {
	return table ({-border=>0,-width => '100%',-cellspacing=>0,-cellpadding=>0},
		      Tr(
			 td({-align=>'left',-colspan=>2,-class=>'bbig'}, 'Damage resistance:'),
			 td({-align=>"right",-class=>'big'}, $char->{'dr'}[0]),
			 ), "\n",
		      Tr(
			 td({-align=>'left'}, i('Armor:')),
			 td({-align=>'left'}, $char->{'armordr'}[1]),
			 td({-align=>"right"}, $char->{'armordr'}[0]),
			 ), "\n",
		      Tr(
			 td({-align=>'left'}, i('Other:')),
			 td({-align=>'left'}, $char->{'otherdr'}[1]),
			 td({-align=>"right"}, $char->{'otherdr'}[0]),
			 ), "\n"
		      );
    }
    if ($type eq 'ad') {
	return table ({-border=>0,-width => '100%',-cellspacing=>0,-cellpadding=>0},
		      Tr(
			 td({-align=>'left',-class=>'bbig'}, 'Active defense'),
			 td({-align=>'right'}, '&nbsp;'),
			 td({-align=>'right'}, b('+PD'))
			 ), "\n",
		      Tr(
			 td({-align=>'left'}, i('Dodge:')),
			 td({-align=>'right'}, $char->{'dodge'}[0]),
			 td({-align=>"right"}, $char->{'dodge'}[1])
			 ), "\n",
		      Tr(
			 td({-align=>'left'}, i('Parry:')),
			 td({-align=>'right'}, $char->{'parry'}[0]),
			 td({-align=>"right"}, $char->{'parry'}[1])
			 ), "\n",
		      Tr(
			 td({-align=>'left'}, i('Block:')),
			 td({-align=>'right'}, $char->{'block'}[0]),
			 td({-align=>"right"}, $char->{'block'}[1])
			 ), "\n"
		      );
    }
};

# advantagetable: Print advantages, disadvantages, or quirks.  The
# same routine handles all of them, since they are printed pretty much
# identically.
sub advantagetable {
    my ($char, $type) = @_;
    my ($header);

    $header = ($type eq 'a') ? 'Advantages' :
	(($type eq 'd') ? 'Disadvantages' : 'Quirks');

    return table({-border=>0,-width=>'100%',-cellspacing=>0,-cellpadding=>0},
		 Tr(
		    td({-align=>"left",-colspan=>2,-class=>'bbig'}, $header),
		    ), "\n",
		 map { Tr(
			  td({-align=>"left"}, $_->[0] || "&nbsp;"),
			  td({-align=>"right"}, $_->[1])
			  ), "\n"
		       } @{$char->{$type}}
		 );
};

# personaltable: Print personal information
sub personaltable {
    my ($char) = @_;

    return table({-border=>0,-width=>'100%',-cellspacing=>0,-cellpadding=>0},
		 Tr(
		    td({-align=>'left'}, i('Age:')),
		    td({-align=>'right'}, $char->{'age'}[0]),
		    td('&nbsp; &nbsp; &nbsp; &nbsp;'),
		    td({-align=>'left'}, i('Total points:')),
		    td({-align=>'right'}, $char->{'totalpoints'}[0])
		    ), "\n",
		 Tr(
		    td({-align=>'left'}, i('Height:')),
		    td({-align=>'right'}, $char->{'height'}[0]),
		    td('&nbsp; &nbsp; &nbsp; &nbsp;'),
		    td({-align=>'left'}, i('Unspent points:')),
		    td({-align=>'right'}, $char->{'unspentpoints'}[0])
		    ), "\n",
		 Tr(
		    td({-align=>'left'}, i('Weight:')),
		    td({-align=>'right'}, $char->{'weight'}[0]),
		    td('&nbsp; &nbsp; &nbsp; &nbsp;'),
		    td({-align=>'left'}, i('Money:')),
		    td({-align=>'right'}, $char->{'money'}[0])
		    ), "\n"
		 );
};

# encumbrancetable: Calculate and print encumbrance
sub encumbrancetable {
    my ($char) = @_;
    my ($st) = $char->{'st'}[0];

    # XXX This should really be calculated in calcstuff(), so that
    # unusual cases can be handled.  In the config file, I'd imagine
    # "encumbrance: *2 / *4 / *6 / *12 / *20" as the default.
    return table({-border=>0,-width=>'100%',-cellspacing=>0,-cellpadding=>0},
		 Tr(
		    td({-align=>'left',-colspan=>2,-class=>'bbig'}, 'Encumbrance')
		    ), "\n",
		 Tr(
		    td({-align=>'left'}, i("None (0)")),
		    td({-align=>'right'}, $st * 2)
		    ), "\n",
		 Tr(
		    td({-align=>'left'}, i("Light (-1)")),
		    td({-align=>'right'}, $st * 4)
		    ), "\n",
		 Tr(
		    td({-align=>'left'}, i("Medium (-2)")),
		    td({-align=>'right'}, $st * 6)
		    ), "\n",
		 Tr(
		    td({-align=>'left'}, i("Heavy (-3)")),
		    td({-align=>'right'}, $st * 12)
		    ), "\n",
		 Tr(
		    td({-align=>'left'}, i("X-Heavy (-4)")),
		    td({-align=>'right'}, $st * 20)
		    ), "\n"
		 );
};

# weapontable: Print damage and skill for all weapons (including missiles)
sub weapontable {
    my ($char) = @_;

    return table({-border=>0,-width=>'100%',-cellspacing=>0,-cellpadding=>0},
		 Tr(
		    td({-align=>'left',-class=>'bbig'}, 'Weapons'),
		    td({-align=>'center',-class=>'b'}, 'type'),
		    td({-align=>'center',-class=>'b'}, 'damage'),
		    td({-align=>'right',-class=>'b'}, 'skill'),
		    ), "\n",
		 map { Tr(
			  td({-align=>'left'}, $_->[0]),
			  td({-align=>'center'}, $_->[1]),
			  td({-align=>'center'}, $_->[2]),
			  td({-align=>'right'}, $_->[3])
			  )
		       } (@{$char->{'w'}}, @{$char->{'m'}})
		 );

};

# missiletable: print missile weapon stats
sub missiletable {
    my ($char) = @_;

    return table({-border=>0,-width=>'100%',-cellspacing=>0,-cellpadding=>0},
		 Tr(
		    td({-align=>'left',-class=>'bbig'}, 'Ranged weapons'),
		    td({-align=>'center',-class=>'b'}, 'SS'),
		    td({-align=>'center',-class=>'b'}, 'Acc'),
		    td({-align=>'right',-class=>'b'}, 'half'),
		    td({-align=>'right',-class=>'b'}, 'max')
		    ), "\n",
		 map { Tr(
			  td({-align=>'left'}, $_->[0]),
			  td({-align=>'center'}, $_->[4]),
			  td({-align=>'center'}, $_->[5]),
			  td({-align=>'right'}, $_->[6]),
			  td({-align=>'right'}, $_->[7])
			  ), "\n"
		       } @{$char->{'m'}}
		 );
};

# summarytable: print point summary
sub summarytable {
    my ($char) = @_;

    return table({-border=>0,-width=>'100%',-cellspacing=>0,-cellpadding=>0},
		 Tr(
		    td({-align=>'left',-colspan=>2}, b('Point summary'))
		    ), "\n",
		 Tr(
		    td({-align=>'left'}, i('Attributes')),
		    td({-align=>'right'}, $char->{'pointsattributes'}[0])
		    ), "\n",
		 Tr(
		    td({-align=>'left'}, i('Advantages')),
		    td({-align=>'right'}, $char->{'pointsadvantages'}[0])
		    ), "\n",
		 Tr(
		    td({-align=>'left'}, i('Disadvantages')),
		    td({-align=>'right'}, $char->{'pointsdisadvantages'}[0])
		    ), "\n",
		 Tr(
		    td({-align=>'left'}, i('Quirks')),
		    td({-align=>'right'}, $char->{'pointsquirks'}[0])
		    ), "\n",
		 Tr(
		    td({-align=>'left'}, i('Skills')),
		    td({-align=>'right'}, $char->{'pointsskills'}[0])
		    ), "\n",
		 Tr(
		    td({-align=>'left'}, i('Spells')),
		    td({-align=>'right'}, $char->{'pointsspells'}[0])
		    ), "\n"
		 );
};

# trackingtable: If an image is supplied, print it.  Otherwise, print
# a table to keep track of HP and mana.
sub trackingtable {
    my ($char) = @_;

    if ($char->{'pictureurl'}[0]) {
	return "<img align=\"center\" src=\"$char->{pictureurl}[0]\">";
    }

    return table({-border=>1,-width=>'100%',-cellspacing=>0,-cellpadding=>0,-valign=>'top'},
		 Tr(
		    td({-width=>'50%',-align=>'center'}, b('HP')),
		    td({-width=>'50%',-align=>'center'}, b('Mana'))
		    ), "\n",
		 Tr(
		    td({-height=>200}, '&nbsp;'),
		    td({-height=>200}, '&nbsp;')
		    ), "\n"
		 );
}

# skilltable: print skills
sub skilltable {
    my ($char, $type) = @_;
    my ($header);

    return table({-border=>0,-width=>'100%',-cellspacing=>0,-cellpadding=>0},
		 "\n",
		 "<THEAD>",
		       Tr(
			  td({-align=>"left",-class=>'b'}, 'pts'),
			  td({-align=>"left",-class=>'bbig'}, 'Skill'),
			  td({-align=>"center",-class=>'b'}, 'type'),
			  td({-align=>"right",-class=>'b'}, 'level')
			  ), "\n",
		 "</THEAD>",
		 "<TBODY>",
		 map { Tr(
			  td({-align=>"left"}, &pointxlate($_->[3])),
			  td({-align=>"left"}, $_->[0] || "&nbsp;"),
			  td({-align=>"center"}, $_->[1]),
			  td({-align=>"right"}, $_->[2])
			  ), "\n"
		       } @{$char->{'s'}},
		 "</TBODY>"
		 );


};

# spelltable: print spell list
sub spelltable {
    my ($char, $type) = @_;
    my ($header);

    return '' unless @{$char->{'z'}};
    return table({-border=>0,-width=>'100%',-cellspacing=>0,-cellpadding=>0},
		 "\n",
		 Tr({-valign=>"bottom"},
		    td({-align=>"left",-class=>'b'}, 'pts'),
		    td({-align=>"left",-class=>'bbig'}, 'Spell'),
		    td({-align=>"center",-class=>'b'}, 'college'),
		    td({-align=>"center",-class=>'b'}, 'time'),
		    td({-align=>"center",-class=>'b'}, 'cost'),
		    td({-align=>"center",-class=>'b'}, 'dur'),
		    td({-align=>"right",-class=>'b'}, 'level')
		    ), "\n",
		 map { Tr(
			  td({-align=>"left"}, &pointxlate($_->[3])),
			  td({-align=>"left"}, $_->[0] || "&nbsp;"),
			  td({-align=>"center"}, $_->[1]),
			  td({-align=>"center"}, $_->[4]),
			  td({-align=>"center"}, $_->[5]),
			  td({-align=>"center"}, $_->[6]),
			  td({-align=>"right"}, $_->[2])
			  ), "\n"
		       } @{$char->{'z'}}
		 );

};

# possesstable: print posessions
sub possesstable {
    my ($char, $type) = @_;
    my ($header);

    $header = ($type eq 'a') ? 'Advantages' :
	(($type eq 'd') ? 'Disadvantages' : 'Quirks');

    return table({-border=>0,-width=>'100%',-cellspacing=>0,-cellpadding=>0},
		 Tr(
		    td({-align=>"left",-class=>'bbig'}, 'Possessions'),
		    td({-align=>"right",-class=>'b'}, 'cost'),
		    td({-align=>"right",-class=>'b'}, 'weight')
		    ), "\n",
		 map { Tr(
			  td({-align=>"left"}, $_->[0] || "&nbsp;"),
			  td({-align=>"right"}, $_->[2]),
			  td({-align=>"right"}, $_->[1])
			  ), "\n"
		       } @{$char->{'p'}}
		 );
};

# tableborder: test routine to print borders around some tables.
# Currently it's pretty much a no-op.
sub tableborder {
    return table({-border=>0,-width=>'100%',-cellspacing=>0,-cellpadding=>0},
		 Tr(
		    td(@_)
		    )
		 );
}

# pointxlate: translate .5 and 1/2 into an HTML 1/2.  Hey, it looks nicer.
sub pointxlate {
    my ($pts) = @_;

    # Translate "0.5"
    $pts =~ s/^0\.5/&frac12;/;
    # Translate "1.5" and ".5".  Do "10.5" correctly!
    $pts =~ s/\.5/&frac12;/;
    # Translate "1/2" and "1 1/2"
    $pts =~ s/\s*1\/2/&frac12;/;
    return $pts;
}

# calcstuff: Calculate lotsa stuff.
sub calcstuff {
    my ($char) = @_;
    my ($sum, $totalsum, $ptr) = (0, 0, 0);
    my ($runningskill, $magery);

    # Total the points used for advantages, disadvantages, and quirks.

    # Advantages
    foreach $ptr (@{$char->{'a'}}) {
	$char->{'pointsadvantages'}[0] += $ptr->[1];
	# pull out magery
	if ($ptr->[0] =~ /magery/i) {
	    if ($ptr->[0] =~ /(\d+)/) {
		$magery = $1 + 0;
	    } elsif ($ptr->[0] =~ /([ivx]+)/i) {
		$magery = &roman2num($1);
	    }
	}	
    }

    # Disadvantages
    foreach $ptr (@{$char->{'d'}}) {
	$char->{'pointsdisadvantages'}[0] += $ptr->[1];
    }

    # Quirks
    foreach $ptr (@{$char->{'q'}}) {
	$ptr->[1] = -1 if $ptr->[1] eq "";
	$char->{'pointsquirks'}[0] += $ptr->[1];
    }

    # Total the points used for skills.  Also, calculate skill levels
    # where possible.

    # Skills
    foreach $ptr (@{$char->{'s'}}) {
	next unless $ptr->[0];
	$char->{'pointsskills'}[0] += $ptr->[3];
	$ptr->[2] = &calcskill($char, $ptr->[1], $ptr->[3], 0)
	    unless $ptr->[2];
	# Pull out running skill for later use
	$running = $ptr->[2] if $ptr->[0] =~ /^running/i;
    }

    # Spell point totals and levels

    # Spells
    foreach $ptr (@{$char->{'z'}}) {
	next unless $ptr->[0];
	$char->{'pointsspells'}[0] += $ptr->[3];
	$ptr->[2] = &calcskill($char,
			       ($ptr->[0] =~ /(vh|path of)/i ? 'MV' : 'MH'),
			       $ptr->[3], $magery)
	    unless $ptr->[2];
    }

    # Keep a subtotal and a total for possessions.

    # Possessions
    my ($subweight, $totalweight);
    foreach $ptr (@{$char->{'p'}}) {
	if ($ptr->[0] =~ /^subtotal/i) {
	    $ptr->[1] = $subweight;
	    $subweight = 0;
	} elsif ($ptr->[0] =~ /^total/i) {
	    $ptr->[1] = $totalweight;
	} else {
	    $subweight += $ptr->[1];
	    $totalweight += $ptr->[1];
	}
    }

    # Calculate speed and movement.

    # Speed = (DX + HT) / 4
    if ($char->{'basicspeed'}[0] eq '') {
	$char->{'basicspeed'}[0] = ($char->{'dx'}[0] + $char->{'ht'}[0]) / 4;
    }

    # Move = Speed + Running/8 - Encumberance, all rounded down to an
    # integer
    if ($char->{'move'}[0] !~ /^\d/) {
	$char->{'move'}[0] = int($char->{'move'}[0] + $char->{'basicspeed'}[0] + $running/8);
    }

    # Calculate senses
    # XXX We should deal with advantages like Alertness and Acute Senses.
    if ($char->{'vision'}[0] !~ /^\d+/) {
	$char->{'vision'}[0] = int(($char->{'iq'}[0] + $char->{'ht'}[0])/2)
	    + $char->{'vision'}[0];
    }
    if ($char->{'hearing'}[0] !~ /^\d+/) {
	$char->{'hearing'}[0] = int(($char->{'iq'}[0] + $char->{'ht'}[0])/2)
	    + $char->{'hearing'}[0];
    }
    if ($char->{'smell'}[0] !~ /^\d+/) {
	$char->{'smell'}[0] = int(($char->{'iq'}[0] + $char->{'ht'}[0])/2)
	    + $char->{'smell'}[0];
    }

    # Calculate will
    if ($char->{'will'}[0] !~ /^\d+/) {
	$char->{'will'}[0] = 11 + $char->{'will'}[0];
    }


    # damage
    if ($char->{'thrust'}[0] eq '') {
	$char->{'thrust'}[0] = $damage_table[$char->{'st'}[0]][0];
	$char->{'swing'}[0] = $damage_table[$char->{'st'}[0]][1];
    }

    # DR and PD totals
    if ($char->{'pd'}[0] eq '') {
	$char->{'pd'}[0] = $char->{'armorpd'}[0] + $char->{'shieldpd'}[0]
	    + $char->{'otherpd'}[0];
    }
    if ($char->{'dr'}[0] eq '') {
	$char->{'dr'}[0] = $char->{'armordr'}[0] + $char->{'otherdr'}[0];
    }

    # Dodge, parry, block
    if ($char->{'dodge'}[0] !~ /^\d/) {
	$char->{'dodge'}[0] = $char->{'move'}[0] + $char->{'dodge'}[0];
    }
    if ($char->{'dodge'}[1] eq '') {
	$char->{'dodge'}[1] = $char->{'dodge'}[0] + $char->{'pd'}[0];
    }
    if ($char->{'parry'}[0] !~ /^\d/) {
	$char->{'parry'}[0] = int($char->{'w'}[0][3] / 2) + $char->{'parry'}[0];
    }
    if ($char->{'parry'}[1] eq '') {
	$char->{'parry'}[1] = $char->{'parry'}[0] + $char->{'pd'}[0];
    }
    if ($char->{'block'}[0] !~ /^\d/) {
	$char->{'block'}[0] = int(($char->{'dx'}[0] - 4) / 2) + $char->{'block'}[0];
    }
    if ($char->{'block'}[1] eq '') {
	$char->{'block'}[1] = $char->{'block'}[0] + $char->{'pd'}[0];
    }

    # Stats
    $char->{'pointsattributes'}[0] = $char->{'st'}[1] + $char->{'dx'}[1]
				   + $char->{'iq'}[1] + $char->{'ht'}[1];

    # Total point value of the character
    $char->{'totalpoints'}[0] = $char->{'pointsadvantages'}[0] +
				$char->{'pointsdisadvantages'}[0] +
				$char->{'pointsquirks'}[0] +
				$char->{'pointsskills'}[0] +
				$char->{'pointsspells'}[0] +
				$char->{'pointsattributes'}[0] +
				$char->{'unspentpoints'}[0];
}

# calcskill (char, type, points, mod): Calculate the level for a skill.
sub calcskill {
    my ($char, $type, $points, $mod) = @_;
    my ($table, $base, $delta, $skilltype, $skilldiff);

    # XXX This routine does not handle any odd skills.  It's actually
    # quite limited.

    # XXX This will probably fail if you use "1/2" point.  Use ".5"
    # instead.  This should be fixed.

    # Figure out the table to use (mental/physical) and the stat (IQ/DX)
    ($skilltype, $skilldiff) = (lc($type) =~ /^(\w)(\w)/);
    if ($skilltype eq 'm') {
	$table = $mental_table;
	$base = $char->{'iq'}[0];
    } elsif ($skilltype eq 'p') {
	$table = $physical_table;
	$base = $char->{'dx'}[0];
    } else {
	return 0;
    }

    # very-hard skills are like hard skills with 1/2 the points.
    if ($skilldiff eq 'v') {
	$points /= 2;
	$skilldiff = 'h';
    }

    # Find the points in the table, determine the level.  We do it
    # this way since it is valid to have an odd number of points in a
    # skill.  For example, you could have 3.5 points in a skill; you
    # would be treated as if you had 2 points until you gained another
    # half point, which would put you at the 4 point level.
    foreach $_ (sort {$a <=> $b} (keys %$table)) {
	if ($_ <= $points) {
	    $delta = $table->{$_};
	} else {
	    last;
	}
    }

    # Modify for easy, medium, and hard.  very-hard was handled already.
    if ($skilldiff eq 'e') {
	$delta -= 0;
    } elsif ($skilldiff eq 'a') {
	$delta -= 1;
    } elsif ($skilldiff eq 'h') {
	$delta -= 2;
    } else {
	return 0;
    }

    return $base + $delta + $mod;
}

# handle_image: If an image is embedded in the file, save it and
# generate a URL.
sub handle_image {
    my ($char) = @_;
    my ($data, $hash, $filename, $fh);

    push(@errlist, "Testing for a picture\n");
    if ($char->{'picturedata'} ne '') {
	# Don't handle huge pictures (larger than 100K encoded, ~75K decoded)
	if (length($data) > 100*1024) {
	    push(@errlist, "Picture is too large (".length($data)." bytes)");
	    return;
	}
	$data = decode_base64($char->{'picturedata'});
	$hash = sha1_hex($data);
	if (substr($data, 0, 2) eq "\377\330") {
	    $filename = "$hash.jpg";
	} elsif (substr($data, 0, 4) eq "GIF8") {
	    $filename = "$hash.gif";
	} elsif (substr($data, 0, 4) eq "\211PNG") {
	    $filename = "$hash.png";
	} else {
	    $filename = $hash;
	}

	if (! -f "tmpimage/$filename") {
	    $fh = new FileHandle("tmpimage/$filename", 'w') || return;
	    print $fh $data;
	    close($fh);
	}
	$char->{'pictureurl'}[0] = "tmpimage/$filename";
    } else {
	push(@errlist, "No picturedata");
    }
}

sub save_char {
    my ($char) = @_;
    my ($hash) = sha1_hex(&print_char($char));
    my ($filename);
    my ($fh);

    return unless ($char->{'save'}[0] =~ /^y/i);

    # generate the filename
    ($filename = $char->{'name'}[0] . "-") =~ s/[^-a-zA-Z0-9]//g;
    $filename .= "$hash.txt";

    if ( ! -f "saved/$filename") {
	$fh = new FileHandle("saved/$filename", 'w') || return;
	print $fh &print_char($char);
	close($fh);
    }
}

sub roman2num {
    my ($roman) = @_;
    my ($result) = 0;
    
    $result += 10 while $roman =~ s/^x//i;
    $result += 9 if $roman =~ s/^ix//i;
    $result += 5 while $roman =~ s/^v//i;
    $result += 4 if $roman =~ s/^iv//i;
    $result += 1 while $roman =~ s/^i//i;

    return $result;
}

# Regenerate the template file, with newly filled-in fields
sub print_char {
    my ($char) = @_;
    my ($line);
    my ($array, $key, $goodkey, $rest, @values);
    my ($valuep, $out);

    # Only do this once and cache the results
    return $char->{'out'} if exists $char->{'out'};

    foreach $line (@{$char->{'template'}}) {
	# Pass most lines through unchanged
	unless ($line =~ /^(\@?)([\w ]*)\s*:\s*(.*?)\s*$/) {
	    $out .= $line . "\n";
	    next;
	}

	# $array is '@' or ''; $key is the key, $rest is the rest of
	# the line.  $nicekey is $key, lowercased and de-spaced.
	# @values contains the list of values.
	($array, $key, $rest) = ($1, $2, $3);
	($nicekey = lc($key)) =~ s/\s+//g;
	@values = split(/\s*\/\s*/, $rest);

	# Just print empty arrays (generally used as spacers)
	if (($array eq '@') && ($rest eq '')) {
	    $out .= $line . "\n";
	    next;
	}

	# Zero out $valuep (pointer to an array of values)
	$valuep = undef;

	# Set $valuep if possible
	if ($array eq '@') {
	    foreach $_ (@{$char->{$nicekey}}) {
		next unless $_->[0] eq $values[0];
		$valuep = $_;
	    }
	} else {
	    $valuep = $char->{$nicekey};
	}
	# If we couldn't set $valuep; just print the line.
	if (!defined $valuep) {
	    $out .= $line . "\n";
	    next;
	}

	# If a value is blank, and we calculated the value, then
	# insert the calculated value surrounded by curly braces.
	foreach ($i=0; $i<@$valuep; $i++) {
	    if (($values[$i] == '') && ($valuep->[$i] != '')) {
		$values[$i] = '{' . $valuep->[$i] . '}';
	    }
	}

	# Print the line
	$out .=  "$array$key: " . join(' / ', @values) . "\n";
    }
    # Cache and return the result
    $char->{'out'} = $out;
}