#!/usr/bin/perl

# Here we go again...GPLv2 will do C 2017 Doug Coulter
# Largely a copy of plotdat - this is a 4d dynamic plot program using gnuplot
# axes mapping is eval'd perl code in edit boxes, which can be saved as presets
# in a file called .plotDpresets in same dir as program, glade file is plotFsr.glade
#
# as usual, if I thought it dodgy, I used @@@ in a nearby comment

use Modern::Perl '2014'; # we only have 5.18 on this machine?
use File::Basename 'dirname'; # for knowing where we are (ease for developer)
use Gtk3 -init; # for our GUI
use Glib  qw(TRUE FALSE); # for periodic events etc
#use Gtk3::Helper; # allows us to add "watch" callbacks to handles?
#http://askubuntu.com/questions/319568/i-cant-configure-rhythmbox-as-gobject-introspection-1-is-not-installed for when you can't install gtk3 or glib
use Storable qw(nstore retrieve); # for (re) storing hash of hashes preset
use DBI; # for mySQL interface

################ globals, because #################################
my $DBUser = "Ops";
my $DBPass = "data";
#GUI stuff (reference,content)
my $mainwin;
my $builder = Gtk3::Builder->new(); # gtkbuilder object, creates a gui from glade's xml

my ($dsnr,$DSN); # Data Source Name (ref,value)
my ($runnumr,$runsel); #runno combo

my ($precr,$prec); # pre loop code
my ($xeqr,$xcode); # "x = code" gui reference, and content
my ($yeqr,$ycode); # "y = code" gui reference, and content
my ($zeqr,$zcode); # "z = code" gui reference, and content
my ($ceqr,$ccode); # "c = code" gui reference, and content
my ($postcr,$postc); # post loop code
my ($xlabr,$xlabel); # label widget ref and content
my ($ylabr,$ylabel); # label widget ref and content
my ($zlabr,$zlabel); # label widget ref and content
my ($clabr,$clabel); # label widget ref and content
my ($lxr,$lx); # log axis setting
my ($lyr,$ly); # log axis setting
my ($lzr,$lz); # log axis setting
my ($csr,$csi,$cstxt); #color space ref, index, text
my ($pollr,$continuous);  # once or many times?
my ($prer,$pretxt); # preset widget, text 
my $ssbutr; # start/stop button for changing the label on it
my ($statr); #status bar

my $dbh; # database handle to plot from
my %presets; # ram version of presets file
my $prepath; # path of that file

my $ploth; # gnuplot handle
my $running; # set to keep poll going

my (@umS,@uMkV,@uMmA,@umB,@uIkV,@uImA,@uHCpM,@uGCpM);  # data from uno data aq in DB
my (@x,@y,@z,@c); # arrays to be plotted
my $acalfactor = 4.955/4096; # volts/count of this particular arduino uno
####################################################################
sub cleararrays { #clear out database raw and computed arrays and so on - make clean
 @x = @y = @z = @c = ();
 @umS = @uMkV = @uMmA = @umB = @uIkV = @uImA = @uHCpM = @uGCpM = ();
# $faketimeu = 100; #mS
}
####################################################################
sub getGUIrefs {	# get widget refs, map from gui id's to references
	$dsnr = $builder->get_object('DSN');
	$runnumr = $builder->get_object('runnum');
	$precr = $builder->get_object('prec');
	$xeqr = $builder->get_object('xeq'); # perl "equations"
	$yeqr = $builder->get_object('yeq');
	$zeqr = $builder->get_object('zeq');
	$ceqr = $builder->get_object('ceq');
	$postcr = $builder->get_object('postc');
	$xlabr = $builder->get_object('XLabel'); # plot axis labels
	$ylabr = $builder->get_object('YLabel');
	$zlabr = $builder->get_object('ZLabel');
	$clabr = $builder->get_object('CLabel');
	$lxr = $builder->get_object('logx'); # log axis requests
	$lyr = $builder->get_object('logy'); 
	$lzr = $builder->get_object('logz'); 
	$csr = $builder->get_object('colorcombo'); # color space combo
	$pollr = $builder->get_object('poll');
	$prer = $builder->get_object('preset'); # preset name combo
	$ssbutr = $builder->get_object('gostop');
	$statr = $builder->get_object('statusbar'); # status bar object
}
####################################################################
sub GUI2var  { # move gui data to variables
	$DSN = $dsnr->get_active_text ();
	$runsel = $runnumr->get_active_text(); # find out what run we selected
	$prec = $precr->get_text();
	$xcode = $xeqr->get_text(); # code for mapping
	$ycode = $yeqr->get_text();
	$zcode = $zeqr->get_text();
	$ccode = $ceqr->get_text();
	$postc = $postcr->get_text();
	$xlabel = $xlabr->get_text(); # axis label text
	$ylabel = $ylabr->get_text();
	$zlabel = $zlabr->get_text();
	$clabel = $clabr->get_text();
	$lx = $lxr->get_active(); # axis log(arithm) request
	$ly = $lyr->get_active(); 
	$lz = $lzr->get_active(); 
	$cstxt = $csr->get_active_text(); # test of color space combo
	$csi = $csr->get_active(); # index of same
	$continuous = $pollr->get_active();
	$pretxt = $prer->get_active_text(); # which preset is selected
}
####################################################################
sub var2GUI    {   # move my variables to GUI
	$precr->set_text($prec);
	$xeqr->set_text($xcode); # code for axis mapping
	$yeqr->set_text($ycode);
	$zeqr->set_text($zcode);
	$ceqr->set_text($ccode);
	$postcr->set_text($postc);
    $xlabr->set_text($xlabel); # axis label text
    $ylabr->set_text($ylabel);
    $zlabr->set_text($zlabel);
    $clabr->set_text($clabel);
    $lxr->set_active($lx); # checkboxes to request log axis
    $lyr->set_active($ly);
    $lzr->set_active($lz);
    $pollr->set_active($continuous);
	$csr->set_active($csi); # color map index
}
####################################################################
sub createguifile # create the gui from xml in a .glade file 
{ # use this for developer convienience.  Final product should put glade xml
  # after the __END__ tag and use createguilocal instead
 $builder->add_from_file(dirname($0) . '/plotFsr.glade'); #@@@ hardcoded filename
 $mainwin = $builder->get_object('mainwin'); #@@@ assumes main window is called mainwin
 $builder->connect_signals(undef);
 $mainwin->set_screen( $mainwin->get_screen() ); #??? from an example.  Seems redundant?
 $mainwin->signal_connect(destroy => sub {Gtk3->main_quit});
 $mainwin->show_all();
# not so program-specific you couldn't use it again
}
####################################################################

#################### debug routine
sub printpresets()
{ #@@@ gnarly dereferencing syntax in this
 my $href; # reference to a particular preset hash in the presets hash of hashes
 my ($okey,$ikey);
 foreach $okey (sort keys %presets)
 {
  print "\n\nPreset Name: $okey\n\n";
  $href = $presets{$okey};
  
  foreach $ikey (sort keys %$href )
  {
   print "key:$ikey, value:$$href{$ikey}\n";
  }
  print "\n\n";
 }
}
####################

####################################################################
sub init_pre_combo
{
 if (-e $prepath)   # ok, file exists, read it into hash-of-hashes
 { # fetch preset data and populate the combo
  %presets = %{ retrieve($prepath) }; # cool rebuild from file
  $prer->get_model->clear(); # seems to work # remove any existing junk
  # now fill combobox
  foreach (sort keys %presets) { $prer->append_text($_); } # put into combo box list
  $prer->set_active(0); # select something, creates event
 } else
 {
  $prer->append_text("no presets file at:$prepath");
  $prer->set_active(0); # show the status
 }
}
####################################################################
sub initialize() # start the ball rolling
{
 createguifile(); # create gui from glade file in same dir as progra
 getGUIrefs(); # get references to the gui elements
 $prepath = dirname($0) . '/.plotFsrpre'; # where we expect a presets file
 init_pre_combo(); # routine re-used for preset updates
 $ploth = create_plot_handle();  # create a gnuplot instance


# initwidgets(); # some need a database connection for info
}

####################################################################
sub on_save_preset_clicked {
my $hashref; #create anon hash to save

#say "save preset clicked"; # debug
GUI2var(); # get the info from the GUI
$hashref = {
  name => $pretxt,
  precode => $prec,
  xcode => $xcode,ycode => $ycode,zcode => $zcode,ccode => $ccode,
  postcode => $postc,
  xlabel => $xlabel,ylabel => $ylabel,zlabel => $zlabel,clabel => $clabel,
  lx => $lx,ly => $ly, lz => $lz,
  csi => $csi
 }; # end hashref build
 $presets{$pretxt} = $hashref;
 nstore (\%presets,$prepath);
 init_pre_combo(); # re-init combo box
# printpresets(); # debug

}
####################################################################
sub on_delete_preset_clicked {
# say "delete preset clicked"; # debug
 GUI2var();  # just update the world
 delete ($presets{$pretxt}); # do the deed
 nstore (\%presets,$prepath); # store to disk
 init_pre_combo();  # refresh display
# printpresets(); # debug
}

####################################################################
sub on_preset_changed {
 my$index;
 my $href; # ref to the particular hash in the presets hash of hashes
 my $name;

 $index = $prer->get_active();
 if (-1 < $index) # see if it's a selection change
 { # it is a real change, so put preset into vars and put those into gui
  $name = $prer->get_active_text(); # What's selected?
#  say "preset really changed, now:$name"; # debug
  $href = $presets{$name}; # get ref to selected preset
  # get preset data into variables, names without sigil are from glade UI
  $prec = $href->{precode};
  $xcode = $href->{xcode};
  $ycode = $href->{ycode};
  $zcode = $href->{zcode};
  $ccode = $href->{ccode};
  $postc = $href->{postcode};
  $xlabel = $href->{xlabel};
  $ylabel = $href->{ylabel};
  $zlabel = $href->{zlabel};
  $clabel = $href->{clabel};
  $lx = $href->{lx};
  $ly = $href->{ly};
  $lz = $href->{lz};
  $csi = $href->{csi};
  var2GUI(); # push to display
 } # else it's just typing in the box, ignore till done
}
####################################################################
sub fillrunbox()
{
 my $txt;
 my $ar = $dbh->selectcol_arrayref('SELECT runno FROM runs WHERE 1;');
# $ary_ref = $dbh->selectcol_arrayref($statement);
 my $runnumindex = -1; # correct value for "nothing in box"
 $runnumr->remove_all();  # clear out any existing..
 
 foreach $txt (@{$ar})
 {
  $runnumr->append_text($txt);
  $runsel = $txt; # when we're done, this will be the last one
  $runnumindex++;
#  say "content of runs was:$txt at index:$runnumindex";
 }
  $runnumr->set_active($runnumindex); # 
#clear arrays since we're doing different data and they all think they start at zero time
 cleararrays();
}
####################################################################
sub on_runnum_changed
{	#@@@ maybe just do this at getGUIdata time only
 $runsel = $runnumr->get_active_text(); # find out what run we selected
 say "new runnum:$runsel";
}
####################################################################
sub on_connect_clicked()
{

#	say "connect clicked";
	GUI2var(); # get it all, why not?
	if ($dbh) {$dbh->disconnect;} # close any old connection
    $dbh = DBI->connect($DSN,$DBUser,$DBPass) or die "couldn't connect to $DSN:$!\n"; 
    fillrunbox(); # get runs from database, update selected run#	
    $ssbutr->set_label("Start"); # we could start now
}
####################################################################
sub create_plot_handle {
  my $plothandle;
  open ($plothandle, '|- ', "gnuplot 2> /tmp/gnuploterr") # plot_gerr_log.txt or /dev/null
                or die "\n$0 : failed to open pipe to \"gnuplot\" : $!\n";
  $plothandle->autoflush(1); # duh, required!
  gnuplot_cmd($plothandle,"set term X11 background rgb \"white\" ");
  return $plothandle;
 }
####################################################################
sub gnuplot_cmd {  #swiped from gnuplotif and modified
    my $gplot = shift; # gplot filehandle to send command to
    my  (@commands)  = @_; # slurp the rest
    @commands = map {$_."\n"} @commands;
    print $gplot @commands
        or die "Couldn't write to pipe: $!";
 #       print "gnuplot:@commands"; # debug

} # ----------  end of subroutine gnuplot_cmd  ----------
####################################################################
sub getu() # get data from uno main data aq
{
 my $ms = defined($umS[-1] ) ? $umS[-1] : 0; # force numeric even if undef first time
 my $stmt = "SELECT ms,a0,a1,a2,a3,a4,a5,c0,c1 FROM uno WHERE runno = $runsel AND ms > $ms;";
 my $ar = $dbh->selectall_arrayref($stmt); #selectall_array doesn't exist anymore?  Gacky ugly.
 
 # @@@ @@@ hardcoded conversion factors...bad
 
 foreach my $rowr (@{$ar}) # each row of values as array ref
 { # later, we will add conversions to real units from a schema lookup that contains perl we can eval
 # say "uno_row: @{$rowr}";
  push @umS, @{$rowr}[0]; # milliseconds for now  
  push @uMkV,@{$rowr}[1] * .016; # main volts (for 10kv factor is .0163)  net is kV
  push @uMmA,@{$rowr}[2] * 0.0128865979381; # main ma
  push @umB,10**((1.667* @{$rowr}[3] *$acalfactor*2.013)-11.33) ; # pressure in mbar
  push @uIkV,@{$rowr}[4]  * 0.0119501691787; # ion volts
  push @uImA,@{$rowr}[5] *  0.00273618998224; # 0.00645327826536 ; # ion current
  push @uHCpM,@{$rowr}[7] * 600; # hornyak cpm
  push @uGCpM,@{$rowr}[8] * 600; # geiger cpm
 }
}
####################################################################
sub map_plot { # use code from the gui to map raw data onto plot arrays


 my ($i, $e);
 my ($looptop,$nextc,$loopend);
 my $evalstring;
 my ($v1,$v2,$v3,$v4,$v5); # for user intermediates
 
 $looptop = 'for $i (0..$#umS) {	
 $e=0;';
 $nextc = 'if ($e) {$x[$i] = $y[$i] = $z[$i] = $c[$i] = 0.01, next; }
 ';
 $loopend = 'if ($e) {
 pop @x,pop @y,pop @z, pop @c;}
  }';

 $evalstring = $looptop . "\n " . $prec . "\n " . $nextc . "\n " . $xcode . 
 "\n " . $ycode . "\n " . $zcode . "\n " . $ccode . "\n " . $postc . "\n " . 
 $loopend . "\n";
 
 eval $evalstring; # do user code mapping
 if ($@) {
 	print "error:$@ in string:\n";
    print "$evalstring\n";
 }

}
####################################################################
sub poll {
# hit once or on schedule to actually pull data and plot it
 my $i;
 unless ($continuous) 
  {
   $running = 0; # just do one time and stop for this case
   $ssbutr->set_label("Start"); # show our real status
  }
  getu(); # get latest database data
  map_plot(); # translate with user code from gui

  gnuplot_cmd($ploth,"splot '-' u 1:2:3:4 title '4D' pt 7 lc palette z with points\n"); #4-d
 # null title avoids spurious "- + + +" on screen
 # tell gnuplot some stuff, and tell it input is coming in as STDIN, then
 # shove data to gnuplot on it's STDIN
  foreach $i (0..$#x)  # assumes X axis' number of points total 
  { # most of the rest of this program was written to make this line this simple
   gnuplot_cmd ($ploth,"$x[$i] $y[$i] $z[$i] $c[$i]"); # So, hard to change, eh?
  }
 gnuplot_cmd($ploth,'e'); # say we're done; take it away, gnuplot!

 return $running;
}
####################################################################
sub on_gostop_clicked {
	if ($running)
	{ #if running, stop
     $running = 0;
     $ssbutr->set_label("Start");
	} else # we were stopped, so go
	{
	 $running = 1;
     $ssbutr->set_label("Stop");
     GUI2var(); # get gui values
	 my $colorcombot = $cstxt; 
     $colorcombot =~ s /<.*>//; # / strip <comment> off text
     # set up gnuplot basics just once per run
     gnuplot_cmd($ploth,"set xlabel \"$xlabel\""); # gnuplot requires quotes on the label
     gnuplot_cmd($ploth,"set ylabel \"$ylabel\"");  # hence the strange escapes here
     gnuplot_cmd($ploth,"set zlabel \"$zlabel\"");
     gnuplot_cmd($ploth,"set title \"$clabel\"");
     gnuplot_cmd($ploth,"set grid"); # show a grid
     gnuplot_cmd($ploth,"set palette rgbformulae $colorcombot");
     if ($lx){gnuplot_cmd($ploth,"set log x");} else {gnuplot_cmd($ploth,"unset log x");}
     if ($ly){gnuplot_cmd($ploth,"set log y");} else {gnuplot_cmd($ploth,"unset log y")};
     if ($lz){gnuplot_cmd($ploth,"set log z");} else {gnuplot_cmd($ploth,"unset log z")};
     gnuplot_cmd($ploth,"set pm3d"); # add palette mapping for 4th dimension     

     Glib::Timeout::add($mainwin,500,\&poll); #!!!! Victory!  Timed polling with sleeps in between.

	}
}
####################################################################



####################################################################
############################ Main ##################################
####################################################################

initialize();
say "Compiled OK."; # way to say we made it.
 Gtk3->main; # GUI event Floop - when we quit, we fall out and exit
 if ($dbh) {$dbh->disconnect;}
say "We're outa here.";
