tk2-1.1.orig/0000755000175000017500000000000010413026737011305 5ustar pg4ipg4itk2-1.1.orig/api2.tcl0000755000175000017500000010216507636377263012674 0ustar pg4ipg4i#################################################################### # This file is part of tk2, a utility program for the # ICOM IC-R2 receiver. # # Copyright (C) 2001, 2002, Bob Parnass # # tk2 is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published # by the Free Software Foundation; either version 2 of the License, # or (at your option) any later version. # # tk2 is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with tk2; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA # 02111-1307 USA #################################################################### set RadioAddress EE set RadioAddressHex \xEE set PCAddress EF set PCAddressHex \xEF set Nmessages 252 set BytesPerMessage 32 set NBanks 8 set NChanPerBank 50 set VNChanPerBank 50 set ChanNumberRepeat yes set HasLabels yes ################################################################### # Starting address (in hexadecimal) for each field in # the memory image. ################################################################### set ImageAddr(MemoryFreqs) 00 ;# to C7F set ImageAddr(MemoryDuplex) 03 set ImageAddr(MemoryOffset) 03 set ImageAddr(MemoryModes) 06 set ImageAddr(MemoryToneCode) 06 set ImageAddr(MemorySkip) 07 set ImageAddr(MemoryToneFlag) 07 set ImageAddr(MemorySteps) 07 set ImageAddr(SearchFreqFirst) 0C80 set ImageAddr(SearchDuplexFirst) 0C83 set ImageAddr(SearchOffsetFirst) 0C83 set ImageAddr(SearchModeFirst) 0C86 set ImageAddr(SearchToneFlagFirst) 0C87 set ImageAddr(SearchStepFirst) 0C87 set ImageAddr(SearchFreqSecond) 0C88 set ImageAddr(SearchDuplexSecond) 0C8B set ImageAddr(SearchOffsetSecond) 0C8B set ImageAddr(SearchModeSecond) 0C8E set ImageAddr(SearchToneFlagSecond) 0C8F set ImageAddr(SearchStepSecond) 0C8F set ImageAddr(BandStackFreq) 0E10 ;# 10 of them set ImageAddr(BandStackDuplex) 0E13 set ImageAddr(BandStackOffset) 0E13 set ImageAddr(BandStackModes) 0E16 ;# 10 of them set ImageAddr(BandStackToneCode) 0E16 set ImageAddr(BandStackSkip) 0E17 set ImageAddr(BandStackToneFlag) 0E17 set ImageAddr(BandStackSteps) 0E17 set ImageAddr(DialStep) 0E60 set ImageAddr(Resume) 0E62 set ImageAddr(Pause) 0E63 set ImageAddr(BankScan) 0E65 set ImageAddr(Beep) 0E68 set ImageAddr(Lamp) 0E69 set ImageAddr(AutoOff) 0E6A set ImageAddr(PowerSave) 0E6B set ImageAddr(Monitor) 0E6C set ImageAddr(DialAccel) 0E6D set ImageAddr(UserComment) 0FA0 set ImageAddr(FileVersion) 0FB0 set Band(USA,0,low) .005 set Band(USA,0,high) 1.620 set Band(USA,1,low) 1.625 set Band(USA,1,high) 29.995 set Band(USA,2,low) 30.000 set Band(USA,2,high) 107.995 set Band(USA,3,low) 76.000 ;# Euro models set Band(USA,3,high) 76.995 ;# Euro models set Band(USA,4,low) 108.000 set Band(USA,4,high) 135.995 set Band(USA,5,low) 136.000 set Band(USA,5,high) 255.095 set Band(USA,6,low) 255.100 set Band(USA,6,high) 382.095 set Band(USA,7,low) 382.100 set Band(USA,7,high) 769.795 set Band(USA,8,low) 769.800 set Band(USA,8,high) 960.095 set Band(USA,9,low) 960.100 set Band(USA,9,high) 1599.995 ########################################################## # Translation tables ########################################################## # Lamp operation set Lamp(OFF) 0 set Lamp(ON) 1 set Lamp(AUTO) 2 set RLamp(0) OFF set RLamp(1) ON set RLamp(2) AUTO # Dial select set Dial(100kHz) 0 set Dial(1MHz) 1 set Dial(10MHz) 2 set RDial(0) 100kHz set RDial(1) 1MHz set RDial(2) 10MHz # Monitor key set Monitor(PUSH) 0 set Monitor(HOLD) 1 set RMonitor(0) PUSH set RMonitor(1) HOLD # Auto Power Off set AutoOff(OFF) 0 set AutoOff(30) 1 set AutoOff(60) 2 set AutoOff(90) 3 set AutoOff(120) 4 set RAutoOff(0) OFF set RAutoOff(1) 30 set RAutoOff(2) 60 set RAutoOff(3) 90 set RAutoOff(4) 120 # Scan Pause set Pause(2) 0 set Pause(4) 1 set Pause(6) 2 set Pause(8) 3 set Pause(10) 4 set Pause(12) 5 set Pause(14) 6 set Pause(16) 7 set Pause(18) 8 set Pause(20) 9 set Pause(HOLD) 10 set RPause(0) 2 set RPause(1) 4 set RPause(2) 6 set RPause(3) 8 set RPause(4) 10 set RPause(5) 12 set RPause(6) 14 set RPause(7) 16 set RPause(8) 18 set RPause(9) 20 set RPause(10) HOLD # Scan Resume set Resume(0) 0 set Resume(1) 1 set Resume(2) 2 set Resume(3) 3 set Resume(4) 4 set Resume(5) 5 set Resume(HOLD) 6 set RResume(0) 0 set RResume(1) 1 set RResume(2) 2 set RResume(3) 3 set RResume(4) 4 set RResume(5) 5 set RResume(6) HOLD set Step(5) "0" set Step(6.25) "1" set Step(10) "2" set Step(12.5) "3" set Step(15) "4" set Step(20) "5" set Step(25) "6" set Step(30) "7" set Step(50) "8" set Step(100) "9" set Step(9) "10" set RStep(0) "5" set RStep(1) "6.25" set RStep(2) "10" set RStep(3) "12.5" set RStep(4) "15" set RStep(5) "20" set RStep(6) "25" set RStep(7) "30" set RStep(8) "50" set RStep(9) "100" set RStep(10) "9" set Mode(M0) "0" set Mode(M7) "7" set Mode(M8) "8" set Mode(M9) "9" set Mode(MA) "A" set Mode(MB) "B" set Mode(MC) "C" set Mode(MD) "D" set Mode(ME) "E" set Mode(MF) "F" set Mode(NFM) "0" set Mode(WFM) "1" set Mode(AM) "2" set Mode(?) "3" set RMode(0) NFM set RMode(1) WFM set RMode(2) AM set RMode(3) ? set Skip(scan) 0 set Skip(pskip) 1 set Skip(skip) 2 set RSkip(0) " " set RSkip(1) pskip set RSkip(2) skip ########################################################## # Encoding in a .ICF file. ########################################################## set Icf2Hex(g) 0 set Icf2Hex(h) 1 set Icf2Hex(i) 2 set Icf2Hex(j) 3 set Icf2Hex(k) 4 set Icf2Hex(l) 5 set Icf2Hex(m) 6 set Icf2Hex(n) 7 set Icf2Hex(o) 8 set Icf2Hex(p) 9 set Icf2Hex(x) a set Icf2Hex(y) b set Icf2Hex(z) c set Icf2Hex({) d set Icf2Hex(|) e set Icf2Hex(}) f set Hex2Digit(30) 0 set Hex2Digit(31) 1 set Hex2Digit(32) 2 set Hex2Digit(33) 3 set Hex2Digit(34) 4 set Hex2Digit(35) 5 set Hex2Digit(36) 6 set Hex2Digit(37) 7 set Hex2Digit(38) 8 set Hex2Digit(39) 9 set Hex2Digit(41) A set Hex2Digit(42) B set Hex2Digit(43) C set Hex2Digit(44) D set Hex2Digit(45) E set Hex2Digit(46) F set Digit2Hex(0) 30 set Digit2Hex(1) 31 set Digit2Hex(2) 32 set Digit2Hex(3) 33 set Digit2Hex(4) 34 set Digit2Hex(5) 35 set Digit2Hex(6) 36 set Digit2Hex(7) 37 set Digit2Hex(8) 38 set Digit2Hex(9) 39 set Digit2Hex(A) 41 set Digit2Hex(B) 42 set Digit2Hex(C) 43 set Digit2Hex(D) 44 set Digit2Hex(E) 45 set Digit2Hex(F) 46 set ToneFlag(0) off set ToneFlag(1) tsql set RToneFlag(off) 0 set RToneFlag(tsql) 1 # CTCSS codes (there are 50 codes total) set CtcssBias 0 set Ctcss(0.0) 0 set Ctcss(67.0) 0 set Ctcss(69.3) 1 set Ctcss(71.9) 2 set Ctcss(74.4) 3 set Ctcss(77.0) 4 set Ctcss(79.7) 5 set Ctcss(82.5) 6 set Ctcss(85.4) 7 set Ctcss(88.5) 8 set Ctcss(91.5) 9 set Ctcss(94.8) 10 set Ctcss(97.4) 11 set Ctcss(100.0) 12 set Ctcss(103.5) 13 set Ctcss(107.2) 14 set Ctcss(110.9) 15 set Ctcss(114.8) 16 set Ctcss(118.8) 17 set Ctcss(123.0) 18 set Ctcss(127.3) 19 set Ctcss(131.8) 20 set Ctcss(136.5) 21 set Ctcss(141.3) 22 set Ctcss(146.2) 23 set Ctcss(151.4) 24 set Ctcss(156.7) 25 set Ctcss(159.8) 26 set Ctcss(162.2) 27 set Ctcss(165.5) 28 set Ctcss(167.9) 29 set Ctcss(171.3) 30 set Ctcss(173.8) 31 set Ctcss(177.3) 32 set Ctcss(179.9) 33 set Ctcss(183.5) 34 set Ctcss(186.2) 35 set Ctcss(189.9) 36 set Ctcss(192.8) 37 set Ctcss(196.6) 38 set Ctcss(199.5) 39 set Ctcss(203.5) 40 set Ctcss(206.5) 41 set Ctcss(210.7) 42 set Ctcss(218.1) 43 set Ctcss(225.7) 44 set Ctcss(229.1) 45 set Ctcss(233.6) 46 set Ctcss(241.8) 47 set Ctcss(250.3) 48 set Ctcss(254.1) 49 set RCtcss(0) 67.0 set RCtcss(1) 69.3 set RCtcss(2) 71.9 set RCtcss(3) 74.4 set RCtcss(4) 77.0 set RCtcss(5) 79.7 set RCtcss(6) 82.5 set RCtcss(7) 85.4 set RCtcss(8) 88.5 set RCtcss(9) 91.5 set RCtcss(10) 94.8 set RCtcss(11) 97.4 set RCtcss(12) 100.0 set RCtcss(13) 103.5 set RCtcss(14) 107.2 set RCtcss(15) 110.9 set RCtcss(16) 114.8 set RCtcss(17) 118.8 set RCtcss(18) 123.0 set RCtcss(19) 127.3 set RCtcss(20) 131.8 set RCtcss(21) 136.5 set RCtcss(22) 141.3 set RCtcss(23) 146.2 set RCtcss(24) 151.4 set RCtcss(25) 156.7 set RCtcss(26) 159.8 set RCtcss(27) 162.2 set RCtcss(28) 165.5 set RCtcss(29) 167.9 set RCtcss(30) 171.3 set RCtcss(31) 173.8 set RCtcss(32) 177.3 set RCtcss(33) 179.9 set RCtcss(34) 183.5 set RCtcss(35) 186.2 set RCtcss(36) 189.9 set RCtcss(37) 192.8 set RCtcss(38) 196.6 set RCtcss(39) 199.5 set RCtcss(40) 203.5 set RCtcss(41) 206.5 set RCtcss(42) 210.7 set RCtcss(43) 218.1 set RCtcss(44) 225.7 set RCtcss(45) 229.1 set RCtcss(46) 233.6 set RCtcss(46) 241.8 set RCtcss(48) 250.3 set RCtcss(49) 254.1 ########################################################## # # Initialize a few global variables. # # Return the pathname to a configuration file in the user's # HOME directory # # Returns: # list of 2 elements: # -name of configuration file # -name of label file # ########################################################## proc InitStuff { } \ { global argv0 global DisplayFontSize global env global Home global Pgm global RootDir global tcl_platform set platform $tcl_platform(platform) switch -glob $platform \ { {unix} \ { set Home $env(HOME) set rcfile [format "%s/.tk2rc" $Home] set labelfile [format "%s/.tk2la" $Home] set DisplayFontSize "Courier 56 bold" } {macintosh} \ { # Configuration file should be # named $HOME/.tk2rc # Use forward slashes within Tcl/Tk # instead of colons. set Home $env(HOME) regsub -all {:} $Home "/" Home set rcfile [format "%s/.tk2rc" $Home] set labelfile [format "%s/.tk2la" $Home] # The following font line may need changing. set DisplayFontSize "Courier 56 bold" } {windows} \ { # Configuration file should be # named $tk2/tk2.ini # Use forward slashes within Tcl/Tk # instead of backslashes. set Home $env(tk2) regsub -all {\\} $Home "/" Home set rcfile [format "%s/tk2.ini" $Home] set labelfile [format "%s/tk2.lab" $Home] set DisplayFontSize "Courier 28 bold" } default \ { puts "Operating System $platform not supported." exit 1 } } set Home $env(HOME) # set Pgm [string last "/" $argv0] set lst [list $rcfile $labelfile] return $lst } ################################################################### # Disable computer control of radio. ################################################################### proc DisableCControl { } \ { global Sid after 500 catch {close $Sid} return } ########################################################## # Copy memory image to radio # # Returns: # 0 -ok # 1 -error # 2 -error, cannot read radio version info ########################################################## proc WriteImage { }\ { global GlobalParam global Mimage global Nmessages global Sid set totmsgs $Nmessages set s [GetModelInfo] binary scan $s "H*" x set GlobalParam(RadioVersion) $x if {$GlobalParam(RadioVersion) == ""} \ { # Error while asking radio for version info. return 2 } # Create and display progress bar. toplevel .pbw wm title .pbw "Writing to IC-R2" grab set .pbw set p [MakeWaitWindow .pbw.g 0 PaleGreen] set pc 0 gauge_value $p $pc update set db 0 # Open serial port. OpenDevice # Write "clone in mode" command, including # radio version information. SendCloneIn set bptr 0 set maddr 0 # For each message. for {set i 0} {$i < $Nmessages} {incr i} \ { # Variable line containes info in the format it # will be written to the radio. set line "" # Variable bline contains packed hex gulp. set bline "" # A message sent to the radio consists of: # E4 - Payload Data Command code # Memory Gulp (unpacked so 2 bytes represent 1 byte): # # memory address (4 bytes unpacked) # number of bytes (2 bytes unpacked) # image data (32 bytes unpacked) append line [binary format "H2" E4 ] # Memory address set hmaddr [format "%04x" $maddr] set bmaddr [binary format "H4" $hmaddr] append bline $bmaddr # Byte count set hn [binary format "H2" 10] append bline $hn # Copy the next chunk of the image set end [expr {$bptr + 15}] set s [string range $Mimage $bptr $end] append bline $s # # Calulate and append the checksum byte # # Checksum is decimal. set cksum [CalcCheckSum $bline] # Convert checksum to hexadecimal. set hcksum [format "%02x" $cksum] set bcksum [binary format "H2" $hcksum ] append bline $bcksum # Unpack the binary stuff. # This makes it twice as long. set msg [DumpBinary $bline] # puts stderr "WriteImage: before packing:\n$msg\n" set ubuf [UnpackString $bline] append line $ubuf SendCmd $Sid $line # Read back the message we just sent to "clean out" # the serial buffers. # If we don't do this, WindowsXP will hang after # the download to the radio is completed. if { [ReadEcho $line] } \ { # Error. # We did not read back what we wrote. puts stderr "WriteImage: Error while reading echo from message $i." # Data xfer suceeded. # Zap the progress bar. grab release .pbw catch {destroy .pbw} # Close serial port. DisableCControl return 1 } incr bptr 16 incr maddr 16 # Update progress bar widget. set pc [ expr $i * 100 / $totmsgs ] if {$pc >= 100.0} \ { set pc 99 } gauge_value $p $pc } SendTermination if {[GetTerminationResult]} \ { # Data xfer failed. set code 1 } \ else \ { # Data xfer suceeded. set code 0 } # Zap the progress bar. grab release .pbw catch {destroy .pbw} # Close serial port. DisableCControl return $code } ########################################################## # Copy memory image from radio ########################################################## proc ReadImage { } \ { global GlobalParam global Mimage global Nmessages global Pgm global Sid set code 0 set s [GetModelInfo] binary scan $s "H*" x set GlobalParam(RadioVersion) $x if {$GlobalParam(RadioVersion) == ""} \ { # Error while asking radio for version info. return 2 } # Create and display progress bar. toplevel .pbw wm title .pbw "Reading IC-R2" grab set .pbw set p [MakeWaitWindow .pbw.g 0 PaleGreen] set pc 0 gauge_value $p $pc update set Mimage "" # Open serial port. OpenDevice SendCloneOut # For each message. for {set i 0} {$i < 500} {incr i} \ { set line [ReadXferRx] set len [string length $line] # puts stderr "ReadImage: i= $i, len= $len" # Update progress bar widget. set pc [ expr {$i * 100 / $Nmessages} ] if {$pc >= 100.0} \ { set pc 99 } gauge_value $p $pc set cc [string range $line 0 0] binary scan $cc "H2" s # Examine the command code byte. if { [string compare -nocase -length 1 $cc \xe5] == 0} \ { # This was a termination message. # There is no more data to read. set code 0 break } if {$len != 41} \ { # Error while reading from radio. set code -1 break } # Got a data record. # Temorarily convert it from funky unpacked # format to binary format. # Then, perform a checksum calculation on it. set pline [PackString [string range $line 1 42]] set plen [string length $pline] # puts stderr "ReadXferRx: line length is: $len" set dbuf [string range $pline 0 18] set cksum [string range $pline 19 19] set ccksum [CalcCheckSum $dbuf] binary scan $cksum "H*" icksum scan $icksum "%x" cksum # puts stderr [format "CHECKSUM radio: %s, calculated: %s\n" \ $cksum $ccksum] if {$cksum != $ccksum} \ { set msg [format \ "%s: error, checksum mismatch, radio: %s, calculated: %s\n" \ $Pgm $cksum $ccksum] Tattle $msg tk_dialog .error "Checksum error while reading" \ $msg error 0 OK # Close serial port. DisableCControl exit } # Strip off memory address and count bytes. set buf [string range $dbuf 3 end] append Mimage $buf } set GlobalParam(NmsgsRead) $i # Zap the progress bar. grab release .pbw destroy .pbw # Close serial port. DisableCControl return $code } ################################################################### # this takes a string and converts the # first character in it to an integer # in the range 0-255 # # if the string is empty, returns an empty string ################################################################### proc Char2Int { c } \ { set tmp "" set n [binary scan $c "c" tmp] if { ($n == 1) && ($tmp < 0) } \ { # Force negative number to be positive set tmp [expr $tmp + 256] } return "$tmp" } ################################################################### # Calculate the 2s complement modulo 256 checksum byte for a string by # summing all the ascii character values, # getting the 2s complement, then modulo 256. ################################################################### proc CalcCheckSum { s } \ { set len [string length $s] set sum 0 binary scan $s "H*" x # regsub -all ".." $x { \0} x # puts stderr "CalcCheckSum: $x" for {set i 0} {$i < $len} {incr i} \ { set c [string index $s $i] set tmp [Char2Int $c] # set xtmp [format "%x" $tmp] # puts stderr "CalcCheckSum: $i (of $len): xtmp = $xtmp" set sum [expr {$sum + $tmp}] } # set xsum [format "%x" $sum] # puts stderr "CalcCheckSum: xsum = $xsum" # set sum [expr {0 - $sum}] # set ysum [format "%x" $sum] # puts stderr "CalcCheckSum: ysum = $ysum" set sum [expr $sum % 256] # set zsum [format "%x" $sum] # puts stderr "CalcCheckSum: zsum = $zsum" return $sum } ################################################################### # Create a string of "n" bytes where each byte is \xff (255 decimal). ################################################################### proc Padff { n } \ { set ffrecd "" set byte [binary format "H2" ff] for {set i 0} {$i < $n} {incr i} \ { append ffrecd $byte } return $ffrecd } ########################################################## # Open the serial port. # # Notes: # This procedure sets the global variable Sid. # # Returns: # "" -ok # This procedure exits if there is an error in opening or # configuring the serial port. # ########################################################## proc OpenDevice {} \ { global Pgm global GlobalParam global Sid global tcl_platform set msg "" set platform $tcl_platform(platform) switch -glob $platform \ { {unix} \ { if [ catch { open $GlobalParam(Device) "r+"} \ Sid] \ { set msg "Error while trying to open " append msg "serial port " append msg $GlobalParam(Device) } } {macintosh} \ { if [ catch { open $GlobalParam(Device) "r+"} \ Sid] \ { set msg "Error while trying to open " append msg "serial port " append msg $GlobalParam(Device) } } {windows} \ { if [ catch { open $GlobalParam(Device) RDWR} \ Sid] \ { set msg "Error while trying to open " append msg "serial port " append msg $GlobalParam(Device) } } default \ { set msg "$Pgm error: Platform $platform " append msg "not supported." } } waiter 500 # If port opened ok, if { $msg == "" } \ { # Set up the serial port parameters (similar to stty) if {[SetSerialP n]} \ { set msg "$Pgm error: " append msg "Cannot configure serial port\n" append msg "$GlobalParam(Device)" # Close serial port. DisableCControl } } if {$msg != ""} \ { Tattle $msg tk_dialog .opnerror "Serial port error" \ $msg error 0 OK exit } waiter 1000 return "" } ################################################################### # Return the preamble for messages sent from computer to radio. ################################################################### proc MsgPreamble { } \ { global RadioAddress global PCAddress # byte 0 = FE # byte 1 = FE # byte 2 = (radio's unique address) # byte 3 = (computer's address) set preamble [ binary format "H2H2H2H2" fe fe \ $RadioAddress $PCAddress ] return $preamble } ################################################################### # # Send "command" to radio. # Write command to error stream if Debug flag is set. # ################################################################### proc SendCmd { Sid command } \ { global GlobalParam set cmd [MsgPreamble] append cmd $command append cmd [binary format "H2" fd] if { $GlobalParam(Debug) > 0 } \ { binary scan $cmd "H*" s # Insert a space between each pair of hex digits # to improve readability. regsub -all ".." $s { \0} s set msg "" set msg [ append msg "---> " $s] Tattle $msg } # Write data to serial port. puts -nonewline $Sid $cmd flush $Sid return } ################################################################### # Interrogate radio for version/model/user information # # Returns: # - a 4 byte version of IC-R2 we have. # - empty string if error occurred. # # Notes: # My IC-R2 returns this string: # 21 27 00 01 20 20 20 20 ... 20 05 09 00 ################################################################### proc GetModelInfo { } \ { global GlobalParam global Sid # Open serial port. OpenDevice set cmd [ binary format "H2H2H2H2H2" E0 00 00 00 00 ] SendCmd $Sid $cmd while {1} \ { # Read messages until we find the # one which matches this request. set line [ReadRx] set len [string length $line] set cn [string range $line 0 0] binary scan $cn "H*" cn # If this is a response to our request. if {$cn == "e1"} {break} # If we got an NG message from the radio. if {$cn == "fa"} {break} } set len [string length $line] # Check if radio sent NG msg. if {$len == 1} \ { set line "" } \ else \ { set line [string range $line 1 4 ] } binary scan $line "H*" x set GlobalParam(RadioVersion) $x # puts stderr "GetModelInfo: RadioVersion= $x" # Close serial port. DisableCControl return $line } ################################################################### # Read a CI-V message from the serial port. # # Inputs: # any - 0 means ignore messages with a "from address" # field which indicates the message is from # this computer. # - 1 means return any message # # Strip off the 2 address bytes. # # Returns: the message without the address fields. ################################################################### proc ReadRx { {any 0} } \ { global GlobalParam global RadioAddressHex global PCAddressHex set ignored "ignoring previous echo msg from the radio." set line {} while { 1 } \ { # Read message from the bus. set line [ReadCIV] if { [string length $line] == 0} \ { # Got a read error. break } # Examine the address bytes. set to [string range $line 0 0] set from [string range $line 1 1] if { ([string compare -nocase -length 1 \ $to $PCAddressHex] != 0) \ && ([string compare -nocase -length 1 \ $to $RadioAddressHex] != 0)} \ { puts stderr "ReadRx: UNKNOWN MESSAGE" continue; } if { $any == 0 } \ { if { [string compare -nocase -length 1 \ $from $PCAddressHex] == 0} \ { # This message is from us, # so ignore it and read again. continue } \ } # Strip of the address bytes. set line [string range $line 2 end] set len [string length $line] break } return $line } ################################################################### # Read a CI-V data transfer message from the serial port. # # INPUTS: # any - 0 means ignore messages with a "from address" # field which indicates the message is from # this computer. # - 1 means return any message # # DESCRIPTION: # Read a data transfer message. # Calculate a checksum and compare it to the # checksum in the message. # Return an empty message if there is an error. # Strip off the 2 address bytes. # # Returns: the data transfer message without the address fields. ################################################################### proc ReadXferRx { {any 0} } \ { global GlobalParam global RadioAddressHex global PCAddressHex set ignored "ignoring previous echo msg from the radio." set line {} while { 1 } \ { # Read message from the bus. set line [ReadCIV] if { [string length $line] == 0} \ { # Got a read error. return "" } # Examine the address bytes. set to [string range $line 0 0] set from [string range $line 1 1] if { ([string compare -nocase -length 1 \ $to $PCAddressHex] != 0) \ && ([string compare -nocase -length 1 \ $to $RadioAddressHex] != 0)} \ { puts stderr "ReadRx: UNKNOWN MESSAGE" continue; } if { $any == 0 } \ { if { [string compare -nocase -length 1 \ $from $PCAddressHex] == 0} \ { # This message is from us, # so ignore it and read again. continue } \ } # Got a message. break } # Strip off the from and to address bytes. set line [string range $line 2 end] return $line } ################################################################### # Read a CI-V message from the serial port. # # Returns: # The message unless there was an error. # The empty string if there was an error. ################################################################### proc ReadCIV { } \ { global GlobalParam global Sid set collision_error false # Skip the 2 byte "fe fe" preamble read $Sid 1 read $Sid 1 set line "" while { 1 } \ { set b [read $Sid 1] # A byte of hexadecimal fc means there was an # error, usually a collision. # Note: I have observered that the radio # usually sends 3 consecutive fc bytes after # a CIV collision. Because fc should never appear # in the IC-R75 data stream, we consider it # an error whenever we see even a single fc byte. # - Bob Parnass, 2/12/2002 if { [string compare -nocase -length 1 $b \xfc] == 0} \ { # Got an error, but continue reading bytes # until we get an end of message byte fe. set collision_error true set line [append line $b] } \ elseif { [string compare -nocase -length 1 $b \xfd] == 0} \ { # Got the end of message code byte. break } \ elseif { [string compare -nocase -length 1 $b \xfe] == 0} \ { ; # Ignore leading preamble bytes. } \ else \ { set line [append line $b] } } if { $GlobalParam(Debug) > 0 } \ { set msg "<--- " binary scan $line "H*" x regsub -all ".." $x { \0} x set msg [append msg $x] Tattle $msg } if { $collision_error == "true" } \ { puts stderr "ReadCIV: collison error." set line "" } return $line } ################################################################### # # Convert an ASCII string to binary. # The ASCII string uses two consecutive bytes, e.g., E3, to represent # one byte of the binary string, e.g. \xE3. # # INPUT: unpacked string # RETURNS: packed string ################################################################### proc PackString { in } \ { global Hex2Digit set len [string length $in] set out "" # puts stderr "len $len, anum: " for {set i 0} {$i < $len} {incr i 2} \ { set j $i set left [string range $in $j $j] incr j set right [string range $in $j $j] binary scan $left "H2" ileft set dleft $Hex2Digit($ileft) binary scan $right "H2" iright set dright $Hex2Digit($iright) set s "" append s $dleft $dright # puts -nonewline stderr "$s " set hnum [binary format "H2" $s] append out $hnum # binary scan $left "H*" cl # binary scan $right "H*" cr # puts stderr "cl= $cl, cr= $cr, num= $num, ileft= $ileft, iright= $iright" } return $out } ################################################################### # # Convert a binary string to an ASCII string. # The ASCII string uses two consecutive bytes, e.g., E3, to represent # one byte of the binary string, e.g. \xE3. # # INPUT: packed string # RETURNS: unpacked string ################################################################### proc UnpackString { in } \ { global Digit2Hex set len [string length $in] set out "" for {set i 0} {$i < $len} {incr i} \ { set c [string index $in $i] binary scan $c "H2" s set s [string toupper $s] set left [string index $s 0] set right [string index $s 1] set dleft $Digit2Hex($left) set dright $Digit2Hex($right) # puts stderr "s= $s, $dleft $dright" append out [binary format "H2H2" $dleft $dright] } return $out } ################################################################### # Send the radio a command to accept memory data. ################################################################### proc SendCloneIn { } \ { global GlobalParam global Sid set cmd [ binary format "H2" E3 ] append cmd [ binary format "H*" $GlobalParam(RadioVersion) ] SendCmd $Sid $cmd # Read the echo if { [ReadEcho $cmd] } \ { # Error. # We did not read back what we wrote. puts stderr "SendCloneIn: Error while reading echo." } return } ################################################################### # Send the radio a command to send memory data to computer. ################################################################### proc SendCloneOut { } \ { global GlobalParam global Sid set cmd [ binary format "H2" E2 ] append cmd [ binary format "H*" \ $GlobalParam(RadioVersion) ] SendCmd $Sid $cmd # Read the echo if { [ReadEcho $cmd] } \ { # Error. # We did not read back what we wrote. puts stderr "SendCloneOut: Error while reading echo." } return } ################################################################### # Send the radio a data termination command. ################################################################### proc SendTermination { } \ { global GlobalParam global Sid set cmd [ binary format "H2" E5 ] append cmd "Icom Inc." SendCmd $Sid $cmd return } ################################################################### # Interrogate radio for version/model/user information # # Returns: # - 0 = no errors # - otherwise, error # # Notes: ################################################################### proc GetTerminationResult { } \ { global GlobalParam global Sid while {1} \ { # Read messages until we find the # one which matches request. set line [ReadRx] set len [string length $line] set cn [string range $line 0 0] binary scan $cn "H*" cn # If this is a termination result.... if {$cn == "e6"} {break} } set x [string range $line 1 1 ] set code -1 if { [string compare -nocase -length 1 $x \x00] == 0} \ { set code 0 } return $code } proc DumpBinary { bstring } \ { binary scan $bstring "H*" s # Insert a space between each pair of hex digits # to improve readability. regsub -all ".." $s { \0} s return $s } proc ReadEcho { sent } \ { global GlobalParam global Pgm if {$GlobalParam(CableEchos) == 0} {return 0} set echo [ReadRx 1] if { [string compare $sent $echo] } \ { # Error. # We did not read back what we wrote. puts stderr "$Pgm: Error while reading echo from message $i." return 1 } return 0 } ################################################################### # Set the serial port parameters. # # proc SetSerialP { parity } # # INPUTS: # parity -o or e or n # # # RETURNS: # 0 -ok # -1 -error occurred # # NOTES: # # Requires tcl/tk 8.4 or later to support the ttycontrol # option on fconfigure. # # # From: Rolf.Schroedter@dlr.de Wed Dec 18 00:44:18 2002 # # The serial stuff in Windows is indeed more complicated than in Unix. # You can see this from the volume of source code. # # In Windows the -mode "string" interpretation resets # all TTY states to their default values. # A simple workaround for you is to set the baud rate # first and only then the -ttycontrol. The following should work: # # fconfigure $Sid -buffering none -translation binary \ # -blocking 1 \ # -mode 9600,$parity,8,1 -ttycontrol {DTR 1 RTS 0} # # Or even # fconfigure $Sid -buffering none -translation binary \ # -blocking 1 # fconfigure $id -mode 9600,$parity,8,1 # fconfigure $id -ttycontrol {DTR 1 RTS 0} # # I'll have a look whether there is a way to correct this for # future Tcl versions. # On the other hand setting -mode is an elementary thing # which reconfigures the UART hardware and should not be # done during communication. # ################################################################### proc SetSerialP { parity } \ { global Pgm global Sid global GlobalParam set code 0 # Set up the serial port parameters (similar to stty) if {($GlobalParam(DTRline) < 0) \ && ($GlobalParam(RTSline) < 0)} \ { if { [catch {fconfigure $Sid \ -buffering none \ -translation binary \ -handshake none \ -mode 9600,$parity,8,1 -blocking 1 \ -ttycontrol {DTR 0 RTS 0} }]} \ { set code -1 } } \ elseif {($GlobalParam(DTRline) < 0) \ && ($GlobalParam(RTSline) > 0)} \ { if { [catch {fconfigure $Sid \ -buffering none \ -translation binary \ -handshake none \ -mode 9600,$parity,8,1 -blocking 1 \ -ttycontrol {DTR 0 RTS 1} }]} \ { set code -1 } } \ elseif {($GlobalParam(DTRline) > 0) \ && ($GlobalParam(RTSline) < 0)} \ { if { [catch {fconfigure $Sid \ -buffering none \ -translation binary \ -handshake none \ -mode 9600,$parity,8,1 -blocking 1 \ -ttycontrol {DTR 1 RTS 0} }]} \ { set code -1 } } \ else \ { if { [catch {fconfigure $Sid \ -buffering none \ -translation binary \ -handshake none \ -mode 9600,$parity,8,1 -blocking 1 \ -ttycontrol {DTR 1 RTS 1} }]} \ { set code -1 } } # Delay a half second to give serial port # time to settle. waiter 500 return $code } tk2-1.1.orig/COPYING0000644000175000017500000003543107461330225012345 0ustar pg4ipg4i GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS tk2-1.1.orig/gui2.tcl0000755000175000017500000040074010032320775012663 0ustar pg4ipg4i################################################################### # This file is part of tk2, a utility program for the # ICOM IC-R2 receiver. # # Copyright (C) 2001 - 2004, Bob Parnass # AJ9S # # tk2 is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published # by the Free Software Foundation; either version 2 of the License, # or (at your option) any later version. # # tk2 is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with tk2; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA # 02111-1307 USA ################################################################### proc MakeGui { } \ { global Cht global Chvector global GlobalParam global ReadRadioFlag global TemplateSavedFlag set Cht "" set GlobalParam(TemplateFilename) untitled.tr2 set TemplateSavedFlag no set ReadRadioFlag no # Set custom font and colors. SetAppearance # set msg [OpenDevice] # # if { $msg != ""} \ # { # tk_dialog .opnerror "tk2 error" \ # $msg error 0 OK # exit # } ############################################################### # Menu bar along the top edge. ############################################################### set fr_menubar [MakeMenuBar .mb] set mf [frame .mainframe] set fr_line1 [frame $mf.line1] set fr_lim [frame $mf.lim] # frame $mf.chtable # set Cht $mf.chtable set fr_misc [MakeMiscFrame $fr_line1.omsg] set fr_display [MakeDisplayFrame $fr_line1.dis] set fr_title [MakeTitleFrame $fr_line1.title] pack $fr_title -side right -fill y pack $fr_misc $fr_display -side left -fill y ############################################################### # Memory channel scrolled window ############################################################### if {$GlobalParam(EditMemoryChannels) == "off"} \ { toplevel .mc set Cht .mc # Prevent user from closing the channel list window unless # he elects to exit the entire program. wm protocol .mc WM_DELETE_WINDOW {ExitApplication} wm title $Cht "tk2 Memory Channels" wm iconify $Cht } ############################################################### # VFO controls window ############################################################### toplevel .vfo set fr_vfo .vfo.ctls frame $fr_vfo -relief groove set fr_search [MakeSearchFrame $fr_vfo.search] set fr_bandstack [MakeBandStackFrame $fr_vfo.bandstack] pack $fr_search $fr_bandstack \ -side left \ -fill both -expand true pack $fr_vfo # Prevent user from closing the VFO controls window unless # he elects to exit the entire program. wm protocol .vfo WM_DELETE_WINDOW {ExitApplication} wm title .vfo "tk2 VFO Settings" ############################################################### # Memory Bank controls window ############################################################### toplevel .mbank set mbank .mbank.ctls frame $mbank -relief groove wm title .mbank "tk2 Memory Bank" set fr_bank [MakeMemoryBankFrame $mbank.bank] pack $fr_bank -side left -fill both -expand true pack $mbank -side left -fill both -expand true # Prevent user from closing the Bank window unless # he elects to exit the entire program. wm protocol .mbank WM_DELETE_WINDOW {ExitApplication} ############################################################### # Secondary controls window ############################################################### toplevel .controls set ctls .controls.ctls frame $ctls -relief groove set fr_com [MakeCommFrame $ctls.com] pack $fr_com -side left -fill both -expand true # toplevel .mc # set Cht .mc # # set fr_bankscan [MakeBankScanFrame $Cht.bankscan] # # # Prevent user from closing the channel list window unless # # he elects to exit the entire program. # wm protocol $Cht WM_DELETE_WINDOW {ExitApplication} # wm title $Cht "tk2 Memory Channels" # wm iconify $Cht set Chvector "" pack $fr_menubar -side top -fill x -pady 3 -padx 3 pack $fr_line1 -side top -fill x -pady 3 -padx 3 pack $fr_lim -side top -fill x -pady 3 -padx 3 pack $ctls -side top -fill both -expand true -padx 3 -pady 3 pack .mainframe -side top -fill both -expand true update idletasks ############################################################### # Ask the window manager to catch the delete window # event. ############################################################### wm protocol . WM_DELETE_WINDOW {ExitApplication} # Prevent user from shrinking or expanding main window. wm minsize . [winfo width .] [winfo height .] # wm maxsize . [winfo width .] [winfo height .] wm protocol .controls WM_DELETE_WINDOW {ExitApplication} wm title .controls "tk2 Secondary Controls" # Prevent user from overshrinking or expanding controls window. wm minsize .controls [winfo width .controls] [winfo height .controls] wm maxsize .controls [winfo width .controls] [winfo height .controls] # Prevent user from shrinking or expanding window. wm minsize .vfo [winfo width .vfo] [winfo height .vfo] # wm maxsize .vfo [winfo width .vfo] [winfo height .vfo] # Force main window to appear on top by hiding, then # then showing it. wm withdraw . wm deiconify . return } ################################################################### # Alter color and font appearance based on user preferences. ################################################################### proc SetAppearance { } \ { global GlobalParam if {$GlobalParam(Font) != "" } \ { # Designate a custom font for most widgets. option add *font $GlobalParam(Font) } if {$GlobalParam(BackGroundColor) != "" } \ { # Designate a custom background color for most widgets. option add *background $GlobalParam(BackGroundColor) } if {$GlobalParam(ForeGroundColor) != "" } \ { # Designate a custom foreground color for most widgets. option add *foreground $GlobalParam(ForeGroundColor) } if {$GlobalParam(TroughColor) != "" } \ { # Designate a custom slider trough color # for most scale widgets. option add *troughColor $GlobalParam(TroughColor) } return } ########################################################## # Check if the configuration file exists. # If it exits, return 1. # # Otherwise, prompt the user to select the # serial port. ########################################################## proc FirstTimeCheck { Rcfile } \ { global AboutMsg global GlobalParam global Libdir global tcl_platform if { [file readable $Rcfile] == 1 } \ { return 0 } tk_dialog .about "About tk2" \ $AboutMsg info 0 OK # No readable config file found. # Treat this as the first time the user has run the program. # Create a new window with radio buttions and # an entry field so user can designate the proper # serial port. set msg "Please identify the serial port to which\n" set msg [append msg "your IC-R2 receiver is connected."] toplevel .serialport set sp .serialport label $sp.intro -text $msg frame $sp.rbframe set fr $sp.rbframe if { $tcl_platform(platform) == "windows" } \ { # For Windows. radiobutton $fr.com1 -text COM1: -variable port \ -value {COM1:} radiobutton $fr.com2 -text COM2: -variable port \ -value {COM2:} radiobutton $fr.com3 -text COM3: -variable port \ -value {COM3:} radiobutton $fr.com4 -text COM4: -variable port \ -value {COM4:} pack $fr.com1 $fr.com2 $fr.com3 $fr.com4 \ -side top -padx 3 -pady 3 -anchor w } \ else \ { # For unix, mac, etc.. radiobutton $fr.s0 -text /dev/ttyS0 -variable port \ -value {/dev/ttyS0} radiobutton $fr.s1 -text /dev/ttyS1 -variable port \ -value {/dev/ttyS1} radiobutton $fr.s2 -text /dev/ttyS2 -variable port \ -value {/dev/ttyS2} radiobutton $fr.s3 -text /dev/ttyS3 -variable port \ -value {/dev/ttyS3} radiobutton $fr.s4 -text /dev/ttyS4 -variable port \ -value {/dev/ttyS4} radiobutton $fr.s5 -text /dev/ttyS5 -variable port \ -value {/dev/ttyS5} pack \ $fr.s0 $fr.s1 $fr.s2 \ $fr.s3 $fr.s4 $fr.s5 \ -side top -padx 3 -pady 3 -anchor w } radiobutton $fr.other -text "other (enter below)" \ -variable port \ -value other entry $fr.ent -width 30 -textvariable otherport pack $fr.other $fr.ent \ -side top -padx 3 -pady 3 -anchor w button $sp.ok -text "OK" \ -command \ { \ global GlobalParam if {$port == "other"} \ { set GlobalParam(Device) $otherport } \ else \ { set GlobalParam(Device) $port } # puts stderr "entered $GlobalParam(Device)" } button $sp.exit -text "Exit" \ -command { exit } pack $sp.intro -side top -padx 3 -pady 3 pack $fr -side top -padx 3 -pady 3 pack $sp.ok $sp.exit -side left -padx 3 -pady 3 -expand true bind $fr.ent \ { global GlobalParam set GlobalParam(Device) $otherport } wm title $sp "Select serial port" wm protocol $sp WM_DELETE_WINDOW {exit} set errorflag true while { $errorflag == "true" } \ { tkwait variable GlobalParam(Device) if { $tcl_platform(platform) != "unix" } \ { set errorflag false break } # The following tests do not work properly # in Windows. That is why we won't perform # the serial port tests when running Windows version. if { ([file readable $GlobalParam(Device)] != 1) \ || ([file writable $GlobalParam(Device)] != 1)}\ { # Device must be readable, writable bell tk_dialog .badport "Serial port problem" \ "Serial port problem" error 0 OK } \ else \ { set errorflag false } } destroy $sp return 1 } ########################################################## # ExitApplication # # This procedure can do any cleanup necessary before # exiting the program. # # Disable computer control of the radio, then quit. ########################################################## proc ExitApplication { } \ { global GlobalParam global ReadRadioFlag global TemplateSavedFlag if { ($ReadRadioFlag == "yes") \ && ($TemplateSavedFlag == "no") } \ { set msg "You did not save the template data" append msg " in a file." set result [tk_dialog .sav "Warning" \ $msg \ warning 0 Cancel Exit ] if {$result == 0} \ { return } } set GlobalParam(EditMemoryChannels) \ $GlobalParam(EditMemoryChannelsNext) SaveSetup # DisableCControl exit } ########################################################## # NoExitApplication # # This procedure prevents the user from # killing the window. ########################################################## proc NoExitApplication { } \ { set response [tk_dialog .quitit "Exit?" \ "Do not close this window." \ warning 0 OK ] return } ########################################################## # # Scroll_Set manages optional scrollbars. # # From "Practical Programming in Tcl and Tk," # second edition, by Brent B. Welch. # Example 27-2 # ########################################################## proc Scroll_Set {scrollbar geoCmd offset size} { if {$offset != 0.0 || $size != 1.0} { eval $geoCmd;# Make sure it is visible $scrollbar set $offset $size } else { set manager [lindex $geoCmd 0] $manager forget $scrollbar ;# hide it } } ########################################################## # # Listbox with optional scrollbars. # # # Inputs: basename of configuration file # # From "Practical Programming in Tcl and Tk," # second edition, by Brent B. Welch. # Example 27-3 # ########################################################## proc Scrolled_Listbox { f args } { frame $f listbox $f.list \ -font {courier 12} \ -xscrollcommand [list Scroll_Set $f.xscroll \ [list grid $f.xscroll -row 1 -column 0 -sticky we]] \ -yscrollcommand [list Scroll_Set $f.yscroll \ [list grid $f.yscroll -row 0 -column 1 -sticky ns]] eval {$f.list configure} $args scrollbar $f.xscroll -orient horizontal \ -command [list $f.list xview] scrollbar $f.yscroll -orient vertical \ -command [list $f.list yview] grid $f.list $f.yscroll -sticky news grid $f.xscroll -sticky news grid rowconfigure $f 0 -weight 1 grid columnconfigure $f 0 -weight 1 return $f.list } ########################################################## # # Create a scrollable frame. # # # From "Effective Tcl/Tk Programming," # by Mark Harrison and Michael McLennan. # Page 121. # ########################################################## proc ScrollformCreate { win } \ { frame $win -class Scrollform -relief groove -borderwidth 3 scrollbar $win.sbar -command "$win.vport yview" pack $win.sbar -side right -fill y canvas $win.vport -yscrollcommand "$win.sbar set" pack $win.vport -side left -fill both -expand true frame $win.vport.form $win.vport create window 0 0 -anchor nw \ -window $win.vport.form bind $win.vport.form "ScrollFormResize $win" return $win } proc ScrollFormResize { win } \ { set bbox [ $win.vport bbox all ] set wid [ winfo width $win.vport.form ] $win.vport configure -width $wid \ -scrollregion $bbox -yscrollincrement 0.1i } proc ScrollFormInterior { win } \ { return "$win.vport.form" } ########################################################## # Contruct the top row of pulldown menus ########################################################## proc MakeMenuBar { f } \ { global AboutMsg global Device global FileTypes global GlobalParam global Pgm global Version # File pull down menu frame $f -relief groove -borderwidth 3 menubutton $f.file -text "File" -menu $f.file.m \ -underline 0 menubutton $f.view -text "View" -menu $f.view.m \ -underline 0 menubutton $f.data -text "Data" -menu $f.data.m \ -underline 0 menubutton $f.radio -text "Radio" -menu $f.radio.m \ -underline 0 menubutton $f.help -text "Help" -menu $f.help.m \ -underline 0 menu $f.view.m AddView $f.view.m menu $f.data.m AddData $f.data.m menu $f.help.m $f.help.m add command -label "Readme" \ -underline 0 \ -command { \ set helpfile [format "%s/README" $Libdir ] set win [textdisplay_create "README"] textdisplay_file $win $helpfile } $f.help.m add command -label "Tcl info" \ -underline 0 \ -command { \ tk_dialog .about "Tcl info" \ [HelpTclInfo] info 0 OK } $f.help.m add command -label "License" \ -underline 0 \ -command { \ set helpfile [format "%s/COPYING" $Libdir ] set win [textdisplay_create "Notice"] textdisplay_file $win $helpfile } $f.help.m add command -label "About tk2" \ -underline 0 \ -command { \ tk_dialog .about "About tk2" \ $AboutMsg info 0 OK } menu $f.file.m -tearoff no $f.file.m add command -label "Open ..." \ -underline 0 \ -command {OpenTemplate .mainframe} $f.file.m add command -label "Save" \ -underline 0 \ -command {SaveTemplate .mainframe 0} $f.file.m add command -label "Save As ..." \ -underline 0 \ -command {SaveTemplate .mainframe 1} $f.file.m add separator set msg "Import memory channels from CSV file ..." $f.file.m add command -label $msg \ -underline 0 \ -command {\ ImportCSV . } set msg "Import memory channels from Percon ICF file ..." $f.file.m add command -label $msg \ -underline 0 \ -command {\ ImportICF . } set msg "Export memory channels to CSV file..." $f.file.m add command -label $msg \ -underline 0 \ -command {ExportChannels .mainframe} $f.file.m add separator $f.file.m add command -label "Exit" \ -underline 1 \ -command { ExitApplication} menu $f.radio.m -tearoff no AddRadio $f.radio.m pack $f.file $f.view $f.data $f.radio -side left -padx 10 pack $f.help -side right update return $f } proc MakeScrollPane {w x y} { frame $w -class ScrollPane -width $x -height $y canvas $w.c -xscrollcommand [list $w.x set] -yscrollcommand [list $w.y set] scrollbar $w.x -orient horizontal -command [list $w.c xview] scrollbar $w.y -orient vertical -command [list $w.c yview] set f [frame $w.c.content -borderwidth 0 -highlightthickness 0] $w.c create window 0 0 -anchor nw -window $f grid $w.c $w.y -sticky nsew grid $w.x -sticky nsew grid rowconfigure $w 0 -weight 1 grid columnconfigure $w 0 -weight 1 # This binding makes the scroll-region of the canvas behave correctly as # you place more things in the content frame. bind $f [list Scrollpane_cfg $w %w %h] $w.c configure -borderwidth 0 -highlightthickness 0 return $f } proc Scrollpane_cfg {w wide high} { set newSR [list 0 0 $wide $high] return if {![string equals [$w cget -scrollregion] $newSR]} { $w configure -scrollregion $newSR } } ########################################################## # Add widgets to the view menu ########################################################## proc AddView { m } \ { global GlobalParam # Change font. if {$GlobalParam(Font) == ""} \ { set msg "Change Font" } \ else \ { set msg [format "Change Font (%s)" $GlobalParam(Font)] } $m add command -label $msg -command \ { set ft [font_select] if {$ft != ""} \ { set GlobalParam(Font) $ft set msg "The change will take effect next " set msg [append msg "time you start tk2."] tk_dialog .wcf "Change Appearance" \ $msg info 0 OK } } $m add command -label "Restore Original Font" -command \ { set GlobalParam(Font) "" set msg "The change will take effect next " set msg [append msg "time you start tk2."] tk_dialog .wcf "Change Appearance" $msg info 0 OK } $m add separator $m add command -label "Change Panel Color" -command \ { set col [tk_chooseColor -initialcolor #d9d9d9] if {$col != ""} \ { set GlobalParam(BackGroundColor) $col set msg "The change will take effect next " set msg [append msg "time you start tk2."] tk_dialog .wcf "Change Appearance" \ $msg info 0 OK } } $m add command -label "Change Lettering Color" -command \ { set col [tk_chooseColor -initialcolor black] if {$col != ""} \ { set GlobalParam(ForeGroundColor) $col set msg "The change will take effect next " set msg [append msg "time you start tk2."] tk_dialog .wcf "Change Appearance" \ $msg info 0 OK } } $m add command -label "Change Slider Trough Color" -command \ { set col [tk_chooseColor -initialcolor #c3c3c3] if {$col != ""} \ { set GlobalParam(TroughColor) $col set msg "The change will take effect next " set msg [append msg "time you start tk2."] tk_dialog .wcf "Change Appearance" \ $msg info 0 OK } } $m add separator set msg "Edit Memory Channel Settings " append msg "(works best with 512 MB or more RAM)" $m add radiobutton \ -label "Memory channels appear in tabbed notebook" \ -variable GlobalParam(EditMemoryChannelsNext) \ -value on \ -command {\ set msg "The change will take effect next " append msg "time you start the program." tk_dialog .wcf "Change Appearance" \ $msg info 0 OK } $m add radiobutton \ -label "Memory channels appear in scrolled window" \ -variable GlobalParam(EditMemoryChannelsNext) \ -value off \ -command {\ set msg "The change will take effect next " append msg "time you start the program." tk_dialog .wcf "Change Appearance" \ $msg info 0 OK } $m add separator # $m add checkbutton \ # -label $msg \ # -variable GlobalParam(EditMemoryChannels) \ # -onvalue on -offvalue off # Helpful tips balloons $m add checkbutton \ -label "Balloon Help Windows" \ -variable GlobalParam(BalloonHelpWindows) \ -onvalue on -offvalue off return } ########################################################## # Add widgets to the Data menu ########################################################## proc AddData { m } \ { global GlobalParam set hint "" append hint "The Encode Image operation " append hint "is designed for use when " append hint "testing tk2." balloonhelp_for $m $hint $m add command -label "Validate data" \ -command \ { if {[ValidateData] == 0} \ { tk_dialog .info "Valiate data" \ "The data is ok." info 0 OK } } $m add command -label "Check for duplicate frequencies" \ -command { CkDuplicate } $m add command -label "Encode Image" \ -command { \ if {[ValidateData] == 0} \ { MakeWait EncodeImage KillWait } } $m add separator $m add command -label "Swap Memory Banks ..." \ -command { MakeSwapFrame } $m add command -label "Sort Channels ..." \ -command { MakeSortFrame } $m add command -label "Clear All Channels" \ -command { ClearAllChannels } return } ########################################################## # Add choices to the Radio menu ########################################################## proc AddRadio { m } \ { global GlobalParam global Libdir $m add command -label "Read from radio ..." \ -command { \ Radio2Template .mainframe update } $m add command -label "Write to radio ..." \ -command { \ Image2Radio .mainframe update } $m add separator $m add command -label "Interrogate radio for model info ..." \ -command { \ global GlobalParam set s [GetModelInfo] binary scan $s "H*" x set GlobalParam(RadioVersion) $x update } $m add separator $m add radiobutton -label "Model with 10 kHz BCB steps" \ -variable GlobalParam(WhichModel) \ -value 10 $m add radiobutton -label "Model with 9 kHz BCB steps" \ -variable GlobalParam(WhichModel) \ -value 9 $m add separator $m add command -label "Configure Serial Port ..." \ -command { MakeConfigurePortFrame } $m add separator $m add checkbutton \ -label "Debug" \ -variable GlobalParam(Debug) \ -onvalue "1" \ -offvalue "0" return $m } ################################################################### # # Permit user to adjust serial port settings. # Create a popup window. # ################################################################### proc MakeConfigurePortFrame { } \ { global GlobalParam global tcl_platform global tcl_version catch {destroy .timingwin} toplevel .timingwin wm title .timingwin "Configure serial port" set f .timingwin set a $f.a frame $a -relief flat -borderwidth 3 label $a.lrtslevel \ -text "Set RTS pin to +12 VDC" \ -borderwidth 3 checkbutton $a.rtslevel -text "" \ -variable GlobalParam(RTSline) \ -onvalue "12" -offvalue "-12" set hint "" append hint "Some cloning cables require +12 VDC on " append hint "the RTS pin, but most do not." balloonhelp_for $a.lrtslevel $hint balloonhelp_for $a.rtslevel $hint label $a.lcableechos \ -text "Read back commands from serial port" \ -borderwidth 3 checkbutton $a.cableechos -text "" \ -variable GlobalParam(CableEchos) \ -onvalue 1 -offvalue 0 set hint "" append hint "Read back commands if:\n\n" append hint "(1) You are using Microsoft Windows " append hint "and using either the Purple or RT Sytems " append hint "CT29A cloning cable.\n\n" append hint "(2) You are using Linux and using \n" append hint "an RT Systems CT29A cloning cable.\n\n" append hint "Do not read back commands if " append hint "you are using Bill Petrowsky's 2-transistor " append hint "cable. " balloonhelp_for $a.cableechos $hint balloonhelp_for $a.lcableechos $hint grid $a.lrtslevel -row 10 -column 0 -sticky w grid $a.rtslevel -row 10 -column 1 -sticky w grid $a.lcableechos -row 20 -column 0 -sticky w grid $a.cableechos -row 20 -column 1 -sticky w pack $a -side top -anchor w -padx 3 -pady 3 -expand true button $f.ok -text "OK" -command \ { catch {destroy .timingwin} } pack $f.ok -side top -padx 3 -pady 3 -expand true update return } ########################################################## # # Create a progress gauge widget. # # # From "Effective Tcl/Tk Programming," # by Mark Harrison and Michael McLennan. # Page 125. # ########################################################## proc gauge_create {win {color ""}} \ { frame $win -class Gauge # set len [option get $win length Length] set len 300 canvas $win.display -borderwidth 0 -background white \ -highlightthickness 0 -width $len -height 20 pack $win.display -expand yes -padx 10 if {$color == ""} \ { set color [option get $win color Color] } $win.display create rectangle 0 0 0 20 \ -outline "" -fill $color -tags bar $win.display create text [expr {0.5 * $len}] 10 \ -anchor c -text "0%" -tags value return $win } proc gauge_value {win val} \ { if {$val < 0 || $val > 100} \ { error "bad value \"$val\": should be 0-100" } set msg [format "%.0f%%" $val] $win.display itemconfigure value -text $msg set w [expr {0.01 * $val * [winfo width $win.display]}] set h [winfo height $win.display] $win.display coords bar 0 0 $w $h update } proc MakeWaitWindow {f cnflag color} \ { global CancelXfer set CancelXfer 0 frame $f button $f.cancel -text Cancel -command {\ global CancelXfer; set CancelXfer 1; puts "Canceled"} gauge_create $f.g PaleGreen option add *Gauge.borderWidth 2 widgetDefault option add *Gauge.relief sunken widgetDefault option add *Gauge.length 300 widgetDefault option add *Gauge.color gray widgetDefault pack $f.g -expand yes -fill both \ -padx 10 -pady 10 if {$cnflag} \ { pack $f.cancel -side top -padx 3 -pady 3 } pack $f return $f.g } ########################################################## # # Copy data from radio to template image (a lengthy string). # ########################################################## proc Radio2Template { f }\ { global Cht global FileTypes global GlobalParam global Home global MemFreq global MemMode global ReadRadioFlag set msg "" append msg "Instructions (read all steps):\n" append msg "1) Ensure the radio is connected to your computer" append msg " and powered on.\n" set result [tk_dialog .info "Read from radio" \ $msg \ info 0 OK Cancel ] if {$result} \ { return } # Read memory image from radio. if {[ReadImage]} \ { set ReadRadioFlag no set msg "Error while reading from radio." tk_dialog .error $msg $msg error 0 OK return } set GlobalParam(Populated) 1 # ZapBankLabels DecodeImage ShowChannels $Cht set msg "Transfer Complete.\n" append msg "Look at the radio display " append msg "to see if it displays a message." tk_dialog .belch "Read IC-R2" \ $msg info 0 OK set ReadRadioFlag yes return } ########################################################## # Write memory image to a template file. ########################################################## proc SaveTemplate { f asflag } \ { global GlobalParam global TemplateSavedFlag global ReadRadioFlag global Mimage global Nmessages if {[string length $Mimage] <= 0} \ { set msg "You must first read template data from" append msg " the radio before saving it in a" append msg " template file." append msg " (Use the Radio menu for reading" append msg " from the radio.)" tk_dialog .error "No template data" \ $msg error 0 OK return } set mitypes \ { {"IC-R2 template files" {.tr2} } } set filename $GlobalParam(TemplateFilename) if { ($GlobalParam(TemplateFilename) == "") \ || ($asflag) } \ { set filename \ [Mytk_getSaveFile $f \ $GlobalParam(MemoryFileDir) \ .tr2 \ "Save IC-R2 data to template file" \ $mitypes] } if { $filename != "" }\ { if {[ValidateData]} {return} MakeWait EncodeImage # Truncate memory image to the proper length. # We want to ignore the several FF records # which may have been appended # at the end of the image. set n [expr {($Nmessages * 32) - 1}] set Mimage [string range $Mimage 0 $n] KillWait set GlobalParam(TemplateFilename) $filename SetWinTitle set GlobalParam(MemoryFileDir) \ [ Dirname $GlobalParam(TemplateFilename) ] set fid [open $GlobalParam(TemplateFilename) "w"] fconfigure $fid -translation binary puts -nonewline $fid $Mimage WriteMemLabels $fid WriteBankLabels $fid close $fid set TemplateSavedFlag yes } return } ########################################################## # Read memory image from a template file. ########################################################## proc OpenTemplate { f } \ { global BytesPerMessage global Cht global GlobalParam global Mimage global Nmessages set mitypes \ { {"IC-R2 template files" {.tr2} } {"Butel ARC2 files" {.ic2 .IC2} } {"Goran Vlaski IC-R2 Programming Utility file" \ {.r2 .R2} } } set GlobalParam(TemplateFilename) [Mytk_getOpenFile \ $f $GlobalParam(MemoryFileDir) \ "Open template file" $mitypes] if { $GlobalParam(TemplateFilename) != "" }\ { set GlobalParam(MemoryFileDir) \ [ Dirname $GlobalParam(TemplateFilename) ] if [ catch { open $GlobalParam(TemplateFilename) "r"} fid] \ { # error tk_dialog .error "tk2" \ "Cannot open file $file" \ error 0 OK set GlobalParam(TemplateFilename) "" return } fconfigure $fid -translation binary if { [regexp -nocase {\.r2$} \ $GlobalParam(TemplateFilename)] } \ { # User wants to read a Goran Valaski # IC-R2 Programming Utility .R2 file. set GlobalParam(TemplateFilename) "" set code [ReadR2File $fid] # ZapBankLabels DecodeImage } \ elseif { [regexp -nocase {\.ic2$} \ $GlobalParam(TemplateFilename)] } \ { # User wants to read a Butel ARC2 .IC2 file. set GlobalParam(TemplateFilename) "" set code [ReadIC2File $fid] # ZapBankLabels DecodeImage } \ else \ { # User specified a .tr2 file. set nbytes [expr {$Nmessages * $BytesPerMessage / 2}] set Mimage [read $fid $nbytes] set code 0 DecodeImage set lst [ReadVariables \ $GlobalParam(TemplateFilename) $fid] SetMemLabels $lst # ZapBankLabels SetBankLabels $lst } close $fid SetWinTitle if {$code == 0} \ { set GlobalParam(Populated) 1 ShowChannels $Cht } } return } ########################################################## # Import data from a .ICF (ICOM Clone Format) file ########################################################## proc ImportICF { f }\ { global Cht global GlobalParam global Icf2Hex global Mimage if {[info exists Mimage] == 0} \ { set msg "You must open a template file\n" append msg " or read an image from the radio\n" append msg " before importing channels.\n" tk_dialog .importinfo "tk2" \ $msg info 0 OK return } set filetypes \ { {"ICOM clone format files" {.ICF .icf} } } set filename [Mytk_getOpenFile $f \ $GlobalParam(MemoryFileDir) \ "Import data from ICF file" $filetypes] if {$filename == ""} then {return ""} set GlobalParam(MemoryFileDir) [ Dirname $filename ] if [ catch { open $filename "r"} fid] \ { # error tk_dialog .error "tk2" \ "Cannot open file $file" \ error 0 OK return } # Read entire .ICF file at one time. set allicf [read $fid] set line "" set i 0 set Mimage "" # For each line in the .csv file. foreach line [split $allicf "\n" ] \ { update incr i # Skip the first 2 lines in the file. if { $i > 2 } then\ { set nchar [string len $line] # for each char in the line set buf "" # puts -nonewline stderr "$i) " for {set j 6} {$j < $nchar} {incr j} \ { set c [string range $line $j $j] if {[info exists Icf2Hex($c)] == 0} \ { puts stderr "Error in ICF file." break } set newc $Icf2Hex($c) append buf $newc # puts -nonewline stderr "$newc" } # Translate to binary set buf [string toupper $buf] set pbuf [PackString $buf] append Mimage $pbuf } # puts -nonewline stderr "\n" } set GlobalParam(TemplateFilename) "" SetWinTitle DecodeImage ShowChannels $Cht close $fid return } ########################################################## # Import memory channels from a .csv file ########################################################## proc ImportCSV { f }\ { global Cht global GlobalParam global MemDuplex global MemFreq global MemMode global MemOffset global MemSkip global MemStep global MemToneCode global MemToneFlag global Mimage if {[info exists Mimage] == 0} \ { set msg "You must open a template file\n" append msg " or read an image from the radio\n" append msg " before importing channels.\n" tk_dialog .importinfo "tk2" \ $msg info 0 OK return } set filetypes \ { {"IC-R2 memory channel files" {.csv .txt} } } set filename [Mytk_getOpenFile $f \ $GlobalParam(MemoryFileDir) \ "Import channels" $filetypes] if {$filename == ""} then {return ""} set GlobalParam(MemoryFileDir) [ Dirname $filename ] if [ catch { open $filename "r"} fid] \ { # error tk_dialog .error "tk2" \ "Cannot open file $file" \ error 0 OK return } # Read entire .csv file at one time. set allchannels [read $fid] set line "" set i 0 # For each line in the .csv file. foreach line [split $allchannels "\n" ] \ { update incr i if { $i > 1 } then\ { # Delete double quote characters. regsub -all "\"" $line "" bline set line $bline if {$line == ""} then {continue} set msg [ParseCsvLine $line] if {$msg != ""} \ { set response [ErrorInFile \ $msg $line $filename] if {$response == 0} then {continue} \ else {ExitApplication} } } } ShowChannels $Cht close $fid return } ################################################################### # Parse a line from the csv file. Perform sanity checks on # the field values and store them in array variables. # # Returns: # empty string -ok # descriptive error message string otherwise ################################################################### proc ParseCsvLine {line} \ { global Ctcss global GlobalParam global MemDuplex global MemFreq global MemLabel global MemMode global MemOffset global MemSkip global MemStep global MemToneCode global MemToneFlag global Mode global Skip global Step set endlabel $GlobalParam(LabelLength) incr endlabel -1 if {$line == ""} {return error} set mlist [split $line ","] set n [llength $mlist] set m [ expr {10 - $n} ] # Add empty fields to the end of the line # if there are too few fields. for {set i 0} {$i < $m} {incr i} \ { append line "," } set mlist [split $line ","] # if { [llength $mlist] < 4 } \ # { # return "Missing one or more fields." # } set bn [lindex $mlist 0] set i [lindex $mlist 1] set ch [expr {($bn * 50) + $i}] set freq [lindex $mlist 2] set mode [lindex $mlist 3] set step [lindex $mlist 4] set offset [lindex $mlist 5] set duplex [lindex $mlist 6] set toneflag [lindex $mlist 7] set ctcss [lindex $mlist 8] set skip [lindex $mlist 9] set label [lindex $mlist 10] if { ($bn < 0) || ($bn > 7) } \ { return "Invalid bank $bn." } if { ($i < 0) || ($i > 49) } \ { return "Invalid channel $i." } if { ($freq < $GlobalParam(LowestFreq)) \ || ($freq > $GlobalParam(HighestFreq)) } \ { return "Invalid frequency $freq." } set nmode [string toupper $mode] if {$nmode == ""} \ { set nmode NFM } if { [info exists Mode($nmode)] == 0 } \ { return "Invalid mode $mode." } set nstep $step if {$nstep == ""} \ { set nstep 5 } if {[info exists Step($nstep)] == 0 } \ { return "Invalid step $step." } if {$offset == ""} \ { set noffset 0.000 } \ else \ { set noffset [format "%.3f" $offset] } if { ($noffset < 0.0) || ($noffset > 159.995) } \ { return "Invalid offset $offset." } # If duplex field consists of one or more spaces, # translate it. if { [regexp {^[[:blank:]]+$} $duplex] != 0} \ { set duplex "" } if {($duplex != "") \ && ($duplex != " ") \ && ($duplex != "+") \ && ($duplex != "-")} \ { return "Invalid duplex flag $duplex." } if {$duplex == " "} \ { set duplex "" } if {$toneflag != ""} \ { set ntoneflag tsql } \ else \ { set ntoneflag off } \ set nctcss $ctcss if {$ctcss == ""} \ { set nctcss 0.0 } \ elseif { [regexp {\.} $ctcss] == 0} \ { # CTCSS code is probably an integer # so append .0 to it. set nctcss [format "%s.0" $ctcss] } if { [info exists Ctcss($nctcss)] == 0 } \ { return "Invalid CTCSS code $ctcss." } # Must be null, a space, skip, or pskip to be valid. if {($skip == "") && ($skip == " ")} \ { if { [info exists Skip($nskip)] == 0 } \ { return "Invalid skip value $skip." } } set MemFreq($ch) [format "%.5f" $freq] set MemMode($ch) $nmode set MemStep($ch) $nstep set MemOffset($ch) $noffset set MemDuplex($ch) $duplex set MemToneFlag($ch) $ntoneflag set MemToneCode($ch) $nctcss set MemSkip($ch) $skip set s [string range $label 0 $endlabel] set s [string trimright $s " "] set MemLabel($ch) $s return "" } ########################################################## # Read memory image from an open Goran Valaski .r2 file # # Inputs: # fid -file descriptor ########################################################## proc ReadR2File { fid }\ { global GlobalParam global Mimage global Nmessages global Pgm # Read the first part of .r2 file one record at a time. set image "" for {set i 0} {$i < $Nmessages} {incr i} \ { set line [read $fid 46] set len [string length $line] if {$len != 46} \ { set msg "$Pgm: " append msg "Corruption in .r2 file" puts stderr $msg tk_dialog .error "tk2" \ "Corrupted .r2 file" \ error 0 OK return -1 } set cc [string index $line 4] if { [string compare -nocase -length 1 $cc \xE4] } \ { set msg "$Pgm: " append msg "Corruption in .r2 file" puts stderr $msg tk_dialog .error "tk2" \ "Corrupted .r2 file" \ error 0 OK return -1 } set pline [PackString [string range $line 5 44]] set plen [string length $pline] set dbuf [string range $pline 0 18] set cksum [string range $pline 19 19] set ccksum [CalcCheckSum $dbuf] binary scan $cksum "H*" icksum scan $icksum "%x" cksum # puts stderr [format "CHECKSUM file: %s, calculated: %s\n" \ # $cksum $ccksum] if {$cksum != $ccksum} \ { set msg [format \ "%s: error, checksum mismatch, radio: %s, calculated: %s\n" \ $Pgm $cksum $ccksum] Tattle $msg tk_dialog .error "Checksum error while reading file" \ $msg error 0 OK return -1 } # Strip off memory address and count bytes. set buf [string range $dbuf 3 end] # set buf [string range $pline 5 44] # set abuf "$i) " # append abuf [DumpBinary $buf] # puts stderr $abuf append image $buf } set Mimage $image return 0 } ########################################################## # Read memory image from an open Butel ARC2 .IC2 file # # Inputs: # fid -file descriptor ########################################################## proc ReadIC2File { fid }\ { global GlobalParam global Mimage global Nmessages global Pgm # Read the first part of .r2 file one line at a time. set image "" for {set i 0} {$i < $Nmessages} {incr i} \ { set len [gets $fid line] if {$len < 40} \ { set msg "$Pgm: " append msg "Corruption in ARC .IC2 file" puts stderr $msg tk_dialog .error "tk2" \ "Corrupted ARC2 .IC2 file" \ error 0 OK return -1 } set line [string range $line 0 39] set pline [binary format "H40" $line] set plen [string length $pline] set dbuf [string range $pline 0 18] set cksum [string range $pline 19 19] set ccksum [CalcCheckSum $dbuf] binary scan $cksum "H*" icksum scan $icksum "%x" cksum # puts stderr [format "CHECKSUM file: %s, calculated: %s\n" \ # $cksum $ccksum] if {$cksum != $ccksum} \ { set msg [format \ "%s: error, checksum mismatch, radio: %s, calculated: %s\n" \ $Pgm $cksum $ccksum] Tattle $msg tk_dialog .error "Checksum error while reading file" \ $msg error 0 OK return -1 } # Strip off memory address and count bytes. set buf [string range $dbuf 3 end] # set buf [string range $pline 5 44] # set abuf "$i) " # append abuf [DumpBinary $buf] # puts stderr $abuf append image $buf } set Mimage $image return 0 } ########################################################## # Show memory channels in a window. ########################################################## proc ShowChannels { f }\ { global BankLabel global Chb global Chvector global GlobalParam global MemDuplex global MemFreq global MemLabel global MemMode global MemOffset global MemSkip global MemStep global MemToneCode global MemToneFlag global RMode set Chvector "" if {$GlobalParam(EditMemoryChannels) == "on"} {return} set prevbn -1 for {set bn 0} {$bn < 8} {incr bn} \ { set ch [expr {$bn * 50}] for {set i 0} {$i < 50} {incr i} \ { if {$bn != $prevbn} \ { if {$bn == 7} \ { set s [format "----- BANK SKIP --------" $bn] } \ else \ { set s [format "----- BANK %d %s --------" $bn $BankLabel($bn)] } lappend Chvector $s set prevbn $bn } if {$MemFreq($ch) > 0.0001} \ { if { $MemOffset($ch) < .001 } \ { set offset "" } \ else \ { set offset [format "%7.3f" \ $MemOffset($ch)] } if { $MemToneFlag($ch) == 1} \ { set toneflag t set tonecode $MemToneCode($ch) } \ else \ { # Tone is off, so # hide CTCSS the code. set toneflag "" set tonecode "" } set mode [string toupper $MemMode($ch)] set s [format "%3d %11.5f %-3s %5s %7s %1s %1s %5s %5s %-s" \ $i $MemFreq($ch) \ $mode \ $MemStep($ch) \ $offset \ $MemDuplex($ch) \ $toneflag \ $tonecode \ $MemSkip($ch) \ $MemLabel($ch) ] lappend Chvector $s } incr ch } } catch {destroy $f.lch} set Chb [ List_channels $f.lch $Chvector 30 ] # Force memory ch window to appear on top by hiding, then # then showing it. catch {wm withdraw $f} catch {wm deiconify $f} $Chb activate 1 pack $f.lch -side top wm maxsize .vfo [winfo width .vfo] [winfo height .vfo] return } ########################################################## # Export memory channels to a .csv file ########################################################## proc ExportChannels { f }\ { global FileTypes global GlobalParam global Home global MemDuplex global MemFreq global MemLabel global MemMode global MemOffset global MemSkip global MemStep global MemToneCode global MemToneFlag global Mimage global Ofilename set endlabel $GlobalParam(LabelLength) incr endlabel -1 if { ([info exists Mimage] == 0) \ || ([string length $Mimage] <= 0) } \ { set msg "You must read data from the radio" append msg " before exporting channels." append msg " (See the Radio menu.)" tk_dialog .info "tk2" $msg info 0 OK return } set Ofilename [Mytk_getSaveFile $f \ $GlobalParam(MemoryFileDir) \ .csv \ "Export memory channels to .csv file" \ $FileTypes] if {$Ofilename != ""} \ { # puts stderr "ExportChannels: Ofilename $Ofilename" set GlobalParam(MemoryFileDir) [ Dirname $Ofilename ] set fid [open $Ofilename "w"] tk_dialog .belch "Export" \ "Export Complete" info 0 OK # Write first line as the field names. puts -nonewline $fid [format "Bank,Ch,MHz,Mode,Step,"] puts $fid [format "Offset,Duplex,TSQL,CTCSS,Skip,Label"] for {set bn 0} {$bn < 8} {incr bn} \ { set ch [expr {$bn * 50}] for {set i 0} {$i < 50} {incr i} \ { if {($MemFreq($ch) == "") \ || ($MemFreq($ch) <= .000001)} \ { incr ch continue } if {$MemToneFlag($ch) == "tsql"} \ { set toneflag tsql } \ else \ { set toneflag "" } set skip $MemSkip($ch) if {$skip == " "} \ { set skip "" } set s [format "%d,%d,%s,%s,%s,%s,%s,%s,%s,%s," \ $bn $i $MemFreq($ch) \ $MemMode($ch) \ $MemStep($ch) \ $MemOffset($ch) \ $MemDuplex($ch) \ $toneflag \ $MemToneCode($ch) \ $skip ] if {$MemLabel($ch) != ""} \ { set lab [string range \ $MemLabel($ch) 0 \ $endlabel] set lab [string trimright $lab \ " "] set lab [format "\"%s\"" $lab] append s $lab } puts $fid $s incr ch } } close $fid } return } ########################################################## # Create a popup window which tells the user # that the file already exists. Ask for guidance. # # Returns: # Cancel # Overwrite ########################################################## proc FileExistsDialog { file } \ { set result [tk_dialog .fed "Warning" \ "File $file already exists. Overwrite file?" \ warning 0 Cancel Overwrite ] puts "result is $result" return $result } ########################################################## # Copy memory image to the radio ########################################################## proc Image2Radio { f }\ { global FileTypes global Mimage global ReadRadioFlag if { ([info exists Mimage] == 0) \ || ([string length $Mimage] <= 0)} \ { # No image to write. set msg "You must first read template data from" append msg " the radio or a file before" append msg " writing it to the radio." tk_dialog .error "Write to radio" $msg error 0 OK } if {$ReadRadioFlag == "yes"} \ { # We read an image from the radio. # Cannot read from and write to the radio # during the same session or else the radio # complains. (Reason unknown.) # # Tell user to save the image file, exit # the program, restart the program, read # the image file, then write to the radio. set msg "" append msg "You cannot read from the radio " append msg "and write to the radio during the same " append msg "session.\n\n" append msg "Please:\n" append msg "1) Save the memory image in a file,\n" append msg "using File --> Save As ...\n" append msg "2) Exit this program.\n" append msg "3) Restart this program.\n" append msg "4) Open the image file you saved " append msg "previously, using File --> Open ...\n " append msg "5) Then, you can write the image " append msg "to the radio." tk_dialog .belch "Write blocked warning" \ $msg warning 0 OK return } if {[ValidateData]} {return} MakeWait EncodeImage KillWait set msg "" append msg "Instructions:\n" append msg "1) Ensure the radio is connected to" append msg " your computer and radio power is on.\n" set result [tk_dialog .info "Write to IC-R2" \ $msg \ info 0 OK Cancel ] if {$result} \ { # User canceled the write. return } set wcode [WriteImage] if {$wcode == 1} \ { set msg "Error while writing to the radio." tk_dialog .error "Write error" $msg error 0 OK KillWait } \ elseif {$wcode == 2} \ { set msg "Error, cannot read radio version info." tk_dialog .error "Write error" $msg error 0 OK KillWait } \ else \ { set msg "Transfer Complete.\n" append msg "Look at the radio display " append msg "to view a status message." tk_dialog .belch "Transfer Complete" \ $msg info 0 OK } return } ################################################################### # Return 1 if frequency is in range 0 - 2000 exclusive. ################################################################### proc FreqInRange { f units } \ { if {$units == "mhz" } \ { if { $f > 0 && $f < 2000.0 } \ { return 1 } } \ elseif {$units == "khz" } \ { if { $f > 0 && $f < 2000000.0 } \ { return 1 } } return 0 } ################################################################### # Return 1 if string 's' is a valid frequency. # Return 0 otherwise. # # Units should be kHz or MHz ################################################################### proc CheckFreqValid { s units }\ { if {$s == ""} then {return 0} # Check for non-digit and non decimal point chars. set rc [regexp {^[0-9.]*$} $s] if {$rc == 0} then {return 0} # All digits. set rc [regexp {^[0-9]*$} $s] if {$rc == 1} \ { return [FreqInRange $s $units] } if {$s == "."} then {return 0} # Check for Two or more decimal points set tmp $s set tmp [split $s "."] set n [llength $tmp] if { $n >= 3 } then {return 0} return [FreqInRange $s $units] } ################################################################### # Set default receiver parameters ################################################################### proc SetUp { } \ { global env global GlobalParam global RootDir global tcl_platform if { [regexp "Darwin" $tcl_platform(os) ] } \ { # For Mac OS X. set RootDir ":" } \ else \ { set RootDir "/" } set GlobalParam(Debug) 0 # set GlobalParam(Device) /dev/ttyS1 set GlobalParam(Ifilename) {} set GlobalParam(MemoryFileDir) $RootDir set GlobalParam(PreviousFreq) 0.0 return } ################################################################### # # Define receiver parameters before we read the # global parameter configuration file in case they are missing # from the configuration file. # This avoids a tcl error if we tried to refer to an # undefined variable. # # These initial definitions will be overridden with # definitions from the configuration file. # ################################################################### proc PresetGlobals { } \ { global GlobalParam global Mode global Rcfile global RootDir global tcl_platform set GlobalParam(BalloonHelpWindows) on set GlobalParam(Attenuator) 0 set GlobalParam(AutoOff) OFF set GlobalParam(BackGroundColor) "" set GlobalParam(BankScan) 0 set GlobalParam(BankSort) -1 set GlobalParam(BatterySaver) 1 set GlobalParam(Beep) 1 set GlobalParam(CableEchos) 1 set GlobalParam(Debug) 0 set GlobalParam(Dial) 1MHz set GlobalParam(DialAccel) 1 set GlobalParam(EditMemoryChannels) on set GlobalParam(EditMemoryChannelsNext) \ $GlobalParam(EditMemoryChannels) set GlobalParam(Font) "" set GlobalParam(ForeGroundColor) "" set GlobalParam(Lamp) AUTO set GlobalParam(LimitSearch) 0 set GlobalParam(Lock) 0 set GlobalParam(MemoryFileDir) $RootDir set GlobalParam(Mode) $Mode(NFM) set GlobalParam(Monitor) PUSH set GlobalParam(Pause) 10 set GlobalParam(PowerSave) 1 set GlobalParam(RadioVersion) "" set GlobalParam(Resume) 2 set GlobalParam(DTRline) 12 set GlobalParam(RTSline) -12 set GlobalParam(SetMenuItem) 0 set GlobalParam(TroughColor) "" set GlobalParam(TuningStep) 5 set GlobalParam(VFOSearch) ALL set GlobalParam(VFOFreq) 162.4000 set GlobalParam(WhichModel) 10 set GlobalParam(WXFreq) 162.55 set GlobalParam(WXMode) AUTO return } ################################################################### # Set global variables after reading the global # configuration file so these settings override # whatever values were in the configuration file. ################################################################### proc OverrideGlobals { } \ { global env global GlobalParam global RootDir global tcl_platform set GlobalParam(BypassAllEncoding) 0 set GlobalParam(EditMemoryChannelsNext) \ $GlobalParam(EditMemoryChannels) set GlobalParam(FileVersion) " " set GlobalParam(Ifilename) {} set GlobalParam(LowestFreq) .005 set GlobalParam(HighestFreq) 1599.995 set GlobalParam(LabelLength) 20 set GlobalParam(NmsgsRead) 0 set GlobalParam(Populated) 0 set GlobalParam(SortBank) 0 set GlobalParam(SortType) freq set GlobalParam(TemplateFilename) {} set GlobalParam(UserComment) " " set GlobalParam(UserPort) 0 # Note on MacOS X: # The initial directory passed to the file chooser widget. # The problem here is that osx's tcl is utterly busted. # The _only_ pathname it accepts is ':' - no other ones work. # Now this isn't as bad as you might think because # the native macos file selector widget persistantly # remembers the last place you opened/saved a file # for a particular application. So the logic to # remember this is simply redundant on macos anyway... # Presumably they'll fix this someday and we can take # out the hack. # - Ben Mesander if { [regexp "Darwin" $tcl_platform(os) ] } \ { # kluge for MacOS X. set GlobalParam(LogFileDir) $RootDir set GlobalParam(MemoryFileDir) $RootDir if {$GlobalParam(Ifilename) != ""} \ { set GlobalParam(Ifilename) $RootDir } } return } ################################################################### # # Parse data from inside the memory image and store it # in global arrays. # ################################################################### proc DecodeImage { } \ { global MemFreq global MemDuplex global MemMode global MemOffset global MemStep global MemToneCode global MemToneFlag MakeWait update idletasks ZapBankLabels for {set bn 0} {$bn < 8} {incr bn} \ { set ch [expr {$bn * 50}] for {set i 0} {$i < 50} {incr i} \ { ZapChannel $ch incr ch } } DecodeMisc DecodeMemories DecodeSearchBanks DecodeBandStack # DecodeDWBanks update idletasks KillWait update idletasks return } ################################################################### # # Parse data from inside the memory image and store it # in global arrays. # ################################################################### proc DecodeMisc { } \ { global GlobalParam global ImageAddr global Mimage global Priority global PriorityMode global RAutoOff global RDial global RBatterySaver global RMode global RMonitor global RLamp global RFstep global RPause global RResume global RStep # Parse file version scan $ImageAddr(FileVersion) "%x" first set last [expr {$first + 15}] set GlobalParam(FileVersion) \ [string range $Mimage $first $last] # Parse user comment scan $ImageAddr(UserComment) "%x" first set last [expr {$first + 15}] set GlobalParam(UserComment) \ [string range $Mimage $first $last] # Parse dial acceleration flag scan $ImageAddr(DialAccel) "%x" first set byte [string range $Mimage $first $first] set GlobalParam(DialAccel) [Char2Int $byte] # Parse power save flag scan $ImageAddr(PowerSave) "%x" first set byte [string range $Mimage $first $first] set GlobalParam(PowerSave) [Char2Int $byte] # Parse bank scan flag scan $ImageAddr(BankScan) "%x" first set byte [string range $Mimage $first $first] set GlobalParam(BankScan) [Char2Int $byte] # Parse beep tone, on or off flag scan $ImageAddr(Beep) "%x" first set byte [string range $Mimage $first $first] set GlobalParam(Beep) [Char2Int $byte] # # parse Tuning Step # scan $ImageAddr(VFOStep) "%x" first # set byte [string range $Mimage $first $first] # binary scan $byte "H2" s # # if { [info exists RStep($s)] } \ # { # set GlobalParam(TuningStep) $RStep($s) # } \ # else \ # { # set GlobalParam(TuningStep) AUTO # } # # # Parse VFO/Limit Search bit # scan $ImageAddr(FlagByte0) "%x" first # set s [string range $Mimage $first $first] # set GlobalParam(LimitSearch) [GetBit $s 3] # Parse Auto Power Off scan $ImageAddr(AutoOff) "%x" first set s [string range $Mimage $first $first] set n [Char2Int $s] if { [info exists RAutoOff($n)] } \ { set GlobalParam(AutoOff) $RAutoOff($n) } \ else \ { set GlobalParam(AutoOff) OFF } # Parse Dial scan $ImageAddr(DialStep) "%x" first set s [string range $Mimage $first $first] set n [Char2Int $s] if { [info exists RDial($n)] } \ { set GlobalParam(Dial) $RDial($n) } \ else \ { set GlobalParam(Dial) 1MHz } scan $ImageAddr(Lamp) "%x" first set s [string range $Mimage $first $first] set n [Char2Int $s] if { [info exists RLamp($n)] } \ { set GlobalParam(Lamp) $RLamp($n) } \ else \ { set GlobalParam(Lamp) AUTO } scan $ImageAddr(Pause) "%x" first set s [string range $Mimage $first $first] set n [Char2Int $s] if { [info exists RPause($n)] } \ { set GlobalParam(Pause) $RPause($n) } \ else \ { set GlobalParam(Pause) 2 } scan $ImageAddr(Resume) "%x" first set s [string range $Mimage $first $first] set n [Char2Int $s] if { [info exists RResume($n)] } \ { set GlobalParam(Resume) $RResume($n) } \ else \ { set GlobalParam(Resume) 2 } # Monitor key scan $ImageAddr(Monitor) "%x" first set s [string range $Mimage $first $first] set n [Char2Int $s] if { [info exists RMonitor($n)] } \ { set GlobalParam(Monitor) $RMonitor($n) } \ else \ { set GlobalParam(Monitor) PUSH } # # Parse Fast Tuning Step # scan $ImageAddr(FastTuningStep) "%x" first # set s [string range $Mimage $first $first] # set n [Char2Int $s] # if { [info exists RFstep($n)] } \ # { # set GlobalParam(FastTuningStep) $RFstep($n) # } \ # else \ # { # set GlobalParam(FastTuningStep) 1MHz # } return } ################################################################### # # Parse data from inside the memory image and store it # in global arrays. # # NOTES: # Each memory channel is represented by 8 consecutive bytes. # The first 3 bytes contain the frequency digits in hex. # The most significant nibble in the first byte is 0-E. # Frequencies of 1000 MHz and higher start with a letter. # # The fourth byte is a little strange. It contains both the # simplex/duplex flag and part of the offset # # ################################################################### proc DecodeMemories { } \ { global CtcssBias global Mimage global MemDuplex global MemFreq global MemMode global MemOffset global MemSkip global MemStep global MemToneCode global MemToneFlag global ImageAddr global RCtcss global RMode global RSkip global RStep global ToneFlag # Parse memory channel frequencies. scan $ImageAddr(MemoryFreqs) "%x" first for {set ch 0} {$ch < 400} {incr ch} \ { set last [expr {$first + 2}] set s [string range $Mimage $first $last] set f [BCD2Freq3 $s] if {$f < .001} \ { set MemFreq($ch) "" } \ else \ { set MemFreq($ch) $f } incr first 8 incr last 8 } # Parse memory channel offset frequencies. scan $ImageAddr(MemoryOffset) "%x" first for {set ch 0} {$ch < 400} {incr ch} \ { set last [expr {$first + 2}] set s [string range $Mimage $first $last] set f [BCD2Offset $s] if {$f < .001} {set f ""} set MemOffset($ch) $f incr first 8 incr last 8 } # Parse memory channel duplex/simplex flag. scan $ImageAddr(MemoryDuplex) "%x" first for {set ch 0} {$ch < 400} {incr ch} \ { set byte [string range $Mimage $first $first] set n [GetBitField $byte 0 3] if {$n == 0}\ { set MemDuplex($ch) " " } \ elseif {$n == 1} \ { set MemDuplex($ch) " " } \ elseif {$n == 2} \ { set MemDuplex($ch) "-" } \ else \ { set MemDuplex($ch) "+" } incr first 8 incr last 8 } # Parse memory channel mode. scan $ImageAddr(MemoryModes) "%x" first for {set ch 0} {$ch < 400} {incr ch} \ { set byte [string range $Mimage $first $first] set a [GetBit $byte 0] set b [GetBit $byte 1] set n [expr {$a + $a + $b}] set MemMode($ch) $RMode($n) incr first 8 incr last 8 } # Parse memory channel tone flag. scan $ImageAddr(MemoryToneFlag) "%x" first for {set ch 0} {$ch < 400} {incr ch} \ { set byte [string range $Mimage $first $first] set m [GetBitField $byte 2 3] if { [info exists ToneFlag($m)] } \ { set MemToneFlag($ch) $ToneFlag($m) } \ else \ { set MemToneFlag($ch) "off" } incr first 8 incr last 8 } # Parse memory CTCSS tone code. scan $ImageAddr(MemoryToneCode) "%x" first for {set ch 0} {$ch < 400} {incr ch} \ { set byte [string range $Mimage $first $first] set n [GetBitField $byte 2 7] # fix me incr n $CtcssBias if { [info exists RCtcss($n)] } \ { set MemToneCode($ch) $RCtcss($n) } \ else \ { set MemToneCode($ch) "0.0" } incr first 8 incr last 8 } # Parse skip field. scan $ImageAddr(MemorySkip) "%x" first for {set ch 0} {$ch < 400} {incr ch} \ { set byte [string range $Mimage $first $first] set n [GetBitField $byte 0 1] if { [info exists RSkip($n)] } \ { set MemSkip($ch) $RSkip($n) } \ else \ { set MemSkip($ch) " " } incr first 8 incr last 8 } # Parse memory channel step size. scan $ImageAddr(MemorySteps) "%x" first for {set ch 0} {$ch < 400} {incr ch} \ { set byte [string range $Mimage $first $first] set n [GetBitField $byte 4 7] if { [info exists RStep($n)] } \ { set MemStep($ch) $RStep($n) } \ else \ { set MemStep($ch) ? } incr first 8 incr last 8 } return } ################################################################### # # Parse data from inside the memory image and store it # in global arrays. # ################################################################### proc DecodeSearchBanks { } \ { global LimitScan global Mimage global MemFreq global MemMode global ImageAddr global RMode global RStep # Parse lower limit frequencies. scan $ImageAddr(SearchFreqFirst) "%x" first for {set bn 0} {$bn < 25} {incr bn} \ { set last [expr {$first + 3}] set s [string range $Mimage $first $last] set f [BCD2Freq3 $s] set LimitScan($bn,lower) $f incr first 16 } # Parse upper limit frequencies. scan $ImageAddr(SearchFreqSecond) "%x" first for {set bn 0} {$bn < 25} {incr bn} \ { set last [expr {$first + 3}] set s [string range $Mimage $first $last] set f [BCD2Freq3 $s] set LimitScan($bn,upper) $f incr first 16 } # Parse lower edge modes. scan $ImageAddr(SearchModeFirst) "%x" first for {set bn 0} {$bn < 25} {incr bn} \ { set last $first set s [string range $Mimage $first $last] set a [GetBit $s 0] set b [GetBit $s 1] set n [expr {$a + $a + $b}] if { [info exists RMode($n)] } \ { set LimitScan($bn,lmode) $RMode($n) } \ else \ { set LimitScan($bn,lmode) ? } incr first 16 } # Parse upper edge modes. scan $ImageAddr(SearchModeSecond) "%x" first for {set bn 0} {$bn < 25} {incr bn} \ { set last $first set s [string range $Mimage $first $last] set a [GetBit $s 0] set b [GetBit $s 1] set n [expr {$a + $a + $b}] if { [info exists RMode($n)] } \ { set LimitScan($bn,umode) $RMode($n) } \ else \ { set LimitScan($bn,umode) ? } incr first 16 } # Parse lower scan edge step size. scan $ImageAddr(SearchStepFirst) "%x" first for {set bn 0} {$bn < 25} {incr bn} \ { set byte [string range $Mimage $first $first] set n [GetBitField $byte 4 7] if { [info exists RStep($n)] } \ { set LimitScan($bn,lstep) $RStep($n) } \ else \ { set LimitScan($bn,lstep) ? } incr first 16 incr last 16 } # Parse upper scan edge step size. scan $ImageAddr(SearchStepSecond) "%x" first for {set bn 0} {$bn < 25} {incr bn} \ { set byte [string range $Mimage $first $first] set n [GetBitField $byte 4 7] if { [info exists RStep($n)] } \ { set LimitScan($bn,ustep) $RStep($n) } \ else \ { set LimitScan($bn,ustep) ? } incr first 16 incr last 16 } return } ################################################################### # # Parse data from inside the memory image and store it # in global arrays. # ################################################################### proc DecodeBandStack { } \ { global CtcssBias global GlobalParam global ImageAddr global Mimage global BandStack global RCtcss global RMode global RSkip global RStep # Parse BandStack frequencies. scan $ImageAddr(BandStackFreq) "%x" first for {set bn 0} {$bn < 10} {incr bn} \ { set last [expr {$first + 2}] set s [string range $Mimage $first $last] set f [BCD2Freq3 $s] set BandStack($bn,freq) $f incr first 8 } # Parse BandStack modes. scan $ImageAddr(BandStackModes) "%x" first for {set bn 0} {$bn < 10} {incr bn} \ { set s [string range $Mimage $first $first] set a [GetBit $s 0] set b [GetBit $s 1] set n [expr {$a + $a + $b}] if { [info exists RMode($n)] } \ { set BandStack($bn,mode) $RMode($n) } \ else \ { set BandStack($bn,mode) "?" } incr first 8 } # Parse bandstack offset frequencies. scan $ImageAddr(BandStackOffset) "%x" first for {set ch 0} {$ch < 10} {incr ch} \ { set last [expr {$first + 2}] set s [string range $Mimage $first $last] set f [BCD2Offset $s] set BandStack($ch,offset) $f incr first 8 incr last 8 } # Parse bandstack duplex/simplex flag. scan $ImageAddr(BandStackDuplex) "%x" first for {set ch 0} {$ch < 10} {incr ch} \ { set byte [string range $Mimage $first $first] set n [GetBitField $byte 0 3] if {$n == 0}\ { set BandStack($ch,duplex) " " } \ elseif {$n == 1} \ { set BandStack($ch,duplex) " " } \ elseif {$n == 2} \ { set BandStack($ch,duplex) "-" } \ else \ { set BandStack($ch,duplex) "+" } incr first 8 incr last 8 } # Parse bandstack tone flag. scan $ImageAddr(BandStackToneFlag) "%x" first for {set ch 0} {$ch < 10} {incr ch} \ { set byte [string range $Mimage $first $first] set BandStack($ch,toneflag) [GetBitField $byte 2 3] incr first 8 incr last 8 } # Parse bandstack CTCSS tone code. scan $ImageAddr(BandStackToneCode) "%x" first for {set ch 0} {$ch < 10} {incr ch} \ { set byte [string range $Mimage $first $first] set n [GetBitField $byte 2 7] # fix me incr n $CtcssBias if { [info exists RCtcss($n)] } \ { set BandStack($ch,tonecode) $RCtcss($n) } \ else \ { set BandStack($ch,tonecode) "0.0" } incr first 8 incr last 8 } # Parse bandstack skip field. scan $ImageAddr(BandStackSkip) "%x" first for {set ch 0} {$ch < 10} {incr ch} \ { set byte [string range $Mimage $first $first] set n [GetBitField $byte 0 1] if { [info exists RSkip($n)] } \ { set BandStack($ch,skip) $RSkip($n) } \ else \ { set BandStack($ch,skip) " " } incr first 8 incr last 8 } # Parse bandstack step size. scan $ImageAddr(BandStackSteps) "%x" first for {set ch 0} {$ch < 10} {incr ch} \ { set byte [string range $Mimage $first $first] set n [GetBitField $byte 4 7] if { [info exists RStep($n)] } \ { set BandStack($ch,step) $RStep($n) } \ else \ { set BandStack($ch,step) ? } incr first 8 incr last 8 } return } ################################################################### # Decode a 3 byte BCD frequency. # # Returns: frequency in MHz ################################################################### proc BCD2Freq3 { s } \ { global GlobalParam # Note: Icom packs two digits per byte, one per nibble. # An important exception is the most significant nibble # in the most significant byte. That nibble can be # 0-9 or a-f. # a-f means 10-15. # set abuf "" # append abuf [DumpBinary $s] # puts stderr "s: $abuf" if {[string length $s] == 0} \ { return "0.0000" } binary scan $s "H6" as if {$GlobalParam(WhichModel) == 9} \ { if { $as == "ffffff" } {return "0.0000"} \ else \ { set rc [regexp {ffff$} $as] if {$rc} \ { # The last 2 bytes are ff # which means # 9 kHz spacing and # freqency is .495 - 1.620 MHz # Multiply value in first byte # by .009 and add it to .495 set b [string index $s 0] binary scan $b "H2" imult scan $imult "%x" mult set f [expr {($mult * .009) + .495}] set f [format "%.4f" $f] return $f } } } # Frequency digit pairs. set i 0 set f1 [string index $s $i] binary scan $f1 "H2" f1 regsub -nocase {a} $f1 10 f1 regsub -nocase {b} $f1 11 f1 regsub -nocase {c} $f1 12 f1 regsub -nocase {d} $f1 13 f1 regsub -nocase {e} $f1 14 f1 regsub -nocase {f} $f1 15 f1 incr i set f2 [string index $s $i] binary scan $f2 "H2" f2 incr i set f3 [string index $s $i] binary scan $f3 "H2" f3 incr i set f [format "%s%s%s" $f1 $f2 $f3] set f [string trimleft $f 0] if { $f == ""} \ { set f "00000000" } # Check for non-digit chars. set rc [regexp {^[0-9]*$} $f] if {$rc == 0} then {set f "00000000"} set f [expr {$f/1000.0}] set f [ format "%.4f" $f] if {($GlobalParam(WhichModel) == 9) \ && ($f >= .495) && ($f <= 1.620)} \ { return [format "%.5f" $f] } set len [string length $f] set j [expr {$len - 2}] set c [string index $f $j] if {($c == "2") || ($c == "7")} \ { # If the kHz position digit is a 2 or 5, # force the last digit to be 5. set f [string replace $f end end 5] } \ elseif {($c == "1") || ($c == "6")} \ { # If the kHz position digit is a 1 or 6, # force the last digit to be 2. set f [string replace $f end end 2] } \ elseif {($c == "3") || ($c == "8")} \ { # If the kHz position digit is a 3 or 8, # force the last digit to be 7. set f [string replace $f end end 7] } return [format "%.5f" $f] } ################################################################### # Decode a 2-1/2 byte BCD frequency offset. # # Returns: frequency in MHz ################################################################### proc BCD2Offset { s } \ { global GlobalParam # Note: ICOM packs two digits per byte, one per nibble. # An important exception is the least significant nibble # in the most significant byte. That nibble can be # 0-9 or a-f. # a-f means 10-15. # Frequency digit pairs. set i 0 set f1 [string index $s $i] # Extract right nibble of most significant byte. set f1 [GetBitField $f1 4 7] incr i set f2 [string index $s $i] binary scan $f2 "H2" f2 incr i set f3 [string index $s $i] binary scan $f3 "H2" f3 incr i set f [format "%d%s%s" $f1 $f2 $f3] set f [string trimleft $f 0] if { $f == ""} \ { set f "00000000" } # Check for non-digit chars. set rc [regexp {^[0-9]*$} $f] if {$rc == 0} then {set f "00000000"} set f [expr {$f/1000.0}] set f [ format "%.3f" $f] return $f } ################################################################### # Encode a frequency offset into a 2-1/2 byte format. # # Usage: Offset2BCD f d # Inputs: # f -frequency in MHz (0.005 <= f < 160.0 MHz) # dir -direction; null, -, + # # Returns: 3 bytes consisting of 1/2 byte direction and # 2-1/2 byte BCD coded frequency ################################################################### proc Offset2BCD { f dir } \ { global GlobalParam # Note: ICOM packs two digits per byte, one per nibble. # An important exception is the least significant nibble # in the most significant byte. That nibble can be # 0-9 or a-f. # a-f means 10-15. if {$f == ""} {set f 0.0} # Check for non-digit chars. set rc [regexp {^[0-9\.]*$} $f] if {$rc == 0} {set f 0.0} if { ($f >= 160.0) || ($f < 0.005) } \ { set f 0.0 } set z [expr {($f * 1000.0) + .0005}] set z [expr {int($z)}] set z [format "%06d" $z] set s [string range $z 0 1] regsub -nocase {10} $s "0a" s regsub -nocase {11} $s "0b" s regsub -nocase {12} $s "0c" s regsub -nocase {13} $s "0d" s regsub -nocase {14} $s "0e" s regsub -nocase {15} $s "0f" s set b1 [binary format "H2" $s] # Frequency digit pairs. Two digits per byte. set s [string range $z 2 3] set b2 [binary format "H2" $s] set s [string range $z 4 5] set b3 [binary format "H2" $s] if {$dir == "+"} \ { set dn 3 } \ elseif {$dir == "-"} \ { set dn 2 } \ else \ { set dn 0 } # Set the left nibble according to the # simplex/duplex+/duplex- value set b1 [SetBitField $b1 0 3 $dn] set freqbytes "" append freqbytes $b1 $b2 $b3 return $freqbytes } ################################################################### # Encode a frequency into 3 byte format. # # Input: frequency in MHz # Returns: 3 byte BCD coded frequency ################################################################### proc Freq2BCD3 { f } \ { global GlobalParam # Note: ICOM packs two digits per byte, one per nibble. # An important exception is the most significant nibble # in the most significant byte. That nibble can be # 0-9 or a-f. # a-f means 10-15. if {($f == "") || ($f < .001)} \ { # Frequency is zero MHz so set all bits. set s [binary format "H2H2H2" FF FF FF] return $s } # Check for non-digit chars. set rc [regexp {^[0-9\.]*$} $f] if {$rc == 0} {set f 0.0} if { ($f > $GlobalParam(HighestFreq)) \ || ($f < $GlobalParam(LowestFreq)) } \ { set f 0.0 } if {$GlobalParam(WhichModel) == 9} \ { # Check that f consists of all digits and an # optional decimal point. if {$f < .495} \ { # puts stderr "Freq2BCD3: bad frequency: $f" set f 0 } \ elseif {$f <= 1.620} \ { set ff [ expr { ($f - .495) / .009 } ] set fi [ expr {int($ff)} ] set s [format "%02x" $fi] set bf [binary format "H2H2H2" $s ff ff] # set abuf [DumpBinary $bf] # puts stderr "f: $f, abuf: $abuf" return $bf } } set z [expr {($f * 1000.0) + .0005}] set z [expr {int($z)}] if {$f <= 1000.0} \ { set z [format "%06d" $z] set s [string range $z 0 1] set b1 [binary format "H2" $s] set i 2 set j 3 } \ else \ { set z [format "%07d" $z] set s [string range $z 0 1] regsub -nocase {10} $s "a" s regsub -nocase {11} $s "b" s regsub -nocase {12} $s "c" s regsub -nocase {13} $s "d" s regsub -nocase {14} $s "e" s regsub -nocase {15} $s "f" s set b1 $s append b1 [string range $z 2 2] set b1 [binary format "H2" $b1] set i 3 set j 4 } # Frequency digit pairs. Two digits per byte. set s [string range $z $i $j] set b2 [binary format "H2" $s] incr i 2 incr j 2 set s [string range $z $i $j] set b3 [binary format "H2" $s] set freqbytes "" append freqbytes $b1 $b2 $b3 return $freqbytes } ################################################################### # Create widgets for the name of this program. ################################################################### proc MakeTitleFrame { f }\ { global DisplayFontSize global Version frame $f -relief flat -borderwidth 3 # set s [format "tk2 v%s" $Version] set s [format "tk2"] label $f.lab -text $s \ -background blue \ -foreground white \ -relief raised \ -borderwidth 3 \ -font $DisplayFontSize set s "" append s [format "Version %s\n" $Version] append s "Experimental Utility\n" append s "for the ICOM IC-R2 Receiver\n" append s "Copyright 2001 - 2004, Bob Parnass" label $f.use -text $s \ -background black \ -foreground white \ -relief raised \ -borderwidth 3 pack $f.lab $f.use -side top -padx 0 -pady 0 \ -fill y -fill x -expand true return $f } ################################################################### # Create frame for display parameters. ################################################################### proc MakeDisplayFrame { f }\ { frame $f -relief groove -borderwidth 3 label $f.lab -text "Display, Keypad Settings" \ -borderwidth 3 pack $f.lab -side top frame $f.b -relief flat -borderwidth 3 MakeDispWidgets $f.b pack $f.b -side top -expand true -fill both return $f } proc MakeDispWidgets {f} \ { global GlobalParam label $f.lmonitor -text "Monitor key" -borderwidth 3 tk_optionMenu $f.monitor GlobalParam(Monitor) PUSH HOLD label $f.llamp -text "Lamp" -borderwidth 3 tk_optionMenu $f.lamp GlobalParam(Lamp) OFF ON AUTO checkbutton $f.beep -text "Confirmation beep" \ -variable GlobalParam(Beep) \ -onvalue 1 -offvalue 0 grid $f.lmonitor -row 4 -column 0 -sticky w grid $f.monitor -row 4 -column 1 -sticky e grid $f.llamp -row 6 -column 0 -sticky w grid $f.lamp -row 6 -column 1 -sticky e grid $f.beep -row 14 -column 0 -sticky w -columnspan 2 return } ################################################################### # Create 25 search banks. ################################################################### proc MakeSearchFrame { f }\ { global GlobalParam frame $f -relief groove -borderwidth 3 frame $f.rb -relief groove -borderwidth 3 set r $f.rb label $r.ldial -text "Fast dial step" -borderwidth 3 tk_optionMenu $r.dial GlobalParam(Dial) 100kHz 1MHz 10MHz # checkbutton $r.dialaccel -text "Dial acceleration" checkbutton $r.dialaccel -text "" \ -variable GlobalParam(DialAccel) \ -onvalue 1 -offvalue 0 label $r.ldialaccel -text "Dial acceleration" -borderwidth 3 label $r.lvfosearch -text "VFO Search" -borderwidth 3 $r.lvfosearch configure -foreground yellow tk_optionMenu $r.vfosearch GlobalParam(VFOSearch) \ BAND ALL \ PROG0 PROG1 PROG2 PROG3 PROG4 PROG5 \ PROG6 PROG7 PROG8 PROG9 \ PROG10 PROG11 PROG12 PROG13 PROG14 PROG15 \ PROG16 PROG17 PROG18 PROG19 \ PROG20 PROG21 PROG22 PROG23 PROG24 grid $r.ldial -row 8 -column 1 -sticky w grid $r.dial -row 8 -column 2 -sticky ew grid $r.ldialaccel -row 12 -column 1 -sticky w grid $r.dialaccel -row 12 -column 2 -sticky e # pack $r.lvfosearch $r.vfosearch -side left pack $r -side top -padx 3 -pady 3 label $f.lab -text "\nLimit Search Banks" -borderwidth 3 pack $f.lab -side top -padx 3 -pady 3 ScrollformCreate $f.b pack $f.b -expand yes -fill both set w [ScrollFormInterior $f.b] label $w.lowerf -text "Lower Freq" -borderwidth 3 label $w.upperf -text "Upper Freq" -borderwidth 3 label $w.lowerm -text "Mode" -borderwidth 3 label $w.upperm -text "Mode" -borderwidth 3 label $w.lowers -text "Step" -borderwidth 3 label $w.uppers -text "Step" -borderwidth 3 for {set i 0} {$i < 25} {incr i} \ { MakeSearchBank $w $i } grid $w.lowerf -row 1 -column 2 grid $w.upperf -row 1 -column 5 grid $w.lowerm -row 1 -column 3 grid $w.upperm -row 1 -column 6 grid $w.lowers -row 1 -column 4 grid $w.uppers -row 1 -column 7 pack $f.b -side top -fill both -expand true -padx 3 -pady 3 return $f } ################################################################### # Create one a set of widgets for one search bank. ################################################################### proc MakeSearchBank { f bn }\ { global LimitScan global GlobalParam label $f.lab$bn -text "PROG$bn" -borderwidth 3 entry $f.lower$bn -width 10 \ -textvariable LimitScan($bn,lower) \ -background white tk_optionMenu $f.lmodemenu$bn LimitScan($bn,lmode) \ NFM WFM AM tk_optionMenu $f.lstep$bn LimitScan($bn,lstep) \ 5 6.25 9 10 12.5 15 20 25 30 50 100 entry $f.upper$bn -width 10 \ -textvariable LimitScan($bn,upper) \ -background white tk_optionMenu $f.umodemenu$bn LimitScan($bn,umode) \ NFM WFM AM tk_optionMenu $f.ustep$bn LimitScan($bn,ustep) \ 5 6.25 9 10 12.5 15 20 25 30 50 100 set row [expr {$bn + 2}] grid $f.lab$bn -row $row -column 1 grid $f.lower$bn -row $row -column 2 grid $f.lmodemenu$bn -row $row -column 3 -sticky ew grid $f.lstep$bn -row $row -column 4 -sticky ew grid $f.upper$bn -row $row -column 5 grid $f.umodemenu$bn -row $row -column 6 -sticky ew grid $f.ustep$bn -row $row -column 7 -sticky ew return $f } ################################################################### # Create frame for misc parameters. ################################################################### proc MakeMiscFrame { f }\ { frame $f -relief groove -borderwidth 3 label $f.lab -text "Misc. Settings" \ -borderwidth 3 pack $f.lab -side top frame $f.b -relief flat -borderwidth 3 MakeMiscWidgets $f.b pack $f.b -side top -expand true -fill both return $f } ################################################################### # Create widgets for misc. parameters. ################################################################### proc MakeMiscWidgets { f } \ { global GlobalParam global Priority global PriorityMode checkbutton $f.battery -text "Power Save" \ -variable GlobalParam(PowerSave) \ -onvalue 1 -offvalue 0 label $f.lautooff -text "Auto power off (min.)" -borderwidth 3 tk_optionMenu $f.autooff GlobalParam(AutoOff) \ OFF 30 60 90 120 label $f.lpause -text "Scan Pause (sec.)" -borderwidth 3 tk_optionMenu $f.pause GlobalParam(Pause) \ 2 4 6 8 10 12 14 16 18 20 HOLD label $f.labresume -text "Scan Resume (sec.)" -borderwidth 3 tk_optionMenu $f.resume GlobalParam(Resume) \ 0 1 2 3 4 5 HOLD checkbutton $f.atten -text "Attenuator" \ -variable GlobalParam(Attenuator) \ -onvalue 1 -offvalue 0 $f.atten configure -foreground yellow grid $f.battery -row 4 -column 0 -sticky w -columnspan 2 grid $f.lautooff -row 8 -column 0 -sticky w grid $f.autooff -row 8 -column 1 -sticky ew grid $f.lpause -row 10 -column 0 -sticky w grid $f.pause -row 10 -column 1 -sticky ew grid $f.labresume -row 14 -column 0 -sticky w grid $f.resume -row 14 -column 1 -sticky ew # grid $f.atten -row 12 -column 0 -sticky w -columnspan 2 return $f } ################################################################### # Create frame for Communications parameters. ################################################################### proc MakeCommFrame { f }\ { frame $f -relief groove -borderwidth 3 label $f.lab -text "Debugging Information" \ -borderwidth 3 pack $f.lab -side top frame $f.b -relief flat -borderwidth 3 MakeCommWidgets $f.b set hint "" append hint "Serial Communications fields " append hint "are useful for testing tk2. " balloonhelp_for $f $hint pack $f.b -side top -expand true -fill y return $f } ################################################################### # Create widgets for Communications params. ################################################################### proc MakeCommWidgets { f } \ { global GlobalParam label $f.labpre -text "Radio Version" -borderwidth 3 entry $f.pre -width 26 \ -textvariable GlobalParam(RadioVersion) \ -background yellow label $f.lfileversion -text "File Version" -borderwidth 3 entry $f.fileversion -width 26 \ -textvariable GlobalParam(FileVersion) \ -background yellow label $f.lusercomment -text "User comment" -borderwidth 3 entry $f.usercomment -width 26 \ -textvariable GlobalParam(UserComment) \ -background yellow label $f.labnmsgs -text "Number Messages Read" -borderwidth 3 entry $f.nmsgs -width 5 \ -textvariable GlobalParam(NmsgsRead) \ -background yellow checkbutton $f.bypassall -text "Bypass All Encoding" \ -variable GlobalParam(BypassAllEncoding) \ -onvalue 1 -offvalue 0 grid $f.labpre -row 0 -column 0 -sticky w grid $f.pre -row 0 -column 1 -sticky e grid $f.lfileversion -row 4 -column 0 -sticky w grid $f.fileversion -row 4 -column 1 -sticky e grid $f.lusercomment -row 8 -column 0 -sticky w grid $f.usercomment -row 8 -column 1 -sticky e grid $f.labnmsgs -row 12 -column 0 -sticky w grid $f.nmsgs -row 12 -column 1 -sticky e grid $f.bypassall -row 16 -column 0 -columnspan 2 return $f } ################################################################### # Create widgets for BandStack Memories. ################################################################### proc MakeBandStackFrame { f }\ { frame $f -relief groove -borderwidth 3 label $f.lab -text "Bandstacking Registers" -borderwidth 3 pack $f.lab -side top frame $f.b -relief flat -borderwidth 3 for {set i 0} {$i < 10} {incr i} \ { MakeBandStackBank $f.b $i } pack $f.b -side top -padx 3 -pady 3 set hint "" append hint "Bandstacking registers " append hint "remember the last VFO frequency and mode " append hint "setting for each band.\n" append hint "They also determine the mode and step size for " append hint "limit searches." balloonhelp_for $f.b $hint return $f } ################################################################### # Create one a set of widgets for one BandStack bank. ################################################################### proc MakeBandStackBank { f bn }\ { global Band global BandStack global GlobalParam set msg [format "%.3f - %.3f" \ $Band(USA,$bn,low) $Band(USA,$bn,high)] label $f.lab$bn -text $msg -borderwidth 3 entry $f.freq$bn -width 10 \ -textvariable BandStack($bn,freq) \ -background white tk_optionMenu $f.bsmodemenu$bn BandStack($bn,mode) \ NFM WFM AM tk_optionMenu $f.bsstep$bn BandStack($bn,step) \ 5 6.25 9 10 12.5 15 20 25 30 50 100 tk_optionMenu $f.duplexmenu$bn BandStack($bn,duplex) \ " " "-" "+" set BandStack($bn,duplex) " " grid $f.lab$bn -row $bn -column 1 -sticky w grid $f.freq$bn -row $bn -column 2 grid $f.bsmodemenu$bn -row $bn -sticky ew -column 3 grid $f.bsstep$bn -row $bn -sticky ew -column 4 grid $f.duplexmenu$bn -row $bn -sticky ew -column 5 return $f } ################################################################### # Encode the information from the data structures into # the memory image string which can be written to the radio. # # We don't understand the meaning of all the bytes in # the memory image. Therefore, the # image string must already exist and we will only # change the bytes which we understand. # ################################################################### proc EncodeImage { } \ { global GlobalParam global Mimage if {$GlobalParam(BypassAllEncoding)} \ { puts stderr "EncodeImage: skip encoding" return 0 } # puts stderr "EncodeImage: encoding" if { ([info exists Mimage] == 0) } \ { puts stderr "EncodeImage: image does not exist" return error } set image $Mimage set image [EncodeMisc $image] if { [string length $image] == 0} {return error} set image [EncodeMemories $image] if { [string length $image] == 0} {return error} set image [EncodeSearchBanks $image] if { [string length $image] == 0} {return error} set image [EncodeBandStack $image] if { [string length $image] == 0} {return error} set Mimage $image return 0 } ################################################################### # Encode misc # information into a memory image. ################################################################### proc EncodeMisc { image } \ { global AutoOff global BatterySaver global Dial global Fstep global ImageAddr global GlobalParam global Lamp global Mimage global Mode global Monitor global Pause global Priority global PriorityMode global Resume global Step # # Priority frequency and mode. # # set s [FreqMode2BCD $Priority $PriorityMode ""] # # scan $ImageAddr(Priority) "%x" first # set last [expr {$first + 3}] # set image [string replace $image $first $last $s] # # # # VFO frequency # # set s [Freq2BCD3p $GlobalParam(VFOFreq)] # scan $ImageAddr(VFOFreq) "%x" first # set last [expr {$first + 3}] # set image [string replace $image $first $last $s] # # # VFO mode. # scan $ImageAddr(VFOMode) "%x" first # set last $first # # set m $GlobalParam(VFOMode) # if { [info exists Mode($m)] } \ # { # set c $Mode($m) # } \ # else \ # { # set c $Mode(NFM) # } # # set s [format "%02x" $c] # set b [binary format "H2" $s] # set image [string replace $image $first $first $b] # # # # Set Attenuator bit # scan $ImageAddr(FlagByte3) "%x" first # set byte [string index $image $first] # set newbyte [AssignBit $byte 5 $GlobalParam(Attenuator)] # set image [string replace $image $first $first $newbyte] # # # # Set Keypad Lock bit # scan $ImageAddr(FlagByte3) "%x" first # set byte [string index $image $first] # set newbyte [AssignBit $byte 1 $GlobalParam(Lock)] # set image [string replace $image $first $first $newbyte] # # # # encode Scan Resume. # # Scan Resume is stored in one hex byte as one # # less than what the user sees on the radio's display. # # Example: Resume of 12 seconds is stored as 0B. # # scan $ImageAddr(Resume) "%x" first # set c [expr {$GlobalParam(Resume) - 1}] # set s [format "%02x" $c] # set b [binary format "H2" $s] # set image [string replace $image $first $first $b] # # # encode Dial Acceleration scan $ImageAddr(DialAccel) "%x" first set s [format "%02x" $GlobalParam(DialAccel)] set b [binary format "H2" $s] set image [string replace $image $first $first $b] # encode Power Saver scan $ImageAddr(PowerSave) "%x" first set s [format "%02x" $GlobalParam(PowerSave)] set b [binary format "H2" $s] set image [string replace $image $first $first $b] # # # Tuning Step is stored in one byte. # # Important note: # # There is a correlation between the Tuning Step byte # # and bit 7 of FlagByte3. # # Bit 7 = 0 if step is AUTO, # # othewise Bit 7 = 1. # # scan $ImageAddr(VFOStep) "%x" first # set c $GlobalParam(TuningStep) # # Translate to hex equivalent # set c $Step($c) # set b [binary format "H2" $c] # set image [string replace $image $first $first $b] # # scan $ImageAddr(FlagByte3) "%x" first # set b [string range $image $first $first] # if {$GlobalParam(TuningStep) == "AUTO"} \ # { # set b [ClearBit $b 7] # } \ # else \ # { # set b [SetBit $b 7] # } # set image [string replace $image $first $first $b] # # # Bank scan flag # scan $ImageAddr(FlagByte0) "%x" first # set b [string range $image $first $first] # set b [AssignBit $b 4 $GlobalParam(BankScan)] # set image [string replace $image $first $first $b] # Pause scan $ImageAddr(Pause) "%x" first set b [string range $image $first $first] set s [format "%02x" $Pause($GlobalParam(Pause))] set b [binary format "H2" $s] set image [string replace $image $first $first $b] # Resume scan $ImageAddr(Resume) "%x" first set b [string range $image $first $first] set s [format "%02x" $Resume($GlobalParam(Resume))] set b [binary format "H2" $s] set image [string replace $image $first $first $b] # Monitor flag scan $ImageAddr(Monitor) "%x" first set b [string range $image $first $first] set s [format "%02x" $Monitor($GlobalParam(Monitor))] set b [binary format "H2" $s] set image [string replace $image $first $first $b] # Beep tone flag scan $ImageAddr(Beep) "%x" first set b [string range $image $first $first] set s [format "%02x" $GlobalParam(Beep)] set b [binary format "H2" $s] set image [string replace $image $first $first $b] # encode Auto Power Off scan $ImageAddr(AutoOff) "%x" first set byte [string index $image $first] set n [format "%02x" $AutoOff($GlobalParam(AutoOff))] set newbyte [binary format "H2" $n] set image [string replace $image $first $first $newbyte] # encode Dial fast step scan $ImageAddr(DialStep) "%x" first set byte [string index $image $first] set n [format "%02x" $Dial($GlobalParam(Dial))] set newbyte [binary format "H2" $n] set image [string replace $image $first $first $newbyte] # encode Lamp scan $ImageAddr(Lamp) "%x" first set byte [string index $image $first] set n [format "%02x" $Lamp($GlobalParam(Lamp))] set newbyte [binary format "H2" $n] set image [string replace $image $first $first $newbyte] # # Set VFO/Limit Search bit # scan $ImageAddr(FlagByte0) "%x" first # set byte [string index $image $first] # set newbyte [AssignBit $byte 3 $GlobalParam(LimitSearch)] # set image [string replace $image $first $first $newbyte] # # # Fast Tuning Step is stored in one byte # scan $ImageAddr(FastTuningStep) "%x" first # set s $GlobalParam(FastTuningStep) # set s [format "%02x" $Fstep($s)] # set b [binary format "H2" $s] # set image [string replace $image $first $first $b] return $image } ################################################################### # Encode the memory channel frequency, mode, and preferential # flag information into a memory image. ################################################################### proc EncodeMemories { image } \ { global Ctcss global CtcssBias global ImageAddr global MemDuplex global MemFreq global MemMode global MemOffset global MemSkip global MemStep global MemToneCode global MemToneFlag global Mode global RToneFlag global Skip global Step global Mimage global ImageAddr # Encode channel frequency. scan $ImageAddr(MemoryFreqs) "%x" first set last [expr {$first + 2}] for {set ch 0} {$ch < 400} {incr ch} \ { set b [ Freq2BCD3 $MemFreq($ch) ] set image [string replace $image $first $last $b] incr first 8 incr last 8 } # Encode channel offset frequencies. # and duplex/simple flags. scan $ImageAddr(MemoryOffset) "%x" first set last [expr {$first + 2}] for {set ch 0} {$ch < 400} {incr ch} \ { set b [ Offset2BCD $MemOffset($ch) $MemDuplex($ch) ] set image [string replace $image $first $last $b] incr first 8 incr last 8 } # Encode channel mode and CTCSS code. scan $ImageAddr(MemoryModes) "%x" first for {set ch 0} {$ch < 400} {incr ch} \ { set b [ string index $image $first ] # Mode set m $Mode($MemMode($ch)) set b [SetBitField $b 0 1 $m] # CTCSS code set ccode $MemToneCode($ch) if { [info exists Ctcss($ccode)] == 0 } \ { set n 0 } \ else \ { set n [expr {$Ctcss($ccode) - $CtcssBias}] } set b [SetBitField $b 2 7 $n] set image [string replace $image $first $first $b] incr first 8 } # Encode channel Skip, Tone Squelch Flag, Tuning Step. scan $ImageAddr(MemorySkip) "%x" first for {set ch 0} {$ch < 400} {incr ch} \ { set b [ string index $image $first ] # Skip type if { [info exists Skip($MemSkip($ch))] == 0 } \ { set m 0 } \ else \ { set m $Skip($MemSkip($ch)) } set b [SetBitField $b 0 1 $m] # Tone Squelch flag set m $MemToneFlag($ch) if { [info exists RToneFlag($m)] } \ { set b [SetBitField $b 2 3 $RToneFlag($m)] } \ else \ { set b [SetBitField $b 2 3 $RToneFlag(off)] } # Tuning Step if { [info exists Step($MemStep($ch))] == 0 } \ { set m 0 } \ else \ { set m $Step($MemStep($ch)) } set b [SetBitField $b 4 7 $m] set image [string replace $image $first $first $b] incr first 8 } # Encode empty memory channels set allff [Padff 8] scan $ImageAddr(MemoryFreqs) "%x" first set last [expr {$first + 7}] for {set ch 0} {$ch < 400} {incr ch} \ { if {($MemFreq($ch) == "") \ || ($MemFreq($ch) < 0.001) \ || ($MemSkip($ch) == "hide")} \ { set image [string replace $image \ $first $last $allff] } incr first 8 incr last 8 } return $image } ################################################################### # Encode the Band Stack Memory channel frequency and mode # information into a memory image. ################################################################### proc EncodeBandStack { image } \ { global BandStack global Ctcss global CtcssBias global ImageAddr global MemDuplex global MemFreq global MemMode global MemOffset global MemSkip global MemStep global MemToneCode global MemToneFlag global Mode global Skip global Step global Mimage global ImageAddr # Encode BandStack frequency. scan $ImageAddr(BandStackFreq) "%x" first set last [expr {$first + 2}] for {set ch 0} {$ch < 10} {incr ch} \ { set b [ Freq2BCD3 $BandStack($ch,freq) ] set image [string replace $image $first $last $b] incr first 8 incr last 8 } # Encode BandStack offset frequencies. # and duplex/simple flags. scan $ImageAddr(BandStackOffset) "%x" first set last [expr {$first + 2}] for {set ch 0} {$ch < 10} {incr ch} \ { set b [ Offset2BCD $BandStack($ch,offset) \ $BandStack($ch,duplex) ] set image [string replace $image $first $last $b] incr first 8 incr last 8 } # Encode BandStack mode and CTCSS code. scan $ImageAddr(BandStackModes) "%x" first for {set ch 0} {$ch < 10} {incr ch} \ { set b [ string index $image $first ] # Mode set m $Mode($BandStack($ch,mode)) set b [SetBitField $b 0 1 $m] # CTCSS code set ccode $BandStack($ch,tonecode) if { [info exists Ctcss($ccode)] == 0 } \ { set n 0 } \ else \ { set n [expr {$Ctcss($ccode) - $CtcssBias}] } set b [SetBitField $b 2 7 $n] set image [string replace $image $first $first $b] incr first 8 } # Encode BandStack Skip, Tone Squelch Flag, Tuning Step. scan $ImageAddr(BandStackSkip) "%x" first for {set ch 0} {$ch < 10} {incr ch} \ { set b [ string index $image $first ] # Skip type if { [info exists Skip($BandStack($ch,skip))] == 0 } \ { set m 0 } \ else \ { set m $Skip($BandStack($ch,skip)) } set b [SetBitField $b 0 1 $m] # Tone Squelch flag set m $BandStack($ch,toneflag) set b [SetBitField $b 2 3 $m] # Tuning Step if { [info exists Step($BandStack($ch,step))] == 0 } \ { set m 0 } \ else \ { set m $Step($BandStack($ch,step)) } set b [SetBitField $b 4 7 $m] set image [string replace $image $first $first $b] incr first 8 } return $image } ################################################################### # Encode the limit search bank frequencies and modes # information into a memory image. ################################################################### proc EncodeSearchBanks { image } \ { global Ctcss global CtcssBias global ImageAddr global LimitScan global Mode global Skip global Step global Mimage global ImageAddr # Encode lower frequency. scan $ImageAddr(SearchFreqFirst) "%x" first set last [expr {$first + 2}] for {set ch 0} {$ch < 25} {incr ch} \ { set b [ Freq2BCD3 $LimitScan($ch,lower) ] set image [string replace $image $first $last $b] incr first 16 incr last 16 } # Encode lower Duplex and Offset. # Force them to simplex and zero offset. (we may improve # this later.) scan $ImageAddr(SearchDuplexFirst) "%x" first set last [expr {$first + 2}] for {set ch 0} {$ch < 25} {incr ch} \ { set b [ binary format "H2H2H2" 00 00 00 ] set image [string replace $image $first $last $b] incr first 16 incr last 16 } # Encode upper frequency. scan $ImageAddr(SearchFreqSecond) "%x" first set last [expr {$first + 2}] for {set ch 0} {$ch < 25} {incr ch} \ { set b [ Freq2BCD3 $LimitScan($ch,upper) ] set image [string replace $image $first $last $b] incr first 16 incr last 16 } # Encode upper Duplex and Offset. # Force them to simplex and zero offset. (we may improve # this later.) scan $ImageAddr(SearchDuplexSecond) "%x" first set last [expr {$first + 2}] for {set ch 0} {$ch < 25} {incr ch} \ { set b [ binary format "H2H2H2" 00 00 00 ] set image [string replace $image $first $last $b] incr first 16 incr last 16 } # Encode lower search limit mode and CTCSS code. scan $ImageAddr(SearchModeFirst) "%x" first for {set ch 0} {$ch < 25} {incr ch} \ { set b [ string index $image $first ] # Mode set m $Mode($LimitScan($ch,lmode)) set b [SetBitField $b 0 1 $m] set image [string replace $image $first $first $b] incr first 16 } # Encode upper search limit mode and CTCSS code. scan $ImageAddr(SearchModeSecond) "%x" first for {set ch 0} {$ch < 25} {incr ch} \ { set b [ string index $image $first ] # Mode set m $Mode($LimitScan($ch,umode)) set b [SetBitField $b 0 1 $m] set image [string replace $image $first $first $b] incr first 16 } # Encode lower search limit Skip, Tone Squelch Flag, # Tuning Step. scan $ImageAddr(SearchStepFirst) "%x" first for {set ch 0} {$ch < 25} {incr ch} \ { set b [ string index $image $first ] # Tuning Step if { [info exists Step($LimitScan($ch,lstep))] == 0 } \ { set m 0 } \ else \ { set m $Step($LimitScan($ch,lstep)) } set b [SetBitField $b 4 7 $m] # zap both Skip and Tone squelch flags set b [SetBitField $b 0 3 0] set image [string replace $image $first $first $b] incr first 16 } # Encode upper search limit Skip, Tone Squelch Flag, # Tuning Step. scan $ImageAddr(SearchStepSecond) "%x" first for {set ch 0} {$ch < 25} {incr ch} \ { set b [ string index $image $first ] # Tuning Step if { [info exists Step($LimitScan($ch,ustep))] == 0 } \ { set m 0 } \ else \ { set m $Step($LimitScan($ch,ustep)) } set b [SetBitField $b 4 7 $m] # zap both Skip and Tone squelch flags set b [SetBitField $b 0 3 0] set image [string replace $image $first $first $b] incr first 16 } # Encode empty search limits set allff [Padff 8] scan $ImageAddr(SearchFreqFirst) "%x" first set last [expr {$first + 7}] for {set ch 0} {$ch < 25} {incr ch} \ { if {$LimitScan($ch,lower) < 0.001} \ { set image [string replace $image \ $first $last $allff] } incr first 16 incr last 16 } scan $ImageAddr(SearchFreqSecond) "%x" first set last [expr {$first + 7}] for {set ch 0} {$ch < 25} {incr ch} \ { if {$LimitScan($ch,upper) < 0.001} \ { set image [string replace $image \ $first $last $allff] } incr first 16 incr last 16 } return $image } ################################################################### # Pop up a window which says "Please wait..." ################################################################### proc MakeWait { } \ { global DisplayFontSize toplevel .wait set w .wait wm title $w "tk2 running" label $w.lab -font $DisplayFontSize -text "Please wait ..." pack $w.lab update idletasks waiter 500 return } ################################################################### # Kill the window which says "Please wait..." ################################################################### proc KillWait { } \ { catch {destroy .wait} update idletasks } ################################################################### # ValidateData tests the data. # It pops up a window with error and/or warning messages. # If there are warnings but no errors, the user can elect # to continue or cancel the current operation. # # Returns: # 0 - continue # 1 - cancel the current operation ################################################################### proc ValidateData { } \ { global Band global BandStack global Emsg global GlobalParam global MemFreq global MemMode global MemStep global LimitScan global Priority global PriorityMode global Skip if { [info exists MemFreq(0)] == 0 } \ { # No data to validate. return 1 } if { $GlobalParam(BypassAllEncoding) } \ { # do not validate. return 0 } set Emsg "" set nerror 0 set nwarning 0 # Memory channels. set ch 0 for {set bn 0} {$bn < 8} {incr bn} \ { for {set i 0} {$i < 50} {incr i} \ { set m "Bank $bn Ch. $i" set f $MemFreq($ch) set code [ValidateFreq $f $m] if {$code == "error"} { incr nerror } \ elseif {$code == "warning"} { incr nwarning } set mode $MemMode($ch) set code [ValidateMode $mode $m $f] if {$code == "error"} { incr nerror } set step $MemStep($ch) set code [ValidateStep $step $m $f] if {$code == "error"} { incr nerror } \ elseif {$code == "warning"} { incr nwarning } if { [expr {$nerror + $nwarning}] > 5} {break} incr ch } } # puts stderr "ValidateData: done with memories" # Limit scan freqs, steps for {set i 0} {$i < 25} {incr i} \ { set m "Limit Scan bank PROG$i lower" set f $LimitScan($i,lower) set code [ValidateFreq $f $m] if {$code == "error"} { incr nerror } \ elseif {$code == "warning"} { incr nwarning } set step $LimitScan($i,lstep) set code [ValidateStep $step $m $f] if {$code == "error"} { incr nerror } \ elseif {$code == "warning"} { incr nwarning } set code [ValidateMode $LimitScan($i,lmode) $m $f] if {$code == "error"} { incr nerror } set m "Limit Scan bank PROG$i upper" set f $LimitScan($i,upper) set code [ValidateFreq $f $m] if {$code == "error"} { incr nerror } \ elseif {$code == "warning"} { incr nwarning } set step $LimitScan($i,ustep) set code [ValidateStep $step $m $f] if {$code == "error"} { incr nerror } \ elseif {$code == "warning"} { incr nwarning } set code [ValidateMode $LimitScan($i,umode) $m $f] if {$code == "error"} { incr nerror } if { [expr {$nerror + $nwarning}] > 5} {break} } # BandStack frequencies, steps for {set i 0} {$i < 10} {incr i} \ { set m "Band Stacking " append m "$Band(USA,$i,low) - $Band(USA,$i,high)" set f $BandStack($i,freq) set code [ValidateFreq $f $m] if {$code == "error"} { incr nerror } \ elseif {$code == "warning"} { incr nwarning } set code [ValidateMode $BandStack($i,mode) $m $f] if {$code == "error"} { incr nerror } set step $BandStack($i,step) set code [ValidateStep $step $m $f] if {$code == "error"} { incr nerror } \ elseif {$code == "warning"} { incr nwarning } if { [expr {$nerror + $nwarning}] > 5} {break} } if {$nerror} \ { tk_dialog .baddata1 "tk2 Invalid data" \ $Emsg error 0 OK # puts stderr "ValidateData: returning 1" return 1 } if {$nwarning} \ { set response [tk_dialog .baddata2 \ "tk2 Data warning" \ $Emsg error 0 Cancel Continue] if {$response == 0} then {return 1} \ else {return 0} } return 0 } ################################################################### # Check a frequency for validity. # Append the error or warning message to a global string. # # Returns: # 0 # warning # error ################################################################### proc ValidateFreq {f m} \ { global Emsg global GlobalParam set code 0 set msg "" if {( ($f != "") && ($f != 0.0) ) \ && (($f < $GlobalParam(LowestFreq)) \ || ($f > $GlobalParam(HighestFreq)))} \ { append msg "\nError: $m frequency ($f) is out" append msg " of range.\n" set code error } if { ($code != "error") && ($f != "") && ($f >= .495) \ && ($f <= 1.620) } \ { if {$GlobalParam(WhichModel) == 9} \ { set ff [ expr {$f * 1000} ] set iff [ expr {round($ff)} ] set remainder [ expr {fmod($iff,9)} ] if {$remainder > 0} \ { append msg "\nWarning: $m frequency " append msg "($f) is not compatible " append msg "with a 9 kHz step " append msg "and will be adjusted.\n" set code warning } } } append Emsg $msg return $code } ################################################################### # Return 1 if a string consists of 2 hex digits. ################################################################### proc IsHex { s } \ { # Check for non-digit and non decimal point chars. set rc [regexp -nocase {^[0-9a-f][0-9a-f]$} $s] if {$rc} \ { return 1 } \ else \ { return 0 } } ################################################################### # Check a mode for validity. # Append the error message to a global string. # # Returns: # 0 # warning # error ################################################################### proc ValidateMode {mode m f} \ { global GlobalParam global Emsg global Mode set code 0 if { [info exists Mode($mode)] == 0} \ { append Emsg "\nError: $m mode ($mode) is invalid.\n" set code error } if { ($f != "") && ($f != 0.0) } \ { if {($mode != "AM") \ && ($mode != "WFM") \ && ($mode != "NFM") } \ { append Emsg "\nError: $m mode ($mode) " append Emsg "is invalid.\n" set code error } } if { ($code != "error") && ($f != "") && ($f >= .495) \ && ($f <= 1.620) } \ { if {$GlobalParam(WhichModel) == 9} \ { if {$mode != "AM"} \ { append Emsg "\nWarning: $m mode " append Emsg "must be AM for this " append Emsg "version radio.\n" set code error } } } return $code } ################################################################### # Check a step size for validity. # Append the error message to a global string. # # Radio version with 9 kHz step in the AM BCB may only have # a 9 kHz step between .495 and 1.620 MHz. # # Radio version with 10 kHz step in the AM BCB cannot have # a 9 kHz step between .495 and 1.620 MHz. # # Returns: # 0 # warning # error ################################################################### proc ValidateStep {step m f} \ { global Emsg global GlobalParam set code 0 if { ($f == "") || ($f == 0.0) } \ { return 0 } if {($f >= .495) && ($f <= 1.620)} \ { if {($step == 9) \ && ($GlobalParam(WhichModel) != 9)} \ { append Emsg "\nError: $m step ($step) " append Emsg "is invalid for this " append Emsg "version radio.\n" set code error } \ elseif {($step != 9) \ && ($GlobalParam(WhichModel) == 9)} \ { append Emsg "\nError: $m step ($step) " append Emsg "is invalid for this " append Emsg "version radio.\n" set code error } } \ else \ { # Extract the Hz portion of the frequency # to the right of the decimal point. set f [format "%.6f" $f] set lst [split $f "."] set fhz [ lindex $lst 1 ] set fhz [string trimleft $fhz 0] if {$fhz == ""} {set fhz 0} # puts stderr "f= $f, fhz= $fhz" # set fhz [expr {$fhz * 1000000}] set stephz [expr {$step * 1000}] set n [expr {fmod($fhz, $stephz)}] set n [expr {int($n)}] if {$n } \ { # Frequency incompatible with step size. # puts stderr "f: $f, fhz: $fhz, step $step, stephz: $stephz, n: $n" append Emsg "\nWarning: $m frequency ($f) " append Emsg "will be adjusted to conform " append Emsg "to step ($step).\n" set code warning } } return $code } ################################################################### # Set title of the main window so it contains the # current template file name. ################################################################### proc SetWinTitle { } \ { global GlobalParam if { ( [info exists GlobalParam(TemplateFilename)] == 0 ) \ || ($GlobalParam(TemplateFilename) == "") } \ { set filename untitled.tr2 } \ else \ { set filename $GlobalParam(TemplateFilename) } set s [format "tk2 - %s" $filename] wm title . $s return } # Prevent user from shrinking or expanding window. proc FixSize { w } \ { wm minsize $w [winfo width $w] [winfo height $w] wm maxsize $w [winfo width $w] [winfo height $w] return } ###################################################################### # Bob Parnass # DATE: # # USAGE: SortaBank first last # # INPUTS: # first -starting channel to sort # last -ending channel to sort # # RETURNS: # 0 -ok # -1 -error # # # PURPOSE: Sort a range of memory channels based on frequency. # # DESCRIPTION: # ###################################################################### proc SortaBank { first last } \ { global GlobalParam global MemDuplex global MemFreq global MemLabel global MemMode global MemOffset global MemSkip global MemStep global MemToneCode global MemToneFlag global Mimage if {[info exists Mimage] == 0} \ { set msg "You must open a template file\n" append msg " or read an image from the radio\n" append msg " before sorting channels.\n" tk_dialog .belch "tk2" \ $msg info 0 OK return -1 } if {$GlobalParam(SortType) == "freq"} \ { set inlist [Bank2List MemFreq $first $last] set vorder [SortFreqList $inlist] } \ else \ { set inlist [Bank2List MemLabel $first $last] set vorder [SortLabelList $inlist] } set inlist [Bank2List MemFreq $first $last] set slist [ReorderList $inlist $vorder] for {set i $first; set j 0} {$i <= $last} {incr i; incr j} \ { set MemFreq($i) [lindex $slist $j] } set slist [ReorderList $inlist $vorder] for {set i $first; set j 0} {$i <= $last} {incr i; incr j} \ { set MemFreq($i) [lindex $slist $j] } set inlist [Bank2List MemMode $first $last] set slist [ReorderList $inlist $vorder] for {set i $first; set j 0} {$i <= $last} {incr i; incr j} \ { set MemMode($i) [lindex $slist $j] if {$MemMode($i) == ""} \ { set MemMode($i) NFM } } set inlist [Bank2List MemDuplex $first $last] set slist [ReorderList $inlist $vorder] for {set i $first; set j 0} {$i <= $last} {incr i; incr j} \ { set MemDuplex($i) [lindex $slist $j] } set inlist [Bank2List MemOffset $first $last] set slist [ReorderList $inlist $vorder] for {set i $first; set j 0} {$i <= $last} {incr i; incr j} \ { set MemOffset($i) [lindex $slist $j] } set inlist [Bank2List MemSkip $first $last] set slist [ReorderList $inlist $vorder] for {set i $first; set j 0} {$i <= $last} {incr i; incr j} \ { set MemSkip($i) [lindex $slist $j] } set inlist [Bank2List MemToneCode $first $last] set slist [ReorderList $inlist $vorder] for {set i $first; set j 0} {$i <= $last} {incr i; incr j} \ { set MemToneCode($i) [lindex $slist $j] } set inlist [Bank2List MemToneFlag $first $last] set slist [ReorderList $inlist $vorder] for {set i $first; set j 0} {$i <= $last} {incr i; incr j} \ { set MemToneFlag($i) [lindex $slist $j] } set inlist [Bank2List MemStep $first $last] set slist [ReorderList $inlist $vorder] for {set i $first; set j 0} {$i <= $last} {incr i; incr j} \ { set MemStep($i) [lindex $slist $j] } set inlist [Bank2List MemLabel $first $last] set slist [ReorderList $inlist $vorder] for {set i $first; set j 0} {$i <= $last} {incr i; incr j} \ { set MemLabel($i) [lindex $slist $j] } return 0 } proc ClearAllChannels { } \ { global Cht global GlobalParam global Mimage global MemFreq global MemSkip if { ([info exists Mimage] == 0) \ || ([string length $Mimage] <= 0)} \ { # No image to write. set msg "You must first read template data from" append msg " the radio or open a file before" append msg " clearing memories." tk_dialog .error "Clear all channels" $msg error 0 OK return } set msg "Warning: This operation will clear all 400 " append msg "memory channels." set result [tk_dialog .clearall "Warning" \ $msg warning 0 Cancel "Clear Memories" ] if {$result == 0} {return} for {set ch 0} {$ch < 400} {incr ch} \ { ZapChannel $ch } ShowChannels $Cht return } proc ZapChannel { ch } \ { global MemDuplex global MemFreq global MemLabel global MemMode global MemOffset global MemSkip global MemStep global MemToneCode global MemToneFlag set MemFreq($ch) "" set MemDuplex($ch) "" set MemLabel($ch) "" set MemMode($ch) NFM set MemOffset($ch) "" set MemSkip($ch) " " set MemStep($ch) 5 set MemToneCode($ch) "" set MemToneFlag($ch) "off" return } proc ZapBankLabels { } \ { global BankLabel global NBanks for {set bn 0} {$bn < $NBanks} {incr bn} \ { set BankLabel($bn) "" } return } ################################################################### # Create memory banks. ################################################################### proc MakeMemoryBankFrame { f }\ { global GlobalParam global MemNB frame $f -relief groove -borderwidth 3 # frame $f.b -relief flat -borderwidth 3 label $f.lab -text "Memory Bank Settings" \ -borderwidth 3 pack $f.lab \ -side top -fill both -expand false -padx 3 -pady 3 MakeMemoryBankFrameCommon $f.common pack $f.common -side left -padx 3 -pady 3 \ -fill both set MemNB $f.banknb MakeMemoryBankNB $MemNB return $f } ################################################################### # Make a frame for settings common to all memory banks. ################################################################### proc MakeMemoryBankFrameCommon { f }\ { global GlobalParam frame $f -relief groove -borderwidth 3 return $f } ################################################################### # Make a single tabbed notebook to hold the settings # for the individual memory banks. ################################################################### proc MakeMemoryBankNB { w } \ { global NBanks tabnotebook_create $w for {set i 0} {$i < $NBanks} {incr i} \ { set p [tabnotebook_page $w "Bank $i"] set fr $p.f; MakeMemoryBankPage $fr $i pack $fr } pack $w -expand true -fill both } ################################################################### # Make a frame to hold the settings # for one memory bank. ################################################################### proc MakeMemoryBankPage { f bn }\ { global GlobalParam frame $f -relief flat -borderwidth 3 MakeBankSettingsFrame $f.c1 $bn pack $f.c1 -side top \ -fill both -padx 3 -pady 3 -expand true if {$GlobalParam(EditMemoryChannels) == "on"} \ { MakeMemoryChannelFrame $f.c2 $bn MakeFillerFrame $f.c3 $bn pack $f.c2 -side left \ -fill both -padx 3 -pady 3 -expand true pack $f.c3 -side left \ -fill both -padx 3 -pady 3 -expand true } return $f } ################################################################### # Create one a set of widgets which pertain to # for one memory bank. # # INPUTS: # f -frame to create # bn -bank number # ################################################################### proc MakeBankSettingsFrame { f bn }\ { global BankLabel global DisplayFontSize global GlobalParam frame $f -relief flat -borderwidth 3 label $f.bankn$bn -text "Bank $bn" -relief flat \ -borderwidth 6 -font $DisplayFontSize label $f.lbankname$bn -text "Label" -relief flat \ -borderwidth 3 entry $f.bankname$bn -width 22 \ -textvariable BankLabel($bn) \ -background white set hint "" append hint "You may create bank and memory channel labels " append hint "up to $GlobalParam(LabelLength) " append hint "characters long. " append hint "They will be kept in the .tr2 template file " append hint "but are not written to or read from the radio.\n\n" append hint "All labels will be cleared when reading " append hint "a memory image from the radio." balloonhelp_for $f.bankname$bn $hint balloonhelp_for $f.lbankname$bn $hint grid $f.bankn$bn -row 10 -column 0 -sticky w grid $f.lbankname$bn -row 10 -column 10 -sticky w grid $f.bankname$bn -row 10 -column 20 -sticky w return $f } ################################################################### # # INPUTS: # f -frame to create # bn -bank number # ################################################################### proc MakeFillerFrame { f bn }\ { global DisplayFontSize frame $f -relief flat -borderwidth 3 for {set i 0} {$i < 12} {incr i} \ { label $f.filler$bn$i -text "-" -relief flat \ -borderwidth 6 grid $f.filler$bn$i -row $i -column 0 -sticky ew } return $f } ################################################################### # Create widgets for memory channels for a bank. ################################################################### proc MakeMemoryChannelFrame { f bn }\ { global GlobalParam global NBanks global NChanPerBank global VNChanPerBank frame $f -relief flat -borderwidth 3 label $f.lab -text "Memory Channels" -borderwidth 3 pack $f.lab -side top ScrollformCreate $f.b pack $f.b -expand yes -fill both set w [ScrollFormInterior $f.b] label $w.freq -text "Freq" -borderwidth 3 label $w.mode -text "Mode" -borderwidth 3 label $w.label -text "Label" -borderwidth 3 label $w.step -text "Step" -borderwidth 3 label $w.offset -text "Offset" -borderwidth 3 label $w.duplex -text "Duplex" -borderwidth 3 label $w.toneflag -text "TSQL" -borderwidth 3 label $w.tonecode -text "CTCSS" -borderwidth 3 label $w.skip -text "Skip" -borderwidth 3 label $w.move -text "Move" -borderwidth 3 if {$GlobalParam(EditMemoryChannels) == "on"} \ { set ch [expr {$bn * $VNChanPerBank}] for {set i 0} {$i < $NChanPerBank} {incr i} \ { MakeChannel $w $bn $i $ch incr ch update idletasks } } grid $w.freq -row 0 -column 20 grid $w.mode -row 0 -column 30 grid $w.label -row 0 -column 35 grid $w.step -row 0 -column 40 grid $w.offset -row 0 -column 50 grid $w.duplex -row 0 -column 60 grid $w.toneflag -row 0 -column 70 grid $w.tonecode -row 0 -column 80 grid $w.skip -row 0 -column 100 grid $w.move -row 0 -column 110 -columnspan 2 return $f } ################################################################### # Create one a set of widgets for one channel. ################################################################### proc MakeChannel { f bn n ch }\ { global ChanNumberRepeat global GlobalParam global MemDuplex global MemFreq global MemMode global MemOffset global MemSkip global MemStep global MemToneCode global MemToneFlag set row [expr {$n + 2}] if {$ChanNumberRepeat == "yes"}\ { set chn $n } \ else \ { set chn $ch } label $f.lab$bn$ch -text "$chn" -borderwidth 3 entry $f.freq$bn$ch -width 12 \ -textvariable MemFreq($ch) \ -background white tk_optionMenu $f.modemenu$bn$ch MemMode($ch) \ NFM WFM AM set wid [expr {2 + $GlobalParam(LabelLength)}] entry $f.label$bn$ch -width $wid \ -textvariable MemLabel($ch) \ -background white tk_optionMenu $f.stepmenu$bn$ch MemStep($ch) \ 5 6.25 9 10 12.5 15 20 25 30 50 100 entry $f.offset$bn$ch -width 12 \ -textvariable MemOffset($ch) \ -background white tk_optionMenu $f.duplexmenu$bn$ch MemDuplex($ch) \ " " "-" "+" tk_optionMenu $f.toneflagmenu$bn$ch MemToneFlag($ch) \ off tsql entry $f.tonecode$bn$ch -width 7 \ -textvariable MemToneCode($ch) \ -background white tk_optionMenu $f.skipmenu$bn$ch MemSkip($ch) \ pskip skip hide " " button $f.lower$bn$ch -text "^" \ -command "SwapChannel $ch [expr {$ch - 1}] 1" button $f.higher$bn$ch -text "v" \ -command "SwapChannel $ch [expr { $ch + 1}] 1" button $f.insert$bn$ch -text "Insert" \ -command "InsertChannel $ch" button $f.delete$bn$ch -text "Delete" \ -command "DeleteChannel $ch" grid $f.lab$bn$ch -row $row -column 10 grid $f.freq$bn$ch -row $row -column 20 grid $f.modemenu$bn$ch -row $row -column 30 -sticky ew grid $f.label$bn$ch -row $row -column 35 -sticky ew grid $f.stepmenu$bn$ch -row $row -column 40 -sticky ew grid $f.offset$bn$ch -row $row -column 50 -sticky ew grid $f.duplexmenu$bn$ch -row $row -column 60 -sticky ew grid $f.toneflagmenu$bn$ch -row $row -column 70 -sticky ew grid $f.tonecode$bn$ch -row $row -column 80 -sticky ew grid $f.skipmenu$bn$ch -row $row -column 100 -sticky ew grid $f.lower$bn$ch -row $row -column 110 grid $f.higher$bn$ch -row $row -column 120 grid $f.insert$bn$ch -row $row -column 130 grid $f.delete$bn$ch -row $row -column 140 return } ################################################################### # Insert a memory channel and move all the higher channels # in the same bank higher by one channel. Clear the current # channel in the bank. ################################################################### proc InsertChannel { ch } \ { global MemDuplex global MemFreq global MemLabel global MemMode global MemOffset global MemSkip global MemStep global MemToneCode global MemToneFlag global NChanPerBank global VNChanPerBank set bn [expr {int($ch/$VNChanPerBank)}] set last [expr {($bn * $VNChanPerBank) + $NChanPerBank - 1}] if {$MemFreq($last) > 0} \ { # No room. set msg "Channel $last is not empty.\n\n" append msg "Please delete channel $last before " append msg "inserting a new channel $ch and " append msg "moving the existing channels higher." tk_dialog .belch "Insert new channel" \ $msg error 0 OK return } set n [expr {$NChanPerBank - fmod($ch, $VNChanPerBank) - 1}] set to $last set from $last incr from -1 for {set i 0} {$i < $n} {incr i} \ { # puts stderr "InsertChannel: n: $n, moving channel $from to $to" set MemFreq($to) $MemFreq($from) set MemLabel($to) $MemLabel($from) set MemMode($to) $MemMode($from) set MemStep($to) $MemStep($from) set MemOffset($to) $MemOffset($from) set MemDuplex($to) $MemDuplex($from) set MemToneFlag($to) $MemToneFlag($from) set MemToneCode($to) $MemToneCode($from) set MemSkip($to) $MemSkip($from) incr from -1 incr to -1 } ZapChannel $ch } ################################################################### # Delete a memory channel and move all the higher channels # in the same bank to the previous channel. Clear the last # channel in the bank. ################################################################### proc DeleteChannel { ch } \ { global MemDuplex global MemFreq global MemLabel global MemMode global MemOffset global MemSkip global MemStep global MemToneCode global MemToneFlag global NChanPerBank global VNChanPerBank set n [expr {$NChanPerBank - fmod($ch, $VNChanPerBank) - 1}] set to $ch set from $ch incr from for {set i 0} {$i < $n} {incr i} \ { # puts stderr "DeleteChannel: moving channel $from to $to" set MemFreq($to) $MemFreq($from) set MemLabel($to) $MemLabel($from) set MemMode($to) $MemMode($from) set MemStep($to) $MemStep($from) set MemOffset($to) $MemOffset($from) set MemDuplex($to) $MemDuplex($from) set MemToneFlag($to) $MemToneFlag($from) set MemToneCode($to) $MemToneCode($from) set MemSkip($to) $MemSkip($from) incr from incr to } set bn [expr {int($ch/$VNChanPerBank)}] set last [expr {($bn * $VNChanPerBank) + $NChanPerBank - 1}] ZapChannel $last return } ################################################################### # Swap channel with the another channel in the bank. # # INPUTS: # ch1 -first channel # ch2 -second channel # samebank -1 = channels must be withn # the same bank. # 0 = channels may be in different # banks. ################################################################### proc SwapChannel { ch1 ch2 samebank } \ { global MemDuplex global MemFreq global MemLabel global MemMode global MemOffset global MemSkip global MemStep global MemToneCode global MemToneFlag global NChanPerBank global VNChanPerBank set bn [expr {int($ch1/$VNChanPerBank)}] set last [expr {($bn * $VNChanPerBank) + $NChanPerBank - 1}] set ch1r [expr {int(fmod($ch1,$VNChanPerBank))}] set ch2r [expr {int(fmod($ch2,$VNChanPerBank))}] if { $samebank && ( ($ch1 > $last) \ || ($ch1 < 0) \ || ($ch2 > $last) \ || ($ch2 < 0) \ || ($ch1r >= $NChanPerBank) \ || ($ch2r >= $NChanPerBank) ) } \ { set msg "Cannot move channel $ch1 to $ch2." tk_dialog .belch "Move channel" \ $msg error 0 OK return } set tmp $MemFreq($ch2) set MemFreq($ch2) $MemFreq($ch1) set MemFreq($ch1) $tmp set tmp $MemLabel($ch2) set MemLabel($ch2) $MemLabel($ch1) set MemLabel($ch1) $tmp set tmp $MemMode($ch2) set MemMode($ch2) $MemMode($ch1) set MemMode($ch1) $tmp set tmp $MemStep($ch2) set MemStep($ch2) $MemStep($ch1) set MemStep($ch1) $tmp set tmp $MemOffset($ch2) set MemOffset($ch2) $MemOffset($ch1) set MemOffset($ch1) $tmp set tmp $MemDuplex($ch2) set MemDuplex($ch2) $MemDuplex($ch1) set MemDuplex($ch1) $tmp set tmp $MemToneFlag($ch2) set MemToneFlag($ch2) $MemToneFlag($ch1) set MemToneFlag($ch1) $tmp set tmp $MemToneCode($ch2) set MemToneCode($ch2) $MemToneCode($ch1) set MemToneCode($ch1) $tmp set tmp $MemSkip($ch2) set MemSkip($ch2) $MemSkip($ch1) set MemSkip($ch1) $tmp return } ################################################################### # # Swap the bank settings, memory channel info, fleet map, # and talk group info for 2 banks with each other. # ################################################################### proc SwapBank { bn1 bn2 } \ { global BankLabel global ChanBank global Cht global GlobalParam global NBanks global NChanPerBank global VNChanPerBank # Sanity checks. if { $bn1 == $bn2 } \ { # Swap bank with itself. return } if { ($bn1 < 0) || ($bn1 >= $NBanks) \ || ($bn2 < 0) || ($bn2 >= $NBanks) } \ { # No such bank. return } # Swap the memory channels. set ch1 [expr {$bn1 * $VNChanPerBank}] set ch2 [expr {$bn2 * $VNChanPerBank}] for {set i 0} {$i < $NChanPerBank} {incr i} \ { SwapChannel $ch1 $ch2 0 incr ch1 incr ch2 } # Swap bank labels. set tmp $BankLabel($bn1) set BankLabel($bn1) $BankLabel($bn2) set BankLabel($bn2) $tmp ShowChannels $Cht return } ################################################################### # Read memory channel labels from list and store them # in a global array. # # Each list element must be of the form: # # MemLabel(channel)=label # # Example: # # 4=Kencom P1 ################################################################### proc SetMemLabels { vlist } \ { global GlobalParam global MemLabel global Pgm # For each entry in the list. set listsize [llength $vlist] for {set i 0} {$i < $listsize} {incr i} \ { set line [lindex $vlist $i] # Valid parameter line must be of the form: # MemLabel(channel)=label set plist [ split $line "=" ] set n [llength $plist] if {$n != 2} \ { continue } set field [ lindex $plist 0 ] set value [ lindex $plist 1 ] set plist [ split $field "(" ] set n [llength $plist] if {$n != 2} \ { continue } set variablename [ lindex $plist 0 ] set vkey [ lindex $plist 1 ] set vkey [ string trimright $vkey ")" ] # puts stderr "variablename: $variablename , vkey: $vkey, value: $value" if {$variablename == "MemLabel"} \ { set MemLabel($vkey) [string range $value \ 0 $GlobalParam(LabelLength)] } } return } ################################################################### # Read bank labels from list and store them # in a global array. # # Each list element must be of the form: # # BankLabel(channel)=label # # Example: # # BankLabel(4)=Kencom P1 ################################################################### proc SetBankLabels { vlist } \ { global BankLabel global Pgm # For each entry in the list. set listsize [llength $vlist] for {set i 0} {$i < $listsize} {incr i} \ { set line [lindex $vlist $i] # Valid parameter line must be of the form: # BankLabel(channel)=label set plist [ split $line "=" ] set n [llength $plist] if {$n != 2} \ { continue } set field [ lindex $plist 0 ] set value [ lindex $plist 1 ] set plist [ split $field "(" ] set n [llength $plist] if {$n != 2} \ { continue } set variablename [ lindex $plist 0 ] set vkey [ lindex $plist 1 ] set vkey [ string trimright $vkey ")" ] # puts stderr "variablename: $variablename , vkey: $vkey, value: $value" if {$variablename == "BankLabel"} \ { set BankLabel($vkey) $value } } return } ################################################################### # Write bank labels from a global array to an open file. # # Each label will be of the form: # # Bank=label # followed by a newline # # Example: # # BankLabel(4)=Kencom P1 ################################################################### proc WriteBankLabels { fid } \ { global BankLabel global GlobalParam global NBanks set endlabel $GlobalParam(LabelLength) incr endlabel -1 for {set bn 0} {$bn < $NBanks} {incr bn} \ { if { [info exists BankLabel($bn)] \ && ($BankLabel($bn) != "") } \ { set s [string range $BankLabel($bn) 0 $endlabel] set s [string trimright $s " "] puts $fid "BankLabel($bn)=$s" } } return } ################################################################### # Write memory labels from a global array to an open file. # # Each label will be of the form: # # channel=label # followed by a newline # # Example: # # MemLabel(4)=Kencom P1 ################################################################### proc WriteMemLabels { fid } \ { global GlobalParam global MemLabel set endlabel $GlobalParam(LabelLength) incr endlabel -1 set a [array names MemLabel] set a [ lsort -dictionary $a ] foreach x $a \ { if { [info exists MemLabel($x)] \ && ($MemLabel($x) != "") } \ { set s [string range $MemLabel($x) 0 $endlabel] set s [string trimright $s " "] puts $fid "MemLabel($x)=$s" } } return } tk2-1.1.orig/misclib.tcl0000755000175000017500000005522107573410672013453 0ustar pg4ipg4i# ---------------------------------------------------------------------- # EXAMPLE: use "wm" commands to manage a balloon help window # ---------------------------------------------------------------------- # Effective Tcl/Tk Programming # Mark Harrison, DSC Communications Corp. # Michael McLennan, Bell Labs Innovations for Lucent Technologies # Addison-Wesley Professional Computing Series # ====================================================================== # Copyright (c) 1996-1997 Lucent Technologies Inc. and Mark Harrison # ====================================================================== option add *Balloonhelp*background yellow widgetDefault option add *Balloonhelp*foreground black widgetDefault option add *Balloonhelp.info.wrapLength 3i widgetDefault option add *Balloonhelp.info.justify left widgetDefault option add *Balloonhelp.info.font \ -*-lucida-medium-r-normal-sans-*-120-* widgetDefault toplevel .balloonhelp -class Balloonhelp \ -background black -borderwidth 1 -relief flat # label .balloonhelp.arrow -anchor nw \ # -bitmap @[file join $env(EFFTCL_LIBRARY) images arrow.xbm] # pack .balloonhelp.arrow -side left -fill y label .balloonhelp.info pack .balloonhelp.info -side left -fill y wm overrideredirect .balloonhelp 1 wm withdraw .balloonhelp # ---------------------------------------------------------------------- # USAGE: balloonhelp_for # # Adds balloon help to the widget named . Whenever the mouse # pointer enters this widget and rests within it for a short delay, # a balloon help window will automatically appear showing the # help . # ---------------------------------------------------------------------- proc balloonhelp_for {win mesg} { global bhInfo set bhInfo($win) $mesg bind $win {balloonhelp_pending %W} bind $win {balloonhelp_cancel} } # ---------------------------------------------------------------------- # USAGE: balloonhelp_control # # Turns balloon help on/off for the entire application. # ---------------------------------------------------------------------- set bhInfo(active) 1 proc balloonhelp_control {state} { global bhInfo if {$state} { set bhInfo(active) 1 } else { balloonhelp_cancel set bhInfo(active) 0 } } # ---------------------------------------------------------------------- # USAGE: balloonhelp_pending # # Used internally to mark the point in time when a widget is first # touched. Sets up an "after" event so that balloon help will appear # if the mouse remains within the current window. # ---------------------------------------------------------------------- proc balloonhelp_pending {win} { global bhInfo balloonhelp_cancel set bhInfo(pending) [after 1500 [list balloonhelp_show $win]] } # ---------------------------------------------------------------------- # USAGE: balloonhelp_cancel # # Used internally to mark the point in time when the mouse pointer # leaves a widget. Cancels any pending balloon help requested earlier # and hides the balloon help window, in case it is visible. # ---------------------------------------------------------------------- proc balloonhelp_cancel {} { global bhInfo if {[info exists bhInfo(pending)]} { after cancel $bhInfo(pending) unset bhInfo(pending) } wm withdraw .balloonhelp } # ---------------------------------------------------------------------- # USAGE: balloonhelp_show # # Used internally to display the balloon help window for the # specified . # # Modified 1/3/2002 by Bob Parnass: # Check flag to enable/inhibit help messages. # ---------------------------------------------------------------------- proc balloonhelp_show {win} { global GlobalParam global bhInfo if {($GlobalParam(BalloonHelpWindows) == "on" ) \ && ($bhInfo(active))} { .balloonhelp.info configure -text $bhInfo($win) \ -background yellow set x [expr [winfo rootx $win]+10] set y [expr [winfo rooty $win]+[winfo height $win]] wm geometry .balloonhelp +$x+$y wm deiconify .balloonhelp raise .balloonhelp } unset bhInfo(pending) } # ---------------------------------------------------------------------- # EXAMPLE: procedures to create dialogs # ---------------------------------------------------------------------- # Effective Tcl/Tk Programming # Mark Harrison, DSC Communications Corp. # Michael McLennan, Bell Labs Innovations for Lucent Technologies # Addison-Wesley Professional Computing Series # ====================================================================== # Copyright (c) 1996-1997 Lucent Technologies Inc. and Mark Harrison # ====================================================================== proc dialog_create {class {win "auto"}} { if {$win == "auto"} { set count 0 set win ".dialog[incr count]" while {[winfo exists $win]} { set win ".dialog[incr count]" } } toplevel $win -class $class frame $win.info pack $win.info -expand yes -fill both -padx 4 -pady 4 frame $win.sep -height 2 -borderwidth 1 -relief sunken pack $win.sep -fill x -pady 4 frame $win.controls pack $win.controls -fill x -padx 4 -pady 4 wm title $win $class wm group $win . after idle [format { update idletasks wm minsize %s [winfo reqwidth %s] [winfo reqheight %s] } $win $win $win] return $win } proc dialog_info {win} { return "$win.info" } proc dialog_controls {win} { return "$win.controls" } proc dialog_wait {win varName} { dialog_safeguard $win set x [expr [winfo rootx .]+50] set y [expr [winfo rooty .]+50] wm geometry $win "+$x+$y" wm deiconify $win grab set $win vwait $varName grab release $win wm withdraw $win } bind modalDialog { wm deiconify %W raise %W } proc dialog_safeguard {win} { if {[lsearch [bindtags $win] modalDialog] < 0} { bindtags $win [linsert [bindtags $win] 0 modalDialog] } } # ---------------------------------------------------------------------- # EXAMPLE: procedures to manipulate fonts # ---------------------------------------------------------------------- # Effective Tcl/Tk Programming # Mark Harrison, DSC Communications Corp. # Michael McLennan, Bell Labs Innovations for Lucent Technologies # Addison-Wesley Professional Computing Series # ====================================================================== # Copyright (c) 1996-1997 Lucent Technologies Inc. and Mark Harrison # ====================================================================== # # Modified 2/2/2002 by Bob Parnass: # Eliminated underline and overstrike attributes. option add *Fontselect*Listbox.background white widgetDefault option add *Fontselect*Text.background white widgetDefault option add *Fontselect*Entry.background white widgetDefault # ---------------------------------------------------------------------- # USAGE: font_best ...