• Antelope Release 5.4 Mac OS X 10.8.5 2014-07-07

 

NAME

bpviewport, bpaxes, bpgrid, bptext, bppolyline, bppolypoint, bptrace, bptracepanel, bpmap, bpdatagrid - BRTT tk canvas item extensions

SYNOPSIS 


package require Buplot

canvaspathName create bpviewport viewportName x y ?options?

canvaspathName create bpaxes viewportName ?options?

canvaspathName create bpgrid viewportName ?options?

canvaspathName create bptext viewportName textstring x y ?options?

canvaspathName create bppolyline viewportName ?options?

canvaspathName create bppolypoint viewportName ?options?

canvaspathName create bpmap viewportName ?options?

canvaspathName create bptracepanel viewportName ?options?

canvaspathName create bpdatagrid viewportName ?options?

DESCRIPTION

These are all special tk canvas item extensions available through the Buplot package in the Antelope tcl/tk extensions. All of these canvas item widgets act as normal tk canvas items, including such functionality as the ability to display these in scrolled canvases and the ability to generate PostScript output, and they should be thought of as extensions to the various items that are described in canvas(n).

In theory, most of what these extensions can do could be done with the off-the-shelf canvas items that normally come with any tcl/tk package. However, the off-the-shelf items have not been written to efficiently display large graphical items, such as dense time series (like seismograms), large geographic map coordinate sets, and other bulky data items, such as large sets of geographic locations that are produced by earthquake catalogs. Another problem with the off-the-shelf items is that they do not provide any embedded and efficient way for computing coordinate transformations which are always necessary for displaying data.

OVERVIEW OF ITEM TYPES

The Buplot package was designed to deal with these inadequacies of the standard tk canvas items. The process of using the Buplot items is to first create a normal tk canvas widget with widget path canvaspathName. This is created in the normal tk widget heirarchy and is manipulated as any other canvas widget. The next step involves the definition of one or more bpviewports, using the create bpviewport tcl canvas item command. The concept of viewports is standard within graphical software packages. The idea is that a viewport acts as a window within a "virtual graphical device", such as a graphical monitor screen, or, in our case, a tk canvas, that is used to display data that is represented in some data-centric "world" coordinate system. For example imagine a set of longitude-latitude data coordinates that you would like to plot within a tk canvas. The world coordinates in this case are longitude and latitude. In order to use the off-the-shelf tk canvas item widgets you would have to convert these longitude-latitude world coordinates into a set of X-Y pixel coordinates, the virtual device coordinate system.

The bpviewport canvas item is a widget that will automatically transform data in world coordinates into integer X-Y pixel data coordinates that are suitable for passing directly into the virtual display device drivers (in this case the tk -> Xwindows drivers). A bpviewport can be thought of as a virtual canvas item since it does not by itself result in display graphics (the exception to this is that it will paint certain background colors). However, use of any of the other extension canvas items require an existing bpviewport item, which is used to define the world to virtual device coordinate transformations. All bpviewports must be assigned a unique name in bpviewportName by the application programmer when they are created. These names are used as references by the other Buplot widget extensions to associate particular widgets with particular viewports.

A set of axes and labels can be created with the bpaxes canvas item. A set of plot grid lines can be displayed with the bpgrid canvas item. Text can be anchored in world coordinates, justified and rotated using the bptext canvas item. Complex polyline objects can be rendered with the bppolyline canvas item. Polyline objects can be displayed as line outlines and/or as filled polygons. A set of plot symbols can be displayed with the bppolypoint canvas item. Each plot symbol shape, color, and an associated text label can be specified independently. Both the bppolyline and bppolypoint canvas items can use bplot_vector(3t) tcl extensions for representing vectors of plot coordinates and symbol attributes. An interface into the Antelope mappts mapping data sets (see gmtmap(3), gshhsmap(3)) is provided with the bpmap canvas item which will make geographic maps of water areas, land areas, coastlines, rivers and political boundaries for the entire world at high resolution.

COMMON ITEM OPTIONS

The Buplot canvas item extensions are configured in the same manner as all other convas items, through an argument list when they are created or by using the normal itemconfigure tk canvas item command. Common item options for all of the Buplot items are as follows.

BPVIEWPORT ITEMS

Bpviewport items are necessary adjuncts to any of the other items. These items will anchor viewport "frames" into a canvas. A viewport can include margins around the actual data viewport for displaying graph labels and titles. A bpviewport item can be configured to be strictly invisible, meaing the viewport itself will cause no graphics to be rendered, or they can be configured to paint in background colors before the other associated items are rendered. Note that multiple viewports can occupy the same space in a canvas. In the following documentation, when we say "viewport frame" we are referring to the entire rectangular viewport area including margins for making axes and title displays. When we refer to "viewport window" we are refering to only the inner portion of the viewport frame inside of the margins that will contain the actual data. A bpviewport item is created with the following command:

With the following item options:

The following standard options are supported by bpviewport items:

The following item options are specific to bpviewport items:

BPAXES ITEMS

Bpaxes items are used to display plot axes annotations including the axes themselves plus tic marks, text labels for the axes, a plot title and units labels along the axes. An bpaxes item is created with the following command:

With the following item options:

The following standard options are supported by bpaxes items:

The following item options are specific to bpaxes items:

BPGRID ITEMS

Bpgrid items are used to display plot grid line annotations. These grid lines normally are configured to align with the tic marks from an bpaxes itme. A bpgrid item is created with the following command:

With the following item options:

The following standard options are supported by bpgrid items:

The following item options are specific to bpgrid items:

BPTEXT ITEMS

Bptext items are used to display general text string annotations. Although there are default tk canvas items for displaying text, the bptext item allows text to be positioned using world coordinates. It also allows text to be rotated. A bptext item is created with the following command:

With the following item options:

The following standard options are supported by bptext items:

The following item options are specific to bptext items:

BPPOLYLINE ITEMS

Bppolyline items are used to display sets of X-Y coordinate vectors as either line plots or as filled polygons. A bppolyline item is created with the following command:

With the following item options:

The following standard options are supported by bppolyline items:

The following item options are specific to bppolyline items:

BPPOLYPOINT ITEMS

Bppolypoint items are used to display sets of X-Y coordinate vectors as points that can be displayed with plot symbols and/or text labels. A bppolypoint item is created with the following command:

With the following item options:

The following standard options are supported by bppolypoint items:

The following item options are specific to bppolypoint items:

BPMAP ITEMS

Bpmap items are used to display geographic base maps. These are rendered as filled complex polygons consisting of vector shoreline data that makes use of the GSHHS data in the Antelope distribution and the gshhsmap(3) utility for accessing this map database. In addition, rivers and political boundaries can also be displayed as polyline plots. These data come from the GMT NetCDF files in the Antelope distribution and the Antelope netcdf(3) routines are used to access these data. Note that typically maps are displayed in viewports with the -wtran option set to "merc" or "edp". A bpmap item is created with the following command:

With the following item options:

The following standard options are supported by bpmap items:

The following item options are specific to bpmap items:

BPTRACEPANEL ITEMS

Bptracepanel items are used to display single or multiple waveform traces in a single item. This is a very complex canvas item and its description is devoted to a separate man page, buplot_bptracepanel(3t).

BPDATAGRID ITEMS

Bpatagrid items are used to display rectilinear data grids, as defined in bugrid(3), as color contours with optional alpha blending onto an underlying color image, such as a map, and with the ability to project the grid mesh onto various map projections and to do on-the-fly slowness to distance transformations using standard travel time functions. A bpdatagrid item is created with the following command:

With the following item options:

The following standard options are supported by bpdatagrid items:

The following item options are specific to bpdatagrid items:

EXAMPLES

Following is an example for using most of the Buplot item extensions. 

% cat testbpgraph
#!/bin/sh
# This comment extends to the next line for tcl \
exec awish $0 -- $*

#   This is a tcl script for testing most of the Buplot
#   package canvas widget item extensions

#    need Buplot backage

package require Buplot
# package require Tclx

#    first we create a frame
frame .f

#    now a normal tk canvas widget
canvas .f.c -width 800 -height 800

#    All Buplot items must be associated with a
#    Buplot 'viewport" item, so we create a viewport
#    item, in the manner we would create any other canvas
#    item, and we give it name "myvp". We set the width
#    and hight to 0, meaning that the viewport width
#    and height should be the same as the canvas
#    dimensions and should change whenever the canvas
#    is resized. We also set the world coordinate to
#    device coordinate scaling (with -xleft, etc.)
#    and some margins and some background fill colors.
 .f.c create bpviewport myvp 0 0 \
                -width 0 -height 0 \
                -xleft 0.0 -xright 5.0 \
                -ybottom -1.1 -ytop 1.1 \
                -mleft 80 -mright 20 \
                -mbottom 50 -mtop 30 \
                -fill_frame lightblue \
                -fill white -tag vp

#    Next we create an "axes" item and associate it
#    with our viewport. We set some axis labels, format
#    strings for printing out the axis numerical
#    annotations and styles for the axes and tic marks.
 .f.c create bpaxes myvp \
                -xformat "%.1f" \
                -yformat "%.1f" \
                -axis_style sw \
                -tic_style siwinoeo \
		-xlabel "My X-stuff" \
		-ylabel "My Y-stuff"

#    Now we create a "grid" item and associate it
#    with our viewport. This will display plot grid
#    lines. Note that the order of item creation
#    determines the order in which it is drawn, so
#    the grid lines will be drawn after the axis
#    annotations.
 .f.c create bpgrid myvp \
                -linewidth 2 \
                -fill black \
                -fill_small gray

#    Now a "ptext" item that we use for drawing a
#    plot title. Note the "v" and "top" tokens in the
#    x-y position arguments.
 .f.c create bptext myvp "My text" 0.5v top+0.1i \
                -fill red \
                -font "Helvetica 14 bold" \
                -justification s \
                -angle 0

#    We finally get around to plotting some data
#    with a "polyline" item. Here we are using the
#    builtin test polyline which is an exponential
#    decaying sinusoid.
 .f.c create bppolyline myvp -test \
                -outline blue \
                -linewidth 3

#    It is more interesting to build up our own data,
#    so we can do this with a perl Vector object (from
#    the extended vector... perl commands). Here we
#    create a vector named "myvec" and add four points
#    to it. We also make sure the vector point label
#    attributes are specified. These labels can be used
#    by "bppolypoint" items to appear as text labels and
#    to affect the plot symbol attributes.

package require Vector

global vec
set vec [vector_create]

vector_append $vec -1 0.1 0.6 "Apt {f=magenta sz=10 sy=circle}"
vector_append $vec -1 1.9 0.4 "Bpt {f=darkblue sz=30 sy=square}"
vector_append $vec -1 0.3 0.9 "Cpt {f=white o= sz=20 sy=star}"
vector_append $vec -1 0.4 0.8 "Dpt {f=black o=orange sz=15}"

#    We create another "bppolyline" item and plot the
#    data from our newly created vector. In this case we
#    specify a fill color which causes the polyline to
#    define the boundary of a complex polygon and to be
#    filled with the color yellow. We also render the
#    polyline outline of the polygon with the color red.
#    Note that when a polyline is filled in this way
#    that the first point is automatically added to the
#    end of the polyline to close the polygon.

 .f.c create bppolyline myvp \
		-vector $vec \
		-fill "yellow" \
		-outline "red" \
		-linewidth 2 \
		-tags "vectorpl"

#    Now we create a "bppolypoint" item, using the same vector,
#    that will display plot symbols and labels at each of the
#    points in the vector. We set some default attributes for
#    drawing the plot symbols. However, the label fields in the
#    vector object contain special tokens that are interpreted
#    by the "polypoint" item as plot symbol attributes that can
#    be different for each point. In this way it is possible
#    to code in individual changes to plot symbol color and
#    size as a function of some other variable (e.g., you
#    could use this to set up a vector of earthquake coordinates
#    with symbol color and size coded by depth and magnitude).

 .f.c create bppolypoint myvp  \
		-vector $vec \
		-symbol "triangle" \
		-fill "white" \
		-outline "green" \
		-font "helvetica 12 bold" \
		-textforeground "brown" \
		-linewidth 2 \
		-showtext 1 \
		-tags "vectorpp"

grid configure .f.c -column 0 -row 0 -sticky nsew
grid configure .f -column 0 -row 0 -sticky nsew

grid rowconfigure .f 0 -weight 1
grid columnconfigure .f 0 -weight 1

grid rowconfigure . 0 -weight 1
grid columnconfigure . 0 -weight 1

#    Now lets bind right mouse button events
#    The idea is to be able to pan the plot region by
#    dragging the right mouse button

proc bindstartpandrag {x y} {
	global xstart
	global ystart

	set xstart $x
	set ystart $y
}

proc bindpandrag {w x y} {
	global xstart
	global ystart

	set delx [expr $xstart - $x]
	set dely [expr $ystart - $y]

	$w itemconfigure "vp" -xtranslate $delx -ytranslate $dely
}

proc bindstoppandrag {w} {
	$w itemconfigure "vp" -xtranslate "apply" -ytranslate "apply"
}

bind .f.c <ButtonPress-3> "bindstartpandrag %x %y"
bind .f.c <Button3-Motion> "bindpandrag %W %x %y"
bind .f.c <ButtonRelease-3> "bindstoppandrag %W"

#    Now shift-right mouse button
#    will cause the plot to zoom in and out
#    while dragging the shift-right mouse button

proc bindstartzoomdrag {w x y} {
	global xstart
	global ystart

	set xstart $x
	set ystart $y

	$w itemconfigure "vp" -xgain_anchor $xstart -ygain_anchor $ystart
}

proc bindzoomdrag {w x y} {
	global xstart
	global ystart

	set delx [expr $xstart - $x]
	set dely [expr $ystart - $y]

	set xgain [expr 1.0 + $delx *  0.001]
	set ygain [expr 1.0 + $dely *  0.001]
	if {$xgain <= 0.0} {set xgain 0.001}
	if {$ygain <= 0.0} {set ygain 0.001}

	$w itemconfigure "vp" -xgain $xgain -ygain $ygain
}

proc bindstopzoomdrag {w} {
	$w itemconfigure "vp" -xgain "apply" -ygain "apply"
}

bind .f.c <Shift-ButtonPress-3> "bindstartzoomdrag %W %x %y"
bind .f.c <Shift-Button3-Motion> "bindzoomdrag %W %x %y"
bind .f.c <Shift-ButtonRelease-3> "bindstopzoomdrag %W"

#    Finally left mouse button
#    will select a close plot point in the polypoint
#    displat and dragging the left mouse button will
#    move the point

proc bindstartpointdrag {win w x y} {
	global dragwindow

	if {[info exists dragwindow] != 0} {unset dragwindow}

	set l [buplot_locatevp $win $x $y "getentries"]
	set vp [lindex $l 0]
	set inside [lindex $l 1]

	#    $inside is set if the polypoint was inside of the viewport plot area

	if {[info exists vp] == 0} {return}
	if { $inside == 0 } {return}

	#    get the closest polypoint out of @entries

	global index
	set entry [lindex $l 2]
	set index [lindex $entry 1]
	set dist [lindex $entry 2]

	#    see if it is close enough

	if { $dist > 20.0 } { return }

	#    close enough, get the plot coordinates and warp cursor

	set dragwindow $vp

	global vec

	set l [vector_get $vec xy $index]
	set xwc [lindex $l 0]
	set ywc [lindex $l 1]
	set label [lindex $l 2]

	set l [buplot_wcoords2pixels  $vp $xwc $ywc]
	set x [expr int([lindex $l 0])]
	set y [expr int([lindex $l 1])]

	event generate $w <Motion> -warp 1 -x $x -y $y

	#    set the point fill color to something indicating it is being moved

	global labelsave
	set labelsave $label

	regsub "\}" $label " o=red\}" label

	vector_puty  $vec $index $ywc $label

	global mycanvas

	$w itemconfigure "vectorpp" -vector $vec
}

proc bindpointdrag {w x y} {
	global dragwindow

	if {[info exists dragwindow] == 0} {return}

	set l [buplot_pixels2wcoords  $dragwindow $x $y]
	set xwc [lindex $l 0]
	set ywc [lindex $l 1]

	global vec
	global index

	vector_put $vec $index $xwc $ywc

	$w itemconfigure "vectorpp" -vector $vec
	$w itemconfigure "vectorpl" -vector $vec
}

proc bindstoppointdrag {w x y} {
	global dragwindow

	if {[info exists dragwindow] == 0} {return}

	set l [buplot_pixels2wcoords  $dragwindow $x $y]
	set xwc [lindex $l 0]
	set ywc [lindex $l 1]

	global labelsave
	global vec
	global  index

	vector_put $vec $index $xwc $ywc $labelsave

	$w itemconfigure "vectorpp" -vector $vec
	$w itemconfigure "vectorpl" -vector $vec

	unset dragwindow
}

bind .f.c <ButtonPress-1> "bindstartpointdrag %i %W %x %y"
bind .f.c <Button1-Motion> "bindpointdrag %W %x %y"
bind .f.c <ButtonRelease-1> "bindstoppointdrag %W %x %y"

#    We update everything to get the display rendered on the
#    screen
update idletasks

#    And finally we make a postscript printout of the display
#    using the standard canvas postscript command.
 .f.c postscript -pageheight 8i -rotate true -file testbuplot.ps

Following is an example for using the bpmap item abd plotting some earthquake locations. 

% cat testbpmap
#!/bin/sh
# This comment extends to the next line for tcl \
exec awish $0 -- $*

#   This is a tcl script for testing most of the Buplot
#   package mapping capabilities

#    need Buplot backage

package require Buplot

#    need Datascope package for bringing in
#    some earthquake coordinates

package require Datascope

#    need Vector package for housing coordinate points

package require Vector

proc balloon_make {w text x y} {
	if [info exists y] {
		set id [$w create text $x $y -text $text -tag balloon]
		foreach {x0 y0 x1 y1} [$w bbox $id] break
		set xc [expr 0.5*($x1-$x0)]
		set yc [expr 0.5*($y1-$y0)]
		set x0 [expr $x0+$xc]
		set y0 [expr $y0+$yc]
		set x1 [expr $x1+$xc]
		set y1 [expr $y1+$yc]
		$w move $id $xc $yc
		$w create rect $x0 $y0 $x1 $y1 -fill lightyellow -tag balloon
		$w raise $id
	}
}

#    this procedure will display the current
#    position of the mouse in units of latitude
#    and longitude

proc showlatlon {win x y} {

	set l [buplot_locatevp $win $x $y]
	set vp [lindex $l 0]
	set inside [lindex $l 1]

	global latlon

	#    if the mouse is not inside a plot region, clear the display

	if { $inside == 0 } {
		set latlon ""
		return
	}

	#    set the display

	set l [buplot_pixels2wcoords  $vp $x $y]
	set lon [lindex $l 0]
	set lat [lindex $l 1]

	if {$lat < 0.0} {
		set lat [format "S%06.3f" [expr -$lat]]
	} else {
		set lat [format "N%06.3f" $lat]
	}
	if {$lon < 0.0} {
		set lon [format "W%07.3f" [expr -$lon]]
	} else {
		set lon [format "E%07.3f" $lon]
	}

	set latlon [format "%s %s" $lat $lon]
}

#    this procedure will move (pan) the edp viewport
#    map reference lat-lon to a point specified by
#    a canvas coordinate

proc panmap {vp x y} {

	set l [buplot_pixels2wcoords  $vp $x $y]
	set lon [lindex $l 0]
	set lat [lindex $l 1]

	if { $vp == "vp" } {
		.f.c itemconfigure  $vp -latr $lat -lonr $lon
	} else {
		set xl [.f.c itemcget $vp -xleft]
		set xr [.f.c itemcget $vp -xright]
		set yb [.f.c itemcget $vp -ybottom]
		set yt [.f.c itemcget $vp -ytop]

		set lonr [expr ($xr-$xl)]
		set latr [expr ($yt-$yb)]

		set xl expr[$lon - 0.5*$lonr]
		set xr expr[$lon + 0.5*$lonr]
		set yb expr[$lat - 0.5*$latr]
		set yt expr[$lat + 0.5*$latr]

		while { $xr > 180.0 } {
			set xl [expr $xl-360.0]
			set xr [expr $xr-360.0]
		}
		while { $xl < -360.0 } {
			set xl [expr $xl+360.0]
			set xr [expr $xr+360.0]
		}

		.f.c itemconfigure $vp -xleft $xl -xright $xr -ybottom $yb -ytop $yt
	}
}

#    this procedure binds to left mouse clicks
#    and will find the closest event, warp the cursor
#    to the event and bring up a balloon that describes
#    the event

proc bindfindclosest {win w x y} {

	set l [buplot_locatevp $win $x $y "getentries"]
	set vp [lindex $l 0]
	set inside [lindex $l 1]

	#    $inside is set if the event was inside of the viewport plot area

	if { $inside == 0 } {return}

	#    get the events vector index out of entries

	set entry [lindex $l 2]
	set item [lindex $entry 0]
	set index [lindex $entry 1]

	set v [$w itemcget $item -vector]

	#    get the events lat-lon and warp the cursor to that lat-lon

	set l [vector_get $v xy $index]
	set lon [lindex $l 0]
	set lat [lindex $l 1]
	set label [lindex $l 2]

	set l [buplot_wcoords2pixels  $vp $lon $lat]
	set x [expr int([lindex $l 0])]
	set y [expr int([lindex $l 1])]

	event generate $w <Motion> -warp 1 -x $x -y $y

	#    get event info and attach the balloon

	global db
	set l [dbgetv $db 0 $index "time" "depth" "mb"]
	set time [lindex $l 0]
	set depth [lindex $l 1]
	set mb [lindex $l 2]
	set msg [format "time : %s\nlat : %.5f\nlon : %.5f\ndepth : %.1f\nmb : %.1f"  
				[strtime $time] $lat $lon $depth $mb]

	#    cancel any old balloon expires

	$w delete balloon
	global afterid
	if {[info exists afterid]} {
		after cancel $afterid
		unset afterid
	}

	#    set balloon position and attach balloon

	balloon_make $w $msg $x $y

	#    this bit causes the balloon to "expire" after 5 seconds

	set afterid [after 5000 [list $w "delete" "balloon"]]
}

proc bindpanmap {win x y} {

	set l [buplot_locatevp $win $x $y]
	set vp [lindex $l 0]
	set inside [lindex $l 1]

	if { $inside == 1 } {panmap $vp $x $y}
}

#    this procedure will zoom in/out either of the
#    map viewports according to a factor. The x y
#    canvas coordinate is used to determine which
#    viewport to zoom.

proc zoommap {vp x y factor} {
	set xl [.f.c itemcget $vp -xleft]
	set xr [.f.c itemcget $vp -xright]
	set yb [.f.c itemcget $vp -ybottom]
	set yt [.f.c itemcget $vp -ytop]

	set xc [expr 0.5*($xl+$xr)]
	set yc [expr 0.5*($yb+$yt)]

	set xl [expr $xl-$xc]
	set xr [expr $xr-$xc]
	set yb [expr $yb-$yc]
	set yt [expr $yt-$yc]

	set xl [expr $xc + $factor * $xl]
	set xr [expr $xc + $factor * $xr]
	set yb [expr $yc + $factor * $yb]
	set yt [expr $yc + $factor * $yt]

	.f.c itemconfigure $vp -xleft $xl -xright $xr -ybottom $yb -ytop $yt
}

proc bindzoommap {win x y key} {

	set l [buplot_locatevp $win $x $y]
	set vp [lindex $l 0]
	set inside [lindex $l 1]

	if { $inside == 0 } {return}

	if { $key == "O" } {zoommap $vp $x $y 2.0}
	if { $key == "o" } {zoommap $vp $x $y 1.25}
	if { $key == "I" } {zoommap $vp $x $y 0.5}
	if { $key == "i" } {zoommap $vp $x $y 0.8}
}

proc bindenter {} {
	focus .f.c
}

#    this procedure will set a color specification
#    for transforming a depth value into a color

proc setcolor {depth} {

	set symlit 0.75

	set hue [expr 240.0*(1.0-($depth/600.0))]
	return [format "%.1f:%s:1.0" $hue $symlit]
}

#    set overall sizes, margins and positions

set width 500
set heightm [expr int ( 0.5 * $width )]
set heighte $width
set mleft 60
set mright 20
set mbottomm 50
set mbottome 20
set mtopm 20
set mtope 5
set water_color "#c0c0ff"

set fwidth [expr $width + $mleft + $mright]
set fheightm [expr $heightm + $mtopm + $mbottomm]
set fheighte [expr $heighte + $mtope + $mbottome]

set cwidth $fwidth
set cheight [expr $fheightm + $fheighte]

#    create main frame

frame .f
grid configure .f -column 0 -row 0 -sticky nsew

grid rowconfigure . 0 -weight 1
grid columnconfigure . 0 -weight 1

grid rowconfigure .f 0 -weight 0
grid rowconfigure .f 1 -weight 1
grid columnconfigure .f 0 -weight 1

#    this frame will contain the current mouse
#    position display

frame .ft -background "white"
grid configure .ft -column 0 -row 1 -sticky nsew

grid rowconfigure .ft 0 -weight 1
grid columnconfigure .ft 0 -weight 1

#    this is the canvas frame that will contain
#    the maps

canvas .f.c -width $cwidth -height $cheight
grid configure .f.c -column 0 -row 1 -sticky nsew

#    setup widget for displaying current
#    mouse coordinates

global latlon
set latlon "                "

label .ft.l -textvariable latlon -width 16 -font "helvetica 10 bold" -background "white"
grid configure .ft.l -column 0 -row 0 -sticky nsew

#    create viewport for Mercator map

 .f.c create bpviewport "vpm" 0 0 \
		-wtran "merc" \
		-latr 0.0 \
		-lonr 0.0 \
		-width $fwidth \
		-height $fheightm \
		-xleft -180.0 \
		-xright 180.0 \
		-ybottom -90.0 \
		-ytop 90.0 \
		-mleft $mleft \
		-mright $mright \
		-mbottom $mbottomm \
		-mtop $mtopm \
		-fill "gray" \
		-fill_frame "#ecffec" \
		-tags "vpm"

#    create map for Mercator map

 .f.c create bpmap "vpm" \
		-resolution "auto" \
		-political "1:#ff0000:1,2:#00a000:0,3:#ff00ff:0" \
		-fill_water $water_color \
		-coasts "1:#000000:0" \
		-tags "mapm"

#    put in axes labeling for Mercator map

 .f.c create bpaxes "vpm" \
		-xlabel "Longitude" \
		-ylabel "Latitude" \
		-mindx 50 \
		-mindy 50 \
		-xincrement 30.0 \
		-yincrement 30.0 \
		-xincrement_small 10.0 \
		-yincrement_small 10.0 \
		-tags "mapm"

#    put in lat-lon grid lines for Marcator map

 .f.c create bpgrid "vpm" \
		-mindx 50 \
		-mindy 50 \
		-xincrement 30.0 \
		-yincrement 30.0 \
		-xincrement_small 10.0 \
		-yincrement_small 10.0 \
		-linewidth 1 \
		-linewidth_small 1 \
		-fill "darkgray" \
		-fill_small "darkgray" \
		-tags "mapm"

#    create viewport for EDP map

 .f.c create bpviewport "vp" 0 $fheightm \
		-wtran "edp" \
		-latr -0.0 \
		-lonr 0.0 \
		-width $fwidth \
		-height $fheighte \
		-xleft -90.0 \
		-xright 90.0 \
		-ybottom -90.0 \
		-ytop 90.0 \
		-mleft $mleft \
		-mright $mright \
		-mbottom $mbottome \
		-mtop $mtope \
		-fill "gray" \
		-fill_frame "#ecffec" \
		-tags "vp"

#    create map for EDP map

 .f.c create bpmap "vp" \
		-resolution "auto" \
		-political "1:#ff0000:1,2:#00a000:0,3:#ff00ff:0" \
		-fill_water $water_color \
		-tags "map"

#    put in axes labeling for EDP map
#    note that currently the axis number labeling
#    is disabled for EDP maps

 .f.c create bpaxes "vp" \
		-mindx 100 \
		-xincrement 30.0 \
		-yincrement 30.0 \
		-xincrement_small 5.0 \
		-yincrement_small 5.0 \
		-tags "map"

#    put in lat-lon grid lines for EDP map

 .f.c create bpgrid "vp" \
		-mindx 0 \
		-mindy 0 \
		-xincrement 30.0 \
		-yincrement 30.0 \
		-xincrement_small 5.0 \
		-yincrement_small 5.0 \
		-linewidth -1 \
		-linewidth_small 1 \
		-fill "darkgray" \
		-fill_small "darkgray" \
		-tags "map"

#    Now lets bind right mouse button events
#    The idea is to be able to pan the plot region by
#    dragging the right mouse button

proc bindstartdrag {win x y} {

	set l [buplot_locatevp $win $x $y]
	if {[llength $l] < 1} {return}
	set vp [lindex $l 0]
	set inside [lindex $l 1]

	global dragwindow
	set dragwindow $vp

	global xstart
	global ystart
	set xstart $x
	set ystart $y
}

proc binddrag {w x y} {
	global dragwindow

	if {[info exists dragwindow] == 0} {return}

	global xstart
	global ystart

	set delx [expr $xstart - $x]
	set dely [expr $ystart - $y]

	$w itemconfigure $dragwindow -xtranslate $delx -ytranslate $dely
}

proc bindstopdrag {w} {
	global dragwindow

	if {[info exists dragwindow] == 0} {return}

	$w itemconfigure $dragwindow -xtranslate "apply" -ytranslate "apply"

	unset dragwindow
}

#    assign canvas bindings for mouse and
#    keyboard events
#    O,o  = zoom out
#    I,i  = zoom in
#    but3-drag = pan map
#    Shift-but3 = pan map by resetting center lat-lon
#    motion = display coords

bind .f.c <KeyPress> "bindzoommap %i %x %y %k"
bind .f.c <ButtonPress-3> "bindstartdrag %i %x %y"
bind .f.c <Button3-Motion> "binddrag %W %x %y"
bind .f.c <ButtonRelease-3> "bindstopdrag %W"
bind .f.c <Shift-ButtonPress-3> "bindpanmap %i %x %y"
bind .f.c <ButtonPress-1> "bindfindclosest %i %W %x %y"
bind .f.c <Motion> "showlatlon %i %x %y"
bind .f.c <Any-Enter> "bindenter"

#    now we are going to create a vector, open
#    a database with some origins, read the origin
#    lats, lons and depths, and fill in the vector

set events [vector_create]

global db
set db [dbopen "gsn" r]
set dbe [dblookup $db 0 "event" 0 0]
set dbo [dblookup $db 0 "origin" 0 0]

set db [dbjoin $dbe $dbo "prefor#orid"]

set nrecs [dbquery $db dbRECORD_COUNT]

for {set i 0} {$i < $nrecs} {incr i} {
	set lat [dbgetv $db 0 $i "lat"]
	set lon [dbgetv $db 0 $i "lon"]
	set depth [dbgetv $db 0 $i "depth"]
	set color [setcolor $depth]
	vector_append $events -1 $lon $lat [format "{f=%s}" $color]
}

#    now we create polypoint items to show the origins
#    in each map

 .f.c create bppolypoint "vpm" \
		-vector $events \
		-symbol "square" \
		-fill "blue" \
		-outline "" \
		-size 3
 .f.c create bppolypoint "vp" \
		-vector $events \
		-symbol "square" \
		-fill "blue" \
		-outline "" \
		-size 3

#    tell the window manager to not allow
#    interactive resizing - this display
#    will be fixed size - and start the
#    mail loop

wm resizable . 0 0

#    We update everything to get the display rendered on the
#    screen
update idletasks

#    And finally we make a postscript printout of the display
#    using the standard canvas postscript command.
 .f.c postscript -pageheight 8i -rotate true -file testbuplot.ps

AUTHOR

Danny Harvey, BRTT
Printer icon