Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

RS232 and Tk with threads

by Anonymous Monk
on Dec 20, 2021 at 08:54 UTC ( [id://11139766]=perlquestion: print w/replies, xml ) Need Help??

Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

Hello,

I'm trying to make a program for RS232 serial communication that uses Tk module.

Since I use Windows 10 the first thing I had to do was converting the module Win32::SerialPort from 32 to 64-bit. Modifying 4 or 5 lines itself took 10 minutes only, finding what to do if Win 10 doesn´t work with RS232 and how to convert it took several weeks). :)

The communication with another laptop Windows 10 with Termite (or CuteCom on Raspberry Pi) functions in both directions: I can send and receive data from both sides.

Things started to become more complicated when I tried to send the received data within the Tk window.

Finally I´ve found that threads could be the solution to my problem - so I´m asking here for Perlmonks wisdom (sincerely I don't know much about threads).

In the version where there was no Tk the program the threads actually functioned: I could send and receive data - they were successfully received from Termite on the other Windows 10 laptop (or CuteCom on raspberry Pi).

In the Tk version of my program Tk window starts but the received data don't show (the way it's written for the time being no wonder it doesn't work).

This is my main module which calls other modules.

#!/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;

The module FindCOM detects the COM port and sets parameters to 19200,None,8,1. It uses the DOS command mode.

#!/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 b +e used # DOS command "mode" finds the number of COM when the RS232 is con +nected 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 work +ed $ob = Win32::SerialPort->new ($PORT) || die "\tSERIAL PORT ERR +OR: $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;

The next module sets threads (at least in the version without Tk):

#!/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;

The both threads actually worked in the version without Tk: it received data.

This is the Tk window:

#!/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 = ".$P +ORT,-justify=>'center',-font=>'Arial 8',-width=>13,-state=>'disabled' +)->pack(); my $baud_L=$baud_Tk->Entry(-relief=>'flat',-text=>"Baud = ".$B +AUD,-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=>'d +isabled')->pack(); my $data_L=$data_Tk->Entry(-relief=>'flat',-text=>"Data = ".$D +ATA,-justify=>'center',-font=>'Arial 8',-width=>10,-state=>'disabled' +)->pack(); my $stop_L=$stop_Tk->Entry(-relief=>'flat',-text=>"Stop = ".$S +TOP,-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=>"",-just +ify=>'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 => 'Receiv +e',-scrollbars => 'e',-sticky => 'n',-gridded => 'y',-width=>400,-hei +ght=>400,-background=>'white'); $pane_receive_Tk->Frame; $pane_receive_Tk->pack; # in the begining i wasn't sure if the thread should be defined he +re or not so i left it commented #$thread = threads->create(&Receive,$PORT,$BAUD,$PARITY,$DATA,$rec +eived); #$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=>$ER +R2,-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,-pad +y=>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',-backg +round=>'grey',-command=>sub{exit;})->pack(-ipadx=>3); &MainLoop(); } 1;

Array @InboundParameters should somehow send the received data to the Tk window but fails - which is the core of my post: how to do it?

The module that receives data is below; I didn't modify much from the original version found in forums:

#!/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->lastlo +ok; return ; } } } } 1;

Thanks for your help in advance!

Marjacktablet

Replies are listed 'Best First'.
Re: RS232 and Tk with threads
by Marshall (Canon) on Dec 21, 2021 at 04:28 UTC
    I am not sure that your code needs to explicitly have any threads at all! Windows is doing the "heavy lifting" interrupt driven low level device service code for you. 9600 baud is about 1,000 chars/ second +- start/stop/data bit settings. The serial port itself may only have a 16 byte buffer. Somebody is doing that and it isn't Perl code.

    You can ask Tk to run a specified routine periodically: $widget->repeat(milliseconds, callback);, like perhaps: $widget->repeat(500, \&update_serial_info); This will cause Tk to call update_serial_info() every 1/2 second - the Tk code continues executing immediately after this "request".

    In the update_serial_info routine, you should use non-blocking calls to the serial port S/W. If the Tk display is not ready to be updated, then don't do anything. If the data is "ready" perhaps you just put the data into some $text_variable that the GUI knows about. If the info received so far warrants a display update like a text window pane, then do that being aware that updating the GUI is very "expensive" compute wise. You probably don't want to do that for every single individual character received! This Serial Port code may run just fine without being in a separate thread if you call it every 200ms or so (maybe less, maybe more).

    A key is to call the non-blocking serial port methods. If there is nothing to be read, then just don't do anything. That will happen most of the time, so make that path fast.

      You can ask Tk to run a specified routine periodically: $widget->repeat(milliseconds, callback);, like perhaps: $widget->repeat(500, \&update_serial_info); This will cause Tk to call update_serial_info() every 1/2 second - the Tk code continues executing immediately after this "request".

      Following your advice I wrote a simple module which uses POSIX and sends time stamps to the GUI window:

      my @localtime=localtime; my $hour=strftime ("%d.%m.%Y  %H:%M:%S", @localtime); our $receive_T->insert('end',$hour."\n");

      I define a text widget in another module where it calls the above module and writes time stamps into the text widget:

      $receive_T = $receive_Tk->ROText(-relief=>'groove',-width=>72,-height= +>20,-font=>'Courier 8 bold')->pack(); $receive_T->repeat(5000,\&Receive2);

      In the update_serial_info routine, you should use non-blocking calls to  the serial port S/W. If the Tk display is not ready to be updated, then  don't do anything. If the data is "ready" perhaps you just put the data  into some $text_variable that the GUI knows about. If the info received  so far warrants a display update like a text window pane, then do that  being aware that updating the GUI is very "expensive" compute wise. You  probably don't want to do that for every single individual character  received! This Serial Port code may run just fine without being in a  separate thread if you call it every 200ms or so (maybe less, maybe  more).

      A key is to call the non-blocking serial port methods. If there is  nothing to be read, then just don't do anything. That will happen most  of the time, so make that path fast.

      I took one of rare examples for serial communication  I could find and which actually worked without GUI.

      Since there are no more laptops with RS232 port I use a USB adapter and one of my modules uses mode from DOS which detects COM port and sets parameters, then opens the COM port.

      I admit I'm not capable to implement the non-blocking calls  in the below lines - maybe it's because of the fact I'm not a programmer or the Win32::SerialPort documetation is too short - so I'm asking for some additional help.

      #!/usr/bin/perl use strict; use Pod::Usage; use Getopt::Std; our $RECEIVED; our $PORT; my $x; our $receive_T; our $ob; my $timeout; sub Receive{             while(1){         $RECEIVED = ReadPort($PORT, 5);         if($RECEIVED ne ""){             print "\t$x\tRX>\t$RECEIVED\n";             $receive_T->insert('end',"\t$x\tRX>".$RECEIVED."\n");             $x++;         }     }  } sub ReadPort{         # Store timeout time in millisecond tic    $timeout = $ob->get_tic +k_count + (1000 * $timeout);     $ob->lookclear;  # Clear lookfor buffers         while(1) {             # polls until we have a line of data         # return unless ( defined ($gotit = $ob->streamline) );         if ($RECEIVED ne "") {             my ($found, $end, $obattern, $instead) = $ob->lastlook;                         return "$RECEIVED";         }         # or an error         return if ($ob->reset_error);         if ($ob->get_tick_count > $timeout) {             my ($match, $after, $obattern, $instead) = $ob->lastlook;             return ;         }     } }

      Thanks in advance for your help.

      Marjacktablet

        Yes, these simple USB to pseudo RS-232 devices can work well. It depends upon what you are talking to. The typical limitation is that voltage swing is only +-5 volts where "real" RS-232 requires +-12 volts. Sometimes cheap devices don't go sufficiently negative (<-3V) for a valid "mark" level and some devices allow invalid voltage ranges to be "counted". I have seen cases where that wasn't good enough, but usually it is. There can be other issues between manufacturer's in how close the device comes to actually performing like a "real" RS-232 I/F chip would, but I think at this stage, you are just trying to get the basics working and that your particular USB->serial gizmo is "good enough".

        Update: The incompatibility issue with voltage levels is complicated. see next post for more discussion of this.

        I haven't ever used Perl to talk to a RS-232 device on Windows, but have done it in other languages and other O/S'es.
        Yes, you are correct that the documentation does leave a lot to be desired! I hope that further explaining things on the conceptual level will be helpful to you and enable you to experiment further.

        The reason to use non-blocking calls is that you don't want your GUI to "freeze" and become unresponsive to mouse clicks. If the processor is off in serial port la-la land, then it won't be processing GUI events. I will allow that perhaps you get a version working with blocking calls and then come back later and refine that so that the GUI doesn't "Freeze". However a lot of applications have some kind of "Stop", "Restart", "Abort" button and you want that button to "work" when needed!

        I presume that you got the timed routine to display something every 1/2 second? $receive_T->repeat(5000,\&Receive2); While the processor is running Receive2(), it is not processing GUI events. As long as Receive2() runs fast enough, the user won't notice any difference in the GUI at all. In this case, Receive2() does some simple job and then returns way faster than a human is even physically capable of fully pushing a mouse button. We want the same thing (really fast return to GUI business) to happen with the serial port polling routine.

        From the documentation:

        $gotit = $PortObj->streamline; # poll until data ready $gotit = $PortObj->streamline($count);# block until $count chars recei +ved # fast alternatives to lookfor with no character processing
        If you use the 2nd call which specifies a $count, the processor will stay inside of the streamline() method until that number of characters are received. If the thing you are talking to is not particularly chatty, that could be an entire day! 9600 baud is about 1 char/ms. By comparison it takes maybe 50ms for you to blink your eyes. If I am stitching together voice prompts and there is more than about a 20ms variation between segments, you can hear the difference quite easily. So if your application is a stimulus/response situation, say you send a 6 byte command and get back a 10 byte fixed length response, the blocking I/F could still work out ok, because xmit,rcv and processing is less than 20ms and that is so fast the human won't know that the GUI wasn't working during that 20ms interval. Note: there does appear to be a mechanism to abort blocking calls after a specified timeout.

        Now if you are listening to be asked to do some command, you might wait for days before a 6 byte command shows up. The user will definitely know that the GUI has gone "bye-bye" while it is waiting for this command to arrive via the serial port.

        The first of these reading methods, $gotit = $PortObj->streamline; works differently. The documentation is poor, but my guess is that you either get: undef, "" (null string) or some number of characters in the string, "abc". In this case, streamline() will return its result right away without any "waiting". I suspect (without any documentation) that undef means that some kind of error occurred. I presume most of the time you will get "", null string, no character received and then there is nothing to do. If you are polling every second, there could be 1,000 characters there.

        So for Receive3(), untested of course,

        at the top of your code, put: $|=1: # turns off buffering for print() sub Receive3 { my $gotit = $ob->streamline; die "got undef from streamline! $!" if (!defined ($gotit)); return if ($gotit eq ""); # nothing to do - no chars received print "$gotit"; # blocking call, but "fast enough" # actual code would do something with $ +gotit # put it in a buffer and decide if it i +s enough for # a complete command or whatever... }
        So when using non-blocking I/O polling, there will not be any while(1){} loop. That is an infinite loop and you could be in there for a long time! I think undef means an error that shouldn't be ignored? This code will find out whether that is true or not. I just printed to the console. You know how to update the GUI and I leave that part to you with the guidance that updating the GUI is a very "expensive" operation - meaning consumes lots of MIPS. Maybe you don't want to update the GUI on a per character basis? However, here it could very well be that it is just fine to do an update per character. Just making you aware that the GUI is "expensive". I've seen programs that spend fully 1/2 of the computer power updating a progress bar too often. When updating the display only when it will change dramatically increases performance.

        Ok, now call Receive3() at some interval (which I think you know how to do now) and see what happens.

        The serial port package has all sorts of tricky "wait for X to happen" features. Those are blocking calls. You may wind up having to do some of these functions yourself. I have no idea what my ($found, $end, $obattern, $instead) = $ob->lastlook; does.

        Update: I don't think that you need to use threads. If you used a separate thread for the serial port, then you could put in blocking calls because even if that thread "blocked", it would not freeze the main GUI thread. But you would still need the paradigm of a non-blocking call to ask the serial port thread whether it had some result to report or not. I think you will be fine with a single thread as long as you don't have any while(1){} loops.

        Update2: I am not sure what your moniker of "Marjacktablet" means, but I suggest that you register as Monk - that process is free and non-fattening. There are a lot of advantages to being a "registered user". When you post as just "anonymous Monk", it is hard for me to see perhaps other perhaps related questions and responses that you have had. When I post a direct response to your question, you will be able to see that you have a new reply without having to find the exact thread from x days ago. So there are advantages and I recommend you do it.

Re: RS232 and Tk with threads
by Anonymous Monk on Dec 20, 2021 at 09:18 UTC
Re: RS232 and Tk with threads
by jmlynesjr (Deacon) on Dec 21, 2021 at 01:44 UTC

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://11139766]
Front-paged by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others rifling through the Monastery: (7)
As of 2024-03-28 14:02 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found