bin/mudela-book.pl

   1 #!@PERL@ -w
   2 # -*-Perl-*-
   3 my $mudcount = 0;
   4 my $mudela_b = 0;
   5 my $outname = "-";
   6 my $outdir;
   7 use Getopt::Long;
   8
   9
  10 # do something, check return status
  11 sub my_system
  12 {
  13     my (@cmds) = @_;
  14     foreach $cmd (@cmds) {
  15         my ($ignoreret)=0;
  16         if ( $cmd  =~ /^-/ ) {
  17             $ignoreret = 1;
  18             $cmd = substr ($cmd, 1);
  19         }
  20
  21         my $ret =  ( system ($cmd));
  22         if ($ret) {
  23             if ($ignoreret) {
  24                 print STDERR "ignoring failed command \`$cmd\' (status $ret)\n";
  25             }else {
  26                 print STDERR "\nmudela-book: failed on command \`$cmd\' (status $ret)\n";
  27                 exit 2;
  28             }
  29         }
  30     }
  31 }
  32 sub gen_mufile
  33 {
  34     return "$outdir/$outname$mudcount.ly";
  35 }
  36
  37 sub gen_texbase
  38 {
  39     return "$outname$mudcount.tex";
  40 }
  41 sub gen_texfile
  42 {
  43     return "$outdir/" . gen_texbase;
  44 }
  45
  46 sub close_mudela
  47 {
  48     $mudela_b = 0;
  49     if ($fragment_b) {
  50         print MUDELA "}\n \\paper { linewidth = -1.0\\cm; castingalgorithm = \\Wordwrap; } }\n";
  51         $fragment_b =0;
  52     }
  53     if ( $verbatim_b)  {
  54         print BOOK "\\end{verbatim}\n\\interexample";
  55         $verbatim_b =0;
  56     }
  57     close MUDELA;
  58     my $status =0;
  59     if ( -f gen_mufile ) {
  60         $status = system "diff -q $outdir/book-mudela.ly " . gen_mufile;
  61     } else {
  62         $status = 1;
  63         }
  64     if ( $status ) {
  65         rename "$outdir/book-mudela.ly", gen_mufile;
  66         unlink gen_texfile;
  67     }
  68
  69     if ( ! -f gen_texfile) {
  70         my_system "lilypond ". gen_mufile;
  71         rename gen_texbase, gen_texfile;
  72     }
  73     print BOOK "\\preexample\\input " . gen_texfile . "\n\\postexample\n";
  74
  75 }
  76
  77 sub open_mudela
  78 {
  79     $mudcount++;
  80     $mudela_b = 1       ;
  81     open MUDELA, ">$outdir/book-mudela.ly";
  82     if ($verbatim_b) {
  83         print BOOK "\\begin{verbatim}\n";
  84     }
  85     if ($fragment_b) {
  86         print MUDELA "\\score { \\melodic {";
  87     }
  88
  89 }
  90
  91 sub begin_b
  92 {
  93     my ($s) = @_;
  94     return (/^\\begin{$s}/) ;
  95 }
  96
  97 sub end_b
  98 {
  99     my ($s) = @_;
 100     return (/^\\end{$s}/) ;
 101 }
 102 sub parse_mudela_opts
 103 {
 104    my ($s) = @_;
 105    $s =~ s/[\[\]]//g;
 106
 107    $verbatim_b =1 if ($s =~ /verbatim/ );
 108    $fragment_b = 1 if ($s =~ /fragment/ );
 109 }
 110
 111 sub help
 112 {
 113     print  "usage: convert-mudela [options] [file]
 114 options:
 115 --help
 116 --outdir=DIRECTORY      write all files in directory DIRECTORY
 117 --outname=NAME          use NAME as base  for the output
 118 ";
 119     exit;
 120 }
 121
 122 sub main
 123 {
 124     GetOptions( 'outdir=s', 'outname=s', 'help');
 125     help    if ( $opt_help ) ;
 126
 127     if  (defined ($opt_outdir)) {
 128         $outdir = $opt_outdir .  "/";
 129     } else {
 130         $outdir = ".";
 131     }
 132
 133     if (defined ($ARGV[0])) {
 134         $infile = $ARGV[0] ;
 135     } else {
 136         $infile = "-";
 137     }
 138     if (defined ($opt_outname)) {
 139         $outname = $opt_outname ;
 140     } else {
 141         die "Need to have an output name, use --outname" if ( $infile eq "-");
 142         $outname = "$infile.tex";
 143     }
 144
 145     my $openout ="$outdir$outname";
 146     if  ( $infile eq $openout ) {
 147         die "The input can't be the output\n";
 148     }
 149
 150     open INFILE, "<$infile";
 151     open BOOK, ">$openout";
 152     while (<INFILE>) {
 153         if ($mudela_b) {
 154             if (end_b "mudela") {
 155                 close_mudela;
 156                 next;
 157             }
 158             print MUDELA;
 159             if ( $verbatim_b ) {
 160                 my $s = $_;
 161                 $s =~ s/\t/    /g; #shit
 162                 print BOOK $s;
 163             }
 164
 165         } else {
 166             if (/^\\begin(\[.*\])?{mudela}/ ) {
 167                 my $opts ="";
 168                 $opts = $1 if ( defined ($1));
 169
 170                 parse_mudela_opts($opts);
 171                 open_mudela;
 172                 next;
 173             }
 174             print BOOK;
 175         }
 176     }
 177     close INFILE;
 178     close BOOK;
 179 }
 180
 181
 182 main;