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