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