1# File: charflags-canvas.tcl 2 3# Purpose: the Character Flags canvas 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 NSCharFlagsCanvas { 14 15 variable Priv 16 17# namespace eval NSCharFlagsCanvas 18} 19 20# NSCharFlagsCanvas::InitModule -- 21# 22# One-time-only-ever initialization. 23# 24# Arguments: 25# arg1 about arg1 26# 27# Results: 28# What happened. 29 30proc NSCharFlagsCanvas::InitModule {} { 31 32 variable Priv 33 34 NSModule::LoadIfNeeded NSBalloon 35 36 set Priv(slots) [list \ 37 INVEN_WIELD \ 38 INVEN_BOW \ 39 INVEN_LEFT \ 40 INVEN_RIGHT \ 41 INVEN_NECK \ 42 INVEN_LITE \ 43 INVEN_BODY \ 44 INVEN_OUTER \ 45 INVEN_ARM \ 46 INVEN_HEAD \ 47 INVEN_HANDS \ 48 INVEN_FEET \ 49 ] 50 51 set Priv(flags) [list \ 52 STR \ 53 INT \ 54 WIS \ 55 DEX \ 56 CON \ 57 CHR \ 58 SUST_STR \ 59 SUST_INT \ 60 SUST_WIS \ 61 SUST_DEX \ 62 SUST_CON \ 63 SUST_CHR \ 64 IM_ACID \ 65 IM_ELEC \ 66 IM_FIRE \ 67 IM_COLD \ 68 RACE_IM_CUT \ 69 RACE_IM_DARK \ 70 RACE_IM_STUN \ 71 RES_ACID \ 72 RES_ELEC \ 73 RES_FIRE \ 74 RES_COLD \ 75 RES_POIS \ 76 RES_FEAR \ 77 RES_LITE \ 78 RES_DARK \ 79 RES_BLIND \ 80 RES_CONF \ 81 RES_SOUND \ 82 RES_SHARDS \ 83 RES_NEXUS \ 84 RES_NETHER \ 85 RES_CHAOS \ 86 RES_DISEN \ 87 RACE_RES_SANITY \ 88 SLOW_DIGEST \ 89 FEATHER \ 90 LITE \ 91 REGEN \ 92 TELEPATHY \ 93 SEE_INVIS \ 94 REFLECT \ 95 FREE_ACT \ 96 HOLD_LIFE \ 97 RACE_EAT_NETHER \ 98 STEALTH \ 99 SEARCH \ 100 INFRA \ 101 TUNNEL \ 102 SPEED \ 103 BLOWS \ 104 XTRA_SHOTS \ 105 XTRA_MIGHT \ 106 SLAY_ANIMAL \ 107 SLAY_EVIL \ 108 SLAY_UNDEAD \ 109 SLAY_DEMON \ 110 SLAY_ORC \ 111 SLAY_TROLL \ 112 SLAY_GIANT \ 113 SLAY_DRAGON \ 114 KILL_DRAGON \ 115 BRAND_POIS \ 116 BRAND_ACID \ 117 BRAND_ELEC \ 118 BRAND_FIRE \ 119 BRAND_COLD \ 120 SH_FIRE \ 121 SH_ELEC \ 122 VORPAL \ 123 IMPACT \ 124 CHAOTIC \ 125 VAMPIRIC \ 126 WRAITH \ 127 NO_MAGIC \ 128 TELEPORT \ 129 NO_TELE \ 130 AGGRAVATE \ 131 DRAIN_EXP \ 132 BLESSED \ 133 CURSED \ 134 HEAVY_CURSE \ 135 PERMA_CURSE \ 136 TY_CURSE \ 137 ] 138 139 set font [Global font,sys,large] 140 set lineHgt [font metrics $font -linespace] 141 142 set Priv(font,font) $font 143 set Priv(font,height) $lineHgt 144 145 return 146} 147 148# NSCharFlagsCanvas::NSCharFlagsCanvas -- 149# 150# Description. 151# 152# Arguments: 153# arg1 about arg1 154# 155# Results: 156# What happened. 157 158proc NSCharFlagsCanvas::NSCharFlagsCanvas {oop parent} { 159 160 variable Priv 161 162 set canvas $parent.header 163 set width 100 164 set height 40 165 canvas $canvas \ 166 -scrollregion "0 0 $width $height" -width $width -height $height \ 167 -relief flat -highlightthickness 0 -background gray40 168 169 Info $oop header,canvas $canvas 170 171 set lineHgt $Priv(font,height) 172 173 set canvas $parent.canvas 174 set width 100 175 set height [expr {$lineHgt * 22}] 176 canvas $canvas \ 177 -scrollregion "0 0 $width [expr {($lineHgt + 3) * 32}]" \ 178 -width $width -height $height -yscrollincrement [expr {$lineHgt + 3}] \ 179 -highlightthickness 0 -background #000022 \ 180 -yscrollcommand "$parent.yscroll set" \ 181 -xscrollcommand "$parent.xscroll set" 182 scrollbar $parent.yscroll \ 183 -orient vertical -command "$canvas yview" 184 scrollbar $parent.xscroll \ 185 -orient horizontal -command "$canvas xview" 186 187 bind $canvas <Configure> \ 188 "+NSCharFlagsCanvas::Configure $oop" 189 bind $canvas <Map> \ 190 "+NSCharFlagsCanvas::Configure $oop" 191# bind $parent.yscroll <Map> \ 192# "eval %W set \[$canvas yview]" 193 NSUtils::SynchScrollBar $canvas $parent.yscroll 194 195 Info $oop canvas $canvas 196 Info $oop frame $parent 197 198 # So it is drawn first 199 raise $parent.header 200 201 grid rowconfigure $parent 0 -weight 0 202 grid rowconfigure $parent 1 -weight 1 203 grid rowconfigure $parent 2 -weight 0 204 grid columnconfigure $parent 0 -weight 1 205 grid columnconfigure $parent 1 -weight 0 206 207 grid $parent.header \ 208 -row 0 -column 0 -rowspan 1 -columnspan 2 -sticky ew 209 grid $parent.canvas \ 210 -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news 211 grid $parent.yscroll \ 212 -row 1 -column 1 -rowspan 1 -columnspan 1 -sticky ns 213 grid $parent.xscroll \ 214 -row 2 -column 0 -rowspan 1 -columnspan 1 -sticky ew 215 grid remove $parent.yscroll 216 grid remove $parent.xscroll 217 Info $oop scrollbar,vert 0 218 Info $oop scrollbar,horz 0 219 220 NSUtils::DestroyObjectWithWidget NSCharFlagsCanvas $oop $canvas 221 222 InitLayout $oop 223 224 return 225} 226 227# NSCharFlagsCanvas::Info -- 228# 229# Query and modify info. 230# 231# Arguments: 232# arg1 about arg1 233# 234# Results: 235# What happened. 236 237proc NSCharFlagsCanvas::Info {oop info args} { 238 239 global NSCharFlagsCanvas 240 241 # Verify the object 242 NSObject::CheckObject NSCharFlagsCanvas $oop 243 244 # Set info 245 if {[llength $args]} { 246 switch -- $info { 247 default { 248 set NSCharFlagsCanvas($oop,$info) [lindex $args 0] 249 } 250 } 251 252 # Get info 253 } else { 254 switch -- $info { 255 default { 256 return $NSCharFlagsCanvas($oop,$info) 257 } 258 } 259 } 260 261 return 262} 263 264# NSCharFlagsCanvas::InitLayout -- 265# 266# Create all the canvas items. 267# 268# Arguments: 269# arg1 about arg1 270# 271# Results: 272# What happened. 273 274proc NSCharFlagsCanvas::InitLayout {oop} { 275 276 variable Priv 277 278 set canvas [Info $oop header,canvas] 279 280 # Calculate the width of the row labels 281 # Width = Text Width + 2 pixels + 2 * 3 282 set labelWidth 0 283 set labels {} 284 foreach flag $Priv(flags) { 285 set label $flag 286 set width [font measure $Priv(font,font) $label] 287 if {$width > $labelWidth} { 288 set labelWidth $width 289 } 290 lappend labels $label 291 } 292 incr labelWidth [expr {2 + (2 * 3)}] 293 if {$labelWidth < 100} { 294 set labelWidth 100 295 } 296 297 # Calculate the width of the canvas 298 set width [expr {$labelWidth + (32 + 2) * ([llength $Priv(slots)] + 1)}] 299 $canvas configure -width [expr {$width + 16}] 300 301if 0 { 302 303 # One icon per equipment slot 304 set x [expr {$labelWidth + 16}] 305 set y 20 306 foreach slot $Priv(slots) { 307 $canvas create widget $x $y -anchor center \ 308 -tags $slot 309 $canvas bind $slot <Enter> \ 310 "NSCharFlagsCanvas::StatusBar_Slot $oop $slot" 311 $canvas bind $slot <Leave> \ 312 "\[NSCharFlagsCanvas::Info $oop statusBar] itemconfigure t1 -text {}" 313 314if 0 { 315 # Focus ring (really only one is needed) 316 set x2 [expr {$x - [icon size] / 2 - 2}] 317 set y2 [expr {$y - [icon size] / 2 - 2}] 318 $canvas create rectangle $x2 $y2 [expr {$x2 + [icon size] + 4}] \ 319 [expr {$y2 + [icon size] + 4}] -outline Gray60 -fill "" \ 320 -tags $slot,focus 321} 322 323 incr x [expr {32 + 2}] 324 } 325 326 # Character icon 327 $canvas create widget $x $y -anchor center -tags py 328 $canvas bind py <Leave> \ 329 "\[NSCharFlagsCanvas::Info $oop statusBar] itemconfigure t1 -text {}" 330} 331 NSBalloon::Delay $canvas 10 332 333 set canvas [Info $oop canvas] 334 $canvas configure -width $width 335 336 set x 2 ; set y 0 337 foreach flag $Priv(flags) label $labels { 338 339 $canvas create rectangle $x $y [expr {$labelWidth - 2}] \ 340 [expr {$y + $Priv(font,height) + 2}] -fill gray40 -tags $flag 341 $canvas create rectangle $labelWidth $y $width \ 342 [expr {$y + $Priv(font,height) + 2}] -fill "" -outline "" \ 343 -tags "rect $flag $flag,rect" 344 $canvas create text [expr {$labelWidth / 2}] [expr {$y + 1}] -anchor n \ 345 -text $label -font $Priv(font,font) -fill White \ 346 -tags [list $flag $flag,text text] 347 348 $canvas bind $flag <Enter> \ 349 "%W itemconfigure $flag,rect -fill #333366 -outline #333366" 350 $canvas bind $flag <Leave> \ 351 "%W itemconfigure $flag,rect -fill {} -outline {}" 352 353 # Dot for each slot 354 set x2 [expr {$labelWidth + 16}] 355 foreach slot $Priv(slots) { 356 $canvas create oval [expr {$x2 - 2}] [expr {$y + 9 - 2}] \ 357 [expr {$x2 + 2}] [expr {$y + 9 + 2}] -fill "" -outline "" \ 358 -tags "$flag,$slot $flag $flag,dot dot" 359 incr x2 34 360 } 361 362 # Dot for character 363 $canvas create oval [expr {$x2 - 2}] [expr {$y + 9 - 2}] \ 364 [expr {$x2 + 2}] [expr {$y + 9 + 2}] -fill "" -outline "" \ 365 -tags "$flag,py $flag $flag,dot dot" 366 367 incr y [expr {$Priv(font,height) + 3}] 368 } 369 370 return 371} 372 373# NSCharFlagsCanvas::SetInfo -- 374# 375# Set text of character-specific items. 376# 377# Arguments: 378# arg1 about arg1 379# 380# Results: 381# What happened. 382 383proc NSCharFlagsCanvas::SetInfo {oop} { 384 385 variable Priv 386 387 set header [Info $oop header,canvas] 388 set canvas [Info $oop canvas] 389 390 set rowHgt [expr {$Priv(font,height) + 3}] 391 392 $canvas itemconfigure dot -fill "" -outline "" 393 $canvas itemconfigure text -fill White 394 foreach flag $Priv(flags) { 395 set visible($flag) 0 396 } 397 set y [expr {$rowHgt * [llength $Priv(flags)]}] 398 399 foreach slot $Priv(slots) { 400 angband equipment info $slot attrib 401 if {$attrib(k_idx)} { 402 NSBalloon::Set_Canvas $header \ 403 $slot "$attrib(char)\) $attrib(name)" 404 } else { 405 set attrib(icon) "icon none 0" 406 NSBalloon::Set_Canvas $header $slot "" 407 } 408 $header itemconfigure $slot -assign $attrib(icon) 409 410 foreach flag [angband equipment flags $slot] { 411 $canvas itemconfigure $flag,$slot -fill White -outline White 412 set visible($flag) 1 413 } 414 } 415 416 foreach flag [angband player flags] { 417 $canvas itemconfigure $flag,py -fill White -outline White 418 set visible($flag) 1 419 } 420 set desc "name, the race and class" 421 NSBalloon::Set_Canvas $header py $desc 422 423 424 foreach flag $Priv(flags) { 425 if {!$visible($flag)} { 426 $canvas itemconfigure $flag,text -fill gray60 427 } 428 } 429 430 $canvas configure -scrollregion [list 0 0 [winfo reqwidth $canvas] $y] 431 $canvas yview moveto 0 432 433 Configure $oop 434 435 # Hack -- Fix scroll glitch 436 set frame [Info $oop frame] 437 set scrollHgt $y 438 set winHgt [expr {[winfo height $frame] - [winfo y $canvas]}] 439 if {$winHgt % $rowHgt} { 440 incr scrollHgt [expr {$rowHgt - ($winHgt % $rowHgt) - 1}] 441 $canvas configure -scrollregion [list 0 0 [winfo reqwidth $canvas] $scrollHgt] 442 } 443 444 return 445} 446 447# NSCharFlagsCanvas::StatusBar_Slot -- 448# 449# Put the name of the item in the given slot in the status bar. 450# Also displays item recall. 451# 452# Arguments: 453# arg1 about arg1 454# 455# Results: 456# What happened. 457 458proc NSCharFlagsCanvas::StatusBar_Slot {oop slot} { 459 460 angband equipment info $slot attrib 461 if {$attrib(k_idx)} { 462 463 # Show name in statusbar 464 [Info $oop statusBar] itemconfigure t1 -text $attrib(name) 465 } 466 467 return 468} 469 470 471# NSCharFlagsCanvas::Configure -- 472# 473# Description. 474# 475# Arguments: 476# arg1 about arg1 477# 478# Results: 479# What happened. 480 481proc NSCharFlagsCanvas::Configure {oop} { 482 483 set frame [Info $oop frame] 484 set canvas [Info $oop canvas] 485 486 set doVert 0 487 set doHorz 0 488 if {[string compare [$canvas yview] "0 1"]} { 489 set doVert 1 490 } 491 if {[string compare [$canvas xview] "0 1"]} { 492 set doHorz 1 493 } 494 if {$doVert != [Info $oop scrollbar,vert]} { 495 if {$doVert} { 496 grid $frame.yscroll 497 } else { 498 grid remove $frame.yscroll 499 } 500 Info $oop scrollbar,vert $doVert 501 } 502 if {$doHorz != [Info $oop scrollbar,horz]} { 503 if {$doHorz} { 504 grid $frame.xscroll 505 } else { 506 grid remove $frame.xscroll 507 } 508 Info $oop scrollbar,horz $doHorz 509 } 510 511 return 512} 513 514