#!/usr/bin/perl
use CGI;


# RTF uses twips for all measurements.  1 twip = 1/20 of a point

sub twips_from_inches {
	my $inches = shift;
	return int(1440 * $inches);
}

sub twips_from_points {
	my $points = shift;
	return int(20 * $points);
}

# \li#### (left indent), \ri#### (right indent)
# \sb#### (vertical space before), \sa#### (space after)
# 1440 twips = 1 inch

$FORMAT_TITLE = 
	'';
$FORMAT_WRITER = 
	'\\sa' . twips_from_points(12);
$FORMAT_SLUG_LINE =
	'\\sb' . twips_from_points(12) .
	'\\keepn'; # keep with next
$FORMAT_CUT_TO = 
	'\\sb' . twips_from_points(12) .
	'\\qr'; # right align
$FORMAT_CHARACTER_NAME = 
	'\\sb' . twips_from_points(12) . 
	'\\li' . twips_from_inches(3.7 - 1.5) .
	'\\keepn'; # keep with next
$FORMAT_PARENTHETICAL =
	'\\li' . twips_from_inches(3.1 - 1.5) .
	'\\ri' . twips_from_inches(2.9 - 1) .
	'\\keepn'; # keep with next
$FORMAT_DIALOGUE =
	'\\li' . twips_from_inches(2.5 - 1.5) .
	'\\ri' . twips_from_inches(2.5 - 1);
$FORMAT_ACTION = 
	'\\sb' . twips_from_points(12);


sub emit_line {
	my ($format, $text) = @_;
	
	$text =~ s/([{}\\])/\\$1/g;
	print "{\\pard\n", $format, "\n", $text, "\n\\par}\n";
}


sub emit_header {
	my ($title, $writer) = @_;
	
	print 
		# RTF version 1; ANSI charset; default font is 0; font table definition
		'{\rtf1\ansi\deff0',
		'{\fonttbl\f0\fmodern\fcharset0 Courier;}',
		'{\info',
		'{\title ', $title, '}',
		'{\author ', $writer, '}',
		'{\doccomm Typeset by a Perl Script}}',
		# default language is English; widow/orphan control enabled
		'\deflang1033\widowctrl',
		# 1.5" left margin; 1" margins on all other sides
		'\margl2160\margr1440\margt1440\margb1440',
		# wrap to page
		'\viewkind1',
		# enable page numbering
		'\f0\fs24';
	
	emit_line($FORMAT_TITLE, $title);
	emit_line($FORMAT_WRITER, $writer);
}


sub emit_footer {
	print '}';
}


sub next_nonblank_line {
	while (my $line = shift @SOURCE_LINES) {
		next if ($line =~ /^\s*$/); # skip blanks
		next if ($line =~ /^#/); # skip comments
		return $line;
	}
	return undef;
}


sub is_all_caps {
	my $string = shift;
	return $string !~ /[a-z]/;
}


sub emit_rtf {
	my $source_text = shift;
	
	my $title = next_nonblank_line();
	my $writer = next_nonblank_line();
	
	emit_header($title, $writer);
	
	my $dialogue_next = 0;
	
	while (my $line = next_nonblank_line()) {
		if (is_all_caps($line)) {
			if ($line =~ m[^(EXT)|(INT)\.]) {
				emit_line($FORMAT_SLUG_LINE, $line);
			} elsif ($line =~ m[:$]) {
				emit_line($FORMAT_CUT_TO, $line);
			} else {
				emit_line($FORMAT_CHARACTER_NAME, $line);
				$dialogue_next = 1;
			}
		} else {
			if ($line =~ m[^\(.+\)$]) {
				emit_line($FORMAT_PARENTHETICAL, $line);
				$dialogue_next = 1;
			} elsif ($dialogue_next) {
				emit_line($FORMAT_DIALOGUE, $line);
				$dialogue_next = 0;
			} else {
				emit_line($FORMAT_ACTION, $line);
			}
		}
		
	}
	emit_footer();
}


my $q = new CGI;

my $error = $q->cgi_error;
if ($error) {
	print $q->header(-status=>$error),
		  $q->start_html('Problem'),
		  $q->h2('Request not processed'),
		  $q->strong($error),
		  $q->end_html();
	exit 0;
}

print $q->header(-type=>'text/rtf',-attachment=>'script.rtf');
@SOURCE_LINES = split(/(\r|\n)+/, $q->param('source'));
emit_rtf();