#!/usr/bin/perl
# Filename:	scurvy
# Author:	David Ljung Madison <DaveSource.com>
# From:		http://MarginalHacks.com/Hacks/scurvy/
# See License:	http://MarginalHacks.com/License/
  my $VERSION=  '1.02';
# Description:	Screenplay/screenwriting tool: txt->script formatter
# Also See:	http://screenplay.sourceforge.net/
#
# Make sure you have not set :expandtab in vi/vim!
# Fix with   :noexpandtab
#
use strict;

##################################################
# Setup the variables
##################################################
my $PROGNAME = $0;
$PROGNAME =~ s|.*/||;

my $TABSIZE = 5;

##################################################
# Usage
##################################################
sub fatal {
  foreach my $msg (@_) { print STDERR "[$PROGNAME] ERROR:  $msg\n"; }
  exit(-1);
}

sub usage {
  foreach my $msg (@_) { print STDERR "ERROR:  $msg\n"; }
  print STDERR <<USAGE;

Usage:\t$PROGNAME [-d] [options] <file> [-o <out>]
\tFormats a script
\t-d                 Set debug mode
\t-o <file>          Output file (default is STDOUT)
\t-c                 Count headings
\t-C                 Show \"Continued\" page breaks
\t-i                 Add initial indent
\t-indent <tabs>     Add initial indent [default 2 tabs]
\t-in_indent <tabs>  Input indent (for non-scurvy formats)
\t-n                 Show page/line numbers
\t-I <fmt>           Set input format [default scurvy]
\t-O <fmt>           Set output format [default script]

\tFormats:
\t  scurvy   Our simple input format (described in docs)
\t  text     The default text script output
\t  final    Final Draft format (text-with-layout)
\t  rtf      RTF (input only) format - using Final Draft RTF format

USAGE
  exit -1;
}

sub parse_args {
  my $opt = {};
  $opt->{infmt}='scurvy';
  $opt->{outfmt}='text';

  # Defaults
  $opt->{per_page} = 53;

  my @formats = qw(scurvy text final rtf);

  while (my $arg=shift(@ARGV)) {
    if ($arg =~ /^-h$/) { usage(); }
    if ($arg =~ /^-d$/) { $MAIN::DEBUG=1; next; }
    if ($arg =~ /^-o$/) { $opt->{out}=shift @ARGV; next; }
    if ($arg =~ /^-c$/) { $opt->{count_head}=1; next; }
    if ($arg =~ /^-C$/) { $opt->{page_breaks}=1; next; }
    if ($arg =~ /^-i$/) { $opt->{indent}=2; next; }
    if ($arg =~ /^-indent$/) { $opt->{indent}=shift @ARGV; next; }
    if ($arg =~ /^-in_indent$/) { $opt->{in_indent}=shift @ARGV; next; }
    if ($arg =~ /^-I$/) { $opt->{infmt}=shift @ARGV; next; }
    if ($arg =~ /^-O$/) { $opt->{outfmt}=shift @ARGV; next; }
    if ($arg =~ /^-n$/) { $opt->{num}=1; next; }
    if ($arg =~ /^-/) { usage("Unknown option: $arg"); }
    usage("Too many files specified [$arg and $opt->{in}]") if $opt->{in};
    $opt->{in}=$arg;
  }
  usage("No file defined") unless $opt->{in};

  usage("Unknown input format: $opt->{infmt}")
    unless grep($opt->{infmt} eq $_, @formats);
  usage("Unknown output format: $opt->{outfmt}")
    unless grep($opt->{outfmt} eq $_, @formats);
  usage("Can't output rtf format: $opt->{outfmt}") if $opt->{outfmt} eq 'rtf';

  $opt;
}

sub debug {
  return unless $MAIN::DEBUG;
  foreach my $msg (@_) { print STDERR "[$PROGNAME] $msg\n"; }
}

##################################################
# Main code
##################################################
my $HEADING	= 0;
my $ACTION	= 2;
my $DIALOGUE	= 3;	# array of [who,parenthetical,dialogue]
my $TRANSITION	= 4;
my $GENERAL	= 5;

sub add {
  my ($script,$type,@what) = @_;
  push(@$script, [$type, @what]);
}

sub read_scurvy {
  my ($opt) = @_;

  # Read in a scurvy format file
  my $script = [];
  my %alias;
  while(<IN>) {
    chomp;
    next unless /\S/;
    next if /^#/;	# "post-notes" for comments
    last if /^ZZSTOP$/;	# hook for debugging scripts

    # Handle {aliases}     # ignore:{
    s/{([^}\s]+)}/$alias{$1} || "{$1}"/eg;

    if (/^(\S+):=(\S[^\t]*)(\t.*)?$/) {
      $alias{$1}=$2;
    } elsif (/^(ext|int|i\/e)/i) {
      add($script, $HEADING, uc($_));
    } elsif (/([^\t]+?)(\s*\(.+\))?:\t(?:\((.+)\)\s+)?(\S.+)/) {
      my ($name, $vo, $paren, $txt) = ($1, $2, $3, $4);
      $name = uc($alias{$name} || $name);
      add($script, $DIALOGUE, "$name$vo", $paren, $txt);
    } elsif (/^\t(\S.*)/) {
      add($script, $ACTION, $1);
    } elsif (/^\t\t(\S.*)/) {
      add($script, $TRANSITION, uc($1));
    } else {
      add($script,$GENERAL, $_);
    }
  }
  $script;
}

my $saveline = undef;
sub getline {
  my ($opt) = @_;
  if (defined $saveline) {
    $_ = $saveline;
    undef $saveline;
    return $_;
  }
  $_ = scalar <IN>;
  return $_;
}
sub pushline {
  my ($opt,$line) = @_;
  die("INTERNAL ERROR: Can't pushline twice without calling getline!\n")
    if defined $saveline;
  $saveline = $line;
}

sub cutline {
  my ($opt) = @_;
  s/[\r\n]$//g;	# Chomp, but handles DOS format better
  s/^[ \d]\d /   /g;		# Remove line numbering
  next if /^PAGE \d+:$/;	# Remove page numbering
  next if /^\s+\(CONTINUED\)$/;	# Remove continuation lines
  next if /^CONTINUED( PAGE \d+:)?$/;

  # Figure out how many tabs of indentation we have
  /^(\s*)(.*)/;
  my ($indent,$txt) = (length($1),$2);
  $indent++ if $txt =~ /^\(/;	# Final Draft puts the '(' in the indent
  my $tabs = int($indent/$TABSIZE) - $opt->{in_indent};
  $tabs=0 if $tabs<0;
  ($tabs,$txt);
}

# Keep getting lines as long as they have the right number of tabs
sub continuetabs {
  my ($opt,$from,$to) = @_;
  $to = $to || $from;
  my @ret;
  while(getline($opt)) {
    my $line = $_;
    my ($tabs,$txt) = cutline($opt);
    if ($tabs<$from || $tabs>$to) {
      pushline($opt,$line);
      last;
    }
    $txt =~ s/\s$//;
    push(@ret,$txt);
  }
  join(' ',@ret);
}

sub read_text {
  my ($opt) = @_;
  my $script;

  # Read in a plaintext script
  my $script = [];
  while(getline($opt)) {
    next unless /\S/;
    my ($tabs,$txt) = cutline($opt);

    if ($tabs==0) {
      # Heading, Action or General
      if ($txt =~ /^(ext|int|i\/e)/i) {
        add($script, $HEADING, $txt);
        next;
      }
      # Could either be action or general..
      # go with action since it has a shorter right margin
      # We have no way of telling if the next lines are a general
      # or a continuation of an action..
      add($script, $ACTION, $txt);
    } elsif ($tabs==4) {
      my ($name,$paren,$dialogue) = $txt;
      my $paren = continuetabs($opt,3);
      $paren =~ s/^\(//;  $paren =~ s/\)$//;
      my $dialogue = continuetabs($opt,2);
      add($script, $DIALOGUE, $name, $paren, $dialogue);
    } elsif ($tabs>=8) {
      my $and = continuetabs($opt,8,10);
      $txt .= " $and" if $and;
      $txt =~ s/:$//;
      add($script, $TRANSITION, $txt);
    } else {
      usage("Saw an unexpected spacing [$tabs tabs] in input file.\n\tConsider using -in_indent option");
    }

  }

  $script;
}

sub read_rtf {
  my ($opt) = @_;
  my $script;

  my @styles = qw(GENERAL SCENE_HEADING ACTION CHARACTER_NAME PARENTHETICAL DIALOG TRANSITION SHOT);

  # Read in a Final Draft RTF file
  my $script = [];
  my %style;
  my ($name,$paren);
  while (<IN>) {
    chomp;
    if (/^{\\s(\d+)[^}]+?\s+([^\\][^\}]+);\s*}/) {
      my ($type,$num) = (uc($2),$1);
      $type =~ s/\s+/_/g;
      $style{$num} = $type;
      print STDERR "Unknown style type: $type\n" unless grep($type eq $_, @styles);
    }
    if (/{\\pard.*\\s(\d+)[^}]+?\s+([^\\][^\}]+)\\par\s*}/) {
      my ($style,$stylenum,$txt) = ($style{$1},$1,$2);
      if (!$style) {
        print STDERR "Unknown style: \\s$stylenum\n";
        next;
      }
      # These are some RTF text codes I know.  I doubt script writers
      # even use all of these.  Does anyone know how you put { or } in text?
      $txt =~ s/\\tab/\t/g;
      $txt =~ s/\\emdash/--/g;
      $txt =~ s/\\endash/-/g;
      $txt =~ s/\\e(m|n)space/ /g;
      $txt =~ s/\\\~/ /g;
      $txt =~ s/\\_/-/g;
      $txt =~ s/\\'([0-9a-f]{2})/chr(hex("0x$1"))/eig;
      $txt =~ s/\\(l|r)quote/'/g;
      $txt =~ s/\\(l|r)dblquote/"/g;
      my @txt = split(/\\(?:par|sect|page)\s*/, $txt);
      my $simple;
      $simple = $HEADING if $style eq 'SCENE_HEADING';
      $simple = $ACTION if $style eq 'ACTION';
      $simple = $GENERAL if $style eq 'GENERAL';
      $simple = $TRANSITION if $style eq 'TRANSITION';
# Not sure what to do with this, we don't handle shots.
      $simple = $TRANSITION if $style eq 'SHOT';
      if (defined $simple) {
        map add($script, $simple, $_), @txt;
        next;
      }
      if ($style eq 'CHARACTER_NAME') {
        $name = $txt;
        next;
      }
      if ($style eq 'PARENTHETICAL') {
        $paren = $txt;
        $paren =~ s/^\(//;
        $paren =~ s/\)$//;
        next;
      }
      if ($style eq 'DIALOG') {
        foreach my $t ( @txt ) {
          add($script, $DIALOGUE, $name, $paren, $t);
          undef $paren;
        }
        undef $name;
        next;
      }
      print STDERR "Unused/unknown style? [$style,$stylenum]\n";
    }
  }

  $script;
}

sub read_input {
  my ($opt) = @_;

  open(IN,"<$opt->{in}") || usage("Couldn't read file: $opt->{in}");

  my $script;
  if ($opt->{infmt} eq 'scurvy') {
    $script = read_scurvy($opt);
  } elsif ($opt->{infmt} eq 'text') {
    $script = read_text($opt);
  } elsif ($opt->{infmt} eq 'final') {
    $opt->{in_indent} = 3 if !defined $opt->{in_indent};
    $script = read_text($opt);
  } elsif ($opt->{infmt} eq 'rtf') {
    $script = read_rtf($opt);
  }
  close(IN);
  $script;
}


##################################################
# Output
##################################################
sub fold {
  my ($cols, $txt, $pre, $pre2) = @_;
  $pre2 = $pre2 || $pre;

  my @fold;
  my $at = 0;
  my $line;
  while ($txt && $txt =~ s/^(\S*)(\s*)//) {
    my ($next,$space) = ($1,$2);
    my $l = length($next);
    my $ls = length($space);
    if ($at+$l+$ls < $cols) {
      $line .= $next.$space;
      $at+=$l+$ls;
    } elsif ($at+$l < $cols) {
      push(@fold, $line.$next);
      $line=""; $at=0;
    } elsif ($l > $cols) {
      push(@fold, $line.substr($next,0,$cols-$at));
      while (length($next) > $cols) {
        push(@fold, substr($next,0,$cols, ""));
      }
      $line = $next;
      $at = length($next);
      if ($at+$ls < $cols) {
        $line.=$space;
        $at+=$ls;
      } else {
        push(@fold, $line);
        $line=""; $at=0;
      }
    } elsif ($l+$ls < $cols) {
      push(@fold, $line);
      $line=$next.$space;
      $at=$l+$ls;
    } else {
      push(@fold, $line, $next);
      $line=""; $at=0;
    }
  }
  push(@fold, $line) if $line;
  my $ret = $pre.join("\n$pre2",@fold);
  split("\n", $ret);
}

sub write_scurvy {
  my ($opt,$script) = @_;

  my $t = "\t";

  foreach my $set ( @$script ) {
    my $what = shift @$set;
    if ($what == $DIALOGUE) {
      my ($name,$paren,$txt) = (@$set);
      $txt = "($paren) $txt" if $paren;
      print OUT "\n";
      print OUT "${name}:\t$txt\n";
      next;
    }
    my $tabs=0;
    $tabs=0 if $what == $HEADING;
    $tabs=1 if $what == $ACTION;
    $tabs=0 if $what == $GENERAL;
    $tabs=2 if $what == $TRANSITION;
    print OUT ${t}x$tabs.join('',@$set)."\n";
  }
  print OUT "\n";
}

sub write_text {
  my ($opt,$script) = @_;

  my $head = 1;
  my $tabsize = $TABSIZE;
  my $t = " "x$tabsize;
  # Indent is 2 tabs
  my $indent = $opt->{indent} ? $opt->{indent}*$tabsize : 0;
  $indent -= 3 if $indent && $opt->{num};
  $indent = " "x$indent;

  my $line = 1;
  my $page = 1;
  my @add;

	my $last_paren = undef;

  print OUT "PAGE $page:\n" if $opt->{num};

  foreach my $set ( @$script ) {
    my $what = shift @$set;
    if ($what == $HEADING) {
      my $txt = $set->[0];
      $txt = "$head $txt" if $opt->{count_head};
      $head++;
      @add = ("", fold(61,$txt));
    } elsif ($what == $ACTION) {
      @add = ("", fold(61,$set->[0]));
    } elsif ($what == $GENERAL) {
      @add = fold(78,$set->[0]);
    } elsif ($what == $TRANSITION) {
      @add = ("", fold(16,$set->[0],"$t"x8));
    } elsif ($what == $DIALOGUE) {
      my ($name,$paren,$txt) = (@$set);
      @add = $last_paren eq $name ? () : ("", fold(38,$name,"$t"x4));
      push(@add, fold(24,"$paren)","$t$t$t(","$t$t$t ")) if $paren;
      push(@add, fold(35,$txt,"$t$t")) if $txt;
			#$last_paren=$name;
    }

    if ($opt->{page_breaks} && $line + $#add+1 > $opt->{per_page}) {
      print OUT " "x50,"(CONTINUED)\n\nCONTINUED";
      print OUT " PAGE $page" if $opt->{num};
      print OUT ":\n";
      $line = 1;
      $page++;
    }

    foreach ( @add ) {
      printf OUT "%2d ",$line if $opt->{num} && /\S/;
      printf OUT "",$line if $opt->{num};
      print OUT "$indent$_\n";
      $line++;
    }
  }
}

sub write_output {
  my ($opt,$script) = @_;

  my $out = $opt->{out} || '&STDOUT';
  open(OUT, ">$out") || usage("Couldn't write output? [$out]");

  if ($opt->{outfmt} eq 'scurvy') {
    write_scurvy($opt,$script);
  } elsif ($opt->{outfmt} eq 'text') {
    write_text($opt,$script);
  } elsif ($opt->{outfmt} eq 'final') {
    $opt->{indent} = 3 if !defined $opt->{indent};
    write_text($opt,$script);
  }
  close OUT;
}

sub main {
  my $opt = parse_args();

  debug("Version: $VERSION\n");

  my $script = read_input($opt);
  write_output($opt,$script);
}
main();

##################################################
# POD/man
##################################################

__END__

=pod
=head1 NAME

scurvy - Format scripts / screenplays

=head1 SYNOPSIS

B<scurvy> [S<options>] E<lt>I<file>E<gt> [S<I<-o E<lt>I<file>E<gt>>>]

=head1 DESCRIPTION

scurvy converts text files in a simple format into proper screenplay
format.  It's something I wrote because I hate using snifty GUI editors
when I believe a text editor is all you need.

  "If you can't vi it, it sucks"

It takes a text file as input and outputs a screenplay.  More formats
may occur someday..

=head1 OPTIONS


=over 4


=item B<-out> I<file>

Set the output file (otherwise write to standard out)

=item B<-c>

Number the scene headings (INT, EXT, I/E)

=item B<-C>

Show the "CONTINUED" page breaks

=item B<-i>

Add the left margin indentation.  (Good for final print)

=item B<-indent> I<tabs>

Add the left margin indentation with a specific number of tabs.

=item B<-in_indent> I<tabs>

Specify the extra number of indent tabs in the input file.
(Defaults to three for 'final' input format)

=item B<-n>

Show page/line numbers

=item B<-I> I<fmt>

Specify the input format:

B<scurvy>   Our simple input format (described below)

B<text>     The default text script output (can be an input format also)

B<final>    Final Draft format (text-with-layout)

B<rtf>      RTF (input only) format
  Using the Final Draft style sheet with styles:
    GENERAL
    SCENE HEADING
    ACTION
    CHARACTER NAME
    PARENTHETICAL
    DIALOG
    TRANSITION
    SHOT

If you want to convert a Final Draft document so you can edit it in scurvy,
then first save it as text-with-layout - we'll call this file 'mymovie.fdr'

Then you can use scurvy to convert this to scurvy format:

% scurvy -I final mymovie.fdr -O scurvy -o mymovie.scr

It's possible you'll get an error if your margins are different - the
default margins should be read correctly, but if not try adjusting -in_indent.

You can also try saving as RTF and then reading in the RTF, though
this isn't guaranteed to work with all versions of Final Draft.
If you have a different script writer that does RTF output, I'd love
to see a sample copy.  To convert rtf we would save as rtf and:

% scurvy -I rtf mymovie.rtf -O scurvy -o mymovie.scr

Then you can edit mymovie.scr and get the final output with scurvy:

% scurvy mymovie.scr -o mymovie.txt

You will, of course, lose any aliases you may have had.  Try a simple
search and replace.  For example, to convert the name "Dave" to be
an alias "D" you can add the alias line to the top:

  Dv:=Dave Madison

And then do the search and replace (example using vi/vim):

  :%s/^Dave Madison/Dv:/
  :%s/^Dave Madison (/Dv (/

(The second line is for quotes with parenthesis)

=item B<-O> I<fmt>

Specify the output format.  (Same formats as input)

=back

=head1 REQUIREMENTS

Since scurvy uses tabs to determine formatting, you need to make sure
your text editor isn't converting this into spaces.  In vi and vim
you need to make sure you haven't set 'expandtab' - if you have, you can
turn it off with

  :noexpandtab

=head1 SCURVY FORMAT

There are five types of line formats: heading, action, dialogue, transition, general.
Each type B<must> be on it's own line.  (Use I<:set wrap> in vi/vim to make it easier to edit)

=over 4

=item B<scene heading>

Scene headings are automatically recognized since they start with INT, EXT or I/E.

=item B<action>

Action lines start after one tab.

=item B<transition>

Transition lines start after two tabs

=item B<dialogue>

Dialogue follows the characters name, a colon and a tab.  Some examples:

  Dave:	I think we should go shopping!
  God (V.O.):	That's a bad idea, Dave
  Dave:	(pondering)	You're probably right.

Parentheticals go after the colon, but V.O., O.S. go before.

=item B<general>

Generals are just regular text not prefaced by tabs.

=item B<comments>

Any line that starts with a '#' character is ignored.

=back

=head1 ALIASES

Aliases for characters can be defined on any line:

  D:=Dave

And then they can be used as the character speaking dialogue:

  D:	I think we should go shopping!

Or in any line of text if inside {curly braces}

  God (V.O.):	That's a bad idea, {D}

=head1 EXAMPLE

Here's an example input file:

  D:=Dave (aliases for characters look like this)
  INT. SCENE HEADING - DAY
  	Actions have one tab
  		Transitions have two tabs
  General text is just plain text.
  Dave:	dialogue follows the ":<tab>"
  John (V.O.):	voice overs go before the :
  D:	(using an alias!)	And parentheticals go after!

=head1 BUGS

Garbage in, garbage out.

When reading 'final' or 'text' formats, it's impossible to
differentiate between a new 'GENERAL' line or a continuation
of an 'ACTION' line since they look the same.  Sad but true.
Hence I assume them to all be ACTIONs.

The different format parsing/output is somewhat beta - if you find
any bugs please send me an example script and the problem.

=head1 AUTHOR

David Ljung Madison <http://MarginalHacks.com/>

=cut