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