#!/usr/bin/perl 
use strict; 
use Pod::Usage; 
use Getopt::Std; 
use Win32::SerialPort; 
use Getopt::Long;
use threads;
use Thread::Queue;
use Tk;
use Tk::Pane;

use FindCOM;
use SetThreads;
use TkWindow;
use Xport;
use tst;

# program name and version

our $ImePrograma;
our $Verzija;

$ImePrograma="RS232";
$Verzija="1.1215";

&FindCOM;
&SetThreads;

##</code><code>##

#!/usr/bin/perl
use strict;
use Pod::Usage;
use Getopt::Std;

my @tmp;
my $tmp;
our $PORT;
our $BAUD;
our $PARITY;
our $DATA;
our $STOP;
our $ERR;
our $ERR1;
our $ERR2;
our $ob;

sub FindCOM{
    
    # modern laptops don't have a RS232 port so a RS232 adapter must be used
    # DOS command "mode" finds the number of COM when the RS232 is connected

    open(LISTDIR,"mode |") || die;
    @tmp=<LISTDIR>;
    close(LISTDIR);
      
    # detecting the COM port

    if($tmp[1]=~/COM/){
        
        # variables $ERR, $ERR1 and $ERR2 are temporary
        
        $ERR="n";
        $ERR1="Type a string in the edit line (below) and press <Enter>.";
        $ERR2="(or wait for the remote device to send data).";
       
        $PORT=$tmp[1];
        chomp($PORT);
        $PORT=~s/Status for device //i;
        $PORT=~s/://;
        
        # setting the COM port
        # - variable $PORT
        # - 19200: baud rate
        # - n: none parity
        # - 8: data bits
        # - 1: stop bits
        
        open(LISTDIR,"mode $PORT 19200,n,8,1 |") || die;
        @tmp=<LISTDIR>;
        close(LISTDIR);
        
        $BAUD=$tmp[3];
        chomp($BAUD);
        $BAUD=~s/ //g;
        $BAUD=~s/Baud://i;
        
        $PARITY=$tmp[4];
        chomp($PARITY);
        $PARITY=~s/ //g;
        $PARITY=~s/Parity://i;
        
        $DATA=$tmp[5];
        chomp($DATA);
        $DATA=~s/ //g;
        $DATA=~s/databits://i;
        
        $STOP=$tmp[6];
        chomp($STOP);
        $STOP=~s/ //g;
        $STOP=~s/stopbits://i;
        
        # opening the COM port
        # in the version without Tk the opened COM port from here worked

        $ob = Win32::SerialPort->new ($PORT) || die "\tSERIAL PORT ERROR: $PORT IS BUSY OR NOT AVAILABLE\n\n"; 

    }
    else{
        $ERR="y";
        $ERR1="Failed to initialize the port.";
        $ERR2="Did you forget to connect RS232 adapter to USB?";
    }
}
1;

##</code><code>##

#!/usr/bin/perl
use strict;
use warnings;

our $log_fh;
our $ob;
our $PORT;
my $thread1;
our $BAUD;
our$PARITY;
our $DATA;
our $STOP;
our $received;
my $thread2;

sub SetThreads{
    
    # in the version without Tk this helped to get rif of annoying on screen errors

    open($log_fh,"> tmp");
    *STDERR = $log_fh;
   
    # THREAD 1: GUI

    $thread1 = threads->create(&TkWindow,$received);
    $thread1->detach();
    
    # THREAD 2: receiving data from another device

    $thread2 = threads->create(&Receive,$PORT,$received);
    $thread1->detach();
}
1;

##</code><code>##

#!/usr/bin/perl
use strict;
use Pod::Usage;
use Getopt::Std;

our $ImePrograma;
our $Verzija;
our $ob;
our $PORT;
our $BAUD;
our $PARITY;
our $DATA;
our $STOP;
my $parameters;
my $thread;
our $received;
our $ERR;
our $ERR1;
our $ERR2;
#our $ERR3;

sub TkWindow{
    
    my $Window_Tk=MainWindow->new;
    $Window_Tk->minsize(qw(100 100));
    $Window_Tk->title("$ImePrograma $Verzija");
    $Window_Tk->configure();
    
    my $notranji_Tk=$Window_Tk->Frame()->pack(-side=>'top',-padx=>10,-pady=>10);
    
    # the serial comm. parameters are written at the top of Tk window
    
    my $parameters_Tk=$notranji_Tk->Frame()->pack(-side=>'top',-padx=>1,-pady=>1);
    my $port_Tk=$parameters_Tk->Frame()->pack(-side=>'left',-padx=>0);
    my $baud_Tk=$parameters_Tk->Frame()->pack(-side=>'left',-padx=>0);
    my $parity_Tk=$parameters_Tk->Frame()->pack(-side=>'left',-padx=>0);
    my $data_Tk=$parameters_Tk->Frame()->pack(-side=>'left',-padx=>0);
    my $stop_Tk=$parameters_Tk->Frame()->pack(-side=>'left',-padx=>0);
   
    if($ERR eq "n"){
        my $port_L=$port_Tk->Entry(-relief=>'flat',-text=>"Port = ".$PORT,-justify=>'center',-font=>'Arial 8',-width=>13,-state=>'disabled')->pack();
        my $baud_L=$baud_Tk->Entry(-relief=>'flat',-text=>"Baud = ".$BAUD,-justify=>'center',-font=>'Arial 8',-width=>14,-state=>'disabled')->pack();
        my $parity_L=$parity_Tk->Entry(-relief=>'flat',-text=>"Parity = ".$PARITY,-justify=>'center',-font=>'Arial 8',-width=>15,-state=>'disabled')->pack();
        my $data_L=$data_Tk->Entry(-relief=>'flat',-text=>"Data = ".$DATA,-justify=>'center',-font=>'Arial 8',-width=>10,-state=>'disabled')->pack();
        my $stop_L=$stop_Tk->Entry(-relief=>'flat',-text=>"Stop = ".$STOP,-justify=>'center',-font=>'Arial 8',-width=>10,-state=>'disabled')->pack();
    }
    else{
        my $port_L=$port_Tk->Entry(-relief=>'flat',-text=>"",-justify=>'center',-font=>'Arial 8',-width=>13,-state=>'disabled')->pack();
        my $baud_L=$baud_Tk->Entry(-relief=>'flat',-text=>"",-justify=>'center',-font=>'Arial 8',-width=>14,-state=>'disabled')->pack();
        my $parity_L=$parity_Tk->Entry(-relief=>'flat',-text=>"",-justify=>'center',-font=>'Arial 8',-width=>15,-state=>'disabled')->pack();
        my $data_L=$data_Tk->Entry(-relief=>'flat',-text=>"",-justify=>'center',-font=>'Arial 8',-width=>10,-state=>'disabled')->pack();
        my $stop_L=$stop_Tk->Entry(-relief=>'flat',-text=>"",-justify=>'center',-font=>'Arial 8',-width=>10,-state=>'disabled')->pack();
    }
    
    # the part of the Tk window where received data are supposed to be written
    
    my $receive_Tk=$notranji_Tk->Frame()->pack(-side=>'top',-padx=>1,-pady=>3);
    my $pane_receive_Tk = $receive_Tk->Scrolled("Pane",Name => 'Receive',-scrollbars => 'e',-sticky => 'n',-gridded => 'y',-width=>400,-height=>400,-background=>'white');
    $pane_receive_Tk->Frame;
    $pane_receive_Tk->pack;
    
    # in the begining i wasn't sure if the thread should be defined here or not so i left it commented
    
    #$thread = threads->create(&Receive,$PORT,$BAUD,$PARITY,$DATA,$received);
    #$thread->detach();
    
    my $pane_receive_L=$pane_receive_Tk->Entry(-relief=>'flat',-text=>$ERR1,-font=>'Arial 9',-width=>55,-background=>'white')->pack(-ipadx=>2);
    $pane_receive_L=$pane_receive_Tk->Entry(-relief=>'flat',-text=>$ERR2,-font=>'Arial 9',-width=>55,-background=>'white')->pack(-ipadx=>2);

    # this is the part of code which should sent received data to this Tk window
    # it prints two lines only - without the received data
    # my approach fails so this is the core of my question

    my @InboundParameters = @_;
    print("In the thread\n");
    print('Got parameters >', join('<>',@InboundParameters), "\n");
    
    # entry

    my $send_Tk=$notranji_Tk->Frame()->pack(-side=>'top',-padx=>0,-pady=>0);
    my $sendE_Tk=$send_Tk->Frame()->pack(-side=>'left',-pady=>1,-padx=>0);
    my $sendG_Tk=$send_Tk->Frame()->pack(-side=>'left',-pady=>1,-padx=>3);
    my $send_E=$sendE_Tk->Entry(-font=>'Arial 8',-width=>61)->pack();
    my $send_G=$sendG_Tk->Button(-text=>'Send',-font=>'Arial 8',-background=>'grey',-command=>sub{exit;})->pack(-ipadx=>3);
    
    &MainLoop();
}
1;

##</code><code>##

#!/usr/bin/perl
use strict;
use Pod::Usage;
use Getopt::Std;

our $received;
our $PORT;
my $x;
our $ob;
my $gotit;
my $found;
my $end;
my $obattern;
my $instead;
my $timeout;
my $thread4;

sub Receive{
    
    $x=1;
    
    # this remains from the not Tk version
    
    print "\n\t"."-"x32 ."\n";
    print "\tRECEIVING LINES FROM OTHER PARTY\n";
    print "\t"."-"x32 ."\n";
    
    while(1){
        $received = ReadPort($PORT, 5);
        if($received ne ""){
            print "\t$x\tRX>\t$received\n";
            $ob->write("Sent back by my script> ".$received."\n");
            $x++;
        }
    }
    print "\n";
    print "";
    
    sub ReadPort{
    
        # Store timeout time in millisecond tic    $timeout = $ob->get_tick_count + (1000 * $timeout);
    
        $ob->lookclear;  # Clear lookfor buffers
        $gotit = "";
    
        while(1) {
            # polls until we have a line of data
            return unless ( defined ($gotit = $ob->streamline) );
            if ($gotit ne "") {
                ($found, $end, $obattern, $instead) = $ob->lastlook;
                return "$gotit";
            }
            # or an error
            return if ($ob->reset_error);
            if ($ob->get_tick_count > $timeout) {
                my ($match, $after, $obattern, $instead) = $ob->lastlook;
                return ;
            }
        }
    }
}
1;