API tools faq
paste
Advertisement
tambascot

cueScripGen.pl

tambascot
Jan 16th, 2013
373
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 5.47 KB | None | 0 0
raw download clone embed print report
  1. #!/usr/bin/perl
  2. #
  3. # cueScriptGen
  4. #
  5. # Generate a cue script from an MIT Shakespeare File
  6. #
  7. # By Tony Tambasco
  8. #
  9. # Released under the GPL 2.0 and all that jazz.
  10. #
  11. # This is just a prototype. A more polished version will need further
  12. # testing and development.
  13. #
  14. # Last Revised 15 Jan. 2013 11 PM
  15.  
  16. use strict;
  17. use warnings;
  18.  
  19. # The user must give us at least one character name (but may give us
  20. # any number of them), followed by a script file. If they don't,
  21. # print a simple error and exit.
  22.  
  23. if (@ARGV < 2) {
  24.   die "usage is \"cueScriptGen character_1 [character_2 &c] file_name\"\n";
  25. }
  26.  
  27. # We should edit this to either accept a file name or a URL.
  28. # If we force a URL, we can explore transformations based on
  29. # alternative methods of formatting.
  30.  
  31. # Whatever the file is, it will be the LAST thing in our
  32. # argument list, so pop it off so we have a list of nothing
  33. # but characters.
  34. my $mit_shakes = pop @ARGV;
  35.  
  36. # Initialize variables.
  37. my $cue_line      = "";
  38. my $prev_cue_line = "";
  39. my $act           = "";
  40. my $scene         = "";
  41. my $new_act       = undef;
  42. my $new_scene     = undef;
  43. my $line          = "";
  44. my $title_of_play = "";
  45.  
  46. # Open a file or quit with a basic warning if you can't.
  47. open PLAY, $mit_shakes or die "Could not open file: $!\n";
  48.  
  49.  
  50.   # Step 0.5: Print basic html header info from the file, and
  51.   # them some heading info so the reader knows what they're
  52.   # looking at.
  53.  
  54. until ($line =~ m/<\/head>/) {
  55.   if ($line =~ m/<title>(.*)<\/title>/) {
  56.     $title_of_play = $1;
  57.   }
  58.   print "$line";
  59.   $line = <PLAY>;
  60. }
  61.  
  62. print "</head>\n<body>\n";
  63. print "<h1>$title_of_play</h1>\n";
  64. print '<h2>Cue Script for ';
  65.  
  66. # This boolean will tell us if we're on the
  67. # first item in the list, which should not
  68. # be preceeded by a comma and a space when
  69. # printing the list of characters.
  70.  
  71. my $i = 0;
  72.  
  73. foreach (@ARGV) {
  74.   if ($i == 0) {
  75.     print "$_";
  76.     $i = 1;
  77.   }
  78.  
  79.   else {
  80.     print ", $_";
  81.   }
  82. }
  83.  
  84. print ". </h2>\n";
  85.  
  86.  
  87. # Traverse the file until EOF
  88. while ($line = <PLAY>) {
  89.   # The editor may have edited by commenting out text. In this case, we should
  90.   # presume they have use comment delimiters exactly as if they had deleted all
  91.   # text and markup in between them. i.e. comment delimiters may be used to join
  92.   # multiple speeches by multiple characters into a single speech.
  93.  
  94.   if ($line =~ m/.*<!--.*/) {
  95.  
  96.     # Split the line with the comment mark, everything before it is
  97.     # text we want to print. Everything after we can ignore...
  98.    
  99.     my ($keep, $comment) = split /<!--/, $line;
  100.     print "$keep\n";
  101.     $cue_line = $keep;
  102.  
  103.     # Until we find a closing comment mark...
  104.    
  105.     $line = <PLAY> until ($line =~ m/.*-->.*/);
  106.  
  107.     # When we split the line again, this time keep everything
  108.     # to the right of the mark, and discarding the rest.
  109.    
  110.     ($comment, $keep) = split /-->/, $line;
  111.     print "$keep\n";
  112.     $prev_cue_line = $cue_line;
  113.     $cue_line = $keep;  
  114.    
  115.   }
  116.  
  117.   # Step 1: Find a speech block that contains a character that we're looking for.
  118.   # We need to do this for every character left in our arguument list.
  119.   foreach (@ARGV) {
  120.     my $character = $_;
  121.    
  122.     if ($line =~ m/^<a name="speech\d+"><b>$character<\/b>/i) {
  123.  
  124.       # Print the act heading if we haven't yet.
  125.       if ($new_act) {
  126.     print "$act\n";
  127.     $new_act = undef;
  128.       }
  129.  
  130.       # Print the scene headin if we haven't yet.
  131.       if ($new_scene) {
  132.     print "$scene\n";
  133.     $new_scene = undef;
  134.       }
  135.      
  136.       # Step 2: We've found a line of text that matches a block of text for the
  137.       # character we're looking for, so first we need to print their cue line.
  138.       # See step 1.5 (below) for details. If the cue line is less than three
  139.       # words long, print the line that came before it, too.
  140.  
  141.       $cue_line =~ m/^<a name="\d+\.\d+\.\d+">(.*)</;
  142.      
  143.       my @cue_words = split /\s/, $1;
  144.       my $cue_words = @cue_words;
  145.      
  146.       if ($cue_words < 2) {
  147.     print "<b>Cue:</b> $prev_cue_line\n$cue_line\n\n";
  148.       }
  149.      
  150.       else {
  151.     print "<b>Cue:</b> $cue_line\n\n";
  152.       }
  153.      
  154.       # Step 3: Print the entire speech block for the character; you know you're
  155.       # at the end of the block when you reach the closing blockquote
  156.       while ($line !~ m/<\/blockquote>/) {
  157.  
  158.     print "$line\n";
  159.  
  160.     # We still need to keep track of the cue line, just in case the cue script
  161.     # is for an actor who plays two roles with back to back lines.
  162.     $prev_cue_line = $cue_line;
  163.     $cue_line      = $line;
  164.    
  165.     # Read the next line of the file.
  166.     $line = <PLAY>;
  167.       }
  168.  
  169.       # Step 4: Print the closing blockquote.
  170.       print "</blockquote>\n";
  171.      
  172.     }
  173.    
  174.     # Step 1.5: We need to keep track of each line of text as we go, so if the
  175.     # line was not a speech heading, see if it's a line of text. If it is, keep it  
  176.     elsif ($line =~ m/^<a name="\d\.\d+\.\d+"/) {
  177.       $prev_cue_line = $cue_line;
  178.       $cue_line      = $line;
  179.     }
  180.  
  181.     # Step 1.6: We should also print act headings.
  182.     elsif ($line =~ m/.*<h3>ACT \w+.*/) {
  183.       $act       = $line;
  184.       $new_act   = "true";
  185.     }
  186.  
  187.     # Step 1.7: We should also print scene headings.
  188.     elsif ($line =~ m/.*<h3>SCENE \w+.*/) {
  189.       $scene     = $line;
  190.       $new_scene = "true";
  191.     }
  192.  
  193.     # Step 1.8: If a line begins with a comment delimiter, skip ahead to the
  194.     # end of the commnt block.
  195.    
  196.   }
  197. }
  198.    
  199. # Last piece of cleanup, close off our HTML elements
  200.  
  201. print "\n</body>\n</html>\n";
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!