Introduction
The control program sends commands to the Arduino and processes the returned data. It is written in Perl and uses Tkx to create a GUI interface. The returned command responses are displayed in graphic and text form.
The control program is used with the project's Arduino sketch and communications object (communications.pm).
Note: See the test programs on how to run the control program from a batch file or run it without a DOS window.
Perl Code
#!/usr/bin/perl -w # ==================================================================== # Map a Grid Project - Control Program # -------------------------------------------------------------------- # # Send commands to the Arduino and process the returned data. # Arduino sketch are available that work with the control program. # # Note: The lower left corner of the grid is 0,0 # # ==================================================================== use strict; use warnings; use Math::Trig; use Tkx; use communications; # ------------------------------------------------------------------- # global constants and variables # ------------------------------------------------------------------- use constant { DEFAULTBAUDRATE => 9600, # default - baudrate DEFAULTPORT => 'COM4', # default - comm port DEFAULTPOS1 => 0, # default - position 1 DEFAULTPOS2 => 90, # default - position 2 DEFAULTSAA => 0, # default - sensor adjustment angle DEFAULTSERVOX => -12, # default servo X coordinate DEFAULTSERVOY => -12, # default servo Y coordinate GCELLX => 12, # grid cell X size (inches) GCELLY => 12, # grid cell Y size (inches) GCOLS => 10, # grid columns (x axis) GROWS => 10, # grid rows (y axis) TCOLS => 66, # text display columns TROWS => 14, # text display rows }; my $BAUDRATE; # baudrate text widget my $COMM; # communication object my $DEBUG = 0; # debug flag - display debug messages my $FIRSTTEXTLINE = 1; # first line of text flag my @GRIDCOUNT = (); # This array is use during a ping # sweep to accumulate the number # of times a cell is found occupied my @GRIDFLAG = (); # For each ping in a ping sweep # an array element (grid cell) is # set to true (1) if it is occupied # and false (0)if it is not. The # value (true/false) determines if # a grid cell's count is incremented. my @GRIDWIDGET = (); # grid display widgets my $PORT; # comm port entry widget my $P1ENTRY; # position 1 entry widget my $P2ENTRY; # position 2 entry widget my $SAAENTRY; # sensor adjustment angle entry widget my $TESTFLAG = 1; # test flag - display test buttons my $TEXT; # text display widget my $SXENTRY; # servo X coordinate entry widget my $SYENTRY; # servo Y coordinate entry widget my $VERBOSE = 0; # display extra processing messages my $VERBOSEBUTTON; # verbose button widget my $GXMIN = 0; # grid minimum X coordinate my $GXMAX = GCELLX * GCOLS; # grid maximum X coordinate my $GYMIN = 0; # grid minimum Y coordinate my $GYMAX = GCELLY * GROWS; # grid maximum Y coordinate # angles used to adjust the sensor angle to test if a cell # is occupied (see the sensor documentation for more information) my @SANGLE = (7,3.5,0,-3.5,-7); # test ping sweep returned data my @TESTPINGSWEEP = ('s45,25','s45,114','s45,178', 's45,160','s45,25', 's46,114','s47,114', 's80,127','s10,127'); # ------------------------------------------------------------------- # define fonts # ------------------------------------------------------------------- my $cfont6 = Tkx::font_create(-family=>'Courier', -size=>6); my $cfont8 = Tkx::font_create(-family=>'Courier', -size=>8); my $cfont10 = Tkx::font_create(-family=>'Courier', -size=>10); my $cfont12 = Tkx::font_create(-family=>'Courier', -size=>12); my $cfont14 = Tkx::font_create(-family=>'Courier', -size=>14); my $cfont16 = Tkx::font_create(-family=>'Courier', -size=>16); my $cfont18 = Tkx::font_create(-family=>'Courier', -size=>18); my $cfont20 = Tkx::font_create(-family=>'Courier', -size=>20); my $cfont6b = Tkx::font_create(-family=>'Courier', -size=>6, -weight=>'bold'); my $cfont8b = Tkx::font_create(-family=>'Courier', -size=>8, -weight=>'bold'); my $cfont10b = Tkx::font_create(-family=>'Courier', -size=>10, -weight=>'bold'); my $cfont12b = Tkx::font_create(-family=>'Courier', -size=>12, -weight=>'bold'); my $cfont14b = Tkx::font_create(-family=>'Courier', -size=>14, -weight=>'bold'); my $cfont16b = Tkx::font_create(-family=>'Courier', -size=>16, -weight=>'bold'); my $cfont18b = Tkx::font_create(-family=>'Courier', -size=>18, -weight=>'bold'); my $cfont20b = Tkx::font_create(-family=>'Courier', -size=>20, -weight=>'bold'); my $hfont6 = Tkx::font_create(-family=>'Helvetica', -size=>6); my $hfont8 = Tkx::font_create(-family=>'Helvetica', -size=>8); my $hfont10 = Tkx::font_create(-family=>'Helvetica', -size=>10); my $hfont12 = Tkx::font_create(-family=>'Helvetica', -size=>12); my $hfont14 = Tkx::font_create(-family=>'Helvetica', -size=>14); my $hfont16 = Tkx::font_create(-family=>'Helvetica', -size=>16); my $hfont18 = Tkx::font_create(-family=>'Helvetica', -size=>18); my $hfont20 = Tkx::font_create(-family=>'Helvetica', -size=>20); my $hfont6b = Tkx::font_create(-family=>'Helvetica', -size=>6, -weight=>'bold'); my $hfont8b = Tkx::font_create(-family=>'Helvetica', -size=>8, -weight=>'bold'); my $hfont10b = Tkx::font_create(-family=>'Helvetica', -size=>10, -weight=>'bold'); my $hfont12b = Tkx::font_create(-family=>'Helvetica', -size=>12, -weight=>'bold'); my $hfont14b = Tkx::font_create(-family=>'Helvetica', -size=>14, -weight=>'bold'); my $hfont16b = Tkx::font_create(-family=>'Helvetica', -size=>16, -weight=>'bold'); my $hfont18b = Tkx::font_create(-family=>'Helvetica', -size=>18, -weight=>'bold'); my $hfont20b = Tkx::font_create(-family=>'Helvetica', -size=>20, -weight=>'bold'); my $tfont6 = Tkx::font_create(-family=>'Times', -size=>6); my $tfont8 = Tkx::font_create(-family=>'Times', -size=>8); my $tfont10 = Tkx::font_create(-family=>'Times', -size=>10); my $tfont12 = Tkx::font_create(-family=>'Times', -size=>12); my $tfont14 = Tkx::font_create(-family=>'Times', -size=>14); my $tfont16 = Tkx::font_create(-family=>'Times', -size=>16); my $tfont18 = Tkx::font_create(-family=>'Times', -size=>18); my $tfont20 = Tkx::font_create(-family=>'Times', -size=>20); my $tfont6b = Tkx::font_create(-family=>'Times', -size=>6, -weight=>'bold'); my $tfont8b = Tkx::font_create(-family=>'Times', -size=>8, -weight=>'bold'); my $tfont10b = Tkx::font_create(-family=>'Times', -size=>10, -weight=>'bold'); my $tfont12b = Tkx::font_create(-family=>'Times', -size=>12, -weight=>'bold'); my $tfont14b = Tkx::font_create(-family=>'Times', -size=>14, -weight=>'bold'); my $tfont16b = Tkx::font_create(-family=>'Times', -size=>16, -weight=>'bold'); my $tfont18b = Tkx::font_create(-family=>'Times', -size=>18, -weight=>'bold'); my $tfont20b = Tkx::font_create(-family=>'Times', -size=>20, -weight=>'bold'); my $btfont = $hfont10b; # button font my $gdfont = $cfont12; # grid display font my $plfont = $hfont8b; # parameter label font my $pvfont = $cfont10; # parameter entry font my $txfont = $cfont10; # text window font my $wtfont = $hfont10b; # window title font # ------------------------------------------------------------------- # main window and frame # ------------------------------------------------------------------- my $mwrow = 0; # row for main window grid my $mw = Tkx::widget->new("."); $mw->g_wm_title("Map a Grid"); my $f = $mw->new_frame(-relief=>'groove', -borderwidth=>2); $f->g_grid(-row=>$mwrow++, -column=>0, -sticky=>'nsew'); # ------------------------------------------------------------------- # title # ------------------------------------------------------------------- my $l; $l = $f->new_label(-text=>'Map a Grid',-font=>$wtfont); $l->g_grid(-row=>$mwrow++, -column=>0, -padx=>4, -pady=>4, -sticky=>'new'); # ------------------------------------------------------------------- # container frames # ------------------------------------------------------------------- # ---- buttons and grid display container frame my $f1; $f1 = $f->new_frame(); $f1->g_grid(-row=>$mwrow++, -column=>0); # buttons container frame my $bf; $bf = $f1->new_frame(-relief=>'groove', -borderwidth=>2); $bf->g_grid(-row=>0, -column=>0, -sticky=>'nsew'); # grid display container frame my $gf; $gf = $f1->new_frame(-relief=>'groove', -borderwidth=>2); $gf->g_grid(-row=>0, -column=>1, -sticky=>'new'); # ---- test bottom container frame my $tbf; if ($TESTFLAG) { $tbf = $f->new_frame(-relief=>'groove', -borderwidth=>2); $tbf->g_grid(-row=>$mwrow++, -column=>0, -sticky=>'nsew'); } # ---- parameter container frame my $f2; $f2 = $f->new_frame(-relief=>'groove', -borderwidth=>2); $f2->g_grid(-row=>$mwrow++, -column=>0, -sticky=>'nsew'); # ---- message area container frame my $f3; $f3 = $f->new_frame(-relief=>'flat'); $f3->g_grid(-row=>$mwrow++, -column=>0, -sticky=>'nsew'); # ------------------------------------------------------------------- # add buttons # ------------------------------------------------------------------- my $b; # button widget my $bc = 0; # button row count $b = $bf->new_button(-text=>'Ping Sweep', -font=>$btfont, -takefocus=>0, -command=>\&ping_sweep); $b->g_grid(-row=>$bc, -column=>0, -padx=>4, -pady=>4, -sticky=>'new'); $bc++; $b = $bf->new_button(-text=>'Single Ping', -font=>$btfont, -takefocus=>0, -command=>\&ping); $b->g_grid(-row=>$bc, -column=>0, -padx=>4, -pady=>4, -sticky=>'ew'); $bc++; $b = $bf->new_button(-text=>'Move Sensor', -font=>$btfont, -takefocus=>0, -command=>\&move); $b->g_grid(-row=>$bc, -column=>0, -padx=>4, -pady=>4, -sticky=>'ew'); $bc++; $b = $bf->new_button(-text=>'Current' . "\n" . 'Pos & Dist', -font=>$btfont, -takefocus=>0, -command=>\¤t); $b->g_grid(-row=>$bc, -column=>0, -padx=>4, -pady=>4, -sticky=>'ew'); $bc++; $b = $bf->new_button(-text=>'Clear Messages', -font=>$btfont, -takefocus=>0, -command =>\&clear_text_display); $b->g_grid(-row=>$bc, -column=>0, -padx=>4, -pady=>4, -sticky=>'ew'); $bc++; $b = $bf->new_button(-text=>"Initialize\nGrid Display", -font=>$btfont, -takefocus=>0, -command =>\&init_grid_display); $b->g_grid(-row=>$bc, -column=>0, -padx=>4, -pady=>4, -sticky=>'ew'); $bc++; $b = $bf->new_button(-text=>"Reconnect to\nArduino", -font=>$btfont, -takefocus=>0, -command =>\&connect_reconnect); $b->g_grid(-row=>$bc, -column=>0, -padx=>4, -pady=>4, -sticky=>'ew'); $bc++; $b = $bf->new_button(-font=>$btfont, -takefocus=>0, -command=>\&toggle_verbose); $b->g_grid(-row=>$bc, -column=>0, -padx=>4, -pady=>4, -sticky=>'ew'); if ($VERBOSE) { $b->configure(-text => 'Verbose Off'); } else { $b->configure(-text => 'Verbose On'); } $VERBOSEBUTTON = $b; $bc++; $b = $bf->new_button(-text=>'Help', -font=>$btfont, -takefocus=>0, -command=>\&help); $b->g_grid(-row=>$bc, -column=>0, -padx=>4, -pady=>4, -sticky=>'ew'); $bc++; $b = $bf->new_button(-text=>'Exit', -font=>$btfont, -takefocus=>0, -command => sub{ $mw->g_destroy }); $b->g_grid(-row=>$bc, -column=>0, -padx=>4, -pady=>4, -sticky=>'ew'); # ------------------------------------------------------------------- # add test buttons # ------------------------------------------------------------------- if ($TESTFLAG) { $b = $tbf->new_button(-text=>"Test Grid\nCount Display", -font=>$btfont, -takefocus=>0, -command =>\&test_grid_count_display); $b->g_grid(-row=>0, -column=>0,-padx=>4, -pady=>4, -sticky=>'nsew'); $b = $tbf->new_button(-text=>"Test Parameters", -font=>$btfont, -takefocus=>0, -command =>\&test_parameters); $b->g_grid(-row=>0, -column=>1, -padx=>4, -pady=>4, -sticky=>'nsew'); $b = $tbf->new_button(-text=>"Display Grid Flags", -font=>$btfont, -takefocus=>0, -command =>\&test_display_grid_flags); $b->g_grid(-row=>0, -column=>2, -padx=>4, -pady=>4, -sticky=>'nsew'); $b = $tbf->new_button(-text=>"Test Ping\nSweep Data", -font=>$btfont, -takefocus=>0, -command =>\&test_ping_sweep); $b->g_grid(-row=>0, -column=>3, -padx=>4, -pady=>4, -sticky=>'nsew'); } # ------------------------------------------------------------------- # add grid cells text widgets to the grid container frame # ------------------------------------------------------------------- for (my $c = 0; $c < GCOLS; $c++) { for (my $r = 0; $r < GROWS; $r++) { my $cw = $gf->new_text(-height=>1, -width=>4, -padx=>2, -pady=>6, -font=>$gdfont); $cw->g_grid(-row=>$r, -column=>$c, -sticky=>'nsew'); $GRIDWIDGET[$c][GROWS - $r - 1] = $cw; } } # ------------------------------------------------------------------- # add parameters # ------------------------------------------------------------------- my $ff = $f2->new_frame(-relief=>'flat'); $ff->g_grid(-row=>0, -column=>0, -sticky=>'nsew'); # ------------------------------------------------------------------- # servo/sensor position widgets # ------------------------------------------------------------------- my $fff; $fff = $ff->new_frame(); $fff->g_grid(-row=>0, -column=>0, -padx=>4, -pady=>4, -sticky=>'nsew'); #---- position 1 $l = $fff->new_label(-text=>'Pos 1', -font=>$plfont); $l->g_grid(-row=>0, -column=>0, -padx=>4, -pady=>4, -sticky=>'nsew'); $P1ENTRY = $fff->new_entry(-font=>$pvfont, -width=>8, -borderwidth=>2, -relief=>'groove'); $P1ENTRY->g_grid(-row=>0, -column=>1, -sticky=>'nsew'); #---- position 2 $l = $fff->new_label(-text=>'Pos 2', -font=>$plfont); $l->g_grid(-row=>1, -column=>0, -padx=>4, -pady=>4, -sticky=>'nsew'); $P2ENTRY= $fff->new_entry(-font=>$pvfont, -width=>8, -borderwidth=>2, -relief=>'groove'); $P2ENTRY->g_grid(-row=>1, -column=>1, -sticky=>'nsew'); # ------------------------------------------------------------------- # sensor adjustment angle widgets # ------------------------------------------------------------------- $fff = $ff->new_frame(); $fff->g_grid(-row=>0, -column=>1, -padx=>4, -pady=>4, -sticky=>'nsew'); $l = $fff->new_label(-text=>"Sensor Adj Angle",-font=>$plfont); $l->g_grid(-row=>0, -column=>0, -padx=>4, -pady=>4,-sticky=>'nsew'); $SAAENTRY = $fff->new_entry(-font=>$pvfont, -width=>8, -borderwidth=>2, -relief=>'groove'); $SAAENTRY->g_grid(-row=>1, -column=>0, -sticky=>'nsew'); # ------------------------------------------------------------------- # servo/sensor coordinate widgets # ------------------------------------------------------------------- $fff = $ff->new_frame(); $fff->g_grid(-row=>0, -column=>2, -padx=>4, -pady=>4, -sticky=>'nsew'); #---- servo/sensor X $l = $fff->new_label(-text=>'Servo X',-font=>$plfont); $l->g_grid(-row=>0, -column=>0, -padx=>4, -pady=>4,-sticky=>'nsew'); $SXENTRY = $fff->new_entry(-font=>$pvfont, -width=>8, -borderwidth=>2, -relief=>'groove'); $SXENTRY->g_grid(-row=>0, -column=>1, -sticky=>'nsew'); #---- Servo/sensor Y $l = $fff->new_label(-text=>'Servo Y',-font=>$plfont); $l->g_grid(-row=>1, -column=>0, -padx=>4, -pady=>4, -sticky=>'nsew'); $SYENTRY= $fff->new_entry(-font=>$pvfont, -width=>8, -borderwidth=>2, -relief=>'groove'); $SYENTRY->g_grid(-row=>1, -column=>1, -sticky=>'nsew'); # ------------------------------------------------------------------- # add comm port widgets # ------------------------------------------------------------------- $fff = $ff->new_frame(); $fff->g_grid(-row=>0, -column=>3, -padx=>4, -pady=>4, -sticky=>'nsew'); #---- port $l = $fff->new_label(-text=>'Port',-font=>$plfont); $l->g_grid(-row=>0, -column=>0, -padx=>4, -pady=>4, -sticky=>'nsew'); $PORT = $fff->new_entry(-font=>$pvfont, -width=>8, -borderwidth=>2, -relief=>'groove'); $PORT->g_grid(-row=>0, -column=>1, -sticky=>'nsew'); #---- baudrate $l = $fff->new_label(-text=>' Baudrate',-font=>$plfont); $l->g_grid(-row=>1, -column=>0, -padx=>4, -pady=>4, -sticky=>'nsew'); $BAUDRATE = $fff->new_entry(-font=>$pvfont, -width=>8, -borderwidth=>2, -relief=>'groove'); $BAUDRATE->g_grid(-row=>1, -column=>1, -sticky=>'nsew'); # ------------------------------------------------------------------- # add message area text widget and scrollbar # ------------------------------------------------------------------- $ff = $f3->new_frame(-relief=>'groove', -borderwidth=>2); $TEXT = $ff->new_text(-font=>$txfont, -padx=>4, -pady=>4, -borderwidth=>0, -relief=>'flat', -height=>TROWS, -width=>TCOLS); my $sby = $ff->new_scrollbar(-orient=>'v', -command=>[$TEXT,'yview']); $TEXT->configure(-yscrollcommand =>[$sby,'set']); $TEXT->g_grid(-row=>0, -column=>0); $sby->g_grid(-row=>0, -column=>1, -padx=>2, -pady=>2, -sticky=>'ns'); $ff->g_grid(-row=>0, -column=>0, -sticky=>'nsew'); # ------------------------------------------------------------------- # initialize # ------------------------------------------------------------------- $BAUDRATE->m_insert('end',DEFAULTBAUDRATE); $P1ENTRY->m_insert('end',DEFAULTPOS1); $P2ENTRY->m_insert('end',DEFAULTPOS2); $PORT->m_insert('end',DEFAULTPORT); $SAAENTRY->m_insert('end',DEFAULTSAA); $SXENTRY->m_insert('end',DEFAULTSERVOX); $SYENTRY->m_insert('end',DEFAULTSERVOY); init_grid_flag_array(); init_grid_count_array(); update_grid_count_display(); write_text_message('Text Messages'); # ------------------------------------------------------------------- # connect to the Arduino # ------------------------------------------------------------------- $COMM = new communications(); my ($status,$aref) = $COMM->open(DEFAULTPORT,DEFAULTBAUDRATE); if (!$status) { clear_text_display(); write_text_message('Connection to Arduino failed'); write_text_message_array($aref); } # ------------------------------------------------------------------- # main loop # ------------------------------------------------------------------- Tkx::MainLoop(); # =================================================================== # =================================================================== # subroutines # =================================================================== # =================================================================== # ------------------------------------------------------------------- # connect/reconnect to Arduino # ------------------------------------------------------------------- sub connect_reconnect { clear_text_display(); write_text_message('Connect/re-connect to the Arduino'); # get and verify communication parameters my $port = $PORT->get(); # port $port =~ s/^\s+//; # remove whitespace $port =~ s/\s+$//; # remove whitespace if ($port eq '') { write_text_message("Error: no Port specified"); return; } my $aref; my $baudrate; my $status; ($status,$baudrate) = verify_integer($BAUDRATE->get()); if (!$status) { write_text_message("Error: Baudrate must be an integer (no sign)"); return; } # close the connection (if there is one) $COMM->close(); # open a connection ($status,$aref) = $COMM->open($port,$baudrate); if (!$status) { write_text_message_array($aref); return; } # success message write_text_message("Connected to Arduino"); return; } # ------------------------------------------------------------------- # do a ping sweep from a start to an end position # return the position and distance at each step # ------------------------------------------------------------------- sub ping_sweep { my $pos1; # servo start position my $pos2; # servo end position my $saa; # sensor adjustment angle my $servox; # servo/sensor X coordinate my $servoy; # servo/sensor T coordinate my $status; # returned status clear_text_display(); write_text_message('Start Ping Sweep'); # verify parameters ($status,$pos1) = verify_integer($P1ENTRY->get()); if (!$status) { write_text_message("Error: Pos 1 must be an integer (no sign)"); return; } ($status,$pos2) = verify_integer($P2ENTRY->get()); if (!$status) { write_text_message("Error: Pos 2 must be an integer (no sign)"); return; } if ($pos2 < $pos1) { write_text_message("Error: Pos 2 < Pos 1"); return; } ($status,$saa) = verify_integer($SAAENTRY->get()); if (!$status) { write_text_message("Error: Sensor Adj Angle must be an integer (no sign)"); return; } ($status,$servox) = verify_signed_integer($SXENTRY->get()); if (!$status) { write_text_message("Error: Servo X must be an integer"); return; } ($status,$servoy) = verify_signed_integer($SYENTRY->get()); if (!$status) { write_text_message("Error: Servo Y must be an integer"); return; } #--- debug ------------------------------------------------------ # write_text_message("Pos 1 = $pos1"); # write_text_message("Pos 2 = $pos2"); # write_text_message("SAA = $saa"); # write_text_message("Servo X = $servox"); # write_text_message("Servo Y = $servoy"); # --------------------------------------------------------------- # send command write_text_message('Sending Command'); ($status,$aref) = $COMM->sendMessage('S' . $pos1 . ',' . $pos2); if(!$status) { write_text_message_array($aref); return; } # receive reply write_text_message('Receiving Reply Data'); ($status,$aref) = $COMM->receiveReply(); if(!$status) { write_text_message_array($aref); return; } if ($DEBUG) { write_text_message_array($aref); } # process the reply data write_text_message('Processing Reply Data'); process_ping_sweep_data($aref,$saa,$servox,$servoy); # update the grid display write_text_message('Updating Grid Display'); update_grid_count_display(); write_text_message('End of Ping Sweep'); return; } # ------------------------------------------------------------------- # process ping sweep data # ------------------------------------------------------------------- sub process_ping_sweep_data { my $aref = $_[0]; my $saa = $_[1]; my $servox = $_[2]; my $servoy = $_[3]; init_grid_count_array(); update_grid_count_display(); foreach my $str (@$aref) { if ($str =~ /^x/) { last; } if (!process_a_ping($str,$saa,$servox,$servoy)) { return 0; } } return 1; } # ------------------------------------------------------------------- # process a single ping from a ping sweep # ------------------------------------------------------------------- sub process_a_ping { my $str = $_[0]; # reply string my $saa = $_[1]; # sensor adjustment angle my $servox = $_[2]; # servo X my $servoy = $_[3]; # servo y if ($VERBOSE) { write_text_message("Processing reply $str"); } if ($str =~ /^s(\d+),(\d+)$/) { my $pos = $1; # servo position my $dst = $2; # object distance if ($DEBUG) { write_text_message("$str pos=$pos dst=$dst"); } if ($dst == 0) { return 1; } # no object detected? # initialize the grid flag array init_grid_flag_array(); # calculate the coordinates of the object my $x; # object's X coordinate my $y; # object's Y coordinate my $c; # object's grid column my $r; # object's grid row my $sa; # adjusted selsor angle foreach my $a (@SANGLE) { # calculate adjusted sensor angle to the object $sa = ($pos + $saa +$a) % 360; # calculate the object's coordinates ($x,$y) = calculate_coordinates($servox,$servoy,$sa,$dst); if ($DEBUG) { write_text_message("$str a=$sa x=$x y=$y"); } # is it outside the grid? if ($x < $GXMIN || $x > $GXMAX || $y < $GYMIN || $y > $GYMAX) { if ($DEBUG) { write_text_message("$str outside the grid"); } next; } # calculate the object's cell $c = int($x / GCELLX); # cell column $r = int($y / GCELLY); # cell row if ($DEBUG) { write_text_message("$str col=$c row=$r"); } # set the cell flag $GRIDFLAG[$c][$r] = 1; } # increment the grid cell occupied count increment_grid_count_array(); return 1; } write_text_message("Error: bad ping sweep data ($str)"); return 0; } # ------------------------------------------------------------------- # calculate coordinates # given: # origin x,y coordinates # angle (clockwise angle from an axis parallel to the grid's X axis) # distance to object from origin # ------------------------------------------------------------------- sub calculate_coordinates { my $ox = $_[0]; # origin X my $oy = $_[1]; # origin Y my $a = $_[2]; # angle (degrees) my $d = $_[3]; # distance my $r = $a * (pi/180); # radians my $x = $ox + (cos($r) * $d); my $y = $oy + (sin($r) * $d); return ($x,$y); } # ------------------------------------------------------------------- # do a single ping using the current servo/sensor position # return the position and distance # ------------------------------------------------------------------- sub ping { my $pos1; my $saa; my $servox; my $servoy; my $status; clear_text_display(); write_text_message('Ping'); # verify parameters ($status,$pos1) = verify_integer($P1ENTRY->get()); if (!$status) { write_text_message("Error: Pos 1 must be an integer (no sign)"); return; } ($status,$saa) = verify_integer($SAAENTRY->get()); if (!$status) { write_text_message("Error: Sensor Adj Angle must be an integer (no sign)"); return; } ($status,$servox) = verify_signed_integer($SXENTRY->get()); if (!$status) { write_text_message("Error: Servo X must be an integer"); return; } ($status,$servoy) = verify_signed_integer($SYENTRY->get()); if (!$status) { write_text_message("Error: Servo Y must be an integer"); return; } #--- debug ------------------------------------------------------ # write_text_message("Pos 1 = $pos1"); # write_text_message("SAA = $saa"); # write_text_message("Servo X = $servox"); # write_text_message("Servo Y = $servoy"); # --------------------------------------------------------------- # send command ($status,$aref) = $COMM->sendMessage('P' . $pos1); if(!$status) { write_text_message_array($aref); return; } # receive reply ($status,$aref) = $COMM->receiveReply(); if(!$status) { write_text_message_array($aref); return; } # display reply write_text_message_array($aref); return; } # ------------------------------------------------------------------- # move the servo/sensor to a specified position # ------------------------------------------------------------------- sub move { my $pos1; my $status; my $aref; clear_text_display(); write_text_message('Move Servo/Sensor to Position'); # verify parameters ($status,$pos1) = verify_integer($P1ENTRY->get()); if (!$status) { write_text_message("Error: Pos 1 must be an integer (no sign)"); return; } # send move command ($status,$aref) = $COMM->sendMessage('M' . $pos1); if(!$status) { write_text_message_array($aref); return; } # receive reply ($status,$aref) = $COMM->receiveReply(); if(!$status) { write_text_message_array($aref); return; } write_text_message_array($aref); return; } # ------------------------------------------------------------------- # display current position and distance in the Arduino # ------------------------------------------------------------------- sub current { my $status; my $aref; clear_text_display(); write_text_message('Current Arduino Position and Distance'); # send current command ($status,$aref) = $COMM->sendMessage('C'); if(!$status) { write_text_message_array($aref); return; } # receive reply ($status,$aref) = $COMM->receiveReply(); if(!$status) { write_text_message_array($aref); return; } # display reply write_text_message_array($aref); return; } # ------------------------------------------------------------------- # initialize the grid count array # ------------------------------------------------------------------- sub init_grid_count_array { for(my $c = 0; $c < GCOLS; $c++) { for(my $r = 0; $r < GROWS; $r++) { $GRIDCOUNT[$c][$r] = 0; } } return; } # ------------------------------------------------------------------- # initialize the grid flag array # ------------------------------------------------------------------- sub init_grid_flag_array { for(my $c = 0; $c < GCOLS; $c++) { for(my $r = 0; $r < GROWS; $r++) { $GRIDFLAG[$c][$r] = 0; } } return; } # ------------------------------------------------------------------- # increment grid count array using the value (0/1) grid flag array # ------------------------------------------------------------------- sub increment_grid_count_array { for(my $c = 0; $c < GCOLS; $c++) { for(my $r = 0; $r < GROWS; $r++) { if ($GRIDFLAG[$c][$r]) { $GRIDCOUNT[$c][$r]++; } } } return; } # ------------------------------------------------------------------- # update grid count display # copy the grid counts to grid display # ------------------------------------------------------------------- sub update_grid_count_display { for(my $c = 0; $c < GCOLS; $c++) { for(my $r = 0; $r < GROWS; $r++) { $GRIDWIDGET[$c][$r]->m_delete('0.0','end'); $GRIDWIDGET[$c][$r]->m_insert('end',$GRIDCOUNT[$c][$r]); } } return; } # ------------------------------------------------------------------- # init the grid display # ------------------------------------------------------------------- sub init_grid_display { init_grid_flag_array(); init_grid_count_array(); update_grid_count_display(); return; } # ------------------------------------------------------------------- # write an array of messages to the message area # (array passed by reference) # ------------------------------------------------------------------- sub write_text_message_array { my $mref = $_[0]; # message array reference foreach my $m (@$mref) { write_text_message($m); } return; } # ------------------------------------------------------------------- # write a message to the message area # ------------------------------------------------------------------- sub write_text_message { my $m = $_[0]; # message if ($FIRSTTEXTLINE) { $TEXT->m_insert('end',$m); $FIRSTTEXTLINE = 0; } else { $TEXT->m_insert('end', "\n" . $m); } $TEXT->m_see('end'); return; } # ------------------------------------------------------------------- # clear the message area # ------------------------------------------------------------------- sub clear_text_display { $TEXT->m_delete('0.0','end'); $FIRSTTEXTLINE = 1; return; } # ------------------------------------------------------------------- # verify integer string # return validation status, integer string with leading and # trailing whitespace removed # ------------------------------------------------------------------- sub verify_integer { my $i = $_[0]; $i =~ s/^\s+//; # remove whitespace $i =~ s/\s+$//; # remove whitespace if ($i !~ /^\d+$/) { return (0,$i); # error } return (1,$i); # OK } # ------------------------------------------------------------------- # verify integer string with/without sign # return validation status, integer string with leading and # trailing whitespace removed # ------------------------------------------------------------------- sub verify_signed_integer { my $i = $_[0]; $i =~ s/^\s+//; # remove whitespace $i =~ s/\s+$//; # remove whitespace if ($i !~ /^[-+]?\d+$/) { return (0,$i); # error } return (1,$i); # OK } # ------------------------------------------------------------------- # toggle verbose flag # ------------------------------------------------------------------- sub toggle_verbose { if ($VERBOSE) { $VERBOSEBUTTON->configure(-text => 'Verbose On'); $VERBOSE = 0; } else { $VERBOSEBUTTON->configure(-text => 'Verbose Off'); $VERBOSE = 1; } } # ------------------------------------------------------------------- # display help information # ------------------------------------------------------------------- sub help { clear_text_display(); write_text_message( "The 'Ping Sweep' command uses Pos 1 and Pos 2 as the start\n" . "and stop positions for ping sweeps. Pos 1 must be less that\n" . "Pos 2 and they should not exceed the range of the servo.\n" . "\nThe 'Move' command uses Pos 1.\n" . "\nThe 'Ping' uses the current servo position.\n" . "\nThe 'Sensor Adj Angle' is the adjustment used when the servo's\n" . "zero direction does not align with the grid's X axis.\n" . "\n'Servo X' and 'Servo Y' are the servo/sensor coordinates.\n" . "\nPort is the Arduino communication port.\n" . "\nBaudrate is the communication port\'s baudrate.\n" . "\nAll of the numeric parameters are integers. " . "Parameters are\nonly validated when a command is " . "executed.\n" . "\nSee the documentation for more information on what the\n" . "parameters are and how they are used."); return; } # ------------------------------------------------------------------- # test - ping sweep # ------------------------------------------------------------------- sub test_ping_sweep { $DEBUG = 1; clear_text_display(); process_ping_sweep_data(\@TESTPINGSWEEP, $SAAENTRY->get(), $SXENTRY->get(), $SYENTRY->get()); $DEBUG = 0; update_grid_count_display(); return; } # ------------------------------------------------------------------- # test - display grid flags # ------------------------------------------------------------------- sub test_display_grid_flags { my $str; clear_text_display(); write_text_message('Current grid flags'); for(my $r = (GROWS - 1); $r >= 0; $r--) { $str = ''; for(my $c = 0; $c < GCOLS; $c++) { $str .= ' ' . $GRIDFLAG[$c][$r]; } write_text_message($str); } return; } # ------------------------------------------------------------------- # test - generate and display random grid count data # ------------------------------------------------------------------- sub test_grid_count_display { clear_text_display(); write_text_message('Generating random grid cell counts'); for(my $c = 0; $c < GCOLS; $c++) { for(my $r = 0; $r < GROWS; $r++) { $GRIDCOUNT[$c][$r] = int(180.0 * rand()); update_grid_count_display(); } } return; } # ------------------------------------------------------------------- # test - parameters # ------------------------------------------------------------------- sub test_parameters { clear_text_display(); my $pos1; my $pos2; my $saa; my $servox; my $servoy; my $baudrate; my $status; # check Pos 1 and Pos 2 ($status,$pos1) = verify_integer($P1ENTRY->get()); if (!$status) { write_text_message("Error: Pos 1 must be an integer (no sign)"); } ($status,$pos2) = verify_integer($P2ENTRY->get()); if (!$status) { write_text_message("Error: Pos 2 must be an integer (no sign)"); } if ($pos2 < $pos1) { write_text_message("Error: Pos 2 < Pos 1"); } # check sensor adjustment angle ($status,$saa) = verify_integer($SAAENTRY->get()); if (!$status) { write_text_message("Error: sensor adjustment angle must " . "be an integer (no sign)"); } # check Servo X ($status,$servox) = verify_signed_integer($SXENTRY->get()); if (!$status) { write_text_message("Error: Servo X must be an integer (no sign)"); } # check Servo y ($status,$servoy) = verify_signed_integer($SYENTRY->get()); if (!$status) { write_text_message("Error: Servo Y must be an integer (no sign)"); } # check baudrate ($status,$baudrate) = verify_integer($BAUDRATE->get()); if (!$status) { write_text_message("Error: baudrate must be an integer (no sign)"); } write_text_message("Pos1 = $pos1"); write_text_message("Pos2 = $pos2"); write_text_message("SAA = $saa"); write_text_message("ServoX = $servox"); write_text_message("ServoY = $servoy"); write_text_message("Baudrate = $baudrate"); return; }