1# File: value-manager.tcl 2 3# Purpose: the Value Manager 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# The Value Manager records various values, and informs clients when those 14# values are modified. 15 16namespace eval NSValueManager { 17 18 variable Command 19 variable Value 20 variable ValuePriv 21 22# namespace eval NSValueManager 23} 24 25# NSValueManager::InitModule -- 26# 27# Description 28# 29# Arguments: 30# arg1 about arg1 31# 32# Results: 33# What happened. 34 35proc NSValueManager::InitModule {} { 36 37 global Angband 38 variable Value 39 variable ValuePriv 40 41 # Each client gets a unique ID 42 set ValuePriv(clientId) 0 43 44 # These are the default values. The tk/config/value file is sourced 45 # below to set user-defined values. 46 47 Manage listBG [palette set 253] 48 Manage listHilite [palette set 158] 49 Manage listInactive [palette set 249] 50 51 # These are the standard Angband terminal colors mapped to 52 # entries in our 256-color palette. They can be accessed via 53 # "Value TERM_XXX". 54 55 Manage TERM_DARK [palette set 255] 56 Manage TERM_WHITE [palette set 0] 57 Manage TERM_SLATE [palette set 250] 58 Manage TERM_ORANGE [palette set 17] 59 Manage TERM_RED [palette set 217] 60 Manage TERM_GREEN [palette set 227] 61 Manage TERM_BLUE [palette set 204] 62 Manage TERM_UMBER [palette set 101] 63 Manage TERM_L_DARK [palette set 129] 64 Manage TERM_L_WHITE [palette set 247] 65 Manage TERM_VIOLET [palette set 30] 66 Manage TERM_YELLOW [palette set 5] 67 Manage TERM_L_RED [palette set 35] 68 Manage TERM_L_GREEN [palette set 185] ; # ~LawnGreen 69 Manage TERM_L_BLUE [palette set 180] ; # ~turquoise2 70 Manage TERM_L_UMBER [palette set 52] 71 72 Manage tip,current 1000 73 Manage tip,show 1 74 75 Manage progress,showBars 1 76 Manage progress,showNumbers 1 77 78 Manage recall,show 1 79 Manage recall,showicon 1 80 81 Manage record,dump 1 82 Manage record,message 1 83 Manage record,photo 1 84 85 Manage bigmap,scale 4 86 Manage map,detail high 87 88 Manage main,statusbar,color White ; # #80FFFF 89 Manage message,float 0 90 91 Manage misc,mode,exp 1 92 Manage misc,mode,armor_class 1 93 Manage misc,textLabels [expr {[winfo screenwidth .] < 800}] 94 Manage misc,layout tall 95 Manage misc,float 0 96 97 Manage messages,max 256 98 99 Manage settings,showUnused 0 100 101 # Icon configuration 102 Manage config,prefix dg32 103 104 Manage choicewindow,show 0 105 Manage choicewindow,autoexpand 1 106 Manage choicewindow,showicon 0 107 108 Manage inventory,alwaysOnTop 1 109 Manage inventory,style new 110 111 Manage store,style new 112 113 Manage message2window,show 0 114 115 Manage font,autobar [Global font,sys,normal] 116 Manage font,choice [Global font,sys,normal] 117 Manage font,inventory [Global font,sys,normal] 118 Manage font,knowledge [Global font,sys,normal] 119 Manage font,magic [Global font,sys,normal] 120 Manage font,message [Global font,sys,normal] 121 Manage font,messages [Global font,sys,normal] 122 Manage font,misc [Global font,sys,small] 123 Manage font,miscPopup [Global font,sys,normal] 124 Manage font,monster [Global font,sys,normal] 125 Manage font,recall [Global font,sys,large] 126 Manage font,options [Global font,sys,normal] 127 Manage font,status [Global font,sys,normal] 128 Manage font,statusBar [Global font,sys,normal] 129 Manage font,store [Global font,sys,normal] 130 131 ### One-time warnings to the user. 132 133 # Show Setup Window first time 134 Manage warning,setup 0 135 136# Manage options,autosave 1 137 Manage window,autosave 1 138 139 LoadValueFile 140 141 return 142} 143 144# NSValueManager::CloseModule -- 145# 146# Called before the game exits. Dumps all values to the tk/config/value 147# file. 148# 149# Arguments: 150# arg1 about arg1 151# 152# Results: 153# What happened. 154 155proc NSValueManager::CloseModule {} { 156 157 global Angband 158 variable Value 159 variable Write 160 161 set tempName [NSUtils::TempFileName [PathTk config]] 162 if {[catch {openlf $tempName} fileId]} { 163 set msg "The following error occurred while attempting to open " 164 append msg "the \"value\" file for writing:\n\n$fileId" 165 tk_messageBox -title Oops -message $msg 166 return 167 } 168 169 puts $fileId "# Automatically generated. Do not edit.\n" 170 171 foreach name [lsort [array names Value]] { 172 if {[info exists Write($name)]} { 173 set value [eval $Write($name) $name] 174 } else { 175 set value [Get $name] 176 } 177 puts $fileId [list Manage $name $value] 178 } 179 180 close $fileId 181 182 set fileName [NSUtils::ReadLink [PathTk config value]] 183 if {[file exists $fileName]} { 184 file rename -force -- $fileName $fileName.bak 185 } 186 file rename -- $tempName $fileName 187 188 return 189} 190 191# NSValueManager::LoadValueFile -- 192# 193# Read tk\config\value. 194# 195# Arguments: 196# arg1 about arg1 197# 198# Results: 199# What happened. 200 201proc NSValueManager::LoadValueFile {} { 202 203 variable Value 204 variable Read 205 206 set fileName [PathTk config value] 207 if {[file exists $fileName]} { 208 source $fileName 209 } 210 211 foreach name [array names Read] { 212 if {[info exists Value($name)]} { 213 eval $Read($name) $name 214 } 215 } 216 217 return 218} 219 220# NSValueManager::AddClient -- 221# 222# Description 223# 224# Arguments: 225# arg1 about arg1 226# 227# Results: 228# What happened. 229 230proc NSValueManager::AddClient {name command} { 231 232 variable Command 233 variable ValuePriv 234 235 set clientId [incr ValuePriv(clientId)] 236 set Command($name,$clientId) $command 237 return $clientId 238} 239 240# NSValueManager::RemoveClient -- 241# 242# Description 243# 244# Arguments: 245# arg1 about arg1 246# 247# Results: 248# What happened. 249 250proc NSValueManager::RemoveClient {name clientId} { 251 252 variable Command 253 254 unset Command($name,$clientId) 255 256 return 257} 258 259# NSValueManager::Manage -- 260# 261# Description 262# 263# Arguments: 264# arg1 about arg1 265# 266# Results: 267# What happened. 268 269proc NSValueManager::Manage {name value} { 270 271 variable Value 272 273 set Value($name) $value 274 275 return 276} 277 278# NSValueManager::Set -- 279# 280# Description 281# 282# Arguments: 283# arg1 about arg1 284# 285# Results: 286# What happened. 287 288proc NSValueManager::Set {name value} { 289 290 variable Value 291 292 set Value($name) $value 293 Changed $name 294 295 return 296} 297 298# NSValueManager::Get -- 299# 300# Description 301# 302# Arguments: 303# arg1 about arg1 304# 305# Results: 306# What happened. 307 308proc NSValueManager::Get {name} { 309 310 variable Value 311 312 return $Value($name) 313} 314 315# NSValueManager::Changed -- 316# 317# Description 318# 319# Arguments: 320# arg1 about arg1 321# 322# Results: 323# What happened. 324 325proc NSValueManager::Changed {name} { 326 327 variable Command 328 329 foreach name [array names Command $name,*] { 330 catch {uplevel #0 $Command($name)} err 331 } 332 333 return 334} 335 336 337# ColorFromValue -- 338# 339# Return the palette RGB color for the value with the given name. 340# 341# Arguments: 342# arg1 about arg1 343# 344# Results: 345# What happened. 346 347proc ColorFromValue {valueName} { 348 349 set index [NSValueManager::Get $valueName] 350 return [palette set $index] 351} 352 353# Value -- 354# 355# Convenience interface to NSValueManager::Get/Set 356# 357# Arguments: 358# arg1 about arg1 359# 360# Results: 361# What happened. 362 363proc Value {name args} { 364 365 # Set info 366 if {[llength $args]} { 367 NSValueManager::Set $name [lindex $args 0] 368 369 # Get info 370 } else { 371 return [NSValueManager::Get $name] 372 } 373 374 return 375} 376 377# ListBackgroundChanged -- 378# 379# Configures the background color of the given canvas to the 380# color of the "listBG" value. 381# 382# Arguments: 383# arg1 about arg1 384# 385# Results: 386# What happened. 387 388proc ListBackgroundChanged {canvas} { 389 390 $canvas configure -background [Value listBG] 391 392 return 393} 394 395# default_tval_to_attr -- 396# 397# Returns the color associated with the given object tval. 398# 399# Arguments: 400# arg1 about arg1 401# 402# Results: 403# What happened. 404 405proc default_tval_to_attr {tval} { 406 407 return [Value $tval] 408} 409 410proc DumpValueManager {} { 411 412 set win .dumpvalue 413 toplevel $win 414 text $win.text 415 pack $win.text 416 417 foreach name [lsort [array names NSValueManager::Value]] { 418 set value [NSValueManager::Get $name] 419 $win.text insert end "Manage $name $value\n" 420 } 421 422 return 423} 424 425