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