#!/usr/bin/perl -I ../../blib/lib

# use gnuplot to show Tektronix TDS2024 trace data

use Lab::Data::Analysis;
use Getopt::Long qw(:config bundling auto_version no_ignore_case);
use Carp;
use Chart::Gnuplot;
use Data::Dumper;

sub usage {
    print "usage $0: [options] datafile\n";
    print "  options:\n";
    print "        --t0='start time' [def: earliest]\n";
    print "        --t1='end time'   [def: latest]\n";
    print "        -o --output=file  output file for non-interactive plot\n";
    print "        -f --force        force otuput file overwriting\n";
    print "        -n --nevents=N    number of events to plot [def: all]\n";
    print "        -s --start=N      first event to plot [def: 1]\n";
    print "        -r --run=N        run number [def: first in file]\n";
    print "        -c --chan=chans   channels to plot [def: all]\n";
    print "        -I --ID           include trace ID on plot title\n";
    print "        -T --Tag          tag plots with processing info\n";
    print "        -d --debug        debug printouts\n";
    print "        -v --verbose      verbose\n";
    print "        -h -? --help      print this help\n";

    print "The following are substituted when generating output filenames:\n";
    print "   %R -> run number \n";
    print "   %E -> event number\n";
    print "   %P -> plot number\n";
    print "   %D -> event date, in YYYYMMDD format\n";
    print "   %T -> event time, in HHMMDD format\n";
    print "The default 'output file format' is postscript, but other types\n";
    print "can be specified using the filetype '.gif', '.png' etc. See the\n";
    print "documentation on Chart::Gnuplot for details. \n";
    print "If more than one plot will be generated, and there are no '%x' \n";
    print "substitutions in the output file name, a '_R%RE%E' will be \n";
    print "appended to the 'base' output filename.\n";
    print "Example: -o 'myplot_R%03R_E%03E.ps'\n";
    print "           ---> myplot_R001_E001.ps \n";
    print "           ---> myplot_R001_E002.ps ...etc\n";
}

our $DEBUG   = $Lab::Generic::CLOptions::DEBUG;
our $VERSION = '3.543';
our $VERBOSE = 1;

#our $GNUPLOT = `which gnuplot`;
#croak("unable to find gnuplot") unless $GNUPLOT !~ /^\s*$/;

my $user = getlogin || getpwuid($<) || '?';
our $TAGINIT = join( ' ', $0, @ARGV, "($user @", scalar localtime, ")" );

main();

sub main {
    my $nev = 0;
    my $chans;
    my (@acqch);
    my $t0;
    my $t1;
    my $start = 1;
    my $outfile;
    my $force = 0;
    my $help  = 0;
    my $tag   = 0;
    my $run;
    my $id = 0;

    Getopt::Long::GetOptions(
        "nevents|n=i" => \$nev,
        "start|s=i"   => \$start,
        "chan|c=s"    => \$chans,
        "debug|d+"    => \$DEBUG,
        "verbose|v+"  => \$VERBOSE,
        "help|h|?"    => \$help,
        "output|o=s"  => \$outfile,
        "force|f"     => \$force,
        "ID|I"        => \$id,
        "t0=s"        => \$t0,
        "t1=s"        => \$t1,
        "run|r=i"     => \$run,
        "Tag|T"       => \$tag,
    );

    if ($help) {
        usage();
        exit(0);
    }

    my $infile = shift(@ARGV);
    croak("no input file given") unless defined $infile;
    croak("unable to find input file") unless -e $infile;

    $nev = 0 if $nev < 0;
    if ( defined($first) && $first <= 0 ) {
        carp("starting at first event (event=1)");
        $first = 1;
    }

    if ( defined($outfile) ) {

        # $nev == 1, only one file, use the given one
        if ( $nev != 1 && $outfile =~ /\.(\w+)$/i ) {

            # split into basename and filetype
            my $ftype = $1;
            my $fbase = substr(
                $outfile, 0,
                length($outfile) - length($ftype) - 1
            );
            if ( $fbase !~ /\%/ ) {
                $fbase .= '_R%RE%E';    # run/event suffix
                $outfile = $fbase . '.' . $ftype;
            }
        }
    }

    if ( defined($chans) ) {            # 'ch1,ch2'  (ch1,ch2) etc.
        $chans =~ s/^\s*(.*)\s*/$1/;
        $chans =~ s/^\"(.*)\"$/$1/;
        $chans =~ s/^\'(.*)\'$/$1/;
        $chans =~ s/^\((.*)\)$/$1/;
        if ( $chans eq '*' || uc($chans) eq 'ALL' ) {
            $chans = undef;
        }
    }

    $chans = 'CH1,CH2,CH3,CH4,MATH,REFA,REFB,REFC,REFD' unless defined $chans;
    my %reqch;
    foreach my $c ( split( /\s*[,\s]\s*/, $chans ) ) {
        if ( $c =~ /^([1-4])$/ ) {
            $c = "CH$1";
        }
        elsif ( $c =~ /^[A-D]$/i ) {
            $c = uc("REF$1");
        }
        elsif ( $c =~ /^M/i ) {
            $c = 'MATH';
        }
        if ( $c =~ /^(CH[1-4]|REF[A-D]|MATH)$/i ) {
            $reqch{$c} = 1;
        }
        else {
            carp("invalid channel $c ignored");
        }
    }

    if ( defined($t0) ) {
        $t0 =~ s/^\s*(.*)\s*$/$1/;
        $t0 =~ s/(s|sec|second|seconds)$//i;    # remove trailing unit name
        $t0 =~ s/([kmunp])$//i;    # remove trailing multiplier, keep;
        my $m = $1;
        if ( $t0 =~ /^[\-\+]?(\d+|\d+\.\d*|\.\d+)(e[\+\-]?\d+)?$/i ) {
            $t0 = $t0 + 0.;        # okay number
            if ( defined($m) ) {
                $m = lc($m);
                $t0 *= 1e3   if $m eq 'k';
                $t0 *= 1e-3  if $m eq 'm';
                $t0 *= 1e-6  if $m eq 'u';
                $t0 *= 1e-9  if $m eq 'n';
                $t0 *= 1e-12 if $m eq 'p';
            }
        }
        else {
            croak("error parsing t0 time '$t0'");
        }
    }

    if ( defined($t1) ) {
        $t1 =~ s/^\s*(.*)\s*$/$1/;
        $t1 =~ s/(s|sec|second|seconds)$//i;    # remove trailing unit name
        $t1 =~ s/([kmunp])$//i;    # remove trailing multiplier, keep;
        my $m = $1;
        if ( $t1 =~ /^[\-\+]?(\d+|\d+\.\d*|\.\d+)(e[\+\-]?\d+)?$/i ) {
            $t1 = $t1 + 0.;        # okay number
            if ( defined($m) ) {
                $m = lc($m);
                $t1 *= 1e3   if $m eq 'k';
                $t1 *= 1e-3  if $m eq 'm';
                $t1 *= 1e-6  if $m eq 'u';
                $t1 *= 1e-9  if $m eq 'n';
                $t1 *= 1e-12 if $m eq 'p';
            }
        }
        else {
            croak("error parsing t1 time '$t1'");
        }
    }

    # all parameters parsed, ready to go
    my $page = 1;

    my $datf = Lab::Data::Analysis->new($infile);
    croak("error initializing analysis input") unless defined $datf;
    my $fhdr = $datf->ReadFileHeader();

    $datf->ConnectAnalyzer( module => 'Lab::Data::Analysis::TekTDS' );

    if ( $start > 1 || defined($run) ) {
        my $p;
        if ( defined($run) ) {
            $p = $datf->FindEvent( run => $run, event => $start );
            croak("run $run event $start not found") unless defined $p;
        }
        else {
            $p = $datf->FindEvent( event => $start );
            croak("event $start not found") unless defined $p;
        }
    }

    my $dirty = 0;
    my $anopts = { dropraw => 1, interpolate => 0, };
    while ( $nev >= 0 ) {
        my $ev = $datf->ReadEvent();
        last unless defined $ev;
        my $r     = $ev->{RUN};
        my $e     = $ev->{EVENT};
        my $title = "$infile TekTDS R${r}EV${e}";
        $ev = $datf->Analyze( event => $ev, options => $anopts );
        carp("error analyzing run $r event $e") unless defined $ev;

        # use a $ev->{ANALYZED}->{TekTDS}->{STREAMS} = [] list?

        my (@plotchan) = ();
        foreach my $s ( keys( %{ $ev->{ANALYZE} } ) ) {
            next unless exists $ev->{ANALYZE}->{$s}->{TekTDS};
            my $a = $ev->{ANALYZE}->{$s}->{TekTDS};
            foreach my $c ( keys( %{ $a->{CHAN} } ) ) {
                push( @plotchan, "$s.$c" ) if exists $reqch{$c};
            }
        }
        if ( $#plotchan < 0 ) {
            carp("no selected channels in run $r event $e, skipping");
            last if $nev == 1;
            $nev--;
            next;
        }

        PlotEvent(
            event => $ev,
            file  => $outfile,
            title => $title,
            chans => [@plotchan],
            dirty => $dirty,
            page  => $page++,
            id    => $id,
            tag   => $tag,
            force => $force,
            t0    => $t0,
            t1    => $t1,
        );
        $dirty = 1;
        last   if $nev == 1;
        $nev-- if $nev > 1;
    }
}

sub PlotEvent {
    my $opt   = {@_};
    my $ev    = $opt->{event};
    my $file  = $opt->{file};
    my $chans = $opt->{chans};
    my $dirty = $opt->{dirty};
    my $nplot = $#{$chans} + 1;
    my $title = $opt->{title};
    my $force = $opt->{force};
    my $page  = $opt->{page};
    my $id    = $opt->{id};
    my $tag   = $opt->{tag};

    my $rgb = {
        CH1  => 'yellow',
        CH2  => 'blue',
        CH3  => 'magenta',
        CH4  => 'green',
        MATH => 'red',
        REFA => 'white',
        REFB => 'white',
        REFC => 'white',
        REFD => 'white',
    };

    $file = fixfilename( $file, $ev, $page, $force );
    if ( !defined($file) ) {
        carp("skipping plot generation");
        return;
    }

    my $chart = Chart::Gnuplot->new(
        output => $file,
        title  => $title,
    );

    my (@charts) = ();
    my $jchart = 0;

    foreach my $sch ( sort( @{$chans} ) ) {
        my $dsopt = {};
        my $plopt = {};

        my ( $str, $ch ) = split( /\./, $sch );
        my $a = $ev->{ANALYZE}->{$str}->{TekTDS}->{CHAN}->{$ch};
        my ( $x0, $x1 ) = ( $a->{XMIN}, $a->{XMAX} );
        $x0 = $opt->{t0} if exists( $opt->{t0} ) && defined( $opt->{t0} );
        $x1 = $opt->{t1} if exists( $opt->{t1} ) && defined( $opt->{t1} );

        my $dx = $x1 - $x0;
        $dx = 1e-9 if $dx < 1e-9;

        my $mx = 1;
        my $xu = 's';

        if ( $dx < 100e-9 ) {
            $mx = 1e9;
            $xu = 'ns';
        }
        elsif ( $dx < 100e-6 ) {
            $mx = 1e6;
            $xu = '{/Symbol m}s';
        }
        elsif ( $dx < 100e-3 ) {
            $mx = 1e3;
            $xu = 'ms';
        }
        elsif ( $dx > 100 ) {
            $mx = 1e-3;
            $xu = 'ks';
        }
        my $xof;
        if ( abs( $x0 * $mx ) > 100 * $mx ) {
            $xof = $x0 - 0.1 * $dx;
        }
        my $xof0 = 0;
        $xof0 = $xof if defined $xof;

        $plopt->{xlabel} = "Time";
        $plopt->{xlabel} .= "+(", $xof0 * $mx, ")" if defined($xof);
        $plopt->{xlabel} .= " [$xu]";

        my $y0 = $a->{YMIN};
        my $y1 = $a->{YMAX};
        my $dy = $y1 - $y0;
        $dy = 1e-6 if $dy < 1e-6;
        my $my = 1;
        my $yu = 'V';
        if ( $dy < 100e-6 ) {
            $my = 1e6;
            $yu = '{/Symbol m}V';
        }
        elsif ( $dy < 100e-3 ) {
            $my = 1e3;
            $yu = 'mV';
        }
        elsif ( $dy > 100 ) {
            $my = 1e-3;
            $yu = 'kV';
        }
        my $yof;
        my $yof0 = 0;
        if ( abs( $y0 * $my ) > 100 * $my ) {
            $yof = $y0 - 0.1 * $dy;
        }
        $yof0 = $yof if defined $yof;
        $plopt->{ylabel} = "Amplitude";
        $plopt->{ylabel} .= "+(", $yof0 * $mx, ")" if defined($yof);
        $plopt->{ylabel} .= " [$yu]";

        $plopt->{title} = $a->{ID} if $id;
        $plopt->{legend} = {
            title  => "Stream${str}:${ch}",
            sample => {
                length => 0,
            }
        };

        $dsopt->{style} = 'lines';

        my $color = $rgb->{$ch};
        $color = 'white' unless defined $color;
        $dsopt->{color} = $color;

        my ( @x, @y );

        for ( my $j = $a->{START}; $j <= $a->{STOP}; $j++ ) {
            my $x = $a->{X}->[$j];
            next if $x < $x0;
            last if $x > $x1;

            $x = ( $x - $xof0 ) * $mx;
            push( @x, $x );
            my $y = $a->{Y}->[$j];
            $y = ( $y - $yof0 ) * $my;
            push( @y, $y );
        }
        $dsopt->{xdata} = \@x;
        $dsopt->{ydata} = \@y;

        $charts[$jchart][0] = Chart::Gnuplot->new( %{$plopt} );
        my $ds = Chart::Gnuplot::DataSet->new( %{$dsopt} );
        $charts[$jchart][0]->add2d($ds);

        if ( $tag && $jchart == 0 ) {
            $charts[$jchart][0]->label(
                text      => $TAGINIT,
                position  => "character 1, character 0.5",
                font      => 'Ariel,7',
                fontcolor => 'black',
                layer     => 'front',
            );
        }

        $jchart++;
    }

    $chart->multiplot( \@charts );
}

# make some space at bottom of page for TAG string

sub Chart::Gnuplot::_setMultiplot {
    my ( $self, $nrows, $ncols ) = @_;

    open( PLT, ">>$self->{_script}" )
        || confess("Can't write $self->{_script}");
    print PLT "set multiplot";
    print PLT " title \"$self->{title}\"" if ( defined $self->{title} );
    print PLT " layout $nrows, $ncols" if ( defined $nrows );
    print PLT " scale 0.9 offset 0,0.01 \n";
    print PLT "\n";
    close(PLT);
}

#
# do substitutions to get actual output filename, and check
# if can/should be written.
#

sub fixfilename {
    my $infile = shift;
    my $ev     = shift;    # event
    my $page   = shift;
    my $force  = shift;

    while ( $infile =~ /\%/ ) {    # need to do substitutions multiple times?
        if ( $infile =~ /^(.*)(\%\d*R)(.*)$/ ) {
            my $pre  = $1;
            my $post = $3;
            my $r    = $2;
            my $d    = substr( $r, 1, length($r) - 2 );
            $r = sprintf( "%${d}d", $ev->{RUN} );
            $infile = $pre . $r . $post;
        }
        elsif ( $infile =~ /^(.*)(\%\d*E)(.*)$/ ) {
            my $pre  = $1;
            my $post = $3;
            my $r    = $2;
            my $d    = substr( $r, 1, length($r) - 2 );
            $r = sprintf( "%${d}d", $ev->{EVENT} );
            $infile = $pre . $r . $post;
        }
        elsif ( $infile =~ /^(.*)(\%\d*P)(.*)$/ ) {
            my $pre  = $1;
            my $post = $3;
            my $r    = $2;
            my $d    = substr( $r, 1, length($r) - 2 );
            $r = sprintf( "%${d}d", $page );
            $infile = $pre . $r . $post;
        }
        elsif ( $infile =~ /^(.*)(\%\d*T)(.*)$/ ) {
            my $pre  = $1;
            my $post = $3;
            my $r    = $2;
            my $d    = substr( $r, 1, length($r) - 2 );
            my ( $s, $m, $h ) = localtime( $ev->{TIME} );
            $r = sprintf( '%02d%02d%02d', $h, $m, $s );
            $infile = $pre . $r . $post;
        }
        elsif ( $infile =~ /^(.*)(\%\d*D)(.*)$/ ) {
            my $pre  = $1;
            my $post = $3;
            my $r    = $2;
            my $d    = substr( $r, 1, length($r) - 2 );
            my ( $s, $m, $h, $md, $mo, $y ) = localtime( $ev->{TIME} );
            $r = sprintf( '%04d%02d%02d', $y + 1900, $mo + 1, $md );
            $infile = $pre . $r . $post;
        }
        else {
            carp("unknown \% string in filename: '$infile'");
            last;
        }
    }
    if ( -e $infile ) {
        if ( -w $infile ) {
            if ( !$force ) {
                carp("output file $infile exists, use --force to overwrite");
                return undef;
            }
        }
        else {
            carp("output file $infile exists, but is not writable");
            return undef;
        }
    }
    else {
        # doesn't exist, test if we can write to file
        if ( open( TST, ">$infile" ) ) {
            close(TST);
            return $infile;
        }
        carp("output file $infile does not exist, not writable");
        return undef;
    }
    return $infile;
}
