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