#
# QCad
# (c) Q Solutions 1998
#
#
#
# Tag processing routines
#

#
# tagAdd canvas id tag  - adds Tag(xxx) to item id
# tagTag canvas id tag - returns Tag(xxx) from tag
# tagGet canvas id tag - returns xxx from tagname(xxx)
# tagPut canvas id tag value - replaces tag with tag(value) in canvas obj id
# tagSearch canvas search type tag  - returns all ids within search with tag type
# tagFind canvas x y not all typelist other  - returns all ids @x,y with tag in typelist ignore not
# tagSearchAll canvas search  taglist - search but only include objs that have taglist.
# need tagFindIn canvas search Types canvas return ids of items with tag in tag list

## NEED TO DEFINE HOW Tags ARE TO BE USED AND THEN DEFINE ROUTINES
## NOTE ALSO THAT STRUCTURE SHOULD ALLOW FOR MULTIPLE ITEMS WITH
##    SAME TAG TYPE. eg   XREF(A1) XREF(A2)
##
proc tagAdd {canvas id tag} {

	eval $canvas addtag $tag withtag $id
}

proc tagGet {canvas id tag} {

	set tl [$canvas itemcget $id -tags]
	return [listGet $tag $tl]
}

proc tagTag {canvas id tag} {

	set tl [$canvas itemcget $id -tags]
	set p [listFind $tag $tl]
 	if { $p == -1} { return "" }
	return [lindex $tl $p]
}

proc tagPut {canvas id tag value} {

	set tl [$canvas itemcget $id -tags]
	set tl [listPut $tag $tl $value]
	$canvas itemconfigure $id -tags $tl
}

#
# DO WE NEED SEARCH ON CANVAS TYPE ???
#
proc tagFind {canvas x y {not 0} {all 0} {typelist ""} {NoPick 0}} {

	set tl [tagFindAll $canvas $x $y $not $all $typelist $NoPick]
	set tag [lindex $tl end]
	Log "tagFind ($tl) $not = $tag: [$canvas itemcget $tag -tags]"
	return $tag
}


proc tagFindAll {canvas x y {not 0} {all 0} {taglist ""} {NoPick 0}} {

	set tl ""
	#Log "Find all with $taglist"
	foreach id [eval $canvas find overlapping [geomSquare 4 $x $y]  ] {
		if { $id == $not } { continue}
		set tags [$canvas itemcget $id -tags]
		if { [inList System $tags] } { continue }
		if { $NoPick && [inList NoPick $tags] } { continue }
		set fnd 0
		foreach tag $taglist {
			if { $all && ! [inList $tag $tags]} { break }
			if { [inList $tag $tags]} {
				set fnd 1
				break
			}
		}
		if { $fnd } { lappend tl $id }
		if {$taglist == "" } {
			lappend tl $id
		}
	}
	#Log "tagFindAll $not: $tl out of [$canvas find overlapping [expr $x -5]  [expr $y -5]  [expr $x +5] [expr $y + 5]]"
	return $tl
}

proc tagSearchAll {canvas search  {taglist ""}} {

	set tl ""
	foreach id [eval $canvas find $search] {
		set tags [$canvas itemcget $id -tags]
		if { [inList System $tags] } { continue }
		foreach tag $taglist {
			if { [inList $tag $tags] } {
				lappend tl $id
			}
		}
		if {$taglist == ""} {
			lappend tl $id
		}
	}
	return $tl
}

###
### NOTE: 
###  IT MAY BE FASTER TO SEARCH ALL TYPES FOR ID 
###  rather than searching all ID for Type
###  it depends on how many objects are in each decal ID
###
proc tagSearchID {canvas id type {itemtype ""} } {

	set tl [tagSearchAll $canvas "withtag $id" $type]
	set rl {}
	foreach tag $tl {
		set ty  [$canvas type $tag]
		if { $itemtype == "" || $ty == $itemtype } { lappend rl $tag }
	}
	return $rl
}

proc refdesTag {canvas id} {

	set tl [tagSearchID $canvas $id Type(RefDes) text]
	if { $tl == "" } {
		Log "Object found with no refdes text item"
		return ""
	}
	if { [llength $tl] > 1 } {
		Log "Object found with more than one refdes text item"
		bell
	}
	return [lindex $tl end]
}


proc tagDel {canvas id tag} {

	set tl [$canvas itemcget $id -tags]
	set tl [listDel $tag $tl]
	$canvas itemconfigure $id -tags $tl
}










