VirtualBox

source: vbox/trunk/src/libs/libvorbis-1.3.7/vq/make_residue_books.pl@ 103131

Last change on this file since 103131 was 96468, checked in by vboxsync, 2 years ago

libs/libvorbis-1.3.7: Re-exporting, hopefully this time everything is there. bugref:10275

File size: 4.2 KB
Line 
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
18die "Could not open $ARGV[0]: $!" unless open (F,$ARGV[0]);
19
20$goflag=0;
21while($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";
171print ">>> $command\n";
172die "Couldn't remove temp files.\n\tcommand:$command\n"
173 if syst($command);
174
175sub syst{
176 system(@_)/256;
177}
Note: See TracBrowser for help on using the repository browser.

© 2024 Oracle Support Privacy / Do Not Sell My Info Terms of Use Trademark Policy Automated Access Etiquette