File Coverage

blib/lib/THD7.pm
Criterion Covered Total %
statement 185 900 20.5
branch 0 314 0.0
condition 0 17 0.0
subroutine 61 277 22.0
pod 116 216 53.7
total 362 1724 21.0


line stmt bran cond sub pod time code
1             package THD7;
2              
3             require 5.004;
4              
5             # David Nesting
6             # THD7.pm - A module for providing control to a TH-D7 radio via serial port
7             #
8             # Kevin Wittmer
9             # Version 1.3 - 3 April 2004
10             # Added support for APRS message send
11             #
12             # Kevin Wittmer
13             # Version 1.2 - 17 January 2004
14             # Added support for the Windows operating system
15             #
16             # David Nesting
17             # Version 1.1 - 17 April 1999
18             # Added support for: CH, DW, UP, FL, FQ, SC, TC, VR, VW, MON, SFT
19             #
20             # David Nesting
21             # Version 1.0 - 15 April 1999
22              
23             BEGIN {
24 1     1   1155 use Exporter ();
  1         2  
  1         34  
25 1     1   7 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  1         1  
  1         233  
26            
27 1     1   2 $VERSION = 1.30;
28              
29 1         21 @ISA = qw(Exporter);
30 1         3 @EXPORT = qw(NOCALLBACK);
31 1         18 %EXPORT_TAGS = (
32             'constants' => [qw{ BAND_A BAND_B ON OFF KEY KEY_DATA ALL
33             TIME CARRIER SEEK DATA BOTH SLOW FAST APO_30 APO_60
34             ENGLISH METRIC MANUAL PTT AUTO NMEA POSITIVE NEGATIVE
35             BLACK BLUE RED MAGENTA GREEN CYAN YELLOW WHITE
36             HIGH LOW EL OPEN CLOSED FULL HALF AIR VHF_A VHF_B UHF }],
37             'functions' => [qw{ ToStep FromStep ToTone FromTone ToPosit FromPosit }]
38             );
39 1         29 @EXPORT_OK = qw(BAND_A BAND_B ON OFF KEY KEY_DATA ALL
40             TIME CARRIER SEEK DATA BOTH SLOW FAST APO_30 APO_60
41             ENGLISH METRIC MANUAL PTT AUTO NMEA POSITIVE NEGATIVE
42             BLACK BLUE RED MAGENTA GREEN CYAN YELLOW WHITE
43             HIGH LOW EL OPEN CLOSED FULL HALF AIR VHF_A VHF_B UHF
44             ToStep FromStep ToTone FromTone ToPosit FromPosit
45             );
46             }
47              
48 1     1   6 use strict;
  1         1  
  1         40  
49 1     1   1253 use Symbol;
  1         1139  
  1         85  
50 1     1   6 use Carp;
  1         2  
  1         82  
51              
52 1     1   6 use constant (BAND_A => 0);
  1         2  
  1         79  
53 1     1   5 use constant (BAND_B => 1);
  1         2  
  1         39  
54 1     1   5 use constant (OFF => 0);
  1         2  
  1         45  
55 1     1   5 use constant (ON => 1);
  1         1  
  1         48  
56 1     1   5 use constant (HIGH => 0);
  1         2  
  1         38  
57 1     1   5 use constant (LOW => 1);
  1         2  
  1         42  
58 1     1   5 use constant (EL => 2);
  1         8  
  1         36  
59 1     1   4 use constant (CLOSED => 0);
  1         3  
  1         38  
60 1     1   5 use constant (OPEN => 1);
  1         1  
  1         37  
61 1     1   5 use constant (HALF => 0);
  1         1  
  1         37  
62 1     1   5 use constant (FULL => 1);
  1         2  
  1         36  
63 1     1   4 use constant (AIR => 1);
  1         1  
  1         37  
64 1     1   5 use constant (VHF_A => 2);
  1         1  
  1         70  
65 1     1   5 use constant (VHF_B => 3);
  1         1  
  1         45  
66 1     1   5 use constant (UHF => 6);
  1         2  
  1         47  
67 1     1   4 use constant (KEY => 1);
  1         2  
  1         35  
68 1     1   5 use constant (KEY_DATA => 2);
  1         8  
  1         46  
69 1     1   5 use constant (ALL => 3);
  1         2  
  1         38  
70 1     1   4 use constant (TIME => 0);
  1         2  
  1         44  
71 1     1   5 use constant (CARRIER => 1);
  1         2  
  1         42  
72 1     1   5 use constant (SEEK => 2);
  1         2  
  1         36  
73 1     1   4 use constant (DATA => 0);
  1         2  
  1         45  
74 1     1   20 use constant (BOTH => 1);
  1         2  
  1         35  
75 1     1   5 use constant (SLOW => 0);
  1         2  
  1         41  
76 1     1   4 use constant (FAST => 1);
  1         2  
  1         48  
77 1     1   4 use constant (APO_30 => 1);
  1         1  
  1         37  
78 1     1   4 use constant (APO_60 => 2);
  1         1  
  1         43  
79 1     1   4 use constant (FM => 0);
  1         2  
  1         51  
80 1     1   5 use constant (AM => 1);
  1         1  
  1         42  
81 1     1   5 use constant (ENGLISH => 0);
  1         1  
  1         43  
82 1     1   4 use constant (METRIC => 1);
  1         2  
  1         41  
83 1     1   5 use constant (MANUAL => 0);
  1         1  
  1         35  
84 1     1   4 use constant (PTT => 1);
  1         3  
  1         39  
85 1     1   5 use constant (AUTO => 2);
  1         1  
  1         41  
86 1     1   4 use constant (BLACK => 0);
  1         2  
  1         35  
87 1     1   10 use constant (BLUE => 1);
  1         2  
  1         42  
88 1     1   4 use constant (RED => 2);
  1         2  
  1         334  
89 1     1   5 use constant (MAGENTA => 3);
  1         2  
  1         172  
90 1     1   5 use constant (GREEN => 4);
  1         1  
  1         51  
91 1     1   5 use constant (CYAN => 5);
  1         2  
  1         38  
92 1     1   5 use constant (YELLOW => 6);
  1         1  
  1         42  
93 1     1   4 use constant (WHITE => 7);
  1         2  
  1         73  
94 1     1   6 use constant (TONES => 1,3..39);
  1         1  
  1         227  
95 1     1   5 use constant (NMEA => 1);
  1         2  
  1         45  
96 1     1   5 use constant (VFO => 0);
  1         1  
  1         44  
97 1     1   5 use constant (MEMORY => 2);
  1         2  
  1         41  
98 1     1   4 use constant (CALL => 3);
  1         2  
  1         46  
99 1     1   4 use constant (POSITIVE => 2);
  1         2  
  1         41  
100 1     1   4 use constant (NEGATIVE => 1);
  1         2  
  1         185  
101              
102             sub NOCALLBACK {
103 0     0 0   \&NOCALLBACK;
104             }
105              
106             my %STEPS = (
107             5 => 0,
108             6.25 => 1,
109             10 => 2,
110             12.5 => 3,
111             15 => 4,
112             20 => 5,
113             25 => 6,
114             30 => 7,
115             50 => 8,
116             100 => 9
117             );
118             my %REV_STEPS;
119             $REV_STEPS{values %STEPS} = keys %STEPS;
120              
121             my %TONES = (
122             67 => 1,
123             71.9 => 3,
124             74.4 => 4,
125             77 => 5,
126             79.7 => 6,
127             82.5 => 7,
128             85.4 => 8,
129             88.5 => 9,
130             91.5 => 10,
131             94.8 => 11,
132             97.4 => 12,
133             100 => 13,
134             103.5 => 14,
135             107.2 => 15,
136             110.9 => 16,
137             114.8 => 17,
138             118.8 => 18,
139             123 => 19,
140             127.3 => 20,
141             131.8 => 21,
142             136.5 => 22,
143             141.3 => 23,
144             146.2 => 24,
145             151.4 => 25,
146             156.7 => 26,
147             162.2 => 27,
148             167.9 => 28,
149             173.8 => 29,
150             179.9 => 30,
151             186.2 => 31,
152             192.8 => 32,
153             203.5 => 33,
154             210.7 => 34,
155             218.8 => 35,
156             225.7 => 36,
157             223.6 => 37,
158             241.8 => 38,
159             250.3 => 39
160             );
161             my %REV_TONES;
162             $REV_TONES{values %TONES} = keys %TONES;
163              
164             my $DEBUG = 1;
165             my $TEXT = 1;
166              
167             # Method error messages
168 1         51 use constant (INVALID_BAND =>
169 1     1   5 "Invalid band selection, expected BAND_A or BAND_B (0/1)");
  1         1  
170 1         54 use constant (INVALID_ONOFF =>
171 1     1   5 "Invalid setting, expected OFF or ON (0/1)");
  1         1  
172 1         50 use constant (NOWRITE =>
173 1     1   5 "Too many arguments (read-only method)");
  1         2  
174 1         50 use constant (INVALID_MODE =>
175 1     1   6 "Invalid mode selection, expected FM or AM (0/1)");
  1         2  
176 1         76 use constant (INVALID_TONE =>
177 1     1   5 "Invalid tone selection, expected 1,3..39 (use ToTone method?)");
  1         2  
178 1         11723 use constant (INVALID_COLOR =>
179 1     1   5 "Invalid color selection, expected 0..7 (use color constants?)");
  1         3  
180              
181             sub new {
182 0     0 0   my $caller = shift;
183 0           my $serial = shift;
184              
185 0           my $self = {};
186            
187 0           my $UNIX = 0;
188 0           my $WINDOWS = 1;
189              
190 0 0         my $os = ($^O eq "MSWin32" ? $WINDOWS : $UNIX);
191              
192 0 0         if ($os == $UNIX) {
    0          
193 0           my $tty = $serial;
194 0           $tty =~ s/[^\w\/\.]//g;
195 0 0         if ($tty) {
196 0 0 0       if ((-r $tty) && (-w $tty)) {
197 0           system("stty 9600 -echo -cstopb raw < $tty");
198 0           $self->{_fd} = gensym;
199 0 0         if (open($self->{_fd}, "+<$tty")) {
200 0           $self->{_serial} = $tty;
201             } else {
202 0           croak "$tty: $!";
203             }
204 0           my $oldfh = select($self->{_fd});
205 0           $|=1;
206 0           select($oldfh);
207             } else {
208 0           $! = 13; # EACCES
209             }
210             }
211             } elsif ($os == $WINDOWS) {
212 0           my $configuration = $serial;
213 0           require Win32::SerialPort;
214 0 0         tie(*FH, 'Win32::SerialPort', $configuration) || croak("Can't tie: $^E");
215 0           $self->{_fd} = *FH;
216 0           $self->{_serial} = $configuration;
217             }
218              
219 0           $self->{_CALLBACK} = {};
220 0           $self->{_TEXT} = $TEXT;
221              
222 0 0 0       if ((!$serial) || $self->{_serial}) {
223 0           bless $self, $caller;
224 0           return $self;
225             } else {
226 0           return undef;
227             }
228             }
229              
230             ##################
231             # Sends the raw argument straight to the serial port
232             sub Send {
233 0     0 0   my $self = shift;
234 0           my $data = shift;
235 0           local($_);
236              
237 0 0         if ($DEBUG) {
238 0           my $ddata = $data;
239 0           chop($ddata);
240 0           $ddata =~ s/[^\w\s]/./g;
241 0           print "[Debug] Sending: $ddata [";
242 0           print join(" ", map(sprintf("%02x", ord($_)), split(//, $data)));
243 0           print "]\n";
244             }
245              
246 0 0         if ($self->{_TEXT}) {
247 0           my $S = $self->{_fd};
248 0           print $S $data;
249             } else {
250 0           syswrite($self->{_fd}, $data, length($data));
251             }
252             }
253             sub RawSend {
254 0     0 1   &Send(@_);
255             }
256              
257             ##################
258             # Receives raw data from the serial port.
259             sub RawReceive {
260 0     0 1   my $self = shift;
261 0   0       my $timeout = shift || 0.3;
262 0           my $buf = "";
263              
264 0 0         if ($self->{_TEXT}) {
265 0           my $save = $/;
266 0           $/ = "\r";
267 0           my $S = $self->{_fd};
268 0           $buf = <$S>;
269 0           $/ = $save;
270             } else {
271 0           my ($rin, $rout, $t);
272 0           vec($rin, fileno($self->{_fd}), 1) = 1;
273 0           while (select($rout=$rin, undef, undef, $timeout)) {
274 0           sysread($self->{_fd}, $t, 1);
275 0           $buf .= $t;
276             }
277             }
278              
279 0 0         if ($DEBUG) {
280 0           my $ddata = $buf;
281 0           chop($ddata);
282 0           $ddata =~ s/[^\w\s]/./g;
283 0           print "[Debug] Received: $ddata [";
284 0           print join(" ", map(sprintf("%02x", ord($_)), split(//, $buf)));
285 0           print "]\n";
286             }
287              
288 0           return $buf;
289             }
290              
291             ##################
292             # Performs an action and returns the results
293             sub Do {
294 0     0 0   my $self = shift;
295 0           my $message = shift;
296 0           my $args = shift;
297 0 0         $args = " $args" if defined($args);
298 0           $args .= join(",", @_);
299              
300 0           my $success = $self->Send("$message$args\r");
301              
302 0 0         if ($success) {
303 0 0         my $result = $self->RawReceive($self->{Timeout} ? $self->{Timeout} : 0.3);
304              
305 0           chomp($result);
306 0 0         return wantarray ? () : undef if $result eq "N";
    0          
307 0 0         $self->do_poll($result) if $self->{_PollOnResult};
308              
309 0           $result =~ s/^\S+\s*//;
310              
311 0 0         return wantarray ? split(/,/, $result) : $result;
312             } else {
313 0 0         return wantarray ? () : undef;
314             }
315             }
316              
317             ##################
318             # Enters binary mode for sending/receiving data
319             sub BinaryMode {
320 0     0 1   my $self = shift;
321 0           my $onoff = shift;
322              
323 0           &validate($onoff, INVALID_ONOFF, undef, ON, OFF);
324              
325 0 0         $self->{_TEXT} = (!$onoff) if defined($onoff);
326 0           return $self->{_TEXT};
327             }
328              
329             sub GetSocket {
330 0     0 0   my $self = shift;
331              
332 0           return $self->{_fd};
333             }
334              
335             # Checks the values of an argument to be sure it's within a required range
336             sub validate {
337 0     0 0   my $what = shift;
338 0   0       my $message = shift || "Invalid argument '$what'";
339              
340 0           for my $v (@_) {
341 0 0         return 1 if $v eq $what;
342             }
343              
344 0 0         if (defined($what)) {
345 0           croak $message;
346             } else {
347 0           croak "Insufficient arguments";
348             }
349             }
350              
351             ##################
352             # Waits $timeout seconds (or indefinitely if undef'd) for a notification
353             # from the D7 about an event. It then passes that event off to any
354             # defined callback function and returns.
355             # Returns: undef=timed out, 0=no callback function, 1=callback called
356             # If called in a list context, the actual line received is returned as
357             # the second argument.
358             sub Poll {
359 0     0 1   my $self = shift;
360 0           my $timeout = shift;
361              
362             # AI must be ON for polling to do anything useful
363 0 0         $self->AI(ON) unless $self->{_AI};
364              
365 0           my ($rin, $rout, $t, $buf);
366 0           vec($rin, fileno($self->{_fd}), 1) = 1;
367 0           while (select($rout=$rin, undef, undef, $timeout)) {
368 0           sysread($self->{_fd}, $t, 1);
369 0           $buf .= $t;
370 0 0         if ($t eq "\r") {
371 0 0         if ($DEBUG) {
372 0           my $ddata = $buf;
373 0           chop($ddata);
374 0           $ddata =~ s/[^\w\s]/./g;
375 0           print "[Debug] Received: $ddata [";
376 0           print join(" ", map(sprintf("%02x", ord($_)), split(//, $buf)));
377 0           print "]\n";
378             }
379 0           chop($buf);
380 0           return $self->do_poll($buf);
381             }
382             }
383 0           return undef;
384             }
385              
386             ##################
387             # Used by Poll and RawReceive to check incoming text to see if we should
388             # pass it off to a callback function
389             sub do_poll {
390 0     0 0   my $self = shift;
391 0           my $buf = shift;
392              
393 0           my ($cmd, $args) = ($buf =~ /^(\S+)\s*(.*)/);
394              
395             # Quick hack to make TC callbacks work -- TS is not a real command?
396 0 0         $cmd = "TC" if $cmd eq "TS";
397              
398 0           my @args = split(/,/, $args);
399 0 0         if (exists($self->{_CALLBACK}->{$cmd})) {
    0          
400 0           &{$self->{_CALLBACK}->{$cmd}}($self, $cmd, split(/,/,$args));
  0            
401 0 0         return wantarray ? (1, $cmd, @args) : 1;
402             } elsif (exists($self->{_CALLBACK}->{_DEFAULT_})) {
403 0           &{$self->{_CALLBACK}->{_DEFAULT_}}($self, $cmd, split(/,/,$args));
  0            
404 0 0         return wantarray ? (0, $cmd, @args) : 1;
405             } else {
406 0 0         return wantarray ? (0, $cmd, @args) : 0;
407             }
408             }
409              
410             ##################
411             # Adds a coderef to the callback hash for the specified command
412             sub add_callback {
413 0     0 0   my $self = shift;
414 0           my $which = shift;
415 0           my $proc = shift;
416              
417 0 0         undef $proc if $proc == NOCALLBACK;
418              
419 0 0         if (defined($proc)) {
420 0           $self->{_CALLBACK}->{$which} = $proc;
421             } else {
422 0           delete $self->{_CALLBACK}->{$which};
423             }
424             }
425              
426             ##################
427             # Sets the "default" callback function, where unassigned callback events go.
428             sub Callback {
429 0     0 1   my $self = shift;
430 0           my $proc = shift;
431              
432 0 0 0       return $self->add_callback("_DEFAULT_", $proc) if
433             (ref($proc) eq "CODE" || (!defined($proc)));
434 0           croak "Not a code ref to Callback method";
435             }
436              
437             ##################
438             # Changes the PollOnResult flag. If set, callback functions will be
439             # called for arguments returned from explicitely sent commands instead
440             # of just when things on the D7 change.
441             sub PollOnResult {
442 0     0 1   my $self = shift;
443 0           my $setting = shift;
444              
445 0           &validate($setting, INVALID_ONOFF, undef, ON, OFF);
446              
447 0 0         $self->{_PollOnResult} = $setting if defined($setting);
448 0           return $self->{_PollOnResult};
449             }
450              
451             ##################
452             sub Simple_OnOff {
453 0     0 0   my $item = shift;
454 0           my $self = shift;
455 0           my $setting = shift;
456              
457 0 0         return $self->add_callback($item, $setting) if ref($setting) eq "CODE";
458 0           &validate($setting, INVALID_ONOFF, undef, ON, OFF);
459              
460 0           $self->Do($item, $setting);
461             }
462              
463             sub Simple_Text {
464 0     0 0   my $item = shift;
465 0           my $self = shift;
466 0           my $text = shift;
467              
468 0 0         return $self->add_callback($item, $text) if ref($text) eq "CODE";
469              
470 0           $self->Do($item, $text);
471             }
472              
473             sub Unknown {
474 0     0 1   my $item = shift;
475 0           my $self = shift;
476              
477 0 0         if ($^W) {
478 0           carp("Warning, $item is an unknown/undefined D7 function in THD7.pm version $VERSION");
479             }
480 0 0         return $self->add_callback($item, $_[0]) if ref($_[0]) eq "CODE";
481              
482 0           $self->Do($item, @_);
483             }
484              
485             sub ToStep {
486 0     0 1   my ($self, $step) = @_;
487 0 0         $step = $self unless ref($self);
488 0           return $STEPS{$step};
489             }
490             sub FromStep {
491 0     0 1   my ($self, $step) = @_;
492 0 0         $step = $self unless ref($self);
493 0           return $REV_STEPS{$step};
494             }
495             sub ToTone {
496 0     0 1   my ($self, $tone) = @_;
497 0 0         $tone = $self unless ref($self);
498 0           return $TONES{$tone};
499             }
500             sub FromTone {
501 0     0 1   my ($self, $tone) = @_;
502 0 0         $tone = $self unless ref($self);
503 0           return $REV_TONES{$tone};
504             }
505             sub ToPosit {
506 0     0 1   my $self = shift;
507 0 0         unshift(@_, $self) unless ref($self);
508 0           my $latm = shift;
509 0           my $lats = shift;
510 0           my $longm = shift;
511 0           my $longs = shift;
512 0           my ($ns, $ew);
513              
514 0 0         if ($latm < 0) {
515 0           $ns = 1;
516 0           $latm *= -1;
517             } else {
518 0           $ns = 0;
519             }
520              
521 0 0         if ($longm < 0) {
522 0           $ew = 1;
523 0           $longm *= -1;
524             } else {
525 0           $ew = 0;
526             }
527              
528 0           my $posit = sprintf("%02d%05d%1d%03d%05d%1d", $latm, $lats * 1000,
529             $ns, $longm, $longs * 1000, $ew);
530              
531 0 0         if ($DEBUG) {
532 0           print "[DEBUG] $latm' $lats\" $ns x $longm' $longs\" $ew -> $posit\n";
533             }
534 0           return $posit;
535             }
536             sub FromPosit {
537 0     0 1   my $self = shift;
538 0 0         unshift(@_, $self) unless ref($self);
539 0           my $posit = shift;
540              
541 0           my $latm = substr($posit, 0, 2);
542 0           my $lats = substr($posit, 2, 5) / 1000;
543 0           my $ns = substr($posit, 7, 1);
544 0           my $longm = substr($posit, 8, 3);
545 0           my $longs = substr($posit, 11, 5) / 1000;
546 0           my $ew = substr($posit, 16, 1);
547              
548 0 0         $latm *= -1 if $ns;
549 0 0         $longm *= -1 if $ew;
550              
551 0           return ($latm, $lats, $longm, $longs);
552             }
553              
554             # Begin TH-D7 Functions
555              
556             ##################
557             # Advanced output
558             #
559             # Syntax:
560             # AI [0|1]
561             # AI [OFF|ON]
562             #
563             # Turns on output functions. Immediate functions output to the serial port.
564             # This feature must be enabled before polling for events.
565             #
566             sub AI {
567 0     0 1   my $self = shift;
568 0           my $which = shift;
569              
570 0 0         return $self->add_callback("AI", $which) if ref($which) eq "CODE";
571 0           &validate($which, INVALID_ONOFF, undef, ON, OFF);
572              
573 0           $self->{_AI} = $self->Do("AI", $which);
574             }
575              
576             ##################
577             # Advanced Intercept Point
578             #
579             # Syntax:
580             # AIP [0|1]
581             # AIP [OFF|ON]
582             #
583             # Alias: VHFAIP
584             #
585             sub AIP {
586 0     0 0   &Simple_OnOff("AIP", @_);
587             }
588 0     0 1   sub VHFAIP { &AIP(@_); }
589              
590             ##################
591             # Automatic Message Reply
592             #
593             # Syntax:
594             # AMR [0|1]
595             # AMR [OFF|ON]
596             #
597             sub AMR {
598 0     0 0   my $self = shift;
599 0           my $mode = shift;
600              
601 0 0         return $self->add_callback("AMR", $mode) if ref($mode) eq "CODE";
602             # &validate($mode, ...);
603              
604 0           $self->Do("AMR", $mode);
605             }
606              
607             ##################
608             # Send APRS message
609             #
610             # Syntax: AMGS [Callsign][Message]
611             #
612             # Alias: APRS_Send
613             #
614             sub AMSG {
615 0     0 0   my $self = shift;
616 0           my $callsign = shift;
617 0           my $message = shift;
618              
619 0 0         return $self->add_callback("AMSG", $message) if ref($message) eq "CODE";
620             # Both parameters are strings so validation step has been left out.
621            
622 0           $self->Do("AMSG", 0, $callsign, $message);
623             }
624 0     0 0   sub APRS_Send { &AMSG(@_); }
625              
626             ##################
627             # Automatic Power Off
628             #
629             # APO [0..2]
630             # APO [OFF|APO_30|APO_60]
631             #
632             # This subroutine returns a second argument that, when ON, indicates the unit is
633             # about to power off due to inactivity.
634             #
635             sub APO {
636 0     0 1   my $self = shift;
637 0           my $setting = shift;
638              
639 0 0         return $self->add_callback("APO", $setting) if ref($setting) eq "CODE";
640 0           &validate($setting,
641             "Invalid APO setting, expected OFF/APO_30/APO_60 [0..2]", undef, OFF,
642             APO_30, APO_60);
643              
644 0           $self->Do("APO", $setting);
645             }
646              
647             ##################
648             # Auto Repeater Offset
649             #
650             # Syntax:
651             # ARO [0|1]
652             # ARO [OFF|ON]
653             #
654             # Alias: AutoOffset
655             #
656             sub ARO {
657 0     0 0   &Simple_OnOff("ARO", @_);
658             }
659 0     0 1   sub AutoOffset { &ARO(@_); }
660              
661             ##################
662             # APRS Position Limit
663             #
664             # Syntax: ARL n (units dependent upon UNIT setting)
665             # Alias: APRS_PosLimit
666             #
667             sub ARL {
668 0     0 0   my $self = shift;
669 0           my $setting = shift;
670              
671 0 0         return $self->add_callback("ARL", $setting) if ref($setting) eq "CODE";
672              
673 0 0         $setting = sprintf("%04d", $setting) if defined($setting);
674 0           $self->Do("ARL", $setting);
675             }
676 0     0 1   sub APRS_PosLimit { &ARL(@_); }
677              
678             ##################
679             # Speaker Balance
680             #
681             # Syntax: BAL [0|1],[0..4], 0=A Only, 4=B Only, 2=Even
682             #
683             # Alias: Balance
684             #
685             # Returns: Balance [0..4]
686             #
687             sub BAL {
688 0     0 0   my $self = shift;
689 0           my $balance = shift;
690              
691 0 0         return $self->add_callback("BAL", $balance) if ref($balance) eq "CODE";
692 0           &validate($balance, "Invalid balance setting (0..4)", undef, 0..4);
693              
694 0           $self->Do("BAL", $balance);
695             }
696 0     0 1   sub Balance { &BAL(@_); }
697              
698             ##################
699             # Band Switch
700             #
701             # Syntax:
702             # BC [0|1]
703             # BC [A|B]
704             # Alias: Band
705             #
706             # Returns: Band A/B [0|1]
707             #
708             sub BC {
709 0     0 0   my $self = shift;
710 0           my $which = shift;
711              
712 0 0         return $self->add_callback("BC", $which) if ref($which) eq "CODE";
713 0           &validate($which, INVALID_BAND, undef, BAND_A, BAND_B);
714              
715 0           $self->Do("BC", $which);
716             }
717 0     0 1   sub Band { &BC(@_); }
718              
719             ##################
720             # APRS Beacon
721             #
722             # Syntax:
723             # BCN [0|1]
724             # BCN [OFF|ON]
725             #
726             # Alias: APRS_Beacon
727             #
728             sub BCN {
729 0     0 0   &Simple_OnOff("BCN", @_);
730             }
731 0     0 1   sub APRS_Beacon { &BCN(@_); }
732              
733             ##################
734             # Bell
735             #
736             # Syntax:
737             # BEL [0|1],[0|1]
738             # BEL [A|B],[OFF|ON]
739             # Alias: Bell
740             #
741             # Turn bell on or off for band A or band B
742             #
743             sub BEL {
744 0     0 0   my $self = shift;
745 0           my $band = shift;
746 0           my $setting = shift;
747              
748 0 0         return $self->add_callback("BEL", $band) if ref($band) eq "CODE";
749 0           &validate($band, INVALID_BAND, BAND_A, BAND_B);
750 0           &validate($setting, INVALID_ONOFF, undef, ON, OFF);
751              
752 0           my $arg = $band;
753 0 0         $arg = "$band,$setting" if defined($setting);
754              
755 0           $self->Do("BEL", $arg);
756             }
757 0     0 1   sub Bell { &BEL(@_); }
758              
759             ##################
760             # Key Beep Mode
761             #
762             # Syntax:
763             # BEP [0..3]
764             # BEP [OFF|KEY|KEY_DATA|ALL]
765             # Alias: Beep
766             #
767             sub BEP {
768 0     0 0   my $self = shift;
769 0           my $mode = shift;
770              
771 0 0         return $self->add_callback("BEP", $mode) if ref($mode) eq "CODE";
772 0           &validate($mode, "Invalid beep setting, expected 0..3", undef, 0..3);
773              
774 0           $self->Do("BEP", $mode);
775             }
776 0     0 1   sub Beep { &BEP(@_); }
777              
778             ##################
779             # APRS Tone Alert Events
780             #
781             # Syntax: BEPT [0..3]
782             #
783             # Sets a distinct tone alert for APRS events.
784             #
785             sub BEPT {
786 0     0 0   my $self = shift;
787 0           my $mode = shift;
788            
789 0 0         return $self->add_callback("BEPT", $mode) if ref($mode) eq "CODE";
790 0           &validate($mode, "Invalid APRS beep setting, expected 0..3", undef, 0..3);
791              
792 0           $self->Do("BEPT", $mode);
793             }
794              
795             ##################
796             # Store VHO Frequency
797             #
798             # Syntax: BUF [A|B],freq_in_Hz,step,?,rev,tone,ctcss,?,tonefreq,?,ctcssfreq,ofs,mode
799             # Alias: Buffer, Set
800             #
801             # Sets the VFO frequency for band [A|B] to the parameters specified.
802             #
803             sub BUF {
804 0     0 1   my $self = shift;
805 0           my ($band, $freq, $step, $x1, $reverse, $tone, $ctcss, $x2,
806             $tonefreq, $x3, $ctcssfreq, $offset, $mode) = @_;
807              
808 0 0         return $self->add_callback("BUF", $band) if ref($band) eq "CODE";
809 0           &validate($band, INVALID_BAND, BAND_A, BAND_B);
810 0 0         if ($freq) {
811 0 0         croak("Invalid frequency, expected integer Hz") if $freq !~ /^\d+$/;
812 0           &validate($step, "Invalid step range, expected 0..9", 0..9);
813 0           &validate($reverse, INVALID_ONOFF, ON, OFF);
814 0           &validate($tone, INVALID_ONOFF, ON, OFF);
815 0           &validate($ctcss, INVALID_ONOFF, ON, OFF);
816 0           &validate($tonefreq, "Invalid PL freq, expected 1,3..39 (use ToTone method?)", TONES);
817 0           &validate($ctcssfreq, "Invalid CTCSS freq, expected 1,3..39 (use ToTone method?)", TONES);
818 0 0         croak("Invalid repeater offset, expected integer Hz") if $offset !~ /^\d+$/;
819 0           &validate($mode, INVALID_MODE, FM, AM);
820 0 0         $self->Do("BUF", $band, sprintf("%011d", $freq), $step, $x1 ? $x1 : 0,
    0          
    0          
821             $reverse, $tone, $ctcss, $x2 ? $x2 : 0, $tonefreq, $x3 ? $x3 : 0,
822             $ctcssfreq, sprintf("%011d", $offset), $mode);
823             } else {
824 0           $self->Do("BUF", $band);
825             }
826             }
827 0     0 1   sub Buffer { &BUF(@_); }
828 0     0 0   sub Set { &BUF(@_); }
829              
830             ##################
831             # Squlech on Band (Not Writeable)
832             #
833             # Syntax:
834             # BY [0|1],[0|1]
835             # BY [A|B], [CLOSED|OPEN]
836             # Alias: Squelched
837             #
838             # Returns: Band A/B [0|1], Squelch Open [0|1]
839             #
840             sub BY {
841 0     0 0   my $self = shift;
842 0           my $band = shift;
843 0           my $anything_else = shift;
844              
845 0 0         return $self->add_callback("BY", $band) if ref($band) eq "CODE";
846 0           &validate($band, INVALID_BAND, BAND_A, BAND_B);
847 0           &validate($anything_else, NOWRITE, undef);
848              
849 0           $self->Do("BY", $band);
850             }
851 0     0 1   sub Squelched { &BY(@_); }
852              
853             ##################
854             # Channel Display Mode
855             #
856             # Syntax: CH [0|1]
857             # Alias: ChannelMode
858             #
859             # Channel Display mode, access restricted to navigating the stored memory channels ONLY.
860             #
861             sub CH {
862 0     0 0   &Simple_OnOff("CH", @_);
863             }
864 0     0 1   sub ChannelMode { &CH(@_); }
865              
866             ##################
867             # LCD Screen Constrast
868             #
869             # Syntax: CNT [1-16] LCD contrast (8 = default)
870             # Alias: Contrast
871             #
872             sub CNT {
873 0     0 0   my $self = shift;
874 0           my $setting = shift;
875              
876 0 0         return $self->add_callback("CNT", $setting) if ref($setting) eq "CODE";
877 0           &validate($setting, "Invalid contrast setting, expected 1..16", undef,
878             1..16);
879              
880 0 0         if (defined($setting)) {
881 0           $self->Do("CNT", sprintf("%02d", $setting));
882             } else {
883 0           $self->Do("CNT");
884             }
885             }
886 0     0 1   sub Contrast { &CNT(@_); }
887              
888             ##################
889             # CTCSS Enabled
890             #
891             # Syntax:
892             # CT [0|1]
893             # CTCSS [OFF|ON]
894             # Alias: CTCSS
895             #
896             sub CT {
897 0     0 0   &Simple_OnOff("CT", @_);
898             }
899 0     0 1   sub CTCSS { &CT(@_); }
900              
901             ##################
902             # CTCSS Frequency
903             #
904             # Syntax: CTN n
905             # Alias: CTCSSFreq
906             #
907             sub CTN {
908 0     0 0   my $self = shift;
909 0           my $freq = shift;
910              
911 0 0         return $self->add_callback("CTN", $freq) if ref($freq) eq "CODE";
912 0           &validate($freq, "Invalid CTCSS frequency, expected 1,3..39 (use ToTone method?)",
913             undef, TONES);
914              
915 0           $self->Do("CTN", $freq);
916             }
917 0     0 1   sub CTCSSFreq { &CTN(@_); }
918              
919             ##################
920             # Dual Channels
921             #
922             # Syntax: DL [OFF|ON]
923             # Alias: Dual
924             #
925             # Returns: Setting OFF/ON [0|1]
926             #
927             sub DL {
928 0     0 0   &Simple_OnOff("DL", @_);
929             }
930 0     0 1   sub Dual { &DL(@_); }
931              
932             ##################
933             # DTMF Store Sequence in Memory
934             #
935             # Syntax: DM cc,n (store sequence n in memory cc)
936             # Alias: DTMF_Memory
937             #
938             sub DM {
939 0     0 0   my $self = shift;
940 0           my $mem = shift;
941 0           my $num = shift;
942              
943 0 0         return $self->add_callback("DM", $mem) if ref($mem) eq "CODE";
944 0 0         croak "Invalid DTMF memory number, expected integer" unless $mem =~ /^\d+$/;
945              
946 0           $self->Do("DM", sprintf("%02d", $mem), $num);
947             }
948 0     0 1   sub DTMF_Memory { &DM(@_); }
949              
950             ##################
951             # DTMF Names Channel
952             #
953             # Syntax: DMN cc,name
954             # Alias: DTMF_Name
955             #
956             sub DMN {
957 0     0 0   my $self = shift;
958 0           my $mem = shift;
959 0           my $name = shift;
960              
961 0 0         return $self->add_callback("DMN", $mem) if ref($mem) eq "CODE";
962 0 0         croak "Invalid DTMF memory number, expected integer" unless $mem =~ /^\d+$/;
963              
964 0           $self->Do("DMN", sprintf("%02d", $mem), $name);
965             }
966 0     0 1   sub DTMF_Name { &DMN(@_); }
967              
968             ##################
969             # DCD Sense
970             #
971             # Syntax:
972             # DS [0|1]
973             # DS [DATA|BOTH]
974             # Alias: DCDSense
975             #
976             sub DS {
977 0     0 0   my $self = shift;
978 0           my $setting = shift;
979              
980 0 0         return $self->add_callback("DS", $setting) if ref($setting) eq "CODE";
981 0           &validate($setting, "Invalid DS setting, expected DATA/BOTH [0|1]",
982             undef, DATA, BOTH);
983              
984 0           $self->Do("DS", $setting);
985             }
986 0     0 1   sub DCDSense { &DS(@_); }
987              
988             ##################
989             # Set Data BAnd
990             #
991             # Syntax:
992             # DTB [0|1]
993             # DTB [A|B]
994             # Alias: DataBand
995             #
996             sub DTB {
997 0     0 0   &Simple_OnOff("DTB", @_);
998             }
999 0     0 1   sub DataBand { &DTB(@_); }
1000              
1001             ##################
1002             # APRS Data Tx Mode
1003             #
1004             # Syntax:
1005             # DTX [0..2]
1006             # DTX [MANUAL|PTT|AUTO]
1007             # Alias: APRS_TransmitMode
1008             #
1009             sub DTX {
1010 0     0 0   my $self = shift;
1011 0           my $setting = shift;
1012              
1013 0 0         return $self->add_callback("DTX", $setting) if ref($setting) eq "CODE";
1014 0           &validate($setting, "Invalid APRS TX mode, expected MANUAL/PTT/AUTO [0..2]",
1015             undef, MANUAL, PTT, AUTO);
1016              
1017 0           $self->Do("DTX", $setting);
1018             }
1019 0     0 1   sub APRS_TransmitMode { &DTX(@_); }
1020              
1021             ##################
1022             # Set Full Duplex Mode
1023             #
1024             # Syntax:
1025             # DUP [0|1]
1026             # DUP [HALF|FULL]
1027             # Alias: Duplex
1028             #
1029             sub DUP {
1030 0     0 0   &Simple_OnOff("DUP", @_);
1031             }
1032 0     0 1   sub Duplex { &DUP(@_); }
1033              
1034             ##################
1035             # Adjust Frequency Downward
1036             #
1037             # Syntax: DW
1038             # Alias: Down
1039             #
1040             sub DW {
1041 0     0 0   my $self = shift;
1042 0           my $blah = shift;
1043              
1044 0 0         return $self->add_callback("DW", $blah) if ref($blah) eq "CODE";
1045 0           &validate($blah, NOWRITE, undef);
1046              
1047 0           $self->Do("DW");
1048             }
1049 0     0 1   sub Down { &DW(@_); }
1050              
1051             ##################
1052             # Tune Enable
1053             #
1054             # Syntax:
1055             # ELK [0|1]
1056             # ELK [OFF|ON]
1057             # Alias: TuneEnable
1058             #
1059             sub ELK {
1060 0     0 0   &Simple_OnOff("ELK", @_);
1061             }
1062 0     0 1   sub TuneEnable { &ELK(@_); }
1063              
1064             ##################
1065             # Returns an Even Numbered List of Band Extents
1066             #
1067             # Syntax: FL
1068             # Alias: FreqList
1069             #
1070             sub FL {
1071 0     0 0   my $self = shift;
1072 0           my $blah = shift;
1073              
1074 0 0         return $self->add_callback("FL", $blah) if ref($blah) eq "CODE";
1075 0           &validate($blah, NOWRITE, undef);
1076              
1077 0           $self->Do("FL");
1078             }
1079 0     0 1   sub FreqList { &FL(@_); }
1080              
1081             ##################
1082             # Sets the Current Frequency and Select Band
1083             #
1084             # Syntax: FQ
1085             # Alias: Freq
1086             #
1087             # Sets/returns the current frequency and step on the currently selected band.
1088             # This callback is not normally used.
1089             #
1090             sub FQ {
1091 0     0 0   my $self = shift;
1092 0           my $freq = shift;
1093 0           my $step = shift;
1094              
1095 0 0         return $self->add_callback("FQ", $freq) if ref($freq) eq "CODE";
1096 0 0         if (defined($freq)) {
1097 0 0         croak("Invalid frequency, expected integer Hz") unless $freq =~ /^\d+$/;
1098 0           &validate($step, "Invalid step, expected 0..9 (use ToStep method?)",
1099             0..9);
1100 0           $freq .= ",$step";
1101             }
1102              
1103 0           $self->Do("FQ", $freq);
1104             }
1105              
1106             ##################
1107             # GPS Unit
1108             #
1109             # Syntax:
1110             # GU [0|1]
1111             # GU [OFF|ON]
1112             # Alias: GPS
1113             #
1114             sub GU {
1115 0     0 0   &Simple_OnOff("GU", @_);
1116             }
1117 0     0 1   sub GPS { &GU(@_); }
1118              
1119             ##################
1120             # Set APRS Icon
1121             #
1122             # Syntax:
1123             # ICO [0|1],i
1124             # ICO [BUILT-IN|EXTENDED], icon # or string
1125             # Alias: APRS_Icon
1126             #
1127             sub ICO {
1128 0     0 0   my $self = shift;
1129 0           my $extended = shift;
1130 0           my $icon = shift;
1131              
1132 0 0         return $self->add_callback("ICO", $extended) if ref($extended) eq "CODE";
1133 0           &validate($extended, "Invalid icon description flag, expected 1 or 0",
1134             undef, 1, 0);
1135 0 0         if ($extended) {
    0          
1136 0 0         croak "Invalid APRS icon, expected user-defined two-byte icon string"
1137             unless $icon;
1138             } elsif (defined($extended)) {
1139 0           &validate($icon, "Invalid APRS icon, expected built-in hex range 0..E",
1140             0..9, "A".."E", "a".."e");
1141             }
1142              
1143 0           $self->Do("ICO", $extended, $icon);
1144             }
1145 0     0 1   sub APRS_Icon { &ICO(@_); }
1146              
1147             ##################
1148             # Radio ID
1149             #
1150             # Syntax: ID
1151             #
1152             # Returns ID (should be "TH-D7")
1153             #
1154             sub ID {
1155 0     0 1   my $self = shift;
1156 0           my $callback = shift;
1157              
1158 0 0         return $self->add_callback("ID", $callback) if ref($callback) eq "CODE";
1159              
1160 0           $self->Do("ID");
1161             }
1162              
1163             ##################
1164             # Lock Radio
1165             #
1166             # Syntax:
1167             # LK [0|1]
1168             # LK [OFF|ON]
1169             # Alias: Lock
1170             #
1171             sub LK {
1172 0     0 0   &Simple_OnOff("LK", @_);
1173             }
1174 0     0 1   sub Lock { &LK(@_); }
1175              
1176             ##################
1177             # Radio Lamp
1178             #
1179             # Syntax:
1180             # LMP [0|1]
1181             # LMP [OFF|ON]
1182             # Alias: Lamp
1183             #
1184             sub LMP {
1185 0     0 0   &Simple_OnOff("LMP", @_);
1186             }
1187 0     0 1   sub Lamp { &LMP(@_); }
1188              
1189             ##################
1190             # APRS list message
1191             #
1192             # Syntax: LIST
1193             # Alias: APRS_List
1194             #
1195             sub LIST {
1196 0     0 0   my $self = shift;
1197 0           my $message = shift;
1198              
1199 0 0         return $self->add_callback("LIST", $message) if ref($message) eq "CODE";
1200 0           &validate($message, "Invalid message id", undef, 1..40);
1201              
1202 0           $self->Do("LIST", $message, ". KB8VME");
1203             }
1204 0     0 0   sub APRS_List { &LIST(@_); }
1205              
1206             ##################
1207             # MAC Color SSTV
1208             #
1209             # Syntax: MAC color
1210             # Alias: SSTV_CallColor
1211             #
1212             sub MAC {
1213 0     0 0   my $self = shift;
1214 0           my $color = shift;
1215              
1216 0 0         return $self->add_callback("MAC", $color) if ref($color) eq "CODE";
1217 0           &validate($color, INVALID_COLOR, undef, 0..7);
1218              
1219 0           $self->Do("MAC", $color);
1220             }
1221 0     0 1   sub SSTV_CallColor { &MAC(@_); }
1222              
1223             ##################
1224             # Set Memory Channel
1225             #
1226             # Syntax:
1227             # MC [0|1], n
1228             # MC [BAND_A|BAND_B], n
1229             # Alias: Memory
1230             #
1231             sub MC {
1232 0     0 0   my $self = shift;
1233 0           my $band = shift;
1234 0           my $mem = shift;
1235              
1236 0 0         return $self->add_callback("MC", $band) if ref($band) eq "CODE";
1237 0           &validate($band, INVALID_BAND, BAND_A, BAND_B);
1238              
1239 0           $self->Do("MC", $band, $mem);
1240             }
1241 0     0 1   sub Memory { &MC(@_); }
1242              
1243             ##################
1244             # Modulation Mode
1245             #
1246             # Syntax:
1247             # MD [0|1]
1248             # MD [FM|AM]
1249             # Alias: Modulation
1250             #
1251             sub MD {
1252 0     0 0   my $self = shift;
1253 0           my $amfm = shift;
1254              
1255 0 0         return $self->add_callback("MD", $amfm) if ref($amfm) eq "CODE";
1256 0           &validate($amfm, "Invalid modulation, expected AM or FM", undef, AM, FM);
1257              
1258 0           $self->Do("MD", $amfm);
1259             }
1260 0     0 1   sub Modulation { &MD(@_); }
1261              
1262             ##################
1263             # Lock Memory Channel
1264             #
1265             # Syntax:
1266             # MCL [0|1],[0|1]
1267             # MCL [BAND_A|BAND_B] [OFF|ON]
1268             # Alias: MemoryLock
1269             #
1270             sub MCL {
1271 0     0 0   my $self = shift;
1272 0           my $band = shift;
1273 0           my $locked = shift;
1274              
1275 0 0         return $self->add_callback("MCL", $band) if ref($band) eq "CODE";
1276 0           &validate($locked, INVALID_ONOFF, undef, ON, OFF);
1277              
1278 0           $self->Do("MCL", $band, $locked);
1279             }
1280 0     0 1   sub MemoryLock { &MCL(@_); }
1281              
1282             ##################
1283             # Power-on Message
1284             #
1285             # Syntax: MES message
1286             # Alias: Message
1287             #
1288             sub MES {
1289 0     0 0   &Simple_Text("MES", @_);
1290             }
1291 0     0 1   sub Message { &MES(@_); }
1292              
1293             ##################
1294             # Memory Channel Name
1295             #
1296             # Syntax: MNA 0?,n,name (8chars max)
1297             # Alias: MemoryName
1298             #
1299             sub MNA {
1300 0     0 0   my $self = shift;
1301 0           my $x1 = shift;
1302 0           my $mem = shift;
1303 0           my $name = shift;
1304              
1305 0 0         return $self->add_callback("MNA", $x1) if ref($x1) eq "CODE";
1306 0 0         $x1 = 0 unless $x1;
1307 0 0         $mem = 0 unless $mem;
1308              
1309 0           $self->Do("MNA", $x1, $mem, $name);
1310             }
1311 0     0 1   sub MemoryName { &MNA(@_); }
1312              
1313             ##################
1314             # Monitor Mode
1315             #
1316             # Syntax: MON [0|1]
1317             # Alias: Monitor
1318             #
1319             # Turns on/off "monitor" (squelch). Similar in effect to BY, but uses
1320             # the currently selected band.
1321             #
1322             sub MON {
1323 0     0 0   &Simple_OnOff("MON", @_);
1324             }
1325 0     0 1   sub Monitor { &MON(@_); }
1326              
1327             ##################
1328             # Position
1329             #
1330             # Syntax: MP posit (iiffffNiiiffffW)
1331             #
1332             # Use ToPosit method to convert normalized coordinates to this format.
1333             # Alias: Position
1334             #
1335             sub MP {
1336 0     0 0   my $self = shift;
1337 0           my $position = shift;
1338              
1339 0 0         return $self->add_callback("MP", $position) if ref($position) eq "CODE";
1340 0 0 0       croak "Invalid position string (use ToPosit?)"
1341             unless !defined($position) || $position =~ /^\d{15}$/;
1342              
1343 0           $self->Do("MP", $position);
1344             }
1345 0     0 1   sub Position { &MP(@_); }
1346              
1347             ##################
1348             # Read Memory Channel
1349             #
1350             # Syntax: MR 0?,0?,n Reads memory channel n
1351             # This appears to be the only way you can get an "MR" response, so callback
1352             # seems unnecessary
1353             # Alias: MemoryRead
1354             #
1355             sub MR {
1356 0     0 0   my $self = shift;
1357 0           my $x1 = shift;
1358 0           my $x2 = shift;
1359 0           my $mem = shift;
1360              
1361 0 0         return $self->add_callback("MR", $x1) if ref($x1) eq "CODE";
1362 0 0         $x1 = 0 unless $x1;
1363 0 0         $x2 = 0 unless $x2;
1364 0 0         croak "Invalid memory channel, expected integer" unless $mem =~ /^\d+$/;
1365              
1366 0           $self->Do("MR", $x1, $x2, sprintf("%03d", $mem));
1367             }
1368 0     0 1   sub MemoryRead { &MR(@_); }
1369              
1370             ##################
1371             # Memory Write
1372             #
1373             # Syntax: MW 0?,n,freq,step,0?,rev,tone,ctcss,0?,tonefreq,0?,ctcssfreq,ofs,mode,0?
1374             # Alias: MemoryWrite
1375             #
1376             sub MW {
1377 0     0 1   my $self = shift;
1378 0           my ($x1, $mem, $freq, $step, $x2, $reverse, $tone, $ctcss, $x3,
1379             $tonefreq, $x4, $ctcssfreq, $offset, $mode, $x5) = @_;
1380              
1381 0 0         return $self->add_callback("MW", $x1) if ref($x1) eq "CODE";
1382 0 0         if ($freq) {
1383 0 0         croak("Invalid frequency, expected integer Hz") if $freq !~ /^\d+$/;
1384 0           &validate($step, "Invalid step range, expected 0..9 (use ToStep method?)",
1385             0..9);
1386 0           &validate($reverse, INVALID_ONOFF, ON, OFF);
1387 0           &validate($tone, INVALID_ONOFF, ON, OFF);
1388 0           &validate($ctcss, INVALID_ONOFF, ON, OFF);
1389 0           &validate($tonefreq, "Invalid PL freq, expected 1,3..39 (use ToTone method?)",
1390             TONES);
1391 0           &validate($ctcssfreq, "Invalid CTCSS freq, expected 1,3..39 (use ToTone method?)",
1392             TONES);
1393 0 0         croak("Invalid repeater offset, expected integer Hz") if $offset !~ /^\d+$/;
1394 0           &validate($mode, INVALID_MODE, FM, AM);
1395 0 0         $self->Do("MW", $x1 ? $x1 : 0, sprintf("%03d", $mem),
    0          
    0          
    0          
    0          
1396             sprintf("%011d", $freq), $step, $x2 ? $x2 : 0,
1397             $reverse, $tone, $ctcss, $x3 ? $x3 : 0, $tonefreq, $x4 ? $x4 : 0,
1398             $ctcssfreq, sprintf("%011d", $offset), $mode, $x5 ? $x5 : 0);
1399             } else {
1400 0           $self->Do("MW", $x1, $mem);
1401             }
1402             }
1403 0     0 1   sub MemoryWrite { &MW(@_); }
1404              
1405             ##################
1406             # Call
1407             #
1408             # Syntax: MYC call
1409             # Alias: APRS_MyCall
1410             #
1411             sub MYC {
1412 0     0 0   &Simple_Text("MYC", @_);
1413             }
1414 0     0 1   sub APRS_MyCall { &MYC(@_); }
1415              
1416             ##################
1417             # NSFT
1418             #
1419             sub NSFT {
1420 0     0 1   my $self = shift;
1421 0           my $x1 = shift;
1422              
1423 0 0         return $self->add_callback("NSFT", $x1) if ref($x1) eq "CODE";
1424              
1425 0           $self->Do("NSFT", $x1, @_);
1426             }
1427              
1428             ##################
1429             # Repeater Offset
1430             #
1431             # Syntax: OS nnnnnnnnn
1432             # Alias: Offset
1433             #
1434             # Note, repeater offset is in Hz
1435             #
1436             sub OS {
1437 0     0 0   my $self = shift;
1438 0           my $offset = shift;
1439              
1440 0 0         return $self->add_callback("OS", $offset) if ref($offset) eq "CODE";
1441 0 0         $offset = sprintf("%09d", $offset) if defined($offset);
1442              
1443 0           $self->Do("OS", $offset);
1444             }
1445 0     0 1   sub Offset { &OS(@_); }
1446              
1447             ##################
1448             # APRS Position Comment
1449             #
1450             # Syntax:
1451             # POSC [0..7]
1452             # POSC off duty|enroute|in service|returning|committed|special|priority|emergency
1453             # Alias: APRS_Comment
1454             #
1455             sub POSC {
1456 0     0 0   my $self = shift;
1457 0           my $comment = shift;
1458              
1459 0 0         return $self->add_callback("POSC", $comment) if ref($comment) eq "CODE";
1460 0           &validate($comment, "Invalid comment setting, expected 0..9", undef, 0..9);
1461              
1462 0           $self->Do("POSC", $comment);
1463             }
1464 0     0 1   sub APRS_Comment { &POSC(@_); }
1465              
1466             ##################
1467             # APRS Packet Path
1468             # Syntax: PP path
1469             # Alias: APRS_Path
1470             #
1471             sub PP {
1472 0     0 0   &Simple_Text("PP", @_);
1473             }
1474 0     0 1   sub APRS_Path { &PP(@_); }
1475              
1476             ##################
1477             # DTMF Transmit Pause
1478             #
1479             # Syntax:
1480             # PT [0-6]
1481             # PT 100|200|500|750|1000|1500|2000 ms
1482             # Alias: DTMF_Pause
1483             #
1484             sub PT {
1485 0     0 0   my $self = shift;
1486 0           my $pause = shift;
1487              
1488 0 0         return $self->add_callback("PT", $pause) if ref($pause) eq "CODE";
1489 0           &validate($pause, "Invalid pause range, expected 0..6", undef, 0..6);
1490              
1491 0           $self->Do("PT", $pause);
1492             }
1493 0     0 1   sub DTMF_Pause { &PT(@_); }
1494            
1495             ##################
1496             # Programmable VFO
1497             #
1498             # Syntax:
1499             # PV [1|2|3|6],f1,f2
1500             # PV [AIR|VHF_A|VHF_B|UHF] low=f1 high=f2
1501             # Alias: ProgrammableVFO
1502             #
1503             # f1 and f2 are frequencies in MHz.
1504             #
1505             sub PV {
1506 0     0 0   my $self = shift;
1507 0           my $band = shift;
1508 0           my $f1 = shift;
1509 0           my $f2 = shift;
1510              
1511 0 0         return $self->add_callback("PV", $band) if ref($band) eq "CODE";
1512 0           &validate($band, "Invalid PV band, expected AIR/VHF_A/VHF_B/UHF",
1513             AIR, VHF_A, VHF_B, UHF);
1514 0 0         if (defined($f1)) {
1515 0 0         if ($f1 =~ /\D/) {
1516 0           croak("Invalid PV argument, expected numeric MHz value for f1");
1517             }
1518 0 0         if ($f2 =~ /\D/) {
1519 0           croak("Invalid PV argument, expected numeric MHz value for f2");
1520             }
1521 0           $self->Do("PV", $band, sprintf("%05d,%05d", $f1, $f2));
1522             } else {
1523 0           $self->Do("PV", $band);
1524             }
1525             }
1526 0     0 1   sub ProgrammableVFO { &PV(@_); }
1527              
1528             ##################
1529             # Reverse Mode
1530             #
1531             # Syntax: REV [OFF|ON]
1532             # Alias: Reverse
1533             #
1534             # Returns: Setting OFF/ON [0|1]
1535             #
1536             sub REV {
1537 0     0 0   my $self = shift;
1538 0           my $setting = shift;
1539              
1540 0 0         return $self->add_callback("REV", $setting) if ref($setting) eq "CODE";
1541 0           &validate($setting, "Argument must be ON or OFF (1/0)", undef, ON, OFF);
1542              
1543 0           $self->Do("REV", $setting);
1544             }
1545 0     0 1   sub Reverse { &REV(@_); }
1546              
1547             ##################
1548             # SSTV RSV Message
1549             #
1550             # Syntax: RSV message
1551             # Alias: SSTV_RSV
1552             #
1553             sub RSV {
1554 0     0 0   &Simple_Text("RSV", @_);
1555             }
1556 0     0 1   sub SSTV_RSVMessage { &RSV(@_); }
1557              
1558             ##################
1559             # SSTV RSC Color
1560             #
1561             # Syntax: RSC color[0..7]
1562             # Alias: SSTV_RSVColor
1563             #
1564             sub RSC {
1565 0     0 0   my $self = shift;
1566 0           my $color = shift;
1567              
1568 0 0         return $self->add_callback("RSC", $color) if ref($color) eq "CODE";
1569 0           &validate($color, INVALID_COLOR, undef, 0..7);
1570              
1571 0           $self->Do("RSC", $color);
1572             }
1573 0     0 1   sub SSTV_RSVColor { &RSC(@_); }
1574              
1575             ##################
1576             # RX Receive
1577             #
1578             # Syntax: RX
1579             # Alias: Receive
1580             #
1581             # Returns: 1 if success, undef if failure
1582             #
1583             sub RX {
1584 0     0 0   my $self = shift;
1585 0           my $which = shift;
1586              
1587 0 0         return $self->add_callback("RX", $which) if ref($which) eq "CODE";
1588 0           &validate($which, NOWRITE, undef);
1589              
1590 0 0         return defined($self->Do("RX")) ? 1 : undef;
1591             }
1592 0     0 1   sub Receive { &RX(@_); }
1593              
1594             ##################
1595             # Scan Toggle
1596             #
1597             # Syntax:
1598             # SC [0|1]
1599             # SC [OFF|ON]
1600             # Alias: Scan
1601             #
1602             # Begins/stops scanning on the currently selected band
1603             #
1604             sub SC {
1605 0     0 0   &Simple_OnOff("SC", @_);
1606             }
1607 0     0 0   sub Scan { &SC(@_); }
1608              
1609             ##################
1610             # Sky Commander Call Sign
1611             #
1612             # SCC call
1613             # Alias: Sky_CommanderCall
1614             #
1615             sub SCC {
1616 0     0 0   &Simple_Text("SCC", @_);
1617             }
1618 0     0 1   sub Sky_CommanderCall { &SCC(@_); }
1619              
1620             ##################
1621             # Scan Resume
1622             #
1623             # Syntax:
1624             # SCR [0..2]
1625             # SCR [TIME|CARRIER|SEEK]
1626             # Alias: ScanResume
1627             #
1628             sub SCR {
1629 0     0 0   my $self = shift;
1630 0           my $setting = shift;
1631              
1632 0 0         return $self->add_callback("SCR", $setting) if ref($setting) eq "CODE";
1633 0           &validate($setting, "Invalid SCR setting, expected 0..2", undef, 0..2);
1634              
1635 0           $self->Do("SCR", $setting);
1636             }
1637 0     0 1   sub ScanResume { &SCR(@_); }
1638              
1639             ##################
1640             # Sky Command Transporter Call Sign
1641             #
1642             # Syntax: SCT call call sign
1643             # Alias: Sky_TransporterCall
1644             #
1645             sub SCT {
1646 0     0 0   &Simple_Text("SCT", @_);
1647             }
1648 0     0 1   sub Sky_TransporterCall { &SCT(@_); }
1649              
1650             ##################
1651             # Repeater Offset Shift
1652             #
1653             # Syntax:
1654             # SFT [0|1|2]
1655             # SFT [OFF|NEGATIVE|POSITIVE]
1656             # Alias: Shift
1657             #
1658             sub SFT {
1659 0     0 0   my $self = shift;
1660 0           my $setting = shift;
1661              
1662 0 0         return $self->add_callback("SFT", $setting) if ref($setting) eq "CODE";
1663 0           &validate($setting, "Invalid shift, expected OFF/NEGATIVE/POSITIVE",
1664             undef, OFF, NEGATIVE, POSITIVE);
1665              
1666 0           $self->Do("SFT", $setting);
1667             }
1668 0     0 1   sub Shift { &SFT(@_); }
1669              
1670             ##################
1671             # Sky Commander Access Tone
1672             #
1673             # Syntax: SKTN tone [1,3..39]
1674             # Alias: Sky_Tone
1675             #
1676             sub SKTN {
1677 0     0 0   my $self = shift;
1678 0           my $tone = shift;
1679              
1680 0 0         return $self->add_callback("SKTN", $tone) if ref($tone) eq "CODE";
1681 0           &validate($tone, INVALID_TONE, undef, TONES);
1682              
1683 0           $self->Do("SKTN", $tone);
1684             }
1685 0     0 1   sub Sky_Tone { &SKTN(@_); }
1686              
1687             ##################
1688             # Signal Meter
1689             #
1690             # Syntax:
1691             # SM [0|1],nn
1692             # SM [A|B
1693             # Alias: SignalMeter
1694             #
1695             # Returns 00..05, READ ONLY
1696             #
1697             sub SM {
1698 0     0 0   my $self = shift;
1699 0           my $band = shift;
1700 0           my $else = shift;
1701              
1702 0 0         return $self->add_callback("SM", $band) if ref($band) eq "CODE";
1703 0           &validate($band, INVALID_BAND, BAND_A, BAND_B);
1704 0           &validate($else, NOWRITE, undef);
1705              
1706 0           $self->Do("SM", $band);
1707             }
1708 0     0 1   sub SignalMeter { &SM(@_); }
1709              
1710             ##################
1711             # SSTV Message Color
1712             #
1713             # Syntax: SMC color[0..7]
1714             # Alias: SSTV_MessageColor
1715             #
1716             sub SMC {
1717 0     0 0   my $self = shift;
1718 0           my $color = shift;
1719              
1720 0 0         return $self->add_callback("SMC", $color) if ref($color) eq "CODE";
1721 0           &validate($color, INVALID_COLOR, undef, 0..7);
1722             }
1723 0     0 1   sub SSTV_MessageColor { &SMC(@_); }
1724              
1725             ##################
1726             # SSTV Message
1727             #
1728             # Syntax: SMSG msg SSTV
1729             # Alias: SSTV_Message
1730             #
1731             sub SMSG {
1732 0     0 0   &Simple_Text("SMSG", @_);
1733             }
1734 0     0 1   sub SSTV_Message { &SMSG(@_); }
1735              
1736             ##################
1737             # SSTV Call
1738             #
1739             # SMY call
1740             # Alias: SSTV_MyCall
1741             #
1742             sub SMY {
1743 0     0 0   &Simple_Text("SMY", @_);
1744             }
1745 0     0 1   sub SSTV_MyCall { &SMY(@_); }
1746              
1747             ##################
1748             # Squelch
1749             #
1750             # Syntax:
1751             # SQ [0|1],[00..05]
1752             # SQ [A|B] (00=open)
1753             # Alias: Squelch
1754             #
1755             sub SQ {
1756 0     0 0   my $self = shift;
1757 0           my $band = shift;
1758 0           my $value = shift;
1759              
1760 0 0         return $self->add_callback("SQ", $band) if ref($band) eq "CODE";
1761 0           &validate($band, INVALID_BAND, BAND_A, BAND_B);
1762 0           &validate($value, "Invalid squelch setting, expected 0..5 (0=open)",
1763             undef, 0..5);
1764              
1765 0 0         $value = sprintf("%02d", $value) if defined($value);
1766              
1767 0           $self->Do("SQ", $band, $value);
1768             }
1769 0     0 1   sub Squelch { &SQ(@_); }
1770              
1771             ##################
1772             # Set Step Size
1773             #
1774             # Syntax: ST n
1775             # Alias: Step
1776             #
1777             sub ST {
1778 0     0 0   my $self = shift;
1779 0           my $step = shift;
1780              
1781 0 0         return $self->add_callback("ST", $step) if ref($step) eq "CODE";
1782 0           &validate($step, "Invalid step size, expected 0..9 (use ToStep method?)",
1783             undef, 0..9);
1784              
1785 0           $self->Do("ST", $step);
1786             }
1787 0     0 1   sub Step { &ST(@_); }
1788              
1789             ##################
1790             # Set APRS Text
1791             #
1792             # Syntax: STAT text
1793             # Alias: APRS_Status
1794             #
1795             sub STAT {
1796 0     0 0   &Simple_Text("STAT", @_);
1797             }
1798 0     0 1   sub APRS_Status { &STAT(@_); }
1799              
1800             ##################
1801             # APRS Status Tx
1802             #
1803             # Syntax: STXR
1804             # Alias: APRS_StatusTx
1805             #
1806             sub STXR {
1807 0     0 0   my $self = shift;
1808 0           my $level = 1;
1809              
1810 0 0         return $self->add_callback("STXR", $level) if ref($level) eq "CODE";
1811 0           &validate($level, "Invalid statux tx, expected 0..8", undef, 0..8);
1812              
1813 0           $self->Do("STXR", $level);
1814             }
1815 0     0 0   sub APRS_StatusTx { &STXR(@_); }
1816              
1817             ##################
1818             # SSTV Superimpose
1819             #
1820             # Syntax: STC call,n
1821             # Alias: SSTV_Superimpose
1822             #
1823             sub STC {
1824 0     0 0   my $self = shift;
1825 0           my $call = shift;
1826 0           my $x1 = shift;
1827              
1828 0 0         return $self->add_callback("STC", $call) if ref($call) eq "CODE";
1829              
1830 0 0         $self->Do("STC", $call, $x1 ? $x1 : 0);
1831             }
1832 0     0 1   sub SSTV_Superimpose { &STC(@_); }
1833              
1834             ##################
1835             # SSTV Transmit Mode
1836             #
1837             # Syntax: STS transmit mode
1838             # Alias: SSTV_Mode
1839             #
1840             sub STS {
1841 0     0 1   my $self = shift;
1842 0           my $x1 = shift;
1843              
1844 0 0         return $self->add_callback("STS", $x1) if ref($x1) eq "CODE";
1845              
1846 0           $self->Do("STS", $x1, @_);
1847             }
1848 0     0 1   sub SSTV_Mode { &STS(@_); }
1849              
1850             ##################
1851             # Set Battery Saver
1852             #
1853             # Syntax:
1854             # SV [0..9]
1855             # SV (off|0.2|0.4|0.6|0.8|1.0|2|3|4|5)
1856             # Alias: BatterySave
1857             #
1858             sub SV {
1859 0     0 0   my $self = shift;
1860 0           my $mode = shift;
1861              
1862 0 0         return $self->add_callback("SV", $mode) if ref($mode) eq "CODE";
1863 0           &validate($mode, "Invalid saver mode, expected 0..9", undef, 0..9);
1864              
1865 0           $self->Do("SV", $mode);
1866             }
1867 0     0 1   sub BatterySave { &SV(@_); }
1868              
1869             ##################
1870             # TNC Packet Mode
1871             #
1872             # Syntax:
1873             # TC [0|1]
1874             # TC [OFF|ON] WRITE-ONLY
1875             # Alias: Packet
1876             #
1877             # Note: Entering packet mode via the D7 keypad will NOT activate a
1878             # callback via this method.
1879             # Note: While in Packet mode, NO OTHER COMMANDS WILL BE AVAILABLE
1880             # EXCEPT THIS ONE. I suppose if your script is designed for that
1881             # sort of thing, you can use the RawSend and RawReceive methods to
1882             # talk to the TNC directly.
1883             # Note: The command itself actually takes 0=ON and 1=OFF, but we
1884             # switch them in the code.
1885             # Note: A callback will be sent ONLY upon the issue of a TC 1 while
1886             # in packet mode, BUT, this callback uses the command "TS" for some
1887             # strange reason. I think we'll change it to TC in the callback
1888             # code.
1889             #
1890             sub TC {
1891 0     0 0   my $self = shift;
1892 0           my $onoff = shift;
1893              
1894 0 0         return $self->add_callback("TS", $onoff) if ref($onoff) eq "CODE";
1895 0           &validate($onoff, INVALID_ONOFF, ON, OFF);
1896              
1897 0 0         $self->Do("TC", $onoff ? OFF : ON);
1898             }
1899 0     0 1   sub Packet { &TC(@_); }
1900              
1901             ##################
1902             # Toggle APRS Mode
1903             #
1904             # Syntax:
1905             # TNC [0|1]
1906             # TNC [OFF|ON]
1907             #
1908             # A notification will not be sent via this callback in the event the D7
1909             # enters Packet mode.
1910             # Alias: APRS
1911             #
1912             sub TNC {
1913 0     0 1   my $self = shift;
1914 0           my $setting = shift;
1915              
1916 0 0         return $self->add_callback("TNC", $setting) if ref($setting) eq "CODE";
1917 0           &validate($setting, INVALID_ONOFF, undef, ON, OFF);
1918              
1919 0           $self->Do("TNC", $setting);
1920             }
1921 0     0 0   sub APRS { &TNC(@_); }
1922              
1923             ##################
1924             # PL Tone Enable
1925             #
1926             # Syntax: TO [0|1]
1927             # Alias: Tone
1928             #
1929             sub TO {
1930 0     0 0   &Simple_OnOff("TO", @_);
1931             }
1932 0     0 1   sub Tone { &TO(@_); }
1933              
1934             ##################
1935             # PL Tone Frequency
1936             #
1937             # Syntax: TN n
1938             # Alias: ToneFreq
1939             #
1940             sub TN {
1941 0     0 0   my $self = shift;
1942 0           my $tone = shift;
1943              
1944 0 0         return $self->add_callback("TN", $tone) if ref($tone) eq "CODE";
1945 0           &validate($tone, INVALID_TONE, undef, TONES);
1946              
1947 0           $self->Do("TN", $tone);
1948             }
1949 0     0 1   sub ToneFreq { &TN(@_); }
1950              
1951             ##################
1952             # DTMF Transmission Speed
1953             #
1954             # Syntax:
1955             # TSP [0|1]
1956             # TSP [SLOW|FAST]
1957             # Alias: DTMF_Speed
1958             #
1959             sub TSP {
1960 0     0 0   my $self = shift;
1961 0           my $setting = shift;
1962              
1963 0 0         return $self->add_callback("TSP", $setting) if ref($setting) eq "CODE";
1964 0           &validate($setting, "Invalid TSP setting, expected SLOW/FAST [0|1]",
1965             undef, SLOW, FAST);
1966              
1967 0           $self->Do("TSP", $setting);
1968             }
1969 0     0 1   sub DTMF_Speed { &TSP(@_); }
1970              
1971             ##################
1972             # Transmit
1973             #
1974             # Syntax:
1975             # TX [0|1]
1976             # TX [A|B]
1977             # Alias: Transmit
1978             #
1979             # WARNING: THIS WILL CAUSE THE D7 TO TRANSMIT UNTIL AN RX COMMAND IS RECEIVED
1980             # UNLESS THE D7'S TX INHIBIT IS ENABLED.
1981             #
1982             sub TX {
1983 0     0 0   my $self = shift;
1984 0           my $band = shift;
1985              
1986 0 0         return $self->add_callback("TX", $band) if ref($band) eq "CODE";
1987 0           &validate($band, INVALID_BAND, undef, BAND_A, BAND_B);
1988              
1989 0           $self->Do("TX", $band);
1990             }
1991 0     0 1   sub Transmit { &TX(@_); }
1992              
1993             ##################
1994             # DTMF Transmit Hold
1995             #
1996             # Syntax:
1997             # TXH [0|1]
1998             # TXH [OFF|ON]
1999             # Alias: DTMF_TransmitHold
2000             #
2001             sub TXH {
2002 0     0 0   my $self = shift;
2003 0           my $setting = shift;
2004              
2005 0 0         return $self->add_callback("TXH", $setting) if ref($setting) eq "CODE";
2006 0           &validate($setting, INVALID_ONOFF, undef, ON, OFF);
2007              
2008 0           $self->Do("TXH", $setting);
2009             }
2010 0     0 0   sub DTMF_TransmitHold { &TXH(@_) }
2011              
2012             ##################
2013             # APRS Transmit Interval
2014             #
2015             # Syntax: TXI [0..7]
2016             # Alias: APRS_TransmitInterval
2017             #
2018             sub TXI {
2019 0     0 0   my $self = shift;
2020 0           my $setting = shift;
2021              
2022 0 0         return $self->add_callback("TXI", $setting) if ref($setting) eq "CODE";
2023 0           &validate($setting, "Invalid interval, expected 0..7", undef, 0..7);
2024              
2025 0           $self->Do("TXI", $setting);
2026             }
2027 0     0 0   sub APRS_TransmitInterval { &TXI(@_); }
2028              
2029             ##################
2030             # TX Inhibit
2031             #
2032             # Syntax: TXS [0|1]
2033             # Alias: TransmitInhibit
2034             #
2035             sub TXS {
2036 0     0 0   &Simple_OnOff("TXS", @_);
2037             }
2038 0     0 1   sub TransmitInhibit { &TXS(@_); }
2039              
2040             ##################
2041             # Measurement Units
2042             #
2043             # Syntax:
2044             # UNIT [0|1]
2045             # UNIT [ENGLISH|METRIC]
2046             # Alias: Unit
2047             #
2048             sub UNIT {
2049 0     0 0   my $self = shift;
2050 0           my $setting = shift;
2051              
2052 0 0         return $self->add_callback("UNIT", $setting) if ref($setting) eq "CODE";
2053 0           &validate($setting, "Invalid unit selection, expected ENGLISH/METRIC [0|1]",
2054             undef, METRIC, ENGLISH);
2055              
2056 0           $self->Do("UNIT", $setting);
2057             }
2058 0     0 1   sub Unit { &UNIT(@_); }
2059              
2060             ##################
2061             # Adjust the Frequency
2062             #
2063             # Syntax: UP
2064             # Alias: Up
2065             #
2066             sub UP {
2067 0     0 0   my $self = shift;
2068 0           my $blah = shift;
2069              
2070 0 0         return $self->add_callback("DW", $blah) if ref($blah) eq "CODE";
2071 0           &validate($blah, NOWRITE, undef);
2072              
2073 0           $self->Do("UP");
2074             }
2075 0     0 1   sub Up { &UP(@_); }
2076              
2077             ##################
2078             # APRS Unprotocol String
2079             #
2080             # Syntax: UPR unprotocol string
2081             # Alias: APRS_Unprotocol
2082             #
2083             sub UPR {
2084 0     0 0   &Simple_Text("UPR", @_);
2085             }
2086 0     0 1   sub APRS_Unprotocol { &UPR(@_); }
2087              
2088             ##################
2089             # VCS Shutter
2090             #
2091             # Syntax:
2092             # VCS [0|1]
2093             # VCS [OFF|ON]
2094             # Alias: SSTV_Shutter
2095             #
2096             sub VCS {
2097 0     0 0   &Simple_OnOff("VCS", @_);
2098             }
2099 0     0 1   sub SSTV_Shutter { &VCS(@_); }
2100              
2101             ##################
2102             # VMC Band Mode
2103             #
2104             # Syntax:
2105             # VMC [0|1],[0|2|3]
2106             # VMC [A|B], [VFO|Memory|Call]
2107             # Alias: Mode
2108             #
2109             sub VMC {
2110 0     0 0   my $self = shift;
2111 0           my $mode = shift;
2112              
2113 0 0         return $self->add_callback("VMC", $mode) if ref($mode) eq "CODE";
2114 0           &validate($mode, "Invalid mode, expected VFO/MEMORY/CALL (0|2|3)",
2115             undef, 0,2,3);
2116              
2117 0           $self->Do("VMC", $mode);
2118             }
2119 0     0 1   sub Mode { &VMC(@_); }
2120              
2121             ##################
2122             # Read VFO Frequency
2123             #
2124             # Syntax: VR vfo
2125             # Alias: VFORead
2126             #
2127             # Reads the currently set frequency for VFO band vfo.
2128             #
2129             sub VR {
2130 0     0 0   my $self = shift;
2131 0           my $vfo = shift;
2132              
2133 0 0         return $self->add_callback("VR", $vfo) if ref($vfo) eq "CODE";
2134 0           &validate($vfo, "Invalid VFO, expected 1/2/3/6", 1,2,3,6);
2135              
2136 0           $self->Do("VR", $vfo);
2137             }
2138              
2139             ##################
2140             # Write VFO Frequency
2141             #
2142             # Syntax: VW vfo,freq_in_Hz,step,?,rev,tone,ctcss,?,tonefreq,?,ctcssfreq,ofs,mode
2143             # Alias: VFOWrite
2144             #
2145             # Sets the VFO frequency for the specified VFO to the parameters specified.
2146             #
2147             sub VW {
2148 0     0 0   my $self = shift;
2149 0           my ($vfo, $freq, $step, $x1, $reverse, $tone, $ctcss, $x2,
2150             $tonefreq, $x3, $ctcssfreq, $offset, $mode) = @_;
2151              
2152 0 0         return $self->add_callback("VW", $vfo) if ref($vfo) eq "CODE";
2153 0           &validate($vfo, "Invalid VFO, expected 1/2/3/6", 1,2,3,6);
2154 0 0         croak("Invalid frequency, expected integer Hz") if $freq !~ /^\d+$/;
2155 0           &validate($step, "Invalid step range, expected 0..9", 0..9);
2156 0           &validate($reverse, INVALID_ONOFF, ON, OFF);
2157 0           &validate($tone, INVALID_ONOFF, ON, OFF);
2158 0           &validate($ctcss, INVALID_ONOFF, ON, OFF);
2159 0           &validate($tonefreq, "Invalid PL freq, expected 1,3..39 (use ToTone method?)",
2160             TONES);
2161 0           &validate($ctcssfreq, "Invalid CTCSS freq, expected 1,3..39 (use ToTone method?)",
2162             TONES);
2163 0 0         croak("Invalid repeater offset, expected integer Hz") if $offset !~ /^\d+$/;
2164 0           &validate($mode, INVALID_MODE, FM, AM);
2165 0 0         $self->Do("VW", $vfo, sprintf("%011d", $freq), $step, $x1 ? $x1 : 0,
    0          
    0          
2166             $reverse, $tone, $ctcss, $x2 ? $x2 : 0, $tonefreq, $x3 ? $x3 : 0,
2167             $ctcssfreq, sprintf("%011d", $offset), $mode);
2168             }
2169              
2170             # UNKNOWNS
2171              
2172 0     0 1   sub CR { &Unknown("CR", @_); }
2173 0     0 1   sub CW { &Unknown("CW", @_); }
2174 0     0 1   sub GC { &Unknown("GC", @_); }
2175 0     0 1   sub PC { &Unknown("PC", @_); }
2176 0     0 1   sub SR { &Unknown("SR", @_); }
2177 0     0 1   sub TH { &Unknown("TH", @_); }
2178 0     0 1   sub TT { &Unknown("TT", @_); }
2179 0     0 1   sub CIN { &Unknown("CIN", @_); }
2180 0     0 1   sub CTD { &Unknown("CTD", @_); }
2181 0     0 1   sub LAN { &Unknown("LAN", @_); }
2182 0     0 1   sub MIN { &Unknown("MIN", @_); }
2183 0     0 1   sub MNF { &Unknown("MNF", @_); }
2184 0     0 1   sub MSH { &Unknown("MSH", @_); }
2185 0     0 1   sub RBN { &Unknown("RBN", @_); }
2186 0     0 1   sub STM { &Unknown("STM", @_); }
2187 0     0 1   sub STR { &Unknown("STR", @_); }
2188 0     0 1   sub STP { &Unknown("STP", @_); }
2189 0     0 1   sub STT { &Unknown("STT", @_); }
2190 0     0 1   sub TXN { &Unknown("TXN", @_); }
2191 0     0 1   sub TYD { &Unknown("TYD", @_); }
2192 0     0 1   sub ULC { &Unknown("ULC", @_); }
2193              
2194             1;
2195              
2196             __END__