gpsman 6.4.4.2-2 / usr / lib / gpsman / serial.tcl

#
# This file is part of:
#
#  gpsman --- GPS Manager: a manager for GPS receiver data
#
# Copyright (c) 1998-2013 Miguel Filgueiras migfilg@t-online.de
#
#    This program 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 3 of the License, or
#      (at your option) any later version.
#
#      This program 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 this program.
#
#  File: serial.tcl
#  Last change:  6 October 2013
#
# Includes contributions by Matt Martin (matt.martin_AT_ieee.org)
#  marked "MGM contribution"
#

# utilities for using the I/O port with Garmin and Magellan receivers

#  USB ports can, in certain conditions, be used as serial ports
#  the Garmin USB protocol is supported if there is low-level system
#   support (e.g., a suitable Linux kernel driver)

# logging the communication with the serial port (for debugging purposes)
set SERIALLOG $USERDIR/logfile
set NotLogging 1

#### no configurable values below this line!

set LogFile ""
set ErrorCount 0
set MAXTRIALS 5
set ProgrWindow 0

##### low-level serial read procedures

## the following two procs do not work under MS-Windows...

proc ReadChar {} {
    # read chars when using file events or polling
    # call $ProcProcChar to process it
    global SRLFILE Eof InBuff NoInProc Polling GPSState

    if { $Eof } { return }
    set buff [read $SRLFILE]
    if { $buff != "" } {
	append InBuff $buff
	if { $NoInProc } { after 0 UseReadChars }
    }
    if { [set Eof [eof $SRLFILE]] } {
	Log "RP> at eof"
	set GPSState offline
	catch {close $SRLFILE}
    } elseif { $Polling } { update ; after 2 ReadChar }
    return
}

proc UseReadChars {} {
    # use chars read from serial channel in string $InBuff
    # call $ProcProcChar for each character read in
    global ProcProcChar InBuff NoInProc SInPacketState

    set NoInProc 0 ; set buff $InBuff ; set InBuff ""
    while { [set n [string length $buff]] } {
        for { set i 0 } { $i < $n } { incr i } {
	    while { $SInPacketState == "block" } { update ; after 1 }
	    $ProcProcChar [string index $buff $i]
	}
	set buff $InBuff ; set InBuff ""
    }
    set NoInProc 1
    return
}

## special procs for use in MS-Windows...
# adapted from GPSMan 5.2
# implement fileevent readable with polling
#      as Tcl/Tk 8.0 and 8.1 do not support it for MS-Windows

proc ReadPollChar {} {
    # poll and read from serial channel
    global Eof InBuff SRLFILE

    if { $Eof } { return }
    set InBuff [read $SRLFILE]
    if { [set Eof [eof $SRLFILE]] } {
	Log "RPoll> at EOF"
	catch {close $SRLFILE}
    }
    UsePollChars 0 [string length $InBuff]
    return
}

proc UsePollChars {i n} {
    # use chars read from serial channel by polling routine
    #  $i is index of next char in buffer
    #  $n is length of buffer
    # call $ProcProcChar for each character read in
    global InBuff Eof SInPacketState ProcProcChar

    while { $i != $n } {
      if { $SInPacketState == "block" } {
	  after 5 "UsePollChars $i $n"
	  return
      }
      $ProcProcChar [string index $InBuff $i]
      incr i
    }
    if { ! $Eof } {
	after 1 ReadPollChar
    }
    return
}

##### logging

proc OpenSerialLog {} {
    # open (if requested) logfile for the communication with the I/O port
    #  (also used when importing NMEA files)
    global NotLogging LogFile SERIALLOG DateFormat VERSION VERSIONDATE \
	    tcl_version tcl_platform
    
    if { ! $NotLogging && $LogFile == "" } {
	set LogFile [open $SERIALLOG w]
	set d [FormatDay $DateFormat $VERSIONDATE(year) $VERSIONDATE(month) \
		         $VERSIONDATE(day)]
	Log "GPSMan $VERSION / $d"
	Log "Date: [NowTZ]"
	Log "tcl_version = $tcl_version"
	foreach f "platform os osVersion machine byteOrder" {
	    if { ! [catch {set v $tcl_platform($f)}] } {
		Log "$f = $v"
	    }
	}
    }
    return
}

proc Log {m} {
    global NotLogging LogFile

    if { $NotLogging } { return }
    puts $LogFile $m
    flush $LogFile
    return
}

proc LogBytes {m bytes} {
    # write list of bytes to the logfile
    global NotLogging LogFile

    if { $NotLogging } { return }
    puts $LogFile $m
    set n 0
    foreach b $bytes {
	if { [binary scan $b "c" dec] != 1 } { set dec "???" }
	puts -nonewline $LogFile " [expr ($dec+256)%256]"
	if { [incr n] > 20 } {
	    puts $LogFile ""
	    set n 0
	}
    }
    puts $LogFile ""
    flush $LogFile
    return
}

##### resetting

proc ResetSerial {} {
    global SOutBusy SInState SInPacketState SInBuffer LInBuffer \
	    PkInState PkLastPID ErrorCount

    set SOutBusy 0
    set SInPacketState start ; set SInState idle
    set SInBuffer "" ; set LInBuffer ""
    set PkInState idle ; set PkLastPID -1
    set ErrorCount 0
    return
}

##### error handling

proc BadPacket {mess} {
    # count errors in receiving packets and abort operation if too many
    global ErrorCount MAXTRIALS MESS

    Log "BP> $mess"
    incr ErrorCount
    if { $ErrorCount == $MAXTRIALS } {
	GMMessage $MESS(toomanyerr)
	AbortComm
    }
    return
}

##### open serial port

proc OpenSerialFailed {baud} {
    # open serial port at given baud rate, and log file if needs be
    # return 1 on failure
    global MESS SRLFILE SERIALPORT InBuff Polling Eof tcl_platform

    if { ! [file exists $SERIALPORT] || \
	     ! [file readable $SERIALPORT] || \
	     [catch {set SRLFILE [open $SERIALPORT r+]}] || \
	     [regexp {^-} $SRLFILE] } {
	GMMessage [format $MESS(badserial) $SERIALPORT]
	return 1
    }
    switch $tcl_platform(platform) {
	unix {
	    set Polling 0 ; set InBuff ""
	    fconfigure $SRLFILE -blocking 0 -mode $baud,n,8,1 \
		    -translation binary
	    fileevent $SRLFILE readable ReadChar
	}
	windows {
	    # Tcl/Tk 8.0p2 does not support I/O from/to serial ports
	    set Polling 1 ; set InBuff ""
	    fconfigure $SRLFILE -blocking 0 -mode $baud,n,8,1 \
		    -translation binary
	    # after 0 ReadPollChar
	    after 0 ReadChar
	}
	default {
	    GMMessage $MESS(badplatform)
	    return 1
	}
    }
    set Eof 0
    OpenSerialLog
    return 0
}

##### upper level

proc EndOutProt {pid} {
    # deal with end of output protocol
    #  $pid in {XfrWP, XfrRT, XfrTR}; not being used
    # set GPSOpResult to 0
    global Jobs GPSOpResult

    CloseInProgrWindow
    set Jobs ""
    ResetSerial
    set GPSOpResult 0
    return
}

##### floating point representation

proc BadFloats {} {
    # check whether conversions of bytes to float are working correctly
    #  in this machine
    global MESS tcl_platform

    if { $tcl_platform(byteOrder) == "littleEndian" } {
	binary scan [join "A B C D" ""] "f" x
    } else {
	binary scan [join "D C B A" ""] "f" x
    }
    if { abs($x-781.035217285) > 1e-3 } {
	return [expr ! [GMConfirm $MESS(badfloats)]]
    }
    return 0
}

##### control

proc GPSConnection {args} {
    # check connection with receiver if protocol is garmin* or magellan
    #  open serial port if needs be
    #  if connected the 1st argument will be called, else the 2nd one;
    #  continuation is either to SentPacket and EndConnCheck/AbortComm, or to
    #  AbortComm
    # return 0 on immediate failure, otherwise 1
    global Jobs Request MESS NoGarmin GPSProtocol ProcProcChar ProcSendPacket \
	SERIALBAUD RecWPCats

    # includes MGM contribution
    if { [string first "garmin" $GPSProtocol] != 0 && \
	     $GPSProtocol != "magellan" } {
	GMMessage $MESS(cantchkprot)
	return 0
    }
    if { $NoGarmin } {
	if { [BadFloats] } { return 0 }
	if { $GPSProtocol == "garmin_usb" } {
	    if { [OpenUSBFailed] } {
		eval [lindex $args 1]
		return 0
	    }
	    set ProcSendPacket SendUSBPacket
	} else {
	    # use as serial port
	    if { $GPSProtocol == "garmin" } {
		# baud rate is to be set to $SERIALBAUD in proc EndConnCheck
		set baud 9600
	    } else { set baud $SERIALBAUD }
	    if { [OpenSerialFailed $baud] } {
		eval [lindex $args 1]
		return 0
	    }
	    set ProcProcChar ProcChar
	    set ProcSendPacket SendSPacket
	}
	set NoGarmin 0
	set RecWPCats ""
    }
    if { [FailsInProgrWindow $MESS(check)] } {
	eval [lindex $args 1]
	return 0
    }
    set Request "check=$args"
    set Jobs [list [after 10000 AbortComm] [after 0 "SendData product"]]
    return 1
}

proc EndConnCheck {messid} {
    # end connection check successfully
    # set GPSOpResult to 0 if ok
    global MYGPS Request MESS CurrPSPID GPSOpResult RecCanChgBaud SERIALBAUD

    ResetSerial
    Log "ECC> $MESS($messid)"
    if { $MYGPS == "Garmin" && ! [catch {set pid $CurrPSPID(WPData)}] } {
	    SymbolsDOForProtocol $pid
    }
    CloseInProgrWindow
    regsub check= $Request "" as
    eval [lindex $as 0]
    set GPSOpResult 0
    if { $MYGPS == "Garmin" && $RecCanChgBaud && $SERIALBAUD != 9600 } {
	ChangeGarminBaud $SERIALBAUD
    }
    return
}

proc GPSOff {} {
    global Request

    set Request turnOff
    SendData turnOff
    return
}

proc GPSBye {} {

    return
}

proc InitGPS {} {

    return
}

proc StartGPS {} {
    global NoGarmin

    set NoGarmin 1
    return
}

proc GetGPS {wh} {
    # get data of type $wh
    global GetSet

    set GetSet($wh) ""
    DoGetGPS $wh
    return
}

proc GetGPSIn {wh ixs args} {
    # get data of type $wh (in {WP, RT}), but only to replace items with
    #  given indices $ixs (that may contain -1, meaning that new items
    #  can be created)
    #  $args not used but needed for compatibility with proc LoadGRElsIn
    global GetSet

    set GetSet($wh) $ixs
    DoGetGPS $wh
    return
}

proc DoGetGPS {wh} {
    # there must be a call to proc EndWPRenaming where this operation
    #  ends if data was stored (see, e.g., proc EndInProt, garmin.tcl)
    global Request MESS PkLastPID

    set PkLastPID -1
    if { [FailsInProgrWindow $MESS(get$wh)] } { return }
    InitWPRenaming
    set Request get$wh
    SendData get $wh 
    return
}

proc PutGPS {wh ixs args} {
    #  $args used for passing other information, for instance, WP categories
    # if global GPSOpResult is set to 1 (error) by proc SendData close
    #  progress window
    global Request MESS PkLastPID GPSOpResult

    set PkLastPID -1
    if { [FailsInProgrWindow $MESS(put$wh)] } { return }
    set Request put$wh
    set GPSOpResult 0
    SendData put $wh $ixs $args
    if { $GPSOpResult } {
	CloseInProgrWindow
	ResetSerial
    }
    return
}

proc AbortComm {args} {
    # abort communication in progress
    # if $MYGPS==Garmin this proc is replaced in garmin.tcl
    #  $args either void or a message id to be shown
    # global $Request==get$wh  where $wh in {WP RT TR PosnData DtTMData}
    #                          (cf. SendData)
    #                         GPSOpResult is set to 1 (error)
    #                ==check=$cargs  where 2nd arg should be executed as
    #                          connection is apparently down
    global Request Jobs MESS GPSOpResult

    CloseInProgrWindow
    # should it be more cautious concerning these cancelations?
    foreach j $Jobs {
	catch { after cancel $j }
    }
    ResetSerial
    if { $args != "" } { GMMessage $MESS($args) }
    set Jobs ""
    switch -glob $Request {
	get* {
	    set Request abort
	    SendData abort
	    # after which SentPacket will call AbortComm again
	    set GPSOpResult 1
	}
	check=* {
	    # assume connection is down
	    regsub check= $Request "" as
	    eval [lindex $as 1]
	    set GPSOpResult 1
	}
	abort { }
    }
    return
}

##### input/output progress window

proc CloseInProgrWindow {} {
    global CMDLINE ProgrWindow ProgrWGrabs

    if { $CMDLINE } {
	set ProgrWindow 0
    } else {
	DestroyRGrabs .inprogr $ProgrWGrabs
    }
    return
}

proc FailsInProgrWindow {mess} {
    # create dialog for signaling operation in progress
    # fail if window already exists
    #  single button: Abort; no bindings
    global COLOUR EPOSX EPOSY TXT SRecACKs SRecNAKs SPckts CMDLINE \
	    ProgrWindow ProgrWGrabs GPSProtocol

    if { $CMDLINE } {
	if { $ProgrWindow } { return 1 }
	incr ProgrWindow
	set SRecACKs 0 ; set SRecNAKs 0 ; set SPckts 0
	return 0
    }
    if { [winfo exists .inprogr] } { Raise .inprogr ; bell ; return 1 }

    set ProgrWGrabs [grab current]
    set SRecACKs 0 ; set SRecNAKs 0 ; set SPckts 0
    GMToplevel .inprogr commrec +$EPOSX+$EPOSY {} \
        {WM_DELETE_WINDOW AbortComm} {}

    frame .inprogr.fr -borderwidth 5 -bg $COLOUR(messbg)
    label .inprogr.fr.title -text "..." -relief sunken
    label .inprogr.fr.text -text "$mess"
    button .inprogr.fr.ok -text $TXT(abort) -command AbortComm
    if { $GPSProtocol != "garmin_usb" } {
	foreach f "A N P" v "SRecACKs SRecNAKs SPckts" t "ACKs NAKs packets" {
	    set fw .inprogr.fr.frc$f
	    frame $fw
	    label $fw.val -textvariable $v -width 5
	    label $fw.tit -text $TXT($t)
	    pack $fw.val $fw.tit -side left -padx 0
	}
	pack .inprogr.fr.title .inprogr.fr.text .inprogr.fr.frcA \
	    .inprogr.fr.frcN .inprogr.fr.frcP .inprogr.fr.ok -side top -pady 5
    } else {
	set fw .inprogr.fr.frcP
	frame $fw
	label $fw.val -textvariable SPckts -width 5
	label $fw.tit -text $TXT(packets)
	pack $fw.val $fw.tit -side left -padx 0
	pack .inprogr.fr.title .inprogr.fr.text .inprogr.fr.frcP \
	    .inprogr.fr.ok -side top -pady 5
    }
    pack .inprogr.fr -side top
    update idletasks
    grab .inprogr
    RaiseWindow .inprogr
    return 0
}