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