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