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