1# File: autobar.tcl 2 3# Purpose: the Autobar display and related commands 4 5# 6# Copyright (c) 1997-2001 Tim Baker 7# 8# This software may be copied and distributed for educational, research, and 9# not for profit purposes provided that this copyright and statement are 10# included in all such copies. 11# 12 13namespace eval NSAutobar { 14 15# namespace eval NSAutobar 16} 17 18# NSAutobar::InitModule -- 19# 20# One-time-only-ever initialization. 21# 22# Arguments: 23# arg1 about arg1 24# 25# Results: 26# What happened. 27 28proc NSAutobar::InitModule {} { 29 30 InitImageIfNeeded Image_ButtonActivate button-activate.gif 31 InitImageIfNeeded Image_ButtonFood button-food.gif 32 InitImageIfNeeded Image_ButtonPotion button-potion.gif 33 InitImageIfNeeded Image_ButtonScroll button-scroll.gif 34 InitImageIfNeeded Image_ButtonRod button-rod.gif 35 InitImageIfNeeded Image_ButtonWand button-wand.gif 36 InitImageIfNeeded Image_ButtonStaff button-staff.gif 37 InitImageIfNeeded Image_ButtonDown button-down.gif 38 InitImageIfNeeded Image_ButtonUp button-up.gif 39 40 InitImageIfNeeded Image_ButtonBook button-book.gif 41 42 NSObject::New NSAutobar 43 44 return 45} 46 47# NSAutobar::CloseModule -- 48# 49# One-time-only-ever cleanup. 50# 51# Arguments: 52# arg1 about arg1 53# 54# Results: 55# What happened. 56 57proc NSAutobar::CloseModule {} { 58 59 catch { 60 destroy [Global autobar,canvas] 61 } 62 63 return 64} 65 66# NSAutobar::MInfo -- 67# 68# Query and modify info. 69# 70# Arguments: 71# arg1 about arg1 72# 73# Results: 74# What happened. 75 76proc NSAutobar::MInfo {info args} { 77 78 variable Priv 79 80 # Set info 81 if {[llength $args]} { 82 set Priv($info) [lindex $args 0] 83 84 # Get info 85 } else { 86 return $Priv($info) 87 } 88 89 return 90} 91 92# NSAutobar::NSAutobar -- 93# 94# Object constructor called by NSObject::New(). 95# 96# Arguments: 97# oop OOP ID. See above. 98# 99# Results: 100# What happened. 101 102proc NSAutobar::NSAutobar {oop} { 103 104 Info $oop busy 0 105 Info $oop current "" 106 Info $oop request,id "" 107 Info $oop showing 0 108 109 Info $oop bar,visible 0 110 Info $oop win,visible 0 111 Info $oop whoHasCursor "" 112 Info $oop after "" 113 114 Info $oop nextButton 0 115 116 InitDisplay $oop 117 118 set canvas [Info $oop canvas] 119 set wText [Info $oop text] 120 121 # Update ourself when the list highlight color changes 122 Info $oop clientId,listHilite \ 123 [NSValueManager::AddClient listHilite \ 124 "$wText tag configure HOT \ 125 -background \[Value listHilite]"] 126 127 # Update ourself when the font changes 128 Info $oop clientId,font,autobar \ 129 [NSValueManager::AddClient font,autobar \ 130 "NSAutobar::ValueChanged_font_autobar $oop"] 131 132 # Destroy the object along with the toplevel (later) 133 NSUtils::DestroyObjectWithWidget NSAutobar $oop $canvas 134 135 Global autobar,canvas $canvas 136 Global autobar,oop $oop 137 138 return 139} 140 141# NSAutobar::~NSAutobar -- 142# 143# Object destructor called by NSObject::Delete(). 144# 145# Arguments: 146# arg1 about arg1 147# 148# Results: 149# What happened. 150 151proc NSAutobar::~NSAutobar {oop} { 152 153 NSValueManager::RemoveClient font,autobar [Info $oop clientId,font,autobar] 154 NSValueManager::RemoveClient listHilite [Info $oop clientId,listHilite] 155 156 return 157} 158 159# NSAutobar::Info -- 160# 161# Query and modify info. 162# 163# Arguments: 164# arg1 about arg1 165# 166# Results: 167# What happened. 168 169proc NSAutobar::Info {oop info args} { 170 171 global NSAutobar 172 173 # Set info 174 if {[llength $args]} { 175 switch -- $info { 176 default { 177 set NSAutobar($oop,$info) [lindex $args 0] 178 } 179 } 180 181 # Get info 182 } else { 183 switch -- $info { 184 default { 185 return $NSAutobar($oop,$info) 186 } 187 } 188 } 189 190 return 191} 192 193# NSAutobar::InitDisplay -- 194# 195# Create the display. 196# 197# Arguments: 198# oop OOP ID. See above. 199# 200# Results: 201# What happened. 202 203proc NSAutobar::InitDisplay {oop} { 204 205 set widget [Global main,widget] 206 207 # 208 # The main canvas, holding the buttons 209 # 210 211 set canvas $widget.autobar$oop 212 canvas $canvas \ 213 -borderwidth 0 -relief flat -highlightthickness 0 \ 214 -background Black -height 22 -width 200 \ 215 -scrollregion {0 0 0 0} 216 217 Info $oop canvas $canvas 218 219 bind $canvas <Enter> \ 220 "NSAutobar::Event $oop enter-bar" 221 bind $canvas <Leave> \ 222 "NSAutobar::Event $oop leave-bar" 223 224 # 225 # Buttons 226 # Some buttons invoke a command when clicked, such as "go down". 227 # Other buttons display a list of item or spell choices. 228 # If a pop-up button has no valid choices, then it isn't displayed 229 # in the bar. 230 # 231 232 set x 2 233 NewButton $oop -image Image_ButtonActivate -popup 1 -hook item \ 234 -args [list equipment A -activate yes] \ 235 -message "Activate an equipment item" 236 237 $canvas configure -width [incr x 20] 238 239 $canvas create rectangle \ 240 0 0 [expr {$x - 1}] 21 -outline gray60 -tags border 241 242 # 243 # Popup window of choices 244 # 245 246 set win $canvas.popup 247 toplevel $win 248 $win configure -borderwidth 1 -relief flat -background gray60 249 wm overrideredirect $win yes 250 wm transient $win [Window main] 251 252 if {[Platform unix]} { 253 $win configure -cursor arrow 254 } 255 256 # Start out withdrawn (hidden) 257 wm withdraw $win 258 259 Info $oop win $win 260 261 set wText $win.text 262 text $wText \ 263 -wrap none -font [Value font,autobar] \ 264 -borderwidth 0 -setgrid no -highlightthickness 0 \ 265 -padx 4 -pady 2 -background Black -foreground White -cursor "" 266 267 # Bypass default Text bindings 268 bindtags $wText [list $wText $win all] 269 270 pack $wText \ 271 -expand yes -fill both 272 273 Info $oop text $wText 274 275 # Fiddle with the selection for list behaviour 276 $wText tag configure HOT -foreground White \ 277 -background [Value listHilite] 278 279 $wText tag bind HOT <ButtonPress-1> \ 280 "NSAutobar::Invoke $oop" 281 $wText tag bind TEXT <Motion> \ 282 "NSAutobar::Motion $oop \[$wText index {@%x,%y linestart}]" 283 $wText tag bind HOT <Leave> \ 284 "NSAutobar::Motion $oop {}" 285 286 bind $win <Enter> \ 287 "NSAutobar::Event $oop enter-win" 288 bind $win <Leave> " 289 NSAutobar::Motion $oop {} 290 NSAutobar::Event $oop leave-win 291 " 292 293 return 294} 295 296# NSAutobar::NewButton -- 297# 298# Add a new button to the Autobar. 299# 300# Arguments: 301# arg1 about arg1 302# 303# Results: 304# What happened. 305 306proc NSAutobar::NewButton {oop args} { 307 308 set canvas [Info $oop canvas] 309 310 # Get the next unique id for this button 311 set num [incr ::NSAutobar($oop,nextButton)] 312 313 set config(-command) "" 314 array set config $args 315 316 set image $config(-image) 317 set command $config(-command) 318 set message $config(-message) 319 320 # The buttons are positioned in ShowBar(). 321 set x 0 322 set y 0 323 324 # Focus rectangle 325 $canvas create rectangle $x $y [expr {$x + 17}] [expr {$y + 17}] \ 326 -tags [list button button$num border$num] 327 328 # Image 329 $canvas create image [expr {$x + 1}] [expr {$y + 1}] -image $image \ 330 -anchor nw -tags "button button$num img$num" 331 332 # Show popup on mouse-over 333 if {![string length $command]} { 334 335 $canvas bind img$num <Enter> " 336 $canvas itemconfigure border$num -outline gray60 337 NSMainWindow::StatusText $oop [list $message] 338 NSAutobar::EnterButton $oop $num 339 " 340 341 Info $oop button,hook,$num $config(-hook) 342 Info $oop button,args,$num $config(-args) 343 344 # Click to invoke command 345 } else { 346 $canvas bind img$num <Enter> " 347 $canvas itemconfigure border$num -outline gray60 348 NSMainWindow::StatusText $oop [list $message] 349 NSAutobar::Event $oop enter-button2 350 " 351 $canvas bind img$num <ButtonPress-1> " 352 $canvas move button$num 1 1 353 $command 354 " 355 $canvas bind img$num <ButtonRelease-1> \ 356 "$canvas move button$num -1 -1" 357 358 Info $oop button,hook,$num "" 359 } 360 361 $canvas bind img$num <Leave> " 362 $canvas itemconfigure border$num -outline Black 363 NSAutobar::Event $oop leave-button 364 NSMainWindow::StatusText $oop {} 365 " 366 367 return 368} 369 370# NSAutobar::SetHook -- 371# 372# Set the hook. 373# 374# Arguments: 375# arg1 about arg1 376# 377# Results: 378# What happened. 379 380proc NSAutobar::SetHook {oop hook} { 381 382 if {[string length $hook]} { 383 Info $oop hook $hook 384 CallHook $oop open 385 } elseif {[string length [Info $oop hook]]} { 386 Info $oop hook "" 387 } 388 389 return 390} 391 392# NSAutobar::CallHook -- 393# 394# Call the hook. 395# 396# Arguments: 397# arg1 about arg1 398# 399# Results: 400# What happened. 401 402proc NSAutobar::CallHook {oop message args} { 403 404 return [uplevel #0 NSAutobar::[Info $oop hook] $oop $message $args] 405} 406 407# NSAutobar::EnterButton -- 408# 409# Display popup of choices. 410# 411# Arguments: 412# arg1 about arg1 413# 414# Results: 415# What happened. 416 417proc NSAutobar::EnterButton {oop buttonNum} { 418 419 set win [Info $oop win] 420 set canvas [Info $oop canvas] 421 set wText [Info $oop text] 422 423 set hook [Info $oop button,hook,$buttonNum] 424 set hookArgs [Info $oop button,args,$buttonNum] 425 426 if {[lsearch -exact [angband inkey_flags] INKEY_CMD] == -1} return 427 428 set x [Info $oop button,x,$buttonNum] 429 incr x [expr {[winfo rootx $canvas] + 9}] 430 set y [winfo rooty $canvas] 431 432 # Set the list 433 SetHook $oop hook_$hook 434 $wText delete 1.0 end 435 eval CallHook $oop set_list $hookArgs 436 437 set width [Info $oop maxWidth] 438 incr width [expr {[$wText cget -padx] * 2}] 439 440 set height [Info $oop maxHeight] 441 incr height [expr {[$wText cget -pady] * 2}] 442 443 incr width [expr {[$win cget -borderwidth] * 2}] 444 incr height [expr {[$win cget -borderwidth] * 2}] 445 446 # x is middle 447 incr x [expr {0 - $width / 2}] 448 if {$x < [winfo rootx $canvas]} { 449 set x [winfo rootx $canvas] 450 } 451 452 # Given y is bottom 453 incr y -$height 454 455 set screenWidth [winfo screenwidth .] 456 if {$x + $width > $screenWidth} { 457 incr x [expr {$screenWidth - ($x + $width)}] 458 } 459 set screenHeight [winfo screenheight .] 460 if {$y + $height > $screenHeight} { 461 incr y [expr {$screenHeight - ($y + $height)}] 462 } 463 464 wm geometry $win ${width}x${height}+${x}+$y 465 466 # Perhaps show the window later 467 Event $oop enter-button 468 469 return 470} 471 472# NSAutobar::Event -- 473# 474# Description. 475# 476# Arguments: 477# arg1 about arg1 478# 479# Results: 480# What happened. 481 482proc NSAutobar::Event {oop event} { 483 484 set who [Info $oop whoHasCursor] 485 486 switch -- $event { 487 enter-status { 488 if {[lsearch -exact [angband inkey_flags] INKEY_CMD] == -1} return 489 set who status 490 } 491 leave-status { 492 set who "" 493 } 494 enter-bar { 495 # The <Enter> binding for a button is invoked before 496 # the binding for the canvas. So we don't want to 497 # forget we are in a button 498 if {[string compare $who button]} { 499 set who bar 500 } 501 } 502 leave-bar { 503 set who "" 504 } 505 enter-win { 506 set who win 507 } 508 leave-win { 509 set who "" 510 } 511 enter-button { 512 set who button 513 } 514 enter-button2 { 515 set who button2 516 } 517 leave-button { 518 set who bar 519 } 520 } 521 522 Info $oop whoHasCursor $who 523 if {[string match enter-* $event]} { 524 set delay 10 525 } else { 526 set delay 200 527 } 528 after cancel [Info $oop after] 529 Info $oop after [after $delay NSAutobar::CheckWhoHasCursor $oop] 530 531 return 532} 533 534# NSAutobar::CheckWhoHasCursor -- 535# 536# Description. 537# 538# Arguments: 539# arg1 about arg1 540# 541# Results: 542# What happened. 543 544proc NSAutobar::CheckWhoHasCursor {oop} { 545 546 set who [Info $oop whoHasCursor] 547 548 switch -- $who { 549 bar { 550 HideWin $oop 551 } 552 button { 553 ShowWin $oop 554 } 555 button2 { 556 HideWin $oop 557 } 558 status { 559 HideWin $oop 560 ShowBar $oop 561 } 562 win { 563 564 } 565 default { 566 HideWin $oop 567 HideBar $oop 568 } 569 } 570 571 Info $oop after "" 572 573 return 574} 575 576# NSAutobar::ShowBar -- 577# 578# Description. 579# 580# Arguments: 581# arg1 about arg1 582# 583# Results: 584# What happened. 585 586proc NSAutobar::ShowBar {oop} { 587 588 set canvas [Info $oop canvas] 589 590 # The bar is already shown 591 if {[Info $oop bar,visible]} return 592 593 # Hide all the buttons 594 $canvas itemconfigure button -state hidden 595 596 # Display buttons which have some commands 597 set x 3 598 set y 3 599 600 # Check each button 601 for {set i 1} {$i <= [Info $oop nextButton]} {incr i} { 602 603 # Get the hook for this button (if any) 604 set hook [Info $oop button,hook,$i] 605 606 # This button has a hook 607 if {[string length $hook]} { 608 609 # Set the hook 610 SetHook $oop hook_$hook 611 612 # Get the extra args to pass to the hook 613 set args [Info $oop button,args,$i] 614 615 # See if there are any valid choices 616 if {[eval CallHook $oop has_cmd $args]} { 617 618 # Position the button horizontally 619 scan [$canvas coords img$i] "%s %s" cx cy 620 $canvas move button$i [expr {$x - $cx}] [expr {$y - $cy}] 621 $canvas itemconfigure button$i -state "" 622 623 # Remember the x coordinate 624 Info $oop button,x,$i $x 625 626 # Leave space for another button 627 incr x 20 628 } 629 630 # Button has no hook, always show it 631 } else { 632 633 # Position the button horizontally 634 scan [$canvas coords img$i] "%s %s" cx cy 635 $canvas move button$i [expr {$x - $cx}] [expr {$y - $cy}] 636 $canvas itemconfigure button$i -state "" 637 638 # Remember the x coordinate 639 Info $oop button,x,$i $x 640 641 # Leave space for another button 642 incr x 20 643 } 644 } 645 646 # Resize the bar, and position the border rectangle 647 set width [expr {$x - 1}] 648 $canvas configure -width $width 649 $canvas coords border 0 0 [expr {$width - 1}] 21 650 651 # Now slide the bar into view 652 set height [winfo reqheight $canvas] 653 foreach frac [list 0.1 0.2 0.3 0.5 0.7 1] { 654 set dy [expr {0 - $height * $frac}] 655 place $canvas -relx 0.5 -rely 1.0 -y $dy -anchor n 656 update idletasks 657 } 658 659 Info $oop bar,visible 1 660 661 return 662} 663 664# NSAutobar::HideBar -- 665# 666# Description. 667# 668# Arguments: 669# arg1 about arg1 670# 671# Results: 672# What happened. 673 674proc NSAutobar::HideBar {oop} { 675 676 if {![Info $oop bar,visible]} return 677 678 set canvas [Info $oop canvas] 679 680 # Now slide the bar out of view 681 set height [winfo reqheight $canvas] 682 foreach frac [list 0.7 0.4 0.1] { 683 set dy [expr {0 - $height * $frac}] 684 place $canvas -relx 0.5 -rely 1.0 -y $dy -anchor n 685 686 # Kind of slow if mouse is whizzing around... 687 update 688 } 689 690 place forget $canvas 691 692 Info $oop bar,visible 0 693 694 return 695} 696 697# NSAutobar::ShowWin -- 698# 699# Description. 700# 701# Arguments: 702# arg1 about arg1 703# 704# Results: 705# What happened. 706 707proc NSAutobar::ShowWin {oop} { 708 709 if {[Info $oop win,visible]} return 710 711 set win [Info $oop win] 712 713 wm deiconify $win 714 if {[Platform unix]} { 715 raise $win 716 } 717 718 Info $oop win,visible 1 719 720 return 721} 722 723# NSAutobar::HideWin -- 724# 725# Description. 726# 727# Arguments: 728# arg1 about arg1 729# 730# Results: 731# What happened. 732 733proc NSAutobar::HideWin {oop} { 734 735 if {![Info $oop win,visible]} return 736 737 set win [Info $oop win] 738 739 wm withdraw $win 740 741 Info $oop win,visible 0 742 743 return 744} 745 746# NSAutobar::Invoke -- 747# 748# Called when a list item is clicked. 749# 750# Arguments: 751# arg1 about arg1 752# 753# Results: 754# What happened. 755 756proc NSAutobar::Invoke {oop} { 757 758 set textBox [Info $oop text] 759 set index [Info $oop current] 760 set row [expr {[lindex [split $index .] 0] - 1}] 761 762 HideWin $oop 763 HideBar $oop 764 765 CallHook $oop invoke $row 766 767 return 768} 769 770# NSAutobar::Motion -- 771# 772# Called when the mouse moves in a list item. 773# 774# Arguments: 775# arg1 about arg1 776# 777# Results: 778# What happened. 779 780proc NSAutobar::Motion {oop index} { 781 782 set textBox [Info $oop text] 783 784 # If you invoke an item, hold down the mouse, and drag... 785 if {![string length [Info $oop hook]]} return 786 787 # No tracking while menu is up 788# if {[Info $oop busy]} return 789 790 # See if the item has changed 791 if {$index == [Info $oop current]} return 792 793 # An item is highlighted 794 if {[string length [Info $oop current]]} { 795 796 # Remove highlighting 797 UnhighlightItem $oop [Info $oop current] 798 } 799 800 # An item is under the pointer 801 if {[string length $index]} { 802 803 # Highlight the item 804 HighlightItem $oop $index 805 } 806 807 # Remember which item is highlighted 808 Info $oop current $index 809 810 return 811} 812 813# NSAutobar::HighlightItem -- 814# 815# Highlights a list item. 816# 817# Arguments: 818# arg1 about arg1 819# 820# Results: 821# What happened. 822 823proc NSAutobar::HighlightItem {oop index} { 824 825 set textBox [Info $oop text] 826 set row [expr {[lindex [split $index .] 0] - 1}] 827 828 # Highlight the item 829 $textBox tag add HOT $index "$index lineend" 830 $textBox tag raise HOT 831 832 # Call the hook (to set the icon, for example) 833 CallHook $oop highlight $row 834 835 return 836} 837 838# NSAutobar::UnhighlightItem -- 839# 840# Removes highlighting from a list item. 841# 842# Arguments: 843# arg1 about arg1 844# 845# Results: 846# What happened. 847 848proc NSAutobar::UnhighlightItem {oop index} { 849 850 set win [Info $oop win] 851 set textBox [Info $oop text] 852 853 # Unhighlight the item 854 $textBox tag remove HOT 1.0 end 855 856 return 857} 858 859# NSAutobar::HasCursor -- 860# 861# See if the cursor is over the window. 862# 863# Arguments: 864# arg1 about arg1 865# 866# Results: 867# What happened. 868 869proc NSAutobar::HasCursor {oop} { 870 871 set pointerx [winfo pointerx .] 872 set pointery [winfo pointery .] 873 set window [winfo containing $pointerx $pointery] 874 if {![string length $window]} { 875 return 0 876 } 877 if {[string compare [winfo toplevel $window] [Info $oop win]]} { 878 return 0 879 } 880 return 1 881} 882 883 884# NSAutobar::ValueChanged_font_autobar -- 885# 886# Called when the font,autobar value changes. 887# Updates the Recall Window. 888# 889# Arguments: 890# arg1 about arg1 891# 892# Results: 893# What happened. 894 895proc NSAutobar::ValueChanged_font_autobar {oop} { 896 897 set text [Info $oop text] 898 $text configure -font [Value font,autobar] 899 900 return 901} 902
