##########################################################################
#
# statline.tcl -- Show a "status line", which represents the time span of
#                 the entire graph, and allow arbitrary bitmaps to
#                 be placed on it and, optionally, dragged around by
#                 the user. This facility is good for (for starters):
#                    - Showing current position in the file.
#                    - Showing the indexer's position in the file
#                    - Showing user-created bookmarks
#                    - Showing system-created bookmarks
#
#                 The status line is on a canvas; the objects that show
#                 positions on the line are called "markers".
#
# Author: Dan Gunter
# Date  : 24 July 1998
#
##########################################################################

#############################
#
# SLInit --
#
#    Create the widget.
#
proc SLInit { path x0 y0 x1 y1 lw } {
    global param widget

    if { $path == "." } {
	set path ""
    }
    incr x0 20
    incr x1 20
    incr y0 20
    incr y1 20
    set param(SL,x0) $x0
    set param(SL,x1) $x1
    set param(SL,y0) $y0
    set param(SL,y1) $y1
    set param(SL,lw) $lw
    set param(SL,lw2) [expr $lw / 2]
    set param(SL,inner) [expr $x1 - $x0 - $lw]
    set param(SL,mid) [expr $y0 + ($y1 - $y0)/2]
    set widget(SL) [canvas $path.c \
			-background \#ffffff \
           		-highlightthickness 0 \
			-bd 0 ]
    # Put in invisible horizontal area for catching clicks
    $widget(SL) create line $x0 $param(SL,mid) $x1 $param(SL,mid) \
	-width [expr ($y1-$y0)] -fill \#ffffff
    # Make scale line
    $widget(SL) create line $x0 $y0 $x0 $y1 $x0 $param(SL,mid) \
	$x1 $param(SL,mid) $x1 $y0 $x1 $y1 \
	-width $lw \
	-tag ruler \
	-fill $param(color-rulerfill)
    $widget(SL) create text $x0 $y1 -text "?" -anchor n -tag lbound
    $widget(SL) create text $x1 $y1 -text "?" -anchor n -tag rbound
   

    # Put scale at ends
    SLUpdateScale $widget(SL) 0 $param(LastFileTime)

    SLRefit $widget(SL)

    pack $widget(SL) -side top -anchor center -expand 1 -fill both 
    return $widget(SL)
}

# Format the time function (macro-esque)
proc fmt_t { t } { 
    global param 
    return [format "%.1f" $t]
}

#############################
#
# SLTimeToPos --
#
#    Convert a time (in the range
#    shown by the status line) to
#    an X-coordinate in the
#    canvas.
#

proc SLTimeToPos { time } {
    global param SLStart SLEnd

    set t0 $SLStart
    set t1 $SLEnd
    #
    if { $time <= $t0 || [expr $t1-$t0+0.0] == 0 } {
	return [expr $param(SL,x0) + $param(SL,lw)]
    } 
    if { $time > $t1 } {
	return [expr $param(SL,x0) + $param(SL,inner) + 0.0] 
    }
    set x1 [expr ($time - $t0+0.0)/($t1-$t0+0.0)]
    set x2 [expr $x1*($param(SL,inner)+0.0)]
    set x3 [expr $x2+$param(SL,x0)]
    return $x3
}

#############################
#
# SLPosToTime --
#
#    Convert an X-coordinate on
#    the canvas to a time
#    value in the range 0..$param(LastFileTime)
#

proc SLPosToTime { pos } {
    global param SLStart SLEnd

    set t0 $SLStart
    set t1 $SLEnd
    set x1 [expr $pos - $param(SL,x0)]
    set x2 [expr $x1 / ($param(SL,inner)+0.0)]
    set x3 [expr $x2 * ($t1 - $t0 + 0.0) + $t0]
    return $x3
} 

#############################
#
# SLGetTime --
#
#    Get the "time" of the marker on
#    the canvas 'path' named 'w'.
#

proc SLGetTime { path w } {
    global param
    return $param(SL,T$path$w)
}

#############################
#
# SLAddMarker --
#
#    Add a new marker to the canvas.
#    The tag allows multiple markers
#    (e.g. text and a pointer) to be
#    grouped and moved, etc. together.
#
#

proc SLAddMarker { atag path bmp {color \#000000} time {updown down} {showtime no} } {
    global param widget

    if { $updown == "up" } {
	set shft -1
	set anch s
    } else {
	set shft 1
	set anch n
    }
    set bx [SLTimeToPos $time]
    set by [expr $param(SL,mid) + $shft * $param(SL,lw)]
    $path create bitmap $bx $by \
	-bitmap $bmp \
	-foreground $color\
	-anchor $anch \
	-tags $atag
    set w $atag
    if { $showtime } {
	set bbox [$path bbox $w]
	set widget(SL,T$path$w) \
	    [ $path create text $bx [expr $by + $shft*([lindex $bbox 3] - [lindex $bbox 1])] \
		  -text "0" \
		  -anchor $anch \
		  -tags $atag 
	     ]
    }
    SLRefit $path
    set param(SL,T$path$w) $time
    return $w
}

#############################
#
# SLMoveMarker --
#
#    Move a marker to a new position,
#    which is given as a time. This
#    is convenient because the main
#    program routines all deal with
#    times, not status-line coordinates.
#

proc SLMoveMarker { path tag newtime } {
    global param widget

    set dx [expr [SLTimeToPos $newtime] - [lindex [$path coords $tag] 0]]
    $path move $tag $dx 0
    set param(SL,T$path$tag) $newtime
    if { $tag == $widget(SL,urhere) } {
	SLMoveUrhere $path $widget(SL,T$path$tag) $param(SL,T$path$tag)
	RewindScaleChanged
    }
}
#############################
proc SLUpdateUrhere { }  {
    global widget param SLStart SLEnd

    if { $param(RewScaleValue) < $SLStart } {
	set param(RewScaleValue) $SLStart
    } elseif { $param(RewScaleValue) > $SLEnd } {
	set param(RewScaleValue) $SLEnd
    }
    SLMoveMarker $widget(SL) $widget(SL,urhere) $param(RewScaleValue)
}
#############################
proc SLMoveUrhere { path w t } {
    global param
    $path itemconfigure $w -text [fmt_t $t]
    set param(RewScaleValue) $t
}

#############################
#
# SLRemoveMarker --
#
#    Remove an existing marker.
#

proc SLRemoveMarker { path tag } {
    $path delete $tag
}

#############################
#
# SLRenameMarker --
#
#    Rename an existing marker with tag
#    'oldtag' to now have the tag 'newtag' (and,
#    not have the old one, of course).
#

proc SLRenameMarker { path oldtag newtag } {
#    puts "renaming $oldtag to $newtag"
    $path addtag $newtag withtag $oldtag
    $path dtag $oldtag
}

#############################
#
# SLMakeDraggable --
#
#    Allow all items on the canvas
#    given by 'path' which have the
#    tag 'tag' to be dragged to the
#    extents of the status-line.
#

proc SLMakeDraggable { path tag } {
    global widget
    set widget(drag) 0

    $path bind $tag <Button-1> " \
        global widget;\
        SLMark %W %x $tag; \
        set widget(drag) 1" 

    $path bind $tag <B1-Motion> "SLDrag %W %x $tag"
}
##################################
#
# SLUnbind --
#
#  Turn off button-'n' bindings for
#  items on the canvas 'path'
#  with tag 'tag'.
#
proc SLUnbind { n path tag } {
    set click "<Button-$n>"
    set move "<B$n-Motion>"
    eval { $path bind $tag $click {} }
    eval { $path bind $tag $move {} }
}

#############################
#
# SLMark --
#
#    When a user clicks on a draggable
#    item, this procedure is called. It
#    synchs the x-coordinate and time
#    variable for the marker.
#

proc SLMark { path x what } {
    global param

    set param(SL,X$path$what) $x
    set param(SL,T$path$what) [SLPosToTime $x]
}

#############################
#
# SLDrag --
#
#    When a user drags a marker, this
#    procedure is called. The actual
#    work of reconfiguring the marker is
#    done by SLMoveMarker.
#
#

proc SLDrag { path x what } {
    global param widget

    set m $param(SL,lw2)
    if { $x < [expr $param(SL,x0) + $m ] || $x > [expr $param(SL,x1) - $m ] } {
	return;
    }
    set param(SL,X$path$what) $x
    SLMoveMarker $path $what [SLPosToTime $x]
    update idletasks
}

#############################
#
# SLUpdateScale --
#
#    Update the numbers which sit
#    on the left-and right- hand
#    borders of the status-line.
#

proc SLUpdateScale { path t0 t1 } {
    global param

    set w lbound
    $path dchars $w 0 end
    $path insert $w 0 [fmt_t $t0]
#
    set w rbound
    $path dchars $w 0 end
    $path insert $w 0 [fmt_t $t1]
#
    SLRefit $path
}

#############################
# 
# SLRefit --
#
#    Redraw the widget so all its
#    elements fit with a standard amount
#    of padding.
#

proc SLRefit { path } {
    set bbox [$path bbox all]
    $path config -height [expr [lindex $bbox 3] + 4] \
	-width [expr [lindex $bbox 2] + 10]
#    update idletasks
}

#############################
# 
#--------> Main <------------
#

set widget(SL) {}
set param(LastFileTime) 10000
set param(SL,entries)   0
set param(SL,numentries) 0
set param(SL,highest) 0
