#
# QCad
# (c) Q Solutions 1998
#
#
#
# Main Processing Routines
#


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

	switch $mode { 
		Shift {
			if { $mark == "" } { return ""}
			eval $data(Canvas) move $mark $data(dx) $data(dy)
			return ""
			}
		Box {
			if { $mark == "" } { return ""}
			Log "Grp $mark: [$data(Canvas) coords $mark]"
			scan [$data(Canvas) coords $mark] "%f %f %f %f" xx y1 xx y2
			if { abs($y - $y1) < abs($y - $y2) } {
				eval $data(Canvas) coords $mark $x $y [lrange [$data(Canvas) coords $mark] 2 3]
			} else {
				eval $data(Canvas) coords $mark [lrange [$data(Canvas) coords $mark] 0 1] $x $y
			}
			Log "Grp3 [$data(Canvas) coords $mark]"
			return ""
			}
		Mark {
			if { $mark == "" } {
				$data(Canvas) create rectangle $x $y $x $y -fill {} -outline White -width 1 -tags {Group Mark NoPick System}
				return "Group"
			}
			set tl [eval $data(Canvas) find enclosed [$data(Canvas) coords Mark]]
			if { $tl == "" } { bell ; return ""}
			set idlist ""
			set c $data(Canvas)
			set bbox [$c coords Mark]
			foreach tag $tl {
				set id [tagTag $c $tag ID]
				set type [tagGet $c $tag Type]
				if { $id == "" || [inList Fixed [$c itemcget $tag -tags]] || $type == "Connection" || $type == "Net"} {continue}
				if { [lsearch -exact $idlist $id] == -1 && [geomWithin $bbox [$c bbox $id]]} {
					lappend idlist $id
					$c addtag Group withtag $id
				}
			}
			if { $idlist == "" } {
				set data(Message) "Group selects nothing"
				bell
				return ""
			} 
			lappend idlist Mark
			set data(edit,objItem) Group
			set data(edit,objType) Group
			set data(edit,objID) $idlist
			#modePop $name
			return "Move"
		}
		End {
			procDropAll $name
			#modePop $name
			return ""
		}
		Clear {
			$data(Canvas) delete Mark
			modePop $name
			return ""
		}
	}
}


proc tieDot { name id n x y} {
	upvar #0 $name data
	set tds	[expr $data(TieDot,Size) * $data(RelScale)]
	set new [canvasCreate $name oval [geomSquare $tds $x $y] TieDot $id [join "TieDot($n) NoPick $data(TieDot,Filled)"]]
}


proc procJoined {name mode id flag {cnt 1}} {
	upvar #0 $name data

	if { $cnt > 50 } {
		set data(Message) "Too many interconnection levels, possible cyclicly connected net"
		bell
	}
	incr cnt
	set c $data(Canvas)
	if { $flag && ! $data(edit,RubberBand) } { return }
	if { ! $flag && $data(edit,RubberBand) } { return }
 	Log "Attached processing for $id"

	foreach end {0 1} {
		set taglist [tagSearchAll $c "withtag CRef$end\([idNum $id])"]
		#Log "List $taglist"
		foreach tag $taglist {
			set refid [tagGet $c $tag ID]
			set type [tagGet $c $tag Type]
			set ref [tagGet $c $tag Tie$end]
			if { $ref == "" } {
				Log "Error: Move attached line without CRef$end"
				continue
			}
			set coords [$c coords $tag]
			set pt [lineEndPoint $end $coords]
			set pin 0
			scan $ref {%d:%[^:]:%d} atid ty pin
			if { $ty == "Anchor" } {
				set parobj [tagSearchAll $c "withtag Anchor($atid:$pin)"]
				#Log "Search $ref for Anchor($atid:$pin) -> $parobj"
			} else {
				set parobj [tagSearchAll $c "withtag ID($atid)" Type($ty)]
			}
			if { $parobj == "" } {
				Log "Can't find $ty for $id to ID($refid)"
				bell
				continue
			}
			if { $type == "Via" } {
				scan [linePointEnd $pin [$data(Canvas) coords $parobj]] "%f %f" px py
				foreach {ox oy} [geomCenter 1 [$data(Canvas) coords $tag]] {}
				eval $c move $tag [expr $px - $ox] [expr $py - $oy]
				procJoined $name $mode ID($refid) $flag $cnt
				continue
			}

			if { $ty == "Anchor" } {
				#Log "GeoC $xy : $parobj :: [$data(Canvas) coords $parobj]"
				if { $type == "Connection" || $type == "Track"} {
					set xy [geomCenter $data(Grid,Step) [$data(Canvas) coords $parobj]]
					set coords [lineNORM $data(Grid,Step) [lineRPoint $pt $coords $xy]]
				} else {
					set xy [geomCenter 1 [$data(Canvas) coords $parobj]]
					set coords [lineRPoint $pt $coords $xy]
				}
				eval $c coords $tag $coords
				procJoined $name $mode ID($refid) $flag $cnt
				continue
			}
			if { $ty == "Track" } {
				#scan [lineEndPoint $pin [$data(Canvas) coords $parobj]] "%f %f" px py
				set pcoord [$data(Canvas) coord $parobj]				
				set coords [lineRPoint [lineEndPoint $pt $coords] $coords [lineGetPoint [lineEndPoint $pin $pcoord] $pcoord] ]
				## Try NORM Tracks while moving objects
				set o $coords
				## set coords [lineNORM $data(Grid,Step)  $coords]
				Log "Track($tag) set to $coords  from $o"
				eval $c coords $tag $coords
				continue
			}
			##
			## connections processing
			##
			scan [lineGetPoint $pt $coords] "%f %f" x y
			set utag [tagFindAll $c $x $y $tag 1 "$id Type(Connection)"]
			if { $utag != "" } {
				continue
			}
			#
			# Gone Walkies, find it
			#
			set dot [tagFindAll $c $x $y  $tag 1 "ID($refid) TieDot($end)"]
#			set dot [tagSearchAll $c "withtag ID($refid)" TieDot($end)]
			set opt 1
			if {$pt != 0 } { set opt [expr $pt -1] }
			set hv [lineSlope [concat [lineGetPoint $pt $coords] [lineGetPoint $opt $coords]]]
			scan [lineIntercect $hv $x $y [$c coords $parobj]] "%f %f" nx ny
			set newcoords [lineRPoint $pt $coords $nx $ny]
			#Log "Dot $dot replace pt:$pt:$opt hv $hv, $coords"
			#Log "       with $newcoords"			
			set newcoords [lineNORM $data(Grid,Step)  $newcoords]
			eval $c coords $tag $newcoords
			#scan [lineGetPoint $pt $newcoords] "%f %f" nx ny
			if { $dot != "" } {
				#Log "Dot moved @($x $y) to ($nx,$ny) by [expr $nx - $x]dx [expr $ny - $y]dy"
				$c move $dot [expr $nx - $x] [expr $ny - $y]
			}
			procJoined $name $mode ID($refid) $flag $cnt
 		}
	}
}

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

	#Log "Move  $data(edit,objID) $data(dx) $data(dy)"
	foreach id $data(edit,objID) {
		# FIX ME
		# INTEGRATE NEW MOVE CODE TO MAKE OBJECT
		# CENTER ON CURSOR RATHER THAN DELTA MOVING
		# SO OBJECT STAYS TIED TO CURSOR
		#
		#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
		$data(Canvas) move $id $data(dx) $data(dy)
		procJoined $name Move $id 1
	}
	if { $data(edit,objRef) != "" } {
		procJoined $name Move $data(edit,objRef) 1
	}
	return ""
}

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

	scan [$data(Canvas) coords $data(edit,objTag)] "%f %f %f %f" x1 y1 x2 y2
	set x1 [expr $x1 - $data(dx)]
	set y1 [expr $y1 - $data(dy)]
	set x2 [expr $x2 + $data(dx)]
	set y2 [expr $y2 + $data(dy)]
	$data(Canvas) coords $data(edit,objTag) $x1 $y1 $x2 $y2
	return ""
}

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

	set pt $data(edit,objpoint)
	set coords [$data(Canvas) coords $data(edit,objTag)]
	if { $pt != -1 } {
		set coords [lineRPoint $pt $coords $data(rx) $data(ry)]
		if { $data(edit,objType) == "Connection" } {
			set coords [lineNORM $data(Grid,Step) $coords]
		}
		if { $data(edit,objType) == "Track" } {
			set coords [lineNORM $data(Grid,Step) $coords 0] 
		}
		if { $pt } {
			set data(edit,objpoint) [linePointMax $coords]
		}

		eval $data(Canvas) coords $data(edit,objTag) $coords
		procJoined $name Move $data(edit,objID) 1
	}
	set seg $data(edit,objseg)
	if { $seg != -1 } {
		set segment [lineGetSeg $seg $coords]
		set slope [lineSlope $segment]
		if { $slope != 0 && abs($slope) != 1 } {
		#	set data(Message) "Line not Horizontal or Vertical"
		#	set data(edit,objseg) -1
		#	bell
		#	return "<<END>>"
		}
		set dx $data(dx)
		set dy $data(dy)
		if { $data(edit,objType) == "Connection" || $data(edit,objType) == "Track"} {
			if { $slope == 0 } { set dx 0} else { set dy 0}
		}
		set trans [geomShift $dx $dy $segment]
		set coords [lineRSeg $seg $coords $trans]
		if { $data(edit,objType) == "Connection"} {
			set coords [lineNORM $data(Grid,Step) $coords]
		}
		if { $data(edit,objType) == "Track"} {
			set coords [lineNORM $data(Grid,Step) $coords 0]
		}
		eval $data(Canvas) coords $data(edit,objTag) $coords
		Log "MSeg $data(Canvas) coords $data(edit,objTag) $coords"
		procJoined $name Move $data(edit,objID) 1
		set coords [$data(Canvas) coords $data(edit,objTag)]
		set seg [lineFindSeg $data(rx) $data(ry) $coords ]
		set len [expr [llength $coords] / 2 - 2]
		set data(edit,objseg) $seg
		if { $seg == -1 || $seg == 0 || $seg == $len } {
			set data(Message) "Segment lost"
			set data(edit,objseg) -1
			bell
			return "<<END>>"
		}
	}
	return ""
}


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

	set coords [$data(Canvas) coords $data(edit,objTag)]
	set pt $data(edit,objpoint)

	if { $data(edit,objType) != "Connection" && $data(edit,objType) != "Net"} {
		if { $pt  } {
			set coords [concat $coords $data(rx) $data(ry)]
			set data(edit,objpoint) [linePointMax $coords]
		} else {
			set coords [concat $data(rx) $data(ry) $coords]
		}
		eval $data(Canvas) coords $data(edit,objTag) $coords 
		return ""
	}
	procJoined $name Move $data(edit,objID) 0

	set tag [tagFind $data(Canvas) $data(cx) $data(cy) $data(edit,objTag) 0 "Type(Anchor) Type(Connection) Type(Track)"]
	set cid [tagGet $data(Canvas) $tag ID]
	if  { $tag == "" || $tag == $data(edit,objTag) } { 
		set data(Message) "Nothing to attach to for $data(edit,objType)"
		if { $data(edit,objType) == "Net" } { return "" }
		if { $pt  } {
			set coords [concat $coords $data(rx) $data(ry)]
			set data(edit,objpoint) [linePointMax $coords]
		} else {
			set coords [concat $data(rx) $data(ry) $coords]
		}
		eval $data(Canvas) coords $data(edit,objTag) $coords 
		##procJoined $name Move $data(edit,objID) 0
		return ""
	}
	### WRONG LOGIC, NEED TO CHECK CREF0 TAG FOR EQUALITY
	if { $cid == $data(edit,objID) } {
			set data(Message) "Cannot tie connection to itself"
			bell
			return ""
	}
	Log "EndPoint Attached to $tag ID($cid)"
	set ty [tagGet $data(Canvas) $tag Type]
	set pin [tagGet $data(Canvas) $tag Pin]
	set end $data(edit,end)
	Log "EndPoint $end, Attached to $tag ID($cid):$pin"
	tagPut $data(Canvas) $data(edit,objTag) CRef$end "$cid"
	tagPut $data(Canvas) $data(edit,objTag) Tie$end "$cid:$ty:$pin"
	if { $ty == "Connection"} {
		set cx $data(rx)
		set cy $data(ry)
		tieDot $name $data(edit,objID) $end $cx $cy
	}
	if {$ty == "Anchor"} {
			#scan [geomCenter $data(Grid,Step) [$data(Canvas) coords $tag]] "%f %f" cx cy
			scan [geomCenter 0 [$data(Canvas) coords $tag]] "%f %f" cx cy
			Log "Center $cx $cy"
			set coords [lineRPoint $pt $coords $cx $cy]
			#set coords [lineNORM $data(Grid,Step) $coords]
			if { $data(edit,objType) == "Connection" } {
				set coords [lineNORM 0 $coords]
			}
			eval $data(Canvas) coords $data(edit,objTag) $coords 
	}
	set data(edit,newobj) ""
	return "<<END>>"
}

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

	set tag [tagFind $data(Canvas) $data(cx) $data(cy)]
	if { $tag == ""} { return }
	if { $mode == "Delete" } {
		set obj $tag
		if { $data(edit,Connected) } {
			set obj [tagTag $data(Canvas) $tag ID]
		}
		set id [tagTag $data(Canvas) $tag ID]
		if { $id == "" } {
			Log "ObjDelete: $tag: Object without ID Tag "
			set obj $tag
		}
		$data(Canvas) delete $obj
		set data(edit,objTag) ""
		set data(edit,objID) ""
		return ""
	}
	set mfunc $mode
	if { $mode == "Create" } {


	}
	set data(edit,objTag) $tag
	set data(edit,objID) [tagTag $data(Canvas) $tag ID]
	if { $data(edit,objID) == "" } {
		Log "ObjEdit: Object without ID Tag"
		bell
	}
	return $func
}

proc procCreate { name {type ""}} {
	upvar #0 $name data

	set data(x) $data(rx)
	set data(y) $data(ry)

	if { $type == "" }  {
		set type $data(Mode,Create)
	}
	set mFunc Resize
	set otags ""
	set objType $data(edit,Type)
	set coords [list $data(rx) $data(ry) $data(rx) $data(ry)]
	set newid [newID]
	set data(edit,objID) $newid

	if { $type == "Connection" || $type == "Net"} {
		set tag [tagFind $data(Canvas) $data(cx) $data(cy) 0 0 "Type(Anchor) Type(Connection)"]
		if { $tag == ""} { set data(Message) "No Anchor or Connection under cursor"; return ""}
		set cid [tagGet $data(Canvas) $tag ID]
		if { $cid == "" } {
			set data(Message) "Attach Error: Object has no ID"
			bell 
			return ""
		}
		set objType $type
		set type "line"
		set cid ID($cid)
		set ty [tagGet $data(Canvas) $tag Type]
		set pin [tagGet $data(Canvas) $tag Pin]
		set otags "CRef0([idNum $cid]) Tie0([idNum $cid]:$ty:$pin)"
		if { $ty == "Anchor" } {
			#scan [geomCenter $data(Grid,Step) [$data(Canvas) coords $tag]] "%f %f" cx cy
			scan [geomCenter 0 [$data(Canvas) coords $tag]] "%f %f" cx cy
			set coords [list $cx $cy $cx $cy]
		}
		if { $ty == "Connection" } {
			set cx $data(rx)
			set cy $data(ry)
			tieDot $name $data(edit,objID) 0 $cx $cy
		}
		set data(edit,end) 1
		set data(edit,Type) Connection
	}
	if { $type == "polygon" } {
		lappend coords $data(rx) $data(ry)
	}
	if { $type == "text" } {
		set coords [list $data(rx) $data(ry)]
		set mFunc Edit
	}
	if { $type == "polygon" || $type == "line" } {
		set data(edit,objseg) -1
		set data(edit,objpoint) 1
		set mFunc Adjust
	}
	set id [canvasCreate $name $type $coords $objType $newid $otags]
	if { $type == "text" } {
		$data(Canvas) focus $id
	}
	set data(edit,newobj) $id
	set data(edit,objTag) $id
	set data(edit,objItem) $type
	set data(edit,objType) $objType
	set data(edit,objpoint) 1
	set data(edit,objseg) -1
	return $mFunc
}

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


	set tag $data(edit,objTag)
	if { $tag == $data(edit,objID) } { return "" }
	set level $data(edit,Break)

	incr level

	set heir [split [tagGet $data(Canvas) $tag Heir] :]
	$data(Canvas) dtag all Group
	if { $level > [llength $heir] } {
		set data(edit,objID) $tag
		set data(Message) "Broke into smallest item"
		return ""
	}
	set hmatch [lindex $heir [expr $level -1]]
	set id [tagTag $data(Canvas) $tag ID]
	foreach tag [tagSearchAll $data(Canvas) "withtag $id"] {
		if { [lsearch [tagGet $data(Canvas) $tag Heir] $hmatch] > -1 } {
			$data(Canvas) addtag Group withtag $tag
		}
	}
	set data(edit,objRef) $id
	set data(edit,objID) Group
	incr data(edit,Break)
	set data(Message) "Break to level $level : $hmatch"	
	return ""
}

proc procGrab { name {mode ""} {args ""}} {
	upvar #0 $name data

	set args [join $args]
	if { $mode == "" } { set mode $data(Mode) }
	set tag [tagFind $data(Canvas) $data(cx) $data(cy) 0 0 "" 1]
	if { $tag == ""} { 
		set data(Message) "Selected nothing"
		bell 
		return ""
	}
	if { $mode == "ObjEdit" } {
		procEditObj $name $tag
		return ""
	}
	if { [inList Fixed [canvasGetTags $data(Canvas) $tag]] } {
		set data(Message) "Item is Fixed, and connot be grabbed"
		bell 
		return ""
	}
	set data(edit,objItem) [$data(Canvas) type $tag]
	set data(edit,objTag) $tag
	set data(edit,objID) [tagTag $data(Canvas) $tag ID]
	set ty [$data(Canvas) type $tag]
	set data(edit,objType) [tagGet $data(Canvas) $tag Type]
	if { ! $data(edit,Connected) } {
		set data(edit,objID) $tag
	}
	if { $mode == "Delete" } {
		## DO DEL CHECKS HERE
		$data(Canvas) delete $data(edit,objID)
		procDropAll $name
		return ""
	}
	set mfunc $mode
	if { $mode == "Copy" } {
		set id [newID]
		foreach o [$data(Canvas) find withtag $data(edit,objID)] {
			canvasObjDup $data(Canvas) $o $id
		}
		set data(edit,newobj) $id
		set data(edit,objTag) $id
		set data(edit,objID) $id
		set mfunc Move
	}
	if { $ty != "text" && $data(edit,Connected) } {
		set ty Obj
	}
	if { $mode == "Edit" } {
		if { $ty == "oval" || $ty == "rectangle" } {
			set mfunc Resize
			scan [$data(Canvas) coords $tag] "%f %f %f %f" x1 y1 x2 y2
		} else {
		}
		if {$ty == "text" } {
			$data(Canvas) focus $tag
			$data(Canvas) icursor $tag @$data(wx),$data(wy)
		}
	}
	if { $data(edit,objType) == "Net" || $data(edit,objType) == "Connection" || $ty == "line" || $ty == "polygon" } {
		### Find Point/Segment
		set mfunc Adjust
		set coords [$data(Canvas) coords $tag]
		set len [lineSegMax $coords]
		set seg [lineFindSeg $data(cx) $data(cy) $coords]
		set pt [lineFindPoint $data(cx) $data(cy) $coords]
		Log "SelCon @$data(rx),$data(ry) seg $seg pt $pt nseg $len npt [linePointMax $coords]"
		if { $pt != 0 && $pt !=  [linePointMax $coords] } { set pt -1 }
		if { $seg == 0 || $seg == $len } { set seg -1}
		if { $seg != -1 } { set pt -1}
		if { $seg == -1 && $pt == -1 } { 
			procDropAll $name
			set data(Message) "Not End point or segment"
			bell
			return ""
		}
		if { $seg != -1 } { set mfunc AdjustS }
		set end 0
		if { $pt > 0 } { set end 1}
		Log "Selected $tag: pt $pt , $seg of $len"
		set data(edit,objseg) $seg
		set data(edit,objpoint) $pt
		set data(edit,end) $end
		if { $data(edit,objType) == "Connection" && $seg == -1 } {
			scan [lineGetPoint $pt $coords] "%f %f" x y
#			set dot [tagSearchAll $data(Canvas) "withtag $data(edit,objID)" TieDot($pt)]
#			set dot [tagFind $data(Canvas) $x $y $data(edit,objTag) 1 "$data(edit,objID) Type(TieDot) TieDot($pt)"]
			set dot  [tagSearchID $data(Canvas) $data(edit,objID) TieDot($end)]
			eval $data(Canvas) delete $dot
			Log "Delete dot $dot @ $x,$y"
			Log "Point $pt  $x,$y  : $coords"
			set data(edit,newobj) $data(edit,objID)
		}
	}
	set data(x) $data(rx)
	set data(y) $data(ry)
	set data(startx) $data(rx)
	set data(starty) $data(ry)
	set data(edit,Break) $data(def,Break)
	set data(Message) "$data(edit,objTag) $data(edit,objID) $data(edit,objType)"
	return $mfunc
}


proc procNull {name} {}

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

#	set data(Mode) [lreplace $data(Mode) end end]
	procJoined $name Move $data(edit,objID) 0
	modePop $name
	procDropAll $name
	return ""
}

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

	set data(edit,objRef) {}
	set data(edit,objID) {}
	set data(edit,objTag) {}
	set data(edit,objItem) {}
	set data(edit,objType) {}
	set data(edit,objList) {}
	set data(edit,newobj) {}
	$data(Canvas) focus {}
	$data(Canvas) dtag all Group
	set data(Message) ""
	return ""
}

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

	Log "Cancel with $data(edit,newobj) "
	if { $data(edit,newobj) != "" } {
		$data(Canvas) delete $data(edit,objID)
		$data(Canvas) delete $data(edit,objTag)
		set data(edit,newobj) ""
	}
	procDropAll $name
	$data(Canvas) delete Mark
	modePop $name
	return ""
}








