File Coverage

blib/lib/Text/Format/Screenplay.pm

Criterion	Covered	Total	%
statement	135	147	91.8
branch	55	72	76.3
condition	8	12	66.6
subroutine	15	15	100.0
pod	2	2	100.0
total	215	248	86.6

package Text::Format::Screenplay;

use 5.008009;
use strict;
use warnings;
use File::Slurp qw(read_file);
use PDF::Create;
use Text::Wrap;

our $VERSION = '0.01';

my $DOUBLE_DIALOG_LINES = 0;
my $SHOW_SCENE_NUMBERS  = 0;

my $CHAR_WIDTH  = 7;
my $CHAR_HEIGHT = 12;
my $PAGE_WIDTH  = 612;
my $PAGE_HEIGHT = 792;

# parse infile
my $TITLE    = '';
my @AUTHOR   = ();
my @CONTACT  = ();
my $DRAFT    = '';
my $DATE     = '';

sub new
{
	my ($class, @args) = @_;
	my $self = bless {}, $class;
	return $self->_init();
}

sub _init
{
	my ($self, %opts) = @_;
	return $self;
}

sub pdf
{
	my ($self, $filename, $outfile) = @_;

	# structure of $scenes: each element: [ 'type', 'content' ]
	my $scenes = $self->_parse_infile( read_file($filename) );

	$self->_create_outfile( $scenes, $outfile );
}

sub _parse_infile
{
  my ($self, @lines) = @_;
  my @sp;

  my $i; my $j;
  for ($i=0; $i
	{
	  next if $lines[$i] =~ /^[\s\t\n\r]*$/;  # ignore blank lines
	  next if $lines[$i] =~ /^[\s\t\n\r]*\#/; # ignore comment lines

	  # parse next paragraph
	  my $para = '';
	  for ($j=$i; $j
		chomp($lines[$j]);
		next if $lines[$j] =~ /^[\s\t\n\r]*\#/; # ignore comment lines
		last if $lines[$j] =~ /^[\s\t\n\r]*$/;  # ignore blank lines
		$para .= $lines[$j];
	  }
	  $i = $j;

	  # split into pre-colon and post-colon parts
	  my ($pre, $post) = $para =~ /^([^\:\~\>]*[\:\~\>]?)(.*)$/;
	  $post = '' unless $post;

	  if ($pre eq 'title:') {
		($TITLE) = uc($post) =~ /^[\s\t]*(.*)[\s\t\r\n]*$/;
	  } elsif ($pre eq 'author:') {
		@AUTHOR = map { s/^[\s\t]*(.*)[\s\t\r\n]*$/$1/; $_ } split /;/, $post;
	  } elsif ($pre eq 'contact:') {
		@CONTACT = map { s/^[\s\t]*(.*)[\s\t\r\n]*$/$1/; $_ } split /;/, $post;
	  } elsif ($pre eq 'draft:') {
		$DRAFT = $post;
	  } elsif ($pre eq 'date:') {
		$DATE = $post;
	  } elsif ($pre eq ':') {
		push @sp, ['s', $post];
	  } elsif ($pre eq '>') {
		push @sp, ['t', $post];
	  } elsif ($pre eq '~') {
		push @sp, ['c', $post];
	  } elsif ($pre =~ /^.{1,20}\:$/) {
		$pre =~ s/\:$//;
		push @sp, [$pre, $post];
	  } else {
		push @sp, ['d', $pre];
	  }
    }

  return \@sp;
}

sub _create_outfile
{
  my ($self, $sp, $outfile) = @_;

  my $pdf = new PDF::Create
	('filename' => $outfile,
	 'Version'  => 1.2,
	 'PageMode' => 'UseOutlines',
	 'Author'   => join(', ', @AUTHOR),
	 'Title'    => $TITLE,
	);
  my $root = $pdf->new_page('Media-Box' => [0, $PAGE_WIDTH, 0, $PAGE_HEIGHT]);
  my $font = $pdf->font
	('Subtype'  => 'Type1',
	 'Encoding' => 'WinAnsiEncoding',
	 'BaseFont' => 'CourierNew');

  my $mid = sprintf "%.0f", ($PAGE_WIDTH / $CHAR_WIDTH / 2);

  #
  # title page
  #
  my $page = $root->new_page; # inherit from root

  my $line = 25;
  $line = _put($page, $font, $TITLE, $line, _mid($mid,$TITLE));
  $line += 4;
  $line = _put($page, $font, "written by", $line, _mid($mid,"written by"));
  $line++;
  foreach (@AUTHOR) { $line = _put($page, $font, $_, $line, _mid($mid,$_)) }
  _put($page, $font, join("\n",@CONTACT), 61-scalar(@CONTACT), 15);
  _put($page, $font, $DRAFT, 56, 62);
  _put($page, $font, $DATE, 60, 62);

  #
  # script pages
  #
  my $pnum = 1; # page counter
  my $snum = 1; # scene counter

  $page = $root->new_page;
  _put($page, $font, sprintf("%10s", "$pnum."), 4, 62);
  $line = 6;
  for (my $e=0; $e<@{$sp}; $e++)
  {
    my $type = $sp->[$e]->[0];
    my $text = $sp->[$e]->[1];

    if ($type !~ /^[stcd]$/) { $text =~ s/\(/\n\(/g; $text =~ s/\)/)\n/g }

    # check if current page is full
    my $till = 0; # till what line the next element needs space
    if ($type eq 's') {
      # own + 1 line space + space for next part
      $till = $line + _sizeof($text,1000);
      $till += 10;
    } elsif ($type eq 't' || $type eq 'c') {
      # one line (+ 2 empty lines of not last line)
      $till = $line + 1;
      $till += 2 unless $till == 60;
    } elsif ($type eq 'd') {
      # own size (+ 1 empty line if not on last line)
      $till = $line + _sizeof($text,54);
      $till++ unless $till == 60;
    } else {
      # name line + dialog lines
      $till = $line + 1 + _sizeof($text,32);
      $till += _sizeof($text,32) if $DOUBLE_DIALOG_LINES;
    }

    # create new page
    if ($till > 60) {
      $pnum++;
      $page = $root->new_page;
      _put($page, $font, sprintf("%10s", "$pnum."), 4, 62);
      $line = 6;
      next;
    }

    # add current element + space to page
    if ($type eq 's') {
      if ($SHOW_SCENE_NUMBERS) {
        _put($page, $font, sprintf("%5s",$snum), $line, 13);
        _put($page, $font, $snum, $line, 74);
        $snum++;
      }
      $line = _put($page, $font, $text, $line, 19);
      $line++;
    } elsif ($type eq 't') {
      $line = _put($page, $font, $text, $line, 62);
      $line += 2 unless $line == 60;
    } elsif ($type eq 'c') {
      $line = _put($page, $font, $text, $line, _mid($mid,$text));
      $line += 2 unless $line == 60;
    } elsif ($type eq 'd') {
      $line = _put($page, $font, _wrapit($text,54), $line, 19);
      if (($e+1 < scalar(@{$sp})) &&
          ($sp->[$e+1]->[0] eq 't' || $sp->[$e+1]->[0] eq 'c' ||
           $sp->[$e+1]->[0] eq 's')) {
        $line += 2 unless $line == 60;
      } else {
        $line++ unless $line == 60;
      }
    } else {
      $line = _put($page, $font, $type, $line, 43);
      $text = _wrapit($text,32); $text =~ s/\(/       \(/g;
      if ($DOUBLE_DIALOG_LINES) {
        $text =~ s/\n/\n\n/g; $text = "\n$text" }
      $line = _put($page, $font, $text, $line, 29);
      if (($e+1 < scalar(@{$sp})) && ($sp->[$e+1]->[0] !~ /^stcd$/)) {
        $line++ unless $line == 60;
      } else {
        $line += 2 unless $line == 60;
      }
    }
  }

  $pdf->close;
}

sub _sizeof
{
  my ($text, $width) = @_;
  $text = _wrapit($text, $width);
  my @lines = split /\n/, $text;
  return scalar(@lines);
}

sub _wrapit
{
  my ($text, $width) = @_;
  $Text::Wrap::columns = $width;
  $text = Text::Wrap::wrap("", "", $text);
  $text =~ s/\s*\n\s*/\n/g;
  $text =~ s/^\s*//g;
  return $text;
}

sub _mid
{
  my ($mid, $str) = @_;
  return sprintf("%.0f", $mid - (length($str) / 2));
}

# places a text block onto a page, starting at a certain position
sub _put
{
  my ($page, $font, $text, $line, $column) = @_;
  foreach (split /\n/, $text) {
	$page->stringl($font, 10,
				   ($column * $CHAR_WIDTH),
				   ($PAGE_HEIGHT - ($line * $CHAR_HEIGHT)), $_);
	$line++;
  }
  return $line;
}

1;
__END__