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