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

# use Topdrawer to show trace data

use Lab::Data::Analysis;
use Getopt::Long qw(:config bundling auto_version no_ignore_case);
use Carp;
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 "The default 'output file format' is .td\n";
}

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

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) ) {
        if ( $outfile !~ /(\.\w+)$/i ) {
            $outfile .= '.td';
        }
    }
    else {
        $outfile = 'TDplot_WR640.td';
    }

    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 = 'C1,C2,C3,C4' unless defined $chans;
    my %reqch;
    foreach my $c ( split( /\s*[,\s]\s*/, $chans ) ) {
        if ( $c =~ /^([1-4])$/ ) {
            $c = "C$1";
        }
        if ( $c =~ /^(C[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->ReadRunHeader();

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

    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, print_summary => 0 };
    while ( $nev >= 0 ) {
        my $ev = $datf->ReadEvent();
        last unless defined $ev;
        my $r     = $ev->{RUN};
        my $e     = $ev->{EVENT};
        my $title = "$infile WaveRunner R${r}E${e}";
        $ev = $datf->Analyze( event => $ev, options => $anopts );
        carp("error analyzing run $r event $e") unless defined $ev;

        my (@plotchan) = ();
        foreach my $s ( keys( %{ $ev->{ANALYZE} } ) ) {
            next unless exists $ev->{ANALYZE}->{$s}->{WaveRunner};
            my $a = $ev->{ANALYZE}->{$s}->{WaveRunner};
            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;
        }

        TDPlotEvent(
            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;
    }
}

our $TD = undef;

sub TDPlotEvent {
    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 = {
        C1 => 'red',
        C2 => 'blue',
        C3 => 'magenta',
        C4 => 'green',
    };

    if ( !defined($TD) ) {
        if ( -e $file && !$force ) {
            die("output file $file exists, use --force to overwrite");
        }
        else {
            open( $TD, ">$file" ) || die("unable to open $file for writing");
        }
        print $TD "set font duplex\n";
    }
    else {
        print $TD "new frame\n";
    }
    print $TD "title top '$title'\n";
    if ($tag) {
        print $TD "title 0.5 0.5 size 1.1 '$TAGINIT p$page'\n";
    }

    my $jchart = 0;

    foreach my $sch ( sort( @{$chans} ) ) {

        print $TD "set window x 1 of 1 y ", $jchart + 1, " of ",
            $#{$chans} + 1, "\n";

        my ( $str, $ch ) = split( /\./, $sch );
        my $a = $ev->{ANALYZE}->{$str}->{WaveRunner}->{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 = 'Ms';
        }
        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;

        my $xlabel = "Time";
        $xlabel .= "+(" . $xof0 * $mx . ")" if defined($xof);
        $xlabel .= " [$xu]";

        my (@xparts) = split( /[\[\]]/, $xlabel );
        $xparts[0] =~ s/./ /g;
        $xparts[2] =~ s/./ /g;

        if ( $xparts[1] eq 'Ms' ) {
            $xparts[1] = 'G ';
        }
        else {
            $xparts[1] =~ s/./ /g;
        }
        my $xcase = join( ' ', @xparts );

        print $TD "title bottom '$xlabel'\n";
        print $TD "case         '$xcase'\n";

        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 = 'MV';
        }
        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;
        $ylabel = "Amplitude";
        $ylabel .= "+(" . $yof0 * $my . ")" if defined($yof);
        $ylabel .= " [$yu]";

        my (@yparts) = split( /[\[\]]/, $ylabel );
        $yparts[0] =~ s/./ /g;
        $yparts[2] =~ s/./ /g;
        if ( $yparts[1] eq 'MV' ) {
            $yparts[1] = 'G ';
        }
        else {
            $yparts[1] =~ s/./ /g;
        }
        my $ycase = join( ' ', @yparts );
        print $TD "title left '$ylabel'\n";
        print $TD "case       '$ycase'\n";
        print $TD "title top size 1.2 lines=-2 '", $a->{ID}, "'\n" if $id;

        print $TD "set order x y\n";

        printf $TD "%g %g\n", $x0 * $mx, $y1 * $my;
        printf $TD "%g %g\n", $x1 * $mx, $y0 * $my;
        print $TD "plot nosymbol size=0.01\n";    # autoscale axes, etc

        #	printf $TD "set limits x from %g to %g\n",$x0*$mx,$x1*$mx;
        #	printf $TD "set limits y from %g to %g\n",$y0*$my,$y1*$my;

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

        my $npts = 0;
        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;

            my $y = $a->{Y}->[$j];
            $y = ( $y - $yof0 ) * $my;
            printf $TD "%g\t%g\n", $x, $y;
            $npts++;
            if ( $npts > 1000 ) {
                print $TD "join $color\n";
                $npts = 0;
            }
        }
        if ( $npts > 0 ) {
            print $TD "join $color\n";
        }

        $jchart++;
    }

}

#
# 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;
}
