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
21use strict;
22$|=1;
23
24# set default values
25my $toast='/usr/bin/toast';
26my $sox='../sox';
27my $fmt='';
28
29my $rate=8000; # sample rates
30my $p=200;  # silence before/after tonepulse
31my $attack=400;
32my $duration=800;
33
34my ($ding,$model,$t,$rms,$lim)=("./ding","./model","sw",11585.2, 0.5);
35
36my $effect=''; # you may want to try a filter
37
38# parse commandline arguments
39while ($_ = shift @ARGV) {
40  if (m{^-[tgai]$}) {
41    $fmt=$_;
42  } else {
43    unshift @ARGV,$_;
44    last;
45  }
46}
47if ($#ARGV >= 0) {
48  $effect="@ARGV";
49}
50
51my $env="$attack:$duration:$attack"; # attack, duration, drop
52
53# output a nice header explaining the data
54print("# Testing gsm compress/decompress ");
55if ($fmt eq '-t') {
56  print("by $toast\n");
57}else{
58  print("by $sox -r$rate in.sw $fmt out.wav $effect\n");
59}
60print("#   with tone pulses from 0.01 to 0.99 percent of Nyquist\n");
61print("#   col 1 is frequency/Nyquist\n");
62print("#   col 2 is (power) dB gain\n");
63print("#   col 3 is (power) dB level of error signal\n");
64print("#\n#freq dB-gain dB-error\n");
65
66# generate the test data
67my $f;
68my %q;
69my $nyq = 1.0;
70my $l=$attack + $duration + $attack;
71for ($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}
103print("#freq dB-gain dB-error\n");
104exit 0;
105