#!/usr/bin/wish

#############################################################################
#	Copyright (c) 2009, Bendor Research Pty. Ltd. All rights reserved.		#
#	This software is released under the GNU General Public License, version	#
#	3, with the exemptions that 1) the header files installed by this 	 	#
#	package can be included in closed-source code and 2) the libraries		#
#	built by this package can be statically linked into a closed-source 	#
#	binary. See the file LICENSE for the details.							#
#	This software is provided "AS IS", without any warranty or guarantee.	#
#	By using this software you acknowledge that neither Bendor Research nor	#
#	any of its personnel or affiliates can be held liable for any damages,	#
#	including, but not limited to, loss of business, loss of money, loss of #
#	life, loss of reputation, arising out of this software being faulty or	#
#	not performing as advertised, even if Bendor Research was aware of such	#
#	faults in the software. You use this software at your own risk, any and #
#	all liabilities that arise out of your using this software are strictly	#
#	yours.																	#
#############################################################################

load liblpctcl.so

#############################################################################
#					Configuration variables									#
#############################################################################

#	Serial port variables
#	~~~~~~~~~~~~~~~~~~~~~
#	port	The name of the serial device
#	man		A flag, indicating manual signal control
#	res		A flag, indicating that reset is inverted
#	isp		A flag, indicating that ISP is inverted
#	rts		A flag, indicating that RTS controls reset
#	ibr		The initial baud rate
#	fbr		The fast baud rate
#	cbr		The baud rate for the console

set port 	"/dev/ttyS0"
set man		0
set res		0
set isp 	0
set rts 	0
set ibr		9600
set	fbr		9600
set cbr		9600

#	Burning option variables
#	~~~~~~~~~~~~~~~~~~~~~~~~
#	bmod	The mode, one of "norm", "wipe" or "keep"
#	bvec	A flag, indicating that vector table cheksum should be calculated

set bmod 	"norm"
set bvec 	1
set	noff	1
set powr	0

#	Buffer option variables
#	~~~~~~~~~~~~~~~~~~~~~~~
#	ldhf	Name of the last loaded hexfile
#	sthf	Name of the last saved hexfile
#	hext	Hexfile type, either "srec" or "ihex"

set	ldhf	""
set	sthf	""
set hext	"srec"

#	Target options
#	~~~~~~~~~~~~~~
#	xtal	Default crystal frequency for the target

set	xtal	14.748

#	Trace options, thy *must* be called like this
#	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

set deltas	0
set	serial	0
set target	0
set fileio	0

#	Console options
#	~~~~~~~~~~~~~~~
#	echo	Console echoes keyboard input
#	wrap	Wrap lines
#	crlf	What to send when the Enter key is pressed

set echo 	1
set wrap 	0
set crlf	"CR"

#	List of variables to load/save
#	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

set vlist	{ port man res isp rts ibr fbr cbr bmod bvec ldhf sthf noff
			  hext xtal deltas serial target fileio echo crlf wrap }

#############################################################################
#					Default load/save procedures							#
#############################################################################

#	Load the defaults from the ~/.lpc-prg file
#	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#	If the file doesn't exist, the function just returns
#	without complaining

proc load_defaults {} \
{
	global vlist env

	foreach var $vlist { global $var }

	if { ! [ catch { open "$env(HOME)/.lpc-prg" r } fd ] } {

		while { ! [ eof $fd ] } { eval [ gets $fd ] }
		close $fd
	}
}

#	Save the defaults into the ~/.lpc-prg file
#	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

proc save_defaults {} \
{
	global vlist env

	if { ! [ catch { open "$env(HOME)/.lpc-prg" w } fd ] } {

		foreach var $vlist {

			global $var
			set loc [expr $$var]
			puts $fd "set $var \"$loc\""
		}

		close $fd
	}
}

#############################################################################
#					Activity log related procedures							#
#############################################################################

#	Create the log window, if the user selects logging
#	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

proc show_trace {} \
{
	toplevel 	.lw
	wm title 	.lw "Library trace"
	text 		.lw.txt -width 90 -yscrollcommand { .lw.scr set }
	scrollbar	.lw.scr -command { .lw.txt yview }
	grid .lw.txt -row 0 -column 0 -sticky nsew
	grid .lw.scr -row 0 -column 1 -sticky ns
	.lw.txt delete 1.0 end
	.oth.trc.but configure -text "Close trace window"
	.oth.trc.but configure -command hide_trace
	lpcprg logproc trace_event .lw
	.lw.txt configure -state disabled
	update
}

#	Destroy the log box if the user deselects it
#	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

proc hide_trace {} \
{
	lpcprg logproc
	destroy .lw
	.oth.trc.but configure -text "Open trace window"
	.oth.trc.but configure -command show_trace
	update
}

#	The logging callback from the library
#	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

proc trace_event { wid logmsg } \
{
	$wid.txt configure -state normal
	$wid.txt insert end $logmsg
	$wid.txt insert end "\n"
	$wid.txt yview moveto 1.0
	$wid.txt configure -state disabled
	update
}

#	Log config variable change tracing
#	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

proc trace_onoff { var elem op } \
{
	global $var
	global [expr $$var]
	if { [expr $$var] } { lpcprg logon $var } else { lpcprg logoff $var }
}

trace add variable deltas write trace_onoff
trace add variable serial write trace_onoff
trace add variable target write trace_onoff
trace add variable fileio write trace_onoff

#############################################################################
#					Action procedures										#
#############################################################################

#	Show an error dialog
#	~~~~~~~~~~~~~~~~~~~~

proc show_error { action emsg } \
{
	set msg "An error occured!\n\nThe current activity was:\n\t"
	append msg $action
	append msg "\nThe error message was:\n\t"
	append msg $emsg
	append msg "\nThe low level error message was:\n\t"
	append msg [ lpcprg errormsg ]
	tk_messageBox -type ok -icon error -message $msg -parent .
}

#	Connect to the target
#	~~~~~~~~~~~~~~~~~~~~~

proc connect {} \
{
	global port ibr fbr tclk chip baud flsh
	lpcprg close

	seropt_disable

	set res [ catch { lpcprg port $port "" } emsg ]

	if { $res != 0 } {

		show_error "Opening the serial port" $emsg
		seropt_enable
		return
	}

	lpcprg baud $ibr $fbr
	set res [ catch { lpcprg connect } emsg ]

	if { $res != 0 } {

		show_error "Connecting to the target" $emsg
		seropt_enable
		return
	}

	.cmd.act.conn configure -text "Disconnect"
	.cmd.act.conn configure -command disconnect
	action_enable
	.cmd.act.burn configure -state disabled
	.oth.tgt.xtal.inp configure -state disabled -relief flat
	set tclk [lpcprg crystal]
	set chip "LPC[lpcprg chiptype]"
	set baud [lpcprg baud]
	set flsh [lpcprg flash]
	xtal_valid
	set connected 1
}

#	Disconnect and close the port
#	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

proc disconnect {} \
{
	global chip baud flsh
	lpcprg close
	lpcprg invalidate
	action_disable
	seropt_enable
	.cmd.act.conn configure -text "Connect"
	.cmd.act.conn configure -command connect
	.cmd.act.conn configure -state normal
	.oth.tgt.xtal.inp configure -state normal -relief sunken
	set chip ""
	set baud ""
	set flsh ""
}

#	Load a hexfile into the buffer
#	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

proc load_hex {} \
{
	global ldhf hext
	set temp [ tk_getOpenFile -multiple 0 -title "Select source hexfile" \
					-initialdir [file normalize [file dirname $ldhf ]] \
					-initialfile [file tail $ldhf ] \
					-filetypes { { Hex { .srec .ihex .hex .s12 .S12 } } \
								 { All { * } } } ]

	if { $temp == "" } return

	set ldhf $temp
	lpcprg format $hext
	action_disable
	set res [ catch { lpcprg load $ldhf } emsg ]

	if { $res != 0 } {

		show_error "Loading a hexfile" $emsg
		action_enable
		.cmd.act.burn configure -state disabled
		return
	}

	action_enable
}

#	Burn the buffer into the target
#	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

proc burn_hex {} \
{
	global bvec bmod

	if { $bvec != 0 } { lpcprg vector }
	action_disable
	set res [ catch { lpcprg burn $bmod } emsg ]
	action_enable

	if { $res != 0 } {

		show_error "Burning the FLASH" $emsg
	} \
	else {

		.cmd.act.burn configure -state disabled
	}
}

#	Save the FLASH content into a file
#	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

proc save_hex {} \
{
	global sthf hext noff
	set temp [ tk_getSaveFile -title "Select the FLASH save file" \
					-initialdir [file normalize [file dirname $sthf ]] \
					-initialfile [file tail $sthf ] \
					-filetypes { { Hex { .srec .ihex .hex .s12 .S12 } } \
								 { All { * } } } ]

	if { $temp == "" } return

	set sthf $temp
	lpcprg format $hext
	update
	action_disable
	set res [ catch { lpcprg save $sthf $noff } emsg ]
	action_enable
	.cmd.act.burn configure -state disabled

	if { $res != 0 } {

		show_error "Saving FLASH content" $emsg
		seropt_enable
		return
	}
}

#	Quit from the application
#	~~~~~~~~~~~~~~~~~~~~~~~~~

proc quit {} \
{
	lpcprg close
	save_defaults
	exit
}

#############################################################################
#					Options panel											#
#############################################################################

set	col_bf	darkgreen
set	col_ac	darkred

#	Callback function for power control
#	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

proc power_callback { x } \
{
	set msg "Please "
	append msg [ expr $x ? {"apply"} : {"remove"} ]
	append msg " target power\nand click OK!"
	tk_messageBox -type ok -icon warning -message $msg -parent .
}

#	Action for the manual power control toggle button
#	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

proc power_ctrl {} \
{
	global powr
	if { $powr } { lpcprg power power_callback } else { lpcprg power }
}

frame		.cmd

labelframe  .cmd.opt			-relief raised
label		.cmd.opt.name		-text "Options" \
								-anchor n -font { * 10 bold } \
								-fg $col_bf -bg gray

labelframe	.cmd.opt.type		-text "Hexfile format" -fg $col_bf
radiobutton	.cmd.opt.type.srec	-anchor w -text "Motorola S-record" \
								-variable hext -value "srec"
radiobutton	.cmd.opt.type.ihex	-anchor w -text "Intel hex format" \
								-variable hext -value "ihex"

pack .cmd.opt.type.srec .cmd.opt.type.ihex \
	 -fill both -expand 1

labelframe	.cmd.opt.burn		-text "Burning mode" -fg $col_bf
radiobutton .cmd.opt.burn.norm	-anchor w \
								-text "Erase modified FLASH sectors" \
								-variable bmod -value "norm"
radiobutton .cmd.opt.burn.wipe	-anchor w \
								-text "Erase the entire FLASH" \
								-variable bmod -value "wipe"
radiobutton .cmd.opt.burn.kold	-anchor w \
								-text "Keep unmodified FLASH content" \
								-variable bmod -value "keep"

pack .cmd.opt.burn.norm .cmd.opt.burn.wipe .cmd.opt.burn.kold \
	 -fill both -expand 1

labelframe	.cmd.opt.misc		-text "Other options" -fg $col_bf
checkbutton .cmd.opt.misc.noff	-anchor w \
								-text "Trim FF-s on save" \
								-variable noff
checkbutton .cmd.opt.misc.vect	-anchor w \
								-text "Update vectortable checksum" \
								-variable bvec
checkbutton .cmd.opt.misc.powr	-anchor w \
								-text "Manual power control" \
								-variable powr -command power_ctrl

pack .cmd.opt.misc.noff .cmd.opt.misc.vect .cmd.opt.misc.powr \
	 -fill both -expand 1
pack .cmd.opt.name -fill both
pack .cmd.opt.type .cmd.opt.burn .cmd.opt.misc -fill both -expand 1

#############################################################################
#					Action buttons											#
#############################################################################

#	Enables all action buttons
#	~~~~~~~~~~~~~~~~~~~~~~~~~~

proc action_enable {} \
{
	.cmd.act.conn configure -state normal
	.cmd.act.load configure -state normal
	.cmd.act.save configure -state normal
	.cmd.act.moni configure -state normal
	.cmd.act.burn configure -state normal
}

#	Disables all action buttons
#	~~~~~~~~~~~~~~~~~~~~~~~~~~~

proc action_disable {} \
{
	.cmd.act.conn configure -state disabled
	.cmd.act.load configure -state disabled
	.cmd.act.save configure -state disabled
	.cmd.act.moni configure -state disabled
	.cmd.act.burn configure -state disabled
}

labelframe	.cmd.act			-relief raised
label		.cmd.act.name		-text "Actions" \
								-anchor n -font { * 10 bold } \
								-fg $col_ac -bg gray
button		.cmd.act.conn		-text "Connect" \
								-command connect -fg $col_ac
button		.cmd.act.load		-text "Load hexfile" \
								-state disabled -command load_hex -fg $col_ac
button		.cmd.act.save		-text "Save the FLASH" \
								-state disabled -command save_hex -fg $col_ac
button		.cmd.act.burn		-text "Burn the FLASH" \
								-state disabled -command burn_hex -fg $col_ac
button		.cmd.act.moni		-text "Start console" \
								-state disabled -command console_create -fg $col_ac
button		.cmd.act.quit		-text "Quit" \
								-command quit -fg $col_ac

pack .cmd.act.name -fill both
pack .cmd.act.conn .cmd.act.load .cmd.act.save .cmd.act.burn \
	 .cmd.act.moni .cmd.act.quit -fill both -expand 1

#############################################################################
#					Trace panel												#
#############################################################################

set	col_tr	darkorange
set	col_tr	black

frame		.oth
labelframe  .oth.trc		-relief raised
label		.oth.trc.name	-text "Trace" \
							-anchor n -font { * 10 bold } \
							-fg $col_tr -bg gray

checkbutton .oth.trc.tim	-text "Show timestamp" \
							-anchor w -variable deltas
checkbutton .oth.trc.tgt	-text "Show target actions" \
							-anchor w -variable target
checkbutton .oth.trc.ser	-text "Show serial comms"	\
							-anchor w -variable serial
checkbutton .oth.trc.fio	-text "Show file I/O"	\
							-anchor w -variable fileio
button		.oth.trc.but	-text "Open trace window" \
							-command show_trace -fg $col_tr

pack .oth.trc.name -fill both
pack .oth.trc.tim .oth.trc.tgt .oth.trc.ser .oth.trc.ser \
	 .oth.trc.fio .oth.trc.but -expand 1 -fill both

#############################################################################
#					Target info panel										#
#############################################################################

set	tclk	""
set	chip	""
set baud	""

set	col_tg	purple4

#	Validates the crystal frequency entry
#	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

proc xtal_valid {} \
{
	global xtal tclk
	focus .

	if { [string is double $tclk] && $tclk >= 4.0 && $tclk <= 25.0 } {

		if { $xtal != $tclk } {

			set xtal $tclk
		}
	} \
	else {

		set tclk $xtal
	}

	return 1
}

#	The crystal frequency variable was written
#	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

proc xtal_wasset { var elem op } \
{
	global xtal tclk
	set tclk $xtal
	lpcprg crystal $xtal
}

#	Progress reporting call-back
#	~~~~~~~~~~~~~~~~~~~~~~~~~~~~

proc progress { unused msg } \
{
	.oth.tgt.prog configure -text $msg
	update
}

labelframe  .oth.tgt			-relief raised
label		.oth.tgt.name		-text "Target" \
								-anchor n -font { * 10 bold } \
								-fg $col_tg -bg gray

frame		.oth.tgt.xtal
label		.oth.tgt.xtal.lab	-text "Clock freq.\[MHz\]:"
entry		.oth.tgt.xtal.inp	-width 8 -textvariable tclk \
								-disabledforeground black
bind 		.oth.tgt.xtal.inp 	<Return> xtal_valid
pack 		.oth.tgt.xtal.lab	-side left -fill x
pack 		.oth.tgt.xtal.inp	-side right

frame		.oth.tgt.baud
label		.oth.tgt.baud.lab	-text "Current baudrate:"
label		.oth.tgt.baud.val	-textvariable baud -width 8 -anchor w
pack 		.oth.tgt.baud.lab	-side left -fill x
pack 		.oth.tgt.baud.val	-side right

frame		.oth.tgt.chip
label		.oth.tgt.chip.lab	-text "Chip type:"
label		.oth.tgt.chip.val	-textvariable chip -width 8 -anchor w
pack 		.oth.tgt.chip.lab	-side left -fill x
pack 		.oth.tgt.chip.val	-side right

frame		.oth.tgt.flsh
label		.oth.tgt.flsh.lab	-text "FLASH \[KB]\:"
label		.oth.tgt.flsh.val	-textvariable flsh -width 8 -anchor w
pack 		.oth.tgt.flsh.lab	-side left -fill x
pack 		.oth.tgt.flsh.val	-side right

label		.oth.tgt.prog		-text "" -fg $col_tg \
								-font TkFixedFont -anchor w

lpcprg progress progress ""
trace add variable xtal write xtal_wasset

pack .oth.tgt.name -fill both
pack .oth.tgt.xtal .oth.tgt.baud .oth.tgt.chip .oth.tgt.flsh .oth.tgt.prog \
	 -fill both -expand 1

#############################################################################
#					Serial port options										#
#############################################################################

set brl { 9600 19200 38400 57600 115200 }
set	col_sl	darkblue

#	Enable / disable procedures for serial parameter settings
#	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

proc seropt_disable {} \
{
	.ser.port.devf 		configure -state disabled
	.ser.ctrl.main.man	configure -state disabled
	.ser.ctrl.main.mod	configure -state disabled
	.ser.ctrl.sigs.rts	configure -state disabled
	.ser.ctrl.sigs.dtr	configure -state disabled
	.ser.ctrl.sinv.rts	configure -state disabled
	.ser.ctrl.sinv.dtr	configure -state disabled
	.ser.baud.init.sel	configure -state disabled
	.ser.baud.fast.sel	configure -state disabled
}

proc seropt_enable {} \
{
	.ser.port.devf 		configure -state normal
	.ser.ctrl.main.man	configure -state normal
	.ser.ctrl.main.mod	configure -state normal
	.ser.ctrl.sigs.rts	configure -state normal
	.ser.ctrl.sigs.dtr	configure -state normal
	.ser.ctrl.sinv.rts	configure -state normal
	.ser.ctrl.sinv.dtr	configure -state normal
	.ser.baud.init.sel	configure -state readonly
	.ser.baud.fast.sel	configure -state readonly
}

proc seropt_console_disable {} \
{
	.ser.baud.cons.sel	configure -state disabled
}

proc seropt_console_enable {} \
{
	.ser.baud.cons.sel	configure -state readonly
}

# Mode control setting changed
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~

proc mode_control { var elem op } \
{
	upvar 1 man man

	if { $man == 1 } {

		lpcprg manual manual

	} \
	else {

		upvar 1 res res
		upvar 1 rts rts
		upvar 1 isp isp
		lpcprg modem [ format "%s%s" 								\
							  [ expr $res ? "{-}" : "{+}" ] 		\
							  [ expr $rts ? "{rts}" : "{dtr}" ] ] 	\
					 [ format "%s%s" 								\
					 		  [ expr $isp ? "{-}" : "{+}" ] 		\
							  [ expr $rts ? "{dtr}" : "{rts}" ] ]
	}
}

#	Baud rate change related procedures
#	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

proc baud_init { var elem op } \
{
	global fbr ibr
	set fbr [ expr $ibr > $fbr ? $ibr : $fbr ]
}

proc baud_fast { var elem op } \
{
	global fbr ibr
	if { $ibr > $fbr } { set fbr $ibr }
}

#	Manual control of the signals
#	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

proc manual { ctrl } \
{
	set msg "Please "

	switch $ctrl {

		0	{ append msg "assert the reset" }
		1	{ append msg "negate the reset" }
		2	{ append msg "assert the ISP" }
		3	{ append msg "negate the ISP" }
	}

	append msg "\nsignal then click on OK!"
	tk_messageBox -type ok -icon warning -message $msg -parent .
}

labelframe	.ser 				-relief raised

label		.ser.name			-text "Serial port settings" \
								-anchor n -font { * 10 bold } \
								-fg $col_sl -bg gray

# Device selection

labelframe	.ser.port			-text "Device file" -labelanchor n -fg $col_sl
entry		.ser.port.devf		-width 30 -textvariable port
bind 		.ser.port.devf 		<Return> { focus . }
pack .ser.port.devf -fill x

# Baudrate selection (3 spinboxes)

labelframe	.ser.baud			-text "Baud rate" -labelanchor n -fg $col_sl
frame		.ser.baud.init
label		.ser.baud.init.lab	-text "Initial"
spinbox		.ser.baud.init.sel	-textvariable ibr -width 6 \
								-readonlybackground white \
								-state readonly -values $brl
pack .ser.baud.init.lab .ser.baud.init.sel -side left -fill x

frame		.ser.baud.fast
label		.ser.baud.fast.lab	-text "Maximum"
spinbox		.ser.baud.fast.sel	-textvariable fbr -width 6 \
								-readonlybackground white \
								-state readonly -values $brl
pack .ser.baud.fast.lab .ser.baud.fast.sel -side left -fill x

frame		.ser.baud.cons
label		.ser.baud.cons.lab	-text "Console"
spinbox		.ser.baud.cons.sel	-textvariable cbr -width 6 \
								-readonlybackground white \
								-state readonly -values $brl
pack .ser.baud.cons.lab .ser.baud.cons.sel -side left -fill x

pack .ser.baud.init .ser.baud.fast .ser.baud.cons -side left -fill y -expand 1

# A subframe for controls

frame		.ser.ctrl

# Manual or modem signal control

labelframe	.ser.ctrl.main		-text "Control mode" -labelanchor n \
								-fg $col_sl
radiobutton	.ser.ctrl.main.man	-anchor w -text "Manual" \
								-variable man -value 1
radiobutton	.ser.ctrl.main.mod	-anchor w -text "Modem" \
								-variable man -value 0
pack .ser.ctrl.main.man .ser.ctrl.main.mod -fill x

# Signal assignment

labelframe	.ser.ctrl.sigs		-text "Signal select" -labelanchor n \
								-fg $col_sl
radiobutton	.ser.ctrl.sigs.rts	-anchor w -text "RTS controls reset" \
								-variable rts -value 1
radiobutton	.ser.ctrl.sigs.dtr	-anchor w -text "RTS controls ISP" \
								-variable rts -value 0
pack .ser.ctrl.sigs.rts .ser.ctrl.sigs.dtr -fill x

# Signal inversion

labelframe	.ser.ctrl.sinv		-text "Polarity" -labelanchor n \
								-fg $col_sl
checkbutton	.ser.ctrl.sinv.rts	-anchor w -text "Invert reset" \
								-variable res
checkbutton	.ser.ctrl.sinv.dtr	-anchor w -text "Invert ISP" \
								-variable isp
pack .ser.ctrl.sinv.rts .ser.ctrl.sinv.dtr -fill x

# Put them together

pack .ser.ctrl.main .ser.ctrl.sigs .ser.ctrl.sinv -expand 1 -side left -fill y
pack .ser.name .ser.port .ser.baud .ser.ctrl -fill x

trace add variable man write mode_control
trace add variable res write mode_control
trace add variable rts write mode_control
trace add variable isp write mode_control

trace add variable fbr write baud_fast
trace add variable ibr write baud_init

#############################################################################
#					Serial console											#
#############################################################################

set	cons	0
set tick	""

#	Create the console window
#	~~~~~~~~~~~~~~~~~~~~~~~~~

proc	console_create {} \
{

	toplevel 	.cw
	wm title 	.cw "Serial console"
	text 		.cw.txt -width 80 -height 25 \
				-yscrollcommand { .cw.ycr set } \
				-xscrollcommand { .cw.xcr set } \
				-font TkFixedFont \
				-wrap none -state disabled

	scrollbar	.cw.ycr -command { .cw.txt yview } -orient vertical
	scrollbar	.cw.xcr -command { .cw.txt xview } -orient horizontal

	frame		.cw.opt
	checkbutton	.cw.opt.wrp	-text "Wrap text" \
							-variable wrap -command console_wrap
	checkbutton	.cw.opt.ech	-text "Echo" -variable echo

	frame		.cw.opt.eol
	label		.cw.opt.eol.lab	-text "Enter=>"
	menubutton	.cw.opt.eol.men	-textvariable crlf
	set eol [menu .cw.opt.eol.men.menu -tearoff 0]
	.cw.opt.eol.men configure -menu $eol
	$eol add radiobutton -value "CR" -label "CR" -variable crlf
	$eol add radiobutton -value "LF" -label "LF" -variable crlf
	$eol add radiobutton -value "CR/LF" -label "CR/LF" -variable crlf
	pack .cw.opt.eol.lab .cw.opt.eol.men -side left -fill both

	button		.cw.opt.res	-text "Reset target" -command { lpcprg reset }
	button		.cw.opt.clr	-text "Clear the window" -command console_clear
	button		.cw.opt.ret	-text "Close console" -command console_destroy
	pack		.cw.opt.wrp .cw.opt.ech .cw.opt.eol .cw.opt.res \
				.cw.opt.clr .cw.opt.ret -side left -expand 1 -fill x

	grid 		.cw.txt -row 0 -column 0 -sticky nsew
	grid 		.cw.ycr -row 0 -column 1 -sticky ns
	grid 		.cw.xcr -row 1 -column 0 -sticky ew
	grid 		.cw.opt -row 2 -column 0 -sticky ew

	bind		.cw.txt <Leave>			{ focus .cw }
	bind		.cw.txt <Enter>			{ focus .cw.txt }
	bind		.cw.txt <FocusOut>		{ focus .cw.txt }
	bind		.cw.txt <KeyPress>		{ console_input %A }
	bind		.cw.txt <ButtonPress-2>	{ console_middle }

	.cw.txt delete 1.0 end
	.cmd.act.conn configure -state disabled
	.cmd.act.load configure -state disabled
	.cmd.act.save configure -state disabled
	.cmd.act.moni configure -state disabled
	.cmd.act.burn configure -state disabled
	global cbr baud cons
	update
	set cons 1
	seropt_console_disable
	lpcprg baud $cbr
	set baud [lpcprg baud]
	console_poll
}

proc	console_destroy {} \
{
	global cons tick
	seropt_console_enable
	disconnect
	set cons 0
	after cancel $tick
	destroy .cw
	.cmd.act.conn configure -state normal
}

#	Keypress event handler
#	~~~~~~~~~~~~~~~~~~~~~~

proc	console_input { key } \
{
	global echo crlf

	if { $key != "" } {

		set con $key

		if { $key == "\r" } {

			set con "\n"

			switch $crlf {

				LF		{ set key "\n" }
				CR/LF	{ append key "\n" }
			}
		}

		lpcprg send $key
		if { $echo == 1 } { console_insert $con }
	}
}

#	Classic X middle-button event handler
#	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

proc	console_middle {} \
{
	global echo

	if { ! [ catch { selection get } sel ] } {
		if { $echo == 1 } { console_insert $sel }
		lpcprg send $sel
	}
}

#	Clears the console window
#	~~~~~~~~~~~~~~~~~~~~~~~~~

proc	console_clear {} \
{
	.cw.txt configure -state normal
	.cw.txt delete 1.0 end
	.cw.txt configure -state disabled
}

#	Inserts some text into the console window
#	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

proc	console_insert { str } \
{
	.cw.txt configure -state normal
	.cw.txt insert end $str
	.cw.txt yview moveto 1.0
	.cw.txt configure -state disabled
}

#	Console polling function
#	~~~~~~~~~~~~~~~~~~~~~~~~

proc	console_poll {} \
{
	global cons
	set rep { "\r" "" }

	if { $cons == 0 } return

	while { 1 } {

		set str [ lpcprg recv ]
		if { $str == "" } break;
		console_insert [ string map $rep $str ]
	}

	set tick [ after 50 console_poll ]
}

#	Console wrap option
#	~~~~~~~~~~~~~~~~~~~

proc console_wrap {} \
{
	global wrap
	.cw.txt configure -wrap [ expr $wrap ? "{char}" : "{none}" ]
}

#	Reset the target
#	~~~~~~~~~~~~~~~~
proc console_reset {} \
{
	lpcprg reset
}

#############################################################################
#					Top level windowm										#
#############################################################################

pack .oth.tgt .oth.trc -side left -expand 1 -fill both
pack .cmd.opt .cmd.act -side left -expand 1 -fill both
pack .cmd .oth .ser -expand 1 -fill both
load_defaults

