--- /dev/null
+#!/usr/bin/perl
+#
+# A state machine that post processes a mup postscript file to alter
+# the colour of various things
+#
+# Copyright (c) 2004 Dirk Koopman
+#
+# $Id: mupcolour,v 1.2 2004/06/02 13:35:29 djk Exp $
+#
+
+use strict;
+use warnings;
+
+my %staff = (); # contains the actions for each staff
+
+# arguments are of the form: -l1=#275643 -s2=#324524
+# ie '-', a letter, a staff no, '=', an RGB triple
+while ($ARGV[0] =~ /^-/) {
+ my $arg = shift;
+ 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})$/) {
+ my $staff = $staff{$staffno} || {};
+ $staff->{$let} = [hex($r)/256, hex($g)/256, hex($b)/256];
+ $staff{$staffno} = $staff;
+ } else {
+ usage("Don't recognise '$arg'");
+ exit(1);
+ }
+}
+
+if (@ARGV == 0) {
+ usage("Need an input filename");
+ exit(1);
+}
+
+while (@ARGV) {
+ process(shift);
+}
+
+sub process
+{
+ my $fn = shift;
+ rename($fn, "$fn.bak") || usage("cannot rename $fn -> $fn.bak") || exit(1);
+ open IN, "$fn.bak" || usage("cannot open $fn.bak ($!)") || exit(1);
+ open OUT, ">$fn" || usage("cannot open $fn ($!)") || exit(1);
+
+ my $state = '';
+ my $staffno = 0;
+ my $store = '';
+ my $dostore = 0;
+
+ while (<IN>) {
+
+ if (/^%\s+S_STAFF/) {
+ print OUT $store if $store;
+ $state = "waitstaff";
+ $dostore = $staffno = 0;
+ $store = '';
+ } elsif (/^%\s+staff\s(\d+)/ && $state eq 'waitstaff') {
+ $staffno = $1;
+ $state = 'waitfont';
+ } elsif (/findfont$/ && $state eq 'waitfont') {
+ $state = 'waitshow';
+ $dostore = 1;
+ } elsif (/\)\s+show$/ && $state eq 'waitshow') {
+ if (!/setrgbcolor/) {
+ my $st = $staff{$staffno};
+ if ($st) {
+ my $rgb = $st->{l};
+ chomp;
+ print OUT "$rgb->[0] $rgb->[1] $rgb->[2] setrgbcolor\n$store$_\n0 0 0 setrgbcolor\n";
+ $state = 'waitfont';
+ $store = '';
+ $dostore = 0;
+ next;
+ }
+ }
+ }
+ if ($dostore) {
+ $store .= $_;
+ } else {
+ print OUT $_;
+ }
+ }
+}
+
+sub usage
+{
+ my $mess = shift;
+ print "mupcolour: A program to add colour to mup output\n\n";
+ print "$mess\n\n" if $mess;
+ print "usage: mupcolour -l1=#324532 -l2=#453232 file.ps\n";
+ print "arguments are of the form: -,letter,staffno,=#,rgb triple\n";
+ print "the letters available are:\n";
+ print " 'l' - lyric colour\n";
+ print "\n";
+ return 0;
+}