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