###################################################################
# This file is part of tk545, a control program for the
# Japan Radio Corp. NRD-545 receiver.
# 
#    Copyright (C) 2001, 2002, Bob Parnass
# 
# tk545 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.
# 
# tk545 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 tk545; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
# 02111-1307  USA
###################################################################

###################################################################
# Dialog to open a file for reading.
#
# Note:
#	I placed a wrapper around the built in Tk routine
#	because the MacOS X version
#	does not handle the initialdir parameter properly.
###################################################################
proc Mytk_getOpenFile {parent initialdir title types} \
{
	global tcl_platform

	if { [regexp "Darwin" $tcl_platform(os) ] } \
		{
		# For Mac OS X.
		set initialdir ":"
		}

	set code [tk_getOpenFile -parent $parent \
		-initialdir $initialdir \
		-title $title -filetypes $types]

	return $code
}



###################################################################
# Dialog to open a file for writing.
#
# Note:
#	I placed a wrapper around the built in Tk routine
#	because the MacOS X version
#	does not handle the initialdir parameter properly.
###################################################################
proc Mytk_getSaveFile {f initialdir defaultextension title types} \
{
	global tcl_platform

	if { [regexp "Darwin" $tcl_platform(os) ] } \
		{
		# For Mac OS X.
		set initialdir ":"
		}

	set code [tk_getSaveFile -parent $f \
		-initialdir $initialdir \
		-defaultextension $defaultextension \
		-title $title \
		-filetypes $types]

	return $code
}


##########################################################
#
# 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
}


##########################################################
#
# Channel Listbox with optional scrollbars.
#
#
# This is modified version of Example 29-1.
# From "Practical Programming in Tcl and Tk,"
# second edition, by Brent B. Welch.
#
# This proc prevents huge listbox windows on MacOS X.
# A bug in the version of Tk for MacOS X prevents the user
# from being able to resize windows larger than the screen.
##########################################################
proc List_channels { parent values height } \
{
	global tcl_platform

	if { [regexp "Darwin" $tcl_platform(os) ] \
		&& (($height == 0) || ($height > 30)) }\
		{
		# Limit the height for Mac OS X.
		set height 30
		}

	frame $parent
	set choices [Scrolled_Listbox $parent.choices \
		-width 0 -height $height ]

	# Insert all the choices
	foreach x $values \
		{
		$choices insert end $x
		}

	pack $parent.choices -side left
	return "$choices"
}


##########################################################
#
# Return the item selected in the channel selector listbox
#
##########################################################

proc ListSelected { w } \
{
	set i [ $w curselection ]
	set item [ $w get $i ]
	return "$item"
}


##########################################################
#
# Return the channel selected from the channel selector listbox
#
##########################################################

proc ChSelected { w } \
{
	set line [ ListSelected $w ]
	set line [string trimleft $line " "]
	regsub " .*" $line "" ch
	return "$ch"
}


##########################################################
# Insert commas in a number
##########################################################

proc InsertCommas {num {sep ,}} {
    while {[regsub {^([-+]?\d+)(\d\d\d)} $num "\\1$sep\\2" num]} {}
    return $num
}


##########################################################
# Active delay
##########################################################

proc waiter { millisec } \
{
	global Waiter

	set Waiter 0
	after $millisec {incr Waiter}
	tkwait variable Waiter
	return
}

###################################################################
# Display tcl version information.
###################################################################
proc HelpTclInfo { } \
{
	global tcl_patchLevel
	global tcl_platform
	global tcl_version

	set version   $tcl_version
	set patch      $tcl_patchLevel
	
	set byteorder $tcl_platform(byteOrder)
	set machine   $tcl_platform(machine)
	set osVersion $tcl_platform(osVersion)
	set platform  $tcl_platform(platform)
	set os        $tcl_platform(os)
	

	set msg ""
	append msg "Tcl version: $version\n"
	append msg "Patch level: $patch\n"
	append msg "Byte order: $byteorder\n"
	append msg "Machine: $machine\n"
	append msg "OS Version: $osVersion\n"
	append msg "Platform: $platform\n"
	append msg "OS: $os\n"

	return $msg
}


###################################################################
# Return the basename of the given pathname.
###################################################################
proc Basename { p } \
{
	regsub -all {.*/} $p "" b
	return $b
}

###################################################################
# Return the directory of the given absolute pathname.
#
# Afterthought: I guess we could have used the 'find dirname'
#	tcl command instead.
###################################################################

proc Dirname { p } \
{
	set lst [ split $p {/} ]
	set n [ llength $lst ]
	incr n -2

	set lst [lrange $lst 0 $n]
	set lst [ join $lst {/} ]

	if { $lst == "" } \
		{
		set lst {.}
		}

	return $lst
}


###################################################################
# Pad 'x' on the left with the proper number of 0s
# until it is 'n' characters long.
###################################################################
proc PadLeft0 { n x } \
{
	set s $x
	set l [ string length $x ]

	set nz [ expr $n - $l ]

	for {set i 0} {$i < $nz} {incr i} \
		{
		# set s [ append s "0" $x ]
		set s [ format "0%s" $s ]
		}

	# puts "n= $n l= $l x= $x s= $s\n"

	return $s
}


###################################################################
# Read global parameters from the configuration file.
#
# Strip off comments.
# Strip out blank and empty lines.
#
# Remaining lines should be of the form:
#
# Fieldname=value
###################################################################

proc ReadSetup { } \
{
	global env
	global GlobalParam
	global Mode
	global Rcfile
	global RootDir
	global tcl_platform


	if [ catch { open $Rcfile "r"} fid] \
		{
		# error
		Tattle "Cannot open $Rcfile for reading."
		return
		} 


	# For each line in the file.

	while { [gets $fid rline] >= 0 } \
		{
		set line $rline

		# Discard comment line.
		# Comment line starts with (optional) white space
		# followed by a pound sign.

		if { [regexp {^[ \t]*#.*} $line] } \
			{
			continue
			}

		# Skip blank line.
		if { [regexp {^ *$} $line] } \
			{
			continue
			}

		set line [string trimleft $line " "]

		# Valid parameter line must be of the form:
		# Fieldname=value

		set plist [ split $line "=" ]
		set n [llength $plist]

		set msg [format "Error in setup file %s,\n" $Rcfile]
		set msg [append msg [format "in this line:\n%s" $rline]]

		if {$n != 2} \
			{
			tk_dialog .error "tk545" \
				$msg error 0 OK

			exit 1
			}
		set field [ lindex $plist 0 ]
		set value [ lindex $plist 1 ]
		set GlobalParam($field) $value
		}


	close $fid
	return
}


###################################################################
# Save global parameters in the configuration file.
###################################################################

proc SaveSetup { } \
{
	global argv0
	global GlobalParam
	global Rcfile
	global Version

	set pgm [Basename $argv0]

	if [ catch { open $Rcfile "w"} fid] \
		{
		# error
		tk_dialog .error $pgm \
			"Cannot save setup in file $Rcfile" error 0 OK

		return
		} 

	set rcf [Basename $Rcfile]
	puts $fid "# $rcf configuration file, Version $Version"

	set a [array names GlobalParam]
	set a [ lsort -dictionary $a ]

	foreach x $a \
		{
		puts $fid "$x=$GlobalParam($x)"
		}

	close $fid
	return
}

