#!/bin/sh
# the next line restarts using wish \
    exec wish "$0" "$@"

# This is an unsupported version of the HC11 EEPROM burning program.
# It is almost the same as eeburn, but contains an X interface.
#  
# (c) 1999,2000 Loren Wyard-Scott
#          wyard@ee.ualberta.ca
#          lorenw@nait.ab.ca
#  See file eeburn for copying permissions.
#  Some variables (particularly paths) will need to be modified within
#  this script.
#  Requires:  hcdl (HC11 Bootstrap Mode interface program).
#             boot_int.s19   Internal EEPROM programming HC11 file.
#             boot_ext.s19   External EEPROM programming HC11 file.
#
# The GUI itself was created using Visual Tcl v1.20
#
# Future Directions
# -----------------
# 
#
# Revision History
# ----------------
# 0.1 - Mon May  8 16:54:00 MDT 2000 
#     - Replaced progress "scale" with a progress bar using
#       package progressbar 1.3 by Alexander Schoepe (GPL).
#     - This application now requires package progressbar v1.3.
#     - To avoid complications in distribution (making a package
#       database), the progress indicator is kept in the "libpath"
#       directory, below.
#     - Made introduction window centred and grab.
#     - Added EEPROM .s19 burn file selection routine (...).
#     - (This revision works much nicer with non-blocking hcdl,
#        revision 0.2 and up).
#     - Brought hcdl code into this application to allow status-bar display
#       of its progress (using HCDL:: namespace).
#     - Changed serial port configuration to non-blocking, and receivebyte
#       procedure to poll MAXPOLLCOUNT times without data before declaring
#       the device on the other end dead.
# 0.0 - Creation

#################################
# GLOBAL VARIABLES
#

# Configuration options.
global s19path
set s19path "/usr/local/hc11/"
global bmppath
set bmppath "/usr/local/hc11/"
global libpath
set libpath "/usr/local/lib/"

global baudrate; 
global bootfile; 
global completed; 
set completed 56
global eetype; 
global filename; 
global selectedButton; 
global serialport; 
global startaddress; 
global status; 
global programstart;
global sdata;
set lockname ""
global lockname;


# Revision information.
global REVISION; 
set REVISION(number) 0.1
set REVISION(date) "Tue May  9 11:17:03 MDT 2000"
set REVISION(author) "L. Wyard-Scott"
set REVISION(authemail) "lorenw@nait.ab.ca"


# Get loading the libraries out of the way.  As mentioned above,
# this is a package, but to avoid making a package database, the
# code is included in this manner.
source $libpath/progressbar.tcl

global widget; 
    set widget(IntroWin) {.top40}
    set widget(MainWin) {.top17}
    set widget(StatusScale) {.top17.sca34}
    set widget(rev,.top17) {MainWin}
    set widget(rev,.top17.sca34) {StatusScale}
    set widget(rev,.top40) {IntroWin}

set MAXPOLLCOUNT 100;			# Number of times to read the serial
                                        # port until it is considered dead.
global MAXPOLLCOUNT 

#################################
# USER DEFINED PROCEDURES
#
proc init {argc argv} {

    global serialport
    global baudrate
    global eetype
    global startaddress
    global s19path
    global REVISION
    global tk_version
    global programstart
    global status

    
    if {$tk_version < 8.1} {
	tk_messageBox -message [list "TK version is $tk_version.  " \
				    "You need at least 8.1.  " \
				    "Time to upgrade!"] -type ok 
	    
	exit 1
    }

    set programstart "";			# Uninitialized program start.

    # If no serial port is specified on the command-line, this
    # one is used. 
    set serialport /dev/ttyS1
    
    # If no bootstrap baudrate is specified on the command-line, 
    # this one is used.  This rate is used by hcdl.
    set baudrate   4800;		       
    
    # Default EEPROM type.
    set eetype 28128
    
    # Default EEPROM address.
    set startaddress 0xC000
    
    # Path to the .s19 files used to actually burn the EEPROM.
    # Trailing slash (/) is required.

    
    set status ""

    # !!! Change this to centre !!!
    # Show the intro screen for a moment.
    Window show .
    Window show .top40
    tkwait visibility .top40
    CenterWindow .top40
    grab .top40
    update idletasks
    after 2000
    Window destroy .top40

    Window show .top17

}

######################################################################
proc CenterWindow { windowname } {
    # Procedure to center the named window.

    set screenheight [winfo vrootheight $windowname]
    set screenwidth [winfo vrootwidth $windowname]
    set geometrylist [split [ join [split [split [wm geometry $windowname] "+"] "x"]]]
    set appwidth [lindex $geometrylist 0]
    set appheight [lindex $geometrylist 1]
    # Do some math to center!
    set newx [expr ($screenwidth / 2) - ($appwidth/2)]
    set newy [expr ($screenheight / 2) - ($appheight/2)]
    # Activate the new position.
    set newgeometry [join [list $appwidth x $appheight +  $newx + $newy] ""]
    wm geometry $windowname $newgeometry

}


######################################################################
proc {BurnFile} {} {
    # Procedure to bring all the GUI components together
    # and to actually write to the EEPROM.

    global status
    global eetype 
    global s19path
    global baudrate
    global bootfile
    global fileID
    global serID
    global sdata
    global serialport
    global completed 
    global filename
    global startaddress
    global completed
    global lockname
    global env

    # Make the progress widget show that nothing has been done.
    set completed 0
    update ;# idletasks

    
    # Open the file with data to burn for reading.
    if ![string match "" $filename] {
	if [catch "open $filename RDONLY" fileID] {
	    tk_messageBox -message "$fileID" -type ok
	    set status "Failed to open $filename."
	    CloseFiles
	    return 1
	}
    } else {
	    tk_messageBox -message "Please specify a file name." -type ok
	    set status "No file name specified."
	    CloseFiles
	    return 1
    }	

    set status "Calling hcdl to load bootloader."

    tk_messageBox -message "Ensure the HC11 is in Bootstrap Download mode." -type ok

    # Ensure that the correct bootstrapper is downloaded.
    if [string match internal $eetype] {
	set bootfile "boot_int.s19"
    } else {
	set bootfile "boot_ext.s19"
    }

    set fileandpath $s19path
    append fileandpath $bootfile
    set cmd [list hcdl $fileandpath -mode quiet -baud $baudrate >@ stdout]
    
    set status "Calling hcdl to send $fileandpath."
    update idletasks

    if [catch "HCDL::hcdl $fileandpath $baudrate $serialport" result] {
	# tk_messageBox -message "HCDL failed:  $result" -type ok -icon error
	set status "HCDL failed to download $bootfile."
	CloseFiles
	return 1
    }

    # Successful download of the bootstrap download program.

    # Reserve the serial port using a lockout file "LCK..ttySx" in the user's home directory.
    # Create the lock file name.
    set status "Locking serial port..."
    set lockname "$env(HOME)/LCK..[lindex [split $serialport /] end]"
    if [catch "exec lockfile  -r 1 $lockname" result] {
	set msg [concat "Could not create lock file $lockname." \
		     " $result" \
		     "Is there another program currently using " \
		     "$serialport?  " \
		     "If not, please type:  rm -f $lockname"]
	return 1
    }


    # Ensure that if we are programming the internal EEPROM, the
    # options are set correctly.
    # The following steps depend upon the selected device.
    if [string match internal $eetype] {
	# Fool the following code into knowing the size
	# of the internal EEPROM.
	set eetype "in4";			# 4kbits
	set startaddress B600;		# Internal EEPROM address.
    }


    # Determine the size of the EEPROM (and therfore the array, sdata).
    set status "Determining EEPROM size."
    update idletasks
    set bits [string range $eetype 2 end]
    set bytes [expr $bits * 1024 / 8]

    # Reset the name of the eetype if internal EEPROM programming is taking
    # place.  This will keep the GUI EEPROM selection accurate.
    if [string match in4 $eetype] {
	set eetype internal
    }

    set status "EEPROM size:  $bits bits ($bytes bytes)."
    update idletasks
    
    # Ensure sdata is interpreted as an array.
    set sdata(0) ""
    
    # Size the array and fill with FF.
    filldata $bytes

    set status "Reading $filename"
    update idletasks
    if [readfile $fileID] {
	# A parsing error has occurred.  Abort.
	set status "Failed to parse $filename."
	CloseFiles
	return 1
    }

    # Open the serial port at 9600 baud (the speed at which the
    # burning programa works.
    if [catch "open $serialport RDWR" serID] {
	tk_messageBox -message "$serID" -type ok
	set status "HCDL failed to open $serialport."
	CloseFiles
	return 1
    }

    # Set the baudrate and the asynchronous format.
    if [catch "fconfigure $serID -mode 9600,n,8,1 -translation binary -blocking 0"] {
	tk_messageBox -message [list  "Problem attempting to set serial " \
				    " transfer rate of 9600."] -type ok
	CloseFiles
	return 1
    }
    
    # Now actually interface with the program that was downloaded
    # in bootstrap mode.
    if [string match internal $eetype] {
	if [SendDataInternal $startaddress $bytes $serID] {
	    set status "Failure to complete internal EEPROM programming."
	    CloseFiles
	    return 1
	}	    
    } else {
	# Programming external interface.  There is a slightly
	# different protocol here.
	if [SendDataExternal $startaddress $bytes $serID] {
	    set status "Failure to complete internal EEPROM programming."
	    CloseFiles
	    return 1
	}
    }

    set status "Successfully completed EEPROM programming."
    tk_messageBox -message "EEPROM programming complete." -type ok -icon info
    update idletasks
    set completed 0;			# Move progress indicator to 0.
    CloseFiles

}


######################################################################
proc SendDataExternal {address length serID} {
    # Routine to send info to the bootstrap program resident
    # in the HC11 0x0000-0x00FF (the EEPROM burning program).
    # Sends length bytes through serial port identified by serID
    # in 64 byte blocks (by call to sendblock).  
    # Data is contained in global sdata.
    # Returns 0 on success, 1 on failure.

    global completed
    global status
    global MAXPOLLCOUNT 

    set numblocks [expr $length / 64]
    set count 0

    set status "Sending synchronization byte."
    update idletasks
    sendbyte "00" $serID

    # Await the NULL which should be returned by the HC11.
    set response [receivebyte $serID $MAXPOLLCOUNT]
    if [string match "NoChar" $response] {
	tk_messageBox -message "HC11 failed to respond to synch byte." \
	    -type ok -icon error
	return 1
    }

    # Compare the byte received with that sent out.
    if [comparebyte "00" $response "Starting Synchronization Error!"] {
	return 1
    }
    
    for {set i 0} {$i < $numblocks} {incr i} {
	# Update the progress scale.
	set completed [expr 100 * ($i+1) / $numblocks]
	update ;#idletasks
	
	# Format the starting address of the block so it is 4 hex digits.
	# Leading zeroes are required.
	set addresshex [format "%04X" $address]
	
	if [sendblock $addresshex $count $serID] {
	    return 1
	}
	
	# Prepare to process the next block.
	incr count 64
	incr address 64
    }
    
    return 0;				# Success.
}


######################################################################
proc SendDataInternal {address length serID} {
    # Routine to send info to the bootstrap program resident
    # in the HC11 0x0000-0x00FF (the EEPROM burning program).
    # Sends length bytes through serial port identified by serID
    # Data is contained in global sdata. 
    # This routine interfaces with the HC11-resident bootstrap
    # program responsible for programming internal EEPROM.
    # Returns 0 on success, 1 on failure.

    global completed
    global status
    global sdata
    global MAXPOLLCOUNT

    # First send NULL to synchronize with the HC11.
    set status "Sending synchronization byte."
    update idletasks
    sendbyte "00" $serID

    # Await the NULL which should be returned by the HC11.
    set response [receivebyte $serID $MAXPOLLCOUNT]
    if [string match "NoChar" $response] {
	tk_messageBox -message "HC11 failed to respond to synch byte." \
	    -type ok -icon error
	return 1
    }

    # Compare the byte received with that sent out.
    if [comparebyte "00" $response "Starting Synchronization Error!"] {
	return 1
    }

    set status "Sending internal EEPROM data."    
    update idletasks
    for {set i 0} {$i<$length} {incr i} {
	set byte $sdata([expr $i ])
	sendbyte $byte $serID
	
	# Update the status widget.
	set completed [expr 100*($i+1)/$length]
	update ;#idletasks
	
	# Grab the response from the HC11.
	set response [receivebyte $serID $MAXPOLLCOUNT]
	if [string match "NoChar" $response] {
	    tk_messageBox -message "HC11 failed to respond with handshake byte." \
		-type ok -icon error
	    return 1
	}


	if [comparebyte $byte $response \
	    [list "Internal EEPROM failure:  Wrote $byte, received $response" \
		 " Address:  [format "%04X" [expr $i + 0x$address]]"]] {
	    return 1
	}
    }
    
    return 0;				# Success
}

######################################################################
proc sendblock {address index serID} {
    # Routine to send one 64 byte block of data (plus its starting
    # address).  Determines the checksum and ensures that the HC11
    # wrote the data correctly by comparing this checksum with that
    # returned by the HC11.
    # Returns 0 if successfull, 1 if not.

    global sdata
    global status
    global MAXPOLLCOUNT

    # Now that we are synchronized, send the address blindly.
    # Calculate the checksum as we go.

    set addrhigh [string range $address 0 1]
    set addrlow [string range $address 2 3]

    sendbyte $addrhigh $serID
    sendbyte $addrlow  $serID

    # Convert the address bytes into their decimal values.
    scan $addrhigh "%x" addrhighval
    scan $addrlow "%x" addrlowval

    set checksum [expr $addrhighval + $addrlowval]

    set status "Sending and verifying block data."
    update idletasks

    # Alright!  Now to send all 64 bytes of data data out!
    for {set i 0} {$i<64} {incr i} {
	set byte $sdata([expr $i + $index])

	sendbyte $byte $serID
	
	# Increase the checksum.
	scan $byte "%x" byteval
	set checksum [expr $checksum + $byteval]
    }
    
    # Get the data back from the HC11 to verify.
    # This data has already been written.

    for {set i 0} {$i<64} {incr i} {
	# What the byte was supposed to be.
	set byte $sdata([expr $i + $index])

	# What the byte is supposed to be.
	set hc11byte [receivebyte $serID $MAXPOLLCOUNT]
	if [string match "NoChar" $hc11byte] {
	    tk_messageBox -message "HC11 failed to respond with handshake byte." \
		-type ok -icon error
	    return 1
	}

	set addresshex [format "%04X" [expr $i + 0x$address]]
	if [comparebyte $byte $hc11byte \
	    [concat "\n\rByte mismatch ([expr $i + 1] of 64) " \
		 " Address $addresshex. (Written, Returned)."]] {
	    return 1
	}
    }

    
    
    # Now receive the checksum byte.

    # All 64 bytes of data have been sent.  The HC11 is to
    # respond with a 1's complement of the single-byte checksum.
    set hc11checksum [receivebyte $serID $MAXPOLLCOUNT]
    if [string match "NoChar" $hc11checksum] {
	tk_messageBox -message "Timed out waiting for checksum from HC11." \
	    -type ok -icon error
	return 1
    }
    
    # Convert the HC11 checksum to a value.
    scan $hc11checksum "%x" hc11val
    # Take the 1's complement.
    set hc11val [expr 255 - $hc11val]
    
    # Now put it back into 2-digit hex.  This will be used for comparison.
    set hc11hex [format "%02X" $hc11val]    
    
    # Convert the checksum calculated here into hex and grab the 2 least-
    # significant digits.
    set checksumhex [format "%02X" $checksum]    
    set length [string length $checksumhex]
    set checksumbytehex [string range $checksumhex [expr $length - 2] end]

    if [comparebyte $checksumbytehex $hc11hex [list "Block checksums unequal" \
					       " Calculated $checksumbytehex" \
						   " Returned $hc11hex."]] {
	return 1
    }
    
    return 0;				# Success.

}


######################################################################
proc sendbyte {hexvalue serID} {
    # Sends a byte specfied in hex out to the serial port.
    
    set data [binary format H2 $hexvalue]

    # The NULL needs to be handled just a little differently.
    if [string match 00 $hexvalue] {
	puts $serID \x00 nonewline
    } else {
	puts $serID $data nonewline
	}
    flush $serID
}


######################################################################
proc receivebyte {serID PollCount} {
    # Receives a byte from the specified serial port and returns 
    # it in 2-digit hex form.  The incoming information is polled.
    # If the serial port is read PollCount times, then the 
    # routine returns the string "NoChar" rather than the byte received.
    
    
    set PollNumber 0
    
    while {$PollNumber < $PollCount} {
	binary scan [read $serID 1] H2 value
	# Make the Hex letters capital for comparison.
	if [info exists value] {
	    set value [string toupper $value]
	    return $value
	} else {
	    after 1;			# Delay 1 millisecond.
	    incr PollNumber
	}
    }
    return "NoChar"
}

######################################################################
proc comparebyte {arg1 arg2 errormsg} {
    # Procedure to compare the 2-digit (hex) arguments.  If
    # they are not equal, the error message is displayed and
    # the application aborted.
    # Returns 0 if the arguments are equal, 1 if the are not.
    
    global dispmode
    
    if ![string match  $arg1 $arg2] {
	tk_messageBox -message [list "$errormsg  " \
				    "$arg1, $arg2 comparison"] -type ok
	return 1
    }
    
    return 0;				# Success.
}

######################################################################
proc CloseFiles { } {
    # Procedure to close open files (if any), and remove the serial
    # port lock file, only if it was defined in this program.
    
    global serID
    global fileID
    global lockname
    
    catch "close $fileID"
    catch "close $serID"
    
    if {![string match "" $lockname]} {
	exec rm -f $lockname
    }
}


######################################################################
proc {ExitProgram} {} {
# Nicely exit the program by closing files.
    
    global serID
    global fileID

    catch "close $serID"
    catch "close $fileID"
    
    exit 0
}


######################################################################
proc {filldata} {length} {
# Ensures that all array elements from 0 to length of global
    # array sdata are initialized to FF.
    
    global sdata

    for {set i 0} {$i<$length} {incr i} {
	set sdata($i) FF
    }
}

######################################################################
proc {readfile} {fileID} {
# Read in an .s19 file into global array called sdata.
    # The program is shifted down to 0x0000 based upon the
    # address specified in the first record.  This could
    # potentially be a problem if the S-records are out
    # of order in the file.  Returns 0 on success, 1 on failure.
    
    global sdata
    global programstart
    global filename

    # Grab the S record type.
    set rectype [read $fileID 2]
    if ![string match S9 $rectype] {

	if ![string match S1 $rectype] {
	    tk_messageBox -message [list "Bad file format:  $filename.  " \
					"Received record type $rectype"] -type ok
	    return 1
	}
	
	#puts stdout "Processing record:  $rectype"
	
	set numdata [expr 0x[read $fileID 2]]
	set numdata [expr $numdata -3]
	# puts stdout "Number of pieces of data:  $numdata"
	
	set addr [expr 0x[read $fileID 4]]
	# puts stdout "Starting address:  $addr"
	if {[string match "" $programstart]} {
	    # This is the first record.  Get the program
	    # starting address from the record.
	    set programstart $addr
	    # puts stdout "Program starting address: $programstart"
	}

	for {set i 0} {$i<$numdata} {incr i} {
	    # puts stdout "$i-" nonewline
	    # Put the data in the array, adjusting for the starting
	    # address of the program.
	    set sdata([expr $addr + $i - $programstart]) [read $fileID 2]
	}
	gets $fileID;			# Read in the newline character.
	readfile $fileID
    }
    return 0;				# Success.
}

proc {main} {argc argv} {

}

proc {Window} {args} {
global vTcl
    set cmd [lindex $args 0]
    set name [lindex $args 1]
    set newname [lindex $args 2]
    set rest [lrange $args 3 end]
    if {$name == "" || $cmd == ""} {return}
    if {$newname == ""} {
        set newname $name
    }
    set exists [winfo exists $newname]
    switch $cmd {
        show {
            if {$exists == "1" && $name != "."} {wm deiconify $name; return}
            if {[info procs vTclWindow(pre)$name] != ""} {
                eval "vTclWindow(pre)$name $newname $rest"
            }
            if {[info procs vTclWindow$name] != ""} {
                eval "vTclWindow$name $newname $rest"
            }
            if {[info procs vTclWindow(post)$name] != ""} {
                eval "vTclWindow(post)$name $newname $rest"
            }
        }
        hide    { if $exists {wm withdraw $newname; return} }
        iconify { if $exists {wm iconify $newname; return} }
        destroy { if $exists {destroy $newname; return} }
    }
}

#################################
# VTCL GENERATED GUI PROCEDURES
#

proc vTclWindow. {base} {
    if {$base == ""} {
        set base .
    }
    ###################
    # CREATING WIDGETS
    ###################
    wm focusmodel $base passive
    wm geometry $base 1x1+0+0
    wm maxsize $base 1009 738
    wm minsize $base 1 1
    wm overrideredirect $base 0
    wm resizable $base 1 1
    wm withdraw $base
    wm title $base "vt.tcl"
    ###################
    # SETTING GEOMETRY
    ###################
}

proc vTclWindow.top17 {base} {

    global completed

    if {$base == ""} {
        set base .top17
    }
    if {[winfo exists $base]} {
        wm deiconify $base; return
    }
    ###################
    # CREATING WIDGETS
    ###################
    toplevel $base -class Toplevel
    wm focusmodel $base passive
    wm geometry $base 379x314+288+198
    wm maxsize $base 1009 738
    wm minsize $base 1 1
    wm overrideredirect $base 0
    wm resizable $base 0 0
    wm deiconify $base
    wm title $base "HC11 EEPROM Burner
"
    frame $base.fra18 \
        -borderwidth 2 -height 75 -relief groove -width 125 
    label $base.fra18.lab19 \
        -borderwidth 1 -relief raised -text {EEPROM Selection} 
    radiobutton $base.fra18.rad20 \
        -text 28128 -value 28128 -variable eetype 
    radiobutton $base.fra18.rad21 \
        -text 28256 -value 28256 -variable eetype 
    radiobutton $base.fra18.rad22 \
        -text Internal -value internal -variable eetype 
    frame $base.cpd23 \
        -borderwidth 1 -height 30 -relief raised -width 30 
    label $base.cpd23.01 \
        -anchor w -relief groove -text {EEPROM Starting Address:} -width 28 
    entry $base.cpd23.02 \
        -cursor {} -highlightthickness 0 -textvariable startaddress 
    frame $base.cpd25 \
        -borderwidth 1 -height 30 -relief raised -width 30 
    label $base.cpd25.01 \
        -anchor w -relief groove -text {Bootstrap (EE burning) Program:} 
    entry $base.cpd25.02 \
        -cursor {} -highlightthickness 0 -textvariable bootfile -state disabled  
    frame $base.cpd26 \
        -borderwidth 1 -height 30 -relief raised -width 30 
    label $base.cpd26.01 \
        -anchor w -relief groove -text {Name of file to burn:} -width 28 
    entry $base.cpd26.02 \
        -cursor {} -highlightthickness 0 -textvariable filename 
    button $base.cpd26.fileselect \
	-text "..." \
	-command { GetFileName }
    
    
    frame $base.fra27 \
        -borderwidth 2 -height 75 -relief groove -width 125 
    label $base.fra27.lab28 \
        -borderwidth 1 -relief raised -text {Serial Port Selection} 
    radiobutton $base.fra27.rad29 \
        -text /dev/ttyS0 -value /dev/ttyS0 -variable serialport 
    radiobutton $base.fra27.rad30 \
        -text /dev/ttyS1 -value /dev/ttyS1 -variable serialport 
    frame $base.fra32 \
        -borderwidth 2 -height 75 -relief groove -width 125 
    label $base.fra32.01 \
        -borderwidth 1 -relief raised \
        -text {Bootstrap Download Baud Rate Selection} 
    radiobutton $base.fra32.02 \
        -text 300 -value 300 -variable baudrate 
    radiobutton $base.fra32.03 \
        -text 1200 -value 1200 -variable baudrate 
    radiobutton $base.fra32.rad33 \
        -text 4800 -value 4800 -variable baudrate 
    # Addition for revision 0.1.
    ::progressbar::progressbar $base.sca34 \
	-width 140 \
        -variable completed 
    label $base.lab35 \
        -borderwidth 1 -text {Progress: } 
    label $base.lab36 \
        -borderwidth 1 -text Action: 
    label $base.lab37 \
        -borderwidth 1 -relief raised -text label -textvariable status 
    button $base.but38 \
        -command BurnFile -text Execute 
    button $base.but39 \
        -command ExitProgram -text Exit 
    ###################
    # SETTING GEOMETRY
    ###################
    place $base.fra18 \
        -x 5 -y 5 -width 370 -height 60 -anchor nw -bordermode ignore 
    place $base.fra18.lab19 \
        -x 10 -y 5 -width 346 -height 18 -anchor nw -bordermode ignore 
    place $base.fra18.rad20 \
        -x 25 -y 30 -anchor nw -bordermode ignore 
    place $base.fra18.rad21 \
        -x 135 -y 30 -anchor nw -bordermode ignore 
    place $base.fra18.rad22 \
        -x 230 -y 30 -anchor nw -bordermode ignore 
    place $base.cpd23 \
        -x 5 -y 215 -width 370 -height 25 -anchor nw -bordermode ignore 
    pack $base.cpd23.01 \
        -in .top17.cpd23 -anchor center -expand 0 -fill none -padx 2 -pady 2 \
        -side left 
    pack $base.cpd23.02 \
        -in .top17.cpd23 -anchor center -expand 1 -fill x -padx 2 -pady 2 \
        -side right 
    place $base.cpd25 \
        -x 5 -y 165 -width 370 -height 25 -anchor nw -bordermode ignore 
    pack $base.cpd25.01 \
        -in .top17.cpd25 -anchor center -expand 0 -fill none -padx 2 -pady 2 \
        -side left 
    pack $base.cpd25.02 \
        -in .top17.cpd25 -anchor center -expand 1 -fill x -padx 2 -pady 2 \
        -side right 
    place $base.cpd26 \
        -x 5 -y 190 -width 370 -height 25 -anchor nw -bordermode ignore 
    pack $base.cpd26.01 \
        -in .top17.cpd26 -anchor center -expand 0 -fill none -padx 2 -pady 2 \
        -side left 
    pack $base.cpd26.fileselect \
	-in .top17.cpd26 -anchor center -expand 1 -fill x -padx 2 -pady 2 \
	-side right
    pack $base.cpd26.02 \
        -in .top17.cpd26 -anchor center -expand 0 -fill x -padx 2 -pady 2 \
        -side right
    place $base.fra27 \
        -x 5 -y 65 -width 370 -height 50 -anchor nw -bordermode ignore 
    place $base.fra27.lab28 \
        -x 5 -y 5 -width 351 -height 18 -anchor nw -bordermode ignore 
    place $base.fra27.rad29 \
        -x 70 -y 25 -anchor nw -bordermode ignore 
    place $base.fra27.rad30 \
        -x 190 -y 25 -anchor nw -bordermode ignore 
    place $base.fra32 \
        -x 5 -y 115 -width 370 -height 50 -anchor nw -bordermode ignore 
    place $base.fra32.01 \
        -x 10 -y 5 -width 351 -height 18 -anchor nw -bordermode ignore 
    place $base.fra32.02 \
        -x 35 -y 25 -anchor nw -bordermode ignore 
    place $base.fra32.03 \
        -x 140 -y 25 -anchor nw -bordermode ignore 
    place $base.fra32.rad33 \
        -x 235 -y 25 -anchor nw -bordermode ignore 
    place $base.sca34 \
        -x 225 -y 287 -width 151 -height 43 -anchor nw -bordermode ignore 
    place $base.lab35 \
        -x 150 -y 290 -anchor nw -bordermode ignore 
    place $base.lab36 \
        -x 5 -y 250 -width 61 -height 23 -anchor nw -bordermode ignore 
    place $base.lab37 \
        -x 65 -y 250 -width 306 -height 18 -anchor nw -bordermode ignore 
    place $base.but38 \
        -x 10 -y 285 -anchor nw -bordermode ignore 
    place $base.but39 \
        -x 90 -y 285 -anchor nw -bordermode ignore 
}

proc vTclWindow.top40 {base} {
    global bmppath

    if {$base == ""} {
        set base .top40
    }
    if {[winfo exists $base]} {
        wm deiconify $base; return
    }
    ###################
    # CREATING WIDGETS
    ###################
    toplevel $base -class Toplevel \
        -menu .top40.m53 -relief sunken 
    wm focusmodel $base passive
    wm geometry $base 295x200+305+578
    wm maxsize $base 1009 738
    wm minsize $base 1 1
    wm overrideredirect $base 0
    wm resizable $base 1 1
    wm deiconify $base
    wm title $base "EEBurn Information"
    label $base.lab42 \
        -borderwidth 1 -font {Helvetica 24 bold} -text {HC11 EEPROM Burner} 
    label $base.lab43 \
        -borderwidth 1 -text {Loren Wyard-Scott (wyard@ee.ualberta.ca)} 
    label $base.lab45 \
        -borderwidth 1 -text (lorenw@nait.ab.ca) 
    label $base.lab46 \
        -borderwidth 1 -text {Revision: } 
    label $base.lab47 \
        -borderwidth 1 -text 0.0 -textvariable REVISION(number) 
    label $base.lab48 \
        -borderwidth 1 -font {Helvetica 10 bold} \
        -text {(c) 1999   See file eeburn for copying permission.} 
    button $base.but52 \
        -bitmap @$bmppath/nait.xbm -text button 
    menu $base.m53 \
        -cursor {} 
    ###################
    # SETTING GEOMETRY
    ###################
    place $base.lab42 \
        -x 15 -y 10 -anchor nw -bordermode ignore 
    place $base.lab43 \
        -x 15 -y 60 -anchor nw -bordermode ignore 
    place $base.lab45 \
        -x 140 -y 80 -anchor nw -bordermode ignore 
    place $base.lab46 \
        -x 15 -y 40 -anchor nw -bordermode ignore 
    place $base.lab47 \
        -x 90 -y 40 -anchor nw -bordermode ignore 
    place $base.lab48 \
        -x 25 -y 95 -anchor nw -bordermode ignore 
    place $base.but52 \
        -x 75 -y 120 -anchor nw -bordermode ignore 
}

######################################################################
proc GetFileName { } {
    # Calls tk_getOpenFile to read the name of an .s19 file.
    
    global filename 

    set filename [tk_getOpenFile \
		     -defaultextension ".s19" \
		     -filetypes { { { S-records} {.s19} } \
				      {{ All Files } * }} \
		     -title "Select a file to burn..."]
}


######################################################################
# The following variables sit in the HCDL namespace
######################################################################
namespace eval HCDL {
    # Variables.
    namespace export hcdl;		# Export the one main proc.
    set sdata(0) ""
    variable  sdata;			# S-record data.
    variable  serID;
    variable  fileID;
    variable  lockname;
    variable MAXPOLLCOUNT 100;
    
    ######################################################################
    proc readfile {fileID} {
	# Read in an .s19 file into global array called sdata.
	
	variable sdata
	
	# Grab the S record type.
	set rectype [read $fileID 2]
	if ![string match S9 $rectype] {
	    
	    set numdata [expr 0x[read $fileID 2]]
	    set numdata [expr $numdata -3]
	    
	    set addr [expr 0x[read $fileID 4]]
	    
	    for {set i 0} {$i<$numdata} {incr i} {
		# puts stdout "$i-" nonewline
		set sdata([expr $addr + $i]) [read $fileID 2]
	    }
	    gets $fileID
	    readfile $fileID
	}
    }
    
    ######################################################################
    proc filldata {length} {
	# Ensures that all array elements from 0 to length of global
	# array sdata are initialized to FF.
	
	variable sdata
	
	for {set i 0} {$i<$length} {incr i} {
	    set sdata($i) FF
	}
    }
    
    
    ######################################################################
    proc senddata {length serID} {
	# Actual routine to send info to HC11 bootstrap program.
	# sends length bytes through serial port identified by serID.
	# Data is contained in global sdata.
	
	variable sdata
	variable MAXPOLLCOUNT
	global status
	global completed

	set status "Sending Synchronization Byte"

	
	
	sendbyte FF $serID
	# Nothing is transmitted by the HC11.  This is used to set
	# the baudrate.  
	
	set status "HCDL Transmitting File Data"
	
	for {set i 0} {$i<$length} {incr i} {
	    set byte $sdata($i)
	    
	    set completed [expr 100 * $i / $length ]
	    update

	    # Actually send the byte out.
	    sendbyte $byte $serID
	    
	    # Set a timer to abort if nothing is received (rather than block).
	    
	    # Get the handshaking byte.
	    set handshake [receivebyte $serID $MAXPOLLCOUNT]
	    
	    if [string match NoChar $handshake] {
		set msg [concat  "Error:  Handshaking byte not received." \
			     "  Is the HC11 in bootstrap download mode?"]
		ExitProgram 1 $msg
		return 1
	    }
	    
	    # Both the byte and handshake variables are capital hex 
	    # and can now be compared.
	    if ![string match $byte $handshake] {
		ExitProgram 1 "HCDL encountered handshaking error."
		return 1
	    }
	    
	}
	
	set status "HCDL Completed Successfully."
	return 0
    }
    
    ######################################################################
    proc sendbyte {hexvalue serID} {
	# Sends a byte specfied in hex out to the serial port.
	
	set data [binary format H2 $hexvalue]
	
	# The NULL needs to be handled just a little differently.
	if [string match 00 $hexvalue] {
	    puts $serID \x00 nonewline
	} else {
	    puts $serID $data nonewline
	}
	flush $serID
    }
    
    
    ######################################################################
    proc receivebyte {serID PollCount} {
	# Receives a byte from the specified serial port and returns 
	# it in 2-digit hex form.  The incoming information is polled.
	# If the serial port is read PollCount times, then the 
	# routine returns the string "NoChar" rather than the byte received.
	
	
	set PollNumber 0
	
	while {$PollNumber < $PollCount} {
	    binary scan [read $serID 1] H2 value
	    # Make the Hex letters capital for comparison.
	    if [info exists value] {
		set value [string toupper $value]
		return $value
	    } else {
		after 1;			# Delay 1 millisecond.
		incr PollNumber
	    }
	}
	return "NoChar"
    }
    
    ######################################################################
    proc ExitProgram {exitvalue message} {
	# Procedure to intercept termination of the program.  Removes the
	# lock file and closes the files.
	# Exit codes (actually return codes from namespace HCDL):
	# 0 - success.
	# 1 - failure (close open streams).
	# 2 - failure (do not close streams).
	
	variable serID
	variable fileID
	variable lockname
	
	if {$exitvalue != 2} {
	    # Close the files.
	    close $serID
	    close $fileID
	    
	    # Remove the lockfile.
	    exec rm -f $lockname
	}

	if {$exitvalue} {
	    tk_messageBox -message $message -type ok -icon error
	    return $exitvalue
	} else {
	    return 0
	}
    }

    ######################################################################
    proc hcdl { filename baudrate serialport } {
	# Stub to the hcdl program.
	# Arguments are:
	#  filename:  name of the .s19 file to send in bootstrap mode.
	#  baudrate:  the serialport baudrate to be used.
	#  serialport:  the serialport to be used.
	
	global env
	variable serID
	variable fileID
	variable lockname

	# Reserve the serial port using a lockout file "LCK..ttySx" in the user's home directory.
	# Create the lock file name.
	set lockname "$env(HOME)/LCK..[lindex [split $serialport /] end]"
	if [catch "exec lockfile  -r 1 $lockname" result] {
	    set msg [concat "Could not create lock file $lockname." \
			 " $result" \
			 "Is there another program currently using " \
			 "$serialport?  " \
			 "If not, please type:  rm -f $lockname"]
	    ExitProgram 2 $msg
	    return 2
	}

	# Open the .s19 file for reading.
	if [catch "open $filename RDONLY" fileID] {
	    ExitProgram 1 $fileID
	    return 1
	}

	# Open the serial port.
	if [catch "open $serialport RDWR" serID] {
	    ExitProgram 1 "HCDL error: $serialport"
	    return 1
	}

	
	# Set the baudrate and the asynchronous format.
	if [catch "fconfigure $serID -mode $baudrate,n,8,1 -translation binary -blocking 0"] {
	    ExitProgram 1 "HCDL error: failure to set $baudrate baud."
	    return 1
	}
	
	######################################################################
	# Fill the entire array with value 'FF'.
	filldata 256
	
	# Read the information from the .s19 file.
	readfile $fileID
	
	if [senddata 256 $serID] {
	    ExitProgram 0 ""
	    return 1 
	}
	
	ExitProgram 0 ""
	return 0
    }


};					# End of HCDL Namespace

init $argc $argv
main $argc $argv