#
# QCad
# (c) Q Solutions 1998
#
#
#
#
# Part editor functions
#
#

proc visualEdit { {decal ""} {type Visual}} {
	decalEdit $decal Visual
}

proc decalEdit { {decal ""} {type Decal}} {

	global GBL PE
	set name Decal_$decal
	upvar #0 $name part
	global $name
	set win .spe_$name

	if { ! [winfo exists $win] || ! [info exists part(Init)] } {
		catch {unset part}
		catch {destroy $win}
		array set part [array get PE]
		canvasMakeWin $name De $win
		set part(File) $decal
		set part(Part) $name
		set part(Init) 1
		array set part {
			Type			De
			Part,Gates	 	{{}}
			Part,GatePins	{{}}
			Part,Decals		{}
			edit,CurrentItem 1
			edit,CurrentGate 1
			edit,itemHead {None None None {} None}
		}
		set part(edit,CurrentType) $type
		set part(Part,Gates) $decal
		set part(Part,Decals) $decal
		partDrawCurrent $name
		set part(Init) 1
		procZoom $name Fit
	} else {
		wm deiconify [winfo toplevel $part(Win)]
		raise  [winfo toplevel $part(Win)]
		focus $part(Canvas)
		return
	}
}

proc partEdit { partno {type Part} {all 1}} {

	set name Part_$partno
	set win .spe_$name
	upvar #0 $name part
	global $name 

	set ty Pe
	if { ! $all } {set ty De}
	if { ! [winfo exists $win] || ! [info exists part(Init)] } {
		catch {unset part}
		catch {destroy $win}
		canvasMakeWin $name $ty $win
		partLoadPart $name $partno
		#set part(File) $partno
		#set part(Part) $partno
		#set partdata [dbGetPart $partno]
		#array set part $partdata
		#set part(Init) 1
	} else {
		wm deiconify [winfo toplevel $part(Win)]
		raise  [winfo toplevel $part(Win)]
		focus $part(Canvas)
		return
	}
	#set part(edit,CurrentGate) [llength $part(Part,Gates)]
	#set part(edit,CurrentItem) 1
	#set part(edit,CurrentType) Visual
	set part(edit,pinnumber) 1

	#partDrawCurrent $name

	set top [winfo toplevel $win]
	update
	scan [winfo geometry $top] {%dx%d+%d,%d} ww wh wl wr 
	wm minsize $top $ww $wh 
}

#
# FIX ME: Should be partLoad as partLoad is not required in its own right
#
proc partLoadPart {name {partno ""}} {

	global GBL
	upvar #0 $name part

	if {$partno == "" } {
		set partno [dbBrowse Part]
	}
	if { $partno == "" } { bell ; return }
	set part(File) $partno
	set part(Part) $partno
	set part(Part,Prefix) X
	set partdata [dbGetPart $partno]
	array set part $partdata
	set part(Init) 1

	set part(edit,CurrentGate) [llength $part(Part,Gates)]
	set part(edit,CurrentItem) 1
	set part(edit,CurrentType) Visual

	partDrawCurrent $name
}

proc partSave { name args } {
	upvar #0 $name part

	incr part(Part,Revision)
	dbPutPart $part(Part) [array get part Part*]
}

proc partLoadDecal { name {item ""}} {
	upvar #0 $name part

	set ty $part(edit,CurrentType)
	if { $item == "" } {
		set item [dbBrowse $ty]
	}
	if { $item == "" } { return }
	set ty $part(edit,CurrentType)
	if { $ty == "Visual" } {
		set part(Part,Gates) $item
	} else {
		set part(Part,Decals) $item
	}
	set part(File) $item
	$part(Canvas) delete Obj
	procZoom $name None
	partDrawCurrent $name
	procZoom $name Fit
}


####
#### FIX ME : MERGE NEW and NEXT with new/next Option
####

proc partNewItem { name type } {
	upvar #0 $name part

	if { $type == "Current" } { set type $part(edit,CurrentType)  }

	switch $type {
		Gate {
			lappend part(Part,Gates) {}
			lappend part(Part,GatePins) {}
			lappend part(Part,GateNames) {}
			set part(edit,CurrentGate) [llength $part(Part,Gates)]
			set part(edit,CurrentItem) 1
			set part(edit,CurrentType) Visual
			partDrawCurrent $name
			set part(Message) "New Gate has no Visuals"
		}
		Visual -
		Decal {
			set gate [expr $part(edit,CurrentGate) -1]
			set gl [lindex $part(Part,Gates) $gate]
		 	set ty $part(edit,CurrentType)
			if { [llength $part(Part,Gates)] == 0  && $ty == "Visual"} {
				set part(Message) "Part has No gates"
				bell
				return
			}
			set item [dbBrowse $ty]
			if { $item == "" } { bell ;return }
			if { $ty == "Visual" } {
				lappend gl $item
				set part(edit,CurrentItem) [llength $gl]
				set part(Part,Gates) [lreplace $part(Part,Gates) $gate $gate $gl]
			} else {
				lappend part(Part,Decals) $item
				set part(edit,CurrentItem) [llength $part(Part,Decals)]
			}
			partDrawCurrent $name
		}
	}
}

proc partNextItem { name type dir } {
	upvar #0 $name part

	if { $type == "Current" } { set type $part(edit,CurrentType)  }
	switch $type {
		Gate {
			set gate [expr $part(edit,CurrentGate) + $dir]
			if { $gate < 1 } { set gate [llength $part(Part,Gates)] }
			if { $gate >  [llength $part(Part,Gates)]} { set gate 1 }
			set part(edit,CurrentGate) $gate
			set part(edit,CurrentItem) 1
			set part(edit,CurrentType) Visual
			partDrawCurrent $name
		}
		Visual -
		Decal {
			set item [expr $part(edit,CurrentItem) + $dir]
			set gate [expr $part(edit,CurrentGate) -1]
			set gl [lindex $part(Part,Gates) $gate]
		 	set ty $part(edit,CurrentType)
			if { $ty == "Visual" } {
				set il [lindex $part(Part,Gates) $gate]
			} else {
				set il $part(Part,Decals)
			}
			if { $item > [llength $il] } { set item 1 }
			if { $item < 1 } { set item [llength $il]  }
			set part(edit,CurrentItem) $item
			partDrawCurrent $name
		}
	}
}

proc partDrawCurrent { name } {
	upvar #0 $name part

	canvasClear $part(Canvas)
	set gate [expr $part(edit,CurrentGate) -1]
	set gl [lindex $part(Part,Gates) $gate]
	set gpins [lindex $part(Part,GatePins) $gate]
 	set ty $part(edit,CurrentType)
	set cnt [expr $part(edit,CurrentItem) - 1]
	if { [llength $gl] == 0  && $part(Type) == "Pe"} {
		set part(Message) "Part has No gates"
		bell
		return
	}
	if { $ty == "Visual" } {
		set item [lindex $gl $cnt]
		if { $item == "" } {
			set part(Message) "No Visuals for this gate"
			return
		}
	} else {
		if { $cnt > [llength $part(Part,Decals)] } {
			set part(Message) "No Decals for this part"
			return
		}
		set item [lindex $part(Part,Decals) $cnt]
	}
	set part(edit,CurrentName) $item
	set itemdata [dbGet$ty $item]
	set part(edit,itemHead) {None None None {} None}
	if { [llength $itemdata] == 0 } {
		set part(Message) "Gate $part(edit,CurrentGate) , Mode $part(edit,CurrentType) ,  $part(edit,CurrentItem) \[$item\] (Not Found)"	
		bell
		canvasClear $part(Canvas)
		return
	}

	set part(edit,itemHead) [lindex $itemdata 0]
	$part(Canvas) delete Obj
	set id ID(1)
	if { $part(Type) == "De" } { set id 0}
	## FIX ME
	## Load parts in disparate mode to allow pin numbers to be tagged
	##
	## set id 0 Breaks PinRenumber code for Part Edit and Schematic
	##
	## Fix is make part renumber work for part editor with disparate ID's
	##
	canvasAddList $name $id [lindex $itemdata 1]
	if { $part(Type) == "Pe" } {
		scan [$part(Canvas) bbox ID(1)] "%f %f" x1 y1
		$part(Canvas) move ID(1) [geomClip $part(Grid,Step) [expr 100 - $x1]] [geomClip $part(Grid,Step) [expr 100 - $y1]]
		if { $ty == "Visual" } {
			partRenumber $name ID(1) "" "" $gpins
		}
		set part(Message) "Gate $part(edit,CurrentGate) , Mode $part(edit,CurrentType) ,  $part(edit,CurrentItem): \[$item\]"	
	}
}


proc partSaveItem { name args } {
	upvar #0 $name part

	set gate [expr $part(edit,CurrentGate) -1]
	set gl [lindex $part(Part,Gates) $gate]
 	set ty $part(edit,CurrentType)
	set cnt [expr $part(edit,CurrentItem) - 1]
	if { $ty == "Visual" } {
		set item [lindex $gl $cnt]
	} else {
		set item [lindex $part(Part,Decals) $cnt]
	}
	set class [lindex $part(edit,itemHead) 2]
	if { $class == "" } {set class "Unknown" }
	set bbox [$part(Canvas) bbox Obj]
	dbPut$ty $item [list $item $class $bbox {}] [canvasGetList canvas $part(Canvas) Obj]

}

proc partAddItem { name {item ""} } {

	upvar #0 $name part

 	set ty $part(edit,CurrentType)
	if { $item == "" } {
		set item [dbBrowseExist $ty]
	}
	if { $item == "" } { return }
	set itemdata [dbGet$ty $item]
	set nid [canvasAddList $name 1 [lindex $itemdata 1]]
	set sc $part(Scale)
	if { $sc != 1 } {
		set sc [expr (6 - $sc)  / 5.0]
		$part(Canvas) scale $nid 0 0 $sc $sc
	}
	$part(Canvas) scale $nid 0 0 $part(RelScale) $part(RelScale)
	return $nid
}

proc partLoad { name args } {

	upvar #0 $name part

	set item [dbBrowse Part]
	if { $item == "" } { return }
	partEdit $item 1
}


proc partRenumber {name id refdes partno pinlist} {
	upvar #0 $name data

	set c $data(Canvas)
	set reftag ""
	set taglist [tagSearchAll $c "withtag $id"]
	Log "PinList : $pinlist"
	set idnum [idNum $id]
	set havepins [expr [llength $pinlist] != 0]
	foreach tag $taglist {
		set tags [$c itemcget $tag -tags]
		set type [listGet Type $tags]
		set item [$c type $tag]
		switch $type {
			RefDes {
				set reftag $tag
				if { $refdes != "" && $item == "text"} {
					$c itemconfig $tag -text $refdes
				}
			}
			PartRef	{
				if { $refdes != "" && $item == "text"} {
					$c itemconfig $tag -text $partno
				}
			}
			Anchor  {
				set pin [listGet Pin $tags]
				if { $pin != "" } {
					if { $havepins } {
						set rpin "[lindex [lindex $pinlist [expr $pin -1]] 0]"
					} else {set rpin "$pin" }
					tagPut $c $tag PPin $rpin
					tagPut $c $tag Anchor $idnum:$pin
				}
			}
			Pin	{
				set pin [listGet PinNum $tags]
				if { $pin != "" && $item == "text"} {
					$c itemconfig $tag -text [lindex [lindex $pinlist [expr $pin -1]] 0]
				}
				set pin [listGet PinName $tags]
				if { $pin != "" && $item == "text"} {
					$c itemconfig $tag -text [lindex [lindex $pinlist [expr $pin -1]] 1]
				}
			}
		}
	}
	if { ($reftag == "") && ($data(Type) == "Sch") } {
		### Create refdes
		Log "Part $id has no refdes, created one"
		scan [$c bbox $id] "%f %f %f %f" x1 y1 x2 y2
		set x [expr $x1 + ($x2 - $x1) / 2]
		set y [expr $y1 - 5]
		set tag [canvasCreate $name text "$x $y" RefDes $id "" "-text \{$refdes\}"]
	}
}

proc pinRenumber { name mode } {
	upvar #0 $name data
	
	set mark [$data(Canvas) find withtag Mark]
	set x $data(cx)
	set y $data(cy)

	switch $mode { 
		Reset {
			set data(edit,pinnumber) 1
			}
		Stamp {
			set tag [tagFind $data(Canvas) $data(cx) $data(cy) 0 0 Type(Anchor)]
			if { $tag == ""} { 
				bell
				return ""
			}
			set pin [tagGet $data(Canvas) $tag Pin]
			if { $pin == "" } { return }
			set id [tagTag $data(Canvas) $tag ID]
			set npin $data(edit,pinnumber)
			foreach tag [tagSearchAll $data(Canvas) "withtag PinNum($pin)"] {
				if {  [$data(Canvas) type $tag] == "text"  } {
						$data(Canvas) itemconfig $tag -text $npin
				}
			}
			foreach tag [tagSearchAll $data(Canvas) "withtag PinName($pin)"] {
				if {  [$data(Canvas) type $tag] == "text"  } {
						$data(Canvas) itemconfig $tag -text #$npin
				}
			}
			partSetPin $name $pin $npin #$npin
			incr data(edit,pinnumber)
		}
	}
	return ""
}

#
# Change a gate pin definition
#
# Enter Lisp mode
# (There must be a better structure for Gate and GatePin items)
#
proc partSetPin {name pinid num pname} {
	upvar #0 $name part

	incr pinid -1
	set gate [expr $part(edit,CurrentGate) -1]
	set gpins [lindex $part(Part,GatePins) $gate]

	while {[llength $gpins] <= $pinid } {
		lappend gpins [list {} {}]
	}
	set pin [lindex $gpins $pinid]
	while { [llength $pin] < 2} {
		lappend pin {}
	}
	set p2 [lreplace $pin 0 0 $num]
	set p2 [lreplace $p2 1 1 $pname]
	set gpins2 [lreplace $gpins $pinid $pinid $p2]
	set part(Part,GatePins) [lreplace $part(Part,GatePins) $gate $gate $gpins2]
}

