File Coverage

blib/lib/Ham/Device/FT817COMM.pm
Criterion Covered Total %
statement 46 6871 0.6
branch 3 4036 0.0
condition 0 885 0.0
subroutine 7 220 3.1
pod 213 213 100.0
total 269 12225 2.2


line stmt bran cond sub pod time code
1             # This is the Yaesu FT-817 Command Library Module
2             # Written by Jordan Rubin (KJ4TLB)
3             # For use with the FT-817 Serial Interface
4             #
5             # $Id: FT817COMM.pm 2014-23-4 12:00:00Z JRUBIN $
6             #
7             # Copyright (C) 2014, Jordan Rubin
8             # jrubin@cpan.org
9              
10             package Ham::Device::FT817COMM;
11              
12 1     1   54358 use strict;
  1         3  
  1         25  
13 1     1   9 use 5.14.0;
  1         3  
14 1     1   5 use Digest::MD5 qw(md5);
  1         2  
  1         61  
15             our $VERSION = '1.0.8';
16              
17             BEGIN {
18 1     1   5 use Exporter ();
  1         1  
  1         41  
19 1         1587 use vars qw($OS_win $VERSION $debug $verbose $agreewithwarning $writeallow
20             %SMETER %SMETERLIN %PMETER %AGCMODES %TXPWR %OPMODES %VFOBANDS %VFOABASE %VFOBBASE
21             %HOMEBASE %MEMMODES %FMSTEP %AMSTEP %CTCSSTONES %DCSCODES %VFOMEMOPTS %RESTOREAREAS
22             %BITWATCHER %BOUNDRIES %MEMORYBASE %MEMORYOPTS %FREQRANGE %CWID @NEWMEM $output
23 1     1   4 $vfo $bitwatch $bitcheck $txpow $toggled $writestatus $charger);
  1         2  
24              
25 1     1   4 my $ft817;
26             my $output;
27              
28 1         16 our %RESTOREAREAS = ('0055' => '00', '0057' => '00', '0058' => '00', '0059' => '45', '005B' => '86', '005C' => 'B2',
29             '005D' => '42', '005E' => '08', '005F' => 'E5', '0060' => '19', '0061' => '32', '0062' => '48',
30             '0063' => 'B2', '0064' => '05', '0065' => '00', '0066' => '00', '0067' => 'B2', '0068' => '32',
31             '0069' => '32', '006A' => '32', '006B' => '32', '006C' => '32', '006D' => '00', '006E' => '00',
32             '006F' => '00', '0070' => '00', '0071' => '00', '0072' => '00', '0073' => '00', '0074' => '00',
33             '0079' => '03', '007A' => '0F', '007B' => '08', '044F' => '00');
34              
35 1         3 our %AGCMODES = (AUTO => '00', FAST => '01', SLOW => '10', OFF => '11');
36              
37 1         6 our %MEMMODES = (LSB => '000', USB => '001', CW => '010', CWR => '011', AM => '100',
38             FM => '101', DIG => '110', PKT => '111');
39              
40 1         7 our %VFOMEMOPTS = (MODE => '1', NARFM => '2', NARCWDIG => '3', RPTOFFSET => '4', TONEDCS => '5',
41             ATT => '6', IPO => '7', FMSTEP => '8', AMSTEP => '9', SSBSTEP => '10', CTCSSTONE => '11',
42             DCSCODE => '12', CLARIFIER => '13', CLAROFFSET => '14', RXFREQ => '15', RPTOFFSETFREQ => '16');
43              
44 1         8 our %MEMORYOPTS = (MODE => '1', HFVHF => '2', TAG => '3', FREQRANGE => '4', NARFM => '5',
45             NARCWDIG => '6', UHF => '7', RPTOFFSET => '8', TONEDCS => '9', ATT => '10', IPO => '11',
46             MEMSKIP => '12', FMSTEP => '13', AMSTEP => '14', SSBSTEP => '15', CTCSSTONE => '16',
47             DCSCODE => '17', CLARIFIER => '18', CLAROFFSET => '19', RXFREQ => '20', RPTOFFSETFREQ => '21',
48             LABEL => '22', READY => '23');
49              
50 1         13 our %FMSTEP = ('5.0' => '000', '6.25' => '001', '10.0' => '010', '12.5' => '011', '15.0' => '100',
51             '20.0' => '101', '25.0' => '110', '50.0' => '111');
52              
53 1         15 our %CWID = ('0' => '0', '1' => '1', '2' => '2', '3' => '3', '4' => '4', '5' => '5', '6' => '6', '7' => '7',
54             '8' => '8', '9' => '9', 'A' => 'A', 'B' => 'B', 'C' => 'C', 'D' => 'D', 'E' => 'E', 'F' => 'F',
55             '10' => 'G', '11' => 'H', '12' => 'I', '13' => 'J', '14' => 'K', '15' => 'L', '16' => 'M', '17' => 'N',
56             '18' => 'O', '19' => 'P', '1A' => 'Q', '1B' => 'R', '1C' => 'S', '1D' => 'T', '1E' => 'U', '1F' => 'V',
57             '20' => 'W', '21' => 'X', '22' => 'Y', '23' => 'Z', '24' =>' ');
58              
59 1         9 our %AMSTEP = ('2.5' => '000', '5.0' => '001', '9.0' => '010', '10.0' => '011', '12.5' => '100',
60             '25.0' => '101');
61              
62 1         30 our %CTCSSTONES = ('000000' => '67.0', '000001' => '69.3', '000010' => '71.9', '000011' => '74.4',
63             '000100' => '77.0', '000101' => '79.7', '000110' => '82.5', '000111' => '85.4',
64             '001000' => '88.5', '001001' => '91.5', '001010' => '94.8', '001011' => '97.4',
65             '001100' => '100.0', '001101' => '103.5', '001110' => '107.2', '001111' => '110.9',
66             '010000' => '114.8', '010001' => '118.8', '010010' => '123.0', '010011' => '127.3',
67             '010100' => '131.8', '010101' => '136.5', '010110' => '141.3', '010111' => '146.2',
68             '011000' => '151.4', '011001' => '156.7', '011010' => '159.8', '011011' => '162.2',
69             '011100' => '165.5', '011101' => '167.9', '011110' => '171.3', '011111' => '173.8',
70             '100000' => '177.3', '100001' => '179.9', '100010' => '183.5', '100011' => '186.2',
71             '100100' => '189.6', '100101' => '192.8', '100110' => '196.6', '100111' => '199.5',
72             '101000' => '203.5', '101001' => '206.5', '101010' => '210.7', '101011' => '218.1',
73             '101100' => '225.7', '101101' => '229.1', '101110' => '233.6', '101111' => '241.8',
74             '110000' => '250.3', '110001' => '254.1');
75              
76 1         40 our %DCSCODES = ('0000000' => '023', '0000001' => '025', '0000010' => '026', '0000011' => '031',
77             '0000100' => '032', '0000101' => '036', '0000110' => '043', '0000111' => '047',
78             '0001000' => '051', '0001001' => '053', '0001010' => '054', '0001011' => '065',
79             '0001100' => '071', '0001101' => '072', '0001110' => '073', '0001111' => '074',
80             '0010000' => '114', '0010001' => '115', '0010010' => '116', '0010011' => '122',
81             '0010100' => '125', '0010101' => '131', '0010110' => '132', '0010111' => '134',
82             '0011000' => '143', '0011001' => '145', '0011010' => '152', '0011011' => '155',
83             '0011100' => '156', '0011101' => '162', '0011110' => '165', '0011111' => '172',
84             '0100000' => '174', '0100001' => '205', '0100010' => '212', '0100011' => '223',
85             '0100100' => '225', '0100101' => '226', '0100110' => '243', '0100111' => '244',
86             '0101000' => '245', '0101001' => '246', '0101010' => '251', '0101011' => '252',
87             '0101100' => '255', '0101101' => '261', '0101110' => '263', '0101111' => '265',
88             '0110000' => '266', '0110001' => '271', '0110010' => '274', '0110011' => '306',
89             '0110100' => '311', '0110101' => '315', '0110110' => '325', '0110111' => '331',
90             '0111000' => '332', '0111001' => '343', '0111010' => '346', '0111011' => '351',
91             '0111100' => '356', '0111101' => '364', '0111110' => '365', '0111111' => '371',
92             '1000000' => '411', '1000001' => '412', '1000010' => '413', '1000011' => '423',
93             '1000100' => '431', '1000101' => '432', '1000110' => '445', '1000111' => '446',
94             '1001000' => '452', '1001001' => '454', '1001010' => '455', '1001011' => '462',
95             '1001100' => '464', '1001101' => '465', '1001110' => '466', '1001111' => '503',
96             '1010000' => '506', '1010001' => '516', '1010010' => '523', '1010011' => '526',
97             '1010100' => '532', '1010101' => '546', '1010110' => '565', '1010111' => '606',
98             '1011000' => '612', '1011001' => '624', '1011010' => '627', '1011011' => '631',
99             '1011100' => '632', '1011101' => '654', '1011110' => '662', '1011111' => '664',
100             '1100000' => '703', '1100001' => '712', '1100010' => '723', '1100011' => '731',
101             '1100100' => '732', '1100101' => '734', '1100110' => '743', '1100111' => '754');
102              
103             # Convention is ..... BYTE [76543210]
104             #
105             # BIT 7 -> 0 , 6 -> 1, 5 -> 2, 4 -> 3, 3 -> 4, 2 -> 5, 1 -> 6, 0 -> 7
106             #
107             # USE ALL => 76543210 for whole BYTE
108             #
109             # 'address' => {
110             # 'bit' => 'value'
111             # }
112 1         107 our %BITWATCHER = (
113             '0006' => {'ALL' => '10100101'},
114             '0055' => {'4' => '0','1' => '0'},
115             '0055' => {'4' => '0'},
116             '0056' => {'ALL' => '10000010'},
117             '0057' => {'4' => '0'},
118             '0058' => {'4' => '0'},
119             '005A' => {'ALL' => '01110001'},
120             '005B' => {'2' => '0'},
121             '0061' => {'0' => '0'},
122             '0065' => {'4' => '0'},
123             '0066' => {'2' => '0'},
124             '0069' => {'0' => '0'},
125             '006A' => {'0' => '0'},
126             '006C' => {'0' => '0'},
127             '0075' => {'0' => '0','1' => '0'},
128             '0076' => {'0' => '0','1' => '0','2' => '0','3' => '0'},
129             '0077' => {'ALL' => '00000000'},
130             '0078' => {'ALL' => '00000000'},
131             '0079' => {'5' => '0'},
132             '007A' => {'1' => '0'},
133             '007B' => {'0' => '0','1' => '0','2' => '0'},
134              
135             '017A' => {'ALL' => '01001000'},
136             '017B' => {'ALL' => '00101101'},
137             '017C' => {'ALL' => '00110000'},
138             '017D' => {'ALL' => '00110000'},
139             '017E' => {'ALL' => '00110010'},
140             '017F' => {'ALL' => '00100000'},
141             '0180' => {'ALL' => '00100000'},
142              
143             '03B5' => {'ALL' => '00110011'},
144             '03B6' => {'ALL' => '00110011'},
145             '03B7' => {'ALL' => '00110011'},
146             '03B8' => {'ALL' => '00100000'},
147             '03B9' => {'ALL' => '00100000'},
148             '03BA' => {'ALL' => '00100000'},
149             '03BB' => {'ALL' => '00100000'},
150             '03BC' => {'ALL' => '00100000'},
151              
152             '03CF' => {'ALL' => '01001000'},
153             '03D0' => {'ALL' => '01001111'},
154             '03D1' => {'ALL' => '01001101'},
155             '03D2' => {'ALL' => '01000101'},
156             '03D3' => {'ALL' => '00101101'},
157             '03D4' => {'ALL' => '00110010'},
158             '03D5' => {'ALL' => '01001101'},
159             '03D6' => {'ALL' => '00100000'},
160              
161             '0437' => {'ALL' => '11111111'},
162             '0438' => {'ALL' => '11111111'},
163             '0439' => {'ALL' => '11111111'},
164             '043A' => {'ALL' => '11111111'},
165             '043B' => {'ALL' => '11111111'},
166             '043C' => {'ALL' => '11111111'},
167             '043D' => {'ALL' => '11111111'},
168             '043E' => {'ALL' => '11111111'},
169             '043F' => {'ALL' => '00000000'},
170             '0440' => {'ALL' => '00000010'},
171             '0441' => {'ALL' => '10111111'},
172             '0442' => {'ALL' => '00100000'},
173             '0443' => {'ALL' => '00000000'},
174             '0444' => {'ALL' => '00000011'},
175             '0445' => {'ALL' => '00001101'},
176             '0446' => {'ALL' => '01000000'},
177             '0447' => {'ALL' => '00000000'},
178             '0448' => {'ALL' => '01001100'},
179             '0449' => {'ALL' => '01001011'},
180             '044A' => {'ALL' => '01000000'},
181             '044B' => {'ALL' => '00000000'},
182             '044C' => {'ALL' => '01010010'},
183             '044D' => {'ALL' => '01100101'},
184             '044E' => {'ALL' => '11000000'},
185              
186             '046B' => {'ALL' => '00000000'},
187             '046C' => {'ALL' => '00000000'},
188             '046D' => {'ALL' => '00000000'},
189             '046E' => {'ALL' => '00000000'},
190             '046F' => {'ALL' => '00000000'},
191             '0470' => {'ALL' => '00000000'},
192             '0471' => {'ALL' => '00000000'},
193             '0472' => {'ALL' => '00000000'},
194             '0473' => {'ALL' => '00000000'},
195             '0474' => {'ALL' => '00000000'},
196             '0475' => {'ALL' => '00000000'},
197             '0476' => {'ALL' => '00000000'},
198             '0477' => {'ALL' => '00000000'},
199             '0478' => {'ALL' => '00000000'},
200             '0479' => {'ALL' => '00000000'},
201             '047A' => {'ALL' => '00000000'},
202             '047B' => {'ALL' => '00000000'},
203             '047C' => {'ALL' => '00000000'},
204             '047D' => {'ALL' => '00000000'},
205             '047E' => {'ALL' => '00000000'},
206             '047F' => {'ALL' => '00000000'},
207             '0480' => {'ALL' => '00000000'},
208             '0481' => {'ALL' => '00000000'},
209             '0482' => {'ALL' => '10000000'},
210             '0483' => {'ALL' => '00000000'},
211              
212             '1908' => {'ALL' => '01100001'},
213             '1909' => {'ALL' => '00000000'},
214             '190A' => {'ALL' => '00000000'},
215             '190B' => {'ALL' => '01001000'},
216             '190C' => {'ALL' => '00000000'},
217             '190D' => {'ALL' => '00000000'},
218             '190E' => {'ALL' => '00001000'},
219             '190F' => {'ALL' => '00000000'},
220             '1910' => {'ALL' => '00000000'},
221             '1911' => {'ALL' => '00000000'},
222             '1912' => {'ALL' => '00000000'},
223             '1913' => {'ALL' => '00000111'},
224             '1914' => {'ALL' => '11100010'},
225             '1915' => {'ALL' => '10001110'},
226             '1916' => {'ALL' => '00000000'},
227             '1917' => {'ALL' => '00000000'},
228             '1918' => {'ALL' => '00100111'},
229             '1919' => {'ALL' => '00010000'},
230             '191A' => {'ALL' => '11111111'},
231             '191B' => {'ALL' => '11111111'},
232             '191C' => {'ALL' => '11111111'},
233             '191D' => {'ALL' => '11111111'},
234             '191E' => {'ALL' => '11111111'},
235             '191F' => {'ALL' => '11111111'},
236             '1920' => {'ALL' => '11111111'},
237             '1921' => {'ALL' => '11111111'},
238             );
239              
240 1         29 our %BOUNDRIES = (
241             '160M' => {'LOW' => '1.800.00', 'HIGH' => '2.000.00'},
242             '80M' => {'LOW' => '3.500.00', 'HIGH' => '4.000.00'},
243             '60M' => {'LOW' => '5.330.50', 'HIGH' => '5.403.50'},
244             '40M' => {'LOW' => '7.000.00', 'HIGH' => '7.300.00'},
245             '30M' => {'LOW' => '10.100.00', 'HIGH' => '10.150.00'},
246             '20M' => {'LOW' => '14.000.00', 'HIGH' => '14.350.00'},
247             '15M' => {'LOW' => '21.000.00', 'HIGH' => '21.450.00'},
248             '12M' => {'LOW' => '24.890.00', 'HIGH' => '24.990.00'},
249             '10M' => {'LOW' => '28.000.00', 'HIGH' => '29.700.00'},
250             '6M' => {'LOW' => '50.000.00', 'HIGH' => '54.000.00'},
251             'FMBC' => {'LOW' => '76.000.00', 'HIGH' => '107.999.99'},
252             'AIR' => {'LOW' => '108.000.00','HIGH' => '137.000.00'},
253             '2M' => {'LOW' => '137.000.00','HIGH' => '154.000.00'},
254             '70CM' => {'LOW' => '420.000.00','HIGH' => '450.000.00'},
255             'UHF' => {'LOW' => '420.000.00','HIGH' => '450.000.00'},
256             'PHAN' => {'LOW' => '1.000.00' ,'HIGH' => '477.000.00'},
257             'MTQMB' => {'LOW' => '1.000.00' ,'HIGH' => '477.000.00'}
258             );
259              
260 1         6 our %FREQRANGE = (
261             'HF' => {'LOW' => '180000', 'HIGH' => '4999999'},
262             '6M' => {'LOW' => '5000000', 'HIGH' => '5400000'},
263             'FMBC' => {'LOW' => '7600000', 'HIGH' => '10799999'},
264             'AIR' => {'LOW' => '10800000','HIGH' => '13700000'},
265             '2M' => {'LOW' => '13700000','HIGH' => '15400000'},
266             'UHF' => {'LOW' => '42000000','HIGH' => '45000000'}
267             );
268              
269 1         3 our %TXPWR = (HIGH => '00', LOW3 => '01', LOW2 => '10', LOW1 => '11');
270              
271 1         4 our @NEWMEM = ('A0','0','3F','48','FF','FF','CD','82','0','0','0','A','AE','60','FF','0','0','0');
272              
273 1         4 our %VFOBANDS = ('160M' => '0000', '75M' => '0001', '40M' => '0010', '30M' => '0011',
274             '20M' => '0100', '17M' => '0101', '15M' => '0110', '12M' => '0111',
275             '10M' => '1000', '6M' => '1001', 'FMBC' => '1010', 'AIR' => '1011',
276             '2M' => '1100', '70CM' => '1101', 'PHAN' => '1110');
277              
278 1         11 our %VFOABASE = ('160M' => '007D', '80M' => '0097', '40M' => '00B1', '30M' => '00CB',
279             '20M' => '00E5', '17M' => '00FF', '15M' => '0119', '12M' => '0133',
280             '10M' => '014D', '6M' => '0167', 'FMBC' => '0181', 'AIR' => '019B',
281             '2M' => '01B5', '70CM' => '01CF', 'PHAN' => '01E9', 'MTQMB' => '040B', 'MTUNE' => '0425');
282              
283 1         10 our %VFOBBASE = ('160M' => '0203', '80M' => '021D', '40M' => '0237', '30M' => '0251',
284             '20M' => '026B', '17M' => '0285', '15M' => '029F', '12M' => '02B9',
285             '10M' => '02D3', '6M' => '02ED', 'FMBC' => '0307', 'AIR' => '0321',
286             '2M' => '033B', '70CM' => '0355', 'PHAN' => '036F');
287              
288 1         2 our %HOMEBASE = ('HF' => '0389', '6M' => '03A3', '2M' => '03BD', 'UHF' => '03D7');
289              
290 1         2 our %MEMORYBASE = ('QMB' => '03F1', 'MEM' => '0484');
291              
292 1         4 our %OPMODES = (LSB => '00', USB => '01', CW => '02',
293             CWR => '03', AM => '04', FM => '08',
294             DIG => '0A', PKT => '0C', FMN => '88',
295             WFM => '06');
296              
297 1         13 our %SMETER = ('S0' => '0000', 'S1' => '0001', 'S2' => '0010', 'S3' => '0011',
298             'S4' => '0100', 'S5' => '0101', 'S6' => '0110', 'S7' => '0111',
299             'S8' => '1000', 'S9' => '1001', '10+' => '1010', '20+' => '1011',
300             '30+' => '1100', '40+' => '1101', '50+' => '1110', '60+' => '1111');
301              
302 1         5 our %SMETERLIN = ('0' => '0000', '1' => '0001', '2' => '0010', '3' => '0011',
303             '4' => '0100', '5' => '0101', '6' => '0110', '7' => '0111',
304             '8' => '1000', '9' => '1001', '10' => '1010', '11' => '1011',
305             '12' => '1100', '13' => '1101', '14' => '1110', '15' => '1111');
306              
307 1         5 our %PMETER = ('0' => '0000', '1' => '0001', '2' => '0010', '3' => '0011',
308             '4' => '0100', '5' => '0101', '6' => '0110', '7' => '0111',
309             '8' => '1000', '9' => '1001', '10' => '1010', '11' => '1011',
310             '12' => '1100', '13' => '1101', '14' => '1110', '15' => '1111');
311              
312              
313 1 50       4 $OS_win = ($^O eq "MSWin32") ? 1 : 0;
314 1 50       2 if ($OS_win) {
315 0         0 eval "use Win32::SerialPort";
316 0 0       0 die "$@\n" if ($@);
317             }
318             else {
319 1     1   63 eval "use Device::SerialPort";
  1         666  
  1         24139  
  1         32  
320 1 50       49209 die "$@\n" if ($@);
321             }
322            
323             }#END BEGIN
324              
325             sub new {
326 0     0 1   my($device,%options) = @_;
327 0           my $ob = bless \%options, $device;
328 0 0         if ($OS_win) {
329 0           $ob->{'port'} = Win32::SerialPort->new ($options{'serialport'});
330 0 0         if($verbose){print "WIN32 DETECTED\n";}
  0            
331             }
332             else {
333 0           $ob->{'port'} = Device::SerialPort->new ($options{'serialport'},'true',$options{'lockfile'});
334 0 0         if($verbose){print "POSIX DETECTED\n";}
  0            
335             }
336 0 0         die "Can't open serial port $options{'serialport'}: $^E\n" unless (ref $ob->{'port'});
337 0 0         $ob->{'port'}->baudrate(9600) unless ($options{'baud'});
338 0           $ob->{'port'}->databits (8);
339 0           $ob->{'port'}->baudrate ($options{'baud'});
340 0           $ob->{'port'}->parity ("none");
341 0           $ob->{'port'}->stopbits (2);
342 0           $ob->{'port'}->handshake("none");
343 0           $ob->{'port'}->read_char_time(0);
344 0           $ob->{'port'}->read_const_time(1000);
345 0           $ob->{'port'}->alias ($options{'name'});
346 0           return $ob;
347             }
348              
349             #### Closes the port and deconstructs method
350              
351             sub moduleVersion {
352 0     0 1   my $self = shift;
353 0           return $VERSION;
354             }
355              
356             sub closePort {
357 0     0 1   my $self = shift;
358 0 0         die "\nCan't close the port $self->{'serialport'}....\n" unless $self->{'port'}->close;
359 0           warn "\nPort $self->{'serialport'} has been closed.\n\n";
360 0           undef $self;
361             }
362              
363             #### sets debugflag if a value exists
364             sub setDebug {
365 0     0 1   my $self = shift;
366 0           my $debugflag = shift;
367 0 0         if($debugflag == '1') {our $debug = $debugflag;}
  0            
368 0 0         if($debugflag == '0') {our $debug = undef;}
  0            
369 0 0 0       if($debug && $verbose){print "DEBUGGER IS ON\n";}
  0            
370 0 0 0       if(!$debug && $verbose){print "DEBUGGER IS OFF\n";}
  0            
371 0           return $debug;
372             }
373              
374             #### sets bitwatcherflag if a value exists
375             sub setBitwatch {
376 0     0 1   my $self = shift;
377 0           my $bitwatcherflag = shift;
378 0 0         if($bitwatcherflag == '1') {our $bitwatch = $bitwatcherflag;}
  0            
379 0 0         if($bitwatcherflag == '0') {our $bitwatch = undef;}
  0            
380 0 0 0       if($bitwatch && $verbose){print "BIT WATCH IS ON\n";}
  0            
381 0 0 0       if(!$bitwatch && $verbose){print "BIT WATCH IS OFF\n";}
  0            
382 0           return $bitwatch;
383             }
384              
385             #### sets output of a set command
386             sub setVerbose {
387 0     0 1   my $self = shift;
388 0           my $verboseflag = shift;
389 0 0         if($verboseflag == '1') {our $verbose = $verboseflag;}
  0            
390 0 0         if($verboseflag == '0') {$verbose = undef;}
  0            
391 0           return $verbose;
392             }
393              
394             #### sets output of a set command
395             sub setWriteallow {
396 0     0 1   my $self = shift;
397 0           my $writeflag = shift;
398 0 0         if($writeflag == '1') {our $writeallow = $writeflag;}
  0            
399 0 0         if($writeflag == '0') {our $writeallow = undef;}
  0            
400 0 0 0       if ($writeallow && $verbose){print "WRITING TO EEPROM ACTIVATED\n";}
  0            
401 0 0 0       if (!$writeallow && $verbose){print "WRITING TO EEPROM DEACTIVATED\n";}
  0            
402 0 0 0       if (!$agreewithwarning && $writeallow && $verbose){print "
  0   0        
403             \n*****NOTICE****** *****NOTICE****** *****NOTICE****** *****NOTICE****** *****NOTICE******
404             \nYou have enabled the option setWriteallow!!!!\n
405             \tWhile the program does its best to ensure that data does not get corrupted, there is always
406             the chance that an error can be written to or received by the radio. This radio has no checksum
407             feature with regard to writing to the EEprom. The user of this program assumes all risk associated
408             with using this software.\n
409             \tIt is recommended that the software calibration settings be backed up to your computer in the event
410             that the radio needs to be reset to factory default. You should have done this anyway, to avoid
411             sending the radio back to Yaesu to be recalibrated. FT817OS will automatically provide a calibration
412             file on first startup. You can also, within this library create a backup of the calibration using
413              
414             \$FT817->getSoftcal\(\"file\",\"filename\.txt\"\)\;
415              
416             You can also use software such as \'FT-817 commander\' to backup your software calibration.
417             Check the site http://wb8nut.com/downloads/ or google it. The program is for windows but
418             functions fine on Ubuntu linux and other possible variants under wine.\n
419              
420             Have a look at restoreEeprom\(\) in the documentation to see how to set a memory address back to
421             default in the event of a problem.
422              
423             \tHaving said that, If you accept this risk and have backed up your software calibration, you
424             can use the following command agreewithwarning(1) before the command setWriteallow(1) in your
425             software to get rid of this message and have the ability to write to the eeprom.
426             "; }
427            
428             }
429             #### sets output of a set command
430             sub agreeWithwarning {
431 0     0 1   my $self = shift;
432 0           my $agreeflag = shift;
433 0 0         if($agreeflag == '1') {our $agreewithwarning = $agreeflag;}
  0            
434 0           return $agreewithwarning;
435             }
436              
437             sub getFlags {
438 0     0 1   my $self = shift;
439 0           my $value = shift;
440 0           my $flags;
441 0 0         if ($value eq 'DEBUG'){$flags = "$debug";}
  0            
442 0 0         if ($value eq 'VERBOSE'){$flags = "$verbose";}
  0            
443 0 0         if ($value eq 'BITWATCH'){$flags = "$bitwatch";}
  0            
444 0 0         if ($value eq 'WRITEALLOW'){$flags = "$writeallow";}
  0            
445 0 0         if ($value eq 'WARNED'){$flags = "$agreewithwarning";}
  0            
446 0 0         if (!$value){$flags = "DEBUG\:$debug \/ VERBOSE\:$verbose \/ WRITE ALLOW:$writeallow \/ \/ BITWATCH:$bitwatch \/ WARNED\:$agreewithwarning";}
  0            
447 0 0         if($verbose){
448 0           printf "\n%-11s %-11s\n", 'FLAG','VALUE';
449 0           print "_________________";
450 0           printf "\n%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n\n", 'DEBUG', "$debug", 'VERBOSE', "$verbose", 'BITWATCH', "$bitwatch", 'WRITE', "$writeallow", 'WARNED', "$agreewithwarning";
451             }
452 0           return $flags;
453             }
454             #### Convert a decimal to a binary
455             sub dec2bin {
456 0     0 1   my $str = unpack("B32", pack("N", shift));
457 0           $str = substr $str, -8;
458 0           return $str;
459             }
460              
461             #### Convert Hex to a binary
462             sub hex2bin {
463 0     0 1   my $h = shift;
464 0           my $hlen = length($h);
465 0           my $blen = $hlen * 4;
466 0           return unpack("B$blen", pack("H$hlen", $h));
467             }
468              
469             #### Add a HEX VALUE AND RETURN MSB/LSB
470             sub hexAdder {
471 0     0 1   my $self = shift;
472 0           my $offset = shift;
473 0           my $base = shift;
474 0 0         if ($debug){print "\n(hexAdder:DEBUG) - RECEIVED BASE [$base] AND OFFSET [$offset]\n";}
  0            
475 0           my $basehex = join("",'0x',"$base");
476 0 0         if ($debug){print "\n(hexAdder:DEBUG) - CONVERT BASE [$basehex]\n";}
  0            
477 0           $basehex = hex($basehex);
478 0 0         if ($debug){print "\n(hexAdder:DEBUG) - OCT BASEHEX [$basehex]\n";}
  0            
479 0           my $startaddress = sprintf("0%X",$basehex + $offset);
480 0 0         if(length($startaddress) < 4) {
481 0 0         if ($debug){print "\n(hexAdder:DEBUG) - TOO SMALL, ADDING LEADING 0 ---> [$startaddress]\n";}
  0            
482 0           $startaddress = join("",'0',"$startaddress");
483 0 0         if ($debug){print "\n(hexAdder:DEBUG) - PADDING WITH 0 ---> [$startaddress]\n";}
  0            
484             }
485 0 0         if(length($startaddress) == 5) {
486 0 0         if ($debug){print "\n(hexAdder:DEBUG) - TOO BIG, DROPPING LEADING 0 ---> [$startaddress]\n";}
  0            
487 0           $startaddress = substr("$startaddress",'1','4');
488 0 0         if ($debug){print "\n(hexAdder:DEBUG) - DROPPED LEADING 0 ---> [$startaddress]\n";}
  0            
489             }
490 0 0         if ($debug){print "\n(hexAdder:DEBUG) - ADDED OFFSET [$startaddress]\n";}
  0            
491 0 0         if ($debug){print "\n(hexAdder:DEBUG) - PRODUCED [$startaddress]\n\n";}
  0            
492 0           return $startaddress;
493             }
494              
495             sub hexDiff {
496 0     0 1   my $self = shift;
497 0           my $ADDRESS1 = shift;
498 0           my $ADDRESS2 = shift;
499 0 0         if ($debug){print "\n(hexDiff:DEBUG) - RECEIVED HEX1 [$ADDRESS1] AND HEX2 [$ADDRESS2]\n";}
  0            
500 0 0         if ($debug){print "\n(hexDiff:DEBUG) - COMPUTING DECIMAL DIFFERENCE\n";}
  0            
501 0           $ADDRESS1 = hex($ADDRESS1);
502 0           $ADDRESS2 = hex($ADDRESS2);
503 0           my $difference = $ADDRESS2 - $ADDRESS1;
504 0 0         if ($debug){print "\n(hexDiff:DEBUG) - GOT $difference\n\n";}
  0            
505 0           return $difference;
506             }
507              
508             #### Does a toggle with no output
509             sub quietToggle{
510 0     0 1   my $self = shift;
511 0           $self->setVerbose(0);
512 0           $self->catvfoToggle();
513 0           $self->setVerbose(1);
514 0           return 0;
515             }
516              
517             #### Does a toggle between MEMORY and VFO with no output
518             sub quietTunetoggle{
519 0     0 1   my $self = shift;
520 0           $self->setVerbose(0);
521 0           my $tuner = $self->getTuner();
522 0           $self->setVerbose(0);
523 0 0         if($tuner eq 'MEMORY'){$writestatus = $self->writeEeprom('0055','1','0');}
  0            
524 0 0         if($tuner eq 'VFO'){$writestatus = $self->writeEeprom('0055','1','1');}
  0            
525 0           $self->setVerbose(1);
526 0           return 0;
527             }
528              
529             #### Does a toggle between MEMORY and VFO with no output
530             sub quietHometoggle{
531 0     0 1   my $self = shift;
532 0           $self->setVerbose(0);
533 0           my $tuner = $self->getHome();
534 0           $self->setVerbose(0);
535 0 0         if($tuner eq 'Y'){$writestatus = $self->writeEeprom('0055','3','0');}
  0            
536 0 0         if($tuner eq 'N'){$writestatus = $self->writeEeprom('0055','3','1');}
  0            
537 0           $self->setVerbose(1);
538 0           return 0;
539             }
540              
541             #### Function for checking boundries
542             sub boundryCheck {
543 0     0 1   my $self = shift;
544 0           my $band = shift;
545 0           my $frequency = shift;
546 0           my $freqlabel = $frequency;
547 0           $frequency =~ tr/.//d;
548 0           my $status = 'OK';
549 0           my $low = $BOUNDRIES{$band}{'LOW'};
550 0           my $high = $BOUNDRIES{$band}{'HIGH'};
551 0           my $lowlabel = $low;
552 0           my $highlabel = $high;
553 0           $low =~ tr/.//d;
554 0           $high =~ tr/.//d;
555 0 0 0       if ($frequency < $low || $frequency > $high){
556 0 0         if($verbose){print "Frequency $freqlabel out of range for $band [$lowlabel \- $highlabel]\n\n"; }
  0            
557 0           return 1;
558             }
559 0           return $status;
560             }
561              
562             #### Function for checking what range frequency is in
563             sub rangeCheck {
564 0     0 1   my $self = shift;
565 0           my $frequency = shift;
566 0           $frequency =~ tr/.//d;
567 0           foreach my $key ( keys %FREQRANGE) {
568 0           my $low = $FREQRANGE{"$key"}{'LOW'};
569 0           my $high = $FREQRANGE{"$key"}{'HIGH'};
570 0 0 0       if ($frequency >= $low && $frequency <= $high){
571 0 0         if($verbose){print "RANGE is $key\n\n";}
  0            
572 0           return $key;
573             }
574             }
575 0 0         if($verbose){print "NOT FOUND!!! ERROR!!\n\n";}
  0            
576 0           return 1;
577             }
578              
579             #### Function for checking the BITWATCHER hash
580             sub bitCheck {
581 0     0 1   my $self = shift;
582 0           my $lastaction = shift;
583 0           my $bit;
584             my $testbit;
585 0           my $status = 'OK';
586 0           foreach my $key ( sort keys %BITWATCHER) {
587 0 0         if ($debug){print "\n(bitCheck:DEBUG) - Monitors in address $key are: \n";}
  0            
588 0           my $memarea = $self->eepromDecode("$key");
589 0           foreach $bit (sort keys %{$BITWATCHER{$key}}) {
  0            
590 0 0         if ($bit ne 'ALL') {$testbit = substr($memarea,"$bit",1);}
  0            
591 0           else {$testbit = $memarea;}
592 0           my $value = $BITWATCHER{$key}{$bit};
593 0 0         if ($debug){print "(bitCheck:DEBUG) - $key: \[$memarea\]\n\n";}
  0            
594 0 0         if ($debug){print "(bitCheck:DEBUG) - AREA: $key BIT: $bit ---> VALUE: $value TESTBIT: $testbit\n\n";}
  0            
595 0 0         if ($value != $testbit){
596 0 0         if ($verbose){print "CHANGE FOUND IN MEMORY AREA [$key]: BIT $bit is $testbit, WAS $value\n";}
  0            
597 0 0 0       if ($verbose && $value){print "LAST MODIFICATION WAS [$lastaction]\n";}
  0            
598 0           $status = 'CHANGE';
599             }
600             }
601             }
602 0 0 0       if ($verbose && $status eq 'CHANGE'){print "\n";}
  0            
603 0 0         if ($status eq 'OK'){if ($debug){print "(bitCheck:DEBUG) - NO CHANGES FOUND\n";}}
  0 0          
  0            
604 0           return $status;
605             }
606              
607             #### Send a CAT command and set the return byte size
608             sub sendCat {
609 0     0 1   my $self = shift;
610 0           my $caller = ( caller(1) )[3];
611 0           my ($data1, $data2, $data3, $data4, $command, $outputsize) = @_;
612 0 0         if ($debug){print "\n(sendCat:DEBUG) - DATA OUT ------> $data1 $data2 $data3 $data4 $command\n";}
  0            
613 0           my $data = join("","$data1","$data2","$data3","$data4","$command");
614 0           our $lastaction = "sendCat: $data from $caller";
615 0 0         if ($debug){print "\n(sendCat:DEBUG) - BUILT PACKET --> $data\n";}
  0            
616 0           $data = pack( 'H[10]', "$data" );
617 0           $self->{'port'}->write($data);
618 0           $output = $self->{'port'}->read($outputsize);
619 0           $output = unpack("H*", $output);
620 0 0         if ($debug) {print "\n(sendCat:DEBUG) - DATA IN <------- $output\n\n";}
  0            
621 0 0         if ($bitwatch){$self->bitCheck("$lastaction");}
  0            
622 0           return $output;
623             }
624              
625             #### Decodes eeprom values from a given address and stips off second byte
626             sub eepromDecode {
627 0     0 1   my $self = shift;
628 0           my $address = shift;
629 0 0         if ($debug){print "\n(eepromDecode:DEBUG) - READING FROM ------> [$address]\n";}
  0            
630 0           my $data = join("","$address",'0000BB');
631 0 0         if ($debug){print "\n(eepromDecode:DEBUG) - PACKET BUILT ------> [$data]\n";}
  0            
632 0           $data = pack( 'H[10]', "$data" );
633 0           $self->{'port'}->write($data);
634 0           $output = $self->{'port'}->read(2);
635 0           my $test = $output;
636 0           $output = unpack("H*", substr($output,0,1));
637 0           my $output2 = unpack("H*", substr($test,1,1));
638 0 0         if ($debug){print "\n(eepromDecode:DEBUG) - OUTPUT HEX -------> [$output]\n";}
  0            
639 0 0         if ($debug){print "\n(eepromDecode:DEBUG) - NEXTBYTE HEX -----> [$output2]\n";}
  0            
640 0           $output = hex2bin($output);
641 0           $output2 = hex2bin($output2);
642 0 0         if ($debug){print "\n(eepromDecode:DEBUG) - OUTPUT BIN -------> [$output]\n";}
  0            
643 0 0         if ($debug){print "\n(eepromDecode:DEBUG) - NEXTBYTE BIN ------> [$output2]\n\n";}
  0            
644 0           return $output;
645             }
646              
647             #### Decodes eeprom values from a given address and stips off second byte
648             sub eepromDoubledecode {
649 0     0 1   my $self = shift;
650 0           my $address = shift;
651 0 0         if ($debug){print "\n(eepromDecode:DEBUG) - READING FROM ------> [$address]\n";}
  0            
652 0           my $data = join("","$address",'0000BB');
653 0 0         if ($debug){print "\n(eepromDecode:DEBUG) - PACKET BUILT ------> [$data]\n";}
  0            
654 0           $data = pack( 'H[10]', "$data" );
655 0           $self->{'port'}->write($data);
656 0           $output = $self->{'port'}->read(2);
657 0           my $test = $output;
658 0           $output = unpack("H*", substr($output,0,1));
659 0           my $output2 = unpack("H*", substr($test,1,1));
660 0 0         if ($debug){print "\n(eepromDecode:DEBUG) - OUTPUT HEX -------> [$output]\n";}
  0            
661 0 0         if ($debug){print "\n(eepromDecode:DEBUG) - NEXTBYTE HEX -----> [$output2]\n";}
  0            
662 0           $output = hex2bin($output);
663 0           $output2 = hex2bin($output2);
664 0 0         if ($debug){print "\n(eepromDecode:DEBUG) - OUTPUT BIN -------> [$output]\n";}
  0            
665 0 0         if ($debug){print "\n(eepromDecode:DEBUG) - NEXTBYTE BIN ------> [$output2]\n\n";}
  0            
666 0           return ("$output","$output2");
667             }
668              
669             #### Decodes eeprom values from a given address and stips off second byte
670             sub eepromDecodenext {
671 0     0 1   my $self = shift;
672 0           my $address = shift;
673 0 0         if ($debug){print "\n(eepromDecodenext:DEBUG) - READING FROM from -> [$address]\n";}
  0            
674 0           my $data = join("","$address",'0000BB');
675 0 0         if ($debug){print "\n(eepromDecodenext:DEBUG) - PACKET BUILT ------> [$data]\n";}
  0            
676 0           $data = pack( 'H[10]', "$data" );
677 0           $self->{'port'}->write($data);
678 0           $output = $self->{'port'}->read(2);
679 0           $output = unpack("H*", substr($output,1,1));
680 0 0         if ($debug){print "\n(eepromDecodenext:DEBUG) - OUTPUT HEX --------> [$output]\n\n";}
  0            
681 0           return $output;
682             }
683              
684             #### Writes data to the eeprom MSB,LSB,BIT# and VALUE, REWRITES NEXT MEMORY ADDRESS
685             sub writeEeprom {
686 0     0 1   my $self=shift;
687 0           my $address = shift;
688 0           my ($writestatus) = @_;
689 0           my $BIT=shift;
690 0           my $VALUE=shift;
691 0           my $caller = ( caller(1) )[3];
692 0           my $NEWHEX1;
693             my $NEWHEX2;
694 0 0 0       if ($writeallow != '1' and $agreewithwarning != '1') {
695 0 0 0       if($debug || $verbose){print"Writing to EEPROM disabled, use setWriteallow(1) to enable\n";}
  0            
696 0           $writestatus = "Write Disabled";
697 0           return $writestatus;
698             }
699 0 0         if ($debug){print "\n(writeEeprom:DEBUG) - OUTPUT FROM [$address]\n";}
  0            
700 0           my $data = join("","$address",'0000BB');
701 0 0         if ($debug){print "\n(writeEeprom:DEBUG) - PACKET BUILT ------> [$data]\n";}
  0            
702 0           $data = pack( 'H[10]', "$data" );
703 0           $self->{'port'}->write($data);
704 0           my $output = $self->{'port'}->read(2);
705 0           my $BYTE1 = unpack("H*", substr($output,0,1));
706 0           my $BYTE2 = unpack("H*", substr($output,1,1));
707 0           my $OLDBYTE1 = $BYTE1;
708 0           my $OLDBYTE2 = $BYTE2;
709 0 0         if ($debug){print "\n(writeEeprom:DEBUG) - BYTE1 ($BYTE1) BYTE2 ($BYTE2) from [$address]\n";}
  0            
710 0           $BYTE1 = hex2bin($BYTE1);
711 0           my $HEX1 = sprintf("%X", oct( "0b$BYTE1" ) );
712 0 0         if ($debug){print "\n(writeEeprom:DEBUG) - BYTE1 BINARY IS [$BYTE1]\n";}
  0            
713 0 0         if ($debug){print "\n(writeEeprom:DEBUG) - CHANGING BIT($BIT) to ($VALUE)\n";}
  0            
714 0           substr($BYTE1, $BIT, 1) = "$VALUE";
715 0 0         if ($debug){print "\n(writeEeprom:DEBUG) - BYTE1: BINARY IS [$BYTE1] AFTER CHANGE\n";}
  0            
716 0           $NEWHEX1 = sprintf("%X", oct( "0b$BYTE1" ) );
717 0 0         if ($debug){print "\n(writeEeprom:DEBUG) - CHECKING IF [$NEWHEX1] needs padding\n";}
  0            
718 0 0         if (length($NEWHEX1) < 2) {
719 0           $NEWHEX1 = join("",'0', "$NEWHEX1");
720 0 0         if ($debug){print "\n(writeEeprom:DEBUG) - Padded to [$NEWHEX1]\n";}
  0            
721             }
722 0 0         else {if ($debug){print "\n(writeEeprom:DEBUG) - No padding of [$NEWHEX1] needed\n";}}
  0            
723 0 0         if ($debug){print "\n(writeEeprom:DEBUG) - BYTE1 ($NEWHEX1) BYTE2 ($BYTE2) to [$address]\n";}
  0            
724 0 0         if ($debug){print "\n(writeEeprom:DEBUG) - WRITING ----------> ($NEWHEX1) ($BYTE2)\n";}
  0            
725 0           my $data2 = join("","$address","$NEWHEX1","$BYTE2",'BC');
726 0           our $lastaction = "writeEeprom: $data2 from $caller";
727 0 0         if ($debug){print "\n(writeEeprom:DEBUG) - PACKET BUILT ------> [$data2]\n";}
  0            
728 0           $data2 = pack( 'H[10]', "$data2" );
729 0           $self->{'port'}->write($data2);
730 0           $output = $self->{'port'}->read(2);
731 0 0         if ($debug){print "\n(writeEeprom:DEBUG) - VALUES WRITTEN, CHECKING...\n";}
  0            
732 0           $self->{'port'}->write($data);
733 0           my $output2 = $self->{'port'}->read(2);
734 0           $BYTE1 = unpack("H*", substr($output2,0,1));
735 0           $BYTE2 = unpack("H*", substr($output2,1,1));
736 0 0         if ($debug){print "\n(writeEeprom:DEBUG) - SHOULD BE: ($NEWHEX1) ($OLDBYTE2)\n";}
  0            
737 0 0         if ($debug){print "\n(writeEeprom:DEBUG) - IS: -----> ($BYTE1) ($BYTE2)\n";}
  0            
738              
739             # We make an exception for setTuner because 0056 bit 0 changes automatically when MEM/VFO is toggled
740              
741 0 0 0       if ($address == '0055' && $BIT == '1'){
742 0 0         if($debug){print "\n(writeEeprom:DEBUG) - TUNER EXEMPTION OK\n\n";}
  0            
743 0           $writestatus = 'OK';
744             }
745             else {
746 0 0 0       if (($NEWHEX1 == $BYTE1) && ($OLDBYTE2 == $BYTE2)) {
747 0           $writestatus = "OK";
748 0 0         if($debug){print "\n(writeEeprom:DEBUG) - VALUES MATCH!!!\n\n";}
  0            
749             }
750             else {
751 0           $writestatus = "1";
752 0 0         if($debug){print "\n(writeEeprom:DEBUG) - NO MATCH!!!\n\n";}
  0            
753             }
754 0 0         if ($bitwatch){$self->bitCheck("$lastaction");}
  0            
755             }
756 0           return $writestatus;
757             }
758              
759             #### Writes an entire byte of data to the eeprom, MSB LSB VALUE
760             sub writeBlock {
761 0     0 1   my $self=shift;
762 0           my ($writestatus) = @_;
763 0           my $address=shift;
764 0           my $VALUE=shift;
765 0           my $caller = ( caller(1) )[3];
766 0 0 0       if ($writeallow != '1' and $agreewithwarning != '1') {
767 0 0 0       if($debug || $verbose){print"Writing to EEPROM disabled, use setWriteallow(1) to enable\n";}
  0            
768 0           $writestatus = "Write Disabled";
769 0           return $writestatus;
770             }
771              
772 0 0         if ($debug){print "\n(writeBlock:DEBUG) - OUTPUT FROM [$address]\n";}
  0            
773 0           my $data = join("","$address",'0000BB');
774 0 0         if ($debug){print "\n(writeBlock:DEBUG) - PACKET BUILT ------> [$data]\n";}
  0            
775 0           $data = pack( 'H[10]', "$data" );
776 0           $self->{'port'}->write($data);
777 0           my $output = $self->{'port'}->read(2);
778 0           my $BYTE2 = unpack("H*", substr($output,1,1));
779 0           my $OLDBYTE2 = $BYTE2;
780 0 0         if ($debug){print "\n(writeBlock:DEBUG) - BYTE2 ($BYTE2) from [$address]\n";}
  0            
781 0 0         if ($debug){print "\n(writeBlock:DEBUG) - BYTE1 ($VALUE) BYTE2 ($BYTE2) to [$address]\n";}
  0            
782 0 0         if ($debug){print "\n(writeBlock:DEBUG) - CHECKING IF [$VALUE] needs padding\n";}
  0            
783 0 0         if (length($VALUE) < 2) {
784 0           $VALUE = join("",'0', "$VALUE");
785 0 0         if ($debug){print "\n(writeBlock:DEBUG) - Padded to [$VALUE]\n";}
  0            
786             }
787 0 0         else {if ($debug){print "\n(writeBlock:DEBUG) - No padding of [$VALUE] needed\n";}}
  0            
788 0 0         if ($debug){print "\n(writeBlock:DEBUG) - WRITING ----------> [$VALUE] [$BYTE2]\n";}
  0            
789 0           my $data2 = join("","$address","$VALUE","$BYTE2",'BC');
790 0 0         if ($debug){print "\n(writeBlock:DEBUG) - PACKET BUILT ------> [$data2]\n";}
  0            
791 0           our $lastaction = "writeBlock: $data2 from $caller";
792 0           $data2 = pack( 'H[10]', "$data2" );
793 0           $self->{'port'}->write($data2);
794 0           $output = $self->{'port'}->read(2);
795 0 0         if ($debug){print "\n(writeBlock:DEBUG) - VALUES WRITTEN, CHECKING...\n";}
  0            
796 0           $self->{'port'}->write($data);
797 0           my $output2 = $self->{'port'}->read(2);
798 0           my $BYTE1 = unpack("H*", substr($output2,0,1));
799 0           $BYTE2 = unpack("H*", substr($output2,1,1));
800 0 0         if ($debug){print "\n(writeBlock:DEBUG) - SHOULD BE: ($VALUE) ($OLDBYTE2)\n";}
  0            
801 0 0         if ($debug){print "\n(writeBlock:DEBUG) - IS: -----> ($BYTE1) ($BYTE2)\n";}
  0            
802 0 0 0       if (($VALUE == $BYTE1) && ($OLDBYTE2 == $BYTE2)) {
803 0           $writestatus = "OK";
804 0 0         if($debug){print "\n(writeBlock:DEBUG) - VALUES MATCH!!!\n\n";}
  0            
805             }
806             else {
807 0           $writestatus = "1";
808 0 0         if($debug){print "\n(writeBlock:DEBUG) - NO MATCH!!!\n\n";}
  0            
809             }
810 0 0         if ($bitwatch){$self->bitCheck("$lastaction");}
  0            
811 0           return $writestatus;
812             }
813              
814             #### Writes an entire byte of data to the eeprom, MSB LSB VALUE
815             sub writeDoubleblock {
816 0     0 1   my $self=shift;
817 0           my ($writestatus) = @_;
818 0           my $address=shift;
819 0           my $VALUE=shift;
820 0           my $VALUE2=shift;
821 0           my $caller = ( caller(1) )[3];
822 0 0 0       if ($writeallow != '1' and $agreewithwarning != '1') {
823 0 0 0       if($debug || $verbose){print"Writing to EEPROM disabled, use setWriteallow(1) to enable\n";}
  0            
824 0           $writestatus = "Write Disabled";
825 0           return $writestatus;
826             }
827              
828 0           my $data = join("","$address",'0000BB');
829 0 0         if ($debug){print "\n(writeDoubleblock:DEBUG) - PACKET BUILT ------> [$data]\n";}
  0            
830 0           $data = pack( 'H[10]', "$data" );
831 0           $self->{'port'}->write($data);
832 0           my $output = $self->{'port'}->read(2);
833 0           my $BYTE1 = unpack("H*", substr($output,0,1));
834 0           my $BYTE2 = unpack("H*", substr($output,1,1));
835 0 0         if ($debug){print "\n(writeDoubleblock:DEBUG) - CHECKING IF [$VALUE] needs padding\n";}
  0            
836 0 0         if (length($VALUE) < 2) {
837 0           $VALUE = join("",'0', "$VALUE");
838 0 0         if ($debug){print "\n(writeBlock:DEBUG) - Padded to [$VALUE]\n";}
  0            
839             }
840 0 0         if ($debug){print "\n(writeDoubleblock:DEBUG) - CHECKING IF [$VALUE2] needs padding\n";}
  0            
841 0 0         if (length($VALUE2) < 2) {
842 0           $VALUE2 = join("",'0', "$VALUE2");
843 0 0         if ($debug){print "\n(writeDoubleblock:DEBUG) - Padded to [$VALUE2]\n";}
  0            
844             }
845 0 0         if ($debug){print "\n(writeDoubleblock:DEBUG) - WRITING ----------> [$VALUE] [$VALUE2]\n";}
  0            
846 0           my $data2 = join("","$address","$VALUE","$VALUE2",'BC');
847 0 0         if ($debug){print "\n(writeBlock:DEBUG) - PACKET BUILT ------> [$data2]\n";}
  0            
848 0           our $lastaction = "writeDoubleblock: $data2 from $caller";
849 0           $data2 = pack( 'H[10]', "$data2" );
850 0           $self->{'port'}->write($data2);
851 0           $output = $self->{'port'}->read(2);
852 0 0         if ($debug){print "\n(writeDoubleblock:DEBUG) - VALUES WRITTEN, CHECKING...\n";}
  0            
853 0           $self->{'port'}->write($data);
854 0           my $output2 = $self->{'port'}->read(2);
855 0           my $NEWBYTE1 = unpack("H*", substr($output2,0,1));
856 0           my $NEWBYTE2 = unpack("H*", substr($output2,1,1));
857 0 0         if ($debug){print "\n(writeDoubleblock:DEBUG) - SHOULD BE: ($VALUE) ($VALUE2)\n";}
  0            
858 0 0         if ($debug){print "\n(writeDoubleblock:DEBUG) - IS: -----> ($NEWBYTE1) ($NEWBYTE2)\n";}
  0            
859 0 0 0       if (($VALUE == $NEWBYTE1) && ($VALUE2 == $NEWBYTE2)) {
860 0           $writestatus = "OK";
861 0 0         if($debug){print "\n(writeDoubleblock:DEBUG) - VALUES MATCH!!!\n\n";}
  0            
862             }
863             else {
864 0           $writestatus = "1";
865 0 0         if($debug){print "\n(writeDoubleblock:DEBUG) - NO MATCH!!!\n\n";}
  0            
866             }
867 0 0         if ($bitwatch){$self->bitCheck("$lastaction");}
  0            
868 0           return $writestatus;
869              
870             }
871              
872             #### Restores eprom memory address to pre written default value in case there was an error
873              
874             sub restoreEeprom {
875 0     0 1   my $self=shift;
876 0           my $area=shift;
877 0           my ($writestatus,$test,$restorevalue,$restorearea,$address) = @_;
878 0 0 0       if ($writeallow != '1' and $agreewithwarning != '1') {
879 0 0 0       if($debug || $verbose){print"Writing to EEPROM disabled, use setWriteallow(1) to enable\n";}
  0            
880 0           $writestatus = "Write Disabled";
881 0           return $writestatus;
882             }
883 0 0         if(!$RESTOREAREAS{$area}){
884 0 0         if ($verbose){print "Address ($area) not supported for restore...\n";}
  0            
885 0           $writestatus = "Invalid memory address ($area)";
886 0           return $writestatus;
887             }
888 0 0         if ($verbose){
889 0           print "\nDEFAULTS LOADED FOR $area\n________________________\n";
890 0 0         if ($area eq '0055'){printf "%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n\n", 'VFO','A', 'MTQMB','NO', 'QMB','NO', 'MEM/VFO', 'VFO';}
  0            
891 0 0         if ($area eq '0057'){printf "%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n\n", 'AGC','AUTO', 'DSP','OFF', 'PBT','OFF', 'NB', 'OFF', 'LOCK','OFF', 'FASTTUNE','OFF';}
  0            
892 0 0         if ($area eq '0058'){printf "%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n\n", 'PWR METER','PWR', 'CW PADDLE','NORMAL', 'KEYER','OFF', 'BK', 'OFF', 'VLT','OFF', 'VOX','OFF';}
  0            
893 0 0         if ($area eq '0059'){printf "%-11s %-11s\n%-11s %-11s\n\n", 'VFO A','2M', 'VFO B','20M';}
  0            
894 0 0         if ($area eq '005B'){printf "%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n\n", 'Contrast','5', 'Color','Blue', 'Backlight','Auto';}
  0            
895 0 0         if ($area eq '005C'){printf "%-11s %-11s\n%-11s %-11s\n\n", 'Beep Volume','50', 'Beep Frequency','880 hz';}
  0            
896 0 0         if ($area eq '005D'){printf "%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n\n", 'Resume Scan','5 SEC', 'PKT Rate','1200', 'Scope','CONT', 'CW-ID', 'OFF', 'Main STEP','FINE', 'ARTS','RANGE';}
  0            
897 0 0         if ($area eq '005E'){printf "%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n\n", 'CW Pitch','700 Hz', 'Lock Mode','Dial', 'OP Filter','OFF';}
  0            
898 0 0         if ($area eq '005F'){printf "%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n\n", 'CW Weight','1:3', '430 ARS','ON', '144 ARS','ON', 'SQL-RFG', 'SQUELCH';}
  0            
899 0 0         if ($area eq '0060'){printf "%-11s %-11s\n%-11s %-11s\n\n", 'CW Delay','250';}
  0            
900 0 0         if ($area eq '0061'){printf "%-11s %-11s\n%-11s %-11s\n\n", 'Sidetone Volume','50';}
  0            
901 0 0         if ($area eq '0062'){printf "%-11s %-11s\n%-11s %-11s\n\n", 'CW Speed','12wpm', 'Chargetime','8hrs';}
  0            
902 0 0         if ($area eq '0063'){printf "%-11s %-11s\n%-11s %-11s\n\n", 'VOX Gain','50', 'AM\&FM DL','DISABLED';}
  0            
903 0 0         if ($area eq '0064'){printf "%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n\n", 'Vox Delay','500 msec', 'Emergency','OFF', 'Cat rate','4800';}
  0            
904 0 0         if ($area eq '0065'){printf "%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n\n", 'APO Time','OFF', 'MEM Groups','OFF', 'DIG Mode','RTTY';}
  0            
905 0 0         if ($area eq '0066'){printf "%-11s %-11s\n%-11s %-11s\n\n", 'TOT Time','OFF', 'DCS INV','TN-RN';}
  0            
906 0 0         if ($area eq '0067'){printf "%-11s %-11s\n %-11s %-11s\n\n", 'SSB MIC','50' , 'MIC SCAN','ON';}
  0            
907 0 0         if ($area eq '0068'){printf "%-11s %-11s\n%-11s %-11s\n\n", 'AM MIC','50', 'MIC KEY','OFF';}
  0            
908 0 0         if ($area eq '0069'){printf "%-11s %-11s\n\n", 'FM MIC','50';}
  0            
909 0 0         if ($area eq '006A'){printf "%-11s %-11s\n\n", 'DIG MIC','50';}
  0            
910 0 0         if ($area eq '006B'){printf "%-11s %-11s\n%-11s %-11s\n\n", 'PKT MIC','50','EXT MENU','OFF';}
  0            
911 0 0         if ($area eq '006C'){printf "%-11s %-11s\n\n", '9600 MIC','50';}
  0            
912 0 0         if ($area eq '006D'){printf "%-11s %-11s\n\n", 'DIG SHIFT MSB','0';}
  0            
913 0 0         if ($area eq '006E'){printf "%-11s %-11s\n\n", 'DIG SHIFT LSB','0';}
  0            
914 0 0         if ($area eq '006F'){printf "%-11s %-11s\n\n", 'DIG DISP MSB','0';}
  0            
915 0 0         if ($area eq '0070'){printf "%-11s %-11s\n\n", 'DIG DISP LSB','0';}
  0            
916 0 0         if ($area eq '0071'){printf "%-11s %-11s\n\n", 'R LSB CAR','0';}
  0            
917 0 0         if ($area eq '0072'){printf "%-11s %-11s\n\n", 'R USB CAR','0';}
  0            
918 0 0         if ($area eq '0073'){printf "%-11s %-11s\n\n", 'T LSB CAR','0';}
  0            
919 0 0         if ($area eq '0074'){printf "%-11s %-11s\n\n", 'T USB CAR','0';}
  0            
920 0 0         if ($area eq '0079'){printf "%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n\n", 'TX Power','LOW1', 'PRI','OFF', 'DUAL-WATCH', 'OFF', 'SCAN', 'OFF', 'ARTS', 'OFF';}
  0            
921 0 0         if ($area eq '007A'){printf "%-11s %-11s\n%-11s %-11s\n\n", 'Antennas','All Rear except VHF and UHF', 'SPL','OFF';}
  0            
922 0 0         if ($area eq '007B'){printf "%-11s %-11s\n%-11s %-11s\n\n", 'Chargetime','8hrs', 'Charger','OFF';}
  0            
923 0 0         if ($area eq '044F'){printf "%-11s %-11s\n\n", 'Current Memory Channel','0';}
  0            
924             }
925 0           $writestatus = $self->writeBlock("$area","$RESTOREAREAS{$area}");
926 0           return $writestatus;
927             }
928              
929             ###############################
930             #CAT COMMANDS IN ORDER BY BOOK#
931             ###############################
932              
933              
934             #### ENABLE/DISABLE LOCK VIA CAT
935             sub catLock {
936 0     0 1   my ($data) = @_;
937 0           my $self=shift;
938 0           my $lock = shift;
939 0           $data = undef;
940 0           $self->setVerbose(0);
941 0           $output=$self->getLock();
942 0           $self->setVerbose(1);
943 0 0         if ($output eq $lock) {
944 0 0         if($verbose){print "\nLock is already set to $lock\n\n"; }
  0            
945 0           return 1;
946             }
947              
948 0 0 0       if ($lock ne 'ON' && $lock ne 'OFF') {
949 0 0         if($verbose){print "\nChoose valid option: ON/OFF\n\n"; }
  0            
950 0           return 1;
951             }
952 0 0         if ($lock eq 'ON') {$data = "00";}
  0            
953 0 0         if ($lock eq 'OFF') {$data = "80";}
  0            
954 0           $output = $self->sendCat('00','00','00','00',"$data",1);
955 0 0         if ($verbose){
956 0 0         print "Set Lock ($lock) Sucessfull.\n" if ($output eq '00');
957 0 0         print "Set Lock ($lock) Failed.\n" if ($output eq 'f0');
958             }
959 0           return $output;
960             }
961              
962             #### ENABLE/DISABLE PTT VIA CAT
963             sub catPtt {
964 0     0 1   my ($data) = @_;
965 0           my $self=shift;
966 0           my $ptt = shift;
967 0           $data = undef;
968              
969 0 0 0       if ($ptt ne 'ON' && $ptt ne 'OFF') {
970 0 0         if($verbose){print "\nChoose valid option: ON/OFF\n\n"; }
  0            
971 0           return 1;
972             }
973              
974 0 0         if ($ptt eq 'ON') {$data = "08";}
  0            
975 0 0         if ($ptt eq 'OFF') {$data = "88";}
  0            
976 0           $output = $self->sendCat('00','00','00','00',"$data",1);
977 0 0         if ($verbose){
978 0 0         print "Set PTT ($ptt) Sucessfull.\n" if ($output eq '00');
979 0 0         print "Set PTT ($ptt) Failed. Already set to $ptt\?\n" if ($output eq 'f0');
980             }
981 0           return $output;
982             }
983              
984             #### SET CURRENT FREQ USING CAT
985             sub catsetFrequency {
986 0     0 1   my ($badf,$f1,$f2,$f3,$f4) = @_;
987 0           my $self=shift;
988 0           my $newfrequency = shift;
989              
990 0           $self->setVerbose(0);
991 0           $output=$self->catgetFrequency();
992 0           $self->setVerbose(1);
993 0 0         if ($output eq $newfrequency) {
994 0 0         if($verbose){print "\nFrequency is already set to $newfrequency\n\n"; }
  0            
995 0           return 1;
996             }
997              
998 0 0 0       if ($newfrequency!~ /\D/ && length($newfrequency)=='8') {
999 0           $f1 = substr($newfrequency, 0,2);
1000 0           $f2 = substr($newfrequency, 2,2);
1001 0           $f3 = substr($newfrequency, 4,2);
1002 0           $f4 = substr($newfrequency, 6,2);
1003             }
1004             else {
1005 0           $badf = $newfrequency;
1006 0           $newfrequency = undef;
1007 0           return 1;
1008             }
1009 0           $output = $self->sendCat("$f1","$f2","$f3","$f4",'01',1);
1010 0 0         if ($verbose){
1011 0 0         print "Set Frequency ($newfrequency) Sucessfull.\n" if ($output eq '00');
1012 0 0         print "Set Frequency ($newfrequency) Failed. $newfrequency invalid or out of range\?\n" if ($output eq 'f0');
1013             }
1014 0           return $output;
1015             }
1016              
1017             #### SET MODE VIA CAT
1018             sub catsetMode {
1019 0     0 1   my $self=shift;
1020 0           my $newmode = shift;
1021 0           $self->setVerbose(0);
1022 0           $output=$self->catgetMode();
1023 0           $self->setVerbose(1);
1024 0 0         if ($output eq $newmode) {
1025 0 0         if($verbose){print "\nMode is already set to $newmode\n\n"; }
  0            
1026 0           return 1;
1027             }
1028              
1029 0           my %newhash = reverse %OPMODES;
1030 0           my ($mode) = grep { $newhash{$_} eq $newmode } keys %newhash;
  0            
1031 0 0         if ($mode eq'') {
1032 0 0         if($verbose){print "\nChoose valid mode: USB/LSB/FM etc etc\n\n"; }
  0            
1033 0           return 1;
1034             }
1035 0           $output = $self->sendCat("$mode","00","00","00",'07',1);
1036 0 0         if ($verbose){
1037 0 0         print "Set Mode ($newmode) Sucessfull.\n" if ($output eq '00');
1038 0 0 0       print "Set Mode ($newmode) Failed.\n" if (! $mode || $output ne '00');
1039             }
1040 0           return $output;
1041             }
1042              
1043             #### ENABLE/DISABLE CLARIFIER VIA CAT
1044             sub catClarifier {
1045 0     0 1   my ($data) = @_;
1046 0           my $self=shift;
1047 0           my $clarifier = shift;
1048 0           $data = undef;
1049              
1050 0 0 0       if ($clarifier ne 'ON' && $clarifier ne 'OFF') {
1051 0 0         if($verbose){print "\nChoose valid option: ON/OFF\n\n"; }
  0            
1052 0           return 1;
1053             }
1054              
1055 0 0         if ($clarifier eq 'ON') {$data = "05";}
  0            
1056 0 0         if ($clarifier eq 'OFF') {$data = "85";}
  0            
1057 0           $output = $self->sendCat('00','00','00','00',"$data",1);
1058 0 0         if ($verbose){
1059 0 0         print "Set Clarifier ($clarifier) Sucessfull.\n" if ($output eq '00');
1060 0 0         print "Set Clarifier ($clarifier) Failed. Already set to $clarifier\?\n" if ($output eq 'f0');
1061             }
1062 0           return $output;
1063             }
1064              
1065             #### SET CLARIFIER FREQ AND POLARITY USING CAT
1066             sub catClarifierfreq {
1067 0     0 1   my ($badf,$f1,$f2,$p) = @_;
1068 0           my $self=shift;
1069 0           my $polarity = shift;
1070 0           my $frequency = shift;
1071 0 0 0       if ($polarity ne 'POS' && $polarity ne 'NEG') {
1072 0 0         if($verbose){print "\nChoose valid option: POS/NEG\n\n"; }
  0            
1073 0           return 1;
1074             }
1075 0           $p = undef;
1076 0           $badf = undef;
1077 0 0 0       if ($frequency!~ /\D/ && length($frequency)=='4') {
1078 0           $f1 = substr($frequency, 0,2);
1079 0           $f2 = substr($frequency, 2,2);
1080             }
1081             else {
1082 0           $badf = $frequency;
1083 0           $frequency = undef;
1084             }
1085 0 0         if ($polarity eq 'POS') {$p = '00';}
  0            
1086 0 0         if ($polarity eq 'NEG') {$p = '11';}
  0            
1087 0 0         if($frequency){if($p){
  0 0          
1088 0           $output = $self->sendCat("$p",'00',"$f1","$f2",'f5',1)}};
1089              
1090 0 0         if ($verbose){
1091 0 0         print "Set Clarifier Frequency ($polarity:$badf) Failed. Must contain 4 digits 0000-0999.\n" if (! $frequency);
1092 0 0         print "Set Clarifier Frequency ($polarity:$frequency) Sucessfull.\n" if ($output eq '00');
1093 0 0         print "Set Clarifier Frequency ($polarity:$frequency) Failed. $frequency out of range? POS / NEG 0000 to 0999\n" if ($output eq 'f0');
1094             }
1095 0           return $output;
1096             }
1097              
1098             #### TOGGLE VFO A/B VIA CAT
1099             sub catvfoToggle {
1100 0     0 1   my $self=shift;
1101 0           $output = $self->sendCat('00','00','00','00','81',1);
1102 0 0         if ($verbose){
1103 0 0         print "VFO toggle Sucessfull.\n" if ($output eq '00');
1104 0 0         print "VFO toggle Failed\n" if ($output eq 'f0');
1105             }
1106 0           return $output;
1107             }
1108              
1109             #### ENABLE/DISABLE SPLIT FREQUENCY VIA CAT
1110             sub catSplitfreq {
1111 0     0 1   my ($data) = @_;
1112 0           my $self=shift;
1113 0           my $split = shift;
1114 0           $data = undef;
1115              
1116 0 0 0       if ($split ne 'ON' && $split ne 'OFF') {
1117 0 0         if($verbose){print "\nChoose valid option: ON/OFF\n\n"; }
  0            
1118 0           return 1;
1119             }
1120 0 0         if ($split eq 'ON') {$data = "02";}
  0            
1121 0 0         if ($split eq 'OFF') {$data = "82";}
  0            
1122              
1123              
1124 0           $output = $self->sendCat('00','00','00','00',"$data",1);
1125 0 0         if ($verbose){
1126 0 0         print "Set Split Frequency ($split) Sucessfull.\n" if ($output eq '00');
1127 0 0         print "Set Split Frequency ($split) Failed. Already set to $split\?\n" if ($output eq 'f0');
1128             }
1129 0           return $output;
1130             }
1131              
1132             #### POS/NEG/SIMPLEX REPEATER OFFSET MODE VIA CAT
1133             sub catOffsetmode {
1134 0     0 1   my ($datablock) = @_;
1135 0           my $self=shift;
1136 0           my $offsetmode = shift;
1137 0           $datablock = undef;
1138              
1139 0 0 0       if ($offsetmode ne 'POS' && $offsetmode ne 'NEG' && $offsetmode ne 'SIMPLEX') {
      0        
1140 0 0         if($verbose){print "\nChoose valid option: POS/NEG/SIMPLEX\n\n"; }
  0            
1141 0           return 1;
1142             }
1143              
1144 0 0         if ($offsetmode eq 'POS'){$datablock = '49';}
  0            
1145 0 0         if ($offsetmode eq 'NEG') {$datablock = '09';}
  0            
1146 0 0         if ($offsetmode eq 'SIMPLEX') {$datablock = '89';}
  0            
1147 0           $output = $self->sendCat("$datablock",'00','00','00','09',1);
1148 0 0         if ($verbose){
1149 0 0         print "Set Offset Mode ($offsetmode) Sucessfull.\n" if ($datablock);
1150 0 0         print "Set Offset Mode ($offsetmode) Failed. Option:$offsetmode invalid\.\n" if (! $datablock);
1151             }
1152 0           return $output;
1153             }
1154              
1155             #### SET REPEATER OFFSET FREQ USING CAT
1156             sub catOffsetfreq {
1157 0     0 1   my ($badf,$f1,$f2,$f3,$f4) = @_;
1158 0           my $self=shift;
1159 0           my $frequency = shift;
1160 0 0 0       if ($frequency!~ /\D/ && length($frequency)=='8') {
1161 0           $f1 = substr($frequency, 0,2);
1162 0           $f2 = substr($frequency, 2,2);
1163 0           $f3 = substr($frequency, 4,2);
1164 0           $f4 = substr($frequency, 6,2);
1165             }
1166             else {
1167 0           $badf = $frequency;
1168 0           $frequency = undef;
1169             }
1170 0           $output = $self->sendCat("$f1","$f2","$f3","$f4",'F9',1);
1171 0 0         if($verbose){
1172 0 0         print "Set Offset Frequency ($badf) Failed. Must contain 8 digits 0000-9999.\n" if (! $frequency);
1173 0 0         print "Set Offset Frequency ($frequency) Sucessfull.\n" if ($output eq '00');
1174 0 0         print "Set Offset Frequency ($frequency) Failed. $frequency invalid or out of range or split frequency on\?\n" if ($output eq 'f0');
1175             }
1176 0           return $output;
1177             }
1178              
1179             #### SETS CTCSS/DCS MODE VIA CAT
1180             sub catCtcssdcs {
1181 0     0 1   my ($split,$data) = @_;
1182 0           my $self=shift;
1183 0           my $ctcssdcs = shift;
1184 0           $data = undef;
1185              
1186 0 0 0       if ($ctcssdcs ne 'DCS' && $ctcssdcs ne 'CTCSS' && $ctcssdcs ne 'ON' && $ctcssdcs ne 'OFF') {
      0        
      0        
1187 0 0         if($verbose){print "\nChoose valid option: DCS/CTCSS/ON/OFF\n\n"; }
  0            
1188 0           return 1;
1189             }
1190              
1191 0 0         if ($ctcssdcs eq 'DCS'){$data = "0A";}
  0            
1192 0 0         if ($ctcssdcs eq 'CTCSS'){$data = "2A";}
  0            
1193 0 0         if ($ctcssdcs eq 'ON'){$data = "4A";}
  0            
1194 0 0         if ($ctcssdcs eq 'OFF'){$data = "8A";}
  0            
1195 0           $output = $self->sendCat("$data",'00','00','00','0A',1);
1196 0 0         if ($verbose){
1197 0 0         print "Set Encoder Type ($ctcssdcs) Sucessfull.\n" if ($data);
1198 0 0         print "Set Encoder Type ($ctcssdcs) Failed. Option:$ctcssdcs invalid\.\n" if (! $data);
1199             }
1200 0           return $output;
1201             }
1202              
1203             #### SETS CTCSS TONE FREQUENCY
1204             sub catCtcsstone {
1205 0     0 1   my ($badf,$f1,$f2) = @_;
1206 0           my $self=shift;
1207 0           my $tonefreq = shift;
1208 0 0 0       if ($tonefreq!~ /\D/ && length($tonefreq)=='4') {
1209 0           $f1 = substr($tonefreq, 0,2);
1210 0           $f2 = substr($tonefreq, 2,2);
1211             }
1212             else {
1213 0           $badf = $tonefreq;
1214 0           $tonefreq = undef;
1215 0 0         print "Set CTCSS Tone ($badf) Failed. Must contain 4 digits 0-9.\n" if (! $tonefreq);
1216 0           return 1;
1217             }
1218 0 0         if($tonefreq){$output = $self->sendCat("$f1","$f2",'00','00','0B',1);}
  0            
1219 0 0         if ($verbose){
1220 0 0         print "Set CTCSS Tone ($badf) Failed. Must contain 4 digits 0-9.\n" if (! $tonefreq);
1221 0 0         print "Set CTCSS Tone ($tonefreq) Sucessfull.\n" if ($output eq '00');
1222              
1223 0 0         if ($output eq 'f0'){
1224 0           print "Set CTCSS ($tonefreq) Failed. $tonefreq is not a valid tone frequency. Leading zero if necessary\n\n";
1225 0           my $columns = 1;
1226 0           foreach my $tones (sort keys %CTCSSTONES) {
1227 0           printf "%-15s %s",$CTCSSTONES{$tones};
1228 0           $columns++;
1229 0 0         if ($columns == 7){print "\n\n"; $columns = 1;}
  0            
  0            
1230             }
1231 0           print "\n\n";
1232             }
1233             }
1234 0           return $output;
1235             }
1236              
1237             #### SET DCS CODE USING CAT######
1238             sub catDcscode {
1239 0     0 1   my ($badf,$f1,$f2) = @_;
1240 0           my $self=shift;
1241 0           my $code = shift;
1242 0 0 0       if ($code!~ /\D/ && length($code)=='4') {
1243 0           $f1 = substr($code, 0,2);
1244 0           $f2 = substr($code, 2,2);
1245             }
1246             else {
1247 0           $badf = $code;
1248 0           $code = undef;
1249 0 0 0       if (!$code && $verbose){print "Set DCS Code ($badf) Failed. Must contain 4 digits 0-9. Leading zero if necessary\n";}
  0            
1250 0           return 1;
1251             }
1252 0 0         if($code){$output = $self->sendCat("$f1","$f2",'00','00','0C',1);}
  0            
1253 0 0         if ($verbose){
1254 0 0         print "Set DCS Code ($badf) Failed. Must contain 4 digits 0-9.\n" if (! $code);
1255 0 0         print "Set DCS Code ($code) Sucessfull.\n" if ($output eq '00');
1256 0 0         if ($output eq 'f0') {
1257 0           print "Set DCS Code ($code) Failed. $code is not a valid DCS Code\.\n\n";
1258 0           my $columns = 1;
1259 0           foreach my $codes (sort keys %DCSCODES) {
1260 0           printf "%-15s %s",$DCSCODES{$codes};
1261 0           $columns++;
1262 0 0         if ($columns == 7){print "\n\n"; $columns = 1;}
  0            
  0            
1263             }
1264 0           print "\n\n";
1265              
1266             }
1267             }
1268 0           return $output;
1269             }
1270              
1271             #### GET MULTIPLE VALUES OF RX STATUS RETURN AS variables OR hash
1272             sub catRxstatus {
1273 0     0 1   my ($match,$desc,$squelch) = @_;
1274 0           my $self=shift;
1275 0           my $option = shift;
1276 0 0         if (!$option){$option = 'HASH';}
  0            
1277 0           $output = $self->sendCat('00','00','00','00','E7',1);
1278 0           my $values = hex2bin($output);
1279 0           my $sq = substr($values,0,1);
1280 0           my $smeter = substr($values,4,4);
1281 0           my $smeterlin = substr($values,4,4);
1282 0           my $ctcssmatch = substr($values,2,1);
1283 0           my $descriminator = substr($values,3,1);
1284 0           ($smeter) = grep { $SMETER{$_} eq $smeter } keys %SMETER;
  0            
1285 0           ($smeterlin) = grep { $SMETERLIN{$_} eq $smeterlin } keys %SMETERLIN;
  0            
1286 0 0         if ($sq == 0) {$squelch = 'OFF';}
  0            
1287 0 0         if ($sq == 1) {$squelch = 'ON';}
  0            
1288 0 0         if ($ctcssmatch == 0) {$match = 'MATCHED/OFF';}
  0            
1289 0 0         if ($ctcssmatch == 1) {$match = 'UNMATCHED';}
  0            
1290 0 0         if ($descriminator == 0) {$desc = 'CENTERED';}
  0            
1291 0 0         if ($descriminator == 1) {$desc = 'OFF-CENTER';}
  0            
1292 0 0         if ($verbose) {
1293 0           print "\nReceive status:\n\n";
1294 0           printf "%-18s %-11s\n", 'FUNCTION','VALUE';
1295 0           print "________________________";
1296 0           printf "\n%-18s %-11s\n%-18s %-11s\n%-18s %-11s\n%-18s %-11s\n\n", 'Squelch', "$squelch", 'S-METER', "$smeter \/ $smeterlin", 'Tone Match', "$match", 'Descriminator', "$desc";
1297             }
1298 0 0         if ($option eq'VARIABLES'){
1299 0           return ("$squelch","$smeter","$smeterlin" ,"$match", "$desc");
1300             }
1301 0 0         if ($option eq 'HASH') {
1302 0           my %rxstatus = ('squelch' => "$squelch", 'smeterdb' => "$smeter", 'smeterlinear' => "$smeterlin",
1303             'descriminator' => "$desc", 'ctcssmatch' => "$match");
1304 0           return %rxstatus;
1305             }
1306             }
1307              
1308             #### GET MULTIPLE VALUES OF TX STATUS RETURN AS variables OR hash
1309             sub catTxstatus {
1310 0     0 1   my ($match,$desc,$ptt,$highswr,$split) = @_;
1311 0           my $self=shift;
1312 0           my $option = shift;
1313 0 0         if (!$option){$option = 'HASH';}
  0            
1314 0           $output = $self->sendCat('00','00','00','00','F7',1);
1315 0           my $values = hex2bin($output);
1316 0           my $pttvalue = substr($values,0,1);
1317 0           my $pometer = substr($values,4,4);
1318 0           my $pometerlin = substr($values,4,4);
1319 0           my $highswrvalue = substr($values,2,1);
1320 0           my $splitvalue = substr($values,3,1);
1321 0           ($pometer) = grep { $PMETER{$_} eq $pometer } keys %PMETER;
  0            
1322 0 0         if ($pttvalue == 0) {$ptt = 'OFF';}
  0            
1323 0 0         if ($pttvalue == 1) {$ptt = 'ON';}
  0            
1324 0 0         if ($highswrvalue == 0) {$highswr = 'OFF';}
  0            
1325 0 0         if ($highswrvalue == 1) {$highswr = 'ON';}
  0            
1326 0 0         if ($splitvalue == 0) {$split = 'ON';}
  0            
1327 0 0         if ($splitvalue == 1) {$split = 'OFF';}
  0            
1328 0 0         if ($verbose) {
1329 0           print "\nTransmit status:\n\n";
1330 0           printf "%-18s %-11s\n", 'FUNCTION','VALUE';
1331 0           print "________________________";
1332 0           printf "\n%-18s %-11s\n%-18s %-11s\n%-18s %-11s\n%-18s %-11s\n\n", 'Power Meter', "$pometer", 'PTT', "$ptt", 'High SWR', "$highswr", 'Split', "$split";
1333             }
1334 0 0         if ($option eq'VARIABLES'){
1335 0           return ("$ptt","$pometer","$highswr" ,"$split");
1336             }
1337 0 0         if ($option eq 'HASH') {
1338 0           my %txstatus = ('ptt' => "$ptt", 'pometer' => "$pometer",
1339             'highswr' => "$highswr", 'split' => "$split");
1340 0           return %txstatus;
1341             }
1342             }
1343              
1344             #### GET CURRENT FREQ USING CAT######
1345             sub catgetFrequency {
1346 0     0 1   my ($freq) = @_;
1347 0           my $self=shift;
1348 0           my $formatted = shift;
1349 0           $output = $self->sendCat('00','00','00','00','03',5);
1350 0           $freq = substr($output,0,8);
1351 0           $freq =~ s/^0+//;
1352 0 0         if ($formatted == 1) {
1353 0           substr($freq,-2,0) = '.';
1354 0           substr($freq,-6,0) = '.';
1355 0           $freq .= " MHZ";
1356             }
1357 0 0         if ($verbose){print "Frequency is $freq\n";}
  0            
1358 0           return $freq;
1359             }
1360              
1361             #### GET CURRENT MODE USING CAT######
1362             sub catgetMode {
1363 0     0 1   my $self=shift;
1364 0           my $currentmode;
1365 0           my $formatted = shift;
1366 0           $output = $self->sendCat('00','00','00','00','03',5);
1367 0           $currentmode = substr($output,8,2);
1368 0           my ($mode) = grep { $OPMODES{$_} eq $currentmode } keys %OPMODES;
  0            
1369 0 0         if ($verbose){print "Mode is $mode\n";}
  0            
1370 0           return $mode;
1371             }
1372              
1373             #### SETS RADIO POWER ON OR OFF VIA CAT
1374             sub catPower {
1375 0     0 1   my ($data) = @_;
1376 0           my $self=shift;
1377 0           my $powerset = shift;
1378 0           $data = undef;
1379 0 0 0       if ($powerset ne 'ON' && $powerset ne 'OFF') {
1380 0 0         if($verbose){print "\nChoose valid option: ON/OFF\n\n"; }
  0            
1381 0           return 1;
1382             }
1383            
1384              
1385 0 0         if ($powerset eq 'ON'){$data = "0F";}
  0            
1386 0 0         if ($powerset eq 'OFF') {$data = "8F";}
  0            
1387 0           $self->sendCat('00','00','00','00','00',1);
1388 0           $output = $self->sendCat('00','00','00','00',"$data",1);
1389 0 0         if($verbose){
1390 0 0         print "Set Power ($powerset) Sucessfull.\n" if ($output eq '00');
1391 0 0         print "Set Power ($powerset) Failed. Already $powerset\?\n" if (!$output);
1392             }
1393              
1394 0           return $output;
1395             }
1396              
1397             ###############################
1398             # END OF CAT COMMANDS #
1399             ###############################
1400              
1401              
1402             ################################
1403             # READ VALUES FROM EEPROM ADDR #
1404             ################################
1405              
1406             # X ################################# GET VALUES OF EEPROM ADDRESS VIA EEPROMDECODE
1407             ###################################### READ ADDRESS GIVEN
1408             sub getEeprom {
1409 0     0 1   my ($times,$valuehex,%valuehash) = @_;
1410 0           my $self=shift;
1411 0           my $address1 =shift;
1412 0           my $address2 = shift;
1413 0           my $base = $address1;
1414 0 0         if (!$address2) {$address2 = $address1;}
  0            
1415 0 0         if ($verbose){
1416 0 0 0       if (!$address1 || length($address1) != 4) {
1417 0           print "Get EEPROM ($address1 $address2) Failed. Must contain hex value 0-9 a-f. i.e. [005F] or [005F 006A] for a range\n";
1418 0           return 1;
1419             }
1420 0 0 0       if ($address2 && length($address2) != 4) {
1421 0           print "Get EEPROM ($address1 $address2) Failed. Must contain hex value 0-9 a-f. i.e. [005F] or [005F 006A] for a range\n";
1422 0           return 1;
1423             }
1424 0           $times=$self->hexDiff("$address1","$address2");
1425 0 0         if ($times < 0) {
1426 0           print "The Secondary value [$address2] must be greater than the first [$address1]";
1427 0           return 1;
1428             }
1429             }
1430 0           print "\n";
1431 0           printf "%-11s %-15s %-11s %-11s\n", 'ADDRESS', 'BINARY', 'DECIMAL', 'VALUE';
1432 0           print "___________________________________________________\n";
1433              
1434 0           $times++;
1435 0           my $cycles = 0;
1436 0           do {
1437 0           my $valuebin = $self->eepromDecode("$address1");
1438 0           my $valuehex = sprintf("%X", oct( "0b$valuebin" ) );
1439 0           $valuehash{"$address1"} = $valuehex;
1440 0           my $valuedec = hex($valuehex);
1441 0           printf "%-11s %-15s %-11s %-11s\n", "$address1", "$valuebin", "$valuedec", "$valuehex";
1442 0           $cycles++;
1443 0           $address1 = $self->hexAdder("$cycles","$base");
1444             }
1445             while ($cycles < $times);
1446 0           print "\n";
1447 0 0         if ($times == 1){
1448 0           return $valuehex;
1449             }
1450              
1451             else {
1452 0           return %valuehash;
1453             }
1454             }
1455              
1456             # 0-3 ################################# GET EEPROM CHECKSUM
1457             ###################################### READ ADDRESS 0X0 AND 0X3
1458             sub getChecksum {
1459 0     0 1   my ($checksumhex0,$checksumhex1,$checksumhex2,$checksumhex3) = @_;
1460 0           my $self=shift;
1461 0           my $type=shift;
1462 0           my ($output0,$output1) = $self->eepromDoubledecode('0000');
1463 0           my ($output2,$output3) = $self->eepromDoubledecode('0002');
1464 0           $checksumhex0 = sprintf("%X", oct( "0b$output0" ) );
1465 0           $checksumhex1 = sprintf("%X", oct( "0b$output1" ) );
1466 0           $checksumhex2 = sprintf("%X", oct( "0b$output2" ) );
1467 0           $checksumhex3 = sprintf("%X", oct( "0b$output3" ) );
1468 0           my $configoutput = "[$checksumhex0][$checksumhex1][$checksumhex2][$checksumhex3]";
1469 0 0         if($verbose){
1470 0           print "\nCHECKSUM VALUES ARE:\n\n";
1471 0           printf "%-11s %-11s\n", 'ADDRESS','HEX';
1472 0           print "_______________";
1473 0           printf "\n%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n%-11s %-11s\n\n", '0x00', "$checksumhex0", '0x01', "$checksumhex1", '0x02', "$checksumhex2", '0x03', "$checksumhex3";
1474             }
1475 0           return $configoutput;
1476             }
1477              
1478             # 4-5 ################################# GET RADIO VERSION VIA EEPROMDECODE
1479             ###################################### READ ADDRESS 0X4 AND 0X5
1480             sub getConfig {
1481 0     0 1   my ($confighex4,$confighex5) = @_;
1482 0           my $self=shift;
1483 0           my $type=shift;
1484 0           my($output4,$output5) = $self->eepromDoubledecode('0004');
1485 0           $confighex4 = sprintf("%x", oct( "0b$output4" ) );
1486 0           $confighex5 = sprintf("%x", oct( "0b$output5" ) );
1487 0           my $configoutput = "[$confighex4][$confighex5]";
1488 0 0         if($verbose){
1489 0           print "\nHardware Jumpers created value of\n\n";
1490 0           printf "%-11s %-11s %-15s\n", 'ADDRESS','BINARY','HEX';
1491 0           print "___________________________";
1492 0           printf "\n%-11s %-11s %-15s\n%-11s %-11s %-15s\n\n", '0x04', "$output4", "$confighex4", '0x05', "$output5", "$confighex5";
1493             }
1494 0           return $configoutput;
1495             }
1496              
1497              
1498             # 7-53 ################################ GET SOFTWARE CAL VALUES EEPROMDECODE
1499             ###################################### READ ADDRESS 0X4 AND 0X5
1500              
1501             sub getSoftcal {
1502 0     0 1   my $self=shift;
1503 0           my $option=shift;
1504 0           my $filename=shift;
1505 0           my $localtime = localtime();
1506 0           my $buildfile;
1507 0 0         if (!$option){$option = 'CONSOLE';}
  0            
1508 0           my $block = 1;
1509 0           my $startaddress = "07";
1510 0           my $digestdata = undef;
1511 0           my $memoryaddress;
1512 0 0         if ($option eq 'CONSOLE') {
1513 0 0         if ($verbose){
1514 0           print "\n";
1515 0           printf "%-11s %-15s %-11s %-11s\n", 'ADDRESS', 'BINARY', 'DECIMAL', 'VALUE';
1516 0           print "___________________________________________________\n";
1517             }
1518             }
1519 0 0 0       if ($verbose && $option eq 'DIGEST'){
1520 0           print "Generated an MD5 hash from software calibration values ";
1521             }
1522 0 0         if ($option eq 'FILE'){
1523 0 0         if (!$filename) {print"\nFilename required. eg. /home/user/softcal.txt\n";return 0;}
  0            
  0            
1524 0 0         if (-e $filename) {
1525 0           print "\nFile exists. Backup/rename old file before creating new one.\n";
1526 0           return 0;
1527             }
1528             else {
1529 0           $buildfile = '1';
1530 0 0         if ($verbose){print "\nCreating calibration backup to $filename........\n";}
  0            
1531 0 0         open FILE , ">>", "$filename" or print"Can't open $filename. error\n";
1532 0           print FILE "FT817 Software Calibration Backup\nUsing FT817COMM.pm version $VERSION\n";
1533 0           print FILE "Created $localtime\n";
1534 0           print FILE "Using FT817OS Format, Do not modify this file\n\n";
1535 0           printf FILE "%-11s %-15s %-11s %-11s\n", 'ADDRESS', 'BINARY', 'DECIMAL', 'VALUE';
1536 0           print FILE "___________________________________________________\n";
1537             }
1538             }
1539 0 0         if ($option eq 'DIGEST') {
1540 0           do {
1541 0           $memoryaddress = sprintf("%x",$startaddress);
1542 0           my $size = length($memoryaddress);
1543 0 0         if ($size < 2){$memoryaddress = join("",'0',"$memoryaddress");}
  0            
1544 0           $memoryaddress = join("",'00',"$memoryaddress");
1545 0           my $valuebin = $self->eepromDecode("$memoryaddress");
1546 0           my $valuehex = sprintf("%x", oct( "0b$valuebin" ) );
1547 0           $digestdata .="$valuehex";
1548 0           $block++;
1549 0           $startaddress ++;
1550             }
1551             while ($block < '77');
1552 0           my $digest = md5($digestdata);
1553 0 0         if ($verbose) {print "DIGEST: ---->$digest<----\n";}
  0            
1554 0           return $digest;
1555             }
1556             else {
1557 0           do {
1558 0           $memoryaddress = sprintf("%x",$startaddress);
1559 0           my $size = length($memoryaddress);
1560 0 0         if ($size < 2){$memoryaddress = join("",'0',"$memoryaddress");}
  0            
1561 0           $memoryaddress = join("",'00',"$memoryaddress");
1562 0           my $valuebin = $self->eepromDecode("$memoryaddress");
1563 0           my $valuehex = sprintf("%x", oct( "0b$valuebin" ) );
1564 0           my $hexsize = length($valuehex);
1565 0 0         if ($hexsize < 2){$valuehex = join("",'0',"$valuehex");}
  0            
1566 0           my $valuedec = hex($valuehex);
1567 0 0 0       if ($option eq 'CONSOLE' || $verbose) {
1568 0           printf "\n%-11s %-15s %-11s %-11s\n", "$memoryaddress", "$valuebin", "$valuedec", "$valuehex";
1569             }
1570 0 0         if ($buildfile == '1'){
1571 0           printf FILE "%-11s %-15s %-11s %-11s\n", "$memoryaddress", "$valuebin", "$valuedec", "$valuehex";
1572             }
1573 0           $block++;
1574 0           $startaddress ++;
1575             }
1576             while ($block < '77');
1577             }
1578 0 0         if ($buildfile == '1'){
1579 0           print FILE "\n\n---END OF Software Calibration Settings---\n";
1580 0           close FILE;
1581 0           return 0;
1582             }
1583 0           return $output;
1584             }
1585              
1586             # 55 ################################# GET MTQMB, QMB, VFO A/B , HOME VFO OR MEMORY VIA EEPROMDECODE
1587             ###################################### READ BIT 0,1,2,4 AND 8 FROM ADDRESS 0X55
1588              
1589             sub getMtqmb {
1590 0     0 1   my $self=shift;
1591 0           my $mtqmb;
1592 0           $output = $self->eepromDecode('0055');
1593 0           my @block55 = split("",$output);
1594 0 0         if ($block55[6] == '0') {$mtqmb = "OFF";}
  0            
1595 0 0         if ($block55[6] == '1') {$mtqmb = "ON";}
  0            
1596 0 0         if($verbose){print "MTQMB is $mtqmb\n";}
  0            
1597 0           return $mtqmb;
1598             }
1599              
1600             sub getQmb {
1601 0     0 1   my $self=shift;
1602 0           my $qmb;
1603 0           $output = $self->eepromDecode('0055');
1604 0           my @block55 = split("",$output);
1605 0 0         if ($block55[5] == '0') {$qmb = "OFF";}
  0            
1606 0 0         if ($block55[5] == '1') {$qmb = "ON";}
  0            
1607 0 0         if($verbose){print "QMB is $qmb\n";}
  0            
1608 0           return $qmb;
1609             }
1610              
1611             sub getMtune {
1612 0     0 1   my $self=shift;
1613 0           my $mtune;
1614 0           $output = $self->eepromDecode('0055');
1615 0           my @block55 = split("",$output);
1616 0 0         if ($block55[2] == '0') {$mtune = "MEMORY";}
  0            
1617 0 0         if ($block55[2] == '1') {$mtune = "MTUNE";}
  0            
1618 0 0         if($verbose){print "MTUNE is $mtune\n";}
  0            
1619 0           return $mtune;
1620             }
1621              
1622             sub getVfo {
1623 0     0 1   my $self=shift;
1624 0           $output = $self->eepromDecode('0055');
1625 0           my @block55 = split("",$output);
1626 0 0         if ($block55[7] == '0') {$vfo = "A";}
  0            
1627 0 0         if ($block55[7] == '1') {$vfo = "B";}
  0            
1628 0 0         if($verbose){print "VFO is $vfo\n";}
  0            
1629 0           return $vfo;
1630             }
1631              
1632             sub getHome {
1633 0     0 1   my $self=shift;
1634 0           my $home;
1635 0           $output = $self->eepromDecode('0055');
1636 0           my @block55 = split("",$output);
1637 0 0         if ($block55[3] == '1') {$home = "Y";}
  0            
1638 0 0         if ($block55[3] == '0') {$home = "N";}
  0            
1639 0 0         if($verbose){
1640 0 0         if($home eq'Y'){print "At Home Frequency.\n";}
  0            
1641 0 0         if($home eq 'N'){print "Not at Home Frequency\n";}
  0            
1642             }
1643 0           return $home;
1644             }
1645              
1646             sub getTuner {
1647 0     0 1   my $self=shift;
1648 0           my $tuneselect;
1649 0           $output = $self->eepromDecode('0055');
1650 0           my @block55 = split("",$output);
1651 0 0         if ($block55[1] == '0') {$tuneselect = "VFO";}
  0            
1652 0 0         if ($block55[1] == '1') {$tuneselect = "MEMORY";}
  0            
1653 0 0         if($verbose){print "Tuner is $tuneselect\n";}
  0            
1654 0           return $tuneselect;
1655             }
1656              
1657             # 57 ################################# GET AGC MODE, NOISE BLOCK, FASTTUNE ,PASSBAND Tuning, DSP AND LOCK ######
1658             ###################################### READ BITS 0-1 , 2, 4 ,5 AND 6 FROM 0X57
1659              
1660             sub getAgc {
1661 0     0 1   my $self=shift;
1662 0           $output = $self->eepromDecode('0057');
1663 0           my $agcvalue = substr($output,6,2);
1664 0           my ($agc) = grep { $AGCMODES{$_} eq $agcvalue } keys %AGCMODES;
  0            
1665 0 0         if($verbose){print "AGC is $agc\n";}
  0            
1666 0           return $agc;
1667             }
1668              
1669             sub getDsp {
1670 0     0 1   my $self=shift;
1671 0           my $dsp;
1672 0           $output = $self->eepromDecode('0057');
1673 0           my @block55 = split("",$output);
1674 0 0         if ($block55[5] == '0') {$dsp = "OFF";}
  0            
1675 0 0         if ($block55[5] == '1') {$dsp = "ON";}
  0            
1676 0 0         if($verbose){print "DSP is $dsp\n";}
  0            
1677 0           return $dsp;
1678             }
1679              
1680             sub getPbt {
1681 0     0 1   my $self=shift;
1682 0           my $pbt;
1683 0           $output = $self->eepromDecode('0057');
1684 0           my @block55 = split("",$output);
1685 0 0         if ($block55[3] == '0') {$pbt = "OFF";}
  0            
1686 0 0         if ($block55[3] == '1') {$pbt = "ON";}
  0            
1687 0 0         if($verbose){print "Passband Tuning is $pbt\n";}
  0            
1688 0           return $pbt;
1689             }
1690              
1691             sub getNb {
1692 0     0 1   my $self=shift;
1693 0           my $nb;
1694 0           $output = $self->eepromDecode('0057');
1695 0           my @block55 = split("",$output);
1696 0 0         if ($block55[2] == '0') {$nb = "OFF";}
  0            
1697 0 0         if ($block55[2] == '1') {$nb = "ON";}
  0            
1698 0 0         if($verbose){print "Noise Blocker is $nb\n";}
  0            
1699 0           return $nb;
1700             }
1701              
1702             sub getLock {
1703 0     0 1   my $self=shift;
1704 0           my $lock;
1705 0           $output = $self->eepromDecode('0057');
1706 0           my @block55 = split("",$output);
1707 0 0         if ($block55[1] == '1') {$lock = "OFF";}
  0            
1708 0 0         if ($block55[1] == '0') {$lock = "ON";}
  0            
1709 0 0         if($verbose){print "Lock is $lock\n";}
  0            
1710 0           return $lock;
1711             }
1712              
1713             sub getFasttuning {
1714 0     0 1   my $self=shift;
1715 0           my $fasttuning;
1716 0           $output = $self->eepromDecode('0057');
1717 0           my @block55 = split("",$output);
1718 0 0         if ($block55[0] == '1') {$fasttuning = "OFF";}
  0            
1719 0 0         if ($block55[0] == '0') {$fasttuning = "ON";}
  0            
1720 0 0         if($verbose){print "Fast Tuning is $fasttuning\n";}
  0            
1721 0           return $fasttuning;
1722             }
1723              
1724             # 58 ################################# GET POWER METER MODE, CW PADDLE, KYR, BK, VLT, VOX ######
1725             ###################################### READ BIT 0-1,2,4,5,6,7 FROM 0X58
1726              
1727             sub getPwrmtr {
1728 0     0 1   my ($pwrmtr) = @_;
1729 0           my $self=shift;
1730 0           $output = $self->eepromDecode('0058');
1731 0           $pwrmtr = substr($output,6,2);
1732 0 0         if ($pwrmtr == '00'){$pwrmtr = 'PWR'};
  0            
1733 0 0         if ($pwrmtr == '01'){$pwrmtr = 'ALC'};
  0            
1734 0 0         if ($pwrmtr == '10'){$pwrmtr = 'SWR'};
  0            
1735 0 0         if ($pwrmtr == '11'){$pwrmtr = 'MOD'};
  0            
1736 0 0         if($verbose){print "Power Meter set to $pwrmtr\n";}
  0            
1737 0           return $pwrmtr;
1738             }
1739              
1740             sub getCwpaddle {
1741 0     0 1   my ($cwpaddle) = @_;
1742 0           my $self=shift;
1743 0           $output = $self->eepromDecode('0058');
1744 0           $cwpaddle = substr($output,5,1);
1745 0 0         if ($cwpaddle == '0'){$cwpaddle = 'NORMAL'};
  0            
1746 0 0         if ($cwpaddle == '1'){$cwpaddle = 'REVERSE'};
  0            
1747 0 0         if($verbose){print "CW Paddle set to $cwpaddle\n";}
  0            
1748 0           return $cwpaddle;
1749             }
1750              
1751             sub getKyr {
1752 0     0 1   my ($kyr) = @_;
1753 0           my $self=shift;
1754 0           $output = $self->eepromDecode('0058');
1755 0           $kyr = substr($output,3,1);
1756 0 0         if ($kyr == '0'){$kyr = 'OFF'};
  0            
1757 0 0         if ($kyr == '1'){$kyr = 'ON'};
  0            
1758 0 0         if($verbose){print "Keyer (KYR) set to $kyr\n";}
  0            
1759 0           return $kyr;
1760             }
1761              
1762             sub getBk {
1763 0     0 1   my ($bk) = @_;
1764 0           my $self=shift;
1765 0           $output = $self->eepromDecode('0058');
1766 0           $bk = substr($output,2,1);
1767 0 0         if ($bk == '0'){$bk = 'OFF'};
  0            
1768 0 0         if ($bk == '1'){$bk = 'ON'};
  0            
1769 0 0         if($verbose){print "Break in (BK) set to $bk\n";}
  0            
1770 0           return $bk;
1771             }
1772              
1773             sub getVlt {
1774 0     0 1   my ($vlt) = @_;
1775 0           my $self=shift;
1776 0           $output = $self->eepromDecode('0058');
1777 0           $vlt = substr($output,1,1);
1778 0 0         if ($vlt == '0'){$vlt = 'OFF'};
  0            
1779 0 0         if ($vlt == '1'){$vlt = 'ON'};
  0            
1780 0 0         if($verbose){print "Voltage display set to $vlt\n";}
  0            
1781 0           return $vlt;
1782             }
1783              
1784             sub getVox {
1785 0     0 1   my ($vox) = @_;
1786 0           my $self=shift;
1787 0           $output = $self->eepromDecode('0058');
1788 0           my @block55 = split("",$output);
1789 0 0         if ($block55[0] == '0') {$vox = "OFF";}
  0            
1790 0 0         if ($block55[0] == '1') {$vox = "ON";}
  0            
1791 0 0         if($verbose){print "VOX is $vox\n";}
  0            
1792 0           return $vox;
1793             }
1794              
1795             # 59 ################################# GET VFO BANDS ######
1796             ###################################### READ ALL BITS FROM 0X59
1797              
1798             sub getVfoband {
1799 0     0 1   my ($vfoband, $vfobandvalue) = @_;
1800 0           my $self=shift;
1801 0           my $value=shift;
1802 0 0 0       if ($value ne 'A' && $value ne 'B'){
1803 0 0         if($verbose){print "Value invalid: Choose A/B\n\n";}
  0            
1804 0           return 1;
1805             }
1806 0           $output = $self->eepromDecode('0059');
1807 0 0         if ($value eq 'A'){$vfobandvalue = substr($output,4,4);}
  0            
1808 0 0         if ($value eq 'B'){$vfobandvalue = substr($output,0,4);}
  0            
1809 0           ($vfoband) = grep { $VFOBANDS{$_} eq $vfobandvalue } keys %VFOBANDS;
  0            
1810 0 0         if($verbose){print "VFO Band is $vfoband\n";}
  0            
1811 0           return $vfoband;
1812             }
1813              
1814             # 5B ################################# GET CONTRAST, COLOR, BACKLIGHT ######
1815             ###################################### READ BIT 0-3, 4, 6-7 FROM 0X5B
1816              
1817             sub getContrast {
1818 0     0 1   my ($contrast) = @_;
1819 0           my $self=shift;
1820 0           $output = $self->eepromDecode('005B');
1821 0           $contrast = substr($output,4,4);
1822 0           my $HEX1 = sprintf("%X", oct( "0b$contrast" ) );
1823 0           $contrast = hex($HEX1);
1824 0           $contrast = $contrast - 1;
1825 0 0         if($verbose){print "CONTRAST is $contrast\n";}
  0            
1826 0           return $contrast;
1827             }
1828              
1829             sub getColor {
1830 0     0 1   my ($color) = @_;
1831 0           my $self=shift;
1832 0           $output = $self->eepromDecode('005B');
1833 0           $color = substr($output,3,1);
1834 0 0         if ($color == '1'){$color = 'AMBER';}
  0            
1835 0           else{$color = 'BLUE';}
1836 0 0         if($verbose){print "COLOR is $color\n";}
  0            
1837 0           return $color;
1838             }
1839              
1840             sub getBacklight {
1841 0     0 1   my ($backlight) = @_;
1842 0           my $self=shift;
1843 0           $output = $self->eepromDecode('005B');
1844 0           $backlight = substr($output,0,2);
1845 0 0         if ($backlight == '00'){$backlight = 'OFF';}
  0            
1846 0 0         if ($backlight == '01'){$backlight = 'ON';}
  0            
1847 0 0         if ($backlight == '10'){$backlight = 'AUTO';}
  0            
1848 0 0         if($verbose){print "BACKLIGHT is set to $backlight\n";}
  0            
1849 0           return $backlight;
1850             }
1851              
1852             # 5C ################################# GET BEEP VOL, BEEP FREQ ######
1853             ###################################### READ BIT 6-0, 7 FROM 0X5C
1854              
1855             sub getBeepvol {
1856 0     0 1   my ($beepvol) = @_;
1857 0           my $self=shift;
1858 0           $output = $self->eepromDecode('005C');
1859 0           $beepvol = substr($output,1,7);
1860 0           my $HEX1 = sprintf("%X", oct( "0b$beepvol" ) );
1861 0           $beepvol = hex($HEX1);
1862 0 0         if($verbose){print "BEEP VOLUME is $beepvol\n";}
  0            
1863 0           return $beepvol;
1864             }
1865              
1866             sub getBeepfreq {
1867 0     0 1   my ($beepfreq) = @_;
1868 0           my $self=shift;
1869 0           $output = $self->eepromDecode('005C');
1870 0           $beepfreq = substr($output,0,1);
1871 0 0         if ($beepfreq == '1'){$beepfreq = '880'};
  0            
1872 0 0         if ($beepfreq == '0'){$beepfreq = '440'};
  0            
1873 0 0         if($verbose){print "BEEP Frequency is $beepfreq hz\n";}
  0            
1874 0           return $beepfreq;
1875             }
1876              
1877             # 5d ################################# GET RESUME SCAN, PKT RATE, SCOPE, CW ID, MAIN STEP, ARTS BEEP MODE ######
1878             ###################################### READ BIT 0-1, 2, 3, 4, 5, 6-7 FROM 0X5d
1879              
1880             sub getResumescan {
1881 0     0 1   my ($resumescan) = @_;
1882 0           my $self=shift;
1883 0           $output = $self->eepromDecode('005D');
1884 0           $resumescan = substr($output,6,2);
1885 0 0         if ($resumescan == '00'){$resumescan = 'OFF'};
  0            
1886 0 0         if ($resumescan == '01'){$resumescan = '3'};
  0            
1887 0 0         if ($resumescan == '10'){$resumescan = '5'};
  0            
1888 0 0         if ($resumescan == '11'){$resumescan = '10'};
  0            
1889 0 0         if($verbose){print "RESUME SCAN is ($resumescan) sec\n";}
  0            
1890 0           return $resumescan;
1891             }
1892              
1893             sub getPktrate {
1894 0     0 1   my ($pktrate) = @_;
1895 0           my $self=shift;
1896 0           $output = $self->eepromDecode('005D');
1897 0           $pktrate = substr($output,5,1);
1898 0 0         if ($pktrate == '0'){$pktrate = '1200'};
  0            
1899 0 0         if ($pktrate == '1'){$pktrate = '9600'};
  0            
1900 0 0         if($verbose){print "PACKET RATE is ($pktrate)\n";}
  0            
1901 0           return $pktrate;
1902             }
1903              
1904             sub getScope {
1905 0     0 1   my ($scope) = @_;
1906 0           my $self=shift;
1907 0           $output = $self->eepromDecode('005D');
1908 0           $scope = substr($output,4,1);
1909 0 0         if ($scope == '0'){$scope = 'CONT'};
  0            
1910 0 0         if ($scope == '1'){$scope = 'CHK'};
  0            
1911 0 0         if($verbose){print "SCOPE is ($scope)\n";}
  0            
1912 0           return $scope;
1913             }
1914              
1915             sub getCwid {
1916 0     0 1   my ($cwid) = @_;
1917 0           my $self=shift;
1918 0           $output = $self->eepromDecode('005D');
1919 0           $cwid = substr($output,3,1);
1920 0 0         if ($cwid == '0'){$cwid = 'OFF'};
  0            
1921 0 0         if ($cwid == '1'){$cwid = 'ON'};
  0            
1922 0 0         if($verbose){print "CW ID is ($cwid)\n";}
  0            
1923 0           return $cwid;
1924             }
1925              
1926             sub getMainstep {
1927 0     0 1   my ($mainstep) = @_;
1928 0           my $self=shift;
1929 0           $output = $self->eepromDecode('005D');
1930 0           $mainstep = substr($output,2,1);
1931 0 0         if ($mainstep == '0'){$mainstep = 'FINE'};
  0            
1932 0 0         if ($mainstep == '1'){$mainstep = 'COURSE'};
  0            
1933 0 0         if($verbose){print "MAIN STEP is ($mainstep)\n";}
  0            
1934 0           return $mainstep;
1935             }
1936              
1937             sub getArtsmode {
1938 0     0 1   my ($artsmode) = @_;
1939 0           my $self=shift;
1940 0           $output = $self->eepromDecode('005D');
1941 0           $artsmode = substr($output,0,2);
1942 0 0         if ($artsmode == '00'){$artsmode = 'OFF'};
  0            
1943 0 0         if ($artsmode == '01'){$artsmode = 'RANGE'};
  0            
1944 0 0         if ($artsmode == '10'){$artsmode = 'ALL'};
  0            
1945 0 0         if($verbose){print "ARTS BEEP is ($artsmode)\n";}
  0            
1946 0           return $artsmode;
1947             }
1948              
1949             # 5E ################################# GET CW PITCH ,LOCK MODE, OP FILTER######
1950             ###################################### READ BIT 0-3, 4-5, 6-7 FROM 0X5E
1951              
1952             sub getCwpitch {
1953 0     0 1   my ($pitch) = @_;
1954 0           my $self=shift;
1955 0           $output = $self->eepromDecode('005E');
1956 0           $pitch = substr($output,4,4);
1957 0           my $HEX1 = sprintf("%X", oct( "0b$pitch" ) );
1958 0           $pitch = hex($HEX1);
1959 0           $pitch = $pitch * 50;
1960 0           $pitch = $pitch + 300;
1961 0 0         if($verbose){print "CW PITCH is $pitch\n";}
  0            
1962 0           return $pitch;
1963             }
1964              
1965             sub getLockmode {
1966 0     0 1   my ($lockmode) = @_;
1967 0           my $self=shift;
1968 0           $output = $self->eepromDecode('005E');
1969 0           $lockmode = substr($output,2,2);
1970 0 0         if ($lockmode == '00'){$lockmode = 'DIAL'};
  0            
1971 0 0         if ($lockmode == '01'){$lockmode = 'FREQ'};
  0            
1972 0 0         if ($lockmode == '10'){$lockmode = 'PANEL'};
  0            
1973 0 0         if($verbose){print "LOCK MODE is $lockmode\n";}
  0            
1974 0           return $lockmode;
1975             }
1976              
1977             sub getOpfilter {
1978 0     0 1   my ($opfilter) = @_;
1979 0           my $self=shift;
1980 0           $output = $self->eepromDecode('005E');
1981 0           $opfilter = substr($output,0,2);
1982 0 0         if ($opfilter == '00'){$opfilter = 'OFF'};
  0            
1983 0 0         if ($opfilter == '01'){$opfilter = 'SSB'};
  0            
1984 0 0         if ($opfilter == '10'){$opfilter = 'CW'};
  0            
1985 0 0         if($verbose){print "OP FILTER is $opfilter\n";}
  0            
1986 0           return $opfilter;
1987             }
1988              
1989             # 5F ################################# GET CW WEIGHT, 420 ARS, 144 ARS, RFGAIN/SQUELCH ######
1990             ###################################### READ BIT 0-4, 5, 6, 7 FROM 0X5F
1991              
1992             sub getCwweight {
1993 0     0 1   my ($cwweight) = @_;
1994 0           my $self=shift;
1995 0           my $option=shift;
1996 0           $output = $self->eepromDecode('005F');
1997 0           $cwweight = substr($output,3,5);
1998 0           my $HEX1 = sprintf("%X", oct( "0b$cwweight" ) );
1999 0           $cwweight = hex($HEX1);
2000 0           $cwweight = $cwweight + 25;
2001 0           substr($cwweight, -1, 0) = '.';
2002 0 0         if (!$option){$cwweight = join("",'1:',"$cwweight");}
  0            
2003 0 0         if($verbose){print "CW WEIGHT is $cwweight\n";}
  0            
2004 0           return $cwweight;
2005             }
2006              
2007             sub getArs144 {
2008 0     0 1   my ($ars144,$value) = @_;
2009 0           my $self=shift;
2010 0           $output = $self->eepromDecode('005F');
2011 0           $ars144 = substr($output,1,1);
2012 0 0         if($ars144 == '0'){$value = 'OFF';}
  0            
2013 0           else {$value = 'ON';}
2014 0 0         if($verbose){print "144 ARS is set to $value\n";}
  0            
2015 0           return $value;
2016             }
2017              
2018             sub getArs430 {
2019 0     0 1   my ($ars430,$value) = @_;
2020 0           my $self=shift;
2021 0           $output = $self->eepromDecode('005F');
2022 0           $ars430 = substr($output,2,1);
2023 0 0         if($ars430 == '0'){$value = 'OFF';}
  0            
2024 0           else {$value = 'ON';}
2025 0 0         if($verbose){print "430 ARS is set to $value\n";}
  0            
2026 0           return $value;
2027             }
2028              
2029             sub getRfknob {
2030 0     0 1   my ($sqlbit,$value) = @_;
2031 0           my $self=shift;
2032 0           $output = $self->eepromDecode('005F');
2033 0           $sqlbit = substr($output,0,1);
2034 0 0         if($sqlbit == '0'){$value = 'RFGAIN';}
  0            
2035 0           else {$value = 'SQUELCH';}
2036 0 0         if($verbose){print "RF-KNOB is set to $value\n";}
  0            
2037 0           return $value;
2038             }
2039              
2040             # 60 ################################# GET CWDELAY ######
2041             ###################################### READ BIT 0-7 FROM 0X60
2042              
2043             sub getCwdelay {
2044 0     0 1   my ($cwdelay) = @_;
2045 0           my $self=shift;
2046 0           $output = $self->eepromDecode('0060');
2047 0           $cwdelay = substr($output,0,8);
2048 0           my $HEX1 = sprintf("%X", oct( "0b$cwdelay" ) );
2049 0           $cwdelay = hex($HEX1);
2050 0           $cwdelay = $cwdelay * 10;
2051 0 0         if($verbose){print "CW DELAY is $cwdelay\n";}
  0            
2052 0           return $cwdelay;
2053             }
2054              
2055             # 61 ################################# GET SIDETONE VOLUME ######
2056             ###################################### READ BIT 0-6 FROM 0X61
2057              
2058             sub getSidetonevol {
2059 0     0 1   my ($sidetonevol) = @_;
2060 0           my $self=shift;
2061 0           $output = $self->eepromDecode('0061');
2062 0           $sidetonevol = substr($output,1,7);
2063 0           my $HEX1 = sprintf("%X", oct( "0b$sidetonevol" ) );
2064 0           $sidetonevol = hex($HEX1);
2065 0 0         if($verbose){print "SIDETONE VOLUME is $sidetonevol\n";}
  0            
2066 0           return $sidetonevol;
2067             }
2068              
2069             # 62 ################################# GET CWSPEED, CHARGETIME ######
2070             ###################################### READ BIT 0-5, 6-7 FROM 0X62
2071              
2072             sub getChargetime {
2073 0     0 1   my ($chargetime) = @_;
2074 0           my $self=shift;
2075 0           $output = $self->eepromDecode('0062');
2076 0           $chargetime = substr($output,0,2);
2077 0 0         if ($chargetime == '00'){$chargetime = '6'};
  0            
2078 0 0         if ($chargetime == '01'){$chargetime = '8'};
  0            
2079 0 0         if ($chargetime == '10'){$chargetime = '10'};
  0            
2080 0 0         if($verbose){ print "CHARGETIME is $chargetime\n";}
  0            
2081 0           return $chargetime;
2082             }
2083              
2084             sub getCwspeed {
2085 0     0 1   my ($cwspeed) = @_;
2086 0           my $self=shift;
2087 0           $output = $self->eepromDecode('0062');
2088 0           $cwspeed = substr($output,2,6);
2089 0           my $HEX1 = sprintf("%X", oct( "0b$cwspeed" ) );
2090 0           $cwspeed = hex($HEX1);
2091 0           $cwspeed = $cwspeed +4;
2092 0 0         if($verbose){print "CW-SPEED is $cwspeed\n";}
  0            
2093 0           return $cwspeed;
2094             }
2095              
2096             # 63 ################################# GET VOX GAIN, DISABLE AM/FM DIAL ######
2097             ###################################### READ BIT 0-6, 7 FROM 0X63
2098              
2099             sub getVoxgain {
2100 0     0 1   my ($voxgain) = @_;
2101 0           my $self=shift;
2102 0           $output = $self->eepromDecode('0063');
2103 0           $voxgain = substr($output,1,7);
2104 0           my $HEX1 = sprintf("%X", oct( "0b$voxgain" ) );
2105 0           $voxgain = hex($HEX1);
2106 0 0         if($verbose){print "VOX GAIN is $voxgain\n";}
  0            
2107 0           return $voxgain;
2108             }
2109              
2110             sub getAmfmdial {
2111 0     0 1   my ($disabledial, $value) = @_;
2112 0           my $self=shift;
2113 0           $output = $self->eepromDecode('0063');
2114 0           $disabledial = substr($output,0,1);
2115 0 0         if($disabledial == '0'){$value = 'ENABLE';}
  0            
2116 0           else {$value = 'DISABLE';}
2117 0 0         if($verbose){print "DISABLE AM/FM DIAL is set to $value\n";}
  0            
2118 0           return $value;
2119             }
2120              
2121             # 64 ################################# GET VOX DELAY, EMERGENCY, CAT RATE ######
2122             ###################################### READ BIT 0-4, 5, 6-7 FROM 0X64
2123              
2124             sub getVoxdelay {
2125 0     0 1   my ($voxdelay) = @_;
2126 0           my $self=shift;
2127 0           $output = $self->eepromDecode('0064');
2128 0           $voxdelay = substr($output,3,5);
2129 0           my $HEX1 = sprintf("%X", oct( "0b$voxdelay" ) );
2130 0           $voxdelay = hex($HEX1);
2131 0           $voxdelay = $voxdelay * 100;
2132 0 0         if($verbose){print "VOX DELAY is $voxdelay msec\n";}
  0            
2133 0           return $voxdelay;
2134             }
2135              
2136             sub getEmergency {
2137 0     0 1   my ($emergency) = @_;
2138 0           my $self=shift;
2139 0           $output = $self->eepromDecode('0064');
2140 0           $emergency = substr($output,2,1);
2141 0 0         if ($emergency == '0'){$emergency = 'OFF'};
  0            
2142 0 0         if ($emergency == '1'){$emergency = 'ON'};
  0            
2143 0 0         if($verbose){print "EMERGENCY is $emergency\n";}
  0            
2144 0           return $emergency;
2145             }
2146              
2147             sub getCatrate {
2148 0     0 1   my ($catrate) = @_;
2149 0           my $self=shift;
2150 0           $output = $self->eepromDecode('0064');
2151 0           $catrate = substr($output,0,2);
2152 0 0         if ($catrate == '00'){$catrate = '4800'};
  0            
2153 0 0         if ($catrate == '01'){$catrate = '9600'};
  0            
2154 0 0         if ($catrate == '10'){$catrate = '38400'};
  0            
2155 0 0         if($verbose){print "CAT RATE is $catrate\n";}
  0            
2156 0           return $catrate;
2157             }
2158              
2159             # 65 ################################# GET APO TIME, MEM GROUP, DIG MODE ######
2160             ###################################### READ BIT 0-2, 4, 5-7 FROM 0X65
2161              
2162             sub getApotime {
2163 0     0 1   my ($apotime) = @_;
2164 0           my $self=shift;
2165 0           $output = $self->eepromDecode('0065');
2166 0           $apotime = substr($output,5,3);
2167 0           my $HEX1 = sprintf("%X", oct( "0b$apotime" ) );
2168 0           $apotime = hex($HEX1);
2169 0 0         if ($apotime == '0'){$apotime = 'OFF';}
  0            
2170 0 0         if($verbose){print "APO TIME is $apotime\n";}
  0            
2171 0           return $apotime;
2172             }
2173              
2174             sub getMemgroup {
2175 0     0 1   my ($memgroup) = @_;
2176 0           my $self=shift;
2177 0           $output = $self->eepromDecode('0065');
2178 0           $memgroup = substr($output,3,1);
2179 0 0         if ($memgroup == '0'){$memgroup = 'OFF'};
  0            
2180 0 0         if ($memgroup == '1'){$memgroup = 'ON'};
  0            
2181 0 0         if($verbose){print "MEMORY GROUPS is $memgroup\n";}
  0            
2182 0           return $memgroup;
2183             }
2184              
2185             sub getDigmode {
2186 0     0 1   my ($digmode) = @_;
2187 0           my $self=shift;
2188 0           $output = $self->eepromDecode('0065');
2189 0           $digmode = substr($output,0,3);
2190 0 0         if ($digmode == '000'){$digmode = 'RTTY'};
  0            
2191 0 0         if ($digmode == '001'){$digmode = 'PSK31-L'};
  0            
2192 0 0         if ($digmode == '010'){$digmode = 'PSK31-U'};
  0            
2193 0 0         if ($digmode == '011'){$digmode = 'USER-L'};
  0            
2194 0 0         if ($digmode == '100'){$digmode = 'USER-U'};
  0            
2195 0 0         if($verbose){print "DIGITAL MODE is $digmode\n";}
  0            
2196 0           return $digmode;
2197             }
2198              
2199             # 66 ################################# GET TOT TIME , DCS INV######
2200             ###################################### READ BIT 0-4, 6-7 FROM 0X66
2201              
2202             sub getTottime {
2203 0     0 1   my ($tottime) = @_;
2204 0           my $self=shift;
2205 0           $output = $self->eepromDecode('0066');
2206 0           $tottime = substr($output,3,5);
2207 0           my $HEX1 = sprintf("%X", oct( "0b$tottime" ) );
2208 0           $tottime = hex($HEX1);
2209 0 0         if ($tottime == 0){$tottime = 'OFF';}
  0            
2210 0 0         if($verbose){print "TIME OUT TIMER Time is $tottime\n";}
  0            
2211 0           return $tottime;
2212             }
2213              
2214             sub getDcsinv {
2215 0     0 1   my ($dcsinv) = @_;
2216 0           my $self=shift;
2217 0           $output = $self->eepromDecode('0066');
2218 0           $dcsinv = substr($output,0,2);
2219 0 0         if ($dcsinv == '00'){$dcsinv = 'TN-RN'};
  0            
2220 0 0         if ($dcsinv == '01'){$dcsinv = 'TN-RIV'};
  0            
2221 0 0         if ($dcsinv == '10'){$dcsinv = 'TIV-RN'};
  0            
2222 0 0         if ($dcsinv == '11'){$dcsinv = 'TIV-RIV'};
  0            
2223 0 0         if($verbose){print "DCS INVERSION is $dcsinv\n";}
  0            
2224 0           return $dcsinv;
2225             }
2226              
2227             # 67 ################################# GET SSB MIC, MIC SCAN ######
2228             ###################################### READ BIT 0-6, 7 FROM 0X67
2229              
2230             sub getSsbmic {
2231 0     0 1   my ($ssbmic) = @_;
2232 0           my $self=shift;
2233 0           $output = $self->eepromDecode('0067');
2234 0           $ssbmic = substr($output,1,7);
2235 0           my $HEX1 = sprintf("%X", oct( "0b$ssbmic" ) );
2236 0           $ssbmic = hex($HEX1);
2237 0 0         if($verbose){print "SSB MIC is $ssbmic\n";}
  0            
2238 0           return $ssbmic;
2239             }
2240              
2241             sub getMicscan {
2242 0     0 1   my ($micscan) = @_;
2243 0           my $self=shift;
2244 0           $output = $self->eepromDecode('0067');
2245 0           $micscan = substr($output,0,1);
2246 0 0         if ($micscan == '0'){$micscan = 'OFF'};
  0            
2247 0 0         if ($micscan == '1'){$micscan = 'ON'};
  0            
2248 0 0         if($verbose){print "MIC SCAN is $micscan\n";}
  0            
2249 0           return $micscan;
2250             }
2251              
2252             # 68 ################################# GET AM MIC , MIC KEY ######
2253             ###################################### READ BIT 0-6 AND 7 FROM 0X68
2254              
2255             sub getAmmic {
2256 0     0 1   my ($ammic) = @_;
2257 0           my $self=shift;
2258 0           $output = $self->eepromDecode('0068');
2259 0           $ammic = substr($output,1,7);
2260 0           my $HEX1 = sprintf("%X", oct( "0b$ammic" ) );
2261 0           $ammic = hex($HEX1);
2262 0 0         if($verbose){print "AM MIC is $ammic\n";}
  0            
2263 0           return $ammic;
2264             }
2265              
2266             sub getMickey {
2267 0     0 1   my ($mickey) = @_;
2268 0           my $self=shift;
2269 0           $output = $self->eepromDecode('0068');
2270 0           $mickey = substr($output,0,1);
2271 0 0         if ($mickey == '0'){$mickey = 'OFF'};
  0            
2272 0 0         if ($mickey == '1'){$mickey = 'ON'};
  0            
2273 0 0         if($verbose){print "MIC KEY is $mickey\n";}
  0            
2274 0           return $mickey;
2275             }
2276              
2277             # 69 ################################# GET FM MIC , ######
2278             ###################################### READ BIT 0-6 FROM 0X69
2279              
2280             sub getFmmic {
2281 0     0 1   my ($fmmic) = @_;
2282 0           my $self=shift;
2283 0           $output = $self->eepromDecode('0069');
2284 0           $fmmic = substr($output,1,7);
2285 0           my $HEX1 = sprintf("%X", oct( "0b$fmmic" ) );
2286 0           $fmmic = hex($HEX1);
2287 0 0         if($verbose){print "FM MIC is $fmmic\n";}
  0            
2288 0           return $fmmic;
2289             }
2290              
2291             # 6A ################################# GET DIG MIC , ######
2292             ###################################### READ BIT 0-6 FROM 0X6A
2293              
2294             sub getDigmic {
2295 0     0 1   my ($digmic) = @_;
2296 0           my $self=shift;
2297 0           $output = $self->eepromDecode('006A');
2298 0           $digmic = substr($output,1,7);
2299 0           my $HEX1 = sprintf("%X", oct( "0b$digmic" ) );
2300 0           $digmic = hex($HEX1);
2301 0 0         if($verbose){print "DIG MIC is $digmic\n";}
  0            
2302 0           return $digmic;
2303             }
2304              
2305             # 6B ################################# GET PKT MIC ,EXT MENU ######
2306             ###################################### READ BIT 0-6,7 FROM 0X6B
2307              
2308             sub getPktmic {
2309 0     0 1   my ($pktmic) = @_;
2310 0           my $self=shift;
2311 0           $output = $self->eepromDecode('006B');
2312 0           $pktmic = substr($output,1,7);
2313 0           my $HEX1 = sprintf("%X", oct( "0b$pktmic" ) );
2314 0           $pktmic = hex($HEX1);
2315 0 0         if($verbose){print "PKT MIC is $pktmic\n";}
  0            
2316 0           return $pktmic;
2317             }
2318              
2319             sub getExtmenu {
2320 0     0 1   my ($extmenu) = @_;
2321 0           my $self=shift;
2322 0           $output = $self->eepromDecode('006B');
2323 0           $extmenu = substr($output,0,1);
2324 0 0         if ($extmenu == '0'){$extmenu = 'OFF'};
  0            
2325 0 0         if ($extmenu == '1'){$extmenu = 'ON'};
  0            
2326 0 0         if($verbose){print "EXT MENU is $extmenu\n";}
  0            
2327 0           return $extmenu;
2328             }
2329              
2330             # 6C ################################# GET 9600 MIC , ######
2331             ###################################### READ BIT 0-6 FROM 0X6C
2332              
2333             sub get9600mic {
2334 0     0 1   my ($b9600mic) = @_;
2335 0           my $self=shift;
2336 0           $output = $self->eepromDecode('006C');
2337 0           $b9600mic = substr($output,1,7);
2338 0           my $HEX1 = sprintf("%X", oct( "0b$b9600mic" ) );
2339 0           $b9600mic = hex($HEX1);
2340 0 0         if($verbose){print "9600 MIC is $b9600mic\n";}
  0            
2341 0           return $b9600mic;
2342             }
2343              
2344             # 6D-6E ################################# GET DIG SHIFT ######
2345             ###################################### READ ALL BITS FROM 0X6D AND 0X6E
2346              
2347             sub getDigshift{
2348 0     0 1   my ($newvalue,$polarity) = @_;
2349 0           my $self=shift;
2350 0           my $MSB = $self->eepromDecode('006D');
2351 0           my $LSB = $self->eepromDecode('006E');
2352 0           my $binvalue = join("","$MSB","$LSB");
2353 0           my $decvalue = oct("0b".$binvalue);
2354 0 0 0       if ($decvalue >= 0 && $decvalue <= 300) {$newvalue = $decvalue; $polarity = '+';}
  0            
  0            
2355 0 0         if ($decvalue > 65235) {$newvalue = 65536 - $decvalue; $polarity = '-';}
  0            
  0            
2356 0           $newvalue = $newvalue * 10;
2357 0 0         if($newvalue != '0'){$newvalue = join("","$polarity","$newvalue");}
  0            
2358 0 0         if($verbose){print "DIG SHIFT is $newvalue\n";}
  0            
2359 0           return $newvalue;
2360             }
2361              
2362             # 6F-70 ################################# GET DIG SHIFT ######
2363             ###################################### READ ALL BITS FROM 0X6F AND 0X70
2364              
2365             sub getDigdisp{
2366 0     0 1   my ($newvalue,$polarity) = @_;
2367 0           my $self=shift;
2368 0           my ($MSB,$LSB) = $self->eepromDoubledecode('006F');
2369 0           my $binvalue = join("","$MSB","$LSB");
2370 0           my $decvalue = oct("0b".$binvalue);
2371 0 0 0       if ($decvalue >= 0 && $decvalue <= 300) {$newvalue = $decvalue; $polarity = '+';}
  0            
  0            
2372 0 0         if ($decvalue > 65235) {$newvalue = 65536 - $decvalue; $polarity = '-';}
  0            
  0            
2373 0           $newvalue = $newvalue * 10;
2374 0 0         if($newvalue != '0'){$newvalue = join("","$polarity","$newvalue");}
  0            
2375 0 0         if($verbose){print "DIG DISP is $newvalue\n";}
  0            
2376 0           return $newvalue;
2377             }
2378              
2379             # 71 ################################# GET R-LSB CAR ######
2380             ###################################### READ ALL BITS FROM 0X71
2381              
2382             sub getRlsbcar{
2383 0     0 1   my ($newvalue,$polarity) = @_;
2384 0           my $self=shift;
2385 0           my $binvalue = $self->eepromDecode('0071');
2386 0           my $decvalue = oct("0b".$binvalue);
2387 0 0 0       if ($decvalue >= 0 && $decvalue <= 30) {$newvalue = $decvalue; $polarity = '+';}
  0            
  0            
2388 0 0         if ($decvalue > 224) {$newvalue = 256 - $decvalue; $polarity = '-';}
  0            
  0            
2389 0           $newvalue = $newvalue * 10;
2390 0 0         if($newvalue != '0'){$newvalue = join("","$polarity","$newvalue");}
  0            
2391 0 0         if($verbose){print "R-LSB CAR is $newvalue\n";}
  0            
2392 0           return $newvalue;
2393             }
2394              
2395             # 72 ################################# GET R-USB CAR ######
2396             ###################################### READ ALL BITS FROM 0X72
2397              
2398             sub getRusbcar{
2399 0     0 1   my ($newvalue,$polarity) = @_;
2400 0           my $self=shift;
2401 0           my $binvalue = $self->eepromDecode('0072');
2402 0           my $decvalue = oct("0b".$binvalue);
2403 0 0 0       if ($decvalue >= 0 && $decvalue <= 30) {$newvalue = $decvalue; $polarity = '+';}
  0            
  0            
2404 0 0         if ($decvalue > 224) {$newvalue = 256 - $decvalue; $polarity = '-';}
  0            
  0            
2405 0           $newvalue = $newvalue * 10;
2406 0 0         if($newvalue != '0'){$newvalue = join("","$polarity","$newvalue");}
  0            
2407 0 0         if($verbose){print "R-USB CAR is $newvalue\n";}
  0            
2408 0           return $newvalue;
2409             }
2410              
2411             # 73 ################################# GET T-LSB CAR ######
2412             ###################################### READ ALL BITS FROM 0X73
2413              
2414             sub getTlsbcar{
2415 0     0 1   my ($newvalue,$polarity) = @_;
2416 0           my $self=shift;
2417 0           my $binvalue = $self->eepromDecode('0073');
2418 0           my $decvalue = oct("0b".$binvalue);
2419 0 0 0       if ($decvalue >= 0 && $decvalue <= 30) {$newvalue = $decvalue; $polarity = '+';}
  0            
  0            
2420 0 0         if ($decvalue > 224) {$newvalue = 256 - $decvalue; $polarity = '-';}
  0            
  0            
2421 0           $newvalue = $newvalue * 10;
2422 0 0         if($newvalue != '0'){$newvalue = join("","$polarity","$newvalue");}
  0            
2423 0 0         if($verbose){print "T-LSB CAR is $newvalue\n";}
  0            
2424 0           return $newvalue;
2425             }
2426              
2427             # 74 ################################# GET T-USB CAR ######
2428             ###################################### READ ALL BITS FROM 0X74
2429              
2430             sub getTusbcar{
2431 0     0 1   my ($newvalue,$polarity) = @_;
2432 0           my $self=shift;
2433 0           my $binvalue = $self->eepromDecode('0074');
2434 0           my $decvalue = oct("0b".$binvalue);
2435 0 0 0       if ($decvalue >= 0 && $decvalue <= 30) {$newvalue = $decvalue; $polarity = '+';}
  0            
  0            
2436 0 0         if ($decvalue > 224) {$newvalue = 256 - $decvalue; $polarity = '-';}
  0            
  0            
2437 0           $newvalue = $newvalue * 10;
2438 0 0         if($newvalue != '0'){$newvalue = join("","$polarity","$newvalue");}
  0            
2439 0 0         if($verbose){print "T-USB CAR is $newvalue\n";}
  0            
2440 0           return $newvalue;
2441             }
2442              
2443             # 79 ################################# GET TX POWER, PRI, DW, SCN AND ARTS ######
2444             ###################################### READ BIT 0-1, 3, 4, 5-6, AND 7 FROM 0X79
2445              
2446             sub getTxpower {
2447 0     0 1   my $self=shift;
2448 0           $output = $self->eepromDecode('0079');
2449 0           my $txpower = substr($output,6,2);
2450 0           ($txpow) = grep { $TXPWR{$_} eq $txpower } keys %TXPWR;
  0            
2451 0 0         if($verbose){print "TRANSMIT POWER is $txpow\n";}
  0            
2452 0           return $txpow;
2453             }
2454              
2455             sub getPri {
2456 0     0 1   my ($pri) = @_;
2457 0           my $self=shift;
2458 0           $output = $self->eepromDecode('0079');
2459 0           $pri = substr($output,3,1);
2460 0 0         if ($pri == '0'){$pri = 'OFF'};
  0            
2461 0 0         if ($pri == '1'){$pri = 'ON'};
  0            
2462 0 0         if($verbose){print "PRIORITY SCANNING is $pri\n";}
  0            
2463 0           return $pri;
2464             }
2465              
2466             sub getDw {
2467 0     0 1   my ($dw) = @_;
2468 0           my $self=shift;
2469 0           $output = $self->eepromDecode('0079');
2470 0           $dw = substr($output,4,1);
2471 0 0         if ($dw == '0'){$dw = 'OFF'};
  0            
2472 0 0         if ($dw == '1'){$dw = 'ON'};
  0            
2473 0 0         if($verbose){print "DUAL WATCH is $dw\n";}
  0            
2474 0           return $dw;
2475             }
2476              
2477             sub getScn {
2478 0     0 1   my ($scn) = @_;
2479 0           my $self=shift;
2480 0           $output = $self->eepromDecode('0079');
2481 0           $scn = substr($output,1,2);
2482 0 0         if ($scn == '00'){$scn = 'OFF'};
  0            
2483 0 0         if ($scn == '10'){$scn = 'UP'};
  0            
2484 0 0         if ($scn == '11'){$scn = 'DOWN'};
  0            
2485 0 0         if($verbose){print "SCANNING is $scn\n";}
  0            
2486 0           return $scn;
2487             }
2488              
2489             sub getArts {
2490 0     0 1   my ($artsis) = @_;
2491 0           my $self=shift;
2492 0           $output = $self->eepromDecode('0079');
2493 0           my $arts = substr($output,0,1);
2494 0 0         if ($arts == '0'){$artsis = 'OFF'};
  0            
2495 0 0         if ($arts == '1'){$artsis = 'ON'};
  0            
2496 0 0         if($verbose){print "ARTS is $artsis\n";}
  0            
2497 0           return $artsis;
2498             }
2499              
2500             # 7A ################################# GET ANTENNA STATUS, SPL ######
2501             ###################################### READ 0-5, 7 BITS FROM 0X7A
2502              
2503             sub getAntenna {
2504 0     0 1   my ($antenna, %antennas, %returnant) = @_;
2505 0           my $self=shift;
2506 0           my $value=shift;
2507 0           my $ant;
2508 0           $output = $self->eepromDecode('007A');
2509 0 0         if ($value eq 'HF'){$antenna = substr($output,7,1);}
  0            
2510 0 0         if ($value eq '6M'){$antenna = substr($output,6,1);}
  0            
2511 0 0         if ($value eq 'FMBCB'){$antenna = substr($output,5,1);}
  0            
2512 0 0         if ($value eq 'AIR'){$antenna = substr($output,4,1);}
  0            
2513 0 0         if ($value eq 'VHF'){$antenna = substr($output,3,1);}
  0            
2514 0 0         if ($value eq 'UHF'){$antenna = substr($output,2,1);}
  0            
2515 0 0         if ($antenna == 0){$ant = 'FRONT';}
  0            
2516 0 0         if ($antenna == 1){$ant = 'BACK';}
  0            
2517 0 0 0       if ($value && $value ne 'ALL'){
2518 0 0         if($verbose){print "ANTENNA [$value] is set to $ant\n";}
  0            
2519             }
2520 0 0 0       if (!$value || $value eq 'ALL'){
2521 0           %antennas = ('HF', 7, '6M', 6, 'FMBCB', 5, 'AIR', 4, 'VHF', 3, 'UHF', 2);
2522 0           my $key;
2523 0           print "\n";
2524 0           foreach $key (sort keys %antennas) {
2525 0           $antenna = substr($output,$antennas{$key},1);
2526 0 0         if ($antenna == 0){$ant = 'FRONT';}
  0            
2527 0 0         if ($antenna == 1){$ant = 'BACK';}
  0            
2528 0           printf "%-11s %-11s %-11s %-11s\n", 'Antenna', "$key", "set to", "$ant";
2529 0           $returnant{$key} = $ant;
2530             }
2531 0           print "\n";
2532 0           return %returnant;
2533             }
2534 0           return $ant;
2535             }
2536              
2537             sub getSpl {
2538 0     0 1   my ($spl) = @_;
2539 0           my $self=shift;
2540 0           $output = $self->eepromDecode('007A');
2541 0           $spl = substr($output,0,1);
2542 0 0         if ($spl == '0'){$spl = 'OFF'};
  0            
2543 0 0         if ($spl == '1'){$spl = 'ON'};
  0            
2544 0 0         if($verbose){print "SPLIT FREQUENCY is $spl\n";}
  0            
2545 0           return $spl;
2546             }
2547              
2548             # 7b ################################# GET BATTERY CHARGE STATUS ######
2549             ###################################### READ BIT 0-3 and 4 FROM 0X7B
2550              
2551             sub getCharger {
2552 0     0 1   my $self=shift;
2553 0           $output = $self->eepromDecode('007B');
2554 0           my $test = substr($output,3,1);
2555 0           my $time = substr($output,4,4);
2556 0           my $timehex = sprintf("%X", oct( "0b$time" ) );
2557 0           $time = hex($timehex);
2558 0 0         if ($test == '0') {$charger = "OFF";}
  0            
2559 0 0         if ($test == '1') {$charger = "ON";}
  0            
2560 0 0         if ($charger eq 'OFF'){
2561 0 0         if($verbose){print "CHARGER is [$charger]: Timer configured for $time hours\n";}
  0            
2562             }
2563 0 0         if ($charger eq 'ON'){
2564 0 0         if($verbose){print "CHARGING is [$charger]: Set for $time hours\n";}
  0            
2565             }
2566 0           return $charger;
2567             }
2568              
2569             # 7D - 388 / 40B - 44E ################################# GET VFO MEM INFO ######
2570             ######################################
2571              
2572             sub readMemvfo {
2573 0     0 1   my ($testvfoband, $address, $testoptions, $base, %baseaddress, $offset, $startaddress, $fmstep, $amstep, $ctcsstone, $dcscode, $polarity, $newvalue) = @_;
2574 0           my $self=shift;
2575 0           my $vfo=shift;
2576 0           my $band=shift;
2577 0           my $value=shift;
2578 0           my %memvfohash = ();
2579 0 0         if (!$value) {$value = 'ALL';}
  0            
2580 0 0 0       if ($vfo ne 'A' && $vfo ne 'B' && $vfo ne 'MTQMB' && $vfo ne 'MTUNE'){
      0        
      0        
2581 0 0         if($verbose){print "Value invalid: Choose A / B / MTQMB / MTUNE\n\n";}
  0            
2582 0           return 1;
2583              
2584             }
2585 0 0         if ($vfo eq 'MTQMB') {$vfo = 'A'; $band = 'MTQMB';}
  0            
  0            
2586 0 0         if ($vfo eq 'MTUNE') {$vfo = 'A'; $band = 'MTUNE';}
  0            
  0            
2587 0           my %newhash = reverse %VFOBANDS;
2588 0           ($testvfoband) = grep { $newhash{$_} eq $band } keys %newhash;
  0            
2589 0 0         if ($testvfoband eq'') {
2590 0 0 0       if ($band ne 'MTQMB' && $band ne 'MTUNE'){
2591 0 0         if($verbose){print "\nChoose valid Band : [160M/75M/40M/30M/20M/17M/15M/12M/10M/6M/2M/70CM/FMBC/AIR/PHAN]\n\n";}
  0            
2592 0           return 1;
2593             }
2594             }
2595 0           my %testhash = reverse %VFOMEMOPTS;
2596 0           ($testoptions) = grep { $testhash{$_} eq $value } keys %testhash;
  0            
2597 0 0 0       if (!$testoptions && $value ne 'ALL'){
2598 0 0         if($verbose){
2599 0           print "Choose a valid option, or no option for ALL\.\n\n";
2600 0           my $columns = 1;
2601 0           foreach my $options (sort keys %testhash) {
2602 0           printf "%-15s %s",$testhash{$options};
2603 0           $columns++;
2604 0 0         if ($columns == 7){print "\n\n"; $columns = 1;}
  0            
  0            
2605             }
2606 0           print "\n\n";
2607             }
2608 0           return 1;
2609             }
2610 0 0         if ($vfo eq 'A'){%baseaddress = reverse %VFOABASE;}
  0            
2611 0 0         if ($vfo eq 'B'){%baseaddress = reverse %VFOBBASE;}
  0            
2612 0           ($base) = grep { $baseaddress{$_} eq $band } keys %baseaddress;
  0            
2613 0 0 0       if ($value eq 'MODE' || $value eq 'ALL'){
2614 0           $offset=0x00;
2615 0           $address = $self->hexAdder("$offset","$base");
2616 0           my $mode;
2617 0           $output = $self->eepromDecode("$address");
2618 0           $output = substr($output,5,3);
2619 0           ($mode) = grep { $MEMMODES{$_} eq $output } keys %MEMMODES;
  0            
2620 0 0         if($verbose){print "VFO $vfo\[$band\] - MODE is $mode\n"};
  0            
2621 0 0         if ($value eq 'ALL'){$memvfohash{'MODE'} = "$mode";}
  0            
2622             else {
2623 0           return $mode;
2624             }
2625             }
2626              
2627              
2628 0 0 0       if ($value eq 'NARFM' || $value eq 'ALL'){
2629 0           $offset=0x01;
2630 0           $address = $self->hexAdder("$offset","$base");
2631 0           my $narfm;
2632 0           $output = $self->eepromDecode("$address");
2633 0           $output = substr($output,4,1);
2634 0 0         if ($output == '0') {$narfm = "OFF";}
  0            
2635 0 0         if ($output == '1') {$narfm = "ON";}
  0            
2636 0 0         if($verbose){print "VFO $vfo\[$band\] - NARROW FM is $narfm\n"};
  0            
2637 0 0         if ($value eq 'ALL'){$memvfohash{'NARFM'} = "$narfm";}
  0            
2638             else {
2639 0           return $narfm;
2640             }
2641             }
2642              
2643 0 0 0       if ($value eq 'NARCWDIG' || $value eq 'ALL'){
2644 0           $offset=0x01;
2645 0           $address = $self->hexAdder("$offset","$base");
2646 0           my $narcw;
2647 0           $output = $self->eepromDecode("$address");
2648 0           $output = substr($output,3,1);
2649 0 0         if ($output == '0') {$narcw = "OFF";}
  0            
2650 0 0         if ($output == '1') {$narcw = "ON";}
  0            
2651 0 0         if($verbose){print "VFO $vfo\[$band\] - NARROW CW/DIG is $narcw\n"};
  0            
2652 0 0         if ($value eq 'ALL'){$memvfohash{'NARCWDIG'} = "$narcw";}
  0            
2653             else {
2654 0           return $narcw;
2655             }
2656             }
2657              
2658 0 0 0       if ($value eq 'RPTOFFSET' || $value eq 'ALL'){
2659 0           $offset=0x01;
2660 0           $address = $self->hexAdder("$offset","$base");
2661 0           my $rptoffset;
2662 0           $output = $self->eepromDecode("$address");
2663 0           $output = substr($output,0,2);
2664 0 0         if ($output == '00') {$rptoffset = "SIMPLEX";}
  0            
2665 0 0         if ($output == '01') {$rptoffset = "MINUS";}
  0            
2666 0 0         if ($output == '10') {$rptoffset = "PLUS";}
  0            
2667 0 0         if ($output == '11') {$rptoffset = "NON-STANDARD";}
  0            
2668 0 0         if($verbose){print "VFO $vfo\[$band\] - REPEATER OFFSET is $rptoffset\n"};
  0            
2669 0 0         if ($value eq 'ALL'){$memvfohash{'RPTOFFSET'} = "$rptoffset";}
  0            
2670             else {
2671 0           return $rptoffset;
2672             }
2673             }
2674              
2675 0 0 0       if ($value eq 'TONEDCS' || $value eq 'ALL'){
2676 0           $offset=0x04;
2677 0           $address = $self->hexAdder("$offset","$base");
2678 0           my $tonedcs;
2679 0           $output = $self->eepromDecode("$address");
2680 0           $output = substr($output,6,2);
2681 0 0         if ($output == '00') {$tonedcs = "OFF";}
  0            
2682 0 0         if ($output == '01') {$tonedcs = "TONE";}
  0            
2683 0 0         if ($output == '10') {$tonedcs = "TONETSQ";}
  0            
2684 0 0         if ($output == '11') {$tonedcs = "DCS";}
  0            
2685 0 0         if($verbose){print "VFO $vfo\[$band\] - TONE/DCS SELECT is $tonedcs\n"};
  0            
2686 0 0         if ($value eq 'ALL'){$memvfohash{'TONEDCS'} = "$tonedcs";}
  0            
2687             else {
2688 0           return $tonedcs;
2689             }
2690             }
2691              
2692 0 0 0       if ($value eq 'ATT' || $value eq 'ALL'){
2693 0           $offset=0x02;
2694 0           $address = $self->hexAdder("$offset","$base");
2695 0           my $att;
2696 0           $output = $self->eepromDecode("$address");
2697 0           $output = substr($output,3,1);
2698 0 0         if ($output == '0') {$att = "OFF";}
  0            
2699 0 0         if ($output == '1') {$att = "ON";}
  0            
2700 0 0         if($verbose){print "VFO $vfo\[$band\] - ATT is $att\n"};
  0            
2701 0 0         if ($value eq 'ALL'){$memvfohash{'ATT'} = "$att";}
  0            
2702             else {
2703 0           return $att;
2704             }
2705             }
2706              
2707 0 0 0       if ($value eq 'IPO' || $value eq 'ALL'){
2708 0           $offset=0x02;
2709 0           $address = $self->hexAdder("$offset","$base");
2710 0           my $ipo;
2711 0           $output = $self->eepromDecode("$address");
2712 0           $output = substr($output,2,1);
2713 0 0         if ($output == '0') {$ipo = "OFF";}
  0            
2714 0 0         if ($output == '1') {$ipo = "ON";}
  0            
2715 0 0         if($verbose){print "VFO $vfo\[$band\] - IPO is $ipo\n"};
  0            
2716 0 0         if ($value eq 'ALL'){$memvfohash{'IPO'} = "$ipo";}
  0            
2717             else {
2718 0           return $ipo;
2719             }
2720             }
2721              
2722 0 0 0       if ($value eq 'FMSTEP' || $value eq 'ALL'){
2723 0           $offset=0x03;
2724 0           $address = $self->hexAdder("$offset","$base");
2725 0           $output = $self->eepromDecode("$address");
2726 0           $output = substr($output,5,3);
2727 0           ($fmstep) = grep { $FMSTEP{$_} eq $output } keys %FMSTEP;
  0            
2728 0 0         if($verbose){print "VFO $vfo\[$band\] - FM STEP is $fmstep\n"};
  0            
2729 0 0         if ($value eq 'ALL'){$memvfohash{'FMSTEP'} = "$fmstep";}
  0            
2730             else {
2731 0           return $fmstep;
2732             }
2733             }
2734              
2735 0 0 0       if ($value eq 'AMSTEP' || $value eq 'ALL'){
2736 0           $offset=0x03;
2737 0           $address = $self->hexAdder("$offset","$base");
2738 0           $output = $self->eepromDecode("$address");
2739 0           $output = substr($output,2,3);
2740 0           ($amstep) = grep { $AMSTEP{$_} eq $output } keys %AMSTEP;
  0            
2741 0 0         if($verbose){print "VFO $vfo\[$band\] - AM STEP is $amstep\n"};
  0            
2742 0 0         if ($value eq 'ALL'){$memvfohash{'AMSTEP'} = "$amstep";}
  0            
2743             else {
2744 0           return $amstep;
2745             }
2746             }
2747              
2748 0 0 0       if ($value eq 'SSBSTEP' || $value eq 'ALL'){
2749 0           $offset=0x03;
2750 0           $address = $self->hexAdder("$offset","$base");
2751 0           my $ssbstep;
2752 0           $output = $self->eepromDecode("$address");
2753 0           $output = substr($output,0,2);
2754 0 0         if ($output == '00') {$ssbstep = '1.0';}
  0            
2755 0 0         if ($output == '01') {$ssbstep = '2.5';}
  0            
2756 0 0         if ($output == '10') {$ssbstep = '5.0';}
  0            
2757 0 0         if($verbose){print "VFO $vfo\[$band\] - SSB STEP is $ssbstep\n"};
  0            
2758 0 0         if ($value eq 'ALL'){$memvfohash{'SSBSTEP'} = "$ssbstep";}
  0            
2759             else {
2760 0           return $ssbstep;
2761             }
2762             }
2763              
2764 0 0 0       if ($value eq 'CTCSSTONE' || $value eq 'ALL'){
2765 0           $offset=0x06;
2766 0           my ($MSB, $LSB) = $self->hexAdder("$offset","$base");
2767 0           $output = $self->eepromDecode("$MSB","$LSB");
2768 0           $output = substr($output,2,6);
2769 0           my %newhash = reverse %CTCSSTONES;
2770 0           ($ctcsstone) = grep { $newhash{$_} eq $output } keys %newhash;
  0            
2771 0 0         if($verbose){print "VFO $vfo\[$band\] - CTCSS TONE is $ctcsstone\n"};
  0            
2772 0 0         if ($value eq 'ALL'){$memvfohash{'CTCSSTONE'} = "$ctcsstone";}
  0            
2773             else {
2774 0           return $ctcsstone;
2775             }
2776             }
2777              
2778 0 0 0       if ($value eq 'DCSCODE' || $value eq 'ALL'){
2779 0           $offset=0x07;
2780 0           $address = $self->hexAdder("$offset","$base");
2781 0           $output = $self->eepromDecode("$address");
2782 0           $output = substr($output,1,7);
2783 0           my %newhash = reverse %DCSCODES;
2784 0           ($dcscode) = grep { $newhash{$_} eq $output } keys %newhash;
  0            
2785 0 0         if($verbose){print "VFO $vfo\[$band\] - DCSCODE is $dcscode\n"};
  0            
2786 0 0         if ($value eq 'ALL'){$memvfohash{'DCSCODE'} = "$dcscode";}
  0            
2787             else {
2788 0           return $dcscode;
2789             }
2790             }
2791              
2792 0 0 0       if ($value eq 'CLARIFIER' || $value eq 'ALL'){
2793 0           $offset=0x02;
2794 0           $address = $self->hexAdder("$offset","$base");
2795 0           my $clarifier;
2796 0           $output = $self->eepromDecode("$address");
2797 0           $output = substr($output,1,1);
2798 0 0         if ($output == '1') {$clarifier = 'ON';}
  0            
2799 0 0         if ($output == '0') {$clarifier = 'OFF';}
  0            
2800 0 0         if($verbose){print "VFO $vfo\[$band\] - CLARIFIER is $clarifier\n"};
  0            
2801 0 0         if ($value eq 'ALL'){$memvfohash{'CLARIFIER'} = "$clarifier";}
  0            
2802             else {
2803 0           return $clarifier;
2804             }
2805             }
2806              
2807 0 0 0       if ($value eq 'CLAROFFSET' || $value eq 'ALL'){
2808              
2809 0           $offset=0x08;
2810 0           $address = $self->hexAdder("$offset","$base");
2811 0           my ($MSB,$LSB) = $self->eepromDoubledecode("$address");
2812 0           my $binvalue = join("","$MSB","$LSB");
2813 0           my $decvalue = oct("0b".$binvalue);
2814 0           my $newvalue;
2815 0 0         if ($decvalue > 999) {$newvalue = 65536 - $decvalue; $polarity = '-';}
  0            
  0            
2816 0 0 0       if ($decvalue >= 0 && $decvalue <= 999) {$newvalue = $decvalue; $polarity = '+';}
  0            
  0            
2817 0           my $vallength = length($newvalue);
2818 0 0         if ($vallength == 1) {$newvalue = join("","0.0","$newvalue");}
  0            
2819 0 0         if ($vallength == 2) {$newvalue = join("","0.","$newvalue");}
  0            
2820 0 0         if ($vallength == 3) {
2821 0           my $part1 = substr($newvalue,0,1);
2822 0           my $part2 = substr($newvalue,1,2);
2823 0           $newvalue = join("","$part1",".","$part2");
2824             }
2825 0 0         if ($vallength == 4) {
2826 0           my $part1 = substr($newvalue,0,2);
2827 0           my $part2 = substr($newvalue,2,2);
2828 0           $newvalue = join("","$part1",".","$part2");
2829             }
2830 0           $newvalue = join("","$polarity","$newvalue");
2831 0 0         if($verbose){print "VFO $vfo\[$band\] - CLARIFIER OFFSET is $newvalue Khz\n";}
  0            
2832 0 0         if ($value eq 'ALL'){$memvfohash{'CLAROFFSET'} = "$newvalue";}
  0            
2833             else {
2834 0           return $newvalue;
2835             }
2836             }
2837              
2838 0 0 0       if ($value eq 'RXFREQ' || $value eq 'ALL'){
2839 0           $offset=0x0A;
2840 0           $address = $self->hexAdder("$offset","$base");
2841 0           my ($ADD1,$ADD2) = $self->eepromDoubledecode("$address");
2842 0           $offset=0x0C;
2843 0           $address = $self->hexAdder("$offset","$base");
2844 0           my ($ADD3,$ADD4) = $self->eepromDoubledecode("$address");
2845 0           my $binvalue = join("","$ADD1","$ADD2","$ADD3","$ADD4");
2846 0           my $decvalue = oct("0b".$binvalue);
2847 0           substr($decvalue, -2, 0) = '.';
2848 0           substr($decvalue, -6, 0) = '.';
2849 0 0         if($verbose){print "VFO $vfo\[$band\] - RECEIVE FREQUENCY is $decvalue Mhz\n";}
  0            
2850 0 0         if ($value eq 'ALL'){$memvfohash{'RXFREQ'} = "$decvalue";}
  0            
2851             else {
2852 0           return $decvalue;
2853             }
2854             }
2855              
2856 0 0 0       if ($value eq 'RPTOFFSETFREQ' || $value eq 'ALL'){
2857 0           $offset=0x0F;
2858 0           $address = $self->hexAdder("$offset","$base");
2859 0           my ($ADD1,$ADD2) = $self->eepromDoubledecode("$address");
2860 0           $offset=0x11;
2861 0           my $address = $self->hexAdder("$offset","$base");
2862 0           my $ADD3 = $self->eepromDecode("$address");
2863 0           my $binvalue = join("","$ADD1","$ADD2","$ADD3");
2864 0           my $decvalue = oct("0b".$binvalue);
2865 0           $decvalue = $decvalue / 100000;
2866 0 0         if($verbose){print "VFO $vfo\[$band\] - REPEATER OFFSET is $decvalue Mhz\n";}
  0            
2867 0 0         if ($value eq 'ALL'){$memvfohash{'RPTOFFSETFREQ'} = "$decvalue";}
  0            
2868             else {
2869 0           return $decvalue;
2870             }
2871             }
2872 0 0         if ($value eq 'ALL'){
2873 0           return %memvfohash;
2874             }
2875              
2876             }
2877              
2878             # 044F ################################# GET CURRENT MEMORY CHANNEL ######
2879             ###################################### READ ALL BITS FROM 0X44F
2880              
2881             sub getCurrentmem {
2882 0     0 1   my ($currentmem) = @_;
2883 0           my $self=shift;
2884 0           $output = $self->eepromDecode('044F');
2885 0           my $HEX1 = sprintf("%X", oct( "0b$output" ) );
2886 0           $output = hex($HEX1);
2887 0           $output ++;
2888 0 0         if ($output == '201'){$output = 'M-PL';}
  0            
2889 0 0         if ($output == '202'){$output = 'M-PU';}
  0            
2890 0 0         if($verbose){print "Current Memory Channel is $output\n";}
  0            
2891 0           return $output;
2892             }
2893              
2894             # 0450 - 046A############################## GET MEMORY MAP ######
2895             ###################################### READ ALL BITS FROM 0X44F
2896              
2897             sub getMemmap {
2898 0     0 1   my $self=shift;
2899 0           my $number = shift;
2900 0           my $startaddress = '0450';
2901 0           my $label = $number;
2902 0 0         if ($number eq 'M-PL'){$number = 201;}
  0            
2903 0 0         if ($number eq 'M-PU'){$number = 202;}
  0            
2904 0 0 0       if ($number < 1 || $number > 202){
2905 0 0         if($verbose){print "Memory [$number] invalid. Must be between 1 and 200 or M-PL / M-PU\n"};
  0            
2906 0           return 1;
2907             }
2908 0           my $register = int(($number - 1) / 8);
2909 0           my $checkbit = ($number - (8 * ($register + 1))) * -1;
2910 0           my $address = $self->hexAdder("$register","$startaddress");
2911 0           $output = $self->eepromDecode("$address");
2912 0           my $test = substr($output,$checkbit,1);
2913 0 0         if ($test == '0'){$output = 'INACTIVE';}
  0            
2914 0 0         if ($test == '1'){$output = 'ACTIVE';}
  0            
2915 0 0         if($verbose){print "Memory Channel $label is $output\n";}
  0            
2916 0           return $output;
2917             }
2918              
2919             sub getActivelist {
2920 0     0 1   my $self=shift;
2921 0           my $currentmem = 1;
2922 0           my $memtag;
2923 0 0         if($verbose){
2924 0           print "\nACTIVE MEMORY AREAS\n___________________\n\n";
2925 0           printf "%-5s %-10s %-10s %-6s %-6s %-12s %-9s %-9s %-9s %-9s\n\n", '#','LABEL','READY','SKIP', 'MODE','RXFREQ','ENCODER','TONE/DCS','SHIFT','RPTOFFSET';
2926             }
2927 0           do {
2928 0           $self->setVerbose(0);
2929 0           $output = $self->getMemmap("$currentmem");
2930 0           $self->setVerbose(1);
2931 0 0         if ($output eq 'ACTIVE'){
2932 0           $self->setVerbose(0);
2933 0           my $label = $self->readMemory('MEM',"$currentmem",'LABEL');
2934 0           my $mode = $self->readMemory('MEM',"$currentmem",'MODE');
2935 0           my $rxfreq = $self->readMemory('MEM',"$currentmem",'RXFREQ');
2936 0           my $memskip = $self->readMemory('MEM',"$currentmem",'MEMSKIP');
2937 0           my $encoder = $self->readMemory('MEM',"$currentmem",'TONEDCS');
2938 0           my $rptoffset = $self->readMemory('MEM',"$currentmem",'RPTOFFSET');
2939 0           my $rptoffsetfreq = $self->readMemory('MEM',"$currentmem",'RPTOFFSETFREQ');
2940 0           my $ready = $self->readMemory('MEM',"$currentmem",'READY');
2941 0           my $encoderval;
2942 0 0 0       if ($encoder eq 'TONE' || $encoder eq 'TONETSQ'){
    0          
2943 0           $encoderval = $self->readMemory('MEM',"$currentmem",'CTCSSTONE');
2944             }
2945             elsif ($encoder eq 'DCS'){
2946 0           $encoderval = $self->readMemory('MEM',"$currentmem",'DCSCODE');
2947             }
2948 0           else {$encoderval = 'OFF';}
2949 0           $memtag = $currentmem;
2950 0 0         if ($currentmem == '201'){$memtag = 'M-PL'};
  0            
2951 0 0         if ($currentmem == '202'){$memtag = 'M-PU'};
  0            
2952 0           $self->setVerbose(1);
2953 0 0         if($verbose){
2954 0           printf "%-5s %-10s %-10s %-6s %-6s %-12s %-9s %-9s %-9s %-9s\n","$memtag","$label","$ready","$memskip","$mode","$rxfreq","$encoder","$encoderval","$rptoffsetfreq Mhz","$rptoffset";
2955             }
2956             }
2957 0           $currentmem++;
2958             }
2959             while ($currentmem < '202');
2960 0 0         if($verbose){print "\n";}
  0            
2961 0           return 0;
2962             }
2963              
2964             # 389 - 40A / 484 - 1907 ################################# GET MEMORY INFO ######
2965             ######################################
2966              
2967             sub readMemory {
2968 0     0 1   my ($testvfoband, $address, $testoptions, $base, %baseaddress, $offset, $startaddress, $fmstep, $amstep, $ctcsstone, $dcscode, $polarity, $newvalue) = @_;
2969 0           my $self=shift;
2970 0           my $type=shift;
2971 0           my $subtype=shift;
2972 0 0         if ($subtype eq 'M-PL') {$subtype = '201';}
  0            
2973 0 0         if ($subtype eq 'M-PU') {$subtype = '202';}
  0            
2974 0           my $memnum = $subtype;
2975 0           my $multiple;
2976 0           my $value=shift;
2977 0           my %memoryhash = ();
2978 0 0         if (!$value) {$value = 'ALL';}
  0            
2979 0 0 0       if ($type ne 'HOME' && $type ne 'QMB' && $type ne 'M-PL' && $type ne 'M-PU' && $type ne 'MEM') {
      0        
      0        
      0        
2980 0 0         if($verbose){print "Value invalid: Choose HOME / QMB / M-PL / M-PU / MEM\n\n";}
  0            
2981 0           return 1;
2982             }
2983 0           my %testhash = reverse %MEMORYOPTS;
2984 0           ($testoptions) = grep { $testhash{$_} eq $value } keys %testhash;
  0            
2985 0 0 0       if (!$testoptions && $value ne 'ALL'){
2986 0 0         if($verbose){
2987 0           print "Choose a valid option, or no option for ALL\.\n\n";
2988 0           my $columns = 1;
2989 0           foreach my $options (sort keys %testhash) {
2990 0           printf "%-15s %s",$testhash{$options};
2991 0           $columns++;
2992 0 0         if ($columns == 7){print "\n\n"; $columns = 1;}
  0            
  0            
2993             }
2994 0           print "\n\n";
2995             }
2996 0           return 1;
2997             }
2998 0 0         if ($type eq 'HOME'){%baseaddress = reverse %HOMEBASE;}
  0            
2999 0 0         if ($type eq 'QMB'){%baseaddress = reverse %MEMORYBASE; $subtype = 'QMB';}
  0            
  0            
3000 0 0         if ($type eq 'MEM'){%baseaddress = reverse %MEMORYBASE; $subtype = 'MEM';}
  0            
  0            
3001 0           ($base) = grep { $baseaddress{$_} eq $subtype } keys %baseaddress;
  0            
3002 0 0         if ($type eq 'MEM'){
3003 0 0         if ($memnum > 1) {
3004 0           $multiple = ($memnum - 1) * 26;
3005 0           $base = $self->hexAdder("$multiple","$base");
3006             }
3007             }
3008              
3009 0 0 0       if ($value eq 'READY' || $value eq 'ALL'){
3010 0           $offset=0x00;
3011 0           $address = $self->hexAdder("$offset","$base");
3012 0           my $ready;
3013 0           $output = $self->eepromDecode("$address");
3014 0           $output = substr($output,1,1);
3015 0 0         if ($output == '0'){$ready = 'YES'};
  0            
3016 0 0         if ($output == '1'){$ready = 'NO'};
  0            
3017 0 0         if($verbose){print "MEMORY $type\[$subtype\] - READY is $ready\n"};
  0            
3018 0           return $ready;
3019             }
3020              
3021 0 0 0       if ($value eq 'MODE' || $value eq 'ALL'){
3022 0           $offset=0x00;
3023 0           $address = $self->hexAdder("$offset","$base");
3024 0           my $mode;
3025 0           $output = $self->eepromDecode("$address");
3026 0           $output = substr($output,5,3);
3027 0           ($mode) = grep { $MEMMODES{$_} eq $output } keys %MEMMODES;
  0            
3028 0 0         if($verbose){print "MEMORY $type\[$subtype\] - MODE is $mode\n"};
  0            
3029 0 0         if ($value eq 'ALL'){$memoryhash{'MODE'} = "$mode";}
  0            
3030             else {
3031 0           return $mode;
3032             }
3033             }
3034              
3035 0 0 0       if ($value eq 'HFVHF' || $value eq 'ALL'){
3036 0           $offset=0x00;
3037 0           $address = $self->hexAdder("$offset","$base");
3038 0           my $hfvhf;
3039 0           $output = $self->eepromDecode("$address");
3040 0           $output = substr($output,2,1);
3041 0 0         if ($output == '0') {$hfvhf = "VHF";}
  0            
3042 0 0         if ($output == '1') {$hfvhf = "HF";}
  0            
3043 0 0         if($verbose){print "MEMORY $type\[$subtype\] - HF\/VHF is $hfvhf\n"};
  0            
3044 0 0         if ($value eq 'ALL'){$memoryhash{'HFVHF'} = "$hfvhf";}
  0            
3045             else {
3046 0           return $hfvhf;
3047             }
3048             }
3049              
3050 0 0 0       if ($value eq 'TAG' || $value eq 'ALL'){
3051 0           $offset=0x00;
3052 0           $address = $self->hexAdder("$offset","$base");
3053 0           my $tag;
3054 0           $output = $self->eepromDecode("$address");
3055 0           $output = substr($output,0,1);
3056 0 0         if ($output == '0') {$tag = "FREQUENCY";}
  0            
3057 0 0         if ($output == '1') {$tag = "LABEL";}
  0            
3058 0 0         if($verbose){print "MEMORY $type\[$subtype\] - Display Tag is $tag\n"};
  0            
3059 0 0         if ($value eq 'ALL'){$memoryhash{'TAG'} = "$tag";}
  0            
3060             else {
3061 0           return $tag;
3062             }
3063             }
3064              
3065 0 0 0       if ($value eq 'FREQRANGE' || $value eq 'ALL'){
3066 0           $offset=0x01;
3067 0           $address = $self->hexAdder("$offset","$base");
3068 0           my $freqrange;
3069 0           $output = $self->eepromDecode("$address");
3070 0           $output = substr($output,5,3);
3071 0 0         if ($output == '000') {$freqrange = "HF";}
  0            
3072 0 0         if ($output == '001') {$freqrange = "6M";}
  0            
3073 0 0         if ($output == '010') {$freqrange = "FM-BCB";}
  0            
3074 0 0         if ($output == '011') {$freqrange = "AIR";}
  0            
3075 0 0         if ($output == '100') {$freqrange = "2M";}
  0            
3076 0 0         if ($output == '101') {$freqrange = "UHF";}
  0            
3077 0 0         if($verbose){print "MEMORY $type\[$subtype\] - Frequency range is $freqrange\n"};
  0            
3078 0 0         if ($value eq 'ALL'){$memoryhash{'FREQRANGE'} = "$freqrange";}
  0            
3079             else {
3080 0           return $freqrange;
3081             }
3082             }
3083              
3084 0 0 0       if ($value eq 'NARFM' || $value eq 'ALL'){
3085 0           $offset=0x01;
3086 0           $address = $self->hexAdder("$offset","$base");
3087 0           my $narfm;
3088 0           $output = $self->eepromDecode("$address");
3089 0           $output = substr($output,4,1);
3090 0 0         if ($output == '0') {$narfm = "OFF";}
  0            
3091 0 0         if ($output == '1') {$narfm = "ON";}
  0            
3092 0 0         if($verbose){print "MEMORY $type\[$subtype\] - NARROW FM is $narfm\n"};
  0            
3093 0 0         if ($value eq 'ALL'){$memoryhash{'NARFM'} = "$narfm";}
  0            
3094             else {
3095 0           return $narfm;
3096             }
3097             }
3098              
3099 0 0 0       if ($value eq 'NARCWDIG' || $value eq 'ALL'){
3100 0           $offset=0x01;
3101 0           $address = $self->hexAdder("$offset","$base");
3102 0           my $narcw;
3103 0           $output = $self->eepromDecode("$address");
3104 0           $output = substr($output,3,1);
3105 0 0         if ($output == '0') {$narcw = "OFF";}
  0            
3106 0 0         if ($output == '1') {$narcw = "ON";}
  0            
3107 0 0         if($verbose){print "MEMORY $type\[$subtype\] - NARROW CW/DIG is $narcw\n"};
  0            
3108 0 0         if ($value eq 'ALL'){$memoryhash{'NARCWDIG'} = "$narcw";}
  0            
3109             else {
3110 0           return $narcw;
3111             }
3112             }
3113              
3114 0 0 0       if ($value eq 'UHF' || $value eq 'ALL'){
3115 0           $offset=0x01;
3116 0           $address = $self->hexAdder("$offset","$base");
3117 0           my $uhf;
3118 0           $output = $self->eepromDecode("$address");
3119 0           $output = substr($output,2,1);
3120 0 0         if ($output == '0') {$uhf = "NO";}
  0            
3121 0 0         if ($output == '1') {$uhf = "YES";}
  0            
3122 0 0         if($verbose){print "MEMORY $type\[$subtype\] - UHF $uhf\n"};
  0            
3123 0 0         if ($value eq 'ALL'){$memoryhash{'UHF'} = "$uhf";}
  0            
3124             else {
3125 0           return $uhf;
3126             }
3127             }
3128              
3129 0 0 0       if ($value eq 'RPTOFFSET' || $value eq 'ALL'){
3130 0           $offset=0x01;
3131 0           $address = $self->hexAdder("$offset","$base");
3132 0           my $rptoffset;
3133 0           $output = $self->eepromDecode("$address");
3134 0           $output = substr($output,0,2);
3135 0 0         if ($output == '00') {$rptoffset = "SIMPLEX";}
  0            
3136 0 0         if ($output == '01') {$rptoffset = "MINUS";}
  0            
3137 0 0         if ($output == '10') {$rptoffset = "PLUS";}
  0            
3138 0 0         if ($output == '11') {$rptoffset = "NON-STANDARD";}
  0            
3139 0 0         if($verbose){print "MEMORY $type\[$subtype\] - REPEATER OFFSET is $rptoffset\n"};
  0            
3140 0 0         if ($value eq 'ALL'){$memoryhash{'RPTOFFSET'} = "$rptoffset";}
  0            
3141             else {
3142 0           return $rptoffset;
3143             }
3144             }
3145              
3146 0 0 0       if ($value eq 'TONEDCS' || $value eq 'ALL'){
3147 0           $offset=0x04;
3148 0           $address = $self->hexAdder("$offset","$base");
3149 0           my $tonedcs;
3150 0           $output = $self->eepromDecode("$address");
3151 0           $output = substr($output,6,2);
3152 0 0         if ($output == '00') {$tonedcs = "OFF";}
  0            
3153 0 0         if ($output == '01') {$tonedcs = "TONE";}
  0            
3154 0 0         if ($output == '10') {$tonedcs = "TONETSQ";}
  0            
3155 0 0         if ($output == '11') {$tonedcs = "DCS";}
  0            
3156 0 0         if($verbose){print "MEMORY $type\[$subtype\] - TONE/DCS SELECT is $tonedcs\n"};
  0            
3157 0 0         if ($value eq 'ALL'){$memoryhash{'TONEDCS'} = "$tonedcs";}
  0            
3158             else {
3159 0           return $tonedcs;
3160             }
3161             }
3162              
3163 0 0 0       if ($value eq 'ATT' || $value eq 'ALL'){
3164 0           $offset=0x02;
3165 0           $address = $self->hexAdder("$offset","$base");
3166 0           my $att;
3167 0           $output = $self->eepromDecode("$address");
3168 0           $output = substr($output,3,1);
3169 0 0         if ($output == '0') {$att = "OFF";}
  0            
3170 0 0         if ($output == '1') {$att = "ON";}
  0            
3171 0 0         if($verbose){print "MEMORY $type\[$subtype\] - ATT is $att\n"};
  0            
3172 0 0         if ($value eq 'ALL'){$memoryhash{'ATT'} = "$att";}
  0            
3173             else {
3174 0           return $att;
3175             }
3176             }
3177              
3178 0 0 0       if ($value eq 'IPO' || $value eq 'ALL'){
3179 0           $offset=0x02;
3180 0           $address = $self->hexAdder("$offset","$base");
3181 0           my $ipo;
3182 0           $output = $self->eepromDecode("$address");
3183 0           $output = substr($output,2,1);
3184 0 0         if ($output == '0') {$ipo = "OFF";}
  0            
3185 0 0         if ($output == '1') {$ipo = "ON";}
  0            
3186 0 0         if($verbose){print "MEMORY $type\[$subtype\] - IPO is $ipo\n"};
  0            
3187 0 0         if ($value eq 'ALL'){$memoryhash{'IPO'} = "$ipo";}
  0            
3188             else {
3189 0           return $ipo;
3190             }
3191             }
3192              
3193 0 0 0       if ($value eq 'MEMSKIP' || $value eq 'ALL'){
3194 0           $offset=0x02;
3195 0           $address = $self->hexAdder("$offset","$base");
3196 0           my $memskip;
3197 0           $output = $self->eepromDecode("$address");
3198 0           $output = substr($output,0,1);
3199 0 0         if ($output == '0') {$memskip = "NO";}
  0            
3200 0 0         if ($output == '1') {$memskip = "YES";}
  0            
3201 0 0         if($verbose){print "MEMORY $type\[$subtype\] - MEMORY SKIP $memskip\n"};
  0            
3202 0 0         if ($value eq 'ALL'){$memoryhash{'MEMSKIP'} = "$memskip";}
  0            
3203             else {
3204 0           return $memskip;
3205             }
3206             }
3207              
3208 0 0 0       if ($value eq 'FMSTEP' || $value eq 'ALL'){
3209 0           $offset=0x03;
3210 0           $address = $self->hexAdder("$offset","$base");
3211 0           $output = $self->eepromDecode("$address");
3212 0           $output = substr($output,5,3);
3213 0           ($fmstep) = grep { $FMSTEP{$_} eq $output } keys %FMSTEP;
  0            
3214 0 0         if($verbose){print "MEMORY $type\[$subtype\] - FM STEP is $fmstep\n"};
  0            
3215 0 0         if ($value eq 'ALL'){$memoryhash{'FMSTEP'} = "$fmstep";}
  0            
3216             else {
3217 0           return $fmstep;
3218             }
3219             }
3220              
3221 0 0 0       if ($value eq 'AMSTEP' || $value eq 'ALL'){
3222 0           $offset=0x03;
3223 0           $address = $self->hexAdder("$offset","$base");
3224 0           $output = $self->eepromDecode("$address");
3225 0           $output = substr($output,2,3);
3226 0           ($amstep) = grep { $AMSTEP{$_} eq $output } keys %AMSTEP;
  0            
3227 0 0         if($verbose){print "MEMORY $type\[$subtype\] - AM STEP is $amstep\n"};
  0            
3228 0 0         if ($value eq 'ALL'){$memoryhash{'AMSTEP'} = "$amstep";}
  0            
3229             else {
3230 0           return $amstep;
3231             }
3232             }
3233              
3234 0 0 0       if ($value eq 'SSBSTEP' || $value eq 'ALL'){
3235 0           $offset=0x03;
3236 0           $address = $self->hexAdder("$offset","$base");
3237 0           my $ssbstep;
3238 0           $output = $self->eepromDecode("$address");
3239 0           $output = substr($output,0,2);
3240 0 0         if ($output == '00') {$ssbstep = '1.0';}
  0            
3241 0 0         if ($output == '01') {$ssbstep = '2.5';}
  0            
3242 0 0         if ($output == '10') {$ssbstep = '5.0';}
  0            
3243 0 0         if($verbose){print "MEMORY $type\[$subtype\] - SSB STEP is $ssbstep\n"};
  0            
3244 0 0         if ($value eq 'ALL'){$memoryhash{'SSBSTEP'} = "$ssbstep";}
  0            
3245             else {
3246 0           return $ssbstep;
3247             }
3248             }
3249              
3250 0 0 0       if ($value eq 'CTCSSTONE' || $value eq 'ALL'){
3251 0           $offset=0x06;
3252 0           my ($MSB, $LSB) = $self->hexAdder("$offset","$base");
3253 0           $output = $self->eepromDecode("$MSB","$LSB");
3254 0           $output = substr($output,2,6);
3255 0           my %newhash = reverse %CTCSSTONES;
3256 0           ($ctcsstone) = grep { $newhash{$_} eq $output } keys %newhash;
  0            
3257 0 0         if($verbose){print "MEMORY $type\[$subtype\] - CTCSS TONE is $ctcsstone\n"};
  0            
3258 0 0         if ($value eq 'ALL'){$memoryhash{'CTCSSTONE'} = "$ctcsstone";}
  0            
3259             else {
3260 0           return $ctcsstone;
3261             }
3262             }
3263              
3264 0 0 0       if ($value eq 'DCSCODE' || $value eq 'ALL'){
3265 0           $offset=0x07;
3266 0           $address = $self->hexAdder("$offset","$base");
3267 0           $output = $self->eepromDecode("$address");
3268 0           $output = substr($output,1,7);
3269 0           my %newhash = reverse %DCSCODES;
3270 0           ($dcscode) = grep { $newhash{$_} eq $output } keys %newhash;
  0            
3271 0 0         if($verbose){print "MEMORY $type\[$subtype\] - DCSCODE is $dcscode\n"};
  0            
3272 0 0         if ($value eq 'ALL'){$memoryhash{'DCSCODE'} = "$dcscode";}
  0            
3273             else {
3274 0           return $dcscode;
3275             }
3276             }
3277              
3278 0 0 0       if ($value eq 'CLARIFIER' || $value eq 'ALL'){
3279 0           $offset=0x02;
3280 0           $address = $self->hexAdder("$offset","$base");
3281 0           my $clarifier;
3282 0           $output = $self->eepromDecode("$address");
3283 0           $output = substr($output,1,1);
3284 0 0         if ($output == '1') {$clarifier = 'ON';}
  0            
3285 0 0         if ($output == '0') {$clarifier = 'OFF';}
  0            
3286 0 0         if($verbose){print "MEMORY $type\[$subtype\] - CLARIFIER is $clarifier\n"};
  0            
3287 0 0         if ($value eq 'ALL'){$memoryhash{'CLARIFIER'} = "$clarifier";}
  0            
3288             else {
3289 0           return $clarifier;
3290             }
3291             }
3292              
3293 0 0 0       if ($value eq 'CLAROFFSET' || $value eq 'ALL'){
3294 0           $offset=0x08;
3295 0           $address = $self->hexAdder("$offset","$base");
3296 0           my ($MSB,$LSB) = $self->eepromDoubledecode("$address");
3297 0           my $binvalue = join("","$MSB","$LSB");
3298 0           my $decvalue = oct("0b".$binvalue);
3299 0           my $newvalue;
3300 0 0         if ($decvalue > 999) {$newvalue = 65536 - $decvalue; $polarity = '-';}
  0            
  0            
3301 0 0 0       if ($decvalue >= 0 && $decvalue <= 999) {$newvalue = $decvalue; $polarity = '+';}
  0            
  0            
3302 0           my $vallength = length($newvalue);
3303 0 0         if ($vallength == 1) {$newvalue = join("","0.0","$newvalue");}
  0            
3304 0 0         if ($vallength == 2) {$newvalue = join("","0.","$newvalue");}
  0            
3305 0 0         if ($vallength == 3) {
3306 0           my $part1 = substr($newvalue,0,1);
3307 0           my $part2 = substr($newvalue,1,2);
3308 0           $newvalue = join("","$part1",".","$part2");
3309             }
3310 0 0         if ($vallength == 4) {
3311 0           my $part1 = substr($newvalue,0,2);
3312 0           my $part2 = substr($newvalue,2,2);
3313 0           $newvalue = join("","$part1",".","$part2");
3314             }
3315 0           $newvalue = join("","$polarity","$newvalue");
3316 0 0         if($verbose){print "MEMORY $type\[$subtype\] - CLARIFIER OFFSET is $newvalue Khz\n";}
  0            
3317 0 0         if ($value eq 'ALL'){$memoryhash{'CLAROFFSET'} = "$newvalue";}
  0            
3318             else {
3319 0           return $newvalue;
3320             }
3321             }
3322              
3323 0 0 0       if ($value eq 'RXFREQ' || $value eq 'ALL'){
3324 0           $offset=0x0A;
3325 0           $address = $self->hexAdder("$offset","$base");
3326 0           my ($ADD1,$ADD2) = $self->eepromDoubledecode("$address");
3327 0           $offset=0x0C;
3328 0           $address = $self->hexAdder("$offset","$base");
3329 0           my ($ADD3,$ADD4) = $self->eepromDoubledecode("$address");
3330 0           my $binvalue = join("","$ADD1","$ADD2","$ADD3","$ADD4");
3331 0           my $decvalue = oct("0b".$binvalue);
3332 0           substr($decvalue, -2, 0) = '.';
3333 0           substr($decvalue, -6, 0) = '.';
3334 0 0         if($verbose){print "MEMORY $type\[$subtype\] - RECEIVE FREQUENCY is $decvalue Mhz\n";}
  0            
3335 0 0         if ($value eq 'ALL'){$memoryhash{'RXFREQ'} = "$decvalue";}
  0            
3336             else {
3337 0           return $decvalue;
3338             }
3339             }
3340              
3341 0 0 0       if ($value eq 'RPTOFFSETFREQ' || $value eq 'ALL'){
3342 0           $offset=0x0F;
3343 0           $address = $self->hexAdder("$offset","$base");
3344 0           my ($ADD1,$ADD2) = $self->eepromDoubledecode("$address");
3345 0           $offset=0x11;
3346 0           my $address = $self->hexAdder("$offset","$base");
3347 0           my $ADD3 = $self->eepromDecode("$address");
3348 0           my $binvalue = join("","$ADD1","$ADD2","$ADD3");
3349 0           my $decvalue = oct("0b".$binvalue);
3350 0           $decvalue = $decvalue / 100000;
3351 0 0         if($verbose){print "MEMORY $type\[$subtype\] - REPEATER OFFSET is $decvalue Mhz\n";}
  0            
3352 0 0         if ($value eq 'ALL'){$memoryhash{'RPTOFFSETFREQ'} = "$decvalue";}
  0            
3353             else {
3354 0           return $decvalue;
3355             }
3356             }
3357              
3358 0 0 0       if ($value eq 'LABEL' || $value eq 'ALL'){
3359 0           my $cycles = 0x00;
3360 0           my $offset = 0x12;
3361 0           my $newaddress;
3362             my $label;
3363 0           $address = $self->hexAdder("$offset","$base");
3364 0           do {
3365 0           $newaddress = $self->hexAdder("$cycles","$address");
3366 0           my ($ADD,$ADD2) = $self->eepromDoubledecode("$newaddress");
3367 0           my $decvalue = oct("0b".$ADD);
3368 0           my $decvalue2 = oct("0b".$ADD2);
3369 0           my $letter = chr($decvalue);
3370 0           my $letter2 = chr($decvalue2);
3371 0           $cycles = $cycles + 2;
3372 0           $label .= "$letter"."$letter2";
3373             }
3374             while ($cycles < 8);
3375 0 0         if (!$label){$label = '\-BLANK\-';}
  0            
3376 0 0         if($verbose){print "MEMORY $type\[$subtype\] - LABEL is $label\n";}
  0            
3377 0 0         if ($value eq 'ALL'){$memoryhash{'LABEL'} = "$label";}
  0            
3378             else {
3379 0           return $label;
3380             }
3381             }
3382 0 0         if ($value eq 'ALL'){
3383 0           return %memoryhash;
3384             }
3385             }
3386              
3387             # 1922 - 1927 ################################# GET ID for CWID ######
3388             ######################################
3389             sub getId {
3390 0     0 1   my $self=shift;
3391 0           my $address = 1922;
3392 0           my $cycles = 0x00;
3393 0           my $cycles2;
3394             my $id;
3395 0           my $letter;
3396 0           my $letter2;
3397 0           my $hexvalue;
3398 0           my $hexvalue2;
3399 0           my %newhash = reverse %CWID;
3400 0           do {
3401 0           my $newaddress = $self->hexAdder("$cycles","$address");
3402 0           my ($ADD,$ADD2) = $self->eepromDoubledecode("$newaddress");
3403 0           my $hexvalue = sprintf("%X", oct( "0b$ADD" ) );
3404 0           my $hexvalue2 = sprintf("%X", oct( "0b$ADD2" ) );
3405 0           ($letter) = grep { $newhash{$_} eq $hexvalue } keys %newhash;
  0            
3406 0           ($letter2) = grep { $newhash{$_} eq $hexvalue2 } keys %newhash;
  0            
3407 0           $cycles = $cycles + 2;
3408 0           $id .= "$letter"."$letter2";
3409             }
3410             while ($cycles < 6);
3411 0           my ($ADD,$ADD2) = $self->eepromDoubledecode('1927');
3412 0           $hexvalue2 = sprintf("%X", oct( "0b$ADD2" ) );
3413 0           ($letter2) = grep { $newhash{$_} eq $hexvalue2 } keys %newhash;
  0            
3414 0           $id .= "$letter2";
3415 0 0         if($verbose){print "CW ID is $id\n";}
  0            
3416 0           return $id;
3417             }
3418              
3419             #################################
3420             # WRITE VALUES FROM EEPROM ADDR #
3421             #################################
3422              
3423             # 07-52 ################################# RESTORES SOFTCAL ######
3424             ###################################### ALL BITS
3425              
3426             sub rebuildSoftcal {
3427 0     0 1   my $self=shift;
3428 0           my $calfile=shift;
3429 0           my ($cal_line) =@_;
3430 0           my $error;
3431 0 0 0       if ($writeallow != '1' and $agreewithwarning != '1') {
3432 0 0 0       if($debug || $verbose){print"Writing to EEPROM disabled, use setWriteallow(1) to enable\n";}
  0            
3433 0           return 1;
3434             }
3435              
3436 0 0         if (!$calfile) {
3437 0 0         if ($verbose){print "No filename given, using default (FT817.cal)\n";}
  0            
3438 0           $calfile = 'FT817.cal';
3439             }
3440 0 0         open(CALFILE, "$calfile") or $error = '1';
3441 0 0         if ($error){
3442 0 0         if ($verbose){print "Failed to open file($calfile)\n";}
  0            
3443 0           return 1;
3444             }
3445             else {
3446 0           print "\n";
3447 0           my @caldata = ;
3448 0           my $linecount = 1;
3449 0           $error = undef;
3450 0           my @ln;
3451 0           our $writestatus = undef;
3452 0           my $cal_value = "$cal_line";
3453 0 0         if ($verbose){print "Validating file [$calfile]: ";}
  0            
3454 0           foreach $cal_line (@caldata) {
3455 0           my $test = substr($cal_line,0,2);
3456 0 0         if ($test ne '00'){next;}
  0            
3457 0           @ln=split(" ",$cal_line);
3458 0 0         if (length($ln[0]) + length($ln[3]) != 6){if($verbose){print "Error on line $linecount\n";} $error = 1;}
  0 0          
  0            
  0            
3459 0           $linecount++;
3460             }
3461 0 0         if ($linecount != '77'){$error = 1;}
  0            
3462 0 0         if ($error){
3463 0 0         if($verbose){print"Errors were found in the CAL file $calfile. Will not Process it!";}
  0            
3464 0           return 1;
3465             }
3466             else {
3467 0           my $skip = 0;
3468 0           my @line1;
3469             my @line2;
3470 0 0         if($verbose){print "---> [OK]\n\n";}
  0            
3471 0           $linecount = 1;
3472 0           $error = undef;
3473 0 0         if($verbose){print "Writing out 38 blocks to the radio. Do not power the unit off!!!!\n";}
  0            
3474 0           foreach $cal_line (@caldata) {
3475 0           my $test = substr($cal_line,0,2);
3476 0 0         if ($test ne '00'){next;}
  0            
3477 0 0         if ($skip == 0){@line1=split(" ",$cal_line);$skip = 1; next;}
  0            
  0            
  0            
3478 0 0         if ($skip == 1){@line2=split(" ",$cal_line);$skip = 0;}
  0            
  0            
3479 0 0         if($verbose){printf "%-2s %-8s %-5s %-5s", "$linecount",'of 38 WRITING',"\[$line1[3]\] --> $line1[0] \&","\[$line2[3]\] --> $line2[0] ";
  0            
3480 0           print " [OK]\n";}
3481 0           $writestatus = $self->writeDoubleblock("$line1[0]","$line1[3]","$line2[3]");
3482 0 0         if ($writestatus ne 'OK'){$error = 1;}
  0            
3483 0           $linecount++;
3484             }
3485             }
3486 0 0         if(!$error){
3487 0 0         if($verbose){print "\nSoftware calibration Loaded from $calfile sucessfull.\n";}
  0            
3488 0           return 0;
3489             }
3490 0 0         else { if($verbose){print "\nSoftware calibration Loaded from $calfile failed.\n";}
  0            
3491 0           return 1;
3492             }
3493             }
3494             }
3495              
3496             ##########################################################TEMPORARY LOCATION LOADCONFIG
3497             sub loadConfig {
3498              
3499 0     0 1   my $self=shift;
3500 0           my $cfgfile=shift;
3501 0           my ($cfg_line) =@_;
3502 0           my $error;
3503 0 0 0       if ($writeallow != '1' and $agreewithwarning != '1') {
3504 0 0 0       if($debug || $verbose){print"Writing to EEPROM disabled, use setWriteallow(1) to enable\n";}
  0            
3505 0           return 1;
3506             }
3507 0 0         if (!$cfgfile) {
3508 0 0         if ($verbose){print "No filename given, using default (FT817.cfg)\n";}
  0            
3509 0           $cfgfile = 'FT817.cfg';
3510             }
3511 0 0         open(CFGFILE, "$cfgfile") or $error = '1';
3512 0 0         if ($error){
3513 0 0         if ($verbose){print "Failed to open file($cfgfile)\n";}
  0            
3514 0           return 1;
3515             }
3516              
3517             else {
3518 0           print "\n";
3519 0           my @cfgdata = ;
3520 0           my $linecount = 1;
3521 0           $error = undef;
3522 0           my @ln;
3523 0           our $writestatus = undef;
3524 0           my $cfg_value = "$cfg_line";
3525 0 0         if ($verbose){print "Validating file [$cfgfile]: ";}
  0            
3526 0           foreach $cfg_line (@cfgdata) {
3527 0           my $test = substr($cfg_line,0,2);
3528 0 0         if ($test < 1){next;}
  0            
3529 0           @ln=split(" ",$cfg_line);
3530 0 0 0       if (!$ln[0] && !$ln[1] && !$ln[2]){if($verbose){print "Error on line $linecount\n";} $error = 1;}
  0 0 0        
  0            
  0            
3531 0           $linecount++;
3532             }
3533 0 0         if ($linecount != '50'){$error = 1;}
  0            
3534 0 0         if ($error){
3535 0 0         if($verbose){print"Errors were found in the CFG file $cfgfile. Will not Process it!";}
  0            
3536 0           return 1;
3537             }
3538             else {
3539 0 0         if($verbose){print "---> [OK]\n\n";}
  0            
3540 0           $linecount = 1;
3541 0           $error = undef;
3542 0 0         if($verbose){print "Writing out 50 configurations to the radio. Do not power the unit off!!!!\n\n";}
  0            
3543 0           foreach $cfg_line (@cfgdata) {
3544 0           my $test = substr($cfg_line,0,2);
3545 0 0         if ($test < 1){next;}
  0            
3546 0           @ln=split(" ",$cfg_line);
3547 0           $ln[1] = substr("$ln[1]",3);
3548 0 0         if($verbose){printf "%-2s %-11s %-12s %-9s %-11s %-1s", "\[$ln[0]\]",'to 57 WRITING',"\[$ln[2]\]", "TO -->", "$ln[1]"," ";
  0            
3549 0           print " [OK]\n";}
3550 0           $ln[1] = join("",'set',"$ln[1]");
3551 0           my $command = $ln[1];
3552 0           my $value = $ln[2];
3553 0           $self->setVerbose(0);
3554 0           $self->$command("$value");
3555 0           $self->setVerbose(1);
3556 0           print "\n";
3557 0           $linecount++;
3558             }
3559             }
3560 0 0         if($verbose){print "\nConfiguration Loaded from $cfgfile sucessfull.\n";}
  0            
3561 0           return 0;
3562             }
3563             }
3564              
3565             ##########################################################TEMPORARY LOCATION SAVEMEMORY
3566              
3567             sub saveMemory {
3568 0     0 1   my $self=shift;
3569 0           my $value=shift;
3570 0           my $localtime = localtime();
3571 0           my $currentmem = 1;
3572 0 0         if (!$value) {if($verbose){print"\nNo filename given using default filename FT817.mem\n";}$value = 'FT817.mem';}
  0 0          
  0            
  0            
3573 0 0         if (-e $value) {unlink $value;}
  0            
3574 0 0         open FILE , ">>", "$value" or print"Can't open $value. error\n";
3575 0           print FILE "FT817 Memory Backup\nUsing FT817COMM.pm version $VERSION\n";
3576 0           print FILE "Created $localtime\n";
3577 0           print FILE "Using FT817OS Format, Do not modify this file\n\n";
3578 0           printf FILE "%-11s %-2s\n", 'ADDRESS', 'VALUE';
3579 0 0         if($verbose){print"Saving Memory....\n";}
  0            
3580              
3581 0           $self->setVerbose(0);
3582 0           do {
3583 0           my $ready = $self->readMemory('MEM',"$currentmem",'READY');
3584 0 0         if ($ready eq 'YES'){
3585 0           my %baseaddress;
3586             my $base;
3587 0           my $multiple;
3588 0           %baseaddress = reverse %MEMORYBASE;
3589 0           ($base) = grep { $baseaddress{$_} eq 'MEM' } keys %baseaddress;
  0            
3590 0 0         if ($currentmem > 1) {
3591 0           $multiple = ($currentmem - 1) * 26;
3592 0           $base = $self->hexAdder("$multiple","$base");
3593             }
3594 0           my $cycles = 0x00;
3595 0           my $offset = 0x00;
3596 0           my $address = $self->hexAdder("$offset","$base");
3597 0           printf FILE "%-11s", "$currentmem";
3598 0           do {
3599 0           my $newaddress;
3600 0           my $HEXVALUE = $NEWMEM["$cycles"];
3601 0 0         if($verbose){print $cycles + 1;print " of 26 BYTES READ\n";}
  0            
  0            
3602 0           $newaddress = $self->hexAdder("$cycles","$address");
3603 0           my ($val,$val2) = $self->eepromDoubledecode("$newaddress");
3604 0           my $valuehex = sprintf("%X", oct( "0b$val" ) );
3605 0           my $valuehex2 = sprintf("%X", oct( "0b$val2" ) );
3606 0           my $size = length($valuehex);
3607 0 0         if ($size < 2){$valuehex = join("",'0',"$valuehex");}
  0            
3608 0           $size = length($valuehex2);
3609 0 0         if ($size < 2){$valuehex2 = join("",'0',"$valuehex2");}
  0            
3610 0           printf FILE "%-2s", "$valuehex:$valuehex2:";
3611 0           $cycles = $cycles + 2;
3612             } while ($cycles < 26);
3613 0           print FILE "\n";
3614             }
3615 0           $currentmem ++;
3616             } while ($currentmem != 203);
3617 0           print FILE "\n\n---END OF Memory Settings---\n";
3618 0           close FILE;
3619 0           $self->setVerbose(1);
3620 0 0         if($verbose){print"Memory Saved to $value\n";}
  0            
3621 0           return 0;
3622             }
3623              
3624             ##########################################################TEMPORARY LOCATION LOADMEMORY
3625              
3626             sub loadMemory {
3627 0     0 1   my $self=shift;
3628 0           my $memfile=shift;
3629 0           my ($mem_line) =@_;
3630 0           my $error;
3631 0           my $linecount = 1;
3632 0           my $totallines;
3633 0 0 0       if ($writeallow != '1' and $agreewithwarning != '1') {
3634 0 0 0       if($debug || $verbose){print"Writing to EEPROM disabled, use setWriteallow(1) to enable\n";}
  0            
3635 0           return 1;
3636             }
3637 0 0         if (!$memfile) {
3638 0 0         if ($verbose){print "No filename given, using default (FT817.mem)\n";}
  0            
3639 0           $memfile = 'FT817.mem';
3640             }
3641 0 0         open(MEMFILE, "$memfile") or $error = '1';
3642 0 0         if ($error){
3643 0 0         if ($verbose){print "Failed to open file($memfile)\n";}
  0            
3644 0           return 1;
3645             }
3646              
3647             else {
3648 0           print "\n";
3649 0           my @memdata = ;
3650 0           $error = undef;
3651 0           my @ln;
3652             my @hexvalues;
3653 0           our $writestatus = undef;
3654 0           my $mem_value = "$mem_line";
3655 0 0         if ($verbose){print "Validating file [$memfile]: ";}
  0            
3656 0           foreach $mem_line (@memdata) {
3657 0           my $testnumber;
3658 0           my $test = substr($mem_line,0,3);
3659 0 0         if ($test < 1){next;}
  0            
3660 0           @ln=split(" ",$mem_line);
3661 0 0 0       if (!$ln[0] && !$ln[1]){if($verbose){print "Error on line $linecount\n";} $error = 1;}
  0 0          
  0            
  0            
3662 0           @hexvalues=split(':',$ln[1]);
3663 0           $testnumber = scalar @hexvalues;
3664 0 0         if ($testnumber != '26'){if($verbose){print "Error on line $linecount\n";} $error = 1;}
  0 0          
  0            
  0            
3665 0           $linecount++;
3666             }
3667 0 0         if ($error){
3668 0 0         if($verbose){print"Errors were found in the MEM file $memfile. Will not Process it!";}
  0            
3669 0           return 1;
3670             }
3671 0 0         if($verbose){print "---> \[OK\]\n";}
  0            
3672 0           $totallines = $linecount - 1;
3673 0 0         if($verbose){print "Writing out $totallines memory areas to the radio. Do not power the unit off!!!!\n\n";}
  0            
3674 0           my %baseaddress;
3675             my $multiple;
3676 0           my $base;
3677 0           %baseaddress = reverse %MEMORYBASE;
3678 0           ($base) = grep { $baseaddress{$_} eq 'MEM' } keys %baseaddress;
  0            
3679 0           my $newbase = $base;
3680 0           foreach $mem_line (@memdata) {
3681 0           my $test = substr($mem_line,0,3);
3682 0 0         if ($test < 1){next;}
  0            
3683 0           @ln=split(" ",$mem_line);
3684 0 0         if ($ln[0] > 1) {
3685 0           $multiple = ($ln[0] - 1) * 26;
3686 0           $newbase = $self->hexAdder("$multiple","$base");
3687             }
3688 0           my $cycles = 0x00;
3689 0           my $cycles2 = $cycles + 1;
3690 0           my $offset = 0x00;
3691 0           my $data_line;
3692 0           my $error = undef;
3693 0           my $address = $self->hexAdder("$offset","$newbase");
3694 0 0         if($verbose){print "Writing memory area \[$ln[0]\] ";}
  0            
3695 0           my @memorydata = split(':',$ln[1]);
3696 0           do {
3697 0           my $newaddress;
3698 0           $newaddress = $self->hexAdder("$cycles","$address");
3699 0           $writestatus = $self->writeDoubleblock("$newaddress","$memorydata[$cycles]","$memorydata[$cycles2]");
3700 0 0         if ($writestatus ne 'OK'){if($verbose){print "---> FAILED"; $error = 1;}}
  0 0          
  0            
  0            
3701 0           $cycles = $cycles + 2;
3702 0           $cycles2 = $cycles + 1;
3703             } while ($cycles < 26);
3704 0 0         if (!$error) {if($verbose){print "---> \[OK\]";}}
  0 0          
  0            
3705 0           print "\n";
3706             }
3707 0 0         if(!$error){
3708 0 0         if($verbose){print "\nMemory Loaded from $memfile sucessfull.\n";}
  0            
3709 0           return 0;
3710             }
3711 0 0         else { if($verbose){print "\nMemory Loaded from $memfile failed.\n";}
  0            
3712 0           return 1;
3713             }
3714              
3715             }
3716              
3717 0           return 0;
3718             }
3719             ##########################################################TEMPORARY LOCATION SAVECONFIG
3720              
3721             sub saveConfig {
3722 0     0 1   my $self=shift;
3723 0           my $value=shift;
3724 0           my $localtime = localtime();
3725 0 0         if (!$value) {if($verbose){print"\nNo filename given using default filename FT817.cfg\n";}$value = 'FT817.cfg';}
  0 0          
  0            
  0            
3726 0           $localtime = localtime();
3727 0 0         if (-e $value) {unlink $value;}
  0            
3728 0 0         open FILE , ">>", "$value" or print"Can't open $value. error\n";
3729 0           print FILE "FT817 Config Backup\nUsing FT817COMM.pm version $VERSION\n";
3730 0           print FILE "Created $localtime\n";
3731 0           print FILE "Using FT817OS Format, Do not modify this file\n\n";
3732 0           printf FILE "%-11s %-15s %-15s\n", 'NUMBER', 'TYPE', 'VALUE';
3733 0           $self->setVerbose(0);
3734 0           printf FILE "%-11s %-15s %-7s\n", '1', 'getArs144', $self->getArs144();
3735 0           printf FILE "%-11s %-15s %-7s\n", '2', 'getArs430', $self->getArs430();
3736 0           printf FILE "%-11s %-15s %-7s\n", '3', 'get9600mic', $self->get9600mic();
3737 0           printf FILE "%-11s %-15s %-7s\n", '4', 'getAmfmdial', $self->getAmfmdial();
3738 0           printf FILE "%-11s %-15s %-7s\n", '5', 'getAmmic', $self->getAmmic();
3739 0           printf FILE "%-11s %-15s %-7s\n", '8', 'getApotime', $self->getApotime();
3740 0           printf FILE "%-11s %-15s %-7s\n", '9', 'getArtsmode', $self->getArtsmode();
3741 0           printf FILE "%-11s %-15s %-7s\n", '10', 'getBacklight', $self->getBacklight();
3742 0           printf FILE "%-11s %-15s %-7s\n", '11', 'getChargetime', $self->getChargetime();
3743 0           printf FILE "%-11s %-15s %-7s\n", '12', 'getBeepfreq', $self->getBeepfreq();
3744 0           printf FILE "%-11s %-15s %-7s\n", '13', 'getBeepvol', $self->getBeepvol();
3745 0           printf FILE "%-11s %-15s %-7s\n", '14', 'getCatrate', $self->getCatrate();
3746 0           printf FILE "%-11s %-15s %-7s\n", '15', 'getColor', $self->getColor();
3747 0           printf FILE "%-11s %-15s %-7s\n", '16', 'getContrast', $self->getContrast();
3748 0           printf FILE "%-11s %-15s %-7s\n", '17', 'getCwdelay', $self->getCwdelay();
3749 0           printf FILE "%-11s %-15s %-7s\n", '18', 'getCwid', $self->getCwid();
3750 0           printf FILE "%-11s %-15s %-7s\n", '19', 'getCwpaddle', $self->getCwpaddle();
3751 0           printf FILE "%-11s %-15s %-7s\n", '20', 'getCwpitch', $self->getCwpitch();
3752 0           printf FILE "%-11s %-15s %-7s\n", '21', 'getCwspeed', $self->getCwspeed();
3753 0           printf FILE "%-11s %-15s %-7s\n", '22', 'getCwweight', $self->getCwweight('1');
3754 0           printf FILE "%-11s %-15s %-7s\n", '24', 'getDigdisp', $self->getDigdisp();
3755 0           printf FILE "%-11s %-15s %-7s\n", '25', 'getDigmic', $self->getDigmic();
3756 0           printf FILE "%-11s %-15s %-7s\n", '26', 'getDigmode', $self->getDigmode();
3757 0           printf FILE "%-11s %-15s %-7s\n", '27', 'getDigshift', $self->getDigshift();
3758 0           printf FILE "%-11s %-15s %-7s\n", '28', 'getEmergency', $self->getEmergency();
3759 0           printf FILE "%-11s %-15s %-7s\n", '29', 'getFmmic', $self->getFmmic();
3760 0           printf FILE "%-11s %-15s %-7s\n", '31', 'getId', $self->getId();
3761 0           printf FILE "%-11s %-15s %-7s\n", '32', 'getLockmode', $self->getLockmode();
3762 0           printf FILE "%-11s %-15s %-7s\n", '33', 'getMainstep', $self->getMainstep();
3763 0           printf FILE "%-11s %-15s %-7s\n", '34', 'getMemgroup', $self->getMemgroup();
3764 0           printf FILE "%-11s %-15s %-7s\n", '36', 'getMickey', $self->getMickey();
3765 0           printf FILE "%-11s %-15s %-7s\n", '37', 'getMicscan', $self->getMicscan();
3766 0           printf FILE "%-11s %-15s %-7s\n", '38', 'getOpfilter', $self->getOpfilter();
3767 0           printf FILE "%-11s %-15s %-7s\n", '39', 'getPktmic', $self->getPktmic();
3768 0           printf FILE "%-11s %-15s %-7s\n", '40', 'getPktrate', $self->getPktrate();
3769 0           printf FILE "%-11s %-15s %-7s\n", '41', 'getResumescan', $self->getResumescan();
3770 0           printf FILE "%-11s %-15s %-7s\n", '43', 'getScope', $self->getScope();
3771 0           printf FILE "%-11s %-15s %-7s\n", '44', 'getSidetonevol', $self->getSidetonevol();
3772 0           printf FILE "%-11s %-15s %-7s\n", '45', 'getRfknob', $self->getRfknob();
3773 0           printf FILE "%-11s %-15s %-7s\n", '46', 'getSsbmic', $self->getSsbmic();
3774 0           printf FILE "%-11s %-15s %-7s\n", '49', 'getTottime', $self->getTottime();
3775 0           printf FILE "%-11s %-15s %-7s\n", '50', 'getVoxdelay', $self->getVoxdelay();
3776 0           printf FILE "%-11s %-15s %-7s\n", '51', 'getVoxgain', $self->getVoxgain();
3777 0           printf FILE "%-11s %-15s %-7s\n", '52', 'getExtmenu', $self->getExtmenu();
3778 0           printf FILE "%-11s %-15s %-7s\n", '53', 'getDcsinv', $self->getDcsinv();
3779 0           printf FILE "%-11s %-15s %-7s\n", '54', 'getRlsbcar', $self->getRlsbcar();
3780 0           printf FILE "%-11s %-15s %-7s\n", '55', 'getRusbcar', $self->getRusbcar();
3781 0           printf FILE "%-11s %-15s %-7s\n", '56', 'getTlsbcar', $self->getTlsbcar();
3782 0           printf FILE "%-11s %-15s %-7s\n", '57', 'getTusbcar', $self->getTusbcar();
3783 0           print FILE "\n\n---END OF Config Settings---\n";
3784 0           close FILE;
3785 0           $self->setVerbose(1);
3786 0 0         if($verbose){print"Config Saved to $value\n";}
  0            
3787 0           return 0;
3788             }
3789              
3790             # 55 ################################# SET VFO A/B , MEM OR VFO, MTUNE OR MEMORY,MTQMB, QMB, HOME ######
3791             ###################################### SET BITS 0,1,2,4,5 AND 7 FROM 0X55
3792              
3793             sub setMtune {
3794 0     0 1   my $self=shift;
3795 0           my $value=shift;
3796 0 0 0       if ($value ne 'MTUNE' && $value ne 'MEMORY'){
3797 0 0         if($verbose){print "Value invalid: Choose MTUNE/MEMORY\n\n";}
  0            
3798 0           return 1;
3799             }
3800 0           $self->setVerbose(0);
3801 0           my $currentmtune = $self->getMtune();
3802 0           $self->setVerbose(1);
3803 0 0         if ($value eq $currentmtune){
3804 0 0         if($verbose){print "Value $currentmtune already selected.\n\n";}
  0            
3805 0           return 1;
3806             }
3807 0 0         if($value eq 'MTUNE'){$writestatus = $self->writeEeprom('0055','2','1');}
  0            
3808 0 0         if($value eq 'MEMORY'){$writestatus = $self->writeEeprom('0055','2','0');}
  0            
3809 0 0         if ($verbose){
3810 0 0         if ($writestatus eq 'OK') {print"MTUNE set to $value sucessfull!\n";}
  0            
3811 0           else {print"MTUNE set to $value failed!!!\n";}
3812             }
3813 0           return $writestatus;
3814             }
3815              
3816             ####################
3817              
3818             sub setMtqmb {
3819 0     0 1   my $self=shift;
3820 0           my $value=shift;
3821 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
3822 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
3823 0           return 1;
3824             }
3825 0           $self->setVerbose(0);
3826 0           my $currentmtqmb = $self->getMtqmb();
3827 0           $self->setVerbose(1);
3828 0 0         if ($value eq $currentmtqmb){
3829 0 0         if($verbose){print "Value $currentmtqmb already selected.\n\n"; }
  0            
3830 0           return 1;
3831             }
3832 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom('0055','6','1');}
  0            
3833 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom('0055','6','0');}
  0            
3834 0 0         if ($verbose){
3835 0 0         if ($writestatus eq 'OK') {print"MTQMB set to $value sucessfull!\n";}
  0            
3836 0           else {print"MTQMB set to $value failed!!!\n";}
3837             }
3838 0           return $writestatus;
3839             }
3840              
3841             ####################
3842              
3843             sub setQmb {
3844 0     0 1   my $self=shift;
3845 0           my $value=shift;
3846 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
3847 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
3848 0           return 1;
3849             }
3850 0           $self->setVerbose(0);
3851 0           my $currentqmb = $self->getQmb();
3852 0           $self->setVerbose(1);
3853 0 0         if ($value eq $currentqmb){
3854 0 0         if($verbose){print "Value $currentqmb already selected.\n\n";}
  0            
3855 0           return 1;
3856             }
3857 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom('0055','5','1');}
  0            
3858 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom('0055','5','0');}
  0            
3859 0 0         if ($verbose){
3860 0 0         if ($writestatus eq 'OK') {print"QMB set to $value sucessfull!\n";}
  0            
3861 0           else {print"QMB set to $value failed!!!\n";}
3862             }
3863 0           return $writestatus;
3864             }
3865              
3866             ####################
3867              
3868             sub setHome {
3869 0     0 1   my $self=shift;
3870 0           my $value=shift;
3871 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
3872 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
3873 0           return 1;
3874             }
3875 0           $self->setVerbose(0);
3876 0           my $currenthome = $self->getHome();
3877 0           $self->setVerbose(1);
3878 0 0         if ($value eq $currenthome){
3879 0 0         if($verbose){print "Value $currenthome already selected.\n\n"; }
  0            
3880 0           return 1;
3881             }
3882 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom('0055','3','1');}
  0            
3883 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom('0055','3','0');}
  0            
3884 0 0         if ($verbose){
3885 0 0         if ($writestatus eq 'OK') {print"HOME set to $value sucessfull!\n";}
  0            
3886 0           else {print"HOME set to $value failed!!!\n";}
3887             }
3888 0           return $writestatus;
3889             }
3890              
3891             ####################
3892              
3893             sub setVfo {
3894 0     0 1   my $self=shift;
3895 0           my $value=shift;
3896 0 0 0       if ($value ne 'A' && $value ne 'B'){
3897 0 0         if($verbose){print "Value invalid: Choose A/B\n\n";}
  0            
3898 0           return 1;
3899             }
3900 0           $self->setVerbose(0);
3901 0           my $currentvfo = $self->getVfo();
3902 0           $self->setVerbose(1);
3903 0 0         if ($value eq $currentvfo){
3904 0 0         if($verbose){print "Value $currentvfo already selected.\n\n"; }
  0            
3905 0           return 1;
3906             }
3907 0 0         if($value eq 'A'){$writestatus = $self->writeEeprom('0055','7','0');}
  0            
3908 0 0         if($value eq 'B'){$writestatus = $self->writeEeprom('0055','7','1');}
  0            
3909 0 0         if ($verbose){
3910 0 0         if ($writestatus eq 'OK') {print"VFO set to $value sucessfull!\n";}
  0            
3911 0           else {print"VFO set to $value failed!!!\n";}
3912             }
3913 0           return $writestatus;
3914             }
3915              
3916             ####################
3917              
3918             sub setTuner {
3919 0     0 1   my $self=shift;
3920 0           my $value=shift;
3921 0 0 0       if ($value ne 'MEMORY' && $value ne 'VFO'){
3922 0 0         if($verbose){print "Value invalid: Choose MEMORY/VFO\n\n";}
  0            
3923 0           return 1;
3924             }
3925 0           $self->setVerbose(0);
3926 0           my $currenttuner = $self->getTuner();
3927 0           $self->setVerbose(1);
3928 0 0         if ($value eq $currenttuner){
3929 0 0         if($verbose){print "Value $currenttuner already selected.\n\n"; }
  0            
3930 0           return 1;
3931             }
3932 0 0         if($value eq 'MEMORY'){$writestatus = $self->writeEeprom('0055','1','1');}
  0            
3933 0 0         if($value eq 'VFO'){$writestatus = $self->writeEeprom('0055','1','0');}
  0            
3934 0 0         if ($verbose){
3935 0 0         if ($writestatus eq 'OK') {print"TUNER set to $value sucessfull!\n";}
  0            
3936 0           else {print"TUNER set to $value failed!!!\n";}
3937             }
3938 0           return $writestatus;
3939             }
3940              
3941             # 57 ################################# SET AGC MODE, NOISE BLOCK, FASTTUNE , DSP AND LOCK ######
3942             ###################################### READ BITS 0-1 , 2, 5 AND 6 FROM 0X57
3943              
3944             sub setAgc {
3945 0     0 1   my $self=shift;
3946 0           my $value=shift;
3947 0 0 0       if ($value ne 'AUTO' && $value ne 'SLOW' && $value ne 'FAST' && $value ne 'OFF'){
      0        
      0        
3948 0 0         if($verbose){print "Value invalid: Choose AUTO/SLOW/FAST/OFF\n\n";}
  0            
3949 0           return 1;
3950             }
3951 0           $self->setVerbose(0);
3952 0           my $currentagc = $self->getAgc();
3953 0           $self->setVerbose(1);
3954 0 0         if ($value eq $currentagc){
3955 0 0         if($verbose){print "Value $currentagc already selected.\n\n";}
  0            
3956 0           return 1;
3957             }
3958 0           my $BYTE1 = $self->eepromDecode('0057');
3959 0 0         if ($value eq 'OFF'){substr ($BYTE1, 6, 2, '11');}
  0            
3960 0 0         if ($value eq 'SLOW'){substr ($BYTE1, 6, 2, '10');}
  0            
3961 0 0         if ($value eq 'FAST'){substr ($BYTE1, 6, 2, '01');}
  0            
3962 0 0         if ($value eq 'AUTO'){substr ($BYTE1, 6, 2, '00');}
  0            
3963 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
3964 0           $writestatus = $self->writeBlock('0057',"$NEWHEX");
3965 0 0         if($verbose){
3966 0 0         if ($writestatus eq 'OK') {print"AGC Set to $value sucessfull!\n";}
  0            
3967 0           else {print"AGC set failed: $writestatus\n";}
3968             }
3969 0           return $writestatus;
3970             }
3971              
3972             ####################
3973              
3974             sub setNb {
3975 0     0 1   my ($currentnb) = @_;
3976 0           my $self=shift;
3977 0           my $value=shift;
3978 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
3979 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
3980 0           return 1;
3981             }
3982 0           $self->setVerbose(0);
3983 0           $currentnb = $self->getNb();
3984 0           $self->setVerbose(1);
3985 0 0         if ($value eq $currentnb){
3986 0 0         if($verbose){print "Value $currentnb already selected.\n\n";}
  0            
3987 0           return 1;
3988             }
3989 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom('0057','2','1');}
  0            
3990 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom('0057','2','0');}
  0            
3991 0 0         if ($verbose){
3992 0 0         if ($writestatus eq 'OK') {print"Noise Block set to $value sucessfull!\n";}
  0            
3993 0           else {print"Noise Block set to $value failed!!!\n";}
3994             }
3995 0           return $writestatus;
3996             }
3997              
3998             ####################
3999              
4000             sub setDsp {
4001 0     0 1   my ($currentdsp) = @_;
4002 0           my $self=shift;
4003 0           my $value=shift;
4004 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
4005 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
4006 0           return 1;
4007             }
4008 0           $self->setVerbose(0);
4009 0           $currentdsp = $self->getDsp();
4010 0           $self->setVerbose(1);
4011 0 0         if ($value eq $currentdsp){
4012 0 0         if($verbose){print "Value $currentdsp already selected.\n\n";}
  0            
4013 0           return 1;
4014             }
4015 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom('0057','5','1');}
  0            
4016 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom('0057','5','0');}
  0            
4017 0 0         if ($verbose){
4018 0 0         if ($writestatus eq 'OK') {print"DSP set to $value sucessfull!\n";}
  0            
4019 0           else {print"DSP set to $value failed!!!\n";}
4020             }
4021 0           return $writestatus;
4022             }
4023              
4024             ####################
4025              
4026             sub setPbt {
4027 0     0 1   my ($currentpbt) = @_;
4028 0           my $self=shift;
4029 0           my $value=shift;
4030 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
4031 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
4032 0           return 1;
4033             }
4034 0           $self->setVerbose(0);
4035 0           $currentpbt = $self->getPbt();
4036 0           $self->setVerbose(1);
4037 0 0         if ($value eq $currentpbt){
4038 0 0         if($verbose){print "Value $currentpbt already selected.\n\n";}
  0            
4039 0           return 1;
4040             }
4041 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom('0057','3','1');}
  0            
4042 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom('0057','3','0');}
  0            
4043 0 0         if ($verbose){
4044 0 0         if ($writestatus eq 'OK') {print"Pass Band Tuning set to $value sucessfull!\n";}
  0            
4045 0           else {print"Pass Band Tuning set to $value failed!!!\n";}
4046             }
4047 0           return $writestatus;
4048             }
4049              
4050             ####################
4051              
4052             sub setLock {
4053 0     0 1   my ($currentlock) = @_;
4054 0           my $self=shift;
4055 0           my $value=shift;
4056 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
4057 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
4058 0           return 1;
4059             }
4060 0           $self->setVerbose(0);
4061 0           $currentlock = $self->getLock();
4062 0           $self->setVerbose(1);
4063 0 0         if ($value eq $currentlock){
4064 0 0         if($verbose){print "Value $currentlock already selected.\n\n";}
  0            
4065 0           return 1;
4066             }
4067 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom('0057','1','0');}
  0            
4068 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom('0057','1','1');}
  0            
4069 0 0         if ($verbose){
4070 0 0         if ($writestatus eq 'OK') {print"Lock set to $value sucessfull!\n";}
  0            
4071 0           else {print"Lock set to $value failed!!!\n";}
4072             }
4073 0           return $writestatus;
4074             }
4075              
4076             ####################
4077              
4078             sub setFasttuning {
4079 0     0 1   my ($currenttuning) = @_;
4080 0           my $self=shift;
4081 0           my $value=shift;
4082 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
4083 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
4084 0           return 1;
4085             }
4086 0           $self->setVerbose(0);
4087 0           $currenttuning = $self->getFasttuning();
4088 0           $self->setVerbose(1);
4089 0 0         if ($value eq $currenttuning){
4090 0 0         if($verbose){print "Value $currenttuning already selected.\n\n";}
  0            
4091 0           return 1;
4092             }
4093 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom('0057','0','0');}
  0            
4094 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom('0057','0','1');}
  0            
4095 0 0         if ($verbose){
4096 0 0         if ($writestatus eq 'OK') {print"Fast Tuning set to $value sucessfull!\n";}
  0            
4097 0           else {print"Fast Tuning set to $value failed!!!\n";}
4098             }
4099 0           return $writestatus;
4100             }
4101              
4102             # 58 ################################# SET PWR MTR MODE, CW PADDLE, KYR, BK, VLT, VOX ######
4103             ###################################### CHANGE BIT 0-1,2,4,5,6,7 FROM 0X58
4104              
4105             sub setPwrmtr {
4106 0     0 1   my $self=shift;
4107 0           my $value=shift;
4108 0 0 0       if ($value ne 'PWR' && $value ne 'ALC' && $value ne 'SWR' && $value ne 'MOD'){
      0        
      0        
4109 0 0         if($verbose){print "Value invalid: Choose PWR/ALC/SWR/MOD\n\n"; }
  0            
4110 0           return 1;
4111             }
4112 0           $self->setVerbose(0);
4113 0           my $currentpwrmtr = $self->getPwrmtr();
4114 0           $self->setVerbose(1);
4115 0 0         if ($value eq $currentpwrmtr){
4116 0 0         if($verbose){print "Value $currentpwrmtr already selected.\n\n";}
  0            
4117 0           return 1;
4118             }
4119 0           my $BYTE1 = $self->eepromDecode('0058');
4120 0 0         if ($value eq 'PWR'){substr ($BYTE1, 6, 2, '00');}
  0            
4121 0 0         if ($value eq 'ALC'){substr ($BYTE1, 6, 2, '01');}
  0            
4122 0 0         if ($value eq 'SWR'){substr ($BYTE1, 6, 2, '10');}
  0            
4123 0 0         if ($value eq 'MOD'){substr ($BYTE1, 6, 2, '11');}
  0            
4124 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
4125 0           $writestatus = $self->writeBlock('0058',"$NEWHEX");
4126 0 0         if($verbose){
4127 0 0         if ($writestatus eq 'OK') {print"Power Meter set to $value sucessfull!\n";}
  0            
4128 0           else {print"Power Meter set failed: $writestatus\n";}
4129             }
4130 0           return $writestatus;
4131             }
4132              
4133             ########################
4134              
4135             sub setCwpaddle {
4136 0     0 1   my ($currentcwpaddle) = @_;
4137 0           my $self=shift;
4138 0           my $value=shift;
4139 0 0 0       if ($value ne 'NORMAL' && $value ne 'REVERSE'){
4140 0 0         if($verbose){print "Value invalid: Choose NORMAL/REVERSE\n\n";}
  0            
4141 0           return 1;
4142             }
4143 0           $self->setVerbose(0);
4144 0           $currentcwpaddle = $self->getCwpaddle();
4145 0           $self->setVerbose(1);
4146 0 0         if ($value eq $currentcwpaddle){
4147 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
4148 0           return 1;
4149             }
4150 0 0         if($value eq 'NORMAL'){$writestatus = $self->writeEeprom('0058','5','0');}
  0            
4151 0 0         if($value eq 'REVERSE'){$writestatus = $self->writeEeprom('0058','5','1');}
  0            
4152 0 0         if ($verbose){
4153 0 0         if ($writestatus eq 'OK') {print"CW Paddle set to $value sucessfull!\n";}
  0            
4154 0           else {print"CW Paddle set to $value failed!!!\n";}
4155             }
4156 0           return $writestatus;
4157             }
4158              
4159             ########################
4160              
4161             sub setKyr {
4162 0     0 1   my ($currentkyr) = @_;
4163 0           my $self=shift;
4164 0           my $value=shift;
4165 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
4166 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
4167 0           return 1;
4168             }
4169 0           $self->setVerbose(0);
4170 0           $currentkyr = $self->getKyr();
4171 0           $self->setVerbose(1);
4172 0 0         if ($value eq $currentkyr){
4173 0 0         if($verbose){print "Value $value already selected.\n\n"; }
  0            
4174 0           return 1;
4175             }
4176 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom('0058','3','1');}
  0            
4177 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom('0058','3','0');}
  0            
4178 0 0         if ($verbose){
4179 0 0         if ($writestatus eq 'OK') {print"Keyer (KYR) set to $value sucessfull!\n";}
  0            
4180 0           else {print"Keyer (KYR) set to $value failed!!!\n";}
4181             }
4182 0           return $writestatus;
4183             }
4184              
4185             ########################
4186              
4187             sub setBk {
4188 0     0 1   my ($currentbk) = @_;
4189 0           my $self=shift;
4190 0           my $value=shift;
4191 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
4192 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
4193 0           return 1;
4194             }
4195 0           $self->setVerbose(0);
4196 0           $currentbk = $self->getBk();
4197 0           $self->setVerbose(1);
4198 0 0         if ($value eq $currentbk){
4199 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
4200 0           return 1;
4201             }
4202 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom('0058','2','1');}
  0            
4203 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom('0058','2','0');}
  0            
4204 0 0         if ($verbose){
4205 0 0         if ($writestatus eq 'OK') {print"Break-in (BK) set to $value sucessfull!\n";}
  0            
4206 0           else {print"Break-in (BK) set to $value failed!!!\n";}
4207             }
4208 0           return $writestatus;
4209             }
4210              
4211             ########################
4212              
4213             sub setVlt {
4214 0     0 1   my ($currentvlt) = @_;
4215 0           my $self=shift;
4216 0           my $value=shift;
4217 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
4218 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
4219 0           return 1;
4220             }
4221 0           $self->setVerbose(0);
4222 0           $currentvlt = $self->getVlt();
4223 0           $self->setVerbose(1);
4224 0 0         if ($value eq $currentvlt){
4225 0 0         if($verbose){print "Value $value already selected.\n\n"; }
  0            
4226 0           return 1;
4227             }
4228 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom('0058','1','1');}
  0            
4229 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom('0058','1','0');}
  0            
4230 0 0         if ($verbose){
4231 0 0         if ($writestatus eq 'OK') {print"Voltage readout set to $value sucessfull!\n";}
  0            
4232 0           else {print"Voltage readout set to $value failed!!!\n";}
4233             }
4234 0           return $writestatus;
4235             }
4236              
4237             ########################
4238              
4239             sub setVox {
4240 0     0 1   my ($currentvox) = @_;
4241 0           my $self=shift;
4242 0           my $value=shift;
4243 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
4244 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
4245 0           return 1;
4246             }
4247 0           $self->setVerbose(0);
4248 0           $currentvox = $self->getVox();
4249 0           $self->setVerbose(1);
4250 0 0         if ($value eq $currentvox){
4251 0 0         if($verbose){print "Value $currentvox already selected.\n\n";}
  0            
4252 0           return 1;
4253             }
4254 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom('0058','0','1');}
  0            
4255 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom('0058','0','0');}
  0            
4256 0 0         if ($verbose){
4257 0 0         if ($writestatus eq 'OK') {print"VOX set to $value sucessfull!\n";}
  0            
4258 0           else {print"VOX set to $value failed!!!\n";}
4259             }
4260 0           return $writestatus;
4261             }
4262              
4263             # 59 ################################# SET VFOBAND ######
4264             ###################################### CHANGE ALL BITS FROM 0X59
4265              
4266             sub setVfoband {
4267 0     0 1   my ($currentband, $writestatus, $vfoband, $testvfoband) = @_;
4268 0           my $self=shift;
4269 0           my $vfo=shift;
4270 0           my $value=shift;
4271 0 0 0       if ($vfo ne 'A' && $vfo ne 'B'){
4272 0 0         if($verbose){print "Value invalid: Choose VFO A/B\n\n";}
  0            
4273 0           return 1;
4274             }
4275 0           my %newhash = reverse %VFOBANDS;
4276 0           ($testvfoband) = grep { $newhash{$_} eq $value } keys %newhash;
  0            
4277 0 0         if ($testvfoband eq'') {
4278 0 0         if($verbose){print "\nChoose valid Band : [160M/75M/40M/30M/20M/17M/15M/12M/10M/6M/2M/70CM/FMBC/AIR/PHAN]\n\n";}
  0            
4279 0           return 1;
4280             }
4281 0           $self->setVerbose(0);
4282 0           $currentband = $self->getVfoband("$vfo");
4283 0           $self->setVerbose(1);
4284 0 0         if ($currentband eq $value) {
4285 0 0         if($verbose){print "\nBand $currentband already selected for VFO $vfo\n\n";}
  0            
4286 0           return 1;
4287             }
4288 0           my $BYTE1 = $self->eepromDecode('0059');
4289 0 0         if ($vfo eq 'A'){substr ($BYTE1, 4, 4, "$testvfoband");}
  0            
4290 0 0         if ($vfo eq 'B'){substr ($BYTE1, 0, 4, "$testvfoband");}
  0            
4291 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
4292 0           $writestatus = $self->writeBlock('0059',"$NEWHEX");
4293 0 0         if ($verbose){
4294 0 0         if ($writestatus eq 'OK') {print"BAND $currentband on VFO $vfo set sucessfull!\n";}
  0            
4295 0           else {print"BAND $currentband on VFO $vfo set failed!!!\n";}
4296             }
4297 0           return $writestatus;
4298             }
4299              
4300             # 5B ################################# SET CONTRAST, COLOR, BACKLIGHT
4301             ###################################### BITS 0-3,4, 6-7 FROM ADDRESS 0X5B
4302            
4303             sub setContrast {
4304 0     0 1   my ($currentcontrast) = @_;
4305 0           my $self=shift;
4306 0           my $value=shift;
4307 0 0 0       if ($value < 1 || $value > 12){
4308 0 0         if($verbose){print "Value invalid: Choose a number between 1 and 12\n\n"; }
  0            
4309 0           return 1;
4310             }
4311 0           $self->setVerbose(0);
4312 0           $currentcontrast = $self->getContrast();
4313 0           $self->setVerbose(1);
4314 0 0         if ($value eq $currentcontrast){
4315 0 0         if($verbose){print "Value $currentcontrast already selected.\n\n"; }
  0            
4316 0           return 1;
4317             }
4318 0           my $firstvalue = $value;
4319 0           $value++;
4320 0           my $binvalue = dec2bin($value);
4321 0           my $BYTE1 = $self->eepromDecode('005B');
4322 0           $binvalue = substr("$binvalue", 4);
4323 0           substr ($BYTE1, 4, 4, "$binvalue");
4324 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
4325 0           $writestatus = $self->writeBlock('005B',"$NEWHEX");
4326 0 0         if($verbose){
4327 0 0         if ($writestatus eq 'OK') {print"Contrast set to $firstvalue sucessfull!\n";}
  0            
4328 0           else {print"Contrast set failed: $writestatus\n";}
4329             }
4330 0           return $writestatus;
4331             }
4332              
4333             ####################
4334              
4335             sub setColor {
4336 0     0 1   my ($currentcolor) = @_;
4337 0           my $self=shift;
4338 0           my $value=shift;
4339 0 0 0       if ($value ne 'BLUE' && $value ne 'AMBER'){
4340 0 0         if($verbose){print "Value invalid: Choose BLUE/AMBER\n\n"; }
  0            
4341 0           return 1;
4342             }
4343 0           $self->setVerbose(0);
4344 0           $currentcolor = $self->getColor();
4345 0           $self->setVerbose(1);
4346 0 0         if ($currentcolor eq $value) {
4347 0 0         if($verbose){print "Setting $value already selected for Screen Color\n\n";}
  0            
4348 0           return 1;
4349             }
4350 0 0         if($value eq 'BLUE'){$writestatus = $self->writeEeprom('005B','3','0');}
  0            
4351 0 0         if($value eq 'AMBER'){$writestatus = $self->writeEeprom('005B','3','1');}
  0            
4352 0 0         if ($verbose){
4353 0 0         if ($writestatus eq 'OK') {print"Screen color set to $value sucessfull!\n";}
  0            
4354 0           else {print"Screen Color set to $value failed!!!\n";}
4355             }
4356 0           return $writestatus;
4357             }
4358              
4359             ####################
4360              
4361             sub setBacklight {
4362 0     0 1   my ($currentbacklight) = @_;
4363 0           my $self=shift;
4364 0           my $value=shift;
4365 0 0 0       if ($value ne 'OFF' && $value ne 'ON' && $value ne 'AUTO'){
      0        
4366 0 0         if($verbose){print "Value invalid: Choose OFF/ON/AUTO\n\n";}
  0            
4367 0           return 1;
4368             }
4369 0           $self->setVerbose(0);
4370 0           $currentbacklight = $self->getBacklight();
4371 0           $self->setVerbose(1);
4372 0 0         if ($value eq $currentbacklight){
4373 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
4374 0           return 1;
4375             }
4376 0           my $BYTE1 = $self->eepromDecode('005B');
4377 0 0         if ($value eq 'OFF'){substr ($BYTE1, 0, 2, '00');}
  0            
4378 0 0         if ($value eq 'ON'){substr ($BYTE1, 0, 2, '01');}
  0            
4379 0 0         if ($value eq 'AUTO'){substr ($BYTE1, 0, 2, '10');}
  0            
4380 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
4381 0           $writestatus = $self->writeBlock('005B',"$NEWHEX");
4382 0 0         if($verbose){
4383 0 0         if ($writestatus eq 'OK') {print"Back Light Set to $value sucessfull!\n";}
  0            
4384 0           else {print"Back Light set failed: $writestatus\n";}
4385             }
4386 0           return $writestatus;
4387             }
4388              
4389             # 5C ################################# SET BEEP VOL , BEEP FREQ ######
4390             ###################################### BITS 0-6, 7 FROM 0X5C
4391              
4392             sub setBeepvol {
4393 0     0 1   my ($currentbeepvol) = @_;
4394 0           my $self=shift;
4395 0           my $value=shift;
4396 0 0 0       if ($value < 0 || $value > 100){
4397 0 0         if($verbose){print "Value invalid: Choose (0 - 100)\n\n";}
  0            
4398 0           return 1;
4399             }
4400 0           $self->setVerbose(0);
4401 0           $currentbeepvol = $self->getBeepvol();
4402 0           $self->setVerbose(1);
4403 0 0         if ($value eq $currentbeepvol){
4404 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
4405 0           return 1;
4406             }
4407 0           my $binvalue = dec2bin($value);
4408 0           my $BYTE1 = $self->eepromDecode('005C');
4409 0           $binvalue = substr("$binvalue", 1);
4410 0           substr ($BYTE1, 1, 7, "$binvalue");
4411 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
4412 0           $writestatus = $self->writeBlock('005C',"$NEWHEX");
4413 0 0         if($verbose){
4414 0 0         if ($writestatus eq 'OK') {print"Beep Volume Set to $value sucessfull!\n";}
  0            
4415 0           else {print"Beep Volume set failed: $writestatus\n";}
4416 0           $writestatus = 'ERROR';
4417             }
4418 0           return $writestatus;
4419             }
4420              
4421             ####################
4422              
4423             sub setBeepfreq {
4424 0     0 1   my ($currentbeepfreq) = @_;
4425 0           my $self=shift;
4426 0           my $value=shift;
4427 0 0 0       if ($value == '440' && $value == '880'){
4428 0 0         if($verbose){print "Value invalid: Choose 440/880\n\n";}
  0            
4429 0           return 1;
4430             }
4431 0           $self->setVerbose(0);
4432 0           $currentbeepfreq = $self->getBeepfreq();
4433 0           $self->setVerbose(1);
4434 0 0         if ($currentbeepfreq eq $value) {
4435 0 0         if($verbose){print "Setting $value already selected for Beep Frequency\n\n";}
  0            
4436 0           return 1;
4437             }
4438 0 0         if($value == '440'){$writestatus = $self->writeEeprom('005C','0','0');}
  0            
4439 0 0         if($value == '880'){$writestatus = $self->writeEeprom('005C','0','1');}
  0            
4440 0 0         if ($verbose){
4441 0 0         if ($writestatus eq 'OK') {print"Beep Frequency set to $value sucessfull!\n";}
  0            
4442 0           else {print"Beep Frequency set to $value failed!!!\n";}
4443             }
4444 0           return $writestatus;
4445             }
4446              
4447             # 5D ################################# SET RESUME SCAN, PKT RATE, SCOPE, CW-ID, MAIN STEP, ARTS MODE
4448             ###################################### BIT 0-1, 2, 3, 4, 5, 6-7 FROM ADDRESS 0X5D
4449              
4450             sub setResumescan {
4451 0     0 1   my ($currentresumescan) = @_;
4452 0           my $self=shift;
4453 0           my $value=shift;
4454 0 0 0       if ($value ne 'OFF' && $value ne '3' && $value ne '5' && $value ne '10'){
      0        
      0        
4455 0 0         if($verbose){print "Value invalid: Choose OFF/3/5/10\n\n";}
  0            
4456 0           return 1;
4457             }
4458 0           $self->setVerbose(0);
4459 0           $currentresumescan = $self->getResumescan();
4460 0           $self->setVerbose(1);
4461 0 0         if ($value eq $currentresumescan){
4462 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
4463 0           return 1;
4464             }
4465 0           my $BYTE1 = $self->eepromDecode('005D');
4466 0 0         if ($value eq 'OFF'){substr ($BYTE1, 0, 2, '00');}
  0            
4467 0 0         if ($value eq '3'){substr ($BYTE1, 6, 2, '01');}
  0            
4468 0 0         if ($value eq '5'){substr ($BYTE1, 6, 2, '10');}
  0            
4469 0 0         if ($value eq '10'){substr ($BYTE1, 6, 2, '11');}
  0            
4470 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
4471 0           $writestatus = $self->writeBlock('005D',"$NEWHEX");
4472 0 0         if($verbose){
4473 0 0         if ($writestatus eq 'OK') {print"Resume (SCAN) Set to $value sucessfull!\n";}
  0            
4474 0           else {print"Resume (SCAN) set failed: $writestatus\n";}
4475             }
4476 0           return $writestatus;
4477             }
4478              
4479             ####################
4480              
4481             sub setPktrate {
4482 0     0 1   my ($currentpktrate) = @_;
4483 0           my $self=shift;
4484 0           my $value=shift;
4485 0 0 0       if ($value != '1200' && $value != '9600'){
4486 0 0         if($verbose){print "Value invalid: Choose 1200/9600\n\n";}
  0            
4487 0           return 1;
4488             }
4489 0           $self->setVerbose(0);
4490 0           $currentpktrate = $self->getPktrate();
4491 0           $self->setVerbose(1);
4492 0 0         if ($currentpktrate eq $value) {
4493 0 0         if($verbose){print "Setting $value already selected for PKT Rate\n\n";}
  0            
4494 0           return 1;
4495             }
4496 0 0         if($value == '1200'){$writestatus = $self->writeEeprom('005D','5','0');}
  0            
4497 0 0         if($value == '9600'){$writestatus = $self->writeEeprom('005D','5','1');}
  0            
4498 0 0         if ($verbose){
4499 0 0         if ($writestatus eq 'OK') {print"PKT RATE set to $value sucessfull!\n";}
  0            
4500 0           else {print"PKT RATE set to $value failed!!!\n";}
4501             }
4502 0           return $writestatus;
4503             }
4504              
4505             ####################
4506              
4507             sub setScope {
4508 0     0 1   my ($currentscope) = @_;
4509 0           my $self=shift;
4510 0           my $value=shift;
4511 0 0 0       if ($value ne 'CONT' && $value ne 'CHK'){
4512 0 0         if($verbose){print "Value invalid: Choose CONT/CHK\n\n";}
  0            
4513 0           return 1;
4514             }
4515 0           $self->setVerbose(0);
4516 0           $currentscope = $self->getScope();
4517 0           $self->setVerbose(1);
4518 0 0         if ($currentscope eq $value) {
4519 0 0         if($verbose){print "Setting $value already selected for Scope\n\n";}
  0            
4520 0           return 1;
4521             }
4522 0 0         if($value eq 'CONT'){$writestatus = $self->writeEeprom('005D','4','0');}
  0            
4523 0 0         if($value eq 'CHK'){$writestatus = $self->writeEeprom('005D','4','1');}
  0            
4524 0 0         if ($verbose){
4525 0 0         if ($writestatus eq 'OK') {print"Scope set to $value sucessfull!\n";}
  0            
4526 0           else {print"Scope set to $value failed!!!\n";}
4527             }
4528 0           return $writestatus;
4529             }
4530              
4531             ####################
4532              
4533             sub setCwid {
4534 0     0 1   my ($currentcwid) = @_;
4535 0           my $self=shift;
4536 0           my $value=shift;
4537 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
4538 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
4539 0           return 1;
4540             }
4541 0           $self->setVerbose(0);
4542 0           $currentcwid = $self->getCwid();
4543 0           $self->setVerbose(1);
4544 0 0         if ($currentcwid eq $value) {
4545 0 0         if($verbose){print "Setting $value already selected for CW-ID\n\n";}
  0            
4546 0           return 1;
4547             }
4548 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom('005D','3','0');}
  0            
4549 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom('005D','3','1');}
  0            
4550 0 0         if ($verbose){
4551 0 0         if ($writestatus eq 'OK') {print"CW-ID set to $value sucessfull!\n";}
  0            
4552 0           else {print"CW-ID set to $value failed!!!\n";}
4553             }
4554 0           return $writestatus;
4555             }
4556              
4557             ####################
4558              
4559             sub setMainstep {
4560 0     0 1   my ($currentmainstep) = @_;
4561 0           my $self=shift;
4562 0           my $value=shift;
4563 0 0 0       if ($value ne 'COURSE' && $value ne 'FINE'){
4564 0 0         if($verbose){print "Value invalid: Choose COURSE/FINE\n\n";}
  0            
4565 0           return 1;
4566             }
4567 0           $self->setVerbose(0);
4568 0           $currentmainstep = $self->getMainstep();
4569 0           $self->setVerbose(1);
4570 0 0         if ($currentmainstep eq $value) {
4571 0 0         if($verbose){print "Setting $value already selected for Main Step\n\n";}
  0            
4572 0           return 1;
4573             }
4574 0 0         if($value eq 'FINE'){$writestatus = $self->writeEeprom('005D','2','0');}
  0            
4575 0 0         if($value eq 'COURSE'){$writestatus = $self->writeEeprom('005D','2','1');}
  0            
4576 0 0         if ($verbose){
4577 0 0         if ($writestatus eq 'OK') {print"Main Step set to $value sucessfull!\n";}
  0            
4578 0           else {print"Main Step set to $value failed!!!\n";}
4579             }
4580 0           return $writestatus;
4581             }
4582              
4583             ####################
4584              
4585             sub setArtsmode {
4586 0     0 1   my ($chargebits, $currentartsmode) = @_;
4587 0           my $self=shift;
4588 0           my $value=shift;
4589 0 0 0       if ($value ne 'OFF' && $value ne 'ALL' && $value ne 'RANGE'){
      0        
4590 0 0         if($verbose){print "Value invalid: Choose OFF/ALL/RANGE\n\n";}
  0            
4591 0           return 1;
4592             }
4593 0           $self->setVerbose(0);
4594 0           $currentartsmode = $self->getArtsmode();
4595 0           $self->setVerbose(1);
4596 0 0         if ($value eq $currentartsmode){
4597 0 0         if($verbose){print "Value $currentartsmode already selected.\n\n";}
  0            
4598 0           return 1;
4599             }
4600 0           my $BYTE1 = $self->eepromDecode('005D');
4601 0 0         if ($value eq 'OFF'){substr ($BYTE1, 0, 2, '00');}
  0            
4602 0 0         if ($value eq 'RANGE'){substr ($BYTE1, 0, 2, '01');}
  0            
4603 0 0         if ($value eq 'ALL'){substr ($BYTE1, 0, 2, '10');}
  0            
4604 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
4605 0           $writestatus = $self->writeBlock('005D',"$NEWHEX");
4606 0 0         if($verbose){
4607 0 0         if ($writestatus eq 'OK') {print"ARTS Mode Set to $value sucessfull!\n";}
  0            
4608 0           else {print"ARTS Mode set failed: $writestatus\n";}
4609 0           $writestatus = 'ERROR';
4610             }
4611 0           return $writestatus;
4612             }
4613              
4614             # 5E ################################# SET CWPITCH, LOCK MODE, OP FILTER
4615             ###################################### BIT 0-3, 4-5 6-7 FROM ADDRESS 0X5E
4616              
4617             sub setCwpitch {
4618 0     0 1   my ($currentcwpitch) = @_;
4619 0           my $self=shift;
4620 0           my $value=shift;
4621 0 0 0       if ($value < 300 || $value > 1000){
4622 0 0         if($verbose){print "Value invalid: Choose a number between 300 and 1000\n\n";}
  0            
4623 0           return 1;
4624             }
4625 0           my $testvalue = substr("$value", -2, 2);
4626 0 0 0       if (($testvalue != '00') && ($testvalue !='50')){
4627 0 0         if($verbose){print "Value invalid: Must be in incriments of 50\n\n";}
  0            
4628 0           return 1;
4629             }
4630 0           $self->setVerbose(0);
4631 0           $currentcwpitch = $self->getCwpitch();
4632 0           $self->setVerbose(1);
4633 0 0         if ($value eq $currentcwpitch){
4634 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
4635 0           return 1;
4636             }
4637 0           my $firstvalue = $value;
4638 0           $value = $value - 300;
4639 0           $value = $value / 50;
4640 0           my $binvalue = dec2bin($value);
4641 0           my $BYTE1 = $self->eepromDecode('005E');
4642 0           $binvalue = substr("$binvalue", 4);
4643 0           substr ($BYTE1, 4, 4, "$binvalue");
4644 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
4645 0           $writestatus = $self->writeBlock('005E',"$NEWHEX");
4646 0 0         if($verbose){
4647 0 0         if ($writestatus eq 'OK') {print"CW Pitch set to $firstvalue sucessfull!\n";}
  0            
4648 0           else {print"CW Pitch set failed: $writestatus\n";}
4649             }
4650 0           return $writestatus;
4651             }
4652              
4653             ####################
4654              
4655             sub setLockmode {
4656 0     0 1   my ($currentlockmode) = @_;
4657 0           my $self=shift;
4658 0           my $value=shift;
4659 0 0 0       if ($value ne 'DIAL' && $value ne 'FREQ' && $value ne 'PANEL'){
      0        
4660 0 0         if($verbose){print "Value invalid: Choose DIAL/FREQ/PANEL\n\n";}
  0            
4661 0           return 1;
4662             }
4663 0           $self->setVerbose(0);
4664 0           $currentlockmode = $self->getLockmode();
4665 0           $self->setVerbose(1);
4666 0 0         if ($value eq $currentlockmode){
4667 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
4668 0           return 1;
4669             }
4670 0           my $BYTE1 = $self->eepromDecode('005E');
4671 0 0         if ($value eq 'DIAL'){substr ($BYTE1, 2, 2, '00');}
  0            
4672 0 0         if ($value eq 'FREQ'){substr ($BYTE1, 2, 2, '01');}
  0            
4673 0 0         if ($value eq 'PANEL'){substr ($BYTE1, 2, 2, '10');}
  0            
4674 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
4675 0           $writestatus = $self->writeBlock('005E',"$NEWHEX");
4676 0 0         if($verbose){
4677 0 0         if ($writestatus eq 'OK') {print"Lock Mode Set to $value sucessfull!\n";}
  0            
4678 0           else {print"Lock Mode set failed: $writestatus\n";}
4679             }
4680 0           return $writestatus;
4681             }
4682              
4683             ####################
4684              
4685             sub setOpfilter {
4686 0     0 1   my ($currentopfilter) = @_;
4687 0           my $self=shift;
4688 0           my $value=shift;
4689 0 0 0       if ($value ne 'OFF' && $value ne 'SSB' && $value ne 'CW'){
      0        
4690 0 0         if($verbose){print "Value invalid: Choose OFF/SSB/CW\n\n";}
  0            
4691 0           return 1;
4692             }
4693 0           $self->setVerbose(0);
4694 0           $currentopfilter = $self->getOpfilter();
4695 0           $self->setVerbose(1);
4696 0 0         if ($value eq $currentopfilter){
4697 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
4698 0           return 1;
4699             }
4700 0           my $BYTE1 = $self->eepromDecode('005E');
4701 0 0         if ($value eq 'OFF'){substr ($BYTE1, 0, 2, '00');}
  0            
4702 0 0         if ($value eq 'SSB'){substr ($BYTE1, 0, 2, '01');}
  0            
4703 0 0         if ($value eq 'CW'){substr ($BYTE1, 0, 2, '10');}
  0            
4704 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
4705 0           $writestatus = $self->writeBlock('005E',"$NEWHEX");
4706 0 0         if($verbose){
4707 0 0         if ($writestatus eq 'OK') {print"Optional Filter Set to $value sucessfull!\n";}
  0            
4708 0           else {print"Optional Filter set failed: $writestatus\n";}
4709             }
4710 0           return $writestatus;
4711             }
4712              
4713             # 5F ################################# SETS CW WEIGHT, 430 ARS, 144 ARS, RFKNOB FUNCTION
4714             ###################################### SETS BIT 0-4, 5, 6, 7 FROM ADDRESS 0X5F
4715              
4716             sub setCwweight {
4717 0     0 1   my ($currentcwweight) = @_;
4718 0           my $self=shift;
4719 0           my $value=shift;
4720 0           my $testvalue = $value;
4721 0           $testvalue =~ tr/.//d;
4722 0 0 0       if ($testvalue < 25 || $testvalue > 45){
4723 0 0         if($verbose){print "Value invalid: Choose a number between 2.5 and 4.5\n\n";}
  0            
4724 0           return 1;
4725             }
4726 0           $self->setVerbose(0);
4727 0           $currentcwweight = $self->getCwweight();
4728 0           $self->setVerbose(1);
4729 0           my $testcwweight = join("",'1:',"$value");
4730 0 0         if ($currentcwweight eq $testcwweight){
4731 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
4732 0           return 1;
4733             }
4734 0           my $firstvalue = $value;
4735 0           $value =~ tr/.//d;
4736 0           $value = $value - 25;
4737 0           my $binvalue = dec2bin($value);
4738 0           my $BYTE1 = $self->eepromDecode('005F');
4739 0           $binvalue = substr("$binvalue", 3);
4740 0           substr ($BYTE1, 3, 5, "$binvalue");
4741 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
4742 0           $writestatus = $self->writeBlock('005F',"$NEWHEX");
4743 0 0         if($verbose){
4744 0 0         if ($writestatus eq 'OK') {print"CW Weight set to $firstvalue sucessfull!\n";}
  0            
4745 0           else {print"CW Weight set failed: $writestatus\n";}
4746             }
4747 0           return $writestatus;
4748             }
4749              
4750             ####################
4751              
4752             sub setArs144 {
4753 0     0 1   my ($currentars144) = @_;
4754 0           my $self=shift;
4755 0           my $value=shift;
4756 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
4757 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
4758 0           return 1;
4759             }
4760 0           $self->setVerbose(0);
4761 0           $currentars144 = $self->getArs144();
4762 0           $self->setVerbose(1);
4763 0 0         if ($currentars144 eq $value) {
4764 0 0         if($verbose){print "Setting $value already selected for 144 ARS\n\n";}
  0            
4765 0           return 1;
4766             }
4767 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom('005F','1','0');}
  0            
4768 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom('005F','1','1');}
  0            
4769 0 0         if ($verbose){
4770 0 0         if ($writestatus eq 'OK') {print"144 ARS set to $value sucessfull!\n";}
  0            
4771 0           else {print"144 ARS set to $value failed!!!\n";}
4772             }
4773 0           return $writestatus;
4774             }
4775              
4776             ####################
4777              
4778             sub setArs430 {
4779 0     0 1   my ($currentars430) = @_;
4780 0           my $self=shift;
4781 0           my $value=shift;
4782 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
4783 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
4784 0           return 1;
4785             }
4786 0           $self->setVerbose(0);
4787 0           $currentars430 = $self->getArs430();
4788 0           $self->setVerbose(1);
4789 0 0         if ($currentars430 eq $value) {
4790 0 0         if($verbose){print "Setting $value already selected for 430 ARS\n\n";}
  0            
4791 0           return 1;
4792             }
4793 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom('005F','2','0');}
  0            
4794 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom('005F','2','1');}
  0            
4795 0 0         if ($verbose){
4796 0 0         if ($writestatus eq 'OK') {print"430 ARS set to $value sucessfull!\n";}
  0            
4797 0           else {print"430 ARS set to $value failed!!!\n";}
4798             }
4799 0           return $writestatus;
4800             }
4801              
4802             ####################
4803              
4804             sub setRfknob {
4805 0     0 1   my ($sqlbit, $writestatus,$currentknob) = @_;
4806 0           my $self=shift;
4807 0           my $value=shift;
4808 0 0 0       if ($value ne 'RFGAIN' && $value ne 'SQUELCH'){
4809 0 0         if($verbose){print "Value invalid: Choose RFGAIN/SQUELCH\n\n";}
  0            
4810 0           return 1;
4811             }
4812 0           $self->setVerbose(0);
4813 0           $currentknob = $self->getRfknob();
4814 0           $self->setVerbose(1);
4815 0 0         if ($currentknob eq $value) {
4816 0 0         if($verbose){print "Setting $currentknob already selected for RFGAIN Knob\n\n";}
  0            
4817 0           return 1;
4818             }
4819 0 0         if($value eq 'RFGAIN'){$writestatus = $self->writeEeprom('005F','0','0');}
  0            
4820 0 0         if($value eq 'SQUELCH'){$writestatus = $self->writeEeprom('005F','0','1');}
  0            
4821 0 0         if ($verbose){
4822 0 0         if ($writestatus eq 'OK') {print"RFGAIN Knob set to $value sucessfull!\n";}
  0            
4823 0           else {print"RFGAIN Knob set to $value failed!!!\n";}
4824             }
4825 0           return $writestatus;
4826             }
4827              
4828             # 60 ################################# SET CW DELAY
4829             ###################################### CHANGE BITS 0-7 FROM ADDRESS 0X60
4830              
4831             sub setCwdelay {
4832 0     0 1   my ($currentcwdelay) = @_;
4833 0           my $self=shift;
4834 0           my $value=shift;
4835 0 0 0       if ($value < 10 || $value > 2500){
4836 0 0         if($verbose){print "Value invalid: Choose a number between 10 and 2500\n\n";}
  0            
4837 0           return 1;
4838             }
4839 0           my $testvalue = substr("$value", -1, 1);
4840 0 0         if ($testvalue != '0'){
4841 0 0         if($verbose){print "Value invalid: Must be in incriments of 10\n\n";}
  0            
4842 0           return 1;
4843             }
4844 0           $self->setVerbose(0);
4845 0           $currentcwdelay = $self->getCwdelay();
4846 0           $self->setVerbose(1);
4847 0 0         if ($value eq $currentcwdelay){
4848 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
4849 0           return 1;
4850             }
4851 0           my $firstvalue = $value;
4852 0           $value = $value / 10;
4853 0           my $binvalue = dec2bin($value);
4854 0           my $NEWHEX = sprintf("%X", oct( "0b$binvalue" ) );
4855 0           $writestatus = $self->writeBlock('0060',"$NEWHEX");
4856 0 0         if($verbose){
4857 0 0         if ($writestatus eq 'OK') {print"CW Delay set to $firstvalue sucessfull!\n";}
  0            
4858 0           else {print"CW Delay set failed: $writestatus\n";}
4859             }
4860 0           return $writestatus;
4861             }
4862              
4863             # 61 ################################# SET SIDETONE VOLUME
4864             ###################################### CHANGE BITS 0-6 FROM ADDRESS 0X61
4865              
4866             sub setSidetonevol {
4867 0     0 1   my ($currentsidetonevol) = @_;
4868 0           my $self=shift;
4869 0           my $value=shift;
4870 0 0 0       if ($value < 0 || $value > 100){
4871 0 0         if($verbose){print "Value invalid: Choose a number between 0 and 100\n\n";}
  0            
4872 0           return 1;
4873             }
4874 0 0         if (length($value) == 0){
4875 0 0         if($verbose){print "Value invalid: Choose a number between 0 and 100\n\n";}
  0            
4876 0           return 1;
4877             }
4878 0           $self->setVerbose(0);
4879 0           $currentsidetonevol = $self->getSidetonevol();
4880 0           $self->setVerbose(1);
4881 0 0         if ($value eq $currentsidetonevol){
4882 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
4883 0           return 1;
4884             }
4885 0           my $firstvalue = $value;
4886 0           my $binvalue = dec2bin($value);
4887 0           my $BYTE1 = $self->eepromDecode('0061');
4888 0           $binvalue = substr("$binvalue", 1);
4889 0           substr ($BYTE1, 1, 7, "$binvalue");
4890 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
4891 0           $writestatus = $self->writeBlock('0061',"$NEWHEX");
4892 0 0         if($verbose){
4893 0 0         if ($writestatus eq 'OK') {print"Sidetone Volume set to $firstvalue sucessfull!\n";}
  0            
4894 0           else {print"Sidetone Volume set failed: $writestatus\n";}
4895             }
4896 0           return $writestatus;
4897             }
4898              
4899             # 62 ################################# SET CW SPEED, CHARGETIME
4900             ###################################### CHANGE BITS 0-5, 6-7 FROM ADDRESS 0X62
4901              
4902             sub setCwspeed {
4903 0     0 1   my ($currentcwspeed) = @_;
4904 0           my $self=shift;
4905 0           my $value=shift;
4906 0 0 0       if ($value < 4 || $value > 60){
4907 0 0         if($verbose){print "Value invalid: Choose a number between 4 and 60\n\n";}
  0            
4908 0           return 1;
4909             }
4910 0           $self->setVerbose(0);
4911 0           $currentcwspeed = $self->getCwspeed();
4912 0           $self->setVerbose(1);
4913              
4914 0 0         if ($value eq $currentcwspeed){
4915 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
4916 0           return 1;
4917             }
4918 0           my $firstvalue = $value;
4919 0           $value = $value - 4;
4920 0           my $binvalue = dec2bin($value);
4921 0           my $BYTE1 = $self->eepromDecode('0062');
4922 0           $binvalue = substr("$binvalue", 2);
4923 0           substr ($BYTE1, 2, 6, "$binvalue");
4924 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
4925 0           $writestatus = $self->writeBlock('0062',"$NEWHEX");
4926 0 0         if($verbose){
4927 0 0         if ($writestatus eq 'OK') {print"CW Speed set to $firstvalue sucessfull!\n";}
  0            
4928 0           else {print"CW Speed set failed: $writestatus\n";}
4929             }
4930 0           return $writestatus;
4931             }
4932              
4933             ####################
4934              
4935             sub setChargetime {
4936 0     0 1   my ($chargebits, $writestatus1, $writestatus2, $writestatus3, $writestatus4, $writestatus5, $writestatus6, $changebits, $change7bbit) = @_;
4937 0           my $self=shift;
4938 0           my $value=shift;
4939 0           $output = $self->eepromDecode('0062');
4940 0           $chargebits = substr($output,0,2);
4941 0           print "Checking : ";
4942 0           my $chargerstatus = $self->getCharger();
4943 0 0         if ($chargerstatus eq 'ON'){
4944 0 0         if($verbose){print "Charger is running: You must disable it first before setting an new chargetime.\n\n";}
  0            
4945 0           return 1;
4946             }
4947 0 0         if($debug){print "Currently set at value ($chargebits) at 0x62\n";}
  0            
4948 0 0 0       if ($value != 10 && $value != 6 && $value != 8){
      0        
4949 0 0         if($verbose){print "Time invalid: Use 6 or 8 or 10.\n\n"; }
  0            
4950 0           return 1;
4951             }
4952             else {
4953 0           my $six = '00'; my $eight = '01'; my $ten = '10';
  0            
  0            
4954 0 0 0       if (($value == 6 && $chargebits == $six) ||
      0        
      0        
      0        
      0        
4955             ($value == 8 && $chargebits == $eight) ||
4956             ($value == 10 && $chargebits == $ten)) {
4957 0           print "Current charge time $value already set.\n";
4958 0           return 1;
4959             }
4960             }
4961 0 0         if($debug){print "Writing New BYTES to 0x62\n";}
  0            
4962 0           my $BYTE1 = $self->eepromDecode('0062');
4963 0 0         if ($value == '6'){substr ($BYTE1, 0, 2, '00');}
  0            
4964 0 0         if ($value == '8'){substr ($BYTE1, 0, 2, '01');}
  0            
4965 0 0         if ($value == '10'){substr ($BYTE1, 0, 2, '10');}
  0            
4966 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
4967 0           $writestatus = $self->writeBlock('0062',"$NEWHEX");
4968 0 0         if($debug){print "Writing New BYTES to 0x62\n";}
  0            
4969 0 0         if($debug){print "Writing New BYTES to 0x7b\n";}
  0            
4970 0           $BYTE1 = $self->eepromDecode('007B');
4971 0 0         if ($value == '6'){substr ($BYTE1, 4, 4, '0110');}
  0            
4972 0 0         if ($value == '8'){substr ($BYTE1, 4, 4, '1000');}
  0            
4973 0 0         if ($value == '10'){substr ($BYTE1, 4, 4, '1010');}
  0            
4974 0           $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
4975 0           $writestatus2 = $self->writeBlock('007B',"$NEWHEX");
4976 0 0         if($verbose){
4977 0 0 0       if (($writestatus eq 'OK' && $writestatus2 eq 'OK')) {print"Chargetime Set to $value sucessfull!\n";}
  0            
4978 0           else {print"Chargetime set failed: $writestatus\n";}
4979             }
4980 0           return $writestatus;
4981             }
4982              
4983             # 63 ################################# SET VOX GAIN, AM/FM DIAL
4984             ###################################### CHANGE BITS 0-6,7 FROM ADDRESS 0X63
4985              
4986             sub setVoxgain {
4987 0     0 1   my ($currentvoxgain) = @_;
4988 0           my $self=shift;
4989 0           my $value=shift;
4990 0 0 0       if ($value < 1 || $value > 100){
4991 0 0         if($verbose){print "Value invalid: Choose a number between 0 and 100\n\n";}
  0            
4992 0           return 1;
4993             }
4994 0           $self->setVerbose(0);
4995 0           $currentvoxgain = $self->getVoxgain();
4996 0           $self->setVerbose(1);
4997 0 0         if ($value eq $currentvoxgain){
4998 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
4999 0           return 1;
5000             }
5001 0           my $firstvalue = $value;
5002 0           my $binvalue = dec2bin($value);
5003 0           my $BYTE1 = $self->eepromDecode('0063');
5004 0           $binvalue = substr("$binvalue", 1);
5005 0           substr ($BYTE1, 1, 7, "$binvalue");
5006 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
5007 0           $writestatus = $self->writeBlock('0063',"$NEWHEX");
5008 0 0         if($verbose){
5009 0 0         if ($writestatus eq 'OK') {print"VOX Gain set to $firstvalue sucessfull!\n";}
  0            
5010 0           else {print"VOX Gain set failed: $writestatus\n";}
5011             }
5012 0           return $writestatus;
5013             }
5014              
5015             ####################
5016              
5017             sub setAmfmdial {
5018 0     0 1   my ($currentdial) = @_;
5019 0           my $self=shift;
5020 0           my $value=shift;
5021 0 0 0       if ($value ne 'ENABLE' && $value ne 'DISABLE'){
5022 0 0         if($verbose){print "Value invalid: Choose ENABLE/DISABLE\n\n";}
  0            
5023 0           return 1;
5024             }
5025 0           $self->setVerbose(0);
5026 0           $currentdial = $self->getAmfmdial();
5027 0           $self->setVerbose(1);
5028 0 0         if ($currentdial eq $value) {
5029 0 0         if($verbose){print "Setting $value already selected\n\n";}
  0            
5030 0           return 1;
5031             }
5032 0 0         if($value eq 'ENABLE'){$writestatus = $self->writeEeprom('0063','0','0');}
  0            
5033 0 0         if($value eq 'DISABLE'){$writestatus = $self->writeEeprom('0063','0','1');}
  0            
5034 0 0         if ($verbose){
5035 0 0         if ($writestatus eq 'OK') {print"AM/FM Dial set to $value sucessfull!\n";}
  0            
5036 0           else {print"AM/FM Dial set to $value failed!!!\n";}
5037             }
5038 0           return $writestatus;
5039             }
5040              
5041             # 64 ################################# SET VOX DELAY, EMERGENCY, CAT RATE
5042             ###################################### CHANGE BITS 0-4, 5, 6-7 FROM ADDRESS 0X64
5043              
5044             sub setVoxdelay {
5045 0     0 1   my ($currentvoxdelay) = @_;
5046 0           my $self=shift;
5047 0           my $value=shift;
5048 0 0 0       if ($value < 100 || $value > 2500){
5049 0 0         if($verbose){print "Value invalid: Choose a number between 100 and 2500\n\n";}
  0            
5050 0           return 1;
5051             }
5052 0           my $testvalue = substr("$value", -2, 2);
5053 0 0         if ($testvalue != '00'){
5054 0 0         if($verbose){print "Value invalid: Must be in incriments of 100\n\n";}
  0            
5055 0           return 1;
5056             }
5057 0           $self->setVerbose(0);
5058 0           $currentvoxdelay = $self->getVoxdelay();
5059 0           $self->setVerbose(1);
5060 0 0         if ($value eq $currentvoxdelay){
5061 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
5062 0           return 1;
5063             }
5064 0           my $firstvalue = $value;
5065 0           $value = $value / 100;
5066 0           my $binvalue = dec2bin($value);
5067 0           my $BYTE1 = $self->eepromDecode('0064');
5068 0           $binvalue = substr("$binvalue", 3);
5069 0           substr ($BYTE1, 3, 5, "$binvalue");
5070 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
5071 0           $writestatus = $self->writeBlock('0064',"$NEWHEX");
5072 0 0         if($verbose){
5073 0 0         if ($writestatus eq 'OK') {print"Vox Delay set to $firstvalue sucessfull!\n";}
  0            
5074 0           else {print"Vox Delay set failed: $writestatus\n";}
5075             }
5076 0           return $writestatus;
5077             }
5078              
5079             ####################
5080              
5081             sub setEmergency {
5082 0     0 1   my ($currentemergency) = @_;
5083 0           my $self=shift;
5084 0           my $value=shift;
5085 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
5086 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
5087 0           return 1;
5088             }
5089 0           $self->setVerbose(0);
5090 0           $currentemergency = $self->getEmergency();
5091 0           $self->setVerbose(1);
5092 0 0         if ($value eq $currentemergency){
5093 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
5094 0           return 1;
5095             }
5096 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom('0064','2','1');}
  0            
5097 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom('0064','2','0');}
  0            
5098 0 0         if ($verbose){
5099 0 0         if ($writestatus eq 'OK') {print"Emergency set to $value sucessfull!\n";}
  0            
5100 0           else {print"Emergency set to $value failed!!!\n";}
5101             }
5102 0           return $writestatus;
5103             }
5104              
5105             ####################
5106              
5107             sub setCatrate {
5108 0     0 1   my ($currentcatrate) = @_;
5109 0           my $self=shift;
5110 0           my $value=shift;
5111 0 0 0       if ($value != '4800' && $value != '9600' && $value != '38400'){
      0        
5112 0 0         if($verbose){print "Value invalid: Choose 4800/9600/38400\n\n";}
  0            
5113 0           return 1;
5114             }
5115 0           $self->setVerbose(0);
5116 0           $currentcatrate = $self->getCatrate();
5117 0           $self->setVerbose(1);
5118 0 0         if ($value eq $currentcatrate){
5119 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
5120 0           return 1;
5121             }
5122 0           my $BYTE1 = $self->eepromDecode('0064');
5123 0 0         if ($value == '4800'){substr ($BYTE1, 0, 2, '00');}
  0            
5124 0 0         if ($value == '9600'){substr ($BYTE1, 0, 2, '01');}
  0            
5125 0 0         if ($value == '38400'){substr ($BYTE1, 0, 2, '10');}
  0            
5126 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
5127 0           $writestatus = $self->writeBlock('0064',"$NEWHEX");
5128 0 0         if($verbose){
5129 0 0         if ($writestatus eq 'OK') {print"CAT RATE Set to $value sucessfull!\n";}
  0            
5130 0           else {print"CAT RATE set failed: $writestatus\n";}
5131             }
5132 0           return $writestatus;
5133             }
5134              
5135             # 65 ################################# SET APO TIME , MEM GROUPS , DIG MODE
5136             ###################################### CHANGE BITS 0-2, 4, 5-7 FROM ADDRESS 0X65
5137              
5138             sub setApotime {
5139 0     0 1   my ($currentapotime) = @_;
5140 0           my $self=shift;
5141 0           my $value=shift;
5142 0 0 0       if (($value ne 'OFF') && ($value < 1 || $value > 6)){
      0        
5143 0 0         if($verbose){print "Value invalid: Choose a OFF or number between 1 and 6\n\n";}
  0            
5144 0           return 1;
5145             }
5146 0           $self->setVerbose(0);
5147 0           $currentapotime = $self->getApotime();
5148 0           $self->setVerbose(1);
5149 0 0         if ($value eq $currentapotime){
5150 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
5151 0           return 1;
5152             }
5153 0           my $firstvalue = $value;
5154 0           my $binvalue = dec2bin($value);
5155 0           my $BYTE1 = $self->eepromDecode('0065');
5156 0           $binvalue = substr("$binvalue", 5);
5157 0           substr ($BYTE1, 5, 3, "$binvalue");
5158 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
5159 0           $writestatus = $self->writeBlock('0065',"$NEWHEX");
5160 0 0         if($verbose){
5161 0 0         if ($writestatus eq 'OK') {print"APO Time set to $firstvalue sucessfull!\n";}
  0            
5162 0           else {print"APO Time set failed: $writestatus\n";}
5163             }
5164 0           return $writestatus;
5165             }
5166              
5167             ####################
5168              
5169             sub setMemgroup {
5170 0     0 1   my ($currentmemgroup) = @_;
5171 0           my $self=shift;
5172 0           my $value=shift;
5173 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
5174 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
5175 0           return 1;
5176             }
5177 0           $self->setVerbose(0);
5178 0           $currentmemgroup = $self->getMemgroup();
5179 0           $self->setVerbose(1);
5180 0 0         if ($value eq $currentmemgroup){
5181 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
5182 0           return 1;
5183             }
5184 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom('0065','3','1');}
  0            
5185 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom('0065','3','0');}
  0            
5186 0 0         if ($verbose){
5187 0 0         if ($writestatus eq 'OK') {print"Memory Groups set to $value sucessfull!\n";}
  0            
5188 0           else {print"Memory Groups set to $value failed!!!\n";}
5189             }
5190 0           return $writestatus;
5191             }
5192              
5193             ####################
5194              
5195             sub setDigmode {
5196 0     0 1   my ($currentdigmode) = @_;
5197 0           my $self=shift;
5198 0           my $value=shift;
5199 0 0 0       if ($value ne 'RTTY' && $value ne 'PSK31-L' && $value ne 'PSK31-U' && $value ne 'USER-L' && $value ne 'USER-U'){
      0        
      0        
      0        
5200 0 0         if($verbose){print "Value invalid: Choose RTTY/PSK31-L/PSK31-U/USER-L/USER-U\n\n"; }
  0            
5201 0           return 1;
5202             }
5203 0           $self->setVerbose(0);
5204 0           $currentdigmode = $self->getDigmode();
5205 0           $self->setVerbose(1);
5206 0 0         if ($value eq $currentdigmode){
5207 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
5208 0           return 1;
5209             }
5210 0           my $BYTE1 = $self->eepromDecode('0065');
5211 0 0         if ($value eq 'RTTY'){substr ($BYTE1, 0, 3, '000');}
  0            
5212 0 0         if ($value eq 'PSK31-L'){substr ($BYTE1, 0, 3, '001');}
  0            
5213 0 0         if ($value eq 'PSK31-U'){substr ($BYTE1, 0, 3, '010');}
  0            
5214 0 0         if ($value eq 'USER-L'){substr ($BYTE1, 0, 3, '011');}
  0            
5215 0 0         if ($value eq 'USER-U'){substr ($BYTE1, 0, 3, '100');}
  0            
5216 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
5217 0           $writestatus = $self->writeBlock('0065',"$NEWHEX");
5218 0 0         if($verbose){
5219 0 0         if ($writestatus eq 'OK') {print"Digital Mode Set to $value sucessfull!\n";}
  0            
5220 0           else {print"Digital Mode set failed: $writestatus\n";}
5221             }
5222 0           return $writestatus;
5223             }
5224              
5225             # 66 ################################# SET TOT TIME , DCSINV
5226             ###################################### CHANGE BITS 0-4 6-7 FROM ADDRESS 0X66
5227              
5228             sub setTottime {
5229 0     0 1   my ($currenttottime) = @_;
5230 0           my $self=shift;
5231 0           my $value=shift;
5232 0 0 0       if (($value ne 'OFF') && ($value < 1 || $value > 20)){
      0        
5233 0 0         if($verbose){print "Value invalid: Choose OFF or a number between 1 and 20\n\n";}
  0            
5234 0           return 1;
5235             }
5236 0           $self->setVerbose(0);
5237 0           $currenttottime = $self->getTottime();
5238 0           $self->setVerbose(1);
5239 0 0         if ($value eq $currenttottime){
5240 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
5241 0           return 1;
5242             }
5243 0 0         if ($value eq 'OFF'){$value = 0;}
  0            
5244 0           my $firstvalue = $value;
5245 0           my $binvalue = dec2bin($value);
5246 0           my $BYTE1 = $self->eepromDecode('0066');
5247 0           $binvalue = substr("$binvalue", 3);
5248 0           substr ($BYTE1, 3, 5, "$binvalue");
5249 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
5250 0           $writestatus = $self->writeBlock('0066',"$NEWHEX");
5251 0 0         if($verbose){
5252 0 0         if ($writestatus eq 'OK') {print"Time out Timer set to $firstvalue sucessfull!\n";}
  0            
5253 0           else {print"Time out Timer set failed: $writestatus\n";}
5254             }
5255 0           return $writestatus;
5256             }
5257              
5258             ####################
5259              
5260             sub setDcsinv {
5261 0     0 1   my ($currentdcsinv) = @_;
5262 0           my $self=shift;
5263 0           my $value=shift;
5264 0 0 0       if ($value ne 'TN-RN' && $value ne 'TN-RIV' && $value ne 'TIV-RN' && $value ne 'TIV-RIV'){
      0        
      0        
5265 0 0         if($verbose){print "Value invalid: Choose TN-RN/TN-RIV/TIV-RN/TIV-RIV\n\n"; }
  0            
5266 0           return 1;
5267             }
5268 0           $self->setVerbose(0);
5269 0           $currentdcsinv = $self->getDcsinv();
5270 0           $self->setVerbose(1);
5271 0 0         if ($value eq $currentdcsinv){
5272 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
5273 0           return 1;
5274             }
5275 0           my $BYTE1 = $self->eepromDecode('0066');
5276 0 0         if ($value eq 'TN-RN'){substr ($BYTE1, 0, 2, '00');}
  0            
5277 0 0         if ($value eq 'TN-RIV'){substr ($BYTE1, 0, 2, '01');}
  0            
5278 0 0         if ($value eq 'TIV-RN'){substr ($BYTE1, 0, 2, '10');}
  0            
5279 0 0         if ($value eq 'TIV-RIV'){substr ($BYTE1, 0, 2, '11');}
  0            
5280 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
5281 0           $writestatus = $self->writeBlock('0066',"$NEWHEX");
5282 0 0         if($verbose){
5283 0 0         if ($writestatus eq 'OK') {print"DCS Inversion Set to $value sucessfull!\n";}
  0            
5284 0           else {print"DCS Inversion set failed: $writestatus\n";}
5285             }
5286 0           return $writestatus;
5287             }
5288              
5289             # 67 ################################# SET SSB MIC, MIC SCAN
5290             ###################################### CHANGE BITS 0-6 , 7 FROM ADDRESS 0X67
5291              
5292             sub setSsbmic {
5293 0     0 1   my ($currentssbmic) = @_;
5294 0           my $self=shift;
5295 0           my $value=shift;
5296 0 0 0       if ($value < 0 || $value > 100){
5297 0 0         if($verbose){print "Value invalid: Choose a number between 0 and 100\n\n";}
  0            
5298 0           return 1;
5299             }
5300              
5301 0 0         if (length($value) == 0){
5302 0 0         if($verbose){print "Value invalid: Choose a number between 0 and 100\n\n";}
  0            
5303 0           return 1;
5304             }
5305              
5306 0           $self->setVerbose(0);
5307 0           $currentssbmic = $self->getSsbmic();
5308 0           $self->setVerbose(1);
5309 0 0         if ($value eq $currentssbmic){
5310 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
5311 0           return 1;
5312             }
5313 0           my $firstvalue = $value;
5314 0           my $binvalue = dec2bin($value);
5315 0           my $BYTE1 = $self->eepromDecode('0067');
5316 0           $binvalue = substr("$binvalue", 1);
5317 0           substr ($BYTE1, 1, 7, "$binvalue");
5318 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
5319 0           $writestatus = $self->writeBlock('0067',"$NEWHEX");
5320 0 0         if($verbose){
5321 0 0         if ($writestatus eq 'OK') {print"SSB MIC set to $firstvalue sucessfull!\n";}
  0            
5322 0           else {print"SSB MIC set failed: $writestatus\n";}
5323             }
5324 0           return $writestatus;
5325             }
5326              
5327             ####################
5328              
5329             sub setMicscan {
5330 0     0 1   my ($currentmicscan) = @_;
5331 0           my $self=shift;
5332 0           my $value=shift;
5333 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
5334 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
5335 0           return 1;
5336             }
5337 0           $self->setVerbose(0);
5338 0           $currentmicscan = $self->getMicscan();
5339 0           $self->setVerbose(1);
5340 0 0         if ($value eq $currentmicscan){
5341 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
5342 0           return 1;
5343             }
5344 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom('0067','0','1');}
  0            
5345 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom('0067','0','0');}
  0            
5346 0 0         if ($verbose){
5347 0 0         if ($writestatus eq 'OK') {print"MIC SCAN set to $value sucessfull!\n";}
  0            
5348 0           else {print"MIC SCAN set to $value failed!!!\n";}
5349             }
5350 0           return $writestatus;
5351             }
5352              
5353             # 68 ################################# SET AM MIC, MIC KEY
5354             ###################################### CHANGE BITS 0-6 , 7 FROM ADDRESS 0X68
5355              
5356             sub setAmmic {
5357 0     0 1   my ($currentammic) = @_;
5358 0           my $self=shift;
5359 0           my $value=shift;
5360 0 0 0       if ($value < 0 || $value > 100){
5361 0 0         if($verbose){print "Value invalid: Choose a number between 0 and 100\n\n";}
  0            
5362 0           return 1;
5363             }
5364              
5365 0 0         if (length($value) == 0){
5366 0 0         if($verbose){print "Value invalid: Choose a number between 0 and 100\n\n";}
  0            
5367 0           return 1;
5368             }
5369 0           $self->setVerbose(0);
5370 0           $currentammic = $self->getAmmic();
5371 0           $self->setVerbose(1);
5372 0 0         if ($value eq $currentammic){
5373 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
5374 0           return 1;
5375             }
5376 0           my $firstvalue = $value;
5377 0           my $binvalue = dec2bin($value);
5378 0           my $BYTE1 = $self->eepromDecode('0068');
5379 0           $binvalue = substr("$binvalue", 1);
5380 0           substr ($BYTE1, 1, 7, "$binvalue");
5381 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
5382 0           $writestatus = $self->writeBlock('0068',"$NEWHEX");
5383 0 0         if($verbose){
5384 0 0         if ($writestatus eq 'OK') {print"AM MIC set to $firstvalue sucessfull!\n";}
  0            
5385 0           else {print"AM MIC set failed: $writestatus\n";}
5386             }
5387 0           return $writestatus;
5388             }
5389              
5390             ####################
5391              
5392             sub setMickey {
5393 0     0 1   my ($currentmickey) = @_;
5394 0           my $self=shift;
5395 0           my $value=shift;
5396 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
5397 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
5398 0           return 1;
5399             }
5400 0           $self->setVerbose(0);
5401 0           $currentmickey = $self->getMickey();
5402 0           $self->setVerbose(1);
5403 0 0         if ($value eq $currentmickey){
5404 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
5405 0           return 1;
5406             }
5407 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom('0068','0','1');}
  0            
5408 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom('0068','0','0');}
  0            
5409 0 0         if ($verbose){
5410 0 0         if ($writestatus eq 'OK') {print"MIC KEY set to $value sucessfull!\n";}
  0            
5411 0           else {print"MIC KEY set to $value failed!!!\n";}
5412             }
5413 0           return $writestatus;
5414             }
5415              
5416             # 69 ################################# SET FM MIC
5417             ###################################### CHANGE BITS 0-6 FROM ADDRESS 0X69
5418              
5419             sub setFmmic {
5420 0     0 1   my ($currentfmmic) = @_;
5421 0           my $self=shift;
5422 0           my $value=shift;
5423 0 0 0       if ($value < 0 || $value > 100){
5424 0 0         if($verbose){print "Value invalid: Choose a number between 0 and 100\n\n";}
  0            
5425 0           return 1;
5426             }
5427 0 0         if (length($value) == 0){
5428 0 0         if($verbose){print "Value invalid: Choose a number between 0 and 100\n\n";}
  0            
5429 0           return 1;
5430             }
5431 0           $self->setVerbose(0);
5432 0           $currentfmmic = $self->getFmmic();
5433 0           $self->setVerbose(1);
5434 0 0         if ($value eq $currentfmmic){
5435 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
5436 0           return 1;
5437             }
5438 0           my $firstvalue = $value;
5439 0           my $binvalue = dec2bin($value);
5440 0           my $BYTE1 = $self->eepromDecode('0069');
5441 0           $binvalue = substr("$binvalue", 1);
5442 0           substr ($BYTE1, 1, 7, "$binvalue");
5443 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
5444 0           $writestatus = $self->writeBlock('0069',"$NEWHEX");
5445 0 0         if($verbose){
5446 0 0         if ($writestatus eq 'OK') {print"FM MIC set to $firstvalue sucessfull!\n";}
  0            
5447 0           else {print"FM MIC set failed: $writestatus\n";}
5448             }
5449 0           return $writestatus;
5450             }
5451              
5452             # 6A ################################# SET DIG MIC
5453             ###################################### CHANGE BITS 0-6 FROM ADDRESS 0X6A
5454              
5455             sub setDigmic {
5456 0     0 1   my ($currentdigmic) = @_;
5457 0           my $self=shift;
5458 0           my $value=shift;
5459 0 0 0       if ($value < 0 || $value > 100){
5460 0 0         if($verbose){print "Value invalid: Choose a number between 0 and 100\n\n";}
  0            
5461 0           return 1;
5462             }
5463 0 0         if (length($value) == 0){
5464 0 0         if($verbose){print "Value invalid: Choose a number between 0 and 100\n\n";}
  0            
5465 0           return 1;
5466             }
5467 0           $self->setVerbose(0);
5468 0           $currentdigmic = $self->getDigmic();
5469 0           $self->setVerbose(1);
5470 0 0         if ($value eq $currentdigmic){
5471 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
5472 0           return 1;
5473             }
5474 0           my $firstvalue = $value;
5475 0           my $binvalue = dec2bin($value);
5476 0           my $BYTE1 = $self->eepromDecode('006A');
5477 0           $binvalue = substr("$binvalue", 1);
5478 0           substr ($BYTE1, 1, 7, "$binvalue");
5479 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
5480 0           $writestatus = $self->writeBlock('006A',"$NEWHEX");
5481 0 0         if($verbose){
5482 0 0         if ($writestatus eq 'OK') {print"DIG MIC set to $firstvalue sucessfull!\n";}
  0            
5483 0           else {print"DIG MIC set failed: $writestatus\n";}
5484             }
5485 0           return $writestatus;
5486             }
5487              
5488             # 6B ################################# SET PKT MIC, EXT MENU
5489             ###################################### CHANGE BITS 0-6, 7 FROM ADDRESS 0X6B
5490              
5491             sub setPktmic {
5492 0     0 1   my ($currentpktmic) = @_;
5493 0           my $self=shift;
5494 0           my $value=shift;
5495 0 0 0       if ($value < 0 || $value > 100){
5496 0 0         if($verbose){print "Value invalid: Choose a number between 0 and 100\n\n";}
  0            
5497 0           return 1;
5498             }
5499 0 0         if (length($value) == 0){
5500 0 0         if($verbose){print "Value invalid: Choose a number between 0 and 100\n\n";}
  0            
5501 0           return 1;
5502             }
5503 0           $self->setVerbose(0);
5504 0           $currentpktmic = $self->getPktmic();
5505 0           $self->setVerbose(1);
5506 0 0         if ($value eq $currentpktmic){
5507 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
5508 0           return 1;
5509             }
5510 0           my $firstvalue = $value;
5511 0           my $binvalue = dec2bin($value);
5512 0           my $BYTE1 = $self->eepromDecode('006B');
5513 0           $binvalue = substr("$binvalue", 1);
5514 0           substr ($BYTE1, 1, 7, "$binvalue");
5515 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
5516 0           $writestatus = $self->writeBlock('006B',"$NEWHEX");
5517 0 0         if($verbose){
5518 0 0         if ($writestatus eq 'OK') {print"PKT MIC set to $firstvalue sucessfull!\n";}
  0            
5519 0           else {print"PKT MIC set failed: $writestatus\n";}
5520             }
5521 0           return $writestatus;
5522             }
5523              
5524             ####################
5525              
5526             sub setExtmenu {
5527 0     0 1   my ($currentextmenu) = @_;
5528 0           my $self=shift;
5529 0           my $value=shift;
5530 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
5531 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
5532 0           return 1;
5533             }
5534 0           $self->setVerbose(0);
5535 0           $currentextmenu = $self->getExtmenu();
5536 0           $self->setVerbose(1);
5537 0 0         if ($value eq $currentextmenu){
5538 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
5539 0           return 1;
5540             }
5541 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom('006B','0','1');}
  0            
5542 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom('006B','0','0');}
  0            
5543 0 0         if ($verbose){
5544 0 0         if ($writestatus eq 'OK') {print"EXT MENU set to $value sucessfull!\n";}
  0            
5545 0           else {print"EXT MENU set to $value failed!!!\n";}
5546             }
5547 0           return $writestatus;
5548             }
5549              
5550             # 6C ################################# SET 9600 MIC
5551             ###################################### CHANGE BITS 0-6 FROM ADDRESS 0X6C
5552              
5553             sub set9600mic {
5554 0     0 1   my ($current9600mic) = @_;
5555 0           my $self=shift;
5556 0           my $value=shift;
5557 0 0 0       if ($value < 0 || $value > 100){
5558 0 0         if($verbose){print "Value invalid: Choose a number between 0 and 100\n\n";}
  0            
5559 0           return 1;
5560             }
5561 0 0         if (length($value) == 0){
5562 0 0         if($verbose){print "Value invalid: Choose a number between 0 and 100\n\n";}
  0            
5563 0           return 1;
5564             }
5565 0           $self->setVerbose(0);
5566 0           $current9600mic = $self->get9600mic();
5567 0           $self->setVerbose(1);
5568 0 0         if ($value eq $current9600mic){
5569 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
5570 0           return 1;
5571             }
5572 0           my $firstvalue = $value;
5573 0           my $binvalue = dec2bin($value);
5574 0           my $BYTE1 = $self->eepromDecode('006C');
5575 0           $binvalue = substr("$binvalue", 1);
5576 0           substr ($BYTE1, 1, 7, "$binvalue");
5577 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
5578 0           $writestatus = $self->writeBlock('006C',"$NEWHEX");
5579 0 0         if($verbose){
5580 0 0         if ($writestatus eq 'OK') {print"9600 MIC set to $firstvalue sucessfull!\n";}
  0            
5581 0           else {print"9600 MIC set failed: $writestatus\n";}
5582             }
5583 0           return $writestatus;
5584             }
5585              
5586              
5587             # 6D-6E ################################# SET DIG SHIFT
5588             ###################################### CHANGE ALL BITS FROM ADDRESS 0X6D, 0X6E
5589              
5590             sub setDigshift {
5591 0     0 1   my ($currentdigshift,$polarity,$newvalue,$endvalue,$binvalue,$bin1,$bin2) = @_;
5592 0           my $self=shift;
5593 0           my $value=shift;
5594 0           $polarity = substr ($value,0,1);
5595 0           $newvalue = substr ($value,1);
5596 0           $endvalue = substr ($value,-1,1);
5597 0 0 0       if ($value != '0' && $polarity ne '+' && $polarity ne '-'){
      0        
5598 0 0         if($verbose){print "Value invalid: Choose -3000 to +3000 (needs + or - with number)\n\n";}
  0            
5599 0           return 1;
5600             }
5601 0 0 0       if ($endvalue != '0' || ($newvalue < 0 || $newvalue > 3000)){
      0        
5602 0 0         if($verbose){print "Value invalid: Choose -3000 to +3000 (Multiple of 10)\n\n";}
  0            
5603 0           return 1;
5604             }
5605 0           $self->setVerbose(0);
5606 0           $currentdigshift = $self->getDigshift();
5607 0           $self->setVerbose(1);
5608 0 0         if ($value eq $currentdigshift){
5609 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
5610 0           return 1;
5611             }
5612 0           $newvalue = $newvalue /10;
5613 0 0         if ($polarity eq '-'){$newvalue = 65536 - $newvalue;}
  0            
5614 0           $binvalue = unpack("B32", pack("N", $newvalue));
5615 0           $binvalue = substr $binvalue, -16;
5616 0           $bin1 = substr $binvalue, 0,8;
5617 0           $bin2 = substr $binvalue, 8,8;
5618 0           my $NEWHEX1 = sprintf("%X", oct( "0b$bin1" ) );
5619 0           my $NEWHEX2 = sprintf("%X", oct( "0b$bin2" ) );
5620 0           my $writestatus1 = $self->writeDoubleblock('006D',"$NEWHEX1","$NEWHEX2");
5621 0 0         if ($writestatus1 eq 'OK'){if($verbose){print"DIG SHIFT set to $value sucessfull!\n";}}
  0 0          
  0            
5622 0 0         else {if($verbose){print"DIG SHIFT set to $value failed!!!\n";}}
  0            
5623 0           return $writestatus;
5624             }
5625              
5626             # 6F-70 ################################# SET DIG DISP
5627             ###################################### CHANGE ALL BITS FROM ADDRESS 0X6F, 0X70
5628              
5629             sub setDigdisp {
5630 0     0 1   my ($currentdigdisp,$polarity,$newvalue,$endvalue,$binvalue,$bin1,$bin2) = @_;
5631 0           my $self=shift;
5632 0           my $value=shift;
5633 0           $polarity = substr ($value,0,1);
5634 0           $newvalue = substr ($value,1);
5635 0           $endvalue = substr ($value,-1,1);
5636 0 0 0       if ($value != '0' && $polarity ne '+' && $polarity ne '-'){
      0        
5637 0 0         if($verbose){print "Value invalid: Choose -3000 to +3000 (needs + or - with number)\n\n";}
  0            
5638 0           return 1;
5639             }
5640 0 0 0       if ($endvalue != '0' || ($newvalue < 0 || $newvalue > 3000)){
      0        
5641 0 0         if($verbose){print "Value invalid: Choose -3000 to +3000 (Multiple of 10)\n\n";}
  0            
5642 0           return 1;
5643             }
5644 0           $self->setVerbose(0);
5645 0           $currentdigdisp = $self->getDigdisp();
5646 0           $self->setVerbose(1);
5647 0 0         if ($value eq $currentdigdisp){
5648 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
5649 0           return 1;
5650             }
5651 0           $newvalue = $newvalue /10;
5652 0 0         if ($polarity eq '-'){$newvalue = 65536 - $newvalue;}
  0            
5653 0           $binvalue = unpack("B32", pack("N", $newvalue));
5654 0           $binvalue = substr $binvalue, -16;
5655 0           $bin1 = substr $binvalue, 0,8;
5656 0           $bin2 = substr $binvalue, 8,8;
5657 0           my $NEWHEX1 = sprintf("%X", oct( "0b$bin1" ) );
5658 0           my $NEWHEX2 = sprintf("%X", oct( "0b$bin2" ) );
5659 0           my $writestatus1 = $self->writeDoubleblock('006F',"$NEWHEX1","$NEWHEX2");
5660 0 0         if ($writestatus1 eq 'OK'){if($verbose){print"DIG DISP set to $value sucessfull!\n";}}
  0 0          
  0            
5661 0 0         else {if($verbose){print"DIG DISP set to $value failed!!!\n";}}
  0            
5662 0           return $writestatus;
5663             }
5664              
5665             # 71 ################################# SET R LSB CAR
5666             ###################################### CHANGE ALL BITS FROM ADDRESS 0X71
5667              
5668             sub setRlsbcar {
5669 0     0 1   my ($currentrlsbcar,$polarity,$newvalue,$endvalue,$binvalue,$bin1,$bin2) = @_;
5670 0           my $self=shift;
5671 0           my $value=shift;
5672 0           $polarity = substr ($value,0,1);
5673 0           $newvalue = substr ($value,1);
5674 0           $endvalue = substr ($value,-1,1);
5675 0 0 0       if ($value != '0' && $polarity ne '+' && $polarity ne '-'){
      0        
5676 0 0         if($verbose){print "Value invalid: Choose -300 to +300 (needs + or - with number)\n\n";}
  0            
5677 0           return 1;
5678             }
5679 0 0 0       if ($endvalue != '0' || ($newvalue < 0 || $newvalue > 300)){
      0        
5680 0 0         if($verbose){print "Value invalid: Choose -300 to +300 (Multiple of 10)\n\n";}
  0            
5681 0           return 1;
5682             }
5683 0           $self->setVerbose(0);
5684 0           $currentrlsbcar = $self->getRlsbcar();
5685 0           $self->setVerbose(1);
5686 0 0         if ($value eq $currentrlsbcar){
5687 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
5688 0           return 1;
5689             }
5690 0           $newvalue = $newvalue /10;
5691 0 0         if ($polarity eq '-'){$newvalue = 256 - $newvalue;}
  0            
5692 0           $binvalue = unpack("B32", pack("N", $newvalue));
5693 0           my $NEWHEX1 = sprintf("%X", oct( "0b$binvalue" ) );
5694 0           my $writestatus1 = $self->writeBlock('0071',"$NEWHEX1");
5695 0 0         if ($writestatus1 eq 'OK'){if($verbose){print"R LSB CAR set to $value sucessfull!\n";}}
  0 0          
  0            
5696 0 0         else {if($verbose){print"R LSB CAR set to $value failed!!!\n";}}
  0            
5697 0           return $writestatus;
5698             }
5699              
5700             # 72 ################################# SET R USB CAR
5701             ###################################### CHANGE ALL BITS FROM ADDRESS 0X72
5702              
5703             sub setRusbcar {
5704 0     0 1   my ($currentrusbcar,$polarity,$newvalue,$endvalue,$binvalue,$bin1,$bin2) = @_;
5705 0           my $self=shift;
5706 0           my $value=shift;
5707 0           $polarity = substr ($value,0,1);
5708 0           $newvalue = substr ($value,1);
5709 0           $endvalue = substr ($value,-1,1);
5710 0 0 0       if ($value != '0' && $polarity ne '+' && $polarity ne '-'){
      0        
5711 0 0         if($verbose){print "Value invalid: Choose -300 to +300 (needs + or - with number)\n\n";}
  0            
5712 0           return 1;
5713             }
5714 0 0 0       if ($endvalue != '0' || ($newvalue < 0 || $newvalue > 300)){
      0        
5715 0 0         if($verbose){print "Value invalid: Choose -300 to +300 (Multiple of 10)\n\n";}
  0            
5716 0           return 1;
5717             }
5718 0           $self->setVerbose(0);
5719 0           $currentrusbcar = $self->getRusbcar();
5720 0           $self->setVerbose(1);
5721 0 0         if ($value eq $currentrusbcar){
5722 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
5723 0           return 1;
5724             }
5725 0           $newvalue = $newvalue /10;
5726 0 0         if ($polarity eq '-'){$newvalue = 256 - $newvalue;}
  0            
5727 0           $binvalue = unpack("B32", pack("N", $newvalue));
5728 0           my $NEWHEX1 = sprintf("%X", oct( "0b$binvalue" ) );
5729 0           my $writestatus1 = $self->writeBlock('0072',"$NEWHEX1");
5730 0 0         if ($writestatus1 eq 'OK'){if($verbose){print"R USB CAR set to $value sucessfull!\n";}}
  0 0          
  0            
5731 0 0         else {if($verbose){print"R USB CAR set to $value failed!!!\n";}}
  0            
5732 0           return $writestatus;
5733             }
5734              
5735             # 73 ################################# SET T LSB CAR
5736             ###################################### CHANGE ALL BITS FROM ADDRESS 0X73
5737              
5738             sub setTlsbcar {
5739 0     0 1   my ($currenttlsbcar,$polarity,$newvalue,$endvalue,$binvalue,$bin1,$bin2) = @_;
5740 0           my $self=shift;
5741 0           my $value=shift;
5742 0           $polarity = substr ($value,0,1);
5743 0           $newvalue = substr ($value,1);
5744 0           $endvalue = substr ($value,-1,1);
5745 0 0 0       if ($value != '0' && $polarity ne '+' && $polarity ne '-'){
      0        
5746 0 0         if($verbose){print "Value invalid: Choose -300 to +300 (needs + or - with number)\n\n";}
  0            
5747 0           return 1;
5748             }
5749 0 0 0       if ($endvalue != '0' || ($newvalue < 0 || $newvalue > 300)){
      0        
5750 0 0         if($verbose){print "Value invalid: Choose -300 to +300 (Multiple of 10)\n\n";}
  0            
5751 0           return 1;
5752             }
5753 0           $self->setVerbose(0);
5754 0           $currenttlsbcar = $self->getTlsbcar();
5755 0           $self->setVerbose(1);
5756 0 0         if ($value eq $currenttlsbcar){
5757 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
5758 0           return 1;
5759             }
5760 0           $newvalue = $newvalue /10;
5761 0 0         if ($polarity eq '-'){$newvalue = 256 - $newvalue;}
  0            
5762 0           $binvalue = unpack("B32", pack("N", $newvalue));
5763 0           my $NEWHEX1 = sprintf("%X", oct( "0b$binvalue" ) );
5764 0           my $writestatus1 = $self->writeBlock('0073',"$NEWHEX1");
5765 0 0         if ($writestatus1 eq 'OK'){if($verbose){print"T LSB CAR set to $value sucessfull!\n";}}
  0 0          
  0            
5766 0 0         else {if($verbose){print"T LSB CAR set to $value failed!!!\n";}}
  0            
5767 0           return $writestatus;
5768             }
5769              
5770             # 74 ################################# SET T USB CAR
5771             ###################################### CHANGE ALL BITS FROM ADDRESS 0X74
5772              
5773             sub setTusbcar {
5774 0     0 1   my ($currenttusbcar,$polarity,$newvalue,$endvalue,$binvalue,$bin1,$bin2) = @_;
5775 0           my $self=shift;
5776 0           my $value=shift;
5777 0           $polarity = substr ($value,0,1);
5778 0           $newvalue = substr ($value,1);
5779 0           $endvalue = substr ($value,-1,1);
5780 0 0 0       if ($value != '0' && $polarity ne '+' && $polarity ne '-'){
      0        
5781 0 0         if($verbose){print "Value invalid: Choose -300 to +300 (needs + or - with number)\n\n";}
  0            
5782 0           return 1;
5783             }
5784 0 0 0       if ($endvalue != '0' || ($newvalue < 0 || $newvalue > 300)){
      0        
5785 0 0         if($verbose){print "Value invalid: Choose -300 to +300 (Multiple of 10)\n\n";}
  0            
5786 0           return 1;
5787             }
5788 0           $self->setVerbose(0);
5789 0           $currenttusbcar = $self->getTusbcar();
5790 0           $self->setVerbose(1);
5791 0 0         if ($value eq $currenttusbcar){
5792 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
5793 0           return 1;
5794             }
5795 0           $newvalue = $newvalue /10;
5796 0 0         if ($polarity eq '-'){$newvalue = 256 - $newvalue;}
  0            
5797 0           $binvalue = unpack("B32", pack("N", $newvalue));
5798 0           my $NEWHEX1 = sprintf("%X", oct( "0b$binvalue" ) );
5799 0           my $writestatus1 = $self->writeBlock('0074',"$NEWHEX1");
5800 0 0         if ($writestatus1 eq 'OK'){if($verbose){print"T USB CAR set to $value sucessfull!\n";}}
  0 0          
  0            
5801 0 0         else {if($verbose){print"T USB CAR set to $value failed!!!\n";}}
  0            
5802 0           return $writestatus;
5803             }
5804              
5805             # 79 ################################# SET TXPOWER, PRI, DW, SCN, ARTS ON/OFF
5806             ###################################### CHANGE BITS 0-1, 3, 4, 5-6, 7 FROM ADDRESS 0X79
5807              
5808             sub setTxpower {
5809              
5810 0     0 1   my ($currentpower, $testtxpwr) = @_;
5811 0           my $self=shift;
5812 0           my $value=shift;
5813 0           my %newhash = reverse %TXPWR;
5814 0           ($testtxpwr) = grep { $newhash{$_} eq $value } keys %newhash;
  0            
5815 0 0         if ($testtxpwr eq'') {
5816 0 0         if($verbose){print "\nChoose valid Option : [HIGH/LOW1/LOW2/LOW3]\n\n";}
  0            
5817 0           return 1;
5818             }
5819 0           $self->setVerbose(0);
5820 0           $currentpower = $self->getTxpower();
5821 0           $self->setVerbose(1);
5822 0 0         if ($currentpower eq $value) {
5823 0 0         if($verbose){print "\nValue $value already selected for TX POWER\n\n"; }
  0            
5824 0           return 1;
5825             }
5826 0           my $BYTE1 = $self->eepromDecode('0079');
5827 0           substr ($BYTE1, 6, 2, "$testtxpwr");
5828 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
5829 0           $writestatus = $self->writeBlock('0079',"$NEWHEX");
5830 0 0         if ($verbose){
5831 0 0         if ($writestatus eq 'OK') {print"TX POWER $value set sucessfull!\n";}
  0            
5832 0           else {print"TX POWER $value set failed!!!\n";}
5833             }
5834 0           return $writestatus;
5835             }
5836              
5837             ####################
5838              
5839             sub setPri {
5840 0     0 1   my ($currentpri) = @_;
5841 0           my $self=shift;
5842 0           my $value=shift;
5843 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
5844 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
5845 0           return 1;
5846             }
5847 0           $self->setVerbose(0);
5848 0           $currentpri = $self->getPri();
5849 0           $self->setVerbose(1);
5850              
5851 0 0         if ($value eq $currentpri){
5852 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
5853 0           return 1;
5854             }
5855 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom('0079','3','1');}
  0            
5856 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom('0079','3','0');}
  0            
5857 0 0         if ($verbose){
5858 0 0         if ($writestatus eq 'OK') {print"PRI set to $value sucessfull!\n";}
  0            
5859 0           else {print"PRI set to $value failed!!!\n";}
5860             }
5861 0           return $writestatus;
5862             }
5863              
5864             ####################
5865              
5866             sub setDw {
5867 0     0 1   my ($currentdw) = @_;
5868 0           my $self=shift;
5869 0           my $value=shift;
5870 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
5871 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
5872 0           return 1;
5873             }
5874 0           $self->setVerbose(0);
5875 0           $currentdw = $self->getDw();
5876 0           $self->setVerbose(1);
5877 0 0         if ($value eq $currentdw){
5878 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
5879 0           return 1;
5880             }
5881 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom('0079','4','1');}
  0            
5882 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom('0079','4','0');}
  0            
5883 0 0         if ($verbose){
5884 0 0         if ($writestatus eq 'OK') {print"DW set to $value sucessfull!\n";}
  0            
5885 0           else {print"DW set to $value failed!!!\n";}
5886             }
5887 0           return $writestatus;
5888             }
5889              
5890             ####################
5891              
5892             sub setScn {
5893 0     0 1   my ($currentscn) = @_;
5894 0           my $self=shift;
5895 0           my $value=shift;
5896 0 0 0       if ($value ne 'OFF' && $value ne 'UP' && $value ne 'DOWN'){
      0        
5897 0 0         if($verbose){print "Value invalid: Choose OFF/UP/DOWN\n\n";}
  0            
5898 0           return 1;
5899             }
5900 0           $self->setVerbose(0);
5901 0           $currentscn = $self->getScn();
5902 0           $self->setVerbose(1);
5903 0 0         if ($value eq $currentscn){
5904 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
5905 0           return 1;
5906             }
5907 0           my $BYTE1 = $self->eepromDecode('0079');
5908 0 0         if ($value eq 'OFF'){substr ($BYTE1, 1, 2, '00');}
  0            
5909 0 0         if ($value eq 'UP'){substr ($BYTE1, 1, 2, '10');}
  0            
5910 0 0         if ($value eq 'DOWN'){substr ($BYTE1, 1, 2, '11');}
  0            
5911 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
5912 0           $writestatus = $self->writeBlock('0079',"$NEWHEX");
5913 0 0         if($verbose){
5914 0 0         if ($writestatus eq 'OK') {print"SCN Set to $value sucessfull!\n";}
  0            
5915 0           else {print"SCN Inversion set failed: $writestatus\n";}
5916             }
5917 0           return $writestatus;
5918             }
5919              
5920             ####################
5921              
5922             sub setArts {
5923 0     0 1   my ($currentarts, $writestatus) = @_;
5924 0           my $self=shift;
5925 0           my $value=shift;
5926 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
5927 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
5928 0           return 1;
5929             }
5930 0           $self->setVerbose(0);
5931 0           $currentarts = $self->getArts();
5932 0           $self->setVerbose(1);
5933              
5934 0 0         if ($value eq $currentarts){
5935 0 0         if($verbose){print "Value $currentarts already selected.\n\n";}
  0            
5936 0           return 1;
5937             }
5938 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom('0079','0','1');}
  0            
5939 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom('0079','0','0');}
  0            
5940 0 0         if ($verbose){
5941 0 0         if ($writestatus eq 'OK') {print"ARTS set to $value sucessfull!\n";}
  0            
5942 0           else {print"ARTS set to $value failed!!!\n";}
5943             }
5944 0           return $writestatus;
5945             }
5946              
5947             # 7a ################################# SET ANTENNA FRONT/BACK, SPL
5948             ###################################### CHANGE BITS 0-5, 7 FROM ADDRESS 0X7A
5949              
5950             sub setAntenna {
5951 0     0 1   my ($currentantenna, $antennabit) = @_;
5952 0           my $self=shift;
5953 0           my $value=shift;
5954 0           my $value2=shift;
5955              
5956 0 0 0       if ($value ne 'HF' && $value ne '6M' && $value ne 'FMBCB' && $value ne 'AIR' && $value ne 'VHF' && $value ne 'UHF'){
      0        
      0        
      0        
      0        
5957 0 0         if($verbose){print "Value invalid: Choose HF/6M/FMBCB/AIR/VHF/UHV\n\n"; }
  0            
5958 0           return 1;
5959             }
5960              
5961 0 0 0       if ($value2 ne 'FRONT' && $value2 ne 'BACK'){
5962 0 0         if($verbose){print "Value invalid: Choose FRONT/BACK\n\n"; }
  0            
5963 0           return 1;
5964             }
5965 0           $self->setVerbose(0);
5966 0           $currentantenna = $self->getAntenna("$value");
5967 0           $self->setVerbose(1);
5968 0 0         if ($currentantenna eq $value2) {
5969 0 0         if($verbose){print "\nAntenna for $value is already set to $value2\n\n"; }
  0            
5970 0           return 1;
5971             }
5972 0           my $valuelabel = $value2;
5973 0 0         if ($value2 eq 'BACK'){$value2 = 1;}
  0            
5974 0 0         if ($value2 eq 'FRONT'){$value2 = 0;}
  0            
5975 0 0         if ($value eq 'HF'){$antennabit = 7;}
  0            
5976 0 0         if ($value eq '6M'){$antennabit = 6;}
  0            
5977 0 0         if ($value eq 'FMBCB'){$antennabit = 5;}
  0            
5978 0 0         if ($value eq 'AIR'){$antennabit = 4;}
  0            
5979 0 0         if ($value eq 'VHF'){$antennabit = 3;}
  0            
5980 0 0         if ($value eq 'UHF'){$antennabit = 2;}
  0            
5981 0           $writestatus = $self->writeEeprom('007A',"$antennabit","$value2");
5982 0 0 0       if($verbose && $writestatus eq 'OK'){print "\nAntenna for $value set to $valuelabel: $writestatus\n\n"; }
  0            
5983 0 0 0       if($verbose && $writestatus ne 'OK'){print "\nError setting antenna: $writestatus\n\n"; }
  0            
5984 0           return $writestatus;
5985             }
5986              
5987             ####################
5988              
5989             sub setSpl {
5990 0     0 1   my ($currentspl) = @_;
5991 0           my $self=shift;
5992 0           my $value=shift;
5993 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
5994 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n"; }
  0            
5995 0           return 1;
5996             }
5997 0           $self->setVerbose(0);
5998 0           $currentspl = $self->getSpl();
5999 0           $self->setVerbose(1);
6000 0 0         if ($value eq $currentspl){
6001 0 0         if($verbose){print "Value $value already selected.\n\n"; }
  0            
6002 0           return 1;
6003             }
6004 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom('007A','0','1');}
  0            
6005 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom('007A','0','0');}
  0            
6006 0 0         if ($verbose){
6007 0 0         if ($writestatus eq 'OK') {print"SPL set to $value sucessfull!\n";}
  0            
6008 0           else {print"SPL set to $value failed!!!\n";}
6009             }
6010 0           return $writestatus;
6011             }
6012              
6013             # 7b ################################# SET CHARGER ON/OFF
6014             ###################################### CHANGE BITS 6-7 FROM ADDRESS 0X7b
6015              
6016             sub setCharger {
6017 0     0 1   my $self=shift;
6018 0           my $value=shift;
6019 0           my $chargerstatus = $self->getCharger();
6020 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
6021 0 0         if($verbose){print "Value invalid: Use ON or OFF.\n\n";}
  0            
6022              
6023 0           return 1;
6024             }
6025 0 0         if ($chargerstatus eq $value){
6026 0 0         if($verbose){print "Staying $value\n";}
  0            
6027 0           return 1;
6028             }
6029             else {
6030 0 0         if($verbose){print "Turning $value\n";}
  0            
6031 0 0         if ($value eq 'OFF'){$writestatus = $self->writeEeprom('007B','3','0');}
  0            
6032 0 0         if ($value eq 'ON'){$writestatus = $self->writeEeprom('007B','3','1');}
  0            
6033 0           return 0;
6034             }
6035 0           return 1;
6036             }
6037              
6038             # 7D - 388, 40B - 44E ################################# SET VFO MEM ######
6039             ############################################
6040              
6041             sub writeMemvfo {
6042 0     0 1   my ($testvfoband, $address, $address2, $address3, $address4, $testoptions, $base, %baseaddress, $musttoggle ,$offset, $startaddress, $fmstep, $amstep, $ctcsstone, $dcscode, $polarity, $newvalue) = @_;
6043 0           my $self=shift;
6044 0           my $vfo=shift;
6045 0           my $band=shift;
6046 0           my $option=shift;
6047 0           my $value=shift;
6048 0 0         if($vfo eq 'MTQMB'){$vfo = 'A'; $band = 'MTQMB';}
  0            
  0            
6049 0 0         if($vfo eq 'MTUNE'){$vfo = 'A'; $band = 'MTUNE';}
  0            
  0            
6050 0 0 0       if ($vfo ne 'A' && $vfo ne 'B'){
6051 0 0         if($verbose){print "Value invalid: Choose A/B\n\n";}
  0            
6052 0           return 1;
6053             }
6054 0           $band = uc($band);
6055 0           $option = uc($option);
6056 0           my %newhash = reverse %VFOBANDS;
6057 0           ($testvfoband) = grep { $newhash{$_} eq $band } keys %newhash;
  0            
6058 0 0         if ($testvfoband eq'') {
6059 0 0 0       if ($band ne 'MTQMB' && $band ne 'MTUNE'){
6060 0 0         if($verbose){print "\nChoose valid Band : [160M/75M/40M/30M/20M/17M/15M/12M/10M/6M/2M/70CM/FMBC/AIR/PHAN]\n\n";}
  0            
6061 0           return 1;
6062             }
6063             }
6064 0           my %testhash = reverse %VFOMEMOPTS;
6065 0           ($testoptions) = grep { $testhash{$_} eq $option } keys %testhash;
  0            
6066 0 0         if (!$testoptions){
6067 0 0         if($verbose){
6068 0           print "Choose a valid option\.\n\n";
6069 0           my $columns = 1;
6070 0           foreach my $options (sort keys %testhash) {
6071 0           printf "%-15s %s",$testhash{$options};
6072 0           $columns++;
6073 0 0         if ($columns == 7){print "\n\n"; $columns = 1;}
  0            
  0            
6074             }
6075 0           print "\n\n";
6076 0           return 1;
6077             }
6078             }
6079 0 0 0       if ($value != '0' && !$value){
6080 0 0         if($verbose){print "A Value must be given\n\n";}
  0            
6081 0           return 1;
6082             }
6083 0           $self->setVerbose(0);
6084 0           my $currentvfo = $self->getVfo();
6085 0           $self->setVerbose(1);
6086 0 0         if ($currentvfo eq $vfo) {$musttoggle = 'TRUE';}
  0            
6087 0 0         if ($vfo eq 'A'){%baseaddress = reverse %VFOABASE;}
  0            
6088 0 0         if ($vfo eq 'B'){%baseaddress = reverse %VFOBBASE;}
  0            
6089 0           ($base) = grep { $baseaddress{$_} eq $band } keys %baseaddress;
  0            
6090              
6091             ############## MODE
6092 0 0         if ($option eq 'MODE') {
6093 0           my ($currentmode) = @_;
6094 0           $self->setVerbose(0);
6095 0           $currentmode = $self->readMemvfo("$vfo","$band","$option");
6096 0           $self->setVerbose(1);
6097 0 0         if ($value eq $currentmode){
6098 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
6099 0           return 1;
6100             }
6101 0           $offset=0x00;
6102 0           $address = $self->hexAdder("$offset","$base");
6103 0           my $mode;
6104 0           my %modehash = reverse %MEMMODES;
6105 0           ($mode) = grep { $modehash{$_} eq $value } keys %modehash;
  0            
6106 0 0         if (!$mode){
6107 0 0         if($verbose){
6108 0           print "\nInvalid Option. Choose from the following\n\n";
6109 0           my $columns = 1;
6110 0           foreach my $codes (sort keys %modehash) {
6111 0           printf "%-15s %s",$modehash{$codes};
6112 0           $columns++;
6113 0 0         if ($columns == 7){print "\n\n"; $columns = 1;}
  0            
  0            
6114             }
6115 0           print "\n\n";
6116             }
6117 0           return 1;
6118             }
6119 0           my $BYTE1 = $self->eepromDecode("$address");
6120 0           substr ($BYTE1, 5, 3, "$mode");
6121 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
6122 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6123 0           $writestatus = $self->writeBlock("$address","$NEWHEX");
6124 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6125 0 0         if($verbose){
6126 0 0         if ($writestatus eq 'OK') {print"MODE Set to $option sucessfull!\n";}
  0            
6127 0           else {print"MODE set failed: $writestatus\n";}
6128             }
6129 0           return $writestatus;
6130             }
6131              
6132             ############## NARFM
6133              
6134 0 0         if ($option eq 'NARFM') {
6135 0           my ($currentnarfm) = @_;
6136 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
6137 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
6138 0           return 1;
6139             }
6140 0           $self->setVerbose(0);
6141 0           $currentnarfm = $self->readMemvfo("$vfo","$band","$option");
6142 0           $self->setVerbose(1);
6143 0 0         if ($value eq $currentnarfm){
6144 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
6145 0           return 1;
6146             }
6147 0           $offset=0x01;
6148 0           $address = $self->hexAdder("$offset","$base");
6149 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6150 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom("$address",'4','1');}
  0            
6151 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom("$address",'4','0');}
  0            
6152 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6153 0 0         if ($verbose){
6154 0 0         if ($writestatus eq 'OK') {print"NAR FM set to $value sucessfull!\n";}
  0            
6155 0           else {print"NAR FM set to $value failed!!!\n";}
6156             }
6157 0           return $writestatus;
6158             }
6159              
6160             ############## NARCWDIG
6161              
6162 0 0         if ($option eq 'NARCWDIG') {
6163 0           my ($currentnarcwdig) = @_;
6164 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
6165 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
6166 0           return 1;
6167             }
6168 0           $self->setVerbose(0);
6169 0           $currentnarcwdig = $self->readMemvfo("$vfo","$band","$option");
6170 0           $self->setVerbose(1);
6171 0 0         if ($value eq $currentnarcwdig){
6172 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
6173 0           return 1;
6174             }
6175 0           $offset=0x01;
6176 0           $address = $self->hexAdder("$offset","$base");
6177 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6178 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom("$address",'3','1');}
  0            
6179 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom("$address",'3','0');}
  0            
6180 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6181 0 0         if ($verbose){
6182 0 0         if ($writestatus eq 'OK') {print"NAR CW DIG set to $value sucessfull!\n";}
  0            
6183 0           else {print"NAR CW DIG set to $value failed!!!\n";}
6184             }
6185 0           return $writestatus;
6186             }
6187              
6188             ############## RPTOFFSET
6189              
6190 0 0         if ($option eq 'RPTOFFSET') {
6191 0           my ($currentrptoffset) = @_;
6192 0 0 0       if ($value ne 'SIMPLEX' && $value ne 'MINUS' && $value ne 'PLUS' && $value ne 'NON-STANDARD'){
      0        
      0        
6193 0 0         if($verbose){print "Value invalid: Choose SIMPLEX/MINUS/PLUS/NON-STANDARD\n\n";}
  0            
6194 0           return 1;
6195             }
6196 0           $self->setVerbose(0);
6197 0           $currentrptoffset = $self->readMemvfo("$vfo","$band","$option");
6198 0           $self->setVerbose(1);
6199 0 0         if ($value eq $currentrptoffset){
6200 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
6201 0           return 1;
6202             }
6203 0           $offset=0x01;
6204 0           $address = $self->hexAdder("$offset","$base");
6205 0           my $BYTE1 = $self->eepromDecode("$address");
6206 0 0         if ($value eq 'SIMPLEX'){substr ($BYTE1, 0, 2, '00');}
  0            
6207 0 0         if ($value eq 'MINUS'){substr ($BYTE1, 0, 2, '01');}
  0            
6208 0 0         if ($value eq 'PLUS'){substr ($BYTE1, 0, 2, '10');}
  0            
6209 0 0         if ($value eq 'NON-STANDARD'){substr ($BYTE1, 0, 2, '11');}
  0            
6210 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
6211 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6212 0           $writestatus = $self->writeBlock("$address","$NEWHEX");
6213 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6214 0 0         if($verbose){
6215 0 0         if ($writestatus eq 'OK') {print"RPTOFFSET Set to $value sucessfull!\n";}
  0            
6216 0           else {print"RPT OFFSET set failed: $writestatus\n";}
6217             }
6218 0           return $writestatus;
6219             }
6220              
6221             ############## TONEDCS
6222              
6223 0 0         if ($option eq 'TONEDCS') {
6224 0           my ($currenttonedcs) = @_;
6225 0 0 0       if ($value ne 'OFF' && $value ne 'TONE' && $value ne 'TONETSQ' && $value ne 'DCS'){
      0        
      0        
6226 0 0         if($verbose){print "Value invalid: Choose OFF/TONE/TONETSQ/DCS\n\n"; }
  0            
6227 0           return 1;
6228             }
6229 0           $self->setVerbose(0);
6230 0           $currenttonedcs = $self->readMemvfo("$vfo","$band","$option");
6231 0           $self->setVerbose(1);
6232 0 0         if ($value eq $currenttonedcs){
6233 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
6234 0           return 1;
6235             }
6236 0           $offset=0x04;
6237 0           $address = $self->hexAdder("$offset","$base");
6238 0           my $BYTE1 = $self->eepromDecode("$address");
6239 0 0         if ($value eq 'OFF'){substr ($BYTE1, 6, 2, '00');}
  0            
6240 0 0         if ($value eq 'TONE'){substr ($BYTE1, 6, 2, '01');}
  0            
6241 0 0         if ($value eq 'TONETSQ'){substr ($BYTE1, 6, 2, '10');}
  0            
6242 0 0         if ($value eq 'DCS'){substr ($BYTE1, 6, 2, '11');}
  0            
6243 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
6244 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6245 0           $writestatus = $self->writeBlock("$address","$NEWHEX");
6246 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6247 0 0         if($verbose){
6248 0 0         if ($writestatus eq 'OK') {print"TONEDCS Set to $value sucessfull!\n";}
  0            
6249 0           else {print"TONEDCS set failed: $writestatus\n";}
6250             }
6251 0           return $writestatus;
6252             }
6253              
6254             ############## CLARIFTER
6255              
6256 0 0         if ($option eq 'CLARIFIER') {
6257 0           my ($currentclarifier) = @_;
6258 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
6259 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
6260 0           return 1;
6261             }
6262 0           $self->setVerbose(0);
6263 0           $currentclarifier = $self->readMemvfo("$vfo","$band","$option");
6264 0           $self->setVerbose(1);
6265 0 0         if ($value eq $currentclarifier){
6266 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
6267 0           return 1;
6268             }
6269 0           $offset=0x02;
6270 0           $address = $self->hexAdder("$offset","$base");
6271 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6272 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom("$address",'1','1');}
  0            
6273 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom("$address",'1','0');}
  0            
6274 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6275 0 0         if ($verbose){
6276 0 0         if ($writestatus eq 'OK') {print"CLARIFIER set to $value sucessfull!\n";}
  0            
6277 0           else {print"CLARIFIER set to $value failed!!!\n";}
6278             }
6279 0           return $writestatus;
6280             }
6281              
6282             ############## ATT
6283              
6284 0 0         if ($option eq 'ATT'){
6285 0           my ($currentatt) = @_;
6286 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
6287 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
6288 0           return 1;
6289             }
6290 0           $self->setVerbose(0);
6291 0           $currentatt = $self->readMemvfo("$vfo","$band","$option");
6292 0           $self->setVerbose(1);
6293 0 0         if ($value eq $currentatt){
6294 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
6295 0           return 1;
6296             }
6297 0           $offset=0x02;
6298 0           $address = $self->hexAdder("$offset","$base");
6299 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6300 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom("$address",'3','1');}
  0            
6301 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom("$address",'3','0');}
  0            
6302 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6303 0 0         if ($verbose){
6304 0 0         if ($writestatus eq 'OK') {print"ATT set to $value sucessfull!\n";}
  0            
6305 0           else {print"ATT set to $value failed!!!\n";}
6306             }
6307 0           return $writestatus;
6308             }
6309              
6310             ############## IPO
6311              
6312 0 0         if ($option eq 'IPO') {
6313 0           my ($currentipo) = @_;
6314 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
6315 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
6316 0           return 1;
6317             }
6318 0           $self->setVerbose(0);
6319 0           $currentipo = $self->readMemvfo("$vfo","$band","$option");
6320 0           $self->setVerbose(1);
6321 0 0         if ($value eq $currentipo){
6322 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
6323 0           return 1;
6324             }
6325 0           $offset=0x02;
6326 0           $address = $self->hexAdder("$offset","$base");
6327 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6328 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom("$address",'2','1');}
  0            
6329 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom("$address",'2','0');}
  0            
6330 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6331 0 0         if ($verbose){
6332 0 0         if ($writestatus eq 'OK') {print"IPO set to $value sucessfull!\n";}
  0            
6333 0           else {print"IPO set to $value failed!!!\n";}
6334             }
6335 0           return $writestatus;
6336             }
6337              
6338             ############## FM STEP
6339              
6340 0 0         if ($option eq 'FMSTEP') {
6341 0           my ($currentfmstep) = @_;
6342 0           $self->setVerbose(0);
6343 0           $currentfmstep = $self->readMemvfo("$vfo","$band","$option");
6344 0           $self->setVerbose(1);
6345 0 0         if ($value eq $currentfmstep){
6346 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
6347 0           return 1;
6348             }
6349 0           $offset=0x03;
6350 0           $address = $self->hexAdder("$offset","$base");
6351 0           my $fmstep;
6352 0           my %fmstephash = reverse %FMSTEP;
6353 0           ($fmstep) = grep { $fmstephash{$_} eq $value } keys %fmstephash;
  0            
6354 0 0         if (!$fmstep){
6355 0 0         if($verbose){
6356 0           print "\nInvalid Option. Choose from the following\n\n";
6357 0           my $columns = 1;
6358 0           foreach my $codes (sort keys %fmstephash) {
6359 0           printf "%-15s %s",$fmstephash{$codes};
6360 0           $columns++;
6361 0 0         if ($columns == 7){print "\n\n"; $columns = 1;}
  0            
  0            
6362             }
6363 0           print "\n\n";
6364             }
6365 0           return 1;
6366             }
6367 0           my $BYTE1 = $self->eepromDecode("$address");
6368 0           substr ($BYTE1, 5, 3, "$fmstep");
6369 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
6370 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6371 0           $writestatus = $self->writeBlock("$address","$NEWHEX");
6372 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6373 0 0         if($verbose){
6374 0 0         if ($writestatus eq 'OK') {print"FM STEP Set to $option sucessfull!\n";}
  0            
6375 0           else {print"FM STEP set failed: $writestatus\n";}
6376             }
6377 0           return $writestatus;
6378             }
6379              
6380             ############## AM STEP
6381              
6382 0 0         if ($option eq 'AMSTEP') {
6383 0           my ($currentamstep) = @_;
6384 0           $self->setVerbose(0);
6385 0           $currentamstep = $self->readMemvfo("$vfo","$band","$option");
6386 0           $self->setVerbose(1);
6387 0 0         if ($value eq $currentamstep){
6388 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
6389 0           return 1;
6390             }
6391 0           $offset=0x03;
6392 0           $address = $self->hexAdder("$offset","$base");
6393 0           my $amstep;
6394 0           my %amstephash = reverse %AMSTEP;
6395 0           ($amstep) = grep { $amstephash{$_} eq $value } keys %amstephash;
  0            
6396 0 0         if (!$amstep){
6397 0 0         if($verbose){
6398 0           print "\nInvalid Option. Choose from the following\n\n";
6399 0           my $columns = 1;
6400 0           foreach my $codes (sort keys %amstephash) {
6401 0           printf "%-15s %s",$amstephash{$codes};
6402 0           $columns++;
6403 0 0         if ($columns == 7){print "\n\n"; $columns = 1;}
  0            
  0            
6404             }
6405 0           print "\n\n";
6406             }
6407 0           return 1;
6408             }
6409 0           my $BYTE1 = $self->eepromDecode("$address");
6410 0           substr ($BYTE1, 2, 3, "$amstep");
6411 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
6412 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6413 0           $writestatus = $self->writeBlock("$address","$NEWHEX");
6414 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6415 0 0         if($verbose){
6416 0 0         if ($writestatus eq 'OK') {print"AM STEP Set to $option sucessfull!\n";}
  0            
6417 0           else {print"AM STEP set failed: $writestatus\n";}
6418             }
6419 0           return $writestatus;
6420             }
6421              
6422             ############## SSB STEP
6423              
6424 0 0         if ($option eq 'SSBSTEP') {
6425 0           my ($currentssbstep) = @_;
6426 0 0 0       if ($value ne '1.0' && $value ne '2.5' && $value ne '5.0'){
      0        
6427 0 0         if($verbose){print "Value invalid: Choose 1.0/2.5/5.0\n\n"; }
  0            
6428 0           return 1;
6429             }
6430 0           $self->setVerbose(0);
6431 0           $currentssbstep = $self->readMemvfo("$vfo","$band","$option");
6432 0           $self->setVerbose(1);
6433 0 0         if ($value eq $currentssbstep){
6434 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
6435 0           return 1;
6436             }
6437 0           $offset=0x03;
6438 0           $address = $self->hexAdder("$offset","$base");
6439 0           my $BYTE1 = $self->eepromDecode("$address");
6440 0 0         if ($value eq '1.0'){substr ($BYTE1, 0, 2, '00');}
  0            
6441 0 0         if ($value eq '2.5'){substr ($BYTE1, 0, 2, '01');}
  0            
6442 0 0         if ($value eq '5.0'){substr ($BYTE1, 0, 2, '10');}
  0            
6443 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
6444 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6445 0           $writestatus = $self->writeBlock("$address","$NEWHEX");
6446 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6447 0 0         if($verbose){
6448 0 0         if ($writestatus eq 'OK') {print"SSB STEP Set to $value sucessfull!\n";}
  0            
6449 0           else {print"SSB STEP set failed: $writestatus\n";}
6450             }
6451 0           return $writestatus;
6452             }
6453              
6454             ############## CTCSSTONE
6455            
6456 0 0         if ($option eq 'CTCSSTONE') {
6457 0           my ($currenttone) = @_;
6458 0           $self->setVerbose(0);
6459 0           $currenttone = $self->readMemvfo("$vfo","$band","$option");
6460 0           $self->setVerbose(1);
6461 0 0         if ($value eq $currenttone){
6462 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
6463 0           return 1;
6464             }
6465 0           $offset=0x06;
6466 0           $address = $self->hexAdder("$offset","$base");
6467 0           my $ctcsstone;
6468 0           my %tonehash = reverse %CTCSSTONES;
6469 0           ($ctcsstone) = grep { $CTCSSTONES{$_} eq $value } keys %CTCSSTONES;
  0            
6470 0 0         if (!$ctcsstone){
6471 0 0         if($verbose){
6472 0           print "\nInvalid Option. Choose from the following\n\n";
6473 0           my $columns = 1;
6474 0           foreach my $tones (sort keys %CTCSSTONES) {
6475 0           printf "%-15s %s",$CTCSSTONES{$tones};
6476 0           $columns++;
6477 0 0         if ($columns == 7){print "\n\n"; $columns = 1;}
  0            
  0            
6478             }
6479 0           print "\n\n";
6480             }
6481 0           return 1;
6482             }
6483 0           my $BYTE1 = $self->eepromDecode("$address");
6484 0           substr ($BYTE1, 2, 6, "$ctcsstone");
6485 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
6486 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6487 0           $writestatus = $self->writeBlock("$address","$NEWHEX");
6488 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6489 0 0         if($verbose){
6490 0 0         if ($writestatus eq 'OK') {print"CTCSS TONE Set to $option sucessfull!\n";}
  0            
6491 0           else {print"CTCSS TONE set failed: $writestatus\n";}
6492             }
6493 0           return $writestatus;
6494             }
6495              
6496             ############## DCSCODE
6497              
6498 0 0         if ($option eq 'DCSCODE') {
6499 0           my ($currentcode) = @_;
6500 0           $self->setVerbose(0);
6501 0           $currentcode = $self->readMemvfo("$vfo","$band","$option");
6502 0           $self->setVerbose(1);
6503 0 0         if ($value eq $currentcode){
6504 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
6505 0           return 1;
6506             }
6507 0           $offset=0x07;
6508 0           $address = $self->hexAdder("$offset","$base");
6509 0           my $dcscode;
6510 0           my %codehash = reverse %DCSCODES;
6511 0           ($dcscode) = grep { $DCSCODES{$_} eq $value } keys %DCSCODES;
  0            
6512 0 0         if (!$dcscode){
6513 0 0         if($verbose){
6514 0           print "\nInvalid Option. Choose from the following\n\n";
6515 0           my $columns = 1;
6516 0           foreach my $codes (sort keys %DCSCODES) {
6517 0           printf "%-15s %s",$DCSCODES{$codes};
6518 0           $columns++;
6519 0 0         if ($columns == 7){print "\n\n"; $columns = 1;}
  0            
  0            
6520             }
6521 0           print "\n\n";
6522             }
6523 0           return 1;
6524             }
6525              
6526 0           my $BYTE1 = $self->eepromDecode("$address");
6527 0           substr ($BYTE1, 1, 7, "$dcscode");
6528 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
6529 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6530 0           $writestatus = $self->writeBlock("$address","$NEWHEX");
6531 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6532 0 0         if($verbose){
6533 0 0         if ($writestatus eq 'OK') {print"DCS CODE Set to $option sucessfull!\n";}
  0            
6534 0           else {print"DCS CODE set failed: $writestatus\n";}
6535             }
6536 0           return $writestatus;
6537             }
6538              
6539             ############## CLAROFFSET
6540              
6541 0 0         if ($option eq 'CLAROFFSET') {
6542 0           my ($currentoffset,$polarity,$newvalue,$endvalue,$binvalue,$bin1,$bin2) = @_;
6543 0           $polarity = substr ($value,0,1);
6544 0           $newvalue = substr ($value,1);
6545 0 0 0       if ($value != '0' && $polarity ne '+' && $polarity ne '-'){
      0        
6546 0 0         if($verbose){print "Value invalid: Choose -9.99 to +9.99 (needs + or - with number)\n\n";}
  0            
6547 0           return 1;
6548             }
6549              
6550 0 0 0       if ($newvalue < 0 || $newvalue > 999){
6551 0 0         if($verbose){print "Value invalid: Choose -9.99 to +9.99 (Multiple of 10)\n\n";}
  0            
6552 0           return 1;
6553             }
6554 0           $self->setVerbose(0);
6555 0           $currentoffset = $self->readMemvfo("$vfo","$band","$option");
6556 0           $self->setVerbose(1);
6557              
6558 0 0         if ($value eq $currentoffset){
6559 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
6560 0           return 1;
6561             }
6562 0           $offset=0x08;
6563 0           $address = $self->hexAdder("$offset","$base");
6564 0           $newvalue =~ tr/.//d;
6565 0 0         if ($polarity eq '-'){$newvalue = 65536 - $newvalue;}
  0            
6566 0           $binvalue = unpack("B32", pack("N", $newvalue));
6567 0           $binvalue = substr $binvalue, -16;
6568 0           $bin1 = substr $binvalue, 0,8;
6569 0           $bin2 = substr $binvalue, 8,8;
6570 0           my $NEWHEX1 = sprintf("%X", oct( "0b$bin1" ) );
6571 0           my $NEWHEX2 = sprintf("%X", oct( "0b$bin2" ) );
6572 0           my $writestatus1 = $self->writeDoubleblock("$address","$NEWHEX1","$NEWHEX2");
6573 0 0         if ($writestatus1 eq 'OK'){if($verbose){print"Clarifier offset set to $value sucessfull!\n";}}
  0 0          
  0            
6574 0 0         else {if($verbose){print"Clarifier offset set to $value failed!!!\n";}}
  0            
6575 0           return $writestatus;
6576             }
6577              
6578             ############## RXFREQ
6579              
6580 0 0         if ($option eq 'RXFREQ') {
6581 0           my ($currentrxfreq,$binvalue,$bin1,$bin2,$bin3,$bin4) = @_;
6582 0           $self->setVerbose(0);
6583 0           $currentrxfreq = $self->readMemvfo("$vfo","$band","$option");
6584 0           $self->setVerbose(1);
6585 0 0         if ($value eq $currentrxfreq){
6586 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
6587 0           return 1;
6588             }
6589              
6590 0           my $test = $self->boundryCheck("$band","$value");
6591 0 0         if ($test ne 'OK'){
6592 0 0         if($verbose){print "Our of range\n\n"; }
  0            
6593 0           return 1;
6594             }
6595 0           $offset=0x0A;
6596 0           $address = $self->hexAdder("$offset","$base");
6597 0           $offset=0x0C;
6598 0           $address3 = $self->hexAdder("$offset","$base");
6599 0           my $valuelabel = $value;
6600 0           $value =~ tr/.//d;
6601 0           $binvalue = unpack("B32", pack("N", $value));
6602 0           $bin1 = substr $binvalue, 0,8;
6603 0           $bin2 = substr $binvalue, 8,8;
6604 0           $bin3 = substr $binvalue, 16,8;
6605 0           $bin4 = substr $binvalue, 24,8;
6606 0           my $NEWHEX1 = sprintf("%X", oct( "0b$bin1" ) );
6607 0           my $NEWHEX2 = sprintf("%X", oct( "0b$bin2" ) );
6608 0           my $NEWHEX3 = sprintf("%X", oct( "0b$bin3" ) );
6609 0           my $NEWHEX4 = sprintf("%X", oct( "0b$bin4" ) );
6610 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6611 0           my $writestatus1 = $self->writeDoubleblock("$address","$NEWHEX1","$NEWHEX2");
6612 0           my $writestatus2 = $self->writeDoubleblock("$address3","$NEWHEX3","$NEWHEX4");
6613 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6614 0 0         if ($writestatus1 eq $writestatus2) {
6615 0 0         if ($writestatus1 eq 'OK'){if($verbose){print"RX Frequency set to $valuelabel sucessfull!\n";}}
  0 0          
  0            
6616             }
6617 0 0         else {if($verbose){print"RX Frequency set to $valuelabel failed!!!\n";}}
  0            
6618 0           return $writestatus;
6619             }
6620              
6621             ############## RPTOFFSETFREQ
6622              
6623 0 0         if ($option eq 'RPTOFFSETFREQ') {
6624 0           my ($currentoffset,$binvalue,$bin1,$bin2,$bin3) = @_;
6625 0 0 0       if ($value < 0 || $value > 9999){
6626 0 0         if($verbose){print "Value invalid: Choose 0 to 99.99\n\n";}
  0            
6627 0           return 1;
6628             }
6629 0           $self->setVerbose(0);
6630 0           $currentoffset = $self->readMemvfo("$vfo","$band","$option");
6631 0           $self->setVerbose(1);
6632 0 0         if ($value eq $currentoffset){
6633 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
6634 0           return 1;
6635             }
6636 0           $offset=0x0F;
6637 0           $address = $self->hexAdder("$offset","$base");
6638 0           $offset=0x11;
6639 0           $address3 = $self->hexAdder("$offset","$base");
6640 0           $value =~ tr/.//d;
6641 0           $value = $value * 1000;
6642 0           $binvalue = unpack("B32", pack("N", $value));
6643 0           $bin1 = substr $binvalue, 8,8;
6644 0           $bin2 = substr $binvalue, 16,8;
6645 0           $bin3 = substr $binvalue, 24,8;
6646 0           my $NEWHEX1 = sprintf("%X", oct( "0b$bin1" ) );
6647 0           my $NEWHEX2 = sprintf("%X", oct( "0b$bin2" ) );
6648 0           my $NEWHEX3 = sprintf("%X", oct( "0b$bin3" ) );
6649 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6650 0           my $writestatus1 = $self->writeDoubleblock("$address","$NEWHEX1","$NEWHEX2");
6651 0           my $writestatus3 = $self->writeBlock("$address3","$NEWHEX3");
6652 0 0         if ($musttoggle) {$self->quietToggle();}
  0            
6653 0 0         if ($writestatus1 eq $writestatus3) {
6654 0 0         if ($writestatus1 eq 'OK'){if($verbose){print"Repeater offset set to $value sucessfull!\n"}}
  0 0          
  0            
6655             }
6656 0 0         else {if($verbose){print"Repeater offset set to $value failed!!!\n";}}
  0            
6657 0           return $writestatus;
6658             }
6659             }
6660              
6661             # 44F ################################# SET CURRENT MEM
6662             ###################################### CHANGE ALL BITS FROM ADDRESS 0X44F
6663              
6664             sub setCurrentmem {
6665 0     0 1   my ($currentcurrentmem) = @_;
6666 0           my $self=shift;
6667 0           my $value=shift;
6668 0           my $firstvalue = $value;
6669 0 0         if ($value eq 'M-PL'){$value = '201'};
  0            
6670 0 0         if ($value eq 'M-PU'){$value = '202'};
  0            
6671 0           $value--;
6672 0 0 0       if ($value < 0 || $value > 202){
6673 0 0         if($verbose){print "Value invalid: Choose a number between 0 and 200, or M-PL / M-PU\n\n";}
  0            
6674 0           return 1;
6675             }
6676              
6677 0 0         if (length($value) == 0){
6678 0 0         if($verbose){print "Value invalid: Choose a number between 0 and 200 or M-PL / M-PU\n\n";}
  0            
6679 0           return 1;
6680             }
6681 0           $self->setVerbose(0);
6682 0           $currentcurrentmem = $self->getCurrentmem();
6683 0           $self->setVerbose(1);
6684 0 0         if ($value eq $currentcurrentmem + 1){
6685 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
6686 0           return 1;
6687             }
6688 0           my $binvalue = dec2bin($value);
6689 0           my $NEWHEX = sprintf("%X", oct( "0b$binvalue" ) );
6690 0           $writestatus = $self->writeBlock('044F',"$NEWHEX");
6691 0 0         if($verbose){
6692 0 0         if ($writestatus eq 'OK') {print"Current Memory set to $firstvalue sucessfull!\n";}
  0            
6693 0           else {print"Current Memory set failed: $writestatus\n";}
6694             }
6695 0           return $writestatus;
6696             }
6697              
6698              
6699             # 450 - 46A ############## ENABLE / DISABLE MEMORY AREA ######
6700             ######################################
6701              
6702             sub setMemarea {
6703 0     0 1   my $self=shift;
6704 0           my $number = shift;
6705 0           my $startaddress = '0450';
6706 0           my $value = shift;
6707 0 0 0       if ($writeallow != '1' and $agreewithwarning != '1') {
6708 0 0 0       if($debug || $verbose){print"Writing to EEPROM disabled, use setWriteallow(1) to enable\n";}
  0            
6709 0           $writestatus = "Write Disabled";
6710 0           return $writestatus;
6711             }
6712 0 0         if ($number eq 'M-PL'){$number = 201;}
  0            
6713 0 0         if ($number eq 'M-PU'){$number = 202;}
  0            
6714 0 0         if ($number == 1){
6715 0 0         if($verbose){print "Memory [$number] Cannot be changed, and must remain ACTIVE\n"};
  0            
6716 0           return 1;
6717             }
6718 0 0 0       if ($number < 2 || $number > 202){
6719 0 0         if($verbose){print "Memory [$number] invalid. Must be between 2 and 200 or M-PL / M-PU\n"};
  0            
6720 0           return 1;
6721             }
6722 0 0 0       if ($value ne 'ACTIVE' && $value ne 'INACTIVE') {
6723 0 0         if($verbose){print "Option [$value] for Memory [$number] invalid. Choose ACTIVE / INACTIVE\n"};
  0            
6724 0           return 1;
6725             }
6726 0           $self->setVerbose(0);
6727 0           my $currentvalue = $self->getMemmap("$number");
6728 0           $self->setVerbose(1);
6729 0 0         if ($value eq $currentvalue) {
6730 0 0         if($verbose){print "Memory [$number] Already $value\n"};
  0            
6731 0           return 1;
6732             }
6733 0           my $valuetag = $value;
6734 0 0         if ($value eq 'ACTIVE'){$value = '1';}
  0            
6735 0 0         if ($value eq 'INACTIVE'){$value = '0';}
  0            
6736 0           my $register = int(($number - 1) / 8);
6737 0           my $checkbit = ($number - (8 * ($register + 1))) * -1;
6738 0           my $address = $self->hexAdder("$register","$startaddress");
6739 0           $writestatus = $self->writeEeprom("$address","$checkbit","$value");
6740 0 0         if($verbose){print "Memory area [$number] set to $valuetag\n"};
  0            
6741 0           $self->setVerbose(0);
6742 0           my $isready = $self->readMemory('MEM',"$number",'READY');
6743 0 0         if ($isready eq 'NO'){$self->writeMemory('MEM',"$number",'READY');}
  0            
6744 0           $self->setVerbose(1);
6745 0           return $writestatus;
6746             }
6747              
6748             # 389 - 40A / 484 - 1907 ############## WRITE MEMORY INFO ######
6749             ######################################
6750              
6751             sub writeMemory {
6752 0     0 1   my ($testvfoband, $address, $address2, $address3, $address4, $testoptions, $base, %baseaddress, $musttoggle, $hometoggle, $offset, $startaddress, $fmstep, $amstep, $ctcsstone, $dcscode, $polarity, $newvalue) = @_;
6753 0           my $self=shift;
6754 0           my $type=shift;
6755 0           my $subtype=shift;
6756 0           my $option = shift;
6757 0           my $value=shift;
6758 0 0 0       if ($writeallow != '1' and $agreewithwarning != '1') {
6759 0 0 0       if($debug || $verbose){print"Writing to EEPROM disabled, use setWriteallow(1) to enable\n";}
  0            
6760 0           $writestatus = "Write Disabled";
6761 0           return $writestatus;
6762             }
6763 0           my $newlabel = "CH-$subtype";
6764 0           $type = uc($type);
6765 0           $subtype = uc($subtype);
6766 0           $option = uc($option);
6767 0 0         if ($subtype eq 'M-PL') {$subtype = '201';}
  0            
6768 0 0         if ($subtype eq 'M-PU') {$subtype = '202';}
  0            
6769 0           my $memnum = $subtype;
6770 0           my $multiple;
6771 0           my %memoryhash = ();
6772 0 0         if (!$value) {$value = 'ALL';}
  0            
6773 0 0 0       if ($type ne 'HOME' && $type ne 'QMB' && $type ne 'M-PL' && $type ne 'M-PU' && $type ne 'MEM') {
      0        
      0        
      0        
6774 0 0         if($verbose){print "Value invalid: Choose HOME / QMB / M-PL / M-PU / MEM\n\n";}
  0            
6775 0           return 1;
6776             }
6777 0           my %testhash = reverse %MEMORYOPTS;
6778 0           ($testoptions) = grep { $testhash{$_} eq $option } keys %testhash;
  0            
6779 0 0 0       if (!$testoptions && $value ne 'ALL'){
6780 0 0         if($verbose){
6781 0           print "Choose a valid option, or no option for ALL\.\n\n";
6782 0           my $columns = 1;
6783 0           foreach my $options (sort keys %testhash) {
6784 0           printf "%-15s %s",$testhash{$options};
6785 0           $columns++;
6786 0 0         if ($columns == 7){print "\n\n"; $columns = 1;}
  0            
  0            
6787             }
6788 0           print "\n\n";
6789             }
6790 0           return 1;
6791             }
6792 0 0         if ($type eq 'HOME'){%baseaddress = reverse %HOMEBASE;}
  0            
6793 0 0         if ($type eq 'QMB'){%baseaddress = reverse %MEMORYBASE; $subtype = 'QMB';}
  0            
  0            
6794 0 0         if ($type eq 'MEM'){%baseaddress = reverse %MEMORYBASE; $subtype = 'MEM'}
  0            
  0            
6795 0           ($base) = grep { $baseaddress{$_} eq $subtype } keys %baseaddress;
  0            
6796 0 0         if ($type eq 'MEM'){
6797 0 0         if ($memnum > 1) {
6798 0           $multiple = ($memnum - 1) * 26;
6799 0           $base = $self->hexAdder("$multiple","$base");
6800             }
6801             }
6802 0 0         if (!$base) {
6803 0 0         if($verbose){print "Command is malformed, check your syntax!!!\n\n";}
  0            
6804 0           return 1;
6805             }
6806 0 0         if ($type eq 'MEM') {$subtype = "$memnum";}
  0            
6807 0           $self->setVerbose(0);
6808 0           my $currenttuner = $self->getTuner();
6809 0           my $ishome = $self->getHome();
6810 0           my $isqmb = $self->getQmb();
6811 0           $self->setVerbose(1);
6812 0 0 0       if ($type eq 'HOME' && $ishome eq 'Y'){$hometoggle = 'TRUE';}
  0            
6813 0 0         if ($currenttuner eq 'MEMORY') {
6814 0 0 0       if ($type eq 'QMB' && $isqmb eq 'ON'){$musttoggle = 'TRUE';}
  0            
6815 0 0         if ($type eq 'MEM'){$musttoggle = 'TRUE';}
  0            
6816             }
6817              
6818             ############# Check to format new memory area
6819 0           $self->setVerbose(0);
6820 0           my $isready = $self->readMemory("$type","$subtype",'READY');
6821 0           $self->setVerbose(1);
6822 0 0         if ($isready eq 'NO'){
6823 0 0         if($verbose){print "This memory area has not yet been formatted. Loading default format...\nThis may take a minute....\n";}
  0            
6824 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
6825 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
6826 0           my $cycles = 0x00;
6827 0           my $cycles2 = $cycles + 1;
6828 0           $offset = 0x00;
6829 0           my $address = $self->hexAdder("$offset","$base");
6830 0           my $newaddress;
6831             my $HEXVALUE;
6832 0           my $HEXVALUE2;
6833 0 0         if ($verbose){print "Writing: Please Wait....\n";}
  0            
6834 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
6835 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
6836 0           do {
6837 0           $HEXVALUE = $NEWMEM["$cycles"];
6838 0           $HEXVALUE2 = $NEWMEM["$cycles2"];
6839 0 0         if($verbose){print $cycles2 + 1;print " of 18 BYTES Written\n";}
  0            
  0            
6840 0           $newaddress = $self->hexAdder("$cycles","$address");
6841 0           $self->writeDoubleblock("$newaddress","$HEXVALUE","$HEXVALUE2");
6842 0           $cycles = $cycles + 2;
6843 0           $cycles2 = $cycles +1;
6844             }
6845             while ($cycles < 18);
6846 0 0         if($verbose){print "\nWriting label $newlabel\n";}
  0            
6847 0           $self->writeMemory("$type","$subtype","LABEL","$newlabel");
6848 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
6849 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
6850             }
6851              
6852             ############## MODE
6853 0 0         if ($option eq 'MODE') {
6854 0           my ($currentmode) = @_;
6855 0           $self->setVerbose(0);
6856 0           $currentmode = $self->readMemory("$type","$subtype","$option");
6857 0           $self->setVerbose(1);
6858 0 0         if ($value eq $currentmode){
6859 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
6860 0           return 1;
6861             }
6862 0           $offset=0x00;
6863 0           $address = $self->hexAdder("$offset","$base");
6864 0           my $mode;
6865 0           my %modehash = reverse %MEMMODES;
6866 0           ($mode) = grep { $modehash{$_} eq $value } keys %modehash;
  0            
6867 0 0         if (!$mode){
6868 0 0         if($verbose){
6869 0           print "\nInvalid Option. Choose from the following\n\n";
6870 0           my $columns = 1;
6871 0           foreach my $codes (sort keys %modehash) {
6872 0           printf "%-15s %s",$modehash{$codes};
6873 0           $columns++;
6874 0 0         if ($columns == 7){print "\n\n"; $columns = 1;}
  0            
  0            
6875             }
6876 0           print "\n\n";
6877             }
6878 0           return 1;
6879             }
6880 0           my $BYTE1 = $self->eepromDecode("$address");
6881 0           substr ($BYTE1, 5, 3, "$mode");
6882 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
6883 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
6884 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
6885 0           $writestatus = $self->writeBlock("$address","$NEWHEX");
6886 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
6887 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
6888 0 0         if($verbose){
6889 0 0         if ($writestatus eq 'OK') {print"MODE Set to $option sucessfull!\n";}
  0            
6890 0           else {print"MODE set failed: $writestatus\n";}
6891             }
6892 0           return $writestatus;
6893             }
6894              
6895             ############## TAG
6896              
6897 0 0         if ($option eq 'TAG') {
6898 0           my ($currenttag) = @_;
6899              
6900 0 0 0       if ($value ne 'LABEL' && $value ne 'FREQUENCY'){
6901 0 0         if($verbose){print "Value invalid: Choose LABEL/FREQUENCY\n\n";}
  0            
6902 0           return 1;
6903             }
6904 0           $self->setVerbose(0);
6905 0           $currenttag = $self->readMemory("$type","$subtype","$option");
6906 0           $self->setVerbose(1);
6907 0 0         if ($value eq $currenttag){
6908 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
6909 0           return 1;
6910             }
6911 0           $offset=0x00;
6912 0           $address = $self->hexAdder("$offset","$base");
6913 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
6914 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
6915 0 0         if($value eq 'LABEL'){$writestatus = $self->writeEeprom("$address",'0','1');}
  0            
6916 0 0         if($value eq 'FREQUENCY'){$writestatus = $self->writeEeprom("$address",'0','0');}
  0            
6917 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
6918 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
6919 0 0         if ($verbose){
6920 0 0         if ($writestatus eq 'OK') {print"TAG set to $value sucessfull!\n";}
  0            
6921 0           else {print"TAG set to $value failed!!!\n";}
6922             }
6923 0           return $writestatus;
6924             }
6925              
6926             ############## NARFM
6927              
6928 0 0         if ($option eq 'NARFM') {
6929 0           my ($currentnarfm) = @_;
6930              
6931 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
6932 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
6933 0           return 1;
6934             }
6935 0           $self->setVerbose(0);
6936 0           $currentnarfm = $self->readMemory("$type","$subtype","$option");
6937 0           $self->setVerbose(1);
6938 0 0         if ($value eq $currentnarfm){
6939 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
6940 0           return 1;
6941             }
6942 0           $offset=0x01;
6943 0           $address = $self->hexAdder("$offset","$base");
6944 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
6945 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
6946 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom("$address",'4','1');}
  0            
6947 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom("$address",'4','0');}
  0            
6948 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
6949 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
6950 0 0         if ($verbose){
6951 0 0         if ($writestatus eq 'OK') {print"NAR FM set to $value sucessfull!\n";}
  0            
6952 0           else {print"NAR FM set to $value failed!!!\n";}
6953             }
6954 0           return $writestatus;
6955             }
6956              
6957             ############## NARCWDIG
6958              
6959 0 0         if ($option eq 'NARCWDIG') {
6960 0           my ($currentnarcwdig) = @_;
6961              
6962 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
6963 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
6964 0           return 1;
6965             }
6966 0           $self->setVerbose(0);
6967 0           $currentnarcwdig = $self->readMemory("$type","$subtype","$option");
6968 0           $self->setVerbose(1);
6969 0 0         if ($value eq $currentnarcwdig){
6970 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
6971 0           return 1;
6972             }
6973 0           $offset=0x01;
6974 0           $address = $self->hexAdder("$offset","$base");
6975 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
6976 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
6977 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom("$address",'3','1');}
  0            
6978 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom("$address",'3','0');}
  0            
6979 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
6980 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
6981 0 0         if ($verbose){
6982 0 0         if ($writestatus eq 'OK') {print"NAR CW DIG set to $value sucessfull!\n";}
  0            
6983 0           else {print"NAR CW DIG set to $value failed!!!\n";}
6984             }
6985 0           return $writestatus;
6986             }
6987              
6988             ############## RPTOFFSET
6989              
6990 0 0         if ($option eq 'RPTOFFSET') {
6991 0           my ($currentrptoffset) = @_;
6992 0 0 0       if ($value ne 'SIMPLEX' && $value ne 'MINUS' && $value ne 'PLUS' && $value ne 'NON-STANDARD'){
      0        
      0        
6993 0 0         if($verbose){print "Value invalid: Choose SIMPLEX/MINUS/PLUS/NON-STANDARD\n\n"; }
  0            
6994 0           return 1;
6995             }
6996 0           $self->setVerbose(0);
6997 0           $currentrptoffset = $self->readMemory("$type","$subtype","$option");
6998 0           $self->setVerbose(1);
6999 0 0         if ($value eq $currentrptoffset){
7000 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
7001 0           return 1;
7002             }
7003 0           $offset=0x01;
7004 0           $address = $self->hexAdder("$offset","$base");
7005 0           my $BYTE1 = $self->eepromDecode("$address");
7006 0 0         if ($value eq 'SIMPLEX'){substr ($BYTE1, 0, 2, '00');}
  0            
7007 0 0         if ($value eq 'MINUS'){substr ($BYTE1, 0, 2, '01');}
  0            
7008 0 0         if ($value eq 'PLUS'){substr ($BYTE1, 0, 2, '10');}
  0            
7009 0 0         if ($value eq 'NON-STANDARD'){substr ($BYTE1, 0, 2, '11');}
  0            
7010 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
7011 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7012 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7013 0           $writestatus = $self->writeBlock("$address","$NEWHEX");
7014 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7015 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7016 0 0         if($verbose){
7017 0 0         if ($writestatus eq 'OK') {print"RPTOFFSET Set to $value sucessfull!\n";}
  0            
7018 0           else {print"RPT OFFSET set failed: $writestatus\n";}
7019             }
7020 0           return $writestatus;
7021             }
7022              
7023             ############## TONEDCS
7024              
7025 0 0         if ($option eq 'TONEDCS') {
7026 0           my ($currenttonedcs) = @_;
7027 0 0 0       if ($value ne 'OFF' && $value ne 'TONE' && $value ne 'TONETSQ' && $value ne 'DCS'){
      0        
      0        
7028 0 0         if($verbose){print "Value invalid: Choose OFF/TONE/TONETSQ/DCS\n\n"; }
  0            
7029 0           return 1;
7030             }
7031 0           $self->setVerbose(0);
7032 0           $currenttonedcs = $self->readMemory("$type","$subtype","$option");
7033 0           $self->setVerbose(1);
7034 0 0         if ($value eq $currenttonedcs){
7035 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
7036 0           return 1;
7037             }
7038 0           $offset=0x04;
7039 0           $address = $self->hexAdder("$offset","$base");
7040 0           my $BYTE1 = $self->eepromDecode("$address");
7041 0 0         if ($value eq 'OFF'){substr ($BYTE1, 6, 2, '00');}
  0            
7042 0 0         if ($value eq 'TONE'){substr ($BYTE1, 6, 2, '01');}
  0            
7043 0 0         if ($value eq 'TONETSQ'){substr ($BYTE1, 6, 2, '10');}
  0            
7044 0 0         if ($value eq 'DCS'){substr ($BYTE1, 6, 2, '11');}
  0            
7045 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
7046 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7047 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7048 0           $writestatus = $self->writeBlock("$address","$NEWHEX");
7049 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7050 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7051 0 0         if($verbose){
7052 0 0         if ($writestatus eq 'OK') {print"TONEDCS Set to $value sucessfull!\n";}
  0            
7053 0           else {print"TONEDCS set failed: $writestatus\n";}
7054             }
7055 0           return $writestatus;
7056             }
7057              
7058             ############## ATT
7059              
7060 0 0         if ($option eq 'ATT') {
7061 0           my ($currentatt) = @_;
7062              
7063 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
7064 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
7065 0           return 1;
7066             }
7067 0           $self->setVerbose(0);
7068 0           $currentatt = $self->readMemory("$type","$subtype","$option");
7069 0           $self->setVerbose(1);
7070 0 0         if ($value eq $currentatt){
7071 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
7072 0           return 1;
7073             }
7074 0           $offset=0x02;
7075 0           $address = $self->hexAdder("$offset","$base");
7076 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7077 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7078 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom("$address",'3','1');}
  0            
7079 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom("$address",'3','0');}
  0            
7080 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7081 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7082 0 0         if ($verbose){
7083 0 0         if ($writestatus eq 'OK') {print"ATT set to $value sucessfull!\n";}
  0            
7084 0           else {print"ATT set to $value failed!!!\n";}
7085             }
7086 0           return $writestatus;
7087             }
7088              
7089             ############## IPO
7090              
7091 0 0         if ($option eq 'IPO') {
7092 0           my ($currentipo) = @_;
7093              
7094 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
7095 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
7096 0           return 1;
7097             }
7098 0           $self->setVerbose(0);
7099 0           $currentipo = $self->readMemory("$type","$subtype","$option");
7100 0           $self->setVerbose(1);
7101 0 0         if ($value eq $currentipo){
7102 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
7103 0           return 1;
7104             }
7105 0           $offset=0x02;
7106 0           $address = $self->hexAdder("$offset","$base");
7107 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7108 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7109 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom("$address",'2','1');}
  0            
7110 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom("$address",'2','0');}
  0            
7111 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7112 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7113 0 0         if ($verbose){
7114 0 0         if ($writestatus eq 'OK') {print"IPO set to $value sucessfull!\n";}
  0            
7115 0           else {print"IPO set to $value failed!!!\n";}
7116             }
7117 0           return $writestatus;
7118             }
7119              
7120             ############## FM STEP
7121              
7122 0 0         if ($option eq 'FMSTEP') {
7123 0           my ($currentfmstep) = @_;
7124 0           $self->setVerbose(0);
7125 0           $currentfmstep = $self->readMemory("$type","$subtype","$option");
7126 0           $self->setVerbose(1);
7127 0 0         if ($value eq $currentfmstep){
7128 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
7129 0           return 1;
7130             }
7131 0           $offset=0x03;
7132 0           $address = $self->hexAdder("$offset","$base");
7133 0           my $fmstep;
7134 0           my %fmstephash = reverse %FMSTEP;
7135 0           ($fmstep) = grep { $fmstephash{$_} eq $value } keys %fmstephash;
  0            
7136 0 0         if (!$fmstep){
7137 0 0         if($verbose){
7138 0           print "\nInvalid Option. Choose from the following\n\n";
7139 0           my $columns = 1;
7140 0           foreach my $codes (sort keys %fmstephash) {
7141 0           printf "%-15s %s",$fmstephash{$codes};
7142 0           $columns++;
7143 0 0         if ($columns == 7){print "\n\n"; $columns = 1;}
  0            
  0            
7144             }
7145 0           print "\n\n";
7146             }
7147 0           return 1;
7148             }
7149 0           my $BYTE1 = $self->eepromDecode("$address");
7150 0           substr ($BYTE1, 5, 3, "$fmstep");
7151 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
7152 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7153 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7154 0           $writestatus = $self->writeBlock("$address","$NEWHEX");
7155 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7156 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7157 0 0         if($verbose){
7158 0 0         if ($writestatus eq 'OK') {print"FM STEP Set to $option sucessfull!\n";}
  0            
7159 0           else {print"FM STEP set failed: $writestatus\n";}
7160             }
7161 0           return $writestatus;
7162             }
7163              
7164             ############## AM STEP
7165              
7166 0 0         if ($option eq 'AMSTEP') {
7167 0           my ($currentamstep) = @_;
7168 0           $self->setVerbose(0);
7169 0           $currentamstep = $self->readMemory("$type","$subtype","$option");
7170 0           $self->setVerbose(1);
7171 0 0         if ($value eq $currentamstep){
7172 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
7173 0           return 1;
7174             }
7175 0           $offset=0x03;
7176 0           $address = $self->hexAdder("$offset","$base");
7177 0           my $amstep;
7178 0           my %amstephash = reverse %AMSTEP;
7179 0           ($amstep) = grep { $amstephash{$_} eq $value } keys %amstephash;
  0            
7180 0 0         if (!$amstep){
7181 0 0         if($verbose){
7182 0           print "\nInvalid Option. Choose from the following\n\n";
7183 0           my $columns = 1;
7184 0           foreach my $codes (sort keys %amstephash) {
7185 0           printf "%-15s %s",$amstephash{$codes};
7186 0           $columns++;
7187 0 0         if ($columns == 7){print "\n\n"; $columns = 1;}
  0            
  0            
7188             }
7189 0           print "\n\n";
7190             }
7191 0           return 1;
7192             }
7193 0           my $BYTE1 = $self->eepromDecode("$address");
7194 0           substr ($BYTE1, 2, 3, "$amstep");
7195 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
7196 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7197 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7198 0           $writestatus = $self->writeBlock("$address","$NEWHEX");
7199 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7200 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7201 0 0         if($verbose){
7202 0 0         if ($writestatus eq 'OK') {print"AM STEP Set to $option sucessfull!\n";}
  0            
7203 0           else {print"AM STEP set failed: $writestatus\n";}
7204             }
7205 0           return $writestatus;
7206             }
7207 0 0         if ($option eq 'SSBSTEP') {
7208 0           my ($currentssbstep) = @_;
7209 0 0 0       if ($value ne '1.0' && $value ne '2.5' && $value ne '5.0'){
      0        
7210 0 0         if($verbose){print "Value invalid: Choose 1.0/2.5/5.0\n\n";}
  0            
7211 0           return 1;
7212             }
7213 0           $self->setVerbose(0);
7214 0           $currentssbstep = $self->readMemory("$type","$subtype","$option");
7215 0           $self->setVerbose(1);
7216 0 0         if ($value eq $currentssbstep){
7217 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
7218 0           return 1;
7219             }
7220 0           $offset=0x03;
7221 0           $address = $self->hexAdder("$offset","$base");
7222 0           my $BYTE1 = $self->eepromDecode("$address");
7223 0 0         if ($value eq '1.0'){substr ($BYTE1, 0, 2, '00');}
  0            
7224 0 0         if ($value eq '2.5'){substr ($BYTE1, 0, 2, '01');}
  0            
7225 0 0         if ($value eq '5.0'){substr ($BYTE1, 0, 2, '10');}
  0            
7226 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
7227 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7228 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7229 0           $writestatus = $self->writeBlock("$address","$NEWHEX");
7230 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7231 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7232 0 0         if($verbose){
7233 0 0         if ($writestatus eq 'OK') {print"SSB STEP Set to $value sucessfull!\n";}
  0            
7234 0           else {print"SSB STEP set failed: $writestatus\n";}
7235             }
7236 0           return $writestatus;
7237             }
7238              
7239             ############## CTCSSTONE
7240            
7241 0 0         if ($option eq 'CTCSSTONE') {
7242 0           my ($currenttone) = @_;
7243 0           $self->setVerbose(0);
7244 0           $currenttone = $self->readMemory("$type","$subtype","$option");
7245 0           $self->setVerbose(1);
7246 0 0         if ($value eq $currenttone){
7247 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
7248 0           return 1;
7249             }
7250 0           $offset=0x06;
7251 0           $address = $self->hexAdder("$offset","$base");
7252 0           my $ctcsstone;
7253 0           my %tonehash = reverse %CTCSSTONES;
7254 0           ($ctcsstone) = grep { $CTCSSTONES{$_} eq $value } keys %CTCSSTONES;
  0            
7255 0 0         if (!$ctcsstone){
7256 0 0         if($verbose){
7257 0           print "\nInvalid Option. Choose from the following\n\n";
7258 0           my $columns = 1;
7259 0           foreach my $tones (sort keys %CTCSSTONES) {
7260 0           printf "%-15s %s",$CTCSSTONES{$tones};
7261 0           $columns++;
7262 0 0         if ($columns == 7){print "\n\n"; $columns = 1;}
  0            
  0            
7263             }
7264 0           print "\n\n";
7265             }
7266 0           return 1;
7267             }
7268 0           my $BYTE1 = $self->eepromDecode("$address");
7269 0           substr ($BYTE1, 2, 6, "$ctcsstone");
7270 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
7271 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7272 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7273 0           $writestatus = $self->writeBlock("$address","$NEWHEX");
7274 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7275 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7276 0 0         if($verbose){
7277 0 0         if ($writestatus eq 'OK') {print"CTCSS TONE Set to $option sucessfull!\n";}
  0            
7278 0           else {print"CTCSS TONE set failed: $writestatus\n";}
7279             }
7280 0           return $writestatus;
7281             }
7282              
7283             ############## CLARIFTER
7284              
7285 0 0         if ($option eq 'CLARIFIER') {
7286 0           my ($currentclarifier) = @_;
7287 0 0 0       if ($value ne 'ON' && $value ne 'OFF'){
7288 0 0         if($verbose){print "Value invalid: Choose ON/OFF\n\n";}
  0            
7289 0           return 1;
7290             }
7291 0           $self->setVerbose(0);
7292 0           $currentclarifier = $self->readMemory("$type","$subtype","$option");
7293 0           $self->setVerbose(1);
7294 0 0         if ($value eq $currentclarifier){
7295 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
7296 0           return 1;
7297             }
7298 0           $offset=0x02;
7299 0           $address = $self->hexAdder("$offset","$base");
7300 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7301 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7302 0 0         if($value eq 'ON'){$writestatus = $self->writeEeprom("$address",'1','1');}
  0            
7303 0 0         if($value eq 'OFF'){$writestatus = $self->writeEeprom("$address",'1','0');}
  0            
7304 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7305 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7306 0 0         if ($verbose){
7307 0 0         if ($writestatus eq 'OK') {print"CLARIFIER set to $value sucessfull!\n";}
  0            
7308 0           else {print"CLARIFIER set to $value failed!!!\n";}
7309             }
7310 0           return $writestatus;
7311             }
7312              
7313             ############## CLAROFFSET
7314              
7315 0 0         if ($option eq 'CLAROFFSET') {
7316 0           my ($currentoffset,$polarity,$newvalue,$endvalue,$binvalue,$bin1,$bin2) = @_;
7317 0           $polarity = substr ($value,0,1);
7318 0           $newvalue = substr ($value,1);
7319 0 0 0       if ($value != '0' && $polarity ne '+' && $polarity ne '-'){
      0        
7320 0 0         if($verbose){print "Value invalid: Choose -9.99 to +9.99 (needs + or - with number)\n\n";}
  0            
7321 0           return 1;
7322             }
7323 0 0 0       if ($newvalue < 0 || $newvalue > 999){
7324 0 0         if($verbose){print "Value invalid: Choose -9.99 to +9.99 (Multiple of 10)\n\n";}
  0            
7325 0           return 1;
7326             }
7327 0           $self->setVerbose(0);
7328 0           $currentoffset = $self->readMemory("$type","$subtype","$option");
7329 0           $self->setVerbose(1);
7330 0 0         if ($value eq $currentoffset){
7331 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
7332 0           return 1;
7333             }
7334 0           $offset=0x08;
7335 0           $address = $self->hexAdder("$offset","$base");
7336 0           $newvalue =~ tr/.//d;
7337 0 0         if ($polarity eq '-'){$newvalue = 65536 - $newvalue;}
  0            
7338 0           $binvalue = unpack("B32", pack("N", $newvalue));
7339 0           $binvalue = substr $binvalue, -16;
7340 0           $bin1 = substr $binvalue, 0,8;
7341 0           $bin2 = substr $binvalue, 8,8;
7342 0           my $NEWHEX1 = sprintf("%X", oct( "0b$bin1" ) );
7343 0           my $NEWHEX2 = sprintf("%X", oct( "0b$bin2" ) );
7344 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7345 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7346 0           my $writestatus1 = $self->writeDoubleblock("$address","$NEWHEX1","$NEWHEX2");
7347 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7348 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7349 0 0         if ($writestatus1 eq 'OK'){if($verbose){print"Clarifier offset set to $value sucessfull!\n";}}
  0 0          
  0            
7350 0 0         else {if($verbose){print"Clarifier offset set to $value failed!!!\n";}}
  0            
7351 0           return $writestatus;
7352             }
7353              
7354             ############## DCSCODE
7355              
7356 0 0         if ($option eq 'DCSCODE') {
7357 0           my ($currentcode) = @_;
7358 0           $self->setVerbose(0);
7359 0           $currentcode = $self->readMemory("$type","$subtype","$option");
7360 0           $self->setVerbose(1);
7361 0 0         if ($value eq $currentcode){
7362 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
7363 0           return 1;
7364             }
7365 0           $offset=0x07;
7366 0           $address = $self->hexAdder("$offset","$base");
7367 0           my $dcscode;
7368 0           my %codehash = reverse %DCSCODES;
7369 0           ($dcscode) = grep { $DCSCODES{$_} eq $value } keys %DCSCODES;
  0            
7370 0 0         if (!$dcscode){
7371 0 0         if($verbose){
7372 0           print "\nInvalid Option. Choose from the following\n\n";
7373 0           my $columns = 1;
7374 0           foreach my $codes (sort keys %DCSCODES) {
7375 0           printf "%-15s %s",$DCSCODES{$codes};
7376 0           $columns++;
7377 0 0         if ($columns == 7){print "\n\n"; $columns = 1;}
  0            
  0            
7378             }
7379 0           print "\n\n";
7380             }
7381 0           return 1;
7382             }
7383 0           my $BYTE1 = $self->eepromDecode("$address");
7384 0           substr ($BYTE1, 1, 7, "$dcscode");
7385 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
7386 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7387 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7388 0           $writestatus = $self->writeBlock("$address","$NEWHEX");
7389 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7390 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7391 0 0         if($verbose){
7392 0 0         if ($writestatus eq 'OK') {print"DCS CODE Set to $option sucessfull!\n";}
  0            
7393 0           else {print"DCS CODE set failed: $writestatus\n";}
7394             }
7395 0           return $writestatus;
7396             }
7397              
7398             ############## MEMSKIP
7399              
7400 0 0         if ($option eq 'MEMSKIP') {
7401 0           my ($currentmemskip) = @_;
7402 0 0 0       if ($value ne 'YES' && $value ne 'NO'){
7403 0 0         if($verbose){print "Value invalid: Choose YES/NO\n\n";}
  0            
7404 0           return 1;
7405             }
7406 0           $self->setVerbose(0);
7407 0           $currentmemskip = $self->readMemory("$type","$subtype","$option");
7408 0           $self->setVerbose(1);
7409 0 0         if ($value eq $currentmemskip){
7410 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
7411 0           return 1;
7412             }
7413 0           $offset=0x02;
7414 0           $address = $self->hexAdder("$offset","$base");
7415 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7416 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7417 0 0         if($value eq 'NO'){$writestatus = $self->writeEeprom("$address",'0','0');}
  0            
7418 0 0         if($value eq 'YES'){$writestatus = $self->writeEeprom("$address",'0','1');}
  0            
7419 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7420 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7421 0 0         if ($verbose){
7422 0 0         if ($writestatus eq 'OK') {print"Memory Skip set to $value sucessfull!\n";}
  0            
7423 0           else {print"Memory Skip set to $value failed!!!\n";}
7424             }
7425 0           return $writestatus;
7426             }
7427              
7428             ############## RXFREQ
7429              
7430 0 0         if ($option eq 'RXFREQ') {
7431 0           my ($currentrxfreq,$binvalue,$bin1,$bin2,$bin3,$bin4) = @_;
7432 0           $self->setVerbose(0);
7433 0           $currentrxfreq = $self->readMemory("$type","$subtype","$option");
7434 0           $self->setVerbose(1);
7435 0 0         if ($value eq $currentrxfreq){
7436 0 0         if($verbose){print "Value $value already selected.\n\n"; }
  0            
7437 0           return 1;
7438             }
7439 0 0         if ($type eq 'HOME'){
7440 0           my $test = $self->boundryCheck("$subtype","$value");
7441 0 0         if ($test ne 'OK'){
7442 0 0         if($verbose){print "Our of range\n\n"; }
  0            
7443 0           return 1;
7444             }
7445             }
7446 0           $offset=0x0A;
7447 0           $address = $self->hexAdder("$offset","$base");
7448 0           $offset=0x0C;
7449 0           $address3 = $self->hexAdder("$offset","$base");
7450 0           my $valuelabel = $value;
7451 0           $value =~ tr/.//d;
7452 0           $binvalue = unpack("B32", pack("N", $value));
7453 0           $bin1 = substr $binvalue, 0,8;
7454 0           $bin2 = substr $binvalue, 8,8;
7455 0           $bin3 = substr $binvalue, 16,8;
7456 0           $bin4 = substr $binvalue, 24,8;
7457 0           my $NEWHEX1 = sprintf("%X", oct( "0b$bin1" ) );
7458 0           my $NEWHEX2 = sprintf("%X", oct( "0b$bin2" ) );
7459 0           my $NEWHEX3 = sprintf("%X", oct( "0b$bin3" ) );
7460 0           my $NEWHEX4 = sprintf("%X", oct( "0b$bin4" ) );
7461 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7462 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7463 0           my $tempaddress;
7464 0           my $tempoffset=0x01;
7465 0           $tempaddress = $self->hexAdder("$tempoffset","$base");
7466 0           $self->setVerbose(0);
7467 0           my $currentuhf = $self->readMemory("$type","$subtype",'UHF');
7468 0           my $currenthfvhf = $self->readMemory("$type","$subtype",'HFVHF');
7469 0           my $currentrange = $self->readMemory("$type","$subtype",'FREQRANGE');
7470 0           my $newrange = $self->rangeCheck("$value");
7471             # sets UHF bit if needed
7472 0 0         if ($value >= 42000000){
7473 0 0         if ($currentuhf ne 'YES') {
7474 0           $writestatus = $self->writeEeprom("$tempaddress",'2','1');}
7475             }
7476             else {
7477 0 0         if ($currentuhf ne 'NO') {
7478 0           $writestatus = $self->writeEeprom("$tempaddress",'2','0');}
7479             }
7480             #sets the HF/VHF bit if needed
7481 0           $tempoffset=0x00;
7482 0           $tempaddress = $self->hexAdder("$tempoffset","$base");
7483 0 0         if ($value >= 5000000){
7484 0 0         if ($currenthfvhf ne 'VHF') {$writestatus = $self->writeEeprom("$tempaddress",'2','0');}
  0            
7485             }
7486              
7487             else {
7488 0 0         if ($currenthfvhf ne 'HF') {$writestatus = $self->writeEeprom("$tempaddress",'2','1');}
  0            
7489             }
7490             #sets the FREQ RANGE bits if needed
7491 0           $tempoffset=0x01;
7492 0           $tempaddress = $self->hexAdder("$tempoffset","$base");
7493 0 0         if ($currentrange ne $newrange){
7494 0           my $datablock;
7495 0           my $BYTE1 = $self->eepromDecode("$tempaddress");
7496 0 0         if ($newrange eq 'HF'){substr ($BYTE1, 5, 3, '000');}
  0            
7497 0 0         if ($newrange eq '6M'){substr ($BYTE1, 5, 3, '001');}
  0            
7498 0 0         if ($newrange eq 'FM-BCB'){substr ($BYTE1, 5, 3, '010');}
  0            
7499 0 0         if ($newrange eq 'AIR'){substr ($BYTE1,5, 3, '011');}
  0            
7500 0 0         if ($newrange eq '2M'){substr ($BYTE1, 5, 3, '100');}
  0            
7501 0 0         if ($newrange eq 'UHF'){substr ($BYTE1, 5, 3, '101');}
  0            
7502 0           my $NEWHEX = sprintf("%X", oct( "0b$BYTE1" ) );
7503 0           $writestatus = $self->writeBlock("$tempaddress","$NEWHEX");
7504             }
7505 0           $self->setVerbose(1);
7506 0           my $writestatus1 = $self->writeDoubleblock("$address","$NEWHEX1","$NEWHEX2");
7507 0           my $writestatus3 = $self->writeDoubleblock("$address3","$NEWHEX3","$NEWHEX4");
7508 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7509 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7510 0 0         if ($writestatus1 eq $writestatus3) {
7511 0 0         if ($writestatus1 eq 'OK'){if($verbose){print"RX Frequency set to $valuelabel sucessfull!\n";}}
  0 0          
  0            
7512             }
7513 0 0         else {if($verbose){print"RX Frequency set to $valuelabel failed!!!\n";}}
  0            
7514 0           return $writestatus;
7515             }
7516            
7517             ############## RPTOFFSETFREQ
7518              
7519 0 0         if ($option eq 'RPTOFFSETFREQ') {
7520 0           my ($currentoffset,$binvalue,$bin1,$bin2,$bin3) = @_;
7521 0 0 0       if ($value < 0 || $value > 9999){
7522 0 0         if($verbose){print "Value invalid: Choose 0 to 99.99\n\n";}
  0            
7523 0           return 1;
7524             }
7525 0           $self->setVerbose(0);
7526 0           $currentoffset = $self->readMemory("$type","$subtype","$option");
7527 0           $self->setVerbose(1);
7528 0 0         if ($value eq $currentoffset){
7529 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
7530 0           return 1;
7531             }
7532 0           $offset=0x0F;
7533 0           $address = $self->hexAdder("$offset","$base");
7534 0           $offset=0x11;
7535 0           $address3 = $self->hexAdder("$offset","$base");
7536 0           $value =~ tr/.//d;
7537 0           $value = $value * 1000;
7538 0           $binvalue = unpack("B32", pack("N", $value));
7539 0           $bin1 = substr $binvalue, 8,8;
7540 0           $bin2 = substr $binvalue, 16,8;
7541 0           $bin3 = substr $binvalue, 24,8;
7542 0           my $NEWHEX1 = sprintf("%X", oct( "0b$bin1" ) );
7543 0           my $NEWHEX2 = sprintf("%X", oct( "0b$bin2" ) );
7544 0           my $NEWHEX3 = sprintf("%X", oct( "0b$bin3" ) );
7545 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7546 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7547 0           my $writestatus1 = $self->writeDoubleblock("$address","$NEWHEX1","$NEWHEX2");
7548 0           my $writestatus3 = $self->writeBlock("$address3","$NEWHEX3");
7549 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7550 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7551 0 0         if ($writestatus1 eq $writestatus3) {
7552 0 0         if ($writestatus1 eq 'OK'){
7553 0 0         if ($verbose){print"Repeater offset set to $value sucessfull!\n";}
  0            
7554             }
7555             }
7556             else {
7557 0 0         if($verbose){print"Repeater offset set to $value failed!!!\n";}
  0            
7558             }
7559 0           return $writestatus;
7560             }
7561              
7562             ############## LABEL
7563              
7564 0 0         if ($option eq 'LABEL') {
7565 0           my ($currentlabel,$binvalue,$bin1,$bin2,$bin3,$bin4) = @_;
7566 0           $self->setVerbose(0);
7567 0           $currentlabel = $self->readMemory("$type","$subtype","$option");
7568 0           $self->setVerbose(1);
7569 0           my $size = length($value);
7570 0 0         if ($value eq $currentlabel){
7571 0 0         if($verbose){print "Value $value already selected.\n\n";}
  0            
7572 0           return 1;
7573             }
7574 0 0         if (length($value) > 11) {
7575 0 0         if($verbose){print "Label is limited to 8 charcters.\n\n";}
  0            
7576 0           return 1;
7577             }
7578 0           my @labelarray = split //, $value;
7579 0           my $cycles = 0x00;
7580 0           my $cycles2 = $cycles + 1;
7581 0           my $offset = 0x12;
7582 0           my $address = $self->hexAdder("$offset","$base");
7583 0           my $newaddress;
7584             my $letter;
7585 0           my $letter2;
7586 0 0         if ($verbose){print "Writing: Please Wait....\n";}
  0            
7587 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7588 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7589 0           do {
7590 0           $letter = ord($labelarray["$cycles"]);
7591 0           $letter2 = ord($labelarray["$cycles2"]);
7592 0 0         if ($letter == '0') {$letter = '32';}
  0            
7593 0 0         if ($letter2 == '0') {$letter2 = '32';}
  0            
7594 0           my $letter = dec2bin("$letter");
7595 0           my $letter2 = dec2bin("$letter2");
7596 0           $letter = sprintf("%X", oct( "0b$letter" ) );
7597 0           $letter2 = sprintf("%X", oct( "0b$letter2" ) );
7598 0           $newaddress = $self->hexAdder("$cycles","$address");
7599 0           my $writestatus1 = $self->writeDoubleblock("$newaddress","$letter","$letter2");
7600 0           $cycles = $cycles +2;
7601 0           $cycles2 = $cycles + 1;
7602             }
7603             while ($cycles < 8);
7604 0 0         if ($hometoggle) {$self->quietHometoggle();}
  0            
7605 0 0         if ($musttoggle) {$self->quietTunetoggle();}
  0            
7606 0 0         if ($verbose){print "DONE!\n";}
  0            
7607             }
7608             }
7609              
7610             # 1922 - 1928 ################################# SET ID for CWID ######
7611             ######################################
7612              
7613             sub setId {
7614 0     0 1   my $self=shift;
7615 0           my $value=shift;
7616 0           $value = uc($value);
7617 0 0         if (length($value) > 10){
7618 0 0         if($verbose){print "Limited to 7 Characters 0-9 A-Z\n\n";}
  0            
7619 0           return 1;
7620             }
7621 0           $self->setVerbose(0);
7622 0           my $currentid = $self->getId();
7623 0           $self->setVerbose(1);
7624 0 0         if ($value eq $currentid){
7625 0 0         if($verbose){print "CW ID already set to $value\n\n";}
  0            
7626 0           return 1;
7627             }
7628 0           my @labelarray = split //, $value;
7629 0           my $address = 1922;
7630 0           my $cycles = 0x00;
7631 0           my $cycles2 = $cycles + 1;
7632 0           my $newaddress;
7633             my $letter;
7634 0           my $letter2;
7635 0           do {
7636 0           $letter = $labelarray["$cycles"];
7637 0           $letter2 = $labelarray["$cycles2"];
7638 0           ($letter) = grep { $CWID{$_} eq $letter } keys %CWID;
  0            
7639 0           ($letter2) = grep { $CWID{$_} eq $letter2 } keys %CWID;
  0            
7640 0           $newaddress = $self->hexAdder("$cycles","$address");
7641 0           my $writestatus1 = $self->writeDoubleblock("$newaddress","$letter","$letter2");
7642 0           $cycles = $cycles +2;
7643 0           $cycles2 = $cycles + 1;
7644             }
7645             while ($cycles < 6);
7646              
7647             #this writes the last two bits again for address 1928
7648 0           $letter = $labelarray[5];
7649 0           $letter2 = $labelarray[6];
7650 0           ($letter) = grep { $CWID{$_} eq $letter } keys %CWID;
  0            
7651 0           ($letter2) = grep { $CWID{$_} eq $letter2 } keys %CWID;
  0            
7652 0           my $writestatus1 = $self->writeDoubleblock('1927',"$letter","$letter2");
7653 0           print "$writestatus1\n";
7654              
7655              
7656              
7657 0 0         if ($verbose){print "DONE!\n";}
  0            
7658 0           return 0;
7659             }
7660              
7661             ################################################## FIN
7662              
7663              
7664             =head1 NAME
7665              
7666             Ham::Device::FT817COMM - Library to control the Yaesu FT817 Ham Radio
7667              
7668             =head1 VERSION
7669              
7670             Version 0.9.9
7671              
7672             =head1 SYNOPSIS
7673              
7674             use HAM::Device::FT817COMM;
7675              
7676             =head2 Constructor and Port Configurations
7677              
7678             my $FT817 = new Ham::Device::FT817COMM (
7679             serialport => '/dev/ttyUSB0',
7680             baud => '38400',
7681             lockfile => '/var/lock/ft817'
7682             );
7683              
7684             my $port = $FT817->{'serialport'};
7685             my $baud = $FT817->{'baud'};
7686             my $lockfile = $FT817->{'lockfile'};
7687             my $version = $FT817->moduleVersion;
7688              
7689             =head2 Destructor
7690              
7691             $FT817->closePort;
7692              
7693             =head2 Lock File
7694              
7695             In the event you abruptly end the software or loose connectivity via ssh. When attempting to reconnect
7696             you will see the following error.
7697              
7698             Can't open serial port /dev/ttyUSB0: File exists
7699              
7700             The lock file can be remove simply by
7701              
7702             rm /var/lock/ft817
7703              
7704              
7705             =head2 Initialization
7706              
7707             The instance of the device and options are created with the constructor and port configurations shown above.
7708             The variable which is an instance of the device may be named at that point. In this case B<$FT817>.
7709             The serialport must be a valid port and not locked. You must consider that your login must have
7710             permission to access the port either being added to the group or giving the user suffucient privilages.
7711             The baudrate 'baud' must match the baudrate of the radio B which is menu item B<14>.
7712              
7713             Note that you are not limited to one radio. You can create more than one instance using a different name and serial port
7714              
7715              
7716             my $anotherFT817 = new Ham::Device::FT817COMM (
7717             serialport => '/dev/ttyUSB1',
7718             baud => '38400',
7719             lockfile => '/var/lock/ft817-2'
7720             );
7721              
7722             my $port = $FT817->{'serialport'};
7723             my $baud = $FT817->{'baud'};
7724             my $lockfile = $FT817->{'lockfile'};
7725             my $version = $FT817->moduleVersion;
7726              
7727             REMEMBER!!!! Each instance created needs its own destructor.
7728              
7729              
7730             Finally B is recommended to ensure that no other software may access the port at the same time.
7731             The lockfile is removed as part of the invocation of the destructor method.
7732              
7733              
7734             =head1 METHODS
7735              
7736             =head2 1. Using Return Data From a Module
7737              
7738             This allows for complete control of the rig through the sub routines
7739             all done through the cat interface
7740              
7741             $output = 'rigname'->'command'('value');
7742              
7743             an example is a follows
7744              
7745             $output = $FT817->catLock('ON');
7746              
7747             Using this method, the output which is collected in the varible B<$output> is designed to be minimal for
7748             use in applications that provide an already formatted output.
7749              
7750             For example:
7751            
7752             $output = $FT817->catLock('ON');
7753             print "$output";
7754              
7755             Would simply return B if the command failed and B<00> if the command was sucessfull. The outputs vary
7756             from module to module, depending on the function
7757              
7758             =head2 2. Using setVerbose()
7759              
7760             The module already has pre-formatted outputs for each subroutine. Using the same example in a different form
7761             and setting B we have the following
7762              
7763             setVerbose(1);
7764             $FT817->catLock('ON');
7765              
7766             The output would be, for example:
7767            
7768             Set Lock (ENABLE) Sucessfull.
7769              
7770             Other verbose outputs exist to catch errors.
7771              
7772             setVerbose(1);
7773             $FT817->catLock('blabla');
7774              
7775             The output would be:
7776              
7777             Set Lock (blabla) Failed. Option:blabla invalid.
7778              
7779             An example of both is shown below for the command getHome()
7780              
7781             As return data: Y
7782             As verbose(1) : At Home Frequency
7783              
7784             We see that return data will be suitable for a program which needs just a boolean value.
7785              
7786             =head2 3. Build a sub-routine into a condition
7787              
7788             Another use can be to use a subrouting as a value in a condition statment to test
7789              
7790             if (($FT817->gethome()) eq 'Y') {
7791             warn "I guess we're home";
7792             }
7793              
7794             Call all of the modules, one at a time and look at the outputs, from which you can decide how the data can be used.
7795             At this time I have completed a command line front end for this module that makes testing all of the functionality easy.
7796              
7797             =head1 DEBUGGER
7798              
7799             FT817COMM has a built in robust debugger that makes available to the user all transactions between the software and the rig.
7800             Where verbose gave the outputs to user initiated subroutines, the debugger does very much the same but with internal functions
7801             not designed to be called directly in the userspace. That being said, you should never directly call these system functions
7802             or you will quickly turn your 817 into a paperweight or door stop. You have been warned.
7803              
7804             Feel free to use the debugger to get an idea as to how the module and the radio communicate.
7805              
7806             $FT817->setDebug(1); # Turns on the debugger
7807              
7808             The first output of which is:
7809              
7810             DEBUGGER IS ON
7811              
7812             Two distinct type of transactions happen with the debugger, they are:
7813              
7814             CAT commands : Commands which use the Yaesu CAT protocol
7815             EPROMM commands: Commands which read and write to the EEPROM
7816              
7817             With the command: B we get the regular output expected, with B
7818              
7819             Mode is FM
7820              
7821             However with the B we will see the following output to the same command:
7822              
7823             [FT817]@/dev/ttyUSB0$ get mode
7824              
7825             (sendCat:DEBUG) - DATA OUT ------> 00 00 00 00 03
7826              
7827             (sendCat:DEBUG) - BUILT PACKET --> 0000000003
7828              
7829             (sendCat:DEBUG) - DATA IN <------- 1471200008
7830              
7831             Mode is FM
7832             [FT817]@/dev/ttyUSB0$
7833              
7834             The sendcat:debug shows the request of B<00 00 00 00 0x03> sent to the rig, and the rig
7835             returning B<1471200008>. What were looking at is the last two digits 08 which is parsed from
7836             the block of data. 08 is mode FM. FT817COMM does all of the parsing and conversion for you.
7837              
7838             As you might have guessed, the first 8 digits are the current frequency, which in this case
7839             is 147.120 MHZ. The catgetFrequency() module would pull the exact same data, but parse it differently
7840              
7841             The debugger works differently on read/write to the eeprom. The next example shown below used the function
7842             B, the function which tunrs arts off.
7843              
7844              
7845             [FT817]@/dev/ttyUSB0$ set arts off
7846              
7847             (eepromDecode:DEBUG) - READING FROM ------> [00x79]
7848              
7849             (eepromDecode:DEBUG) - PACKET BUILT ------> [00790000BB]
7850              
7851             (eepromDecode:DEBUG) - OUTPUT HEX -------> [81]
7852              
7853             (eepromDecode:DEBUG) - OUTPUT BIN -------> [10000001]
7854              
7855              
7856             (writeEeprom:DEBUG) - OUTPUT FROM [00x79]
7857              
7858             (writeEeprom:DEBUG) - PACKET BUILT ------> [00790000BB]
7859              
7860             (writeEeprom:DEBUG) - BYTE1 (81) BYTE2 (1F) from [00x79]
7861              
7862             (writeEeprom:DEBUG) - BYTE1 BINARY IS [10000001]
7863              
7864             (writeEeprom:DEBUG) - CHANGING BIT(0) to (0)
7865              
7866             (writeEeprom:DEBUG) - BYTE1: BINARY IS [00000001] AFTER CHANGE
7867              
7868             (writeEeprom:DEBUG) - CHECKING IF [1] needs padding
7869              
7870             (writeEeprom:DEBUG) - Padded to [01]
7871              
7872             (writeEeprom:DEBUG) - BYTE1 (01) BYTE2 (1F) to [00x79]
7873              
7874             (writeEeprom:DEBUG) - WRITING ----------> (01) (1F)
7875              
7876             (writeEeprom:DEBUG) - PACKET BUILT ------> [0079011fBC]
7877              
7878             (writeEeprom:DEBUG) - VALUES WRITTEN, CHECKING...
7879              
7880             (writeEeprom:DEBUG) - SHOULD BE: (01) (1F)
7881              
7882             (writeEeprom:DEBUG) - IS: -----> (01) (1F)
7883              
7884             (writeEeprom:DEBUG) - VALUES MATCH!!!
7885              
7886             ARTS set to OFF sucessfull!
7887              
7888             The output shows all of the transactions and modifications conducted by the system functions
7889              
7890              
7891             =head1 Modules
7892              
7893             =over
7894              
7895             =item agreeWithwarning()
7896              
7897             $agree = $FT817->agreeWithwarning(#);
7898              
7899             Turns on and off the internal flag that says. You undrstand the risks of writing to the EEPROM
7900             Activated when any value is in the (). Good practice says () or (1) for OFF and ON.
7901              
7902             Returns the argument sent to it on success.
7903              
7904              
7905             =item bitCheck()
7906              
7907             $output = $FT817->bitCheck();
7908              
7909             The function that checks the BITWATCHER hash for changes and throws an Alarm if a change is found
7910             showing what the change is. The BITWATCHER hash is hard coded in FT817COMM.pm as areas are discovered
7911             they are removed from the hash. If an alarm is thrown, look at what function was done in the history log
7912             and output log to figure out why the value was changed
7913              
7914             [FT817]@/dev/ttyUSB0/:$ bitcheck
7915             CHANGE FOUND IN MEMORY AREA [0055]: BIT 4 is 0, WAS 1
7916              
7917              
7918             If it finds no changes, it will return the following
7919             [FT817]@/dev/ttyUSB0/:$ bitcheck
7920              
7921             NO CHANGES FOUND
7922              
7923             Returns 'OK' when no change found, 'CHANGE' when a change was found
7924              
7925              
7926             =item boundryCheck()
7927              
7928             $output = $FT817->boundryCheck([BAND],[FREQUENCY]);
7929             $output = $FT817->boundryCheck('14m','14.070');
7930              
7931             This is an internal function to check if a frequency is in the correct range
7932             for the Band given. The ranges are listed in a hash of hashes called %BOUNDRIES
7933              
7934             Returns 'OK' when within range, returns 1 on error
7935              
7936              
7937             =item catClarifier()
7938              
7939             $setclar = $FT817->catClarifier([ON/OFF]);
7940              
7941             Enables or disables the clarifier
7942              
7943             Returns '00' on success or 'f0' on failure
7944              
7945              
7946             =item catClarifierfreq()
7947              
7948             $clarifierfreq = $FT817->catClarifierfreq([####]);
7949              
7950             Uses 4 digits as an argument to set the Clarifier frequency. Leading and trailing zeros required where applicable
7951             1.234 KHZ would be 1234
7952              
7953             Returns '00' on success or 'f0' on failure
7954              
7955              
7956             =item catCtcssdcs()
7957              
7958             $ctcssdcs = $FT817->catCtcssdcs({DCS/CTCSS/ENCODER/OFF});
7959              
7960             Sets the CTCSS DCS mode of the radio
7961              
7962             Returns 'OK' on success or something else on failure
7963              
7964              
7965             =item catCtcsstone()
7966              
7967             $ctcsstone = $FT817->catCtcsstone([####]);
7968              
7969             Uses 4 digits as an argument to set the CTCSS tone. Leading and trailing zeros required where applicable
7970             192.8 would be 1928 as an argument
7971              
7972             Returns '00' on success or 'f0' on failure
7973             On 'f0' verbose(1) displays all valid tones
7974              
7975              
7976             =item catDcscode()
7977              
7978             $dcscode = $FT817->catDcscode([####]);
7979              
7980             Uses 4 digits as an argument to set the DCS code. Leading and trailing zeros required where applicable
7981             0546 would be 546 as an argument
7982              
7983             Returns '00' on success or 'f0' on failure
7984             On 'f0' verbose(1) displays all valid tones
7985              
7986              
7987             =item catgetFrequency()
7988              
7989             $frequency = $FT817->catgetFrequency([#]);
7990              
7991             Returns the current frequency of the rig eg. B<14712000> with B
7992             Returns the current frequency of the rig eg. B<147.120.00> MHZ with B
7993              
7994              
7995             =item catgetMode()
7996              
7997             $mode = $FT817->catgetMode();
7998              
7999             Returns the current Mode of the Radio : AM / FM / USB / CW etc.......
8000              
8001              
8002             =item catLock()
8003              
8004             $setlock = $FT817->catLock([ON/OFF]);
8005              
8006             Enables or disables the radio lock.
8007              
8008             Returns '00' on success or 'f0' on failure
8009              
8010              
8011             =item catOffsetfreq()
8012              
8013             $offsetfreq = $FT817->catOffsetfreq([########]);
8014              
8015             Uses 8 digits as an argument to set the offset frequency. Leading and trailing zeros required where applicable
8016             1.230 MHZ would be 00123000
8017              
8018             Returns '00' on success or 'f0' on failure
8019              
8020              
8021             =item catOffsetmode()
8022              
8023             $setoffsetmode = $FT817->catOffsetmode([POS/NEG/SIMPLEX]);
8024              
8025             Sets the mode of the radio with one of the valid modes.
8026              
8027             Returns '00' on success or 'f0' on failure
8028              
8029              
8030             =item catPower()
8031              
8032             $setPower = $FT817->catPower([ON/OFF]);
8033              
8034             Sets the power of the radio on or off. Note that this function, as stated in the manual only works
8035             Correctly when connected to DC power and NO Battery installed
8036              
8037             Returns '00' on success or 'null' on failure
8038              
8039              
8040             =item catPtt()
8041              
8042             $setptt = $FT817->catPtt([ON/OFF]);
8043              
8044             Sets the Push to talk of the radio on or off.
8045              
8046             Returns '00' on success or 'f0' on failure
8047              
8048              
8049             =item catRxstatus()
8050              
8051             $rxstatus = $FT817->catRxstatus([VARIABLES/HASH]);
8052              
8053             Retrieves the status of SQUELCH / S-METER / TONEMATCH / DESCRIMINATOR in one
8054             command and posts the information when verbose(1).
8055              
8056             Returns with variables as argument $squelch $smeter $smeterlin $desc $match
8057             Returns with hash as argument %rxstatus
8058              
8059              
8060             =item catsetFrequency()
8061              
8062             $setfreq = $FT817->catsetFrequency([########]);
8063              
8064             Uses 8 digits as an argument to set the frequency. Leading and trailing zeros required where applicable
8065             147.120 MHZ would be 14712000
8066             14.070 MHZ would be 01407000
8067              
8068             Returns '00' on success or 'f0' on failure
8069              
8070              
8071             =item catsetMode()
8072              
8073             $setmode = $FT817->catsetMode([LSB/USB/CW/CWR/AM/FM/DIG/PKT/FMN/WFM]);
8074              
8075             Sets the mode of the radio with one of the valid modes.
8076              
8077             Returns '00' on success or 'f0' on failure
8078              
8079              
8080             =item catSplitfreq()
8081              
8082             $setsplit = $FT817->catSplitfreq([ON/OFF]);
8083              
8084             Sets the radio to split the transmit and receive frequencies
8085              
8086             Returns '00' on success or 'f0' on failure
8087              
8088              
8089             =item catTxstatus()
8090              
8091             $txstatus = $FT817->catTxstatus([VARIABLES/HASH]);
8092              
8093             Retrieves the status of POWERMETER / PTT / HIGHSWR / SPLIT in one
8094             command and posts the information when verbose(1).
8095              
8096             Returns with variables as argument $pometer $ptt $highswr $split
8097             Returns with hash as argument %txstatus
8098              
8099              
8100             =item catvfoToggle()
8101              
8102             $vfotoggle = $FT817->catvfotoggle();
8103              
8104             Togles the VFO between A and B
8105              
8106             Returns '00' on success or 'f0' on failure
8107              
8108              
8109             =item closePort()
8110              
8111             $FT817->closePort();
8112              
8113             This function should be executed at the end of the program. This closes the serial port and removed the lock
8114             file if applicable. If you do not use this, and exit abnormally, you will need to manually remove the lock
8115             file if it was enabled in the settings.
8116              
8117              
8118             =item dec2bin()
8119              
8120             Simple internal function for converting decimal to binary. Has no use to the end user.
8121              
8122              
8123             =item eepromDecode()
8124              
8125             An internal function to retrieve code from an address of the eeprom and convert the first byte to
8126             binary, dumping the second byte.
8127              
8128              
8129             =item eepromDecodenext()
8130              
8131             An internal function to retrieve code from an address of the eeprom returning hex value of the next
8132             memory address up.
8133              
8134              
8135             =item eepromDoubledecode()
8136              
8137             An internal function to retrieve code from an address of the eeprom AND the next memory address up
8138             memory address up.
8139              
8140              
8141             =item get9600mic()
8142              
8143             $b9600mic = $FT817->get9600mic();
8144              
8145             MENU ITEM # 3 - Returns the setting of 9600 MIC 0-100
8146              
8147              
8148             =item getActivelist()
8149              
8150             $agc = $FT817->getActivelist();
8151              
8152             Returns a list of all Active/Visible memory Channels
8153              
8154             [FT817]@/dev/ttyUSB0/MEMORY[MEM]:# list
8155            
8156             ACTIVE MEMORY AREAS
8157             ___________________
8158              
8159             # LABEL SKIP MODE RXFREQ ENCODER TONE/DCS SHIFT RPTOFFSET
8160              
8161             1 The Zoo NO FM 147.120.00 TONE 103.5 0.5 Mhz PLUS
8162             2 N4FLA NO FM 140.000.00 TONE 103.5 0.5 Mhz PLUS
8163             3 20M PSK YES USB 14.070.15 OFF OFF 0 Mhz SIMPLEX
8164             4 20M JT65 YES USB 14.076.00 OFF OFF 0 Mhz SIMPLEX
8165             5 MAR MOBL YES USB 14.300.00 OFF OFF 0 Mhz SIMPLEX
8166              
8167              
8168             =item getAgc()
8169              
8170             $agc = $FT817->getAgc();
8171              
8172             Returns the current setting of the AGC: AUTO / FAST / SLOW / OFF
8173              
8174              
8175             =item getAmfmdial()
8176              
8177             $amfmdial = $FT817->getAmfmdial();
8178              
8179             MENU ITEM # 4 - Returns the Disable option of the AM/FM dial ENABLE / DISABLE
8180              
8181              
8182             =item getAmmic()
8183              
8184             $ammic = $FT817->getAmmic();
8185              
8186             MENU ITEM # 5 - Returns the setting of AM MIC 0-100
8187              
8188              
8189             =item getAntenna ()
8190              
8191             $antenna = $FT817->getAntenna({HF/6M/FMBCB/AIR/VHF/UHF});
8192             %antenna = $FT817->getAntenna({ALL});
8193             %antenna = $FT817->getAntenna();
8194              
8195             Returns the FRONT/BACK configuration of the antenna for the different types of
8196             bands. Returns one value when an argument is used. If the argument ALL or no
8197             argument is used will print a list of the configurations or all bands and returns
8198             a hash or the configuration
8199              
8200              
8201             =item getApotime()
8202              
8203             $apotime = $FT817->getApotime();
8204              
8205             MENU ITEM # 8 - Returns the Auto Power Off time as OFF or 1 - 6 hours
8206              
8207              
8208             =item getArts ()
8209              
8210             $arts = $FT817->getArts();
8211              
8212             Returns the status of ARTS: ON / OFF
8213              
8214              
8215             =item getArs144 ()
8216              
8217             $ars144 = $FT817->getArs144();
8218              
8219             MENU ITEM # 1 - Returns the status of 144 ARS: OFF / ON
8220              
8221              
8222             =item getArs430 ()
8223              
8224             $ars430 = $FT817->getArs430();
8225              
8226             MENU ITEM # 2 - Returns the status of 430 ARS: OFF / ON
8227              
8228              
8229             =item getArtsmode ()
8230              
8231             $artsmode = $FT817->getArtsmode();
8232              
8233             MENU ITEM # 9 - Returns the status of ARTS BEEP: OFF / RANGE /ALL
8234              
8235              
8236             =item getBacklight ()
8237              
8238             $backlight = $FT817->getBacklight();
8239              
8240             MENU ITEM # 10 - Returns the status of the Backlight: OFF / ON / AUTO
8241              
8242              
8243             =item getBeepfreq ()
8244              
8245             $beepfreq = $FT817->getBeepfreq();
8246              
8247             MENU ITEM # 12 - Returns the BEEP Frequency of the radio : 440 / 880
8248              
8249              
8250             =item getBeepvol ()
8251              
8252             $beepvol = $FT817->getBeepvol();
8253              
8254             MENU ITEM # 13 - Returns the BEEP VOLUME of the radio : 0 - 100
8255              
8256              
8257             =item getBk ()
8258              
8259             $bk = $FT817->getBk();
8260              
8261             Returns the status of Break-in (BK) ON / OFF
8262            
8263              
8264             =item getCatrate()
8265              
8266             $catrate = $FT817->getCatrate();
8267              
8268             MENU ITEM # 14 - Returns the CAT RATE (4800/9600/38400)
8269              
8270              
8271             =item getCharger()
8272              
8273             $charger = $FT817->getCharger();
8274              
8275             Returns the status of the battery charger. Verbose will show the status and if the
8276             status is on, how many hours the battery is set to charge for.
8277              
8278              
8279             =item getChargetime()
8280              
8281             $chargetime = $FT817->getChargetime();
8282              
8283             MENU ITEM # 11 - Returns how many hours the charger is set for in the config. 6/8/10
8284              
8285              
8286             =item getChecksum()
8287              
8288             $checksum = $FT817->getChecksum();
8289              
8290             Returns the checksum bits in EEPROM areas 0x00 through 0x03
8291              
8292              
8293             =item getColor()
8294              
8295             $color = $FT817->getColor();
8296              
8297             MENU ITEM # 15 - Returns the Color of the LCD display (BLUE/AMBER)
8298              
8299              
8300             =item getConfig()
8301              
8302             $config = $FT817->getConfig();
8303              
8304             Returns the two values that make up the Radio configuration. This is set by the soldier blobs
8305             of J4001-J4009 in the radio.
8306              
8307              
8308             =item getContrast()
8309              
8310             $contrast = $FT817->getContrast();
8311              
8312             MENU ITEM # 16 - Returns the Contrast of the LCD display (1-12)
8313              
8314              
8315             =item getCurrentmem()
8316              
8317             $currentmem = $FT817->getCurrentmem();
8318              
8319             Returns the currently selected memory area that appears on startup [0-200] or M-PL, M-PU
8320              
8321              
8322             =item getCwdelay()
8323              
8324             $cwdelay = $FT817->getCwdelay();
8325              
8326             MENU ITEM # 17 - Shows CW Delay 10-2500 ms
8327              
8328              
8329             =item getCwid()
8330              
8331             $cwid = $FT817->getCwid();
8332              
8333             MENU ITEM # 18 - Shows if CW ID is ON / OFF
8334              
8335              
8336             =item getCwpaddle()
8337              
8338             $cwpaddle = $FT817->getCwpaddle();
8339              
8340             MENU ITEM # 19 - Shows if CW Paddle is NORMAL / REVERSE
8341              
8342              
8343             =item getCwpitch()
8344              
8345             $cwpitch = $FT817->getCwpitch();
8346              
8347             MENU ITEM # 20 - Shows the CW Pitch 300-1000 Hz
8348              
8349              
8350             =item getCwspeed()
8351              
8352             $cwspeed = $FT817->getCwspeed();
8353              
8354             MENU ITEM # 21 - Returns the speed of CW in WPM
8355              
8356              
8357             =item getCwweight()
8358              
8359             $cwweight = $FT817->getCwweight();
8360             $cwweight = $FT817->getCwweight('1');
8361              
8362             MENU ITEM # 22 - Returns the Weight of CW [1:2.5 - 1:4.5] with no option
8363             Returns the Weight of CW [2.5 - 4.5] with no option
8364              
8365              
8366             =item getDcsinv()
8367              
8368             $dcsinv = $FT817->getDcsinv();
8369              
8370             MENU ITEM # 53 - Returns the Setting DCS encoding, normal or inverted
8371             [TN-RN/TN-RIV/TIV-RN/TIV-RIV]
8372              
8373              
8374             =item getDigdisp()
8375              
8376             $digdisp = $FT817->getDigdisp();
8377              
8378             MENU ITEM # 24 - Shows the Digital Frequency Offset -3000 to +3000 Hz
8379              
8380              
8381             =item getDigmic()
8382              
8383             $digmic = $FT817->getDigmic();
8384              
8385             MENU ITEM # 25 - Returns the setting of DIG MIC 0-100
8386              
8387              
8388             =item getDigmode()
8389              
8390             $digmode = $FT817->getDigmode();
8391              
8392             MENU ITEM # 26 - Returns the Setting of the Digital mode
8393             [RTTY/PSK31-L/PSK31-U/USER-L/USER-U]
8394              
8395              
8396             =item getDigshift()
8397              
8398             $digshift = $FT817->getDigshift();
8399              
8400             MENU ITEM # 27 - Shows the Digital Shift -3000 to +3000 Hz
8401              
8402              
8403             =item getDsp()
8404              
8405             $dsp = $FT817->getDsp();
8406              
8407             Returns the current setting of the Digital Signal Processor (if applicable) : ON / OFF
8408              
8409              
8410             =item getDw()
8411              
8412             $dw = $FT817->getDw();
8413              
8414             Returns the status of Dual Watch (DW) ON / OFF
8415              
8416              
8417             =item getEeprom()
8418              
8419             $value = $FT817->getEeprom();
8420              
8421             Currently returns just the value you send it. In verbose mode however, it will display a formatted
8422             output of the memory address specified.
8423              
8424             With one argument it will display the information about a memory address
8425              
8426             [FT817]@/dev/ttyUSB0$ get eeprom 005f
8427              
8428             ADDRESS BINARY DECIMAL VALUE
8429             ___________________________________________________
8430             005F 11100101 229 E5
8431              
8432              
8433             With two arguments it will display information on a range of addresses
8434              
8435             [FT817]@/dev/ttyUSB0$ get eeprom 005f 0062
8436              
8437             ADDRESS BINARY DECIMAL VALUE
8438             ___________________________________________________
8439             005F 11100101 229 E5
8440             0060 00011001 25 19
8441             0061 00110010 50 32
8442             0062 10001000 136 88
8443              
8444              
8445             =item getEmergency()
8446              
8447             $emergency = $FT817->getEmergency();
8448              
8449             MENU ITEM # 28 - Shows if Emergency is set to ON / OFF
8450              
8451              
8452             =item getExtmenu()
8453              
8454             $extmenu = $FT817->getExtmenu();
8455              
8456             MENU ITEM # 52 - Shows the Extended Menu Setting ON /OFF
8457              
8458              
8459             =item getFasttuning()
8460              
8461             $fasttune = $FT817->getFasttuning();
8462              
8463             Returns the current setting of the Fast Tuning mode : ON / OFF
8464              
8465              
8466             =item getFlags()
8467              
8468             $flags = $FT817->getFlags();
8469              
8470             Returns the current status of the flags : DEBUG / VERBOSE / WRITE ALLOW / WARNED
8471              
8472              
8473             =item getFmmic()
8474              
8475             $fmmic = $FT817->getFmmic();
8476              
8477             MENU ITEM # 29 - Returns the setting of FM MIC 0-100
8478              
8479              
8480             =item getHome()
8481              
8482             $home = $FT817->getHome();
8483              
8484             Returns the current status of the rig being on the Home Frequency : Y/N
8485              
8486              
8487             =item getId()
8488              
8489             $id = $FT817->getId();
8490              
8491             MENU ITEM # 31 - Returns the charachers for CWID
8492              
8493              
8494             =item getKyr()
8495              
8496             $kyr = $FT817->getKyr();
8497              
8498             Returns the current status of the Keyer (KYR) : ON/OFF
8499              
8500              
8501             =item getLock()
8502              
8503             $lock = $FT817->getLock();
8504              
8505             Returns the current status of the Lock : ON/OFF
8506              
8507              
8508             =item getLockmode()
8509              
8510             $lockmode = $FT817->getLockmode();
8511              
8512             MENU ITEM # 32 - Returns the Lock Mode DIAL / FREQ / PANEL
8513              
8514              
8515             =item getMainstep()
8516              
8517             $mainstep = $FT817->getMainstep();
8518              
8519             MENU ITEM # 33 - Returns the Main Step COURSE / FINE
8520              
8521              
8522             =item getMemgroup()
8523              
8524             $memgroup = $FT817->getMemgroup();
8525              
8526             MENU ITEM # 34 - Returns Status of Memory groups ON / OFF
8527              
8528              
8529             =item getMemmap()
8530              
8531             $Memory = $FT817->getMemmap([1-200 / M-PL / M-PU]);
8532              
8533             Returns the given memory number as Active or Inactive
8534              
8535              
8536             =item getMickey()
8537              
8538             $mickey = $FT817->getMickey();
8539              
8540             MENU ITEM # 36 - Returns Status of MIC KEY ON / OFF
8541              
8542              
8543             =item getMicscan()
8544              
8545             $micscan = $FT817->getMicscan();
8546              
8547             MENU ITEM # 37 - Returns Status of MIC SCAN ON / OFF
8548              
8549              
8550             =item getMtqmb()
8551              
8552             $mtqmb = $FT817->getMtqmb();
8553              
8554             Returns the current Status of MTQMB : ON / OFF
8555              
8556              
8557             =item getMtune()
8558              
8559             $mtune = $FT817->getMtune();
8560              
8561             Returns the current Status of MTUNE : MTUNE / MEMORY
8562              
8563              
8564             =item getNb()
8565              
8566             $nb = $FT817->getNb();
8567              
8568             Returns the current Status of the Noise Blocker : ON / OFF
8569              
8570              
8571             =item getOpfilter()
8572              
8573             $opfilter = $FT817->getOpfilter();
8574              
8575             MENU ITEM # 38 - Returns the OP Filter setting OFF / SSB / CW
8576              
8577              
8578             =item getPktmic()
8579              
8580             $pktmic = $FT817->getPktmic();
8581              
8582             MENU ITEM # 39 - Returns the setting of PKT MIC 0-100
8583              
8584              
8585             =item getPktrate()
8586              
8587             $pktrate = $FT817->getPktrate();
8588              
8589             MENU ITEM # 40 - Returns the Packet Rate 1200 / 9600 Baud
8590              
8591              
8592             =item getPbt()
8593              
8594             $pbt = $FT817->getPbt();
8595              
8596             Returns the status of Pass Band Tuning: ON /OFF
8597              
8598              
8599             =item getPri()
8600              
8601             $pri = $FT817->getPri();
8602              
8603             Returns the status of Priority Scaning Feature: ON /OFF
8604              
8605              
8606             =item getPwrmtr()
8607              
8608             $pwrmtr = $FT817->getPwrmtr();
8609              
8610             Returns the current Setting of the Power meter : PWR / ALC / SWR / MOD
8611              
8612              
8613             =item getQmb()
8614              
8615             $qmb = $FT817->getQmb();
8616              
8617             Returns the current Status of QMB : ON / OFF
8618              
8619              
8620             =item getResumescan()
8621              
8622             $resumescan = $FT817->getResumescan();
8623              
8624             MENU ITEM # 41 - Returns the RESUME(scan) setting OFF / 3,5,10 SEC
8625              
8626              
8627             =item getRfknob()
8628              
8629             $rfknob = $FT817->getRfknob();
8630              
8631             MENU ITEM # 45 - Returns the current Functionality of the RF-GAIN Knob : RFGAIN / SQUELCH
8632              
8633              
8634             =item getRlsbcar()
8635              
8636             $rlsbcar = $FT817->getRlsbcar();
8637              
8638             MENU ITEM # 54 - Shows the Rx Carrier point for LSB -000 to +300 Hz
8639              
8640              
8641             =item getRusbcar()
8642              
8643             $rusbcar = $FT817->getRlsbcar();
8644              
8645             MENU ITEM # 55 - Shows the Rx Carrier point for USB -000 to +300 Hz
8646              
8647              
8648             =item getScn()
8649              
8650             $pwrmtr = $FT817->getScn();
8651              
8652             Returns the current function of the Scan Feature : OFF / UP / DOWN
8653              
8654              
8655             =item getScope()
8656              
8657             $scope = $FT817->getScope();
8658              
8659             MENU ITEM # 43 - Returns the Setting for SCOPE : Continuous / CHK (every 10 sec)
8660              
8661              
8662             =item getSidetonevol()
8663              
8664             $sidetonevol = $FT817->getSidetonevol();
8665              
8666             MENU ITEM # 44 - Returns the Sidetone Volume 0-100
8667              
8668              
8669             =item getSpl()
8670              
8671             $spl = $FT817->getSpl();
8672              
8673             Returns the current Status of SPL, Split Frequency : ON / OFF
8674              
8675              
8676             =item getSsbmic()
8677              
8678             $ssbmic = $FT817->getSsbmic();
8679              
8680             MENU ITEM # 46 - Returns the Value of SSB MIC 0-100
8681              
8682              
8683             =item getSoftcal()
8684              
8685             $softcal = $FT817->getSoftcal({console/digest/file filename.txt});
8686              
8687             This command currently works with verbose and write to file. Currently there is no
8688             usefull return information Except for digest. With no argument, it defaults to
8689             console and dumps the entire 76 software calibration memory areas to the screen.
8690             Using digest will return an md5 hash of the calibration settings. Using file along
8691             with a file name writes the output to a file. It's a good idea to keep a copy of
8692             this in case the eeprom gets corrupted and the radio factory defaults. If you dont have
8693             this information, you will have to send the radio back to the company for recalibration.
8694              
8695              
8696             =item getTlsbcar()
8697              
8698             $tlsbcar = $FT817->getTlsbcar();
8699              
8700             MENU ITEM # 56 - Shows the Tx Carrier point for LSB -000 to +300 Hz
8701              
8702              
8703             =item getTusbcar()
8704              
8705             $tusbcar = $FT817->getTusbcar();
8706              
8707             MENU ITEM # 57 - Shows the Tx Carrier point for USB -000 to +300 Hz
8708              
8709              
8710             =item getTottime()
8711              
8712             $tottime = $FT817->getTottime();
8713              
8714             MENU ITEM # 49 - Returns the Value of the Time out Timer in Minutes
8715              
8716              
8717             =item getTuner()
8718              
8719             $tuner = $FT817->getTuner();
8720              
8721             Returns the current tuner setting : VFO / MEMORY
8722              
8723              
8724             =item getTxpower()
8725              
8726             $txpower = $FT817->getTxpower();
8727              
8728             Returns the current Transmit power level : HIGH / LOW3 / LOW2 / LOW1
8729              
8730              
8731             =item getVfo()
8732              
8733             $vfo = $FT817->getVfo();
8734              
8735             Returns the current VFO : A / B
8736              
8737              
8738             =item getVfoband()
8739              
8740             $vfoband = $FT817->getVfoband([A/B]);
8741              
8742             Returns the current band of a given VFO
8743              
8744              
8745             =item getVlt()
8746              
8747             $vlt = $FT817->getVlt();
8748              
8749             Returns if the voltage display is ON or OFF
8750              
8751              
8752             =item getVox()
8753              
8754             $vox = $FT817->getVox();
8755              
8756             Returns the status of VOX : ON / OFF
8757              
8758              
8759             =item getVoxdelay()
8760              
8761             $voxdelay = $FT817->getVoxdelay();
8762              
8763             MENU ITEM # 50 - Returns the VOX Delay (100-2500)ms
8764              
8765              
8766             =item getVoxgain()
8767              
8768             $voxgain = $FT817->getVoxgain();
8769              
8770             MENU ITEM # 51 - Returns the VOX Gain (1-100)
8771              
8772              
8773             =item hex2bin()
8774              
8775             Simple internal function for convrting hex to binary. Has no use to the end user.
8776              
8777              
8778             =item hexAdder()
8779              
8780             Internal function to incriment a given hex value off a base address
8781              
8782              
8783             =item hexDiff()
8784              
8785             Internal function to return decimal value as the difference between two hex numbers
8786              
8787              
8788             =item loadConfig()
8789              
8790             $output = $FT817->loadConfig([filename]);
8791              
8792             This will restore the radio configuration from a file using the FT817OS format overwriting
8793             the existing radio config
8794              
8795             Without a filename this will load the config from the default file FT817.cfg
8796              
8797              
8798             =item loadMemory()
8799              
8800             $output = $FT817->loadMemory([filename]);
8801              
8802             This will restore the radio memory from a file using the FT817OS format overlapping
8803             the existing radio memory. Whichever valid memory areas were saved at the time will
8804             be the ones overwritten. If you create, between the last save, other memory areas
8805             within the radio they will not be updated. If you want an accurate reload of the memory
8806             be sure to use save memory after making changes to memory areas.
8807              
8808             Without a filename this will load the config from the default file FT817.mem
8809              
8810              
8811             =item moduleVersion()
8812              
8813             $version = $FT817->moduleVersion();
8814              
8815             Returns the version of FT817COMM.pm to the software calling it.
8816              
8817              
8818             =item new()
8819              
8820             my $FT817 = new Ham::Device::FT817COMM (
8821             serialport => '/dev/ttyUSB0',
8822             baud => '38400',
8823             lockfile => '/var/lock/ft817'
8824             );
8825              
8826             Creates an instance of the device that is the Radio. Called at the beginning of the program.
8827             See the Constructors section for more info.
8828              
8829              
8830             =item quietToggle()
8831              
8832             $output = $FT817->quiettoggle();
8833              
8834             This is an internal function to toggle the vfo with verbose off. To cut down on repetative code
8835              
8836             Returns 0
8837              
8838              
8839             =item quietHometoggle()
8840              
8841             $output = $FT817->quiettoggle();
8842              
8843             This is an internal function to toggle the HOME with verbose off. To cut down on repetative code
8844              
8845             Returns 0
8846              
8847              
8848             =item quietTunetoggle()
8849              
8850             $output = $FT817->quiettoggle();
8851              
8852             This is an internal function to toggle the MEMORY / VFO with verbose off. To cut down on repetative code
8853              
8854             Returns 0
8855              
8856              
8857             =item rangeCheck()
8858              
8859             $band = $FT817->rangeCheck([FREQNENCY]);
8860              
8861             This is an internal function to check the FREQRANGE hash to see what band the given frequency is in
8862              
8863             Returns BAND
8864              
8865              
8866             =item readMemvfo ()
8867              
8868             my $option = $FT817->readMemvfo('[A/B]', '[BAND]', '[OPTION]');
8869             my $option = $FT817->readMemvfo('[MTUNE/MTQMB]','[OPTION]');
8870              
8871             Reads and returns information from the VFO memory given a VFO [A/B] and a BAND [20M/40M/70CM] etc..
8872             Reads and returns information from the VFO for [MTUNE/MTQMB] doesn't take a band argument.
8873             This is only for VFO memory's and not the Stored Memories nor Home Memories. Leave OPTION empty to
8874             Return a hash with all OPTIONS below
8875              
8876             Returns information based on one of the valid options:
8877              
8878             MODE - Returns the mode in memory - update only appears after toggling the VFO
8879             NARFM - Returns if Narrow FM os ON or OFF
8880             NARCWDIG - Returns if the CW or Digital Mode is on Narrow
8881             RPTOFFSET - Returns the Repeater offset
8882             TONEDCS - Returns type type of tone being used
8883             ATT - Returns if ATT is on if applicable, if not shows OFF
8884             IPO - Returns if IPO is on if applicable, if not shows OFF
8885             FMSTEP - Returns the setting for FM STEP in KHZ
8886             AMSTEP - Returns the setting for AM STEP in KHZ
8887             SSBSTEP - Returns the setting for SSB STEP in KHZ
8888             CTCSSTONE - Returns the currently set CTCSS Tone
8889             DCSCODE - Returns the currently set DCS Code
8890             CLARIFIER - Returns if the CLARIFIER is on or off
8891             CLAROFFSET - Returns the polarity and offset frequency of the clarifier stored on EEPROM
8892             RXFREQ - Returns the stored Receive Frequency
8893             RPTOFFSETFREQ - Returns the stored Repeater offset Frequency
8894              
8895             The CLAROFFSET is the stored value in the VFO not the active one. The EEPROM doesnt write everytime
8896             you turn the clarifer adjustment. When using the CAT command to set the CLARIFIERFREQ this value will
8897             not update, only when set directly in the VFO mem will it show a live update
8898              
8899             If you have never used the QMB/MTQMB option on the radio, the memory addresses will show garbled data.
8900             Its simply easier to first send some arbitrary data to the channels in the radio by following the instructions
8901             on manual page 44. This is not a requirment, if you dont use QMB or MTQMB you do not need to do this.
8902              
8903              
8904             =item readMemory()
8905              
8906             my $option = $FT817->readMemory('[MEM]','[1-200 / M-PL / M-PU]','[OPTION]');
8907             my $option = $FT817->readMemory('[HOME]','[BAND]','[OPTION]');
8908             my $option = $FT817->readMemory('[QMB]','[OPTION]');
8909              
8910             Reads and returns information from the Memory given a Memory area [MEM/HOME] and a TYPE [NUM or BAND] etc..
8911             Reads and returns information from the Memory for [QMB] doesn't take a type argument.
8912             This is only for Stored Memories not VFO nor Home Memories. Leave OPTION empty to
8913             Return a hash with all OPTIONS below
8914              
8915             Returns information based on one of the valid options:
8916              
8917             READY - Returns if the ready bit is set after proper data is set in memory bank
8918             MODE - Returns the mode in memory
8919             HFVHF - Returns if the memory area is HF or VHF
8920             TAG - Returns if set to show Frequency or Label on the Display
8921             FREQRANGE - Returns the Frequency range of the memory area HF / 6m / FMBCB / AIR / 2m / UHF
8922             NARFM - Returns if Narrow FM os ON or OFF
8923             NARCWDIG - Returns if the CW or Digital Mode is on Narrow
8924             UHF - Returns if the memory area is UHF or not
8925             RPTOFFSET - Returns the Repeater offset
8926             TONEDCS - Returns type type of tone being used
8927             ATT - Returns if ATT is on if applicable, if not shows OFF
8928             IPO - Returns if IPO is on if applicable, if not shows OFF
8929             MEMSKIP - Returns if the memory is skipped on scan or not
8930             FMSTEP - Returns the setting for FM STEP in KHZ
8931             AMSTEP - Returns the setting for AM STEP in KHZ
8932             SSBSTEP - Returns the setting for SSB STEP in KHZ
8933             CTCSSTONE - Returns the currently set CTCSS Tone
8934             DCSCODE - Returns the currently set DCS Code
8935             CLARIFIER - Returns if the CLARIFIER is on or off
8936             CLAROFFSET - Returns the polarity and offset frequency of the clarifier stored on EEPROM
8937             RXFREQ - Returns the stored Receive Frequency
8938             RPTOFFSETFREQ - Returns the stored Repeater offset Frequency
8939             LABEL - Returns the 8 character label for the memory area or ???????? if empty
8940              
8941             If you have never used the QMB/MTQMB option on the radio, the memory addresses will show garbled data.
8942             Its simply easier to first send some arbitrary data to the channels in the radio by following the instructions
8943             on manual page 44. This is not a requirment, if you dont use QMB or MTQMB you do not need to do this.
8944              
8945              
8946             =item rebuildSoftcal()
8947              
8948             $status = $FT817->rebuildSoftcal([filename]);
8949              
8950             This command is used to reload all of the software calibration settings for the FT817 in the event
8951             that either the software calibration had become corrupted, or a master reset was needed for the rig.
8952             This reload uses the FT817OS 'cal' file format to reload data. If you did not backup your cal settings
8953             then this will be of little use and the rig will have to go to the factory to be recalibrated.
8954              
8955             You can call the command without an argument to use the default file name FT817.cal
8956              
8957             The cal file must be in the directory where you are running the program which calls it. The program will
8958             ensure the file exists, and the data is correct before it attempts to write it to the Eeprom. If it finds
8959             an error it will tell you what line of the cal file produced the error and stop.
8960              
8961             Note that this will start writing data if the cal file is error free and not provide any user prompt
8962              
8963             Returns 0 on sucessfull write of the 76 bytes
8964             Returns 1 on Error
8965              
8966              
8967             =item restoreEeprom()
8968              
8969             $restorearea = $FT817->restoreEeprom();
8970              
8971             This restores a specific memory area of the EEPROM back to a known good default value.
8972             This is a WRITEEEPROM based function and requires both setWriteallow() and agreeWithwarning()
8973             to be set to 1.
8974             This command does not allow for an arbitrary address to be written.
8975            
8976             Currently
8977             [0055] [0057] [0058] [0059] [0060]
8978             [005B] [005C] [005D] [005E] [005F]
8979             [0061] [0062] [0063] [0064] [0065]
8980             [0066] [0067] [0068] [0069] [006A]
8981             [006B] [006C] [006D] [006E] [006F]
8982             [0070] [0071] [0072] [0073] [0074]
8983             [0079] [007A] [007B] [044F]
8984            
8985             are allowed
8986              
8987             restoreEeprom('005F');
8988              
8989             Returns 'OK' on success. Any other output an error.
8990              
8991              
8992             =item saveConfig()
8993              
8994             $output = $FT817->saveConfig([filename]);
8995              
8996             This will backup the radio configuration to a file using the FT817OS format so that it can
8997             be restored, if needed.
8998              
8999             Without a filename this will write the config to the default file FT817.cfg and if that file
9000             already exists, overwrite it.
9001              
9002              
9003             =item saveMemory()
9004              
9005             $output = $FT817->saveMemory([filename]);
9006              
9007             This will backup the regular memory areas 1-200 and M-PL M-PU to a file using the FT817OS
9008             format so that it can be restored, if needed. This will capture both active and inactive
9009             memory areas provided the memory area is correctly formatted and the READY bit is high.
9010              
9011             Without a filename this will write the memory to the default file FT817.mem and if that file
9012             already exists, overwrite it.
9013              
9014              
9015             =item sendCat()
9016              
9017             Internal function, if you try to call it, you may very well end up with a broken radio.
9018             You have been warned.
9019              
9020              
9021             =item set9600mic()
9022              
9023             $status = $FT817->set9600mic([0-100]);
9024              
9025             MENU ITEM # 3 Sets the 9600 MIC
9026              
9027             This is a WRITEEEPROM based function and requires both setWriteallow() and
9028             agreeWithwarning() to be set to 1.
9029              
9030             In the event of a failure, the memory area can be restored with. The following
9031             command that also requires both flags previously mentioned set to 1.
9032              
9033             restoreEeprom('006C');
9034              
9035              
9036             =item setAgc()
9037              
9038             $status = $FT817->setAgc([AUTO/FAST/SLOW/OFF];
9039              
9040             Sets the agc
9041              
9042             This is a WRITEEEPROM based function and requires both setWriteallow() and
9043             agreeWithwarning() to be set to 1.
9044              
9045             In the event of a failure, the memory area can be restored with. The following
9046             command that also requires both flags previously mentioned set to 1.
9047              
9048             restoreEeprom('0057');
9049              
9050              
9051             =item setAmfmdial()
9052              
9053             $status = $FT817->setAmfmdial([ENABLE/DISABLE]);
9054              
9055             MENU ITEM # 4 Sets the function of the dial when using AM or FM
9056              
9057             This is a WRITEEEPROM based function and requires both setWriteallow() and
9058             agreeWithwarning() to be set to 1.
9059              
9060             In the event of a failure, the memory area can be restored with. The following
9061             command that also requires both flags previously mentioned set to 1.
9062              
9063             restoreEeprom('0063');
9064              
9065              
9066             =item setAmmic()
9067              
9068             $status = $FT817->setAmmic([0-100]);
9069              
9070             MENU ITEM # 5 Sets the AM MIC
9071              
9072             This is a WRITEEEPROM based function and requires both setWriteallow() and
9073             agreeWithwarning() to be set to 1.
9074              
9075             In the event of a failure, the memory area can be restored with. The following
9076             command that also requires both flags previously mentioned set to 1.
9077              
9078             restoreEeprom('0068');
9079              
9080              
9081             =item setAntenna()
9082              
9083             $status = $FT817->setAntenna([HF/6M/FMBCB/AIR/VHF/UHF] [FRONT/BACK]);
9084              
9085             Sets the antenna for the given band as connected on the FRONT or REAR of the radio
9086              
9087             This is a WRITEEEPROM based function and requires both setWriteallow() and
9088             agreeWithwarning() to be set to 1.
9089              
9090             In the event of a failure, the memory area can be restored with. The following
9091             command that also requires both flags previously mentioned set to 1.
9092              
9093             restoreEeprom('007A');
9094              
9095              
9096             =item setApotime()
9097              
9098             $status = $FT817->setApotime([OFF/1-6]);
9099              
9100             MENU ITEM # 8 Sets the Auto Power Off time to OFF or 1-6 hours
9101              
9102             This is a WRITEEEPROM based function and requires both setWriteallow() and
9103             agreeWithwarning() to be set to 1.
9104              
9105             In the event of a failure, the memory area can be restored with. The following
9106             command that also requires both flags previously mentioned set to 1.
9107              
9108             restoreEeprom('0065');
9109              
9110              
9111             =item setArs144()
9112              
9113             $status = $FT817->setArs144([OFF/ON]);
9114              
9115             MENU ITEM # 1 Sets the 144 ARS ON or OFF
9116              
9117             This is a WRITEEEPROM based function and requires both setWriteallow() and
9118             agreeWithwarning() to be set to 1.
9119              
9120             In the event of a failure, the memory area can be restored with. The following
9121             command that also requires both flags previously mentioned set to 1.
9122              
9123             restoreEeprom('005F');
9124              
9125              
9126             =item setArs430()
9127              
9128             $status = $FT817->setArs430([OFF/ON]);
9129              
9130             MENU ITEM # 2 Sets the 430 ARS ON or OFF
9131              
9132             This is a WRITEEEPROM based function and requires both setWriteallow() and
9133             agreeWithwarning() to be set to 1.
9134              
9135             In the event of a failure, the memory area can be restored with. The following
9136             command that also requires both flags previously mentioned set to 1.
9137              
9138             restoreEeprom('005F');
9139              
9140             =item setArts()
9141              
9142             $arts = $FT817->setArts([ON/OFF]);
9143              
9144             Sets the ARTS function of the radio to ON or OFF
9145              
9146             This is a WRITEEEPROM based function and requires both setWriteallow() and
9147             agreeWithwarning() to be set to 1.
9148              
9149             In the event of a failure, the memory area can be restored with. The following
9150             command that also requires both flags previously mentioned set to 1.
9151              
9152             restoreEeprom('0079');
9153              
9154              
9155             =item setArtsmode()
9156              
9157             $artsmode = $FT817->setArts([OFF/RANGE/BEEP]);
9158              
9159             MENU ITEM # 9 Sets the ARTS function of the radio when ARTS is enabled
9160              
9161             This is a WRITEEEPROM based function and requires both setWriteallow() and
9162             agreeWithwarning() to be set to 1.
9163              
9164             In the event of a failure, the memory area can be restored with. The following
9165             command that also requires both flags previously mentioned set to 1.
9166              
9167             restoreEeprom('005D');
9168              
9169             =item setBacklight()
9170              
9171             $status = $FT817->setBacklight([OFF/ON/AUTO]);
9172              
9173             MENU ITEM # 10 Sets the Backlight of the radio
9174              
9175             This is a WRITEEEPROM based function and requires both setWriteallow() and
9176             agreeWithwarning() to be set to 1.
9177              
9178             In the event of a failure, the memory area can be restored with. The following
9179             command that also requires both flags previously mentioned set to 1.
9180              
9181             restoreEeprom('005B');
9182              
9183              
9184             =item setBeepfreq()
9185              
9186             $status = $FT817->setBeepfreq([440/880]);
9187              
9188             MENU ITEM # 13 Sets the frequency of the radio beep
9189              
9190             This is a WRITEEEPROM based function and requires both setWriteallow() and
9191             agreeWithwarning() to be set to 1.
9192              
9193             In the event of a failure, the memory area can be restored with. The following
9194             command that also requires both flags previously mentioned set to 1.
9195              
9196             restoreEeprom('005C');
9197              
9198              
9199             =item setBeepvol()
9200              
9201             $status = $FT817->setBeepvol([1-100]);
9202              
9203             MENU ITEM # 13 Sets the volume of the radio beep
9204              
9205             This is a WRITEEEPROM based function and requires both setWriteallow() and
9206             agreeWithwarning() to be set to 1.
9207              
9208             In the event of a failure, the memory area can be restored with. The following
9209             command that also requires both flags previously mentioned set to 1.
9210              
9211             restoreEeprom('005C');
9212              
9213              
9214             =item setBitwatch()
9215              
9216             $bitwatch = $FT817->setBitwatch([#]);
9217              
9218             Turns on and off the internal BITWATCHER. Sends an alert when a value in eeprom changed
9219             from that lister in the BITWATCHER hash. Will Dramatically slow down the software and is
9220             there just to help in identifing unknown memory areas. When in doubt, leave it set to off.
9221              
9222             Activated when any value is in the (). Good practice says () or (1) for OFF and ON.
9223              
9224             Returns the argument sent to it on success.
9225              
9226              
9227             =item setBk()
9228              
9229             $status = $FT817->setBk([ON/OFF]);
9230              
9231             Sets the CW Break-in (BK) ON or OFF
9232              
9233             This is a WRITEEEPROM based function and requires both setWriteallow() and
9234             agreeWithwarning() to be set to 1.
9235              
9236             In the event of a failure, the memory area can be restored with. The following
9237             command that also requires both flags previously mentioned set to 1.
9238              
9239             restoreEeprom('0058');
9240              
9241              
9242             =item setCatrate()
9243              
9244             $status = $FT817->setCatrate([4800/9600/38400]);
9245              
9246             MENU ITEM # 14 Sets the Baud rate of the CAT interface
9247            
9248             Takes effect on next radio restart, be sure to update value baud in new().
9249              
9250             This is a WRITEEEPROM based function and requires both setWriteallow() and
9251             agreeWithwarning() to be set to 1.
9252              
9253             In the event of a failure, the memory area can be restored with. The following
9254             command that also requires both flags previously mentioned set to 1.
9255              
9256             restoreEeprom('0064');
9257              
9258              
9259             =item setCharger()
9260              
9261             $charger = $FT817->setCharger([ON/OFF]);
9262              
9263             Turns the battery Charger on or off
9264             This is a WRITEEEPROM based function and requires both setWriteallow() and
9265             agreeWithwarning() to be set to 1.
9266              
9267             In the event of a failure, the memory area can be restored with. The following
9268             command that also requires both flags previously mentioned set to 1.
9269              
9270             restoreEeprom('007B');
9271              
9272              
9273             =item setChargetime()
9274              
9275             $chargetime = $FT817->setChargetime([6/8/10]);
9276              
9277             MENU ITEM # 11
9278              
9279             Sets the Battery charge time to 6, 8 or 10 hours. If the charger is currently
9280             on, it will return an error and not allow the change. Charger must be off.
9281             This is a WRITEEEPROM based function and requires both setWriteallow() and
9282             agreeWithwarning() to be set to 1.
9283              
9284             In the event of a failure, the memory area can be restored with. The following
9285             commands that also requires both flags previously mentioned set to 1.
9286              
9287             restoreEeprom('0062');
9288             restoreEeprom('007B');
9289              
9290             Returns 'OK' on success. Any other output an error.
9291              
9292              
9293             =item setColor()
9294              
9295             $output = $FT817->setColor([BLUE/AMBER]);
9296              
9297             MENU ITEM # 15
9298              
9299             Sets the Color of the LCD screen
9300              
9301             This is a WRITEEEPROM based function and requires both setWriteallow() and
9302             agreeWithwarning() to be set to 1.
9303              
9304             In the event of a failure, the memory area can be restored with. The following
9305             command that also requires both flags previously mentioned set to 1.
9306              
9307             restoreEeprom('005B');
9308              
9309              
9310             =item setContrast()
9311              
9312             $output = $FT817->setContrast([1-12]);
9313              
9314             MENU ITEM # 16
9315              
9316             Sets the Contrast of the LCD screen, this seems to only update the screen
9317             after a power cycle, either manually, or by CAT command
9318              
9319             This is a WRITEEEPROM based function and requires both setWriteallow() and
9320             agreeWithwarning() to be set to 1.
9321              
9322             In the event of a failure, the memory area can be restored with. The following
9323             command that also requires both flags previously mentioned set to 1.
9324              
9325             restoreEeprom('005B');
9326              
9327              
9328             =item setCurrentmem()
9329              
9330             $output = $FT817->setCurrentmem([0-200] or [M-PU/M-PL]);
9331              
9332             Sets the current memory channel of the radio
9333              
9334             This is a WRITEEEPROM based function and requires both setWriteallow() and
9335             agreeWithwarning() to be set to 1.
9336              
9337             In the event of a failure, the memory area can be restored with. The following
9338             command that also requires both flags previously mentioned set to 1.
9339              
9340             restoreEeprom('044F');
9341              
9342              
9343             =item setCwdelay()
9344              
9345             $output = $FT817->setCwdelay([10-2500]);
9346              
9347             MENU ITEM # 17
9348              
9349             Sets the CW Delay between 10 - 2500 ms in incriments of 10
9350              
9351             This is a WRITEEEPROM based function and requires both setWriteallow() and
9352             agreeWithwarning() to be set to 1.
9353              
9354             In the event of a failure, the memory area can be restored with. The following
9355             command that also requires both flags previously mentioned set to 1.
9356              
9357             restoreEeprom('0060');
9358              
9359              
9360             =item setCwid()
9361              
9362             $output = $FT817->setCwid([ON/OFF]);
9363              
9364             MENU ITEM # 18
9365              
9366             Sets the CW ID to ON or OFF
9367              
9368             This is a WRITEEEPROM based function and requires both setWriteallow() and
9369             agreeWithwarning() to be set to 1.
9370              
9371             In the event of a failure, the memory area can be restored with. The following
9372             command that also requires both flags previously mentioned set to 1.
9373              
9374             restoreEeprom('005D');
9375              
9376              
9377             =item setCwpitch()
9378              
9379             $output = $FT817->setCwpitch([300-1000]);
9380              
9381             MENU ITEM # 20
9382              
9383             Sets the CW Pitch from 300 to 1000 hz in incriments of 50
9384              
9385             This is a WRITEEEPROM based function and requires both setWriteallow() and
9386             agreeWithwarning() to be set to 1.
9387              
9388             In the event of a failure, the memory area can be restored with. The following
9389             command that also requires both flags previously mentioned set to 1.
9390              
9391             restoreEeprom('005E');
9392              
9393              
9394             =item setCwpaddle()
9395              
9396             $output = $FT817->setCwpaddle([NORMAL/REVERSE]);
9397              
9398             MENU ITEM # 19
9399              
9400             Sets the CW paddle to NORMAL or REVERSE
9401              
9402             This is a WRITEEEPROM based function and requires both setWriteallow() and
9403             agreeWithwarning() to be set to 1.
9404              
9405             In the event of a failure, the memory area can be restored with. The following
9406             command that also requires both flags previously mentioned set to 1.
9407              
9408             restoreEeprom('0058');
9409              
9410              
9411             =item setCwspeed()
9412              
9413             $output = $FT817->setCwpaddle([4-60]);
9414              
9415             MENU ITEM # 21
9416              
9417             Sets the CW Speed
9418              
9419             This is a WRITEEEPROM based function and requires both setWriteallow() and
9420             agreeWithwarning() to be set to 1.
9421              
9422             In the event of a failure, the memory area can be restored with. The following
9423             command that also requires both flags previously mentioned set to 1.
9424              
9425             restoreEeprom('0062');
9426              
9427              
9428             =item setCwweight()
9429              
9430             $output = $FT817->setCwweight([2.5-4.5]);
9431              
9432             MENU ITEM # 22
9433              
9434             Sets the CW weight
9435              
9436             This is a WRITEEEPROM based function and requires both setWriteallow() and
9437             agreeWithwarning() to be set to 1.
9438              
9439             In the event of a failure, the memory area can be restored with. The following
9440             command that also requires both flags previously mentioned set to 1.
9441              
9442             restoreEeprom('005F');
9443              
9444              
9445             =item setDcsinv()
9446              
9447             $output = $FT817->setDcsinv([TN-RN/TN-RIV/TIV-RN/TIV-RIV]);
9448              
9449             MENU ITEM # 53
9450              
9451             Sets the DCS Inversion
9452              
9453             This is a WRITEEEPROM based function and requires both setWriteallow() and
9454             agreeWithwarning() to be set to 1.
9455              
9456             In the event of a failure, the memory area can be restored with. The following
9457             command that also requires both flags previously mentioned set to 1.
9458              
9459             restoreEeprom('0066');
9460              
9461              
9462             =item setDebug()
9463              
9464             $debug = $FT817->setDebug([#]);
9465              
9466             Turns on and off the internal debugger. Provides information on all serial transactions when on.
9467             Activated when any value is in the (). Good practice says () or (1) for OFF and ON.
9468              
9469             Returns the argument sent to it on success.
9470              
9471              
9472             =item setDigdisp()
9473              
9474             $output = $FT817->setDigdisp([0]);
9475             $output = $FT817->setDigdisp([+/-][0-3000]);
9476              
9477             MENU ITEM # 24
9478              
9479             Sets the digital frequency offset shift in hz, in incriments of 10 takes 0 or +/- 0-3000
9480              
9481             This is a WRITEEEPROM based function and requires both setWriteallow() and
9482             agreeWithwarning() to be set to 1.
9483              
9484             In the event of a failure, the memory area can be restored with the following
9485             commands that also requires both flags previously mentioned set to 1.
9486              
9487             restoreEeprom('006F');
9488             restoreEeprom('0070');
9489              
9490              
9491             =item setDigmic()
9492              
9493             $output = $FT817->setDigmic([0-100]);
9494              
9495             MENU ITEM # 25
9496              
9497             Sets the DIG MIC
9498              
9499             This is a WRITEEEPROM based function and requires both setWriteallow() and
9500             agreeWithwarning() to be set to 1.
9501              
9502             In the event of a failure, the memory area can be restored with. The following
9503             command that also requires both flags previously mentioned set to 1.
9504              
9505             restoreEeprom('006A');
9506              
9507             =item setDigmode()
9508              
9509             $output = $FT817->setDigmode([RTTY/PSK31-L/PSK31-U/USER-L/USER-U]);
9510              
9511             MENU ITEM # 26
9512              
9513             Sets the Digital Mode type
9514              
9515             This is a WRITEEEPROM based function and requires both setWriteallow() and
9516             agreeWithwarning() to be set to 1.
9517              
9518             In the event of a failure, the memory area can be restored with. The following
9519             command that also requires both flags previously mentioned set to 1.
9520              
9521             restoreEeprom('0065');
9522              
9523              
9524             =item setDigshift()
9525              
9526             $output = $FT817->setDigshift([0]);
9527             $output = $FT817->setDigshift([+/-][0-3000]);
9528              
9529             MENU ITEM # 27
9530              
9531             Sets the digital shift in hz, in incriments of 10 takes 0 or +/- 0-3000
9532              
9533             This is a WRITEEEPROM based function and requires both setWriteallow() and
9534             agreeWithwarning() to be set to 1.
9535              
9536             In the event of a failure, the memory area can be restored with the following
9537             commands that also requires both flags previously mentioned set to 1.
9538              
9539             restoreEeprom('006D');
9540             restoreEeprom('006E');
9541              
9542              
9543             =item setDsp()
9544              
9545             $output = $FT817->setDsp([ON/OFF]);
9546              
9547             Turns the DSP on or off if available
9548              
9549             This is a WRITEEEPROM based function and requires both setWriteallow() and
9550             agreeWithwarning() to be set to 1.
9551              
9552             In the event of a failure, the memory area can be restored with. The following
9553             command that also requires both flags previously mentioned set to 1.
9554              
9555             restoreEeprom('0057');
9556              
9557              
9558             =item setDw()
9559              
9560             $status = $FT817->setDw([ON/OFF]);
9561              
9562             Sets the Dual Watch (DW) ON or OFF
9563              
9564             This is a WRITEEEPROM based function and requires both setWriteallow() and
9565             agreeWithwarning() to be set to 1.
9566              
9567             In the event of a failure, the memory area can be restored with. The following
9568             command that also requires both flags previously mentioned set to 1.
9569              
9570             restoreEeprom('0079');
9571              
9572              
9573             =item setEmergency()
9574              
9575             $output = $FT817->setEmergency([ON/OFF]);
9576              
9577             MENU ITEM # 28
9578              
9579             Sets the Emergency to ON or OFF
9580              
9581             This is a WRITEEEPROM based function and requires both setWriteallow() and
9582             agreeWithwarning() to be set to 1.
9583              
9584             In the event of a failure, the memory area can be restored with. The following
9585             command that also requires both flags previously mentioned set to 1.
9586              
9587             restoreEeprom('0064');
9588              
9589              
9590             =item setExtmenu()
9591              
9592             $output = $FT817->setExtmenu([ON/OFF]);
9593              
9594             MENU ITEM # 52
9595              
9596             Sets the Emergency to ON or OFF
9597              
9598             This is a WRITEEEPROM based function and requires both setWriteallow() and
9599             agreeWithwarning() to be set to 1.
9600              
9601             In the event of a failure, the memory area can be restored with. The following
9602             command that also requires both flags previously mentioned set to 1.
9603              
9604             restoreEeprom('006B');
9605              
9606              
9607             =item setFasttuning()
9608              
9609             $output = $FT817->setFasttuning([ON/OFF]);
9610              
9611             Sets the Fast Tuning of the radio to ON or OFF
9612              
9613             This is a WRITEEEPROM based function and requires both setWriteallow() and
9614             agreeWithwarning() to be set to 1.
9615              
9616             In the event of a failure, the memory area can be restored with. The following
9617             command that also requires both flags previously mentioned set to 1.
9618              
9619             restoreEeprom('0057');
9620              
9621              
9622             =item setFmmic()
9623              
9624             $output = $FT817->setFmmic([0-100]);
9625              
9626             MENU ITEM # 29
9627              
9628             Sets the FM MIC
9629              
9630             This is a WRITEEEPROM based function and requires both setWriteallow() and
9631             agreeWithwarning() to be set to 1.
9632              
9633             In the event of a failure, the memory area can be restored with. The following
9634             command that also requires both flags previously mentioned set to 1.
9635              
9636             restoreEeprom('0069');
9637              
9638              
9639             =item setHome()
9640              
9641             $output = $FT817->setHome([ON/OFF]);
9642              
9643             Sets the Radio to HOME frequency or back to normal frequencies
9644              
9645             This is a WRITEEEPROM based function and requires both setWriteallow() and
9646             agreeWithwarning() to be set to 1.
9647              
9648             In the event of a failure, the memory area can be restored with. The following
9649             command that also requires both flags previously mentioned set to 1.
9650              
9651             restoreEeprom('0055');
9652              
9653              
9654             =item setId()
9655              
9656             $output = $FT817->setId('CCCCCC');
9657              
9658             MENU ITEM # 31 - Sets the charachers for CWID
9659              
9660              
9661             =item setKyr()
9662              
9663             $output = $FT817->setKyr([ON/OFF]);
9664              
9665             Sets the CW Keyer (KYR) on or off
9666              
9667             This is a WRITEEEPROM based function and requires both setWriteallow() and
9668             agreeWithwarning() to be set to 1.
9669              
9670             In the event of a failure, the memory area can be restored with. The following
9671             command that also requires both flags previously mentioned set to 1.
9672              
9673             restoreEeprom('0058');
9674              
9675              
9676             =item setLock()
9677              
9678             $output = $FT817->setLock([ON/OFF]);
9679              
9680             Sets the Radio Lock on or off. Similar to catLock() but calls it directly
9681              
9682             This is a WRITEEEPROM based function and requires both setWriteallow() and
9683             agreeWithwarning() to be set to 1.
9684              
9685             In the event of a failure, the memory area can be restored with. The following
9686             command that also requires both flags previously mentioned set to 1.
9687              
9688             restoreEeprom('0057');
9689              
9690              
9691             =item setLockmode()
9692              
9693             $status = $FT817->setLockmode([DIAL/FREQ/PANEL]);
9694              
9695             MENU ITEM # 32 Sets the Radio Lock Mode
9696              
9697             This is a WRITEEEPROM based function and requires both setWriteallow() and
9698             agreeWithwarning() to be set to 1.
9699              
9700             In the event of a failure, the memory area can be restored with. The following
9701             command that also requires both flags previously mentioned set to 1.
9702              
9703             restoreEeprom('005E');
9704              
9705              
9706             =item setMainstep()
9707              
9708             $status = $FT817->setMainstep([COURSE/FINE]);
9709              
9710             MENU ITEM # 33 Sets the Main step
9711              
9712             This is a WRITEEEPROM based function and requires both setWriteallow() and
9713             agreeWithwarning() to be set to 1.
9714              
9715             In the event of a failure, the memory area can be restored with. The following
9716             command that also requires both flags previously mentioned set to 1.
9717              
9718             restoreEeprom('005D');
9719              
9720              
9721             =item setMemarea()
9722              
9723             $status = $FT817->setMemarea([2-200/M-PL/M-PU] [ACTIVE/INACTIVE]);
9724              
9725             Sets the given memory area as active or inactive. You cannot set area 1 which
9726             is always active. This will check to see if the memory area is formatted and if not call a function
9727             within writeMemory to format that area and give it a label
9728              
9729              
9730             =item setMemgroup()
9731              
9732             $status = $FT817->setMemgroup([ON/OFF]);
9733              
9734             MENU ITEM # 33 Sets the Memory Groups ON or OFF
9735              
9736             This is a WRITEEEPROM based function and requires both setWriteallow() and
9737             agreeWithwarning() to be set to 1.
9738              
9739             In the event of a failure, the memory area can be restored with. The following
9740             command that also requires both flags previously mentioned set to 1.
9741              
9742             restoreEeprom('0065');
9743              
9744              
9745             =item setMickey()
9746              
9747             $status = $FT817->setMickey([ON/OFF]);
9748              
9749             MENU ITEM # 36 Sets the MIC KEY ON or OFF
9750              
9751             This is a WRITEEEPROM based function and requires both setWriteallow() and
9752             agreeWithwarning() to be set to 1.
9753              
9754             In the event of a failure, the memory area can be restored with. The following
9755             command that also requires both flags previously mentioned set to 1.
9756              
9757             restoreEeprom('0068');
9758              
9759              
9760             =item setMicscan()
9761              
9762             $status = $FT817->setMicscan([ON/OFF]);
9763              
9764             MENU ITEM # 37 Sets the MIC SCAN ON or OFF
9765              
9766             This is a WRITEEEPROM based function and requires both setWriteallow() and
9767             agreeWithwarning() to be set to 1.
9768              
9769             In the event of a failure, the memory area can be restored with. The following
9770             command that also requires both flags previously mentioned set to 1.
9771              
9772             restoreEeprom('0067');
9773              
9774              
9775             =item setMtqmb()
9776              
9777             $output = $FT817->setMtqmb([ON/OFF]);
9778              
9779             Sets the MTQMB to ON or OFF
9780              
9781             This is a WRITEEEPROM based function and requires both setWriteallow() and
9782             agreeWithwarning() to be set to 1.
9783              
9784             In the event of a failure, the memory area can be restored with. The following
9785             command that also requires both flags previously mentioned set to 1.
9786              
9787             restoreEeprom('0055');
9788              
9789              
9790             =item setMtune()
9791              
9792             $output = $FT817->setMtune([MTUNE/MEMORY]);
9793              
9794             Sets the MTUNE to MTUNE or MEMORY
9795              
9796             This is a WRITEEEPROM based function and requires both setWriteallow() and
9797             agreeWithwarning() to be set to 1.
9798              
9799             In the event of a failure, the memory area can be restored with. The following
9800             command that also requires both flags previously mentioned set to 1.
9801              
9802             restoreEeprom('0055');
9803              
9804              
9805             =item setNb()
9806              
9807             $output = $FT817->setNb([ON/OFF]);
9808              
9809             Turns the Noise Blocker on or off
9810              
9811             This is a WRITEEEPROM based function and requires both setWriteallow() and
9812             agreeWithwarning() to be set to 1.
9813              
9814             In the event of a failure, the memory area can be restored with. The following
9815             command that also requires both flags previously mentioned set to 1.
9816              
9817             restoreEeprom('0057');
9818              
9819             Returns 'OK' on success. Any other output an error.
9820              
9821              
9822             =item setOpfilter()
9823              
9824             $output = $FT817->setOpfilter([OFF/SSB/CW]);
9825              
9826             MENU ITEM # 38
9827              
9828             Sets the Optional Filter
9829              
9830             This is a WRITEEEPROM based function and requires both setWriteallow() and
9831             agreeWithwarning() to be set to 1.
9832              
9833             In the event of a failure, the memory area can be restored with. The following
9834             command that also requires both flags previously mentioned set to 1.
9835              
9836             restoreEeprom('005E');
9837              
9838              
9839             =item setPktmic()
9840              
9841             $output = $FT817->setPktmic([0-100]);
9842              
9843             MENU ITEM # 39
9844              
9845             Sets the PKT MIC
9846              
9847             This is a WRITEEEPROM based function and requires both setWriteallow() and
9848             agreeWithwarning() to be set to 1.
9849              
9850             In the event of a failure, the memory area can be restored with. The following
9851             command that also requires both flags previously mentioned set to 1.
9852              
9853             restoreEeprom('006B');
9854              
9855              
9856             =item setPktrate()
9857              
9858             $output = $FT817->setCwpaddle([NORMAL/REVERSE]);
9859              
9860             MENU ITEM # 40
9861              
9862             Sets the Packet rate
9863              
9864             This is a WRITEEEPROM based function and requires both setWriteallow() and
9865             agreeWithwarning() to be set to 1.
9866              
9867             In the event of a failure, the memory area can be restored with. The following
9868             command that also requires both flags previously mentioned set to 1.
9869              
9870             restoreEeprom('005D');
9871              
9872              
9873             =item setPbt()
9874              
9875             $status = $FT817->setPbt([OFF/ON];
9876              
9877             Enables or disables the Pass Band Tuning
9878              
9879             This is a WRITEEEPROM based function and requires both setWriteallow() and
9880             agreeWithwarning() to be set to 1.
9881              
9882             In the event of a failure, the memory area can be restored with. The following
9883             command that also requires both flags previously mentioned set to 1.
9884              
9885             restoreEeprom('0057');
9886              
9887              
9888             =item setPri()
9889              
9890             $output = $FT817->setPri([ON/OFF]);
9891              
9892             Sets the Priority Scanning ON or OFF
9893              
9894             This is a WRITEEEPROM based function and requires both setWriteallow() and
9895             agreeWithwarning() to be set to 1.
9896              
9897             In the event of a failure, the memory area can be restored with. The following
9898             command that also requires both flags previously mentioned set to 1.
9899              
9900             restoreEeprom('0079');
9901              
9902              
9903             =item setPwrmtr()
9904              
9905             $status = $FT817->setPwrmtr([PWR/ALC/SWR/MOD];
9906              
9907             Sets the active display of the Power Meter
9908              
9909             This is a WRITEEEPROM based function and requires both setWriteallow() and
9910             agreeWithwarning() to be set to 1.
9911              
9912             In the event of a failure, the memory area can be restored with. The following
9913             command that also requires both flags previously mentioned set to 1.
9914              
9915             restoreEeprom('0058');
9916              
9917             =item setQmb()
9918              
9919             $output = $FT817->setQmb([ON/OFF]);
9920              
9921             Sets the QMB to ON or OFF
9922              
9923             This is a WRITEEEPROM based function and requires both setWriteallow() and
9924             agreeWithwarning() to be set to 1.
9925              
9926             In the event of a failure, the memory area can be restored with. The following
9927             command that also requires both flags previously mentioned set to 1.
9928              
9929             restoreEeprom('0055');
9930              
9931              
9932             =item setResumescan()
9933              
9934             $status = $FT817->setResumescan([OFF/3/5/10]);
9935              
9936             MENU ITEM # 41 - SETS THE Resume (scan) functionality.
9937              
9938             This is a WRITEEEPROM based function and requires both setWriteallow() and
9939             agreeWithwarning() to be set to 1.
9940              
9941             In the event of a failure, the memory area can be restored with. The following
9942             command that also requires both flags previously mentioned set to 1.
9943              
9944             restoreEeprom('005D');
9945              
9946             Returns 'OK' on success. Any other output an error.
9947              
9948              
9949             =item setRfknob()
9950              
9951             $rfknob = $FT817->setRfknob([RFGAIN/SQUELCH]);
9952              
9953             MENU ITEM # 45 - SETS THE RF-GAIN knob functionality.
9954              
9955             This is a WRITEEEPROM based function and requires both setWriteallow() and
9956             agreeWithwarning() to be set to 1.
9957              
9958             In the event of a failure, the memory area can be restored with. The following
9959             command that also requires both flags previously mentioned set to 1.
9960              
9961             restoreEeprom('005F');
9962              
9963             Returns 'OK' on success. Any other output an error.
9964              
9965              
9966             =item setRlsbcar()
9967              
9968             $output = $FT817->setRlsbcar([0]);
9969             $output = $FT817->setRlsbcar([+/-][0-300]);
9970              
9971             MENU ITEM # 54
9972              
9973             Sets the Rx Carrier Point for LSB in hz, in incriments of 10 takes 0 or +/- 0-300
9974              
9975             This is a WRITEEEPROM based function and requires both setWriteallow() and
9976             agreeWithwarning() to be set to 1.
9977              
9978             In the event of a failure, the memory area can be restored with the following
9979             command that also requires both flags previously mentioned set to 1.
9980              
9981             restoreEeprom('0071');
9982              
9983              
9984             =item setRusbcar()
9985              
9986             $output = $FT817->setRusbcar([0]);
9987             $output = $FT817->setRusbcar([+/-][0-300]);
9988              
9989             MENU ITEM # 55
9990              
9991             Sets the Rx Carrier Point for USB in hz, in incriments of 10 takes 0 or +/- 0-300
9992              
9993             This is a WRITEEEPROM based function and requires both setWriteallow() and
9994             agreeWithwarning() to be set to 1.
9995              
9996             In the event of a failure, the memory area can be restored with the following
9997             command that also requires both flags previously mentioned set to 1.
9998              
9999             restoreEeprom('0072');
10000              
10001              
10002             =item setScn()
10003              
10004             $output = $FT817->setScn([OFF/UP/DOWN]);
10005              
10006             Sets the SCN, Scanningn to OFF UP or DOWN
10007              
10008             This is a WRITEEEPROM based function and requires both setWriteallow() and
10009             agreeWithwarning() to be set to 1.
10010              
10011             In the event of a failure, the memory area can be restored with. The following
10012             command that also requires both flags previously mentioned set to 1.
10013              
10014             restoreEeprom('0079');
10015              
10016              
10017             =item setScope()
10018              
10019             $output = $FT817->setScope([CONT/CHK]);
10020              
10021             MENU ITEM # 43
10022              
10023             Sets the Scope
10024              
10025             This is a WRITEEEPROM based function and requires both setWriteallow() and
10026             agreeWithwarning() to be set to 1.
10027              
10028             In the event of a failure, the memory area can be restored with. The following
10029             command that also requires both flags previously mentioned set to 1.
10030              
10031             restoreEeprom('005D');
10032              
10033              
10034             =item setSidetonevol()
10035              
10036             $output = $FT817->setSidetonevol([1-100]);
10037              
10038             MENU ITEM # 44
10039              
10040             Sets the Sidetone Volume
10041              
10042             This is a WRITEEEPROM based function and requires both setWriteallow() and
10043             agreeWithwarning() to be set to 1.
10044              
10045             In the event of a failure, the memory area can be restored with. The following
10046             command that also requires both flags previously mentioned set to 1.
10047              
10048             restoreEeprom('0061');
10049              
10050              
10051             =item setSpl()
10052              
10053             $status = $FT817->setSpl([ON/OFF]);
10054              
10055             Sets the Split Frequency (SPL) ON or OFF
10056              
10057             This is a WRITEEEPROM based function and requires both setWriteallow() and
10058             agreeWithwarning() to be set to 1.
10059              
10060             In the event of a failure, the memory area can be restored with. The following
10061             command that also requires both flags previously mentioned set to 1.
10062              
10063             restoreEeprom('007A');
10064              
10065              
10066             =item setSsbmic()
10067              
10068             $output = $FT817->setSsbmic([0-100]);
10069              
10070             MENU ITEM # 46
10071              
10072             Sets the SSB MIC
10073              
10074             This is a WRITEEEPROM based function and requires both setWriteallow() and
10075             agreeWithwarning() to be set to 1.
10076              
10077             In the event of a failure, the memory area can be restored with. The following
10078             command that also requires both flags previously mentioned set to 1.
10079              
10080             restoreEeprom('0067');
10081              
10082              
10083             =item setTlsbcar()
10084              
10085             $output = $FT817->setTlsbcar([0]);
10086             $output = $FT817->setTlsbcar([+/-][0-300]);
10087              
10088             MENU ITEM # 56
10089              
10090             Sets the Tx Carrier Point for LSB in hz, in incriments of 10 takes 0 or +/- 0-300
10091              
10092             This is a WRITEEEPROM based function and requires both setWriteallow() and
10093             agreeWithwarning() to be set to 1.
10094              
10095             In the event of a failure, the memory area can be restored with the following
10096             command that also requires both flags previously mentioned set to 1.
10097              
10098             restoreEeprom('0073');
10099              
10100              
10101             =item setTusbcar()
10102              
10103             $output = $FT817->setTusbcar([0]);
10104             $output = $FT817->setTusbcar([+/-][0-300]);
10105              
10106             MENU ITEM # 57
10107              
10108             Sets the Tx Carrier Point for USB in hz, in incriments of 10 takes 0 or +/- 0-300
10109              
10110             This is a WRITEEEPROM based function and requires both setWriteallow() and
10111             agreeWithwarning() to be set to 1.
10112              
10113             In the event of a failure, the memory area can be restored with the following
10114             command that also requires both flags previously mentioned set to 1.
10115              
10116             restoreEeprom('0074');
10117              
10118              
10119             =item setTottime()
10120              
10121             $output = $FT817->setTottime([OFF/1-20]);
10122              
10123             MENU ITEM # 49
10124              
10125             Sets the Time out Timer OFF or in minutes from 1 to 20
10126              
10127             This is a WRITEEEPROM based function and requires both setWriteallow() and
10128             agreeWithwarning() to be set to 1.
10129              
10130             In the event of a failure, the memory area can be restored with. The following
10131             command that also requires both flags previously mentioned set to 1.
10132              
10133             restoreEeprom('0066');
10134              
10135              
10136             =item setTuner()
10137              
10138             $output = $FT817->setTuner([VFO/MEMORY]);
10139              
10140             Sets the Tuner to VFO or memory
10141              
10142             This is a WRITEEEPROM based function and requires both setWriteallow() and
10143             agreeWithwarning() to be set to 1.
10144              
10145             In the event of a failure, the memory area can be restored with. The following
10146             command that also requires both flags previously mentioned set to 1.
10147              
10148             restoreEeprom('0055');
10149              
10150             Returns 'OK' on success. Any other output an error.
10151              
10152              
10153             =item setTxpower()
10154              
10155             $status = $FT817->setTxpower([HIGH/LOW1/LOW2/LOW3];
10156              
10157             Sets the Transmitter Power
10158              
10159             This is a WRITEEEPROM based function and requires both setWriteallow() and
10160             agreeWithwarning() to be set to 1.
10161              
10162             In the event of a failure, the memory area can be restored with. The following
10163             command that also requires both flags previously mentioned set to 1.
10164              
10165             restoreEeprom('0079');
10166              
10167              
10168             =item setVerbose()
10169              
10170             $debug = $FT817->setVerbose([#]);
10171              
10172             Turns on and off the Verbose flag. Provides information where verbose is enabled
10173             Activated when any value is in the (). Good practice says () or (1) for OFF and ON.
10174              
10175             Returns the argument sent to it on success.
10176              
10177              
10178             =item setVfo()
10179              
10180             $status = $FT817->setVfo([A/B];
10181              
10182             Sets the VFO to A or B
10183              
10184             This is a WRITEEEPROM based function and requires both setWriteallow() and
10185             agreeWithwarning() to be set to 1.
10186              
10187             In the event of a failure, the memory area can be restored with. The following
10188             command that also requires both flags previously mentioned set to 1.
10189              
10190             restoreEeprom('0055');
10191              
10192              
10193             =item setVfoband()
10194              
10195             $setvfoband = $FT817->setVfoband([A/B] [160M/75M/40M/30M/20M/17M/15M/12M/10M/6M/2M/70CM/FMBC/AIR/PHAN]);
10196              
10197             Sets the band of the selected VFO
10198             Returns 'OK' on success or '1' on failure
10199              
10200             This is a WRITEEEPROM based function and requires both setWriteallow() and
10201             agreeWithwarning() to be set to 1.
10202              
10203             In the event of a failure, the memory area can be restored with. The following
10204             command that also requires both flags previously mentioned set to 1.
10205              
10206             restoreEeprom('0059');
10207              
10208              
10209             =item setVlt()
10210              
10211             $status = $FT817->setVlt([ON/OFF];
10212              
10213             Enables or disables the voltage display
10214              
10215             This is a WRITEEEPROM based function and requires both setWriteallow() and
10216             agreeWithwarning() to be set to 1.
10217              
10218             In the event of a failure, the memory area can be restored with. The following
10219             command that also requires both flags previously mentioned set to 1.
10220              
10221             restoreEeprom('0058');
10222              
10223              
10224             =item setVox()
10225              
10226             $setvox = $FT817->setVox([ON/OFF]);
10227              
10228             Sets the VOX feature of the radio on or off.
10229             Returns 'OK' on success or '1' on failure
10230              
10231             This is a WRITEEEPROM based function and requires both setWriteallow() and
10232             agreeWithwarning() to be set to 1.
10233              
10234             In the event of a failure, the memory area can be restored with. The following
10235             command that also requires both flags previously mentioned set to 1.
10236              
10237             restoreEeprom('0058');
10238              
10239              
10240             =item setVoxdelay()
10241              
10242             $output = $FT817->setVoxdelay([100-2500]);
10243              
10244             MENU ITEM # 50
10245              
10246             Sets the Vox delay. Done in incriments of 100
10247              
10248             This is a WRITEEEPROM based function and requires both setWriteallow() and
10249             agreeWithwarning() to be set to 1.
10250              
10251             In the event of a failure, the memory area can be restored with. The following
10252             command that also requires both flags previously mentioned set to 1.
10253              
10254             restoreEeprom('0064');
10255              
10256              
10257             =item setVoxgain()
10258              
10259             $output = $FT817->setVoxgain([1-100]);
10260              
10261             MENU ITEM # 51
10262              
10263             Sets the Vox Gain.
10264              
10265             This is a WRITEEEPROM based function and requires both setWriteallow() and
10266             agreeWithwarning() to be set to 1.
10267              
10268             In the event of a failure, the memory area can be restored with. The following
10269             command that also requires both flags previously mentioned set to 1.
10270              
10271             restoreEeprom('0063');
10272              
10273              
10274             =item setWriteallow()
10275              
10276             $writeallow = $FT817->setWriteallow([#]);
10277              
10278             Turns on and off the write Flag. Provides a warning about writing to the EEPROM and
10279             requires the agreeWithwarning() to also be set to 1 after reading the warning
10280             Activated when any value is in the (). Good practice says () or (1) for OFF and ON.
10281              
10282             Returns the argument sent to it on success.
10283              
10284              
10285             =item writeBlock()
10286              
10287             Internal function, if you try to call it, you may very well end up with a broken radio.
10288             You have been warned.
10289              
10290              
10291             =item writeDoubleblock()
10292              
10293             Internal function, if you try to call it, you may very well end up with a broken radio.
10294             You have been warned.
10295              
10296              
10297             =item writeEeprom()
10298              
10299             Internal function, if you try to call it, you may very well end up with a broken radio.
10300             You have been warned.
10301              
10302              
10303             =item writeMemory()
10304              
10305             my $option = $FT817->writeMemory('[HOME]', '[BAND]', '[OPTION]','[VALUE]');
10306             my $option = $FT817->writeMemory('[MEM]','[1-200/M-PL/M-PU]', '[OPTION]','[VALUE]');
10307             my $option = $FT817->writeMemory('[QMB]','[OPTION]','[VALUE]');
10308              
10309             Writes settings to the memory area given HOME [BAND] and an Option and value.
10310             Writes settings to the memory area given MEM [1-200/M-PL/M-PU] and an Option and value.
10311             Writes settings to the memory area given QMB and an Option and value.
10312            
10313             This is only for regular memory's and not the VFO Memories.
10314              
10315             Valid options:
10316              
10317             MODE - Sets the mode in memory - update only appears after toggling the VFO
10318             NARFM - Sets if Narrow FM os ON or OFF
10319             NARCWDIG - Sets if the CW or Digital Mode is on Narrow
10320             RPTOFFSET - Sets the Repeater offset
10321             TAG - Sets the radio display to show label or frequency
10322             LABEL - Sets the 8 character label for memory area
10323             MEMSKIP - Sets if the memory area is skipped on scan or not
10324             TONEDCS - Sets type type of tone being used
10325             ATT - Sets if ATT is on if applicable.
10326             IPO - Sets if IPO is on if applicable.
10327             FMSTEP - Sets the setting for FM STEP in KHZ
10328             AMSTEP - Sets the setting for AM STEP in KHZ
10329             SSBSTEP - Sets the setting for SSB STEP in KHZ
10330             CTCSSTONE - Sets the CTCSS Tone
10331             DCSCODE - Sets the DCS Code
10332             CLARIFIER - Sets the CLARIFIER on or off
10333             CLAROFFSET - Sets the polarity and offset frequency of the clarifier
10334             RXFREQ - Sets the stored Receive Frequency
10335             RPTOFFSETFREQ - Sets the stored Repeater offset Frequency
10336              
10337             The UHF / HF/VHF and FREQ RANGE options are set automatically by the RXFREQ option and should not be manually set
10338              
10339             If you have never used the QMB/MTQMB option on the radio, the memory addresses will show garbled data.
10340             Its simply easier to first send some arbitrary data to the channels in the radio by following the instructions
10341             on manual page 44. This is not a requirment, if you dont use QMB or MTQMB you do not need to do this.
10342              
10343             Never used memory addresses will be automatically formatted with the correct data when the memory area is activated
10344             Using a built in function within writeMem That checks for the ready bit within that area.
10345              
10346              
10347             =item writeMemvfo ()
10348              
10349             my $option = $FT817->writeMemvfo('[A/B]', '[BAND]', '[OPTION]','[VALUE]');
10350             my $option = $FT817->writeMemvfo('[MTUNE/MTQMB]', '[OPTION]','[VALUE]');
10351              
10352             Writes settings to the VFO memory given a VFO [A/B] and a BAND [20M/40M/70CM] etc..
10353             Writes settings to the VFO memory given a VFO [MTUNE/MTQMB] no band required for these.
10354             This is only for VFO memory's and not the Stored Memories nor Home Memories.
10355              
10356             Valid options:
10357              
10358             MODE - Sets the mode in memory - update only appears after toggling the VFO
10359             NARFM - Sets if Narrow FM os ON or OFF
10360             NARCWDIG - Sets if the CW or Digital Mode is on Narrow
10361             RPTOFFSET - Sets the Repeater offset
10362             TONEDCS - Sets type type of tone being used
10363             ATT - Sets if ATT is on if applicable.
10364             IPO - Sets if IPO is on if applicable.
10365             FMSTEP - Sets the setting for FM STEP in KHZ
10366             AMSTEP - Sets the setting for AM STEP in KHZ
10367             SSBSTEP - Sets the setting for SSB STEP in KHZ
10368             CTCSSTONE - Sets the CTCSS Tone
10369             DCSCODE - Sets the DCS Code
10370             CLARIFIER - Sets the CLARIFIER on or off
10371             CLAROFFSET - Sets the polarity and offset frequency of the clarifier
10372             RXFREQ - Sets the stored Receive Frequency
10373             RPTOFFSETFREQ - Sets the stored Repeater offset Frequency
10374              
10375             If you have never used the QMB/MTQMB option on the radio, the memory addresses will show garbled data.
10376             Its simply easier to first send some arbitrary data to the channels in the radio by following the instructions
10377             on manual page 44. This is not a requirment, if you dont use QMB or MTQMB you do not need to do this.
10378              
10379             =back
10380              
10381             =head1 AUTHOR
10382              
10383             Jordan Rubin KJ4TLB, C<< >>
10384              
10385             =head1 BUGS
10386              
10387             Please report any bugs or feature requests to C, or through
10388             the web interface at L. I will be notified, and then you'll
10389             automatically be notified of progress on your bug as I make changes.
10390              
10391             =head1 SUPPORT
10392              
10393             You can find documentation for this module with the perldoc command.
10394             perldoc Ham::Device::FT817COMM
10395              
10396             You can also look for information at:
10397              
10398             =over 4
10399              
10400             =item * Technologically Induced Coma
10401             L
10402              
10403             =item * RT: CPAN's request tracker (report bugs here)
10404             L
10405              
10406             =item * AnnoCPAN: Annotated CPAN documentation
10407             L
10408              
10409             =item * CPAN Ratings
10410             L
10411              
10412             =item * Search CPAN
10413             L
10414              
10415             =back
10416              
10417             =head1 ACKNOWLEDGEMENTS
10418              
10419             Thank you to Clint Turner KA7OEI for his research on the FT817 and discovering the mysteries of the EEprom
10420             FT817 and Yaesu are a registered trademark of Vertex standard Inc.
10421              
10422             =head1 LICENSE AND COPYRIGHT
10423              
10424             Copyright 2014 Jordan Rubin.
10425              
10426             This program is free software; you can redistribute it and/or modify it
10427             under the terms of the the Artistic License (2.0). You may obtain a
10428             copy of the full license at:
10429              
10430             L
10431              
10432             Any use, modification, and distribution of the Standard or Modified
10433             Versions is governed by this Artistic License. By using, modifying or
10434             distributing the Package, you accept this license. Do not use, modify,
10435             or distribute the Package, if you do not accept this license.
10436              
10437             If your Modified Version has been derived from a Modified Version made
10438             by someone other than you, you are nevertheless required to ensure that
10439             your Modified Version complies with the requirements of this license.
10440              
10441             This license does not grant you the right to use any trademark, service
10442             mark, tradename, or logo of the Copyright Holder.
10443             This license includes the non-exclusive, worldwide, free-of-charge
10444             patent license to make, have made, use, offer to sell, sell, import and
10445             otherwise transfer the Package with respect to any patent claims
10446             licensable by the Copyright Holder that are necessarily infringed by the
10447             Package. If you institute patent litigation (including a cross-claim or
10448             counterclaim) against any party alleging that the Package constitutes
10449             direct or contributory patent infringement, then this Artistic License
10450             to you shall terminate on the date that such litigation is filed.
10451              
10452             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
10453             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
10454             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
10455             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
10456             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
10457             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
10458             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
10459             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
10460              
10461             =cut
10462              
10463              
10464             1; # End of Ham::Device::FT817COMM