git.zerfleddert.de Git - micropolis/blob - res/micropolis.tcl

   1 #######################################################################
   2 # Micropolis.tcl, by Don Hopkins.
   3 # Copyright (C) 2002 by Electronic Arts.
   4 # This file defines the user interface of Micropolis.
   5 # Modify at your own risk!
   6 ########################################################################
   7 # Micropolis, Unix Version.  This game was released for the Unix platform
   8 # in or about 1990 and has been modified for inclusion in the One Laptop
   9 # Per Child program.  Copyright (C) 1989 - 2007 Electronic Arts Inc.  If
  10 # you need assistance with this program, you may contact:
  11 #   http://wiki.laptop.org/go/Micropolis  or email  micropolis@laptop.org.
  12 #
  13 # This program is free software: you can redistribute it and/or modify
  14 # it under the terms of the GNU General Public License as published by
  15 # the Free Software Foundation, either version 3 of the License, or (at
  16 # your option) any later version.
  17 #
  18 # This program is distributed in the hope that it will be useful, but
  19 # WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 # General Public License for more details.  You should have received a
  22 # copy of the GNU General Public License along with this program.  If
  23 # not, see <http://www.gnu.org/licenses/>.
  24 #
  25 #             ADDITIONAL TERMS per GNU GPL Section 7
  26 #
  27 # No trademark or publicity rights are granted.  This license does NOT
  28 # give you any right, title or interest in the trademark SimCity or any
  29 # other Electronic Arts trademark.  You may not distribute any
  30 # modification of this program using the trademark SimCity or claim any
  31 # affliation or association with Electronic Arts Inc. or its employees.
  32 #
  33 # Any propagation or conveyance of this program must include this
  34 # copyright notice and these terms.
  35 #
  36 # If you convey this program (or any modifications of it) and assume
  37 # contractual liability for the program to recipients of it, you agree
  38 # to indemnify Electronic Arts for any liability that those contractual
  39 # assumptions impose on Electronic Arts.
  40 #
  41 # You may not misrepresent the origins of this program; modified
  42 # versions of the program must be marked as such and not identified as
  43 # the original program.
  44 #
  45 # This disclaimer supplements the one included in the General Public
  46 # License.  TO THE FULLEST EXTENT PERMISSIBLE UNDER APPLICABLE LAW, THIS
  47 # PROGRAM IS PROVIDED TO YOU "AS IS," WITH ALL FAULTS, WITHOUT WARRANTY
  48 # OF ANY KIND, AND YOUR USE IS AT YOUR SOLE RISK.  THE ENTIRE RISK OF
  49 # SATISFACTORY QUALITY AND PERFORMANCE RESIDES WITH YOU.  ELECTRONIC ARTS
  50 # DISCLAIMS ANY AND ALL EXPRESS, IMPLIED OR STATUTORY WARRANTIES,
  51 # INCLUDING IMPLIED WARRANTIES OF MERCHANTABILITY, SATISFACTORY QUALITY,
  52 # FITNESS FOR A PARTICULAR PURPOSE, NONINFRINGEMENT OF THIRD PARTY
  53 # RIGHTS, AND WARRANTIES (IF ANY) ARISING FROM A COURSE OF DEALING,
  54 # USAGE, OR TRADE PRACTICE.  ELECTRONIC ARTS DOES NOT WARRANT AGAINST
  55 # INTERFERENCE WITH YOUR ENJOYMENT OF THE PROGRAM; THAT THE PROGRAM WILL
  56 # MEET YOUR REQUIREMENTS; THAT OPERATION OF THE PROGRAM WILL BE
  57 # UNINTERRUPTED OR ERROR-FREE, OR THAT THE PROGRAM WILL BE COMPATIBLE
  58 # WITH THIRD PARTY SOFTWARE OR THAT ANY ERRORS IN THE PROGRAM WILL BE
  59 # CORRECTED.  NO ORAL OR WRITTEN ADVICE PROVIDED BY ELECTRONIC ARTS OR
  60 # ANY AUTHORIZED REPRESENTATIVE SHALL CREATE A WARRANTY.  SOME
  61 # JURISDICTIONS DO NOT ALLOW THE EXCLUSION OF OR LIMITATIONS ON IMPLIED
  62 # WARRANTIES OR THE LIMITATIONS ON THE APPLICABLE STATUTORY RIGHTS OF A
  63 # CONSUMER, SO SOME OR ALL OF THE ABOVE EXCLUSIONS AND LIMITATIONS MAY
  64 # NOT APPLY TO YOU.
  65
  66
  67 ########################################################################
  68 # Libraries
  69 ########################################################################
  70
  71
  72 set errorInfo {}
  73 set auto_noexec 1
  74
  75 source $tk_library/wish.tcl
  76
  77
  78 ########################################################################
  79 # Globals
  80 ########################################################################
  81
  82
  83 set UniqueID 0
  84 set State uninitialized
  85 set CityName "Micropolis"
  86 set GameLevel 0
  87 set SimHome [pwd]
  88 set CityLibDir $SimHome/cities
  89 set CityDir $CityLibDir
  90 set OldBudget 0
  91 set BudgetRoadFund 0
  92 set BudgetFireFund 0
  93 set BudgetPoliceFund 0
  94 set BudgetTaxRate 0
  95 set DemandRes 0
  96 set DemandCom 0
  97 set DemandInd 0
  98 set Priority 2
  99 set Time 3
 100 set AutoGoto 1
 101 set AutoBudget 1
 102 set Disasters 1
 103 set AutoBulldoze 1
 104 set Sound 1
 105 set DoAnimation 1
 106 set DoMessages 1
 107 set DoNotices 1
 108 set ShapePies 1
 109 set SoundServers {}
 110 set AudioChannels {mode edit fancy warning intercom}
 111 set BudgetTimeout 30
 112 set BudgetTimer 0
 113 set BudgetTimerActive 0
 114 set BudgetsVisible 0
 115 set EvaluationsVisible 0
 116 set SplashScreenDelay 5000
 117 set Scenario -1
 118 set Chatting 0
 119 set ChatServer "localhost"
 120 set ChatSocket 6667
 121 set ChatConnection {}
 122 set NickName "nickname"
 123 set UserName "username"
 124 set ServerName "servername"
 125 set RealName "realname"
 126 set ChannelName "#Micropolis"
 127 set HomeDir ""
 128 set ResourceDir ""
 129 set HostName ""
 130 set LocalHostName "[exec hostname]"
 131 set SaveCityWin ""
 132 set MapHistory {}
 133 set MapHistoryNum -1
 134 set HelpLoaded 0
 135 set QueryX 0
 136 set QueryY 0
 137 set FreeVotes 0
 138 set ShowingPicture 300
 139 set MaxLines 500
 140 set ShrinkLines 250
 141 set ShowingParms {}
 142 set VoteNames {UseThisMap Ask Zone}
 143 set VotesForUseThisMap {}
 144 set VotesForAsk {}
 145 set VotesForZone {}
 146 set VotesForBudget {}
 147 set CurrentDate {}
 148
 149 set HeadWindows {}
 150 set EditorWindows {}
 151 set MapWindows {}
 152 set GraphWindows {}
 153 set BudgetWindows {}
 154 set EvaluationWindows {}
 155 set SplashWindows {}
 156 set ScenarioWindows {}
 157 set FileWindows {}
 158 set AskWindows {}
 159 set PlayerWindows {}
 160 set NoticeWindows {}
 161 set HelpWindows {}
 162 set FrobWindows {}
 163
 164 set HeadPanelWidth 360
 165 set HeadPanelHeight 200
 166
 167 set MapPanelWidth 360
 168 set MapPanelHeight 330
 169
 170 set NoticePanelWidth 360
 171 set NoticePanelHeight 250
 172
 173 set SplashPanelWidth 1200
 174 set SplashPanelHeight 900
 175
 176 set ScenarioPanelWidth 420
 177 set ScenarioPanelHeight 440
 178
 179 set SugarURI ""
 180 set SugarNickName ""
 181 set SugarShared 0
 182 set SugarActivated 0
 183 set SugarBuddies {}
 184
 185 set SubWindows {
 186   {editor EditorWindows}
 187   {map MapWindows}
 188   {graph GraphWindows}
 189   {budget BudgetWindows}
 190   {evaluation EvaluationWindows}
 191   {scenario ScenarioWindows}
 192   {splash SplashWindows}
 193   {file FileWindows}
 194   {ask AskWindows}
 195   {player PlayerWindows}
 196   {notice NoticeWindows}
 197   {help HelpWindows}
 198   {frob FrobWindows}
 199   {head HeadWindows}
 200 }
 201
 202
 203 #   0           1               2               3       4         5   6   7   8         9       10   11       12      13
 204 #   type        id              callback        param   var       x   y   w   h         normal  over disabled checked checkedover
 205 #   ----------- --------------- --------------- ------- ------- --- --- --- ---         ------- ---- -------- ------- -----------
 206 set ScenarioButtons {
 207   { button      load            DoLoad          ""      ""       70 238 157  90         ""      @images/button1hilite.xpm "" }
 208   { button      generate        DoGenerate      ""      ""       62 392 157  90         ""      @images/button2hilite.xpm "" }
 209   { button      quit            DoQuit          ""      ""       68 544 157  90         ""      @images/button3hilite.xpm "" }
 210   { button      about           DoAbout         ""      ""      101 705 157  90         ""      @images/button4hilite.xpm "" }
 211   { checkbox    easy            DoLevel         0       ""      982 106 190  70         ""      @images/checkbox1hilite.xpm "" @images/checkbox1checked.xpm @images/checkbox1hilitechecked.xpm }
 212   { checkbox    medium          DoLevel         1       ""      982 176 190  70         ""      @images/checkbox2hilite.xpm "" @images/checkbox2checked.xpm @images/checkbox2hilitechecked.xpm }
 213   { checkbox    hard            DoLevel         2       ""      982 246 190  70         ""      @images/checkbox3hilite.xpm "" @images/checkbox3checked.xpm @images/checkbox3hilitechecked.xpm }
 214   { button      left            DoLeft          ""      ""      540 375  50  50         ""      @images/lefthilite.xpm @images/leftdisabled.xpm }
 215   { button      right           DoRight         ""      ""      841 375  50  50         ""      @images/righthilite.xpm @images/rightdisabled.xpm }
 216   { button      play            DoPlay          ""      ""      625 376 180  50         ""      @images/playhilite.xpm "" }
 217   { button      scenario1       DoPickScenario  "1"     ""      310 451 209 188         ""      @images/scenario1hilite.xpm "" }
 218   { button      scenario2       DoPickScenario  "2"     ""      519 451 209 188         ""      @images/scenario2hilite.xpm "" }
 219   { button      scenario3       DoPickScenario  "3"     ""      727 450 209 188         ""      @images/scenario3hilite.xpm "" }
 220   { button      scenario4       DoPickScenario  "4"     ""      936 450 209 188         ""      @images/scenario4hilite.xpm "" }
 221   { button      scenario5       DoPickScenario  "5"     ""      310 639 209 188         ""      @images/scenario5hilite.xpm "" }
 222   { button      scenario6       DoPickScenario  "8"     ""      519 639 209 188         ""      @images/scenario6hilite.xpm "" }
 223   { button      scenario7       DoPickScenario  "7"     ""      728 638 209 188         ""      @images/scenario7hilite.xpm "" }
 224   { button      scenario8       DoPickScenario  "6"     ""      937 638 209 188         ""      @images/scenario8hilite.xpm "" }
 225 }
 226
 227 # Disabled until we handle mouse events on the map itself.
 228 #   { button    map             DoMap           ""      ""      516  30 396 338         ""      @images/maphilite.xpm }
 229
 230
 231 ########################################################################
 232 # Fonts
 233
 234
 235 set FontInfo {
 236   {Big {
 237         {-*-dejavu lgc sans-medium-r-normal-*-90-*}
 238   }}
 239   {Large {
 240         {-*-dejavu lgc sans-medium-r-normal-*-80-*}
 241   }}
 242   {Medium {
 243         {-*-dejavu lgc sans-medium-r-normal-*-70-*}
 244   }}
 245   {Small {
 246         {-*-dejavu lgc sans-medium-r-normal-*-60-*}
 247   }}
 248   {Narrow {
 249         {-*-dejavu lgc sans-medium-r-normal-*-60-*}
 250   }}
 251   {Tiny {
 252         {-*-dejavu lgc sans-medium-r-normal-*-60-*}
 253   }}
 254   {Text {
 255         {-*-dejavu lgc sans-medium-r-normal-*-70-*}
 256   }}
 257   {Message {
 258         {-*-dejavu lgc sans-medium-r-normal-*-70-*}
 259   }}
 260   {Alert {
 261         {-*-dejavu lgc sans-medium-r-normal-*-70-*}
 262   }}
 263 }
 264
 265
 266 ########################################################################
 267
 268
 269 set MapTitles {
 270   {Micropolis Overall Map}
 271   {Residential Zone Map}
 272   {Commercial Zone Map}
 273   {Industrial Zone Map}
 274   {Power Grid Map}
 275   {Transportation Map}
 276   {Population Density Map}
 277   {Rate of Growth Map}
 278   {Traffic Density Map}
 279   {Pollution Desity Map}
 280   {Crime Rate Map}
 281   {Land Value Map}
 282   {Fire Coverage Map}
 283   {Police Coverage Map}
 284   {Dynamic Filter Map}
 285 }
 286
 287
 288 set EditorPallets {
 289   leftframe.tools.palletres
 290   leftframe.tools.palletcom
 291   leftframe.tools.palletind
 292   leftframe.tools.palletfire
 293   leftframe.tools.palletquery
 294   leftframe.tools.palletpolice
 295   leftframe.tools.palletwire
 296   leftframe.tools.palletbulldozer
 297   leftframe.tools.palletrail
 298   leftframe.tools.palletroad
 299   leftframe.tools.palletchalk
 300   leftframe.tools.palleteraser
 301   leftframe.tools.palletstadium
 302   leftframe.tools.palletpark
 303   leftframe.tools.palletseaport
 304   leftframe.tools.palletcoal
 305   leftframe.tools.palletnuclear
 306   leftframe.tools.palletairport
 307 }
 308
 309
 310 set EditorPalletImages {
 311   res com ind fire qry pol
 312   wire dozr rail road chlk ersr
 313   stad park seap coal nuc airp
 314 }
 315
 316
 317 set EditorPalletSounds {
 318   Res Com Ind Fire Query Police
 319   Wire Bulldozer Rail Road Chalk Eraser
 320   Stadium Park Seaport Coal Nuclear Airport
 321 }
 322
 323
 324 set GraphPallets {
 325   leftframe.left.res
 326   leftframe.left.com
 327   leftframe.left.ind
 328   leftframe.right.money
 329   leftframe.right.crime
 330   leftframe.right.pollution
 331 }
 332
 333
 334 set GraphPalletImages {
 335   res com ind mony crim poll
 336 }
 337
 338
 339 set GraphYearPallets {
 340   leftframe.year.year10
 341   leftframe.year.year120
 342 }
 343
 344
 345 set GraphYearPalletImages { 10 120 }
 346
 347
 348 set ToolInfo {
 349   {     {a}     {Residential Zone}      {$100}}
 350   {     {a}     {Commercial Zone}       {$100}}
 351   {     {an}    {Industrial Zone}       {$100}}
 352   {     {a}     {Fire Station}          {$500}}
 353   {     {a}     {Query}                 {free}}
 354   {     {a}     {Police Station}        {$500}}
 355   {     {a}     {Wire}                  {$5}}
 356   {     {a}     {Bulldozer}             {$1}}
 357   {     {a}     {Rail}                  {$20}}
 358   {     {a}     {Road}                  {$10}}
 359   {     {a}     {Chalk}                 {free}}
 360   {     {an}    {Eraser}                {free}}
 361   {     {a}     {Stadium}               {$5,000}}
 362   {     {a}     {Park}                  {$20}}
 363   {     {a}     {Seaport}               {$3,000}}
 364   {     {a}     {Coal Power Plant}      {$3,000}}
 365   {     {a}     {Nuclear Power Plant}   {$5,000}}
 366   {     {an}    {Airport}               {$10,000}}
 367   {     {a}     {Network}               {$1,000}}
 368 }
 369
 370
 371 set DynamicDataNames {
 372   {Population Density}
 373   {Rate of Growth}
 374   {Traffic Density}
 375   {Pollution Density}
 376   {Crime Rate}
 377   {Land Value}
 378   {Police Coverage}
 379   {Fire Coverage}
 380 }
 381
 382 ########################################################################
 383 # Initialization
 384 ########################################################################
 385
 386
 387 wm title . {Micropolis Root}
 388
 389
 390 if {"[sim Platform]" == "msdos"} {
 391   sim DoAnimation 0
 392   set DoAnimation 0
 393   set ShapePies 0
 394 } else {
 395   sim DoAnimation 1
 396   set DoAnimation 1
 397   set ShapePies 1
 398 }
 399
 400 sprite explosion 7
 401 sprite tornado 6
 402 sprite airplane 3
 403 sprite helicopter 2
 404 sprite monster 5
 405 sprite ship 4
 406 sprite bus 8
 407 sprite train 1
 408
 409 sim ResetDynamic
 410
 411 # The next three lines have no effect on the OLPC, where we don't provide
 412 # the font in res (because it's already in the system fonts).  These lines
 413 # are for other systems that lack the font.
 414 set FontPath "[pwd]/res/dejavu-lgc"
 415 system "xset -fp $FontPath >/dev/null 2>&1"
 416 system "xset +fp $FontPath >/dev/null 2>&1"
 417
 418
 419 ########################################################################
 420 # Messages
 421 ########################################################################
 422
 423
 424 proc Message {id color title msg {props {}}} {
 425   global Messages
 426   set Messages($id) [list $color $title $msg $props]
 427 }
 428
 429
 430 Message 1 #7f7fff {DULLSVILLE, USA  1900} \
 431 {Things haven't changed much around here in the last hundred years or so and the residents are beginning to get bored.  They think Dullsville could be the next great city with the right leader.
 432
 433 It is your job to attract new growth and development, turning Dullsville into a Metropolis within 30 years.}
 434
 435 Message 2 #7f7fff {SAN FRANCISCO, CA.  1906} \
 436 {Damage from the earthquake was minor compared to that of the ensuing fires, which took days to control.  1500 people died.
 437
 438 Controlling the fires should be your initial concern.  Then clear the rubble and start rebuilding.  You have 5 years.}
 439
 440 Message 3 #7f7fff {HAMBURG, GERMANY  1944} \
 441 {Allied fire-bombing of German cities in WWII caused tremendous damage and loss of life.  People living in the inner cities were at greatest risk.
 442
 443 You must control the firestorms during the bombing and then rebuild the city after the war.  You have 5 years.}
 444
 445 Message 4 #7f7fff {BERN, SWITZERLAND  1965} \
 446 {The roads here are becoming more congested every day, and the residents are upset.  They demand that you do something about it.
 447
 448 Some have suggested a mass transit system as the answer, but this would require major rezoning in the downtown area.  You have 10 years.}
 449
 450 Message 5 #7f7fff {TOKYO, JAPAN  1957} \
 451 {A large reptilian creature has been spotted heading for Tokyo bay.  It seems to be attracted to the heavy levels of industrial pollution there.
 452
 453 Try to control the fires, then rebuild the industrial center.  You have 5 years.}
 454
 455 Message 6 #7f7fff {DETROIT, MI.  1972} \
 456 {By 1970, competition from overseas and other economic factors pushed the once "automobile capital of the world" into recession.  Plummeting land values and unemployment then increased crime in the inner-city to chronic levels.
 457
 458 You have 10 years to reduce crime and rebuild the industrial base of the city.}
 459
 460 Message 7 #7f7fff {BOSTON, MA.  2010} \
 461 {A major meltdown is about to occur at one of the new downtown nuclear reactors.  The area in the vicinity of the reactor will be severly contaminated by radiation, forcing you to restructure the city around it.
 462
 463 You have 5 years to get the situation under control.}
 464
 465 Message 8 #7f7fff {RIO DE JANEIRO, BRAZIL  2047} \
 466 {In the mid-21st century, the greenhouse effect raised global temperatures 6 degrees F.  Polar icecaps melted and raised sea levels worldwide.  Coastal areas were devastated by flood and erosion.
 467
 468 You have 10 years to turn this swamp back into a city again.}
 469
 470 Message 9 #ffa500 {Query Zone Status} \
 471 {
 472 Zone:       %s
 473 Density:    %s
 474 Value:      %s
 475 Crime:      %s
 476 Pollution:  %s
 477 Growth:     %s} \
 478 {{view {PanView $v $QueryX $QueryY}}}
 479
 480 Message 10 #ff4f4f {POLLUTION ALERT!} \
 481 {Pollution in your city has exceeded the maximum allowable amounts established by the Micropolis Pollution Agency.  You are running the risk of grave ecological consequences.
 482
 483 Either clean up your act or open a gas mask concession at city hall.} \
 484 {{view {PanView $v [sim PolMaxX] [sim PolMaxY]}}}
 485
 486 Message 11 #ff4f4f {CRIME ALERT!} \
 487 {Crime in your city is our of hand.  Angry mobs are looting and vandalizing the central city.  The president will send in the national guard soon if you cannot control the problem.} \
 488 {{view {PanView $v [sim CrimeMaxX] [sim CrimeMaxY]}}}
 489
 490 Message 12 #ff4f4f {TRAFFIC WARNING!} \
 491 {Traffic in this city is horrible.  The city gridlock is expanding.  The commuters are getting militant.
 492
 493 Either build more roads and rails or get a bulletproof limo.} \
 494 {{view {PanView $v [sim TrafMaxX] [sim TrafMaxY]}}}
 495
 496 Message 20 #ff4f4f {FIRE REPORTED!} \
 497 "A fire has been reported!" \
 498 {{view {PanView $v [sim CrashX] [sim CrashY]}}}
 499
 500 Message 21 #ff4f4f {MONSTER ATTACK!} \
 501 "A large reptilian creature has been spotted in the water.  It seems to be attracted to areas of high pollution.  There is a trail of destruction wherever it goes.  \
 502 All you can do is wait till he leaves, then rebuild from the rubble." \
 503 {{view {FollowView $v monster}}}
 504
 505 # XXX: write more text
 506 Message 22 #ff4f4f {TORNADO ALERT!} \
 507 {A tornado has been reported!  There's nothing you can do to stop it, so you'd better prepare to clean up after the disaster!} \
 508 {{view {FollowView $v tornado}}}
 509
 510 # XXX: write more text
 511 Message 23 #ff4f4f {EARTHQUAKE!} \
 512 {A major earthquake has occurred!  Put out the fires as quickly as possible, before they spread, then reconnect the power grid and rebuild the city.} \
 513 {{view {PanView $v [sim CenterX] [sim CenterY]}}}
 514
 515 # XXX: write more text
 516 Message 24 #ff4f4f {PLANE CRASH!} \
 517 {A plane has crashed!} \
 518 {{view {PanView $v [sim CrashX] [sim CrashY]}}}
 519
 520 # XXX: write more text
 521 Message 25 #ff4f4f {SHIPWRECK!} \
 522 {A ship has wrecked!} \
 523 {{view {PanView $v [sim CrashX] [sim CrashY]}}}
 524
 525 # XXX: write more text
 526 Message 26 #ff4f4f {TRAIN CRASH!} \
 527 {A train has crashed!} \
 528 {{view {PanView $v [sim CrashX] [sim CrashY]}}}
 529
 530 # XXX: write more text
 531 Message 27 #ff4f4f {HELICOPTER CRASH!} \
 532 {A helicopter has crashed!} \
 533 {{view {PanView $v [sim CrashX] [sim CrashY]}}}
 534
 535 Message 30 #ff4f4f {FIREBOMBING REPORTED!} \
 536 {Firebombs are falling!!} \
 537 {{view {PanView $v [sim CrashX] [sim CrashY]}}}
 538
 539 Message 35 #7fff7f {TOWN} \
 540 {Congratulations, your village has grown to town status.  You now have 2,000 citizens.} \
 541 {{view {PanView $v [sim CenterX] [sim CenterY]}}}
 542
 543 Message 36 #7fff7f {CITY} \
 544 {Your town has grown into a full sized city, with a current population of 10,000.  Keep up the good work!} \
 545 {{view {PanView $v [sim CenterX] [sim CenterY]}}}
 546
 547 Message 37 #7fff7f {CAPITAL} \
 548 {Your city has become a capital.  The current population here is 50,000.  Your political future looks bright.} \
 549 {{view {PanView $v [sim CenterX] [sim CenterY]}}}
 550
 551 Message 38 #7fff7f {METROPOLIS} \
 552 {Your capital city has now achieved the status of metropolis.  The current population is 100,000.  With your management skills, you should seriously consider running for governor.} \
 553 {{view {PanView $v [sim CenterX] [sim CenterY]}}}
 554
 555 Message 39 #7fff7f {MEGALOPOLIS} \
 556 {Congratulation, you have reached the highest category of urban development, the megalopolis.
 557
 558 If you manage to reach this level, send us email at micropolis@laptop.org or send us a copy of your city.  We might do something interesting with it.} \
 559 {{view {PanView $v [sim CenterX] [sim CenterY]}}}
 560
 561 Message 40 #7fff7f {MEGALINIUM} \
 562 {Congratulation, you have reached the end of time!
 563
 564 Because of the toroidal nature of the the Micropolis Space/Time Continuum, your city has wrapped back in time to 1900!} \
 565 {{view {PanView $v [sim CenterX] [sim CenterY]}}}
 566
 567 # XXX: write more text
 568 Message 41 #ff4f4f {HEAVY TRAFFIC!} \
 569 {Sky Watch One
 570 reporting heavy traffic!} \
 571 {{view {FollowView $v helicopter}}}
 572
 573 # XXX: write more text
 574 Message 42 #ff4f4f {FLOODING REPORTED!} \
 575 {Flooding has been been reported along the water's edge!} \
 576 {{view {PanView $v [sim FloodX] [sim FloodY]}}}
 577
 578 Message 43 #ff4f4f {NUCLEAR MELTDOWN!} \
 579 {A nuclear meltdown has occured at your power plant.  You are advised to avoid the area until the radioactive isotopes decay.
 580
 581 Many generations will confront this problem before it goes away, so don't hold your breath.} \
 582 {{view {PanView $v [sim MeltX] [sim MeltY]}}}
 583
 584
 585 Message 44 #ff4f4f {RIOTS!} \
 586 {The citizens are rioting in the streets, setting cars and houses on fire, and bombing government buildings and businesses!
 587
 588 All media coverage is blacked out, while the fascist pigs beat the poor citizens into submission.}
 589
 590 Message 46 #ff4f4f {NO SOUND SERVER!} \
 591 {There is no sound server running on your X11 display "%s".  You won't hear any noise unless you run a sound server, and turn the sound back on in the "Options" menu.}
 592
 593 Message 48 #7f7fff {Start a New City} \
 594 {Build your very own city from the ground up, starting with this map of uninhabited land.}
 595
 596 Message 49 #7f7fff {Restore a Saved City} \
 597 {This city was saved in the file named: %s}
 598
 599 Message 100 #7fff7f {YOU'RE A WINNER!} \
 600 {Your mayorial skill and city planning expertise have earned you the KEY TO THE CITY.  Local residents will erect monuments to your glory and name their first-born children after you.  Why not run for governor?} \
 601 {{middle {@images/key2city.xpm}}}
 602
 603 Message 200 #ff4f4f {IMPEACHMENT NOTICE!} \
 604 {The entire population of this city has finally had enough of your inept planning and incompetant management.  An angry mob -- led by your mother -- has been spotted in the vicinity of city hall.
 605
 606 You should seriously consider taking an extended vacation -- NOW.  (Or read the manual and try again.)}
 607
 608 Message 300 #ffd700 {About Micropolis} \
 609 "Micropolis Version [sim Version] Copyright (C) 2007
 610     by Electronic Arts.
 611 Based on the Original Micropolis Concept and Design
 612     by Will Wright.
 613 TCL/Tk User Interface Designed and Created
 614     by Don Hopkins, DUX Software.
 615 Ported to Linux, Optimized and Adapted for OLPC
 616     by Don Hopkins.
 617 Licensed under the GNU General Public License,
 618     version 3, with additional conditions."
 619
 620
 621 ########################################################################
 622 # Options
 623 ########################################################################
 624
 625
 626 option add *CheckButton.relief          flat
 627 option add *Dialog.cursor               top_left_arrow
 628 option add *Entry.relief                sunken
 629 option add *Frame.borderWidth           0
 630 option add *Listbox.relief              sunken
 631 option add *Scrollbar.relief            sunken
 632 option add *RadioButton.anchor          w
 633 option add *RadioButton.relief          flat
 634
 635 option add *background                  #b0b0b0
 636 option add *foreground                  #000000
 637 option add *activeBackground            #d0d0d0
 638 option add *activeForeground            #000000
 639 option add *disabledForeground          ""
 640 option add *selectBackground            #d0d0d0
 641 option add *selectForeground            #000000
 642 #option add *selector                   #ffff80
 643 option add *selector                    #bf0000
 644
 645 option add *Scrollbar.Background        #b0b0b0
 646 option add *Scrollbar.Foreground        #d0d0d0
 647 option add *Interval.Background         #b0b0b0
 648 option add *Interval.Foreground         #000000
 649 option add *Interval.activeForeground   #d0d0d0
 650 option add *Interval.sliderForeground   #b0b0b0
 651 option add *Scale.activeForeground      #d0d0d0
 652 option add *Scale.sliderForeground      #b0b0b0
 653 option add *PieMenu.activeBackground    #b0b0b0
 654
 655 option add Mwm*Micropolis.clientDecoration -maximize
 656
 657
 658 ########################################################################
 659 # Global Bindings
 660 ########################################################################
 661
 662
 663 bind all <Help> {HandleHelp %W %x %y %X %Y}
 664 bind all <Shift-ButtonPress> {HandleHelp %W %x %y %X %Y}
 665 bind all <Meta-ButtonPress> {HandleHelp %W %x %y %X %Y}
 666 bind all <Shift-Meta-ButtonPress> {HandleHelp %W %x %y %X %Y}
 667
 668
 669 ########################################################################
 670 # Utilities
 671 ########################################################################
 672
 673
 674 proc echo {args} {
 675   puts stdout $args
 676   flush stdout
 677 }
 678
 679
 680 proc Unique {} {
 681   global UniqueID
 682   set id $UniqueID
 683   incr UniqueID
 684   return $id
 685 }
 686
 687
 688 proc tkerror {err} {
 689     global errorInfo
 690     puts stderr "$errorInfo"
 691 }
 692
 693
 694 proc ident {i} {
 695   return "$i"
 696 }
 697
 698 proc NoFunction {args} {}
 699
 700
 701 proc LinkWindow {fromname to} {
 702   global WindowLinks
 703   set WindowLinks($fromname) $to
 704 }
 705
 706
 707 proc WindowLink {fromname} {
 708   global WindowLinks
 709   set to ""
 710   catch {set to $WindowLinks($fromname)}
 711   return $to
 712 }
 713
 714
 715 proc DeleteWindow {sym name win} {
 716   set head [WindowLink $win.head]
 717   LinkWindow $head.$sym {}
 718   global $name
 719   set wins [eval ident "\$$name"]
 720   set i [lsearch $wins $win]
 721   if {$i != -1} {
 722     set $name [lreplace $wins $i $i]
 723   }
 724   destroy $win
 725 }
 726
 727
 728 proc Font {win name} {
 729   global FontInfo FontCache HeadWindows
 730   set scr [winfo screen $win]
 731   set font ""
 732   catch {
 733     set font $FontCache($scr,$name)
 734   }
 735   if {"$font" == ""} {
 736     set label ""
 737     catch {
 738       set label $FontCache($scr)
 739     }
 740     if {"$label" == ""} {
 741       foreach head $HeadWindows {
 742         if {"[winfo screen $head]" == "$scr"} {
 743           set label $head.fontlabel
 744           label $label -text "X11 Sucks" -font fixed
 745           set FontCache($scr) $label
 746         }
 747       }
 748     }
 749
 750     set fonts [keylget FontInfo $name]
 751     foreach font $fonts {
 752       #echo "Configuring font $font on $label"
 753       if {[catch "$label config -font \"$font\""] == 0} {
 754         #echo "yow!"
 755         break
 756       } else {
 757         #echo "oops!"
 758         set font ""
 759       }
 760     }
 761     if {"$font" == ""} {
 762       #set font 8x16
 763       # OLCP default font
 764       set font 6x13
 765     }
 766     set FontCache($scr,$name) $font
 767   }
 768   return $font
 769 }
 770
 771
 772 proc Color {win color mono} {
 773   if {[winfo screendepth $win] == 1} {
 774     return $mono
 775   } else {
 776     return $color
 777   }
 778 }
 779
 780
 781 ########################################################################
 782 # Window Definition Functions
 783 ########################################################################
 784
 785
 786 proc MakeWindow.head {{display ":0"}} {
 787   global ResourceDir
 788   source $ResourceDir/whead.tcl
 789   return $win
 790 }
 791
 792
 793 proc MakeWindow.editor {head {display ":0"}} {
 794   global ResourceDir
 795   source $ResourceDir/weditor.tcl
 796   return $win
 797 }
 798
 799
 800 proc MakeWindow.map {head {display ":0"}} {
 801   global ResourceDir
 802   source $ResourceDir/wmap.tcl
 803   return $win
 804 }
 805
 806
 807 proc MakeWindow.graph {head {display ":0"}} {
 808   global ResourceDir
 809   source $ResourceDir/wgraph.tcl
 810   return $win
 811 }
 812
 813
 814 proc MakeWindow.budget {head {display ":0"}} {
 815   global ResourceDir
 816   source $ResourceDir/wbudget.tcl
 817   return $win
 818 }
 819
 820
 821 proc MakeWindow.evaluation {head {display ":0"}} {
 822   global ResourceDir
 823   source $ResourceDir/weval.tcl
 824   return $win
 825 }
 826
 827
 828 proc MakeWindow.splash {head {display ":0"}} {
 829   global ResourceDir
 830   source $ResourceDir/wsplash.tcl
 831   return $win
 832 }
 833
 834
 835 proc MakeWindow.scenario {head {display ":0"}} {
 836   global ResourceDir
 837   source $ResourceDir/wscen.tcl
 838   return $win
 839 }
 840
 841
 842 proc MakeWindow.file {head {display ":0"}} {
 843   global ResourceDir
 844   source $ResourceDir/wfile.tcl
 845   return $win
 846 }
 847
 848
 849 proc MakeWindow.ask {head {display ":0"}} {
 850   global ResourceDir
 851   source $ResourceDir/wask.tcl
 852   return $win
 853 }
 854
 855
 856 proc MakeWindow.player {head {display ":0"}} {
 857   global ResourceDir
 858   source $ResourceDir/wplayer.tcl
 859   return $win
 860 }
 861
 862
 863 proc MakeWindow.notice {head {display ":0"}} {
 864   global ResourceDir
 865   source $ResourceDir/wnotice.tcl
 866   return $win
 867 }
 868
 869 proc MakeWindow.help {head {display ":0"}} {
 870   global ResourceDir
 871   source $ResourceDir/whelp.tcl
 872   return $win
 873 }
 874
 875 proc MakeWindow.frob {head {display ":0"}} {
 876   global ResourceDir
 877   source $ResourceDir/wfrob.tcl
 878   return $win
 879 }
 880
 881
 882 ########################################################################
 883 # Sound Support
 884 ########################################################################
 885
 886
 887 proc UIInitializeSound {} {
 888 }
 889
 890
 891 proc UIShutDownSound {} {
 892 }
 893
 894
 895 proc UIDoSoundOn {win cmd} {
 896   global Sound SoundServers
 897   if {$Sound} {
 898     set win [WindowLink [winfo toplevel $win].head]
 899     if {[lsearch $SoundServers $win] != -1} {
 900       set cmd "send -quick -server $win Sound sound $cmd"
 901       if {[catch $cmd]} {
 902         # XXX: Lost a sound server...
 903         LostSoundServer $win
 904       }
 905     }
 906   }
 907 }
 908
 909
 910 proc UIDoSound {cmd} {
 911   global Sound SoundServers
 912   if {$Sound} {
 913     foreach win $SoundServers {
 914       set foo "send -quick -server $win Sound $cmd"
 915       if {[catch $foo]} {
 916         # XXX: Lost a sound server...
 917         LostSoundServer $win
 918       }
 919     }
 920   }
 921 }
 922
 923
 924 proc KillSoundServers {} {
 925   global SoundServers
 926   foreach win $SoundServers {
 927     set foo "send -quick -server $win Sound KillSoundServer"
 928     catch $foo
 929   }
 930   set SoundServers {}
 931 }
 932
 933
 934 proc UISetChannelVolume {win chan vol} {
 935   UIDoSoundOn $win "channel $chan -volume $vol"
 936 }
 937
 938
 939 proc EchoPlaySound {soundspec} {
 940   # Temporary workaround to tell Python Sugar app to play sound.
 941   global Sound
 942   if {$Sound} {
 943     #echo PlaySound [lindex $soundspec 0]
 944     signal ignore SIGCHLD
 945     exec res/sounds/player res/sounds/[string tolower [lindex $soundspec 0]].wav &
 946   }
 947 }
 948
 949
 950 proc UIMakeSoundOn {win chan sound {opts ""}} {
 951   # Send message to Python to play sound.
 952   EchoPlaySound $sound
 953
 954   #UIDoSoundOn $win "play $sound -replay -channel $chan $opts"
 955 }
 956
 957
 958 proc UIStartSoundOn {win chan sound {opts ""}} {
 959   # Send message to Python to play sound.
 960   EchoPlaySound $sound
 961
 962   #UIDoSoundOn $win "play $sound -replay -channel $chan -repeat 100 $opts"
 963 }
 964
 965
 966 proc UIStopSoundOn {win chan sound {opts ""}} {
 967   UIDoSoundOn $win "stop $sound"
 968 }
 969
 970
 971 proc UIMakeSound {chan sound {opts ""}} {
 972   # Send message to Python to play sound.
 973   EchoPlaySound $sound
 974
 975   #UIDoSound "sound play $sound -replay -channel $chan $opts"
 976 }
 977
 978
 979 proc UIStartSound {chan sound {opts ""}} {
 980   # Send message to Python to play sound.
 981   EchoPlaySound $sound
 982
 983   #UIDoSound "sound play $sound -channel $chan -repeat 100 $opts"
 984 }
 985
 986
 987 proc UIStopSound {chan sound {opts ""}} {
 988   UIDoSound "sound stop $sound"
 989 }
 990
 991
 992 proc SetupSoundServer {win} {
 993   AddSoundServer $win
 994 }
 995
 996
 997 proc AddSoundServer {win} {
 998   global SoundServers
 999   set i [lsearch $SoundServers $win]
1000   if {$i < 0} {
1001     set SoundServers [linsert $SoundServers 0 $win]
1002   }
1003 }
1004
1005
1006 proc LostSoundServer {win} {
1007   DeleteSoundServer $win
1008 #  UIShowPictureOn [WindowLink $win.head] 46 [winfo screen $win]
1009 }
1010
1011
1012 proc DeleteSoundServer {win} {
1013   global SoundServers
1014   set i [lsearch $SoundServers $win]
1015   if {$i >= 0} {
1016     set SoundServers [lreplace $SoundServers $i $i]
1017   }
1018 }
1019
1020
1021 proc UISoundOff {} {
1022 }
1023
1024
1025 proc MonsterSpeed {} {
1026   return [expr "[sim Rand 40] + 70"]
1027 }
1028
1029
1030 proc ExplosionPitch {} {
1031   return [expr "[sim Rand 20] + 90"]
1032 }
1033
1034
1035 proc HonkPitch {} {
1036   return [expr "[sim Rand 20] + 90"]
1037 }
1038
1039
1040 ########################################################################
1041 # Global Window Handlers
1042
1043
1044 proc WithdrawAll {} {
1045   WithdrawHeads
1046   WithdrawEditors
1047   WithdrawMaps
1048   WithdrawGraphs
1049   WithdrawBudgets
1050   WithdrawEvaluations
1051   WithdrawSplashes
1052   WithdrawScenarios
1053   WithdrawFiles
1054   WithdrawAsks
1055   WithdrawPlayers
1056   WithdrawNotices
1057   WithdrawHelps
1058   WithdrawFrobs
1059 }
1060
1061
1062 proc ShowInitial {} {
1063   ShowHeads
1064   ShowEditors
1065   ShowMaps
1066   EnableMaps
1067 }
1068
1069
1070 ########################################################################
1071 # Head Window Handlers
1072
1073
1074 proc PrepHead {head} {
1075   global State
1076   InitHeadMenus $head
1077   case $State {
1078     uninitialized {
1079     }
1080     splash {
1081       WithdrawHeadOf $head
1082       ShowSplashOf $head
1083     }
1084     scenario {
1085       after 1000 "WithdrawSplashOf $head"
1086       WithdrawHeadOf $head
1087       ShowScenarioOf $head
1088       sim UpdateMaps
1089     }
1090     play {
1091       WithdrawSplashOf $head
1092       WithdrawScenarioOf $head
1093       ShowHeadOf $head
1094       ShowEditorOf $head
1095       ShowMapOf $head
1096       EnableMaps
1097       ReShowPictureOn $head
1098       InitHead $head
1099       InitHeadMenus $head
1100     }
1101   }
1102 }
1103
1104
1105 proc ShowHeadOf {head} {
1106   wm deiconify $head
1107 }
1108
1109
1110 proc WithdrawHeadOf {head} {
1111   wm withdraw $head
1112 }
1113
1114
1115 proc ShowHeads {} {
1116   global HeadWindows
1117   foreach win $HeadWindows {
1118     ShowHeadOf $win
1119   }
1120 }
1121
1122
1123 proc WithdrawHeads {} {
1124   global HeadWindows
1125   foreach win $HeadWindows {
1126     wm withdraw $win
1127   }
1128 }
1129
1130
1131 proc DeleteHeadWindow {head} {
1132   UIQuit $head
1133 }
1134
1135
1136 proc InitHeads {} {
1137   global HeadWindows
1138   foreach win $HeadWindows {
1139     InitHead $win
1140   }
1141 }
1142
1143
1144 proc InitHead {win} {
1145   set w [WindowLink $win.text]
1146   $w configure -state normal
1147   $w delete 0.0 end
1148   $w insert end "\n"
1149   $w configure -state disabled
1150
1151   if {[sim MultiPlayerMode]} {
1152     set w [WindowLink $win.entry]
1153     $w delete 0 end
1154     global ${w}.value
1155     set ${w}.value ""
1156   }
1157
1158   sim UpdateHeads
1159   UIUpdateRunning
1160 }
1161
1162
1163 proc InitAllHeadMenus {} {
1164   global HeadWindows
1165
1166   foreach win $HeadWindows {
1167     InitHeadMenus $win
1168   }
1169 }
1170
1171
1172 proc InitHeadMenus {win} {
1173   global State
1174   set m0 [WindowLink $win.m0]
1175   set m1 [WindowLink $win.m1]
1176   set m2 [WindowLink $win.m2]
1177   set m3 [WindowLink $win.m3]
1178   set m4 [WindowLink $win.m4]
1179   set b0 [WindowLink $win.b0]
1180   set b1 [WindowLink $win.b1]
1181   set b2 [WindowLink $win.b2]
1182   set b3 [WindowLink $win.b3]
1183   set b4 [WindowLink $win.b4]
1184   case $State {
1185     uninitialized {
1186     }
1187     splash {
1188     }
1189     scenario {
1190       $m0 unpost
1191       $m1 unpost
1192       $m2 unpost
1193       $m3 unpost
1194       $m4 unpost
1195       $m0 disable 1
1196       $m0 disable 2
1197       # When in multi player mode there is an extra menu
1198       # item to add another player, before the quit item,
1199       # so compensate for it here.
1200       if {[sim MultiPlayerMode]} {
1201         $m0 disable 4
1202       } else {
1203         $m0 disable 3
1204       }
1205       $b0 config -state normal
1206       $b2 config -state disabled
1207       $b4 config -state disabled
1208     }
1209     play {
1210       $m0 enable 1
1211       $m0 enable 2
1212       # When in multi player mode there is an extra menu
1213       # item to add another player, before the quit item,
1214       # so compensate for it here.
1215       if {[sim MultiPlayerMode]} {
1216         $m0 enable 4
1217       } else {
1218         $m0 enable 3
1219       }
1220       $b0 config -state normal
1221       $b2 config -state normal
1222       $b4 config -state normal
1223     }
1224   }
1225 }
1226
1227
1228 proc UIDisaster {win cmd action} {
1229   AskQuestion [Color $win #ff0000 #ffffff] "Cause a Disaster" \
1230     "Oh no! Do you really want to $action" \
1231     "{No way!} Disaster.No {WithdrawAsks}" \
1232     "" \
1233     "{I guess so.} Disaster.Yes {WithdrawAsks ; $cmd}"
1234 }
1235
1236
1237 proc CrushHead {head} {
1238   global SubWindows VoteNames
1239
1240   foreach foo $VoteNames {
1241     global VotesFor$foo
1242     set votes [eval ident \$VotesFor$foo]
1243     set i [lsearch $votes $head]
1244     if {$i != -1} {
1245       set VotesFor$foo [lreplace $votes $i $i]
1246     }
1247   }
1248
1249   foreach foo $SubWindows {
1250     set sym [lindex $foo 0]
1251     set name [lindex $foo 1]
1252     global $name
1253     set wins [eval ident "\$$name"]
1254     foreach win $wins {
1255       if {[WindowLink $win.head] == $head} {
1256         DeleteWindow $sym $name $win
1257       }
1258     }
1259   }
1260 }
1261
1262
1263 proc ChatDown {win} {
1264   tk_butDown $win
1265 }
1266
1267
1268 proc ChatUp {win} {
1269   tk_butUp $win
1270
1271   global Chatting
1272
1273   if {$Chatting} {
1274     CloseChat
1275   } else {
1276     OpenChat
1277   }
1278 }
1279
1280
1281 proc OpenChat {} {
1282   global Chatting
1283   global ChatServer
1284   global ChatSocket
1285   global ChatConnection
1286
1287   DoSendMessage "Opening Connection to Chat Server $ChatServer socket $ChatSocket ..." status
1288
1289   set ChatConnection {}
1290   catch {
1291     set ChatConnection [connect $ChatServer $ChatSocket]
1292   }
1293
1294   if {$ChatConnection == {}} then {
1295     DoSendMessage "Sorry, I could not open a connection to chat server $ChatServer socket $ChatSocket." status
1296     set Chatting 0
1297   } else {
1298     filehandler $ChatConnection r "ReceiveChat"
1299     set Chatting 1
1300   }
1301
1302   global NickName
1303   global UserName
1304   global HostName
1305   global ServerName
1306   global RealName
1307   global ChannelName
1308   catch {
1309     puts $ChatConnection "USER $UserName $HostName $ServerName $RealName\r\n" nonewline
1310     puts $ChatConnection "NICK $NickName\r\n" nonewline
1311     puts $ChatConnection "JOIN $ChannelName\r\n" nonewline
1312     flush $ChatConnection
1313   }
1314 }
1315
1316
1317 proc ReceiveChat {mode f} {
1318 #    DoSendMessage "ReceiveChat: MODE $mode F $f"
1319     set msg ""
1320     gets $f msg
1321
1322     if {[string first {:} $msg]} {
1323         set msg ": $msg"
1324     }
1325
1326     set from [lindex $msg 0]
1327     set cmd [string tolower [lindex $msg 1]]
1328
1329     set handled 0
1330
1331     if {($cmd == "privmsg") ||
1332         ($cmd == "notice")} then {
1333       set handled 1
1334       set chan [lindex $msg 2]
1335       set i [expr "[string length $from] + 1 + [string length $cmd] + 1 + [string length $chan] + 2"]
1336       set j [expr "[string length $msg] - 2"]
1337       set line [string range $msg $i $j]
1338       set chan [string range $chan 1 [string length $chan]]
1339       set from [string range $from 1 [expr "[string length $from] - 1"]]
1340       set from [split $from {!}]
1341       set from [lindex $from 0]
1342       DoSendMessage "$from> $line"
1343     }
1344
1345     if {$handled == 0} {
1346         set msg [string range $msg \
1347                   [expr "[string length $from] + 1"] \
1348                   [expr "[string length $msg] - 2"]]
1349         DoSendMessage $msg
1350     }
1351 }
1352
1353
1354 proc SendChatMessage {msg win} {
1355     global ChatConnection ChannelName NickName
1356
1357     if {"$msg" == ""} {
1358         return
1359     }
1360
1361     if {[string range $msg 0 0] == "/"} {
1362         set cmd [string range $msg 1 [string length $msg]]
1363         DoSendMessage "$NickName> \[$cmd\]"
1364         set cmd "$cmd\r\n"
1365     } else {
1366         set cmd "PRIVMSG $ChannelName :$msg\r\n"
1367         DoSendMessage "$NickName> $msg"
1368     }
1369
1370
1371     set result 1
1372
1373     catch {
1374         puts $ChatConnection $cmd nonewline
1375         flush $ChatConnection
1376         set result 0
1377     }
1378
1379     if {$result} {
1380         DoSendMessage "IRC Broke the connection"
1381         CloseChat
1382     }
1383 }
1384
1385
1386 proc CloseChat {} {
1387   global Chatting
1388   global ChatServer
1389   global ChatSocket
1390   global ChatConnection
1391
1392   DoSendMessage "Closing Connection to Chat Server." status
1393
1394   catch {
1395     puts $ChatConnection "QUIT\r\n" nonewline
1396     flush $ChatConnection
1397     $ChatConnection close
1398   }
1399
1400   set ChatConnection {}
1401   set Chatting 0
1402 }
1403
1404
1405 proc DoEnterMessage {win var} {
1406   global Chatting
1407   global $var
1408   set msg [eval ident "\$\{$var\}"]
1409
1410   if {$Chatting} then {
1411     SendChatMessage $msg $win
1412   } else {
1413     DoSendMessage $msg
1414   }
1415   $win delete 0 end
1416 }
1417
1418
1419 proc DoEvalMessage {win var} {
1420   global $var
1421   set command [eval ident "\$\{$var\}"]
1422   $win delete 0 end
1423   DoSendMessage "Evaluating TCL: $command"
1424   catch {uplevel #0 $command} result
1425   DoSendMessage "Result: $result"
1426 }
1427
1428
1429 proc DoSendMessage {msg {tag message}} {
1430   global HeadWindows
1431   foreach win $HeadWindows {
1432     appendWithTag [WindowLink $win.text] $tag "$msg"
1433   }
1434 }
1435
1436
1437 proc UISetMessage {msg {tag status}} {
1438   global DoMessages EditorWindows HeadWindows
1439
1440   if {$DoMessages == 0} {
1441       return
1442   }
1443
1444   foreach win $EditorWindows {
1445     [WindowLink $win.message] configure -text "$msg"
1446   }
1447
1448   foreach win $HeadWindows {
1449     appendWithTag [WindowLink $win.text] $tag "$msg"
1450   }
1451 }
1452
1453
1454
1455
1456 proc appendWithTag {w tag text} {
1457     global MaxLines
1458     global ShrinkLines
1459
1460     set start [$w index end]
1461     $w configure -state normal
1462     if {$start > $MaxLines} then {
1463         $w delete 0.0 $ShrinkLines.0
1464         set start [$w index end]
1465     }
1466     $w insert end "${text}\n"
1467     $w tag add $tag $start {end - 1 char}
1468     $w configure -state disabled
1469     $w yview -pickplace {end - 1 char}
1470 }
1471
1472
1473 ########################################################################
1474 # Budget Window Handlers
1475
1476
1477 proc ShowBudgetOf {head} {
1478   set win [WindowLink $head.budget]
1479   if {$win == {}} {
1480     set win [MakeWindow.budget $head [winfo screen $head]]
1481   }
1482   wm deiconify $win
1483   wm raise $win
1484   update idletasks
1485   sim UpdateBudget
1486 }
1487
1488
1489 proc ShowBudgets {} {
1490   global HeadWindows BudgetsVisible
1491   set BudgetsVisible 1
1492   foreach win $HeadWindows {
1493     ShowBudgetOf $win
1494   }
1495 }
1496
1497
1498 proc WithdrawBudgets {} {
1499   global BudgetWindows BudgetsVisible
1500   foreach win $BudgetWindows {
1501     wm withdraw $win
1502   }
1503   StopBudgetTimer
1504   set BudgetsVisible 0
1505 }
1506
1507
1508 proc BudgetContinue {{win ""}} {
1509   global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1510   set OldBudget 0
1511   if {([sim RoadFund] != $BudgetRoadFund) ||
1512       ([sim FireFund] != $BudgetFireFund) ||
1513       ([sim PoliceFund] != $BudgetPoliceFund) ||
1514       ([sim TaxRate] != $BudgetTaxRate)} {
1515     UISetMessage "The budget was changed."
1516   } else {
1517     UISetMessage "The budget wasn't changed."
1518   }
1519   WithdrawBudgets
1520   sim Resume
1521   MakeRunningSound
1522 }
1523
1524
1525 proc BudgetReset {{win ""}} {
1526   global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1527   if {([sim RoadFund] != $BudgetRoadFund) ||
1528       ([sim FireFund] != $BudgetFireFund) ||
1529       ([sim PoliceFund] != $BudgetPoliceFund) ||
1530       ([sim TaxRate] != $BudgetTaxRate)} {
1531     UISetMessage "The budget was reset."
1532     if {[sim Players] > 1} {
1533       UIMakeSound edit Sorry
1534     }
1535   } else {
1536     UISetMessage "The budget was reset."
1537   }
1538   sim RoadFund $BudgetRoadFund
1539   sim FireFund $BudgetFireFund
1540   sim PoliceFund $BudgetPoliceFund
1541   sim TaxRate $BudgetTaxRate
1542   set OldBudget 0
1543   ChangeBudget
1544 }
1545
1546
1547 proc BudgetCancel {{win ""}} {
1548   BudgetReset
1549   WithdrawBudgets
1550   sim Resume
1551   MakeRunningSound
1552 }
1553
1554
1555 proc SetTaxRate {rate} {
1556   sim TaxRate $rate
1557 }
1558
1559
1560 proc BudgetSetTaxRate {rate} {
1561   SetTaxRate $rate
1562   ChangeBudget
1563 }
1564
1565
1566 proc BudgetSetRoadFund {percent} {
1567   sim RoadFund $percent
1568   ChangeBudget
1569 }
1570
1571
1572 proc BudgetSetFireFund {percent} {
1573   sim FireFund $percent
1574   ChangeBudget
1575 }
1576
1577
1578 proc BudgetSetPoliceFund {percent} {
1579   sim PoliceFund $percent
1580   ChangeBudget
1581 }
1582
1583
1584 proc UIShowBudgetAndWait {} {
1585   global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1586   if {$OldBudget == 0} {
1587     set BudgetRoadFund [sim RoadFund]
1588     set BudgetFireFund [sim FireFund]
1589     set BudgetPoliceFund [sim PoliceFund]
1590     set BudgetTaxRate [sim TaxRate]
1591     set OldBudget 1
1592   }
1593   ShowBudgets
1594   UISetMessage "Pausing to set the budget ..."
1595   sim Pause
1596   MakeRunningSound
1597   StartBudgetTimer
1598   InitVotesForBudget
1599   sim UpdateBudget
1600   sim UpdateBudgetWindow
1601 }
1602
1603
1604 proc ToggleBudgetTimer {} {
1605   global BudgetTimerActive
1606   if {$BudgetTimerActive} {
1607     StopBudgetTimer
1608   } else {
1609     StartBudgetTimer
1610   }
1611 }
1612
1613
1614 proc StopBudgetTimer {} {
1615   global BudgetTimerActive
1616   set BudgetTimerActive 0
1617   UpdateBudgetTimer
1618 }
1619
1620
1621 proc StartBudgetTimer {} {
1622   global BudgetTimerActive BudgetTimer BudgetTimeout
1623   set me [Unique]
1624   set BudgetTimerActive $me
1625   set BudgetTimer $BudgetTimeout
1626   UpdateBudgetTimer
1627   after 1000 TickBudgetTimer $me
1628 }
1629
1630
1631 proc RestartBudgetTimer {} {
1632   global BudgetTimerActive
1633   if {$BudgetTimerActive} {
1634     StopBudgetTimer
1635     StartBudgetTimer
1636   }
1637 }
1638
1639
1640 proc UpdateBudgetTimer {} {
1641   global BudgetWindows BudgetTimerActive BudgetTimer
1642   if {$BudgetTimerActive} {
1643     set text [format "Auto Cancel In %d Seconds (click to disable)" $BudgetTimer]
1644   } else {
1645     set text [format "Enable Auto Cancel (currently disabled)"]
1646   }
1647   foreach win $BudgetWindows {
1648     set t [WindowLink $win.timer]
1649     $t config -text "$text"
1650   }
1651 }
1652
1653
1654 proc TickBudgetTimer {me} {
1655   global BudgetTimerActive BudgetTimer BudgetTimeout
1656   if {$BudgetTimerActive == $me} {
1657     incr BudgetTimer -1
1658     if {$BudgetTimer < 0} {
1659       StopBudgetTimer
1660       UpdateBudgetTimer
1661       FireBudgetTimer
1662     } else {
1663       UpdateBudgetTimer
1664       after 1000 TickBudgetTimer $me
1665     }
1666   }
1667 }
1668
1669
1670 proc FireBudgetTimer {} {
1671   BudgetCancel
1672 }
1673
1674
1675 proc funds {n} {
1676   sim Funds $n
1677 }
1678
1679
1680 proc ToggleAutoBudget {} {
1681   global AutoBudget
1682   if {$AutoBudget} {
1683       #echo "ToggleAutoBudget found on, clearing"
1684       sim AutoBudget 0
1685   } else {
1686       #echo "ToggleAutoBudget found off, setting"
1687       sim AutoBudget 1
1688   }
1689 }
1690
1691
1692 proc UIUpdateBudget {} {
1693   UpdateAutoBudget
1694 }
1695
1696
1697 proc UpdateAutoBudget {} {
1698   global BudgetWindows AutoBudget
1699   if {[sim AutoBudget]} {
1700     set text "Disable Auto Budget (currently enabled)"
1701   } else {
1702     set text "Enable Auto Budget (currently disabled)"
1703   }
1704   #echo "UpdateAutoBudget $AutoBudget $text"
1705   foreach win $BudgetWindows {
1706     set t [WindowLink $win.autobudget]
1707     $t config -text "$text"
1708   }
1709 }
1710
1711
1712 proc UISetBudget {cashflow previous current collected taxrate} {
1713   global BudgetWindows BudgetsVisible
1714
1715   #echo "UISetBudgetValues $taxrate $BudgetsVisible"
1716
1717   if {$BudgetsVisible} {
1718
1719     foreach win $BudgetWindows {
1720       set w [WindowLink $win.cashflow]
1721       set old [lindex [$w configure -text] 4]
1722       if {$old != $cashflow} {
1723         $w configure -text $cashflow
1724       }
1725       set w [WindowLink $win.previous]
1726       set old [lindex [$w configure -text] 4]
1727       if {$old != $previous} {
1728         $w configure -text $previous
1729       }
1730       set w [WindowLink $win.current]
1731       set old [lindex [$w configure -text] 4]
1732       if {$old != $current} {
1733         $w configure -text $current
1734       }
1735       set w [WindowLink $win.collected]
1736       set old [lindex [$w configure -text] 4]
1737       if {$old != $collected} {
1738         $w configure -text $collected
1739       }
1740
1741       set w [WindowLink $win.taxrate]
1742       set old [$w get]
1743       if {$old != $taxrate} {
1744         $w set $taxrate
1745       }
1746
1747       set w [WindowLink $win.taxlabel]
1748       set old [lindex [$w configure -text] 4]
1749       set new "$taxrate%"
1750       if {$old != $new} {
1751         $w configure -text $new
1752       }
1753     }
1754   }
1755
1756   global HeadWindows
1757   foreach win $HeadWindows {
1758
1759     set w [WindowLink $win.taxrate]
1760     set old [$w get]
1761     if {$old != $taxrate} {
1762       # FIXME: this might not work if the slider is disabled in multi player mode.
1763       $w set $taxrate
1764     }
1765
1766     set w [WindowLink $win.taxlabel]
1767     set old [lindex [$w configure -text] 4]
1768     set new "Tax Rate: $taxrate%"
1769     if {$old != $new} {
1770       $w configure -text $new
1771     }
1772   }
1773 }
1774
1775
1776 proc UISetBudgetValues {roadgot roadwant roadpercent policegot policewant policepercent firegot firewant firepercent} {
1777   global BudgetWindows BudgetsVisible
1778
1779   if {$BudgetsVisible == 0} {
1780       return;
1781   }
1782
1783   foreach win $BudgetWindows {
1784     set w [WindowLink $win.fire].request
1785     set old [lindex [$w configure -text] 4]
1786     set new "$firepercent% of $firewant = $firegot"
1787     if {$old != $new} {
1788       $w configure -text $new
1789     }
1790     set w [WindowLink $win.fire].fund
1791     set old [$w get]
1792     if {$old != $firepercent} {
1793       $w set $firepercent
1794     }
1795
1796     set w [WindowLink $win.police].request
1797     set old [lindex [$w configure -text] 4]
1798     set new "$policepercent% of $policewant = $policegot"
1799     if {$old != $new} {
1800       $w configure -text $new
1801     }
1802     set w [WindowLink $win.police].fund
1803     set old [$w get]
1804     if {$old != $policepercent} {
1805       $w set $policepercent
1806     }
1807
1808     set w [WindowLink $win.road].request
1809     set old [lindex [$w configure -text] 4]
1810     set new "$roadpercent% of $roadwant = $roadgot"
1811     if {$old != $new} {
1812       $w configure -text $new
1813     }
1814     set w [WindowLink $win.road].fund
1815     set old [$w get]
1816     if {$old != $roadpercent} {
1817       $w set $roadpercent
1818     }
1819   }
1820 }
1821
1822
1823 proc ChangeBudget {} {
1824   global VotesForBudget
1825   if {"$VotesForBudget" != ""} {
1826     InitVotesForBudget
1827   }
1828   RestartBudgetTimer
1829 }
1830
1831
1832 proc InitVotesForBudget {} {
1833   global VotesForBudget BudgetWindows
1834   set VotesForBudget {}
1835   foreach win $BudgetWindows {
1836     [WindowLink $win.vote] config -relief raised
1837   }
1838   UpdateVotesForBudget
1839 }
1840
1841
1842 proc UpdateVotesForBudget {} {
1843   global BudgetWindows
1844   UpdateVotesFor Budget $BudgetWindows
1845 }
1846
1847
1848 proc UpdateTaxRateSliders {} {
1849   global HeadWindows
1850   set players [sim Players]
1851   foreach win $HeadWindows {
1852     set slider [WindowLink $win.taxrate]
1853     #echo "UpdateTaxRateSliders players $players win $win slider $slider"
1854     if {$players == 1} {
1855       $slider configure -state normal
1856     } else {
1857       $slider configure -state disabled
1858     }
1859   }
1860 }
1861
1862
1863 ########################################################################
1864 # Evaluation Window Handlers
1865
1866
1867 proc ToggleEvaluationOf {head} {
1868   global State
1869   if {"$State" != "play"} {
1870     return
1871   }
1872
1873   set mapped 0
1874   set win [WindowLink $head.evaluation]
1875   if {$win != ""} {
1876     set mapped [winfo ismapped $win]
1877   }
1878
1879   if {$mapped} {
1880     WithdrawEvaluationOf $head
1881   } else {
1882     ShowEvaluationOf $head
1883   }
1884
1885 }
1886
1887
1888 proc WithdrawEvaluationOf {head} {
1889   set win [WindowLink $head.evaluation]
1890   if {"$win" != ""} {
1891     pack unpack $win
1892   }
1893 }
1894
1895
1896 proc ShowEvaluationOf {head} {
1897   set win [WindowLink $head.evaluation]
1898   if {$win == {}} {
1899     set win [MakeWindow.evaluation $head [winfo screen $head]]
1900   }
1901   #wm raise $win
1902   #wm deiconify $win
1903   set parent [WindowLink $win.parent]
1904   #pack append [WindowLink $head.col2]\
1905   #  $parent {top frame nw fill}
1906   pack append $parent\
1907     $win {top frame nw fillx}
1908   update idletasks
1909   sim UpdateEvaluation
1910 }
1911
1912
1913 proc WithdrawEvaluations {} {
1914   global EvaluationWindows EvaluationsVisible
1915   foreach win $EvaluationWindows {
1916     #wm withdraw $win
1917     #set parent [WindowLink $win.parent]
1918     #pack unpack $parent
1919     pack unpack $win
1920   }
1921   set EvaluationsVisible 0
1922 }
1923
1924
1925 proc EvaluationVisible {w v} {
1926     global EvaluationsVisible
1927     global [set var $w.visible]
1928
1929     set $var $v
1930
1931     if ($v) {
1932         set EvaluationsVisible [expr "$EvaluationsVisible + 1"]
1933     } else {
1934         set EvaluationsVisible [expr "$EvaluationsVisible - 1"]
1935     }
1936 }
1937
1938
1939 proc UISetEvaluation {changed score ps0 ps1 ps2 ps3 pv0 pv1 pv2 pv3 pop delta assessed cityclass citylevel goodyes goodno title} {
1940   global EvaluationWindows EvaluationsVisible CurrentDate
1941
1942   set class [string tolower $cityclass]
1943   UISetMessage "$CurrentDate: Score $score, $class population $pop."
1944
1945   if {$EvaluationsVisible} {
1946
1947     foreach win $EvaluationWindows {
1948
1949       global [set var $win.visible]
1950       set visible [eval ident "\$\{$var\}"]
1951
1952       if {$visible} {
1953
1954         # TODO: set evaluation window and icon title
1955         #wm title $win "$title"
1956         #wm iconname $win "$title"
1957
1958         set w [WindowLink $win.goodjob]
1959         set old [lindex [$w configure -text] 4]
1960         set new "$goodyes\n$goodno"
1961         if {$old != $new} {
1962           $w configure -text $new
1963         }
1964
1965         set w [WindowLink $win.problemnames]
1966         set old [lindex [$w configure -text] 4]
1967         set new "$ps0\n$ps1\n$ps2\n$ps3"
1968         if {$old != $new} {
1969           $w configure -text $new
1970         }
1971
1972         set w [WindowLink $win.problempercents]
1973         set old [lindex [$w configure -text] 4]
1974         set new "$pv0\n$pv1\n$pv2\n$pv3"
1975         if {$old != $new} {
1976           $w configure -text $new
1977         }
1978
1979         set w [WindowLink $win.stats]
1980         set old [lindex [$w configure -text] 4]
1981         set new "$pop\n$delta\n\n$assessed\n$cityclass\n$citylevel"
1982         if {$old != $new} {
1983           $w configure -text $new
1984         }
1985
1986         set w [WindowLink $win.score]
1987         set old [lindex [$w configure -text] 4]
1988         set new "$score\n$changed"
1989         if {$old != $new} {
1990           $w configure -text $new
1991         }
1992       }
1993     }
1994   }
1995 }
1996
1997
1998 ########################################################################
1999 # File Window Handlers
2000
2001
2002 proc ShowFileOf {head} {
2003   set win [WindowLink $head.file]
2004   if {$win == {}} {
2005     set win [MakeWindow.file $head [winfo screen $head]]
2006   }
2007   wm deiconify $win
2008   wm raise $win
2009   return $win
2010 }
2011
2012
2013 proc ShowFiles {} {
2014   global HeadWindows
2015   foreach win $HeadWindows {
2016     ShowFileOf $win
2017   }
2018 }
2019
2020
2021 proc WithdrawFiles {} {
2022   global FileWindows
2023   foreach win $FileWindows {
2024     wm withdraw $win
2025   }
2026 }
2027
2028
2029 proc DoFileDialog {win Message Path Pattern FileName ActionOk ActionCancel} {
2030   ShowFileDialog $win "$Path" "$Pattern"
2031   $win.message1 configure -text "$Message"
2032   $win.path.path delete 0 end
2033   $win.path.path insert 0 $Path
2034   $win.file.file delete 0 end
2035   $win.file.file insert 0 "$FileName"
2036   $win.frame1.ok config -command "
2037       $ActionOk \[$win.file.file get\] \[$win.path.path get\]
2038       wm withdraw $win"
2039   $win.frame1.rescan config -command "
2040       ShowFileDialog $win \[$win.path.path get\] $Pattern"
2041   $win.frame1.cancel config -command "
2042       $ActionCancel
2043       wm withdraw $win"
2044   bind $win.files.files "<Double-Button-1>" "\
2045     FileSelectDouble $win %W %y $Pattern \"
2046         $ActionOk \[$win.file.file get\] \[$win.path.path get\]\""
2047   bind $win.path.path <Return> "
2048     ShowFileDialog $win \[$win.path.path get\] $Pattern
2049     $win.file.file cursor 0
2050     focus $win.file.file"
2051   bind $win.file.file <Return> "\
2052     $ActionOk \[$win.file.file get\] \[$win.path.path get]
2053     wm withdraw $win"
2054 }
2055
2056
2057 proc BindSelectOne {win Y} {
2058   set Nearest [$win nearest $Y]
2059   if {$Nearest >= 0} {
2060     $win select from $Nearest
2061     $win select to $Nearest
2062   }
2063 }
2064
2065
2066 proc FileSelect {win widget Y} {
2067   BindSelectOne $widget $Y
2068   set Nearest [$widget nearest $Y]
2069   if {$Nearest >= 0} {
2070     set Path [$win.path.path get]
2071     set TmpEntry [$widget get $Nearest]
2072     if {[string compare "/" [string index $TmpEntry \
2073           [expr [string length $TmpEntry]-1]]] == 0 || \
2074         [string compare "@" [string index $TmpEntry \
2075           [expr [string length $TmpEntry]-1]]] == 0} {
2076       # handle directories, and symbolic links to directories
2077       set FileName [string range $TmpEntry 0 \
2078             [expr [string length $TmpEntry]-2]]
2079       # whoops / or @ is part of the name
2080       if {[MiscIsDir $Path/$FileName] != 1} {
2081         set FileName $TmpEntry
2082       }
2083     } {
2084       if {[string compare "*" [string index $TmpEntry \
2085             [expr [string length $TmpEntry]-1]]] == 0} {
2086         # handle executable filenames
2087         set FileName [string range $TmpEntry 0 \
2088               [expr [string length $TmpEntry]-2]]
2089         # whoops * is part of the name
2090         if {[file executable $Path/$FileName] != 1} {
2091           set FileName $TmpEntry
2092         }
2093       } {
2094         # a ordinary filename
2095         set FileName $TmpEntry
2096       }
2097     }
2098     # enter the selected filename into the filename field
2099     if {[MiscIsDir $Path/$FileName] != 1} {
2100       $win.file.file delete 0 end
2101       $win.file.file insert 0 $FileName
2102     }
2103   }
2104 }
2105
2106
2107 proc FileSelectDouble {win widget Y Pattern Action} {
2108   BindSelectOne $widget $Y
2109   set Nearest [$widget nearest $Y]
2110   if {$Nearest >= 0} {
2111     set Path [$win.path.path get]
2112     set TmpEntry [$widget get $Nearest]
2113     if {[string compare $TmpEntry "../"] == 0} {
2114       # go up one directory
2115       set TmpEntry \
2116         [string trimright [string trimright [string trim $Path] /] @]
2117       if {[string length $TmpEntry] <= 0} {
2118         return
2119       }
2120       set Path [file dirname $TmpEntry]
2121       $win.path.path delete 0 end
2122       $win.path.path insert 0 $Path
2123       ShowFileDialog $win $Path $Pattern
2124     } {
2125       if {[string compare "/" [string index $TmpEntry \
2126             [expr [string length $TmpEntry]-1]]] == 0 || \
2127           [string compare "@" [string index $TmpEntry \
2128             [expr [string length $TmpEntry]-1]]] == 0} {
2129         # handle directorys, and symbolic links to directorys
2130         set FileName [string range $TmpEntry 0 \
2131               [expr [string length $TmpEntry]-2]]
2132         # whoops / or @ is part of the name
2133         if {[MiscIsDir $Path/$FileName] != 1} {
2134           set FileName $TmpEntry
2135         }
2136       } {
2137         if {[string compare "*" [string index $TmpEntry \
2138               [expr [string length $TmpEntry]-1]]] == 0} {
2139           # handle executable filenames
2140           set FileName [string range $TmpEntry 0 \
2141                 [expr [string length $TmpEntry]-2]]
2142           # whoops * is part of the name
2143           if {[file executable $Path/$FileName] != 1} {
2144             set FileName $TmpEntry
2145           }
2146         } {
2147           # a ordinary filename
2148           set FileName $TmpEntry
2149         }
2150       }
2151       # change directory
2152       if {[MiscIsDir $Path/$FileName] == 1} {
2153         if {[string compare "/" [string index $Path \
2154               [expr [string length $Path]-1]]] == 0} {
2155            append Path $FileName
2156         } {
2157           append Path / $FileName
2158         }
2159         $win.path.path delete 0 end
2160         $win.path.path insert 0 $Path
2161         ShowFileDialog $win $Path $Pattern
2162       } {
2163         # enter the selected filename into the filename field
2164         $win.file.file delete 0 end
2165         $win.file.file insert 0 "$FileName"
2166         if {[string length $Action] > 0} {
2167           eval $Action
2168         }
2169         wm withdraw $win
2170       }
2171     }
2172   }
2173 }
2174
2175
2176 proc NameComplete {win Type} {
2177
2178   set NewFile ""
2179   set Matched ""
2180
2181   if {[string compare $Type path] == 0} {
2182     set DirName [file dirname [$win.path.path get]]
2183     set FileName [file tail [$win.path.path get]]
2184   } {
2185     set DirName [file dirname [$win.path.path get]/]
2186     set FileName [file tail [$win.file.file get]]
2187   }
2188
2189   set FoundCounter 0
2190   if {[MiscIsDir $DirName] == 1} {
2191     catch "exec ls $DirName/" Result
2192     set Counter 0
2193     set ListLength [llength $Result]
2194     # go through list
2195     while {$Counter < $ListLength} {
2196       if {[string length $FileName] == 0} {
2197         if {$FoundCounter == 0} {
2198           set NewFile [lindex $Result $Counter]
2199         } {
2200           set Counter1 0
2201           set TmpFile1 $NewFile
2202           set TmpFile2 [lindex $Result $Counter]
2203           set Length1 [string length $TmpFile1]
2204           set Length2 [string length $TmpFile2]
2205           set NewFile ""
2206           if {$Length1 > $Length2} {
2207             set Length1 $Length2
2208           }
2209           while {$Counter1 < $Length1} {
2210             if {[string compare [string index $TmpFile1 $Counter1] \
2211                   [string index $TmpFile2 $Counter1]] == 0} {
2212               append NewFile [string index $TmpFile1 $Counter1]
2213             } {
2214               break
2215             }
2216             incr Counter1 1
2217           }
2218         }
2219         incr FoundCounter 1
2220       } {
2221         if {[regexp "^$FileName" [lindex $Result $Counter] \
2222               Matched] == 1} {
2223           if {$FoundCounter == 0} {
2224             set NewFile [lindex $Result $Counter]
2225           } {
2226             set Counter1 0
2227             set TmpFile1 $NewFile
2228             set TmpFile2 [lindex $Result $Counter]
2229             set Length1 [string length $TmpFile1]
2230             set Length2 [string length $TmpFile2]
2231             set NewFile ""
2232             if {$Length1 > $Length2} {
2233               set Length1 $Length2
2234             }
2235             while {$Counter1 < $Length1} {
2236               if {[string compare [string index $TmpFile1 $Counter1] \
2237                     [string index $TmpFile2 $Counter1]] == 0} {
2238                 append NewFile [string index $TmpFile1 $Counter1]
2239               } {
2240                 break
2241               }
2242               incr Counter1 1
2243             }
2244           }
2245           incr FoundCounter 1
2246         }
2247       }
2248       incr Counter 1
2249     }
2250   }
2251
2252   if {$FoundCounter == 1} {
2253     if {[MiscIsDir $DirName/$NewFile] == 1} {
2254       if {[string compare $DirName "/"] == 0} {
2255         $win.path.path delete 0 end
2256         $win.path.path insert 0 "/[string trim [string trim $NewFile /] @]/"
2257       } {
2258         $win.path.path delete 0 end
2259         $win.path.path insert 0 "[string trimright $DirName /]/[string trim [string trim $NewFile /] @]/"
2260       }
2261     } {
2262       $win.path.path delete 0 end
2263       $win.path.path insert 0 \
2264         "[string trim [string trimright $DirName /] @]/"
2265       $win.file.file delete 0 end
2266       $win.file.file insert 0 "$NewFile"
2267     }
2268   } {
2269     if {[MiscIsDir $DirName/$NewFile] == 1 ||
2270         [string compare $Type path] == 0} {
2271       $win.path.path delete 0 end
2272       $win.path.path insert 0 \
2273         "[string trimright $DirName /]/[string trim [string trim $NewFile /] @]"
2274     } {
2275       $win.path.path delete 0 end
2276       $win.path.path insert 0 "$DirName"
2277       if {[string length $NewFile] > 0} {
2278         $win.file.file delete 0 end
2279         $win.file.file insert 0 "$NewFile"
2280       }
2281     }
2282   }
2283 }
2284
2285
2286 proc ShowFileDialog {win Path Pattern} {
2287   busy $win {
2288     set Path [lindex [split $Path] 0]
2289     if {[$win.files.files size] > 0} {
2290       $win.files.files delete 0 end
2291     }
2292     # read directory
2293     if {[catch "exec ls -F $Path" Result]} {
2294       set ElementList {}
2295     }
2296     if {[string match $Result "* not found"]} {
2297       set ElementList {}
2298     }
2299     set ElementList [lsort $Result]
2300
2301     # insert ..
2302     if {[string compare $Path "/"]} {
2303       $win.files.files insert end "../"
2304     }
2305
2306     # walk through list
2307     foreach Counter $ElementList {
2308       # insert filename
2309       if {[string match $Pattern $Counter] == 1} {
2310         if {[string compare $Counter "../"] &&
2311             [string compare $Counter "./"]} {
2312           $win.files.files insert end $Counter
2313         }
2314       } else {
2315         set fn $Path/[string trim [string trim [string trim $Counter /] @] *]
2316         if {[MiscIsDir $fn]} {
2317           $win.files.files insert end $Counter
2318         }
2319       }
2320     }
2321   }
2322 }
2323
2324
2325 proc MiscIsDir {PathName} {
2326
2327   if {[file isdirectory $PathName] == 1} {
2328     return 1
2329   } {
2330     catch "file type $PathName" Type
2331     if {[string compare $Type link] == 0} {
2332       set LinkName [file readlink $PathName]
2333       catch "file type $LinkName" Type
2334       while {[string compare $Type link] == 0} {
2335         set LinkName [file readlink $LinkName]
2336       }
2337       return [file isdirectory $LinkName]
2338     }
2339   }
2340   return 0
2341 }
2342
2343
2344 proc busy {win cmds} {
2345     set busy {}
2346     set list [winfo children $win]
2347     set busy $list
2348     while {$list != ""} {
2349         set next {}
2350         foreach w $list {
2351             set class [winfo class $w]
2352             set cursor [lindex [$w config -cursor] 4]
2353             if {[winfo toplevel $w] == $w} {
2354                 lappend busy [list $w $cursor]
2355             }
2356             set next [concat $next [winfo children $w]]
2357         }
2358         set list $next
2359     }
2360
2361     foreach w $busy {
2362         catch {[lindex $w 0] config -cursor watch}
2363     }
2364
2365     update idletasks
2366
2367     set error [catch {uplevel eval [list $cmds]} result]
2368
2369     foreach w $busy {
2370         catch {[lindex $w 0] config -cursor [lindex $w 1]}
2371     }
2372
2373     if $error {
2374         error $result
2375     } else {
2376         return $result
2377     }
2378 }
2379
2380
2381 ########################################################################
2382 # Editor Window Handlers
2383
2384 proc ShowEditorOf {head} {
2385   global EditorWindows
2386   set found 0
2387   foreach win $EditorWindows {
2388     if {[WindowLink $win.head] == $head} {
2389       set parent [WindowLink $win.parent]
2390       #pack append [WindowLink $head.col2]\
2391       #  $parent {top frame nw expand fill}
2392       pack append $parent\
2393         $win {top frame nw expand fill}
2394       set found 1
2395     }
2396   }
2397   if {$found == 0} {
2398     NewEditorOf $head
2399   } else {
2400     update idletasks
2401     sim UpdateEditors
2402     sim UpdateMaps
2403   }
2404 }
2405
2406
2407 proc NewEditorOf {head} {
2408   set win [MakeWindow.editor $head [winfo screen $head]]
2409   #wm deiconify $win
2410   set parent [WindowLink $win.parent]
2411   pack append $parent\
2412     $win {top frame nw expand fill}
2413   update idletasks
2414   sim UpdateEditors
2415   sim UpdateMaps
2416 }
2417
2418
2419 proc ShowEditors {} {
2420   global HeadWindows
2421   foreach win $HeadWindows {
2422     ShowEditorOf $win
2423   }
2424 }
2425
2426
2427 proc WithdrawEditors {} {
2428   global EditorWindows
2429   foreach win $EditorWindows {
2430     #set parent [WindowLink $win.parent]
2431     #pack unpack $parent
2432     pack unpack $win
2433   }
2434 }
2435
2436
2437 proc InitEditors {} {
2438   global EditorWindows
2439   foreach win $EditorWindows {
2440     InitEditor $win
2441   }
2442 }
2443
2444
2445 proc InitEditor {win} {
2446   set e [WindowLink $win.view]
2447   UISetToolState $win 7
2448   $e ToolState 7
2449   set size [$e size]
2450   $e Pan 960 800
2451   $e AutoGoing 0
2452   global $e.TrackState
2453   set $e.TrackState {}
2454 }
2455
2456
2457 proc SetEditorAutoGoto {win val} {
2458   global AutoGoto.$win
2459   set AutoGoto.$win $val
2460   set e [WindowLink $win.view]
2461   $e AutoGoto $val
2462 }
2463
2464
2465 proc SetEditorControls {win val} {
2466   global Controls.$win
2467   set Controls.$win $val
2468   if {$val} {
2469     pack append $win $win.leftframe {left frame center filly}
2470   } else {
2471     pack unpack $win.leftframe
2472   }
2473 }
2474
2475
2476 proc SetEditorOverlay {win val} {
2477   global Overlay.$win
2478   set Overlay.$win $val
2479   set e [WindowLink $win.view]
2480   $e ShowOverlay $val
2481 }
2482
2483
2484 proc SetEditorDynamicFilter {win val} {
2485   global DynamicFilter.$win
2486   set DynamicFilter.$win $val
2487   set e [WindowLink $win.view]
2488   $e DynamicFilter $val
2489   if {$val == 1} then {
2490     ShowFrobOf [WindowLink $win.head]
2491   }
2492 }
2493
2494
2495 proc SetEditorSkip {win val} {
2496   set e [WindowLink $win.view]
2497   $e Skip $val
2498 }
2499
2500
2501 proc EditorToolDown {mod w x y} {
2502   global [set var $w.TrackState]
2503
2504   $w ToolMode 1
2505
2506   case [$w ToolState] in \
2507     7 { # bulldozer
2508       UIMakeSoundOn $w edit Rumble "-repeat 4"
2509     } \
2510     10 { # chalk
2511       StartChalk $w
2512     }
2513
2514   case $mod in \
2515     constrain {
2516       set $var [list constrain_start $x $y]
2517       $w ToolConstrain $x $y
2518     } \
2519     default {
2520       set $var none
2521     }
2522   EditorTool ToolDown $w $x $y
2523   sim NeedRest 5
2524 }
2525
2526
2527 proc EditorToolDrag {w x y} {
2528   EditorTool ToolDrag $w $x $y
2529   sim NeedRest 5
2530 }
2531
2532
2533 proc EditorToolUp {w x y} {
2534   global [set var $w.TrackState]
2535   $w ToolMode 0
2536
2537   case [$w ToolState] in \
2538     7 { # bulldozer
2539      UIStopSoundOn $w edit 1
2540     } \
2541     10 { # chalk
2542       StopChalk $w
2543     }
2544
2545   EditorTool ToolUp $w $x $y
2546   set $var {}
2547   $w ToolConstrain -1 -1
2548   sim UpdateMaps
2549   sim UpdateEditors
2550   sim NeedRest 5
2551 }
2552
2553
2554 proc EditorTool {action w x y} {
2555   global [set var $w.TrackState]
2556   set state [eval ident "\$\{$var\}"]
2557   case [lindex $state 0] in \
2558     constrain_start {
2559       set x0 [lindex $state 1]
2560       set y0 [lindex $state 2]
2561       set dx [expr "$x - $x0"]
2562       set dy [expr "$y - $y0"]
2563       if [expr "($dx > 16) || ($dx < -16)"] then {
2564         $w ToolConstrain -1 $y0
2565         set $var none
2566       } else {
2567         if [expr "($dy > 16) || ($dy < -16)"] then {
2568           $w ToolConstrain $x0 -1
2569           set $var none
2570         }
2571       }
2572     }
2573   $w $action $x $y
2574 }
2575
2576
2577 proc StartChalk {w} {
2578   sim CollapseMotion 0
2579 }
2580
2581
2582 proc StopChalk {w} {
2583   sim CollapseMotion 1
2584 }
2585
2586
2587 proc EditorPanDown {mod w x y} {
2588   global [set var $w.TrackState]
2589   $w ToolMode -1
2590   case $mod in \
2591     constrain {
2592       set $var [list constrain_start $x $y]
2593       $w ToolConstrain $x $y
2594     } \
2595     default {
2596       set $var none
2597     }
2598   EditorTool PanStart $w $x $y
2599 }
2600
2601
2602 proc EditorPanDrag {w x y} {
2603   EditorTool PanTo $w $x $y
2604 }
2605
2606
2607 proc EditorPanUp {w x y} {
2608   $w AutoGoing 0
2609   $w ToolMode 0
2610   EditorTool PanTo $w $x $y
2611   $w ToolConstrain -1 -1
2612   sim UpdateMaps
2613   sim UpdateEditors
2614 }
2615
2616
2617 proc EditorKeyDown {w k} {
2618   $w KeyDown $k
2619 }
2620
2621
2622 proc EditorKeyUp {w k} {
2623   $w KeyUp $k
2624 }
2625
2626
2627 proc BindEditorButtons {win} {
2628   set w [WindowLink $win.top]
2629
2630   bind $win <1> "CancelPie $win ; EditorToolDown none %W %x %y"
2631   bind $win <B1-Motion> {EditorToolDrag %W %x %y}
2632   bind $win <ButtonRelease-1> {EditorToolUp %W %x %y}
2633
2634   bind $win <Control-1> "CancelPie $win ; EditorToolDown constrain %W %x %y"
2635   bind $win <Control-B1-Motion> {EditorToolDrag %W %x %y}
2636   bind $win <Control-ButtonRelease-1> {EditorToolUp %W %x %y}
2637
2638   bind $win <2> "CancelPie $win ; EditorPanDown none %W %x %y"
2639   bind $win <B2-Motion> {EditorPanDrag %W %x %y}
2640   bind $win <ButtonRelease-2> {EditorPanUp %W %x %y}
2641
2642   bind $win <Control-2> "CancelPie $win ; EditorPanDown constrain %W %x %y"
2643   bind $win <Control-B2-Motion> {EditorPanDrag %W %x %y}
2644   bind $win <Control-ButtonRelease-2> {EditorPanUp %W %x %y}
2645
2646   InitPie $win $w.toolpie
2647 }
2648
2649
2650 proc UISetFunds {funds} {
2651   global HeadWindows
2652   foreach win $HeadWindows {
2653     [WindowLink $win.funds] configure -text "$funds"
2654   }
2655 }
2656
2657
2658 proc UISetDate {date month year} {
2659   global HeadWindows
2660   global CurrentDate
2661
2662   set CurrentDate "$date"
2663
2664   foreach win $HeadWindows {
2665     [WindowLink $win.date] Set $month $year
2666   }
2667 }
2668
2669
2670 proc SetPriority {index} {
2671   case $index { \
2672     {0} {
2673       sim Delay 500000
2674       sim Skips 0
2675     } \
2676     {1} {
2677       sim Delay 100000
2678       sim Skips 0
2679     } \
2680     {2} {
2681       sim Delay 25000
2682       sim Skips 0
2683     } \
2684     {3} {
2685       sim Delay 5000
2686       sim Skips 20
2687     } \
2688     {4} {
2689       sim Delay 5
2690       sim Skips 500
2691     }
2692   }
2693 }
2694
2695
2696 proc UISetDemand {r c i} {
2697   global HeadWindows DemandRes DemandCom DemandInd
2698
2699   set DemandRes $r
2700   set DemandCom $c
2701   set DemandInd $i
2702
2703   if {$r <= 0} then {set ry0 32} else {set ry0 24}
2704   set ry1 [expr "$ry0 - $r"]
2705   if {$c <= 0} then {set cy0 32} else {set cy0 24}
2706   set cy1 [expr "$cy0 - $c"]
2707   if {$i <= 0} then {set iy0 32} else {set iy0 24}
2708   set iy1 [expr "$iy0 - $i"]
2709
2710   foreach win $HeadWindows {
2711     set can [WindowLink $win.demand]
2712 #    $can coords r 8 $ry0 14 $ry1
2713 #    $can coords c 17 $cy0 23 $cy1
2714 #    $can coords i 26 $iy0 32 $iy1
2715     $can coords r 49 $ry0 55 $ry1
2716     $can coords c 58 $cy0 64 $cy1
2717     $can coords i 67 $iy0 73 $iy1
2718   }
2719 }
2720
2721
2722 proc UISetOptions {autobudget autogoto autobulldoze disasters sound animation messages notices} {
2723   global AutoBudget AutoGoto AutoBulldoze Disasters Sound
2724   set AutoBudget $autobudget
2725   set AutoGoto $autogoto
2726   set AutoBulldoze $autobulldoze
2727   set Disasters $disasters
2728   set Sound $sound
2729   set DoAnimation $animation
2730   set DoMessages $messages
2731   set DoNotices $notices
2732 }
2733
2734
2735 proc UIDidToolRes {win x y} {
2736   UIMakeSoundOn $win edit O "-speed 140"
2737 }
2738
2739
2740 proc UIDidToolCom {win x y} {
2741   UIMakeSoundOn $win edit A "-speed 140"
2742 }
2743
2744
2745 proc UIDidToolInd {win x y} {
2746   UIMakeSoundOn $win edit E "-speed 140"
2747 }
2748
2749
2750 proc UIDidToolFire {win x y} {
2751   UIMakeSoundOn $win edit O "-speed 130"
2752 }
2753
2754
2755 proc UIDidToolQry {win x y} {
2756   UIMakeSoundOn $win edit E "-speed 200"
2757 }
2758
2759
2760 proc UIDidToolPol {win x y} {
2761   UIMakeSoundOn $win edit E "-speed 130"
2762 }
2763
2764
2765 proc UIDidToolWire {win x y} {
2766   UIMakeSoundOn $win edit O "-speed 120"
2767 }
2768
2769
2770 proc UIDidToolDozr {win x y} {
2771   UIMakeSoundOn $win edit Rumble
2772 }
2773
2774
2775 proc UIDidToolRail {win x y} {
2776   UIMakeSoundOn $win edit O "-speed 100"
2777 }
2778
2779
2780 proc UIDidToolRoad {win x y} {
2781   UIMakeSoundOn $win edit E "-speed 100"
2782 }
2783
2784
2785 proc UIDidToolChlk {win x y} {
2786 }
2787
2788
2789 proc UIDidToolEraser {win x y} {
2790 }
2791
2792
2793 proc UIDidToolStad {win x y} {
2794   UIMakeSoundOn $win edit O "-speed 90"
2795 }
2796
2797
2798 proc UIDidToolPark {win x y} {
2799   UIMakeSoundOn $win edit A "-speed 130"
2800 }
2801
2802
2803 proc UIDidToolSeap {win x y} {
2804   UIMakeSoundOn $win edit E "-speed 90"
2805 }
2806
2807
2808 proc UIDidToolCoal {win x y} {
2809   UIMakeSoundOn $win edit O "-speed 75"
2810 }
2811
2812
2813 proc UIDidToolNuc {win x y} {
2814   UIMakeSoundOn $win edit E "-speed 75"
2815 }
2816
2817
2818 proc UIDidToolAirp {win x y} {
2819   UIMakeSoundOn $win edit A "-speed 50"
2820 }
2821
2822
2823 proc UISetToolState {w state} {
2824   global EditorPallets EditorPalletImages ToolInfo
2825   set win [WindowLink $w.top]
2826   #echo "UISETTOOLSTATE w $w win $win $state"
2827   ExclusivePallet $state $win $EditorPallets ic $EditorPalletImages \
2828         raised sunken {NoFunction}
2829         {NoFunction}
2830   set c1 [WindowLink $w.cost1]
2831   if {"$c1" != ""} {
2832     set info [lindex $ToolInfo $state]
2833     set cost1 [lindex $info 1]
2834     set cost2 [lindex $info 2]
2835     $c1 configure -text "$cost1"
2836     [WindowLink $w.cost2] configure -text "$cost2"
2837   }
2838 }
2839
2840
2841 proc UIShowZoneStatus {zone density value crime pollution growth x y} {
2842   global QueryX QueryY
2843   set QueryX [expr "8 + 16 * $x"]
2844   set QueryY [expr "8 + 16 * $y"]
2845   UIShowPicture 9 [list $zone $density $value $crime $pollution $growth]
2846 }
2847
2848
2849 ########################################################################
2850 # Map Window Handlers
2851
2852
2853 proc ShowMapOf {head} {
2854   global MapWindows
2855   set found 0
2856   foreach win $MapWindows {
2857     if {"[WindowLink $win.head]" == "$head"} {
2858       global MapPanelWidth MapPanelHeight
2859       #place configure $win -x 0 -y 0 -width $MapPanelWidth -height $MapPanelHeight
2860       #[WindowLink $win.parent] configure -width $MapPanelWidth -height $MapPanelHeight
2861       set parent [WindowLink $win.parent]
2862       pack append [WindowLink $head.w2] \
2863           $win {top frame nw expand fill}
2864       set found 1
2865     }
2866   }
2867   if {$found == 0} {
2868     NewMapOf $head
2869   } else {
2870     update idletasks
2871     sim UpdateMaps
2872   }
2873 }
2874
2875
2876 proc NewMapOf {head} {
2877   set win [MakeWindow.map $head [winfo screen $head]]
2878   global MapPanelWidth MapPanelHeight
2879   #place configure $win -x 0 -y 0 -width $MapPanelWidth -height $MapPanelHeight
2880   #[WindowLink $win.parent] configure -width $MapPanelWidth -height $MapPanelHeight
2881   set parent [WindowLink $win.parent]
2882   #pack append [WindowLink $head.col1]\
2883   #  $parent {top frame nw fillx}
2884   pack append [WindowLink $head.w2] \
2885       $win {top frame nw expand fill}
2886   sim UpdateMaps
2887 }
2888
2889
2890 proc ShowMaps {} {
2891   global HeadWindows
2892   foreach win $HeadWindows {
2893     ShowMapOf $win
2894   }
2895 }
2896
2897
2898 proc WithdrawMaps {} {
2899   global MapWindows
2900   foreach win $MapWindows {
2901     #place forget $win
2902     pack unpack $win
2903   }
2904 }
2905
2906
2907 proc InitMaps {} {
2908   global MapWindows
2909   foreach win $MapWindows {
2910     InitMap $win
2911   }
2912 }
2913
2914
2915 proc InitMap {win} {
2916   SetMapState $win 0
2917 }
2918
2919
2920 proc EnableMaps {} {
2921   global MapWindows
2922   foreach win $MapWindows {
2923     EnableMap $win
2924   }
2925 }
2926
2927
2928 proc EnableMap {win} {
2929   [WindowLink $win.view] ShowEditors 1
2930   [WindowLink $win.zones] config -state normal
2931   [WindowLink $win.overlays] config -state normal
2932 }
2933
2934
2935 proc DisableMaps {} {
2936   global MapWindows
2937   foreach win $MapWindows {
2938     DisableMap $win
2939   }
2940 }
2941
2942
2943 proc DisableMap {win} {
2944   [WindowLink $win.view] ShowEditors 0
2945   [WindowLink $win.zones] config -state disabled
2946   [WindowLink $win.overlays] config -state disabled
2947 }
2948
2949
2950 proc SetMapState {win state} {
2951   set m [WindowLink $win.view]
2952   $m MapState $state
2953   if {$state == 14} then {
2954     ShowFrobOf [WindowLink $win.head]
2955   }
2956 }
2957
2958
2959 proc MapPanDown {w x y} {
2960   $w PanStart $x $y
2961 }
2962
2963
2964 proc MapPanDrag {w x y} {
2965   $w PanTo $x $y
2966 }
2967
2968
2969 proc MapPanUp {w x y} {
2970   $w PanTo $x $y
2971   sim UpdateMaps
2972   sim UpdateEditors
2973 }
2974
2975
2976 proc UISetMapState {w state} {
2977   global MapTitles
2978   #set win [winfo toplevel $w]
2979   set win [WindowLink $w.win]
2980   set m [WindowLink $win.view]
2981   set title [lindex $MapTitles $state]
2982
2983   # TODO: set map text field header to title
2984   #wm title $win "$title"
2985   #wm iconname $win "$title"
2986
2987   global [set var MapState.$win]
2988   set $var $state
2989
2990   case $state { \
2991     {6 8 9 10 11 12 13} {
2992       [WindowLink $win.legend] config -bitmap "@images/legendmm.xpm"
2993     } \
2994     {7} {
2995       [WindowLink $win.legend] config -bitmap "@images/legendpm.xpm"
2996     } \
2997     {0 1 2 3 4 5 14} {
2998       [WindowLink $win.legend] config -bitmap "@images/legendn.xpm"
2999     }
3000   }
3001 }
3002
3003
3004 ########################################################################
3005 # Graph Window Handlers
3006
3007
3008 proc ToggleGraphOf {head} {
3009   global State
3010   if {"$State" != "play"} {
3011     return
3012   }
3013
3014   set mapped 0
3015   set win [WindowLink $head.graph]
3016   if {$win != ""} {
3017     set mapped [winfo ismapped $win]
3018   }
3019
3020   if {$mapped} {
3021     WithdrawGraphOf $head
3022   } else {
3023     ShowGraphOf $head
3024   }
3025
3026 }
3027
3028
3029 proc WithdrawGraphOf {head} {
3030   set win [WindowLink $head.graph]
3031   if {"$win" != ""} {
3032     pack unpack $win
3033   }
3034 }
3035
3036
3037 proc ShowGraphOf {head} {
3038   set win [WindowLink $head.graph]
3039   if {$win == {}} {
3040     set win [MakeWindow.graph $head [winfo screen $head]]
3041   }
3042   #wm deiconify $win
3043   #wm raise $win
3044   set parent [WindowLink $win.parent]
3045   pack append $parent\
3046     $win {top frame nw fillx}
3047   update idletasks
3048   sim UpdateGraphs
3049 }
3050
3051
3052 proc WithdrawGraphs {} {
3053   global GraphWindows
3054   foreach win $GraphWindows {
3055     #wm withdraw $win
3056     pack unpack $win
3057   }
3058 }
3059
3060
3061 proc InitGraphs {} {
3062   global GraphWindows
3063   foreach win $GraphWindows {
3064     InitGraph $win
3065   }
3066 }
3067
3068
3069 proc InitGraph {win} {
3070   UISetGraphState $win 1 1 1 1 1 1 0
3071 }
3072
3073
3074 proc UISetGraphState {win t0 t1 t2 t3 t4 t5 range} {
3075   set g [WindowLink $win.graphview]
3076   GraphPalletMask $win [expr "$t0 + ($t1<<1) + ($t2<<2) + ($t3<<3) + ($t4<<4) + ($t5<<5)"]
3077   GraphYearPallet $win $range
3078 }
3079
3080
3081 ########################################################################
3082 # Splash Window Handlers
3083
3084
3085 proc ShowSplashOf {head} {
3086   set win [WindowLink $head.splash]
3087   if {$win == {}} {
3088     set win [MakeWindow.splash $head [winfo screen $head]]
3089   }
3090   set splashscreen [WindowLink $win.splashscreen]
3091   set success 0
3092   catch {$splashscreen config -bitmap "@images/splashscreen.xpm"; set success 1}
3093   if {$success} {
3094     wm deiconify $win
3095     global SplashScreenDelay
3096     after $SplashScreenDelay "UIPickScenarioMode"
3097   } else {
3098     UIPickScenarioMode
3099   }
3100 }
3101
3102
3103 proc WithdrawSplashOf {head} {
3104   set win WindowLink $head.splash]
3105   wm withdraw $win
3106 }
3107
3108
3109 proc ShowSplashes {} {
3110   global HeadWindows
3111   foreach win $HeadWindows {
3112     ShowSplashOf $win
3113   }
3114 }
3115
3116
3117 proc WithdrawSplashes {} {
3118   global SplashWindows
3119   foreach win $SplashWindows {
3120     wm withdraw $win
3121     set splashscreen [WindowLink $win.splashscreen]
3122     $splashscreen config -bitmap ""
3123   }
3124 }
3125
3126
3127 proc InitSplashes {} {
3128 }
3129
3130
3131 proc InitSplash {win} {
3132 }
3133
3134
3135 proc DeleteSplashWindow {win} {
3136   # TODO
3137 }
3138
3139
3140 ########################################################################
3141 # Scenario Window Handlers
3142
3143
3144 proc ShowScenarioOf {head} {
3145   set win [WindowLink $head.scenario]
3146   if {$win == {}} {
3147     set win [MakeWindow.scenario $head [winfo screen $head]]
3148   }
3149   # TODO: load background bitmap
3150   wm deiconify $win
3151 }
3152
3153
3154 proc WithdrawScenarioOf {head} {
3155   set win WindowLink $head.scenario]
3156   wm withdraw $win
3157 }
3158
3159
3160 proc ShowScenarios {} {
3161   global HeadWindows
3162   foreach win $HeadWindows {
3163     ShowScenarioOf $win
3164   }
3165 }
3166
3167
3168 proc WithdrawScenarios {} {
3169   global ScenarioWindows
3170   foreach win $ScenarioWindows {
3171     wm withdraw $win
3172     # TODO: flush background bitmap
3173   }
3174 }
3175
3176
3177 proc InitScenarios {} {
3178   global MapHistory MapHistoryNum
3179   if {$MapHistoryNum < 1} {
3180     set prev disabled
3181   } else {
3182     set prev normal
3183   }
3184   if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3185     set next disabled
3186   } else {
3187     set next normal
3188   }
3189   global ScenarioWindows
3190   foreach win $ScenarioWindows {
3191     # TODO
3192     #[WindowLink $win.previous] config -state $prev
3193     #[WindowLink $win.next] config -state $next
3194   }
3195 }
3196
3197
3198 proc InitScenario {win} {
3199   global MapHistory MapHistoryNum
3200   if {$MapHistoryNum < 1} {
3201     set prev disabled
3202   } else {
3203     set prev normal
3204   }
3205
3206   if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3207     set next disabled
3208   } else {
3209     set next normal
3210   }
3211
3212   # TODO
3213   #[WindowLink $win.previous] config -state $prev
3214   #[WindowLink $win.next] config -state $next
3215
3216   LinkWindow $win.scenarioTarget -1
3217   LinkWindow $win.scenarioTargetDown -1
3218
3219   global ScenarioButtons
3220   set i 0
3221   set len [llength $ScenarioButtons]
3222   while {$i < $len} {
3223     set data [lindex $ScenarioButtons $i]
3224     set type [lindex $data 0]
3225     set id [lindex $data 1]
3226     #echo "DATA $data"
3227     #echo "ID $id"
3228
3229     LinkWindow $win.$id.over 0
3230     LinkWindow $win.$id.enabled 1
3231     LinkWindow $win.$id.checked 0
3232     #echo "SETTING WIN $win ID $id"
3233
3234     set i [expr "$i + 1"]
3235   }
3236
3237   UpdateLevelSelection $win
3238   UpdateLeftRightEnabled $win
3239 }
3240
3241
3242 proc UpdateLevelSelection {win} {
3243   #echo UpdateLevelSelection
3244   global GameLevel
3245   if {$GameLevel == 0} then {
3246     LinkWindow $win.easy.checked 1
3247     LinkWindow $win.medium.checked 0
3248     LinkWindow $win.hard.checked 0
3249   }
3250   if {$GameLevel == 1} then {
3251     LinkWindow $win.easy.checked 0
3252     LinkWindow $win.medium.checked 1
3253     LinkWindow $win.hard.checked 0
3254   }
3255   if {$GameLevel == 2} then {
3256     LinkWindow $win.easy.checked 0
3257     LinkWindow $win.medium.checked 0
3258     LinkWindow $win.hard.checked 1
3259   }
3260
3261   UpdateScenarioButtonID $win easy
3262   UpdateScenarioButtonID $win medium
3263   UpdateScenarioButtonID $win hard
3264
3265 }
3266
3267
3268 proc UpdateLeftRightEnabled {win} {
3269   #echo UpdateLeftRightEnabled
3270
3271   global MapHistory MapHistoryNum
3272   if {$MapHistoryNum < 1} {
3273     LinkWindow $win.left.enabled 0
3274   } else {
3275     LinkWindow $win.left.enabled 1
3276   }
3277
3278   if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3279     LinkWindow $win.right.enabled 0
3280   } else {
3281     LinkWindow $win.right.enabled 1
3282   }
3283
3284   UpdateScenarioButtonID $win left
3285   UpdateScenarioButtonID $win right
3286 }
3287
3288
3289 proc UpdateScenarioButtonID {win id} {
3290
3291   global ScenarioButtons
3292   set i 0
3293   set len [llength $ScenarioButtons]
3294   while {$i < $len} {
3295     set data [lindex $ScenarioButtons $i]
3296     set id
3297     if {$id == [lindex $data 1]} then {
3298       UpdateScenarioButton $win $data
3299       break
3300     }
3301
3302     set i [expr "$i + 1"]
3303   }
3304 }
3305
3306
3307 proc UpdateScenarioButton {win data} {
3308   set type [lindex $data 0]
3309   set id [lindex $data 1]
3310   set over [WindowLink $win.$id.over]
3311   set enabled [WindowLink $win.$id.enabled]
3312   set checked [WindowLink $win.$id.checked]
3313   #echo "WIN $win TYPE $type ID $id OVER $over ENABLED $enabled CHECKED $checked"
3314   if {$enabled} {
3315     if {$checked} {
3316       if {$over} {
3317         set bm [lindex $data 13]
3318       } else {
3319         set bm [lindex $data 12]
3320       }
3321     } else {
3322       if {$over} {
3323         set bm [lindex $data 10]
3324       } else {
3325         set bm [lindex $data 9]
3326       }
3327     }
3328   } else {
3329     set bm [lindex $data 11]
3330   }
3331
3332   [WindowLink $win.canvas] itemconfig $id -bitmap $bm
3333 }
3334
3335
3336 proc DoEnterCityName {win} {
3337 }
3338
3339
3340 proc InitVotesForUseThisMap {} {
3341   # TODO: Disabled for new scenario window.
3342   return
3343
3344   global VotesForUseThisMap ScenarioWindows
3345   set VotesForUseThisMap {}
3346   foreach win $ScenarioWindows {
3347     [WindowLink $win.vote] config -relief raised
3348   }
3349   UpdateVotesForUseThisMap
3350 }
3351
3352
3353 proc UpdateVotesForUseThisMap {} {
3354   global ScenarioWindows
3355   UpdateVotesFor UseThisMap $ScenarioWindows
3356 }
3357
3358
3359 proc UIUseThisMap {} {
3360   global CityName GameLevel Scenario
3361   WithdrawAll
3362   # special handling for scenarios?
3363   if {$GameLevel != -1} {
3364     sim GameLevel $GameLevel
3365   }
3366   sim CityName $CityName
3367   UINewGame
3368   UIPlayGame
3369   if {$Scenario != -1} {
3370     UIShowPicture $Scenario
3371   }
3372 }
3373
3374
3375 proc HandleScenarioDown {win x y} {
3376   #echo HandleScenarioDown $win $x $y
3377   HandleScenarioMove $win $x $y
3378   set w [WindowLink $win.w]
3379   set target [WindowLink $w.scenarioTarget]
3380   LinkWindow $w.scenarioTargetDown $target
3381 }
3382
3383
3384 proc HandleScenarioUp {win x y} {
3385   #echo HandleScenarioUp $win $x $y
3386   HandleScenarioMove $win $x $y
3387   global ScenarioButtons
3388   set w [WindowLink $win.w]
3389   set target [WindowLink $w.scenarioTarget]
3390   set targetDown [WindowLink $w.scenarioTargetDown]
3391   if {($target != -1) &&
3392       ($target == $targetDown)} {
3393     set data [lindex $ScenarioButtons $target]
3394     set type [lindex $data 0]
3395     set id [lindex $data 1]
3396     set callback [lindex $data 2]
3397     set param [lindex $data 3]
3398     set var [lindex $data 4]
3399     set xx [lindex $data 5]
3400     set yy [lindex $data 6]
3401     set ww [lindex $data 7]
3402     set hh [lindex $data 8]
3403     set normal [lindex $data 9]
3404     set over [lindex $data 10]
3405     set disabled [lindex $data 11]
3406     if {$type == "button"} {
3407       #echo callback $callback w $w param $param
3408       eval "$callback $w {$param}"
3409     } else {
3410       if {$type == "checkbox"} {
3411         #echo checkbox callback $callback w $w param $param
3412         eval "$callback $w {$param}"
3413       }
3414     }
3415   }
3416 }
3417
3418
3419 proc HandleScenarioMove {win x y} {
3420   #echo HandleScenarioMove $win $x $y
3421   global ScenarioButtons
3422   set w [WindowLink $win.w]
3423   set target [WindowLink $w.scenarioTarget]
3424   set found -1
3425   set i 0
3426   set len [llength $ScenarioButtons]
3427   while {$i < $len} {
3428     set data [lindex $ScenarioButtons $i]
3429     set type [lindex $data 0]
3430     set id [lindex $data 1]
3431     set callback [lindex $data 2]
3432     set param [lindex $data 3]
3433     set var [lindex $data 4]
3434     set xx [lindex $data 5]
3435     set yy [lindex $data 6]
3436     set ww [lindex $data 7]
3437     set hh [lindex $data 8]
3438
3439     set enabled [WindowLink $w.$id.enabled]
3440     set checked [WindowLink $w.$id.checked]
3441
3442     #echo "ID $id ENABLED $enabled CHECKED $checked w $w id $id"
3443
3444     if {($enabled != 0) &&
3445         ($x >= $xx) &&
3446         ($x < ($xx + $ww)) &
3447         ($y >= $yy) &&
3448         ($y < ($yy + $hh))} {
3449       set found $i
3450       break
3451     }
3452
3453     set i [expr "$i + 1"]
3454   }
3455
3456   if {$found != $target} {
3457
3458     if {$found == -1} {
3459       if {$target != -1} {
3460
3461         #echo OUT $w $found $xx $yy $normal
3462         LinkWindow $w.scenarioTarget -1
3463
3464         set targetdata [lindex $ScenarioButtons $target]
3465         set targetid [lindex $targetdata 1]
3466         LinkWindow $w.$targetid.over 0
3467         UpdateScenarioButton $w $targetdata
3468
3469       }
3470     } else {
3471
3472       #echo IN $w $found $xx $yy $over
3473       LinkWindow $w.scenarioTarget $found
3474       LinkWindow $w.$id.over 1
3475
3476       if {$target != -1} {
3477         set targetdata [lindex $ScenarioButtons $target]
3478         set targetid [lindex $targetdata 1]
3479         LinkWindow $w.$targetid.over 0
3480         UpdateScenarioButton $w $targetdata
3481       }
3482
3483       UpdateScenarioButton $w $data
3484
3485     }
3486   }
3487 }
3488
3489 proc DoLoad {win param} {
3490   #echo DOLOAD $win $param
3491   UILoadCity $win
3492 }
3493
3494
3495 proc DoGenerate {win param} {
3496   #echo DOGENERATE $win $param
3497   UIGenerateNewCity
3498 }
3499
3500
3501 proc DoQuit {win param} {
3502   #echo DOQUIT $win $param
3503   UIQuit $win
3504 }
3505
3506
3507 proc DoAbout {win param} {
3508   #echo DOABOUT $win $param
3509   MakeHistory "DoLoadCity cities/about.cty"
3510 }
3511
3512
3513 proc DoMap {win param} {
3514   #echo DOMAP $win $param
3515 }
3516
3517
3518 proc DoLevel {win param} {
3519   #echo DOLEVEL $win $param
3520   DoSetGameLevel $param
3521 }
3522
3523
3524 proc DoLeft {win param} {
3525   #echo DOLEFT $win $param
3526   PrevHistory
3527 }
3528
3529
3530 proc DoRight {win param} {
3531   #echo DORIGHT $win $param
3532  NextHistory
3533 }
3534
3535
3536 proc DoPlay {win param} {
3537   #echo DOPLAY $win $param
3538   UIUseThisMap
3539 }
3540
3541
3542 proc DoPickScenario {win param} {
3543   #echo DOPICKSCENARIO $win $param
3544   UILoadScenario $param
3545 }
3546
3547
3548 ########################################################################
3549 # Undo/Redo Facility
3550
3551
3552 proc InitHistory {} {
3553   global MapHistory
3554   global MapHistoryNum
3555   set MapHistory {}
3556   set MapHistoryNum -1
3557 }
3558
3559
3560 proc MakeHistory {cmd} {
3561   global MapHistory
3562   set len [llength $MapHistory]
3563   if {($len == 0) ||
3564       ($cmd != [lindex $MapHistory [expr $len-1]])} {
3565     lappend MapHistory $cmd
3566   } else {
3567     incr len -1
3568   }
3569   GotoHistory $len
3570 }
3571
3572
3573 proc GotoHistory {i} {
3574   global MapHistory
3575   global MapHistoryNum
3576   InitVotesForUseThisMap
3577   if {$i != $MapHistoryNum} {
3578     set MapHistoryNum $i
3579     set cmd [lindex $MapHistory $i]
3580     eval $cmd
3581   }
3582   if {$MapHistoryNum == 0} {
3583     set prev disabled
3584   } else {
3585     set prev normal
3586   }
3587   if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3588     set next disabled
3589   } else {
3590     set next normal
3591   }
3592
3593   global ScenarioWindows
3594   foreach win $ScenarioWindows {
3595     UpdateLeftRightEnabled $win
3596   }
3597
3598 }
3599
3600
3601 proc NextHistory {} {
3602   global MapHistory
3603   global MapHistoryNum
3604   set len [llength $MapHistory]
3605   set i [expr "$MapHistoryNum + 1"]
3606   if {$i < $len} {
3607     GotoHistory $i
3608   }
3609 }
3610
3611
3612 proc PrevHistory {} {
3613   global MapHistory
3614   global MapHistoryNum
3615   set i [expr "$MapHistoryNum - 1"]
3616   if {$i >= 0} {
3617     GotoHistory $i
3618   }
3619 }
3620
3621
3622 ########################################################################
3623 # Ask Window Handlers
3624
3625 proc ShowAskOf {head} {
3626   set win [WindowLink $head.ask]
3627   if {$win == {}} {
3628     set win [MakeWindow.ask $head [winfo screen $head]]
3629   }
3630   wm deiconify $win
3631   wm raise $win
3632   return $win
3633 }
3634
3635
3636 proc ShowAsks {} {
3637   global HeadWindows
3638   foreach win $HeadWindows {
3639     ShowAskOf $win
3640   }
3641 }
3642
3643
3644 proc WithdrawAsks {} {
3645   global AskWindows
3646   foreach win $AskWindows {
3647     wm withdraw $win
3648   }
3649 }
3650
3651
3652 proc WithdrawAskOf {win} {
3653   set ask [WindowLink $win.ask]
3654   if {"$ask" != ""} {
3655     wm withdraw $ask
3656   }
3657 }
3658
3659
3660 proc AskQuestion {color title text left middle right} {
3661   global HeadWindows
3662   foreach win $HeadWindows {
3663     AskQuestionOn $win $color $title $text $left $middle $right
3664   }
3665 }
3666
3667
3668 proc AskQuestionOn {head color title text left middle right} {
3669   ShowAskOf $head
3670
3671   set win [WindowLink $head.ask]
3672   set t [WindowLink $win.title]
3673   $t configure -text $title
3674   $t configure -background $color
3675
3676   set t [WindowLink $win.text]
3677   $t configure -state normal
3678   $t delete 0.0 end
3679   $t insert end "${text}\n"
3680   $t configure -state disabled
3681
3682   set bf [WindowLink $win.frame]
3683   set l [WindowLink $win.left]
3684   set m [WindowLink $win.middle]
3685   set r [WindowLink $win.vote]
3686   set rf [WindowLink $win.voteframe]
3687
3688   if {$left != ""} {
3689     $l config \
3690         -text [lindex $left 0] \
3691         -command [format [lindex $left 2] $head]
3692     SetHelp $l [lindex $left 1]
3693     pack append $bf $l {left frame center}
3694   } else {
3695     pack unpack $l
3696   }
3697
3698   if {$middle != ""} {
3699     $m config \
3700         -text [lindex $middle 0] \
3701         -command [format [lindex $middle 2] $head]
3702     SetHelp $m [lindex $middle 1]
3703     pack append $bf $m {left frame center expand}
3704   } else {
3705     pack unpack $m
3706   }
3707
3708   if {$right != ""} {
3709     set notify [format [lindex $right 2] $head]
3710     set preview [format [lindex $right 3] $head]
3711     set cmd [list DoVote $win Ask $notify $preview]
3712     $r config \
3713         -text [lindex $right 0] \
3714         -command $cmd
3715     SetHelp $r [lindex $right 1]
3716     pack append $bf $rf {right frame center}
3717   } else {
3718     pack unpack $rf
3719   }
3720
3721   InitVotesForAsk
3722 }
3723
3724
3725 proc BindVotingButton {win but name} {
3726   set w [WindowLink $win.top]
3727
3728   bind $but <Any-Enter> "VoteButtonEnter $win $but"
3729   bind $but <Any-Leave> "VoteButtonLeave $win $but"
3730   bind $but <1> "VoteButtonDown $win $but $name"
3731   bind $but <ButtonRelease-1> "VoteButtonUp $win $but $name"
3732   bind $but <2> "VoteButtonDown $win $but $name"
3733   bind $but <ButtonRelease-2> "VoteButtonUp $win $but $name"
3734   bind $but <3> "VoteButtonDown $win $but $name"
3735   bind $but <ButtonRelease-3> "VoteButtonUp $win $but $name"
3736 }
3737
3738
3739 proc VoteButtonEnter {win but} {
3740   global tk_priv
3741   set screen [winfo screen $but]
3742   if {[lindex [$but config -state] 4] != "disabled"} {
3743     $but config -state active
3744     set tk_priv(window@$screen) $but
3745   } else {
3746     set tk_priv(window@$screen) ""
3747   }
3748 }
3749
3750
3751 proc VoteButtonLeave {win but} {
3752   global tk_priv
3753   if {[lindex [$but config -state] 4] != "disabled"} {
3754     $but config -state normal
3755   }
3756   set screen [winfo screen $but]
3757   set tk_priv(window@$screen) ""
3758 }
3759
3760
3761 proc VoteButtonDown {win but name} {
3762   global tk_priv
3763   set screen [winfo screen $but]
3764   set rel [lindex [$but config -relief] 4]
3765   set tk_priv(relief@$screen) $rel
3766   if {[lindex [$but config -state] 4] != "disabled"} {
3767     set head [WindowLink $win.head]
3768     if {[IsVotingFor $head $name]} {
3769       $but config -relief raised
3770     } else {
3771       $but config -relief sunken
3772     }
3773   }
3774 }
3775
3776
3777 proc VoteButtonUp {win but name} {
3778   global tk_priv
3779   set screen [winfo screen $but]
3780   $but config -relief $tk_priv(relief@$screen)
3781   if {($but == $tk_priv(window@$screen))
3782         && ([lindex [$but config -state] 4] != "disabled")} {
3783     uplevel #0 [list $but invoke]
3784     set head [WindowLink $win.head]
3785     if {[IsVotingFor $head $name]} {
3786       $but config -relief sunken
3787     } else {
3788       $but config -relief raised
3789     }
3790   }
3791 }
3792
3793
3794 proc PressVoteButton {win but name} {
3795   global tk_priv
3796   uplevel #0 [list $but invoke]
3797   set head [WindowLink $win.head]
3798   if {[IsVotingFor $head $name]} {
3799     $but config -relief sunken
3800   } else {
3801     $but config -relief raised
3802   }
3803 }
3804
3805
3806 proc IsVotingFor {win name} {
3807   global VotesFor$name
3808   set votes [eval ident "\$\{VotesFor$name\}"]
3809   if {[lsearch $votes $win] == -1} {
3810     return 0
3811   } else {
3812     return 1
3813   }
3814 }
3815
3816
3817 proc DoVote {win name notify preview} {
3818   global VotesFor$name
3819   set votes [eval ident "\$\{VotesFor$name\}"]
3820
3821   set win [WindowLink $win.head]
3822   set i [lsearch $votes $win]
3823   if {$i == -1} {
3824     lappend VotesFor$name $win
3825   } else {
3826     set VotesFor$name [lreplace $votes $i $i]
3827   }
3828   UpdateVotesFor$name
3829   set votes [eval ident "\$\{VotesFor$name\}"]
3830   if {[llength $votes] >= [NeededVotes]} {
3831     eval "$notify"
3832   } else {
3833     eval "$preview"
3834   }
3835 }
3836
3837
3838 proc UpdateVotesFor {name wins} {
3839   global VotesFor$name
3840   set votes [eval llength "\$\{VotesFor$name\}"]
3841   set needed [NeededVotes]
3842
3843   foreach win $wins {
3844     set head [WindowLink $win.head]
3845     if {[IsVotingFor $head $name]} {
3846       set border [expr "($needed - $votes) * 1"]
3847       set pad [expr "6 - $border"]
3848       [WindowLink $win.vote] config -padx $pad -pady $pad
3849       [WindowLink $win.voteframe] config -borderwidth $border
3850     } else {
3851       set border [expr "($needed - $votes - 1) * 1"]
3852       set pad [expr "6 - $border"]
3853       [WindowLink $win.vote] config -padx $pad -pady $pad
3854       [WindowLink $win.voteframe] config -borderwidth $border
3855     }
3856   }
3857 }
3858
3859
3860 proc InitVotesForAsk {} {
3861   global VotesForAsk AskWindows
3862   set VotesForAsk {}
3863   foreach win $AskWindows {
3864     [WindowLink $win.vote] config -relief raised
3865   }
3866   sim PendingTool -1
3867   UpdateVotesForAsk
3868 }
3869
3870
3871 proc UpdateVotesForAsk {} {
3872   global AskWindows
3873   UpdateVotesFor Ask $AskWindows
3874 }
3875
3876
3877 ########################################################################
3878 # Player Window Handlers
3879
3880 proc ShowPlayerOf {head} {
3881   set win [WindowLink $head.player]
3882   if {$win == {}} {
3883     set win [MakeWindow.player $head [winfo screen $head]]
3884   }
3885   wm deiconify $win
3886   wm raise $win
3887   return $win
3888 }
3889
3890
3891 proc ShowPlayers {} {
3892   global HeadWindows
3893   foreach win $HeadWindows {
3894     ShowPlayerOf $win
3895   }
3896 }
3897
3898
3899 proc WithdrawPlayers {} {
3900   global PlayerWindows
3901   foreach win $PlayerWindows {
3902     wm withdraw $win
3903   }
3904 }
3905
3906
3907 proc UpdatePlayers {} {
3908   # TODO: Disabled for new scenario window.
3909   return
3910
3911   global HeadWindows PlayerWindows
3912
3913   set players ""
3914   foreach win $HeadWindows {
3915     set server [winfo screen $win]
3916 #    if {[string first : $server] == 0} {
3917 #      set server "[exec hostname]:0"
3918 #    }
3919     lappend players $server
3920   }
3921
3922   sim Players [llength $players]
3923
3924   foreach win $PlayerWindows {
3925     set list [WindowLink $win.players]
3926     $list delete 0 end
3927     eval "$list insert 0 $players"
3928   }
3929
3930   UpdateVotesForUseThisMap
3931   UpdateVotesForAsk
3932   UpdateVotesForBudget
3933   UpdateTaxRateSliders
3934 }
3935
3936
3937 proc UIShowPlayer {win} {
3938   ShowPlayerOf $win
3939 }
3940
3941
3942 proc DoNewPlayer {win} {
3943   set field [WindowLink $win.display]
3944   set dpy [$field get]
3945   if {"$dpy" != ""} {
3946     $field delete 0 end
3947     sim Flush
3948     update idletasks
3949     if {[AddPlayer $dpy] != ""} {
3950       wm withdraw $win
3951     }
3952   }
3953 }
3954
3955 ########################################################################
3956 # Notice Window Handlers
3957
3958
3959 proc ShowNoticeOf {head} {
3960   set win [WindowLink $head.notice]
3961   if {$win == {}} {
3962     set win [MakeWindow.notice $head [winfo screen $head]]
3963   }
3964   global NoticePanelWidth NoticePanelHeight
3965   #place configure $win -x 0 -y 0 -width $NoticePanelWidth -height $NoticePanelHeight
3966   pack append [WindowLink $head.w3] \
3967       $win {bottom frame sw expand fill}
3968   return $win
3969 }
3970
3971
3972 proc ShowNotices {} {
3973   global HeadWindows
3974   foreach win $HeadWindows {
3975     ShowNoticeOf $win
3976   }
3977 }
3978
3979
3980 proc WithdrawNotices {} {
3981   global NoticeWindows
3982   foreach win $NoticeWindows {
3983     #place forget $win
3984     pack unpack $win
3985   }
3986 }
3987
3988
3989 proc ReShowPictureOn {{head ""}} {
3990   global ShowingPicture ShowingParms
3991   UIShowPictureOn $head $ShowingPicture $ShowingParms
3992 }
3993
3994
3995 proc UIShowPicture {id {parms ""}} {
3996   UIShowPictureOn "" $id $parms
3997 }
3998
3999
4000 proc UIShowPictureOn {where id {parms ""}} {
4001   global DoNotices Messages ShowingPicture ShowingParms
4002   if {$DoNotices == 0} {
4003       return
4004   }
4005
4006   set ShowingPicture $id
4007   set ShowingParms $parms
4008   set msg $Messages($id)
4009   set color [lindex $msg 0]
4010   set title [lindex $msg 1]
4011   set body [lindex $msg 2]
4012   if {$parms != ""} {
4013     set cmd "format {$body} $parms"
4014     set body [uplevel #0 $cmd]
4015   }
4016   set props [lindex $msg 3]
4017   if {"$where" == ""} {
4018     global HeadWindows
4019     set where $HeadWindows
4020   }
4021   foreach head $where {
4022     NoticeMessageOn $head "$title" $color "$body" Medium $props
4023   }
4024 }
4025
4026
4027 proc NoticeMessageOn {head title color text font props} {
4028   ShowNoticeOf $head
4029   set win [WindowLink $head.notice]
4030
4031   set t [WindowLink $win.title]
4032   $t configure -text $title -background $color
4033
4034   set t [WindowLink $win.text]
4035   $t configure -state normal -font [Font $head $font]
4036   $t delete 0.0 end
4037   $t insert end "${text}\n"
4038   $t configure -state disabled
4039
4040   set left ""
4041   catch {set left [keylget props left]}
4042   set l [WindowLink $win.left]
4043   if {$left != ""} {
4044     $l config -bitmap $left
4045     place $l -in $t -anchor sw -relx .05 -rely .95
4046   } else {
4047     place forget $l
4048   }
4049
4050   set middle ""
4051   catch {set middle [keylget props middle]}
4052   set m [WindowLink $win.middle]
4053   if {$middle != ""} {
4054     $m config -bitmap $middle
4055     place $m -in $t -anchor s -relx .5 -rely .95
4056   } else {
4057     place forget $m
4058   }
4059
4060   set right ""
4061   catch {set right [keylget props right]}
4062   set r [WindowLink $win.right]
4063   if {$right != ""} {
4064     $r config -bitmap $right
4065     place $r -in $t -anchor se -relx .95 -rely .95
4066   } else {
4067     place forget $r
4068   }
4069
4070   set view ""
4071   catch {set view [keylget props view]}
4072   set vf [WindowLink $win.viewframe]
4073   global v
4074   set v [WindowLink $win.view]
4075   set bg [WindowLink $win.background]
4076   if {$view != ""} {
4077     uplevel #0 "$view"
4078     pack unpack $t
4079     pack append $bg $vf {left frame center fill}
4080     pack append $bg $t {right frame center fill expand}
4081   } else {
4082     pack unpack $vf
4083   }
4084 }
4085
4086
4087 proc UIPopUpMessage {msg} {
4088   DoSendMessage $msg
4089 }
4090
4091
4092 proc ComeToMe {view} {
4093   set win [winfo toplevel $view]
4094
4095   set xy [$view Pan]
4096   set x [expr "[lindex $xy 0] >>4"]
4097   set y [expr "[lindex $xy 1] >>4"]
4098
4099   ComeTo $win $x $y
4100 }
4101
4102
4103 proc ComeTo {win x y} {
4104   global EditorWindows
4105   set head [WindowLink $win.head]
4106   set myeds {}
4107   set myautoeds {}
4108   foreach ed $EditorWindows {
4109     if {"[WindowLink $ed.head]" == "$head"} {
4110       lappend myeds $ed
4111       set view [WindowLink $ed.view]
4112       if {[$view AutoGoto]} {
4113         lappend myautoeds $ed
4114       }
4115     }
4116   }
4117   if {[llength $myautoeds]} {
4118     UIAutoGotoOn $x $y $myautoeds
4119   } else {
4120     if {[llength $myeds]} {
4121       UIAutoGotoOn $x $y $myeds
4122     }
4123   }
4124 }
4125
4126
4127 proc FollowView {view id} {
4128   $view Follow $id
4129
4130   set skips 999999
4131   if {[sim DoAnimation]} {
4132     set head [WindowLink [winfo toplevel $view].head]
4133     global EditorWindows
4134     foreach win $EditorWindows {
4135       if {"[WindowLink $win.head]" == "$head"} {
4136         set s [[WindowLink $win.view] Skip]
4137         set skips [min $skips $s]
4138       }
4139     }
4140
4141     if {$skips == 999999} {
4142       set skips 0
4143     }
4144   }
4145
4146   $view Skip $skips
4147   $view Update
4148 }
4149
4150
4151 proc PanView {view x y} {
4152   FollowView $view ""
4153   $view Pan $x $y
4154 }
4155
4156
4157 ########################################################################
4158 # Help Window Handlers
4159
4160
4161 proc ShowHelpOf {head} {
4162   set win [WindowLink $head.help]
4163   if {$win == {}} {
4164     set win [MakeWindow.help $head [winfo screen $head]]
4165   }
4166   wm deiconify $win
4167   wm raise $win
4168   return $win
4169 }
4170
4171
4172 proc ShowHelps {} {
4173   global HeadWindows
4174   foreach win $HeadWindows {
4175     ShowHelpOf $win
4176   }
4177 }
4178
4179
4180 proc WithdrawHelps {} {
4181   global HelpWindows
4182   foreach win $HelpWindows {
4183     wm withdraw $win
4184   }
4185 }
4186
4187
4188 ########################################################################
4189 # Frob Window Handlers
4190
4191
4192 proc ShowFrobOf {head} {
4193   set win [WindowLink $head.frob]
4194   if {$win == {}} {
4195     set win [MakeWindow.frob $head [winfo screen $head]]
4196   }
4197   wm deiconify $win
4198   wm raise $win
4199
4200   return $win
4201 }
4202
4203
4204 proc ShowFrobs {} {
4205   global HeadWindows
4206   foreach win $HeadWindows {
4207     ShowFrobOf $win
4208   }
4209 }
4210
4211
4212 proc WithdrawFrobs {} {
4213   global FrobWindows
4214   foreach win $FrobWindows {
4215     wm withdraw $win
4216   }
4217 }
4218
4219
4220 proc UISetDynamic {i min max} {
4221   sim DynamicData [expr "$i*2"] $min
4222   sim DynamicData [expr "$i*2+1"] $max
4223 }
4224
4225
4226 ########################################################################
4227 # Help Handler
4228
4229
4230 proc LoadHelp {} {
4231   global ResourceDir
4232
4233   source $ResourceDir/help.tcl
4234 }
4235
4236 proc HandleHelp {win x y rootx rooty} {
4237   global HelpLoaded HelpWidgets Messages
4238
4239   if {$HelpLoaded == 0} {
4240     LoadHelp
4241     set HelpLoaded 1
4242   }
4243
4244   set orig $win
4245   set head [WindowLink [winfo toplevel $win].head]
4246   set id ""
4247   while {1} {
4248     catch {set id $HelpWidgets($win)}
4249     if {$id != ""} {
4250       break
4251     }
4252     set list [split $win .]
4253     set len [expr "[llength $list] - 2"]
4254     set list [lrange $list 0 $len]
4255     if {[llength $list] <= 1} {
4256       set id Window
4257       break
4258     }
4259     set win [join $list .]
4260   }
4261   if [info exists Messages($id)] {
4262     UIShowHelpOn $head $id
4263   } else {
4264     UIShowHelpOn $head Window
4265   }
4266 }
4267
4268
4269 proc UIShowHelpOn {win id {parms ""}} {
4270   global Messages ShowingPicture ShowingParms ResourceDir
4271   set head [WindowLink $win.head]
4272   set msg $Messages($id)
4273   set color [lindex $msg 0]
4274   set title [lindex $msg 1]
4275   set body [lindex $msg 2]
4276   if {$parms != ""} {
4277     set cmd "format {$body} $parms"
4278     set body [uplevel #0 $cmd]
4279   }
4280   set props [lindex $msg 3]
4281
4282   ShowHelpOf $head
4283   set win [WindowLink $head.help]
4284
4285   set t [WindowLink $win.title]
4286   $t configure -text $title -background $color
4287
4288   set t [WindowLink $win.text]
4289   $t configure -state normal -font [Font $head Large]
4290   $t delete 0.0 end
4291   $t insert end "${body}\n"
4292   FormatHTML $ResourceDir/doc/$id.html $t
4293   $t configure -state disabled
4294 }
4295
4296
4297 proc FormatHTML {filename text} {
4298   set f ""
4299   catch {
4300     set f [open $filename]
4301     set line ""
4302     set header ""
4303     set title ""
4304     gets $f header
4305     gets $f title
4306
4307     while {[gets $f line] >= 0} {
4308       if {"$line" == "</body>"} {
4309         break
4310       }
4311       if {([string index $line 0] == "#") || ([string length $line] == 0)} {
4312         continue
4313       }
4314       $text insert end "$line\n"
4315     }
4316   }
4317   if {$f != ""} {
4318     close $f
4319   }
4320 }
4321
4322
4323 proc SetHelp {win id} {
4324   global HelpWidgets
4325   set HelpWidgets($win) $id
4326 }
4327
4328
4329 proc Help {id title {msg {}} {props {}}} {
4330   Message $id #7f7fff $title $msg $props
4331 }
4332
4333 ########################################################################
4334 # Pie Menu Handlers
4335
4336
4337 # Set up the bindings to pop up $pie when the right button is clicked in $win
4338 proc InitPie {win pie} {
4339   bind $win <Motion> {}
4340   bind $win <3> "PieMenuDown $win $pie $pie Initial %X %Y"
4341   bind $win <B3-Motion> {}
4342   bind $win <B3-ButtonRelease> {}
4343 }
4344
4345
4346 # Set up the bindings to continue tracking $pie
4347 # Get this: we keep the tracking machine state in the bindings!
4348 proc ActivatePie {win root pie state} {
4349   bind $win <Motion> "PieMenuMotion $win $root $pie $state %X %Y"
4350   bind $win <3> "PieMenuDown $win $root $pie $state %X %Y"
4351   bind $win <B3-Motion> "PieMenuMotion $win $root $pie $state %X %Y"
4352   bind $win <B3-ButtonRelease> "PieMenuUp $win $root $pie $state %X %Y"
4353 }
4354
4355
4356 # Cancel and reset a pie menu
4357 proc CancelPie {win} {
4358   set binding [bind $win <3>]
4359   set root [lindex $binding 2]
4360   set pie [lindex $binding 3]
4361   set state [lindex $binding 4]
4362   if {"$state" != "Initial"} {
4363     catch {$root ungrab $win}
4364     $pie unpost
4365     $pie activate none
4366     UIMakeSoundOn $win fancy Oop
4367   }
4368   InitPie $win $root
4369 }
4370
4371
4372 # Handle pie menu button down
4373 proc PieMenuDown {win root pie state x y} {
4374   case $state {
4375     Initial {
4376       ActivatePie $win $root $pie FirstDown
4377       update idletasks
4378       catch {$root grab $win}
4379       $pie activate none
4380       $pie post $x $y
4381       PreviewPieMenu $win $pie $x $y
4382       update idletasks
4383     }
4384     ClickedUp {
4385       TrackPieMenu $pie $x $y
4386       ActivatePie $win $root $pie SecondDown
4387     }
4388     SelectedUp {
4389       $pie activate none
4390       #$pie post $x $y
4391       $pie defer
4392       PreviewPieMenu $win $pie $x $y
4393       ActivatePie $win $root $pie SecondDown
4394     }
4395     FirstDown { # error
4396       CancelPie $win
4397     }
4398     SecondDown { # error
4399       CancelPie $win
4400     }
4401   }
4402 }
4403
4404
4405 # Handle pie menu button motion
4406 proc PieMenuMotion {win root pie state x y} {
4407   case $state {
4408     FirstDown {
4409       TrackPieMenu $pie $x $y
4410       $pie defer
4411     }
4412     ClickedUp {
4413       $pie activate none
4414       #$pie post $x $y
4415     }
4416     SecondDown {
4417       TrackPieMenu $pie $x $y
4418       $pie defer
4419     }
4420     SelectedUp {
4421       $pie activate none
4422       #$pie post $x $y
4423     }
4424     Initial { # error
4425       CancelPie $win
4426     }
4427   }
4428 }
4429
4430
4431 # Handle pie menu button up
4432 proc PieMenuUp {win root pie state x y} {
4433   case $state {
4434     FirstDown {
4435       TrackPieMenu $pie $x $y
4436       set active [$pie index active]
4437       if {$active == "none"} {
4438         $pie show
4439         catch {$root grab $win}
4440         ActivatePie $win $root $pie ClickedUp
4441       } else {
4442         set label [lindex [$pie entryconfig $active -label] 4]
4443         set submenu [lindex [$pie entryconfig $active -piemenu] 4]
4444         UIMakeSoundOn $win mode $label
4445         if {$submenu == {}} {
4446           set reward [$pie pending]
4447           catch {$root ungrab $win}
4448           $pie unpost
4449           $pie activate none
4450           if {$reward} {
4451             sim Funds [expr "[sim Funds] + 5"]
4452             UIMakeSoundOn $win fancy Aaah
4453           }
4454           eval [lindex [$pie entryconfig $active -command] 4]
4455           InitPie $win $root
4456         } else {
4457           $pie unpost
4458           $pie activate none
4459           $submenu activate none
4460           $submenu post $x $y
4461           PreviewPieMenu $win $submenu $x $y
4462           catch {$root grab $win}
4463           ActivatePie $win $root $submenu SelectedUp
4464         }
4465       }
4466     }
4467     SecondDown {
4468       TrackPieMenu $pie $x $y
4469       set active [$pie index active]
4470       if {$active == "none"} {
4471         CancelPie $win
4472       } else {
4473         set label [lindex [$pie entryconfig $active -label] 4]
4474         set submenu [lindex [$pie entryconfig $active -piemenu] 4]
4475         UIMakeSoundOn $win mode $label
4476         if {$submenu == {}} {
4477           set reward [$pie pending]
4478           catch {$root ungrab $win}
4479           $pie unpost
4480           $pie activate none
4481           if {$reward} {
4482             sim Funds [expr "[sim Funds] + 5"]
4483             UIMakeSoundOn $win fancy Aaah
4484           }
4485           eval [lindex [$pie entryconfig $active -command] 4]
4486           InitPie $win $root
4487         } else {
4488           $pie unpost
4489           $pie activate none
4490           $submenu activate none
4491           $submenu post $x $y
4492           PreviewPieMenu $win $submenu $x $y
4493           catch {$root grab $win}
4494           ActivatePie $win $root $submenu SelectedUp
4495         }
4496       }
4497     }
4498     Initial { # error
4499       CancelPie $win
4500     }
4501     ClickedUp { # error
4502       CancelPie $win
4503     }
4504     SelectedUp { # error
4505       CancelPie $win
4506     }
4507   }
4508 }
4509
4510
4511 # Track the selected item
4512 proc TrackPieMenu {pie x y} {
4513   $pie activate @$x,$y
4514 }
4515
4516
4517 proc PreviewPieMenu {win pie x y} {
4518   set preview [lindex [$pie config -preview] 4]
4519   if {"$preview" != ""} {
4520     set rx [winfo rootx $win]
4521     set ry [winfo rooty $win]
4522     set x [expr "$x - $rx"]
4523     set y [expr "$y - $ry"]
4524     eval [format $preview $x $y]
4525   }
4526 }
4527
4528
4529 ########################################################################
4530 # Pallet Handlers
4531
4532
4533 proc ExclusivePallet {state parent children prefix images inactive active cmd} {
4534   #echo "ExclusivePallet state $state parent $parent children $children prefix $prefix images $images inactive $inactive active $active cmd $cmd"
4535   set i 0
4536   foreach child $children {
4537     set name [lindex $images $i]
4538     if {$i == $state} then {
4539       $parent.$child config \
4540           -bitmap "@images/${prefix}${name}hi.xpm" \
4541           -relief $active
4542     } else {
4543       $parent.$child config \
4544           -bitmap "@images/${prefix}${name}.xpm" \
4545           -relief $inactive
4546     }
4547     incr i
4548   }
4549   eval [concat $cmd $state]
4550 }
4551
4552
4553 proc NonExclusivePallet {mask parent children prefix images
4554                          inactive active cmd} {
4555   set i 0
4556   foreach child $children {
4557     set name [lindex $images $i]
4558     if {$mask & (1<<$i)} then {
4559       $parent.$child config \
4560           -bitmap "@images/${prefix}${name}hi.xpm" \
4561           -relief $active
4562     } else {
4563       $parent.$child config \
4564           -bitmap "@images/${prefix}${name}.xpm" \
4565           -relief $inactive
4566     }
4567     incr i
4568   }
4569   eval [concat $cmd $mask]
4570 }
4571
4572
4573 proc EditorPallet {win state} {
4574   global EditorPalletSounds
4575   UIMakeSoundOn $win mode [lindex $EditorPalletSounds $state]
4576   EditorSetTool $win $state
4577 }
4578
4579
4580 proc EditorSetTool {win state} {
4581   global EditorPallets
4582   global EditorPalletImages
4583   ExclusivePallet $state $win $EditorPallets ic $EditorPalletImages \
4584         flat raised "$win.centerframe.view ToolState"
4585 }
4586
4587
4588 proc GraphPallet {win state} {
4589   set mask [[WindowLink $win.graphview] Mask]
4590   set mask [expr "$mask ^ (1<<$state)"]
4591   GraphPalletMask $win $mask
4592 }
4593
4594
4595 proc GraphPalletMask {win mask} {
4596   global GraphPallets
4597   global GraphPalletImages
4598   NonExclusivePallet $mask $win $GraphPallets gr $GraphPalletImages \
4599         flat flat "SetGraphState $win"
4600 }
4601
4602
4603 proc GraphYearPallet {win state} {
4604   global GraphYearPallets
4605   global GraphYearPalletImages
4606   ExclusivePallet $state $win $GraphYearPallets gr $GraphYearPalletImages \
4607         flat flat "SetGraphYearState $win"
4608 }
4609
4610
4611 proc SetGraphYearState {win state} {
4612   set graph [WindowLink $win.graphview]
4613   if {$state == 0} {
4614     $graph Range 10
4615   } else {
4616     $graph Range 120
4617   }
4618 }
4619
4620
4621 proc SetGraphState {win mask} {
4622   global GraphPallets
4623   set graph [WindowLink $win.graphview]
4624   $graph Mask $mask
4625 }
4626
4627
4628 ########################################################################
4629 # Button Handlers
4630
4631 proc sim_butEnter {w} {
4632   global tk_priv
4633   set screen [winfo screen $w]
4634   set tk_priv(window@$screen) $w
4635 }
4636
4637
4638 proc sim_butLeave {w} {
4639   global tk_priv
4640   set screen [winfo screen $w]
4641   set tk_priv(window@$screen) ""
4642 }
4643
4644
4645 proc sim_butDown {w} {
4646   global tk_priv
4647   set screen [winfo screen $w]
4648   set pict [lindex [$w config -bitmap] 4]
4649   set tk_priv(relief@$screen) $pict
4650   $w config -bitmap [lindex [split $pict .] 0]hi.xpm
4651   update idletasks
4652 }
4653
4654
4655 proc sim_butUp {w} {
4656   global tk_priv
4657   set screen [winfo screen $w]
4658   $w config -bitmap $tk_priv(relief@$screen)
4659   update idletasks
4660   if {$w == $tk_priv(window@$screen)} {
4661     uplevel #0 [list $w invoke]
4662   }
4663 }
4664
4665
4666 proc BindSimButton {w} {
4667   bind $w <Any-Enter> {sim_butEnter %W}
4668   bind $w <Any-Leave> {sim_butLeave %W}
4669   bind $w <1> {sim_butDown %W}
4670   bind $w <ButtonRelease-1> {sim_butUp %W}
4671   bind $w <2> {sim_butDown %W}
4672   bind $w <ButtonRelease-2> {sim_butUp %W}
4673   bind $w <3> {sim_butDown %W}
4674   bind $w <ButtonRelease-3> {sim_butUp %W}
4675 }
4676
4677
4678 ########################################################################
4679 # Internal Callbacks
4680
4681
4682 proc UIStartMicropolis {homedir resourcedir hostname} {
4683   global HomeDir ResourceDir HostName HeadWindows
4684   set HomeDir $homedir
4685   set ResourceDir $resourcedir
4686   set HostName $hostname
4687   sim InitGame
4688   sim GameStarted
4689   update
4690
4691   foreach display [sim Displays] {
4692     if {"[AddPlayer $display]" == ""} {
4693       echo Couldn't add a player on $display ...
4694     }
4695   }
4696
4697   if {"$HeadWindows" == ""} {
4698     echo Micropolis is exiting because it couldn't connect to any players.
4699     sim ReallyQuit
4700   }
4701 }
4702
4703
4704 proc UISelectCity {win} {
4705   AskQuestion [Color $win #ff0000 #ffffff] "Choose Another City" \
4706     "Do you want to abandon this city and choose another one?" \
4707     "{Keep playing.} SelectCity.No {RejectPlan}" \
4708     "" \
4709     "{Another city!} SelectCity.Yes {UIPickScenarioMode}"
4710 }
4711
4712
4713 proc UIQuit {head} {
4714   if {[sim Players] == 1} {
4715     set l "{Keep playing.} Quit.No {RejectPlan}"
4716     set m ""
4717     set r "{I quit!} Quit.IQuit {DoReallyQuit %s}"
4718   } else {
4719     set l "{Keep playing.} Quit.No {RejectPlan}"
4720     set m "{I quit!} Quit.IResign {DoIResign %s}"
4721     set r "{Everyone quit!} Quit.AllQuit {DoReallyQuit %s}"
4722   }
4723   AskQuestion [Color $head #ff0000 #ffffff] "Quit Playing Micropolis" \
4724     "Do you want to quit playing Micropolis?" \
4725     $l $m $r
4726 }
4727
4728
4729 proc DoIResign {head} {
4730   global VotesForAsk
4731   set display [winfo screen $head]
4732   CrushHead $head
4733   DecRefDisplay $display
4734   UISetMessage "The player on X11 Display $display has resigned."
4735   UpdatePlayers
4736   if {([sim Players] == 0) ||
4737       ([llength $VotesForAsk] >= [sim Players])} {
4738     sim ReallyQuit
4739   }
4740 }
4741
4742
4743 proc DoReallyQuit {head} {
4744   echo QuitMicropolis
4745   sim ReallyQuit
4746 }
4747
4748
4749 proc UISplashMode {} {
4750   global State
4751   set State splash
4752   sim Pause
4753   WithdrawAll
4754   InitSplashes
4755   ShowSplashes
4756 }
4757
4758
4759 proc UIPickScenarioMode {} {
4760   global State
4761   global CityLibDir
4762   set State scenario
4763   sim Pause
4764   WithdrawAll
4765   InitHistory
4766   UIGenerateCityNow
4767   InitScenarios
4768   InitVotesForUseThisMap
4769   ShowScenarios
4770 }
4771
4772
4773 proc ForcePickScenarioMode {} {
4774   global State
4775   if {"$State" != "scenario"} {
4776     UIPickScenarioMode
4777   }
4778 }
4779
4780
4781 proc UIGenerateCityNow {} {
4782   global CityName GameLevel
4783   sim CityName NowHere
4784   sim GameLevel 0
4785   UIGenerateNewCity
4786 }
4787
4788
4789 proc UIGenerateNewCity {} {
4790   global CityName GameLevel
4791   if {$GameLevel == -1} {
4792     set GameLevel 0
4793   }
4794   MakeHistory "DoNewCity NowHere $GameLevel [sim Rand] [sim TreeLevel] [sim LakeLevel] [sim CurveLevel] [sim CreateIsland]"
4795 }
4796
4797
4798 proc DoNewCity {name level {r ""} {tl -1} {ll -1} {cl -1} {ci -1}} {
4799   global Scenario
4800   set Scenario -1
4801   sim TreeLevel $tl
4802   sim LakeLevel $ll
4803   sim CurveLevel $cl
4804   sim CreateIsland $ci
4805   if {"$r" == ""} {
4806     sim GenerateNewCity
4807   } else {
4808     sim GenerateSomeCity $r
4809   }
4810   sim CityName $name
4811   sim GameLevel $level
4812   UIShowPicture 48
4813 }
4814
4815
4816 proc UIDidGenerateNewCity {} {
4817   sim Update
4818 }
4819
4820
4821 proc IncRefDisplay {display} {
4822   global DisplayRegistry
4823   if ![info exists DisplayRegistry($display)] {
4824     set DisplayRegistry($display) 0
4825   }
4826   incr DisplayRegistry($display)
4827 }
4828
4829
4830 proc DecRefDisplay {display} {
4831   global DisplayRegistry
4832   incr DisplayRegistry($display) -1
4833   if {$DisplayRegistry($display) <= 0} {
4834     CloseDisplay $display
4835   }
4836 }
4837
4838
4839 proc CloseDisplay {display} {
4840 }
4841
4842
4843 proc DoStopMicropolis {} {
4844   KillSoundServers
4845   destroy .
4846 }
4847
4848
4849 proc AddPlayer {display} {
4850   set i [string first : $display]
4851   if {$i == 0} {
4852   } else {
4853     if {$i == -1} {
4854       set display "$display:0"
4855     }
4856   }
4857
4858   echo Adding a player on $display ...
4859
4860   set head [MakeWindow.head $display]
4861
4862   if {"$head" != ""} {
4863     set display [winfo screen $head]
4864     IncRefDisplay $display
4865     PrepHead $head
4866     UISetMessage "Added a player on X11 Display \"$display\"."
4867     UpdatePlayers
4868   } else {
4869     UISetMessage "Couldn't add a player on X11 Display \"$display\"!"
4870   }
4871   return $head
4872 }
4873
4874
4875 proc FireBomb {} {
4876   sim FireBomb
4877 }
4878
4879 proc DropFireBombs {} {
4880   FireBomb
4881   after 300 FireBomb
4882   after 600 FireBomb
4883   after 900 FireBomb
4884 }
4885
4886
4887 proc UIMakeMonster {} {
4888   sim MakeMonster [sim Rand 120] [sim Rand 100]
4889 }
4890
4891
4892 proc melt {} {
4893   sim HeatSteps 1
4894   sim HeatFlow -7
4895   sim HeatRule 0
4896 }
4897
4898
4899 proc eco {} {
4900   sim HeatSteps 1
4901   sim HeatFlow 19
4902   sim HeatRule 1
4903 }
4904
4905
4906 proc oops {} {
4907   sim HeatSteps 0
4908 }
4909
4910
4911 proc TogglePause {} {
4912   global State
4913
4914   if {"$State" != "play" || [sim Speed]} {
4915     sim Speed 0
4916   } else {
4917     sim Speed 3
4918   }
4919   MakeRunningSound
4920 }
4921
4922
4923 proc SetSpeedTime {time} {
4924   sim Speed $time
4925   MakeRunningSound
4926 }
4927
4928
4929 proc MakeRunningSound {} {
4930   global State
4931
4932   if {"$State" == "play" && [sim Speed]} {
4933     UIMakeSound edit Boing "-speed 1[sim Speed]0"
4934   } else {
4935     UIMakeSound edit Boing "-speed 90"
4936   }
4937 }
4938
4939
4940 proc SayDemands {} {
4941   global DemandRes DemandCom DemandInd
4942   set slope 3
4943   set r [expr "100 + ($DemandRes * $slope)"]
4944   set c [expr "100 + ($DemandCom * $slope)"]
4945   set i [expr "100 + ($DemandInd * $slope)"]
4946   after 020 "UIMakeSound edit O \"-speed $r\""
4947   after 220 "UIMakeSound edit A \"-speed $c\""
4948   after 440 "UIMakeSound edit E \"-speed $i\""
4949 }
4950
4951
4952 proc UISaveCity {win} {
4953   global SaveCityWin
4954   set SaveCityWin $win
4955   sim SaveCity
4956 }
4957
4958
4959 proc UISaveCityAs {{win ""}} {
4960   global SaveCityWin
4961   if {"$win" == ""} {set win $SaveCityWin}
4962   set SaveCityWin $win
4963
4964   global CityDir
4965   set file [ShowFileOf $win]
4966   DoFileDialog $file "Choose a File to Save the City" $CityDir "*.cty" "" \
4967         "UIDoReallySaveCity" ""
4968 }
4969
4970
4971 proc UIDoReallySaveCity {name path} {
4972   global CityDir
4973   if {![string match *.cty $name]} {
4974     set name $name.cty
4975   }
4976   set CityDir $path
4977   sim SaveCityAs $path/$name
4978 }
4979
4980
4981 proc UIDidSaveCity {} {
4982   DoSendMessage "Saved the city in \"[sim CityFileName]\"." status
4983 }
4984
4985
4986 proc UIDidntSaveCity {msg} {
4987   DoSendMessage $msg alert
4988   UIMakeSound warning Sorry "-speed 85"
4989 }
4990
4991
4992 proc UILoadScenario {scen} {
4993   MakeHistory "DoScenario $scen"
4994 }
4995
4996
4997 proc DoScenario {scen} {
4998   global Scenario
4999   set Scenario $scen
5000   sim LoadScenario $scen
5001   UIShowPicture $scen
5002 }
5003
5004
5005 proc UIDidLoadScenario {} {
5006 }
5007
5008
5009 proc UIStartScenario {id} {
5010   global Scenario
5011   set Scenario $id
5012   UILoadScenario $id
5013   UIPlayGame
5014   UIShowPicture $id
5015 }
5016
5017
5018 proc UIPlayNewCity {} {
5019   UIGenerateNewCity
5020   UIPlayGame
5021 }
5022
5023
5024 proc UIStartLoad {} {
5025   UIPlayGame
5026 }
5027
5028
5029 proc UIReallyStartGame {} {
5030   #UIPickScenarioMode
5031   UISplashMode
5032 }
5033
5034
5035 proc UIPlayGame {} {
5036   global State
5037   global Priority
5038   set State play
5039   sim Resume
5040   sim Speed 3
5041   sim AutoGoto 1
5042   SetPriority $Priority
5043   InitHeads
5044   InitAllHeadMenus
5045   ShowInitial
5046   sim NeedRest 10
5047 }
5048
5049
5050 proc UISetSpeed {speed} {
5051   global Time State
5052   set Time $speed
5053   if {"$State" == "play"} {
5054     UISetMessage [lindex {
5055       {Time pauses.}
5056       {Time flows slow.}
5057       {Time flows medium.}
5058       {Time flows fast.}
5059     } $speed]
5060   }
5061   UIUpdateRunning
5062 }
5063
5064
5065 proc UIUpdateRunning {} {
5066   global HeadWindows Time State
5067
5068         if {($State == "play") && $Time} {
5069     set pict "@images/micropolisg.xpm"
5070   } else {
5071     set pict "@images/micropoliss.xpm"
5072   }
5073
5074   foreach win $HeadWindows {
5075     set can [WindowLink $win.demand]
5076     $can itemconfig micropolis -bitmap $pict
5077   }
5078 }
5079
5080
5081 proc DoSetGameLevel {level} {
5082   sim GameLevel $level
5083 }
5084
5085
5086 proc UISetGameLevel {level} {
5087   global GameLevel
5088   set GameLevel $level
5089   global ScenarioWindows
5090   foreach win $ScenarioWindows {
5091     UpdateLevelSelection $win
5092   }
5093 }
5094
5095
5096 proc UISetCityName {name} {
5097   global EditorWindows
5098   global CityName
5099   set CityName $name
5100   set title "Micropolis Editor on $name"
5101   foreach win $EditorWindows {
5102     # TODO: set editor window and icon title
5103     #wm title $win "$title"
5104     #wm iconname $win "$title"
5105   }
5106 }
5107
5108
5109 proc UILoadCity {win} {
5110   # if changed, r-u-sure?
5111   global CityDir
5112   set file [ShowFileOf $win]
5113   DoFileDialog $file "Choose a City to Load" $CityDir "*.cty" "" \
5114         "UIDoLoadCity" ""
5115 }
5116
5117
5118 proc UIDoLoadCity {name path} {
5119   global CityDir
5120   set CityDir $path
5121   if {![string match *.cty $name]} {
5122     set name $name.cty
5123   }
5124   MakeHistory "DoLoadCity $path/$name"
5125 }
5126
5127
5128 proc DoLoadCity {filename} {
5129   sim LoadCity $filename
5130 }
5131
5132 proc UIDidLoadCity {} {
5133   global State GameLevel Scenario
5134   set Scenario -1
5135   set GameLevel -1
5136   if {$State == "play"} {
5137     UIPlayGame
5138   } else {
5139     UIShowPicture 49 [sim CityFileName]
5140   }
5141 }
5142
5143
5144 proc UIDidntLoadCity {msg} {
5145   DoSendMessage $msg alert
5146   UIMakeSound warning Sorry "-speed 85"
5147   UIShowPicture 49 [sim CityFileName]
5148   sim Fill 0
5149   sim UpdateMaps
5150 }
5151
5152
5153 proc UINewGame {} {
5154   global OldBudget
5155   set OldBudget 0
5156   sim InitGame
5157   sim EraseOverlay
5158   InitEditors
5159   InitMaps
5160   InitGraphs
5161   update
5162   sim UpdateMaps
5163 }
5164
5165
5166 proc UIDidPan {w x y} {
5167   if {[$w ToolMode] == 1} {
5168     EditorToolDrag $w $x $y
5169   }
5170   update idletasks
5171 }
5172
5173
5174 proc UIDidStopPan {win} {
5175   UIMakeSoundOn $win fancy Skid "-volume 25"
5176   $win TweakCursor
5177 }
5178
5179
5180 proc UIEarthQuake {} {
5181 }
5182
5183
5184 proc UIAutoGoto {x y {except {}}} {
5185   global EditorWindows
5186   set didOne 0
5187   set x [expr "$x * 16 + 8"]
5188   set y [expr "$y * 16 + 8"]
5189   foreach win $EditorWindows {
5190     if {"$win" != "$except"} {
5191       set view [WindowLink $win.view]
5192       if {[$view AutoGoto]} {
5193         set didOne 1
5194         $view AutoGoal $x $y
5195       }
5196     }
5197   }
5198   if {$didOne} {
5199     sim UpdateMaps
5200   }
5201 }
5202
5203
5204 proc UIAutoGotoOn {x y eds} {
5205   set x [expr "$x * 16 + 8"]
5206   set y [expr "$y * 16 + 8"]
5207   foreach win $eds {
5208     [WindowLink $win.view] AutoGoal $x $y
5209   }
5210   sim UpdateMaps
5211 }
5212
5213
5214 proc DoLeaveGame {head} {
5215 }
5216
5217
5218 proc UILoseGame {} {
5219   UIPickScenarioMode
5220   UIShowPicture 200
5221 }
5222
5223
5224 proc UIWinGame {} {
5225   UIShowPicture 100
5226 }
5227
5228
5229 proc DoPendTool {view tool x y} {
5230   global HeadWindows ToolInfo VotesForAsk
5231
5232   set win [WindowLink $view.top]
5233   set head [WindowLink $win.head]
5234
5235   if {($tool == [sim PendingTool]) &&
5236       ($x == [sim PendingX]) &&
5237       ($y == [sim PendingY])} {
5238     if {[lsearch $VotesForAsk $head] != -1} {
5239       # you can only vote once
5240       UIMakeSound edit Oop
5241     } else {
5242       UIMakeSound edit Boing
5243       set ask [WindowLink $head.ask]
5244       PressVoteButton $ask [WindowLink $ask.vote] Ask
5245     }
5246   } else {
5247     UIAutoGoto $x $y $win
5248
5249     UIMakeSound edit Boing
5250     set info [lindex $ToolInfo $tool]
5251     set a [lindex $info 0]
5252     set name [lindex $info 1]
5253     set cost [lindex $info 2]
5254     set title "Build $a $name"
5255     set question "Do you support the plan to build $a $name for $cost?"
5256     AskQuestion [Color $win #00ff00 #ffffff] "$title" \
5257         "$question" \
5258         "{Veto plan.} Plan.Veto
5259            {RejectPlan}" \
5260         "{Goto plan.} Plan.Goto
5261            {ComeTo %s $x $y}" \
5262         "{Support plan!} Plan.Support
5263            {SupportPlan $view %s $tool $x $y}
5264            {PreviewSupportPlan $view %s $tool $x $y}"
5265     set VotesForAsk $head
5266     set ask [WindowLink $head.ask]
5267     [WindowLink $ask.vote] config -relief sunken
5268
5269     UpdateVotesForAsk
5270
5271     sim PendingTool $tool
5272     sim PendingX $x
5273     sim PendingY $y
5274     sim Votes [llength $VotesForAsk]
5275   }
5276 }
5277
5278
5279 proc RejectPlan {} {
5280   sim PendingTool -1
5281   if {[sim Players] > 1} {
5282     UIMakeSound edit Sorry
5283   }
5284   WithdrawAsks
5285 }
5286
5287
5288 proc NeededVotes {} {
5289   global FreeVotes
5290   set players [sim Players]
5291   set needed [expr "$players - $FreeVotes"]
5292   return [max 0 $needed]
5293 }
5294
5295
5296 proc SupportPlan {view h tool x y} {
5297   global VotesForAsk
5298   sim Votes [llength $VotesForAsk]
5299   sim PendingTool -1
5300   sim OverRide 1
5301   $view DoTool $tool $x $y
5302   sim OverRide 0
5303   WithdrawAsks
5304   UIMakeSound edit Aaah
5305 }
5306
5307
5308 proc PreviewSupportPlan {view h tool x y} {
5309   global VotesForAsk
5310   sim Votes [llength $VotesForAsk]
5311 }
5312
5313
5314 proc SugarStartUp {uri} {
5315   global SugarURI
5316   set SugarURI $uri
5317
5318   # TODO: Load the city file at the given URI, or configure according to URI parameters.
5319 }
5320
5321
5322 proc SugarNickName {nick} {
5323   global SugarNickName
5324   set SugarNickName $nick
5325 }
5326
5327
5328 proc SugarActivate {} {
5329   global SugarActivated
5330   set SugarActivated 1
5331 }
5332
5333
5334 proc SugarDeactivate {} {
5335   global SugarActivated
5336   set SugarActivated 0
5337 }
5338
5339
5340 proc SugarShare {} {
5341   global SugarShared
5342   set SugarShared 1
5343 }
5344
5345
5346 proc SugarBuddyAdd {key nick color address} {
5347   global SugarBuddies
5348   set buddy [list $key $nick $color $address]
5349   lappend SugarBuddies $buddy
5350 }
5351
5352
5353 proc SugarBuddyDel {key nick color address} {
5354   global SugarBuddies
5355   set buddy [list $key $nick $color $address]
5356   set i [lsearch $wins $win]
5357   if {$i != -1} {
5358     set SugarBuddies [lreplace $wins $i $i]
5359   }
5360 }
5361
5362
5363 proc SugarQuit {} {
5364   sim ReallyQuit
5365 }
5366
5367
5368 ########################################################################