1#!/usr/bin/perl -w
2
3# ltest.pl -- program to help generate response/error graphs for DSP 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 $sox='../src/sox';
26my $effect='rate';
27#my $effect='rate -q';
28#my $effect='rate -l';
29#my $effect='rate -h -M';
30#my $effect='rate -h -b 90';
31#my $effect='sinc 400-2000';
32#my $effect='sinc -n 1024 400-2000';
33
34#my ($rate0,$rate1)=(44100,44100); # sample rates
35my ($rate0,$rate1)=(8000,22050); # sample rates
36my $p=400;  # silence before/after tonepulse
37my $attack=4000;
38my $duration=16000;
39
40#my ($rate0,$rate1)=(22050,8000); # sample rates
41#my $p=1102;  # silence before/after tonepulse
42#my $attack=11025;
43#my $duration=44100;
44
45# parse commandline arguments
46my $updown = 0; # set to 1 for up/down rate-conversion test
47my ($model,$t,$rms,$lim)=("./model","sw",11585.2, 0.5);
48while ($_ = shift @ARGV) {
49  if ($_ eq "-l") {
50    ($model,$t,$rms,$lim)=("./lmodel","sl",759250125.0, 50.0);
51  } elsif ($_ eq "-ud") {
52    $updown=1;
53  } else {
54    unshift @ARGV,$_;
55    last;
56  }
57}
58if ($#ARGV >= 0) {
59  $effect="@ARGV";
60}
61
62my $ratechange=0;
63if ($effect =~ m{^(rate|upsample|downsample|speed)}) {
64  $ratechange=1;
65}
66
67# output a nice header explaining the data
68if ($ratechange==0) {
69  print("# Testing $sox -c1 -r$rate0 i0.xx.$t j0.xx.$t $effect\n");
70} else {
71  print("# Testing $sox -c1 -r$rate0 i*.$t -r$rate1 u*.$t $effect\n");
72  if ($updown==1) {
73    print("#   then back down to $rate0\n");
74  }
75}
76print("#   with tone pulses from 0.01 to 0.99 percent of Nyquist\n");
77
78# generate the test data
79my $f;
80my %q;
81my $nyq = ($rate0<=$rate1)? 1.0:($rate1/$rate0);
82my $l=$attack + $duration + $attack;
83my $env="$attack:$duration:$attack"; # attack, duration, drop
84for ($f=0.01; $f<.999; $f+=0.01) {
85  my @mod;
86
87  my $s=sprintf("%4.2f",$f);
88  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};
89  if ($ratechange==0) {
90    qx{$sox -c1 -r$rate0 i$s.$t -r$rate0 o$s.$t $effect} ;
91    @mod = grep {/v2max/} qx{$model -f$s -e$env $rate0 o$s.$t 2>&1};
92  } else {
93    qx{$sox -c1 -r$rate0 i$s.$t -r$rate1 u$s.$t $effect 2>/dev/null};
94    if ($updown) {
95      qx{$sox -c1 -r$rate1 u$s.$t -r$rate0 o$s.$t $effect 2>/dev/null};
96      @mod = grep {/v2max/} qx{$model -f$s -e$env $rate0:$rate0 o$s.$t 2>&1};
97    }else{
98      @mod = grep {/v2max/} qx{$model -f$s -e$env $rate0:$rate1 u$s.$t 2>&1};
99    }
100  }
101  print STDERR "$s: ",@mod;
102  $_=shift(@mod);
103  if (m{s2max *([0-9.]+), *v2max *([0-9.]+), *rmserr *(-?[0-9.]+)}) {
104    #print("$s $1\n");
105    #print("$s $1 $3\n");
106    my $v = ($1 > $lim)? $1 : $lim;
107    my $r = ($3 > $lim)? $3 : $lim;
108    my $dbv = 20*log($v/$rms)/log(10);
109    my $dbr = 20*log($r/$rms)/log(10);
110    printf("%s %.3f %.3f\n",$s,$dbv,$dbr);
111  }
112  unlink "i$s.$t","u$s.$t","o$s.$t";
113}
114
115exit 0;
116