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