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