#
# QCad
# (c) Q Solutions 1998
#
#
#
#
# Common Routines
#

proc fileSave { name } {
	upvar #0 $name data

	procZoom $name None
	set bbox [$data(Canvas) bbox Obj]
	set class $data(Class)
	set all ""
	set type $data(Type)
	Log "Save $data(File)"
	foreach sheet $data(Sheets) {
		set canvas $data(Win).sh_$sheet
		set items [canvasGetList $data(Sheet) $canvas Obj]
		set all [concat $all $items]
	
	}
	dbPut $type $data(File) [list $name $class $bbox [array get data refcnt,*]] $all
}

proc fileLoad { name {item ""}} {

	upvar #0 $name data

 	set type $data(Type)
	if { $item == "" } {
		set item [dbBrowse $type]
	}
	if { $item == "" } { return }
	Log "load $item"
	set itemdata [dbGet $type $item]
	canvasClear $data(Canvas)
	procZoom $name None
	set nid [canvasAddList $name 0 [lindex $itemdata 1]]
	set head [lindex $itemdata 0]
	set adata [lindex $head 4]
	array set data $adata 
	set data(File) $item
	procZoom $name Fit
}


proc canvasMakeWin { name ref win} {

	global GBL
	upvar #0 $name data
	upvar #0 [string toupper $ref] def


	if { ! [winfo exist $win] } {
		toplevel $win
		wm title $win "QSCad $ref - $name"
		wm withdraw $win
	}
	if { [winfo exists $win.fr] } {
		wm deiconify $win
		raise $win
		focus $data(Canvas)
		return
	}
	set top [winfo toplevel $win]
	array set data [array get GBL]
	array set data [array get def]
	pack [frame $win.cmd -bd 0 -relief raised] -anc nw -side top -fill x
	pack [frame $win.cmd.f1 -width 20] -anc nw -side left
	pack [frame $win.cmd.f2 -bd 0 -relief solid] -anc nw -side left -fill x -expand 1
 	pack [frame $win.fr -bd 0 -relief solid] -anc nw -side top -fill both -expand 1

	global $name
	upvar #0 $name data
	set data(File) {}
	set data(Type) $ref
	set data(Class) $ref
	set data(Win)  $win
	set data(Win,ToolBar)  $win.cmd.f2
	set data(edit,PartRef) {}
	set canvas $win.sh_Sheet1
	set data(Canvas) $canvas
	set data(Sheets) Sheet1
	set data(x) 0
	set data(y) 0
	set data(rx) 0
	set data(ry) 0
	set data(cx) 0
	set data(cy) 0
	set data(canvas,W) 0
	set data(canvas,H) 0
	set data(Stack) {}
	set copts [array get data -*]
	set g [expr $data(Grid,Size) - 2]
	set g 5
	eval canvas $canvas $copts -scrollregion [list [list -$g -$g $data(Canvas,width) $data(Canvas,height)]] \
		-yscrollcommand {"$win.fr.vsc set"} \
		-xscrollcommand {"$win.fr.hsc set"} -bd 0 \
			-height $data(Window,height) \
			-width $data(Window,width) \
			$copts 

	Log "canvas opt $copts"
	pack [scrollbar $win.fr.vsc -command "canvasScroll $name yview" -orient vertical -takefocus 0] -side left -fill y -anc nw
	pack $canvas -in $win.fr -side top -anc nw  -fill both -expand 1
	pack [scrollbar $win.fr.hsc -command "canvasScroll $name xview"  -orient horizontal -takefocus 0] -side bottom -fill x -anc nw
	pack [label $win.message -textvariable $name\(Message) -relief sunken] -in $win.fr -anc nw -fill x
	$canvas xview moveto 0
	$canvas yview moveto 0
	update
	
	foreach ty $data(TypeList) {
		set id [$canvas create oval -1 -1 1 1 -fill {} -outline {} -tags "$ty NoPick System Fixed"]
		$canvas raise $id 
	}
	procDropAll $name
	set data(show,Grid)   1
	set data(show,Cursor) 1

	editMakeMenu $name
	eventBind $name
	bind $canvas <Configure> 	"canvasConfig $name"
	set data(Message) {}

	trace variable $name\(Message) w "messageTrace $name" 
	trace variable $name\(File) w "editWinTitle $name ;#"
	setVarTrace $name GridList canvasDrawGrid
	setVarTrace $name Grid,RelStep varAssign Grid,Step {$data(Grid,RelStep) * $data(RelScale)}
	setVarTrace $name Mode,Create modeSet Create
	modeSet $name Move
	#puts "Scroll $data(Canvas,width) x $data(Canvas,height)"
	update
	wm deiconify [winfo toplevel $win]
	raise $win
	focus $canvas
}


# makeMenu List format
#
#	All Level Type TypeData
#
# All - 1 if always print, 0 only if all flag = 1
# Level : + = make subframe, S = One current level , - = Pop subframe
# Type - L Label,B Button , E Entry, M MenuButton
# TypeData
#	MenuButton {MenuName}
#	L label	{ Text variable}
#	C checkButton {text variable onvalue offvalue)
#	R radioButton {text variable onvalue)
#	B button	{ text Command}
#	T Text {text}
#	V Variable
#	M menu {variable List}
#	E entry	{ width ArrayVariable}
#
# Macro Subs
#	%N - Name
#	%W - widget name
#	%B - bitmap
#	%V - textvariable
#	%I	 Image1 Image2
#	%P - Pack options
#	%
#
###
### NEED varAlt equiv for Menu Button Option
###

proc makeMenu { name win list } {

	global GBL
	global $name
	upvar #0 $name ref
	set num 1

	set fr $win	
	set fnt [list $ref(ButtonFont)]
	set wtype [winType $ref(Type)]
	foreach {flag level type data} $list {

		set widget ${fr}.w$num
		if { ($flag != "*") && ([string first $wtype $flag] == -1) } { continue }
		if { $level == "+" } { 
			set fr [frame $win.fr$num -bd 0 -relief solid] 
			pack $fr -side left -fill both -padx 5 -anc w -pady 2 
			set widget ${fr}.w$num
		}
		set opt {}
		set bind {}
		switch $type {
			T {
				set type label
				set opt "-text [list [lindex $data 0]] -anc w"
				set data [lrange $data 1 end]
			}
			L {
				set type label
				set opt " -width [lindex $data 0] -textvariable $name\([lindex $data 1]) -anchor w"
				set data [lrange $data 2 end]
			}
			B {
				set type button
				set func [lindex $data 1]
				set args [lrange $func 1 end]
				set func [lindex $func 0]
				set opt "-text [list [lindex $data 0]] -command [list [concat $func $name $args]]"
				set data [lrange $data 2 end]
			}
			R {
				set type radiobutton
				set opt "-text [list [lindex $data 0]] -variable $name\([lindex $data 1]) -value [list [lindex $data 2]] -indicatoron 0"
				set data [lrange $data 3 end]
			}
			C {
				set type checkbutton
				set opt "-text [list [lindex $data 0]] -variable $name\([lindex $data 1]) -offvalue [list [lindex $data 2]] -onvalue [list [lindex $data 3]] -indicatoron 0 -selectcolor {}"
				set data [lrange $data 4 end]
			}
			M {
				set v [lindex $data 0]
				set l [lindex $data 1]
				set l $ref($l)
				set data [lrange $data 2 end]
				set type menubutton
				set opt "-textvariable $name\($v) -indicatoron 1 -menu $widget.menu  -relief raised -bd 2 -highlightthickness 2 -anchor c"
				set menu "makeoptionMenu $widget.menu $name $v $l"
			}
			E {
				set type entry
				set opt "$opt -width [lindex $data 0] -textvariable $name\([lindex $data 1])"
				set data [lrange $data 2 end]
			}
		}

		set item "$type $widget $opt [makeArgs $name $data] -takefocus 0 -font $fnt"
		regsub "%N" $item "$name" item
		regsub "%W" $item "$widget" item
		#Log "$item"
		set it [eval $item]
		eval pack $it -side left -fill both -anc c -ipadx 2
		if { $type == "menubutton" } { eval "$menu" }
		incr num
		ToolTip $it $type $opt
	}

}

proc makeoptionMenu {m name v args } {

	menu $m -tearoff 0
	foreach i $args {
		$m add radiobutton -label $i -variable $name\($v)
	}
#	upvar #0 $name\($v) var
#	set var [lindex $args 0]
}

proc makeArgs {name arglist } {

	set l [llength $arglist]
	set i 0
	set res {}
	while { $i < $l } {
		set v [lindex $arglist $i]
		incr i
		set a [lindex $arglist $i]
		incr i
		set res "$res [makeParse $name $v $a]"
	}
	return [join $res]
}

proc makeParse { name v a } {

	switch $v {
		%B	{ set file [bitmapFind $a] ; if { $file != "" } {set file "-bitmap @$file" } ; return $file }
		%T	{  return "-text $a" }
		%V	{  return "-textvariable $name\($a)" }
		%I	{
				scan $a "%s %s" i1 i2
				return "-image [image create bitmap -file [bitmapFind $i1]] -selectimage [image create bitmap -file [bitmapFind $i2]]"
			 }
	}
	return "$v $a"
}

proc editMakeMenu {  name } {

	global GBL
	upvar #0 $name data

	set win $data(Win,ToolBar)
	set f1 [frame $win.f1 -bd 1 -relief sunken]
	set f2 [frame $win.f1.f2 -bd 1 -relief sunken]
	set f3 [frame $win.f1.f3 -bd 1 -relief sunken]
	set f4 [frame $win.f4 -bd 1 -relief sunken]
	set f5 [frame $win.f5 -bd 1 -relief sunken]
	pack $f1 -fill x -pady 2 -anc nw -side top
	pack $f2 -side left -anc w -fill x 
	pack $f3 -side right -anc e -fill x -padx 10
	pack $f4 -fill x -pady 2 -anc nw -side top
	pack $f5 -fill x -pady 2 -anc nw -side top

	set menu1 {
	* 	+ 	L {0 File}
	P 	+	B {Info {helpText {Part Editor}} %B Info}
	C	+	B {Info {helpText {Schematic Capture}} %B Info}
	B 	+	B {Info {helpText {PCB Layout}} %B Info}
	D 	+	B {Info {helpText Visuals/Decals} %B Info}
	X 	S	T {%N}						
	P 	S	B {pLoad partLoadPart %B Load}
	P 	S	B {pSave partSave %B Save}
	CB 	S	B {Load {fileLoad } %B Load}
	CB 	S	B {Save {fileSave } %B Save}
	D	S 	B {Load {partLoadDecal} %B Load}
	D 	S	B {Save {partSaveItem Current} %B Save}
	*	S	B {Print canvasPrint %B Print}
	P 	+	T {Gate}
	P 	S 	L {2 edit,CurrentGate}	
	P 	S 	L {0 edit,CurrentType}
	P 	S 	L {0 edit,CurrentName}							
	X 	+ 	T {Layer}
	X 	S 	M {edit,Layer LayerList}
	X 	S	T {Type}
	X 	S 	M {edit,Type  TypeList}
	X 	S 	T {Scale}
	X 	S 	M {Scale  ScaleList}
	X 	S 	T {{Step}}
	X 	S 	M {Grid,RelStep  StepList}
	}

	set cursor {
	* +	T {X}
	* S L {6 ux}	
	* +	T {Y}
	* S L {6 uy}	
	* +	T {RSc}
	* S L {3 RelScale}	
	}				

	set menu2 {
	CD 	S	C {Rb edit,RubberBand 1 0 %I {Rubber Norubber}  %B Move}	
	PBD S	C {F edit,Connected 1 0 %I {Connected Unconnected} }	
	* 	+	R {M Mode Move  %B Move}	
	* 	S	R {E Mode Edit  %B Edit}	
	BDF	S	R {C Mode Copy  %B Copy}		
	* 	S	R {D Mode Delete %B Delete}
	PDF	+	C {F edit,filled  0 1  %I {Unfilled Filled}}	
	PDF	S	R {Mo Mode,Create oval %B Circle}
	PDF	S	R {Mr Mode,Create rectangle %B Rectangle}
	PDF	S	R {Ml Mode,Create line %B Line}
	PDF	S	R {Mp Mode,Create polygon %B Polygon}
	* 	S	R {Mt Mode,Create text %B Text}
	CPDF 	S	R {Mc Mode,Create Connection %B Connection}
	P	+	B {nG {partNewItem Gate} }	
	P 	S	B {>> {partNextItem Gate 1} }
	P 	S	B {<< {partNextItem Gate -1} }
	PD 	+	C {dd edit,CurrentType  Visual Decal %I {Visual Decal} }	
	* 	S	B {vR {partAddItem} }
	P 	S	B {new {partNewItem Current} }
	X	 S B {Ldecal {partLoadDecal} }
	P 	S	B {v>> {partNextItem Current 1} }
	P 	S	B {<<v {partNextItem Current -1} }
	P 	S	B {vS {partSaveItem Current} }	
	F	+	B {-?- {schMenuAddItem 0 FLOW_CHOICE} %B Flow_Choice}
	F	+	B {-B- {schMenuAddItem 0 FLOW_BOX} %B Flow_Box}
	*	+	R {S Mode Stamp  %B Stamp}
	}

	set menu3 {
	* 	+ 	T {Layer}
	* 	S 	M {edit,Layer LayerList}
	PD 	S	T {Type}
	PD 	S 	M {edit,Type  TypeList}
	* 	S 	T {Scale}
	* 	S 	M {Scale  ScaleList}
	* 	S 	T {{Step}}
	* 	S 	M {Grid,RelStep  StepList}
	* 	+ 	T {Mode}
	* 	S 	L {15 Mode}	
	P 	+ 	R {Pin# Mode PinNum %B PinNumber}
	P 	S 	E {3 edit,pinnumber}	
	}

	makeMenu $name $f2 $menu1 
	makeMenu $name $f3 $cursor 
	makeMenu $name $f4 $menu2 
	makeMenu $name $f5 $menu3 
	raise $f1
	raise $f2
	raise $f3

}

proc editWinTitle {name } {
	upvar #0 $name data
	wm title $data(Win) "QSCad $data(Type) - $data(File)"
}

proc messageTrace { name v1 v2 cmd} {

	upvar  $v1\($v2) data

	if { $data != "" } {
		Log "$name.Mesage $data"
	}
}

proc setVarTrace {name var cmd args} {

	global $name
	trace variable $name\($var) w "varTrace $name $cmd [list $args]"
}

proc varTrace { name cmd carg v1 v2 tcmd} {

	eval $cmd $name $carg

}
proc varAssign { name v1 args} {
	upvar #0 $name data

	if {[catch {set data($v1) [eval expr $args]} err] } {
		set data(Message) "CalcError ($v1) : $err"
	}
}



proc varSet { name var val} {
	upvar #0 $name data

	set data($var) $val
	return ""
}

proc varToggle {name var} {
	upvar #0 $name data

	set data($var) [expr 1 - $data($var)]
	return ""
}

proc varAlt {name var} {
	upvar #0 $name data

	set data($var) [concat [lrange $data($var) 1 end] [lindex $data($var) 0]]
	return ""
}

proc winType { ty } {
	if {$ty == "Pe" }  { return P}
	if {$ty == "Sch" } { return C}
	if {$ty == "Pcb" } { return B}
	if {$ty == "De" }  { return D}
	if {$ty == "Flow"} { return F}
	return U
}

proc procZoom { name how} {
	upvar #0 $name data

	set x2 ""
	set m 0
	set oZoom $data(Zoom)
	switch $how {
		None {
			set data(Zoom) 0
		}
		In {
			incr data(Zoom) $data(Zoom,Step)
		}
		Out {
			incr data(Zoom) [expr - $data(Zoom,Step)]
		}
		Fit {
			scan [$data(Canvas) bbox Obj] "%f %f %f %f" x1 y1 x2 y2
			if { $x2 == "" } { bell ; return "" }
			#set x2 [expr $x2 / $data(RelScale)]
			#set y2 [expr $y2 / $data(RelScale)]
			set x2 [expr $x2 / $data(RelScale) - $x1 / $data(RelScale)]
			set y2 [expr $y2 / $data(RelScale) - $y1 / $data(RelScale)]
			set w [expr $data(canvas,W) ]
			set h [expr $data(canvas,H) ]
			#set w [expr $data(canvas,W) - [$data(Canvas) canvasx 0]]
			#set h [expr $data(canvas,H) - [$data(Canvas) canvasy 0]]
			set my [expr $h / $y2]
			set mx [expr $w / $x2]
			Log "bbox $x1,$y1,$x2,$y2 of w $w h $h - mx $mx  my $my"
			if { $my > $mx } {
				set mult $mx 
			} else {
				set mult $my
			}
			if { 0 && $data(Zoom,Limit) } {			
				if { $mult <= 1.0 } {
					set m [expr ceil( $data(Scale,Step) / $mult) -1]
					set mult [expr 1.0 / ($data(RelScale) * $m) ]
					incr data(Zoom) [expr -int($m)]
				} else {
					set m [expr floor( ($mult) / $data(RelScale) ) -1]
					incr data(Zoom) [expr int($m)]
					if { $m == 0 } {
						set mult 0
					} else {
						set mult [expr ($data(RelScale) * $m)]
					}
				}
			}
			set data(Zoom) [zoomIndex [mathRational $mult]]
			if { $mult > 1 } {
				set data(Zoom) [expr -$data(Zoom)]
			}
			Log "Fit $m = $mult Mr = [mathRational $mult] zoom $data(Zoom)"
		}
	}
	set factor [zoomFactor $name]
	if { $factor == "" } {
		set data(Message) "At End of zoom range $data(Zoom)"
		bell
		set data(Zoom) $oZoom
		return ""
	}
	set rev [expr 1.0 / $data(RelScale)]
	set diff [expr (1.0 / $data(RelScale)) * $factor]
	if { $diff == 0 } { Log "Diff $0" ; bell ; return }
 	#if { $diff == 1 } { Log "Diff 1"  ; return }
	if { $data(Zoom,Correct) } {
		$data(Canvas) scale Obj 0 0 $rev $rev
		$data(Canvas) scale Obj 0 0 $factor $factor
		set data(RelScale)  [expr $diff * $data(RelScale)]
		set data(Grid,Step) [expr $diff * $data(Grid,Step)]
	} else {
		$data(Canvas) scale Obj 0 0 $diff $diff
		set data(RelScale)  [expr $diff * $data(RelScale)]
		set data(Grid,Step) [expr $diff * $data(Grid,Step)]
	}
	canvasDrawGrid $name
	scan  [$data(Canvas) bbox Obj] "%f %f %f %f" x1 y1 x2 y2
	if { $x2 == "" } { bell ; return "" }
	#set x2 [expr $x2 * 1.5]
	#set y2 [expr $y2 * 1.5]
	#set x1 [expr - $data(Grid,Size) * 2]
	#set y1 $x1
	$data(Canvas) configure -scrollregion [geomClip $data(Grid,Size) $x1 $y1 $x2 $y2]
	if {$how == "Fit" } {
		$data(Canvas) yview moveto 0.0
		$data(Canvas) xview moveto 0.0
	}
	Log "Scale $how - Zoom $data(Zoom) ds $diff fact $factor Scale now $data(RelScale)"
}

proc zoomFactor { name } {
	upvar #0 $name data
	global fTable 

	set zoom $data(Zoom)
	if { $zoom == 0 } {
		return 1.0
	}
	set ratio [lindex $fTable [expr abs($zoom) -1]]
	if { $ratio == "" } { return ""}
	if { $zoom < 0 } {
		return [expr 1.0 / $ratio ]
	}
	return [expr $ratio ]
}

proc zoomIndex {ratio} {
	global fTable

	set i [lsearch -exact $fTable $ratio]
	if { $i == -1 } { set i 0}
	return [expr $i  + 1]
}

#
#
# Irrational numbers represent a clear and present danger to 
# the stability of scaling , 
#	I HEARBY AUTHORIZE OPERATION RECIPROSITY
#
# Actually repeated scaling by irrational fractions results in less than 1 pixel
# error so rounding to point values on scaling would eliminate any accumulated
# error. this could be done on save and print.
#
#

global fTable

set fTable { 
		0.8 0.64 0.625 0.5 0.4 0.32 0.3125 0.25 0.2 
		0.16 0.125 0.1 0.08 0.0625 0.05
		0.04 0.025 0.02 0.0125 
	}

proc mathRational {num} {
	global fTable


	if {$num > 1 } {
		set match [expr 1.0 / $num]
	} else {
		set match $num
	}

	set cnum 0
	set min 1e30
	foreach new $fTable {
		if { ($num < 1) && ($new > $match)} { continue}
		if { ($num > 1) && ($new < $match)} { continue}
		set err [expr abs( $new - $match)]
		if { $err < $min } {
			set cnum $new
			set min $err
		}
	}
	if { $cnum == 0 } { return ""}
	if { $num > 1 } {
		return [expr 1.0 / $cnum]
	}
	return $cnum
}











