1#---------------------------------------------------------------------------- 2# PLPLOT TK/TCL graphics renderer 3# plplot window initialization procs 4# 5# Maurice LeBrun 6# IFS, University of Texas at Austin 7# 29-May-1993 8# 9# Note: to keep namespace problems to a minimum, all procs defined here begin 10# with "pl". These are further subdivided into "plw::" for button- or 11# menu-accessible commands, or "pl_" for utility commands. 12#---------------------------------------------------------------------------- 13 14namespace eval plw { 15 namespace export create plr_create plxframe 16} 17 18#---------------------------------------------------------------------------- 19# plw::create 20# 21# Front-end routine to create plplot megawidget for use from PLplot tk 22# driver. Right now does nothing special. 23#---------------------------------------------------------------------------- 24 25proc plw::create {w {client_id {}}} { 26 plxframe $w $client_id 27 wm title . [string trim $w .] 28} 29 30#---------------------------------------------------------------------------- 31# plr_create 32# 33# A front-end to plw::create, used by plrender. 34#---------------------------------------------------------------------------- 35 36proc plw::plr_create {w {client_id {}}} { 37 global is_plrender; set is_plrender 1 38 plw::create $w $client_id 39} 40 41#---------------------------------------------------------------------------- 42# plxframe 43# 44# Creates the "extended" plframe widget. Eventually may be replaced with 45# a real megawidget capability, using itcl. The actual plframe widget 46# is named $w.plwin. Example usage: 47# 48# plxframe .plw 49# pack .plw -side bottom -fill both -expand yes 50# 51# The PLplot/TK (or DP) driver works by fork/exec of a plserver (an 52# extended wish), and subsequent communication of graphics instructions 53# data from the driver via a FIFO or socket. In this case the client_id 54# variable must be specified in the call. In direct widget instantiation 55# the client_id variable should not be used. 56#---------------------------------------------------------------------------- 57 58proc plw::plxframe {w {client_id {}}} { 59 60# Note the window name w must never be a global. 61 global client plot_menu_on 62 63# Save client name 64 65 if {$client_id != ""} then { 66 set client $client_id 67 } 68 69# Make container frame. It is mapped later. 70 71 catch {frame $w} 72 73# Create child plplot widget (plframe), and pack into parent. 74 75 plframe $w.plwin -relief sunken 76 pack $w.plwin -side bottom -expand yes -fill both 77 $w.plwin configure -width 250 -height 200 78# Set up defaults 79 80 plw::setup_defaults $w 81 82# Make frame for top row widgets. 83# plframe widget must already have been created (the plframe is queried 84# for a list of the valid output devices for page dumps). 85 86 if $plot_menu_on { 87 plw::create_TopRow $w 88 pack $w.ftop -side top -fill x 89 } 90 91# Also grab the initial input focus. 92 93 if {[info tclversion] < 8.0} { 94 tk_bindForTraversal $w.plwin 95 } 96 focus $w.plwin 97 98# Set up bop/eop signal and inform client of plplot widget name for widget 99# commands. 100 101 if { [info exists client] } { 102 if $plot_menu_on { 103 set bop_col [option get $w.ftop.leop off Label] 104 set eop_col [option get $w.ftop.leop on Label] 105 106 $w.plwin configure -bopcmd "plw::flash $w $bop_col" 107 $w.plwin configure -eopcmd "plw::flash $w $eop_col" 108 109 } else { 110 $w.plwin configure -bopcmd {update} 111 $w.plwin configure -eopcmd {update} 112 } 113 # Resize binding -- just experimental for now. 114 # bind $w.plwin <Configure> "client_cmd \"plfinfo %w %h\"" 115 client_cmd "set plwidget $w.plwin" 116 } else { 117 global plstate_bopseen; set plstate_bopseen($w) 0 118 $w.plwin configure -bopcmd "plw::bop $w" 119 $w.plwin configure -eopcmd "plw::eop $w" 120 } 121 122 return $w 123} 124 125#---------------------------------------------------------------------------- 126# plw::setup_defaults 127# 128# Set up default settings. 129#---------------------------------------------------------------------------- 130 131proc plw::setup_defaults {w} { 132 133# In the two cases below, the options can be specified in advance through 134# the global variables zoomopt_0, etc, and saveopt_0, etc. Not a great 135# solution but will have to do for now. 136 137# zoom options: 138# 0: 0=don't preserve aspect ratio, 1=do 139# 1: 0=stretch from corner, 1=stretch from center 140 141 global zoomopts zoomopt_0 zoomopt_1 142 143 set zoomopts($w,0) 1 144 set zoomopts($w,1) 1 145 if { [info exists zoomopt_0] } {set zoomopts($w,0) $zoomopt_0} 146 if { [info exists zoomopt_1] } {set zoomopts($w,1) $zoomopt_1} 147 148# save options: 149# 0: name of default save device 150# 1: 0=save 1 plot/file, 1=save multi plots/file (must close!) 151 152 global saveopts saveopt_0 saveopt_1 153 154 set saveopts($w,0) "psc" 155 set saveopts($w,1) 0 156 set saveopts($w,flip) 1 157 if { [info exists saveopt_0] } {set saveopts($w,0) $saveopt_0} 158 if { [info exists saveopt_1] } {set saveopts($w,1) $saveopt_1} 159 160# Set up zoom windows list 161 162 global zidx zidx_max zxl zyl zxr zyr 163 164 set zidx($w) 0 165 set zidx_max($w) 0 166 set zxl($w,0) 0.0 167 set zyl($w,0) 0.0 168 set zxr($w,0) 1.0 169 set zyr($w,0) 1.0 170 171# Bindings 172 173 bind $w.plwin <Any-KeyPress> \ 174 "plw::key_filter $w %N %s %x %y %K %A" 175 176 bind $w.plwin <Any-ButtonPress> \ 177 "plw::user_mouse $w %b %s %x %y" 178 179 bind $w.plwin <B1-Motion> \ 180 "plw::user_mouse $w %b %s %x %y" 181 182 bind $w.plwin <B2-Motion> \ 183 "plw::user_mouse $w %b %s %x %y" 184 185 bind $w.plwin <B3-Motion> \ 186 "plw::user_mouse $w %b %s %x %y" 187 188 bind $w.plwin <Any-Enter> \ 189 "focus $w.plwin" 190} 191 192#---------------------------------------------------------------------------- 193# plw::create_TopRow 194# 195# Create top row widgets. Page-oriented widgets only have a meaning in 196# the context of the PLplot driver, so don't create them if there is no 197# client (as occurs for direct widget instantiation). 198#---------------------------------------------------------------------------- 199 200proc plw::create_TopRow {w} { 201 global is_plrender client 202 203 frame $w.ftop 204 205# End of page indicator 206 207 if { [info exists client] } { 208 pack [label $w.ftop.leop -relief raised] \ 209 -side left -fill both -padx 12 210 211 $w.ftop.leop config -bg [option get $w.ftop.leop on Label] 212 } 213 214# Plot menu 215 plw::create_pmenu $w $w.ftop.pmenu 216 217# Forward and backward (plrender only) page buttons. 218# Just a hack until I get around to doing it right. 219 220 if { [info exists client] } { 221 if { [info exists is_plrender] } { 222 pack [button $w.ftop.bp -text "<<" -relief raised] \ 223 -side left -fill both -padx 10 224 225 $w.ftop.bp configure -command \ 226 "client_cmd {keypress 65288 0 0 0 0. 0. BackSpace}" 227 } 228 229 pack [button $w.ftop.fp -text ">>" -relief raised] \ 230 -side left -fill x -padx 10 231 232 $w.ftop.fp configure -command \ 233 [list client_cmd [list keypress 65293 0 0 0 0. 0. Return]] 234 } 235 236# Label widget for status messages. 237 238 label $w.ftop.lstat -anchor w -relief raised 239 plw::label_push $w [string range $w 1 end] 240 pack $w.ftop.lstat -side right -expand yes -fill x 241} 242 243#---------------------------------------------------------------------------- 244# plw::create_pmenu 245# 246# Create plot menu. 247# 248# It is tempting to create buttons for some of these options, but buttons 249# are difficult to effectively place and extend. Menus have a clear 250# placement mechanism and are easy to add to. Further, TK menus can be 251# torn off (select menu with middle mouse button and move to where you 252# want it) which makes selecting top-level menu buttons easy. Finally, 253# certain menu options have keyboard equivalents: zoom-select (z), 254# zoom-reset (r), print (P), and save-again (s). 255#---------------------------------------------------------------------------- 256 257proc plw::create_pmenu {w pmbut} { 258 global pmenu 259 260 set pmenu($w) $w.plmenubar 261 menu $pmenu($w) 262 set top [winfo toplevel $w] 263 $top configure -menu $pmenu($w) 264 265 plw::create_pmenu_file $w 266 plw::create_pmenu_orient $w 267 plw::create_pmenu_zoom $w 268 plw::create_pmenu_page $w 269 plw::create_pmenu_options $w 270 plw::create_pmenu_help $w 271 plw::create_pmenu_exit $w 272 273 return $pmbut 274} 275 276#---------------------------------------------------------------------------- 277# plw::create_pmenu_exit 278#---------------------------------------------------------------------------- 279 280proc plw::create_pmenu_exit {w} { 281 global pmenu 282 283 $pmenu($w) add command -label "Exit" \ 284 -command exit 285} 286 287#---------------------------------------------------------------------------- 288# plw::create_pmenu_help 289#---------------------------------------------------------------------------- 290 291proc plw::create_pmenu_help {w} { 292 global pmenu 293 294 $pmenu($w) add command -label "Help" \ 295 -command "help_keys" 296} 297 298#---------------------------------------------------------------------------- 299# plw::create_pmenu_file 300# 301# Create plot-file menu (cascade) 302#---------------------------------------------------------------------------- 303 304proc plw::create_pmenu_file {w} { 305 306 global pmenu; set m $pmenu($w).file 307 308 $pmenu($w) add cascade -label "File" -menu $m 309 menu $m 310 311 $m add command -label "Print..." \ 312 -command "plw::print $w" -accelerator Cmd-P 313# Save - As 314 $m add command -label "Close" \ 315 -command "destroy [winfo toplevel $w]" -accelerator Cmd-W 316 317 $m add command -label "Save As" \ 318 -command "plw::save_as $w" 319 320# Save - Again 321 322 $m add command -label "Save Again" \ 323 -command "plw::save_again $w" \ 324 -state disabled 325 326# Save - Close 327 328 $m add command -label "Save Close" \ 329 -command "plw::save_close $w" \ 330 -state disabled 331 332 $m add separator 333 334# Save - Set device.. (another cascade) 335 336 $m add cascade -label "Save device" -menu $m.sdev 337 menu $m.sdev 338 339 global saveopts 340 341 $m.sdev add check -label "Flip B/W before save or print" \ 342 -variable saveopts($w,flip) 343 $m.sdev add separator 344# Generate the device list in the "Save/Set device" widget menu, by querying 345# the plframe widget for the available output devices (which are listed). 346 347 set devnames [$w.plwin info devnames] 348 set devkeys [$w.plwin info devkeys] 349 set ndevs [llength $devnames] 350 for {set i 0} {$i < $ndevs} {incr i} { 351 set devnam [lindex $devnames $i] 352 set devkey [lindex $devkeys $i] 353 354 $m.sdev add radio -label $devnam \ 355 -variable saveopts($w,0) -value $devkey 356 } 357 358# Save - Set file type.. (another cascade) 359 360 $m add cascade -label "Set file type" -menu $m.sfile 361 menu $m.sfile 362 363# Single file (one plot/file) 364 365 $m.sfile add radio -label "Single file (one plot/file)" \ 366 -variable saveopts($w,1) -value 0 367 368# Archive file (many plots/file) 369 370 $m.sfile add radio -label "Archive file (many plots/file)" \ 371 -variable saveopts($w,1) -value 1 372} 373 374#---------------------------------------------------------------------------- 375# plw::create_pmenu_orient 376# 377# Create plot-orient menu (cascade) 378#---------------------------------------------------------------------------- 379 380proc plw::create_pmenu_orient {w} { 381 global pmenu; set m $pmenu($w).orient 382 383 $pmenu($w) add cascade -label "Orient" -menu $m 384 menu $m 385 386 $m configure -postcommand "plw::update_orient $w" 387 388# Orient - 0 degrees 389 390 $m add radio -label "0 degrees" \ 391 -command "plw::orient $w 0" 392 393# Orient - 90 degrees 394 395 $m add radio -label "90 degrees" \ 396 -command "plw::orient $w 1" 397 398# Orient - 180 degrees 399 400 $m add radio -label "180 degrees" \ 401 -command "plw::orient $w 2" 402 403# Orient - 270 degrees 404 405 $m add radio -label "270 degrees" \ 406 -command "plw::orient $w 3" 407} 408 409#---------------------------------------------------------------------------- 410# plw::create_pmenu_zoom 411# 412# Create plot-zoom menu (cascade) 413#---------------------------------------------------------------------------- 414 415proc plw::create_pmenu_zoom {w} { 416 global pmenu; set m $pmenu($w).zoom 417 418 $pmenu($w) add cascade -label "Zoom" -menu $m 419 menu $m 420 421 $m configure -postcommand "plw::update_zoom $w" 422 423# Zoom - select (by mouse) 424 425 $m add command -label "Select" \ 426 -command "plw::zoom_select $w" 427 428# Zoom - back (go back 1 zoom level) 429 430 $m add command -label "Back" \ 431 -command "plw::zoom_back $w" \ 432 -state disabled 433 434# Zoom - forward (go forward 1 zoom level) 435 436 $m add command -label "Forward" \ 437 -command "plw::zoom_forward $w" \ 438 -state disabled 439 440# Zoom - enter bounds 441 442 $m add command -label "Enter bounds.." \ 443 -command "plw::zoom_enter $w" 444 445# Zoom - reset 446 447 $m add command -label "Reset" \ 448 -command "plw::zoom_reset $w" 449 450# Zoom - options (another cascade) 451 452 $m add cascade -label "Options" -menu $m.options 453 menu $m.options 454 455 global zoomopts 456 $m.options add check -label "Preserve aspect ratio" \ 457 -variable zoomopts($w,0) 458 459 $m.options add separator 460 461 $m.options add radio -label "Start from corner" \ 462 -variable zoomopts($w,1) -value 0 463 464 $m.options add radio -label "Start from center" \ 465 -variable zoomopts($w,1) -value 1 466 467 $m.options invoke 1 468} 469 470#---------------------------------------------------------------------------- 471# plw::create_pmenu_page 472# 473# Create plot-page menu (cascade) 474#---------------------------------------------------------------------------- 475 476proc plw::create_pmenu_page {w} { 477 global pmenu; set m $pmenu($w).page 478 479 $pmenu($w) add cascade -label "Page" -menu $m 480 menu $m 481 482# Page - enter bounds 483 484 $m add command -label "Setup.." \ 485 -command "plw::page_enter $w" 486 487# Page - reset 488 489 $m add command -label "Reset" \ 490 -command "plw::page_reset $w" 491} 492 493#---------------------------------------------------------------------------- 494# plw::create_pmenu_redraw 495# 496# Create plot-redraw menu 497# I only use this for debugging in cases where the normal redraw capability 498# isn't working right. 499#---------------------------------------------------------------------------- 500 501proc plw::create_pmenu_redraw {w} { 502 global pmenu 503 504 $pmenu($w) add command -label "Redraw" \ 505 -command "$w.plwin redraw" 506} 507 508#---------------------------------------------------------------------------- 509# plw::create_pmenu_options 510# 511# Create plot-options menu (cascade) 512#---------------------------------------------------------------------------- 513 514proc plw::create_pmenu_options {w} { 515 516 global pmenu; set m $pmenu($w).options 517 518 $pmenu($w) add cascade -label "Options" -menu $m 519 menu $m 520 521 $m add command -label "Palette 0" \ 522 -command "plcmap0_edit $w" 523 524 $m add command -label "Palette 1" \ 525 -command "plcmap1_edit $w" 526 527 global plotopts 528 set plotopts($w,xhairs) [$w.plwin configure -xhairs] 529 set plotopts($w,dbl) [$w.plwin configure -doublebuffer] 530 $m add checkbutton -label "Crosshairs" -variable \ 531 plotopts($w,xhairs) -command "$w.plwin configure -xhairs \$plotopts($w,xhairs)" 532 $m add checkbutton -label "Doublebuffer" -variable \ 533 plotopts($w,dbl) -command "$w.plwin configure -doublebuffer \$plotopts($w,dbl)" 534 535 global plopt_static_redraw plopt_dynamic_redraw pl_itcl_package_name 536 537# The palette tools require Itcl 3.0 or later. 538 539 if [catch {eval package require $pl_itcl_package_name}] { return } 540 541# Set up redraw variables. Basically if you have r/w colorcells (e.g. 542# PseudoColor visual, not sure if any others), you don't need either of 543# these -- they are updated automatically. Otherwise (e.g. TrueColor), you 544# definitely want static_redraw set and probably dynamic_redraw. The latter is 545# very cpu intensive as it redraws the plot every time you move one of the 546# sliders, similar to a zoom/pan. 547 548# Note: it would be better to reach down to the X driver to get the info on 549# whether we have r/w colorcells to set the default, but this procedure is a 550# lot easier and almost as good. 551 552# See if we have a visual capable of r/w colorcells. 553 554 set rwcolorcells 0 555 set visual [winfo visual $w] 556 if { $visual == "pseudocolor" } { 557 set rwcolorcells 1 558 } 559 560 if $rwcolorcells { 561 set plopt_static_redraw($w) 0 562 set plopt_dynamic_redraw($w) 0 563 } else { 564 set plopt_static_redraw($w) 1 565 set plopt_dynamic_redraw($w) 1 566 } 567 568# Set up palette tools 569 570 $m add command -label "Palette 0" \ 571 -command "plcmap0_edit $w.plwin $w" 572 573 $m add command -label "Palette 1" \ 574 -command "plcmap1_edit $w.plwin $w" 575 576# Palettes - options (another cascade) 577 578 $m add cascade -label "Options" -menu $m.options 579 menu $m.options 580 581# Setup checkboxes for dynamic/static redraws. Eventually a resource setting 582# will be used to allow overrides that way too, but for now this will do. 583 584 $m.options add check -label "Enable static plot redraws" \ 585 -variable plopt_static_redraw($w) 586 587 $m.options add check -label "Enable dynamic plot redraws" \ 588 -variable plopt_dynamic_redraw($w) 589 590# Set up traces to force the following logical relationship: 591# 592# dynamic_redraw ==> static_redraw 593# 594# and its contrapositive. 595 596 trace variable plopt_static_redraw($w) w plw::pmenu_palettes_checkvars 597 trace variable plopt_dynamic_redraw($w) w plw::pmenu_palettes_checkvars 598} 599 600proc plw::pmenu_palettes_checkvars {var w op} { 601 global plopt_static_redraw plopt_dynamic_redraw 602 if { $var == "plopt_dynamic_redraw" } { 603 if $plopt_dynamic_redraw($w) { set plopt_static_redraw($w) 1 } 604 } 605 if { $var == "plopt_static_redraw" } { 606 if !$plopt_static_redraw($w) { set plopt_dynamic_redraw($w) 0 } 607 } 608} 609 610#---------------------------------------------------------------------------- 611# plw::start 612# 613# Responsible for plplot graphics package initialization on the widget. 614# People driving the widget directly should just use pack themselves. 615# 616# Put here to reduce the possibility of a time out over a slow network -- 617# the client program waits until the variable widget_is_ready is set. 618#---------------------------------------------------------------------------- 619 620proc plw::start {w} { 621 global client 622 623# Manage widget hierarchy 624 625 pack $w -side bottom -expand yes -fill both 626 627 update 628 629# Inform client that we're done. 630 631 if { [info exists client] } { 632 client_cmd "set widget_is_ready 1" 633 } 634 635 # Call a user supplied routine to do any necessary post initialization 636 catch after_plw::start 637} 638 639#---------------------------------------------------------------------------- 640# plw::key_filter 641# 642# Front-end to key handler. 643# For supported operations it's best to modify the global key variables 644# to get the desired action. More advanced stuff can be done with the 645# $user_key_filter proc. Find anything particularly useful? Let me know, 646# so it can be added to the default behavior. 647#---------------------------------------------------------------------------- 648 649proc plw::key_filter {w keycode state x y keyname ascii} { 650 global user_key_filter 651 652 global key_zoom_select 653 global key_zoom_reset 654 global key_print 655 global key_save_again 656 global key_scroll_right 657 global key_scroll_left 658 global key_scroll_up 659 global key_scroll_down 660 661# puts "keypress: $keyname $keycode $ascii $state" 662 663# Call user-defined key filter, if one exists 664 665 if { [info exists user_key_filter] } { 666 $user_key_filter $w $keyname $keycode $ascii 667 } 668 669# Interpret keystroke 670 671 switch $keyname \ 672 $key_zoom_select "plw::zoom_select $w" \ 673 "b" "plw::zoom_back $w" \ 674 "f" "plw::zoom_forward $w" \ 675 $key_zoom_reset "plw::zoom_reset $w" \ 676 $key_print "plw::print $w" \ 677 $key_save_again "plw::save_again $w" \ 678 $key_scroll_right "plw::view_scroll $w 1 0 $state" \ 679 $key_scroll_left "plw::view_scroll $w -1 0 $state" \ 680 $key_scroll_up "plw::view_scroll $w 0 -1 $state" \ 681 $key_scroll_down "plw::view_scroll $w 0 1 $state" \ 682 "Return" "plw::next_page $w" 683 684# Pass keypress event info back to client. 685 686 plw::user_key $w $keycode $state $x $y $keyname $ascii 687} 688 689proc plw::next_page {w} { 690 $w.plwin nextpage 691} 692 693#---------------------------------------------------------------------------- 694# plw::user_key 695# 696# Passes keypress event information back to client. 697# Based on plw::user_mouse. 698#---------------------------------------------------------------------------- 699 700proc plw::user_key {w keycode state x y keyname ascii} { 701 global client 702 703 if { [info exists client] } { 704 705 # calculate relative window coordinates. 706 707 set xw [expr "$x / [winfo width $w.plwin]."] 708 set yw [expr "1.0 - $y / [winfo height $w.plwin]."] 709 710 # calculate normalized device coordinates into original window. 711 712 set view [$w.plwin view] 713 set xrange [expr "[lindex $view 2] - [lindex $view 0]"] 714 set xnd [expr "($xw * $xrange) + [lindex $view 0]"] 715 set yrange [expr "[lindex $view 3] - [lindex $view 1]"] 716 set ynd [expr "($yw * $yrange ) + [lindex $view 1]"] 717 718 # send them back to the client. 719 720# puts "keypress $keycode $state $x $y $xnd $ynd $keyname $ascii" 721 client_cmd \ 722 [list keypress $keycode $state $x $y $xnd $ynd $keyname $ascii] 723 } 724} 725 726#---------------------------------------------------------------------------- 727# plw::user_mouse 728# 729# Passes buttonpress event information back to client. 730# Written by Radey Shouman 731#---------------------------------------------------------------------------- 732 733proc plw::user_mouse {w button state x y} { 734 global client 735 736 if { [info exists client] } { 737 738 # calculate relative window coordinates. 739 740 set xw [expr "$x / [winfo width $w.plwin]."] 741 set yw [expr "1.0 - $y / [winfo height $w.plwin]."] 742 743 # calculate normalized device coordinates into original window. 744 745 set view [$w.plwin view] 746 set xrange [expr "[lindex $view 2] - [lindex $view 0]"] 747 set xnd [expr "($xw * $xrange) + [lindex $view 0]"] 748 set yrange [expr "[lindex $view 3] - [lindex $view 1]"] 749 set ynd [expr "($yw * $yrange ) + [lindex $view 1]"] 750 751 # send them back to the client. 752 753 client_cmd \ 754 [list buttonpress $button $state $x $y $xnd $ynd] 755 } 756} 757 758#---------------------------------------------------------------------------- 759# plw::flash 760# 761# Set eop button color to indicate page status. 762#---------------------------------------------------------------------------- 763 764proc plw::flash {w col} { 765 $w.ftop.leop config -bg $col 766 update idletasks 767} 768 769#---------------------------------------------------------------------------- 770# plw::end 771# 772# Executed as part of orderly shutdown procedure. Eventually will just 773# destroy the plframe and surrounding widgets, and server will exit only 774# if all plotting widgets have been destroyed and it is a child of the 775# plplot/TK driver. Maybe. 776# 777# The closelink command was added in the hopes of making the dp driver 778# cleanup a bit more robust, but doesn't seem to have any effect except 779# to slow things down quite a bit. 780#---------------------------------------------------------------------------- 781 782proc plw::end {w} { 783 global dp 784# $w.plwin closelink 785 if { $dp } { 786 global list_sock 787 close $list_sock 788 } 789 exit 790} 791 792#---------------------------------------------------------------------------- 793# plw::print 794# 795# Prints plot. Uses the "plpr" script, which must be set up for your site 796# as appropriate. There are better ways to do it but this way is safest 797# for now. 798#---------------------------------------------------------------------------- 799 800proc plw::print {w} { 801 plw::label_set $w "Printing plot..." 802 update 803 if { [catch "$w.plwin print" foo] } { 804 bogue_out "$foo" 805 } else { 806 status_msg $w "Plot printed." 807 } 808} 809 810#---------------------------------------------------------------------------- 811# plw::save_as 812# 813# Saves plot to default device, prompting for file name. 814#---------------------------------------------------------------------------- 815 816proc plw::save_as {w} { 817 global pmenu saveopts 818 set file [plw::SaveFile $saveopts($w,0)] 819 if { [string length $file] > 0 } { 820 if { [file exists $file] } { 821 if { ! [confirm "File $file already exists. Are you sure?"] } { 822 return 823 } 824 } 825 826 plw::label_set $w "Saving plot..." 827 update 828 if $saveopts($w,flip) { 829 set c0 [$w.plwin cmd plgcmap0] 830 $w.plwin cmd plscmap0 16 #ffffff 831 for {set i 1} {$i <= 15} {incr i} { 832 $w.plwin cmd plscol0 $i #000000 833 } 834 } 835 if { [catch [list $w.plwin save as $saveopts($w,0) $file] foo] } { 836 plw::label_reset $w 837 bogue_out "$foo" 838 } else { 839 status_msg $w "Plot saved." 840 } 841 if $saveopts($w,flip) { 842 #eval $w.plwin cmd plscmap0 $c0 843 $w.plwin cmd plscmap0 16 #000000 844 for {set i 1} {$i <= 15} {incr i} { 845 $w.plwin cmd plscol0 $i [lindex $c0 [expr $i +1]] 846 } 847 } 848 849 if { $saveopts($w,1) == 0 } { 850 $w.plwin save close 851 } else { 852 $pmenu($w).file entryconfigure 3 -state normal 853 $pmenu($w).file entryconfigure 4 -state normal 854 bogue_out "Warning: archive files must be closed before using" 855 } 856 } else { 857 status_msg $w "No file specified" 858 } 859} 860 861proc plw::SaveFile {devkey} { 862 switch -- "$devkey" \ 863 "ps" "set filter .ps" \ 864 "psc" "set filter .ps" \ 865 "plmeta" "set filter .plm" \ 866 "pam" "set filter .ppm" \ 867 "xfig" "set filter .fig" 868 869 if {[info exists filter]} { 870 set f [tk_getSaveFile -defaultextension $filter] 871 } else { 872 set f [tk_getSaveFile] 873 } 874 # the save dialog asked the user whether to replace already. 875 if [file exists $f] { file delete $f } 876 return $f 877} 878 879#---------------------------------------------------------------------------- 880# plw::save_again 881# 882# Saves plot to an already open file. 883#---------------------------------------------------------------------------- 884 885proc plw::save_again {w} { 886 if { [catch "$w.plwin save" foo] } { 887 bogue_out "$foo" 888 } else { 889 status_msg $w "Plot saved." 890 } 891} 892 893#---------------------------------------------------------------------------- 894# plw::save_close 895# 896# Close archive save file. 897#---------------------------------------------------------------------------- 898 899proc plw::save_close {w} { 900 global pmenu 901 if { [catch "$w.plwin save close" foo] } { 902 bogue_out "$foo" 903 } else { 904 status_msg $w "Archive file closed." 905 $pmenu($w).file entryconfigure Again -state disabled 906 $pmenu($w).file entryconfigure Close -state disabled 907 } 908} 909 910#---------------------------------------------------------------------------- 911# plw::update_zoom 912# 913# Responsible for making sure zoom menu entries are normal or disabled as 914# appropriate. In particular, that "Back" or "Forward" are only displayed 915# if it is possible to traverse the zoom windows list in that direction. 916#---------------------------------------------------------------------------- 917 918proc plw::update_zoom {w} { 919 global zidx zidx_max zxl zyl zxr zyr 920 global pmenu 921 922# Back 923 924 if { $zidx($w) == 0 } { 925 $pmenu($w).zoom entryconfigure "Back" -state disabled 926 } else { 927 $pmenu($w).zoom entryconfigure "Back" -state normal 928 } 929 930# Forward 931 932 if { $zidx_max($w) == 0 || $zidx($w) == $zidx_max($w) } { 933 $pmenu($w).zoom entryconfigure "Forward" -state disabled 934 } else { 935 $pmenu($w).zoom entryconfigure "Forward" -state normal 936 } 937} 938 939#---------------------------------------------------------------------------- 940# plw::zoom_select 941# 942# Zooms plot in response to mouse selection. 943#---------------------------------------------------------------------------- 944 945proc plw::zoom_select {w} { 946 global def_button_cmd zoomopts 947 948 set def_button_cmd [bind $w.plwin <ButtonPress>] 949 950 if { $zoomopts($w,1) == 0 } { 951 plw::label_set $w "Click on one corner of zoom region." 952 } else { 953 plw::label_set $w "Click on center of zoom region." 954 } 955 956 bind $w.plwin <ButtonPress> "plw::zoom_start $w %x %y" 957} 958 959#---------------------------------------------------------------------------- 960# plw::zoom_enter 961# 962# Zooms plot in response to text entry. 963#---------------------------------------------------------------------------- 964 965proc plw::zoom_enter {w} { 966 global fv00 fv01 fv10 fv11 967 global fn00 fn01 fn10 fn11 968 969 set coords [$w.plwin view] 970 971 set fv00 [lindex "$coords" 0] 972 set fv01 [lindex "$coords" 1] 973 set fv10 [lindex "$coords" 2] 974 set fv11 [lindex "$coords" 3] 975 976 set fn00 xmin 977 set fn01 ymin 978 set fn10 xmax 979 set fn11 ymax 980 981 Form2d .e "Enter window coordinates for zoom. Each coordinate should range from 0 to 1, with (0,0) corresponding to the lower left hand corner." 982 tkwait window .e 983 984 plw::view_select $w $fv00 $fv01 $fv10 $fv11 985} 986 987#---------------------------------------------------------------------------- 988# plw::zoom_reset 989# 990# Resets after zoom. 991# Note that an explicit redraw is not necessary since the packer issues a 992# resize after the scrollbars are unmapped. 993#---------------------------------------------------------------------------- 994 995proc plw::zoom_reset {w} { 996 global def_button_cmd 997 998 plw::label_reset $w 999 bind $w.plwin <ButtonPress> $def_button_cmd 1000 $w.plwin view reset 1001 if { [winfo exists $w.hscroll] && [winfo ismapped $w.hscroll] } { 1002 pack unpack $w.hscroll 1003 } 1004 if { [winfo exists $w.vscroll] && [winfo exists $w.vscroll] } { 1005 pack unpack $w.vscroll 1006 } 1007 1008# Reset zoom windows list 1009 1010 global zidx zidx_max zxl zyl zxr zyr 1011 1012 set zidx($w) 0 1013 set zidx_max($w) 0 1014 set zxl($w,0) 0.0 1015 set zyl($w,0) 0.0 1016 set zxr($w,0) 1.0 1017 set zyr($w,0) 1.0 1018} 1019 1020#---------------------------------------------------------------------------- 1021# plw::update_orient 1022# 1023# Responsible for making sure orientation radio buttons are up to date. 1024#---------------------------------------------------------------------------- 1025 1026proc plw::update_orient {w} { 1027 global pmenu 1028 $pmenu($w).orient invoke "[expr 90*int([$w.plwin orient])] degrees" 1029} 1030 1031#---------------------------------------------------------------------------- 1032# plw::orient 1033# 1034# Changes plot orientation. 1035#---------------------------------------------------------------------------- 1036 1037proc plw::orient {w rot} { 1038 if { [$w.plwin orient] != $rot} { 1039 $w.plwin orient $rot 1040 } 1041} 1042 1043#---------------------------------------------------------------------------- 1044# plw::page_enter 1045# 1046# Changes output page parameters (margins, aspect ratio, justification). 1047#---------------------------------------------------------------------------- 1048 1049proc plw::page_enter {w} { 1050 global fv00 fv01 fv10 fv11 1051 global fn00 fn01 fn10 fn11 1052 1053 set coords [$w.plwin page] 1054 1055 set fv00 [lindex "$coords" 0] 1056 set fv01 [lindex "$coords" 1] 1057 set fv10 [lindex "$coords" 2] 1058 set fv11 [lindex "$coords" 3] 1059 1060 set fn00 mar 1061 set fn01 aspect 1062 set fn10 jx 1063 set fn11 jy 1064 1065 Form2d .e "Enter page setup parameters. mar denotes the fractional page area on each side to use as a margin (0 to 0.5). jx and jy are the fractional justification relative to the center (-0.5 to 0.5). aspect is the page aspect ratio (0 preserves original aspect ratio)." 1066 tkwait window .e 1067 1068 $w.plwin page $fv00 $fv01 $fv10 $fv11 1069} 1070 1071#---------------------------------------------------------------------------- 1072# plw::page_reset 1073# 1074# Resets page parameters. 1075#---------------------------------------------------------------------------- 1076 1077proc plw::page_reset {w} { 1078 $w.plwin page 0. 0. 0. 0. 1079} 1080 1081#---------------------------------------------------------------------------- 1082# plw::zoom_start 1083# 1084# Starts plot zoom. 1085#---------------------------------------------------------------------------- 1086 1087proc plw::zoom_start {w wx wy} { 1088 global def_button_cmd 1089 1090 bind $w.plwin <ButtonPress> $def_button_cmd 1091 plw::label_set $w "Select zoom region by dragging mouse, then release." 1092 1093 $w.plwin draw init 1094 bind $w.plwin <B1-Motion> "plw::zoom_mouse_draw $w $wx $wy %x %y" 1095 bind $w.plwin <B1-ButtonRelease> "plw::zoom_mouse_end $w $wx $wy %x %y" 1096} 1097 1098#---------------------------------------------------------------------------- 1099# plw::zoom_coords 1100# 1101# Transforms the initial and final mouse coordinates to either: 1102# 1103# opt = 0 device coordinates 1104# opt = 1 normalized device coordinates 1105# 1106# The global variable "zoomopts" is used to determine zoom behavior: 1107# 1108# zoomopts($w,0): 1109# 0 box follows mouse movements exactly 1110# 1 box follows mouse movements so that aspect ratio is preserved (default) 1111# 1112# zoomopts($w,1): 1113# 0 first and last points specified determine opposite corners 1114# of zoom box. 1115# 1 box is centered about the first point clicked on, 1116# perimeter follows mouse (default) 1117# 1118#---------------------------------------------------------------------------- 1119 1120proc plw::zoom_coords {w x0 y0 x1 y1 opt} { 1121 global zoomopts 1122 1123 set Lx [winfo width $w.plwin] 1124 set Ly [winfo height $w.plwin] 1125 1126# Enforce boundaries in device coordinate space 1127 1128 set bounds [$w.plwin view bounds] 1129 set xmin [expr [lindex "$bounds" 0] * $Lx] 1130 set ymin [expr [lindex "$bounds" 1] * $Ly] 1131 set xmax [expr [lindex "$bounds" 2] * $Lx] 1132 set ymax [expr [lindex "$bounds" 3] * $Ly] 1133 1134 set x1 [max $xmin [min $xmax $x1]] 1135 set y1 [max $ymin [min $ymax $y1]] 1136 1137# Two-corners zoom. 1138 1139 if { $zoomopts($w,1) == 0 } { 1140 1141 # Get box lengths 1142 1143 set dx [expr $x1 - $x0] 1144 set dy [expr $y1 - $y0] 1145 1146 set sign_dx [expr ($dx > 0) ? 1 : -1] 1147 set sign_dy [expr ($dy > 0) ? 1 : -1] 1148 1149 set xl $x0 1150 set yl $y0 1151 1152 # Constant aspect ratio 1153 1154 if { $zoomopts($w,0) == 1 } { 1155 1156 # Scale factors used to maintain plot aspect ratio 1157 1158 set xscale [expr $xmax - $xmin] 1159 set yscale [expr $ymax - $ymin] 1160 1161 # Adjust box size for proper aspect ratio 1162 1163 set rx [expr double(abs($dx)) / $xscale] 1164 set ry [expr double(abs($dy)) / $yscale] 1165 1166 if { $rx > $ry } { 1167 set dy [expr $yscale * $rx * $sign_dy] 1168 } else { 1169 set dx [expr $xscale * $ry * $sign_dx] 1170 } 1171 1172 set xr [expr $xl + $dx] 1173 set yr [expr $yl + $dy] 1174 1175 # Now check again to see if in bounds, and adjust if not 1176 1177 if { $xr < $xmin || $xr > $xmax } { 1178 if { $xr < $xmin } { 1179 set dx [expr $xmin - $x0] 1180 } else { 1181 set dx [expr $xmax - $x0] 1182 } 1183 set rx [expr double(abs($dx)) / $xscale] 1184 set dy [expr $yscale * $rx * $sign_dy] 1185 } 1186 1187 if { $yr < $ymin || $yr > $ymax } { 1188 if { $yr < $ymin } { 1189 set dy [expr $ymin - $y0] 1190 } else { 1191 set dy [expr $ymax - $y0] 1192 } 1193 set ry [expr double(abs($dy)) / $yscale] 1194 set dx [expr $xscale * $ry * $sign_dx] 1195 } 1196 } 1197 1198 # Final box coordinates 1199 1200 set xr [expr $xl + $dx] 1201 set yr [expr $yl + $dy] 1202 1203# zoom from center out, preserving aspect ratio 1204 1205 } else { 1206 1207 # Get box lengths, adjusting downward if necessary to keep in bounds 1208 1209 set dx [expr abs($x1 - $x0)] 1210 set dy [expr abs($y1 - $y0)] 1211 1212 set xr [expr $x0 + $dx] 1213 set xl [expr $x0 - $dx] 1214 set yr [expr $y0 + $dy] 1215 set yl [expr $y0 - $dy] 1216 1217 if { $xl < $xmin } { 1218 set dx [expr $x0 - $xmin] 1219 } 1220 if { $xr > $xmax } { 1221 set dx [expr $xmax - $x0] 1222 } 1223 if { $yl < $ymin } { 1224 set dy [expr $y0 - $ymin] 1225 } 1226 if { $yr > $ymax } { 1227 set dy [expr $ymax - $y0] 1228 } 1229 1230 # Constant aspect ratio 1231 1232 if { $zoomopts($w,0) == 1 } { 1233 1234 # Scale factors used to maintain plot aspect ratio 1235 1236 set xscale [expr $xmax - $xmin] 1237 set yscale [expr $ymax - $ymin] 1238 1239 # Adjust box size for proper aspect ratio 1240 1241 set rx [expr double($dx) / $xscale] 1242 set ry [expr double($dy) / $yscale] 1243 1244 if { $rx > $ry } { 1245 set dy [expr $yscale * $rx] 1246 } else { 1247 set dx [expr $xscale * $ry] 1248 } 1249 1250 set xr [expr $x0 + $dx] 1251 set xl [expr $x0 - $dx] 1252 set yr [expr $y0 + $dy] 1253 set yl [expr $y0 - $dy] 1254 1255 # Now check again to see if in bounds, and adjust downward if not 1256 1257 if { $xl < $xmin } { 1258 set dx [expr $x0 - $xmin] 1259 set rx [expr double($dx) / $xscale] 1260 set dy [expr $yscale * $rx] 1261 } 1262 if { $xr > $xmax } { 1263 set dx [expr $xmax - $x0] 1264 set rx [expr double($dx) / $xscale] 1265 set dy [expr $yscale * $rx] 1266 } 1267 if { $yl < $ymin } { 1268 set dy [expr $y0 - $ymin] 1269 set ry [expr double($dy) / $yscale] 1270 set dx [expr $xscale * $ry] 1271 } 1272 if { $yr > $ymax } { 1273 set dy [expr $ymax - $y0] 1274 set ry [expr double($dy) / $yscale] 1275 set dx [expr $xscale * $ry] 1276 } 1277 } 1278 1279 # Final box coordinates 1280 1281 set xr [expr $x0 + $dx] 1282 set xl [expr $x0 - $dx] 1283 set yr [expr $y0 + $dy] 1284 set yl [expr $y0 - $dy] 1285 } 1286 1287# Optional translation to relative device coordinates. 1288 1289 if { $opt == 1 } { 1290 set wxl [expr "$xl / double($Lx)" ] 1291 set wxr [expr "$xr / double($Lx)" ] 1292 set wyl [expr "1.0 - $yr / double($Ly)" ] 1293 set wyr [expr "1.0 - $yl / double($Ly)" ] 1294 1295 } else { 1296 set wxr $xl 1297 set wxl $xr 1298 set wyr $yl 1299 set wyl $yr 1300 } 1301 1302 return "$wxl $wyl $wxr $wyr" 1303} 1304 1305#---------------------------------------------------------------------------- 1306# plw::zoom_mouse_draw 1307# 1308# Draws zoom box in response to mouse motion (with button held down). 1309#---------------------------------------------------------------------------- 1310 1311proc plw::zoom_mouse_draw {w wx0 wy0 wx1 wy1} { 1312 1313 set coords [plw::zoom_coords $w $wx0 $wy0 $wx1 $wy1 0] 1314 1315 $w.plwin draw rect \ 1316 [lindex "$coords" 0] [lindex "$coords" 1] \ 1317 [lindex "$coords" 2] [lindex "$coords" 3] 1318} 1319 1320#---------------------------------------------------------------------------- 1321# plw::zoom_mouse_end 1322# 1323# Performs actual zoom, invoked when user releases mouse button. 1324#---------------------------------------------------------------------------- 1325 1326proc plw::zoom_mouse_end {w wx0 wy0 wx1 wy1} { 1327 1328# Finish rubber band draw 1329 1330 bind $w.plwin <B1-ButtonRelease> {} 1331 bind $w.plwin <B1-Motion> {} 1332 plw::label_reset $w 1333 $w.plwin draw end 1334 1335# Select new plot region 1336 1337 set coords [plw::zoom_coords $w $wx0 $wy0 $wx1 $wy1 1] 1338 1339 plw::view_zoom $w \ 1340 [lindex "$coords" 0] [lindex "$coords" 1] \ 1341 [lindex "$coords" 2] [lindex "$coords" 3] 1342} 1343 1344#---------------------------------------------------------------------------- 1345# plw::view_select 1346# 1347# Handles change of view into plot. 1348# Given in relative plot window coordinates. 1349#---------------------------------------------------------------------------- 1350 1351proc plw::view_select {w x0 y0 x1 y1} { 1352 1353# Adjust arguments to be in bounds and properly ordered (xl < xr, etc) 1354 1355 set xl [min $x0 $x1] 1356 set yl [min $y0 $y1] 1357 set xr [max $x0 $x1] 1358 set yr [max $y0 $y1] 1359 1360 set xmin 0. 1361 set ymin 0. 1362 set xmax 1. 1363 set ymax 1. 1364 1365 set xl [max $xmin [min $xmax $xl]] 1366 set yl [max $ymin [min $ymax $yl]] 1367 set xr [max $xmin [min $xmax $xr]] 1368 set yr [max $ymin [min $ymax $yr]] 1369 1370# Only create scrollbars if really needed. 1371 1372 if {($xl == $xmin) && ($xr == $xmax)} \ 1373 then {set hscroll 0} else {set hscroll 1} 1374 1375 if {($yl == $xmin) && ($yr == $xmax)} \ 1376 then {set vscroll 0} else {set vscroll 1} 1377 1378 if { ! ($hscroll || $vscroll)} {return} 1379 1380# Select plot region 1381 1382 $w.plwin view select $xl $yl $xr $yr 1383 1384# Fix up view 1385 1386 plw::fixview $w $hscroll $vscroll 1387} 1388 1389#---------------------------------------------------------------------------- 1390# plw::view_zoom 1391# 1392# Handles zoom. 1393# Given in relative device coordinates. 1394#---------------------------------------------------------------------------- 1395 1396proc plw::view_zoom {w x0 y0 x1 y1} { 1397 1398 global xl xr yl yr 1399 1400# Adjust arguments to be properly ordered (xl < xr, etc) 1401 1402 set xl [min $x0 $x1] 1403 set yl [min $y0 $y1] 1404 set xr [max $x0 $x1] 1405 set yr [max $y0 $y1] 1406 1407# Check for double-click (specified zoom region less than a few pixels 1408# wide). In this case, magnification is 2X in each direction, centered at 1409# the mouse location. At the boundary, the magnification is determined 1410# by the distance to the boundary. 1411 1412 set stdzoom 0.5 1413 if { ($xr - $xl < 0.02) && ($yr - $yl < 0.02) } { 1414 set nxl [expr $xl - 0.5 * $stdzoom] 1415 set nxr [expr $xl + 0.5 * $stdzoom] 1416 if { $nxl < 0.0 } { 1417 set nxl 0.0 1418 set nxr [expr 2.0 * $xl] 1419 } 1420 if { $nxr > 1.0 } { 1421 set nxr 1.0 1422 set nxl [expr 2.0 * $xl - 1.0] 1423 } 1424 set xl $nxl 1425 set xr $nxr 1426 1427 set nyl [expr $yl - 0.5 * $stdzoom] 1428 set nyr [expr $yl + 0.5 * $stdzoom] 1429 if { $nyl < 0.0 } { 1430 set nyl 0.0 1431 set nyr [expr 2.0 * $yl] 1432 } 1433 if { $nyr > 1.0 } { 1434 set nyr 1.0 1435 set nyl [expr 2.0 * $yl - 1.0] 1436 } 1437 set yl $nyl 1438 set yr $nyr 1439 } 1440 1441# Adjust arguments to be in bounds (in case margins are in effect). 1442 1443 set bounds [$w.plwin view bounds] 1444 set xmin [lindex "$bounds" 0] 1445 set ymin [lindex "$bounds" 1] 1446 set xmax [lindex "$bounds" 2] 1447 set ymax [lindex "$bounds" 3] 1448 1449 set xl [max $xmin [min $xmax $xl]] 1450 set yl [max $ymin [min $ymax $yl]] 1451 set xr [max $xmin [min $xmax $xr]] 1452 set yr [max $ymin [min $ymax $yr]] 1453 1454# Only create scrollbars if really needed. 1455 1456 set hscroll [expr ($xl != $xmin) || ($xr != $xmax)] 1457 set vscroll [expr ($yl != $ymin) || ($yr != $ymax)] 1458 1459 if { ! ($hscroll || $vscroll)} { 1460 $w.plwin redraw 1461 return 1462 } 1463 1464# Select plot region 1465 1466 $w.plwin view zoom $xl $yl $xr $yr 1467 1468# Fix up view 1469 1470 plw::fixview $w $hscroll $vscroll 1471 1472# Add window to zoom windows list 1473 1474 global zidx zidx_max zxl zyl zxr zyr 1475 1476 incr zidx($w) 1477 set zidx_max($w) $zidx($w) 1478 1479 set coords [$w.plwin view] 1480 set zxl($w,$zidx($w)) [lindex "$coords" 0] 1481 set zyl($w,$zidx($w)) [lindex "$coords" 1] 1482 set zxr($w,$zidx($w)) [lindex "$coords" 2] 1483 set zyr($w,$zidx($w)) [lindex "$coords" 3] 1484} 1485 1486#---------------------------------------------------------------------------- 1487# plw::zoom_back 1488# 1489# Traverses the zoom windows list backward. 1490#---------------------------------------------------------------------------- 1491 1492proc plw::zoom_back {w} { 1493 1494 global zidx zxl zyl zxr zyr 1495 1496 if { $zidx($w) == 0 } then return 1497 1498 incr zidx($w) -1 1499 1500 set xl $zxl($w,$zidx($w)) 1501 set yl $zyl($w,$zidx($w)) 1502 set xr $zxr($w,$zidx($w)) 1503 set yr $zyr($w,$zidx($w)) 1504 1505# Select plot region 1506 1507 $w.plwin view select $xl $yl $xr $yr 1508} 1509 1510#---------------------------------------------------------------------------- 1511# plw::zoom_forward 1512# 1513# Traverses the zoom windows list forward. 1514#---------------------------------------------------------------------------- 1515 1516proc plw::zoom_forward {w} { 1517 1518 global zidx zidx_max zxl zyl zxr zyr 1519 1520 if { $zidx_max($w) == 0 || $zidx($w) == $zidx_max($w) } then return 1521 1522 incr zidx($w) 1523 1524 set xl $zxl($w,$zidx($w)) 1525 set yl $zyl($w,$zidx($w)) 1526 set xr $zxr($w,$zidx($w)) 1527 set yr $zyr($w,$zidx($w)) 1528 1529# Select plot region 1530 1531 $w.plwin view select $xl $yl $xr $yr 1532} 1533 1534#---------------------------------------------------------------------------- 1535# plw::view_scroll 1536# 1537# Scrolls view incrementally. 1538# Similar to clicking on arrow at end of scrollbar (but speed is user 1539# controllable). 1540#---------------------------------------------------------------------------- 1541 1542proc plw::view_scroll {w dx dy s} { 1543 global key_scroll_mag 1544 global key_scroll_speed 1545 1546# Set up multiplication factor 1547 1548 set mult $key_scroll_speed 1549 if { $s & 0x01 } { 1550 set mult [expr $mult * $key_scroll_mag] 1551 } 1552 if { $s & 0x02 } { 1553 set mult [expr $mult * $key_scroll_mag] 1554 } 1555 if { $s & 0x04 } { 1556 set mult [expr $mult * $key_scroll_mag] 1557 } 1558 if { $s & 0x08 } { 1559 set mult [expr $mult * $key_scroll_mag] 1560 } 1561 1562# Now scroll 1563 1564 if {($dx != 0) && \ 1565 [winfo exists $w.hscroll] && [winfo ismapped $w.hscroll] } { 1566 1567 set dx [expr $dx * $mult] 1568 set first [lindex [$w.hscroll get] 2] 1569 $w.plwin xview scroll [expr $first+$dx] units 1570 } 1571 if {($dy != 0) && \ 1572 [winfo exists $w.vscroll] && [winfo ismapped $w.vscroll] } { 1573 1574 set dy [expr $dy * $mult] 1575 set first [lindex [$w.vscroll get] 2] 1576 $w.plwin yview scroll [expr $first+$dy] units 1577 } 1578} 1579 1580#---------------------------------------------------------------------------- 1581# plw::fixview 1582# 1583# Handles updates of scrollbars & plot after view change. 1584#---------------------------------------------------------------------------- 1585 1586proc plw::fixview {w hscroll vscroll} { 1587 1588# Create scrollbars if they don't already exist. 1589 1590 set created_sb 0 1591 if { $hscroll && ! [winfo exists $w.hscroll] } { 1592 set created_sb 1 1593 scrollbar $w.hscroll -relief sunken -orient horiz \ 1594 -command "$w.plwin xview" 1595 $w.plwin config -xscroll "$w.hscroll set" 1596 } 1597 if { $vscroll && ! [winfo exists $w.vscroll] } { 1598 set created_sb 1 1599 scrollbar $w.vscroll -relief sunken \ 1600 -command "$w.plwin yview" 1601 $w.plwin config -yscroll "$w.vscroll set" 1602 } 1603 1604# When scrollbars are first created, it may be necessary to unmap then map 1605# the plframe widget so that it has a chance to initialize the scrollbars 1606# before they are mapped. 1607 1608 if { $created_sb } { 1609 pack forget $w.plwin 1610 pack $w.plwin -side left -expand yes -fill both 1611 } 1612 1613# Map scrollbars if not already mapped. 1614# To get packing right, need to unmap then remap plot widget. 1615# Otherwise need to do explicit redraw. 1616 1617 if { ($hscroll && ! [winfo ismapped $w.hscroll]) || \ 1618 ($vscroll && ! [winfo ismapped $w.vscroll]) } { 1619 1620 update 1621 pack forget $w.plwin 1622 if { $hscroll } { 1623 pack $w.hscroll -side bottom -fill x 1624 } 1625 if { $vscroll } { 1626 pack $w.vscroll -side right -fill y 1627 } 1628 pack $w.plwin -expand yes -fill both 1629 1630 } else { 1631 $w.plwin redraw 1632 } 1633} 1634 1635#---------------------------------------------------------------------------- 1636# plw::update_view 1637# 1638# Updates view. Results in scrollbars being added if they are appropriate. 1639# Does nothing if the plot window is unchanged from the default. 1640#---------------------------------------------------------------------------- 1641 1642proc plw::update_view {w} { 1643 eval plw::view_select $w [$w.plwin view] 1644} 1645 1646#---------------------------------------------------------------------------- 1647# status_msg 1648# 1649# Used for temporarily flashing a status message in the status bar. Better 1650# than a dialog because it can be ignored and will go away on its own. 1651#---------------------------------------------------------------------------- 1652 1653proc status_msg {w msg} { 1654 1655 plw::label_set $w $msg 1656 after 2500 plw::label_reset $w 1657} 1658 1659#---------------------------------------------------------------------------- 1660# plw::label_reset 1661# 1662# Resets message in status bar to the default. 1663#---------------------------------------------------------------------------- 1664 1665proc plw::label_reset {w} { 1666 1667 $w.ftop.lstat configure -text " [string range $w 1 end]" 1668} 1669 1670#---------------------------------------------------------------------------- 1671# plw::label_set 1672# 1673# Sets message in status bar. 1674#---------------------------------------------------------------------------- 1675 1676proc plw::label_set {w msg} { 1677 1678 $w.ftop.lstat configure -text " $msg" 1679} 1680 1681#---------------------------------------------------------------------------- 1682# plw::dplink 1683# 1684# Initializes socket data link between widget and client code. 1685# In addition, as this is the last client/server connection needed, I 1686# disable further connections. 1687#---------------------------------------------------------------------------- 1688 1689proc plw::dplink {w client} { 1690 1691 global list_sock data_sock 1692 1693 dp_Host + 1694 set rv [dp_connect -server 0] 1695 set list_sock [lindex $rv 0] 1696 set data_port [lindex $rv 1] 1697 1698 dp_RDO $client set data_port $data_port 1699 set data_sock [lindex [dp_accept $list_sock] 0] 1700 $w.plwin openlink socket $data_sock 1701 dp_Host - 1702} 1703 1704 1705