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