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