# test_axis.tcl --
#     Test the drawing of the axis: nice rounded values?
#     And vertical text to right axis?
#
#     NOTE:
#     Negative values require floor() instead of ceil()!
#
#     NOTE:
#     Problem with right axis!
#
#     TODO:
#     Floor and Ceil and less stringent check for bounds!
#

set base [file dirname [file dirname [file dirname [file normalize [info script]]]]]

source "$base/modules/plotchart/plotchart.tcl"
source "$base/modules/crosshair/crosshair.tcl"

package require Plotchart

grid [canvas .c1] [canvas .c2]
grid [canvas .c3] [canvas .c4]
grid [canvas .c5] [canvas .c6]
grid [canvas .c7] [canvas .c8]

#
# Create the plots
#

set plot_axes [list { 0.12  10.4  1.0} {-0.12  10.4  2.5} \
		    {10.12 -10.4 -2.0} {-5.1   -4.5  0.1} \
	            {-0.12  10.4  2.5} { 0.12  10.4  1.0} \
		    {-5.1   -4.5  0.1} {10.12 -10.4 -2.0} \
		    { 0.12  10.4  1.0} {-0.12  10.4  2.5} \
		    {10.12 -10.4 -2.0} {-5.1   -4.5  0.1} \
	            {-0.12  10.4  2.5} { 0.12  10.4  1.0} \
		    {-5.1   -4.5  0.1} {10.12 -10.4 -2.0}]
set i 1
foreach {x y} $plot_axes {
    set p($i) [::Plotchart::createXYPlot .c${i} $x $y]
    incr i
}


# Adding crosshairs to the plots
set i 1
array set color {1 blue 2 red 3 green 4 black 5 blue 6 red 7 green 8 black}
foreach {x y} $plot_axes {
    .c${i} configure -cursor tcross
    crosshair::crosshair .c$i -dash {.} -fill $color($i)
    crosshair::track on  .c$i put_coords
    set bbox_ll [::Plotchart::coordsToPixel [$p($i) canvas] [lindex $x 0] [lindex $y 0]]
    set bbox_ur [::Plotchart::coordsToPixel [$p($i) canvas] [lindex $x 1] [lindex $y 1]]

    #--- testing coordinate mixed up
    if {$i==0} {
	set bbox [concat $bbox_ll $bbox_ur]
    } elseif {$i==1} {
	set bbox [list [lindex $bbox_ur 0] [lindex $bbox_ll 1] [lindex $bbox_ll 0] [lindex $bbox_ur 1]]
    } elseif {$i==2} {
	set bbox [list [lindex $bbox_ll 0] [lindex $bbox_ur 1] [lindex $bbox_ur 0] [lindex $bbox_ll 1]]
    } else {
	set bbox [concat $bbox_ur $bbox_ll]
    }
    crosshair::bbox_add .c$i "$bbox"

    puts "plot $i ==> bbox== $bbox  color = $color($i)"

    incr i
}


#--- Testing crosshairs with scaling on the bottom 4 plots.
.c5 scale all 0 0 0.50 0.50
.c6 scale all 0 0 0.50 0.75
.c7 scale all 0 0 1.00 1.00
.c8 scale all 0 0 2.00 1.50

proc put_coords {a b c d e f g} {
    set pcoords [::Plotchart::pixelToCoords $a $b $c]
    set pcoord_x [lindex $pcoords 0]
    set pcoord_y [lindex $pcoords 1]
    puts "Canvas=$a Canvas_Coords=($b $c)  PlotChart_plot_coords=([format "%.2f %.2f" $pcoord_x $pcoord_y])"
}

catch { console show }

2013-03-25  Andreas Kupries  <andreas_kupries@users.sourceforge.net>

	*
	* Released and tagged Tklib 0.6 ========================
	* 

2013-02-25  Andreas Kupries  <andreas_kupries@users.sourceforge.net>

2013-04-26  Andreas Kupries  <andreask@activestate.com>

	* crosshair.tcl: [Bug 3603562]: Integrated changes made by Frank
	* pkgIndex.tcl: to automatically track changes in canvas scale,
	* ../../examples/canvas/crosshair_scaled.tcl: i.e. zooming. Bumped
	  version to 1.2 (new feature). New example for scaling.

2013-03-25  Andreas Kupries  <andreas_kupries@users.sourceforge.net>

	*
	* Released and tagged Tklib 0.6 ========================
	* 

2013-02-25  Andreas Kupries  <andreas_kupries@users.sourceforge.net>

proc ::crosshair::bbox_add { w bbox } {
    variable config
    if { ![info exists config($w)] } {
	return -code error "no crosshairs in $w"
    }
    array set opts $config($w)

    # Sort the coordinates and make sure the bbox is in format
    # "lower-left upper-right". The larger Y is on the lower left and
    # the larger X is on the upper right.


    set x_coords [lsort -real -increasing [list [lindex $bbox 0] [lindex $bbox 2]]]
    set y_coords [lsort -real -decreasing [list [lindex $bbox 1] [lindex $bbox 3]]]

    set bbox [list \
		  [lindex $x_coords 0] [lindex $y_coords 0] \
		  [lindex $x_coords 1] [lindex $y_coords 1]]

    lappend opts(bbox) $bbox
    set config($w) [array get opts]





    set token bbox$w/[llength $opts(bbox)]

    return $token
}

#----------------------------------------------------------------------
#
# ::crosshair::bbox_remove --
#
................................................................................
	unset opts(bbox)
    } else {
	# Keep remainder.
	set opts(bbox) $newboxes
    }

    set config($w) [array get opts]




    return
}

#----------------------------------------------------------------------
#
# ::crosshair::track --
#
................................................................................
    # slow. If that happens consider creation and maintenance of some
    # fast data structure (R-tree, or similar) which can take
    # advantage of overlap and nesting to quickly rule out large
    # areas. Note that such a structure has its own price in time,
    # memory, and code complexity.

    set first 1
    foreach box $opts(bbox) {
	# Ignore removed boxes, not yet cleaned up. Note that we have
	# at least one active box here to touch by the loop. If we had
	# none the bbox_remove command ensured that (x) above
	# triggered.
	if {![llength $box]} continue


	# Ignore all boxes we are outside of. They do not go into the
	# boundary calculation.

	if {[Outside $box $x $y]} continue

	# Unfold the box data and check if its boundaries are better
	# (less restrictive) than we currently have, or if this is the
	# first restriction.
	set nllx [lindex $box 0]

	set nlly [lindex $box 1]
	set nurx [lindex $box 2]
	set nury [lindex $box 3]

	if {$first || ($nllx < $llx)} { set llx $nllx }
	if {$first || ($nlly > $lly)} { set lly $nlly }
	if {$first || ($nurx > $urx)} { set urx $nurx }
	if {$first || ($nury < $ury)} { set ury $nury }

	set first 0
................................................................................
    # visibility.
    #puts LIMIT($x,$y):$llx,$lly,$urx,$ury
    return 1
}

proc ::crosshair::Outside { box x y } {
    # Unfold box
    set llx [lindex $box 0]
    set lly [lindex $box 1]
    set urx [lindex $box 2]
    set ury [lindex $box 3]

    #puts \tTEST($x,$y):$llx,$lly,$urx,$ury:[expr {($x < $llx) || ($x > $urx) || ($y < $lly) || ($y > $ury)}]

    # Test each edge. Note that the border lines are considered as "outside".


    expr {($x <= $llx) ||
	  ($x >= $urx) ||
	  ($y >= $lly) ||
	  ($y <= $ury)}
}

#----------------------------------------------------------------------
#
# ::crosshair::Move --
#
#       Moves the crosshairs in a camvas
................................................................................
    bind Crosshair <Leave>   "[namespace code Hide] %W"
    bind Crosshair <Motion>  "[namespace code Move] %W %x %y"
}

# ### ### ### ######### ######### #########
## Ready

package provide crosshair 1.1

proc ::crosshair::bbox_add { w bbox } {
    variable config
    if { ![info exists config($w)] } {
	return -code error "no crosshairs in $w"
    }
    array set opts $config($w)

    if {[info exists opts(bbox)]} {
	set len [llength $opts(bbox)]
    } else {
	set len 0
    }

    set token bbox$w/$len





    lappend opts(bbox) $token
    set config($w) [array get opts]
 
    foreach {nllx nlly nurx nury} $bbox break
    # Tcl 8.4 foreach-as-lassign hack
    set rect [$w create rect \
		  $nllx $nlly $nurx $nury \
		  -tags $token -state hidden]

    return $token
}

#----------------------------------------------------------------------
#
# ::crosshair::bbox_remove --
#
................................................................................
	unset opts(bbox)
    } else {
	# Keep remainder.
	set opts(bbox) $newboxes
    }

    set config($w) [array get opts]
    
    #--- Delete Bbox
    $w delete $token 
    
    return
}

#----------------------------------------------------------------------
#
# ::crosshair::track --
#
................................................................................
    # slow. If that happens consider creation and maintenance of some
    # fast data structure (R-tree, or similar) which can take
    # advantage of overlap and nesting to quickly rule out large
    # areas. Note that such a structure has its own price in time,
    # memory, and code complexity.

    set first 1
    foreach token $opts(bbox) {
	# Ignore removed boxes, not yet cleaned up. Note that we have
	# at least one active box here to touch by the loop. If we had
	# none the bbox_remove command ensured that (x) above
	# triggered.
	if {$token eq {}} continue

	# Get the box data, then test for usability. Ignore all boxes
	# we are outside of. They are not used for the boundary
	# calculation.
	set box [$w coords $token]
	if {[Outside $box $x $y]} continue

	# Unfold the box data and check if its boundaries are better
	# (less restrictive) than we currently have, or if this is the
	# first restriction.


	foreach {nllx nlly nurx nury} $box break



	if {$first || ($nllx < $llx)} { set llx $nllx }
	if {$first || ($nlly > $lly)} { set lly $nlly }
	if {$first || ($nurx > $urx)} { set urx $nurx }
	if {$first || ($nury < $ury)} { set ury $nury }

	set first 0
................................................................................
    # visibility.
    #puts LIMIT($x,$y):$llx,$lly,$urx,$ury
    return 1
}

proc ::crosshair::Outside { box x y } {
    # Unfold box
    foreach {llx lly urx ury} $box break



 
    #puts \tTEST($x,$y):$llx,$lly,$urx,$ury:[expr {($x < $llx) || ($x > $urx) || ($y < $lly) || ($y > $ury)}]

    # Test each edge. Note that the border lines are considered as
    # "outside".

    expr {($x <= $llx) ||
	  ($x >= $urx) ||
	  ($y <= $lly) ||
	  ($y >= $ury)}
}

#----------------------------------------------------------------------
#
# ::crosshair::Move --
#
#       Moves the crosshairs in a camvas
................................................................................
    bind Crosshair <Leave>   "[namespace code Hide] %W"
    bind Crosshair <Motion>  "[namespace code Move] %W %x %y"
}

# ### ### ### ######### ######### #########
## Ready

package provide crosshair 1.2

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
package ifneeded crosshair 1.1 [list source [file join $dir crosshair.tcl]]

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
package ifneeded crosshair 1.2 [list source [file join $dir crosshair.tcl]]