cvs.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"
 416 system "xset +fp $FontPath >&/dev/null"
 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   }
 945 }
 946
 947
 948 proc UIMakeSoundOn {win chan sound {opts ""}} {
 949   # Send message to Python to play sound.
 950   EchoPlaySound $sound
 951
 952   #UIDoSoundOn $win "play $sound -replay -channel $chan $opts"
 953 }
 954
 955
 956 proc UIStartSoundOn {win chan sound {opts ""}} {
 957   # Send message to Python to play sound.
 958   EchoPlaySound $sound
 959
 960   #UIDoSoundOn $win "play $sound -replay -channel $chan -repeat 100 $opts"
 961 }
 962
 963
 964 proc UIStopSoundOn {win chan sound {opts ""}} {
 965   UIDoSoundOn $win "stop $sound"
 966 }
 967
 968
 969 proc UIMakeSound {chan sound {opts ""}} {
 970   # Send message to Python to play sound.
 971   EchoPlaySound $sound
 972
 973   #UIDoSound "sound play $sound -replay -channel $chan $opts"
 974 }
 975
 976
 977 proc UIStartSound {chan sound {opts ""}} {
 978   # Send message to Python to play sound.
 979   EchoPlaySound $sound
 980
 981   #UIDoSound "sound play $sound -channel $chan -repeat 100 $opts"
 982 }
 983
 984
 985 proc UIStopSound {chan sound {opts ""}} {
 986   UIDoSound "sound stop $sound"
 987 }
 988
 989
 990 proc SetupSoundServer {win} {
 991   AddSoundServer $win
 992 }
 993
 994
 995 proc AddSoundServer {win} {
 996   global SoundServers
 997   set i [lsearch $SoundServers $win]
 998   if {$i < 0} {
 999     set SoundServers [linsert $SoundServers 0 $win]
1000   }
1001 }
1002
1003
1004 proc LostSoundServer {win} {
1005   DeleteSoundServer $win
1006 #  UIShowPictureOn [WindowLink $win.head] 46 [winfo screen $win]
1007 }
1008
1009
1010 proc DeleteSoundServer {win} {
1011   global SoundServers
1012   set i [lsearch $SoundServers $win]
1013   if {$i >= 0} {
1014     set SoundServers [lreplace $SoundServers $i $i]
1015   }
1016 }
1017
1018
1019 proc UISoundOff {} {
1020 }
1021
1022
1023 proc MonsterSpeed {} {
1024   return [expr "[sim Rand 40] + 70"]
1025 }
1026
1027
1028 proc ExplosionPitch {} {
1029   return [expr "[sim Rand 20] + 90"]
1030 }
1031
1032
1033 proc HonkPitch {} {
1034   return [expr "[sim Rand 20] + 90"]
1035 }
1036
1037
1038 ########################################################################
1039 # Global Window Handlers
1040
1041
1042 proc WithdrawAll {} {
1043   WithdrawHeads
1044   WithdrawEditors
1045   WithdrawMaps
1046   WithdrawGraphs
1047   WithdrawBudgets
1048   WithdrawEvaluations
1049   WithdrawSplashes
1050   WithdrawScenarios
1051   WithdrawFiles
1052   WithdrawAsks
1053   WithdrawPlayers
1054   WithdrawNotices
1055   WithdrawHelps
1056   WithdrawFrobs
1057 }
1058
1059
1060 proc ShowInitial {} {
1061   ShowHeads
1062   ShowEditors
1063   ShowMaps
1064   EnableMaps
1065 }
1066
1067
1068 ########################################################################
1069 # Head Window Handlers
1070
1071
1072 proc PrepHead {head} {
1073   global State
1074   InitHeadMenus $head
1075   case $State {
1076     uninitialized {
1077     }
1078     splash {
1079       WithdrawHeadOf $head
1080       ShowSplashOf $head
1081     }
1082     scenario {
1083       after 1000 "WithdrawSplashOf $head"
1084       WithdrawHeadOf $head
1085       ShowScenarioOf $head
1086       sim UpdateMaps
1087     }
1088     play {
1089       WithdrawSplashOf $head
1090       WithdrawScenarioOf $head
1091       ShowHeadOf $head
1092       ShowEditorOf $head
1093       ShowMapOf $head
1094       EnableMaps
1095       ReShowPictureOn $head
1096       InitHead $head
1097       InitHeadMenus $head
1098     }
1099   }
1100 }
1101
1102
1103 proc ShowHeadOf {head} {
1104   wm deiconify $head
1105 }
1106
1107
1108 proc WithdrawHeadOf {head} {
1109   wm withdraw $head
1110 }
1111
1112
1113 proc ShowHeads {} {
1114   global HeadWindows
1115   foreach win $HeadWindows {
1116     ShowHeadOf $win
1117   }
1118 }
1119
1120
1121 proc WithdrawHeads {} {
1122   global HeadWindows
1123   foreach win $HeadWindows {
1124     wm withdraw $win
1125   }
1126 }
1127
1128
1129 proc DeleteHeadWindow {head} {
1130   UIQuit $head
1131 }
1132
1133
1134 proc InitHeads {} {
1135   global HeadWindows
1136   foreach win $HeadWindows {
1137     InitHead $win
1138   }
1139 }
1140
1141
1142 proc InitHead {win} {
1143   set w [WindowLink $win.text]
1144   $w configure -state normal
1145   $w delete 0.0 end
1146   $w insert end "\n"
1147   $w configure -state disabled
1148
1149   if {[sim MultiPlayerMode]} {
1150     set w [WindowLink $win.entry]
1151     $w delete 0 end
1152     global ${w}.value
1153     set ${w}.value ""
1154   }
1155
1156   sim UpdateHeads
1157   UIUpdateRunning
1158 }
1159
1160
1161 proc InitAllHeadMenus {} {
1162   global HeadWindows
1163
1164   foreach win $HeadWindows {
1165     InitHeadMenus $win
1166   }
1167 }
1168
1169
1170 proc InitHeadMenus {win} {
1171   global State
1172   set m0 [WindowLink $win.m0]
1173   set m1 [WindowLink $win.m1]
1174   set m2 [WindowLink $win.m2]
1175   set m3 [WindowLink $win.m3]
1176   set m4 [WindowLink $win.m4]
1177   set b0 [WindowLink $win.b0]
1178   set b1 [WindowLink $win.b1]
1179   set b2 [WindowLink $win.b2]
1180   set b3 [WindowLink $win.b3]
1181   set b4 [WindowLink $win.b4]
1182   case $State {
1183     uninitialized {
1184     }
1185     splash {
1186     }
1187     scenario {
1188       $m0 unpost
1189       $m1 unpost
1190       $m2 unpost
1191       $m3 unpost
1192       $m4 unpost
1193       $m0 disable 1
1194       $m0 disable 2
1195       # When in multi player mode there is an extra menu
1196       # item to add another player, before the quit item,
1197       # so compensate for it here.
1198       if {[sim MultiPlayerMode]} {
1199         $m0 disable 4
1200       } else {
1201         $m0 disable 3
1202       }
1203       $b0 config -state normal
1204       $b2 config -state disabled
1205       $b4 config -state disabled
1206     }
1207     play {
1208       $m0 enable 1
1209       $m0 enable 2
1210       # When in multi player mode there is an extra menu
1211       # item to add another player, before the quit item,
1212       # so compensate for it here.
1213       if {[sim MultiPlayerMode]} {
1214         $m0 enable 4
1215       } else {
1216         $m0 enable 3
1217       }
1218       $b0 config -state normal
1219       $b2 config -state normal
1220       $b4 config -state normal
1221     }
1222   }
1223 }
1224
1225
1226 proc UIDisaster {win cmd action} {
1227   AskQuestion [Color $win #ff0000 #ffffff] "Cause a Disaster" \
1228     "Oh no! Do you really want to $action" \
1229     "{No way!} Disaster.No {WithdrawAsks}" \
1230     "" \
1231     "{I guess so.} Disaster.Yes {WithdrawAsks ; $cmd}"
1232 }
1233
1234
1235 proc CrushHead {head} {
1236   global SubWindows VoteNames
1237
1238   foreach foo $VoteNames {
1239     global VotesFor$foo
1240     set votes [eval ident \$VotesFor$foo]
1241     set i [lsearch $votes $head]
1242     if {$i != -1} {
1243       set VotesFor$foo [lreplace $votes $i $i]
1244     }
1245   }
1246
1247   foreach foo $SubWindows {
1248     set sym [lindex $foo 0]
1249     set name [lindex $foo 1]
1250     global $name
1251     set wins [eval ident "\$$name"]
1252     foreach win $wins {
1253       if {[WindowLink $win.head] == $head} {
1254         DeleteWindow $sym $name $win
1255       }
1256     }
1257   }
1258 }
1259
1260
1261 proc ChatDown {win} {
1262   tk_butDown $win
1263 }
1264
1265
1266 proc ChatUp {win} {
1267   tk_butUp $win
1268
1269   global Chatting
1270
1271   if {$Chatting} {
1272     CloseChat
1273   } else {
1274     OpenChat
1275   }
1276 }
1277
1278
1279 proc OpenChat {} {
1280   global Chatting
1281   global ChatServer
1282   global ChatSocket
1283   global ChatConnection
1284
1285   DoSendMessage "Opening Connection to Chat Server $ChatServer socket $ChatSocket ..." status
1286
1287   set ChatConnection {}
1288   catch {
1289     set ChatConnection [connect $ChatServer $ChatSocket]
1290   }
1291
1292   if {$ChatConnection == {}} then {
1293     DoSendMessage "Sorry, I could not open a connection to chat server $ChatServer socket $ChatSocket." status
1294     set Chatting 0
1295   } else {
1296     filehandler $ChatConnection r "ReceiveChat"
1297     set Chatting 1
1298   }
1299
1300   global NickName
1301   global UserName
1302   global HostName
1303   global ServerName
1304   global RealName
1305   global ChannelName
1306   catch {
1307     puts $ChatConnection "USER $UserName $HostName $ServerName $RealName\r\n" nonewline
1308     puts $ChatConnection "NICK $NickName\r\n" nonewline
1309     puts $ChatConnection "JOIN $ChannelName\r\n" nonewline
1310     flush $ChatConnection
1311   }
1312 }
1313
1314
1315 proc ReceiveChat {mode f} {
1316 #    DoSendMessage "ReceiveChat: MODE $mode F $f"
1317     set msg ""
1318     gets $f msg
1319
1320     if {[string first {:} $msg]} {
1321         set msg ": $msg"
1322     }
1323
1324     set from [lindex $msg 0]
1325     set cmd [string tolower [lindex $msg 1]]
1326
1327     set handled 0
1328
1329     if {($cmd == "privmsg") ||
1330         ($cmd == "notice")} then {
1331       set handled 1
1332       set chan [lindex $msg 2]
1333       set i [expr "[string length $from] + 1 + [string length $cmd] + 1 + [string length $chan] + 2"]
1334       set j [expr "[string length $msg] - 2"]
1335       set line [string range $msg $i $j]
1336       set chan [string range $chan 1 [string length $chan]]
1337       set from [string range $from 1 [expr "[string length $from] - 1"]]
1338       set from [split $from {!}]
1339       set from [lindex $from 0]
1340       DoSendMessage "$from> $line"
1341     }
1342
1343     if {$handled == 0} {
1344         set msg [string range $msg \
1345                   [expr "[string length $from] + 1"] \
1346                   [expr "[string length $msg] - 2"]]
1347         DoSendMessage $msg
1348     }
1349 }
1350
1351
1352 proc SendChatMessage {msg win} {
1353     global ChatConnection ChannelName NickName
1354
1355     if {"$msg" == ""} {
1356         return
1357     }
1358
1359     if {[string range $msg 0 0] == "/"} {
1360         set cmd [string range $msg 1 [string length $msg]]
1361         DoSendMessage "$NickName> \[$cmd\]"
1362         set cmd "$cmd\r\n"
1363     } else {
1364         set cmd "PRIVMSG $ChannelName :$msg\r\n"
1365         DoSendMessage "$NickName> $msg"
1366     }
1367
1368
1369     set result 1
1370
1371     catch {
1372         puts $ChatConnection $cmd nonewline
1373         flush $ChatConnection
1374         set result 0
1375     }
1376
1377     if {$result} {
1378         DoSendMessage "IRC Broke the connection"
1379         CloseChat
1380     }
1381 }
1382
1383
1384 proc CloseChat {} {
1385   global Chatting
1386   global ChatServer
1387   global ChatSocket
1388   global ChatConnection
1389
1390   DoSendMessage "Closing Connection to Chat Server." status
1391
1392   catch {
1393     puts $ChatConnection "QUIT\r\n" nonewline
1394     flush $ChatConnection
1395     $ChatConnection close
1396   }
1397
1398   set ChatConnection {}
1399   set Chatting 0
1400 }
1401
1402
1403 proc DoEnterMessage {win var} {
1404   global Chatting
1405   global $var
1406   set msg [eval ident "\$\{$var\}"]
1407
1408   if {$Chatting} then {
1409     SendChatMessage $msg $win
1410   } else {
1411     DoSendMessage $msg
1412   }
1413   $win delete 0 end
1414 }
1415
1416
1417 proc DoEvalMessage {win var} {
1418   global $var
1419   set command [eval ident "\$\{$var\}"]
1420   $win delete 0 end
1421   DoSendMessage "Evaluating TCL: $command"
1422   catch {uplevel #0 $command} result
1423   DoSendMessage "Result: $result"
1424 }
1425
1426
1427 proc DoSendMessage {msg {tag message}} {
1428   global HeadWindows
1429   foreach win $HeadWindows {
1430     appendWithTag [WindowLink $win.text] $tag "$msg"
1431   }
1432 }
1433
1434
1435 proc UISetMessage {msg {tag status}} {
1436   global DoMessages EditorWindows HeadWindows
1437
1438   if {$DoMessages == 0} {
1439       return
1440   }
1441
1442   foreach win $EditorWindows {
1443     [WindowLink $win.message] configure -text "$msg"
1444   }
1445
1446   foreach win $HeadWindows {
1447     appendWithTag [WindowLink $win.text] $tag "$msg"
1448   }
1449 }
1450
1451
1452
1453
1454 proc appendWithTag {w tag text} {
1455     global MaxLines
1456     global ShrinkLines
1457
1458     set start [$w index end]
1459     $w configure -state normal
1460     if {$start > $MaxLines} then {
1461         $w delete 0.0 $ShrinkLines.0
1462         set start [$w index end]
1463     }
1464     $w insert end "${text}\n"
1465     $w tag add $tag $start {end - 1 char}
1466     $w configure -state disabled
1467     $w yview -pickplace {end - 1 char}
1468 }
1469
1470
1471 ########################################################################
1472 # Budget Window Handlers
1473
1474
1475 proc ShowBudgetOf {head} {
1476   set win [WindowLink $head.budget]
1477   if {$win == {}} {
1478     set win [MakeWindow.budget $head [winfo screen $head]]
1479   }
1480   wm deiconify $win
1481   wm raise $win
1482   update idletasks
1483   sim UpdateBudget
1484 }
1485
1486
1487 proc ShowBudgets {} {
1488   global HeadWindows BudgetsVisible
1489   set BudgetsVisible 1
1490   foreach win $HeadWindows {
1491     ShowBudgetOf $win
1492   }
1493 }
1494
1495
1496 proc WithdrawBudgets {} {
1497   global BudgetWindows BudgetsVisible
1498   foreach win $BudgetWindows {
1499     wm withdraw $win
1500   }
1501   StopBudgetTimer
1502   set BudgetsVisible 0
1503 }
1504
1505
1506 proc BudgetContinue {{win ""}} {
1507   global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1508   set OldBudget 0
1509   if {([sim RoadFund] != $BudgetRoadFund) ||
1510       ([sim FireFund] != $BudgetFireFund) ||
1511       ([sim PoliceFund] != $BudgetPoliceFund) ||
1512       ([sim TaxRate] != $BudgetTaxRate)} {
1513     UISetMessage "The budget was changed."
1514   } else {
1515     UISetMessage "The budget wasn't changed."
1516   }
1517   WithdrawBudgets
1518   sim Resume
1519   MakeRunningSound
1520 }
1521
1522
1523 proc BudgetReset {{win ""}} {
1524   global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1525   if {([sim RoadFund] != $BudgetRoadFund) ||
1526       ([sim FireFund] != $BudgetFireFund) ||
1527       ([sim PoliceFund] != $BudgetPoliceFund) ||
1528       ([sim TaxRate] != $BudgetTaxRate)} {
1529     UISetMessage "The budget was reset."
1530     if {[sim Players] > 1} {
1531       UIMakeSound edit Sorry
1532     }
1533   } else {
1534     UISetMessage "The budget was reset."
1535   }
1536   sim RoadFund $BudgetRoadFund
1537   sim FireFund $BudgetFireFund
1538   sim PoliceFund $BudgetPoliceFund
1539   sim TaxRate $BudgetTaxRate
1540   set OldBudget 0
1541   ChangeBudget
1542 }
1543
1544
1545 proc BudgetCancel {{win ""}} {
1546   BudgetReset
1547   WithdrawBudgets
1548   sim Resume
1549   MakeRunningSound
1550 }
1551
1552
1553 proc SetTaxRate {rate} {
1554   sim TaxRate $rate
1555 }
1556
1557
1558 proc BudgetSetTaxRate {rate} {
1559   SetTaxRate $rate
1560   ChangeBudget
1561 }
1562
1563
1564 proc BudgetSetRoadFund {percent} {
1565   sim RoadFund $percent
1566   ChangeBudget
1567 }
1568
1569
1570 proc BudgetSetFireFund {percent} {
1571   sim FireFund $percent
1572   ChangeBudget
1573 }
1574
1575
1576 proc BudgetSetPoliceFund {percent} {
1577   sim PoliceFund $percent
1578   ChangeBudget
1579 }
1580
1581
1582 proc UIShowBudgetAndWait {} {
1583   global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1584   if {$OldBudget == 0} {
1585     set BudgetRoadFund [sim RoadFund]
1586     set BudgetFireFund [sim FireFund]
1587     set BudgetPoliceFund [sim PoliceFund]
1588     set BudgetTaxRate [sim TaxRate]
1589     set OldBudget 1
1590   }
1591   ShowBudgets
1592   UISetMessage "Pausing to set the budget ..."
1593   sim Pause
1594   MakeRunningSound
1595   StartBudgetTimer
1596   InitVotesForBudget
1597   sim UpdateBudget
1598   sim UpdateBudgetWindow
1599 }
1600
1601
1602 proc ToggleBudgetTimer {} {
1603   global BudgetTimerActive
1604   if {$BudgetTimerActive} {
1605     StopBudgetTimer
1606   } else {
1607     StartBudgetTimer
1608   }
1609 }
1610
1611
1612 proc StopBudgetTimer {} {
1613   global BudgetTimerActive
1614   set BudgetTimerActive 0
1615   UpdateBudgetTimer
1616 }
1617
1618
1619 proc StartBudgetTimer {} {
1620   global BudgetTimerActive BudgetTimer BudgetTimeout
1621   set me [Unique]
1622   set BudgetTimerActive $me
1623   set BudgetTimer $BudgetTimeout
1624   UpdateBudgetTimer
1625   after 1000 TickBudgetTimer $me
1626 }
1627
1628
1629 proc RestartBudgetTimer {} {
1630   global BudgetTimerActive
1631   if {$BudgetTimerActive} {
1632     StopBudgetTimer
1633     StartBudgetTimer
1634   }
1635 }
1636
1637
1638 proc UpdateBudgetTimer {} {
1639   global BudgetWindows BudgetTimerActive BudgetTimer
1640   if {$BudgetTimerActive} {
1641     set text [format "Auto Cancel In %d Seconds (click to disable)" $BudgetTimer]
1642   } else {
1643     set text [format "Enable Auto Cancel (currently disabled)"]
1644   }
1645   foreach win $BudgetWindows {
1646     set t [WindowLink $win.timer]
1647     $t config -text "$text"
1648   }
1649 }
1650
1651
1652 proc TickBudgetTimer {me} {
1653   global BudgetTimerActive BudgetTimer BudgetTimeout
1654   if {$BudgetTimerActive == $me} {
1655     incr BudgetTimer -1
1656     if {$BudgetTimer < 0} {
1657       StopBudgetTimer
1658       UpdateBudgetTimer
1659       FireBudgetTimer
1660     } else {
1661       UpdateBudgetTimer
1662       after 1000 TickBudgetTimer $me
1663     }
1664   }
1665 }
1666
1667
1668 proc FireBudgetTimer {} {
1669   BudgetCancel
1670 }
1671
1672
1673 proc funds {n} {
1674   sim Funds $n
1675 }
1676
1677
1678 proc ToggleAutoBudget {} {
1679   global AutoBudget
1680   if {$AutoBudget} {
1681       #echo "ToggleAutoBudget found on, clearing"
1682       sim AutoBudget 0
1683   } else {
1684       #echo "ToggleAutoBudget found off, setting"
1685       sim AutoBudget 1
1686   }
1687 }
1688
1689
1690 proc UIUpdateBudget {} {
1691   UpdateAutoBudget
1692 }
1693
1694
1695 proc UpdateAutoBudget {} {
1696   global BudgetWindows AutoBudget
1697   if {[sim AutoBudget]} {
1698     set text "Disable Auto Budget (currently enabled)"
1699   } else {
1700     set text "Enable Auto Budget (currently disabled)"
1701   }
1702   #echo "UpdateAutoBudget $AutoBudget $text"
1703   foreach win $BudgetWindows {
1704     set t [WindowLink $win.autobudget]
1705     $t config -text "$text"
1706   }
1707 }
1708
1709
1710 proc UISetBudget {cashflow previous current collected taxrate} {
1711   global BudgetWindows BudgetsVisible
1712
1713   #echo "UISetBudgetValues $taxrate $BudgetsVisible"
1714
1715   if {$BudgetsVisible} {
1716
1717     foreach win $BudgetWindows {
1718       set w [WindowLink $win.cashflow]
1719       set old [lindex [$w configure -text] 4]
1720       if {$old != $cashflow} {
1721         $w configure -text $cashflow
1722       }
1723       set w [WindowLink $win.previous]
1724       set old [lindex [$w configure -text] 4]
1725       if {$old != $previous} {
1726         $w configure -text $previous
1727       }
1728       set w [WindowLink $win.current]
1729       set old [lindex [$w configure -text] 4]
1730       if {$old != $current} {
1731         $w configure -text $current
1732       }
1733       set w [WindowLink $win.collected]
1734       set old [lindex [$w configure -text] 4]
1735       if {$old != $collected} {
1736         $w configure -text $collected
1737       }
1738
1739       set w [WindowLink $win.taxrate]
1740       set old [$w get]
1741       if {$old != $taxrate} {
1742         $w set $taxrate
1743       }
1744
1745       set w [WindowLink $win.taxlabel]
1746       set old [lindex [$w configure -text] 4]
1747       set new "$taxrate%"
1748       if {$old != $new} {
1749         $w configure -text $new
1750       }
1751     }
1752   }
1753
1754   global HeadWindows
1755   foreach win $HeadWindows {
1756
1757     set w [WindowLink $win.taxrate]
1758     set old [$w get]
1759     if {$old != $taxrate} {
1760       # FIXME: this might not work if the slider is disabled in multi player mode.
1761       $w set $taxrate
1762     }
1763
1764     set w [WindowLink $win.taxlabel]
1765     set old [lindex [$w configure -text] 4]
1766     set new "Tax Rate: $taxrate%"
1767     if {$old != $new} {
1768       $w configure -text $new
1769     }
1770   }
1771 }
1772
1773
1774 proc UISetBudgetValues {roadgot roadwant roadpercent policegot policewant policepercent firegot firewant firepercent} {
1775   global BudgetWindows BudgetsVisible
1776
1777   if {$BudgetsVisible == 0} {
1778       return;
1779   }
1780
1781   foreach win $BudgetWindows {
1782     set w [WindowLink $win.fire].request
1783     set old [lindex [$w configure -text] 4]
1784     set new "$firepercent% of $firewant = $firegot"
1785     if {$old != $new} {
1786       $w configure -text $new
1787     }
1788     set w [WindowLink $win.fire].fund
1789     set old [$w get]
1790     if {$old != $firepercent} {
1791       $w set $firepercent
1792     }
1793
1794     set w [WindowLink $win.police].request
1795     set old [lindex [$w configure -text] 4]
1796     set new "$policepercent% of $policewant = $policegot"
1797     if {$old != $new} {
1798       $w configure -text $new
1799     }
1800     set w [WindowLink $win.police].fund
1801     set old [$w get]
1802     if {$old != $policepercent} {
1803       $w set $policepercent
1804     }
1805
1806     set w [WindowLink $win.road].request
1807     set old [lindex [$w configure -text] 4]
1808     set new "$roadpercent% of $roadwant = $roadgot"
1809     if {$old != $new} {
1810       $w configure -text $new
1811     }
1812     set w [WindowLink $win.road].fund
1813     set old [$w get]
1814     if {$old != $roadpercent} {
1815       $w set $roadpercent
1816     }
1817   }
1818 }
1819
1820
1821 proc ChangeBudget {} {
1822   global VotesForBudget
1823   if {"$VotesForBudget" != ""} {
1824     InitVotesForBudget
1825   }
1826   RestartBudgetTimer
1827 }
1828
1829
1830 proc InitVotesForBudget {} {
1831   global VotesForBudget BudgetWindows
1832   set VotesForBudget {}
1833   foreach win $BudgetWindows {
1834     [WindowLink $win.vote] config -relief raised
1835   }
1836   UpdateVotesForBudget
1837 }
1838
1839
1840 proc UpdateVotesForBudget {} {
1841   global BudgetWindows
1842   UpdateVotesFor Budget $BudgetWindows
1843 }
1844
1845
1846 proc UpdateTaxRateSliders {} {
1847   global HeadWindows
1848   set players [sim Players]
1849   foreach win $HeadWindows {
1850     set slider [WindowLink $win.taxrate]
1851     #echo "UpdateTaxRateSliders players $players win $win slider $slider"
1852     if {$players == 1} {
1853       $slider configure -state normal
1854     } else {
1855       $slider configure -state disabled
1856     }
1857   }
1858 }
1859
1860
1861 ########################################################################
1862 # Evaluation Window Handlers
1863
1864
1865 proc ToggleEvaluationOf {head} {
1866   global State
1867   if {"$State" != "play"} {
1868     return
1869   }
1870
1871   set mapped 0
1872   set win [WindowLink $head.evaluation]
1873   if {$win != ""} {
1874     set mapped [winfo ismapped $win]
1875   }
1876
1877   if {$mapped} {
1878     WithdrawEvaluationOf $head
1879   } else {
1880     ShowEvaluationOf $head
1881   }
1882
1883 }
1884
1885
1886 proc WithdrawEvaluationOf {head} {
1887   set win [WindowLink $head.evaluation]
1888   if {"$win" != ""} {
1889     pack unpack $win
1890   }
1891 }
1892
1893
1894 proc ShowEvaluationOf {head} {
1895   set win [WindowLink $head.evaluation]
1896   if {$win == {}} {
1897     set win [MakeWindow.evaluation $head [winfo screen $head]]
1898   }
1899   #wm raise $win
1900   #wm deiconify $win
1901   set parent [WindowLink $win.parent]
1902   #pack append [WindowLink $head.col2]\
1903   #  $parent {top frame nw fill}
1904   pack append $parent\
1905     $win {top frame nw fillx}
1906   update idletasks
1907   sim UpdateEvaluation
1908 }
1909
1910
1911 proc WithdrawEvaluations {} {
1912   global EvaluationWindows EvaluationsVisible
1913   foreach win $EvaluationWindows {
1914     #wm withdraw $win
1915     #set parent [WindowLink $win.parent]
1916     #pack unpack $parent
1917     pack unpack $win
1918   }
1919   set EvaluationsVisible 0
1920 }
1921
1922
1923 proc EvaluationVisible {w v} {
1924     global EvaluationsVisible
1925     global [set var $w.visible]
1926
1927     set $var $v
1928
1929     if ($v) {
1930         set EvaluationsVisible [expr "$EvaluationsVisible + 1"]
1931     } else {
1932         set EvaluationsVisible [expr "$EvaluationsVisible - 1"]
1933     }
1934 }
1935
1936
1937 proc UISetEvaluation {changed score ps0 ps1 ps2 ps3 pv0 pv1 pv2 pv3 pop delta assessed cityclass citylevel goodyes goodno title} {
1938   global EvaluationWindows EvaluationsVisible CurrentDate
1939
1940   set class [string tolower $cityclass]
1941   UISetMessage "$CurrentDate: Score $score, $class population $pop."
1942
1943   if {$EvaluationsVisible} {
1944
1945     foreach win $EvaluationWindows {
1946
1947       global [set var $win.visible]
1948       set visible [eval ident "\$\{$var\}"]
1949
1950       if {$visible} {
1951
1952         # TODO: set evaluation window and icon title
1953         #wm title $win "$title"
1954         #wm iconname $win "$title"
1955
1956         set w [WindowLink $win.goodjob]
1957         set old [lindex [$w configure -text] 4]
1958         set new "$goodyes\n$goodno"
1959         if {$old != $new} {
1960           $w configure -text $new
1961         }
1962
1963         set w [WindowLink $win.problemnames]
1964         set old [lindex [$w configure -text] 4]
1965         set new "$ps0\n$ps1\n$ps2\n$ps3"
1966         if {$old != $new} {
1967           $w configure -text $new
1968         }
1969
1970         set w [WindowLink $win.problempercents]
1971         set old [lindex [$w configure -text] 4]
1972         set new "$pv0\n$pv1\n$pv2\n$pv3"
1973         if {$old != $new} {
1974           $w configure -text $new
1975         }
1976
1977         set w [WindowLink $win.stats]
1978         set old [lindex [$w configure -text] 4]
1979         set new "$pop\n$delta\n\n$assessed\n$cityclass\n$citylevel"
1980         if {$old != $new} {
1981           $w configure -text $new
1982         }
1983
1984         set w [WindowLink $win.score]
1985         set old [lindex [$w configure -text] 4]
1986         set new "$score\n$changed"
1987         if {$old != $new} {
1988           $w configure -text $new
1989         }
1990       }
1991     }
1992   }
1993 }
1994
1995
1996 ########################################################################
1997 # File Window Handlers
1998
1999
2000 proc ShowFileOf {head} {
2001   set win [WindowLink $head.file]
2002   if {$win == {}} {
2003     set win [MakeWindow.file $head [winfo screen $head]]
2004   }
2005   wm deiconify $win
2006   wm raise $win
2007   return $win
2008 }
2009
2010
2011 proc ShowFiles {} {
2012   global HeadWindows
2013   foreach win $HeadWindows {
2014     ShowFileOf $win
2015   }
2016 }
2017
2018
2019 proc WithdrawFiles {} {
2020   global FileWindows
2021   foreach win $FileWindows {
2022     wm withdraw $win
2023   }
2024 }
2025
2026
2027 proc DoFileDialog {win Message Path Pattern FileName ActionOk ActionCancel} {
2028   ShowFileDialog $win "$Path" "$Pattern"
2029   $win.message1 configure -text "$Message"
2030   $win.path.path delete 0 end
2031   $win.path.path insert 0 $Path
2032   $win.file.file delete 0 end
2033   $win.file.file insert 0 "$FileName"
2034   $win.frame1.ok config -command "
2035       $ActionOk \[$win.file.file get\] \[$win.path.path get\]
2036       wm withdraw $win"
2037   $win.frame1.rescan config -command "
2038       ShowFileDialog $win \[$win.path.path get\] $Pattern"
2039   $win.frame1.cancel config -command "
2040       $ActionCancel
2041       wm withdraw $win"
2042   bind $win.files.files "<Double-Button-1>" "\
2043     FileSelectDouble $win %W %y $Pattern \"
2044         $ActionOk \[$win.file.file get\] \[$win.path.path get\]\""
2045   bind $win.path.path <Return> "
2046     ShowFileDialog $win \[$win.path.path get\] $Pattern
2047     $win.file.file cursor 0
2048     focus $win.file.file"
2049   bind $win.file.file <Return> "\
2050     $ActionOk \[$win.file.file get\] \[$win.path.path get]
2051     wm withdraw $win"
2052 }
2053
2054
2055 proc BindSelectOne {win Y} {
2056   set Nearest [$win nearest $Y]
2057   if {$Nearest >= 0} {
2058     $win select from $Nearest
2059     $win select to $Nearest
2060   }
2061 }
2062
2063
2064 proc FileSelect {win widget Y} {
2065   BindSelectOne $widget $Y
2066   set Nearest [$widget nearest $Y]
2067   if {$Nearest >= 0} {
2068     set Path [$win.path.path get]
2069     set TmpEntry [$widget get $Nearest]
2070     if {[string compare "/" [string index $TmpEntry \
2071           [expr [string length $TmpEntry]-1]]] == 0 || \
2072         [string compare "@" [string index $TmpEntry \
2073           [expr [string length $TmpEntry]-1]]] == 0} {
2074       # handle directories, and symbolic links to directories
2075       set FileName [string range $TmpEntry 0 \
2076             [expr [string length $TmpEntry]-2]]
2077       # whoops / or @ is part of the name
2078       if {[MiscIsDir $Path/$FileName] != 1} {
2079         set FileName $TmpEntry
2080       }
2081     } {
2082       if {[string compare "*" [string index $TmpEntry \
2083             [expr [string length $TmpEntry]-1]]] == 0} {
2084         # handle executable filenames
2085         set FileName [string range $TmpEntry 0 \
2086               [expr [string length $TmpEntry]-2]]
2087         # whoops * is part of the name
2088         if {[file executable $Path/$FileName] != 1} {
2089           set FileName $TmpEntry
2090         }
2091       } {
2092         # a ordinary filename
2093         set FileName $TmpEntry
2094       }
2095     }
2096     # enter the selected filename into the filename field
2097     if {[MiscIsDir $Path/$FileName] != 1} {
2098       $win.file.file delete 0 end
2099       $win.file.file insert 0 $FileName
2100     }
2101   }
2102 }
2103
2104
2105 proc FileSelectDouble {win widget Y Pattern Action} {
2106   BindSelectOne $widget $Y
2107   set Nearest [$widget nearest $Y]
2108   if {$Nearest >= 0} {
2109     set Path [$win.path.path get]
2110     set TmpEntry [$widget get $Nearest]
2111     if {[string compare $TmpEntry "../"] == 0} {
2112       # go up one directory
2113       set TmpEntry \
2114         [string trimright [string trimright [string trim $Path] /] @]
2115       if {[string length $TmpEntry] <= 0} {
2116         return
2117       }
2118       set Path [file dirname $TmpEntry]
2119       $win.path.path delete 0 end
2120       $win.path.path insert 0 $Path
2121       ShowFileDialog $win $Path $Pattern
2122     } {
2123       if {[string compare "/" [string index $TmpEntry \
2124             [expr [string length $TmpEntry]-1]]] == 0 || \
2125           [string compare "@" [string index $TmpEntry \
2126             [expr [string length $TmpEntry]-1]]] == 0} {
2127         # handle directorys, and symbolic links to directorys
2128         set FileName [string range $TmpEntry 0 \
2129               [expr [string length $TmpEntry]-2]]
2130         # whoops / or @ is part of the name
2131         if {[MiscIsDir $Path/$FileName] != 1} {
2132           set FileName $TmpEntry
2133         }
2134       } {
2135         if {[string compare "*" [string index $TmpEntry \
2136               [expr [string length $TmpEntry]-1]]] == 0} {
2137           # handle executable filenames
2138           set FileName [string range $TmpEntry 0 \
2139                 [expr [string length $TmpEntry]-2]]
2140           # whoops * is part of the name
2141           if {[file executable $Path/$FileName] != 1} {
2142             set FileName $TmpEntry
2143           }
2144         } {
2145           # a ordinary filename
2146           set FileName $TmpEntry
2147         }
2148       }
2149       # change directory
2150       if {[MiscIsDir $Path/$FileName] == 1} {
2151         if {[string compare "/" [string index $Path \
2152               [expr [string length $Path]-1]]] == 0} {
2153            append Path $FileName
2154         } {
2155           append Path / $FileName
2156         }
2157         $win.path.path delete 0 end
2158         $win.path.path insert 0 $Path
2159         ShowFileDialog $win $Path $Pattern
2160       } {
2161         # enter the selected filename into the filename field
2162         $win.file.file delete 0 end
2163         $win.file.file insert 0 "$FileName"
2164         if {[string length $Action] > 0} {
2165           eval $Action
2166         }
2167         wm withdraw $win
2168       }
2169     }
2170   }
2171 }
2172
2173
2174 proc NameComplete {win Type} {
2175
2176   set NewFile ""
2177   set Matched ""
2178
2179   if {[string compare $Type path] == 0} {
2180     set DirName [file dirname [$win.path.path get]]
2181     set FileName [file tail [$win.path.path get]]
2182   } {
2183     set DirName [file dirname [$win.path.path get]/]
2184     set FileName [file tail [$win.file.file get]]
2185   }
2186
2187   set FoundCounter 0
2188   if {[MiscIsDir $DirName] == 1} {
2189     catch "exec ls $DirName/" Result
2190     set Counter 0
2191     set ListLength [llength $Result]
2192     # go through list
2193     while {$Counter < $ListLength} {
2194       if {[string length $FileName] == 0} {
2195         if {$FoundCounter == 0} {
2196           set NewFile [lindex $Result $Counter]
2197         } {
2198           set Counter1 0
2199           set TmpFile1 $NewFile
2200           set TmpFile2 [lindex $Result $Counter]
2201           set Length1 [string length $TmpFile1]
2202           set Length2 [string length $TmpFile2]
2203           set NewFile ""
2204           if {$Length1 > $Length2} {
2205             set Length1 $Length2
2206           }
2207           while {$Counter1 < $Length1} {
2208             if {[string compare [string index $TmpFile1 $Counter1] \
2209                   [string index $TmpFile2 $Counter1]] == 0} {
2210               append NewFile [string index $TmpFile1 $Counter1]
2211             } {
2212               break
2213             }
2214             incr Counter1 1
2215           }
2216         }
2217         incr FoundCounter 1
2218       } {
2219         if {[regexp "^$FileName" [lindex $Result $Counter] \
2220               Matched] == 1} {
2221           if {$FoundCounter == 0} {
2222             set NewFile [lindex $Result $Counter]
2223           } {
2224             set Counter1 0
2225             set TmpFile1 $NewFile
2226             set TmpFile2 [lindex $Result $Counter]
2227             set Length1 [string length $TmpFile1]
2228             set Length2 [string length $TmpFile2]
2229             set NewFile ""
2230             if {$Length1 > $Length2} {
2231               set Length1 $Length2
2232             }
2233             while {$Counter1 < $Length1} {
2234               if {[string compare [string index $TmpFile1 $Counter1] \
2235                     [string index $TmpFile2 $Counter1]] == 0} {
2236                 append NewFile [string index $TmpFile1 $Counter1]
2237               } {
2238                 break
2239               }
2240               incr Counter1 1
2241             }
2242           }
2243           incr FoundCounter 1
2244         }
2245       }
2246       incr Counter 1
2247     }
2248   }
2249
2250   if {$FoundCounter == 1} {
2251     if {[MiscIsDir $DirName/$NewFile] == 1} {
2252       if {[string compare $DirName "/"] == 0} {
2253         $win.path.path delete 0 end
2254         $win.path.path insert 0 "/[string trim [string trim $NewFile /] @]/"
2255       } {
2256         $win.path.path delete 0 end
2257         $win.path.path insert 0 "[string trimright $DirName /]/[string trim [string trim $NewFile /] @]/"
2258       }
2259     } {
2260       $win.path.path delete 0 end
2261       $win.path.path insert 0 \
2262         "[string trim [string trimright $DirName /] @]/"
2263       $win.file.file delete 0 end
2264       $win.file.file insert 0 "$NewFile"
2265     }
2266   } {
2267     if {[MiscIsDir $DirName/$NewFile] == 1 ||
2268         [string compare $Type path] == 0} {
2269       $win.path.path delete 0 end
2270       $win.path.path insert 0 \
2271         "[string trimright $DirName /]/[string trim [string trim $NewFile /] @]"
2272     } {
2273       $win.path.path delete 0 end
2274       $win.path.path insert 0 "$DirName"
2275       if {[string length $NewFile] > 0} {
2276         $win.file.file delete 0 end
2277         $win.file.file insert 0 "$NewFile"
2278       }
2279     }
2280   }
2281 }
2282
2283
2284 proc ShowFileDialog {win Path Pattern} {
2285   busy $win {
2286     set Path [lindex [split $Path] 0]
2287     if {[$win.files.files size] > 0} {
2288       $win.files.files delete 0 end
2289     }
2290     # read directory
2291     if {[catch "exec ls -F $Path" Result]} {
2292       set ElementList {}
2293     }
2294     if {[string match $Result "* not found"]} {
2295       set ElementList {}
2296     }
2297     set ElementList [lsort $Result]
2298
2299     # insert ..
2300     if {[string compare $Path "/"]} {
2301       $win.files.files insert end "../"
2302     }
2303
2304     # walk through list
2305     foreach Counter $ElementList {
2306       # insert filename
2307       if {[string match $Pattern $Counter] == 1} {
2308         if {[string compare $Counter "../"] &&
2309             [string compare $Counter "./"]} {
2310           $win.files.files insert end $Counter
2311         }
2312       } else {
2313         set fn $Path/[string trim [string trim [string trim $Counter /] @] *]
2314         if {[MiscIsDir $fn]} {
2315           $win.files.files insert end $Counter
2316         }
2317       }
2318     }
2319   }
2320 }
2321
2322
2323 proc MiscIsDir {PathName} {
2324
2325   if {[file isdirectory $PathName] == 1} {
2326     return 1
2327   } {
2328     catch "file type $PathName" Type
2329     if {[string compare $Type link] == 0} {
2330       set LinkName [file readlink $PathName]
2331       catch "file type $LinkName" Type
2332       while {[string compare $Type link] == 0} {
2333         set LinkName [file readlink $LinkName]
2334       }
2335       return [file isdirectory $LinkName]
2336     }
2337   }
2338   return 0
2339 }
2340
2341
2342 proc busy {win cmds} {
2343     set busy {}
2344     set list [winfo children $win]
2345     set busy $list
2346     while {$list != ""} {
2347         set next {}
2348         foreach w $list {
2349             set class [winfo class $w]
2350             set cursor [lindex [$w config -cursor] 4]
2351             if {[winfo toplevel $w] == $w} {
2352                 lappend busy [list $w $cursor]
2353             }
2354             set next [concat $next [winfo children $w]]
2355         }
2356         set list $next
2357     }
2358
2359     foreach w $busy {
2360         catch {[lindex $w 0] config -cursor watch}
2361     }
2362
2363     update idletasks
2364
2365     set error [catch {uplevel eval [list $cmds]} result]
2366
2367     foreach w $busy {
2368         catch {[lindex $w 0] config -cursor [lindex $w 1]}
2369     }
2370
2371     if $error {
2372         error $result
2373     } else {
2374         return $result
2375     }
2376 }
2377
2378
2379 ########################################################################
2380 # Editor Window Handlers
2381
2382 proc ShowEditorOf {head} {
2383   global EditorWindows
2384   set found 0
2385   foreach win $EditorWindows {
2386     if {[WindowLink $win.head] == $head} {
2387       set parent [WindowLink $win.parent]
2388       #pack append [WindowLink $head.col2]\
2389       #  $parent {top frame nw expand fill}
2390       pack append $parent\
2391         $win {top frame nw expand fill}
2392       set found 1
2393     }
2394   }
2395   if {$found == 0} {
2396     NewEditorOf $head
2397   } else {
2398     update idletasks
2399     sim UpdateEditors
2400     sim UpdateMaps
2401   }
2402 }
2403
2404
2405 proc NewEditorOf {head} {
2406   set win [MakeWindow.editor $head [winfo screen $head]]
2407   #wm deiconify $win
2408   set parent [WindowLink $win.parent]
2409   pack append $parent\
2410     $win {top frame nw expand fill}
2411   update idletasks
2412   sim UpdateEditors
2413   sim UpdateMaps
2414 }
2415
2416
2417 proc ShowEditors {} {
2418   global HeadWindows
2419   foreach win $HeadWindows {
2420     ShowEditorOf $win
2421   }
2422 }
2423
2424
2425 proc WithdrawEditors {} {
2426   global EditorWindows
2427   foreach win $EditorWindows {
2428     #set parent [WindowLink $win.parent]
2429     #pack unpack $parent
2430     pack unpack $win
2431   }
2432 }
2433
2434
2435 proc InitEditors {} {
2436   global EditorWindows
2437   foreach win $EditorWindows {
2438     InitEditor $win
2439   }
2440 }
2441
2442
2443 proc InitEditor {win} {
2444   set e [WindowLink $win.view]
2445   UISetToolState $win 7
2446   $e ToolState 7
2447   set size [$e size]
2448   $e Pan 960 800
2449   $e AutoGoing 0
2450   global $e.TrackState
2451   set $e.TrackState {}
2452 }
2453
2454
2455 proc SetEditorAutoGoto {win val} {
2456   global AutoGoto.$win
2457   set AutoGoto.$win $val
2458   set e [WindowLink $win.view]
2459   $e AutoGoto $val
2460 }
2461
2462
2463 proc SetEditorControls {win val} {
2464   global Controls.$win
2465   set Controls.$win $val
2466   if {$val} {
2467     pack append $win $win.leftframe {left frame center filly}
2468   } else {
2469     pack unpack $win.leftframe
2470   }
2471 }
2472
2473
2474 proc SetEditorOverlay {win val} {
2475   global Overlay.$win
2476   set Overlay.$win $val
2477   set e [WindowLink $win.view]
2478   $e ShowOverlay $val
2479 }
2480
2481
2482 proc SetEditorDynamicFilter {win val} {
2483   global DynamicFilter.$win
2484   set DynamicFilter.$win $val
2485   set e [WindowLink $win.view]
2486   $e DynamicFilter $val
2487   if {$val == 1} then {
2488     ShowFrobOf [WindowLink $win.head]
2489   }
2490 }
2491
2492
2493 proc SetEditorSkip {win val} {
2494   set e [WindowLink $win.view]
2495   $e Skip $val
2496 }
2497
2498
2499 proc EditorToolDown {mod w x y} {
2500   global [set var $w.TrackState]
2501
2502   $w ToolMode 1
2503
2504   case [$w ToolState] in \
2505     7 { # bulldozer
2506       UIMakeSoundOn $w edit Rumble "-repeat 4"
2507     } \
2508     10 { # chalk
2509       StartChalk $w
2510     }
2511
2512   case $mod in \
2513     constrain {
2514       set $var [list constrain_start $x $y]
2515       $w ToolConstrain $x $y
2516     } \
2517     default {
2518       set $var none
2519     }
2520   EditorTool ToolDown $w $x $y
2521   sim NeedRest 5
2522 }
2523
2524
2525 proc EditorToolDrag {w x y} {
2526   EditorTool ToolDrag $w $x $y
2527   sim NeedRest 5
2528 }
2529
2530
2531 proc EditorToolUp {w x y} {
2532   global [set var $w.TrackState]
2533   $w ToolMode 0
2534
2535   case [$w ToolState] in \
2536     7 { # bulldozer
2537      UIStopSoundOn $w edit 1
2538     } \
2539     10 { # chalk
2540       StopChalk $w
2541     }
2542
2543   EditorTool ToolUp $w $x $y
2544   set $var {}
2545   $w ToolConstrain -1 -1
2546   sim UpdateMaps
2547   sim UpdateEditors
2548   sim NeedRest 5
2549 }
2550
2551
2552 proc EditorTool {action w x y} {
2553   global [set var $w.TrackState]
2554   set state [eval ident "\$\{$var\}"]
2555   case [lindex $state 0] in \
2556     constrain_start {
2557       set x0 [lindex $state 1]
2558       set y0 [lindex $state 2]
2559       set dx [expr "$x - $x0"]
2560       set dy [expr "$y - $y0"]
2561       if [expr "($dx > 16) || ($dx < -16)"] then {
2562         $w ToolConstrain -1 $y0
2563         set $var none
2564       } else {
2565         if [expr "($dy > 16) || ($dy < -16)"] then {
2566           $w ToolConstrain $x0 -1
2567           set $var none
2568         }
2569       }
2570     }
2571   $w $action $x $y
2572 }
2573
2574
2575 proc StartChalk {w} {
2576   sim CollapseMotion 0
2577 }
2578
2579
2580 proc StopChalk {w} {
2581   sim CollapseMotion 1
2582 }
2583
2584
2585 proc EditorPanDown {mod w x y} {
2586   global [set var $w.TrackState]
2587   $w ToolMode -1
2588   case $mod in \
2589     constrain {
2590       set $var [list constrain_start $x $y]
2591       $w ToolConstrain $x $y
2592     } \
2593     default {
2594       set $var none
2595     }
2596   EditorTool PanStart $w $x $y
2597 }
2598
2599
2600 proc EditorPanDrag {w x y} {
2601   EditorTool PanTo $w $x $y
2602 }
2603
2604
2605 proc EditorPanUp {w x y} {
2606   $w AutoGoing 0
2607   $w ToolMode 0
2608   EditorTool PanTo $w $x $y
2609   $w ToolConstrain -1 -1
2610   sim UpdateMaps
2611   sim UpdateEditors
2612 }
2613
2614
2615 proc EditorKeyDown {w k} {
2616   $w KeyDown $k
2617 }
2618
2619
2620 proc EditorKeyUp {w k} {
2621   $w KeyUp $k
2622 }
2623
2624
2625 proc BindEditorButtons {win} {
2626   set w [WindowLink $win.top]
2627
2628   bind $win <1> "CancelPie $win ; EditorToolDown none %W %x %y"
2629   bind $win <B1-Motion> {EditorToolDrag %W %x %y}
2630   bind $win <ButtonRelease-1> {EditorToolUp %W %x %y}
2631
2632   bind $win <Control-1> "CancelPie $win ; EditorToolDown constrain %W %x %y"
2633   bind $win <Control-B1-Motion> {EditorToolDrag %W %x %y}
2634   bind $win <Control-ButtonRelease-1> {EditorToolUp %W %x %y}
2635
2636   bind $win <2> "CancelPie $win ; EditorPanDown none %W %x %y"
2637   bind $win <B2-Motion> {EditorPanDrag %W %x %y}
2638   bind $win <ButtonRelease-2> {EditorPanUp %W %x %y}
2639
2640   bind $win <Control-2> "CancelPie $win ; EditorPanDown constrain %W %x %y"
2641   bind $win <Control-B2-Motion> {EditorPanDrag %W %x %y}
2642   bind $win <Control-ButtonRelease-2> {EditorPanUp %W %x %y}
2643
2644   InitPie $win $w.toolpie
2645 }
2646
2647
2648 proc UISetFunds {funds} {
2649   global HeadWindows
2650   foreach win $HeadWindows {
2651     [WindowLink $win.funds] configure -text "$funds"
2652   }
2653 }
2654
2655
2656 proc UISetDate {date month year} {
2657   global HeadWindows
2658   global CurrentDate
2659
2660   set CurrentDate "$date"
2661
2662   foreach win $HeadWindows {
2663     [WindowLink $win.date] Set $month $year
2664   }
2665 }
2666
2667
2668 proc SetPriority {index} {
2669   case $index { \
2670     {0} {
2671       sim Delay 500000
2672       sim Skips 0
2673     } \
2674     {1} {
2675       sim Delay 100000
2676       sim Skips 0
2677     } \
2678     {2} {
2679       sim Delay 25000
2680       sim Skips 0
2681     } \
2682     {3} {
2683       sim Delay 5000
2684       sim Skips 20
2685     } \
2686     {4} {
2687       sim Delay 5
2688       sim Skips 500
2689     }
2690   }
2691 }
2692
2693
2694 proc UISetDemand {r c i} {
2695   global HeadWindows DemandRes DemandCom DemandInd
2696
2697   set DemandRes $r
2698   set DemandCom $c
2699   set DemandInd $i
2700
2701   if {$r <= 0} then {set ry0 32} else {set ry0 24}
2702   set ry1 [expr "$ry0 - $r"]
2703   if {$c <= 0} then {set cy0 32} else {set cy0 24}
2704   set cy1 [expr "$cy0 - $c"]
2705   if {$i <= 0} then {set iy0 32} else {set iy0 24}
2706   set iy1 [expr "$iy0 - $i"]
2707
2708   foreach win $HeadWindows {
2709     set can [WindowLink $win.demand]
2710 #    $can coords r 8 $ry0 14 $ry1
2711 #    $can coords c 17 $cy0 23 $cy1
2712 #    $can coords i 26 $iy0 32 $iy1
2713     $can coords r 49 $ry0 55 $ry1
2714     $can coords c 58 $cy0 64 $cy1
2715     $can coords i 67 $iy0 73 $iy1
2716   }
2717 }
2718
2719
2720 proc UISetOptions {autobudget autogoto autobulldoze disasters sound animation messages notices} {
2721   global AutoBudget AutoGoto AutoBulldoze Disasters Sound
2722   set AutoBudget $autobudget
2723   set AutoGoto $autogoto
2724   set AutoBulldoze $autobulldoze
2725   set Disasters $disasters
2726   set Sound $sound
2727   set DoAnimation $animation
2728   set DoMessages $messages
2729   set DoNotices $notices
2730 }
2731
2732
2733 proc UIDidToolRes {win x y} {
2734   UIMakeSoundOn $win edit O "-speed 140"
2735 }
2736
2737
2738 proc UIDidToolCom {win x y} {
2739   UIMakeSoundOn $win edit A "-speed 140"
2740 }
2741
2742
2743 proc UIDidToolInd {win x y} {
2744   UIMakeSoundOn $win edit E "-speed 140"
2745 }
2746
2747
2748 proc UIDidToolFire {win x y} {
2749   UIMakeSoundOn $win edit O "-speed 130"
2750 }
2751
2752
2753 proc UIDidToolQry {win x y} {
2754   UIMakeSoundOn $win edit E "-speed 200"
2755 }
2756
2757
2758 proc UIDidToolPol {win x y} {
2759   UIMakeSoundOn $win edit E "-speed 130"
2760 }
2761
2762
2763 proc UIDidToolWire {win x y} {
2764   UIMakeSoundOn $win edit O "-speed 120"
2765 }
2766
2767
2768 proc UIDidToolDozr {win x y} {
2769   UIMakeSoundOn $win edit Rumble
2770 }
2771
2772
2773 proc UIDidToolRail {win x y} {
2774   UIMakeSoundOn $win edit O "-speed 100"
2775 }
2776
2777
2778 proc UIDidToolRoad {win x y} {
2779   UIMakeSoundOn $win edit E "-speed 100"
2780 }
2781
2782
2783 proc UIDidToolChlk {win x y} {
2784 }
2785
2786
2787 proc UIDidToolEraser {win x y} {
2788 }
2789
2790
2791 proc UIDidToolStad {win x y} {
2792   UIMakeSoundOn $win edit O "-speed 90"
2793 }
2794
2795
2796 proc UIDidToolPark {win x y} {
2797   UIMakeSoundOn $win edit A "-speed 130"
2798 }
2799
2800
2801 proc UIDidToolSeap {win x y} {
2802   UIMakeSoundOn $win edit E "-speed 90"
2803 }
2804
2805
2806 proc UIDidToolCoal {win x y} {
2807   UIMakeSoundOn $win edit O "-speed 75"
2808 }
2809
2810
2811 proc UIDidToolNuc {win x y} {
2812   UIMakeSoundOn $win edit E "-speed 75"
2813 }
2814
2815
2816 proc UIDidToolAirp {win x y} {
2817   UIMakeSoundOn $win edit A "-speed 50"
2818 }
2819
2820
2821 proc UISetToolState {w state} {
2822   global EditorPallets EditorPalletImages ToolInfo
2823   set win [WindowLink $w.top]
2824   #echo "UISETTOOLSTATE w $w win $win $state"
2825   ExclusivePallet $state $win $EditorPallets ic $EditorPalletImages \
2826         raised sunken {NoFunction}
2827         {NoFunction}
2828   set c1 [WindowLink $w.cost1]
2829   if {"$c1" != ""} {
2830     set info [lindex $ToolInfo $state]
2831     set cost1 [lindex $info 1]
2832     set cost2 [lindex $info 2]
2833     $c1 configure -text "$cost1"
2834     [WindowLink $w.cost2] configure -text "$cost2"
2835   }
2836 }
2837
2838
2839 proc UIShowZoneStatus {zone density value crime pollution growth x y} {
2840   global QueryX QueryY
2841   set QueryX [expr "8 + 16 * $x"]
2842   set QueryY [expr "8 + 16 * $y"]
2843   UIShowPicture 9 [list $zone $density $value $crime $pollution $growth]
2844 }
2845
2846
2847 ########################################################################
2848 # Map Window Handlers
2849
2850
2851 proc ShowMapOf {head} {
2852   global MapWindows
2853   set found 0
2854   foreach win $MapWindows {
2855     if {"[WindowLink $win.head]" == "$head"} {
2856       global MapPanelWidth MapPanelHeight
2857       #place configure $win -x 0 -y 0 -width $MapPanelWidth -height $MapPanelHeight
2858       #[WindowLink $win.parent] configure -width $MapPanelWidth -height $MapPanelHeight
2859       set parent [WindowLink $win.parent]
2860       pack append [WindowLink $head.w2] \
2861           $win {top frame nw expand fill}
2862       set found 1
2863     }
2864   }
2865   if {$found == 0} {
2866     NewMapOf $head
2867   } else {
2868     update idletasks
2869     sim UpdateMaps
2870   }
2871 }
2872
2873
2874 proc NewMapOf {head} {
2875   set win [MakeWindow.map $head [winfo screen $head]]
2876   global MapPanelWidth MapPanelHeight
2877   #place configure $win -x 0 -y 0 -width $MapPanelWidth -height $MapPanelHeight
2878   #[WindowLink $win.parent] configure -width $MapPanelWidth -height $MapPanelHeight
2879   set parent [WindowLink $win.parent]
2880   #pack append [WindowLink $head.col1]\
2881   #  $parent {top frame nw fillx}
2882   pack append [WindowLink $head.w2] \
2883       $win {top frame nw expand fill}
2884   sim UpdateMaps
2885 }
2886
2887
2888 proc ShowMaps {} {
2889   global HeadWindows
2890   foreach win $HeadWindows {
2891     ShowMapOf $win
2892   }
2893 }
2894
2895
2896 proc WithdrawMaps {} {
2897   global MapWindows
2898   foreach win $MapWindows {
2899     #place forget $win
2900     pack unpack $win
2901   }
2902 }
2903
2904
2905 proc InitMaps {} {
2906   global MapWindows
2907   foreach win $MapWindows {
2908     InitMap $win
2909   }
2910 }
2911
2912
2913 proc InitMap {win} {
2914   SetMapState $win 0
2915 }
2916
2917
2918 proc EnableMaps {} {
2919   global MapWindows
2920   foreach win $MapWindows {
2921     EnableMap $win
2922   }
2923 }
2924
2925
2926 proc EnableMap {win} {
2927   [WindowLink $win.view] ShowEditors 1
2928   [WindowLink $win.zones] config -state normal
2929   [WindowLink $win.overlays] config -state normal
2930 }
2931
2932
2933 proc DisableMaps {} {
2934   global MapWindows
2935   foreach win $MapWindows {
2936     DisableMap $win
2937   }
2938 }
2939
2940
2941 proc DisableMap {win} {
2942   [WindowLink $win.view] ShowEditors 0
2943   [WindowLink $win.zones] config -state disabled
2944   [WindowLink $win.overlays] config -state disabled
2945 }
2946
2947
2948 proc SetMapState {win state} {
2949   set m [WindowLink $win.view]
2950   $m MapState $state
2951   if {$state == 14} then {
2952     ShowFrobOf [WindowLink $win.head]
2953   }
2954 }
2955
2956
2957 proc MapPanDown {w x y} {
2958   $w PanStart $x $y
2959 }
2960
2961
2962 proc MapPanDrag {w x y} {
2963   $w PanTo $x $y
2964 }
2965
2966
2967 proc MapPanUp {w x y} {
2968   $w PanTo $x $y
2969   sim UpdateMaps
2970   sim UpdateEditors
2971 }
2972
2973
2974 proc UISetMapState {w state} {
2975   global MapTitles
2976   #set win [winfo toplevel $w]
2977   set win [WindowLink $w.win]
2978   set m [WindowLink $win.view]
2979   set title [lindex $MapTitles $state]
2980
2981   # TODO: set map text field header to title
2982   #wm title $win "$title"
2983   #wm iconname $win "$title"
2984
2985   global [set var MapState.$win]
2986   set $var $state
2987
2988   case $state { \
2989     {6 8 9 10 11 12 13} {
2990       [WindowLink $win.legend] config -bitmap "@images/legendmm.xpm"
2991     } \
2992     {7} {
2993       [WindowLink $win.legend] config -bitmap "@images/legendpm.xpm"
2994     } \
2995     {0 1 2 3 4 5 14} {
2996       [WindowLink $win.legend] config -bitmap "@images/legendn.xpm"
2997     }
2998   }
2999 }
3000
3001
3002 ########################################################################
3003 # Graph Window Handlers
3004
3005
3006 proc ToggleGraphOf {head} {
3007   global State
3008   if {"$State" != "play"} {
3009     return
3010   }
3011
3012   set mapped 0
3013   set win [WindowLink $head.graph]
3014   if {$win != ""} {
3015     set mapped [winfo ismapped $win]
3016   }
3017
3018   if {$mapped} {
3019     WithdrawGraphOf $head
3020   } else {
3021     ShowGraphOf $head
3022   }
3023
3024 }
3025
3026
3027 proc WithdrawGraphOf {head} {
3028   set win [WindowLink $head.graph]
3029   if {"$win" != ""} {
3030     pack unpack $win
3031   }
3032 }
3033
3034
3035 proc ShowGraphOf {head} {
3036   set win [WindowLink $head.graph]
3037   if {$win == {}} {
3038     set win [MakeWindow.graph $head [winfo screen $head]]
3039   }
3040   #wm deiconify $win
3041   #wm raise $win
3042   set parent [WindowLink $win.parent]
3043   pack append $parent\
3044     $win {top frame nw fillx}
3045   update idletasks
3046   sim UpdateGraphs
3047 }
3048
3049
3050 proc WithdrawGraphs {} {
3051   global GraphWindows
3052   foreach win $GraphWindows {
3053     #wm withdraw $win
3054     pack unpack $win
3055   }
3056 }
3057
3058
3059 proc InitGraphs {} {
3060   global GraphWindows
3061   foreach win $GraphWindows {
3062     InitGraph $win
3063   }
3064 }
3065
3066
3067 proc InitGraph {win} {
3068   UISetGraphState $win 1 1 1 1 1 1 0
3069 }
3070
3071
3072 proc UISetGraphState {win t0 t1 t2 t3 t4 t5 range} {
3073   set g [WindowLink $win.graphview]
3074   GraphPalletMask $win [expr "$t0 + ($t1<<1) + ($t2<<2) + ($t3<<3) + ($t4<<4) + ($t5<<5)"]
3075   GraphYearPallet $win $range
3076 }
3077
3078
3079 ########################################################################
3080 # Splash Window Handlers
3081
3082
3083 proc ShowSplashOf {head} {
3084   set win [WindowLink $head.splash]
3085   if {$win == {}} {
3086     set win [MakeWindow.splash $head [winfo screen $head]]
3087   }
3088   set splashscreen [WindowLink $win.splashscreen]
3089   set success 0
3090   catch {$splashscreen config -bitmap "@images/splashscreen.xpm"; set success 1}
3091   if {$success} {
3092     wm deiconify $win
3093     global SplashScreenDelay
3094     after $SplashScreenDelay "UIPickScenarioMode"
3095   } else {
3096     UIPickScenarioMode
3097   }
3098 }
3099
3100
3101 proc WithdrawSplashOf {head} {
3102   set win WindowLink $head.splash]
3103   wm withdraw $win
3104 }
3105
3106
3107 proc ShowSplashes {} {
3108   global HeadWindows
3109   foreach win $HeadWindows {
3110     ShowSplashOf $win
3111   }
3112 }
3113
3114
3115 proc WithdrawSplashes {} {
3116   global SplashWindows
3117   foreach win $SplashWindows {
3118     wm withdraw $win
3119     set splashscreen [WindowLink $win.splashscreen]
3120     $splashscreen config -bitmap ""
3121   }
3122 }
3123
3124
3125 proc InitSplashes {} {
3126 }
3127
3128
3129 proc InitSplash {win} {
3130 }
3131
3132
3133 proc DeleteSplashWindow {win} {
3134   # TODO
3135 }
3136
3137
3138 ########################################################################
3139 # Scenario Window Handlers
3140
3141
3142 proc ShowScenarioOf {head} {
3143   set win [WindowLink $head.scenario]
3144   if {$win == {}} {
3145     set win [MakeWindow.scenario $head [winfo screen $head]]
3146   }
3147   # TODO: load background bitmap
3148   wm deiconify $win
3149 }
3150
3151
3152 proc WithdrawScenarioOf {head} {
3153   set win WindowLink $head.scenario]
3154   wm withdraw $win
3155 }
3156
3157
3158 proc ShowScenarios {} {
3159   global HeadWindows
3160   foreach win $HeadWindows {
3161     ShowScenarioOf $win
3162   }
3163 }
3164
3165
3166 proc WithdrawScenarios {} {
3167   global ScenarioWindows
3168   foreach win $ScenarioWindows {
3169     wm withdraw $win
3170     # TODO: flush background bitmap
3171   }
3172 }
3173
3174
3175 proc InitScenarios {} {
3176   global MapHistory MapHistoryNum
3177   if {$MapHistoryNum < 1} {
3178     set prev disabled
3179   } else {
3180     set prev normal
3181   }
3182   if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3183     set next disabled
3184   } else {
3185     set next normal
3186   }
3187   global ScenarioWindows
3188   foreach win $ScenarioWindows {
3189     # TODO
3190     #[WindowLink $win.previous] config -state $prev
3191     #[WindowLink $win.next] config -state $next
3192   }
3193 }
3194
3195
3196 proc InitScenario {win} {
3197   global MapHistory MapHistoryNum
3198   if {$MapHistoryNum < 1} {
3199     set prev disabled
3200   } else {
3201     set prev normal
3202   }
3203
3204   if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3205     set next disabled
3206   } else {
3207     set next normal
3208   }
3209
3210   # TODO
3211   #[WindowLink $win.previous] config -state $prev
3212   #[WindowLink $win.next] config -state $next
3213
3214   LinkWindow $win.scenarioTarget -1
3215   LinkWindow $win.scenarioTargetDown -1
3216
3217   global ScenarioButtons
3218   set i 0
3219   set len [llength $ScenarioButtons]
3220   while {$i < $len} {
3221     set data [lindex $ScenarioButtons $i]
3222     set type [lindex $data 0]
3223     set id [lindex $data 1]
3224     #echo "DATA $data"
3225     #echo "ID $id"
3226
3227     LinkWindow $win.$id.over 0
3228     LinkWindow $win.$id.enabled 1
3229     LinkWindow $win.$id.checked 0
3230     #echo "SETTING WIN $win ID $id"
3231
3232     set i [expr "$i + 1"]
3233   }
3234
3235   UpdateLevelSelection $win
3236   UpdateLeftRightEnabled $win
3237 }
3238
3239
3240 proc UpdateLevelSelection {win} {
3241   #echo UpdateLevelSelection
3242   global GameLevel
3243   if {$GameLevel == 0} then {
3244     LinkWindow $win.easy.checked 1
3245     LinkWindow $win.medium.checked 0
3246     LinkWindow $win.hard.checked 0
3247   }
3248   if {$GameLevel == 1} then {
3249     LinkWindow $win.easy.checked 0
3250     LinkWindow $win.medium.checked 1
3251     LinkWindow $win.hard.checked 0
3252   }
3253   if {$GameLevel == 2} then {
3254     LinkWindow $win.easy.checked 0
3255     LinkWindow $win.medium.checked 0
3256     LinkWindow $win.hard.checked 1
3257   }
3258
3259   UpdateScenarioButtonID $win easy
3260   UpdateScenarioButtonID $win medium
3261   UpdateScenarioButtonID $win hard
3262
3263 }
3264
3265
3266 proc UpdateLeftRightEnabled {win} {
3267   #echo UpdateLeftRightEnabled
3268
3269   global MapHistory MapHistoryNum
3270   if {$MapHistoryNum < 1} {
3271     LinkWindow $win.left.enabled 0
3272   } else {
3273     LinkWindow $win.left.enabled 1
3274   }
3275
3276   if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3277     LinkWindow $win.right.enabled 0
3278   } else {
3279     LinkWindow $win.right.enabled 1
3280   }
3281
3282   UpdateScenarioButtonID $win left
3283   UpdateScenarioButtonID $win right
3284 }
3285
3286
3287 proc UpdateScenarioButtonID {win id} {
3288
3289   global ScenarioButtons
3290   set i 0
3291   set len [llength $ScenarioButtons]
3292   while {$i < $len} {
3293     set data [lindex $ScenarioButtons $i]
3294     set id
3295     if {$id == [lindex $data 1]} then {
3296       UpdateScenarioButton $win $data
3297       break
3298     }
3299
3300     set i [expr "$i + 1"]
3301   }
3302 }
3303
3304
3305 proc UpdateScenarioButton {win data} {
3306   set type [lindex $data 0]
3307   set id [lindex $data 1]
3308   set over [WindowLink $win.$id.over]
3309   set enabled [WindowLink $win.$id.enabled]
3310   set checked [WindowLink $win.$id.checked]
3311   #echo "WIN $win TYPE $type ID $id OVER $over ENABLED $enabled CHECKED $checked"
3312   if {$enabled} {
3313     if {$checked} {
3314       if {$over} {
3315         set bm [lindex $data 13]
3316       } else {
3317         set bm [lindex $data 12]
3318       }
3319     } else {
3320       if {$over} {
3321         set bm [lindex $data 10]
3322       } else {
3323         set bm [lindex $data 9]
3324       }
3325     }
3326   } else {
3327     set bm [lindex $data 11]
3328   }
3329
3330   [WindowLink $win.canvas] itemconfig $id -bitmap $bm
3331 }
3332
3333
3334 proc DoEnterCityName {win} {
3335 }
3336
3337
3338 proc InitVotesForUseThisMap {} {
3339   # TODO: Disabled for new scenario window.
3340   return
3341
3342   global VotesForUseThisMap ScenarioWindows
3343   set VotesForUseThisMap {}
3344   foreach win $ScenarioWindows {
3345     [WindowLink $win.vote] config -relief raised
3346   }
3347   UpdateVotesForUseThisMap
3348 }
3349
3350
3351 proc UpdateVotesForUseThisMap {} {
3352   global ScenarioWindows
3353   UpdateVotesFor UseThisMap $ScenarioWindows
3354 }
3355
3356
3357 proc UIUseThisMap {} {
3358   global CityName GameLevel Scenario
3359   WithdrawAll
3360   # special handling for scenarios?
3361   if {$GameLevel != -1} {
3362     sim GameLevel $GameLevel
3363   }
3364   sim CityName $CityName
3365   UINewGame
3366   UIPlayGame
3367   if {$Scenario != -1} {
3368     UIShowPicture $Scenario
3369   }
3370 }
3371
3372
3373 proc HandleScenarioDown {win x y} {
3374   #echo HandleScenarioDown $win $x $y
3375   HandleScenarioMove $win $x $y
3376   set w [WindowLink $win.w]
3377   set target [WindowLink $w.scenarioTarget]
3378   LinkWindow $w.scenarioTargetDown $target
3379 }
3380
3381
3382 proc HandleScenarioUp {win x y} {
3383   #echo HandleScenarioUp $win $x $y
3384   HandleScenarioMove $win $x $y
3385   global ScenarioButtons
3386   set w [WindowLink $win.w]
3387   set target [WindowLink $w.scenarioTarget]
3388   set targetDown [WindowLink $w.scenarioTargetDown]
3389   if {($target != -1) &&
3390       ($target == $targetDown)} {
3391     set data [lindex $ScenarioButtons $target]
3392     set type [lindex $data 0]
3393     set id [lindex $data 1]
3394     set callback [lindex $data 2]
3395     set param [lindex $data 3]
3396     set var [lindex $data 4]
3397     set xx [lindex $data 5]
3398     set yy [lindex $data 6]
3399     set ww [lindex $data 7]
3400     set hh [lindex $data 8]
3401     set normal [lindex $data 9]
3402     set over [lindex $data 10]
3403     set disabled [lindex $data 11]
3404     if {$type == "button"} {
3405       #echo callback $callback w $w param $param
3406       eval "$callback $w {$param}"
3407     } else {
3408       if {$type == "checkbox"} {
3409         #echo checkbox callback $callback w $w param $param
3410         eval "$callback $w {$param}"
3411       }
3412     }
3413   }
3414 }
3415
3416
3417 proc HandleScenarioMove {win x y} {
3418   #echo HandleScenarioMove $win $x $y
3419   global ScenarioButtons
3420   set w [WindowLink $win.w]
3421   set target [WindowLink $w.scenarioTarget]
3422   set found -1
3423   set i 0
3424   set len [llength $ScenarioButtons]
3425   while {$i < $len} {
3426     set data [lindex $ScenarioButtons $i]
3427     set type [lindex $data 0]
3428     set id [lindex $data 1]
3429     set callback [lindex $data 2]
3430     set param [lindex $data 3]
3431     set var [lindex $data 4]
3432     set xx [lindex $data 5]
3433     set yy [lindex $data 6]
3434     set ww [lindex $data 7]
3435     set hh [lindex $data 8]
3436
3437     set enabled [WindowLink $w.$id.enabled]
3438     set checked [WindowLink $w.$id.checked]
3439
3440     #echo "ID $id ENABLED $enabled CHECKED $checked w $w id $id"
3441
3442     if {($enabled != 0) &&
3443         ($x >= $xx) &&
3444         ($x < ($xx + $ww)) &
3445         ($y >= $yy) &&
3446         ($y < ($yy + $hh))} {
3447       set found $i
3448       break
3449     }
3450
3451     set i [expr "$i + 1"]
3452   }
3453
3454   if {$found != $target} {
3455
3456     if {$found == -1} {
3457       if {$target != -1} {
3458
3459         #echo OUT $w $found $xx $yy $normal
3460         LinkWindow $w.scenarioTarget -1
3461
3462         set targetdata [lindex $ScenarioButtons $target]
3463         set targetid [lindex $targetdata 1]
3464         LinkWindow $w.$targetid.over 0
3465         UpdateScenarioButton $w $targetdata
3466
3467       }
3468     } else {
3469
3470       #echo IN $w $found $xx $yy $over
3471       LinkWindow $w.scenarioTarget $found
3472       LinkWindow $w.$id.over 1
3473
3474       if {$target != -1} {
3475         set targetdata [lindex $ScenarioButtons $target]
3476         set targetid [lindex $targetdata 1]
3477         LinkWindow $w.$targetid.over 0
3478         UpdateScenarioButton $w $targetdata
3479       }
3480
3481       UpdateScenarioButton $w $data
3482
3483     }
3484   }
3485 }
3486
3487 proc DoLoad {win param} {
3488   #echo DOLOAD $win $param
3489   UILoadCity $win
3490 }
3491
3492
3493 proc DoGenerate {win param} {
3494   #echo DOGENERATE $win $param
3495   UIGenerateNewCity
3496 }
3497
3498
3499 proc DoQuit {win param} {
3500   #echo DOQUIT $win $param
3501   UIQuit $win
3502 }
3503
3504
3505 proc DoAbout {win param} {
3506   #echo DOABOUT $win $param
3507   MakeHistory "DoLoadCity cities/about.cty"
3508 }
3509
3510
3511 proc DoMap {win param} {
3512   #echo DOMAP $win $param
3513 }
3514
3515
3516 proc DoLevel {win param} {
3517   #echo DOLEVEL $win $param
3518   DoSetGameLevel $param
3519 }
3520
3521
3522 proc DoLeft {win param} {
3523   #echo DOLEFT $win $param
3524   PrevHistory
3525 }
3526
3527
3528 proc DoRight {win param} {
3529   #echo DORIGHT $win $param
3530  NextHistory
3531 }
3532
3533
3534 proc DoPlay {win param} {
3535   #echo DOPLAY $win $param
3536   UIUseThisMap
3537 }
3538
3539
3540 proc DoPickScenario {win param} {
3541   #echo DOPICKSCENARIO $win $param
3542   UILoadScenario $param
3543 }
3544
3545
3546 ########################################################################
3547 # Undo/Redo Facility
3548
3549
3550 proc InitHistory {} {
3551   global MapHistory
3552   global MapHistoryNum
3553   set MapHistory {}
3554   set MapHistoryNum -1
3555 }
3556
3557
3558 proc MakeHistory {cmd} {
3559   global MapHistory
3560   set len [llength $MapHistory]
3561   if {($len == 0) ||
3562       ($cmd != [lindex $MapHistory [expr $len-1]])} {
3563     lappend MapHistory $cmd
3564   } else {
3565     incr len -1
3566   }
3567   GotoHistory $len
3568 }
3569
3570
3571 proc GotoHistory {i} {
3572   global MapHistory
3573   global MapHistoryNum
3574   InitVotesForUseThisMap
3575   if {$i != $MapHistoryNum} {
3576     set MapHistoryNum $i
3577     set cmd [lindex $MapHistory $i]
3578     eval $cmd
3579   }
3580   if {$MapHistoryNum == 0} {
3581     set prev disabled
3582   } else {
3583     set prev normal
3584   }
3585   if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3586     set next disabled
3587   } else {
3588     set next normal
3589   }
3590
3591   global ScenarioWindows
3592   foreach win $ScenarioWindows {
3593     UpdateLeftRightEnabled $win
3594   }
3595
3596 }
3597
3598
3599 proc NextHistory {} {
3600   global MapHistory
3601   global MapHistoryNum
3602   set len [llength $MapHistory]
3603   set i [expr "$MapHistoryNum + 1"]
3604   if {$i < $len} {
3605     GotoHistory $i
3606   }
3607 }
3608
3609
3610 proc PrevHistory {} {
3611   global MapHistory
3612   global MapHistoryNum
3613   set i [expr "$MapHistoryNum - 1"]
3614   if {$i >= 0} {
3615     GotoHistory $i
3616   }
3617 }
3618
3619
3620 ########################################################################
3621 # Ask Window Handlers
3622
3623 proc ShowAskOf {head} {
3624   set win [WindowLink $head.ask]
3625   if {$win == {}} {
3626     set win [MakeWindow.ask $head [winfo screen $head]]
3627   }
3628   wm deiconify $win
3629   wm raise $win
3630   return $win
3631 }
3632
3633
3634 proc ShowAsks {} {
3635   global HeadWindows
3636   foreach win $HeadWindows {
3637     ShowAskOf $win
3638   }
3639 }
3640
3641
3642 proc WithdrawAsks {} {
3643   global AskWindows
3644   foreach win $AskWindows {
3645     wm withdraw $win
3646   }
3647 }
3648
3649
3650 proc WithdrawAskOf {win} {
3651   set ask [WindowLink $win.ask]
3652   if {"$ask" != ""} {
3653     wm withdraw $ask
3654   }
3655 }
3656
3657
3658 proc AskQuestion {color title text left middle right} {
3659   global HeadWindows
3660   foreach win $HeadWindows {
3661     AskQuestionOn $win $color $title $text $left $middle $right
3662   }
3663 }
3664
3665
3666 proc AskQuestionOn {head color title text left middle right} {
3667   ShowAskOf $head
3668
3669   set win [WindowLink $head.ask]
3670   set t [WindowLink $win.title]
3671   $t configure -text $title
3672   $t configure -background $color
3673
3674   set t [WindowLink $win.text]
3675   $t configure -state normal
3676   $t delete 0.0 end
3677   $t insert end "${text}\n"
3678   $t configure -state disabled
3679
3680   set bf [WindowLink $win.frame]
3681   set l [WindowLink $win.left]
3682   set m [WindowLink $win.middle]
3683   set r [WindowLink $win.vote]
3684   set rf [WindowLink $win.voteframe]
3685
3686   if {$left != ""} {
3687     $l config \
3688         -text [lindex $left 0] \
3689         -command [format [lindex $left 2] $head]
3690     SetHelp $l [lindex $left 1]
3691     pack append $bf $l {left frame center}
3692   } else {
3693     pack unpack $l
3694   }
3695
3696   if {$middle != ""} {
3697     $m config \
3698         -text [lindex $middle 0] \
3699         -command [format [lindex $middle 2] $head]
3700     SetHelp $m [lindex $middle 1]
3701     pack append $bf $m {left frame center expand}
3702   } else {
3703     pack unpack $m
3704   }
3705
3706   if {$right != ""} {
3707     set notify [format [lindex $right 2] $head]
3708     set preview [format [lindex $right 3] $head]
3709     set cmd [list DoVote $win Ask $notify $preview]
3710     $r config \
3711         -text [lindex $right 0] \
3712         -command $cmd
3713     SetHelp $r [lindex $right 1]
3714     pack append $bf $rf {right frame center}
3715   } else {
3716     pack unpack $rf
3717   }
3718
3719   InitVotesForAsk
3720 }
3721
3722
3723 proc BindVotingButton {win but name} {
3724   set w [WindowLink $win.top]
3725
3726   bind $but <Any-Enter> "VoteButtonEnter $win $but"
3727   bind $but <Any-Leave> "VoteButtonLeave $win $but"
3728   bind $but <1> "VoteButtonDown $win $but $name"
3729   bind $but <ButtonRelease-1> "VoteButtonUp $win $but $name"
3730   bind $but <2> "VoteButtonDown $win $but $name"
3731   bind $but <ButtonRelease-2> "VoteButtonUp $win $but $name"
3732   bind $but <3> "VoteButtonDown $win $but $name"
3733   bind $but <ButtonRelease-3> "VoteButtonUp $win $but $name"
3734 }
3735
3736
3737 proc VoteButtonEnter {win but} {
3738   global tk_priv
3739   set screen [winfo screen $but]
3740   if {[lindex [$but config -state] 4] != "disabled"} {
3741     $but config -state active
3742     set tk_priv(window@$screen) $but
3743   } else {
3744     set tk_priv(window@$screen) ""
3745   }
3746 }
3747
3748
3749 proc VoteButtonLeave {win but} {
3750   global tk_priv
3751   if {[lindex [$but config -state] 4] != "disabled"} {
3752     $but config -state normal
3753   }
3754   set screen [winfo screen $but]
3755   set tk_priv(window@$screen) ""
3756 }
3757
3758
3759 proc VoteButtonDown {win but name} {
3760   global tk_priv
3761   set screen [winfo screen $but]
3762   set rel [lindex [$but config -relief] 4]
3763   set tk_priv(relief@$screen) $rel
3764   if {[lindex [$but config -state] 4] != "disabled"} {
3765     set head [WindowLink $win.head]
3766     if {[IsVotingFor $head $name]} {
3767       $but config -relief raised
3768     } else {
3769       $but config -relief sunken
3770     }
3771   }
3772 }
3773
3774
3775 proc VoteButtonUp {win but name} {
3776   global tk_priv
3777   set screen [winfo screen $but]
3778   $but config -relief $tk_priv(relief@$screen)
3779   if {($but == $tk_priv(window@$screen))
3780         && ([lindex [$but config -state] 4] != "disabled")} {
3781     uplevel #0 [list $but invoke]
3782     set head [WindowLink $win.head]
3783     if {[IsVotingFor $head $name]} {
3784       $but config -relief sunken
3785     } else {
3786       $but config -relief raised
3787     }
3788   }
3789 }
3790
3791
3792 proc PressVoteButton {win but name} {
3793   global tk_priv
3794   uplevel #0 [list $but invoke]
3795   set head [WindowLink $win.head]
3796   if {[IsVotingFor $head $name]} {
3797     $but config -relief sunken
3798   } else {
3799     $but config -relief raised
3800   }
3801 }
3802
3803
3804 proc IsVotingFor {win name} {
3805   global VotesFor$name
3806   set votes [eval ident "\$\{VotesFor$name\}"]
3807   if {[lsearch $votes $win] == -1} {
3808     return 0
3809   } else {
3810     return 1
3811   }
3812 }
3813
3814
3815 proc DoVote {win name notify preview} {
3816   global VotesFor$name
3817   set votes [eval ident "\$\{VotesFor$name\}"]
3818
3819   set win [WindowLink $win.head]
3820   set i [lsearch $votes $win]
3821   if {$i == -1} {
3822     lappend VotesFor$name $win
3823   } else {
3824     set VotesFor$name [lreplace $votes $i $i]
3825   }
3826   UpdateVotesFor$name
3827   set votes [eval ident "\$\{VotesFor$name\}"]
3828   if {[llength $votes] >= [NeededVotes]} {
3829     eval "$notify"
3830   } else {
3831     eval "$preview"
3832   }
3833 }
3834
3835
3836 proc UpdateVotesFor {name wins} {
3837   global VotesFor$name
3838   set votes [eval llength "\$\{VotesFor$name\}"]
3839   set needed [NeededVotes]
3840
3841   foreach win $wins {
3842     set head [WindowLink $win.head]
3843     if {[IsVotingFor $head $name]} {
3844       set border [expr "($needed - $votes) * 1"]
3845       set pad [expr "6 - $border"]
3846       [WindowLink $win.vote] config -padx $pad -pady $pad
3847       [WindowLink $win.voteframe] config -borderwidth $border
3848     } else {
3849       set border [expr "($needed - $votes - 1) * 1"]
3850       set pad [expr "6 - $border"]
3851       [WindowLink $win.vote] config -padx $pad -pady $pad
3852       [WindowLink $win.voteframe] config -borderwidth $border
3853     }
3854   }
3855 }
3856
3857
3858 proc InitVotesForAsk {} {
3859   global VotesForAsk AskWindows
3860   set VotesForAsk {}
3861   foreach win $AskWindows {
3862     [WindowLink $win.vote] config -relief raised
3863   }
3864   sim PendingTool -1
3865   UpdateVotesForAsk
3866 }
3867
3868
3869 proc UpdateVotesForAsk {} {
3870   global AskWindows
3871   UpdateVotesFor Ask $AskWindows
3872 }
3873
3874
3875 ########################################################################
3876 # Player Window Handlers
3877
3878 proc ShowPlayerOf {head} {
3879   set win [WindowLink $head.player]
3880   if {$win == {}} {
3881     set win [MakeWindow.player $head [winfo screen $head]]
3882   }
3883   wm deiconify $win
3884   wm raise $win
3885   return $win
3886 }
3887
3888
3889 proc ShowPlayers {} {
3890   global HeadWindows
3891   foreach win $HeadWindows {
3892     ShowPlayerOf $win
3893   }
3894 }
3895
3896
3897 proc WithdrawPlayers {} {
3898   global PlayerWindows
3899   foreach win $PlayerWindows {
3900     wm withdraw $win
3901   }
3902 }
3903
3904
3905 proc UpdatePlayers {} {
3906   # TODO: Disabled for new scenario window.
3907   return
3908
3909   global HeadWindows PlayerWindows
3910
3911   set players ""
3912   foreach win $HeadWindows {
3913     set server [winfo screen $win]
3914 #    if {[string first : $server] == 0} {
3915 #      set server "[exec hostname]:0"
3916 #    }
3917     lappend players $server
3918   }
3919
3920   sim Players [llength $players]
3921
3922   foreach win $PlayerWindows {
3923     set list [WindowLink $win.players]
3924     $list delete 0 end
3925     eval "$list insert 0 $players"
3926   }
3927
3928   UpdateVotesForUseThisMap
3929   UpdateVotesForAsk
3930   UpdateVotesForBudget
3931   UpdateTaxRateSliders
3932 }
3933
3934
3935 proc UIShowPlayer {win} {
3936   ShowPlayerOf $win
3937 }
3938
3939
3940 proc DoNewPlayer {win} {
3941   set field [WindowLink $win.display]
3942   set dpy [$field get]
3943   if {"$dpy" != ""} {
3944     $field delete 0 end
3945     sim Flush
3946     update idletasks
3947     if {[AddPlayer $dpy] != ""} {
3948       wm withdraw $win
3949     }
3950   }
3951 }
3952
3953 ########################################################################
3954 # Notice Window Handlers
3955
3956
3957 proc ShowNoticeOf {head} {
3958   set win [WindowLink $head.notice]
3959   if {$win == {}} {
3960     set win [MakeWindow.notice $head [winfo screen $head]]
3961   }
3962   global NoticePanelWidth NoticePanelHeight
3963   #place configure $win -x 0 -y 0 -width $NoticePanelWidth -height $NoticePanelHeight
3964   pack append [WindowLink $head.w3] \
3965       $win {bottom frame sw expand fill}
3966   return $win
3967 }
3968
3969
3970 proc ShowNotices {} {
3971   global HeadWindows
3972   foreach win $HeadWindows {
3973     ShowNoticeOf $win
3974   }
3975 }
3976
3977
3978 proc WithdrawNotices {} {
3979   global NoticeWindows
3980   foreach win $NoticeWindows {
3981     #place forget $win
3982     pack unpack $win
3983   }
3984 }
3985
3986
3987 proc ReShowPictureOn {{head ""}} {
3988   global ShowingPicture ShowingParms
3989   UIShowPictureOn $head $ShowingPicture $ShowingParms
3990 }
3991
3992
3993 proc UIShowPicture {id {parms ""}} {
3994   UIShowPictureOn "" $id $parms
3995 }
3996
3997
3998 proc UIShowPictureOn {where id {parms ""}} {
3999   global DoNotices Messages ShowingPicture ShowingParms
4000   if {$DoNotices == 0} {
4001       return
4002   }
4003
4004   set ShowingPicture $id
4005   set ShowingParms $parms
4006   set msg $Messages($id)
4007   set color [lindex $msg 0]
4008   set title [lindex $msg 1]
4009   set body [lindex $msg 2]
4010   if {$parms != ""} {
4011     set cmd "format {$body} $parms"
4012     set body [uplevel #0 $cmd]
4013   }
4014   set props [lindex $msg 3]
4015   if {"$where" == ""} {
4016     global HeadWindows
4017     set where $HeadWindows
4018   }
4019   foreach head $where {
4020     NoticeMessageOn $head "$title" $color "$body" Medium $props
4021   }
4022 }
4023
4024
4025 proc NoticeMessageOn {head title color text font props} {
4026   ShowNoticeOf $head
4027   set win [WindowLink $head.notice]
4028
4029   set t [WindowLink $win.title]
4030   $t configure -text $title -background $color
4031
4032   set t [WindowLink $win.text]
4033   $t configure -state normal -font [Font $head $font]
4034   $t delete 0.0 end
4035   $t insert end "${text}\n"
4036   $t configure -state disabled
4037
4038   set left ""
4039   catch {set left [keylget props left]}
4040   set l [WindowLink $win.left]
4041   if {$left != ""} {
4042     $l config -bitmap $left
4043     place $l -in $t -anchor sw -relx .05 -rely .95
4044   } else {
4045     place forget $l
4046   }
4047
4048   set middle ""
4049   catch {set middle [keylget props middle]}
4050   set m [WindowLink $win.middle]
4051   if {$middle != ""} {
4052     $m config -bitmap $middle
4053     place $m -in $t -anchor s -relx .5 -rely .95
4054   } else {
4055     place forget $m
4056   }
4057
4058   set right ""
4059   catch {set right [keylget props right]}
4060   set r [WindowLink $win.right]
4061   if {$right != ""} {
4062     $r config -bitmap $right
4063     place $r -in $t -anchor se -relx .95 -rely .95
4064   } else {
4065     place forget $r
4066   }
4067
4068   set view ""
4069   catch {set view [keylget props view]}
4070   set vf [WindowLink $win.viewframe]
4071   global v
4072   set v [WindowLink $win.view]
4073   set bg [WindowLink $win.background]
4074   if {$view != ""} {
4075     uplevel #0 "$view"
4076     pack unpack $t
4077     pack append $bg $vf {left frame center fill}
4078     pack append $bg $t {right frame center fill expand}
4079   } else {
4080     pack unpack $vf
4081   }
4082 }
4083
4084
4085 proc UIPopUpMessage {msg} {
4086   DoSendMessage $msg
4087 }
4088
4089
4090 proc ComeToMe {view} {
4091   set win [winfo toplevel $view]
4092
4093   set xy [$view Pan]
4094   set x [expr "[lindex $xy 0] >>4"]
4095   set y [expr "[lindex $xy 1] >>4"]
4096
4097   ComeTo $win $x $y
4098 }
4099
4100
4101 proc ComeTo {win x y} {
4102   global EditorWindows
4103   set head [WindowLink $win.head]
4104   set myeds {}
4105   set myautoeds {}
4106   foreach ed $EditorWindows {
4107     if {"[WindowLink $ed.head]" == "$head"} {
4108       lappend myeds $ed
4109       set view [WindowLink $ed.view]
4110       if {[$view AutoGoto]} {
4111         lappend myautoeds $ed
4112       }
4113     }
4114   }
4115   if {[llength $myautoeds]} {
4116     UIAutoGotoOn $x $y $myautoeds
4117   } else {
4118     if {[llength $myeds]} {
4119       UIAutoGotoOn $x $y $myeds
4120     }
4121   }
4122 }
4123
4124
4125 proc FollowView {view id} {
4126   $view Follow $id
4127
4128   set skips 999999
4129   if {[sim DoAnimation]} {
4130     set head [WindowLink [winfo toplevel $view].head]
4131     global EditorWindows
4132     foreach win $EditorWindows {
4133       if {"[WindowLink $win.head]" == "$head"} {
4134         set s [[WindowLink $win.view] Skip]
4135         set skips [min $skips $s]
4136       }
4137     }
4138
4139     if {$skips == 999999} {
4140       set skips 0
4141     }
4142   }
4143
4144   $view Skip $skips
4145   $view Update
4146 }
4147
4148
4149 proc PanView {view x y} {
4150   FollowView $view ""
4151   $view Pan $x $y
4152 }
4153
4154
4155 ########################################################################
4156 # Help Window Handlers
4157
4158
4159 proc ShowHelpOf {head} {
4160   set win [WindowLink $head.help]
4161   if {$win == {}} {
4162     set win [MakeWindow.help $head [winfo screen $head]]
4163   }
4164   wm deiconify $win
4165   wm raise $win
4166   return $win
4167 }
4168
4169
4170 proc ShowHelps {} {
4171   global HeadWindows
4172   foreach win $HeadWindows {
4173     ShowHelpOf $win
4174   }
4175 }
4176
4177
4178 proc WithdrawHelps {} {
4179   global HelpWindows
4180   foreach win $HelpWindows {
4181     wm withdraw $win
4182   }
4183 }
4184
4185
4186 ########################################################################
4187 # Frob Window Handlers
4188
4189
4190 proc ShowFrobOf {head} {
4191   set win [WindowLink $head.frob]
4192   if {$win == {}} {
4193     set win [MakeWindow.frob $head [winfo screen $head]]
4194   }
4195   wm deiconify $win
4196   wm raise $win
4197
4198   return $win
4199 }
4200
4201
4202 proc ShowFrobs {} {
4203   global HeadWindows
4204   foreach win $HeadWindows {
4205     ShowFrobOf $win
4206   }
4207 }
4208
4209
4210 proc WithdrawFrobs {} {
4211   global FrobWindows
4212   foreach win $FrobWindows {
4213     wm withdraw $win
4214   }
4215 }
4216
4217
4218 proc UISetDynamic {i min max} {
4219   sim DynamicData [expr "$i*2"] $min
4220   sim DynamicData [expr "$i*2+1"] $max
4221 }
4222
4223
4224 ########################################################################
4225 # Help Handler
4226
4227
4228 proc LoadHelp {} {
4229   global ResourceDir
4230
4231   source $ResourceDir/help.tcl
4232 }
4233
4234 proc HandleHelp {win x y rootx rooty} {
4235   global HelpLoaded HelpWidgets Messages
4236
4237   if {$HelpLoaded == 0} {
4238     LoadHelp
4239     set HelpLoaded 1
4240   }
4241
4242   set orig $win
4243   set head [WindowLink [winfo toplevel $win].head]
4244   set id ""
4245   while {1} {
4246     catch {set id $HelpWidgets($win)}
4247     if {$id != ""} {
4248       break
4249     }
4250     set list [split $win .]
4251     set len [expr "[llength $list] - 2"]
4252     set list [lrange $list 0 $len]
4253     if {[llength $list] <= 1} {
4254       set id Window
4255       break
4256     }
4257     set win [join $list .]
4258   }
4259   if [info exists Messages($id)] {
4260     UIShowHelpOn $head $id
4261   } else {
4262     UIShowHelpOn $head Window
4263   }
4264 }
4265
4266
4267 proc UIShowHelpOn {win id {parms ""}} {
4268   global Messages ShowingPicture ShowingParms ResourceDir
4269   set head [WindowLink $win.head]
4270   set msg $Messages($id)
4271   set color [lindex $msg 0]
4272   set title [lindex $msg 1]
4273   set body [lindex $msg 2]
4274   if {$parms != ""} {
4275     set cmd "format {$body} $parms"
4276     set body [uplevel #0 $cmd]
4277   }
4278   set props [lindex $msg 3]
4279
4280   ShowHelpOf $head
4281   set win [WindowLink $head.help]
4282
4283   set t [WindowLink $win.title]
4284   $t configure -text $title -background $color
4285
4286   set t [WindowLink $win.text]
4287   $t configure -state normal -font [Font $head Large]
4288   $t delete 0.0 end
4289   $t insert end "${body}\n"
4290   FormatHTML $ResourceDir/doc/$id.html $t
4291   $t configure -state disabled
4292 }
4293
4294
4295 proc FormatHTML {filename text} {
4296   set f ""
4297   catch {
4298     set f [open $filename]
4299     set line ""
4300     set header ""
4301     set title ""
4302     gets $f header
4303     gets $f title
4304
4305     while {[gets $f line] >= 0} {
4306       if {"$line" == "</body>"} {
4307         break
4308       }
4309       if {([string index $line 0] == "#") || ([string length $line] == 0)} {
4310         continue
4311       }
4312       $text insert end "$line\n"
4313     }
4314   }
4315   if {$f != ""} {
4316     close $f
4317   }
4318 }
4319
4320
4321 proc SetHelp {win id} {
4322   global HelpWidgets
4323   set HelpWidgets($win) $id
4324 }
4325
4326
4327 proc Help {id title {msg {}} {props {}}} {
4328   Message $id #7f7fff $title $msg $props
4329 }
4330
4331 ########################################################################
4332 # Pie Menu Handlers
4333
4334
4335 # Set up the bindings to pop up $pie when the right button is clicked in $win
4336 proc InitPie {win pie} {
4337   bind $win <Motion> {}
4338   bind $win <3> "PieMenuDown $win $pie $pie Initial %X %Y"
4339   bind $win <B3-Motion> {}
4340   bind $win <B3-ButtonRelease> {}
4341 }
4342
4343
4344 # Set up the bindings to continue tracking $pie
4345 # Get this: we keep the tracking machine state in the bindings!
4346 proc ActivatePie {win root pie state} {
4347   bind $win <Motion> "PieMenuMotion $win $root $pie $state %X %Y"
4348   bind $win <3> "PieMenuDown $win $root $pie $state %X %Y"
4349   bind $win <B3-Motion> "PieMenuMotion $win $root $pie $state %X %Y"
4350   bind $win <B3-ButtonRelease> "PieMenuUp $win $root $pie $state %X %Y"
4351 }
4352
4353
4354 # Cancel and reset a pie menu
4355 proc CancelPie {win} {
4356   set binding [bind $win <3>]
4357   set root [lindex $binding 2]
4358   set pie [lindex $binding 3]
4359   set state [lindex $binding 4]
4360   if {"$state" != "Initial"} {
4361     catch {$root ungrab $win}
4362     $pie unpost
4363     $pie activate none
4364     UIMakeSoundOn $win fancy Oop
4365   }
4366   InitPie $win $root
4367 }
4368
4369
4370 # Handle pie menu button down
4371 proc PieMenuDown {win root pie state x y} {
4372   case $state {
4373     Initial {
4374       ActivatePie $win $root $pie FirstDown
4375       update idletasks
4376       catch {$root grab $win}
4377       $pie activate none
4378       $pie post $x $y
4379       PreviewPieMenu $win $pie $x $y
4380       update idletasks
4381     }
4382     ClickedUp {
4383       TrackPieMenu $pie $x $y
4384       ActivatePie $win $root $pie SecondDown
4385     }
4386     SelectedUp {
4387       $pie activate none
4388       #$pie post $x $y
4389       $pie defer
4390       PreviewPieMenu $win $pie $x $y
4391       ActivatePie $win $root $pie SecondDown
4392     }
4393     FirstDown { # error
4394       CancelPie $win
4395     }
4396     SecondDown { # error
4397       CancelPie $win
4398     }
4399   }
4400 }
4401
4402
4403 # Handle pie menu button motion
4404 proc PieMenuMotion {win root pie state x y} {
4405   case $state {
4406     FirstDown {
4407       TrackPieMenu $pie $x $y
4408       $pie defer
4409     }
4410     ClickedUp {
4411       $pie activate none
4412       #$pie post $x $y
4413     }
4414     SecondDown {
4415       TrackPieMenu $pie $x $y
4416       $pie defer
4417     }
4418     SelectedUp {
4419       $pie activate none
4420       #$pie post $x $y
4421     }
4422     Initial { # error
4423       CancelPie $win
4424     }
4425   }
4426 }
4427
4428
4429 # Handle pie menu button up
4430 proc PieMenuUp {win root pie state x y} {
4431   case $state {
4432     FirstDown {
4433       TrackPieMenu $pie $x $y
4434       set active [$pie index active]
4435       if {$active == "none"} {
4436         $pie show
4437         catch {$root grab $win}
4438         ActivatePie $win $root $pie ClickedUp
4439       } else {
4440         set label [lindex [$pie entryconfig $active -label] 4]
4441         set submenu [lindex [$pie entryconfig $active -piemenu] 4]
4442         UIMakeSoundOn $win mode $label
4443         if {$submenu == {}} {
4444           set reward [$pie pending]
4445           catch {$root ungrab $win}
4446           $pie unpost
4447           $pie activate none
4448           if {$reward} {
4449             sim Funds [expr "[sim Funds] + 5"]
4450             UIMakeSoundOn $win fancy Aaah
4451           }
4452           eval [lindex [$pie entryconfig $active -command] 4]
4453           InitPie $win $root
4454         } else {
4455           $pie unpost
4456           $pie activate none
4457           $submenu activate none
4458           $submenu post $x $y
4459           PreviewPieMenu $win $submenu $x $y
4460           catch {$root grab $win}
4461           ActivatePie $win $root $submenu SelectedUp
4462         }
4463       }
4464     }
4465     SecondDown {
4466       TrackPieMenu $pie $x $y
4467       set active [$pie index active]
4468       if {$active == "none"} {
4469         CancelPie $win
4470       } else {
4471         set label [lindex [$pie entryconfig $active -label] 4]
4472         set submenu [lindex [$pie entryconfig $active -piemenu] 4]
4473         UIMakeSoundOn $win mode $label
4474         if {$submenu == {}} {
4475           set reward [$pie pending]
4476           catch {$root ungrab $win}
4477           $pie unpost
4478           $pie activate none
4479           if {$reward} {
4480             sim Funds [expr "[sim Funds] + 5"]
4481             UIMakeSoundOn $win fancy Aaah
4482           }
4483           eval [lindex [$pie entryconfig $active -command] 4]
4484           InitPie $win $root
4485         } else {
4486           $pie unpost
4487           $pie activate none
4488           $submenu activate none
4489           $submenu post $x $y
4490           PreviewPieMenu $win $submenu $x $y
4491           catch {$root grab $win}
4492           ActivatePie $win $root $submenu SelectedUp
4493         }
4494       }
4495     }
4496     Initial { # error
4497       CancelPie $win
4498     }
4499     ClickedUp { # error
4500       CancelPie $win
4501     }
4502     SelectedUp { # error
4503       CancelPie $win
4504     }
4505   }
4506 }
4507
4508
4509 # Track the selected item
4510 proc TrackPieMenu {pie x y} {
4511   $pie activate @$x,$y
4512 }
4513
4514
4515 proc PreviewPieMenu {win pie x y} {
4516   set preview [lindex [$pie config -preview] 4]
4517   if {"$preview" != ""} {
4518     set rx [winfo rootx $win]
4519     set ry [winfo rooty $win]
4520     set x [expr "$x - $rx"]
4521     set y [expr "$y - $ry"]
4522     eval [format $preview $x $y]
4523   }
4524 }
4525
4526
4527 ########################################################################
4528 # Pallet Handlers
4529
4530
4531 proc ExclusivePallet {state parent children prefix images inactive active cmd} {
4532   #echo "ExclusivePallet state $state parent $parent children $children prefix $prefix images $images inactive $inactive active $active cmd $cmd"
4533   set i 0
4534   foreach child $children {
4535     set name [lindex $images $i]
4536     if {$i == $state} then {
4537       $parent.$child config \
4538           -bitmap "@images/${prefix}${name}hi.xpm" \
4539           -relief $active
4540     } else {
4541       $parent.$child config \
4542           -bitmap "@images/${prefix}${name}.xpm" \
4543           -relief $inactive
4544     }
4545     incr i
4546   }
4547   eval [concat $cmd $state]
4548 }
4549
4550
4551 proc NonExclusivePallet {mask parent children prefix images
4552                          inactive active cmd} {
4553   set i 0
4554   foreach child $children {
4555     set name [lindex $images $i]
4556     if {$mask & (1<<$i)} then {
4557       $parent.$child config \
4558           -bitmap "@images/${prefix}${name}hi.xpm" \
4559           -relief $active
4560     } else {
4561       $parent.$child config \
4562           -bitmap "@images/${prefix}${name}.xpm" \
4563           -relief $inactive
4564     }
4565     incr i
4566   }
4567   eval [concat $cmd $mask]
4568 }
4569
4570
4571 proc EditorPallet {win state} {
4572   global EditorPalletSounds
4573   UIMakeSoundOn $win mode [lindex $EditorPalletSounds $state]
4574   EditorSetTool $win $state
4575 }
4576
4577
4578 proc EditorSetTool {win state} {
4579   global EditorPallets
4580   global EditorPalletImages
4581   ExclusivePallet $state $win $EditorPallets ic $EditorPalletImages \
4582         flat raised "$win.centerframe.view ToolState"
4583 }
4584
4585
4586 proc GraphPallet {win state} {
4587   set mask [[WindowLink $win.graphview] Mask]
4588   set mask [expr "$mask ^ (1<<$state)"]
4589   GraphPalletMask $win $mask
4590 }
4591
4592
4593 proc GraphPalletMask {win mask} {
4594   global GraphPallets
4595   global GraphPalletImages
4596   NonExclusivePallet $mask $win $GraphPallets gr $GraphPalletImages \
4597         flat flat "SetGraphState $win"
4598 }
4599
4600
4601 proc GraphYearPallet {win state} {
4602   global GraphYearPallets
4603   global GraphYearPalletImages
4604   ExclusivePallet $state $win $GraphYearPallets gr $GraphYearPalletImages \
4605         flat flat "SetGraphYearState $win"
4606 }
4607
4608
4609 proc SetGraphYearState {win state} {
4610   set graph [WindowLink $win.graphview]
4611   if {$state == 0} {
4612     $graph Range 10
4613   } else {
4614     $graph Range 120
4615   }
4616 }
4617
4618
4619 proc SetGraphState {win mask} {
4620   global GraphPallets
4621   set graph [WindowLink $win.graphview]
4622   $graph Mask $mask
4623 }
4624
4625
4626 ########################################################################
4627 # Button Handlers
4628
4629 proc sim_butEnter {w} {
4630   global tk_priv
4631   set screen [winfo screen $w]
4632   set tk_priv(window@$screen) $w
4633 }
4634
4635
4636 proc sim_butLeave {w} {
4637   global tk_priv
4638   set screen [winfo screen $w]
4639   set tk_priv(window@$screen) ""
4640 }
4641
4642
4643 proc sim_butDown {w} {
4644   global tk_priv
4645   set screen [winfo screen $w]
4646   set pict [lindex [$w config -bitmap] 4]
4647   set tk_priv(relief@$screen) $pict
4648   $w config -bitmap [lindex [split $pict .] 0]hi.xpm
4649   update idletasks
4650 }
4651
4652
4653 proc sim_butUp {w} {
4654   global tk_priv
4655   set screen [winfo screen $w]
4656   $w config -bitmap $tk_priv(relief@$screen)
4657   update idletasks
4658   if {$w == $tk_priv(window@$screen)} {
4659     uplevel #0 [list $w invoke]
4660   }
4661 }
4662
4663
4664 proc BindSimButton {w} {
4665   bind $w <Any-Enter> {sim_butEnter %W}
4666   bind $w <Any-Leave> {sim_butLeave %W}
4667   bind $w <1> {sim_butDown %W}
4668   bind $w <ButtonRelease-1> {sim_butUp %W}
4669   bind $w <2> {sim_butDown %W}
4670   bind $w <ButtonRelease-2> {sim_butUp %W}
4671   bind $w <3> {sim_butDown %W}
4672   bind $w <ButtonRelease-3> {sim_butUp %W}
4673 }
4674
4675
4676 ########################################################################
4677 # Internal Callbacks
4678
4679
4680 proc UIStartMicropolis {homedir resourcedir hostname} {
4681   global HomeDir ResourceDir HostName HeadWindows
4682   set HomeDir $homedir
4683   set ResourceDir $resourcedir
4684   set HostName $hostname
4685   sim InitGame
4686   sim GameStarted
4687   update
4688
4689   foreach display [sim Displays] {
4690     if {"[AddPlayer $display]" == ""} {
4691       echo Couldn't add a player on $display ...
4692     }
4693   }
4694
4695   if {"$HeadWindows" == ""} {
4696     echo Micropolis is exiting because it couldn't connect to any players.
4697     sim ReallyQuit
4698   }
4699 }
4700
4701
4702 proc UISelectCity {win} {
4703   AskQuestion [Color $win #ff0000 #ffffff] "Choose Another City" \
4704     "Do you want to abandon this city and choose another one?" \
4705     "{Keep playing.} SelectCity.No {RejectPlan}" \
4706     "" \
4707     "{Another city!} SelectCity.Yes {UIPickScenarioMode}"
4708 }
4709
4710
4711 proc UIQuit {head} {
4712   if {[sim Players] == 1} {
4713     set l "{Keep playing.} Quit.No {RejectPlan}"
4714     set m ""
4715     set r "{I quit!} Quit.IQuit {DoReallyQuit %s}"
4716   } else {
4717     set l "{Keep playing.} Quit.No {RejectPlan}"
4718     set m "{I quit!} Quit.IResign {DoIResign %s}"
4719     set r "{Everyone quit!} Quit.AllQuit {DoReallyQuit %s}"
4720   }
4721   AskQuestion [Color $head #ff0000 #ffffff] "Quit Playing Micropolis" \
4722     "Do you want to quit playing Micropolis?" \
4723     $l $m $r
4724 }
4725
4726
4727 proc DoIResign {head} {
4728   global VotesForAsk
4729   set display [winfo screen $head]
4730   CrushHead $head
4731   DecRefDisplay $display
4732   UISetMessage "The player on X11 Display $display has resigned."
4733   UpdatePlayers
4734   if {([sim Players] == 0) ||
4735       ([llength $VotesForAsk] >= [sim Players])} {
4736     sim ReallyQuit
4737   }
4738 }
4739
4740
4741 proc DoReallyQuit {head} {
4742   echo QuitMicropolis
4743   sim ReallyQuit
4744 }
4745
4746
4747 proc UISplashMode {} {
4748   global State
4749   set State splash
4750   sim Pause
4751   WithdrawAll
4752   InitSplashes
4753   ShowSplashes
4754 }
4755
4756
4757 proc UIPickScenarioMode {} {
4758   global State
4759   global CityLibDir
4760   set State scenario
4761   sim Pause
4762   WithdrawAll
4763   InitHistory
4764   UIGenerateCityNow
4765   InitScenarios
4766   InitVotesForUseThisMap
4767   ShowScenarios
4768 }
4769
4770
4771 proc ForcePickScenarioMode {} {
4772   global State
4773   if {"$State" != "scenario"} {
4774     UIPickScenarioMode
4775   }
4776 }
4777
4778
4779 proc UIGenerateCityNow {} {
4780   global CityName GameLevel
4781   sim CityName NowHere
4782   sim GameLevel 0
4783   UIGenerateNewCity
4784 }
4785
4786
4787 proc UIGenerateNewCity {} {
4788   global CityName GameLevel
4789   if {$GameLevel == -1} {
4790     set GameLevel 0
4791   }
4792   MakeHistory "DoNewCity NowHere $GameLevel [sim Rand] [sim TreeLevel] [sim LakeLevel] [sim CurveLevel] [sim CreateIsland]"
4793 }
4794
4795
4796 proc DoNewCity {name level {r ""} {tl -1} {ll -1} {cl -1} {ci -1}} {
4797   global Scenario
4798   set Scenario -1
4799   sim TreeLevel $tl
4800   sim LakeLevel $ll
4801   sim CurveLevel $cl
4802   sim CreateIsland $ci
4803   if {"$r" == ""} {
4804     sim GenerateNewCity
4805   } else {
4806     sim GenerateSomeCity $r
4807   }
4808   sim CityName $name
4809   sim GameLevel $level
4810   UIShowPicture 48
4811 }
4812
4813
4814 proc UIDidGenerateNewCity {} {
4815   sim Update
4816 }
4817
4818
4819 proc IncRefDisplay {display} {
4820   global DisplayRegistry
4821   if ![info exists DisplayRegistry($display)] {
4822     set DisplayRegistry($display) 0
4823   }
4824   incr DisplayRegistry($display)
4825 }
4826
4827
4828 proc DecRefDisplay {display} {
4829   global DisplayRegistry
4830   incr DisplayRegistry($display) -1
4831   if {$DisplayRegistry($display) <= 0} {
4832     CloseDisplay $display
4833   }
4834 }
4835
4836
4837 proc CloseDisplay {display} {
4838 }
4839
4840
4841 proc DoStopMicropolis {} {
4842   KillSoundServers
4843   destroy .
4844 }
4845
4846
4847 proc AddPlayer {display} {
4848   set i [string first : $display]
4849   if {$i == 0} {
4850   } else {
4851     if {$i == -1} {
4852       set display "$display:0"
4853     }
4854   }
4855
4856   echo Adding a player on $display ...
4857
4858   set head [MakeWindow.head $display]
4859
4860   if {"$head" != ""} {
4861     set display [winfo screen $head]
4862     IncRefDisplay $display
4863     PrepHead $head
4864     UISetMessage "Added a player on X11 Display \"$display\"."
4865     UpdatePlayers
4866   } else {
4867     UISetMessage "Couldn't add a player on X11 Display \"$display\"!"
4868   }
4869   return $head
4870 }
4871
4872
4873 proc FireBomb {} {
4874   sim FireBomb
4875 }
4876
4877 proc DropFireBombs {} {
4878   FireBomb
4879   after 300 FireBomb
4880   after 600 FireBomb
4881   after 900 FireBomb
4882 }
4883
4884
4885 proc UIMakeMonster {} {
4886   sim MakeMonster [sim Rand 120] [sim Rand 100]
4887 }
4888
4889
4890 proc melt {} {
4891   sim HeatSteps 1
4892   sim HeatFlow -7
4893   sim HeatRule 0
4894 }
4895
4896
4897 proc eco {} {
4898   sim HeatSteps 1
4899   sim HeatFlow 19
4900   sim HeatRule 1
4901 }
4902
4903
4904 proc oops {} {
4905   sim HeatSteps 0
4906 }
4907
4908
4909 proc TogglePause {} {
4910   global State
4911
4912   if {"$State" != "play" || [sim Speed]} {
4913     sim Speed 0
4914   } else {
4915     sim Speed 3
4916   }
4917   MakeRunningSound
4918 }
4919
4920
4921 proc SetSpeedTime {time} {
4922   sim Speed $time
4923   MakeRunningSound
4924 }
4925
4926
4927 proc MakeRunningSound {} {
4928   global State
4929
4930   if {"$State" == "play" && [sim Speed]} {
4931     UIMakeSound edit Boing "-speed 1[sim Speed]0"
4932   } else {
4933     UIMakeSound edit Boing "-speed 90"
4934   }
4935 }
4936
4937
4938 proc SayDemands {} {
4939   global DemandRes DemandCom DemandInd
4940   set slope 3
4941   set r [expr "100 + ($DemandRes * $slope)"]
4942   set c [expr "100 + ($DemandCom * $slope)"]
4943   set i [expr "100 + ($DemandInd * $slope)"]
4944   after 020 "UIMakeSound edit O \"-speed $r\""
4945   after 220 "UIMakeSound edit A \"-speed $c\""
4946   after 440 "UIMakeSound edit E \"-speed $i\""
4947 }
4948
4949
4950 proc UISaveCity {win} {
4951   global SaveCityWin
4952   set SaveCityWin $win
4953   sim SaveCity
4954 }
4955
4956
4957 proc UISaveCityAs {{win ""}} {
4958   global SaveCityWin
4959   if {"$win" == ""} {set win $SaveCityWin}
4960   set SaveCityWin $win
4961
4962   global CityDir
4963   set file [ShowFileOf $win]
4964   DoFileDialog $file "Choose a File to Save the City" $CityDir "*.cty" "" \
4965         "UIDoReallySaveCity" ""
4966 }
4967
4968
4969 proc UIDoReallySaveCity {name path} {
4970   global CityDir
4971   if {![string match *.cty $name]} {
4972     set name $name.cty
4973   }
4974   set CityDir $path
4975   sim SaveCityAs $path/$name
4976 }
4977
4978
4979 proc UIDidSaveCity {} {
4980   DoSendMessage "Saved the city in \"[sim CityFileName]\"." status
4981 }
4982
4983
4984 proc UIDidntSaveCity {msg} {
4985   DoSendMessage $msg alert
4986   UIMakeSound warning Sorry "-speed 85"
4987 }
4988
4989
4990 proc UILoadScenario {scen} {
4991   MakeHistory "DoScenario $scen"
4992 }
4993
4994
4995 proc DoScenario {scen} {
4996   global Scenario
4997   set Scenario $scen
4998   sim LoadScenario $scen
4999   UIShowPicture $scen
5000 }
5001
5002
5003 proc UIDidLoadScenario {} {
5004 }
5005
5006
5007 proc UIStartScenario {id} {
5008   global Scenario
5009   set Scenario $id
5010   UILoadScenario $id
5011   UIPlayGame
5012   UIShowPicture $id
5013 }
5014
5015
5016 proc UIPlayNewCity {} {
5017   UIGenerateNewCity
5018   UIPlayGame
5019 }
5020
5021
5022 proc UIStartLoad {} {
5023   UIPlayGame
5024 }
5025
5026
5027 proc UIReallyStartGame {} {
5028   #UIPickScenarioMode
5029   UISplashMode
5030 }
5031
5032
5033 proc UIPlayGame {} {
5034   global State
5035   global Priority
5036   set State play
5037   sim Resume
5038   sim Speed 3
5039   sim AutoGoto 1
5040   SetPriority $Priority
5041   InitHeads
5042   InitAllHeadMenus
5043   ShowInitial
5044   sim NeedRest 10
5045 }
5046
5047
5048 proc UISetSpeed {speed} {
5049   global Time State
5050   set Time $speed
5051   if {"$State" == "play"} {
5052     UISetMessage [lindex {
5053       {Time pauses.}
5054       {Time flows slow.}
5055       {Time flows medium.}
5056       {Time flows fast.}
5057     } $speed]
5058   }
5059   UIUpdateRunning
5060 }
5061
5062
5063 proc UIUpdateRunning {} {
5064   global HeadWindows Time State
5065
5066         if {($State == "play") && $Time} {
5067     set pict "@images/micropolisg.xpm"
5068   } else {
5069     set pict "@images/micropoliss.xpm"
5070   }
5071
5072   foreach win $HeadWindows {
5073     set can [WindowLink $win.demand]
5074     $can itemconfig micropolis -bitmap $pict
5075   }
5076 }
5077
5078
5079 proc DoSetGameLevel {level} {
5080   sim GameLevel $level
5081 }
5082
5083
5084 proc UISetGameLevel {level} {
5085   global GameLevel
5086   set GameLevel $level
5087   global ScenarioWindows
5088   foreach win $ScenarioWindows {
5089     UpdateLevelSelection $win
5090   }
5091 }
5092
5093
5094 proc UISetCityName {name} {
5095   global EditorWindows
5096   global CityName
5097   set CityName $name
5098   set title "Micropolis Editor on $name"
5099   foreach win $EditorWindows {
5100     # TODO: set editor window and icon title
5101     #wm title $win "$title"
5102     #wm iconname $win "$title"
5103   }
5104 }
5105
5106
5107 proc UILoadCity {win} {
5108   # if changed, r-u-sure?
5109   global CityDir
5110   set file [ShowFileOf $win]
5111   DoFileDialog $file "Choose a City to Load" $CityDir "*.cty" "" \
5112         "UIDoLoadCity" ""
5113 }
5114
5115
5116 proc UIDoLoadCity {name path} {
5117   global CityDir
5118   set CityDir $path
5119   if {![string match *.cty $name]} {
5120     set name $name.cty
5121   }
5122   MakeHistory "DoLoadCity $path/$name"
5123 }
5124
5125
5126 proc DoLoadCity {filename} {
5127   sim LoadCity $filename
5128 }
5129
5130 proc UIDidLoadCity {} {
5131   global State GameLevel Scenario
5132   set Scenario -1
5133   set GameLevel -1
5134   if {$State == "play"} {
5135     UIPlayGame
5136   } else {
5137     UIShowPicture 49 [sim CityFileName]
5138   }
5139 }
5140
5141
5142 proc UIDidntLoadCity {msg} {
5143   DoSendMessage $msg alert
5144   UIMakeSound warning Sorry "-speed 85"
5145   UIShowPicture 49 [sim CityFileName]
5146   sim Fill 0
5147   sim UpdateMaps
5148 }
5149
5150
5151 proc UINewGame {} {
5152   global OldBudget
5153   set OldBudget 0
5154   sim InitGame
5155   sim EraseOverlay
5156   InitEditors
5157   InitMaps
5158   InitGraphs
5159   update
5160   sim UpdateMaps
5161 }
5162
5163
5164 proc UIDidPan {w x y} {
5165   if {[$w ToolMode] == 1} {
5166     EditorToolDrag $w $x $y
5167   }
5168   update idletasks
5169 }
5170
5171
5172 proc UIDidStopPan {win} {
5173   UIMakeSoundOn $win fancy Skid "-volume 25"
5174   $win TweakCursor
5175 }
5176
5177
5178 proc UIEarthQuake {} {
5179 }
5180
5181
5182 proc UIAutoGoto {x y {except {}}} {
5183   global EditorWindows
5184   set didOne 0
5185   set x [expr "$x * 16 + 8"]
5186   set y [expr "$y * 16 + 8"]
5187   foreach win $EditorWindows {
5188     if {"$win" != "$except"} {
5189       set view [WindowLink $win.view]
5190       if {[$view AutoGoto]} {
5191         set didOne 1
5192         $view AutoGoal $x $y
5193       }
5194     }
5195   }
5196   if {$didOne} {
5197     sim UpdateMaps
5198   }
5199 }
5200
5201
5202 proc UIAutoGotoOn {x y eds} {
5203   set x [expr "$x * 16 + 8"]
5204   set y [expr "$y * 16 + 8"]
5205   foreach win $eds {
5206     [WindowLink $win.view] AutoGoal $x $y
5207   }
5208   sim UpdateMaps
5209 }
5210
5211
5212 proc DoLeaveGame {head} {
5213 }
5214
5215
5216 proc UILoseGame {} {
5217   UIPickScenarioMode
5218   UIShowPicture 200
5219 }
5220
5221
5222 proc UIWinGame {} {
5223   UIShowPicture 100
5224 }
5225
5226
5227 proc DoPendTool {view tool x y} {
5228   global HeadWindows ToolInfo VotesForAsk
5229
5230   set win [WindowLink $view.top]
5231   set head [WindowLink $win.head]
5232
5233   if {($tool == [sim PendingTool]) &&
5234       ($x == [sim PendingX]) &&
5235       ($y == [sim PendingY])} {
5236     if {[lsearch $VotesForAsk $head] != -1} {
5237       # you can only vote once
5238       UIMakeSound edit Oop
5239     } else {
5240       UIMakeSound edit Boing
5241       set ask [WindowLink $head.ask]
5242       PressVoteButton $ask [WindowLink $ask.vote] Ask
5243     }
5244   } else {
5245     UIAutoGoto $x $y $win
5246
5247     UIMakeSound edit Boing
5248     set info [lindex $ToolInfo $tool]
5249     set a [lindex $info 0]
5250     set name [lindex $info 1]
5251     set cost [lindex $info 2]
5252     set title "Build $a $name"
5253     set question "Do you support the plan to build $a $name for $cost?"
5254     AskQuestion [Color $win #00ff00 #ffffff] "$title" \
5255         "$question" \
5256         "{Veto plan.} Plan.Veto
5257            {RejectPlan}" \
5258         "{Goto plan.} Plan.Goto
5259            {ComeTo %s $x $y}" \
5260         "{Support plan!} Plan.Support
5261            {SupportPlan $view %s $tool $x $y}
5262            {PreviewSupportPlan $view %s $tool $x $y}"
5263     set VotesForAsk $head
5264     set ask [WindowLink $head.ask]
5265     [WindowLink $ask.vote] config -relief sunken
5266
5267     UpdateVotesForAsk
5268
5269     sim PendingTool $tool
5270     sim PendingX $x
5271     sim PendingY $y
5272     sim Votes [llength $VotesForAsk]
5273   }
5274 }
5275
5276
5277 proc RejectPlan {} {
5278   sim PendingTool -1
5279   if {[sim Players] > 1} {
5280     UIMakeSound edit Sorry
5281   }
5282   WithdrawAsks
5283 }
5284
5285
5286 proc NeededVotes {} {
5287   global FreeVotes
5288   set players [sim Players]
5289   set needed [expr "$players - $FreeVotes"]
5290   return [max 0 $needed]
5291 }
5292
5293
5294 proc SupportPlan {view h tool x y} {
5295   global VotesForAsk
5296   sim Votes [llength $VotesForAsk]
5297   sim PendingTool -1
5298   sim OverRide 1
5299   $view DoTool $tool $x $y
5300   sim OverRide 0
5301   WithdrawAsks
5302   UIMakeSound edit Aaah
5303 }
5304
5305
5306 proc PreviewSupportPlan {view h tool x y} {
5307   global VotesForAsk
5308   sim Votes [llength $VotesForAsk]
5309 }
5310
5311
5312 proc SugarStartUp {uri} {
5313   global SugarURI
5314   set SugarURI $uri
5315
5316   # TODO: Load the city file at the given URI, or configure according to URI parameters.
5317 }
5318
5319
5320 proc SugarNickName {nick} {
5321   global SugarNickName
5322   set SugarNickName $nick
5323 }
5324
5325
5326 proc SugarActivate {} {
5327   global SugarActivated
5328   set SugarActivated 1
5329 }
5330
5331
5332 proc SugarDeactivate {} {
5333   global SugarActivated
5334   set SugarActivated 0
5335 }
5336
5337
5338 proc SugarShare {} {
5339   global SugarShared
5340   set SugarShared 1
5341 }
5342
5343
5344 proc SugarBuddyAdd {key nick color address} {
5345   global SugarBuddies
5346   set buddy [list $key $nick $color $address]
5347   lappend SugarBuddies $buddy
5348 }
5349
5350
5351 proc SugarBuddyDel {key nick color address} {
5352   global SugarBuddies
5353   set buddy [list $key $nick $color $address]
5354   set i [lsearch $wins $win]
5355   if {$i != -1} {
5356     set SugarBuddies [lreplace $wins $i $i]
5357   }
5358 }
5359
5360
5361 proc SugarQuit {} {
5362   sim ReallyQuit
5363 }
5364
5365
5366 ########################################################################