1# File: main-window.tcl 2 3# Purpose: the Main 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 NSMainWindow { 14 15 variable Priv 16 17 variable tracking 0 18 variable trackId 0 19 variable trackStepping 0 20 variable trackX 21 variable trackY 22 23# namespace eval NSMainWindow 24} 25 26# NSMainWindow::InitModule -- 27# 28# One-time-only-ever initialization. 29# 30# Arguments: 31# 32# Results: 33# What happened. 34 35proc NSMainWindow::InitModule {} { 36 37 global Display 38 global PYPX 39 40 NSModule::LoadIfNeeded NSMap 41 NSModule::LoadIfNeeded NSWidget 42 NSModule::LoadIfNeeded NSTerm 43 44 # The character's position 45 set PYPX "0 0" 46 47 # Keep track of active window (inventory, book, etc) 48 set Display(window) none 49 50 # Create the main window 51 NSObject::New NSMainWindow 52 53 return 54} 55 56# NSMainWindow::NSMainWindow -- 57# 58# Object constructor called by NSObject::New(). 59# 60# Arguments: 61# oop OOP ID of NSMainWindow object. 62# 63# Results: 64# What happened. 65 66proc NSMainWindow::NSMainWindow {oop} { 67 68 InitWindow $oop 69 70 # Window positions 71 Info $oop window,autosave [Value window,autosave] 72 73 # 74 # Global access 75 # 76 77 Window main [Info $oop win] 78 Global main,oop $oop 79 80 InitAutobar $oop 81 82 return 83} 84 85# NSMainWindow::Info -- 86# 87# Query and modify info. 88# 89# Arguments: 90# arg1 about arg1 91# 92# Results: 93# What happened. 94 95proc NSMainWindow::Info {oop info args} { 96 97 global NSMainWindow 98 99 # Verify the object 100 NSObject::CheckObject NSMainWindow $oop 101 102 # Set info 103 if {[llength $args]} { 104 switch -- $info { 105 default { 106 set NSMainWindow($oop,$info) [lindex $args 0] 107 } 108 } 109 110 # Get info 111 } else { 112 switch -- $info { 113 default { 114 return $NSMainWindow($oop,$info) 115 } 116 } 117 } 118 119 return 120} 121 122# NSMainWindow::InitWindow -- 123# 124# Creates the Main Window. 125# 126# Arguments: 127# oop OOP ID of NSMainWindow object. 128# 129# Results: 130# What happened. 131 132proc NSMainWindow::InitWindow {oop} { 133 134 global Angband 135 136 set win .main$oop 137 toplevel $win 138 wm title $win "Main - ZAngband" 139 140 # Do stuff when window closes 141 wm protocol $win WM_DELETE_WINDOW "NSMainWindow::Close $oop" 142 143 # Start out withdrawn (hidden) 144 wm withdraw $win 145 146 # Remember the window 147 Info $oop win $win 148 149 # Create the menus 150 InitMenus $oop 151 152 set frame $win.divider2 153 MakeDivider $frame x 154 155 # 156 # Statusbar 157 # There is a level of tomfoolery with the statusbar to prevent 158 # a really long message causing the Main Window to change size. 159 # This is in spite of the fact that many other windows do not 160 # change size with long statusbar labels. I thought gridded 161 # geometry solved the problem, but not in this case... 162 # 163 # The hack involves pack'ing the label in a frame, and turning 164 # off pack propagation for that frame. Oh well. 165 # 166 167 # Font for all statusbars 168 set font [Value font,statusBar] 169 170 frame $win.statusBar \ 171 -borderwidth 0 172 frame $win.statusBar.frameLabel \ 173 -borderwidth 0 174 label $win.statusBar.frameLabel.label \ 175 -anchor w -text "Hello world!" -relief sunken -padx 2 \ 176 -foreground [Value main,statusbar,color] -background Black -font $font 177 label $win.statusBar.center \ 178 -text "C" -relief sunken -width 2 -padx 0 -foreground White \ 179 -background Black -font $font 180 label $win.statusBar.depth \ 181 -relief sunken -width 12 -padx 2 \ 182 -foreground White -background Black -font $font 183 184 bind $win.statusBar.frameLabel.label <ButtonPress-3> \ 185 "NSMainWindow::ContextMenu_StatusBar $win.context %X %Y" 186 187 # Used in various places 188 Global main,statusBar $win.statusBar.frameLabel.label 189 190 # Hack 191 pack $win.statusBar.frameLabel.label -fill x 192 pack propagate $win.statusBar.frameLabel no 193 194 grid columnconfigure $win.statusBar 0 -weight 1 195 grid columnconfigure $win.statusBar 1 -weight 0 196 grid columnconfigure $win.statusBar 2 -weight 0 197 grid rowconfigure $win.statusBar 0 -weight 0 198 199 grid $win.statusBar.frameLabel \ 200 -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news 201 grid $win.statusBar.center \ 202 -row 0 -column 1 -rowspan 1 -columnspan 1 203 grid $win.statusBar.depth \ 204 -row 0 -column 2 -rowspan 1 -columnspan 1 205 206 bind $win.statusBar.center <Enter> " 207 %W configure -foreground gray60 208 NSMainWindow::StatusText $oop {Click to recenter the display.} 209 " 210 bind $win.statusBar.center <Leave> " 211 %W configure -foreground White 212 NSMainWindow::StatusText $oop {} 213 " 214 215 # Update ourself when the font,statusBar value changes 216 NSValueManager::AddClient font,statusBar \ 217 "NSMainWindow::ValueChanged_font_statusBar" 218 219 # 220 # Message line when Message Window is closed 221 # 222 223 set frame $win.message 224 frame $frame -background black -borderwidth 1 -relief sunken 225 226 # 227 # Misc info when Misc Window is closed 228 # 229 230 set frame $win.misc 231 frame $frame -background black -borderwidth 1 -relief sunken 232 233 # 234 # Main widget 235 # 236 237 # Black background affects border color 238 frame $win.mainframe \ 239 -borderwidth 1 -relief sunken -background Black 240 241 # Get the icon dimensions 242 set gsize [icon size] 243 244 # This is a large monitor 245 if {[winfo screenwidth .] >= 800} { 246 set width [expr {15 * 32}] 247 set height [expr {11 * 32}] 248 249 # This is a small monitor 250 } else { 251 set width [expr {13 * 32}] 252 set height [expr {9 * 32}] 253 } 254 255 set widgetId [NSObject::New NSWidget $win.mainframe \ 256 $width $height $gsize $gsize] 257 NSWidget::Info $widgetId leaveCmd NSMainWindow::Leave 258 set widget [NSWidget::Info $widgetId widget] 259 260 bind $widget <ButtonPress-1> "NSMainWindow::TrackPress $oop %x %y" 261 bind $widget <Button1-Motion> "NSMainWindow::TrackMotion $oop %x %y" 262 bind $widget <ButtonRelease-1> "NSMainWindow::TrackRelease $oop" 263 264 bind $widget <Control-ButtonPress-1> "NSMainWindow::MouseCommand $oop %x %y +" 265 bind $widget <Shift-ButtonPress-1> "NSMainWindow::MouseCommand $oop %x %y ." 266 267 bind $widget <Control-Shift-ButtonPress-1> " 268 NSWidget::Info $widgetId track,x %x 269 NSWidget::Info $widgetId track,y %y 270 NSWidget::Info $widgetId track,mouseMoved 0 271 " 272 bind $widget <Control-Shift-Button1-Motion> \ 273 "NSWidget::TrackOnce $widgetId %x %y" 274 275 bind $widget <ButtonPress-3> \ 276 "NSMainWindow::ButtonPress3 $oop %x %y %X %Y" 277 bind $widget <Control-ButtonPress-3> \ 278 "NSRecall::PopupSelect_Use $win.context %X %Y" 279 280 # When the pointer leaves the Main Window Widget, we clear the 281 # statusbar text, in addition to the behaviour defined by the 282 # NSWidget module. 283# bind $widget <Leave> "+NSMainWindow::StatusText $oop {}" 284 285 # Remember the center of the Main Window Widget. 286 Global main,widget,center [angband player position] 287 288 variable HT "" 289 290 # The "big map", the map of the entire cave with scroll bars. 291 # The user can change the scale via a popup menu, so we save 292 # the desired scale. 293 set scale [Value bigmap,scale] 294 set width [expr $width - 16] 295 set height [expr $height - 16] 296 set mapId [NSObject::New NSMap $widget $width $height $scale $scale] 297 set widget2 [NSMap::Info $mapId widget] 298 299 NSMap::Info $mapId scaleCmd \ 300 "Value bigmap,scale \[NSWidget::Info [NSMap::Info $mapId widgetId] scale]" 301 302 bind $widget2 <Leave> {+ 303 [Global mapdetail,widget] center -100 -100 304 NSMainWindow::StatusText [Global main,oop] {} 305 } 306 307 # Hide the Big Map when clicked (but not dragged) 308 bind $widget2 <ButtonRelease-1> { 309 if {![NSWidget::Info [Global bigmap,widgetId] track,mouseMoved]} { 310 angband keypress \033 311 } 312 } 313 314 # Each NSMap widget has Left/Right etc bindings. Need this to 315 # hide the map. 316 bind $widget2 <KeyPress-Escape> { 317 angband keypress \033 318 } 319 320 # Global access 321 Global main,widgetId $widgetId 322 Global main,widget $widget 323 Global bigmap,mapId $mapId 324 Global bigmap,widgetId [NSMap::Info $mapId widgetId] 325 Global bigmap,widget [NSMap::Info $mapId widget] 326 327 # This binding is called whenever the Main Window is resized 328 # by the user. 329 bind $widget <Configure> \ 330 "NSMainWindow::Configure $oop %w %h" 331 332 pack $widget -expand yes -fill both 333 334 # 335 # Geometry 336 # 337 338 grid rowconfigure $win 0 -weight 0 339 grid rowconfigure $win 1 -weight 0 340 grid rowconfigure $win 2 -weight 1 341 grid rowconfigure $win 3 -weight 0 342 grid columnconfigure $win 0 -weight 0 343 grid columnconfigure $win 1 -weight 1 344 345 grid $win.divider2 \ 346 -row 0 -column 0 -rowspan 1 -columnspan 2 -sticky ew 347 grid $win.message \ 348 -row 1 -column 0 -columnspan 2 -sticky we 349 grid $win.misc \ 350 -row 2 -column 0 -sticky ns 351 grid $win.mainframe \ 352 -row 2 -column 1 -rowspan 1 -columnspan 1 -sticky news 353 grid $win.statusBar \ 354 -row 3 -column 0 -rowspan 1 -columnspan 2 -sticky ew 355 356 # 357 # Context menu 358 # 359 360 menu $win.context -tearoff 0 361 362 # 363 # Feed Term when keys pressed 364 # 365 366 Term_KeyPress_Bind $win 367 368 # Create terms window 369 370 set width [expr {16 * 80}] 371 set height [expr {16 * 24}] 372 373 set term .term 374 375 toplevel $term 376 377 wm title $term "Terminal" 378 379 wm geometry $term +$width+$height 380 wm minsize $term $width $height 381 382 Term_KeyPress_Bind $term 383 384 # Do stuff when window closes 385 wm protocol $term WM_DELETE_WINDOW "NSTerm::Close $oop" 386 387 set termId [NSObject::New NSTerm .term $width $height 16 16] 388 389 update 390 391 392 393 return 394} 395 396proc NSMainWindow::InitAutobar {oop} { 397 398 set statusBar [Global main,statusBar] 399 400 bind $statusBar <Enter> \ 401 "NSMainWindow::ShowAutobar $oop" 402 403 return 404} 405 406proc NSMainWindow::ShowAutobar {oop} { 407 408 # Allow easy rebooting of the module 409 if {[NSModule::LoadIfNeeded NSAutobar]} { 410 411 set autobarId [Global autobar,oop] 412 set statusBar [Global main,statusBar] 413 414 bind $statusBar <Leave> \ 415 "NSAutobar::Event $autobarId leave-status" 416 } 417 418 set autobarId [Global autobar,oop] 419 NSAutobar::Event $autobarId enter-status 420 421 return 422} 423 424# NSMainWindow::InitMenus -- 425# 426# Initialize the menus for the Main Window. 427# 428# Arguments: 429# oop OOP ID of NSMainWindow object. 430# 431# Results: 432# What happened. 433 434proc NSMainWindow::InitMenus {oop} { 435 436 global Angband 437 438 set win [Info $oop win] 439 440 set mbarId [NSObject::New NSMenu $win -tearoff 0 \ 441 -postcommand "NSMainWindow::SetupMenus $oop" -identifier MENUBAR] 442 443 # Call our command when an entry is invoked 444 NSMenu::Info $mbarId invokeCmd "NSMainWindow::MenuInvoke $oop" 445 446 Info $oop mbarId $mbarId 447 448 # 449 # File Menu 450 # 451 452 NSObject::New NSMenu $mbarId -tearoff 0 -identifier MENU_FILE 453 NSMenu::MenuInsertEntry $mbarId -end MENUBAR -type cascade \ 454 -menu MENU_FILE -label "File" -underline 0 -identifier M_FILE 455 456 set entries {} 457 lappend entries [list -type command -label "Save" -identifier E_GAME_SAVE] 458 lappend entries [list -type separator] 459 lappend entries [list -type command -label "Quit With Save" -identifier E_GAME_EXIT] 460 lappend entries [list -type command -label "Quit" -identifier E_GAME_ABORT] 461 462 NSMenu::MenuInsertEntries $mbarId -end MENU_FILE $entries 463 464 # 465 # Inven Menu 466 # 467 468 set menuId [NSObject::New NSMenu $mbarId -tearoff 0 -identifier MENU_INVEN] 469 NSMenu::Info $menuId setupCmd "NSMainWindow::MenuSetupCmd $oop" 470 NSMenu::MenuInsertEntry $mbarId -end MENUBAR -type cascade \ 471 -menu MENU_INVEN -label "Inven" -underline 0 -identifier M_INVEN 472 473 # Magic Menu 474 set menuId [NSObject::New NSMenu $mbarId -tearoff 0 -identifier MENU_MAGIC] 475 NSMenu::Info $menuId setupCmd "NSMainWindow::MenuSetupCmd $oop" 476 set entries {} 477 lappend entries [list -type command -label "Activate" -identifier E_MAGIC_ACTIVATE] 478 lappend entries [list -type command -label "Aim Wand" -identifier E_MAGIC_WAND] 479 lappend entries [list -type command -label "Drink Potion" -identifier E_MAGIC_POTION] 480 lappend entries [list -type command -label "Read Scroll" -identifier E_MAGIC_SCROLL] 481 lappend entries [list -type command -label "Use Staff" -identifier E_MAGIC_STAFF] 482 lappend entries [list -type command -label "Zap Rod" -identifier E_MAGIC_ROD] 483 lappend entries [list -type separator] 484 lappend entries [list -type command -label "Browse" -identifier E_MAGIC_BROWSE] 485 lappend entries [list -type command -label "Study" -identifier E_MAGIC_STUDY] 486 487 NSMenu::MenuInsertEntries $mbarId -end MENU_MAGIC $entries 488 489 set menuId [NSObject::New NSMenu $mbarId -tearoff 0 -identifier MENU_USE] 490 NSMenu::Info $menuId setupCmd "NSMainWindow::MenuSetupCmd $oop" 491 set entries {} 492 lappend entries [list -type command -label "Destroy" -identifier E_USE_DESTROY] 493 lappend entries [list -type command -label "Drop" -identifier E_USE_DROP] 494 lappend entries [list -type command -label "Pick Up" -identifier E_USE_PICKUP] 495 lappend entries [list -type command -label "Take Off" -identifier E_USE_TAKEOFF] 496 lappend entries [list -type command -label "Wear/Wield" -identifier E_USE_WIELD] 497 lappend entries [list -type separator] 498 lappend entries [list -type command -label "Eat Food" -identifier E_USE_FOOD] 499 lappend entries [list -type command -label "Fire Missle" -identifier E_USE_MISSILE] 500 lappend entries [list -type command -label "Fuel Light" -identifier E_USE_FUEL] 501 lappend entries [list -type command -label "Jam Spike" -identifier E_USE_SPIKE] 502 lappend entries [list -type command -label "Throw" -identifier E_USE_THROW] 503 504 NSMenu::MenuInsertEntries $mbarId -end MENU_USE $entries 505 506 set entries {} 507 lappend entries [list -type command -label "Equipment" -identifier E_INVEN_EQUIPMENT] 508 lappend entries [list -type command -label "Inventory" -identifier E_INVEN_INVENTORY] 509 lappend entries [list -type separator] 510 lappend entries [list -type cascade -menu MENU_MAGIC -label "Magic" -identifier M_MAGIC] 511 lappend entries [list -type cascade -menu MENU_USE -label "Use" -identifier M_USE] 512 lappend entries [list -type separator] 513 lappend entries [list -type command -label "Inspect" -identifier E_INVEN_INSPECT] 514 lappend entries [list -type separator] 515 lappend entries [list -type command -label "Inscribe" -identifier E_INVEN_INSCRIBE] 516 lappend entries [list -type command -label "Uninscribe" -identifier E_INVEN_UNINSCRIBE] 517 518 NSMenu::MenuInsertEntries $mbarId -end MENU_INVEN $entries 519 520 # 521 # Action Menu 522 # 523 524 set menuId [NSObject::New NSMenu $mbarId -tearoff 0 -identifier MENU_ACTION] 525 NSMenu::Info $menuId setupCmd "NSMainWindow::MenuSetupCmd $oop" 526 NSMenu::MenuInsertEntry $mbarId -end MENUBAR -type cascade \ 527 -menu MENU_ACTION -label "Action" -underline 0 -identifier M_ACTION 528 529 set menuId [NSObject::New NSMenu $mbarId -tearoff 0 -identifier MENU_ACTION_ALTER] 530 NSMenu::Info $menuId setupCmd "NSMainWindow::MenuSetupCmd $oop" 531 set entries {} 532 lappend entries [list -type command -label "Alter" -identifier E_ACTION_ALTER] 533 lappend entries [list -type command -label "Bash" -identifier E_ACTION_BASH] 534 lappend entries [list -type command -label "Close" -identifier E_ACTION_CLOSE] 535 lappend entries [list -type command -label "Disarm" -identifier E_ACTION_DISARM] 536 lappend entries [list -type command -label "Open" -identifier E_ACTION_OPEN] 537 lappend entries [list -type command -label "Tunnel" -identifier E_ACTION_TUNNEL] 538 NSMenu::MenuInsertEntries $mbarId -end MENU_ACTION_ALTER $entries 539 540 set menuId [NSObject::New NSMenu $mbarId -tearoff 0 -identifier MENU_ACTION_LOOKING] 541 NSMenu::Info $menuId setupCmd "NSMainWindow::MenuSetupCmd $oop" 542 set entries {} 543 lappend entries [list -type command -label "Look" -identifier E_ACTION_LOOK] 544 lappend entries [list -type command -label "Map" -identifier E_ACTION_MAP] 545 NSMenu::MenuInsertEntries $mbarId -end MENU_ACTION_LOOKING $entries 546 547 set menuId [NSObject::New NSMenu $mbarId -tearoff 0 -identifier MENU_ACTION_RESTING] 548 NSMenu::Info $menuId setupCmd "NSMainWindow::MenuSetupCmd $oop" 549 set entries {} 550 lappend entries [list -type command -label "Rest" -identifier E_ACTION_REST] 551 lappend entries [list -type command -label "Stay (With Pickup)" -identifier E_ACTION_STAY] 552 lappend entries [list -type command -label "Stay" -identifier E_ACTION_STAY_TOGGLE] 553 NSMenu::MenuInsertEntries $mbarId -end MENU_ACTION_RESTING $entries 554 555 set menuId [NSObject::New NSMenu $mbarId -tearoff 0 -identifier MENU_ACTION_SEARCHING] 556 NSMenu::Info $menuId setupCmd "NSMainWindow::MenuSetupCmd $oop" 557 set entries {} 558 lappend entries [list -type command -label "Search" -identifier E_ACTION_SEARCH] 559 lappend entries [list -type command -label "Search Mode" -identifier E_ACTION_SEARCH_MODE] 560 NSMenu::MenuInsertEntries $mbarId -end MENU_ACTION_SEARCHING $entries 561 562 set menuId [NSObject::New NSMenu $mbarId -tearoff 0 -identifier MENU_ACTION_MOVEMENT] 563 NSMenu::Info $menuId setupCmd "NSMainWindow::MenuSetupCmd $oop" 564 set entries {} 565 lappend entries [list -type command -label "Go Down" -identifier E_ACTION_DOWN] 566 lappend entries [list -type command -label "Go Up" -identifier E_ACTION_UP] 567 lappend entries [list -type command -label "Run" -identifier E_ACTION_RUN] 568 lappend entries [list -type command -label "Walk (With Pickup)" -identifier E_ACTION_WALK] 569 lappend entries [list -type command -label "Walk" -identifier E_ACTION_WALK_TOGGLE] 570 NSMenu::MenuInsertEntries $mbarId -end MENU_ACTION_MOVEMENT $entries 571 572 set entries {} 573 lappend entries [list -type cascade -menu MENU_ACTION_ALTER -label "Alter" -identifier M_ACTION_ALTER] 574 lappend entries [list -type cascade -menu MENU_ACTION_LOOKING -label "Looking" -identifier M_ACTION_LOOKING] 575 lappend entries [list -type cascade -menu MENU_ACTION_MOVEMENT -label "Movement" -identifier M_ACTION_MOVEMENT] 576 lappend entries [list -type cascade -menu MENU_ACTION_RESTING -label "Resting" -identifier M_ACTION_RESTING] 577 lappend entries [list -type cascade -menu MENU_ACTION_SEARCHING -label "Searching" -identifier M_ACTION_SEARCHING] 578 lappend entries [list -type separator] 579 lappend entries [list -type command -label "Note" -identifier E_ACTION_NOTE] 580 lappend entries [list -type command -label "Repeat" -identifier E_ACTION_REPEAT] 581 lappend entries [list -type command -label "Target" -identifier E_ACTION_TARGET] 582 lappend entries [list -type separator] 583 lappend entries [list -type command -label "Pets" -identifier E_ACTION_PETS] 584 lappend entries [list -type command -label "Use Power" -identifier E_ACTION_POWER] 585 586 NSMenu::MenuInsertEntries $mbarId -end MENU_ACTION $entries 587 588 # 589 # Other Menu 590 # 591 592 NSObject::New NSMenu $mbarId -tearoff 0 -identifier MENU_OTHER 593 NSMenu::MenuInsertEntry $mbarId -end MENUBAR -type cascade \ 594 -menu MENU_OTHER -label "Other" -underline 0 -identifier M_OTHER 595 596 NSObject::New NSMenu $mbarId -tearoff 0 -identifier MENU_PREFERENCES 597 set entries {} 598 lappend entries [list -type command -label "Font" -identifier E_PREF_FONT] 599 lappend entries [list -type command -label "Options" -identifier E_PREF_OPTIONS] 600 NSMenu::MenuInsertEntries $mbarId -end MENU_PREFERENCES $entries 601 602 set entries {} 603 lappend entries [list -type command -label "Character Info" -identifier E_OTHER_INFO] 604 lappend entries [list -type command -label "Feeling" -identifier E_OTHER_FEELING] 605 lappend entries [list -type command -label "Knowledge" -identifier E_OTHER_KNOWLEDGE] 606 lappend entries [list -type command -label "Message History" -identifier E_OTHER_MESSAGES] 607 lappend entries [list -type cascade -menu MENU_PREFERENCES -label "Preferences" -identifier M_PREFERENCES] 608 lappend entries [list -type command -label "Quest Status" -identifier E_OTHER_QUEST] 609 lappend entries [list -type command -label "Time Of Day" -identifier E_OTHER_TIME] 610 611 NSMenu::MenuInsertEntries $mbarId -end MENU_OTHER $entries 612 613 # 614 # Window Menu 615 # 616 617 NSObject::New NSMenu $mbarId -tearoff 0 -identifier MENU_WINDOW 618 NSMenu::MenuInsertEntry $mbarId -end MENUBAR -type cascade \ 619 -menu MENU_WINDOW -label "Window" -underline 0 -identifier M_WINDOW 620 621 set entries {} 622 lappend entries [list -type command -label "Arrange Windows..." -identifier E_WINDOW_DEFPOS] 623 lappend entries [list -type command -label "Maximize Windows..." -identifier E_WINDOW_MAXIMIZE] 624 lappend entries [list -type separator] 625 lappend entries [list -type command -label "Save Window Positions" -identifier E_WINDOW_SAVEPOS] 626 lappend entries [list -type command -label "Load Window Positions" -identifier E_WINDOW_LOADPOS] 627 lappend entries [list -type checkbutton -label "AutoSave Positions" \ 628 -variable ::NSMainWindow($oop,window,autosave) -identifier E_WINDOW_AUTOSAVE] 629 if {[file exists [PathTk choice-window.tcl]]} { 630 Info $oop choiceWindow [Value choicewindow,show] 631 lappend entries [list -type separator] 632 lappend entries [list -type checkbutton -label "Choice Window" \ 633 -variable ::NSMainWindow($oop,choiceWindow) -identifier E_CHOICEWINDOW] 634 } 635 Info $oop messageWindow [Value message,float] 636 lappend entries [list -type checkbutton -label "Message Window" \ 637 -variable ::NSMainWindow($oop,messageWindow) -identifier E_WINDOW_MESSAGE] 638 Info $oop messagesWindow 0 639 lappend entries [list -type checkbutton -label "Messages Window" \ 640 -variable ::NSMainWindow($oop,messagesWindow) -identifier E_WINDOW_MESSAGES] 641 Info $oop miscWindow [Value misc,float] 642 lappend entries [list -type checkbutton -label "Misc Window" \ 643 -variable ::NSMainWindow($oop,miscWindow) -identifier E_WINDOW_MISC] 644if 0 { 645 lappend entries [list -type checkbutton -label "Progress Window" \ 646 -variable ::NSMainWindow($oop,progressWindow) \ 647 -identifier E_WINDOW_PROGRESS] 648} 649 Info $oop recallWindow [Value recall,show] 650 lappend entries [list -type checkbutton -label "Recall Window" \ 651 -variable ::NSMainWindow($oop,recallWindow) -identifier E_WINDOW_RECALL] 652 NSMenu::MenuInsertEntries $mbarId -end MENU_WINDOW $entries 653 654 # 655 # Help Menu 656 # 657 658 NSObject::New NSMenu $mbarId -tearoff 0 -identifier MENU_HELP 659 NSMenu::MenuInsertEntry $mbarId -end MENUBAR -type cascade \ 660 -menu MENU_HELP -label "Help" -underline 0 -identifier M_HELP 661 662 set entries {} 663 lappend entries [list -type command -label "Help" -identifier E_HELP] 664 lappend entries [list -type command -label "Tips" -identifier E_TIPS] 665 lappend entries [list -type separator] 666 lappend entries [list -type command \ 667 -label "About ZAngband..." -identifier E_ABOUT] 668 669 NSMenu::MenuInsertEntries $mbarId -end MENU_HELP $entries 670 671 NSMenu::SetIdentArray $mbarId 672 673 return 674} 675 676# NSMainWindow::SetupMenus -- 677# 678# Called by NSMenus::_MenuPostCommand() to enable menu items before 679# posting a menu. 680# 681# Arguments: 682# oop OOP ID of NSMainWindow object. 683# mbarId OOP ID of NSMenu object (the menubar). 684# 685# Results: 686# What happened. 687 688proc NSMainWindow::SetupMenus {oop mbarId} { 689 690 global Windows 691 692 lappend identList E_WINDOW_SAVEPOS E_WINDOW_DEFPOS \ 693 E_WINDOW_LOADPOS E_WINDOW_AUTOSAVE E_WINDOW_MAXIMIZE E_ABOUT E_TIPS 694 lappend identList M_PREFERENCES E_PREF_FONT 695 696 lappend identList E_CHOICEWINDOW E_WINDOW_MESSAGE E_WINDOW_MESSAGES \ 697 E_WINDOW_MISC E_WINDOW_RECALL 698 if {[info exists Windows(choice)]} { 699 Info $oop choiceWindow [winfo ismapped [Window choice]] 700 } 701 Info $oop messageWindow [winfo ismapped [Window message]] 702 if {[info exists Windows(message2)]} { 703 Info $oop messagesWindow [winfo ismapped [Window message2]] 704 } 705 Info $oop miscWindow [winfo ismapped [Window misc]] 706 Info $oop recallWindow [winfo ismapped [Window recall]] 707 708 if {[string equal [angband inkey_flags] INKEY_CMD]} { 709 lappend identList E_GAME_SAVE E_GAME_EXIT E_OTHER_FEELING \ 710 E_OTHER_INFO E_OTHER_KNOWLEDGE \ 711 E_OTHER_MESSAGES E_PREF_OPTIONS E_HELP \ 712 E_OTHER_QUEST E_OTHER_TIME 713 } 714 715 lappend identList E_GAME_ABORT 716 717 NSMenu::MenuEnable $mbarId $identList 718 719 return 720} 721 722# NSMainWindow::MenuSetupCmd -- 723# 724# Called when a menu is about to be posted. We use this to change the 725# setupMode of a menu so we don't need to pass a huge list of identifiers 726# to the MenuEnable() command. 727# 728# Arguments: 729# arg1 about arg1 730# 731# Results: 732# What happened. 733 734proc NSMainWindow::MenuSetupCmd {oop menuId} { 735 736 if {[string compare [angband inkey_flags] INKEY_CMD]} { 737 NSMenu::Info $menuId setupMode disabled 738 } else { 739 NSMenu::Info $menuId setupMode normal 740 } 741 742 return 743} 744 745# NSMainWindow::MenuInvoke -- 746# 747# Called when a menu entry is invoked. 748# 749# Arguments: 750# arg1 about arg1 751# 752# Results: 753# What happened. 754 755proc NSMainWindow::MenuInvoke {oop menuId ident} { 756 757 switch -glob -- $ident { 758 759 E_GAME_SAVE {DoUnderlyingCommand ^s} 760 E_GAME_EXIT {DoUnderlyingCommand ^x} 761 E_GAME_ABORT {QuitNoSave} 762 763 E_MAGIC_ACTIVATE {DoUnderlyingCommand A} 764 E_MAGIC_WAND {DoUnderlyingCommand a} 765 E_MAGIC_POTION {DoUnderlyingCommand q} 766 E_MAGIC_SCROLL {DoUnderlyingCommand r} 767 E_MAGIC_STAFF {DoUnderlyingCommand u} 768 E_MAGIC_ROD {DoUnderlyingCommand z} 769 E_MAGIC_BROWSE {DoUnderlyingCommand b} 770 E_MAGIC_STUDY {DoUnderlyingCommand G} 771 772 E_USE_DESTROY {DoUnderlyingCommand k} 773 E_USE_DROP {DoUnderlyingCommand d} 774 E_USE_PICKUP {DoUnderlyingCommand g} 775 E_USE_TAKEOFF {DoUnderlyingCommand t} 776 E_USE_WIELD {DoUnderlyingCommand w} 777 E_USE_FOOD {DoUnderlyingCommand E} 778 E_USE_MISSILE {DoUnderlyingCommand f} 779 E_USE_FUEL {DoUnderlyingCommand F} 780 E_USE_SPIKE {DoUnderlyingCommand j} 781 E_USE_THROW {DoUnderlyingCommand v} 782 783 E_INVEN_EQUIPMENT {DoUnderlyingCommand e} 784 E_INVEN_INVENTORY {DoUnderlyingCommand i} 785 E_INVEN_INSPECT {DoUnderlyingCommand I} 786 E_INVEN_INSCRIBE {DoUnderlyingCommand \{} 787 E_INVEN_UNINSCRIBE {DoUnderlyingCommand \}} 788 789 E_ACTION_ALTER {DoUnderlyingCommand +} 790 E_ACTION_BASH {DoUnderlyingCommand B} 791 E_ACTION_CLOSE {DoUnderlyingCommand c} 792 E_ACTION_DISARM {DoUnderlyingCommand D} 793 E_ACTION_DOWN {DoUnderlyingCommand >} 794 E_ACTION_OPEN {DoUnderlyingCommand o} 795 E_ACTION_LOOK {DoUnderlyingCommand l} 796 E_ACTION_MAP {DoUnderlyingCommand M} 797 E_ACTION_NOTE {DoUnderlyingCommand :} 798 E_ACTION_SHAPE {DoUnderlyingCommand \]} 799 E_ACTION_PETS {DoUnderlyingCommand p} 800 E_ACTION_POWER {DoUnderlyingCommand U} 801 E_ACTION_REPEAT {DoUnderlyingCommand n} 802 E_ACTION_REST {DoUnderlyingCommand R} 803 E_ACTION_RUN {DoUnderlyingCommand .} 804 E_ACTION_SEARCH {DoUnderlyingCommand s} 805 E_ACTION_SEARCH_MODE {DoUnderlyingCommand S} 806 E_ACTION_STAY {DoUnderlyingCommand ,} 807 E_ACTION_STAY_TOGGLE {DoUnderlyingCommand g} 808 E_ACTION_TARGET {DoUnderlyingCommand *} 809 E_ACTION_TUNNEL {DoUnderlyingCommand T} 810 E_ACTION_UP {DoUnderlyingCommand <} 811 E_ACTION_WALK {DoUnderlyingCommand ";"} 812 E_ACTION_WALK_TOGGLE {DoUnderlyingCommand -} 813 814 E_PREF_FONT { 815 NSModule::LoadIfNeeded NSFont 816 NSWindowManager::Display font 817 } 818 E_PREF_OPTIONS {DoUnderlyingCommand =} 819 820 E_OTHER_INFO {DoUnderlyingCommand C} 821 E_OTHER_FEELING {DoUnderlyingCommand ^F} 822 E_OTHER_KNOWLEDGE {DoUnderlyingCommand ~} 823 E_OTHER_MESSAGES {DoUnderlyingCommand ^p} 824 E_OTHER_QUEST {DoUnderlyingCommand ^Q} 825 E_OTHER_TIME {DoUnderlyingCommand ^T} 826 827 E_WINDOW_DEFPOS { 828 set title "dialog-title-defpos" 829 set message "dialog-msg-defpos" 830 set answer [tk_messageBox -parent [Info $oop win] -type yesno \ 831 -icon question -title $title -message $message] 832 if {[string equal $answer yes]} { 833 HardcodeGeometry 834 } 835 } 836 E_WINDOW_MAXIMIZE { 837 set title "dialog-title-max" 838 set message "dialog-msg-max" 839 set answer [tk_messageBox -parent [Info $oop win] -type yesno \ 840 -icon question -title $title -message $message] 841 if {[string equal $answer yes]} { 842 MaximizeWindows 843 } 844 } 845 E_WINDOW_SAVEPOS {WriteGeometryFile} 846 E_WINDOW_LOADPOS { 847 set title "dialog-title-loadpos" 848 if {![file exists [PathTk config geometry]]} { 849 set message "dialog-msg-loadpos-fail" 850 tk_messageBox -parent [Info $oop win] \ 851 -title $title -message $message 852 return 853 } 854 set message "dialog-msg-loadpos" 855 set answer [tk_messageBox -parent [Info $oop win] -type yesno \ 856 -icon question -title $title -message $message] 857 if {[string equal $answer yes]} { 858 ReadGeometryFile 859 } 860 } 861 E_WINDOW_AUTOSAVE { 862 Value window,autosave [Info $oop window,autosave] 863 } 864 865 E_CHOICEWINDOW { 866 if {[Info $oop choiceWindow]} { 867 NSModule::LoadIfNeeded NSChoiceWindow 868 NSWindowManager::Display choice 869 } else { 870 NSWindowManager::Undisplay choice 871 } 872 } 873 E_WINDOW_MESSAGES { 874 if {[Info $oop messagesWindow]} { 875 NSModule::LoadIfNeeded NSMessageWindow 876 NSWindowManager::Display message2 877 } else { 878 NSWindowManager::Undisplay message2 879 } 880 } 881 E_WINDOW_MESSAGE { 882 if {[Info $oop messageWindow]} { 883 wm deiconify [Window message] 884 grid remove [Window main].message 885 Global message,message [Window message].message 886 } else { 887 wm withdraw [Window message] 888 grid [Window main].message 889 Global message,message [Window main].message.message 890 } 891 Value message,float [Info $oop messageWindow] 892 } 893 E_WINDOW_MISC { 894 if {[Info $oop miscWindow]} { 895 wm deiconify [Window misc] 896 grid remove [Window main].misc 897 Global misc,canvas [Window misc].misc 898 if {[Value misc,layout] == "wide"} { 899 wm deiconify [Window progress] 900 } 901 } else { 902 Value misc,layout tall 903 wm withdraw [Window misc] 904 wm withdraw [Window progress] 905 grid [Window main].misc 906 Global misc,canvas [Window main].misc.misc 907 } 908 Value misc,float [Info $oop miscWindow] 909 if {[Value misc,layout] == "wide"} { 910 NSMiscWindow::MiscArrangeWide 911 } else { 912 NSMiscWindow::MiscArrangeTall 913 } 914 } 915 E_WINDOW_RECALL { 916 if {[Info $oop recallWindow]} { 917 NSWindowManager::Display recall 918 } else { 919 NSWindowManager::Undisplay recall 920 } 921 } 922 923 E_HELP {DoUnderlyingCommand ?} 924 E_TIPS { 925 NSModule::LoadIfNeeded NSTips 926 WindowBringToFront [Window tip] 927 } 928 E_ABOUT {AboutApplication} 929 default { 930 error "unhandled menu entry \"$ident\"" 931 } 932 } 933 934 return 935} 936 937# NSMainWindow::Close -- 938# 939# Called when the user attempts to close the window. 940# 941# Arguments: 942# oop OOP ID of NSMainWindow object. 943# 944# Results: 945# What happened. 946 947proc NSMainWindow::Close {oop} { 948 949 global Angband 950 951 # Check if game is waiting for a command. If not, it isn't a 952 # good time to quit. 953 if {[string compare [angband inkey_flags] INKEY_CMD]} { 954 bell 955 return 956 } 957 958 # Ask the user to confirm quit with save 959 set answer [tk_messageBox -icon question -type yesno \ 960 -title [format "dialog-title-quit" "ZAngband"] \ 961 -message "dialog-msg-quit"] 962 if {[string equal $answer no]} return 963 964 # Save and quit 965 DoCommandIfAllowed ^x 966 967 return 968} 969 970# NSMainWindow::Configure -- 971# 972# Called when the Main Window widget changes size. 973# 974# Arguments: 975# oop OOP ID of NSMainWindow object. 976# 977# Results: 978# What happened. 979 980proc NSMainWindow::Configure {oop width height} { 981 982 set widgetId [Global main,widgetId] 983 set widget [Global main,widget] 984 985 NSWidget::Resize $widgetId $width $height 986 987 return 988} 989 990 991# NSMainWindow::ValueChanged_font_statusBar -- 992# 993# Called when the font,statusBar value changes. 994# Updates the Main Window statusbar. 995# 996# Arguments: 997# arg1 about arg1 998# 999# Results: 1000# What happened. 1001 1002proc NSMainWindow::ValueChanged_font_statusBar {} { 1003 1004 set statusBar [Window main].statusBar 1005 1006 # Get the desired font 1007 set font [Value font,statusBar] 1008 1009 # Update the font. Too bad there isn't a -fontvar font variable 1010 $statusBar.frameLabel.label configure -font $font 1011 $statusBar.center configure -font $font 1012 $statusBar.depth configure -font $font 1013 1014 return 1015} 1016 1017 1018# NSMainWindow::SynchMenuAccel -- 1019# 1020# Sets the accelerator option for certain menu entries depending on 1021# the current keymap. 1022# 1023# Arguments: 1024# oop OOP ID of NSMainWindow object. 1025# 1026# Results: 1027# What happened. 1028 1029proc NSMainWindow::SynchMenuAccel {oop force} { 1030 1031 global NSMenu 1032 variable Priv 1033 1034 # Since many keymaps may change when a pref file is read in, delay 1035 # configuring the menu accelerators until idle time. 1036 if {!$force} { 1037 1038 if {![string length $Priv(keymap,afterId)]} { 1039 set Priv(keymap,afterId) \ 1040 [after idle NSMainWindow::SynchMenuAccel $oop 1] 1041 } 1042 1043 # The idle task was scheduled by a previous call, but this 1044 # call isn't from the idle task. 1045 return 1046 } 1047 1048 # Important: clear the after id. 1049 set Priv(keymap,afterId) "" 1050 1051 set mbarId [Info $oop mbarId] 1052 1053 lappend data E_GAME_SAVE ^S 1054 lappend data E_GAME_EXIT ^X 1055 1056 lappend data E_MAGIC_ACTIVATE A 1057 lappend data E_MAGIC_WAND a 1058 lappend data E_MAGIC_POTION q 1059 lappend data E_MAGIC_SCROLL r 1060 lappend data E_MAGIC_STAFF u 1061 lappend data E_MAGIC_ROD z 1062 lappend data E_MAGIC_BROWSE b 1063 lappend data E_MAGIC_STUDY G 1064 1065 lappend data E_USE_DESTROY k 1066 lappend data E_USE_DROP d 1067 lappend data E_USE_PICKUP g 1068 lappend data E_USE_TAKEOFF t 1069 lappend data E_USE_WIELD w 1070 lappend data E_USE_FOOD E 1071 lappend data E_USE_MISSILE f 1072 lappend data E_USE_FUEL F 1073 lappend data E_USE_SPIKE j 1074 lappend data E_USE_THROW v 1075 1076 lappend data E_INVEN_EQUIPMENT e 1077 lappend data E_INVEN_INVENTORY i 1078 lappend data E_INVEN_INSPECT I 1079 lappend data E_INVEN_INSCRIBE \{ 1080 lappend data E_INVEN_UNINSCRIBE \} 1081 1082 lappend data E_ACTION_ALTER + 1083 lappend data E_ACTION_BASH B 1084 lappend data E_ACTION_CLOSE c 1085 lappend data E_ACTION_DISARM D 1086 lappend data E_ACTION_DOWN > 1087 lappend data E_ACTION_LOOK l 1088 lappend data E_ACTION_MAP M 1089 lappend data E_ACTION_NOTE : 1090 lappend data E_ACTION_OPEN o 1091 lappend data E_ACTION_REPEAT n 1092 1093 lappend data E_ACTION_REST R 1094 lappend data E_ACTION_RUN . 1095 lappend data E_ACTION_SEARCH s 1096 lappend data E_ACTION_SEARCH_MODE S 1097 lappend data E_ACTION_STAY , 1098 lappend data E_ACTION_STAY_TOGGLE g 1099 lappend data E_ACTION_TARGET * 1100 lappend data E_ACTION_TUNNEL T 1101 lappend data E_ACTION_UP < 1102 lappend data E_ACTION_WALK ";" 1103 lappend data E_ACTION_WALK_TOGGLE - 1104 1105 lappend data E_ACTION_PETS p 1106 lappend data E_ACTION_POWER U 1107 1108 lappend data E_HELP ? 1109 lappend data E_OTHER_FEELING ^F 1110 lappend data E_OTHER_INFO C 1111 lappend data E_OTHER_KNOWLEDGE ~ 1112 lappend data E_OTHER_MESSAGES ^P 1113 lappend data E_OTHER_QUEST ^Q 1114 lappend data E_OTHER_TIME ^T 1115 1116 lappend data E_PREF_OPTIONS = 1117 1118 foreach {ident key} $data { 1119 set entry [NSMenu::MenuFindEntry $mbarId $ident] 1120 if {$::DEBUG && ![llength $entry]} { 1121 error "can't find menu identifier \"$ident\"" 1122 } 1123 set menuId [lindex $entry 0] 1124 set index [lindex $entry 1] 1125 set menu $NSMenu($menuId,menu) 1126 1127 if 0 { 1128 1129 set string [angband keymap find $key] 1130 regsub {\^} $string Ctrl+ string 1131 $menu entryconfigure $index -accelerator $string 1132 } 1133 } 1134 1135 return 1136} 1137 1138 1139# NSMainWindow::MouseCmd -- 1140# 1141# Use to execute commands when a mouse button is pressed. The direction 1142# is determined from the given widget coordinates. 1143# Calls "angband keypress CMD DIR". 1144# 1145# Arguments: 1146# oop OOP ID of NSMainWindow object. 1147# x x coordinate in Widget (as returned by event) 1148# y y coordinate in Widget (as returned by event) 1149# cmd Command to invoke. 1150# 1151# Results: 1152# What happened. 1153 1154proc NSMainWindow::MouseCommand {oop x y cmd} { 1155 1156 set widgetId [Global main,widgetId] 1157 1158 set coords [NSWidget::PointToCave $widgetId $x $y] 1159 scan $coords "%d %d" caveY caveX 1160 set dirInfo [CaveToDirection $caveY $caveX] 1161 set charDir [lindex $dirInfo 0] 1162 1163 if {$charDir != 5} { 1164 angband keypress \\$cmd$charDir 1165 } 1166 1167 return 1168} 1169 1170# NSMainWindow::TrackPress -- 1171# 1172# Set up mouse tracking when <ButtonPress-1> occurs. See TrackMotion() 1173# and TrackOnce() as well. 1174# 1175# Arguments: 1176# oop OOP ID of NSMainWindow object. 1177# x x coordinate in Widget (as returned by event) 1178# y y coordinate in Widget (as returned by event) 1179# 1180# Results: 1181# What happened. 1182 1183proc NSMainWindow::TrackPress {oop x y} { 1184 1185 variable tracking 1186 variable track1st 1187 variable trackStepping 1188 variable trackX 1189 variable trackY 1190 1191 set tracking 1 1192 set track1st 1 1193 set trackX $x 1194 set trackY $y 1195 1196 # Hack -- Allow drag during targetting 1197 if {[string equal [angband inkey_flags] INKEY_TARGET]} { 1198 NSWidget::TrackPress [Global main,widgetId] $x $y 1199 return 1200 } 1201 1202 scan [angband player hitpoints] "%d %d" curhp maxhp 1203 1204 TrackOnce $oop 1205 1206 set track1st 0 1207 1208 set trackStepping 1 1209 after 200 set NSMainWindow::trackStepping 0 1210 1211 return 1212} 1213 1214# NSMainWindow::TrackMotion -- 1215# 1216# Called to remember the cursor position when <Button1-Motion> occurs. 1217# See TrackOnce() below as well. 1218# 1219# Arguments: 1220# oop OOP ID of NSMainWindow object. 1221# x x coordinate in Widget (as returned by event) 1222# y y coordinate in Widget (as returned by event) 1223# 1224# Results: 1225# What happened. 1226 1227proc NSMainWindow::TrackMotion {oop x y} { 1228 1229 variable trackX 1230 variable trackY 1231 1232 # Hack -- Allow drag during targetting 1233 if {[string equal [angband inkey_flags] INKEY_TARGET]} { 1234 NSWidget::TrackOnce [Global main,widgetId] $x $y 1235 return 1236 } 1237 1238 set trackX $x 1239 set trackY $y 1240 1241 return 1242} 1243 1244# NSMainWindow::TrackOnce -- 1245# 1246# This command examines the result of "angband inkey_flags" and 1247# takes some action depending on the value. During INKEY_MORE and 1248# INKEY_DISTURB it calls "angband keypress" with a single space 1249# character. During INKEY_DIR it calls "angband keypress" with the 1250# corresponding direction character (0-9). 1251# 1252# During INKEY_CMD it calls "angband keypress" with a direction 1253# key (to move the character). 1254# 1255# This command is usually called when the <Inkey> binding is invoked, 1256# but if the character is unable to move it calls itself again as 1257# an "after" command. 1258# 1259# Arguments: 1260# oop OOP ID of NSMainWindow object. 1261# 1262# Results: 1263# What happened. 1264 1265proc NSMainWindow::TrackOnce {oop} { 1266 1267 variable tracking 1268 variable track1st 1269 variable trackX 1270 variable trackY 1271 variable trackId 1272 variable trackStepping 1273 1274 # If the mouse isn't down, then do nothing. This command gets 1275 # called whenever the <Inkey> event is generated. 1276 if {!$tracking} return 1277if 0 { 1278 # Hack -- Allow drag during targetting 1279 if {[string equal [angband inkey_flags] INKEY_TARGET]} { 1280 NSWidget::TrackOnce [Global main,widgetId] $trackX $trackY 1281 return 1282 } 1283} 1284 # It is important to delay after taking the first step, otherwise 1285 # the character won't be able to navigate cleanly, and -more- 1286 # messages may go zipping by. 1287 if {$trackStepping} { 1288 set trackId [after 1 NSMainWindow::TrackOnce $oop] 1289 return 1290 } 1291 1292 # (1) Walking into a door with always_repeat 1293 # (2) Walking through rubble/tree (OAngband) 1294 if {!$track1st && [angband player command_rep]} return 1295 1296 # Get the inkey_flags 1297 set flags [angband inkey_flags] 1298 1299 # If the game is displaying the "-more-" message, feed the Term 1300 # with a single space character. This only works if the "quick_messages" 1301 # option is set. 1302 if {[string equal $flags INKEY_MORE]} { 1303 angband keypress " " 1304 return 1305 } 1306 1307 # If a repeated command is in progress, a mouse-click will disturb 1308 if {[string equal $flags INKEY_DISTURB]} { 1309 angband keypress " " 1310 return 1311 } 1312 1313 set widgetId [Global main,widgetId] 1314 set widget [Global main,widget] 1315 1316 set coords [NSWidget::PointToCave $widgetId $trackX $trackY] 1317 if {![string length $coords]} { 1318 set trackId [after 1 NSMainWindow::TrackOnce $oop] 1319 return 1320 } 1321 scan $coords "%d %d" caveY caveX 1322 set dirInfo [CaveToDirection $caveY $caveX] 1323 set dirKey [lindex $dirInfo 0] 1324 set y [lindex $dirInfo 1] 1325 set x [lindex $dirInfo 2] 1326 1327 # If the game is waiting for the user to enter a direction, then 1328 # feed the direction key into the Term. 1329 if {[string equal $flags INKEY_DIR]} { 1330 angband keypress $dirKey 1331 return 1332 } 1333 1334 # If the game is NOT asking for a command, then do nothing 1335 if {[string compare $flags INKEY_CMD]} { 1336 return 1337 } 1338 1339 # If the mouse is over the player grid, only move if this is 1340 # the initial mouse click. Otherwise the user may accidentally 1341 # "run on the spot". 1342 if {!$track1st && ($dirKey == 5)} { 1343 set trackId [after 10 NSMainWindow::TrackOnce $oop] 1344 return 1345 } 1346 1347 # If the spacebar is down, we may get any number of Inkey 1348 # events per turn. To prevent "mouse command overflow" we 1349 # never feed the Term with more than one key per turn. 1350 if {[angband keycount]} return 1351 1352 # Move the character 1353 angband keypress $dirKey 1354 1355 return 1356} 1357 1358# NSMainWindow::TrackRelease -- 1359# 1360# Cancels mouse tracking when the mouse button is released. 1361# 1362# Arguments: 1363# oop OOP ID of NSMainWindow object. 1364# 1365# Results: 1366# What happened. 1367 1368proc NSMainWindow::TrackRelease {oop} { 1369 1370 variable trackId 1371 variable tracking 1372 variable trackStepping 1373 variable trackX 1374 variable trackY 1375 1376 # One time I selected a menu command and received an error after releasing 1377 # the mouse-button 1378 if {!$tracking} return 1379 1380 set tracking 0 1381 set trackStepping 0 1382 1383 after cancel $trackId 1384 1385 # If the Widget wasn't dragged, then tell the game to target 1386 if {[string equal [angband inkey_flags] INKEY_TARGET]} { 1387 set widgetId [Global main,widgetId] 1388 if {![NSWidget::Info $widgetId track,mouseMoved]} { 1389 set coords [NSWidget::PointToCave $widgetId $trackX $trackY] 1390 scan $coords "%d %d" caveY caveX 1391 angband keypress @$caveY\n$caveX\n 1392 return 1393 } 1394 } 1395 1396 return 1397} 1398 1399 1400 1401# NSMainWindow::Leave -- 1402# 1403# Handle the mouse leaving the Widget. Called as NSWidget(OOP,leaveCmd). 1404# 1405# Arguments: 1406# oop OOP ID NSWidget. 1407# 1408# Results: 1409# What happened. 1410 1411proc NSMainWindow::Leave {oop} { 1412 1413 # Unused: PROJECT_HINT 1414 if {0 && [string equal [angband inkey_flags] INKEY_TARGET]} { 1415 1416 # Show target grids at the cursor 1417 set y [Global cursor,y] 1418 set x [Global cursor,x] 1419 angband keypress &$y\n$x\n 1420 return 1421 } 1422 1423 # Clear the statusbar prompt 1424 StatusText $oop "" 1425 1426 return 1427} 1428 1429# NSMainWindow::CaveToDirection -- 1430# 1431# Given cave location y,x, determine the direction key relative 1432# to the player location. 1433# 1434# Arguments: 1435# y y cave location. 1436# x x cave location. 1437# 1438# Results: 1439# Return "dir y x", where dir is key to move, y/x is adjacent cave location 1440# character would move to. 1441 1442proc NSMainWindow::CaveToDirection {y x} { 1443 1444 global PYPX 1445 1446 scan $PYPX "%d %d" py px 1447 1448 if {$y < $py} { 1449 set yyy 789 1450 incr py -1 1451 } elseif {$y > $py} { 1452 set yyy 123 1453 incr py 1454 } else { 1455 set yyy 456 1456 } 1457 1458 if {$x < $px} { 1459 set dirKey [string index $yyy 0] 1460 incr px -1 1461 } elseif {$x > $px} { 1462 set dirKey [string index $yyy 2] 1463 incr px 1464 } else { 1465 set dirKey [string index $yyy 1] 1466 } 1467 1468 return "$dirKey $py $px" 1469} 1470 1471# NSMainWindow::StatusText -- 1472# 1473# Displays text in the status bar. 1474# 1475# Arguments: 1476# oop OOP ID of NSMainWindow object. 1477# 1478# Results: 1479# What happened. 1480 1481proc NSMainWindow::StatusText {oop text} { 1482 1483 set label [Global main,statusBar] 1484 if {[string compare $text [$label cget -text]]} { 1485 $label configure -text $text 1486 } 1487 1488 return 1489} 1490 1491# NSMainWindow::DisplayDepth -- 1492# 1493# Displays the dungeon level in the Main Window's status bar. 1494# 1495# Arguments: 1496# label The label widget to display the depth in. 1497# depth Current depth. 1498# 1499# Results: 1500# What happened. 1501 1502proc NSMainWindow::DisplayDepth {label depth} { 1503 1504 if {$depth == 0} { 1505 set depthStr [angband cave wild_name] 1506 } else { 1507 set depthStr [format "Level %d" $depth] 1508 } 1509 $label configure -text $depthStr 1510 1511 return 1512} 1513 1514# NSMainWindow::ButtonPress3 -- 1515# 1516# Do something when Button 3 is pressed in the main widget. 1517# 1518# Arguments: 1519# oop OOP ID of NSMainWindow object. 1520# x y Coords in Widget (as returned by event). 1521# X Y Global coords (as returned by event). 1522# 1523# Results: 1524# What happened. 1525 1526proc NSMainWindow::ButtonPress3 {oop x y X Y} { 1527 1528 set win [Info $oop win] 1529 1530 set flags [angband inkey_flags] 1531 1532 # Run 1533 if {[string equal $flags INKEY_CMD]} { 1534 MouseCommand $oop $x $y . 1535 1536 # Set target 1537 } elseif {[string equal $flags INKEY_DIR]} { 1538 scan [NSWidget::PointToCave [Global main,widgetId] $x $y] "%d %d" y2 x2 1539 angband keypress *@$y2\n$x2\n 1540 } 1541 1542 return 1543} 1544 1545# NSMainWindow::SelectWindow -- 1546# 1547# Make a window the frontmost active window. 1548# 1549# Arguments: 1550# window Index into Windows[] (inventory, book, etc) 1551# 1552# Results: 1553# What happened. 1554 1555proc NSMainWindow::SelectWindow {window} { 1556 1557 if {[info exists NSWindowManager::Priv($window,win)]} { 1558 NSWindowManager::Display $window 1559 return 1560 } 1561 1562 WindowBringToFront [Window $window] 1563 1564 return 1565} 1566 1567# NSMainWindow::WithdrawWindow -- 1568# 1569# Withdraw a window. 1570# 1571# Arguments: 1572# window Index into Windows[] (inventory, book, etc) 1573# 1574# Results: 1575# What happened. 1576 1577proc NSMainWindow::WithdrawWindow {window} { 1578 1579 wm withdraw [Window $window] 1580 1581 return 1582} 1583 1584# NSMainWindow::Display -- 1585# 1586# Remove current window (if any), and select given window. 1587# 1588# Arguments: 1589# window Index into Windows[] (inventory, book, etc) 1590# 1591# Results: 1592# What happened. 1593 1594proc NSMainWindow::Display {window} { 1595 1596 global Display 1597 1598 if {[string compare $Display(window) none] && 1599 [string compare $Display(window) $window]} { 1600 WithdrawWindow $Display(window) 1601 } 1602 1603 SelectWindow $window 1604 1605 set Display(window) $window 1606 1607 return 1608} 1609 1610 1611# NSMainWindow::PositionChanged -- 1612# 1613# Called as a qebind <Position> script. Update the Main Window 1614# when the character's position changes. Handles the "disturb_panel" option. 1615# 1616# Arguments: 1617# arg1 about arg1 1618# 1619# Results: 1620# What happened. 1621 1622proc NSMainWindow::PositionChanged {widget y x} { 1623 1624 global PYPX 1625 1626 # Keep character centered in the display 1627 $widget center $y $x 1628 Global main,widget,center "$y $x" 1629 1630 # This global is read in various places 1631 set PYPX "$y $x" 1632 1633 return 1634} 1635 1636# FlashCanvasText -- 1637# 1638# Configure the fill color of a canvas item, then do it again later. 1639# 1640# Arguments: 1641# canvas Canvas widget the item is in. 1642# tagOrId The canvas item ID to manipulate. 1643# color The fill color. 1644# num Number of times to flash it. 1645# 1646# Results: 1647# What happened. 1648 1649global FlashCanvas 1650 1651proc FlashCanvasTextAux {canvas tagOrId} { 1652 1653 global FlashCanvas 1654 1655 set num $FlashCanvas($canvas,$tagOrId,num) 1656 if {$num & 1} { 1657 set fill $FlashCanvas($canvas,$tagOrId,colorOff) 1658 } else { 1659 set fill $FlashCanvas($canvas,$tagOrId,colorOn) 1660 } 1661 $canvas itemconfigure $tagOrId -fill $fill 1662 1663 incr num -1 1664 set FlashCanvas($canvas,$tagOrId,num) $num 1665 1666 if {$num} { 1667 set id [after 250 "FlashCanvasTextAux $canvas $tagOrId"] 1668 set FlashCanvas($canvas,$tagOrId,afterId) $id 1669 } else { 1670 unset FlashCanvas($canvas,$tagOrId,afterId) 1671 } 1672 1673 return 1674} 1675 1676proc FlashCanvasText {canvas tagOrId colorOn colorOff num} { 1677 1678 global FlashCanvas 1679 1680 # Never set more than one "after" command for an item 1681 if {[info exists FlashCanvas($canvas,$tagOrId,afterId)]} { 1682 set id $FlashCanvas($canvas,$tagOrId,afterId) 1683 after cancel $id 1684 } 1685 1686 set FlashCanvas($canvas,$tagOrId,colorOn) $colorOn 1687 set FlashCanvas($canvas,$tagOrId,colorOff) $colorOff 1688 set FlashCanvas($canvas,$tagOrId,num) $num 1689 1690 FlashCanvasTextAux $canvas $tagOrId 1691 1692 return 1693} 1694 1695# FlashCanvasTextFill -- 1696# 1697# Returns the fill color for an canvas item. This routine should be 1698# called if a canvas item may be "flashing". 1699# 1700# Arguments: 1701# arg1 about arg1 1702# 1703# Results: 1704# What happened. 1705 1706proc FlashCanvasTextFill {canvas tagOrId} { 1707 1708 global FlashCanvas 1709 1710 if {[info exists FlashCanvas($canvas,$tagOrId,afterId)]} { 1711 return $FlashCanvas($canvas,$tagOrId,colorOff) 1712 } else { 1713 return [$canvas itemcget $tagOrId -fill] 1714 } 1715} 1716 1717# DoCommandIfAllowed -- 1718# 1719# Feeds a string of bytes to the Term, but only if INKEY_CMD is set. 1720# 1721# Arguments: 1722# string String argument to "angband keypress" 1723# 1724# Results: 1725# What happened. 1726 1727proc DoCommandIfAllowed {string} { 1728 1729 # Check if game is waiting for a command 1730 if {[string compare [angband inkey_flags] INKEY_CMD]} return 1731 1732 # Feed the Term 1733 angband keypress $string 1734 1735 return 1736} 1737 1738# DoUnderlyingCommand -- 1739# 1740# Feeds the string to "angband keypress", but prepends a slash 1741# to bypass keymaps. This only works if request_command() is being 1742# called to handle the \ escape character. INKEY_CMD is actually set 1743# when examining the inventory or equipment, and when browsing a book, 1744# in which case this cannot be used. 1745# 1746# Arguments: 1747# string String argument to "angband keypress" 1748# 1749# Results: 1750# What happened. 1751 1752proc DoUnderlyingCommand {string} { 1753 1754 # Check if game is waiting for a command 1755 if {[string compare [angband inkey_flags] INKEY_CMD]} return 1756 1757 # Feed the Term 1758 angband keypress \\$string 1759 1760 return 1761} 1762 1763# DoKeymapCmd -- 1764# 1765# Maps the given command char to the underlying command and calls 1766# "angband keypress" with it. Some command chars can be represented 1767# by the X11 keysym. 1768# 1769# Arguments: 1770# prefix Misc characters to prepend to command char 1771# command The underlying command char 1772# suffix Misc characters to append to command char 1773# 1774# Results: 1775# What happened. 1776 1777proc DoKeymapCmd {prefix command suffix} { 1778 1779 switch -- $command { 1780 backslash {set command \\} 1781 braceleft {set command \{} 1782 braceright {set command \}} 1783 bracketleft {set command \[} 1784 bracketright {set command \]} 1785 quotedbl {set command \"} 1786 } 1787 1788 #set command [angband keymap find $command] 1789 angband keypress $prefix$command$suffix 1790 1791 return 1792} 1793 1794# Note: Setting a delay of 0 results in running after the mouse is 1795# released; setting a delay of 1 or more prevents this 1796proc ConfigureMouse {} { 1797 1798 set win .mouse 1799 toplevel $win 1800 wm title $win "Mouse Settings" 1801 1802 set scale $win.speed 1803 scale $scale \ 1804 -orient horizontal -label "Tracking Delay" \ 1805 -width 15 -sliderlength 20 -length 200 -from 0 -to 200 \ 1806 -command "set ::trackDelay" 1807 1808 $scale set $::trackDelay 1809 1810 pack $scale 1811 1812 1813 set clicks [clock clicks] 1814 set text [time {after 1} 100] 1815 set diff [expr {[clock clicks] - $clicks}] 1816 1817 Debug $text 1818 Debug "1 ms = [expr {$diff / 100}] clicks" 1819 1820 return 1821} 1822 1823proc TestRedrawSpeed {} { 1824 set widget [Global main,widget] 1825 set clicks [clock clicks] 1826 set text [time {$widget wipe ; update idletasks} 100] 1827 set diff [expr {[clock clicks] - $clicks}] 1828 Debug "TestRedrawSpeed: 100 redraws in $diff clicks" 1829 1830 return 1831} 1832 1833 1834# NSMainWindow::ContextMenu_StatusBar -- 1835# 1836# Pop up a context menu in the StatusBar to configure it's 1837# appearance. 1838# 1839# Arguments: 1840# arg1 about arg1 1841# 1842# Results: 1843# What happened. 1844 1845proc NSMainWindow::ContextMenu_StatusBar {menu x y} { 1846 1847 $menu delete 0 end 1848 1849 $menu add command -label "Set Font" \ 1850 -command "NSModule::LoadIfNeeded NSFont ; NSWindowManager::Display font statusBar" 1851 $menu add command -label "Set Color" \ 1852 -command { 1853 set color [tk_chooseColor -parent [Window main] \ 1854 -initialcolor [Value main,statusbar,color]] 1855 if {$color != ""} { 1856 Value main,statusbar,color $color 1857 [Global main,statusBar] configure -foreground $color 1858 } 1859 } 1860 $menu add command -label "Set Autobar Font" \ 1861 -command "NSModule::LoadIfNeeded NSFont ; NSWindowManager::Display font autobar" 1862 $menu add separator 1863 $menu add command -label "Cancel" 1864 1865 tk_popup $menu $x $y 1866 1867 return 1868} 1869 1870