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

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

	set c $data(Canvas)
	set w [winfo width $c] 
	set h [winfo height $c]
	if { (abs($w - $data(canvas,W)) < 10) && (abs($h - $data(canvas,H)) < 10) } {
		Log "Config ignored"
		return ""
	}
	Log "Config action $name $w x $h"
	set data(canvas,H) $h
	set data(canvas,W) $w
	canvasDrawGrid $name  
	canvasMakeCursor $c $w $h $data(Grid,Colour)
	$data(Win).message configure -wraplength [expr [winfo width $c] - 20]
	return ""
}

proc canvasGetTags {canvas id} {

	return [$canvas itemcget $id -tags]
}


proc canvasGetOpts {canvas id} {

	foreach opt [$canvas itemconfig $id] {
		lappend opts [lindex $opt 0] [list [lindex $opt 4]]
	}
	return [join $opts]
}


proc canvasScroll { name m args } {
	upvar #0 $name data

	set c $data(Canvas)
	eval $c $m $args
	set x1 [$c canvasx 0]
	set y1 [$c canvasy 0]

	set s $data(Grid,Size)
	set s [expr $data(Grid,Size) * $data(RelScale)]
	set xd [expr fmod( $x1 , $s)]
	set yd [expr fmod( $y1 , $s)]
	set x1 [expr $x1 - fmod( $x1 , $s) -$s]
	set y1 [expr $y1 - fmod( $y1 , $s) -$s]
	scan [$c coords GridOrigin] "%f %f" xo1 yo1 
	#puts "Sc x1,y1 $x1,$y1 xd,yd $xd,$yd xo,yo $xo1,$yo1" 
	if { $data(show,Grid) } {
		$c move Grid [expr $x1 - $xo1] [expr $y1 - $yo1]
	}
	if { $data(show,Cursor) } {
		canvasMoveCursor $data(Canvas) $data(wx) $data(wy)
	}
}


proc canvasMoveCursor { c x y} { 

	set rx [$c canvasx $x]
	set ry [$c canvasy $y]
	set x1 [$c canvasx 0]
	set y1 [$c canvasy 0]
	set w [winfo width $c]
	set h [winfo height $c]

	set cx 0
	set cy 0
	scan [$c coords Cursor] "%f %f" cx cy
	$c move CursorX [expr $rx - $cx ] [expr $ry - $cy]
#	scan [$c coords CursorH] "%f %f" cx cy
#	$c move CursorH [expr $x1 - $cx ] [expr $ry - $cy ]

}

proc canvasMakeCursor { c w h fill} {

	$c delete CursorH
	$c delete CursorV
	$c delete Cursor
	set Hw [expr $w / 2]
	set Hh [expr $h / 2]

	set wh 100
	
	$c create line 0 0 0 0  -fill $fill -tags {NoPick System Cursor CursorX}
	$c create line 0 -$wh 0 $wh -fill $fill -tags {NoPick System CursorV CursorX}
	$c create line -$wh 0 $wh 0  -fill $fill -tags {NoPick System CursorH CursorX}

}


proc canvasDrawGrid { name } {

	upvar #0 $name data

	global GBL SC PCB PE

	set gtype [lindex $data(GridList) 0]
	set c $data(Canvas)
	set fill $data(Grid,Colour)
	set size $data(Grid,DotSize)
	set s [expr $data(Grid,Size) * $data(RelScale)]
	set out {}
	set wid 1


	$c delete Grid
	set x1 [$c canvasx 0]
	set y1 [$c canvasy 0]
	set x2 [expr $x1 + [winfo width  $c] + $s]
	set y2 [expr $y1 + [winfo height $c] + $s]

	set x1 [expr $x1 - fmod( $x1 , $s) - $s]
	set y1 [expr $y1 - fmod( $y1 , $s) - $s]
	$c create rectangle  $x1 $y1 $x1 $y1 \
					-outline {} -fill {} -tags {NoPick System Grid GridOrigin}

	if { $gtype == "None" } {
		return
	}
	if { $s < 10 } {
		Log "Grid Too small ($s)"
		return ""
	}

	switch $gtype {
		Dots -
		Points {
			if { $gtype == "Points" } { set size 0.5 }
			for { set x $x1 } { $x < $x2 } {set  x [expr $x + $s]} {
				for { set y $y1 } {$y < $y2 } { set y [expr $y + $s]} {
					$c create rectangle  [expr $x - $size] [expr $y - $size] [expr $x + $size] [expr $y + $size] \
							-outline $out -width $wid -fill $fill -tags {NoPick System Grid}
				}
			}
		}
		Lines {
			for { set x $x1 ; set y $y1} { $x < $x2 } {set  x [expr $x + $s] ; set y [expr $y + $s]} {
				$c create line  $x $y1 $x $y2 \
					 -fill $fill -tags {NoPick System Grid}
				$c create line  $x1 $y $x2 $y \
					 -fill $fill -tags {NoPick System Grid}
			}
		}
	}
	$c raise Grid
	$c raise Cursor
}

proc canvasInfo { name what} {
	upvar #0 $name data

	set c $data(Canvas)
	set x [expr [winfo pointerx $c] - [winfo rootx $c]]
	set y [expr [winfo pointery $c] - [winfo rooty $c]]
	set x [$c canvasx $x] 
	set y [$c canvasy $y]
	set tag [tagFind $c $x $y]
	if { $tag == "" } {return }
	if { $what }  {
		set data(Message) "Obj $tag: [$c type $tag] [$c itemconfig $tag]"
	} else {
		set data(Message) "Obj $tag: [$c type $tag] @[$c coords $tag] ([$c itemcget $tag -tags])"
	}
	return ""
}

###
### Not Much Use for This Routine
### TRASH IT

proc canvasRaiseLower { name rl} {
	upvar #0 $name data

	set c $data(Canvas)
	set x [expr [winfo pointerx $c] - [winfo rootx $c]]
	set y [expr [winfo pointery $c] - [winfo rooty $c]]
	set x [$c canvasx $x] 
	set y [$c canvasy $y]
	set tag [tagFind $c $x $y]
	if { $tag == "" } {return }
	set data(Message) "Raise/Lower Not finished $tag: [$c type $tag] @[$c coords $tag] ([$c itemcget $tag -tags])"
	return ""
}

proc canvasTransform { name func}  {
	upvar #0 $name data

	set c $data(Canvas)
	set objlist $data(edit,objID)
	if { $objlist == "" } { bell ; return }

	foreach obj $objlist {
		scan [geomCenter  $data(Grid,Step) [$c bbox $obj]] "%f %f" cx cy
		foreach t [$c find withtag $obj] {
			eval $c coords $t [geom$func $cx $cy [$c coords $t]]
		scan [geomCenter  $data(Grid,Step) [$c bbox $obj]] "%f %f" ncx ncy
			Log "trans$func $obj @$cx $cy new center@ $ncx $ncy"
			if { [$c type $t] == "text" } {
				$c itemconfig $t -anchor [ancT $func [$c itemcget $t -anchor]]
			}
		}
	}
	procJoined $name Move $obj 1
	return ""
}

proc canvasScale { name dir {obj Obj}} {

	upvar #0 $name data

	set c $data(Canvas)

	set xc 0
	set yc 0
	if { ! $dir  } {
		set scale [expr 1.0 / $data(Scale,Step)]
	} else {
		set scale $data(Scale,Step)
	}
	set ilist  $data(edit,objID)
	if { $ilist == "" } {lappend ilist [list]}
	foreach id $ilist {
		if { $id != "" } { 
			set obj $id
			scan [geomCenter $data(Grid,Step) [$c bbox $id]] "%f %f" xc yc
			set xc $data(rx)
			set yc $data(ry)
		}
		$c scale $obj $xc $yc $scale $scale
		Log "Scale $obj $dir"
		if { $data(edit,objID) != "" } { 
			procJoined $name Move $id 1
			Log "Pj $id"
		}
	}
	if { $data(edit,objID) == $data(edit,objTag) } {
		if { [$c type $data(edit,objID)] == "text" } {
			foreach {fnt size type} [$c itemcget $data(edit,objID) -font] {}
			set size [expr int($size * $scale)]
			if { $size < 4 } { set size 4}
			$c itemconfig $data(edit,objID) -font [list $fnt $size $type]
		}
	}
	return ""
}


proc ancT {func anc} {

	switch $func {
		Rotate { 
			set ca [list e ne n ne w sw s se] 
			set na [list n nw w sw s se e ne]
		}
		MirrorX { 
			set ca [list ne e se] 
			set na [list nw w sw]
		}
		MirrorY {
			set ca [list nw n ne] 
			set na [list sw s se]
		}
	}
	set p [lsearch -exact $ca $anc]
	if { $p == -1 } { return $anc }
	return [lindex $na $p]
}

proc canvasObjDup { c id newid} {

	set type [$c type $id]
	set coords [$c coords $id]
	foreach cfg [$c itemconfigure $id] {
		set opt [lindex $cfg 0]
		set data [lindex $cfg 4]
		if { "$opt" == "-tags" } {
			set tags $data
		} else {
			lappend opts $opt
			lappend opts $data
		}
	}
	set tags [concat $newid [listDel ID $tags]]
	Log "copy $id: $newid tags $tags"
	set item [eval $c create $type $coords $opts -tags {$tags}]
	$c lower $item Grid
	Log "$c create $type $coords $opts -tags $tags"
	
	return ID($id)
}

proc newID {} { 
	global _ID 
	if { ! [info exists _ID] } {  set _ID 1 }
	incr _ID 
	return ID($_ID) 
}

proc idNum { id } {
	regsub {(.+[(])(.*)([)])} $id {\2} id
	return $id
}

proc canvasClear { c } {

	global _ID
	set _ID 1
	$c delete Obj
	
}

### FIX ME
###
### CanvasCreate and CanvasAddList are inefficient and ugly.
##
## Use associative arrays for the argument processing.
## cleanup code dealing with filled/unfilled.
## merge actual create code into one routine
## pull in all args for object from disk and just fiddle/delete
## ones that need to be processed.
##
# Id = 
#		0 - keep id from file
#		1 - allow new id
#		ID(x) - use $id as new id.

proc canvasAddList { name id list {heir ""}} {
	upvar #0 $name data

	global _ID
	set max -1000

	set c $data(Canvas)
	set newid {}
	if { $id != "0" } { 
		if { $id == "1" } {
			set newid [newID]
		} else {
			set newid $id
		}
	}
	foreach o $list {
		set ty [lindex $o 0]
		if { $ty == "" } { continue }
		if { $ty == "canvas" } { set ty Sheet1 }
		if {  [lsearch -exact $data(Sheets) $ty] == "-1" } { 
			Log "Sheet $ty is unknown" 
			continue
		}
		set itemtype [lindex $o 1]
		set coords [lindex $o 2]
#		set coords [$scaleproc $scale $coords]
		set opts [join [lrange $o 4 end]]
		set tags [lindex $o 3]
		if { $id  != "0" } {
			set tags [listDel ID $tags]
			lappend tags $newid
		}
		set type [listGet Type $tags]
		set doutline "-outline $data(Unknown,outline)"
		set dfill 	"-fill $data(Unknown,fill)"
		set width 	"-width $data(Unknown,width)"

		if { $data(ColourMode) == "ByType" } {
			set cref $type
		} else  {
		  set cref [listGet Layer $tags]
		} 
		catch { set doutline "-outline [list $data($cref,outline)]"}
		catch { set dwidth   "-width   [list $data($cref,width)]"}
		catch { set dfill    "-fill    [list $data($cref,fill)]"}

		set fnt     ""

		set opt ""
		if { $itemtype == "line" } {
			set opt "[listOpt -joinstyle $opts] [listOpt -capstyle $opts]"
		}
		if { $itemtype == "arc" } {
			set opt "[listOpt -start $opts] [listOpt -extent $opts] -style arc"
		}
		if { ! [inList Obj $tags] } {
			lappend tags Obj
		}
		if { ! [inList Obj $tags] } {
			set tags "Obj $tags"
		}
		if { [inList Filled $tags] } {
			if { $doutline != "" } {
				set fill "-fill [list [lindex $doutline 1]]"
				set outline "-outline [list {}]"
			}
		} else {
			if { $dfill != "" } {
			  set outline "-outline  [list [lindex $dfill 1]]"
			  set fill "-fill [list {}]"
			}
		}
		if { $itemtype == "text" } {
			set width ""
			set fill "-fill [list [lindex $dfill 1]]"
			set outline ""
			set fnt 	$data(Unknown,font)
			catch {set fnt	$data($cref,font) }
			if { $fnt != "" } { set fnt "-font [list $fnt]" }
			set opt "[listOpt -text $opts] [listOpt -anchor $opts]"
		}
		if { $itemtype == "line" } {
			if {  $doutline != "" } {
				set fill "-fill [list [lindex $doutline 1]]"
			} else {
				set fill "-fill [list [lindex $dfill 1]]"
			}
			set outline ""
		}
		if {$type == "Track" } {
			set width [listOpt -width $opts]
		}
		set item "$data(Canvas) create $itemtype $coords \
			-tags \"$tags\" \
			 $fill $outline $width $fnt $opt"
		Log "create $item"
		set xid [eval $item]
		$c raise $xid $type

		set n [listGet ID $tags]
		if { $n > $max } { set max $n }
	}
	if { $id == "0" && $max > 1} {
		set _ID $max
		Log "New ID set : $max"
	}
	$c raise Grid
	$c raise Cursor
	return $newid
}

proc canvasGetList { sheet c ref } {


	set olist [list]
	foreach o [$c find withtag $ref] {
		set ty [$c type $o]
		set co [$c coords $o]
		set tags {}
		set opts {}
		foreach cfg [$c itemconfigure $o] {
			set opt [lindex $cfg 0]
			set data [lindex $cfg 4]
			if { "$opt" == "-tags" } {
				set tags $data
			} else {
				lappend opts $opt
				lappend opts $data
			}
		}
#		set tags [listDel ID $tags]
		lappend olist [list $sheet $ty $co $tags $opts]
	}
	Log "getlist [join $olist \n]"
	return $olist

}

proc canvasCreate { name itemtype  coords {type ""} {id ""} {otags ""} {oopt ""}} {
	upvar #0 $name data

	if { $type == "" } {
		set type    $data(edit,Type)
	}
	if { $id == "" } {
		set id [newID]
	}
	set outline "-outline $data(Unknown,outline)"
	set fill 	"-fill $data(Unknown,fill)"
	set width 	"-width $data(Unknown,width)"
	if { $data(ColourMode) == "ByType" } {
		set cref $type
	} else  {
		  set cref $data(edit,Layer)
	} 
	catch { set outline "-outline [list $data($cref,outline)]"}
	catch { set width   "-width   [list $data($cref,width)]"}
	catch { set fill    "-fill    [list $data($cref,fill)]"}
	set fnt ""
	set other ""

	if { $itemtype == "line"  } {
		set oopt "$oopt -joinstyle round -capstyle round"
		if {  $outline != "" } {
			set fill "-fill [list [lindex $outline 1]]"
		}
		set outline ""
	}
	if { $itemtype == "text" } {
		set width ""
		set fill "-fill [list [lindex $outline 1]]"
		set outline ""
		set fnt	"-font [list $data($cref,font)]"
	}
	if { $itemtype != "text" && $itemtype != "line" && ($data(edit,filled) || [inList Filled $otags])} {
		if {  $outline != "" } {
			set fill "-fill [list [lindex $outline 1]]"
			set outline "-outline {}"
		}
		if { ! [inList Filled $otags] } {
			set other "Filled"
		}
	} else {
		set outline "-outline  [list [lindex $fill 1]]"
		set fill "-fill [list {}]"
	}
	if { $itemtype == "line" || $itemtype == "text" } {
		set fill "-fill [list [lindex $outline 1]]"
		set outline ""
	}
	set item "$data(Canvas) create $itemtype $coords \
		-tags \"$id Obj Type($type) Layer($data(edit,Layer)) $other $otags\" \
		 $fill $outline $width $fnt $oopt"
	Log "create $item"
	set id [eval $item]
	catch {$data(Canvas) raise $id $type}
	return $id
}






















