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