1d56b751b26f64802e613150b2a295f4375dfc1d
[micropolis] / res / micropolis.tcl
1 #######################################################################
2 # Micropolis.tcl, by Don Hopkins.
3 # Copyright (C) 2002 by Electronic Arts.
4 # This file defines the user interface of Micropolis.
5 # Modify at your own risk!
6 ########################################################################
7 # Micropolis, Unix Version. This game was released for the Unix platform
8 # in or about 1990 and has been modified for inclusion in the One Laptop
9 # Per Child program. Copyright (C) 1989 - 2007 Electronic Arts Inc. If
10 # you need assistance with this program, you may contact:
11 # http://wiki.laptop.org/go/Micropolis or email micropolis@laptop.org.
12 #
13 # This program is free software: you can redistribute it and/or modify
14 # it under the terms of the GNU General Public License as published by
15 # the Free Software Foundation, either version 3 of the License, or (at
16 # your option) any later version.
17 #
18 # This program is distributed in the hope that it will be useful, but
19 # WITHOUT ANY WARRANTY; without even the implied warranty of
20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 # General Public License for more details. You should have received a
22 # copy of the GNU General Public License along with this program. If
23 # not, see <http://www.gnu.org/licenses/>.
24 #
25 # ADDITIONAL TERMS per GNU GPL Section 7
26 #
27 # No trademark or publicity rights are granted. This license does NOT
28 # give you any right, title or interest in the trademark SimCity or any
29 # other Electronic Arts trademark. You may not distribute any
30 # modification of this program using the trademark SimCity or claim any
31 # affliation or association with Electronic Arts Inc. or its employees.
32 #
33 # Any propagation or conveyance of this program must include this
34 # copyright notice and these terms.
35 #
36 # If you convey this program (or any modifications of it) and assume
37 # contractual liability for the program to recipients of it, you agree
38 # to indemnify Electronic Arts for any liability that those contractual
39 # assumptions impose on Electronic Arts.
40 #
41 # You may not misrepresent the origins of this program; modified
42 # versions of the program must be marked as such and not identified as
43 # the original program.
44 #
45 # This disclaimer supplements the one included in the General Public
46 # License. TO THE FULLEST EXTENT PERMISSIBLE UNDER APPLICABLE LAW, THIS
47 # PROGRAM IS PROVIDED TO YOU "AS IS," WITH ALL FAULTS, WITHOUT WARRANTY
48 # OF ANY KIND, AND YOUR USE IS AT YOUR SOLE RISK. THE ENTIRE RISK OF
49 # SATISFACTORY QUALITY AND PERFORMANCE RESIDES WITH YOU. ELECTRONIC ARTS
50 # DISCLAIMS ANY AND ALL EXPRESS, IMPLIED OR STATUTORY WARRANTIES,
51 # INCLUDING IMPLIED WARRANTIES OF MERCHANTABILITY, SATISFACTORY QUALITY,
52 # FITNESS FOR A PARTICULAR PURPOSE, NONINFRINGEMENT OF THIRD PARTY
53 # RIGHTS, AND WARRANTIES (IF ANY) ARISING FROM A COURSE OF DEALING,
54 # USAGE, OR TRADE PRACTICE. ELECTRONIC ARTS DOES NOT WARRANT AGAINST
55 # INTERFERENCE WITH YOUR ENJOYMENT OF THE PROGRAM; THAT THE PROGRAM WILL
56 # MEET YOUR REQUIREMENTS; THAT OPERATION OF THE PROGRAM WILL BE
57 # UNINTERRUPTED OR ERROR-FREE, OR THAT THE PROGRAM WILL BE COMPATIBLE
58 # WITH THIRD PARTY SOFTWARE OR THAT ANY ERRORS IN THE PROGRAM WILL BE
59 # CORRECTED. NO ORAL OR WRITTEN ADVICE PROVIDED BY ELECTRONIC ARTS OR
60 # ANY AUTHORIZED REPRESENTATIVE SHALL CREATE A WARRANTY. SOME
61 # JURISDICTIONS DO NOT ALLOW THE EXCLUSION OF OR LIMITATIONS ON IMPLIED
62 # WARRANTIES OR THE LIMITATIONS ON THE APPLICABLE STATUTORY RIGHTS OF A
63 # CONSUMER, SO SOME OR ALL OF THE ABOVE EXCLUSIONS AND LIMITATIONS MAY
64 # NOT APPLY TO YOU.
65
66
67 ########################################################################
68 # Libraries
69 ########################################################################
70
71
72 set errorInfo {}
73 set auto_noexec 1
74
75 source $tk_library/wish.tcl
76
77
78 ########################################################################
79 # Globals
80 ########################################################################
81
82
83 set UniqueID 0
84 set State uninitialized
85 set CityName "Micropolis"
86 set GameLevel 0
87 set SimHome [pwd]
88 set CityLibDir $SimHome/cities
89 set CityDir $CityLibDir
90 set OldBudget 0
91 set BudgetRoadFund 0
92 set BudgetFireFund 0
93 set BudgetPoliceFund 0
94 set BudgetTaxRate 0
95 set DemandRes 0
96 set DemandCom 0
97 set DemandInd 0
98 set Priority 2
99 set Time 3
100 set Pause 0
101 set AutoGoto 1
102 set AutoBudget 1
103 set Disasters 1
104 set AutoBulldoze 1
105 set Sound 1
106 set DoAnimation 1
107 set DoMessages 1
108 set DoNotices 1
109 set ShapePies 1
110 set SoundServers {}
111 set AudioChannels {mode edit fancy warning intercom}
112 set BudgetTimeout 30
113 set BudgetTimer 0
114 set BudgetTimerActive 0
115 set BudgetsVisible 0
116 set EvaluationsVisible 0
117 set SplashScreenDelay 5000
118 set Scenario -1
119 set Chatting 0
120 set ChatServer "localhost"
121 set ChatSocket 6667
122 set ChatConnection {}
123 set NickName "nickname"
124 set UserName "username"
125 set ServerName "servername"
126 set RealName "realname"
127 set ChannelName "#Micropolis"
128 set HomeDir ""
129 set ResourceDir ""
130 set HostName ""
131 set LocalHostName "[exec hostname]"
132 set SaveCityWin ""
133 set MapHistory {}
134 set MapHistoryNum -1
135 set HelpLoaded 0
136 set QueryX 0
137 set QueryY 0
138 set FreeVotes 0
139 set ShowingPicture 300
140 set MaxLines 500
141 set ShrinkLines 250
142 set ShowingParms {}
143 set VoteNames {UseThisMap Ask Zone}
144 set VotesForUseThisMap {}
145 set VotesForAsk {}
146 set VotesForZone {}
147 set VotesForBudget {}
148 set CurrentDate {}
149
150 set HeadWindows {}
151 set EditorWindows {}
152 set MapWindows {}
153 set GraphWindows {}
154 set BudgetWindows {}
155 set EvaluationWindows {}
156 set SplashWindows {}
157 set ScenarioWindows {}
158 set FileWindows {}
159 set AskWindows {}
160 set PlayerWindows {}
161 set NoticeWindows {}
162 set HelpWindows {}
163 set FrobWindows {}
164
165 set HeadPanelWidth 360
166 set HeadPanelHeight 200
167
168 set MapPanelWidth 360
169 set MapPanelHeight 330
170
171 set NoticePanelWidth 360
172 set NoticePanelHeight 250
173
174 set SplashPanelWidth 1200
175 set SplashPanelHeight 900
176
177 set ScenarioPanelWidth 420
178 set ScenarioPanelHeight 440
179
180 set SugarURI ""
181 set SugarNickName ""
182 set SugarShared 0
183 set SugarActivated 0
184 set SugarBuddies {}
185
186 set SubWindows {
187 {editor EditorWindows}
188 {map MapWindows}
189 {graph GraphWindows}
190 {budget BudgetWindows}
191 {evaluation EvaluationWindows}
192 {scenario ScenarioWindows}
193 {splash SplashWindows}
194 {file FileWindows}
195 {ask AskWindows}
196 {player PlayerWindows}
197 {notice NoticeWindows}
198 {help HelpWindows}
199 {frob FrobWindows}
200 {head HeadWindows}
201 }
202
203
204 # 0 1 2 3 4 5 6 7 8 9 10 11 12 13
205 # type id callback param var x y w h normal over disabled checked checkedover
206 # ----------- --------------- --------------- ------- ------- --- --- --- --- ------- ---- -------- ------- -----------
207 set ScenarioButtons {
208 { button load DoLoad "" "" 70 238 157 90 "" @images/button1hilite.xpm "" }
209 { button generate DoGenerate "" "" 62 392 157 90 "" @images/button2hilite.xpm "" }
210 { button quit DoQuit "" "" 68 544 157 90 "" @images/button3hilite.xpm "" }
211 { button about DoAbout "" "" 101 705 157 90 "" @images/button4hilite.xpm "" }
212 { checkbox easy DoLevel 0 "" 982 106 190 70 "" @images/checkbox1hilite.xpm "" @images/checkbox1checked.xpm @images/checkbox1hilitechecked.xpm }
213 { checkbox medium DoLevel 1 "" 982 176 190 70 "" @images/checkbox2hilite.xpm "" @images/checkbox2checked.xpm @images/checkbox2hilitechecked.xpm }
214 { checkbox hard DoLevel 2 "" 982 246 190 70 "" @images/checkbox3hilite.xpm "" @images/checkbox3checked.xpm @images/checkbox3hilitechecked.xpm }
215 { button left DoLeft "" "" 540 375 50 50 "" @images/lefthilite.xpm @images/leftdisabled.xpm }
216 { button right DoRight "" "" 841 375 50 50 "" @images/righthilite.xpm @images/rightdisabled.xpm }
217 { button play DoPlay "" "" 625 376 180 50 "" @images/playhilite.xpm "" }
218 { button scenario1 DoPickScenario "1" "" 310 451 209 188 "" @images/scenario1hilite.xpm "" }
219 { button scenario2 DoPickScenario "2" "" 519 451 209 188 "" @images/scenario2hilite.xpm "" }
220 { button scenario3 DoPickScenario "3" "" 727 450 209 188 "" @images/scenario3hilite.xpm "" }
221 { button scenario4 DoPickScenario "4" "" 936 450 209 188 "" @images/scenario4hilite.xpm "" }
222 { button scenario5 DoPickScenario "5" "" 310 639 209 188 "" @images/scenario5hilite.xpm "" }
223 { button scenario6 DoPickScenario "8" "" 519 639 209 188 "" @images/scenario6hilite.xpm "" }
224 { button scenario7 DoPickScenario "7" "" 728 638 209 188 "" @images/scenario7hilite.xpm "" }
225 { button scenario8 DoPickScenario "6" "" 937 638 209 188 "" @images/scenario8hilite.xpm "" }
226 }
227
228 # Disabled until we handle mouse events on the map itself.
229 # { button map DoMap "" "" 516 30 396 338 "" @images/maphilite.xpm }
230
231
232 ########################################################################
233 # Fonts
234
235
236 set FontInfo {
237 {Big {
238 {-*-dejavu lgc sans-medium-r-normal-*-90-*}
239 }}
240 {Large {
241 {-*-dejavu lgc sans-medium-r-normal-*-80-*}
242 }}
243 {Medium {
244 {-*-dejavu lgc sans-medium-r-normal-*-70-*}
245 }}
246 {Small {
247 {-*-dejavu lgc sans-medium-r-normal-*-60-*}
248 }}
249 {Narrow {
250 {-*-dejavu lgc sans-medium-r-normal-*-60-*}
251 }}
252 {Tiny {
253 {-*-dejavu lgc sans-medium-r-normal-*-60-*}
254 }}
255 {Text {
256 {-*-dejavu lgc sans-medium-r-normal-*-70-*}
257 }}
258 {Message {
259 {-*-dejavu lgc sans-medium-r-normal-*-70-*}
260 }}
261 {Alert {
262 {-*-dejavu lgc sans-medium-r-normal-*-70-*}
263 }}
264 }
265
266
267 ########################################################################
268
269
270 set MapTitles {
271 {Micropolis Overall Map}
272 {Residential Zone Map}
273 {Commercial Zone Map}
274 {Industrial Zone Map}
275 {Power Grid Map}
276 {Transportation Map}
277 {Population Density Map}
278 {Rate of Growth Map}
279 {Traffic Density Map}
280 {Pollution Desity Map}
281 {Crime Rate Map}
282 {Land Value Map}
283 {Fire Coverage Map}
284 {Police Coverage Map}
285 {Dynamic Filter Map}
286 }
287
288
289 set EditorPallets {
290 leftframe.tools.palletres
291 leftframe.tools.palletcom
292 leftframe.tools.palletind
293 leftframe.tools.palletfire
294 leftframe.tools.palletquery
295 leftframe.tools.palletpolice
296 leftframe.tools.palletwire
297 leftframe.tools.palletbulldozer
298 leftframe.tools.palletrail
299 leftframe.tools.palletroad
300 leftframe.tools.palletchalk
301 leftframe.tools.palleteraser
302 leftframe.tools.palletstadium
303 leftframe.tools.palletpark
304 leftframe.tools.palletseaport
305 leftframe.tools.palletcoal
306 leftframe.tools.palletnuclear
307 leftframe.tools.palletairport
308 }
309
310
311 set EditorPalletImages {
312 res com ind fire qry pol
313 wire dozr rail road chlk ersr
314 stad park seap coal nuc airp
315 }
316
317
318 set EditorPalletSounds {
319 Res Com Ind Fire Query Police
320 Wire Bulldozer Rail Road Chalk Eraser
321 Stadium Park Seaport Coal Nuclear Airport
322 }
323
324
325 set GraphPallets {
326 leftframe.left.res
327 leftframe.left.com
328 leftframe.left.ind
329 leftframe.right.money
330 leftframe.right.crime
331 leftframe.right.pollution
332 }
333
334
335 set GraphPalletImages {
336 res com ind mony crim poll
337 }
338
339
340 set GraphYearPallets {
341 leftframe.year.year10
342 leftframe.year.year120
343 }
344
345
346 set GraphYearPalletImages { 10 120 }
347
348
349 set ToolInfo {
350 { {a} {Residential Zone} {$100}}
351 { {a} {Commercial Zone} {$100}}
352 { {an} {Industrial Zone} {$100}}
353 { {a} {Fire Station} {$500}}
354 { {a} {Query} {free}}
355 { {a} {Police Station} {$500}}
356 { {a} {Wire} {$5}}
357 { {a} {Bulldozer} {$1}}
358 { {a} {Rail} {$20}}
359 { {a} {Road} {$10}}
360 { {a} {Chalk} {free}}
361 { {an} {Eraser} {free}}
362 { {a} {Stadium} {$5,000}}
363 { {a} {Park} {$20}}
364 { {a} {Seaport} {$3,000}}
365 { {a} {Coal Power Plant} {$3,000}}
366 { {a} {Nuclear Power Plant} {$5,000}}
367 { {an} {Airport} {$10,000}}
368 { {a} {Network} {$1,000}}
369 }
370
371
372 set DynamicDataNames {
373 {Population Density}
374 {Rate of Growth}
375 {Traffic Density}
376 {Pollution Density}
377 {Crime Rate}
378 {Land Value}
379 {Police Coverage}
380 {Fire Coverage}
381 }
382
383 ########################################################################
384 # Initialization
385 ########################################################################
386
387
388 wm title . {Micropolis Root}
389
390
391 if {"[sim Platform]" == "msdos"} {
392 sim DoAnimation 0
393 set DoAnimation 0
394 set ShapePies 0
395 } else {
396 sim DoAnimation 1
397 set DoAnimation 1
398 set ShapePies 1
399 }
400
401 sprite explosion 7
402 sprite tornado 6
403 sprite airplane 3
404 sprite helicopter 2
405 sprite monster 5
406 sprite ship 4
407 sprite bus 8
408 sprite train 1
409
410 sim ResetDynamic
411
412 # The next three lines have no effect on the OLPC, where we don't provide
413 # the font in res (because it's already in the system fonts). These lines
414 # are for other systems that lack the font.
415 set FontPath "[pwd]/res/dejavu-lgc"
416 system "xset -fp \"$FontPath\" >/dev/null 2>&1"
417 system "xset +fp \"$FontPath\" >/dev/null 2>&1"
418
419
420 ########################################################################
421 # Messages
422 ########################################################################
423
424
425 proc Message {id color title msg {props {}}} {
426 global Messages
427 set Messages($id) [list $color $title $msg $props]
428 }
429
430
431 Message 1 #7f7fff {DULLSVILLE, USA 1900} \
432 {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.
433
434 It is your job to attract new growth and development, turning Dullsville into a Metropolis within 30 years.}
435
436 Message 2 #7f7fff {SAN FRANCISCO, CA. 1906} \
437 {Damage from the earthquake was minor compared to that of the ensuing fires, which took days to control. 1500 people died.
438
439 Controlling the fires should be your initial concern. Then clear the rubble and start rebuilding. You have 5 years.}
440
441 Message 3 #7f7fff {HAMBURG, GERMANY 1944} \
442 {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.
443
444 You must control the firestorms during the bombing and then rebuild the city after the war. You have 5 years.}
445
446 Message 4 #7f7fff {BERN, SWITZERLAND 1965} \
447 {The roads here are becoming more congested every day, and the residents are upset. They demand that you do something about it.
448
449 Some have suggested a mass transit system as the answer, but this would require major rezoning in the downtown area. You have 10 years.}
450
451 Message 5 #7f7fff {TOKYO, JAPAN 1957} \
452 {A large reptilian creature has been spotted heading for Tokyo bay. It seems to be attracted to the heavy levels of industrial pollution there.
453
454 Try to control the fires, then rebuild the industrial center. You have 5 years.}
455
456 Message 6 #7f7fff {DETROIT, MI. 1972} \
457 {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.
458
459 You have 10 years to reduce crime and rebuild the industrial base of the city.}
460
461 Message 7 #7f7fff {BOSTON, MA. 2010} \
462 {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.
463
464 You have 5 years to get the situation under control.}
465
466 Message 8 #7f7fff {RIO DE JANEIRO, BRAZIL 2047} \
467 {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.
468
469 You have 10 years to turn this swamp back into a city again.}
470
471 Message 9 #ffa500 {Query Zone Status} \
472 {
473 Zone: %s
474 Density: %s
475 Value: %s
476 Crime: %s
477 Pollution: %s
478 Growth: %s} \
479 {{view {PanView $v $QueryX $QueryY}}}
480
481 Message 10 #ff4f4f {POLLUTION ALERT!} \
482 {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.
483
484 Either clean up your act or open a gas mask concession at city hall.} \
485 {{view {PanView $v [sim PolMaxX] [sim PolMaxY]}}}
486
487 Message 11 #ff4f4f {CRIME ALERT!} \
488 {Crime in your city is out of hand. Angry mobs are looting and vandalizing the central city. The president will send in the national guard soon if you cannot control the problem.} \
489 {{view {PanView $v [sim CrimeMaxX] [sim CrimeMaxY]}}}
490
491 Message 12 #ff4f4f {TRAFFIC WARNING!} \
492 {Traffic in this city is horrible. The city gridlock is expanding. The commuters are getting militant.
493
494 Either build more roads and rails or get a bulletproof limo.} \
495 {{view {PanView $v [sim TrafMaxX] [sim TrafMaxY]}}}
496
497 Message 20 #ff4f4f {FIRE REPORTED!} \
498 "A fire has been reported!" \
499 {{view {PanView $v [sim CrashX] [sim CrashY]}}}
500
501 Message 21 #ff4f4f {MONSTER ATTACK!} \
502 "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. \
503 All you can do is wait till he leaves, then rebuild from the rubble." \
504 {{view {FollowView $v monster}}}
505
506 # XXX: write more text
507 Message 22 #ff4f4f {TORNADO ALERT!} \
508 {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!} \
509 {{view {FollowView $v tornado}}}
510
511 # XXX: write more text
512 Message 23 #ff4f4f {EARTHQUAKE!} \
513 {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.} \
514 {{view {PanView $v [sim CenterX] [sim CenterY]}}}
515
516 # XXX: write more text
517 Message 24 #ff4f4f {PLANE CRASH!} \
518 {A plane has crashed!} \
519 {{view {PanView $v [sim CrashX] [sim CrashY]}}}
520
521 # XXX: write more text
522 Message 25 #ff4f4f {SHIPWRECK!} \
523 {A ship has wrecked!} \
524 {{view {PanView $v [sim CrashX] [sim CrashY]}}}
525
526 # XXX: write more text
527 Message 26 #ff4f4f {TRAIN CRASH!} \
528 {A train has crashed!} \
529 {{view {PanView $v [sim CrashX] [sim CrashY]}}}
530
531 # XXX: write more text
532 Message 27 #ff4f4f {HELICOPTER CRASH!} \
533 {A helicopter has crashed!} \
534 {{view {PanView $v [sim CrashX] [sim CrashY]}}}
535
536 Message 30 #ff4f4f {FIREBOMBING REPORTED!} \
537 {Firebombs are falling!!} \
538 {{view {PanView $v [sim CrashX] [sim CrashY]}}}
539
540 Message 35 #7fff7f {TOWN} \
541 {Congratulations, your village has grown to town status. You now have 2,000 citizens.} \
542 {{view {PanView $v [sim CenterX] [sim CenterY]}}}
543
544 Message 36 #7fff7f {CITY} \
545 {Your town has grown into a full sized city, with a current population of 10,000. Keep up the good work!} \
546 {{view {PanView $v [sim CenterX] [sim CenterY]}}}
547
548 Message 37 #7fff7f {CAPITAL} \
549 {Your city has become a capital. The current population here is 50,000. Your political future looks bright.} \
550 {{view {PanView $v [sim CenterX] [sim CenterY]}}}
551
552 Message 38 #7fff7f {METROPOLIS} \
553 {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.} \
554 {{view {PanView $v [sim CenterX] [sim CenterY]}}}
555
556 Message 39 #7fff7f {MEGALOPOLIS} \
557 {Congratulation, you have reached the highest category of urban development, the megalopolis.
558
559 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.} \
560 {{view {PanView $v [sim CenterX] [sim CenterY]}}}
561
562 Message 40 #7fff7f {MEGALINIUM} \
563 {Congratulation, you have reached the end of time!
564
565 Because of the toroidal nature of the the Micropolis Space/Time Continuum, your city has wrapped back in time to 1900!} \
566 {{view {PanView $v [sim CenterX] [sim CenterY]}}}
567
568 # XXX: write more text
569 Message 41 #ff4f4f {HEAVY TRAFFIC!} \
570 {Sky Watch One
571 reporting heavy traffic!} \
572 {{view {FollowView $v helicopter}}}
573
574 # XXX: write more text
575 Message 42 #ff4f4f {FLOODING REPORTED!} \
576 {Flooding has been been reported along the water's edge!} \
577 {{view {PanView $v [sim FloodX] [sim FloodY]}}}
578
579 Message 43 #ff4f4f {NUCLEAR MELTDOWN!} \
580 {A nuclear meltdown has occured at your power plant. You are advised to avoid the area until the radioactive isotopes decay.
581
582 Many generations will confront this problem before it goes away, so don't hold your breath.} \
583 {{view {PanView $v [sim MeltX] [sim MeltY]}}}
584
585
586 Message 44 #ff4f4f {RIOTS!} \
587 {The citizens are rioting in the streets, setting cars and houses on fire, and bombing government buildings and businesses!
588
589 All media coverage is blacked out, while the fascist pigs beat the poor citizens into submission.}
590
591 Message 46 #ff4f4f {NO SOUND SERVER!} \
592 {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.}
593
594 Message 48 #7f7fff {Start a New City} \
595 {Build your very own city from the ground up, starting with this map of uninhabited land.}
596
597 Message 49 #7f7fff {Restore a Saved City} \
598 {This city was saved in the file named: %s}
599
600 Message 100 #7fff7f {YOU'RE A WINNER!} \
601 {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?} \
602 {{middle {@images/key2city.xpm}}}
603
604 Message 200 #ff4f4f {IMPEACHMENT NOTICE!} \
605 {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.
606
607 You should seriously consider taking an extended vacation -- NOW. (Or read the manual and try again.)}
608
609 Message 300 #ffd700 {About Micropolis} \
610 "Micropolis Version [sim Version] Copyright (C) 2007
611 by Electronic Arts.
612 Based on the Original Micropolis Concept and Design
613 by Will Wright.
614 TCL/Tk User Interface Designed and Created
615 by Don Hopkins, DUX Software.
616 Ported to Linux, Optimized and Adapted for OLPC
617 by Don Hopkins.
618 Licensed under the GNU General Public License,
619 version 3, with additional conditions."
620
621
622 ########################################################################
623 # Options
624 ########################################################################
625
626
627 option add *CheckButton.relief flat
628 option add *Dialog.cursor top_left_arrow
629 option add *Entry.relief sunken
630 option add *Frame.borderWidth 0
631 option add *Listbox.relief sunken
632 option add *Scrollbar.relief sunken
633 option add *RadioButton.anchor w
634 option add *RadioButton.relief flat
635
636 option add *background #b0b0b0
637 option add *foreground #000000
638 option add *activeBackground #d0d0d0
639 option add *activeForeground #000000
640 option add *disabledForeground ""
641 option add *selectBackground #d0d0d0
642 option add *selectForeground #000000
643 #option add *selector #ffff80
644 option add *selector #bf0000
645
646 option add *Scrollbar.Background #b0b0b0
647 option add *Scrollbar.Foreground #d0d0d0
648 option add *Interval.Background #b0b0b0
649 option add *Interval.Foreground #000000
650 option add *Interval.activeForeground #d0d0d0
651 option add *Interval.sliderForeground #b0b0b0
652 option add *Scale.activeForeground #d0d0d0
653 option add *Scale.sliderForeground #b0b0b0
654 option add *PieMenu.activeBackground #b0b0b0
655
656 option add Mwm*Micropolis.clientDecoration -maximize
657
658
659 ########################################################################
660 # Global Bindings
661 ########################################################################
662
663
664 bind all <Help> {HandleHelp %W %x %y %X %Y}
665 bind all <Shift-ButtonPress> {HandleHelp %W %x %y %X %Y}
666 bind all <Meta-ButtonPress> {HandleHelp %W %x %y %X %Y}
667 bind all <Shift-Meta-ButtonPress> {HandleHelp %W %x %y %X %Y}
668
669
670 ########################################################################
671 # Utilities
672 ########################################################################
673
674
675 proc echo {args} {
676 puts stdout $args
677 flush stdout
678 }
679
680
681 proc Unique {} {
682 global UniqueID
683 set id $UniqueID
684 incr UniqueID
685 return $id
686 }
687
688
689 proc tkerror {err} {
690 global errorInfo
691 puts stderr "$errorInfo"
692 }
693
694
695 proc ident {i} {
696 return "$i"
697 }
698
699 proc NoFunction {args} {}
700
701
702 proc LinkWindow {fromname to} {
703 global WindowLinks
704 set WindowLinks($fromname) $to
705 }
706
707
708 proc WindowLink {fromname} {
709 global WindowLinks
710 set to ""
711 catch {set to $WindowLinks($fromname)}
712 return $to
713 }
714
715
716 proc DeleteWindow {sym name win} {
717 set head [WindowLink $win.head]
718 LinkWindow $head.$sym {}
719 global $name
720 set wins [eval ident "\$$name"]
721 set i [lsearch $wins $win]
722 if {$i != -1} {
723 set $name [lreplace $wins $i $i]
724 }
725 destroy $win
726 }
727
728
729 proc Font {win name} {
730 global FontInfo FontCache HeadWindows
731 set scr [winfo screen $win]
732 set font ""
733 catch {
734 set font $FontCache($scr,$name)
735 }
736 if {"$font" == ""} {
737 set label ""
738 catch {
739 set label $FontCache($scr)
740 }
741 if {"$label" == ""} {
742 foreach head $HeadWindows {
743 if {"[winfo screen $head]" == "$scr"} {
744 set label $head.fontlabel
745 label $label -text "X11 Sucks" -font fixed
746 set FontCache($scr) $label
747 }
748 }
749 }
750
751 set fonts [keylget FontInfo $name]
752 foreach font $fonts {
753 #echo "Configuring font $font on $label"
754 if {[catch "$label config -font \"$font\""] == 0} {
755 #echo "yow!"
756 break
757 } else {
758 #echo "oops!"
759 set font ""
760 }
761 }
762 if {"$font" == ""} {
763 #set font 8x16
764 # OLCP default font
765 set font 6x13
766 }
767 set FontCache($scr,$name) $font
768 }
769 return $font
770 }
771
772
773 proc Color {win color mono} {
774 if {[winfo screendepth $win] == 1} {
775 return $mono
776 } else {
777 return $color
778 }
779 }
780
781
782 ########################################################################
783 # Window Definition Functions
784 ########################################################################
785
786
787 proc MakeWindow.head {{display ":0"}} {
788 global ResourceDir
789 source $ResourceDir/whead.tcl
790 return $win
791 }
792
793
794 proc MakeWindow.editor {head {display ":0"}} {
795 global ResourceDir
796 source $ResourceDir/weditor.tcl
797 return $win
798 }
799
800
801 proc MakeWindow.map {head {display ":0"}} {
802 global ResourceDir
803 source $ResourceDir/wmap.tcl
804 return $win
805 }
806
807
808 proc MakeWindow.graph {head {display ":0"}} {
809 global ResourceDir
810 source $ResourceDir/wgraph.tcl
811 return $win
812 }
813
814
815 proc MakeWindow.budget {head {display ":0"}} {
816 global ResourceDir
817 source $ResourceDir/wbudget.tcl
818 return $win
819 }
820
821
822 proc MakeWindow.evaluation {head {display ":0"}} {
823 global ResourceDir
824 source $ResourceDir/weval.tcl
825 return $win
826 }
827
828
829 proc MakeWindow.splash {head {display ":0"}} {
830 global ResourceDir
831 source $ResourceDir/wsplash.tcl
832 return $win
833 }
834
835
836 proc MakeWindow.scenario {head {display ":0"}} {
837 global ResourceDir
838 source $ResourceDir/wscen.tcl
839 return $win
840 }
841
842
843 proc MakeWindow.file {head {display ":0"}} {
844 global ResourceDir
845 source $ResourceDir/wfile.tcl
846 return $win
847 }
848
849
850 proc MakeWindow.ask {head {display ":0"}} {
851 global ResourceDir
852 source $ResourceDir/wask.tcl
853 return $win
854 }
855
856
857 proc MakeWindow.player {head {display ":0"}} {
858 global ResourceDir
859 source $ResourceDir/wplayer.tcl
860 return $win
861 }
862
863
864 proc MakeWindow.notice {head {display ":0"}} {
865 global ResourceDir
866 source $ResourceDir/wnotice.tcl
867 return $win
868 }
869
870 proc MakeWindow.help {head {display ":0"}} {
871 global ResourceDir
872 source $ResourceDir/whelp.tcl
873 return $win
874 }
875
876 proc MakeWindow.frob {head {display ":0"}} {
877 global ResourceDir
878 source $ResourceDir/wfrob.tcl
879 return $win
880 }
881
882
883 ########################################################################
884 # Sound Support
885 ########################################################################
886
887
888 proc UIInitializeSound {} {
889 }
890
891
892 proc UIShutDownSound {} {
893 }
894
895
896 proc UIDoSoundOn {win cmd} {
897 global Sound SoundServers
898 if {$Sound} {
899 set win [WindowLink [winfo toplevel $win].head]
900 if {[lsearch $SoundServers $win] != -1} {
901 set cmd "send -quick -server $win Sound sound $cmd"
902 if {[catch $cmd]} {
903 # XXX: Lost a sound server...
904 LostSoundServer $win
905 }
906 }
907 }
908 }
909
910
911 proc UIDoSound {cmd} {
912 global Sound SoundServers
913 if {$Sound} {
914 foreach win $SoundServers {
915 set foo "send -quick -server $win Sound $cmd"
916 if {[catch $foo]} {
917 # XXX: Lost a sound server...
918 LostSoundServer $win
919 }
920 }
921 }
922 }
923
924
925 proc KillSoundServers {} {
926 global SoundServers
927 foreach win $SoundServers {
928 set foo "send -quick -server $win Sound KillSoundServer"
929 catch $foo
930 }
931 set SoundServers {}
932 }
933
934
935 proc UISetChannelVolume {win chan vol} {
936 UIDoSoundOn $win "channel $chan -volume $vol"
937 }
938
939
940 proc EchoPlaySound {soundspec} {
941 }
942
943
944 proc UIMakeSoundOn {win chan sound {opts ""}} {
945 playsound $chan $sound $opts
946 }
947
948
949 proc UIStartSoundOn {win chan sound {opts ""}} {
950 # Send message to Python to play sound.
951 EchoPlaySound $sound
952
953 #UIDoSoundOn $win "play $sound -replay -channel $chan -repeat 100 $opts"
954 }
955
956
957 proc UIMakeSound {chan sound {opts ""}} {
958 playsound $chan $sound $opts
959 }
960
961
962 proc UIStartSound {chan sound {opts ""}} {
963 # Send message to Python to play sound.
964 EchoPlaySound $sound
965
966 #UIDoSound "sound play $sound -channel $chan -repeat 100 $opts"
967 }
968
969
970 proc SetupSoundServer {win} {
971 AddSoundServer $win
972 }
973
974
975 proc AddSoundServer {win} {
976 global SoundServers
977 set i [lsearch $SoundServers $win]
978 if {$i < 0} {
979 set SoundServers [linsert $SoundServers 0 $win]
980 }
981 }
982
983
984 proc LostSoundServer {win} {
985 DeleteSoundServer $win
986 # UIShowPictureOn [WindowLink $win.head] 46 [winfo screen $win]
987 }
988
989
990 proc DeleteSoundServer {win} {
991 global SoundServers
992 set i [lsearch $SoundServers $win]
993 if {$i >= 0} {
994 set SoundServers [lreplace $SoundServers $i $i]
995 }
996 }
997
998
999 proc UISoundOff {} {
1000 }
1001
1002
1003 proc MonsterSpeed {} {
1004 return [expr "[sim Rand 40] + 70"]
1005 }
1006
1007
1008 proc ExplosionPitch {} {
1009 return [expr "[sim Rand 20] + 90"]
1010 }
1011
1012
1013 proc HonkPitch {} {
1014 return [expr "[sim Rand 20] + 90"]
1015 }
1016
1017
1018 ########################################################################
1019 # Global Window Handlers
1020
1021
1022 proc WithdrawAll {} {
1023 WithdrawHeads
1024 WithdrawEditors
1025 WithdrawMaps
1026 WithdrawGraphs
1027 WithdrawBudgets
1028 WithdrawEvaluations
1029 WithdrawSplashes
1030 WithdrawScenarios
1031 WithdrawFiles
1032 WithdrawAsks
1033 WithdrawPlayers
1034 WithdrawNotices
1035 WithdrawHelps
1036 WithdrawFrobs
1037 }
1038
1039
1040 proc ShowInitial {} {
1041 ShowHeads
1042 ShowEditors
1043 ShowMaps
1044 EnableMaps
1045 }
1046
1047
1048 ########################################################################
1049 # Head Window Handlers
1050
1051
1052 proc PrepHead {head} {
1053 global State
1054 InitHeadMenus $head
1055 case $State {
1056 uninitialized {
1057 }
1058 splash {
1059 WithdrawHeadOf $head
1060 ShowSplashOf $head
1061 }
1062 scenario {
1063 after 1000 "WithdrawSplashOf $head"
1064 WithdrawHeadOf $head
1065 ShowScenarioOf $head
1066 sim UpdateMaps
1067 }
1068 play {
1069 WithdrawSplashOf $head
1070 WithdrawScenarioOf $head
1071 ShowHeadOf $head
1072 ShowEditorOf $head
1073 ShowMapOf $head
1074 EnableMaps
1075 ReShowPictureOn $head
1076 InitHead $head
1077 InitHeadMenus $head
1078 }
1079 }
1080 }
1081
1082
1083 proc ShowHeadOf {head} {
1084 wm deiconify $head
1085 }
1086
1087
1088 proc WithdrawHeadOf {head} {
1089 wm withdraw $head
1090 }
1091
1092
1093 proc ShowHeads {} {
1094 global HeadWindows
1095 foreach win $HeadWindows {
1096 ShowHeadOf $win
1097 }
1098 }
1099
1100
1101 proc WithdrawHeads {} {
1102 global HeadWindows
1103 foreach win $HeadWindows {
1104 wm withdraw $win
1105 }
1106 }
1107
1108
1109 proc DeleteHeadWindow {head} {
1110 UIQuit $head
1111 }
1112
1113
1114 proc InitHeads {} {
1115 global HeadWindows
1116 foreach win $HeadWindows {
1117 InitHead $win
1118 }
1119 }
1120
1121
1122 proc InitHead {win} {
1123 set w [WindowLink $win.text]
1124 $w configure -state normal
1125 $w delete 0.0 end
1126 $w insert end "\n"
1127 $w configure -state disabled
1128
1129 if {[sim MultiPlayerMode]} {
1130 set w [WindowLink $win.entry]
1131 $w delete 0 end
1132 global ${w}.value
1133 set ${w}.value ""
1134 }
1135
1136 sim UpdateHeads
1137 UIUpdateRunning
1138 }
1139
1140
1141 proc InitAllHeadMenus {} {
1142 global HeadWindows
1143
1144 foreach win $HeadWindows {
1145 InitHeadMenus $win
1146 }
1147 }
1148
1149
1150 proc InitHeadMenus {win} {
1151 global State
1152 set m0 [WindowLink $win.m0]
1153 set m1 [WindowLink $win.m1]
1154 set m2 [WindowLink $win.m2]
1155 set m3 [WindowLink $win.m3]
1156 set m4 [WindowLink $win.m4]
1157 set b0 [WindowLink $win.b0]
1158 set b1 [WindowLink $win.b1]
1159 set b2 [WindowLink $win.b2]
1160 set b3 [WindowLink $win.b3]
1161 set b4 [WindowLink $win.b4]
1162 case $State {
1163 uninitialized {
1164 }
1165 splash {
1166 }
1167 scenario {
1168 $m0 unpost
1169 $m1 unpost
1170 $m2 unpost
1171 $m3 unpost
1172 $m4 unpost
1173 $m0 disable 1
1174 $m0 disable 2
1175 # When in multi player mode there is an extra menu
1176 # item to add another player, before the quit item,
1177 # so compensate for it here.
1178 if {[sim MultiPlayerMode]} {
1179 $m0 disable 4
1180 } else {
1181 $m0 disable 3
1182 }
1183 $b0 config -state normal
1184 $b2 config -state disabled
1185 $b4 config -state disabled
1186 }
1187 play {
1188 $m0 enable 1
1189 $m0 enable 2
1190 # When in multi player mode there is an extra menu
1191 # item to add another player, before the quit item,
1192 # so compensate for it here.
1193 if {[sim MultiPlayerMode]} {
1194 $m0 enable 4
1195 } else {
1196 $m0 enable 3
1197 }
1198 $b0 config -state normal
1199 $b2 config -state normal
1200 $b4 config -state normal
1201 }
1202 }
1203 }
1204
1205
1206 proc UIDisaster {win cmd action} {
1207 AskQuestion [Color $win #ff0000 #ffffff] "Cause a Disaster" \
1208 "Oh no! Do you really want to $action" \
1209 "{No way!} Disaster.No {WithdrawAsks}" \
1210 "" \
1211 "{I guess so.} Disaster.Yes {WithdrawAsks ; $cmd}"
1212 }
1213
1214
1215 proc CrushHead {head} {
1216 global SubWindows VoteNames
1217
1218 foreach foo $VoteNames {
1219 global VotesFor$foo
1220 set votes [eval ident \$VotesFor$foo]
1221 set i [lsearch $votes $head]
1222 if {$i != -1} {
1223 set VotesFor$foo [lreplace $votes $i $i]
1224 }
1225 }
1226
1227 foreach foo $SubWindows {
1228 set sym [lindex $foo 0]
1229 set name [lindex $foo 1]
1230 global $name
1231 set wins [eval ident "\$$name"]
1232 foreach win $wins {
1233 if {[WindowLink $win.head] == $head} {
1234 DeleteWindow $sym $name $win
1235 }
1236 }
1237 }
1238 }
1239
1240
1241 proc ChatDown {win} {
1242 tk_butDown $win
1243 }
1244
1245
1246 proc ChatUp {win} {
1247 tk_butUp $win
1248
1249 global Chatting
1250
1251 if {$Chatting} {
1252 CloseChat
1253 } else {
1254 OpenChat
1255 }
1256 }
1257
1258
1259 proc OpenChat {} {
1260 global Chatting
1261 global ChatServer
1262 global ChatSocket
1263 global ChatConnection
1264
1265 DoSendMessage "Opening Connection to Chat Server $ChatServer socket $ChatSocket ..." status
1266
1267 set ChatConnection {}
1268 catch {
1269 set ChatConnection [connect $ChatServer $ChatSocket]
1270 }
1271
1272 if {$ChatConnection == {}} then {
1273 DoSendMessage "Sorry, I could not open a connection to chat server $ChatServer socket $ChatSocket." status
1274 set Chatting 0
1275 } else {
1276 filehandler $ChatConnection r "ReceiveChat"
1277 set Chatting 1
1278 }
1279
1280 global NickName
1281 global UserName
1282 global HostName
1283 global ServerName
1284 global RealName
1285 global ChannelName
1286 catch {
1287 puts $ChatConnection "USER $UserName $HostName $ServerName $RealName\r\n" nonewline
1288 puts $ChatConnection "NICK $NickName\r\n" nonewline
1289 puts $ChatConnection "JOIN $ChannelName\r\n" nonewline
1290 flush $ChatConnection
1291 }
1292 }
1293
1294
1295 proc ReceiveChat {mode f} {
1296 # DoSendMessage "ReceiveChat: MODE $mode F $f"
1297 set msg ""
1298 gets $f msg
1299
1300 if {[string first {:} $msg]} {
1301 set msg ": $msg"
1302 }
1303
1304 set from [lindex $msg 0]
1305 set cmd [string tolower [lindex $msg 1]]
1306
1307 set handled 0
1308
1309 if {($cmd == "privmsg") ||
1310 ($cmd == "notice")} then {
1311 set handled 1
1312 set chan [lindex $msg 2]
1313 set i [expr "[string length $from] + 1 + [string length $cmd] + 1 + [string length $chan] + 2"]
1314 set j [expr "[string length $msg] - 2"]
1315 set line [string range $msg $i $j]
1316 set chan [string range $chan 1 [string length $chan]]
1317 set from [string range $from 1 [expr "[string length $from] - 1"]]
1318 set from [split $from {!}]
1319 set from [lindex $from 0]
1320 DoSendMessage "$from> $line"
1321 }
1322
1323 if {$handled == 0} {
1324 set msg [string range $msg \
1325 [expr "[string length $from] + 1"] \
1326 [expr "[string length $msg] - 2"]]
1327 DoSendMessage $msg
1328 }
1329 }
1330
1331
1332 proc SendChatMessage {msg win} {
1333 global ChatConnection ChannelName NickName
1334
1335 if {"$msg" == ""} {
1336 return
1337 }
1338
1339 if {[string range $msg 0 0] == "/"} {
1340 set cmd [string range $msg 1 [string length $msg]]
1341 DoSendMessage "$NickName> \[$cmd\]"
1342 set cmd "$cmd\r\n"
1343 } else {
1344 set cmd "PRIVMSG $ChannelName :$msg\r\n"
1345 DoSendMessage "$NickName> $msg"
1346 }
1347
1348
1349 set result 1
1350
1351 catch {
1352 puts $ChatConnection $cmd nonewline
1353 flush $ChatConnection
1354 set result 0
1355 }
1356
1357 if {$result} {
1358 DoSendMessage "IRC Broke the connection"
1359 CloseChat
1360 }
1361 }
1362
1363
1364 proc CloseChat {} {
1365 global Chatting
1366 global ChatServer
1367 global ChatSocket
1368 global ChatConnection
1369
1370 DoSendMessage "Closing Connection to Chat Server." status
1371
1372 catch {
1373 puts $ChatConnection "QUIT\r\n" nonewline
1374 flush $ChatConnection
1375 $ChatConnection close
1376 }
1377
1378 set ChatConnection {}
1379 set Chatting 0
1380 }
1381
1382
1383 proc DoEnterMessage {win var} {
1384 global Chatting
1385 global $var
1386 set msg [eval ident "\$\{$var\}"]
1387
1388 if {$Chatting} then {
1389 SendChatMessage $msg $win
1390 } else {
1391 DoSendMessage $msg
1392 }
1393 $win delete 0 end
1394 }
1395
1396
1397 proc DoEvalMessage {win var} {
1398 global $var
1399 set command [eval ident "\$\{$var\}"]
1400 $win delete 0 end
1401 DoSendMessage "Evaluating TCL: $command"
1402 catch {uplevel #0 $command} result
1403 DoSendMessage "Result: $result"
1404 }
1405
1406
1407 proc DoSendMessage {msg {tag message}} {
1408 global HeadWindows
1409 foreach win $HeadWindows {
1410 appendWithTag [WindowLink $win.text] $tag "$msg"
1411 }
1412 }
1413
1414
1415 proc UISetMessage {msg {tag status}} {
1416 global DoMessages EditorWindows HeadWindows
1417
1418 if {$DoMessages == 0} {
1419 return
1420 }
1421
1422 foreach win $EditorWindows {
1423 [WindowLink $win.message] configure -text "$msg"
1424 }
1425
1426 foreach win $HeadWindows {
1427 appendWithTag [WindowLink $win.text] $tag "$msg"
1428 }
1429 }
1430
1431
1432
1433
1434 proc appendWithTag {w tag text} {
1435 global MaxLines
1436 global ShrinkLines
1437
1438 set start [$w index end]
1439 $w configure -state normal
1440 if {$start > $MaxLines} then {
1441 $w delete 0.0 $ShrinkLines.0
1442 set start [$w index end]
1443 }
1444 $w insert end "${text}\n"
1445 $w tag add $tag $start {end - 1 char}
1446 $w configure -state disabled
1447 $w yview -pickplace {end - 1 char}
1448 }
1449
1450
1451 ########################################################################
1452 # Budget Window Handlers
1453
1454
1455 proc ShowBudgetOf {head} {
1456 set win [WindowLink $head.budget]
1457 if {$win == {}} {
1458 set win [MakeWindow.budget $head [winfo screen $head]]
1459 }
1460 wm deiconify $win
1461 wm raise $win
1462 update idletasks
1463 sim UpdateBudget
1464 }
1465
1466
1467 proc ShowBudgets {} {
1468 global HeadWindows BudgetsVisible
1469 set BudgetsVisible 1
1470 foreach win $HeadWindows {
1471 ShowBudgetOf $win
1472 }
1473 }
1474
1475
1476 proc WithdrawBudgets {} {
1477 global BudgetWindows BudgetsVisible
1478 foreach win $BudgetWindows {
1479 wm withdraw $win
1480 }
1481 StopBudgetTimer
1482 set BudgetsVisible 0
1483 }
1484
1485
1486 proc BudgetContinue {{win ""}} {
1487 global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1488 set OldBudget 0
1489 if {([sim RoadFund] != $BudgetRoadFund) ||
1490 ([sim FireFund] != $BudgetFireFund) ||
1491 ([sim PoliceFund] != $BudgetPoliceFund) ||
1492 ([sim TaxRate] != $BudgetTaxRate)} {
1493 UISetMessage "The budget was changed."
1494 } else {
1495 UISetMessage "The budget wasn't changed."
1496 }
1497 WithdrawBudgets
1498 sim Resume
1499 MakeRunningSound
1500 }
1501
1502
1503 proc BudgetReset {{win ""}} {
1504 global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1505 if {([sim RoadFund] != $BudgetRoadFund) ||
1506 ([sim FireFund] != $BudgetFireFund) ||
1507 ([sim PoliceFund] != $BudgetPoliceFund) ||
1508 ([sim TaxRate] != $BudgetTaxRate)} {
1509 UISetMessage "The budget was reset."
1510 if {[sim Players] > 1} {
1511 UIMakeSound edit Sorry
1512 }
1513 } else {
1514 UISetMessage "The budget was reset."
1515 }
1516 sim RoadFund $BudgetRoadFund
1517 sim FireFund $BudgetFireFund
1518 sim PoliceFund $BudgetPoliceFund
1519 sim TaxRate $BudgetTaxRate
1520 set OldBudget 0
1521 ChangeBudget
1522 }
1523
1524
1525 proc BudgetCancel {{win ""}} {
1526 BudgetReset
1527 WithdrawBudgets
1528 sim Resume
1529 MakeRunningSound
1530 }
1531
1532
1533 proc SetTaxRate {rate} {
1534 sim TaxRate $rate
1535 }
1536
1537
1538 proc BudgetSetTaxRate {rate} {
1539 SetTaxRate $rate
1540 ChangeBudget
1541 }
1542
1543
1544 proc BudgetSetRoadFund {percent} {
1545 sim RoadFund $percent
1546 ChangeBudget
1547 }
1548
1549
1550 proc BudgetSetFireFund {percent} {
1551 sim FireFund $percent
1552 ChangeBudget
1553 }
1554
1555
1556 proc BudgetSetPoliceFund {percent} {
1557 sim PoliceFund $percent
1558 ChangeBudget
1559 }
1560
1561
1562 proc UIShowBudgetAndWait {} {
1563 global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1564 if {$OldBudget == 0} {
1565 set BudgetRoadFund [sim RoadFund]
1566 set BudgetFireFund [sim FireFund]
1567 set BudgetPoliceFund [sim PoliceFund]
1568 set BudgetTaxRate [sim TaxRate]
1569 set OldBudget 1
1570 }
1571 ShowBudgets
1572 UISetMessage "Pausing to set the budget ..."
1573 sim Pause
1574 MakeRunningSound
1575 StartBudgetTimer
1576 InitVotesForBudget
1577 sim UpdateBudget
1578 sim UpdateBudgetWindow
1579 }
1580
1581
1582 proc ToggleBudgetTimer {} {
1583 global BudgetTimerActive
1584 if {$BudgetTimerActive} {
1585 StopBudgetTimer
1586 } else {
1587 StartBudgetTimer
1588 }
1589 }
1590
1591
1592 proc StopBudgetTimer {} {
1593 global BudgetTimerActive
1594 set BudgetTimerActive 0
1595 UpdateBudgetTimer
1596 }
1597
1598
1599 proc StartBudgetTimer {} {
1600 global BudgetTimerActive BudgetTimer BudgetTimeout
1601 set me [Unique]
1602 set BudgetTimerActive $me
1603 set BudgetTimer $BudgetTimeout
1604 UpdateBudgetTimer
1605 after 1000 TickBudgetTimer $me
1606 }
1607
1608
1609 proc RestartBudgetTimer {} {
1610 global BudgetTimerActive
1611 if {$BudgetTimerActive} {
1612 StopBudgetTimer
1613 StartBudgetTimer
1614 }
1615 }
1616
1617
1618 proc UpdateBudgetTimer {} {
1619 global BudgetWindows BudgetTimerActive BudgetTimer
1620 if {$BudgetTimerActive} {
1621 set text [format "Auto Cancel In %d Seconds (click to disable)" $BudgetTimer]
1622 } else {
1623 set text [format "Enable Auto Cancel (currently disabled)"]
1624 }
1625 foreach win $BudgetWindows {
1626 set t [WindowLink $win.timer]
1627 $t config -text "$text"
1628 }
1629 }
1630
1631
1632 proc TickBudgetTimer {me} {
1633 global BudgetTimerActive BudgetTimer BudgetTimeout
1634 if {$BudgetTimerActive == $me} {
1635 incr BudgetTimer -1
1636 if {$BudgetTimer < 0} {
1637 StopBudgetTimer
1638 UpdateBudgetTimer
1639 FireBudgetTimer
1640 } else {
1641 UpdateBudgetTimer
1642 after 1000 TickBudgetTimer $me
1643 }
1644 }
1645 }
1646
1647
1648 proc FireBudgetTimer {} {
1649 BudgetCancel
1650 }
1651
1652
1653 proc funds {n} {
1654 sim Funds $n
1655 }
1656
1657
1658 proc ToggleAutoBudget {} {
1659 global AutoBudget
1660 if {$AutoBudget} {
1661 #echo "ToggleAutoBudget found on, clearing"
1662 sim AutoBudget 0
1663 } else {
1664 #echo "ToggleAutoBudget found off, setting"
1665 sim AutoBudget 1
1666 }
1667 }
1668
1669
1670 proc UIUpdateBudget {} {
1671 UpdateAutoBudget
1672 }
1673
1674
1675 proc UpdateAutoBudget {} {
1676 global BudgetWindows AutoBudget
1677 if {[sim AutoBudget]} {
1678 set text "Disable Auto Budget (currently enabled)"
1679 } else {
1680 set text "Enable Auto Budget (currently disabled)"
1681 }
1682 #echo "UpdateAutoBudget $AutoBudget $text"
1683 foreach win $BudgetWindows {
1684 set t [WindowLink $win.autobudget]
1685 $t config -text "$text"
1686 }
1687 }
1688
1689
1690 proc UISetBudget {cashflow previous current collected taxrate} {
1691 global BudgetWindows BudgetsVisible
1692
1693 #echo "UISetBudgetValues $taxrate $BudgetsVisible"
1694
1695 if {$BudgetsVisible} {
1696
1697 foreach win $BudgetWindows {
1698 set w [WindowLink $win.cashflow]
1699 set old [lindex [$w configure -text] 4]
1700 if {$old != $cashflow} {
1701 $w configure -text $cashflow
1702 }
1703 set w [WindowLink $win.previous]
1704 set old [lindex [$w configure -text] 4]
1705 if {$old != $previous} {
1706 $w configure -text $previous
1707 }
1708 set w [WindowLink $win.current]
1709 set old [lindex [$w configure -text] 4]
1710 if {$old != $current} {
1711 $w configure -text $current
1712 }
1713 set w [WindowLink $win.collected]
1714 set old [lindex [$w configure -text] 4]
1715 if {$old != $collected} {
1716 $w configure -text $collected
1717 }
1718
1719 set w [WindowLink $win.taxrate]
1720 set old [$w get]
1721 if {$old != $taxrate} {
1722 $w set $taxrate
1723 }
1724
1725 set w [WindowLink $win.taxlabel]
1726 set old [lindex [$w configure -text] 4]
1727 set new "$taxrate%"
1728 if {$old != $new} {
1729 $w configure -text $new
1730 }
1731 }
1732 }
1733
1734 global HeadWindows
1735 foreach win $HeadWindows {
1736
1737 set w [WindowLink $win.taxrate]
1738 set old [$w get]
1739 if {$old != $taxrate} {
1740 # FIXME: this might not work if the slider is disabled in multi player mode.
1741 $w set $taxrate
1742 }
1743
1744 set w [WindowLink $win.taxlabel]
1745 set old [lindex [$w configure -text] 4]
1746 set new "Tax Rate: $taxrate%"
1747 if {$old != $new} {
1748 $w configure -text $new
1749 }
1750 }
1751 }
1752
1753
1754 proc UISetBudgetValues {roadgot roadwant roadpercent policegot policewant policepercent firegot firewant firepercent} {
1755 global BudgetWindows BudgetsVisible
1756
1757 if {$BudgetsVisible == 0} {
1758 return;
1759 }
1760
1761 foreach win $BudgetWindows {
1762 set w [WindowLink $win.fire].request
1763 set old [lindex [$w configure -text] 4]
1764 set new "$firepercent% of $firewant = $firegot"
1765 if {$old != $new} {
1766 $w configure -text $new
1767 }
1768 set w [WindowLink $win.fire].fund
1769 set old [$w get]
1770 if {$old != $firepercent} {
1771 $w set $firepercent
1772 }
1773
1774 set w [WindowLink $win.police].request
1775 set old [lindex [$w configure -text] 4]
1776 set new "$policepercent% of $policewant = $policegot"
1777 if {$old != $new} {
1778 $w configure -text $new
1779 }
1780 set w [WindowLink $win.police].fund
1781 set old [$w get]
1782 if {$old != $policepercent} {
1783 $w set $policepercent
1784 }
1785
1786 set w [WindowLink $win.road].request
1787 set old [lindex [$w configure -text] 4]
1788 set new "$roadpercent% of $roadwant = $roadgot"
1789 if {$old != $new} {
1790 $w configure -text $new
1791 }
1792 set w [WindowLink $win.road].fund
1793 set old [$w get]
1794 if {$old != $roadpercent} {
1795 $w set $roadpercent
1796 }
1797 }
1798 }
1799
1800
1801 proc ChangeBudget {} {
1802 global VotesForBudget
1803 if {"$VotesForBudget" != ""} {
1804 InitVotesForBudget
1805 }
1806 RestartBudgetTimer
1807 }
1808
1809
1810 proc InitVotesForBudget {} {
1811 global VotesForBudget BudgetWindows
1812 set VotesForBudget {}
1813 foreach win $BudgetWindows {
1814 [WindowLink $win.vote] config -relief raised
1815 }
1816 UpdateVotesForBudget
1817 }
1818
1819
1820 proc UpdateVotesForBudget {} {
1821 global BudgetWindows
1822 UpdateVotesFor Budget $BudgetWindows
1823 }
1824
1825
1826 proc UpdateTaxRateSliders {} {
1827 global HeadWindows
1828 set players [sim Players]
1829 foreach win $HeadWindows {
1830 set slider [WindowLink $win.taxrate]
1831 #echo "UpdateTaxRateSliders players $players win $win slider $slider"
1832 if {$players == 1} {
1833 $slider configure -state normal
1834 } else {
1835 $slider configure -state disabled
1836 }
1837 }
1838 }
1839
1840
1841 ########################################################################
1842 # Evaluation Window Handlers
1843
1844
1845 proc ToggleEvaluationOf {head} {
1846 global State
1847 if {"$State" != "play"} {
1848 return
1849 }
1850
1851 set mapped 0
1852 set win [WindowLink $head.evaluation]
1853 if {$win != ""} {
1854 set mapped [winfo ismapped $win]
1855 }
1856
1857 if {$mapped} {
1858 WithdrawEvaluationOf $head
1859 } else {
1860 ShowEvaluationOf $head
1861 }
1862
1863 }
1864
1865
1866 proc WithdrawEvaluationOf {head} {
1867 set win [WindowLink $head.evaluation]
1868 if {"$win" != ""} {
1869 pack unpack $win
1870 }
1871 }
1872
1873
1874 proc ShowEvaluationOf {head} {
1875 set win [WindowLink $head.evaluation]
1876 if {$win == {}} {
1877 set win [MakeWindow.evaluation $head [winfo screen $head]]
1878 }
1879 #wm raise $win
1880 #wm deiconify $win
1881 set parent [WindowLink $win.parent]
1882 #pack append [WindowLink $head.col2]\
1883 # $parent {top frame nw fill}
1884 pack append $parent\
1885 $win {top frame nw fillx}
1886 update idletasks
1887 sim UpdateEvaluation
1888 }
1889
1890
1891 proc WithdrawEvaluations {} {
1892 global EvaluationWindows EvaluationsVisible
1893 foreach win $EvaluationWindows {
1894 #wm withdraw $win
1895 #set parent [WindowLink $win.parent]
1896 #pack unpack $parent
1897 pack unpack $win
1898 }
1899 set EvaluationsVisible 0
1900 }
1901
1902
1903 proc EvaluationVisible {w v} {
1904 global EvaluationsVisible
1905 global [set var $w.visible]
1906
1907 set $var $v
1908
1909 if ($v) {
1910 set EvaluationsVisible [expr "$EvaluationsVisible + 1"]
1911 } else {
1912 set EvaluationsVisible [expr "$EvaluationsVisible - 1"]
1913 }
1914 }
1915
1916
1917 proc UISetEvaluation {changed score ps0 ps1 ps2 ps3 pv0 pv1 pv2 pv3 pop delta assessed cityclass citylevel goodyes goodno title} {
1918 global EvaluationWindows EvaluationsVisible CurrentDate
1919
1920 set class [string tolower $cityclass]
1921 UISetMessage "$CurrentDate: Score $score, $class population $pop."
1922
1923 if {$EvaluationsVisible} {
1924
1925 foreach win $EvaluationWindows {
1926
1927 global [set var $win.visible]
1928 set visible [eval ident "\$\{$var\}"]
1929
1930 if {$visible} {
1931
1932 # TODO: set evaluation window and icon title
1933 #wm title $win "$title"
1934 #wm iconname $win "$title"
1935
1936 set w [WindowLink $win.goodjob]
1937 set old [lindex [$w configure -text] 4]
1938 set new "$goodyes\n$goodno"
1939 if {$old != $new} {
1940 $w configure -text $new
1941 }
1942
1943 set w [WindowLink $win.problemnames]
1944 set old [lindex [$w configure -text] 4]
1945 set new "$ps0\n$ps1\n$ps2\n$ps3"
1946 if {$old != $new} {
1947 $w configure -text $new
1948 }
1949
1950 set w [WindowLink $win.problempercents]
1951 set old [lindex [$w configure -text] 4]
1952 set new "$pv0\n$pv1\n$pv2\n$pv3"
1953 if {$old != $new} {
1954 $w configure -text $new
1955 }
1956
1957 set w [WindowLink $win.stats]
1958 set old [lindex [$w configure -text] 4]
1959 set new "$pop\n$delta\n\n$assessed\n$cityclass\n$citylevel"
1960 if {$old != $new} {
1961 $w configure -text $new
1962 }
1963
1964 set w [WindowLink $win.score]
1965 set old [lindex [$w configure -text] 4]
1966 set new "$score\n$changed"
1967 if {$old != $new} {
1968 $w configure -text $new
1969 }
1970 }
1971 }
1972 }
1973 }
1974
1975
1976 ########################################################################
1977 # File Window Handlers
1978
1979
1980 proc ShowFileOf {head} {
1981 set win [WindowLink $head.file]
1982 if {$win == {}} {
1983 set win [MakeWindow.file $head [winfo screen $head]]
1984 }
1985 wm deiconify $win
1986 wm raise $win
1987 return $win
1988 }
1989
1990
1991 proc ShowFiles {} {
1992 global HeadWindows
1993 foreach win $HeadWindows {
1994 ShowFileOf $win
1995 }
1996 }
1997
1998
1999 proc WithdrawFiles {} {
2000 global FileWindows
2001 foreach win $FileWindows {
2002 wm withdraw $win
2003 }
2004 }
2005
2006
2007 proc DoFileDialog {win Message Path Pattern FileName ActionOk ActionCancel} {
2008 ShowFileDialog $win "$Path" "$Pattern"
2009 $win.message1 configure -text "$Message"
2010 $win.path.path delete 0 end
2011 $win.path.path insert 0 $Path
2012 $win.file.file delete 0 end
2013 $win.file.file insert 0 "$FileName"
2014 $win.frame1.ok config -command "
2015 $ActionOk \[$win.file.file get\] \[$win.path.path get\]
2016 wm withdraw $win"
2017 $win.frame1.rescan config -command "
2018 ShowFileDialog $win \[$win.path.path get\] $Pattern"
2019 $win.frame1.cancel config -command "
2020 $ActionCancel
2021 wm withdraw $win"
2022 bind $win.files.files "<Double-Button-1>" "\
2023 FileSelectDouble $win %W %y $Pattern \"
2024 $ActionOk {\[$win.file.file get\]} {\[$win.path.path get\]}\""
2025 bind $win.path.path <Return> "
2026 ShowFileDialog $win \[$win.path.path get\] $Pattern
2027 $win.file.file cursor 0
2028 focus $win.file.file"
2029 bind $win.file.file <Return> "\
2030 $ActionOk \[$win.file.file get\] \[$win.path.path get\]
2031 wm withdraw $win"
2032 }
2033
2034
2035 proc BindSelectOne {win Y} {
2036 set Nearest [$win nearest $Y]
2037 if {$Nearest >= 0} {
2038 $win select from $Nearest
2039 $win select to $Nearest
2040 }
2041 }
2042
2043
2044 proc FileSelect {win widget Y} {
2045 BindSelectOne $widget $Y
2046 set Nearest [$widget nearest $Y]
2047 if {$Nearest >= 0} {
2048 set Path [$win.path.path get]
2049 set TmpEntry [$widget get $Nearest]
2050 if {[string compare "/" [string index $TmpEntry \
2051 [expr [string length $TmpEntry]-1]]] == 0 || \
2052 [string compare "@" [string index $TmpEntry \
2053 [expr [string length $TmpEntry]-1]]] == 0} {
2054 # handle directories, and symbolic links to directories
2055 set FileName [string range $TmpEntry 0 \
2056 [expr [string length $TmpEntry]-2]]
2057 # whoops / or @ is part of the name
2058 if {[MiscIsDir $Path/$FileName] != 1} {
2059 set FileName $TmpEntry
2060 }
2061 } {
2062 if {[string compare "*" [string index $TmpEntry \
2063 [expr [string length $TmpEntry]-1]]] == 0} {
2064 # handle executable filenames
2065 set FileName [string range $TmpEntry 0 \
2066 [expr [string length $TmpEntry]-2]]
2067 # whoops * is part of the name
2068 if {[file executable $Path/$FileName] != 1} {
2069 set FileName $TmpEntry
2070 }
2071 } {
2072 # a ordinary filename
2073 set FileName $TmpEntry
2074 }
2075 }
2076 # enter the selected filename into the filename field
2077 if {[MiscIsDir $Path/$FileName] != 1} {
2078 $win.file.file delete 0 end
2079 $win.file.file insert 0 $FileName
2080 }
2081 }
2082 }
2083
2084
2085 proc FileSelectDouble {win widget Y Pattern Action} {
2086 BindSelectOne $widget $Y
2087 set Nearest [$widget nearest $Y]
2088 if {$Nearest >= 0} {
2089 set Path [$win.path.path get]
2090 set TmpEntry [$widget get $Nearest]
2091 if {[string compare $TmpEntry "../"] == 0} {
2092 # go up one directory
2093 set TmpEntry \
2094 [string trimright [string trimright [string trim $Path] /] @]
2095 if {[string length $TmpEntry] <= 0} {
2096 return
2097 }
2098 set Path [file dirname $TmpEntry]
2099 $win.path.path delete 0 end
2100 $win.path.path insert 0 $Path
2101 ShowFileDialog $win $Path $Pattern
2102 } {
2103 if {[string compare "/" [string index $TmpEntry \
2104 [expr [string length $TmpEntry]-1]]] == 0 || \
2105 [string compare "@" [string index $TmpEntry \
2106 [expr [string length $TmpEntry]-1]]] == 0} {
2107 # handle directorys, and symbolic links to directorys
2108 set FileName [string range $TmpEntry 0 \
2109 [expr [string length $TmpEntry]-2]]
2110 # whoops / or @ is part of the name
2111 if {[MiscIsDir $Path/$FileName] != 1} {
2112 set FileName $TmpEntry
2113 }
2114 } {
2115 if {[string compare "*" [string index $TmpEntry \
2116 [expr [string length $TmpEntry]-1]]] == 0} {
2117 # handle executable filenames
2118 set FileName [string range $TmpEntry 0 \
2119 [expr [string length $TmpEntry]-2]]
2120 # whoops * is part of the name
2121 if {[file executable $Path/$FileName] != 1} {
2122 set FileName $TmpEntry
2123 }
2124 } {
2125 # a ordinary filename
2126 set FileName $TmpEntry
2127 }
2128 }
2129 # change directory
2130 if {[MiscIsDir $Path/$FileName] == 1} {
2131 if {[string compare "/" [string index $Path \
2132 [expr [string length $Path]-1]]] == 0} {
2133 append Path $FileName
2134 } {
2135 append Path / $FileName
2136 }
2137 $win.path.path delete 0 end
2138 $win.path.path insert 0 $Path
2139 ShowFileDialog $win $Path $Pattern
2140 } {
2141 # enter the selected filename into the filename field
2142 $win.file.file delete 0 end
2143 $win.file.file insert 0 "$FileName"
2144 if {[string length $Action] > 0} {
2145 eval $Action
2146 }
2147 wm withdraw $win
2148 }
2149 }
2150 }
2151 }
2152
2153
2154 proc NameComplete {win Type} {
2155
2156 set NewFile ""
2157 set Matched ""
2158
2159 if {[string compare $Type path] == 0} {
2160 set DirName [file dirname [$win.path.path get]]
2161 set FileName [file tail [$win.path.path get]]
2162 } {
2163 set DirName [file dirname [$win.path.path get]/]
2164 set FileName [file tail [$win.file.file get]]
2165 }
2166
2167 set FoundCounter 0
2168 if {[MiscIsDir $DirName] == 1} {
2169 catch "exec ls $DirName/" Result
2170 set Counter 0
2171 set ListLength [llength $Result]
2172 # go through list
2173 while {$Counter < $ListLength} {
2174 if {[string length $FileName] == 0} {
2175 if {$FoundCounter == 0} {
2176 set NewFile [lindex $Result $Counter]
2177 } {
2178 set Counter1 0
2179 set TmpFile1 $NewFile
2180 set TmpFile2 [lindex $Result $Counter]
2181 set Length1 [string length $TmpFile1]
2182 set Length2 [string length $TmpFile2]
2183 set NewFile ""
2184 if {$Length1 > $Length2} {
2185 set Length1 $Length2
2186 }
2187 while {$Counter1 < $Length1} {
2188 if {[string compare [string index $TmpFile1 $Counter1] \
2189 [string index $TmpFile2 $Counter1]] == 0} {
2190 append NewFile [string index $TmpFile1 $Counter1]
2191 } {
2192 break
2193 }
2194 incr Counter1 1
2195 }
2196 }
2197 incr FoundCounter 1
2198 } {
2199 if {[regexp "^$FileName" [lindex $Result $Counter] \
2200 Matched] == 1} {
2201 if {$FoundCounter == 0} {
2202 set NewFile [lindex $Result $Counter]
2203 } {
2204 set Counter1 0
2205 set TmpFile1 $NewFile
2206 set TmpFile2 [lindex $Result $Counter]
2207 set Length1 [string length $TmpFile1]
2208 set Length2 [string length $TmpFile2]
2209 set NewFile ""
2210 if {$Length1 > $Length2} {
2211 set Length1 $Length2
2212 }
2213 while {$Counter1 < $Length1} {
2214 if {[string compare [string index $TmpFile1 $Counter1] \
2215 [string index $TmpFile2 $Counter1]] == 0} {
2216 append NewFile [string index $TmpFile1 $Counter1]
2217 } {
2218 break
2219 }
2220 incr Counter1 1
2221 }
2222 }
2223 incr FoundCounter 1
2224 }
2225 }
2226 incr Counter 1
2227 }
2228 }
2229
2230 if {$FoundCounter == 1} {
2231 if {[MiscIsDir $DirName/$NewFile] == 1} {
2232 if {[string compare $DirName "/"] == 0} {
2233 $win.path.path delete 0 end
2234 $win.path.path insert 0 "/[string trim [string trim $NewFile /] @]/"
2235 } {
2236 $win.path.path delete 0 end
2237 $win.path.path insert 0 "[string trimright $DirName /]/[string trim [string trim $NewFile /] @]/"
2238 }
2239 } {
2240 $win.path.path delete 0 end
2241 $win.path.path insert 0 \
2242 "[string trim [string trimright $DirName /] @]/"
2243 $win.file.file delete 0 end
2244 $win.file.file insert 0 "$NewFile"
2245 }
2246 } {
2247 if {[MiscIsDir $DirName/$NewFile] == 1 ||
2248 [string compare $Type path] == 0} {
2249 $win.path.path delete 0 end
2250 $win.path.path insert 0 \
2251 "[string trimright $DirName /]/[string trim [string trim $NewFile /] @]"
2252 } {
2253 $win.path.path delete 0 end
2254 $win.path.path insert 0 "$DirName"
2255 if {[string length $NewFile] > 0} {
2256 $win.file.file delete 0 end
2257 $win.file.file insert 0 "$NewFile"
2258 }
2259 }
2260 }
2261 }
2262
2263
2264 proc ShowFileDialog {win Path Pattern} {
2265 busy $win {
2266 #set Path [lindex [split $Path] 0]
2267 if {[$win.files.files size] > 0} {
2268 $win.files.files delete 0 end
2269 }
2270 # read directory
2271 if {[catch "exec ls -F \"$Path\"" Result]} {
2272 set ElementList {}
2273 }
2274 if {[string match $Result "* not found"]} {
2275 set ElementList {}
2276 }
2277 set ElementList [lsort [split $Result "\n"]]
2278
2279 # insert ..
2280 if {[string compare $Path "/"]} {
2281 $win.files.files insert end "../"
2282 }
2283
2284 # walk through list
2285 foreach Counter $ElementList {
2286 # insert filename
2287 if {[string match $Pattern $Counter] == 1} {
2288 if {[string compare $Counter "../"] &&
2289 [string compare $Counter "./"]} {
2290 $win.files.files insert end $Counter
2291 }
2292 } else {
2293 set fn $Path/[string trim [string trim [string trim $Counter /] @] *]
2294 if {[MiscIsDir $fn]} {
2295 $win.files.files insert end $Counter
2296 }
2297 }
2298 }
2299 }
2300 }
2301
2302
2303 proc MiscIsDir {PathName} {
2304
2305 if {[file isdirectory $PathName] == 1} {
2306 return 1
2307 } {
2308 catch "file type $PathName" Type
2309 if {[string compare $Type link] == 0} {
2310 set LinkName [file readlink $PathName]
2311 catch "file type $LinkName" Type
2312 while {[string compare $Type link] == 0} {
2313 set LinkName [file readlink $LinkName]
2314 }
2315 return [file isdirectory $LinkName]
2316 }
2317 }
2318 return 0
2319 }
2320
2321
2322 proc busy {win cmds} {
2323 set busy {}
2324 set list [winfo children $win]
2325 set busy $list
2326 while {$list != ""} {
2327 set next {}
2328 foreach w $list {
2329 set class [winfo class $w]
2330 set cursor [lindex [$w config -cursor] 4]
2331 if {[winfo toplevel $w] == $w} {
2332 lappend busy [list $w $cursor]
2333 }
2334 set next [concat $next [winfo children $w]]
2335 }
2336 set list $next
2337 }
2338
2339 foreach w $busy {
2340 catch {[lindex $w 0] config -cursor watch}
2341 }
2342
2343 update idletasks
2344
2345 set error [catch {uplevel eval [list $cmds]} result]
2346
2347 foreach w $busy {
2348 catch {[lindex $w 0] config -cursor [lindex $w 1]}
2349 }
2350
2351 if $error {
2352 error $result
2353 } else {
2354 return $result
2355 }
2356 }
2357
2358
2359 ########################################################################
2360 # Editor Window Handlers
2361
2362 proc ShowEditorOf {head} {
2363 global EditorWindows
2364 set found 0
2365 foreach win $EditorWindows {
2366 if {[WindowLink $win.head] == $head} {
2367 set parent [WindowLink $win.parent]
2368 #pack append [WindowLink $head.col2]\
2369 # $parent {top frame nw expand fill}
2370 pack append $parent\
2371 $win {top frame nw expand fill}
2372 set found 1
2373 }
2374 }
2375 if {$found == 0} {
2376 NewEditorOf $head
2377 } else {
2378 update idletasks
2379 sim UpdateEditors
2380 sim UpdateMaps
2381 }
2382 }
2383
2384
2385 proc NewEditorOf {head} {
2386 set win [MakeWindow.editor $head [winfo screen $head]]
2387 #wm deiconify $win
2388 set parent [WindowLink $win.parent]
2389 pack append $parent\
2390 $win {top frame nw expand fill}
2391 update idletasks
2392 sim UpdateEditors
2393 sim UpdateMaps
2394 }
2395
2396
2397 proc ShowEditors {} {
2398 global HeadWindows
2399 foreach win $HeadWindows {
2400 ShowEditorOf $win
2401 }
2402 }
2403
2404
2405 proc WithdrawEditors {} {
2406 global EditorWindows
2407 foreach win $EditorWindows {
2408 #set parent [WindowLink $win.parent]
2409 #pack unpack $parent
2410 pack unpack $win
2411 }
2412 }
2413
2414
2415 proc InitEditors {} {
2416 global EditorWindows
2417 foreach win $EditorWindows {
2418 InitEditor $win
2419 }
2420 }
2421
2422
2423 proc InitEditor {win} {
2424 set e [WindowLink $win.view]
2425 UISetToolState $win 7
2426 $e ToolState 7
2427 set size [$e size]
2428 $e Pan 960 800
2429 $e AutoGoing 0
2430 global $e.TrackState
2431 set $e.TrackState {}
2432 }
2433
2434
2435 proc SetEditorAutoGoto {win val} {
2436 global AutoGoto.$win
2437 set AutoGoto.$win $val
2438 set e [WindowLink $win.view]
2439 $e AutoGoto $val
2440 }
2441
2442
2443 proc SetEditorControls {win val} {
2444 global Controls.$win
2445 set Controls.$win $val
2446 if {$val} {
2447 pack append $win $win.leftframe {left frame center filly}
2448 } else {
2449 pack unpack $win.leftframe
2450 }
2451 }
2452
2453
2454 proc SetEditorOverlay {win val} {
2455 global Overlay.$win
2456 set Overlay.$win $val
2457 set e [WindowLink $win.view]
2458 $e ShowOverlay $val
2459 }
2460
2461
2462 proc SetEditorDynamicFilter {win val} {
2463 global DynamicFilter.$win
2464 set DynamicFilter.$win $val
2465 set e [WindowLink $win.view]
2466 $e DynamicFilter $val
2467 if {$val == 1} then {
2468 ShowFrobOf [WindowLink $win.head]
2469 }
2470 }
2471
2472
2473 proc SetEditorSkip {win val} {
2474 set e [WindowLink $win.view]
2475 $e Skip $val
2476 }
2477
2478
2479 proc EditorToolDown {mod w x y} {
2480 global [set var $w.TrackState]
2481
2482 $w ToolMode 1
2483
2484 case [$w ToolState] in \
2485 7 { # bulldozer
2486 UIMakeSoundOn $w edit Rumble "-repeat 4"
2487 } \
2488 10 { # chalk
2489 StartChalk $w
2490 }
2491
2492 case $mod in \
2493 constrain {
2494 set $var [list constrain_start $x $y]
2495 $w ToolConstrain $x $y
2496 } \
2497 default {
2498 set $var none
2499 }
2500 EditorTool ToolDown $w $x $y
2501 sim NeedRest 5
2502 }
2503
2504
2505 proc EditorToolDrag {w x y} {
2506 EditorTool ToolDrag $w $x $y
2507 sim NeedRest 5
2508 }
2509
2510
2511 proc EditorToolUp {w x y} {
2512 global [set var $w.TrackState]
2513 $w ToolMode 0
2514
2515 case [$w ToolState] in \
2516 7 { # bulldozer
2517 stopdozer
2518 } \
2519 10 { # chalk
2520 StopChalk $w
2521 }
2522
2523 EditorTool ToolUp $w $x $y
2524 set $var {}
2525 $w ToolConstrain -1 -1
2526 sim UpdateMaps
2527 sim UpdateEditors
2528 sim NeedRest 5
2529 }
2530
2531
2532 proc EditorTool {action w x y} {
2533 global [set var $w.TrackState]
2534 set state [eval ident "\$\{$var\}"]
2535 case [lindex $state 0] in \
2536 constrain_start {
2537 set x0 [lindex $state 1]
2538 set y0 [lindex $state 2]
2539 set dx [expr "$x - $x0"]
2540 set dy [expr "$y - $y0"]
2541 if [expr "($dx > 16) || ($dx < -16)"] then {
2542 $w ToolConstrain -1 $y0
2543 set $var none
2544 } else {
2545 if [expr "($dy > 16) || ($dy < -16)"] then {
2546 $w ToolConstrain $x0 -1
2547 set $var none
2548 }
2549 }
2550 }
2551 $w $action $x $y
2552 }
2553
2554
2555 proc StartChalk {w} {
2556 sim CollapseMotion 0
2557 }
2558
2559
2560 proc StopChalk {w} {
2561 sim CollapseMotion 1
2562 }
2563
2564
2565 proc EditorPanDown {mod w x y} {
2566 global [set var $w.TrackState]
2567 $w ToolMode -1
2568 case $mod in \
2569 constrain {
2570 set $var [list constrain_start $x $y]
2571 $w ToolConstrain $x $y
2572 } \
2573 default {
2574 set $var none
2575 }
2576 EditorTool PanStart $w $x $y
2577 }
2578
2579
2580 proc EditorPanDrag {w x y} {
2581 EditorTool PanTo $w $x $y
2582 }
2583
2584
2585 proc EditorPanUp {w x y} {
2586 $w AutoGoing 0
2587 $w ToolMode 0
2588 EditorTool PanTo $w $x $y
2589 $w ToolConstrain -1 -1
2590 sim UpdateMaps
2591 sim UpdateEditors
2592 }
2593
2594
2595 proc EditorKeyDown {w k} {
2596 $w KeyDown $k
2597 }
2598
2599
2600 proc EditorKeyUp {w k} {
2601 $w KeyUp $k
2602 }
2603
2604
2605 proc BindEditorButtons {win} {
2606 set w [WindowLink $win.top]
2607
2608 bind $win <1> "CancelPie $win ; EditorToolDown none %W %x %y"
2609 bind $win <B1-Motion> {EditorToolDrag %W %x %y}
2610 bind $win <ButtonRelease-1> {EditorToolUp %W %x %y}
2611
2612 bind $win <Control-1> "CancelPie $win ; EditorToolDown constrain %W %x %y"
2613 bind $win <Control-B1-Motion> {EditorToolDrag %W %x %y}
2614 bind $win <Control-ButtonRelease-1> {EditorToolUp %W %x %y}
2615
2616 bind $win <2> "CancelPie $win ; EditorPanDown none %W %x %y"
2617 bind $win <B2-Motion> {EditorPanDrag %W %x %y}
2618 bind $win <ButtonRelease-2> {EditorPanUp %W %x %y}
2619
2620 bind $win <Control-2> "CancelPie $win ; EditorPanDown constrain %W %x %y"
2621 bind $win <Control-B2-Motion> {EditorPanDrag %W %x %y}
2622 bind $win <Control-ButtonRelease-2> {EditorPanUp %W %x %y}
2623
2624 InitPie $win $w.toolpie
2625 }
2626
2627
2628 proc UISetFunds {funds} {
2629 global HeadWindows
2630 foreach win $HeadWindows {
2631 [WindowLink $win.funds] configure -text "$funds"
2632 }
2633 }
2634
2635
2636 proc UISetDate {date month year} {
2637 global HeadWindows
2638 global CurrentDate
2639
2640 set CurrentDate "$date"
2641
2642 foreach win $HeadWindows {
2643 [WindowLink $win.date] Set $month $year
2644 }
2645 }
2646
2647
2648 proc SetPriority {index} {
2649 case $index { \
2650 {0} {
2651 sim Delay 500000
2652 sim Skips 0
2653 } \
2654 {1} {
2655 sim Delay 100000
2656 sim Skips 0
2657 } \
2658 {2} {
2659 sim Delay 25000
2660 sim Skips 0
2661 } \
2662 {3} {
2663 sim Delay 5000
2664 sim Skips 20
2665 } \
2666 {4} {
2667 sim Delay 5
2668 sim Skips 500
2669 }
2670 }
2671 }
2672
2673
2674 proc UISetDemand {r c i} {
2675 global HeadWindows DemandRes DemandCom DemandInd
2676
2677 set DemandRes $r
2678 set DemandCom $c
2679 set DemandInd $i
2680
2681 if {$r <= 0} then {set ry0 32} else {set ry0 24}
2682 set ry1 [expr "$ry0 - $r"]
2683 if {$c <= 0} then {set cy0 32} else {set cy0 24}
2684 set cy1 [expr "$cy0 - $c"]
2685 if {$i <= 0} then {set iy0 32} else {set iy0 24}
2686 set iy1 [expr "$iy0 - $i"]
2687
2688 foreach win $HeadWindows {
2689 set can [WindowLink $win.demand]
2690 # $can coords r 8 $ry0 14 $ry1
2691 # $can coords c 17 $cy0 23 $cy1
2692 # $can coords i 26 $iy0 32 $iy1
2693 $can coords r 49 $ry0 55 $ry1
2694 $can coords c 58 $cy0 64 $cy1
2695 $can coords i 67 $iy0 73 $iy1
2696 }
2697 }
2698
2699
2700 proc UISetOptions {autobudget autogoto autobulldoze disasters sound animation messages notices} {
2701 global AutoBudget AutoGoto AutoBulldoze Disasters Sound
2702 set AutoBudget $autobudget
2703 set AutoGoto $autogoto
2704 set AutoBulldoze $autobulldoze
2705 set Disasters $disasters
2706 set Sound $sound
2707 set DoAnimation $animation
2708 set DoMessages $messages
2709 set DoNotices $notices
2710 }
2711
2712
2713 proc UIDidToolRes {win x y} {
2714 UIMakeSoundOn $win edit O "-speed 140"
2715 }
2716
2717
2718 proc UIDidToolCom {win x y} {
2719 UIMakeSoundOn $win edit A "-speed 140"
2720 }
2721
2722
2723 proc UIDidToolInd {win x y} {
2724 UIMakeSoundOn $win edit E "-speed 140"
2725 }
2726
2727
2728 proc UIDidToolFire {win x y} {
2729 UIMakeSoundOn $win edit O "-speed 130"
2730 }
2731
2732
2733 proc UIDidToolQry {win x y} {
2734 UIMakeSoundOn $win edit E "-speed 200"
2735 }
2736
2737
2738 proc UIDidToolPol {win x y} {
2739 UIMakeSoundOn $win edit E "-speed 130"
2740 }
2741
2742
2743 proc UIDidToolWire {win x y} {
2744 UIMakeSoundOn $win edit O "-speed 120"
2745 }
2746
2747
2748 proc UIDidToolDozr {win x y} {
2749 UIMakeSoundOn $win edit Rumble
2750 }
2751
2752
2753 proc UIDidToolRail {win x y} {
2754 UIMakeSoundOn $win edit O "-speed 100"
2755 }
2756
2757
2758 proc UIDidToolRoad {win x y} {
2759 UIMakeSoundOn $win edit E "-speed 100"
2760 }
2761
2762
2763 proc UIDidToolChlk {win x y} {
2764 }
2765
2766
2767 proc UIDidToolEraser {win x y} {
2768 }
2769
2770
2771 proc UIDidToolStad {win x y} {
2772 UIMakeSoundOn $win edit O "-speed 90"
2773 }
2774
2775
2776 proc UIDidToolPark {win x y} {
2777 UIMakeSoundOn $win edit A "-speed 130"
2778 }
2779
2780
2781 proc UIDidToolSeap {win x y} {
2782 UIMakeSoundOn $win edit E "-speed 90"
2783 }
2784
2785
2786 proc UIDidToolCoal {win x y} {
2787 UIMakeSoundOn $win edit O "-speed 75"
2788 }
2789
2790
2791 proc UIDidToolNuc {win x y} {
2792 UIMakeSoundOn $win edit E "-speed 75"
2793 }
2794
2795
2796 proc UIDidToolAirp {win x y} {
2797 UIMakeSoundOn $win edit A "-speed 50"
2798 }
2799
2800
2801 proc UISetToolState {w state} {
2802 global EditorPallets EditorPalletImages ToolInfo
2803 set win [WindowLink $w.top]
2804 #echo "UISETTOOLSTATE w $w win $win $state"
2805 ExclusivePallet $state $win $EditorPallets ic $EditorPalletImages \
2806 raised sunken {NoFunction}
2807 {NoFunction}
2808 set c1 [WindowLink $w.cost1]
2809 if {"$c1" != ""} {
2810 set info [lindex $ToolInfo $state]
2811 set cost1 [lindex $info 1]
2812 set cost2 [lindex $info 2]
2813 $c1 configure -text "$cost1"
2814 [WindowLink $w.cost2] configure -text "$cost2"
2815 }
2816 }
2817
2818
2819 proc UIShowZoneStatus {zone density value crime pollution growth x y} {
2820 global QueryX QueryY
2821 set QueryX [expr "8 + 16 * $x"]
2822 set QueryY [expr "8 + 16 * $y"]
2823 UIShowPicture 9 [list $zone $density $value $crime $pollution $growth]
2824 }
2825
2826
2827 ########################################################################
2828 # Map Window Handlers
2829
2830
2831 proc ShowMapOf {head} {
2832 global MapWindows
2833 set found 0
2834 foreach win $MapWindows {
2835 if {"[WindowLink $win.head]" == "$head"} {
2836 global MapPanelWidth MapPanelHeight
2837 #place configure $win -x 0 -y 0 -width $MapPanelWidth -height $MapPanelHeight
2838 #[WindowLink $win.parent] configure -width $MapPanelWidth -height $MapPanelHeight
2839 set parent [WindowLink $win.parent]
2840 pack append [WindowLink $head.w2] \
2841 $win {top frame nw expand fill}
2842 set found 1
2843 }
2844 }
2845 if {$found == 0} {
2846 NewMapOf $head
2847 } else {
2848 update idletasks
2849 sim UpdateMaps
2850 }
2851 }
2852
2853
2854 proc NewMapOf {head} {
2855 set win [MakeWindow.map $head [winfo screen $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.col1]\
2861 # $parent {top frame nw fillx}
2862 pack append [WindowLink $head.w2] \
2863 $win {top frame nw expand fill}
2864 sim UpdateMaps
2865 }
2866
2867
2868 proc ShowMaps {} {
2869 global HeadWindows
2870 foreach win $HeadWindows {
2871 ShowMapOf $win
2872 }
2873 }
2874
2875
2876 proc WithdrawMaps {} {
2877 global MapWindows
2878 foreach win $MapWindows {
2879 #place forget $win
2880 pack unpack $win
2881 }
2882 }
2883
2884
2885 proc InitMaps {} {
2886 global MapWindows
2887 foreach win $MapWindows {
2888 InitMap $win
2889 }
2890 }
2891
2892
2893 proc InitMap {win} {
2894 SetMapState $win 0
2895 }
2896
2897
2898 proc EnableMaps {} {
2899 global MapWindows
2900 foreach win $MapWindows {
2901 EnableMap $win
2902 }
2903 }
2904
2905
2906 proc EnableMap {win} {
2907 [WindowLink $win.view] ShowEditors 1
2908 [WindowLink $win.zones] config -state normal
2909 [WindowLink $win.overlays] config -state normal
2910 }
2911
2912
2913 proc DisableMaps {} {
2914 global MapWindows
2915 foreach win $MapWindows {
2916 DisableMap $win
2917 }
2918 }
2919
2920
2921 proc DisableMap {win} {
2922 [WindowLink $win.view] ShowEditors 0
2923 [WindowLink $win.zones] config -state disabled
2924 [WindowLink $win.overlays] config -state disabled
2925 }
2926
2927
2928 proc SetMapState {win state} {
2929 set m [WindowLink $win.view]
2930 $m MapState $state
2931 if {$state == 14} then {
2932 ShowFrobOf [WindowLink $win.head]
2933 }
2934 }
2935
2936
2937 proc MapPanDown {w x y} {
2938 $w PanStart $x $y
2939 }
2940
2941
2942 proc MapPanDrag {w x y} {
2943 $w PanTo $x $y
2944 }
2945
2946
2947 proc MapPanUp {w x y} {
2948 $w PanTo $x $y
2949 sim UpdateMaps
2950 sim UpdateEditors
2951 }
2952
2953
2954 proc UISetMapState {w state} {
2955 global MapTitles
2956 #set win [winfo toplevel $w]
2957 set win [WindowLink $w.win]
2958 set m [WindowLink $win.view]
2959 set title [lindex $MapTitles $state]
2960
2961 # TODO: set map text field header to title
2962 #wm title $win "$title"
2963 #wm iconname $win "$title"
2964
2965 global [set var MapState.$win]
2966 set $var $state
2967
2968 case $state { \
2969 {6 8 9 10 11 12 13} {
2970 [WindowLink $win.legend] config -bitmap "@images/legendmm.xpm"
2971 } \
2972 {7} {
2973 [WindowLink $win.legend] config -bitmap "@images/legendpm.xpm"
2974 } \
2975 {0 1 2 3 4 5 14} {
2976 [WindowLink $win.legend] config -bitmap "@images/legendn.xpm"
2977 }
2978 }
2979 }
2980
2981
2982 ########################################################################
2983 # Graph Window Handlers
2984
2985
2986 proc ToggleGraphOf {head} {
2987 global State
2988 if {"$State" != "play"} {
2989 return
2990 }
2991
2992 set mapped 0
2993 set win [WindowLink $head.graph]
2994 if {$win != ""} {
2995 set mapped [winfo ismapped $win]
2996 }
2997
2998 if {$mapped} {
2999 WithdrawGraphOf $head
3000 } else {
3001 ShowGraphOf $head
3002 }
3003
3004 }
3005
3006
3007 proc WithdrawGraphOf {head} {
3008 set win [WindowLink $head.graph]
3009 if {"$win" != ""} {
3010 pack unpack $win
3011 }
3012 }
3013
3014
3015 proc ShowGraphOf {head} {
3016 set win [WindowLink $head.graph]
3017 if {$win == {}} {
3018 set win [MakeWindow.graph $head [winfo screen $head]]
3019 }
3020 #wm deiconify $win
3021 #wm raise $win
3022 set parent [WindowLink $win.parent]
3023 pack append $parent\
3024 $win {top frame nw fillx}
3025 update idletasks
3026 sim UpdateGraphs
3027 }
3028
3029
3030 proc WithdrawGraphs {} {
3031 global GraphWindows
3032 foreach win $GraphWindows {
3033 #wm withdraw $win
3034 pack unpack $win
3035 }
3036 }
3037
3038
3039 proc InitGraphs {} {
3040 global GraphWindows
3041 foreach win $GraphWindows {
3042 InitGraph $win
3043 }
3044 }
3045
3046
3047 proc InitGraph {win} {
3048 UISetGraphState $win 1 1 1 1 1 1 0
3049 }
3050
3051
3052 proc UISetGraphState {win t0 t1 t2 t3 t4 t5 range} {
3053 set g [WindowLink $win.graphview]
3054 GraphPalletMask $win [expr "$t0 + ($t1<<1) + ($t2<<2) + ($t3<<3) + ($t4<<4) + ($t5<<5)"]
3055 GraphYearPallet $win $range
3056 }
3057
3058
3059 ########################################################################
3060 # Splash Window Handlers
3061
3062
3063 proc ShowSplashOf {head} {
3064 set win [WindowLink $head.splash]
3065 if {$win == {}} {
3066 set win [MakeWindow.splash $head [winfo screen $head]]
3067 }
3068 set splashscreen [WindowLink $win.splashscreen]
3069 set success 0
3070 catch {$splashscreen config -bitmap "@images/splashscreen.xpm"; set success 1}
3071 if {$success} {
3072 wm deiconify $win
3073 global SplashScreenDelay
3074 after $SplashScreenDelay "UIPickScenarioMode"
3075 } else {
3076 UIPickScenarioMode
3077 }
3078 }
3079
3080
3081 proc WithdrawSplashOf {head} {
3082 set win [WindowLink $head.splash]
3083 if {$win != {}} {
3084 wm withdraw $win
3085 }
3086 }
3087
3088
3089 proc ShowSplashes {} {
3090 global HeadWindows
3091 foreach win $HeadWindows {
3092 ShowSplashOf $win
3093 }
3094 }
3095
3096
3097 proc WithdrawSplashes {} {
3098 global SplashWindows
3099 foreach win $SplashWindows {
3100 wm withdraw $win
3101 set splashscreen [WindowLink $win.splashscreen]
3102 $splashscreen config -bitmap ""
3103 }
3104 }
3105
3106
3107 proc InitSplashes {} {
3108 }
3109
3110
3111 proc InitSplash {win} {
3112 }
3113
3114
3115 proc DeleteSplashWindow {win} {
3116 # TODO
3117 }
3118
3119
3120 ########################################################################
3121 # Scenario Window Handlers
3122
3123
3124 proc ShowScenarioOf {head} {
3125 set win [WindowLink $head.scenario]
3126 if {$win == {}} {
3127 set win [MakeWindow.scenario $head [winfo screen $head]]
3128 }
3129 # TODO: load background bitmap
3130 wm deiconify $win
3131 }
3132
3133
3134 proc WithdrawScenarioOf {head} {
3135 set win [WindowLink $head.scenario]
3136 if {$win != {}} {
3137 wm withdraw $win
3138 }
3139 }
3140
3141
3142 proc ShowScenarios {} {
3143 global HeadWindows
3144 foreach win $HeadWindows {
3145 ShowScenarioOf $win
3146 }
3147 }
3148
3149
3150 proc WithdrawScenarios {} {
3151 global ScenarioWindows
3152 foreach win $ScenarioWindows {
3153 wm withdraw $win
3154 # TODO: flush background bitmap
3155 }
3156 }
3157
3158
3159 proc InitScenarios {} {
3160 global MapHistory MapHistoryNum
3161 if {$MapHistoryNum < 1} {
3162 set prev disabled
3163 } else {
3164 set prev normal
3165 }
3166 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3167 set next disabled
3168 } else {
3169 set next normal
3170 }
3171 global ScenarioWindows
3172 foreach win $ScenarioWindows {
3173 # TODO
3174 #[WindowLink $win.previous] config -state $prev
3175 #[WindowLink $win.next] config -state $next
3176 }
3177 }
3178
3179
3180 proc InitScenario {win} {
3181 global MapHistory MapHistoryNum
3182 if {$MapHistoryNum < 1} {
3183 set prev disabled
3184 } else {
3185 set prev normal
3186 }
3187
3188 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3189 set next disabled
3190 } else {
3191 set next normal
3192 }
3193
3194 # TODO
3195 #[WindowLink $win.previous] config -state $prev
3196 #[WindowLink $win.next] config -state $next
3197
3198 LinkWindow $win.scenarioTarget -1
3199 LinkWindow $win.scenarioTargetDown -1
3200
3201 global ScenarioButtons
3202 set i 0
3203 set len [llength $ScenarioButtons]
3204 while {$i < $len} {
3205 set data [lindex $ScenarioButtons $i]
3206 set type [lindex $data 0]
3207 set id [lindex $data 1]
3208 #echo "DATA $data"
3209 #echo "ID $id"
3210
3211 LinkWindow $win.$id.over 0
3212 LinkWindow $win.$id.enabled 1
3213 LinkWindow $win.$id.checked 0
3214 #echo "SETTING WIN $win ID $id"
3215
3216 set i [expr "$i + 1"]
3217 }
3218
3219 UpdateLevelSelection $win
3220 UpdateLeftRightEnabled $win
3221 }
3222
3223
3224 proc UpdateLevelSelection {win} {
3225 #echo UpdateLevelSelection
3226 global GameLevel
3227 if {$GameLevel == 0} then {
3228 LinkWindow $win.easy.checked 1
3229 LinkWindow $win.medium.checked 0
3230 LinkWindow $win.hard.checked 0
3231 }
3232 if {$GameLevel == 1} then {
3233 LinkWindow $win.easy.checked 0
3234 LinkWindow $win.medium.checked 1
3235 LinkWindow $win.hard.checked 0
3236 }
3237 if {$GameLevel == 2} then {
3238 LinkWindow $win.easy.checked 0
3239 LinkWindow $win.medium.checked 0
3240 LinkWindow $win.hard.checked 1
3241 }
3242
3243 UpdateScenarioButtonID $win easy
3244 UpdateScenarioButtonID $win medium
3245 UpdateScenarioButtonID $win hard
3246
3247 }
3248
3249
3250 proc UpdateLeftRightEnabled {win} {
3251 #echo UpdateLeftRightEnabled
3252
3253 global MapHistory MapHistoryNum
3254 if {$MapHistoryNum < 1} {
3255 LinkWindow $win.left.enabled 0
3256 } else {
3257 LinkWindow $win.left.enabled 1
3258 }
3259
3260 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3261 LinkWindow $win.right.enabled 0
3262 } else {
3263 LinkWindow $win.right.enabled 1
3264 }
3265
3266 UpdateScenarioButtonID $win left
3267 UpdateScenarioButtonID $win right
3268 }
3269
3270
3271 proc UpdateScenarioButtonID {win id} {
3272
3273 global ScenarioButtons
3274 set i 0
3275 set len [llength $ScenarioButtons]
3276 while {$i < $len} {
3277 set data [lindex $ScenarioButtons $i]
3278 set id
3279 if {$id == [lindex $data 1]} then {
3280 UpdateScenarioButton $win $data
3281 break
3282 }
3283
3284 set i [expr "$i + 1"]
3285 }
3286 }
3287
3288
3289 proc UpdateScenarioButton {win data} {
3290 global Messages
3291
3292 set type [lindex $data 0]
3293 set id [lindex $data 1]
3294 set over [WindowLink $win.$id.over]
3295 set enabled [WindowLink $win.$id.enabled]
3296 set checked [WindowLink $win.$id.checked]
3297 #echo "WIN $win TYPE $type ID $id OVER $over ENABLED $enabled CHECKED $checked"
3298 if {$over} {
3299 if {[lindex ${data} 2] == "DoPickScenario"} {
3300 catch {text $win.desc \
3301 -borderwidth 2 \
3302 -relief flat \
3303 -wrap word \
3304 -state normal \
3305 -font [Font $win Large]}
3306
3307 $win.desc configure -state normal
3308 $win.desc delete 0.0 end
3309 $win.desc insert end "[lindex $Messages([lindex ${data} 3]) 1]\n\n[lindex $Messages([lindex ${data} 3]) 2]"
3310 $win.desc configure -state disabled
3311
3312 place $win.desc -x 232 -y 170 -width 280 -height 285
3313 }
3314 } else {
3315 catch {destroy $win.desc}
3316 }
3317 if {$enabled} {
3318 if {$checked} {
3319 if {$over} {
3320 set bm [lindex $data 13]
3321 } else {
3322 set bm [lindex $data 12]
3323 }
3324 } else {
3325 if {$over} {
3326 set bm [lindex $data 10]
3327 } else {
3328 set bm [lindex $data 9]
3329 }
3330 }
3331 } else {
3332 set bm [lindex $data 11]
3333 }
3334
3335 [WindowLink $win.canvas] itemconfig $id -bitmap $bm
3336 }
3337
3338
3339 proc DoEnterCityName {win} {
3340 }
3341
3342
3343 proc InitVotesForUseThisMap {} {
3344 # TODO: Disabled for new scenario window.
3345 return
3346
3347 global VotesForUseThisMap ScenarioWindows
3348 set VotesForUseThisMap {}
3349 foreach win $ScenarioWindows {
3350 [WindowLink $win.vote] config -relief raised
3351 }
3352 UpdateVotesForUseThisMap
3353 }
3354
3355
3356 proc UpdateVotesForUseThisMap {} {
3357 global ScenarioWindows
3358 UpdateVotesFor UseThisMap $ScenarioWindows
3359 }
3360
3361
3362 proc UIUseThisMap {} {
3363 global CityName GameLevel Scenario
3364 WithdrawAll
3365 # special handling for scenarios?
3366 if {$GameLevel != -1} {
3367 sim GameLevel $GameLevel
3368 }
3369 sim CityName $CityName
3370 UINewGame
3371 UIPlayGame
3372 if {$Scenario != -1} {
3373 UIShowPicture $Scenario
3374 }
3375 }
3376
3377
3378 proc HandleScenarioDown {win x y} {
3379 #echo HandleScenarioDown $win $x $y
3380 HandleScenarioMove $win $x $y
3381 set w [WindowLink $win.w]
3382 set target [WindowLink $w.scenarioTarget]
3383 LinkWindow $w.scenarioTargetDown $target
3384 }
3385
3386
3387 proc HandleScenarioUp {win x y} {
3388 #echo HandleScenarioUp $win $x $y
3389 HandleScenarioMove $win $x $y
3390 global ScenarioButtons
3391 set w [WindowLink $win.w]
3392 set target [WindowLink $w.scenarioTarget]
3393 set targetDown [WindowLink $w.scenarioTargetDown]
3394 if {($target != -1) &&
3395 ($target == $targetDown)} {
3396 set data [lindex $ScenarioButtons $target]
3397 set type [lindex $data 0]
3398 set id [lindex $data 1]
3399 set callback [lindex $data 2]
3400 set param [lindex $data 3]
3401 set var [lindex $data 4]
3402 set xx [lindex $data 5]
3403 set yy [lindex $data 6]
3404 set ww [lindex $data 7]
3405 set hh [lindex $data 8]
3406 set normal [lindex $data 9]
3407 set over [lindex $data 10]
3408 set disabled [lindex $data 11]
3409 if {$type == "button"} {
3410 #echo callback $callback w $w param $param
3411 eval "$callback $w {$param}"
3412 } else {
3413 if {$type == "checkbox"} {
3414 #echo checkbox callback $callback w $w param $param
3415 eval "$callback $w {$param}"
3416 }
3417 }
3418 }
3419 }
3420
3421
3422 proc HandleScenarioMove {win x y} {
3423 #echo HandleScenarioMove $win $x $y
3424 global ScenarioButtons
3425 set w [WindowLink $win.w]
3426 set target [WindowLink $w.scenarioTarget]
3427 set found -1
3428 set i 0
3429 set len [llength $ScenarioButtons]
3430 while {$i < $len} {
3431 set data [lindex $ScenarioButtons $i]
3432 set type [lindex $data 0]
3433 set id [lindex $data 1]
3434 set callback [lindex $data 2]
3435 set param [lindex $data 3]
3436 set var [lindex $data 4]
3437 set xx [lindex $data 5]
3438 set yy [lindex $data 6]
3439 set ww [lindex $data 7]
3440 set hh [lindex $data 8]
3441
3442 set enabled [WindowLink $w.$id.enabled]
3443 set checked [WindowLink $w.$id.checked]
3444
3445 #echo "ID $id ENABLED $enabled CHECKED $checked w $w id $id"
3446
3447 if {($enabled != 0) &&
3448 ($x >= $xx) &&
3449 ($x < ($xx + $ww)) &
3450 ($y >= $yy) &&
3451 ($y < ($yy + $hh))} {
3452 set found $i
3453 break
3454 }
3455
3456 set i [expr "$i + 1"]
3457 }
3458
3459 if {$found != $target} {
3460
3461 if {$found == -1} {
3462 if {$target != -1} {
3463
3464 #echo OUT $w $found $xx $yy $normal
3465 LinkWindow $w.scenarioTarget -1
3466
3467 set targetdata [lindex $ScenarioButtons $target]
3468 set targetid [lindex $targetdata 1]
3469 LinkWindow $w.$targetid.over 0
3470 UpdateScenarioButton $w $targetdata
3471
3472 }
3473 } else {
3474
3475 #echo IN $w $found $xx $yy $over
3476 LinkWindow $w.scenarioTarget $found
3477 LinkWindow $w.$id.over 1
3478
3479 if {$target != -1} {
3480 set targetdata [lindex $ScenarioButtons $target]
3481 set targetid [lindex $targetdata 1]
3482 LinkWindow $w.$targetid.over 0
3483 UpdateScenarioButton $w $targetdata
3484 }
3485
3486 UpdateScenarioButton $w $data
3487
3488 }
3489 }
3490 }
3491
3492 proc DoLoad {win param} {
3493 #echo DOLOAD $win $param
3494 UILoadCity $win
3495 }
3496
3497
3498 proc DoGenerate {win param} {
3499 #echo DOGENERATE $win $param
3500 UIGenerateNewCity
3501 }
3502
3503
3504 proc DoQuit {win param} {
3505 #echo DOQUIT $win $param
3506 UIQuit $win
3507 }
3508
3509
3510 proc DoAbout {win param} {
3511 #echo DOABOUT $win $param
3512 MakeHistory "DoLoadCity cities/about.cty"
3513 }
3514
3515
3516 proc DoMap {win param} {
3517 #echo DOMAP $win $param
3518 }
3519
3520
3521 proc DoLevel {win param} {
3522 #echo DOLEVEL $win $param
3523 DoSetGameLevel $param
3524 }
3525
3526
3527 proc DoLeft {win param} {
3528 #echo DOLEFT $win $param
3529 PrevHistory
3530 }
3531
3532
3533 proc DoRight {win param} {
3534 #echo DORIGHT $win $param
3535 NextHistory
3536 }
3537
3538
3539 proc DoPlay {win param} {
3540 #echo DOPLAY $win $param
3541 UIUseThisMap
3542 }
3543
3544
3545 proc DoPickScenario {win param} {
3546 #echo DOPICKSCENARIO $win $param
3547 UILoadScenario $param
3548 }
3549
3550 proc DeleteScenarioWindow {win} {
3551 UIQuit $win
3552 }
3553
3554
3555 ########################################################################
3556 # Undo/Redo Facility
3557
3558
3559 proc InitHistory {} {
3560 global MapHistory
3561 global MapHistoryNum
3562 set MapHistory {}
3563 set MapHistoryNum -1
3564 }
3565
3566
3567 proc MakeHistory {cmd} {
3568 global MapHistory
3569 set len [llength $MapHistory]
3570 if {($len == 0) ||
3571 ($cmd != [lindex $MapHistory [expr $len-1]])} {
3572 lappend MapHistory $cmd
3573 } else {
3574 incr len -1
3575 }
3576 GotoHistory $len
3577 }
3578
3579
3580 proc GotoHistory {i} {
3581 global MapHistory
3582 global MapHistoryNum
3583 InitVotesForUseThisMap
3584 if {$i != $MapHistoryNum} {
3585 set MapHistoryNum $i
3586 set cmd [lindex $MapHistory $i]
3587 eval $cmd
3588 }
3589 if {$MapHistoryNum == 0} {
3590 set prev disabled
3591 } else {
3592 set prev normal
3593 }
3594 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3595 set next disabled
3596 } else {
3597 set next normal
3598 }
3599
3600 global ScenarioWindows
3601 foreach win $ScenarioWindows {
3602 UpdateLeftRightEnabled $win
3603 }
3604
3605 }
3606
3607
3608 proc NextHistory {} {
3609 global MapHistory
3610 global MapHistoryNum
3611 set len [llength $MapHistory]
3612 set i [expr "$MapHistoryNum + 1"]
3613 if {$i < $len} {
3614 GotoHistory $i
3615 }
3616 }
3617
3618
3619 proc PrevHistory {} {
3620 global MapHistory
3621 global MapHistoryNum
3622 set i [expr "$MapHistoryNum - 1"]
3623 if {$i >= 0} {
3624 GotoHistory $i
3625 }
3626 }
3627
3628
3629 ########################################################################
3630 # Ask Window Handlers
3631
3632 proc ShowAskOf {head} {
3633 set win [WindowLink $head.ask]
3634 if {$win == {}} {
3635 set win [MakeWindow.ask $head [winfo screen $head]]
3636 }
3637 wm deiconify $win
3638 wm raise $win
3639 return $win
3640 }
3641
3642
3643 proc ShowAsks {} {
3644 global HeadWindows
3645 foreach win $HeadWindows {
3646 ShowAskOf $win
3647 }
3648 }
3649
3650
3651 proc WithdrawAsks {} {
3652 global AskWindows
3653 foreach win $AskWindows {
3654 wm withdraw $win
3655 }
3656 }
3657
3658
3659 proc WithdrawAskOf {win} {
3660 set ask [WindowLink $win.ask]
3661 if {"$ask" != ""} {
3662 wm withdraw $ask
3663 }
3664 }
3665
3666
3667 proc AskQuestion {color title text left middle right} {
3668 global HeadWindows
3669 foreach win $HeadWindows {
3670 AskQuestionOn $win $color $title $text $left $middle $right
3671 }
3672 }
3673
3674
3675 proc AskQuestionOn {head color title text left middle right} {
3676 ShowAskOf $head
3677
3678 set win [WindowLink $head.ask]
3679 set t [WindowLink $win.title]
3680 $t configure -text $title
3681 $t configure -background $color
3682
3683 set t [WindowLink $win.text]
3684 $t configure -state normal
3685 $t delete 0.0 end
3686 $t insert end "${text}\n"
3687 $t configure -state disabled
3688
3689 set bf [WindowLink $win.frame]
3690 set l [WindowLink $win.left]
3691 set m [WindowLink $win.middle]
3692 set r [WindowLink $win.vote]
3693 set rf [WindowLink $win.voteframe]
3694
3695 if {$left != ""} {
3696 $l config \
3697 -text [lindex $left 0] \
3698 -command [format [lindex $left 2] $head]
3699 SetHelp $l [lindex $left 1]
3700 pack append $bf $l {left frame center}
3701 } else {
3702 pack unpack $l
3703 }
3704
3705 if {$middle != ""} {
3706 $m config \
3707 -text [lindex $middle 0] \
3708 -command [format [lindex $middle 2] $head]
3709 SetHelp $m [lindex $middle 1]
3710 pack append $bf $m {left frame center expand}
3711 } else {
3712 pack unpack $m
3713 }
3714
3715 if {$right != ""} {
3716 set notify [format [lindex $right 2] $head]
3717 set preview [format [lindex $right 3] $head]
3718 set cmd [list DoVote $win Ask $notify $preview]
3719 $r config \
3720 -text [lindex $right 0] \
3721 -command $cmd
3722 SetHelp $r [lindex $right 1]
3723 pack append $bf $rf {right frame center}
3724 } else {
3725 pack unpack $rf
3726 }
3727
3728 InitVotesForAsk
3729 }
3730
3731
3732 proc BindVotingButton {win but name} {
3733 set w [WindowLink $win.top]
3734
3735 bind $but <Any-Enter> "VoteButtonEnter $win $but"
3736 bind $but <Any-Leave> "VoteButtonLeave $win $but"
3737 bind $but <1> "VoteButtonDown $win $but $name"
3738 bind $but <ButtonRelease-1> "VoteButtonUp $win $but $name"
3739 bind $but <2> "VoteButtonDown $win $but $name"
3740 bind $but <ButtonRelease-2> "VoteButtonUp $win $but $name"
3741 bind $but <3> "VoteButtonDown $win $but $name"
3742 bind $but <ButtonRelease-3> "VoteButtonUp $win $but $name"
3743 }
3744
3745
3746 proc VoteButtonEnter {win but} {
3747 global tk_priv
3748 set screen [winfo screen $but]
3749 if {[lindex [$but config -state] 4] != "disabled"} {
3750 $but config -state active
3751 set tk_priv(window@$screen) $but
3752 } else {
3753 set tk_priv(window@$screen) ""
3754 }
3755 }
3756
3757
3758 proc VoteButtonLeave {win but} {
3759 global tk_priv
3760 if {[lindex [$but config -state] 4] != "disabled"} {
3761 $but config -state normal
3762 }
3763 set screen [winfo screen $but]
3764 set tk_priv(window@$screen) ""
3765 }
3766
3767
3768 proc VoteButtonDown {win but name} {
3769 global tk_priv
3770 set screen [winfo screen $but]
3771 set rel [lindex [$but config -relief] 4]
3772 set tk_priv(relief@$screen) $rel
3773 if {[lindex [$but config -state] 4] != "disabled"} {
3774 set head [WindowLink $win.head]
3775 if {[IsVotingFor $head $name]} {
3776 $but config -relief raised
3777 } else {
3778 $but config -relief sunken
3779 }
3780 }
3781 }
3782
3783
3784 proc VoteButtonUp {win but name} {
3785 global tk_priv
3786 set screen [winfo screen $but]
3787 $but config -relief $tk_priv(relief@$screen)
3788 if {($but == $tk_priv(window@$screen))
3789 && ([lindex [$but config -state] 4] != "disabled")} {
3790 uplevel #0 [list $but invoke]
3791 set head [WindowLink $win.head]
3792 if {[IsVotingFor $head $name]} {
3793 $but config -relief sunken
3794 } else {
3795 $but config -relief raised
3796 }
3797 }
3798 }
3799
3800
3801 proc PressVoteButton {win but name} {
3802 global tk_priv
3803 uplevel #0 [list $but invoke]
3804 set head [WindowLink $win.head]
3805 if {[IsVotingFor $head $name]} {
3806 $but config -relief sunken
3807 } else {
3808 $but config -relief raised
3809 }
3810 }
3811
3812
3813 proc IsVotingFor {win name} {
3814 global VotesFor$name
3815 set votes [eval ident "\$\{VotesFor$name\}"]
3816 if {[lsearch $votes $win] == -1} {
3817 return 0
3818 } else {
3819 return 1
3820 }
3821 }
3822
3823
3824 proc DoVote {win name notify preview} {
3825 global VotesFor$name
3826 set votes [eval ident "\$\{VotesFor$name\}"]
3827
3828 set win [WindowLink $win.head]
3829 set i [lsearch $votes $win]
3830 if {$i == -1} {
3831 lappend VotesFor$name $win
3832 } else {
3833 set VotesFor$name [lreplace $votes $i $i]
3834 }
3835 UpdateVotesFor$name
3836 set votes [eval ident "\$\{VotesFor$name\}"]
3837 if {[llength $votes] >= [NeededVotes]} {
3838 eval "$notify"
3839 } else {
3840 eval "$preview"
3841 }
3842 }
3843
3844
3845 proc UpdateVotesFor {name wins} {
3846 global VotesFor$name
3847 set votes [eval llength "\$\{VotesFor$name\}"]
3848 set needed [NeededVotes]
3849
3850 foreach win $wins {
3851 set head [WindowLink $win.head]
3852 if {[IsVotingFor $head $name]} {
3853 set border [expr "($needed - $votes) * 1"]
3854 set pad [expr "6 - $border"]
3855 [WindowLink $win.vote] config -padx $pad -pady $pad
3856 [WindowLink $win.voteframe] config -borderwidth $border
3857 } else {
3858 set border [expr "($needed - $votes - 1) * 1"]
3859 set pad [expr "6 - $border"]
3860 [WindowLink $win.vote] config -padx $pad -pady $pad
3861 [WindowLink $win.voteframe] config -borderwidth $border
3862 }
3863 }
3864 }
3865
3866
3867 proc InitVotesForAsk {} {
3868 global VotesForAsk AskWindows
3869 set VotesForAsk {}
3870 foreach win $AskWindows {
3871 [WindowLink $win.vote] config -relief raised
3872 }
3873 sim PendingTool -1
3874 UpdateVotesForAsk
3875 }
3876
3877
3878 proc UpdateVotesForAsk {} {
3879 global AskWindows
3880 UpdateVotesFor Ask $AskWindows
3881 }
3882
3883
3884 ########################################################################
3885 # Player Window Handlers
3886
3887 proc ShowPlayerOf {head} {
3888 set win [WindowLink $head.player]
3889 if {$win == {}} {
3890 set win [MakeWindow.player $head [winfo screen $head]]
3891 }
3892 wm deiconify $win
3893 wm raise $win
3894 return $win
3895 }
3896
3897
3898 proc ShowPlayers {} {
3899 global HeadWindows
3900 foreach win $HeadWindows {
3901 ShowPlayerOf $win
3902 }
3903 }
3904
3905
3906 proc WithdrawPlayers {} {
3907 global PlayerWindows
3908 foreach win $PlayerWindows {
3909 wm withdraw $win
3910 }
3911 }
3912
3913
3914 proc UpdatePlayers {} {
3915 # TODO: Disabled for new scenario window.
3916 return
3917
3918 global HeadWindows PlayerWindows
3919
3920 set players ""
3921 foreach win $HeadWindows {
3922 set server [winfo screen $win]
3923 # if {[string first : $server] == 0} {
3924 # set server "[exec hostname]:0"
3925 # }
3926 lappend players $server
3927 }
3928
3929 sim Players [llength $players]
3930
3931 foreach win $PlayerWindows {
3932 set list [WindowLink $win.players]
3933 $list delete 0 end
3934 eval "$list insert 0 $players"
3935 }
3936
3937 UpdateVotesForUseThisMap
3938 UpdateVotesForAsk
3939 UpdateVotesForBudget
3940 UpdateTaxRateSliders
3941 }
3942
3943
3944 proc UIShowPlayer {win} {
3945 ShowPlayerOf $win
3946 }
3947
3948
3949 proc DoNewPlayer {win} {
3950 set field [WindowLink $win.display]
3951 set dpy [$field get]
3952 if {"$dpy" != ""} {
3953 $field delete 0 end
3954 sim Flush
3955 update idletasks
3956 if {[AddPlayer $dpy] != ""} {
3957 wm withdraw $win
3958 }
3959 }
3960 }
3961
3962 ########################################################################
3963 # Notice Window Handlers
3964
3965
3966 proc ShowNoticeOf {head} {
3967 set win [WindowLink $head.notice]
3968 if {$win == {}} {
3969 set win [MakeWindow.notice $head [winfo screen $head]]
3970 }
3971 global NoticePanelWidth NoticePanelHeight
3972 #place configure $win -x 0 -y 0 -width $NoticePanelWidth -height $NoticePanelHeight
3973 pack append [WindowLink $head.w3] \
3974 $win {bottom frame sw expand fill}
3975 return $win
3976 }
3977
3978
3979 proc ShowNotices {} {
3980 global HeadWindows
3981 foreach win $HeadWindows {
3982 ShowNoticeOf $win
3983 }
3984 }
3985
3986
3987 proc WithdrawNotices {} {
3988 global NoticeWindows
3989 foreach win $NoticeWindows {
3990 #place forget $win
3991 pack unpack $win
3992 }
3993 }
3994
3995
3996 proc ReShowPictureOn {{head ""}} {
3997 global ShowingPicture ShowingParms
3998 UIShowPictureOn $head $ShowingPicture $ShowingParms
3999 }
4000
4001
4002 proc UIShowPicture {id {parms ""}} {
4003 UIShowPictureOn "" $id $parms
4004 }
4005
4006
4007 proc UIShowPictureOn {where id {parms ""}} {
4008 global DoNotices Messages ShowingPicture ShowingParms
4009 if {$DoNotices == 0} {
4010 return
4011 }
4012
4013 set ShowingPicture $id
4014 set ShowingParms $parms
4015 set msg $Messages($id)
4016 set color [lindex $msg 0]
4017 set title [lindex $msg 1]
4018 set body [lindex $msg 2]
4019 if {$parms != ""} {
4020 set cmd "format {$body} $parms"
4021 set body [uplevel #0 $cmd]
4022 }
4023 set props [lindex $msg 3]
4024 if {"$where" == ""} {
4025 global HeadWindows
4026 set where $HeadWindows
4027 }
4028 foreach head $where {
4029 NoticeMessageOn $head "$title" $color "$body" Medium $props
4030 }
4031 }
4032
4033
4034 proc NoticeMessageOn {head title color text font props} {
4035 ShowNoticeOf $head
4036 set win [WindowLink $head.notice]
4037
4038 set t [WindowLink $win.title]
4039 $t configure -text $title -background $color
4040
4041 set t [WindowLink $win.text]
4042 $t configure -state normal -font [Font $head $font]
4043 $t delete 0.0 end
4044 $t insert end "${text}\n"
4045 $t configure -state disabled
4046
4047 set left ""
4048 catch {set left [keylget props left]}
4049 set l [WindowLink $win.left]
4050 if {$left != ""} {
4051 $l config -bitmap $left
4052 place $l -in $t -anchor sw -relx .05 -rely .95
4053 } else {
4054 place forget $l
4055 }
4056