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