#!/usr/bin/perl

##############################################################################
# C 2016 Doug Coulter, GPLv2 license
# remote ethernet interface for GW-Instek GDS-2204a scope
# Assumed ip is 192.168.1.201:3000
# Could be made to work over USB with code from my other projects,
# Just setup serial and use $port intstead of $socket in all this
#
# With some perl wizardry, I could have put the channels stuff in a loop,
# used arrays, etc.  TIMTOWTDI
# Cut/paste was quicker for me and more readable for you.
# lots more functionality could be added, like labels, math etc.  
# I am video recording the screen anyway...
# I just needed to set speeds and feeds during a fusion run from a safe place.
##############################################################################

use Modern::Perl;
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?
use IO::Socket;
use File::Basename 'dirname'; # for knowing where we are (ease for developer)
use Storable qw(nstore retrieve); # for presets on disk
#####
my $debug;      # set true for terminal vebosity
my $socket; 	# scope socket
my $msg;	# message back and forth
my %settings;	# hash of scope settings for presets (using Storable)
######################################################################
my $builder = Gtk3::Builder->new();
my $mainwin;
# form for below is ($widget reference, $value)
# value happens to be same name as GUI id (but no $ for that)
############### Horizontal
my ($sweepr,$sweep);            # secs/division
my ($offsetr,$offset);          # trigger offset
my ($tchannelr,$tchannel);      # trigger channel
my ($ttyper,$ttype);            # trigger type
#@@@ lots more could be added here (slope, coupling, etc)
############### Channel 1
my ($ch1vdivr,$ch1vdiv);
my ($ch1offsr,$ch1offs);
my ($ch1coupr,$ch1coup);
############### Channel 2
my ($ch2vdivr,$ch2vdiv);
my ($ch2offsr,$ch2offs);
my ($ch2coupr,$ch2coup);
############### Channel 3
my ($ch3vdivr,$ch3vdiv);
my ($ch3offsr,$ch3offs);
my ($ch3coupr,$ch3coup);
############### Channel 4
my ($ch4vdivr,$ch4vdiv);
my ($ch4offsr,$ch4offs);
my ($ch4coupr,$ch4coup);
# preset
my ($presetfiler); # don't keep the value around, just get as needed with this reference
######################################################################
sub getwidgetrefs { # get widget refs for all the GUI elements we'll read and write
  $sweepr = $builder->get_object('sweep');
  $offsetr = $builder->get_object('offset');
  $tchannelr = $builder->get_object('tchannel');
  $ttyper = $builder->get_object('ttype');
  # swear this could be reorganized into a loop all over, but painful and less readable
  $ch1vdivr = $builder->get_object('ch1vdiv') or die "ch1vdivr not set $!";
  $ch1offsr = $builder->get_object('ch1offs');
  $ch1coupr = $builder->get_object('ch1coup');
  $ch2vdivr = $builder->get_object('ch2vdiv');
  $ch2offsr = $builder->get_object('ch2offs');
  $ch2coupr = $builder->get_object('ch2coup');
  $ch3vdivr = $builder->get_object('ch3vdiv');
  $ch3offsr = $builder->get_object('ch3offs');
  $ch3coupr = $builder->get_object('ch3coup');
  $ch4vdivr = $builder->get_object('ch4vdiv');
  $ch4offsr = $builder->get_object('ch4offs');
  $ch4coupr = $builder->get_object('ch4coup');
  $presetfiler = $builder->get_object('presetfile');
 }
######################################################################
sub scope2GUI () {
 $msg = ":TIM:SCAL?\n";  # sweep rate	
 print $socket $msg;
 $msg = <$socket>;
 print "Scope returned:$msg" if $debug;
 chomp $msg;
 $sweepr->set_text($msg);
 
 $msg = ":TIM:POS?\n";  # offset from trigger?
 print $socket $msg;
 $msg = <$socket>;
 print "Scope returned (offset):$msg" if $debug;
 chomp $msg;
 $offsetr->set_text($msg); 
 
 $msg = "TRIG:SOUR?\n";  # trigger source
 print $socket $msg;
 $msg = <$socket>;
 print "Scope returned (source):$msg" if $debug;
 chomp $msg;
 $tchannelr->set_text($msg);

 $msg = "TRIG:TYP?\n";  # trigger type
 print $socket $msg;
 $msg = <$socket>;
 print "Scope returned (trigtype):$msg" if $debug;
 chomp $msg;
 $ttyper->set_text($msg);
 # vertical gains
 $msg = "CHAN1:SCAL?\n";  # v/div
 print $socket $msg;
 $msg = <$socket>;
 print "Scope returned (ch1 v/div):$msg" if $debug;
 chomp $msg;
 $ch1vdivr->set_text($msg);
 $msg = "CHAN2:SCAL?\n";  # v/div
 print $socket $msg;
 $msg = <$socket>;
 print "Scope returned (ch2 v/div):$msg" if $debug;
 chomp $msg;
 $ch2vdivr->set_text($msg);
 $msg = "CHAN3:SCAL?\n";  # v/div
 print $socket $msg;
 $msg = <$socket>;
 print "Scope returned (ch3 v/div):$msg" if $debug;
 chomp $msg;
 $ch3vdivr->set_text($msg);
 $msg = "CHAN4:SCAL?\n";  # v/div
 print $socket $msg;
 $msg = <$socket>;
 print "Scope returned (ch4 v/div):$msg" if $debug;
 chomp $msg;
 $ch4vdivr->set_text($msg);
# vertical offsets
 $msg = "CHAN1:POS?\n";  # offset 
 print $socket $msg;
 $msg = <$socket>;
 print "Scope returned (ch1 position):$msg" if $debug;
 chomp $msg;
 $ch1offsr->set_text($msg);
 $msg = "CHAN2:POS?\n";  # offset
 print $socket $msg;
 $msg = <$socket>;
 print "Scope returned (ch2 position):$msg" if $debug;
 chomp $msg;
 $ch2offsr->set_text($msg);
 $msg = "CHAN3:POS?\n";  # offset
 print $socket $msg;
 $msg = <$socket>;
 print "Scope returned (ch3 position):$msg" if $debug;
 chomp $msg;
 $ch3offsr->set_text($msg);
 $msg = "CHAN4:POS?\n";  # offset
 print $socket $msg;
 $msg = <$socket>;
 print "Scope returned (ch4 position):$msg" if $debug;
 chomp $msg;
 $ch4offsr->set_text($msg);
# vertical couplings
 $msg = "CHAN1:COUP?\n";
 print $socket $msg;
 $msg = <$socket>;
 print "Scope returned (ch1 coupling):$msg" if $debug;
 chomp $msg;
 $ch1coupr->set_text($msg);
 $msg = "CHAN2:COUP?\n";
 print $socket $msg;
 $msg = <$socket>;
 print "Scope returned (ch2 coupling):$msg" if $debug;
 chomp $msg;
 $ch2coupr->set_text($msg);
 $msg = "CHAN3:COUP?\n";
 print $socket $msg;
 $msg = <$socket>;
 print "Scope returned (ch3 coupling):$msg" if $debug;
 chomp $msg;
 $ch3coupr->set_text($msg);
 $msg = "CHAN4:COUP?\n";
 print $socket $msg;
 $msg = <$socket>;
 print "Scope returned (ch4 coupling):$msg" if $debug;
 chomp $msg;
 $ch4coupr->set_text($msg);
}
######################################################################
sub GUI2scope() {
 # Horizontal stuff
   $msg = "TIM:SCAL " . $sweepr->get_text() . "\n";
   say "sending:$msg" if $debug;
   print $socket $msg;
   $msg = "TIM:POS " . $offsetr->get_text() . "\n";
   say "sending:$msg" if $debug;
   print $socket $msg;
   $msg = "TRIG:SOUR " . $tchannelr->get_text() . "\n";
   say "sending:$msg" if $debug;
   print $socket $msg;
   $msg = "TRIG:TYP " . $ttyper->get_text() . "\n";
   say "sending:$msg" if $debug;
   print $socket $msg;
# Vertical stuff
   $msg = "CHAN1:SCAL " . $ch1vdivr->get_text() ."\n";
   say "sending:$msg" if $debug;
   print $socket $msg;
   $msg = "CHAN2:SCAL " . $ch2vdivr->get_text() ."\n";
   say "sending:$msg" if $debug;
   print $socket $msg;
   $msg = "CHAN3:SCAL " . $ch3vdivr->get_text() ."\n";
   say "sending:$msg" if $debug;
   print $socket $msg;
   $msg = "CHAN4:SCAL " . $ch4vdivr->get_text() ."\n";
   say "sending:$msg" if $debug;
   print $socket $msg;
   
   $msg = "CHAN1:POS " . $ch1offsr->get_text() . "\n";
   say "sending:$msg" if $debug;
   print $socket $msg;
   $msg = "CHAN2:POS " . $ch2offsr->get_text() . "\n";
   say "sending:$msg" if $debug;
   print $socket $msg;
   $msg = "CHAN3:POS " . $ch3offsr->get_text() . "\n";
   say "sending:$msg" if $debug;
   print $socket $msg;
   $msg = "CHAN4:POS " . $ch4offsr->get_text() . "\n";
   say "sending:$msg" if $debug;
   print $socket $msg;

   $msg = "CHAN1:COUP " . $ch1coupr->get_text() . "\n";
   say "sending:$msg" if $debug;
   print $socket $msg;
   $msg = "CHAN2:COUP " . $ch2coupr->get_text() . "\n";
   say "sending:$msg" if $debug;
   print $socket $msg;
   $msg = "CHAN3:COUP " . $ch3coupr->get_text() . "\n";
   say "sending:$msg" if $debug;
   print $socket $msg;
   $msg = "CHAN4:COUP " . $ch4coupr->get_text() . "\n";
   say "sending:$msg" if $debug;
   print $socket $msg;
 }
######################################################################
sub GUI2hash() { # get current GUI settings to a hash I can store/retrieve with file
 $settings{'sweep'} = $sweepr->get_text;
 $settings{'offset'} = $offsetr->get_text;
 $settings{'tchannel'} = $tchannelr->get_text;
 $settings{'ttype'} = $ttyper->get_text;
 
 $settings{'ch1vdiv'} = $ch1vdivr->get_text;
 $settings{'ch1offs'} = $ch1offsr->get_text;
 $settings{'ch1coup'} = $ch1coupr->get_text;
 $settings{'ch2vdiv'} = $ch2vdivr->get_text;
 $settings{'ch2offs'} = $ch2offsr->get_text;
 $settings{'ch2coup'} = $ch2coupr->get_text;
 $settings{'ch3vdiv'} = $ch3vdivr->get_text;
 $settings{'ch3offs'} = $ch3offsr->get_text;
 $settings{'ch3coup'} = $ch3coupr->get_text;
 $settings{'ch4vdiv'} = $ch4vdivr->get_text;
 $settings{'ch4offs'} = $ch4offsr->get_text;
 $settings{'ch4coup'} = $ch4coupr->get_text;
}
######################################################################
sub hash2GUI() {  # move content from %settings to GUI
  $sweepr->set_text($settings{'sweep'});
  $offsetr->set_text($settings{'offset'});
  $tchannelr->set_text($settings{'tchannel'});
  $ttyper->set_text($settings{'ttype'});
  
  $ch1vdivr->set_text($settings{'ch1vdiv'});
  $ch1offsr->set_text($settings{'ch1offs'});
  $ch1coupr->set_text($settings{'ch1coup'});

  $ch2vdivr->set_text($settings{'ch2vdiv'});
  $ch2offsr->set_text($settings{'ch2offs'});
  $ch2coupr->set_text($settings{'ch2coup'});

  $ch3vdivr->set_text($settings{'ch3vdiv'});
  $ch3offsr->set_text($settings{'ch3offs'});
  $ch3coupr->set_text($settings{'ch3coup'});
  
  $ch4vdivr->set_text($settings{'ch4vdiv'});
  $ch4offsr->set_text($settings{'ch4offs'});
  $ch4coupr->set_text($settings{'ch4coup'});
 }
######################################################################
sub on_getpreset_clicked {
  my $filename = dirname($0) . '/' . $presetfiler->get_text(); 
  %settings = %{retrieve($filename)};  # dereference hanshref
  hash2GUI(); # show the retrieved stuff
 }
######################################################################
sub on_savepreset_clicked {
  GUI2hash(); # get the stuff from the screen into %settings
  # we save screen content regardless of what's in the scope
  my $filename = dirname($0) . '/' . $presetfiler->get_text();
  nstore (\%settings, $filename); # do the deed
 }
######################################################################
sub on_set_clicked { #send gui data to scope
 say "set scope clicked" if $debug;
 GUI2scope(); # actually do the deed
}
######################################################################
sub on_get_clicked { # get scope settings
  say "get scope was clicked" if $debug;
  scope2GUI(); # so get the stuff from the scope
 }
######################################################################
sub on_quit_clicked {
#@@@ shutdown other stuff - make it safe!
 Gtk3->main_quit; # the sub name must match the glade event call
 } 
######################################################################
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) . '/scope.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
}

######################################################################
sub initialize() {
$socket = IO::Socket::INET->new(
    PeerAddr => '192.168.1.201', 	# scope ip address
    PeerPort => 3000,               		# port it uses
    Proto    => "tcp",              		#  yes, really go out on the wire
    Type     => SOCK_STREAM		# with tcp/ip, not UDP
  ) 
  or die "Couldn't connect to scope $@\n";    # if it didn't work - tell me why

 createguifile();    # create GUI from a glade XML file
 getwidgetrefs();    # get references to the widgets
 scope2GUI();        # get existing scope setup
}
######################################################################
sub getid() {
		$msg = "*idn?\n";
		print "Asking scope for ID\n";
		print $socket $msg;
		$msg = <$socket>;
		print "Scope returned:$msg";
}
######################################################################
# getall - *lrn only works for 2ch scopes so removed
#		$msg = "*CLS\n"; # supposedly clears errors.  No evident effect, or maybe you have to suck up a return message?
#		print $socket $msg;


######################################################################
########################   MAIN   ####################################
######################################################################

initialize();
Gtk3->main; # GUI event Floop - when we quit, we fall out and exit



		
		
	
		
