test/wtest.pl

   1 #!/usr/bin/perl -w
   2
   3 # wtest.pl -- program to help generate response/error graphs for adpcm/gsm code.
   4 #
   5 # Copyright (C) 1999 Stanley J. Brooks <stabro@megsinet.net>
   6 #
   7 # This program is free software; you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 2 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # This program is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program; if not, write to the Free Software
  19 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
  20
  21 use strict;
  22 $|=1;
  23
  24 # set default values
  25 my $toast='/usr/bin/toast';
  26 my $sox='../sox';
  27 my $fmt='';
  28
  29 my $rate=8000; # sample rates
  30 my $p=200;  # silence before/after tonepulse
  31 my $attack=400;
  32 my $duration=800;
  33
  34 my ($ding,$model,$t,$rms,$lim)=("./ding","./model","sw",11585.2, 0.5);
  35
  36 my $effect=''; # you may want to try a filter
  37
  38 # parse commandline arguments
  39 while ($_ = shift @ARGV) {
  40   if (m{^-[tgai]$}) {
  41     $fmt=$_;
  42   } else {
  43     unshift @ARGV,$_;
  44     last;
  45   }
  46 }
  47 if ($#ARGV >= 0) {
  48   $effect="@ARGV";
  49 }
  50
  51 my $env="$attack:$duration:$attack"; # attack, duration, drop
  52
  53 # output a nice header explaining the data
  54 print("# Testing gsm compress/decompress ");
  55 if ($fmt eq '-t') {
  56   print("by $toast\n");
  57 }else{
  58   print("by $sox -r$rate in.sw $fmt out.wav $effect\n");
  59 }
  60 print("#   with tone pulses from 0.01 to 0.99 percent of Nyquist\n");
  61 print("#   col 1 is frequency/Nyquist\n");
  62 print("#   col 2 is (power) dB gain\n");
  63 print("#   col 3 is (power) dB level of error signal\n");
  64 print("#\n#freq dB-gain dB-error\n");
  65
  66 # generate the test data
  67 my $f;
  68 my %q;
  69 my $nyq = 1.0;
  70 my $l=$attack + $duration + $attack;
  71 for ($f=0.01; $f<0.999; $f+=0.01) {
  72   my @mod;
  73
  74   my $s=sprintf("%4.2f",$f);
  75   qx{$sox -2r2 -n i$s.$t synth ${l}s sin $s vol .5 fade h ${attack}s ${l}s ${attack}s pad ${p}s ${p}s};
  76
  77   if ($fmt eq '-t') {
  78     qx{$toast -l i$s.$t};
  79     qx{$toast -dl i$s.$t.gsm};
  80   }else{
  81     qx{cp i$s.$t a$s.$t 2>/dev/null};
  82     qx{$sox -r$rate i$s.$t -g g$s.wav $effect 2>/dev/null};
  83     unlink "i$s.$t";
  84     qx{$sox g$s.wav i$s.$t 2>/dev/null};
  85     qx{cp i$s.$t b$s.$t 2>/dev/null};
  86     unlink "g$s.wav";
  87   }
  88
  89   @mod = grep {/v2max/} qx{$model -f$s -e$env $rate i$s.$t 2>&1};
  90   print STDERR "$s: ",@mod;
  91   $_=shift(@mod);
  92   if (m{s2max *([0-9.]+), *v2max *([0-9.]+), *rmserr *(-?[0-9.]+)}) {
  93     #print("$s $1\n");
  94     #print("$s $1 $3\n");
  95     my $v = ($1 > $lim)? $1 : $lim;
  96     my $r = ($3 > $lim)? $3 : $lim;
  97     my $dbv = 20*log($v/$rms)/log(10);
  98     my $dbr = 20*log($r/$rms)/log(10);
  99     printf("%s %.3f %.3f\n",$s,$dbv,$dbr);
 100   }
 101   unlink "i$s.$t";
 102 }
 103 print("#freq dB-gain dB-error\n");
 104 exit 0;