#!/usr/local/bin/perl -w
#
# Copyright (C) 2000 Free Software Foundation
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# ---------------------
# TODO:
#
# XML::Writer is a pig (oh well)
#
# http://www.script-o-rama.com/table.shtml

use strict;
use Carp;
use XML::Writer;
use XML::Parser;
use Benchmark;
use Emotion;

our $VERSION = '2000.11.11';
our $destdir = '.';

while (@ARGV and $ARGV[0] =~ m/^-/) {
    my $opt = shift @ARGV;
    if ($opt eq '-v') {
	print "$0 v$VERSION

";
    } else {
       warn "ignoring `$opt'";
    }
}

usage() if @ARGV != 1 || !defined $destdir;

sub usage {
    print "usage: prepare_script.pl [-v] <script>\n";
    exit;
}

my $script = $ARGV[0];
my $stem = $script;
$stem =~ s/\.xml$//;

Emotion::set_transcript($script);

my $Time0 = Benchmark->new;
my $outfh;
open $outfh, ">$stem.html";
my $out = XML::Writer->new(OUTPUT => $outfh, NEWLINES => 1);

{
our $SaveCData=0;
our $CData;

sub set_save_text {
    my ($yes) = @_;
    if ($yes == $SaveCData) {
	carp "set_save_text already = $yes";
	return;
    }
    $SaveCData = $yes;
    $CData = '' if $yes;
    $CData;
}

sub text {
    my ($expat, $str) = @_;
    if ($SaveCData) {
	$CData .= $str;
    } else {
	$out->characters($str);
    }
}
}

my $cregex = do {
    my @CTags = qw(destroys steals uneasy exposes impasse admires
		   observes accepts ready);
    my $tmp = '^('.join('|', @CTags).')$';
    qr/$tmp/;
};

our @Situation;
our @Stack;  # this is silly; just incr/decr $level XXX

sub output_situations {
    while (@Situation) {
	my ($o) = shift @Situation;
	$out->characters("$o->{phrase_id}. ");

	if (exists $o->{context} or exists $o->{answer}) {
	    $out->characters('(');
	    my $space;
	    for my $ref (qw(context answer)) {
		next if !exists $o->{$ref};
		my $l = $o->{$ref};
		$out->characters(' ')
		    if $space;
		$out->dataElement('A', "$ref=$l->{dialog_id}.$l->{phrase_id}",
				  HREF=>"#l$l->{dialog_id}");
		$space=1;
	    }
	    $out->characters(')');
	}
	
	for my $phase (qw(before after intensity tension)) {
	    next if !exists $o->{$phase};
	    my $i = $o->{$phase};
	    $out->characters(" $phase=$i");
	    last;
	}
	
	$out->characters(' ');
	my $type = $o->{type};
	if ($type eq 'ready') {
	    $out->characters("$o->{left} and $o->{right} are at readiness");
	} elsif ($type eq 'observes') {
	    $out->characters("$o->{left} observes $o->{right}");
	} elsif ($type eq 'uneasy') {
	    $out->characters("$o->{left} is made uneasy by $o->{right}");
	} elsif ($type eq 'destroys') {
	    $out->dataElement('b', $o->{left});
	    $out->characters(" destroys $o->{right}");
	} elsif ($type eq 'impasse') {
	    $out->dataElement('b', $o->{left});
	    $out->characters(" and $o->{right} are at an impasse");
	} else {
	    my $init = $o->{initiative};
	    
	    my $pretty = $type;
	    $pretty = "steals from"
		if $pretty eq 'steals';
	    
	    if ($init eq 'left') {
		$out->dataElement('b', $o->{left});
		$out->characters(" $pretty $o->{right}");
	    } else {
		$out->characters("$o->{left} $pretty ");
		$out->dataElement('b', $o->{right});
	    }
	}
	
	$out->emptyTag('BR')
	    if @Situation;
    }
}

sub start {
    my ($expat, $elem, %attr) = @_;
    if ($elem eq 'title') {
	set_save_text(1);
    } elsif ($elem eq 'script') {
	# ok
    } elsif ($elem eq 'scene') {
	$out->startTag('P');
	$out->startTag('B');
    } elsif ($elem eq 'talk') {
	$out->startTag('TABLE', WIDTH => '100%');
	$out->startTag('TR');
	$out->startTag('TD', VALIGN => 'TOP');
	my $id = Emotion::set_speaker($attr{who});
	$out->startTag('A', NAME => "l$id");
	$out->dataElement('tt', "$id $attr{who}: ");
	$out->endTag('A');
    } elsif ($elem =~ /$cregex/) {
	$attr{type} = $elem;
	push @Situation, Emotion::Atom->new($expat, \%attr);
	my $at = @Situation;
	$out->dataElement('font', " [$at ", color => 'blue');
	push @Stack, $at;
    } else {
	warn "tag `$elem' ignored";
    }
}

sub end {
    my ($expat, $elem) = @_;
    if ($elem eq 'title') {
	my $title = set_save_text(0);
	$out->startTag('HEAD');
	$out->dataElement('TITLE', $title);
	$out->dataElement('LINK', '', REV => 'made',
			  HREF => 'mailto:joshua@why-compete.org');
	$out->dataElement('STYLE',
			  join("\n",
			       "TD { padding : 2; }",
			       # "TABLE { width : 100%; border : 0; }"
			       ),
			  TYPE => 'text/css');
	$out->endTag('HEAD');

	$out->startTag('BODY', bgcolor=>"#FFFFFF", text=>"#000000");
    } elsif ($elem eq 'scene') {
	$out->endTag;
	$out->endTag;
    } elsif ($elem eq 'talk') {
	$out->endTag('TD');
	if (@Situation) {
	    $out->startTag('TD', VALIGN => 'TOP', BGCOLOR => '#ccffcc');
	    output_situations();
	    $out->endTag('TD');
	}
	$out->endTag('TR');
	$out->endTag('TABLE');
    } elsif ($elem =~ /$cregex/) {
	my $at = pop @Stack;
	$out->dataElement('font', " $at] ", color => 'blue');
    }
}

$out->doctype("HTML", "-//W3C//DTD HTML 4.0 Transitional//EN", '');
$out->startTag('HTML');

my $p = XML::Parser->new(ErrorContext => 1);
$p->setHandlers(Char => \&text, Start => \&start, End => \&end);
$p->parsefile($script);

$out->dataElement('HR', '');
$out->dataElement('P', "$0 v$VERSION ".localtime());

$out->endTag('BODY');
$out->endTag('HTML');
$out->end;

my $size = (stat($outfh))[7];
close $outfh;

warn "$size bytes (".timestr(timediff(Benchmark->new, $Time0)).")\n";
