]> git.zerfleddert.de Git - micropolis/blame_incremental - res/micropolis.tcl
show description (including time limit) when hovering over a scenario
[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 global Messages
3314
3315 set type [lindex $data 0]
3316 set id [lindex $data 1]
3317 set over [WindowLink $win.$id.over]
3318 set enabled [WindowLink $win.$id.enabled]
3319 set checked [WindowLink $win.$id.checked]
3320 #echo "WIN $win TYPE $type ID $id OVER $over ENABLED $enabled CHECKED $checked"
3321 if {$over} {
3322 if {[lindex ${data} 2] == "DoPickScenario"} {
3323 catch {text $win.desc \
3324 -borderwidth 2 \
3325 -relief flat \
3326 -wrap word \
3327 -state normal \
3328 -font [Font $win Large]}
3329
3330 $win.desc configure -state normal
3331 $win.desc delete 0.0 end
3332 $win.desc insert end "[lindex $Messages([lindex ${data} 3]) 1]\n\n[lindex $Messages([lindex ${data} 3]) 2]"
3333 $win.desc configure -state disabled
3334
3335 place $win.desc -x 232 -y 170 -width 280 -height 285
3336 }
3337 } else {
3338 catch {destroy $win.desc}
3339 }
3340 if {$enabled} {
3341 if {$checked} {
3342 if {$over} {
3343 set bm [lindex $data 13]
3344 } else {
3345 set bm [lindex $data 12]
3346 }
3347 } else {
3348 if {$over} {
3349 set bm [lindex $data 10]
3350 } else {
3351 set bm [lindex $data 9]
3352 }
3353 }
3354 } else {
3355 set bm [lindex $data 11]
3356 }
3357
3358 [WindowLink $win.canvas] itemconfig $id -bitmap $bm
3359}
3360
3361
3362proc DoEnterCityName {win} {
3363}
3364
3365
3366proc InitVotesForUseThisMap {} {
3367 # TODO: Disabled for new scenario window.
3368 return
3369
3370 global VotesForUseThisMap ScenarioWindows
3371 set VotesForUseThisMap {}
3372 foreach win $ScenarioWindows {
3373 [WindowLink $win.vote] config -relief raised
3374 }
3375 UpdateVotesForUseThisMap
3376}
3377
3378
3379proc UpdateVotesForUseThisMap {} {
3380 global ScenarioWindows
3381 UpdateVotesFor UseThisMap $ScenarioWindows
3382}
3383
3384
3385proc UIUseThisMap {} {
3386 global CityName GameLevel Scenario
3387 WithdrawAll
3388 # special handling for scenarios?
3389 if {$GameLevel != -1} {
3390 sim GameLevel $GameLevel
3391 }
3392 sim CityName $CityName
3393 UINewGame
3394 UIPlayGame
3395 if {$Scenario != -1} {
3396 UIShowPicture $Scenario
3397 }
3398}
3399
3400
3401proc HandleScenarioDown {win x y} {
3402 #echo HandleScenarioDown $win $x $y
3403 HandleScenarioMove $win $x $y
3404 set w [WindowLink $win.w]
3405 set target [WindowLink $w.scenarioTarget]
3406 LinkWindow $w.scenarioTargetDown $target
3407}
3408
3409
3410proc HandleScenarioUp {win x y} {
3411 #echo HandleScenarioUp $win $x $y
3412 HandleScenarioMove $win $x $y
3413 global ScenarioButtons
3414 set w [WindowLink $win.w]
3415 set target [WindowLink $w.scenarioTarget]
3416 set targetDown [WindowLink $w.scenarioTargetDown]
3417 if {($target != -1) &&
3418 ($target == $targetDown)} {
3419 set data [lindex $ScenarioButtons $target]
3420 set type [lindex $data 0]
3421 set id [lindex $data 1]
3422 set callback [lindex $data 2]
3423 set param [lindex $data 3]
3424 set var [lindex $data 4]
3425 set xx [lindex $data 5]
3426 set yy [lindex $data 6]
3427 set ww [lindex $data 7]
3428 set hh [lindex $data 8]
3429 set normal [lindex $data 9]
3430 set over [lindex $data 10]
3431 set disabled [lindex $data 11]
3432 if {$type == "button"} {
3433 #echo callback $callback w $w param $param
3434 eval "$callback $w {$param}"
3435 } else {
3436 if {$type == "checkbox"} {
3437 #echo checkbox callback $callback w $w param $param
3438 eval "$callback $w {$param}"
3439 }
3440 }
3441 }
3442}
3443
3444
3445proc HandleScenarioMove {win x y} {
3446 #echo HandleScenarioMove $win $x $y
3447 global ScenarioButtons
3448 set w [WindowLink $win.w]
3449 set target [WindowLink $w.scenarioTarget]
3450 set found -1
3451 set i 0
3452 set len [llength $ScenarioButtons]
3453 while {$i < $len} {
3454 set data [lindex $ScenarioButtons $i]
3455 set type [lindex $data 0]
3456 set id [lindex $data 1]
3457 set callback [lindex $data 2]
3458 set param [lindex $data 3]
3459 set var [lindex $data 4]
3460 set xx [lindex $data 5]
3461 set yy [lindex $data 6]
3462 set ww [lindex $data 7]
3463 set hh [lindex $data 8]
3464
3465 set enabled [WindowLink $w.$id.enabled]
3466 set checked [WindowLink $w.$id.checked]
3467
3468 #echo "ID $id ENABLED $enabled CHECKED $checked w $w id $id"
3469
3470 if {($enabled != 0) &&
3471 ($x >= $xx) &&
3472 ($x < ($xx + $ww)) &
3473 ($y >= $yy) &&
3474 ($y < ($yy + $hh))} {
3475 set found $i
3476 break
3477 }
3478
3479 set i [expr "$i + 1"]
3480 }
3481
3482 if {$found != $target} {
3483
3484 if {$found == -1} {
3485 if {$target != -1} {
3486
3487 #echo OUT $w $found $xx $yy $normal
3488 LinkWindow $w.scenarioTarget -1
3489
3490 set targetdata [lindex $ScenarioButtons $target]
3491 set targetid [lindex $targetdata 1]
3492 LinkWindow $w.$targetid.over 0
3493 UpdateScenarioButton $w $targetdata
3494
3495 }
3496 } else {
3497
3498 #echo IN $w $found $xx $yy $over
3499 LinkWindow $w.scenarioTarget $found
3500 LinkWindow $w.$id.over 1
3501
3502 if {$target != -1} {
3503 set targetdata [lindex $ScenarioButtons $target]
3504 set targetid [lindex $targetdata 1]
3505 LinkWindow $w.$targetid.over 0
3506 UpdateScenarioButton $w $targetdata
3507 }
3508
3509 UpdateScenarioButton $w $data
3510
3511 }
3512 }
3513}
3514
3515proc DoLoad {win param} {
3516 #echo DOLOAD $win $param
3517 UILoadCity $win
3518}
3519
3520
3521proc DoGenerate {win param} {
3522 #echo DOGENERATE $win $param
3523 UIGenerateNewCity
3524}
3525
3526
3527proc DoQuit {win param} {
3528 #echo DOQUIT $win $param
3529 UIQuit $win
3530}
3531
3532
3533proc DoAbout {win param} {
3534 #echo DOABOUT $win $param
3535 MakeHistory "DoLoadCity cities/about.cty"
3536}
3537
3538
3539proc DoMap {win param} {
3540 #echo DOMAP $win $param
3541}
3542
3543
3544proc DoLevel {win param} {
3545 #echo DOLEVEL $win $param
3546 DoSetGameLevel $param
3547}
3548
3549
3550proc DoLeft {win param} {
3551 #echo DOLEFT $win $param
3552 PrevHistory
3553}
3554
3555
3556proc DoRight {win param} {
3557 #echo DORIGHT $win $param
3558 NextHistory
3559}
3560
3561
3562proc DoPlay {win param} {
3563 #echo DOPLAY $win $param
3564 UIUseThisMap
3565}
3566
3567
3568proc DoPickScenario {win param} {
3569 #echo DOPICKSCENARIO $win $param
3570 UILoadScenario $param
3571}
3572
3573proc DeleteScenarioWindow {win} {
3574 UIQuit $win
3575}
3576
3577
3578########################################################################
3579# Undo/Redo Facility
3580
3581
3582proc InitHistory {} {
3583 global MapHistory
3584 global MapHistoryNum
3585 set MapHistory {}
3586 set MapHistoryNum -1
3587}
3588
3589
3590proc MakeHistory {cmd} {
3591 global MapHistory
3592 set len [llength $MapHistory]
3593 if {($len == 0) ||
3594 ($cmd != [lindex $MapHistory [expr $len-1]])} {
3595 lappend MapHistory $cmd
3596 } else {
3597 incr len -1
3598 }
3599 GotoHistory $len
3600}
3601
3602
3603proc GotoHistory {i} {
3604 global MapHistory
3605 global MapHistoryNum
3606 InitVotesForUseThisMap
3607 if {$i != $MapHistoryNum} {
3608 set MapHistoryNum $i
3609 set cmd [lindex $MapHistory $i]
3610 eval $cmd
3611 }
3612 if {$MapHistoryNum == 0} {
3613 set prev disabled
3614 } else {
3615 set prev normal
3616 }
3617 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3618 set next disabled
3619 } else {
3620 set next normal
3621 }
3622
3623 global ScenarioWindows
3624 foreach win $ScenarioWindows {
3625 UpdateLeftRightEnabled $win
3626 }
3627
3628}
3629
3630
3631proc NextHistory {} {
3632 global MapHistory
3633 global MapHistoryNum
3634 set len [llength $MapHistory]
3635 set i [expr "$MapHistoryNum + 1"]
3636 if {$i < $len} {
3637 GotoHistory $i
3638 }
3639}
3640
3641
3642proc PrevHistory {} {
3643 global MapHistory
3644 global MapHistoryNum
3645 set i [expr "$MapHistoryNum - 1"]
3646 if {$i >= 0} {
3647 GotoHistory $i
3648 }
3649}
3650
3651
3652########################################################################
3653# Ask Window Handlers
3654
3655proc ShowAskOf {head} {
3656 set win [WindowLink $head.ask]
3657 if {$win == {}} {
3658 set win [MakeWindow.ask $head [winfo screen $head]]
3659 }
3660 wm deiconify $win
3661 wm raise $win
3662 return $win
3663}
3664
3665
3666proc ShowAsks {} {
3667 global HeadWindows
3668 foreach win $HeadWindows {
3669 ShowAskOf $win
3670 }
3671}
3672
3673
3674proc WithdrawAsks {} {
3675 global AskWindows
3676 foreach win $AskWindows {
3677 wm withdraw $win
3678 }
3679}
3680
3681
3682proc WithdrawAskOf {win} {
3683 set ask [WindowLink $win.ask]
3684 if {"$ask" != ""} {
3685 wm withdraw $ask
3686 }
3687}
3688
3689
3690proc AskQuestion {color title text left middle right} {
3691 global HeadWindows
3692 foreach win $HeadWindows {
3693 AskQuestionOn $win $color $title $text $left $middle $right
3694 }
3695}
3696
3697
3698proc AskQuestionOn {head color title text left middle right} {
3699 ShowAskOf $head
3700
3701 set win [WindowLink $head.ask]
3702 set t [WindowLink $win.title]
3703 $t configure -text $title
3704 $t configure -background $color
3705
3706 set t [WindowLink $win.text]
3707 $t configure -state normal
3708 $t delete 0.0 end
3709 $t insert end "${text}\n"
3710 $t configure -state disabled
3711
3712 set bf [WindowLink $win.frame]
3713 set l [WindowLink $win.left]
3714 set m [WindowLink $win.middle]
3715 set r [WindowLink $win.vote]
3716 set rf [WindowLink $win.voteframe]
3717
3718 if {$left != ""} {
3719 $l config \
3720 -text [lindex $left 0] \
3721 -command [format [lindex $left 2] $head]
3722 SetHelp $l [lindex $left 1]
3723 pack append $bf $l {left frame center}
3724 } else {
3725 pack unpack $l
3726 }
3727
3728 if {$middle != ""} {
3729 $m config \
3730 -text [lindex $middle 0] \
3731 -command [format [lindex $middle 2] $head]
3732 SetHelp $m [lindex $middle 1]
3733 pack append $bf $m {left frame center expand}
3734 } else {
3735 pack unpack $m
3736 }
3737
3738 if {$right != ""} {
3739 set notify [format [lindex $right 2] $head]
3740 set preview [format [lindex $right 3] $head]
3741 set cmd [list DoVote $win Ask $notify $preview]
3742 $r config \
3743 -text [lindex $right 0] \
3744 -command $cmd
3745 SetHelp $r [lindex $right 1]
3746 pack append $bf $rf {right frame center}
3747 } else {
3748 pack unpack $rf
3749 }
3750
3751 InitVotesForAsk
3752}
3753
3754
3755proc BindVotingButton {win but name} {
3756 set w [WindowLink $win.top]
3757
3758 bind $but <Any-Enter> "VoteButtonEnter $win $but"
3759 bind $but <Any-Leave> "VoteButtonLeave $win $but"
3760 bind $but <1> "VoteButtonDown $win $but $name"
3761 bind $but <ButtonRelease-1> "VoteButtonUp $win $but $name"
3762 bind $but <2> "VoteButtonDown $win $but $name"
3763 bind $but <ButtonRelease-2> "VoteButtonUp $win $but $name"
3764 bind $but <3> "VoteButtonDown $win $but $name"
3765 bind $but <ButtonRelease-3> "VoteButtonUp $win $but $name"
3766}
3767
3768
3769proc VoteButtonEnter {win but} {
3770 global tk_priv
3771 set screen [winfo screen $but]
3772 if {[lindex [$but config -state] 4] != "disabled"} {
3773 $but config -state active
3774 set tk_priv(window@$screen) $but
3775 } else {
3776 set tk_priv(window@$screen) ""
3777 }
3778}
3779
3780
3781proc VoteButtonLeave {win but} {
3782 global tk_priv
3783 if {[lindex [$but config -state] 4] != "disabled"} {
3784 $but config -state normal
3785 }
3786 set screen [winfo screen $but]
3787 set tk_priv(window@$screen) ""
3788}
3789
3790
3791proc VoteButtonDown {win but name} {
3792 global tk_priv
3793 set screen [winfo screen $but]
3794 set rel [lindex [$but config -relief] 4]
3795 set tk_priv(relief@$screen) $rel
3796 if {[lindex [$but config -state] 4] != "disabled"} {
3797 set head [WindowLink $win.head]
3798 if {[IsVotingFor $head $name]} {
3799 $but config -relief raised
3800 } else {
3801 $but config -relief sunken
3802 }
3803 }
3804}
3805
3806
3807proc VoteButtonUp {win but name} {
3808 global tk_priv
3809 set screen [winfo screen $but]
3810 $but config -relief $tk_priv(relief@$screen)
3811 if {($but == $tk_priv(window@$screen))
3812 && ([lindex [$but config -state] 4] != "disabled")} {
3813 uplevel #0 [list $but invoke]
3814 set head [WindowLink $win.head]
3815 if {[IsVotingFor $head $name]} {
3816 $but config -relief sunken
3817 } else {
3818 $but config -relief raised
3819 }
3820 }
3821}
3822
3823
3824proc PressVoteButton {win but name} {
3825 global tk_priv
3826 uplevel #0 [list $but invoke]
3827 set head [WindowLink $win.head]
3828 if {[IsVotingFor $head $name]} {
3829 $but config -relief sunken
3830 } else {
3831 $but config -relief raised
3832 }
3833}
3834
3835
3836proc IsVotingFor {win name} {
3837 global VotesFor$name
3838 set votes [eval ident "\$\{VotesFor$name\}"]
3839 if {[lsearch $votes $win] == -1} {
3840 return 0
3841 } else {
3842 return 1
3843 }
3844}
3845
3846
3847proc DoVote {win name notify preview} {
3848 global VotesFor$name
3849 set votes [eval ident "\$\{VotesFor$name\}"]
3850
3851 set win [WindowLink $win.head]
3852 set i [lsearch $votes $win]
3853 if {$i == -1} {
3854 lappend VotesFor$name $win
3855 } else {
3856 set VotesFor$name [lreplace $votes $i $i]
3857 }
3858 UpdateVotesFor$name
3859 set votes [eval ident "\$\{VotesFor$name\}"]
3860 if {[llength $votes] >= [NeededVotes]} {
3861 eval "$notify"
3862 } else {
3863 eval "$preview"
3864 }
3865}
3866
3867
3868proc UpdateVotesFor {name wins} {
3869 global VotesFor$name
3870 set votes [eval llength "\$\{VotesFor$name\}"]
3871 set needed [NeededVotes]
3872
3873 foreach win $wins {
3874 set head [WindowLink $win.head]
3875 if {[IsVotingFor $head $name]} {
3876 set border [expr "($needed - $votes) * 1"]
3877 set pad [expr "6 - $border"]
3878 [WindowLink $win.vote] config -padx $pad -pady $pad
3879 [WindowLink $win.voteframe] config -borderwidth $border
3880 } else {
3881 set border [expr "($needed - $votes - 1) * 1"]
3882 set pad [expr "6 - $border"]
3883 [WindowLink $win.vote] config -padx $pad -pady $pad
3884 [WindowLink $win.voteframe] config -borderwidth $border
3885 }
3886 }
3887}
3888
3889
3890proc InitVotesForAsk {} {
3891 global VotesForAsk AskWindows
3892 set VotesForAsk {}
3893 foreach win $AskWindows {
3894 [WindowLink $win.vote] config -relief raised
3895 }
3896 sim PendingTool -1
3897 UpdateVotesForAsk
3898}
3899
3900
3901proc UpdateVotesForAsk {} {
3902 global AskWindows
3903 UpdateVotesFor Ask $AskWindows
3904}
3905
3906
3907########################################################################
3908# Player Window Handlers
3909
3910proc ShowPlayerOf {head} {
3911 set win [WindowLink $head.player]
3912 if {$win == {}} {
3913 set win [MakeWindow.player $head [winfo screen $head]]
3914 }
3915 wm deiconify $win
3916 wm raise $win
3917 return $win
3918}
3919
3920
3921proc ShowPlayers {} {
3922 global HeadWindows
3923 foreach win $HeadWindows {
3924 ShowPlayerOf $win
3925 }
3926}
3927
3928
3929proc WithdrawPlayers {} {
3930 global PlayerWindows
3931 foreach win $PlayerWindows {
3932 wm withdraw $win
3933 }
3934}
3935
3936
3937proc UpdatePlayers {} {
3938 # TODO: Disabled for new scenario window.
3939 return
3940
3941 global HeadWindows PlayerWindows
3942
3943 set players ""
3944 foreach win $HeadWindows {
3945 set server [winfo screen $win]
3946# if {[string first : $server] == 0} {
3947# set server "[exec hostname]:0"
3948# }
3949 lappend players $server
3950 }
3951
3952 sim Players [llength $players]
3953
3954 foreach win $PlayerWindows {
3955 set list [WindowLink $win.players]
3956 $list delete 0 end
3957 eval "$list insert 0 $players"
3958 }
3959
3960 UpdateVotesForUseThisMap
3961 UpdateVotesForAsk
3962 UpdateVotesForBudget
3963 UpdateTaxRateSliders
3964}
3965
3966
3967proc UIShowPlayer {win} {
3968 ShowPlayerOf $win
3969}
3970
3971
3972proc DoNewPlayer {win} {
3973 set field [WindowLink $win.display]
3974 set dpy [$field get]
3975 if {"$dpy" != ""} {
3976 $field delete 0 end
3977 sim Flush
3978 update idletasks
3979 if {[AddPlayer $dpy] != ""} {
3980 wm withdraw $win
3981 }
3982 }
3983}
3984
3985########################################################################
3986# Notice Window Handlers
3987
3988
3989proc ShowNoticeOf {head} {
3990 set win [WindowLink $head.notice]
3991 if {$win == {}} {
3992 set win [MakeWindow.notice $head [winfo screen $head]]
3993 }
3994 global NoticePanelWidth NoticePanelHeight
3995 #place configure $win -x 0 -y 0 -width $NoticePanelWidth -height $NoticePanelHeight
3996 pack append [WindowLink $head.w3] \
3997 $win {bottom frame sw expand fill}
3998 return $win
3999}
4000
4001
4002proc ShowNotices {} {
4003 global HeadWindows
4004 foreach win $HeadWindows {
4005 ShowNoticeOf $win
4006 }
4007}
4008
4009
4010proc WithdrawNotices {} {
4011 global NoticeWindows
4012 foreach win $NoticeWindows {
4013 #place forget $win
4014 pack unpack $win
4015 }
4016}
4017
4018
4019proc ReShowPictureOn {{head ""}} {
4020 global ShowingPicture ShowingParms
4021 UIShowPictureOn $head $ShowingPicture $ShowingParms
4022}
4023
4024
4025proc UIShowPicture {id {parms ""}} {
4026 UIShowPictureOn "" $id $parms
4027}
4028
4029
4030proc UIShowPictureOn {where id {parms ""}} {
4031 global DoNotices Messages ShowingPicture ShowingParms
4032 if {$DoNotices == 0} {
4033 return
4034 }
4035
4036 set ShowingPicture $id
4037 set ShowingParms $parms
4038 set msg $Messages($id)
4039 set color [lindex $msg 0]
4040 set title [lindex $msg 1]
4041 set body [lindex $msg 2]
4042 if {$parms != ""} {
4043 set cmd "format {$body} $parms"
4044 set body [uplevel #0 $cmd]
4045 }
4046 set props [lindex $msg 3]
4047 if {"$where" == ""} {
4048 global HeadWindows
4049 set where $HeadWindows
4050 }
4051 foreach head $where {
4052 NoticeMessageOn $head "$title" $color "$body" Medium $props
4053 }
4054}
4055
4056
4057proc NoticeMessageOn {head title color text font props} {
4058 ShowNoticeOf $head
4059 set win [WindowLink $head.notice]
4060
4061 set t [WindowLink $win.title]
4062 $t configure -text $title -background $color
4063
4064 set t [WindowLink $win.text]
4065 $t configure -state normal -font [Font $head $font]
4066 $t delete 0.0 end
4067 $t insert end "${text}\n"
4068 $t configure -state disabled
4069
4070 set left ""
4071 catch {set left [keylget props left]}
4072 set l [WindowLink $win.left]
4073 if {$left != ""} {
4074 $l config -bitmap $left
4075 place $l -in $t -anchor sw -relx .05 -rely .95
4076 } else {
4077 place forget $l
4078 }
4079
4080 set middle ""
4081 catch {set middle [keylget props middle]}
4082 set m [WindowLink $win.middle]
4083 if {$middle != ""} {
4084 $m config -bitmap $middle
4085 place $m -in $t -anchor s -relx .5 -rely .95
4086 } else {
4087 place forget $m
4088 }
4089
4090 set right ""
4091 catch {set right [keylget props right]}
4092 set r [WindowLink $win.right]
4093 if {$right != ""} {
4094 $r config -bitmap $right
4095 place $r -in $t -anchor se -relx .95 -rely .95
4096 } else {
4097 place forget $r
4098 }
4099
4100 set view ""
4101 catch {set view [keylget props view]}
4102 set vf [WindowLink $win.viewframe]
4103 global v
4104 set v [WindowLink $win.view]
4105 set bg [WindowLink $win.background]
4106 if {$view != ""} {
4107 uplevel #0 "$view"
4108 pack unpack $t
4109 pack append $bg $vf {left frame center fill}
4110 pack append $bg $t {right frame center fill expand}
4111 } else {
4112 pack unpack $vf
4113 }
4114}
4115
4116
4117proc UIPopUpMessage {msg} {
4118 DoSendMessage $msg
4119}
4120
4121
4122proc ComeToMe {view} {
4123 set win [winfo toplevel $view]
4124
4125 set xy [$view Pan]
4126 set x [expr "[lindex $xy 0] >>4"]
4127 set y [expr "[lindex $xy 1] >>4"]
4128
4129 ComeTo $win $x $y
4130}
4131
4132
4133proc ComeTo {win x y} {
4134 global EditorWindows
4135 set head [WindowLink $win.head]
4136 set myeds {}
4137 set myautoeds {}
4138 foreach ed $EditorWindows {
4139 if {"[WindowLink $ed.head]" == "$head"} {
4140 lappend myeds $ed
4141 set view [WindowLink $ed.view]
4142 if {[$view AutoGoto]} {
4143 lappend myautoeds $ed
4144 }
4145 }
4146 }
4147 if {[llength $myautoeds]} {
4148 UIAutoGotoOn $x $y $myautoeds
4149 } else {
4150 if {[llength $myeds]} {
4151 UIAutoGotoOn $x $y $myeds
4152 }
4153 }
4154}
4155
4156
4157proc FollowView {view id} {
4158 $view Follow $id
4159
4160 set skips 999999
4161 if {[sim DoAnimation]} {
4162 set head [WindowLink [winfo toplevel $view].head]
4163 global EditorWindows
4164 foreach win $EditorWindows {
4165 if {"[WindowLink $win.head]" == "$head"} {
4166 set s [[WindowLink $win.view] Skip]
4167 set skips [min $skips $s]
4168 }
4169 }
4170
4171 if {$skips == 999999} {
4172 set skips 0
4173 }
4174 }
4175
4176 $view Skip $skips
4177 $view Update
4178}
4179
4180
4181proc PanView {view x y} {
4182 FollowView $view ""
4183 $view Pan $x $y
4184}
4185
4186
4187########################################################################
4188# Help Window Handlers
4189
4190
4191proc ShowHelpOf {head} {
4192 set win [WindowLink $head.help]
4193 if {$win == {}} {
4194 set win [MakeWindow.help $head [winfo screen $head]]
4195 }
4196 wm deiconify $win
4197 wm raise $win
4198 return $win
4199}
4200
4201
4202proc ShowHelps {} {
4203 global HeadWindows
4204 foreach win $HeadWindows {
4205 ShowHelpOf $win
4206 }
4207}
4208
4209
4210proc WithdrawHelps {} {
4211 global HelpWindows
4212 foreach win $HelpWindows {
4213 wm withdraw $win
4214 }
4215}
4216
4217
4218########################################################################
4219# Frob Window Handlers
4220
4221
4222proc ShowFrobOf {head} {
4223 set win [WindowLink $head.frob]
4224 if {$win == {}} {
4225 set win [MakeWindow.frob $head [winfo screen $head]]
4226 }
4227 wm deiconify $win
4228 wm raise $win
4229
4230 return $win
4231}
4232
4233
4234proc ShowFrobs {} {
4235 global HeadWindows
4236 foreach win $HeadWindows {
4237 ShowFrobOf $win
4238 }
4239}
4240
4241
4242proc WithdrawFrobs {} {
4243 global FrobWindows
4244 foreach win $FrobWindows {
4245 wm withdraw $win
4246 }
4247}
4248
4249
4250proc UISetDynamic {i min max} {
4251 sim DynamicData [expr "$i*2"] $min
4252 sim DynamicData [expr "$i*2+1"] $max
4253}
4254
4255
4256########################################################################
4257# Help Handler
4258
4259
4260proc LoadHelp {} {
4261 global ResourceDir
4262
4263 source $ResourceDir/help.tcl
4264}
4265
4266proc HandleHelp {win x y rootx rooty} {
4267 global HelpLoaded HelpWidgets Messages
4268
4269 if {$HelpLoaded == 0} {
4270 LoadHelp
4271 set HelpLoaded 1
4272 }
4273
4274 set orig $win
4275 set head [WindowLink [winfo toplevel $win].head]
4276 set id ""
4277 while {1} {
4278 catch {set id $HelpWidgets($win)}
4279 if {$id != ""} {
4280 break
4281 }
4282 set list [split $win .]
4283 set len [expr "[llength $list] - 2"]
4284 set list [lrange $list 0 $len]
4285 if {[llength $list] <= 1} {
4286 set id Window
4287 break
4288 }
4289 set win [join $list .]
4290 }
4291 if [info exists Messages($id)] {
4292 UIShowHelpOn $head $id
4293 } else {
4294 UIShowHelpOn $head Window
4295 }
4296}
4297
4298
4299proc UIShowHelpOn {win id {parms ""}} {
4300 global Messages ShowingPicture ShowingParms ResourceDir
4301 set head [WindowLink $win.head]
4302 set msg $Messages($id)
4303 set color [lindex $msg 0]
4304 set title [lindex $msg 1]
4305 set body [lindex $msg 2]
4306 if {$parms != ""} {
4307 set cmd "format {$body} $parms"
4308 set body [uplevel #0 $cmd]
4309 }
4310 set props [lindex $msg 3]
4311
4312 ShowHelpOf $head
4313 set win [WindowLink $head.help]
4314
4315 set t [WindowLink $win.title]
4316 $t configure -text $title -background $color
4317
4318 set t [WindowLink $win.text]
4319 $t configure -state normal -font [Font $head Large]
4320 $t delete 0.0 end
4321 $t insert end "${body}\n"
4322 FormatHTML $ResourceDir/doc/$id.html $t
4323 $t configure -state disabled
4324}
4325
4326
4327proc FormatHTML {filename text} {
4328 set f ""
4329 catch {
4330 set f [open $filename]
4331 set line ""
4332 set header ""
4333 set title ""
4334 gets $f header
4335 gets $f title
4336
4337 while {[gets $f line] >= 0} {
4338 if {"$line" == "</body>"} {
4339 break
4340 }
4341 if {([string index $line 0] == "#") || ([string length $line] == 0)} {
4342 continue
4343 }
4344 $text insert end "$line\n"
4345 }
4346 }
4347 if {$f != ""} {
4348 close $f
4349 }
4350}
4351
4352
4353proc SetHelp {win id} {
4354 global HelpWidgets
4355 set HelpWidgets($win) $id
4356}
4357
4358
4359proc Help {id title {msg {}} {props {}}} {
4360 Message $id #7f7fff $title $msg $props
4361}
4362
4363########################################################################
4364# Pie Menu Handlers
4365
4366
4367# Set up the bindings to pop up $pie when the right button is clicked in $win
4368proc InitPie {win pie} {
4369 bind $win <Motion> {}
4370 bind $win <3> "PieMenuDown $win $pie $pie Initial %X %Y"
4371 bind $win <B3-Motion> {}
4372 bind $win <B3-ButtonRelease> {}
4373}
4374
4375
4376# Set up the bindings to continue tracking $pie
4377# Get this: we keep the tracking machine state in the bindings!
4378proc ActivatePie {win root pie state} {
4379 bind $win <Motion> "PieMenuMotion $win $root $pie $state %X %Y"
4380 bind $win <3> "PieMenuDown $win $root $pie $state %X %Y"
4381 bind $win <B3-Motion> "PieMenuMotion $win $root $pie $state %X %Y"
4382 bind $win <B3-ButtonRelease> "PieMenuUp $win $root $pie $state %X %Y"
4383}
4384
4385
4386# Cancel and reset a pie menu
4387proc CancelPie {win} {
4388 set binding [bind $win <3>]
4389 set root [lindex $binding 2]
4390 set pie [lindex $binding 3]
4391 set state [lindex $binding 4]
4392 if {"$state" != "Initial"} {
4393 catch {$root ungrab $win}
4394 $pie unpost
4395 $pie activate none
4396 UIMakeSoundOn $win fancy Oop
4397 }
4398 InitPie $win $root
4399}
4400
4401
4402# Handle pie menu button down
4403proc PieMenuDown {win root pie state x y} {
4404 case $state {
4405 Initial {
4406 ActivatePie $win $root $pie FirstDown
4407 update idletasks
4408 catch {$root grab $win}
4409 $pie activate none
4410 $pie post $x $y
4411 PreviewPieMenu $win $pie $x $y
4412 update idletasks
4413 }
4414 ClickedUp {
4415 TrackPieMenu $pie $x $y
4416 ActivatePie $win $root $pie SecondDown
4417 }
4418 SelectedUp {
4419 $pie activate none
4420 #$pie post $x $y
4421 $pie defer
4422 PreviewPieMenu $win $pie $x $y
4423 ActivatePie $win $root $pie SecondDown
4424 }
4425 FirstDown { # error
4426 CancelPie $win
4427 }
4428 SecondDown { # error
4429 CancelPie $win
4430 }
4431 }
4432}
4433
4434
4435# Handle pie menu button motion
4436proc PieMenuMotion {win root pie state x y} {
4437 case $state {
4438 FirstDown {
4439 TrackPieMenu $pie $x $y
4440 $pie defer
4441 }
4442 ClickedUp {
4443 $pie activate none
4444 #$pie post $x $y
4445 }
4446 SecondDown {
4447 TrackPieMenu $pie $x $y
4448 $pie defer
4449 }
4450 SelectedUp {
4451 $pie activate none
4452 #$pie post $x $y
4453 }
4454 Initial { # error
4455 CancelPie $win
4456 }
4457 }
4458}
4459
4460
4461# Handle pie menu button up
4462proc PieMenuUp {win root pie state x y} {
4463 case $state {
4464 FirstDown {
4465 TrackPieMenu $pie $x $y
4466 set active [$pie index active]
4467 if {$active == "none"} {
4468 $pie show
4469 catch {$root grab $win}
4470 ActivatePie $win $root $pie ClickedUp
4471 } else {
4472 set label [lindex [$pie entryconfig $active -label] 4]
4473 set submenu [lindex [$pie entryconfig $active -piemenu] 4]
4474 UIMakeSoundOn $win mode $label
4475 if {$submenu == {}} {
4476 set reward [$pie pending]
4477 catch {$root ungrab $win}
4478 $pie unpost
4479 $pie activate none
4480 if {$reward} {
4481 sim Funds [expr "[sim Funds] + 5"]
4482 UIMakeSoundOn $win fancy Aaah
4483 }
4484 eval [lindex [$pie entryconfig $active -command] 4]
4485 InitPie $win $root
4486 } else {
4487 $pie unpost
4488 $pie activate none
4489 $submenu activate none
4490 $submenu post $x $y
4491 PreviewPieMenu $win $submenu $x $y
4492 catch {$root grab $win}
4493 ActivatePie $win $root $submenu SelectedUp
4494 }
4495 }
4496 }
4497 SecondDown {
4498 TrackPieMenu $pie $x $y
4499 set active [$pie index active]
4500 if {$active == "none"} {
4501 CancelPie $win
4502 } else {
4503 set label [lindex [$pie entryconfig $active -label] 4]
4504 set submenu [lindex [$pie entryconfig $active -piemenu] 4]
4505 UIMakeSoundOn $win mode $label
4506 if {$submenu == {}} {
4507 set reward [$pie pending]
4508 catch {$root ungrab $win}
4509 $pie unpost
4510 $pie activate none
4511 if {$reward} {
4512 sim Funds [expr "[sim Funds] + 5"]
4513 UIMakeSoundOn $win fancy Aaah
4514 }
4515 eval [lindex [$pie entryconfig $active -command] 4]
4516 InitPie $win $root
4517 } else {
4518 $pie unpost
4519 $pie activate none
4520 $submenu activate none
4521 $submenu post $x $y
4522 PreviewPieMenu $win $submenu $x $y
4523 catch {$root grab $win}
4524 ActivatePie $win $root $submenu SelectedUp
4525 }
4526 }
4527 }
4528 Initial { # error
4529 CancelPie $win
4530 }
4531 ClickedUp { # error
4532 CancelPie $win
4533 }
4534 SelectedUp { # error
4535 CancelPie $win
4536 }
4537 }
4538}
4539
4540
4541# Track the selected item
4542proc TrackPieMenu {pie x y} {
4543 $pie activate @$x,$y
4544}
4545
4546
4547proc PreviewPieMenu {win pie x y} {
4548 set preview [lindex [$pie config -preview] 4]
4549 if {"$preview" != ""} {
4550 set rx [winfo rootx $win]
4551 set ry [winfo rooty $win]
4552 set x [expr "$x - $rx"]
4553 set y [expr "$y - $ry"]
4554 eval [format $preview $x $y]
4555 }
4556}
4557
4558
4559########################################################################
4560# Pallet Handlers
4561
4562
4563proc ExclusivePallet {state parent children prefix images inactive active cmd} {
4564 #echo "ExclusivePallet state $state parent $parent children $children prefix $prefix images $images inactive $inactive active $active cmd $cmd"
4565 set i 0
4566 foreach child $children {
4567 set name [lindex $images $i]
4568 if {$i == $state} then {
4569 $parent.$child config \
4570 -bitmap "@images/${prefix}${name}hi.xpm" \
4571 -relief $active
4572 } else {
4573 $parent.$child config \
4574 -bitmap "@images/${prefix}${name}.xpm" \
4575 -relief $inactive
4576 }
4577 incr i
4578 }
4579 eval [concat $cmd $state]
4580}
4581
4582
4583proc NonExclusivePallet {mask parent children prefix images
4584 inactive active cmd} {
4585 set i 0
4586 foreach child $children {
4587 set name [lindex $images $i]
4588 if {$mask & (1<<$i)} then {
4589 $parent.$child config \
4590 -bitmap "@images/${prefix}${name}hi.xpm" \
4591 -relief $active
4592 } else {
4593 $parent.$child config \
4594 -bitmap "@images/${prefix}${name}.xpm" \
4595 -relief $inactive
4596 }
4597 incr i
4598 }
4599 eval [concat $cmd $mask]
4600}
4601
4602
4603proc EditorPallet {win state} {
4604 global EditorPalletSounds
4605 UIMakeSoundOn $win mode [lindex $EditorPalletSounds $state]
4606 EditorSetTool $win $state
4607}
4608
4609
4610proc EditorSetTool {win state} {
4611 global EditorPallets
4612 global EditorPalletImages
4613 ExclusivePallet $state $win $EditorPallets ic $EditorPalletImages \
4614 flat raised "$win.centerframe.view ToolState"
4615}
4616
4617
4618proc GraphPallet {win state} {
4619 set mask [[WindowLink $win.graphview] Mask]
4620 set mask [expr "$mask ^ (1<<$state)"]
4621 GraphPalletMask $win $mask
4622}
4623
4624
4625proc GraphPalletMask {win mask} {
4626 global GraphPallets
4627 global GraphPalletImages
4628 NonExclusivePallet $mask $win $GraphPallets gr $GraphPalletImages \
4629 flat flat "SetGraphState $win"
4630}
4631
4632
4633proc GraphYearPallet {win state} {
4634 global GraphYearPallets
4635 global GraphYearPalletImages
4636 ExclusivePallet $state $win $GraphYearPallets gr $GraphYearPalletImages \
4637 flat flat "SetGraphYearState $win"
4638}
4639
4640
4641proc SetGraphYearState {win state} {
4642 set graph [WindowLink $win.graphview]
4643 if {$state == 0} {
4644 $graph Range 10
4645 } else {
4646 $graph Range 120
4647 }
4648}
4649
4650
4651proc SetGraphState {win mask} {
4652 global GraphPallets
4653 set graph [WindowLink $win.graphview]
4654 $graph Mask $mask
4655}
4656
4657
4658########################################################################
4659# Button Handlers
4660
4661proc sim_butEnter {w} {
4662 global tk_priv
4663 set screen [winfo screen $w]
4664 set tk_priv(window@$screen) $w
4665}
4666
4667
4668proc sim_butLeave {w} {
4669 global tk_priv
4670 set screen [winfo screen $w]
4671 set tk_priv(window@$screen) ""
4672}
4673
4674
4675proc sim_butDown {w} {
4676 global tk_priv
4677 set screen [winfo screen $w]
4678 set pict [lindex [$w config -bitmap] 4]
4679 set tk_priv(relief@$screen) $pict
4680 $w config -bitmap [lindex [split $pict .] 0]hi.xpm
4681 update idletasks
4682}
4683
4684
4685proc sim_butUp {w} {
4686 global tk_priv
4687 set screen [winfo screen $w]
4688 $w config -bitmap $tk_priv(relief@$screen)
4689 update idletasks
4690 if {$w == $tk_priv(window@$screen)} {
4691 uplevel #0 [list $w invoke]
4692 }
4693}
4694
4695
4696proc BindSimButton {w} {
4697 bind $w <Any-Enter> {sim_butEnter %W}
4698 bind $w <Any-Leave> {sim_butLeave %W}
4699 bind $w <1> {sim_butDown %W}
4700 bind $w <ButtonRelease-1> {sim_butUp %W}
4701 bind $w <2> {sim_butDown %W}
4702 bind $w <ButtonRelease-2> {sim_butUp %W}
4703 bind $w <3> {sim_butDown %W}
4704 bind $w <ButtonRelease-3> {sim_butUp %W}
4705}
4706
4707
4708########################################################################
4709# Internal Callbacks
4710
4711
4712proc UIStartMicropolis {homedir resourcedir hostname} {
4713 global HomeDir ResourceDir HostName HeadWindows
4714 set HomeDir $homedir
4715 set ResourceDir $resourcedir
4716 set HostName $hostname
4717 sim InitGame
4718 sim GameStarted
4719 update
4720
4721 foreach display [sim Displays] {
4722 if {"[AddPlayer $display]" == ""} {
4723 echo Couldn't add a player on $display ...
4724 }
4725 }
4726
4727 if {"$HeadWindows" == ""} {
4728 echo Micropolis is exiting because it couldn't connect to any players.
4729 sim ReallyQuit
4730 }
4731}
4732
4733
4734proc UISelectCity {win} {
4735 AskQuestion [Color $win #ff0000 #ffffff] "Choose Another City" \
4736 "Do you want to abandon this city and choose another one?" \
4737 "{Keep playing.} SelectCity.No {RejectPlan}" \
4738 "" \
4739 "{Another city!} SelectCity.Yes {UIPickScenarioMode}"
4740}
4741
4742
4743proc UIQuit {head} {
4744 if {[sim Players] == 1} {
4745 set l "{Keep playing.} Quit.No {RejectPlan}"
4746 set m ""
4747 set r "{I quit!} Quit.IQuit {DoReallyQuit %s}"
4748 } else {
4749 set l "{Keep playing.} Quit.No {RejectPlan}"
4750 set m "{I quit!} Quit.IResign {DoIResign %s}"
4751 set r "{Everyone quit!} Quit.AllQuit {DoReallyQuit %s}"
4752 }
4753 AskQuestion [Color $head #ff0000 #ffffff] "Quit Playing Micropolis" \
4754 "Do you want to quit playing Micropolis?" \
4755 $l $m $r
4756}
4757
4758
4759proc DoIResign {head} {
4760 global VotesForAsk
4761 set display [winfo screen $head]
4762 CrushHead $head
4763 DecRefDisplay $display
4764 UISetMessage "The player on X11 Display $display has resigned."
4765 UpdatePlayers
4766 if {([sim Players] == 0) ||
4767 ([llength $VotesForAsk] >= [sim Players])} {
4768 sim ReallyQuit
4769 }
4770}
4771
4772
4773proc DoReallyQuit {head} {
4774 echo QuitMicropolis
4775 sim ReallyQuit
4776}
4777
4778
4779proc UISplashMode {} {
4780 global State
4781 set State splash
4782 sim Pause
4783 WithdrawAll
4784 InitSplashes
4785 ShowSplashes
4786}
4787
4788
4789proc UIPickScenarioMode {} {
4790 global State
4791 global CityLibDir
4792 set State scenario
4793 sim Pause
4794 WithdrawAll
4795 InitHistory
4796 UIGenerateCityNow
4797 InitScenarios
4798 InitVotesForUseThisMap
4799 ShowScenarios
4800}
4801
4802
4803proc ForcePickScenarioMode {} {
4804 global State
4805 if {"$State" != "scenario"} {
4806 UIPickScenarioMode
4807 }
4808}
4809
4810
4811proc UIGenerateCityNow {} {
4812 global CityName GameLevel
4813 sim CityName NowHere
4814 sim GameLevel 0
4815 UIGenerateNewCity
4816}
4817
4818
4819proc UIGenerateNewCity {} {
4820 global CityName GameLevel
4821 if {$GameLevel == -1} {
4822 set GameLevel 0
4823 }
4824 MakeHistory "DoNewCity NowHere $GameLevel [sim Rand] [sim TreeLevel] [sim LakeLevel] [sim CurveLevel] [sim CreateIsland]"
4825}
4826
4827
4828proc DoNewCity {name level {r ""} {tl -1} {ll -1} {cl -1} {ci -1}} {
4829 global Scenario
4830 set Scenario -1
4831 sim TreeLevel $tl
4832 sim LakeLevel $ll
4833 sim CurveLevel $cl
4834 sim CreateIsland $ci
4835 if {"$r" == ""} {
4836 sim GenerateNewCity
4837 } else {
4838 sim GenerateSomeCity $r
4839 }
4840 sim CityName $name
4841 sim GameLevel $level
4842 UIShowPicture 48
4843}
4844
4845
4846proc UIDidGenerateNewCity {} {
4847 sim Update
4848}
4849
4850
4851proc IncRefDisplay {display} {
4852 global DisplayRegistry
4853 if ![info exists DisplayRegistry($display)] {
4854 set DisplayRegistry($display) 0
4855 }
4856 incr DisplayRegistry($display)
4857}
4858
4859
4860proc DecRefDisplay {display} {
4861 global DisplayRegistry
4862 incr DisplayRegistry($display) -1
4863 if {$DisplayRegistry($display) <= 0} {
4864 CloseDisplay $display
4865 }
4866}
4867
4868
4869proc CloseDisplay {display} {
4870}
4871
4872
4873proc DoStopMicropolis {} {
4874 KillSoundServers
4875 destroy .
4876}
4877
4878
4879proc AddPlayer {display} {
4880 set i [string first : $display]
4881 if {$i == 0} {
4882 } else {
4883 if {$i == -1} {
4884 set display "$display:0"
4885 }
4886 }
4887
4888 echo Adding a player on $display ...
4889
4890 set head [MakeWindow.head $display]
4891
4892 if {"$head" != ""} {
4893 set display [winfo screen $head]
4894 IncRefDisplay $display
4895 PrepHead $head
4896 UISetMessage "Added a player on X11 Display \"$display\"."
4897 UpdatePlayers
4898 } else {
4899 UISetMessage "Couldn't add a player on X11 Display \"$display\"!"
4900 }
4901 return $head
4902}
4903
4904
4905proc FireBomb {} {
4906 sim FireBomb
4907}
4908
4909proc DropFireBombs {} {
4910 FireBomb
4911 after 300 FireBomb
4912 after 600 FireBomb
4913 after 900 FireBomb
4914}
4915
4916
4917proc UIMakeMonster {} {
4918 sim MakeMonster [sim Rand 120] [sim Rand 100]
4919}
4920
4921
4922proc melt {} {
4923 sim HeatSteps 1
4924 sim HeatFlow -7
4925 sim HeatRule 0
4926}
4927
4928
4929proc eco {} {
4930 sim HeatSteps 1
4931 sim HeatFlow 19
4932 sim HeatRule 1
4933}
4934
4935
4936proc oops {} {
4937 sim HeatSteps 0
4938}
4939
4940
4941proc TogglePause {} {
4942 global State Pause
4943
4944 if {"$State" != "play" || [sim Speed]} {
4945 sim Speed 0
4946 set Pause 1
4947 } else {
4948 sim Speed 3
4949 set Pause 0
4950 }
4951 MakeRunningSound
4952}
4953
4954
4955proc SetSpeedTime {time} {
4956 sim Speed $time
4957 MakeRunningSound
4958}
4959
4960
4961proc MakeRunningSound {} {
4962 global State
4963
4964 if {"$State" == "play" && [sim Speed]} {
4965 UIMakeSound edit Boing "-speed 1[sim Speed]0"
4966 } else {
4967 UIMakeSound edit Boing "-speed 90"
4968 }
4969}
4970
4971
4972proc SayDemands {} {
4973 global DemandRes DemandCom DemandInd
4974 set slope 3
4975 set r [expr "100 + ($DemandRes * $slope)"]
4976 set c [expr "100 + ($DemandCom * $slope)"]
4977 set i [expr "100 + ($DemandInd * $slope)"]
4978 after 020 "UIMakeSound edit O \"-speed $r\""
4979 after 220 "UIMakeSound edit A \"-speed $c\""
4980 after 440 "UIMakeSound edit E \"-speed $i\""
4981}
4982
4983
4984proc UISaveCity {win} {
4985 global SaveCityWin
4986 set SaveCityWin $win
4987 sim SaveCity
4988}
4989
4990
4991proc UISaveCityAs {{win ""}} {
4992 global SaveCityWin
4993 if {"$win" == ""} {set win $SaveCityWin}
4994 set SaveCityWin $win
4995
4996 global CityDir
4997 set file [ShowFileOf $win]
4998 DoFileDialog $file "Choose a File to Save the City" $CityDir "*.cty" "" \
4999 "UIDoReallySaveCity" ""
5000}
5001
5002
5003proc UIDoReallySaveCity {name path} {
5004 global CityDir
5005 if {![string match *.cty $name]} {
5006 set name $name.cty
5007 }
5008 set CityDir $path
5009 sim SaveCityAs $path/$name
5010}
5011
5012
5013proc UIDidSaveCity {} {
5014 DoSendMessage "Saved the city in \"[sim CityFileName]\"." status
5015}
5016
5017
5018proc UIDidntSaveCity {msg} {
5019 DoSendMessage $msg alert
5020 UIMakeSound warning Sorry "-speed 85"
5021}
5022
5023
5024proc UILoadScenario {scen} {
5025 MakeHistory "DoScenario $scen"
5026}
5027
5028
5029proc DoScenario {scen} {
5030 global Scenario
5031 set Scenario $scen
5032 sim LoadScenario $scen
5033 UIShowPicture $scen
5034}
5035
5036
5037proc UIDidLoadScenario {} {
5038}
5039
5040
5041proc UIStartScenario {id} {
5042 global Scenario
5043 set Scenario $id
5044 UILoadScenario $id
5045 UIPlayGame
5046 UIShowPicture $id
5047}
5048
5049
5050proc UIPlayNewCity {} {
5051 UIGenerateNewCity
5052 UIPlayGame
5053}
5054
5055
5056proc UIStartLoad {} {
5057 UIPlayGame
5058}
5059
5060
5061proc UIReallyStartGame {} {
5062 #UIPickScenarioMode
5063 UISplashMode
5064}
5065
5066
5067proc UIPlayGame {} {
5068 global State
5069 global Priority
5070 set State play
5071 sim Resume
5072 sim Speed 3
5073 sim AutoGoto 1
5074 SetPriority $Priority
5075 InitHeads
5076 InitAllHeadMenus
5077 ShowInitial
5078 sim NeedRest 10
5079}
5080
5081
5082proc UISetSpeed {speed} {
5083 global Time State
5084 set Time $speed
5085 if {"$State" == "play"} {
5086 UISetMessage [lindex {
5087 {Time pauses.}
5088 {Time flows slow.}
5089 {Time flows medium.}
5090 {Time flows fast.}
5091 } $speed]
5092 }
5093 UIUpdateRunning
5094}
5095
5096
5097proc UIUpdateRunning {} {
5098 global HeadWindows Time State
5099
5100 if {($State == "play") && $Time} {
5101 set pict "@images/micropolisg.xpm"
5102 } else {
5103 set pict "@images/micropoliss.xpm"
5104 }
5105
5106 foreach win $HeadWindows {
5107 set can [WindowLink $win.demand]
5108 $can itemconfig micropolis -bitmap $pict
5109 }
5110}
5111
5112
5113proc DoSetGameLevel {level} {
5114 sim GameLevel $level
5115}
5116
5117
5118proc UISetGameLevel {level} {
5119 global GameLevel
5120 set GameLevel $level
5121 global ScenarioWindows
5122 foreach win $ScenarioWindows {
5123 UpdateLevelSelection $win
5124 }
5125}
5126
5127
5128proc UISetCityName {name} {
5129 global EditorWindows
5130 global CityName
5131 set CityName $name
5132 set title "Micropolis Editor on $name"
5133 foreach win $EditorWindows {
5134 # TODO: set editor window and icon title
5135 #wm title $win "$title"
5136 #wm iconname $win "$title"
5137 }
5138}
5139
5140
5141proc UILoadCity {win} {
5142 # if changed, r-u-sure?
5143 global CityDir
5144 set file [ShowFileOf $win]
5145 DoFileDialog $file "Choose a City to Load" $CityDir "*.cty" "" \
5146 "UIDoLoadCity" ""
5147}
5148
5149
5150proc UIDoLoadCity {name path} {
5151 global CityDir
5152 set CityDir $path
5153 if {![string match *.cty $name]} {
5154 set name $name.cty
5155 }
5156 MakeHistory "DoLoadCity {$path/$name}"
5157}
5158
5159
5160proc DoLoadCity {filename} {
5161 sim LoadCity $filename
5162}
5163
5164proc UIDidLoadCity {} {
5165 global State GameLevel Scenario
5166 set Scenario -1
5167 set GameLevel -1
5168 if {$State == "play"} {
5169 UIPlayGame
5170 } else {
5171 UIShowPicture 49 [sim CityFileName]
5172 }
5173}
5174
5175
5176proc UIDidntLoadCity {msg} {
5177 DoSendMessage $msg alert
5178 UIMakeSound warning Sorry "-speed 85"
5179 UIShowPicture 49 [sim CityFileName]
5180 sim Fill 0
5181 sim UpdateMaps
5182}
5183
5184
5185proc UINewGame {} {
5186 global OldBudget
5187 set OldBudget 0
5188 sim InitGame
5189 sim EraseOverlay
5190 InitEditors
5191 InitMaps
5192 InitGraphs
5193 update
5194 sim UpdateMaps
5195}
5196
5197
5198proc UIDidPan {w x y} {
5199 if {[$w ToolMode] == 1} {
5200 EditorToolDrag $w $x $y
5201 }
5202 update idletasks
5203}
5204
5205
5206proc UIDidStopPan {win} {
5207 UIMakeSoundOn $win fancy Skid "-volume 25"
5208 $win TweakCursor
5209}
5210
5211
5212proc UIEarthQuake {} {
5213}
5214
5215
5216proc UIAutoGoto {x y {except {}}} {
5217 global EditorWindows
5218 set didOne 0
5219 set x [expr "$x * 16 + 8"]
5220 set y [expr "$y * 16 + 8"]
5221 foreach win $EditorWindows {
5222 if {"$win" != "$except"} {
5223 set view [WindowLink $win.view]
5224 if {[$view AutoGoto]} {
5225 set didOne 1
5226 $view AutoGoal $x $y
5227 }
5228 }
5229 }
5230 if {$didOne} {
5231 sim UpdateMaps
5232 }
5233}
5234
5235
5236proc UIAutoGotoOn {x y eds} {
5237 set x [expr "$x * 16 + 8"]
5238 set y [expr "$y * 16 + 8"]
5239 foreach win $eds {
5240 [WindowLink $win.view] AutoGoal $x $y
5241 }
5242 sim UpdateMaps
5243}
5244
5245
5246proc DoLeaveGame {head} {
5247}
5248
5249
5250proc UILoseGame {} {
5251 UIPickScenarioMode
5252 UIShowPicture 200
5253}
5254
5255
5256proc UIWinGame {} {
5257 UIShowPicture 100
5258}
5259
5260
5261proc DoPendTool {view tool x y} {
5262 global HeadWindows ToolInfo VotesForAsk
5263
5264 set win [WindowLink $view.top]
5265 set head [WindowLink $win.head]
5266
5267 if {($tool == [sim PendingTool]) &&
5268 ($x == [sim PendingX]) &&
5269 ($y == [sim PendingY])} {
5270 if {[lsearch $VotesForAsk $head] != -1} {
5271 # you can only vote once
5272 UIMakeSound edit Oop
5273 } else {
5274 UIMakeSound edit Boing
5275 set ask [WindowLink $head.ask]
5276 PressVoteButton $ask [WindowLink $ask.vote] Ask
5277 }
5278 } else {
5279 UIAutoGoto $x $y $win
5280
5281 UIMakeSound edit Boing
5282 set info [lindex $ToolInfo $tool]
5283 set a [lindex $info 0]
5284 set name [lindex $info 1]
5285 set cost [lindex $info 2]
5286 set title "Build $a $name"
5287 set question "Do you support the plan to build $a $name for $cost?"
5288 AskQuestion [Color $win #00ff00 #ffffff] "$title" \
5289 "$question" \
5290 "{Veto plan.} Plan.Veto
5291 {RejectPlan}" \
5292 "{Goto plan.} Plan.Goto
5293 {ComeTo %s $x $y}" \
5294 "{Support plan!} Plan.Support
5295 {SupportPlan $view %s $tool $x $y}
5296 {PreviewSupportPlan $view %s $tool $x $y}"
5297 set VotesForAsk $head
5298 set ask [WindowLink $head.ask]
5299 [WindowLink $ask.vote] config -relief sunken
5300
5301 UpdateVotesForAsk
5302
5303 sim PendingTool $tool
5304 sim PendingX $x
5305 sim PendingY $y
5306 sim Votes [llength $VotesForAsk]
5307 }
5308}
5309
5310
5311proc RejectPlan {} {
5312 sim PendingTool -1
5313 if {[sim Players] > 1} {
5314 UIMakeSound edit Sorry
5315 }
5316 WithdrawAsks
5317}
5318
5319
5320proc NeededVotes {} {
5321 global FreeVotes
5322 set players [sim Players]
5323 set needed [expr "$players - $FreeVotes"]
5324 return [max 0 $needed]
5325}
5326
5327
5328proc SupportPlan {view h tool x y} {
5329 global VotesForAsk
5330 sim Votes [llength $VotesForAsk]
5331 sim PendingTool -1
5332 sim OverRide 1
5333 $view DoTool $tool $x $y
5334 sim OverRide 0
5335 WithdrawAsks
5336 UIMakeSound edit Aaah
5337}
5338
5339
5340proc PreviewSupportPlan {view h tool x y} {
5341 global VotesForAsk
5342 sim Votes [llength $VotesForAsk]
5343}
5344
5345
5346proc SugarStartUp {uri} {
5347 global SugarURI
5348 set SugarURI $uri
5349
5350 # TODO: Load the city file at the given URI, or configure according to URI parameters.
5351}
5352
5353
5354proc SugarNickName {nick} {
5355 global SugarNickName
5356 set SugarNickName $nick
5357}
5358
5359
5360proc SugarActivate {} {
5361 global SugarActivated
5362 set SugarActivated 1
5363}
5364
5365
5366proc SugarDeactivate {} {
5367 global SugarActivated
5368 set SugarActivated 0
5369}
5370
5371
5372proc SugarShare {} {
5373 global SugarShared
5374 set SugarShared 1
5375}
5376
5377
5378proc SugarBuddyAdd {key nick color address} {
5379 global SugarBuddies
5380 set buddy [list $key $nick $color $address]
5381 lappend SugarBuddies $buddy
5382}
5383
5384
5385proc SugarBuddyDel {key nick color address} {
5386 global SugarBuddies
5387 set buddy [list $key $nick $color $address]
5388 set i [lsearch $wins $win]
5389 if {$i != -1} {
5390 set SugarBuddies [lreplace $wins $i $i]
5391 }
5392}
5393
5394
5395proc SugarQuit {} {
5396 sim ReallyQuit
5397}
5398
5399
5400########################################################################
Impressum, Datenschutz