1# File: knowledge.tcl 2 3# Purpose: the Knowledge Window 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 NSKnowledge { 14 15 variable MenuString 16 variable Priv 17 18# namespace eval NSKnowledge 19} 20 21# NSKnowledge::InitModule -- 22# 23# One-time-only-ever initialization. 24# 25# Arguments: 26# arg1 about arg1 27# 28# Results: 29# What happened. 30 31proc NSKnowledge::InitModule {} { 32 33 variable Priv 34 35 set Priv(hook) {} 36 37 # Create the Knowledge Window 38 NSObject::New NSKnowledge 39 40 return 41} 42 43# NSKnowledge::CloseModule -- 44# 45# One-time-only-ever cleanup. 46# 47# Arguments: 48# arg1 about arg1 49# 50# Results: 51# What happened. 52 53proc NSKnowledge::CloseModule {} { 54 55 catch { 56 destroy [Window knowledge] 57 } 58 59 return 60} 61 62# NSKnowledge::NSKnowledge -- 63# 64# Object constructor called by NSObject::New(). 65# 66# Arguments: 67# arg1 about arg1 68# 69# Results: 70# What happened. 71 72proc NSKnowledge::NSKnowledge {oop} { 73 74 variable Priv 75 76 InitWindow $oop 77 78 set win [Info $oop win] 79 80 Info $oop group,current -1 81 Info $oop member,current -1 82 83 # Info about selected group & member for each hook 84 foreach {hook label} $Priv(hook) { 85 Info $oop group,$hook 0 86 Info $oop member,$hook -1 87 } 88 89 set Priv(find,string) "" 90 set Priv(find,fromStart) 1 91 92 NSWindowManager::RegisterWindow knowledge $win \ 93 "GetDefaultGeometry $win reqwidth main" "" \ 94 "NSKnowledge::DisplayCmd $oop" 95 96 # Destroy the object along with the toplevel (later) 97 NSUtils::DestroyObjectWithWidget NSKnowledge $oop $win 98 99 # 100 # Global list of application windows 101 # 102 103 Global knowledge,oop $oop 104 Window knowledge $win 105 106 return 107} 108 109# NSKnowledge::~NSKnowledge -- 110# 111# Object destructor called by NSObject::Delete(). 112# 113# Arguments: 114# arg1 about arg1 115# 116# Results: 117# What happened. 118 119proc NSKnowledge::~NSKnowledge {oop} { 120 121 NSValueManager::RemoveClient listBG [Info $oop listBG,clientId] 122 NSValueManager::RemoveClient font,knowledge [Info $oop font,clientId] 123 124 return 125} 126 127# NSKnowledge::Info -- 128# 129# Query and modify info. 130# 131# Arguments: 132# arg1 about arg1 133# 134# Results: 135# What happened. 136 137proc NSKnowledge::Info {oop info args} { 138 139 global NSKnowledge 140 141 # Verify the object 142 NSObject::CheckObject NSKnowledge $oop 143 144 # Set info 145 if {[llength $args]} { 146 switch -- $info { 147 default { 148 set NSKnowledge($oop,$info) [lindex $args 0] 149 } 150 } 151 152 # Get info 153 } else { 154 switch -- $info { 155 groupCanvas { 156 set canvistId [Info $oop group,canvistId] 157 return [NSCanvist::Info $canvistId canvas] 158 } 159 memberCanvas { 160 set canvistId [Info $oop member,canvistId] 161 return [NSCanvist::Info $canvistId canvas] 162 } 163 default { 164 return $NSKnowledge($oop,$info) 165 } 166 } 167 } 168 169 return 170} 171 172# NSKnowledge::InitWindow -- 173# 174# Create the window. 175# 176# Arguments: 177# arg1 about arg1 178# 179# Results: 180# What happened. 181 182proc NSKnowledge::InitWindow {oop} { 183 184 variable Priv 185 186 set win .knowledge$oop 187 toplevel $win 188 wm title $win "Knowledge" 189 190 wm transient $win [Window main] 191 192 # Do stuff when window closes 193 wm protocol $win WM_DELETE_WINDOW "NSKnowledge::Close $oop" 194 195 # Start out withdrawn (hidden) 196 wm withdraw $win 197 198 Info $oop win $win 199 200 # 201 # Menus 202 # 203 204 InitMenus $oop 205 206 # 207 # Divider 208 # 209 210 MakeDivider $win.divider2 x 211 212 # 213 # Tabs! 214 # 215 216 set tabsId [NSObject::New NSTabs $win] 217 foreach {hook label} $Priv(hook) { 218 NSTabs::Add $tabsId $label 219 } 220 NSTabs::Info $tabsId invokeCmd "NSKnowledge::InvokeTab $oop" 221 NSTabs::Info $tabsId active 1 222 Info $oop tabsId $tabsId 223 224 # 225 # Group List 226 # 227 228 set cw [font measure [Value font,knowledge] "W"] 229# set width [expr {$cw * 26}] 230 set width [CalcGroupListWidth $oop] 231 set iconSize [expr {[icon size] + 8}] 232 233 frame $win.frameGroup \ 234 -borderwidth 1 -relief sunken 235 set canvistId [NSObject::New NSCanvist $win.frameGroup $iconSize $width 300 \ 236 "NSKnowledge::NewItemCmd $oop" "NSKnowledge::HighlightItemCmd $oop"] 237 set canvas [NSCanvist::Info $canvistId canvas] 238 $canvas configure -background [Value listBG] 239 $canvas configure -yscrollcommand "$win.frameGroup.scroll set" 240 scrollbar $win.frameGroup.scroll \ 241 -command "$canvas yview" -orient vert 242 243 # Do something when a group is selected 244 NSCanvist::Info $canvistId selectionCmd \ 245 "NSKnowledge::SelectionChanged_Group $oop" 246 247 # Update ourself when the listBG value changes 248 Info $oop listBG,clientId \ 249 [NSValueManager::AddClient listBG \ 250 "NSKnowledge::ValueChanged_listBG $oop"] 251 252 # Update ourself when the font,knowledge value changes 253 Info $oop font,clientId \ 254 [NSValueManager::AddClient font,knowledge \ 255 "NSKnowledge::ValueChanged_font_knowledge $oop"] 256 257 pack $win.frameGroup.scroll -side right -fill y 258 pack $canvas -side left -expand yes -fill both -anchor nw 259 260 Info $oop group,canvistId $canvistId 261 262 # 263 # Member List 264 # 265 266# set width [expr {$cw * 50}] 267 set width 350 268 269 frame $win.frame \ 270 -borderwidth 1 -relief sunken 271 set canvistId [NSObject::New NSCanvist $win.frame $iconSize $width 300 \ 272 "NSKnowledge::NewItemCmd $oop" "NSKnowledge::HighlightItemCmd $oop"] 273 set canvas [NSCanvist::Info $canvistId canvas] 274 $canvas configure -background [Value listBG] 275 $canvas configure -yscrollcommand "$win.frame.scroll set" 276 scrollbar $win.frame.scroll \ 277 -command "$canvas yview" -orient vert 278 279 # Do something when a member is selected 280 NSCanvist::Info $canvistId selectionCmd \ 281 "NSKnowledge::SelectionChanged_Member $oop" 282 283 # Do something when a selected member is clicked. 284 NSCanvist::Info $canvistId clickCmd \ 285 "NSKnowledge::Click_Member $oop" 286 287 bind $canvas <Configure> " 288 NSKnowledge::Configure $oop $canvas 289 " 290 291 Info $oop member,canvistId $canvistId 292 293 pack $win.frame.scroll -side right -fill y 294 pack $canvas -side left -expand yes -fill both -anchor nw 295 296 # 297 # Statusbar 298 # 299 300 MakeStatusBar $win.statusBar 20 301 302 # 303 # Geometry 304 # 305 306 grid rowconfig $win 0 -weight 0 -minsize 0 307 grid rowconfig $win 1 -weight 0 -minsize 0 308 grid rowconfig $win 2 -weight 1 -minsize 0 309 grid rowconfig $win 3 -weight 0 -minsize 0 310 grid columnconfig $win 0 -weight 0 -minsize 0 311 grid columnconfig $win 1 -weight 1 -minsize 0 312 313 if {[Platform windows]} { 314 grid $win.divider2 \ 315 -row 0 -column 0 -rowspan 1 -columnspan 2 -sticky ew 316 } 317 grid [NSTabs::Info $tabsId canvas] \ 318 -row 1 -column 0 -rowspan 1 -columnspan 2 -sticky ew 319 grid $win.frameGroup \ 320 -row 2 -column 0 -rowspan 1 -columnspan 1 -sticky ns 321 grid $win.frame \ 322 -row 2 -column 1 -rowspan 1 -columnspan 1 -sticky news 323 grid $win.statusBar -in $win \ 324 -row 3 -column 0 -rowspan 1 -columnspan 2 -sticky ew 325 326 # 327 # Feed Term when keys pressed 328 # 329 330 bind $win <KeyPress-Escape> "NSKnowledge::Close $oop" 331 bind $win <Control-KeyPress-w> "NSKnowledge::Close $oop" 332 333 bind $win <KeyPress-f> "NSKnowledge::Find $oop 0" 334 bind $win <KeyPress-g> "NSKnowledge::Find $oop 1" 335 336 # 337 # Synch the scrollbars when window is shown. 338 # Hmmm. This doesn't work if you bind to $win.frame.scroll... 339 # 340 341 NSUtils::SynchScrollBar [Info $oop groupCanvas] $win.frameGroup.scroll 342 NSUtils::SynchScrollBar [Info $oop memberCanvas] $win.frame.scroll 343 344 return 345} 346 347# NSKnowledge::InitMenus -- 348# 349# Create the menus. 350# 351# Arguments: 352# arg1 about arg1 353# 354# Results: 355# What happened. 356 357proc NSKnowledge::InitMenus {oop} { 358 359# global NSKnowledge 360# global NSMenu 361 variable MenuString 362 variable Priv 363 364 set win [Info $oop win] 365 366 set mod "Ctrl" 367 368 # 369 # Menu bar 370 # 371 372 set mbar [NSObject::New NSMenu $win -tearoff 0 \ 373 -postcommand "NSKnowledge::SetupMenus $oop" -identifier MENUBAR] 374 Info $oop mbarId $mbar 375 376 # Context-sensitive help 377 NSMenu::Info $mbar menuSelectCmd "NSKnowledge::MenuSelect $oop" 378 379 # Call our command when an entry is invoked 380 NSMenu::Info $mbar invokeCmd "NSKnowledge::MenuInvoke $oop" 381 382 # 383 # Knowledge Menu 384 # 385 386 NSObject::New NSMenu $mbar -tearoff 0 -identifier MENU_KNOWLEDGE 387 NSMenu::MenuInsertEntry $mbar -end MENUBAR -type cascade \ 388 -menu MENU_KNOWLEDGE -label "Knowledge" -underline 0 \ 389 -identifier M_KNOWLEDGE 390 391 set entries {} 392 set i 1 393 foreach {hook label} $Priv(hook) { 394 lappend entries [list -type radiobutton -label $label \ 395 -variable NSKnowledge($oop,radio,hook) -value $hook \ 396 -accelerator $i -identifier E_HOOK_$i] 397 bind $win <KeyPress-$i> "NSKnowledge::SetHook $oop $hook" 398 incr i 399 } 400 lappend entries [list -type separator] 401 lappend entries [list -type command -label "Find..." \ 402 -accelerator f -underline 0 -identifier E_FIND] 403 lappend entries [list -type command -label "Find Again" \ 404 -accelerator g -underline 6 -identifier E_FIND_AGAIN] 405 lappend entries [list -type separator] 406 lappend entries [list -type command -label "Set Font" \ 407 -underline 0 -identifier E_FONT] 408 lappend entries [list -type separator] 409 lappend entries [list -type command -label "Close" \ 410 -underline 0 -accelerator $mod+W -identifier E_CLOSE] 411 412 NSMenu::MenuInsertEntries $mbar -end MENU_KNOWLEDGE $entries 413 414 # 415 # Hook Menu 416 # 417 418 set m [NSMenu::Info $mbar menu].hook 419 menu $m -tearoff 0 420 Info $oop hookMenu,menu $m 421 Info $oop hookMenu,inserted 0 422 423 set MenuString(M_KNOWLEDGE) \ 424 "Contains commands for displaying and searching groups." 425 set MenuString(E_FIND) \ 426 "Searches for a member by name." 427 set MenuString(E_FIND_AGAIN) \ 428 "Repeats the previous search." 429 set MenuString(E_CLOSE) \ 430 "Closes the window." 431 432 return 433} 434 435# NSKnowledge::SetupMenus -- 436# 437# Prepare to post the menus. 438# 439# Arguments: 440# arg1 about arg1 441# 442# Results: 443# What happened. 444 445proc NSKnowledge::SetupMenus {oop mbarID} { 446 447 variable Priv 448 449 set i 0 450 foreach {hook label} $Priv(hook) { 451 lappend identList E_HOOK_[incr i] 452 } 453 454 lappend identList E_FIND E_FIND_AGAIN E_FONT E_CLOSE 455 456 if {[Info $oop hookMenu,inserted]} { 457 set menu [Info $oop hookMenu,menu] 458 set last [$menu index end] 459 for {set i 0} {$i <= $last} {incr i} { 460 if {[string equal [$menu type $i] separator]} continue 461 $menu entryconfigure $i -state disabled 462 } 463 CallHook $oop menu_setup 464 } 465 466 NSMenu::MenuEnable $mbarID $identList 467 468 [Info $oop win].statusBar cover show 469 470 return 471} 472 473# NSKnowledge::MenuSelect -- 474# 475# Displays a help string associated with a menu entry. 476# 477# Arguments: 478# arg1 about arg1 479# 480# Results: 481# What happened. 482 483proc NSKnowledge::MenuSelect {oop menuId index ident} { 484 485 variable MenuString 486 variable Priv 487 488 switch -glob -- $ident { 489 {} { 490 set desc {} 491 } 492 E_HOOK_* { 493 set desc "Displays this group." 494 } 495 default { 496 if {[info exists MenuString($ident)]} { 497 set desc $MenuString($ident) 498 } else { 499 set menu [NSMenu::Info $menuId menu] 500 set desc [$menu entrycget $index -label] 501 } 502 } 503 } 504 505 [Info $oop win].statusBar cover set $desc 506 if {![string length $desc]} { 507 if {$menuId == [Info $oop mbarId]} { 508 [Info $oop win].statusBar cover hide 509 } 510 } 511 512 return 513} 514 515# NSKnowledge::MenuInvoke -- 516# 517# Called when a menu entry is invoked. 518# 519# Arguments: 520# arg1 about arg1 521# 522# Results: 523# What happened. 524 525proc NSKnowledge::MenuInvoke {oop menuId ident} { 526 527 variable Priv 528 529 switch -glob -- $ident { 530 E_HOOK_* { 531 scan $ident "E_HOOK_%d" hookNum 532 SetHook $oop [lindex $Priv(hook) [expr {($hookNum - 1) * 2}]] 533 } 534 E_FIND {Find $oop 0} 535 E_FIND_AGAIN {Find $oop 1} 536 E_FONT { 537 NSModule::LoadIfNeeded NSFont 538 NSWindowManager::Display font knowledge 539 } 540 E_CLOSE {Close $oop} 541 } 542 543 return 544} 545 546# NSKnowledge::DisplayCmd -- 547# 548# Called by NSWindowManager::Display(). 549# 550# Arguments: 551# arg1 about arg1 552# 553# Results: 554# What happened. 555 556proc NSKnowledge::DisplayCmd {oop message first args} { 557 558 variable Priv 559 560 switch -- $message { 561 preDisplay { 562 563 # Assume angband.exe called us. See Close() 564 Info $oop hideOnEscape 0 565 566 # Display a specific group 567 if {[llength $args]} { 568 set hook [lindex $args 0] 569 Info $oop hook hook_$hook 570 if {[llength $args] > 1} { 571 set index [lindex $args 1] 572 DisplayMember $oop hook_$hook $index 573 574 # Hack -- Escape hides window 575 Info $oop hideOnEscape 1 576 } 577 } 578 579 SetHook $oop [Info $oop hook] 580 } 581 postDisplay { 582 } 583 postWithdraw { 584 StateRemember $oop 585 NSCanvist::DeleteAll [Info $oop group,canvistId] 586 NSCanvist::DeleteAll [Info $oop member,canvistId] 587 } 588 } 589 590 return 591} 592 593# NSKnowledge::Close -- 594# 595# Do something when closing the window. 596# 597# Arguments: 598# arg1 about arg1 599# 600# Results: 601# What happened. 602 603proc NSKnowledge::Close {oop} { 604 605 if {[Info $oop hideOnEscape]} { 606 NSWindowManager::Undisplay knowledge 607 } 608 609 angband keypress \033 610 611 return 612} 613 614# NSKnowledge::StateRemember -- 615# 616# Remember the selected group and member, then clear the lists. 617# 618# Arguments: 619# arg1 about arg1 620# 621# Results: 622# What happened. 623 624proc NSKnowledge::StateRemember {oop} { 625 626 global Angband 627 628 ### Mega-Hack -- Don't do this during geometry foolishness 629# if !$NSWindowManager::Priv(knowledge,setup) return 630 631 set hook [Info $oop hook] 632 633 # Because we are clearing the lists here, and don't want to 634 # upset the user, I save the selected group/member so it can 635 # be restored in StateRestore() below. 636 637 # Because the contents of a group change as the character gains 638 # knowledge, I save the proper index, not the row, of the 639 # selected group/member. 640 641 set row [Info $oop group,current] 642 if {$row != -1} { 643 set index [lindex [Info $oop group,match] $row] 644 } else { 645 set index -1 646 } 647 Info $oop group,$hook $index 648 649 set row [Info $oop member,current] 650 if {$row != -1} { 651 set index [lindex [Info $oop member,match] $row] 652 } else { 653 set index -1 654 } 655 Info $oop member,$hook $index 656 657 return 658} 659 660# NSKnowledge::StateRestore -- 661# 662# Restore the display. 663# 664# Arguments: 665# arg1 about arg1 666# 667# Results: 668# What happened. 669 670proc NSKnowledge::StateRestore {oop} { 671 672 global Angband 673 674 ### Mega-Hack -- Don't do this during geometry foolishness 675# if !$NSWindowManager::Priv(knowledge,setup) return 676 677 set hook [Info $oop hook] 678 679 # Restore the selected group. It might not be there if the 680 # "cheat_know" option was turned off. 681 set current [Info $oop group,$hook] 682 if {$current != -1} { 683 set row [lsearch -exact [Info $oop group,match] $current] 684 if {$row != -1} { 685 set canvistId [Info $oop group,canvistId] 686 NSCanvist::UpdateSelection $canvistId $row {} 687 NSCanvist::See $canvistId $row 688 } else { 689 Info $oop member,$hook -1 690 } 691 } 692 693 # Restore the selected member. It might not be there if the 694 # "cheat_know" option was turned off. 695 set current [Info $oop member,$hook] 696 if {$current != -1} { 697 set row [lsearch -exact [Info $oop member,match] $current] 698 if {$row != -1} { 699 set canvistId [Info $oop member,canvistId] 700 NSCanvist::UpdateSelection $canvistId $row {} 701 NSCanvist::See $canvistId $row 702 } 703 } 704 705 return 706} 707 708# NSKnowledge::CallHook -- 709# 710# Call the hook. 711# 712# Arguments: 713# arg1 about arg1 714# 715# Results: 716# What happened. 717 718proc NSKnowledge::CallHook {oop message args} { 719 720 return [uplevel #0 NSKnowledge::[Info $oop hook] $oop $message $args] 721} 722 723# NSKnowledge::SetHook -- 724# 725# Set the hook. 726# 727# Arguments: 728# arg1 about arg1 729# 730# Results: 731# What happened. 732 733proc NSKnowledge::SetHook {oop hook} { 734 735 global NSMenu 736 variable Priv 737 738 if {$hook != [Info $oop hook]} { 739 set again 0 740 } else { 741 set again 1 742 } 743 744 if {!$again} { 745 StateRemember $oop 746 } 747 748 # Remember the hook 749 Info $oop hook $hook 750 751 # Clear the hook-specific menu 752 set hookMenu [Info $oop hookMenu,menu] 753 $hookMenu delete 0 end 754 eval destroy [winfo children $hookMenu] 755 756 # Show icons by default 757 ConfigureList_Member $oop 1 758 759 # Calculate the row height of the group list 760 set rowHgt [font metrics [Value font,knowledge] -linespace] 761 if {[icon size] > $rowHgt} { 762 set rowHgt [icon size] 763 } 764 incr rowHgt 8 765 set canvistId [Info $oop group,canvistId] 766 set canvas [NSCanvist::Info $canvistId canvas] 767 NSCanvist::Info $canvistId rowHgt $rowHgt 768 $canvas configure -yscrollincrement $rowHgt 769 770 # Set the group list 771 SetList_Group $oop 772 773 # If the hook-menu is empty, remove it, otherwise insert it 774 set mbarId [Info $oop mbarId] 775 if {[string equal [$hookMenu index end] none]} { 776 if {[Info $oop hookMenu,inserted]} { 777 $NSMenu($mbarId,menu) delete 2 778 Info $oop hookMenu,inserted 0 779 } 780 } else { 781 set index [lsearch -exact $Priv(hook) $hook] 782 if {![Info $oop hookMenu,inserted]} { 783 $NSMenu($mbarId,menu) add cascade -menu $hookMenu 784 Info $oop hookMenu,inserted 1 785 } 786 $NSMenu($mbarId,menu) entryconfigure end \ 787 -label [lindex $Priv(hook) [incr index]] 788 } 789 790 # Radiobutton menu entries 791 Info $oop radio,hook $hook 792 793 set tabsId [Info $oop tabsId] 794 set current [NSTabs::Info $tabsId current] 795 set tabId [NSTabs::GetNthId $tabsId [expr {[lsearch -exact $Priv(hook) $hook] / 2}]] 796 if {$tabId != $current} { 797 NSTabs::Smaller $tabsId $current 798 NSTabs::Bigger $tabsId $tabId 799 NSTabs::Info $tabsId current $tabId 800 } 801 802 [Info $oop win].statusBar itemconfigure t2 -text "" 803 804 StateRestore $oop 805 806 return 807} 808 809# NSKnowledge::Click_Member -- 810# 811# Do something when a selected member is clicked. 812# 813# Arguments: 814# arg1 about arg1 815# 816# Results: 817# What happened. 818 819proc NSKnowledge::Click_Member {oop canvistId row} { 820 821 CallHook $oop click_member $row 822 return 823} 824 825# NSKnowledge::SelectionChanged_Group -- 826# 827# When a "group" list item is selected, display artifacts/monsters 828# in the "member" list. 829# 830# Arguments: 831# arg1 about arg1 832# 833# Results: 834# What happened. 835 836proc NSKnowledge::SelectionChanged_Group {oop canvistId select deselect} { 837 838 # If nothing was selected, clear the member list 839 if {![llength $select]} { 840 set canvistId [Info $oop member,canvistId] 841 NSCanvist::DeleteAll $canvistId 842 Info $oop group,current -1 843 StatusBar $oop "" 0 844 [Info $oop win].statusBar itemconfigure t2 -text "" 845 return 846 } 847 848 # Get the (first) row 849 set row [lindex $select 0] 850 Info $oop group,current $row 851 852 # Add matching artifacts/monsters to the list 853 SetList_Member $oop $row 854 855 return 856} 857 858# NSKnowledge::SelectionChanged_Member -- 859# 860# When a "member" list item is selected, display memory for the 861# artifact/monster in the Recall Window. 862# 863# Arguments: 864# arg1 about arg1 865# 866# Results: 867# What happened. 868 869proc NSKnowledge::SelectionChanged_Member {oop canvistId select deselect} { 870 871 # Do nothing if no new row was selected 872 if {![llength $select]} { 873 Info $oop member,current -1 874 StatusBar $oop "" 0 875 return 876 } 877 878 # Get the (first) row 879 set row [lindex $select 0] 880 Info $oop member,current $row 881 882 # Call the hook to do other stuff (recall, etc) 883 CallHook $oop select_member $row 884 885 return 886} 887 888# NSKnowledge::SetList_Group -- 889# 890# Set the group list. 891# 892# Arguments: 893# arg1 about arg1 894# 895# Results: 896# What happened. 897 898proc NSKnowledge::SetList_Group {oop} { 899 900 set win [Info $oop win] 901 set canvistId [Info $oop group,canvistId] 902 903 # Feedback 904 StatusBar $oop "Displaying..." 0 905 update idletasks 906 907 # Clear the list 908 NSCanvist::DeleteAll $canvistId 909 910 # Call hook to set the group list 911 CallHook $oop set_list_group 912 913 Info $oop group,current -1 914 915 # Hack -- Clear the "member" list 916 NSCanvist::DeleteAll [Info $oop member,canvistId] 917 918 # Feedback 919 StatusBar $oop "Done." 1 920 921 return 922} 923 924# NSKnowledge::SetList_Member -- 925# 926# Set the member list. 927# 928# Arguments: 929# arg1 about arg1 930# 931# Results: 932# What happened. 933 934proc NSKnowledge::SetList_Member {oop group} { 935 936 set canvistId [Info $oop member,canvistId] 937 938 # Clear the list 939 NSCanvist::DeleteAll $canvistId 940 941 Info $oop member,current -1 942 943 # Call hook to set the member list 944 CallHook $oop set_list_member $group 945 946 return 947} 948 949# NSKnowledge::ConfigureList_Member -- 950# 951# Set the row height of the member list. 952# 953# Arguments: 954# arg1 about arg1 955# 956# Results: 957# What happened. 958 959proc NSKnowledge::ConfigureList_Member {oop show_icons} { 960 961 set canvistId [Info $oop member,canvistId] 962 set canvas [NSCanvist::Info $canvistId canvas] 963 964 set rowHgt [font metrics [Value font,knowledge] -linespace] 965 966 if {$show_icons} { 967 if {[icon size] > $rowHgt} { 968 set rowHgt [icon size] 969 } 970 } 971 972 incr rowHgt 8 973 974 NSCanvist::Info $canvistId rowHgt $rowHgt 975 $canvas configure -yscrollincrement $rowHgt 976 977 return 978} 979 980# NSKnowledge::StatusBar -- 981# 982# Display text in the status bar, perhaps clearing it later. 983# 984# Arguments: 985# arg1 about arg1 986# 987# Results: 988# What happened. 989 990proc NSKnowledge::StatusBar {oop text zap} { 991 992 set win [Info $oop win] 993 set label [$win.statusBar itemcget t1 -label] 994 $label configure -text $text 995 if {$zap} { 996 NSUtils::ZapLabel $label 997 } 998 999 return 1000} 1001 1002# NSKnowledge::NewItemCmd -- 1003# 1004# Called by NSCanvist::InsertItem() to create a list row. 1005# 1006# Arguments: 1007# arg1 about arg1 1008# 1009# Results: 1010# What happened. 1011 1012proc NSKnowledge::NewItemCmd {oop canvistId y args} { 1013 1014 variable Priv 1015 1016 array set data [list -text "" -assign "" -color White -extra ""] 1017 array set data $args 1018 1019 set c [NSCanvist::Info $canvistId canvas] 1020 set lineHeight [NSCanvist::Info $canvistId rowHgt] 1021 set font [Value font,knowledge] 1022 1023 set fh [font metrics $font -linespace] 1024 set diff [expr {int([expr {($lineHeight - $fh) / 2}])}] 1025 1026 # Get the width of the canvas 1027 set canvasWidth [winfo width $c] 1028 1029if 0 { 1030 1031 # Image 1032 if {[string length $data(-assign)]} { 1033 set iw [icon size] 1034 set ih [icon size] 1035 set wid [expr {[icon size] + 8}] 1036 set xdiff [expr {int([expr {($wid - $iw) / 2}])}] 1037 set ydiff [expr {int([expr {($lineHeight - $ih) / 2}])}] 1038 lappend itemIdList [$c create widget $xdiff [expr {$y + $ydiff}] \ 1039 -assign $data(-assign)] 1040 } else { 1041 set wid 3 1042 } 1043} 1044 1045 # Text 1046 lappend itemIdList [$c create text [expr {$wid + 1}] [expr {$y + $diff}] \ 1047 -text $data(-text) -anchor nw -font $font -fill $data(-color) \ 1048 -tags text] 1049 1050 # Selection rectangle around everything 1051 lappend itemIdList [$c create rectangle 2 [expr {$y + 2}] \ 1052 [expr {([winfo width $c] - 1) - 2}] [expr {$y + $lineHeight - 2}] \ 1053 -fill {} -outline {} -tags selrect -width 2.0] 1054 1055 if {[string length $data(-extra)]} { 1056 lappend itemIdList [$c create text [expr {($canvasWidth - 1) - 4}] \ 1057 [expr {$y + $diff}] -text $data(-extra) -anchor ne -font $font \ 1058 -fill White -tags extra] 1059 } 1060 1061 return $itemIdList 1062} 1063 1064# NSKnowledge::HighlightItemCmd -- 1065# 1066# Called by NSCanvist::Select() to highlight a row. 1067# 1068# Arguments: 1069# oop OOP ID. See above. 1070# canvistId OOP ID of NSCanvist object. 1071# state 1 or 0 highlight state. 1072# args List of canvas item ids 1073# 1074# Results: 1075# What happened. 1076 1077proc NSKnowledge::HighlightItemCmd {oop canvistId state args} { 1078 1079 set canvas [NSCanvist::Info $canvistId canvas] 1080 set itemIdList $args 1081 1082 set idRect [FindItemByTag $canvas $itemIdList selrect] 1083 1084 if {[NSUtils::HasFocus $canvas]} { 1085 set fill [Value listHilite] 1086 } else { 1087 set fill [Value listInactive] 1088 } 1089 1090 if {$state} { 1091 $canvas itemconfigure $idRect -outline $fill 1092 1093 } else { 1094 $canvas itemconfigure $idRect -fill {} -outline {} 1095 } 1096 1097 return 1098} 1099 1100# NSKnowledge::Configure -- 1101# 1102# Called as a <Configure> event script. Resizes the selection rectangles 1103# so they fit properly. 1104# 1105# Arguments: 1106# arg1 about arg1 1107# 1108# Results: 1109# What happened. 1110 1111proc NSKnowledge::Configure {oop canvas} { 1112 1113 # Get the width of the canvas 1114 set canvasWidth [winfo width $canvas] 1115 1116 foreach itemId [$canvas find withtag selrect] { 1117 set coords [$canvas coords $itemId] 1118 set right [expr {($canvasWidth - 1) - 2}] 1119 set coords [lreplace $coords 2 2 $right] 1120 eval $canvas coords $itemId $coords 1121 } 1122 1123 foreach itemId [$canvas find withtag extra] { 1124 set coords [$canvas coords $itemId] 1125 set right [expr {($canvasWidth - 1) - 4}] 1126 set coords [lreplace $coords 0 0 $right] 1127 eval $canvas coords $itemId $coords 1128 } 1129 1130 # Set the scrollregion to prevent horizontal scrolling 1131 scan [$canvas cget -scrollregion] "%s %s %s %s" x1 y1 x2 y2 1132 $canvas configure -scrollregion "$x1 $y1 $canvasWidth $y2" 1133 1134 return 1135} 1136 1137# NSKnowledge::InvokeTab -- 1138# 1139# Called when a tab is clicked. 1140# 1141# Arguments: 1142# arg1 about arg1 1143# 1144# Results: 1145# What happened. 1146 1147proc NSKnowledge::InvokeTab {oop tabsId tabId} { 1148 1149 variable Priv 1150 set index [lsearch -exact [NSTabs::Info $tabsId id] $tabId] 1151 SetHook $oop [lindex $Priv(hook) [expr {$index * 2}]] 1152 1153 return 1154} 1155 1156# NSKnowledge::DisplayMember -- 1157# 1158# Find the group the given member is in, and display it. 1159# 1160# Arguments: 1161# arg1 about arg1 1162# 1163# Results: 1164# What happened. 1165 1166proc NSKnowledge::DisplayMember {oop hook member} { 1167 1168 foreach group [CallHook $oop group_list] { 1169 set memberList [CallHook $oop member_list $group] 1170 set index [lsearch -exact $memberList $member] 1171 if {$index != -1} { 1172 # Note: real index, not list row 1173 Info $oop group,$hook $group 1174 Info $oop member,$hook $member 1175 break 1176 } 1177 } 1178 1179 return 1180} 1181 1182# NSKnowledge::Find -- 1183# 1184# Simple search routine to look for a member by name. 1185# 1186# Arguments: 1187# arg1 about arg1 1188# 1189# Results: 1190# What happened. 1191 1192proc NSKnowledge::Find {oop again} { 1193 1194 variable Priv 1195 1196 # Repeat the last search 1197 if {$again && [string length $Priv(find,string)]} { 1198 set string $Priv(find,string) 1199 1200 # Enter a string to find, start from the beginning 1201 } else { 1202 1203 # Ask the user for a name 1204 set string [NSUtils::StringBox -title "Find" \ 1205 -initial $Priv(find,string) -prompt "find-prompt" \ 1206 -buttons [list "Find" "Cancel"] -parent [Info $oop win]] 1207 if {![string length $string]} return 1208 1209 # Clean up after the dialog, give message 1210 StatusBar $oop "Searching..." 1 1211 update 1212 1213 # Reset search parameters 1214 set Priv(find,string) $string 1215 } 1216 1217 # Default to searching from the beginning 1218 set groupRow 0 1219 set memberRow 0 1220 1221 # Search in selected group, if any 1222 if {!$Priv(find,fromStart)} { 1223 set groupCurr [Info $oop group,current] 1224 set memberCurr [Info $oop member,current] 1225 if {$groupCurr != -1} { 1226 set groupRow $groupCurr 1227 } 1228 if {$memberCurr != -1} { 1229 set memberRow [expr {$memberCurr + 1}] 1230 } 1231 } 1232 1233 set max [NSCanvist::Info [Info $oop group,canvistId] count] 1234 1235 # Compare lowercase 1236 set string [string tolower $string] 1237 1238 set groupList [CallHook $oop group_list] 1239 1240 for {set i $groupRow} {$i < $max} {incr i} { 1241 1242 set group [lindex $groupList $i] 1243 set memberList [lrange [CallHook $oop member_list $group] $memberRow end] 1244 1245 foreach index $memberList { 1246 1247 # Get the member name 1248 set name2 [CallHook $oop member_name $index] 1249 1250 # Compare lowercase 1251 set name2 [string tolower $name2] 1252 1253 # Found a match 1254 if {[string first $string $name2] != -1} { 1255 1256 set canvistId [Info $oop group,canvistId] 1257 1258 # The new group is not displayed 1259 if {![NSCanvist::IsRowSelected $canvistId $i]} { 1260 1261 # Clear the current selection 1262 NSCanvist::RemoveSelection $canvistId 1263 1264 # Select the new group. As a side effect, the 1265 # SetList_Member() command is called to display 1266 # the monsters in the group. 1267 NSCanvist::UpdateSelection $canvistId $i {} 1268 NSCanvist::See $canvistId $i 1269 1270 # The new group is already selected 1271 } else { 1272 } 1273 1274 set canvistId [Info $oop member,canvistId] 1275 1276 # Select the matching member, deselecting all others 1277 NSCanvist::UpdateSelection $canvistId $memberRow all 1278 NSCanvist::See $canvistId $memberRow 1279 1280 # Don't search from start next time 1281 set Priv(find,fromStart) 0 1282 1283 # Clear "Searching..." message 1284 StatusBar $oop "" 0 1285 1286 # Done 1287 return 1288 } 1289 incr memberRow 1290 } 1291 set memberRow 0 1292 } 1293 1294 # If we didn't search from the start, then wrap around 1295 if {!$Priv(find,fromStart)} { 1296 set Priv(find,fromStart) 1 1297 Find $oop 1 1298 return 1299 } 1300 1301 StatusBar $oop "No match for \"$string\"." 1 1302 1303 return 1304} 1305 1306 1307 1308# NSKnowledge::CalcGroupListWidth -- 1309# 1310# Returns the desired width of the group list. 1311# 1312# Arguments: 1313# arg1 about arg1 1314# 1315# Results: 1316# What happened. 1317 1318proc NSKnowledge::CalcGroupListWidth {oop} { 1319 1320 variable Priv 1321 1322 # Get the desired font 1323 set font [Value font,knowledge] 1324 1325 set maxWidth 100 1326 1327 foreach {hook label} $Priv(hook) { 1328 foreach name [$hook $oop group_names] { 1329 set width [font measure $font $name] 1330 if {$width > $maxWidth} { 1331 set maxWidth $width 1332 } 1333 } 1334 } 1335 1336 return [expr {[icon size] + 8 + $maxWidth + 20 + 4}] 1337} 1338 1339# NSKnowledge::ValueChanged_font_knowledge -- 1340# 1341# Called when the font,knowledge value changes. 1342# Updates the Knowledge Window. 1343# 1344# Arguments: 1345# arg1 about arg1 1346# 1347# Results: 1348# What happened. 1349 1350proc NSKnowledge::ValueChanged_font_knowledge {oop} { 1351 1352 # Get the desired font 1353 set font [Value font,knowledge] 1354 1355 # Calculate row height 1356 set rowHgt [font metrics $font -linespace] 1357 if {[icon size] > $rowHgt} { 1358 set rowHgt [icon size] 1359 } 1360 incr rowHgt 8 1361 1362 # Set row height of group list 1363 set canvistId [Info $oop group,canvistId] 1364 set canvas [NSCanvist::Info $canvistId canvas] 1365 NSCanvist::Info $canvistId rowHgt $rowHgt 1366 $canvas configure -yscrollincrement $rowHgt 1367 1368 # Set the width of the group list 1369 set oldWidth [winfo width $canvas] 1370 set newWidth [CalcGroupListWidth $oop] 1371 $canvas configure -width $newWidth 1372 1373 # Set the scrollregion to prevent horizontal scrolling 1374 scan [$canvas cget -scrollregion] "%s %s %s %s" x1 y1 x2 y2 1375 $canvas configure -scrollregion "$x1 $y1 $newWidth $y2" 1376 1377 # Hack -- Resize the toplevel so the member list is not resized 1378 set diff [expr {$newWidth - $oldWidth}] 1379 if {$diff} { 1380 set win [Info $oop win] 1381 set newWidth [expr {[winfo width $win] + $diff}] 1382 NSToplevel::SetTotalWidth $win $newWidth 1383 } 1384 1385 if {[winfo ismapped [Info $oop win]]} { 1386 [Info $oop groupCanvas] itemconfigure text -font $font 1387 [Info $oop memberCanvas] itemconfigure text -font $font 1388 } 1389 1390 return 1391} 1392 1393# NSKnowledge::ValueChanged_listBG -- 1394# 1395# Called when the listBG value changes. 1396# Updates the Knowledge Window. 1397# 1398# Arguments: 1399# arg1 about arg1 1400# 1401# Results: 1402# What happened. 1403 1404proc NSKnowledge::ValueChanged_listBG {oop} { 1405 1406 set color [Value listBG] 1407 1408 [Info $oop groupCanvas] configure -background $color 1409 [Info $oop memberCanvas] configure -background $color 1410 1411 return 1412} 1413 1414