@OggVorbisソリューション/libvorbis-1.3.2/vq/make_residue_books.pl

   1 #!/usr/bin/perl
   2
   3 # quick, very dirty little script so that we can put all the
   4 # information for building a residue book set (except the original
   5 # partitioning) in one spec file.
   6
   7 #eg:
   8
   9 # >res0_128_128 interleaved
  10 # haux 44c0_s/resaux_0.vqd res0_96_128aux 0,4,2 9
  11 # :1 res0_128_128_1.vqd, 4, nonseq cull, 0 +- 1
  12 # :2 res0_128_128_2.vqd, 4, nonseq, 0 +- 1(.7) 2
  13 # :3 res0_128_128_3.vqd, 4, nonseq, 0 +- 1(.7) 3 5
  14 # :4 res0_128_128_4.vqd, 2, nonseq, 0 +- 1(.7) 3 5 8 11
  15 # :5 res0_128_128_5.vqd, 1, nonseq, 0 +- 1 3 5 8 11 14 17 20 24 28 31 35 39
  16
  17
  18 die "Could not open $ARGV[0]: $!" unless open (F,$ARGV[0]);
  19
  20 $goflag=0;
  21 while($line=<F>){
  22
  23     print "#### $line";
  24     if($line=~m/^GO/){
  25         $goflag=1;
  26         next;
  27     }
  28
  29     if($goflag==0){
  30         if($line=~m/\S+/ && !($line=~m/^\#/) ){
  31             my $command=$line;
  32             print ">>> $command";
  33             die "Couldn't shell command.\n\tcommand:$command\n"
  34                 if syst($command);
  35         }
  36         next;
  37     }
  38
  39     # >res0_128_128
  40     if($line=~m/^>(\S+)\s+(\S*)/){
  41         # set the output name
  42         $globalname=$1;
  43         $interleave=$2;
  44         next;
  45     }
  46
  47     # haux 44c0_s/resaux_0.vqd res0_96_128aux 0,4,2 9
  48     if($line=~m/^h(.*)/){
  49         # build a huffman book (no mapping)
  50         my($name,$datafile,$bookname,$interval,$range)=split(' ',$1);
  51
  52         # check the desired subdir to see if the data file exists
  53         if(-e $datafile){
  54             my $command="cp $datafile $bookname.tmp";
  55             print ">>> $command\n";
  56             die "Couldn't access partition data file.\n\tcommand:$command\n"
  57                 if syst($command);
  58
  59             my $command="huffbuild $bookname.tmp $interval";
  60             print ">>> $command\n";
  61             die "Couldn't build huffbook.\n\tcommand:$command\n"
  62                 if syst($command);
  63
  64             my $command="rm $bookname.tmp";
  65             print ">>> $command\n";
  66             die "Couldn't remove temporary file.\n\tcommand:$command\n"
  67                 if syst($command);
  68         }else{
  69             my $command="huffbuild $bookname.tmp 0-$range";
  70             print ">>> $command\n";
  71             die "Couldn't build huffbook.\n\tcommand:$command\n"
  72                 if syst($command);
  73
  74         }
  75         next;
  76     }
  77
  78     # :1 res0_128_128_1.vqd, 4, nonseq, 0 +- 1
  79     if($line=~m/^:(.*)/){
  80         my($namedata,$dim,$seqp,$vals)=split(',',$1);
  81         my($name,$datafile)=split(' ',$namedata);
  82         # build value list
  83         my$plusminus="+";
  84         my$list;
  85         my$thlist;
  86         my$count=0;
  87         foreach my$val (split(' ',$vals)){
  88             if($val=~/\-?\+?\d+/){
  89                 my$th;
  90
  91                 # got an explicit threshhint?
  92                 if($val=~/([0-9\.]+)\(([^\)]+)/){
  93                     $val=$1;
  94                     $th=$2;
  95                 }
  96
  97                 if($plusminus=~/-/){
  98                     $list.="-$val ";
  99                     if(defined($th)){
 100                         $thlist.="," if(defined($thlist));
 101                         $thlist.="-$th";
 102                     }
 103                     $count++;
 104                 }
 105                 if($plusminus=~/\+/){
 106                     $list.="$val ";
 107                     if(defined($th)){
 108                         $thlist.="," if(defined($thlist));
 109                         $thlist.="$th";
 110                     }
 111                     $count++;
 112                 }
 113             }else{
 114                 $plusminus=$val;
 115             }
 116         }
 117         die "Couldn't open temp file $globalname$name.vql: $!" unless
 118             open(G,">$globalname$name.vql");
 119         print G "$count $dim 0 ";
 120         if($seqp=~/non/){
 121             print G "0\n$list\n";
 122         }else{
 123             print G "1\n$list\n";
 124         }
 125         close(G);
 126
 127         my $command="latticebuild $globalname$name.vql > $globalname$name.vqh";
 128         print ">>> $command\n";
 129         die "Couldn't build latticebook.\n\tcommand:$command\n"
 130             if syst($command);
 131
 132         if(-e $datafile){
 133
 134             if($interleave=~/non/){
 135                 $restune="res1tune";
 136             }else{
 137                 $restune="res0tune";
 138             }
 139
 140             if($seqp=~/cull/){
 141                 my $command="$restune $globalname$name.vqh $datafile 1 > temp$$.vqh";
 142                 print ">>> $command\n";
 143                 die "Couldn't tune latticebook.\n\tcommand:$command\n"
 144                     if syst($command);
 145             }else{
 146                 my $command="$restune $globalname$name.vqh $datafile > temp$$.vqh";
 147                 print ">>> $command\n";
 148                 die "Couldn't tune latticebook.\n\tcommand:$command\n"
 149                     if syst($command);
 150             }
 151
 152             my $command="mv temp$$.vqh $globalname$name.vqh";
 153             print ">>> $command\n";
 154             die "Couldn't rename latticebook.\n\tcommand:$command\n"
 155                 if syst($command);
 156
 157         }else{
 158             print "No matching training file; leaving this codebook untrained.\n";
 159         }
 160
 161         my $command="rm $globalname$name.vql";
 162         print ">>> $command\n";
 163         die "Couldn't remove temp files.\n\tcommand:$command\n"
 164             if syst($command);
 165
 166         next;
 167     }
 168 }
 169
 170 $command="rm -f temp$$.vqd";
 171 print ">>> $command\n";
 172 die "Couldn't remove temp files.\n\tcommand:$command\n"
 173     if syst($command);
 174
 175 sub syst{
 176     system(@_)/256;
 177 }