package provide carto 0.3
 # Creates the carto command handler for canvas widgets.
	# The canvas coordinate space is changed to a cartographic coordinate space
	# where y coordinates are positive northt. A number of functions
	# facilitating cartography are added for convinience.
	# The shape primitives of the canvas widget are not affected by the carto command.
	# Two new virtual primitives are added: symbol and crosshair which are special
	# composit canvas primitives.
	# Usage :
	# carto pathName ?options?
	# Example:
	# carto .c -setview {0 200 200 200}
	# pack .c
	# (C) 2004-2005, Dimitrios Zachariadis
	# Licensed under the BSD License
	#
 proc carto {w args} {
	namespace eval ::carto::${w} {
		variable var
		array set var [list \
			-autoscale "meet" \
			-detail 1 \
			-meets "x" \
			-pixelaspectratio 1 \
			-space cartesian \
			w 200 \
			h 200 \
			scale 1 \
			cxy {}
		]
	}
	upvar ::carto::${w}::var v
	if {![winfo exists $w]} {
		eval [list canvas $w -width 200 -height 200]
	}
	rename ::$w ::_$w
	::carto::dispatchConfig $w $args
	# the window dimensions returned by winfo include border and highlight
	# which we must subtract to get the actual width and height
	set brdrs [expr {2*([::_$w cget -highlightthickness]+[::_$w cget -borderwidth])}]
	scan [winfo geometry $w] "%dx%d" v(ww) v(wh)
	set v(ww) [expr {$v(ww)-$brdrs}]
	set v(wh) [expr {$v(wh)-$brdrs}]
	::_$w configure -xscrollincrement 1
	::_$w configure -yscrollincrement 1
	bind $w <Configure> {::carto::setScale %W}
	proc ::$w {cmd args} "return \[eval ::carto::Handler $w \$cmd \$args]"
	set w
 }

 namespace eval carto {
	proc Handler {w cmd args} {
	 	set debug 0
		upvar ::carto::${w}::var v
		switch -- $cmd {
			center {
				set vcx [expr {([::_$w canvasx 0]+$v(ww)/2.0)/($v(scale)*$v(-pixelaspectratio))}]
				set vcy [expr {-([::_$w canvasy 0]+$v(wh)/2.0)/$v(scale)}]
				if {$args=={}} {
					return [list $vcx $vcy $v(scale)]
				}
				if {[llength $args]!=3} {
					error "wrong # args: should be \"$w center x y scale\""
				}
				set redraw 0
				# Set center of cartoview and scale
				foreach {x y scale} $args {}
				# if scale has changed find the new viewbox width
				if {$scale!="-"} {
					set v(scale) $scale
					if {$debug} {puts "...set scale to $v(scale)"}
					set v(w) [expr {double($v(ww))/($v(scale)*$v(-pixelaspectratio))}]
					set v(h) [expr {double($v(wh))/$v(scale)}]
					# scale changed so force a redraw
					set redraw 1
				}
				# if x or y did not change, get them from current view
				if {$x=="-" || $x==""} {
					set x $vcx
				}
				if {$y=="-" || $y==""} {
					set y $vcy
				}
				# set viewbox according to the new center
				set x0 [expr {$x-$v(ww)/(2.0*$v(scale)*$v(-pixelaspectratio))}]
				set y0 [expr {$y+$v(wh)/(2.0*$v(scale))}]
				# Redraw or just scroll canvas to view
				if {$redraw} {
					if {$debug} {puts "...generating event $w <<CartoRedraw>>"}
					event generate $w <<CartoRedraw>>
				}
				setScroll $w $x0 $y0
			}
			cget {
				switch -- [lindex $args 0] {
					-autoscale {return $v(-autoscale)}
					-detail {return $v(-detail)}
					-meets {return $v(-meets)}
					-space {return $v(-space)}
					-pixelaspectratio {return $v(-pixelaspectratio)}
					default {eval {::_$w $cmd } $args}
				}
			}
			config -
			configure {eval [list dispatchConfig $w] $args}
			create {
				switch -- [lindex $args 0] {
					crosshair {
						if {[llength $args]<2} {
							error "wrong # args: should be \"$w create crosshair tag ?option value?\""
						}
						set tag [lindex $args 1]
						eval [list ::_$w create line -3000 0 3000 0  -tag [list $tag ${tag}x]] [lrange $args 2 end]
						eval [list ::_$w create line 0 -3000 0 3000  -tag [list $tag ${tag}y]] [lrange $args 2 end]
						foreach {x1 y1 x2 y2} [::_$w bbox $tag] {}
						set v($tag,offset) [list [expr {(abs($x1)+abs($x2))/2.0}] [expr {(abs($y1)+abs($y2))/2.0}]]
						# save tag in a list so that we can find it for redraw
					}
					default {eval [list ::_$w $cmd] $args}
				}
			}
			delete {
				set tag [lindex $args 0]
				if {[info exists v($tag,offset)]} {
					unset v($tag,offset)
				}
				eval [list ::_$w $cmd] $args
			}
			destroy {
				# destroy canvas widget and carto command
				namespace delete ::carto::${w}
				destroy ::$w
				rename ::$w {}
				rename ::_$w {}
			}
			forget {
				# destroy carto command but retain carto widget
				namespace delete ::carto::${w}
				rename ::$w {}
				rename ::_$w ::$w
			}
			Move {
				if {[llength $args]<3} {error "wrong # args: should be \"$w Move tagOrId x y\""}
				foreach {tag x y} $args {}
				# calculate tag's center coords
				foreach {bbx1 bby1 bbx2 bby2} [::_$w bbox $tag] {}
				if {![info exists bbx1]} {
					# couldn't find tag
					return
				}
				if {![info exists v($tag,offset)]} {
					# tag is not a symbol
					set cx0 $bbx1
					set cy0 $bby1
				} else {
					set cx0 [expr {($bbx1+[lindex $v($tag,offset) 0])}]
					set cy0 [expr {($bby1+[lindex $v($tag,offset) 1])}]
				}
				set cx [expr {$x*$v(scale)*$v(-pixelaspectratio)}]
				set cy [expr {-$y*$v(scale)}]
				::_$w move $tag [expr {$cx-$cx0}] [expr {$cy-$cy0}]
			}
			Plot {
				# accepts one of:
				# pathName Plot x y ?-tag tag? ?-mode [abs|rel]? ?-space [cartesian|polar]? ?-option option?
				# pathName Plot {x y ...} ?-option option?
				if {$debug} {puts "Plot...args=$args"}
				set arglen [llength $args]
				if {$arglen==0 || $arglen==2 || $arglen==4} {
					return;error "wrong # args: should be \"$w Plot tagOrId ?x y ... ?\""
				}
				foreach  {tag x1 y1 x2 y2} [lrange $args 0 4] {}
				if {[::_$w find withtag $tag]=={}} {
					# this is a new tag
					if {$x2=={}} {
						set x2 $x1
						set y2 $y1
					}
					::_$w create line \
						[expr {$x1*$v(scale)*$v(-pixelaspectratio)}]  [expr {-$y1*$v(scale)}] \
						[expr {$x2*$v(scale)*$v(-pixelaspectratio)}]  [expr {-$y2*$v(scale)}] \
						-tag $tag -fill grey
					if {$arglen>5} {
						set d [::_$w coords $tag]
						foreach {x y} [lrange $args 5 end] {
							lappend d  [expr {$x*$v(scale)*$v(-pixelaspectratio)}]  [expr {-$y*$v(scale)}]
						}
						::_$w coords $tag $d
					}
				} else {
					set d [::_$w coords $tag]
					foreach {x y} [lrange $args 1 end] {
						lappend d  [expr {$x*$v(scale)*$v(-pixelaspectratio)}]  [expr {-$y*$v(scale)}]
					}
					::_$w coords $tag $d
				}
			}
			lPlot {
				if {$debug} {puts "lPlot...args=$args"}
				if {[llength $args]<=5} {return;error "wrong # args: should be \"$w lPlot tagOrId ?x1 y1 x2 y2 ... ?\"" }
				set tag [lindex $args 0]
				if {[::_$w find withtag $tag]!={}} {
					foreach {x y} [lrange $args 1 end] {
						lappend d  [expr {$x*$v(scale)*$v(-pixelaspectratio)}]  [expr {-$y*$v(scale)}]
					}
				} else {
					foreach  {tag x1 y1 x2 y2} [lrange $args 0 4] {}
					lappend d  [expr {$x1*$v(scale)*$v(-pixelaspectratio)}]  [expr {-$y1*$v(scale)}]
					lappend d  [expr {$x2*$v(scale)*$v(-pixelaspectratio)}]  [expr {-$y2*$v(scale)}]
					::_$w create line $d -tag $tag -fill grey
					foreach {x y} [lrange $args 5 end] {
						lappend d  [expr {$x*$v(scale)*$v(-pixelaspectratio)}]  [expr {-$y*$v(scale)}]
					}
				}
				::_$w coords $tag $d
			}
			setview {
				set args [join $args]
				set vx0 [expr {[::_$w canvasx 0]/($v(scale)*$v(-pixelaspectratio))}]
				set vy0 [expr {-[::_$w canvasy 0]/$v(scale)}]
				if {$args=={}} {
					return [list $vx0 $vy0 [expr {$v(ww)/($v(scale)*$v(-pixelaspectratio))}] [expr {$v(wh)/$v(scale)}]]
				}
				if {[llength $args]!=4} {
					error "wrong # args: should be \"$w setview x y w h\""
				}
				set redraw 0
				foreach {x0 y0 wi hi} $args {}
				# do we need this ?
				if {$x0=="-"} {
					set x0 $vx0
				}
				if {$y0=="-"} {
					set y0 $vy0
				}
				# if viewbox width changed force redraw
				if {$wi!="-"} {
					set v(w) $wi
					set redraw 1
				}
				# if viewbox height changed force redraw
				if {$hi!="-"} {
					set v(h) $hi
					set redraw 1
				}
				# Redraw or just scroll canvas to view
				if {$redraw} {
					setScale $w
				}
				setScroll $w $x0 $y0
			}
			symbolize {
				if {[llength $args]!=1 && [llength $args]!=3} {
					error "wrong # args: should be \"$w symbolize tag ?offsetx offsety?\""
				}
				set symbol [lindex $args 0]
				if {[$w find withtag $symbol]=={}} {
					error "tag $symbol does not exist"
				}
				if {[llength $args]==1} {
					foreach {x1 y1 x2 y2} [::_$w bbox $symbol] {}
					set v($symbol,offset) [list [expr {($x2-$x1)/2.0}] [expr {($y2-$y1)/2.0}]]
				} else {
					set v($symbol,offset) [lrange $args 1 end]
				}
			}
			default {eval [list ::_$w $cmd] $args}
		}
	}

	#dispatch configure pairs
	proc dispatchConfig {w args} {
		set debug 0
		if {$debug} {puts "dispatchConfig called by [expr {[info level]>1?[lindex [info level -1] 0]:[list user]}]"}
		# strip possible ::_ so that namespace is referenced properly
		regexp {^(::_)*(.*)} $w m pre wg
		upvar ::carto::${wg}::var v
		if {[llength $args]==0} {
			return [concat [eval {::_$w configure}] \
				[list [list -space $v(-space)]] \
				[list [list -pixelaspectratio $v(-pixelaspectratio)]] \
				[list [list -autoscale $v(-autoscale)]] \
				]
		}
		foreach {opt val} $args {
			switch -- $opt {
				-autoscale {
					if {$val=={}} {return $v(-autoscale)}
					if {![regexp -- {meet|slice|none} $val]} {
						error "unknown option $val: should be meet, slice or none"
					}
					set v(-autoscale) $val
				}
				-detail {
					if {$val=={}} {return $v(-detail)}
					if {![string is int $val]} {
						error "expected integer but got $val"
					}
					set v(-detail) $val
				}
				-space {
					if {$val=={}} {return $v(-space)}
					if {![regexp -- {meet|slice|none} $val]} {
						error "unknown option $val: should be cartesian or polar"
					}
					set v(-space) $val
				}
				-pixelaspectratio {
					if {$val=={}} {return $v(-pixelaspectratio)}
					if {![string is double $val]} {
						error "expected real but got $val"
					}
					set v(-pixelaspectratio) $val
				}
				default {eval {::_$w configure} $opt $val}
			}
		}
	}

	proc setScale wg {
		set debug 0
		if {$debug} {puts "setScale called by [expr {[info level]>1?[lindex [info level -1] 0]:[list user]}]"}
		upvar ::carto::${wg}::var v
		scan [winfo geometry $wg] "%dx%d" v(ww) v(wh)
		set brdrs [expr {2*([::_$wg cget -highlightthickness]+[::_$wg cget -borderwidth])}]
		set v(ww) [expr {$v(ww)-$brdrs}]
		set v(wh) [expr {$v(wh)-$brdrs}]
		set aspectratio [expr {double($v(ww))/$v(wh)}]
		switch -regexp -- $v(-autoscale) {
			meet {
				# max(viewbox) -> min(window)
				if {$v(wh)!=0 && $v(w)!=0 && $v(h)!=0} {
					if {double($v(w))/$v(h)>$aspectratio} {
						set v(-meets) "x"
						set v(scale) [expr {double($v(ww))/$v(w)}]
					} else {
						set v(-meets) "y"
						set v(scale) [expr {double($v(wh))/$v(h)}]
					}
				}
			}
			slice {
				# min(viewbox) -> max(window)
				if {$v(wh)!=0 && $v(w)!=0 && $v(h)!=0} {
					if {double($v(w))/$v(h)>$aspectratio} {
						set v(-meets) "y"
						set v(scale) [expr {double($v(wh))/$v(h)}]
					} else {
						set v(-meets) "x"
						set v(scale) [expr {double($v(ww))/$v(w)}]
					}
				}
			}
			none {
				# no event is generated
				return
			}
			default {
				return
			}
		}
 #		set v(w) [expr {double($v(ww))/$v(scale)}]
 #		set v(h) [expr {double($v(wh))/$v(scale)}]
		if {$debug} {puts "...event generate $wg <<CartoRedraw>>"}
		event generate $wg <<CartoRedraw>>
		if {$debug} {puts "...set scale to $v(scale)"}
	}

	proc setScroll {w x0 y0} {
		upvar ::carto::${w}::var v
		::_$w xview scroll [expr {round($x0*$v(scale)*$v(-pixelaspectratio)-[::_$w canvasx 0])}] u
		::_$w yview scroll [expr {-round($y0*$v(scale)+[::_$w canvasy 0])}] u
	}

	proc screentocarto {w x y} {
		upvar ::carto::${w}::var v
		return [list \
				[expr {($x+[::_$w canvasx 0])/($v(scale)*$v(-pixelaspectratio))}] \
				[expr {-($y+[::_$w canvasy 0])/$v(scale)}]]
	}
	proc tocarto {w x y} {
		upvar ::carto::${w}::var v
		return [list [expr {$x/($v(scale)*$v(-pixelaspectratio))}] [expr {-$y/$v(scale)}]]
	}
	proc tocanvas {w x y} {
		upvar ::carto::${w}::var v
		return [list [expr {$x*$v(scale)*$v(-pixelaspectratio)}] [expr {-$y*$v(scale)}]]
	}
	proc centertoview {w args} {
	}
	proc viewtocenter {w args} {
	}
 }