#
# zoombox.tcl -- A little blt::graph window that has a box in it
#                which the user can move around. In NLV, this
#                moves the "zoom window" in the graph window.
#
# $Author: mstoufer $
# $Date: 2000/12/05 19:52:33 $
# $Id: zoombox.tcl,v 1.1.1.1 2000/12/05 19:52:33 mstoufer Exp $
#
# Original author: Dan Gunter
# Original date  : 12/10/1999
#

namespace eval zscroll {
    proc create { path callback } {
	global widget param

	# Button options
	set bopts [list -bg $param(color-buttonbg) -fg $param(color-buttonfg) \
		       -activebackground $param(color-buttonabg) \
		       -highlightbackground $param(color-ctlbg) -font $param(bigfont) ]	
	# Frames
	set path [frame $path.all -bg $param(color-ctlbg)]
	frame $path.mid -bg $param(color-ctlbg)
	frame $path.mid.r -bg $param(color-ctlbg)
	frame $path.mid.l -bg $param(color-ctlbg)
	frame $path.bot -bg $param(color-ctlbg)

	# Arrow buttons
	eval { button $path.mid.r.zup -bitmap arrow_up -width 11 -height 10 \
		   -command zscroll::up } $bopts
	eval { button $path.mid.r.zdown -bitmap arrow_down -width 11 -height 10 \
		   -command zscroll::down } $bopts
	eval { button $path.bot.zleft -bitmap arrow_left -width 11 -height 10 \
		   -command zscroll::left } $bopts
	eval { button $path.bot.zright -bitmap arrow_right -width 11 -height 10 \
		   -command zscroll::right } $bopts	
	
	blt::graph $path.zscroll \
	    -title "" \
	    -width 50 \
	    -height 50 \
	    -plotpadx 0 \
	    -plotpady 0 \
	    -leftmargin 5 \
	    -topmargin 20 \
	    -bottommargin 5 \
	    -rightmargin 5 \
	    -bg $param(color-ctlbg)
	$path.zscroll xaxis configure -hide 1
	$path.zscroll yaxis configure -hide 1
	$path.zscroll grid configure \
		-color #eeeeee \
		-dashes 0 \
		-hide 0
	$path.zscroll legend configure -hide 1
	
 	set c "#cc2222"
	$path.zscroll element create zsbox \
	    -symbol none \
	    -linewidth 5 \
	    -color $c \
	    -data { 0 0 0 1 1 1 1 0 0 0 }
	#
	# Pack arrows and graph
	#
	pack $path.bot.zleft $path.bot.zright -side left -fill both -expand 1
	pack $path.zscroll -in $path.mid.l -side left -fill both -expand 1
	pack $path.mid.r.zup $path.mid.r.zdown -side top -fill both -expand 1
	pack $path.mid.l $path.mid.r -side left -fill both -expand 1
	pack $path.mid $path.bot -side top -fill both -expand 1
	pack $path

	set widget(zscroll) $path.zscroll
	set param(zscroll,callback) $callback
	set param(zscroll,b1) { -1 -1 }
	
	bind $path.zscroll <ButtonPress-1> {
	    set isElt [%W element closest %x %y e -halo 5 \
		    -interpolate yes]
	    if { $isElt } {
		set param(zscroll,b1) [%W invtransform %x %y]
	    } else {
		set param(zscroll,b1) { -1 -1 }
	    }
	}

	bind $path.zscroll <ButtonRelease-1> {
	}

	bind $path.zscroll <B1-Motion> {
	    global param
	    if { [lindex $param(zscroll,b1) 0] != -1 } {
		set coords [%W invtransform %x %y]
		set x [lindex $coords 0]
		set y [lindex $coords 1]
		if { $x < 0 || $x > 1 || $y < 0 || $y > 1 } { 
		} else {
		    set deltax [expr $x - [lindex $param(zscroll,b1) 0] + 0.0]
		    set deltay [expr $y - [lindex $param(zscroll,b1) 1] + 0.0]
		    zscroll::shift $deltax $deltay
		    set param(zscroll,b1) $coords
		}
	    }
	}
	return $path.zscroll
    }

    proc bounds { } {
	global widget
	$widget(zscroll) xaxis configure -min 0 -max 1
	$widget(zscroll) yaxis configure -min 0 -max 1
    }

    proc resize { x0 y0 x1 y1 } {
	global widget
	$widget(zscroll) element configure zsbox \
	    -data [ list \
			$x0 $y0 $x0 $y1 \
			$x1 $y1 $x1 $y0 $x0 $y0 ]
	bounds
    }

    proc shift { dx dy } {
	global widget param
	set cur [$widget(zscroll) element cget zsbox -data]
	set curlen [llength $cur]
	set new { }
	for { set i 0 } { $i < $curlen } { incr i 2 } {
	    lappend new [expr [lindex $cur $i] + $dx * 1.0]
	    lappend new [expr [lindex $cur [expr $i + 1]] + $dy * 1.0]
	}
	if { [lindex $new 0] < 0 || [lindex $new 1] < 0 \
		|| [lindex $new 4] > 1 || [lindex $new 5] > 1 } {
	    return
	}
	$widget(zscroll) element configure zsbox -data $new
	bounds
	$param(zscroll,callback) [lindex $new 0] [lindex $new 1] [lindex $new 4] [lindex $new 5]
    }

    # Width of zoom box
    proc curwidth { } {
	global widget
	set cur [$widget(zscroll) element cget zsbox -data]
	return [expr [lindex $cur 4] - [lindex $cur 0]]
    }

    # Height of zoom box
    proc curheight { } {
	global widget
	set cur [$widget(zscroll) element cget zsbox -data]
	return [expr [lindex $cur 3] - [lindex $cur 1]]
    }

    # Move up 10%
    proc up { } {
	shift 0 [expr [curheight] / 10 ]
    }

    # Move down 10%
    proc down { } {
	shift 0 [expr [curheight] / -10 ]
    }

    # Move left 10%
    proc left { } {
	shift [expr [curwidth] / -10 ] 0
    }

    # Move right 10%
    proc right { } {
	shift [expr [curwidth] / 10 ] 0
    }

    proc title { str } {
      global widget
      $widget(zscroll) configure -title $str
    }
    proc title_font { fn } {
      global widget
      $widget(zscroll) configure -font $fn
    }
    proc frame_size { w h } {
      global widget
      $widget(zscroll) configure -width $w -height $h
    }
}
