1# File: init-startup.tcl 2 3# Purpose: the Startup 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 13# This is the first file sourced during program initialization. It is 14# sourced before init_angband() is called. 15 16 17# Global -- 18# 19# Query and modify info. 20# 21# Arguments: 22# arg1 about arg1 23# 24# Results: 25# What happened. 26 27proc Global {info args} { 28 29 global Global 30 31 # Set info 32 if {[llength $args]} { 33 set Global($info) [lindex $args 0] 34 35 # Get info 36 } else { 37 return $Global($info) 38 } 39 40 return 41} 42 43# Platform -- 44# 45# Return 1 if we are running on any of the given platforms. 46# 47# Arguments: 48# arg1 about arg1 49# 50# Results: 51# What happened. 52 53proc Platform {args} { 54 55 global Angband 56 57 if {![llength $args]} { 58 return $Angband(platform) 59 } 60 61 foreach name $args { 62 if {[string equal $name $Angband(platform)]} { 63 return 1 64 } 65 } 66 return 0 67} 68 69# Window -- 70# 71# Global window info. 72# 73# Arguments: 74# arg1 about arg1 75# 76# Results: 77# What happened. 78 79proc Window {info args} { 80 81 global Windows 82 83 # Set info 84 if {[llength $args]} { 85 set Windows($info) [lindex $args 0] 86 87 # Get info 88 } else { 89 return $Windows($info) 90 } 91 92 return 93} 94 95# Source -- 96# 97# Source a .tcl file in the tk directory or a subdirectory of it. 98# Post a warning if the file is not found. 99# 100# Arguments: 101# arg1 about arg1 102# 103# Results: 104# What happened. 105 106proc Source {args} { 107 108 global Angband 109 110 set path [eval file join [list $Angband(dirTk)] $args] 111 if {![file exists $path]} { 112 error "file not found:\n $args, $path" 113 } 114 uplevel #0 source $path 115 116 return 117} 118 119# LongName -- 120# 121# Under Windows, return -longname of the given file. 122# 123# Arguments: 124# arg1 about arg1 125# 126# Results: 127# What happened. 128 129proc LongName {name} { 130 131 if {[string equal $::tcl_platform(platform) windows]} { 132 return [file attributes $name -longname] 133 } 134 return $name 135} 136 137 138# AboutApplication -- 139# 140# Display program information. 141# 142# Arguments: 143# arg1 about arg1 144# 145# Results: 146# What happened. 147 148proc AboutApplication {} { 149 150 NSModule::LoadIfNeeded NSAbout 151 NSAbout::About 152 153 return 154} 155 156 157# QuitNoSave -- 158# 159# Quit the game without saving. If the game is not asking for 160# a command, then call "game abort". Otherwise do a clean exit. 161# 162# Arguments: 163# arg1 about arg1 164# 165# Results: 166# What happened. 167 168proc QuitNoSave {} { 169 170 global Angband 171 172 # Check if game is waiting for a command 173 if {[string compare [angband inkey_flags] INKEY_CMD]} { 174 angband game abort 175 return 176 } 177 178 # Ask the user to confirm quit with save 179 set answer [tk_messageBox -icon question -type yesno \ 180 -title "Quit ZAngband" -message "Do you really want to\ 181 quit without saving?"] 182 if {[string equal $answer no]} return 183 184 # Quit without saving 185 DoUnderlyingCommand ^Ey 186 187 return 188} 189 190namespace eval NSInitStartup { 191} 192 193 194# NSInitStartup::InitStartupScreen -- 195# 196# Initialize the startup window. 197# 198# Arguments: 199# arg1 about arg1 200# 201# Results: 202# What happened. 203 204proc NSInitStartup::InitStartupScreen {} { 205 206 global Angband 207 208 wm title . "ZAngband" 209 wm resizable . no no 210 211 # Quit application if the user closes the window 212 wm protocol . WM_DELETE_WINDOW "exit" 213 214 # Load the "Tcl Powered Logo" 215 image create photo Image_PwrdLogo175 \ 216 -file [PathTk image pwrdLogo175.gif] 217 218 # Program name 219 if {[Platform unix]} { 220 set font {Times 24 bold} 221 } 222 if {[Platform windows]} { 223 set font {Times 18 bold} 224 } 225 label .title \ 226 -text "ZAngband" -font $font 227 228 # Program info 229 set info "ZAngband\nhttp://www.zangband.org\n" 230 label .info \ 231 -text $info -justify left 232 233 # Tcl Powered Logo 234 label .logo \ 235 -image Image_PwrdLogo175 236 237 # Startup progress 238 listbox .prompt \ 239 -width 15 -height 10 -borderwidth 0 -highlightthickness 0 240 .prompt insert end "Initializing arrays..." 241 242 # Geometry 243 pack .title \ 244 -side top -expand no -anchor w 245 pack .info \ 246 -side top -expand no -anchor w 247 pack .logo \ 248 -side left -expand no 249 pack [frame .filler -borderwidth 0 -height 10] -side top -anchor w 250 pack .prompt \ 251 -side top -expand no -pady 00 -padx 20 -anchor w 252 253 # Position 254 WindowPosition . 2 3 255 256 # When the listbox is unpacked, the window may shrink horizontally. 257 # So set the desired window geometry to what it is now (with the list). 258 wm geometry . [wm geometry .] 259 260 update 261 262 return 263} 264 265 266# angband_startup -- 267# 268# Called by Angband (and below) to display status messages 269# during program initialization. 270# 271# Arguments: 272# arg1 about arg1 273# 274# Results: 275# What happened. 276 277proc angband_startup {what} { 278 279 switch -- $what { 280 281 init_misc { 282 set prompt " misc" 283 } 284 init_script { 285 set prompt " script" 286 } 287 init_wilderness { 288 set prompt " wilderness" 289 } 290 init_quests { 291 set prompt " quests" 292 } 293 init_plots { 294 set prompt " plots" 295 } 296 init_other { 297 set prompt " other" 298 } 299 init_alloc { 300 set prompt " alloc" 301 } 302 303 default { 304 set prompt $what 305 } 306 } 307 308 .prompt insert end $prompt 309 .prompt see end 310 311 update 312 313 return 314} 315 316# angband_initialized -- 317# 318# Called by Angband when program initialization is complete. 319# 320# Arguments: 321# arg1 about arg1 322# 323# Results: 324# What happened. 325 326proc angband_initialized {} { 327 328 .prompt delete 0 end 329 .prompt insert end "Sourcing scripts..." 330 331 # Source library files 332 angband_startup " object.tcl" 333 Source library object.tcl 334 angband_startup " buttonlabel.tcl" 335 Source library buttonlabel.tcl 336 angband_startup " canvist.tcl" 337 Source library canvist.tcl 338 angband_startup " menu.tcl" 339 Source library menu.tcl 340 angband_startup " module.tcl" 341 Source library module.tcl 342 angband_startup " status-text.tcl" 343 Source library status-text.tcl 344 angband_startup " progress.tcl" 345 Source library progress1.tcl 346 Source library progress2.tcl 347 Source library progress-window.tcl 348 angband_startup " tabs.tcl" 349 Source library tabs.tcl 350 angband_startup " texist.tcl" 351 Source library texist.tcl 352 angband_startup " toplevel.tcl" 353 Source library toplevel.tcl 354 angband_startup " window-manager.tcl" 355 Source library window-manager.tcl 356 357 NSModule::IndexLoad [PathTk library moduleIndex.tcl] 358 359 destroy .filler 360 destroy .prompt 361 362 Source config.tcl 363 NSConfig::InitModule 364 365 return 366} 367 368 369 370# Because init-other.tcl isn't called before Angband starts calling 371# "angband_xxx", I must set a dummy proc's here. 372 373proc angband_display {args} { 374} 375 376 377# InitLoadWindow -- 378# 379# Creates and displays the Load Window, which is used to display 380# progress during savefile loading and subsequent program initialization. 381# 382# Arguments: 383# arg1 about arg1 384# 385# Results: 386# What happened. 387 388proc InitLoadWindow {} { 389 390 global Angband 391 global AngbandPriv 392 393 # If there are no front windows, the application is swapped 394 # into the background. 395 if {[winfo exists .load]} return 396 397 set win .load 398 toplevel $win -borderwidth 4 -relief ridge 399 wm overrideredirect $win yes 400 401 # Busy 402 $win configure -cursor watch 403 404 set width 350 405 set height 250 406 set height2 40 407 408 set fg Black 409 set bg White 410 411 set canvas $win.canvas 412 canvas $canvas \ 413 -borderwidth 0 -highlightthickness 0 \ 414 -width $width -height $height -background $bg 415 416 set progId [NSObject::New NSProgress2 $win.canvas 150 8] 417 418### 419 420 if {[Platform unix]} { 421 set font {Times 24 bold} 422 set font2 {Times 12} 423 } 424 if {[Platform windows]} { 425 set font {Times 18 bold} 426 set font2 {Times 10} 427 } 428 set anchor nw 429 set x 11 430 set y 11 431 set lineSpace [font metrics $font -linespace] 432 433 # Create a "shadow" for the text below 434 $canvas create text $x $y -font $font -anchor $anchor -fill gray \ 435 -text "Zangband" 436 $canvas create text $x [expr {$y + $lineSpace}] -font $font2 \ 437 -text "Copyright (c) 1997-2001 Tim Baker and ZAngband Dev Team" -anchor $anchor -fill gray 438 439 # Draw text over the shadow created above 440 incr x -1 441 incr y -1 442 $canvas create text $x $y -text "ZAngband" \ 443 -font $font -anchor $anchor -fill $fg 444 $canvas create text $x [expr {$y + $lineSpace}] -font $font2 \ 445 -text "Copyright (c) 1997-2001 Tim Baker" -anchor $anchor -fill $fg \ 446 -tags copyright 447 448 # Scrolling text 449 scan [$canvas bbox copyright] "%s %s %s %s" left top right bottom 450 set height3 [expr {$height - ($height2 + 8) - ($bottom + 8)}] 451 $canvas create rectangle 0 [expr {$bottom + 8}] $width \ 452 [expr {$bottom + 8 + $height3}] -fill gray90 -outline {} 453 454 # Rectangle at bottom 455 $canvas create rectangle 0 [expr {$height - $height2}] $width $height \ 456 -fill $fg 457 $canvas create text [expr {$width / 2}] [expr {$height - $height2 + 4}] \ 458 -text "" -fill $bg -anchor n -tags message 459 460### 461 462 set font [Global font,sys,normal] 463 set rowHeight [font metrics $font -linespace] 464 set rowCount [expr {($height3 - 6) / $rowHeight}] 465 set AngbandPriv(load,rowCount) $rowCount 466 set y [expr {$height - $height2 - 8 - ($height3 - ($rowHeight * $rowCount)) / 2}] 467 for {set row 1} {$row <= $rowCount} {incr row} { 468 $canvas create text [expr {$width / 2}] \ 469 [expr {$y - $row * $rowHeight}] \ 470 -fill Black -font $font -anchor n -tags row$row 471 } 472 473 pack $canvas -padx 1 -pady 1 474 place [NSProgress2::Info $progId frame] -x [expr {$width / 2}] \ 475 -y [expr {$height - 8}] -anchor s 476 477### 478 479 # Position the window 480 WindowPosition $win 2 3 481 482 # This inocuous call insures an *active* front window exists 483 focus $win 484 485 # Hide the startup screen 486 wm withdraw . 487 488 # Cleanup the startup screen 489 foreach window [winfo children .] { 490 if {[string compare [winfo class $window] Toplevel]} { 491 destroy $window 492 } 493 } 494 image delete Image_PwrdLogo175 495 foreach tag [bind .] { 496 bind . $tag {} 497 } 498 499 set AngbandPriv(load,win) $win 500 set AngbandPriv(load,prog) $progId 501 set AngbandPriv(load,message) {} 502 503 return 504} 505 506# LoadNote -- 507# 508# Inserts the given message to the head of the message queue, then 509# displays all the messages following the message in the Load Window. 510# 511# Arguments: 512# arg1 about arg1 513# 514# Results: 515# What happened. 516 517proc LoadNote {message} { 518 519 global AngbandPriv 520 521 set win .load 522 set canvas $win.canvas 523 524 set AngbandPriv(load,message) \ 525 [linsert $AngbandPriv(load,message) 0 $message] 526 set AngbandPriv(load,message) \ 527 [lrange $AngbandPriv(load,message) 0 $AngbandPriv(load,rowCount)] 528 529 set row 1 530 foreach message [lrange $AngbandPriv(load,message) 1 end] { 531 $canvas itemconfigure row$row -text $message 532 incr row 533 } 534 535 return 536} 537 538# angband_load -- 539# 540# Called by Angband to display info during savefile loading. 541# 542# Arguments: 543# arg1 about arg1 544# 545# Results: 546# What happened. 547 548proc angband_load {action {message ""}} { 549 550 global AngbandPriv 551 552 switch -- $action { 553 kill { 554 set win $AngbandPriv(load,win) 555 destroy $win 556 } 557 note { 558 set canvas $AngbandPriv(load,win).canvas 559 $canvas itemconfigure message -text $message 560 LoadNote $message 561 } 562 progress { 563 NSProgress2::SetDoneRatio $AngbandPriv(load,prog) $message 564 } 565 } 566 567 update 568 569 return 570} 571 572# NSInitStartup::InitStartup -- 573# 574# The main initialization command. 575# 576# Arguments: 577# arg1 about arg1 578# 579# Results: 580# What happened. 581 582proc NSInitStartup::InitStartup {} { 583 584 global auto_path 585 global Angband 586 global DEBUG 587 588 # The tk directory 589 set Angband(dirTk) [angband game tkdir] 590 set Angband(dirTk) [LongName $Angband(dirTk)] 591 592 # The msgs directory (message catalog) 593 set Angband(dirTk,msgs) [list [file join $Angband(dirTk) msgs]] 594 595 # Remember the platform 596 switch -- $::tcl_platform(platform) { 597 macintosh - 598 unix - 599 windows { 600 set Angband(platform) $::tcl_platform(platform) 601 } 602 default { 603 error "unknown platform \"$::tcl_platform(platform)\"" 604 } 605 } 606 607 # This call makes sure Tcl reads in info about all available packages. 608 # Without this call, the "package names" command returns an empty list. 609 # Also, "package require Tk" doesn't scan external packages. 610 catch {package require no-such-package} 611 612 if {$Angband(platform) == "windows"} { 613 # Set the default window icon 614 wm iconbitmap . -default [file join $Angband(dirTk) image angbandtk.ico] 615 } 616 617 # Development debug support 618 set DEBUG 1 619 620 Source errorInfo.tcl 621 622 proc ::ASSERT {condition message} { 623 if {![uplevel expr $condition]} { 624 error $message 625 } 626 return 627 } 628 629 # Error handling 630 Source bgerror.tcl 631 632 # Global copyright blurb 633 set Angband(copy) "Based on ZAngband (c) the ZAngband Dev Team" 634 635 # Hack -- Require WindowPosition() command 636 Source library utils.tcl 637 638 # Various game-related commands 639 Source misc.tcl 640 641 # Create a universal "empty" image 642 image create photo Image_Empty 643 644 # Poor-Man's Font Management 645 set screenWidth [winfo screenwidth .] 646 if {[Platform windows]} { 647 set fontSys "{MS Sans Serif}" 648 set fontFixed "Courier" 649 if {$screenWidth > 800} { 650 Global font,sys,small "$fontSys 8" 651 Global font,sys,normal "$fontSys 8" 652 Global font,sys,large "$fontSys 10" 653 Global font,fixed,small "$fontFixed 9" 654 Global font,fixed,normal "$fontFixed 10" 655 } elseif {$screenWidth > 640} { 656 Global font,sys,small "$fontSys 8" 657 Global font,sys,normal "$fontSys 8" 658 Global font,sys,large "$fontSys 8" 659 Global font,fixed,small "$fontFixed 8" 660 Global font,fixed,normal "$fontFixed 9" 661 } else { 662 Global font,sys,small "$fontSys 8" 663 Global font,sys,normal "$fontSys 8" 664 Global font,sys,large "$fontSys 8" 665 Global font,fixed,small "$fontFixed 8" 666 Global font,fixed,normal "$fontFixed 8" 667 } 668 # Platform win 669 } 670 if {[Platform unix]} { 671 Global font,sys,small {Helvetica 10} 672 Global font,sys,normal {Helvetica 12} 673 Global font,sys,large {Helvetica 12} 674 Global font,fixed,small {Courier 10} 675 Global font,fixed,normal {Courier 12} 676 } 677 678 # The MS Windows version of Tk supports platform-specific color names 679 # all beginning with "System". Each of these colors is set here for 680 # each platform. 681 682 # Get these from library/utils.tcl 683 Global SystemButtonFace $::SystemButtonFace 684 Global SystemButtonHighlight $::SystemButtonHighlight 685 Global SystemButtonShadow $::SystemButtonShadow 686 Global SystemHighlight $::SystemHighlight 687 Global SystemHighlightText $::SystemHighlightText 688 Global System3dLight $::System3dLight 689 Global System3dDarkShadow $::System3dDarkShadow 690 Global SystemInfoBackground $::SystemInfoBackground 691 692 if {[Platform unix]} { 693 option add *Button.default normal widgetDefault 694 option add *Button.font {Helvetica 12} widgetDefault 695 option add *Checkbutton.font {Helvetica 12} widgetDefault 696 option add *Dialog.msg.font {Helvetica 12} 697 option add *Entry.background White widgetDefault 698 option add *Label.font {Helvetica 12} widgetDefault 699 option add *Listbox.font {Helvetica 12} widgetDefault 700 option add *Menu.font {Helvetica 12} widgetDefault 701 option add *Message.font {Helvetica 12} widgetDefault 702 option add *Radiobutton.font {Helvetica 12} widgetDefault 703 option add *Scale.font {Helvetica 12} widgetDefault 704 option add *selectForeground [Global SystemHighlightText] 100 705 option add *selectBackground [Global SystemHighlight] 706 } 707 708 # Get term colours 709 Global term_attr {"TERM_DARK" \ 710 "TERM_WHITE" \ 711 "TERM_SLATE" \ 712 "TERM_ORANGE" \ 713 "TERM_RED" \ 714 "TERM_GREEN" \ 715 "TERM_BLUE" \ 716 "TERM_UMBER" \ 717 "TERM_L_DARK" \ 718 "TERM_L_WHITE" \ 719 "TERM_VIOLET" \ 720 "TERM_YELLOW" \ 721 "TERM_L_RED" \ 722 "TERM_L_GREEN" \ 723 "TERM_L_BLUE" \ 724 "TERM_L_UMBER"} 725 726 # If a new character is created, this is set to 1 727 Global isNewGame 0 728 729 # Value Manager (needed for Birth Options Window) 730 Source value-manager.tcl 731 732 NSValueManager::InitModule 733 734 InitStartupScreen 735 736 return 737} 738 739# Begin 740NSInitStartup::InitStartup 741
