mupcolour

   1 #!/usr/bin/perl
   2 #
   3 # A state machine that post processes a mup postscript file to alter
   4 # the colour of various things
   5 #
   6 # Copyright (c) 2004 Dirk Koopman
   7 #
   8 # $Id: mupcolour,v 1.2 2004/06/02 13:35:29 djk Exp $
   9 #
  10
  11 use strict;
  12 use warnings;
  13
  14 my %staff = ();                                 # contains the actions for each staff
  15
  16 # arguments are of the form: -l1=#275643 -s2=#324524
  17 # ie '-', a letter, a staff no, '=', an RGB triple
  18 while ($ARGV[0] =~ /^-/) {
  19         my $arg = shift;
  20         if (my ($let, $staffno, $r, $g, $b) = $arg =~ /^-([a-zA-Z])(\d+)=#([0-9a-fA-F]{2})([0-9a-fA-F]{2})([0-9a-fA-F]{2})$/) {
  21                 my $staff = $staff{$staffno} || {};
  22                 $staff->{$let} = [hex($r)/256, hex($g)/256, hex($b)/256];
  23                 $staff{$staffno} = $staff;
  24         } else {
  25                 usage("Don't recognise '$arg'");
  26                 exit(1);
  27         }
  28 }
  29
  30 if (@ARGV == 0) {
  31         usage("Need an input filename");
  32         exit(1);
  33 }
  34
  35 while (@ARGV) {
  36         process(shift);
  37 }
  38
  39 sub process
  40 {
  41         my $fn = shift;
  42         rename($fn, "$fn.bak") || usage("cannot rename $fn -> $fn.bak") || exit(1);
  43         open IN, "$fn.bak" || usage("cannot open $fn.bak ($!)") || exit(1);
  44         open OUT, ">$fn" || usage("cannot open $fn ($!)") || exit(1);
  45
  46         my $state = '';
  47         my $staffno = 0;
  48         my $store = '';
  49         my $dostore = 0;
  50
  51         while (<IN>) {
  52
  53                 if (/^%\s+S_STAFF/) {
  54                         print OUT $store if $store;
  55                         $state = "waitstaff";
  56                         $dostore = $staffno = 0;
  57                         $store = '';
  58                 } elsif (/^%\s+staff\s(\d+)/ && $state eq 'waitstaff') {
  59                         $staffno = $1;
  60                         $state = 'waitfont';
  61                 } elsif (/findfont$/ && $state eq 'waitfont') {
  62                         $state = 'waitshow';
  63                         $dostore = 1;
  64                 } elsif (/\)\s+show$/ && $state eq 'waitshow') {
  65                         if (!/setrgbcolor/) {
  66                                 my $st = $staff{$staffno};
  67                                 if ($st) {
  68                                         my $rgb = $st->{l};
  69                                         chomp;
  70                                         print OUT "$rgb->[0] $rgb->[1] $rgb->[2] setrgbcolor\n$store$_\n0 0 0 setrgbcolor\n";
  71                                         $state = 'waitfont';
  72                                         $store = '';
  73                                         $dostore = 0;
  74                                         next;
  75                                 }
  76                         }
  77                 }
  78                 if ($dostore) {
  79                         $store .= $_;
  80                 } else {
  81                         print OUT $_;
  82                 }
  83         }
  84 }
  85
  86 sub usage
  87 {
  88         my $mess = shift;
  89         print "mupcolour: A program to add colour to mup output\n\n";
  90         print "$mess\n\n" if $mess;
  91         print "usage: mupcolour -l1=#324532 -l2=#453232 file.ps\n";
  92         print "arguments are of the form: -,letter,staffno,=#,rgb triple\n";
  93         print "the letters available are:\n";
  94         print "    'l' - lyric colour\n";
  95         print "\n";
  96         return 0;
  97 }