
# QCad
# (c) Q Solutions 1998
#
#
#
#
# Configurator
#
#

# Config Array
#  Title Array List


proc Configure {} {

	global GBL PE SCH PCB FLOW
	global uGBL uPE uSCH uPCB uFLOW
	set w .cfgWin

	if { [winfo exist $w] } {
		wm deiconify $w
		raise $w
		focus $w
		return
	}
	array set uGBL [array get GBL]
	array set uPE [array get PE]
	array set uSCH [array get SCH]
	array set uPCB [array get PCB]
	array set uFLOW [array get FLOW]

	global TEMP _v 

	set of [focus]

	set _cfg {
		Grid	GBL ^Grid,
		Page	GBL ^Page,
		Sch-Window	SCH ^Canvas,|^-,
		Part-Window	PE ^Canvas,|^-
		PCB-Window	PCB ^Canvas,
		Flow-Window	FLOW ^Canvas,
		Fill-Colour	GBL	,fill$
		Outline-Colour GBL ,outline$
		Widths	GBL ,width$
		Fonts	GBL ,font$
		Options GBL ^-
		TieDots GBL TieDot,
		Bindings	GBL bind,
	}
	
	destroy $w
	toplevel $w
	wm title $w "Configuration Options"
	pack [frame $w.top] -side top
	pack [frame $w.data] -side top
	pack [frame $w.bottom -bd 1 -relief solid] -side bottom
	#pack [frame $w.right  -bd 1 -relief solid] -side right -anc n -fill y -expand 1
	#pack [frame $w.left  -bd 1 -relief solid] -side left -anc n -fill y

	foreach {n a e} $_cfg {
		lappend name $n
		set _v($n,Array) $a
		set _v($n,Expr) $e
	}
	set m [eval tk_optionMenu $w.top.x _v(Array) $name]
	pack $w.top.x  -side top -anc nw -fill x

	pack [button $w.bottom.ca -text "Save" -command "ConfigSave ; set _v(Done) {}"] -fill x -side left
	pack [button $w.bottom.re -text "Restore Defaults" -command "initSystemData ; set _v(Done) {}"] -fill x -side left
	pack [button $w.bottom.ok -text "Done" -command "set _v(Done) {}"] -fill x -side right


	ConfigSet $w.data
	trace variable _v(Array) w "ConfigSet $w.data ;#"
	vwait _v(Done)
	trace vdelete _v(Array) w "ConfigSet $w.data ;#"
	destroy $w
	focus -force $of
	unset uGBL
	unset uPE
	unset uSCH
	unset uPCB
	unset uFLOW

	return ""
}

proc ConfigSet {w} {

	global _v
	global GBL PE SCH PCB FLOW

	eval destroy [winfo children $w]

	set nf 1
	foreach n [lsort [array names $_v($_v(Array),Array)]] {
		if { ! [regexp  $_v($_v(Array),Expr) $n] } {continue}
		regsub  $_v($_v(Array),Expr) $n "" name
		pack [set f [frame $w.f$nf -bd 1 -relief solid]] -anc nw -fill x -pady 2
		pack [label $f.l1 -text $name -width 15 -anc e] -side left -padx 2 -anc w
		pack [entry $f.e1 -textvariable $_v($_v(Array),Array)\($n) -width 20] -side left -anc w -padx 2
		switch -glob -- $n {
			*,font {
				pack [button $f.fnt -text "..." -command "ConfigFont $_v($_v(Array),Array) $n [winfo toplevel $w]"] -side left -anc ne
			}
			*,fill -
			*,outline -
			*,Colour {
				pack [button $f.fnt -text "..." -command "ConfigColour $_v($_v(Array),Array) $n"] -side left -anc ne
			}


		}
		incr nf

	}
}

proc ConfigSave {} {

	global GBL PE SCH PCB FLOW
	global uGBL uPE uSCH uPCB uFLOW

	set file [open [fileFind $GBL(LibraryPath) .qscadrc {}] w]

	foreach a {GBL PE SCH PCB FLOW} {
		upvar #0 $a data
		upvar #0 u$a save
		foreach e [array names data] {
			if { $data($e) != $save($e) } {
				puts $file "$a $e [list $data($e)]"
			}
		}
	}
	close $file
}

proc ConfigLoad {} {

	global GBL PE SCH PCB FLOW
	set file [fileFind $GBL(LibraryPath) .qscadrc {}] 
	if { ! [file exists $file] } {return}

	set file [open $file r]
	set data [read $file]
	close $file
	foreach {a e d} $data {
		uplevel #0 "set $a\($e) [list $d]"
	}
}

proc ConfigFont {array n par} {

	upvar #0 $array\($n) v
	global _FONT
	set w .wnFont

	destroy $w
	toplevel $w
	catch {unset _FONT}
	wm title $w "Select Font"
	wm geometry $w +[winfo pointerx $par]+[winfo pointery $par]
	wm protocol $w WM_DELETE "set ::_FONT(Done) 0"
	if { $v != "" } {
		foreach {_FONT(fn) _FONT(fs) _FONT(ft)} $v {}
	}
	pack [frame $w.f -bd 3 -relief flat] -anc nw -fill x
	pack [frame $w.t -bd 1 -relief sunken] -padx 10 -pady 10 -anc nw -fill x
	pack [frame $w.b -bd 1 -relief raised] -anc nw -fill x
	pack [button $w.b.ok -text Ok -command "set ::_FONT(Done) 1"] -side left -anc w
	pack [button $w.b.can -text Cancel -command "set ::_FONT(Done) 0"] -side left -anc e
	pack [label $w.t.l -text {abcdefgABCDEFG /&*%$#@!}]
	set m [eval tk_optionMenu $w.f.m1 ::_FONT(fn) [lsort [font families]]]
	pack $w.f.m1 -side left -padx 10 -anc w
	set m2 [tk_optionMenu $w.f.m2 ::_FONT(fs) 8 10 12 14 16 18 20 22 24 28 30 36 48 72 100]
	pack $w.f.m2 -side left -padx 10 -anc c
	set m3 [tk_optionMenu $w.f.m3 ::_FONT(ft) normal bold italic]
	pack $w.f.m3 -side left -padx 10 -anc e
	FontSet $w.t.l
	set _FONT(Done) 0
	trace variable ::_FONT w "FontSet $w.t.l ;#"
	vwait _FONT(Done)
	trace vdelete ::_FONT w "FontSet $w.t.l ;#"
	destroy $w
	if {! [info exists _FONT(Done)] } {return }
	if {$_FONT(Done) } {
		set v [list $_FONT(fn) $_FONT(fs) $_FONT(ft)]
	}
	unset _FONT
	return $v
}

proc FontSet {w} {
	global _FONT

	catch {$w configure -font [list $_FONT(fn) $_FONT(fs) $_FONT(ft)]}
}

proc ConfigColour {array n} {

	upvar #0 $array\($n) v
	if {$v != "" } {
		set x [tk_chooseColor -initialcolor $v]
	} else {
		set x [tk_chooseColor]
	}
	if { $x != "" } {set v $x}
}

