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