#
# QCad
# (c) Q Solutions 1998
#
#
#
#
# Schematic entry
#
#


proc schEdit { file {type ""}} {

	set name Sch_$file
	set win .spe_$name
	upvar #0 $name schema
	global $name 

	if { ! [winfo exists $win] || ! [info exists schema(Init)] } {
		catch {unset schema}
		catch {destroy $win}
		canvasMakeWin $name Sch $win
		set schema(File) $file
		fileLoad $name $file
		sheetDraw $name $schema(edit,Sheet)
		set top [winfo toplevel $win]
		update
		scan [winfo geometry $top] {%dx%d+%d,%d} ww wh wl wr 
		wm minsize $top $ww $wh 
		set schema(Init) 1
	} else {
		wm deiconify [winfo toplevel $schema(Win)]
		raise  [winfo toplevel $schema(Win)]
		focus $schema(Canvas)
		return
	}
}

proc flowEdit { file {type ""}} {

	set name Flow_$file
	set win .spe_$name
	upvar #0 $name schema
	global $name 

	if { ! [winfo exists $win] || ! [info exists schema(Init)] } {
		catch {unset schema}
		catch {destroy $win}
		set schema(File) $file
		canvasMakeWin $name Flow $win
		fileLoad $name $file
		sheetDraw $name $schema(edit,Sheet)
		set top [winfo toplevel $win]
		update
		scan [winfo geometry $top] {%dx%d+%d,%d} ww wh wl wr 
		wm minsize $top $ww $wh
		set schema(Init) 1
	} else {
		wm deiconify [winfo toplevel $schema(Win)]
		raise  [winfo toplevel $schema(Win)]
		focus $schema(Canvas)
		return
	}
}


###
### FIX MAKE CANVAS for NEW SHEETS
### GET CODE FROM makeWin AND PUT INTO ROUTINE makeCanvas
### Assign Bindings etc.

proc sheetDraw {name sheet} {
	upvar #0 $name data

	if { $data(edit,Sheet) == $sheet } { return }

	set win $data(Win)
	set c $win.sh_$sheet
	if { ! [winfo exists $c] } {
		set copts [array get data -*]
		set g [expr $data(Grid,Size) * 2]
		eval canvas $c $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) \
				-cursor dotbox
	}
	pack forget $data(Canvas)
	pack $c -side top -anc nw
	set data(Canvas) $c
	set data(Sheet) $sheet
}


proc schMenuAddItem { name {next 0} {item ""}} {
	upvar #0 $name data

	schAddItem $name $next $item
	modePush $name Place
}

proc schDupItem { name {id ""}} {
	upvar #0 $name data

	if { $id == "" } {
			set tag [tagFind $data(Canvas) $data(cx) $data(cy) 0 0 Type(RefDes)]
			set id [tagTag $data(Canvas) $tag ID]
	}
	if { $id == "" } {
		set data(Message) "Not reference designator"
		bell
		return ""
	}
	set reftag [refdesTag $data(Canvas) $id]
	set partno [tagGet $data(Canvas) $reftag PartNo]
	set refdes [tagGet $data(Canvas) $reftag Ref]

	if { $refdes == "" || $partno == "" } {
		Log "Part $reftag:$id $refdes, $partno"
		set data(Message) "$id - Not a valid part item"
		bell
		return ""
	}
	set data(edit,PartRef) $refdes
	schAddItem $name 1 $partno
}

proc schAddItem { name {next 0} {aitem ""}} {

	upvar #0 $name data

	set data(edit,objItem) ""
	set data(edit,objTag) ""
	set data(edit,objID) ""
	set data(edit,newobj) ""
	set gate 0
	set item $aitem
	if { ! $next } {
		if { $aitem == "" } {
			set item [dbBrowseExist Part]
		}
	} else {
		if { $aitem == "" } {
			set item $data(edit,Part)
			incr data(edit,Gate)
			set gate $data(edit,Gate)
		} 
	}
	if { $item == "" } { return "<<END>>"}
	set partdata [dbGetPart $item]
	if { [string length $partdata] == 0 } { 
		set data(Message) "Part $item not found"
		bell
		return ""
	}
	array set part $partdata

	set pre $part(Part,Prefix)
	if { ! [info exists data(refcnt,$pre)] } {
		set data(refcnt,$pre) 1
	}
	set ngates [llength $part(Part,Gates)]
	set gd [lindex $part(Part,Gates) $gate]
	set ref ""
	if { $data(Type) != "Flow" && $next && ($ngates > 1) } {
		set ref $data(edit,PartRef)
		set tag [tagSearchAll $data(Canvas) "withtag Ref($ref)"]
		if { $tag == "" } {
			set data(Message) "Part has no Ref($ref) tag, cannot place next gate"
			bell
			return ""
		}
		set ng -1
		for {set i 0 } {$i < $ngates} {incr i} {
			set gtag [tagSearchAll $data(Canvas) "withtag GateRef($i:$ref)"]
			Log "Search gate $i = $gtag"
			if { $gtag == "" } {
				set ng $i
				break
			}
		}
		if { $ng == -1 } {
			incr data(refcnt,$pre)
		}
		if { $ng == -1} { set next 0}
		if { $ng == -1} {set ng 0}
		set gate $ng
	}
	if { $gd == "" } {
		set gate 0
		set gd [lindex $part(Part,Gates) $gate]
	}
	set refdes $data(edit,PartRef)
	if { ($ngates == 1) && ($next == 1) } {
		incr data(refcnt,$pre)
	}
	if { $next == 0 } {
		set refdes $pre$data(refcnt,$pre)
	}
	if { $refdes == "" || $ngates == 1} {
		set refdes $pre$data(refcnt,$pre)
	}
	Log "Gate $gate of $ngates"
	set gpins [lindex $part(Part,GatePins) $gate]

	set decal [lindex $gd 0]
	Log "Part add $refdes decal $decal from gd:$gd  pins $gpins"
	set nid [newID]
	schLoadDecal $name $nid $decal Visual $refdes $item $gpins $pre $ngates $gate 0

	set data(edit,objItem) Obj
	set data(edit,objTag) 0
	set data(edit,objID) $nid
	set data(edit,objType) Part
	set data(edit,Part) $item
	set data(edit,PartRef) $refdes
	set data(edit,Gate) $gate
	set data(edit,Decal) 0
	set data(edit,newobj) $nid
	if { $data(Mode) == "Place" } { return "" }
	return Place
}


###
### MAKE WORK WITH BOTH SCH AND PCB DECALS
###
proc schAltDecal { name } {

	upvar #0 $name data

	set rtag [refdesTag $data(Canvas) $data(edit,objID)]
	if { $rtag == "" } { return "" }

	set item [tagGet $data(Canvas) $rtag PartNo]
	set ndecal [tagGet $data(Canvas) $rtag Decal]
	set gate [tagGet $data(Canvas) $rtag Gate]
	set type [tagGet $data(Canvas) $rtag DecalType]
	set refdes [tagGet $data(Canvas) $rtag Ref]

	if { $item == "" } {
		set data(Message) "Selected item:$rtag is not a part"
		bell
		return ""
	}	

	set partdata [dbGetPart $item]
	if { [string length $partdata] == 0 } { 
		set data(Message) "Part $item not found"
		bell
		return ""
	}
	array set part $partdata

	set ngates [llength $part(Part,Gates)]
	set gate [tagGet $data(Canvas) $rtag Gate]
	set ndecal [tagGet $data(Canvas) $rtag Decal]

	if { $type == "Visual" } {
		set gpins [lindex $part(Part,GatePins) $gate]
		set gd [lindex $part(Part,Gates) $gate]
	} else {
		set gd $part(Part,Decals)
		set gpins {}
	}

	Log "Crnt gate $gate , decal $ndecal Alt: gd $gd , of $part(Part,Gates)	"
	if { [llength $gd] < 2 } {
		set data(Message) "No alternate decals for this gate"
		bell
		return ""
	}

	incr ndecal
	if { $ndecal >= [llength $gd] } { set ndecal 0}
	set decal [lindex $gd $ndecal]

	schLoadDecal $name $data(edit,objID) $decal $type $refdes $item $gpins {} $ngates $gate $ndecal
	return ""
}

proc schLoadDecal { name id decal type refdes partno pins pre ngates gnum dnum} {

	upvar #0 $name data


	set itemdata [dbGet$type $decal]
	if { $itemdata == ""  } {
		set data(Message) "Decal $decal, not found for this gate($gnum)"
		bell
		return ""
	}
	$data(Canvas) delete $id
	procZoom $name None
	set refname $refdes
	if { $ngates > 1} {
		set refname "$refdes-[expr $gnum + 1]"
	}
	set nid [canvasAddList $name $id [lindex $itemdata 1]]
	set sc $data(Scale)
	if { $sc != 1 } {
		set sc [expr (6 - $sc)  / 5.0]
		$data(Canvas) scale $nid 0 0 $sc $sc
	}
	scan [geomCenter $data(Grid,Step) [$data(Canvas) bbox $nid]] "%f %f" x y
	set dx [expr $data(rx) - $x]
	set dy [expr $data(ry) - $y]
	$data(Canvas) move $nid $dx $dy
	Log "Part renum with $pins"
	partRenumber $name $nid $refname $partno $pins

	set tag [refdesTag $data(Canvas) $nid]
	if { $tag != "" } {
		$data(Canvas) addtag PartNo($partno) withtag $tag
		$data(Canvas) addtag Gate($gnum)  withtag $tag
		$data(Canvas) addtag Decal($dnum) withtag $tag
		$data(Canvas) addtag NoDelete withtag $tag
		$data(Canvas) addtag Ref($refdes) withtag $tag
		$data(Canvas) addtag GateRef($gnum:$refdes) withtag $tag
		$data(Canvas) addtag DecalType($type) withtag $tag
		set data(edit,Decal) $dnum
		set data(edit,Gate) $gnum
	}
	procJoined $name Move $nid 1
	return ""
}


proc schGenNet {name} {
	upvar #0 $name data
	global GBL


	set Parts ""
	set tl [tagSearchAll $data(Canvas) "withtag Gate(0)" Type(RefDes)]
	foreach tag $tl {
		set ID [tagGet $data(Canvas) $tag ID]
		set part [tagGet $data(Canvas) $tag PartNo]
		set ref  [$data(Canvas) itemcget $tag -text]
		regsub -- "-.*" $ref "" ref
		lappend Parts [list $ref $part]
		lappend PartList [list $ref $ID $part]
		set data(nl,$ref) $ID
	}
	Log "Parts\n\t[join $Parts \n\t]"
	set conDone {}
	set c $data(Canvas)
	set tl [tagSearchAll $data(Canvas) "withtag Type(Connection)"]
	foreach tag $tl {
		if { [inList $tag $conDone] } {continue}
		lappend conDone $tag
		set refid [tagGet $c $tag ID]
		getNet $name $c $tag tags pins nets refs
		if { $tags != "" } {eval lappend conDone $tags}
		Log "Net $refid: $tags, $pins , $nets"
		lappend Nets [list $refs $pins $nets $tags]
		lappend NetList [list $nets $pins]
	}
	bell
	Log "Nets \n\t[join $Nets \n\t]"
	set file [fileFind $GBL(LibraryPath) $data(File) .p]
	set GBL(vNewFile) $data(File)
	set GBL(vFile) $data(File)
	dbSetPath $file
	set file [dbBrowse Net Save]
	if {$file == "" } { bell ; return ""}
	set file [file join $GBL(vSelTopDir) $GBL(vSelSubDir) $file.net] 
	set f [open $file w]
	puts $f "PartList [list $PartList]"
	puts $f "NetList  [list $NetList]"
	close $f

}

proc getNet { name c id tags pins nets refs} {
	upvar #0 $name data
	upvar $tags taglist
	upvar $pins pinlist
	upvar $nets netlist
	upvar $refs reflist

	set tl $id
	set taglist ""
	set pinlist ""
	set netlist ""
	set reflist ""
	while { $tl != "" } {
		set tag [lindex $tl 0]
		set tl [lrange $tl 1 end]
		if { [inList $tag tdone] } {continue}
		lappend tdone $tag
		lappend taglist $tag
		set refid [tagGet $c $tag ID]
		update
		foreach end {0 1} {
			set ref [tagGet $c $tag Tie$end]
			if { $ref == "" } {
				Log "Error: Connection $tag: ID($refid) without Tie$end"
				continue
			}
			set pin -1
			scan $ref {%d:%[^:]:%d} atid ty pin
			set dtag [tagSearchAll $c "withtag Anchor\($atid:$pin)"]
			set dpin [tagGet $c $dtag PPin]
			if {$dpin == "" } { set dpin $pin }
			#Log "$refid:$end $atid:$ty:$pin"
			if { $ty == "Anchor" } {
				set refdes [$c itemcget [refdesTag $c ID($atid)] -text]
				regsub -- -.* $refdes "" refdes
				#puts "$refid -> $atid: $refdes:$dpin ($dtag)"
				set ref0 $data(nl,$refdes)
				if { ! [inList $atid:$pin $tdone] } {
					#lappend pinlist $atid:$dpin
					lappend pinlist $ref0:$dpin
					lappend tdone $atid:$pin
					set anet [tagGet $c $atid Net]
					if { $anet != "" } { lappend netlist $anet }
					lappend reflist [$c itemcget [refdesTag $c ID($atid)] -text].$pin
				}
				set alist [tagSearchAll $c "withtag Tie$end\($atid:Anchor:$pin)"]
				foreach tagx $alist {
					if { ! [inList $tagx $tdone] &&  ! [inList $tagx $tl] } {
						lappend tl $tagx
					}
				}
			} else {
				set parobj [tagSearchAll $c "withtag ID($atid)" Type(Connection)]
				if { ! [inList $parobj $tdone] && ! [inList $parobj $tl]} {
					#Log "$refid -> $atid  $tag -> $parobj"
					lappend tl $parobj
				} else {
					#Log "Been here already"
				}
			}
			set alist [tagSearchAll $c "withtag CRef$end\($refid)"]
			#Log "List $alist"
			foreach tagx $alist {
				if { ! [inList $tagx $tdone]  &&  ! [inList $tagx $tl] } {
					lappend tl $tagx
				}
			}
		}
	}
}




