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.
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.
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/>.
25 # ADDITIONAL TERMS per GNU GPL Section 7
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.
33 # Any propagation or conveyance of this program must include this
34 # copyright notice and these terms.
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.
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.
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
67 ########################################################################
69 ########################################################################
75 source $tk_library/wish.tcl
78 ########################################################################
80 ########################################################################
84 set State uninitialized
85 set CityName
"Micropolis"
88 set CityLibDir
$SimHome/cities
89 set CityDir
$CityLibDir
93 set BudgetPoliceFund
0
111 set AudioChannels
{mode edit fancy warning intercom
}
114 set BudgetTimerActive
0
116 set EvaluationsVisible
0
117 set SplashScreenDelay
5000
120 set ChatServer
"localhost"
122 set ChatConnection
{}
123 set NickName
"nickname"
124 set UserName
"username"
125 set ServerName
"servername"
126 set RealName
"realname"
127 set ChannelName
"#Micropolis"
131 set LocalHostName
"[exec hostname]"
139 set ShowingPicture
300
143 set VoteNames
{UseThisMap Ask Zone
}
144 set VotesForUseThisMap
{}
147 set VotesForBudget
{}
155 set EvaluationWindows
{}
157 set ScenarioWindows
{}
165 set HeadPanelWidth
360
166 set HeadPanelHeight
200
168 set MapPanelWidth
360
169 set MapPanelHeight
330
171 set NoticePanelWidth
360
172 set NoticePanelHeight
250
174 set SplashPanelWidth
1200
175 set SplashPanelHeight
900
177 set ScenarioPanelWidth
420
178 set ScenarioPanelHeight
440
187 {editor EditorWindows
}
190 {budget BudgetWindows
}
191 {evaluation EvaluationWindows
}
192 {scenario ScenarioWindows
}
193 {splash SplashWindows
}
196 {player PlayerWindows
}
197 {notice NoticeWindows
}
204 # 0 1 2 3 4 5 6 7 8 9 10 11 12 13
205 # type id callback param var x y w h normal over disabled checked checkedover
206 # ----------- --------------- --------------- ------- ------- --- --- --- --- ------- ---- -------- ------- -----------
207 set ScenarioButtons
{
208 { button load DoLoad
"" "" 70 238 157 90 "" @images
/button1hilite.xpm
"" }
209 { button generate DoGenerate
"" "" 62 392 157 90 "" @images
/button2hilite.xpm
"" }
210 { button quit DoQuit
"" "" 68 544 157 90 "" @images
/button3hilite.xpm
"" }
211 { button about DoAbout
"" "" 101 705 157 90 "" @images
/button4hilite.xpm
"" }
212 { checkbox easy DoLevel
0 "" 982 106 190 70 "" @images
/checkbox1hilite.xpm
"" @images
/checkbox1checked.xpm
@images
/checkbox1hilitechecked.xpm
}
213 { checkbox medium DoLevel
1 "" 982 176 190 70 "" @images
/checkbox2hilite.xpm
"" @images
/checkbox2checked.xpm
@images
/checkbox2hilitechecked.xpm
}
214 { checkbox hard DoLevel
2 "" 982 246 190 70 "" @images
/checkbox3hilite.xpm
"" @images
/checkbox3checked.xpm
@images
/checkbox3hilitechecked.xpm
}
215 { button left DoLeft
"" "" 540 375 50 50 "" @images
/lefthilite.xpm
@images
/leftdisabled.xpm
}
216 { button right DoRight
"" "" 841 375 50 50 "" @images
/righthilite.xpm
@images
/rightdisabled.xpm
}
217 { button play DoPlay
"" "" 625 376 180 50 "" @images
/playhilite.xpm
"" }
218 { button scenario1 DoPickScenario
"1" "" 310 451 209 188 "" @images
/scenario1hilite.xpm
"" }
219 { button scenario2 DoPickScenario
"2" "" 519 451 209 188 "" @images
/scenario2hilite.xpm
"" }
220 { button scenario3 DoPickScenario
"3" "" 727 450 209 188 "" @images
/scenario3hilite.xpm
"" }
221 { button scenario4 DoPickScenario
"4" "" 936 450 209 188 "" @images
/scenario4hilite.xpm
"" }
222 { button scenario5 DoPickScenario
"5" "" 310 639 209 188 "" @images
/scenario5hilite.xpm
"" }
223 { button scenario6 DoPickScenario
"8" "" 519 639 209 188 "" @images
/scenario6hilite.xpm
"" }
224 { button scenario7 DoPickScenario
"7" "" 728 638 209 188 "" @images
/scenario7hilite.xpm
"" }
225 { button scenario8 DoPickScenario
"6" "" 937 638 209 188 "" @images
/scenario8hilite.xpm
"" }
228 # Disabled until we handle mouse events on the map itself.
229 # { button map DoMap "" "" 516 30 396 338 "" @images/maphilite.xpm }
232 ########################################################################
238 {-*-dejavu lgc sans-medium-r-normal-
*-90-*}
241 {-*-dejavu lgc sans-medium-r-normal-
*-80-*}
244 {-*-dejavu lgc sans-medium-r-normal-
*-70-*}
247 {-*-dejavu lgc sans-medium-r-normal-
*-60-*}
250 {-*-dejavu lgc sans-medium-r-normal-
*-60-*}
253 {-*-dejavu lgc sans-medium-r-normal-
*-60-*}
256 {-*-dejavu lgc sans-medium-r-normal-
*-70-*}
259 {-*-dejavu lgc sans-medium-r-normal-
*-70-*}
262 {-*-dejavu lgc sans-medium-r-normal-
*-70-*}
267 ########################################################################
271 {Micropolis Overall Map
}
272 {Residential Zone Map
}
273 {Commercial Zone Map
}
274 {Industrial Zone Map
}
277 {Population Density Map
}
279 {Traffic Density Map
}
280 {Pollution Desity Map
}
284 {Police Coverage Map
}
290 leftframe.tools.palletres
291 leftframe.tools.palletcom
292 leftframe.tools.palletind
293 leftframe.tools.palletfire
294 leftframe.tools.palletquery
295 leftframe.tools.palletpolice
296 leftframe.tools.palletwire
297 leftframe.tools.palletbulldozer
298 leftframe.tools.palletrail
299 leftframe.tools.palletroad
300 leftframe.tools.palletchalk
301 leftframe.tools.palleteraser
302 leftframe.tools.palletstadium
303 leftframe.tools.palletpark
304 leftframe.tools.palletseaport
305 leftframe.tools.palletcoal
306 leftframe.tools.palletnuclear
307 leftframe.tools.palletairport
311 set EditorPalletImages
{
312 res com ind fire qry pol
313 wire dozr rail road chlk ersr
314 stad park seap coal nuc airp
318 set EditorPalletSounds
{
319 Res Com Ind Fire Query Police
320 Wire Bulldozer Rail Road Chalk Eraser
321 Stadium Park Seaport Coal Nuclear Airport
329 leftframe.right.money
330 leftframe.right.crime
331 leftframe.right.pollution
335 set GraphPalletImages
{
336 res com ind mony crim poll
340 set GraphYearPallets
{
341 leftframe.year.year10
342 leftframe.year.year120
346 set GraphYearPalletImages
{ 10 120 }
350 { {a
} {Residential Zone
} {$100}}
351 { {a
} {Commercial Zone
} {$100}}
352 { {an
} {Industrial Zone
} {$100}}
353 { {a
} {Fire Station
} {$500}}
354 { {a
} {Query
} {free
}}
355 { {a
} {Police Station
} {$500}}
357 { {a
} {Bulldozer
} {$1}}
360 { {a
} {Chalk
} {free
}}
361 { {an
} {Eraser
} {free
}}
362 { {a
} {Stadium
} {$5,000}}
364 { {a
} {Seaport
} {$3,000}}
365 { {a
} {Coal Power Plant
} {$3,000}}
366 { {a
} {Nuclear Power Plant
} {$5,000}}
367 { {an
} {Airport
} {$10,000}}
368 { {a
} {Network
} {$1,000}}
372 set DynamicDataNames
{
383 ########################################################################
385 ########################################################################
388 wm title .
{Micropolis Root
}
391 if {"[sim Platform]" == "msdos"} {
412 # The next three lines have no effect on the OLPC, where we don't provide
413 # the font in res (because it's already in the system fonts). These lines
414 # are for other systems that lack the font.
415 set FontPath
"[pwd]/res/dejavu-lgc"
416 system
"xset -fp \"$FontPath\" >/dev/null 2>&1"
417 system
"xset +fp \"$FontPath\" >/dev/null 2>&1"
420 ########################################################################
422 ########################################################################
425 proc Message
{id color title msg
{props
{}}} {
427 set Messages
($id) [list $color $title $msg $props]
431 Message
1 #7f7fff {DULLSVILLE, USA 1900} \
432 {Things haven't changed much around here in the last hundred years or so and the residents are beginning to get bored. They think Dullsville could be the next great city with the right leader.
434 It is your job to attract new growth and development
, turning Dullsville into a Metropolis within
30 years.
}
436 Message
2 #7f7fff {SAN FRANCISCO, CA. 1906} \
437 {Damage from the earthquake was minor compared to that of the ensuing fires
, which took days to control.
1500 people died.
439 Controlling the fires should be your initial concern. Then clear the rubble and start rebuilding. You have
5 years.
}
441 Message
3 #7f7fff {HAMBURG, GERMANY 1944} \
442 {Allied fire-bombing of German cities in WWII caused tremendous damage and loss of life. People living in the inner cities were at greatest risk.
444 You must control the firestorms during the bombing and then rebuild the city
after the war. You have
5 years.
}
446 Message
4 #7f7fff {BERN, SWITZERLAND 1965} \
447 {The roads here are becoming more congested every day
, and the residents are upset. They demand that you do something about it.
449 Some have suggested a mass transit system as the answer
, but this would require major rezoning in the downtown area. You have
10 years.
}
451 Message
5 #7f7fff {TOKYO, JAPAN 1957} \
452 {A large reptilian creature has been spotted heading
for Tokyo bay. It seems to be attracted to the heavy levels of industrial pollution there.
454 Try to control the fires
, then rebuild the industrial center. You have
5 years.
}
456 Message
6 #7f7fff {DETROIT, MI. 1972} \
457 {By
1970, competition from overseas and other economic factors pushed the once
"automobile capital of the world" into recession. Plummeting land values and unemployment then increased crime in the inner-city to chronic levels.
459 You have
10 years to reduce crime and rebuild the industrial base of the city.
}
461 Message
7 #7f7fff {BOSTON, MA. 2010} \
462 {A major meltdown is about to occur at one of the new downtown nuclear reactors. The area in the vicinity of the reactor will be severly contaminated by radiation
, forcing you to restructure the city around it.
464 You have
5 years to get the situation under control.
}
466 Message
8 #7f7fff {RIO DE JANEIRO, BRAZIL 2047} \
467 {In the mid-21st century
, the greenhouse effect raised
global temperatures
6 degrees F. Polar icecaps melted and raised sea levels worldwide. Coastal areas were devastated by flood and erosion.
469 You have
10 years to turn this swamp back into a city again.
}
471 Message
9 #ffa500 {Query Zone Status} \
479 {{view
{PanView
$v $QueryX $QueryY}}}
481 Message
10 #ff4f4f {POLLUTION ALERT!} \
482 {Pollution in your city has exceeded the maximum allowable amounts established by the Micropolis Pollution Agency. You are running the risk of grave ecological consequences.
484 Either clean up your act or
open a gas mask concession at city hall.
} \
485 {{view
{PanView
$v [sim PolMaxX
] [sim PolMaxY
]}}}
487 Message
11 #ff4f4f {CRIME ALERT!} \
488 {Crime in your city is out of hand. Angry mobs are looting and vandalizing the central city. The president will
send in the national guard soon
if you cannot control the problem.
} \
489 {{view
{PanView
$v [sim CrimeMaxX
] [sim CrimeMaxY
]}}}
491 Message
12 #ff4f4f {TRAFFIC WARNING!} \
492 {Traffic in this city is horrible. The city gridlock is expanding. The commuters are getting militant.
494 Either build more roads and rails or get a bulletproof limo.
} \
495 {{view
{PanView
$v [sim TrafMaxX
] [sim TrafMaxY
]}}}
497 Message
20 #ff4f4f {FIRE REPORTED!} \
498 "A fire has been reported!" \
499 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
501 Message
21 #ff4f4f {MONSTER ATTACK!} \
502 "A large reptilian creature has been spotted in the water. It seems to be attracted to areas of high pollution. There is a trail of destruction wherever it goes. \
503 All you can do is wait till he leaves, then rebuild from the rubble." \
504 {{view
{FollowView
$v monster
}}}
506 # XXX: write more text
507 Message
22 #ff4f4f {TORNADO ALERT!} \
508 {A tornado has been reported
! There's nothing you can do to stop it
, so you'd better prepare to clean up
after the disaster
!} \
509 {{view
{FollowView
$v tornado
}}}
511 # XXX: write more text
512 Message
23 #ff4f4f {EARTHQUAKE!} \
513 {A major earthquake has occurred
! Put out the fires as quickly as possible
, before they spread
, then reconnect the power
grid and rebuild the city.
} \
514 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
516 # XXX: write more text
517 Message
24 #ff4f4f {PLANE CRASH!} \
518 {A plane has crashed
!} \
519 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
521 # XXX: write more text
522 Message
25 #ff4f4f {SHIPWRECK!} \
523 {A ship has wrecked
!} \
524 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
526 # XXX: write more text
527 Message
26 #ff4f4f {TRAIN CRASH!} \
528 {A train has crashed
!} \
529 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
531 # XXX: write more text
532 Message
27 #ff4f4f {HELICOPTER CRASH!} \
533 {A helicopter has crashed
!} \
534 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
536 Message
30 #ff4f4f {FIREBOMBING REPORTED!} \
537 {Firebombs are falling
!!} \
538 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
540 Message
35 #7fff7f {TOWN} \
541 {Congratulations
, your village has grown to town status. You now have
2,000 citizens.
} \
542 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
544 Message
36 #7fff7f {CITY} \
545 {Your town has grown into a full sized city
, with a current population of
10,000. Keep up the good work
!} \
546 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
548 Message
37 #7fff7f {CAPITAL} \
549 {Your city has become a capital. The current population here is
50,000. Your political future looks bright.
} \
550 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
552 Message
38 #7fff7f {METROPOLIS} \
553 {Your capital city has now achieved the status of metropolis. The current population is
100,000. With your management skills
, you should seriously consider running
for governor.
} \
554 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
556 Message
39 #7fff7f {MEGALOPOLIS} \
557 {Congratulation
, you have reached the highest category of urban development
, the megalopolis.
559 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.
} \
560 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
562 Message
40 #7fff7f {MEGALINIUM} \
563 {Congratulation
, you have reached the end of
time!
565 Because of the toroidal nature of the the Micropolis Space
/Time Continuum
, your city has wrapped back in
time to
1900!} \
566 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
568 # XXX: write more text
569 Message
41 #ff4f4f {HEAVY TRAFFIC!} \
571 reporting heavy traffic
!} \
572 {{view
{FollowView
$v helicopter
}}}
574 # XXX: write more text
575 Message
42 #ff4f4f {FLOODING REPORTED!} \
576 {Flooding has been been reported along the water's edge
!} \
577 {{view
{PanView
$v [sim FloodX
] [sim FloodY
]}}}
579 Message
43 #ff4f4f {NUCLEAR MELTDOWN!} \
580 {A nuclear meltdown has occured at your power plant. You are advised to avoid the area until the radioactive isotopes decay.
582 Many generations will confront this problem before it goes away
, so don't hold your breath.
} \
583 {{view
{PanView
$v [sim MeltX
] [sim MeltY
]}}}
586 Message
44 #ff4f4f {RIOTS!} \
587 {The citizens are rioting in the streets
, setting cars and houses on fire
, and bombing government buildings and businesses
!
589 All media coverage is blacked out
, while the fascist pigs beat the poor citizens into submission.
}
591 Message
46 #ff4f4f {NO SOUND SERVER!} \
592 {There is no sound server running on your X11 display
"%s". You won't hear any noise unless you run a sound server
, and turn the sound back on in the
"Options" menu.
}
594 Message
48 #7f7fff {Start a New City} \
595 {Build your very own city from the ground up
, starting with this map of uninhabited land.
}
597 Message
49 #7f7fff {Restore a Saved City} \
598 {This city was saved in the
file named
: %s
}
600 Message
100 #7fff7f {YOU'RE A WINNER!} \
601 {Your mayorial skill and city planning expertise have earned you the KEY TO THE CITY. Local residents will erect monuments to your glory and name their first-born children
after you. Why not run
for governor?
} \
602 {{middle
{@images
/key2city.xpm
}}}
604 Message
200 #ff4f4f {IMPEACHMENT NOTICE!} \
605 {The entire population of this city has finally had enough of your inept planning and incompetant management. An angry mob
-- led by your mother
-- has been spotted in the vicinity of city hall.
607 You should seriously consider taking an extended vacation
-- NOW.
(Or
read the manual and try again.
)}
609 Message
300 #ffd700 {About Micropolis} \
610 "Micropolis Version [sim Version] Copyright (C) 2007
612 Based on the Original Micropolis Concept and Design
614 TCL/Tk User Interface Designed and Created
615 by Don Hopkins, DUX Software.
616 Ported to Linux, Optimized and Adapted for OLPC
618 Licensed under the GNU General Public License,
619 version 3, with additional conditions."
622 ########################################################################
624 ########################################################################
627 option add
*CheckButton.relief flat
628 option add
*Dialog.cursor top_left_arrow
629 option add
*Entry.relief sunken
630 option add
*Frame.borderWidth
0
631 option add
*Listbox.relief sunken
632 option add
*Scrollbar.relief sunken
633 option add
*RadioButton.anchor w
634 option add
*RadioButton.relief flat
636 option add
*background
#b0b0b0
637 option add
*foreground
#000000
638 option add
*activeBackground
#d0d0d0
639 option add
*activeForeground
#000000
640 option add
*disabledForeground
""
641 option add
*selectBackground
#d0d0d0
642 option add
*selectForeground
#000000
643 #option add *selector #ffff80
644 option add
*selector
#bf0000
646 option add
*Scrollbar.Background
#b0b0b0
647 option add
*Scrollbar.Foreground
#d0d0d0
648 option add
*Interval.Background
#b0b0b0
649 option add
*Interval.Foreground
#000000
650 option add
*Interval.activeForeground
#d0d0d0
651 option add
*Interval.sliderForeground
#b0b0b0
652 option add
*Scale.activeForeground
#d0d0d0
653 option add
*Scale.sliderForeground
#b0b0b0
654 option add
*PieMenu.activeBackground
#b0b0b0
656 option add Mwm
*Micropolis.clientDecoration
-maximize
659 ########################################################################
661 ########################################################################
664 bind all
<Help
> {HandleHelp
%W
%x
%y
%X
%Y
}
665 bind all
<Shift-ButtonPress
> {HandleHelp
%W
%x
%y
%X
%Y
}
666 bind all
<Meta-ButtonPress
> {HandleHelp
%W
%x
%y
%X
%Y
}
667 bind all
<Shift-Meta-ButtonPress
> {HandleHelp
%W
%x
%y
%X
%Y
}
670 ########################################################################
672 ########################################################################
691 puts stderr
"$errorInfo"
699 proc NoFunction
{args
} {}
702 proc LinkWindow
{fromname to
} {
704 set WindowLinks
($fromname) $to
708 proc WindowLink
{fromname
} {
711 catch {set to
$WindowLinks($fromname)}
716 proc DeleteWindow
{sym name win
} {
717 set head
[WindowLink
$win.head
]
718 LinkWindow
$head.
$sym {}
720 set wins
[eval ident
"\$$name"]
721 set i
[lsearch $wins $win]
723 set $name [lreplace $wins $i $i]
729 proc Font
{win name
} {
730 global FontInfo FontCache HeadWindows
731 set scr
[winfo screen
$win]
734 set font $FontCache($scr,$name)
739 set label $FontCache($scr)
741 if {"$label" == ""} {
742 foreach head
$HeadWindows {
743 if {"[winfo screen $head]" == "$scr"} {
744 set label $head.fontlabel
745 label $label -text "X11 Sucks" -font fixed
746 set FontCache
($scr) $label
751 set fonts
[keylget FontInfo
$name]
752 foreach font $fonts {
753 #echo "Configuring font $font on $label"
754 if {[catch "$label config -font \"$font\""] == 0} {
767 set FontCache
($scr,$name) $font
773 proc Color
{win color mono
} {
774 if {[winfo screendepth
$win] == 1} {
782 ########################################################################
783 # Window Definition Functions
784 ########################################################################
787 proc MakeWindow.head
{{display
":0"}} {
789 source $ResourceDir/whead.tcl
794 proc MakeWindow.editor
{head
{display
":0"}} {
796 source $ResourceDir/weditor.tcl
801 proc MakeWindow.map
{head
{display
":0"}} {
803 source $ResourceDir/wmap.tcl
808 proc MakeWindow.graph
{head
{display
":0"}} {
810 source $ResourceDir/wgraph.tcl
815 proc MakeWindow.budget
{head
{display
":0"}} {
817 source $ResourceDir/wbudget.tcl
822 proc MakeWindow.evaluation
{head
{display
":0"}} {
824 source $ResourceDir/weval.tcl
829 proc MakeWindow.splash
{head
{display
":0"}} {
831 source $ResourceDir/wsplash.tcl
836 proc MakeWindow.scenario
{head
{display
":0"}} {
838 source $ResourceDir/wscen.tcl
843 proc MakeWindow.
file {head
{display
":0"}} {
845 source $ResourceDir/wfile.tcl
850 proc MakeWindow.ask
{head
{display
":0"}} {
852 source $ResourceDir/wask.tcl
857 proc MakeWindow.player
{head
{display
":0"}} {
859 source $ResourceDir/wplayer.tcl
864 proc MakeWindow.notice
{head
{display
":0"}} {
866 source $ResourceDir/wnotice.tcl
870 proc MakeWindow.help
{head
{display
":0"}} {
872 source $ResourceDir/whelp.tcl
876 proc MakeWindow.frob
{head
{display
":0"}} {
878 source $ResourceDir/wfrob.tcl
883 ########################################################################
885 ########################################################################
888 proc UIInitializeSound
{} {
892 proc UIShutDownSound
{} {
896 proc UIDoSoundOn
{win cmd
} {
897 global Sound SoundServers
899 set win
[WindowLink
[winfo toplevel $win].head
]
900 if {[lsearch $SoundServers $win] != -1} {
901 set cmd
"send -quick -server $win Sound sound $cmd"
903 # XXX: Lost a sound server...
911 proc UIDoSound
{cmd
} {
912 global Sound SoundServers
914 foreach win
$SoundServers {
915 set foo
"send -quick -server $win Sound $cmd"
917 # XXX: Lost a sound server...
925 proc KillSoundServers
{} {
927 foreach win
$SoundServers {
928 set foo
"send -quick -server $win Sound KillSoundServer"
935 proc UISetChannelVolume
{win chan vol
} {
936 UIDoSoundOn
$win "channel $chan -volume $vol"
940 proc EchoPlaySound
{soundspec
} {
944 proc UIMakeSoundOn
{win chan sound
{opts
""}} {
945 playsound
$chan $sound $opts
949 proc UIStartSoundOn
{win chan sound
{opts
""}} {
950 # Send message to Python to play sound.
953 #UIDoSoundOn $win "play $sound -replay -channel $chan -repeat 100 $opts"
957 proc UIMakeSound
{chan sound
{opts
""}} {
958 playsound
$chan $sound $opts
962 proc UIStartSound
{chan sound
{opts
""}} {
963 # Send message to Python to play sound.
966 #UIDoSound "sound play $sound -channel $chan -repeat 100 $opts"
970 proc SetupSoundServer
{win
} {
975 proc AddSoundServer
{win
} {
977 set i
[lsearch $SoundServers $win]
979 set SoundServers
[linsert $SoundServers 0 $win]
984 proc LostSoundServer
{win
} {
985 DeleteSoundServer
$win
986 # UIShowPictureOn [WindowLink $win.head] 46 [winfo screen $win]
990 proc DeleteSoundServer
{win
} {
992 set i
[lsearch $SoundServers $win]
994 set SoundServers
[lreplace $SoundServers $i $i]
1003 proc MonsterSpeed
{} {
1004 return [expr "[sim Rand 40] + 70"]
1008 proc ExplosionPitch
{} {
1009 return [expr "[sim Rand 20] + 90"]
1014 return [expr "[sim Rand 20] + 90"]
1018 ########################################################################
1019 # Global Window Handlers
1022 proc WithdrawAll
{} {
1040 proc ShowInitial
{} {
1048 ########################################################################
1049 # Head Window Handlers
1052 proc PrepHead
{head
} {
1059 WithdrawHeadOf
$head
1063 after 1000 "WithdrawSplashOf $head"
1064 WithdrawHeadOf
$head
1065 ShowScenarioOf
$head
1069 WithdrawSplashOf
$head
1070 WithdrawScenarioOf
$head
1075 ReShowPictureOn
$head
1083 proc ShowHeadOf
{head
} {
1088 proc WithdrawHeadOf
{head
} {
1095 foreach win
$HeadWindows {
1101 proc WithdrawHeads
{} {
1103 foreach win
$HeadWindows {
1109 proc DeleteHeadWindow
{head
} {
1116 foreach win
$HeadWindows {
1122 proc InitHead
{win
} {
1123 set w
[WindowLink
$win.
text]
1124 $w configure
-state normal
1127 $w configure
-state disabled
1129 if {[sim MultiPlayerMode
]} {
1130 set w
[WindowLink
$win.
entry]
1141 proc InitAllHeadMenus
{} {
1144 foreach win
$HeadWindows {
1150 proc InitHeadMenus
{win
} {
1152 set m0
[WindowLink
$win.m0
]
1153 set m1
[WindowLink
$win.m1
]
1154 set m2
[WindowLink
$win.m2
]
1155 set m3
[WindowLink
$win.m3
]
1156 set m4
[WindowLink
$win.m4
]
1157 set b0
[WindowLink
$win.b0
]
1158 set b1
[WindowLink
$win.b1
]
1159 set b2
[WindowLink
$win.b2
]
1160 set b3
[WindowLink
$win.b3
]
1161 set b4
[WindowLink
$win.b4
]
1175 # When in multi player mode there is an extra menu
1176 # item to add another player, before the quit item,
1177 # so compensate for it here.
1178 if {[sim MultiPlayerMode
]} {
1183 $b0 config
-state normal
1184 $b2 config
-state disabled
1185 $b4 config
-state disabled
1190 # When in multi player mode there is an extra menu
1191 # item to add another player, before the quit item,
1192 # so compensate for it here.
1193 if {[sim MultiPlayerMode
]} {
1198 $b0 config
-state normal
1199 $b2 config
-state normal
1200 $b4 config
-state normal
1206 proc UIDisaster
{win cmd action
} {
1207 AskQuestion
[Color
$win #ff0000 #ffffff] "Cause a Disaster" \
1208 "Oh no! Do you really want to $action" \
1209 "{No way!} Disaster.No {WithdrawAsks}" \
1211 "{I guess so.} Disaster.Yes {WithdrawAsks ; $cmd}"
1215 proc CrushHead
{head
} {
1216 global SubWindows VoteNames
1218 foreach foo
$VoteNames {
1220 set votes
[eval ident
\$VotesFor$foo]
1221 set i
[lsearch $votes $head]
1223 set VotesFor
$foo [lreplace $votes $i $i]
1227 foreach foo
$SubWindows {
1228 set sym
[lindex $foo 0]
1229 set name
[lindex $foo 1]
1231 set wins
[eval ident
"\$$name"]
1233 if {[WindowLink
$win.head
] == $head} {
1234 DeleteWindow
$sym $name $win
1241 proc ChatDown
{win
} {
1263 global ChatConnection
1265 DoSendMessage
"Opening Connection to Chat Server $ChatServer socket $ChatSocket ..." status
1267 set ChatConnection
{}
1269 set ChatConnection
[connect
$ChatServer $ChatSocket]
1272 if {$ChatConnection == {}} then
{
1273 DoSendMessage
"Sorry, I could not open a connection to chat server $ChatServer socket $ChatSocket." status
1276 filehandler
$ChatConnection r
"ReceiveChat"
1287 puts $ChatConnection "USER $UserName $HostName $ServerName $RealName\r\n" nonewline
1288 puts $ChatConnection "NICK $NickName\r\n" nonewline
1289 puts $ChatConnection "JOIN $ChannelName\r\n" nonewline
1290 flush $ChatConnection
1295 proc ReceiveChat
{mode f
} {
1296 # DoSendMessage "ReceiveChat: MODE $mode F $f"
1300 if {[string first
{:} $msg]} {
1304 set from
[lindex $msg 0]
1305 set cmd
[string tolower
[lindex $msg 1]]
1309 if {($cmd == "privmsg") ||
1310 ($cmd == "notice")} then
{
1312 set chan
[lindex $msg 2]
1313 set i
[expr "[string length $from] + 1 + [string length $cmd] + 1 + [string length $chan] + 2"]
1314 set j
[expr "[string length $msg] - 2"]
1315 set line
[string range
$msg $i $j]
1316 set chan
[string range
$chan 1 [string length
$chan]]
1317 set from
[string range
$from 1 [expr "[string length $from] - 1"]]
1318 set from
[split $from {!}]
1319 set from
[lindex $from 0]
1320 DoSendMessage
"$from> $line"
1323 if {$handled == 0} {
1324 set msg
[string range
$msg \
1325 [expr "[string length $from] + 1"] \
1326 [expr "[string length $msg] - 2"]]
1332 proc SendChatMessage
{msg win
} {
1333 global ChatConnection ChannelName NickName
1339 if {[string range
$msg 0 0] == "/"} {
1340 set cmd
[string range
$msg 1 [string length
$msg]]
1341 DoSendMessage
"$NickName> \[$cmd\]"
1344 set cmd
"PRIVMSG $ChannelName :$msg\r\n"
1345 DoSendMessage
"$NickName> $msg"
1352 puts $ChatConnection $cmd nonewline
1353 flush $ChatConnection
1358 DoSendMessage
"IRC Broke the connection"
1368 global ChatConnection
1370 DoSendMessage
"Closing Connection to Chat Server." status
1373 puts $ChatConnection "QUIT\r\n" nonewline
1374 flush $ChatConnection
1375 $ChatConnection close
1378 set ChatConnection
{}
1383 proc DoEnterMessage
{win var
} {
1386 set msg
[eval ident
"\$\{$var\}"]
1388 if {$Chatting} then
{
1389 SendChatMessage
$msg $win
1397 proc DoEvalMessage
{win var
} {
1399 set command
[eval ident
"\$\{$var\}"]
1401 DoSendMessage
"Evaluating TCL: $command"
1402 catch {uplevel #0 $command} result
1403 DoSendMessage
"Result: $result"
1407 proc DoSendMessage
{msg
{tag
message}} {
1409 foreach win
$HeadWindows {
1410 appendWithTag
[WindowLink
$win.
text] $tag "$msg"
1415 proc UISetMessage
{msg
{tag status
}} {
1416 global DoMessages EditorWindows HeadWindows
1418 if {$DoMessages == 0} {
1422 foreach win
$EditorWindows {
1423 [WindowLink
$win.
message] configure
-text "$msg"
1426 foreach win
$HeadWindows {
1427 appendWithTag
[WindowLink
$win.
text] $tag "$msg"
1434 proc appendWithTag
{w tag
text} {
1438 set start
[$w index end
]
1439 $w configure
-state normal
1440 if {$start > $MaxLines} then
{
1441 $w delete
0.0 $ShrinkLines.0
1442 set start
[$w index end
]
1444 $w insert end
"${text}\n"
1445 $w tag add
$tag $start {end
- 1 char
}
1446 $w configure
-state disabled
1447 $w yview
-pickplace {end
- 1 char
}
1451 ########################################################################
1452 # Budget Window Handlers
1455 proc ShowBudgetOf
{head
} {
1456 set win
[WindowLink
$head.budget
]
1458 set win
[MakeWindow.budget
$head [winfo screen
$head]]
1467 proc ShowBudgets
{} {
1468 global HeadWindows BudgetsVisible
1469 set BudgetsVisible
1
1470 foreach win
$HeadWindows {
1476 proc WithdrawBudgets
{} {
1477 global BudgetWindows BudgetsVisible
1478 foreach win
$BudgetWindows {
1482 set BudgetsVisible
0
1486 proc BudgetContinue
{{win
""}} {
1487 global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1489 if {([sim RoadFund
] != $BudgetRoadFund) ||
1490 ([sim FireFund
] != $BudgetFireFund) ||
1491 ([sim PoliceFund
] != $BudgetPoliceFund) ||
1492 ([sim TaxRate
] != $BudgetTaxRate)} {
1493 UISetMessage
"The budget was changed."
1495 UISetMessage
"The budget wasn't changed."
1503 proc BudgetReset
{{win
""}} {
1504 global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1505 if {([sim RoadFund
] != $BudgetRoadFund) ||
1506 ([sim FireFund
] != $BudgetFireFund) ||
1507 ([sim PoliceFund
] != $BudgetPoliceFund) ||
1508 ([sim TaxRate
] != $BudgetTaxRate)} {
1509 UISetMessage
"The budget was reset."
1510 if {[sim Players
] > 1} {
1511 UIMakeSound edit Sorry
1514 UISetMessage
"The budget was reset."
1516 sim RoadFund
$BudgetRoadFund
1517 sim FireFund
$BudgetFireFund
1518 sim PoliceFund
$BudgetPoliceFund
1519 sim TaxRate
$BudgetTaxRate
1525 proc BudgetCancel
{{win
""}} {
1533 proc SetTaxRate
{rate
} {
1538 proc BudgetSetTaxRate
{rate
} {
1544 proc BudgetSetRoadFund
{percent
} {
1545 sim RoadFund
$percent
1550 proc BudgetSetFireFund
{percent
} {
1551 sim FireFund
$percent
1556 proc BudgetSetPoliceFund
{percent
} {
1557 sim PoliceFund
$percent
1562 proc UIShowBudgetAndWait
{} {
1563 global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1564 if {$OldBudget == 0} {
1565 set BudgetRoadFund
[sim RoadFund
]
1566 set BudgetFireFund
[sim FireFund
]
1567 set BudgetPoliceFund
[sim PoliceFund
]
1568 set BudgetTaxRate
[sim TaxRate
]
1572 UISetMessage
"Pausing to set the budget ..."
1578 sim UpdateBudgetWindow
1582 proc ToggleBudgetTimer
{} {
1583 global BudgetTimerActive
1584 if {$BudgetTimerActive} {
1592 proc StopBudgetTimer
{} {
1593 global BudgetTimerActive
1594 set BudgetTimerActive
0
1599 proc StartBudgetTimer
{} {
1600 global BudgetTimerActive BudgetTimer BudgetTimeout
1602 set BudgetTimerActive
$me
1603 set BudgetTimer
$BudgetTimeout
1605 after 1000 TickBudgetTimer
$me
1609 proc RestartBudgetTimer
{} {
1610 global BudgetTimerActive
1611 if {$BudgetTimerActive} {
1618 proc UpdateBudgetTimer
{} {
1619 global BudgetWindows BudgetTimerActive BudgetTimer
1620 if {$BudgetTimerActive} {
1621 set text [format "Auto Cancel In %d Seconds (click to disable)" $BudgetTimer]
1623 set text [format "Enable Auto Cancel (currently disabled)"]
1625 foreach win
$BudgetWindows {
1626 set t
[WindowLink
$win.timer
]
1627 $t config
-text "$text"
1632 proc TickBudgetTimer
{me
} {
1633 global BudgetTimerActive BudgetTimer BudgetTimeout
1634 if {$BudgetTimerActive == $me} {
1636 if {$BudgetTimer < 0} {
1642 after 1000 TickBudgetTimer
$me
1648 proc FireBudgetTimer
{} {
1658 proc ToggleAutoBudget
{} {
1661 #echo "ToggleAutoBudget found on, clearing"
1664 #echo "ToggleAutoBudget found off, setting"
1670 proc UIUpdateBudget
{} {
1675 proc UpdateAutoBudget
{} {
1676 global BudgetWindows AutoBudget
1677 if {[sim AutoBudget
]} {
1678 set text "Disable Auto Budget (currently enabled)"
1680 set text "Enable Auto Budget (currently disabled)"
1682 #echo "UpdateAutoBudget $AutoBudget $text"
1683 foreach win
$BudgetWindows {
1684 set t
[WindowLink
$win.autobudget
]
1685 $t config
-text "$text"
1690 proc UISetBudget
{cashflow previous current collected taxrate
} {
1691 global BudgetWindows BudgetsVisible
1693 #echo "UISetBudgetValues $taxrate $BudgetsVisible"
1695 if {$BudgetsVisible} {
1697 foreach win
$BudgetWindows {
1698 set w
[WindowLink
$win.cashflow
]
1699 set old
[lindex [$w configure
-text] 4]
1700 if {$old != $cashflow} {
1701 $w configure
-text $cashflow
1703 set w
[WindowLink
$win.previous
]
1704 set old
[lindex [$w configure
-text] 4]
1705 if {$old != $previous} {
1706 $w configure
-text $previous
1708 set w
[WindowLink
$win.current
]
1709 set old
[lindex [$w configure
-text] 4]
1710 if {$old != $current} {
1711 $w configure
-text $current
1713 set w
[WindowLink
$win.collected
]
1714 set old
[lindex [$w configure
-text] 4]
1715 if {$old != $collected} {
1716 $w configure
-text $collected
1719 set w
[WindowLink
$win.taxrate
]
1721 if {$old != $taxrate} {
1725 set w
[WindowLink
$win.taxlabel
]
1726 set old
[lindex [$w configure
-text] 4]
1729 $w configure
-text $new
1735 foreach win
$HeadWindows {
1737 set w
[WindowLink
$win.taxrate
]
1739 if {$old != $taxrate} {
1740 # FIXME: this might not work if the slider is disabled in multi player mode.
1744 set w
[WindowLink
$win.taxlabel
]
1745 set old
[lindex [$w configure
-text] 4]
1746 set new
"Tax Rate: $taxrate%"
1748 $w configure
-text $new
1754 proc UISetBudgetValues
{roadgot roadwant roadpercent policegot policewant policepercent firegot firewant firepercent
} {
1755 global BudgetWindows BudgetsVisible
1757 if {$BudgetsVisible == 0} {
1761 foreach win
$BudgetWindows {
1762 set w
[WindowLink
$win.fire
].request
1763 set old
[lindex [$w configure
-text] 4]
1764 set new
"$firepercent% of $firewant = $firegot"
1766 $w configure
-text $new
1768 set w
[WindowLink
$win.fire
].fund
1770 if {$old != $firepercent} {
1774 set w
[WindowLink
$win.police
].request
1775 set old
[lindex [$w configure
-text] 4]
1776 set new
"$policepercent% of $policewant = $policegot"
1778 $w configure
-text $new
1780 set w
[WindowLink
$win.police
].fund
1782 if {$old != $policepercent} {
1783 $w set $policepercent
1786 set w
[WindowLink
$win.road
].request
1787 set old
[lindex [$w configure
-text] 4]
1788 set new
"$roadpercent% of $roadwant = $roadgot"
1790 $w configure
-text $new
1792 set w
[WindowLink
$win.road
].fund
1794 if {$old != $roadpercent} {
1801 proc ChangeBudget
{} {
1802 global VotesForBudget
1803 if {"$VotesForBudget" != ""} {
1810 proc InitVotesForBudget
{} {
1811 global VotesForBudget BudgetWindows
1812 set VotesForBudget
{}
1813 foreach win
$BudgetWindows {
1814 [WindowLink
$win.vote
] config
-relief raised
1816 UpdateVotesForBudget
1820 proc UpdateVotesForBudget
{} {
1821 global BudgetWindows
1822 UpdateVotesFor Budget
$BudgetWindows
1826 proc UpdateTaxRateSliders
{} {
1828 set players
[sim Players
]
1829 foreach win
$HeadWindows {
1830 set slider
[WindowLink
$win.taxrate
]
1831 #echo "UpdateTaxRateSliders players $players win $win slider $slider"
1832 if {$players == 1} {
1833 $slider configure
-state normal
1835 $slider configure
-state disabled
1841 ########################################################################
1842 # Evaluation Window Handlers
1845 proc ToggleEvaluationOf
{head
} {
1847 if {"$State" != "play"} {
1852 set win
[WindowLink
$head.evaluation
]
1854 set mapped
[winfo ismapped
$win]
1858 WithdrawEvaluationOf
$head
1860 ShowEvaluationOf
$head
1866 proc WithdrawEvaluationOf
{head
} {
1867 set win
[WindowLink
$head.evaluation
]
1874 proc ShowEvaluationOf
{head
} {
1875 set win
[WindowLink
$head.evaluation
]
1877 set win
[MakeWindow.evaluation
$head [winfo screen
$head]]
1881 set parent
[WindowLink
$win.parent
]
1882 #pack append [WindowLink $head.col2]\
1883 # $parent {top frame nw fill}
1884 pack append $parent\
1885 $win {top
frame nw fillx
}
1887 sim UpdateEvaluation
1891 proc WithdrawEvaluations
{} {
1892 global EvaluationWindows EvaluationsVisible
1893 foreach win
$EvaluationWindows {
1895 #set parent [WindowLink $win.parent]
1896 #pack unpack $parent
1899 set EvaluationsVisible
0
1903 proc EvaluationVisible
{w v
} {
1904 global EvaluationsVisible
1905 global [set var
$w.visible
]
1910 set EvaluationsVisible
[expr "$EvaluationsVisible + 1"]
1912 set EvaluationsVisible
[expr "$EvaluationsVisible - 1"]
1917 proc UISetEvaluation
{changed score ps0 ps1 ps2 ps3 pv0 pv1 pv2 pv3 pop delta assessed cityclass citylevel goodyes goodno title
} {
1918 global EvaluationWindows EvaluationsVisible CurrentDate
1920 set class
[string tolower
$cityclass]
1921 UISetMessage
"$CurrentDate: Score $score, $class population $pop."
1923 if {$EvaluationsVisible} {
1925 foreach win
$EvaluationWindows {
1927 global [set var
$win.visible
]
1928 set visible
[eval ident
"\$\{$var\}"]
1932 # TODO: set evaluation window and icon title
1933 #wm title $win "$title"
1934 #wm iconname $win "$title"
1936 set w
[WindowLink
$win.goodjob
]
1937 set old
[lindex [$w configure
-text] 4]
1938 set new
"$goodyes\n$goodno"
1940 $w configure
-text $new
1943 set w
[WindowLink
$win.problemnames
]
1944 set old
[lindex [$w configure
-text] 4]
1945 set new
"$ps0\n$ps1\n$ps2\n$ps3"
1947 $w configure
-text $new
1950 set w
[WindowLink
$win.problempercents
]
1951 set old
[lindex [$w configure
-text] 4]
1952 set new
"$pv0\n$pv1\n$pv2\n$pv3"
1954 $w configure
-text $new
1957 set w
[WindowLink
$win.stats
]
1958 set old
[lindex [$w configure
-text] 4]
1959 set new
"$pop\n$delta\n\n$assessed\n$cityclass\n$citylevel"
1961 $w configure
-text $new
1964 set w
[WindowLink
$win.score
]
1965 set old
[lindex [$w configure
-text] 4]
1966 set new
"$score\n$changed"
1968 $w configure
-text $new
1976 ########################################################################
1977 # File Window Handlers
1980 proc ShowFileOf
{head
} {
1981 set win
[WindowLink
$head.
file]
1983 set win
[MakeWindow.
file $head [winfo screen
$head]]
1993 foreach win
$HeadWindows {
1999 proc WithdrawFiles
{} {
2001 foreach win
$FileWindows {
2007 proc DoFileDialog
{win Message Path Pattern FileName ActionOk ActionCancel
} {
2008 ShowFileDialog
$win "$Path" "$Pattern"
2009 $win.message1 configure
-text "$Message"
2010 $win.path.path delete
0 end
2011 $win.path.path insert
0 $Path
2012 $win.
file.
file delete
0 end
2013 $win.
file.
file insert
0 "$FileName"
2014 $win.frame1.ok config
-command "
2015 $ActionOk \[$win.file.file get\] \[$win.path.path get\]
2017 $win.frame1.rescan config
-command "
2018 ShowFileDialog $win \[$win.path.path get\] $Pattern"
2019 $win.frame1.cancel config
-command "
2022 bind $win.files.files
"<Double-Button-1>" "\
2023 FileSelectDouble $win %W %y $Pattern \"
2024 $ActionOk {\[$win.file.file get\]} {\[$win.path.path get\]}\""
2025 bind $win.path.path
<Return
> "
2026 ShowFileDialog $win \[$win.path.path get\] $Pattern
2027 $win.file.file cursor 0
2028 focus $win.file.file"
2029 bind $win.
file.
file <Return
> "\
2030 $ActionOk \[$win.file.file get\] \[$win.path.path get\]
2035 proc BindSelectOne
{win Y
} {
2036 set Nearest
[$win nearest
$Y]
2037 if {$Nearest >= 0} {
2038 $win select from
$Nearest
2039 $win select to
$Nearest
2044 proc FileSelect
{win widget Y
} {
2045 BindSelectOne
$widget $Y
2046 set Nearest
[$widget nearest
$Y]
2047 if {$Nearest >= 0} {
2048 set Path
[$win.path.path get
]
2049 set TmpEntry
[$widget get
$Nearest]
2050 if {[string compare
"/" [string index
$TmpEntry \
2051 [expr [string length
$TmpEntry]-1]]] == 0 ||
\
2052 [string compare
"@" [string index
$TmpEntry \
2053 [expr [string length
$TmpEntry]-1]]] == 0} {
2054 # handle directories, and symbolic links to directories
2055 set FileName
[string range
$TmpEntry 0 \
2056 [expr [string length
$TmpEntry]-2]]
2057 # whoops / or @ is part of the name
2058 if {[MiscIsDir
$Path/$FileName] != 1} {
2059 set FileName
$TmpEntry
2062 if {[string compare
"*" [string index
$TmpEntry \
2063 [expr [string length
$TmpEntry]-1]]] == 0} {
2064 # handle executable filenames
2065 set FileName
[string range
$TmpEntry 0 \
2066 [expr [string length
$TmpEntry]-2]]
2067 # whoops * is part of the name
2068 if {[file executable
$Path/$FileName] != 1} {
2069 set FileName
$TmpEntry
2072 # a ordinary filename
2073 set FileName
$TmpEntry
2076 # enter the selected filename into the filename field
2077 if {[MiscIsDir
$Path/$FileName] != 1} {
2078 $win.
file.
file delete
0 end
2079 $win.
file.
file insert
0 $FileName
2085 proc FileSelectDouble
{win widget Y Pattern Action
} {
2086 BindSelectOne
$widget $Y
2087 set Nearest
[$widget nearest
$Y]
2088 if {$Nearest >= 0} {
2089 set Path
[$win.path.path get
]
2090 set TmpEntry
[$widget get
$Nearest]
2091 if {[string compare
$TmpEntry "../"] == 0} {
2092 # go up one directory
2094 [string trimright
[string trimright
[string trim
$Path] /] @]
2095 if {[string length
$TmpEntry] <= 0} {
2098 set Path
[file dirname
$TmpEntry]
2099 $win.path.path delete
0 end
2100 $win.path.path insert
0 $Path
2101 ShowFileDialog
$win $Path $Pattern
2103 if {[string compare
"/" [string index
$TmpEntry \
2104 [expr [string length
$TmpEntry]-1]]] == 0 ||
\
2105 [string compare
"@" [string index
$TmpEntry \
2106 [expr [string length
$TmpEntry]-1]]] == 0} {
2107 # handle directorys, and symbolic links to directorys
2108 set FileName
[string range
$TmpEntry 0 \
2109 [expr [string length
$TmpEntry]-2]]
2110 # whoops / or @ is part of the name
2111 if {[MiscIsDir
$Path/$FileName] != 1} {
2112 set FileName
$TmpEntry
2115 if {[string compare
"*" [string index
$TmpEntry \
2116 [expr [string length
$TmpEntry]-1]]] == 0} {
2117 # handle executable filenames
2118 set FileName
[string range
$TmpEntry 0 \
2119 [expr [string length
$TmpEntry]-2]]
2120 # whoops * is part of the name
2121 if {[file executable
$Path/$FileName] != 1} {
2122 set FileName
$TmpEntry
2125 # a ordinary filename
2126 set FileName
$TmpEntry
2130 if {[MiscIsDir
$Path/$FileName] == 1} {
2131 if {[string compare
"/" [string index
$Path \
2132 [expr [string length
$Path]-1]]] == 0} {
2133 append Path
$FileName
2135 append Path
/ $FileName
2137 $win.path.path delete
0 end
2138 $win.path.path insert
0 $Path
2139 ShowFileDialog
$win $Path $Pattern
2141 # enter the selected filename into the filename field
2142 $win.
file.
file delete
0 end
2143 $win.
file.
file insert
0 "$FileName"
2144 if {[string length
$Action] > 0} {
2154 proc NameComplete
{win Type
} {
2159 if {[string compare
$Type path
] == 0} {
2160 set DirName
[file dirname
[$win.path.path get
]]
2161 set FileName
[file tail
[$win.path.path get
]]
2163 set DirName
[file dirname
[$win.path.path get
]/]
2164 set FileName
[file tail
[$win.
file.
file get
]]
2168 if {[MiscIsDir
$DirName] == 1} {
2169 catch "exec ls $DirName/" Result
2171 set ListLength
[llength $Result]
2173 while {$Counter < $ListLength} {
2174 if {[string length
$FileName] == 0} {
2175 if {$FoundCounter == 0} {
2176 set NewFile
[lindex $Result $Counter]
2179 set TmpFile1
$NewFile
2180 set TmpFile2
[lindex $Result $Counter]
2181 set Length1
[string length
$TmpFile1]
2182 set Length2
[string length
$TmpFile2]
2184 if {$Length1 > $Length2} {
2185 set Length1
$Length2
2187 while {$Counter1 < $Length1} {
2188 if {[string compare
[string index
$TmpFile1 $Counter1] \
2189 [string index
$TmpFile2 $Counter1]] == 0} {
2190 append NewFile
[string index
$TmpFile1 $Counter1]
2199 if {[regexp "^$FileName" [lindex $Result $Counter] \
2201 if {$FoundCounter == 0} {
2202 set NewFile
[lindex $Result $Counter]
2205 set TmpFile1
$NewFile
2206 set TmpFile2
[lindex $Result $Counter]
2207 set Length1
[string length
$TmpFile1]
2208 set Length2
[string length
$TmpFile2]
2210 if {$Length1 > $Length2} {
2211 set Length1
$Length2
2213 while {$Counter1 < $Length1} {
2214 if {[string compare
[string index
$TmpFile1 $Counter1] \
2215 [string index
$TmpFile2 $Counter1]] == 0} {
2216 append NewFile
[string index
$TmpFile1 $Counter1]
2230 if {$FoundCounter == 1} {
2231 if {[MiscIsDir
$DirName/$NewFile] == 1} {
2232 if {[string compare
$DirName "/"] == 0} {
2233 $win.path.path delete
0 end
2234 $win.path.path insert
0 "/[string trim [string trim $NewFile /] @]/"
2236 $win.path.path delete
0 end
2237 $win.path.path insert
0 "[string trimright $DirName /]/[string trim [string trim $NewFile /] @]/"
2240 $win.path.path delete
0 end
2241 $win.path.path insert
0 \
2242 "[string trim [string trimright $DirName /] @]/"
2243 $win.
file.
file delete
0 end
2244 $win.
file.
file insert
0 "$NewFile"
2247 if {[MiscIsDir
$DirName/$NewFile] == 1 ||
2248 [string compare
$Type path
] == 0} {
2249 $win.path.path delete
0 end
2250 $win.path.path insert
0 \
2251 "[string trimright $DirName /]/[string trim [string trim $NewFile /] @]"
2253 $win.path.path delete
0 end
2254 $win.path.path insert
0 "$DirName"
2255 if {[string length
$NewFile] > 0} {
2256 $win.
file.
file delete
0 end
2257 $win.
file.
file insert
0 "$NewFile"
2264 proc ShowFileDialog
{win Path Pattern
} {
2266 #set Path [lindex [split $Path] 0]
2267 if {[$win.files.files size
] > 0} {
2268 $win.files.files delete
0 end
2271 if {[catch "exec ls -F \"$Path\"" Result
]} {
2274 if {[string match
$Result "* not found"]} {
2277 set ElementList
[lsort [split $Result "\n"]]
2280 if {[string compare
$Path "/"]} {
2281 $win.files.files insert end
"../"
2285 foreach Counter
$ElementList {
2287 if {[string match
$Pattern $Counter] == 1} {
2288 if {[string compare
$Counter "../"] &&
2289 [string compare
$Counter "./"]} {
2290 $win.files.files insert end
$Counter
2293 set fn
$Path/[string trim
[string trim
[string trim
$Counter /] @] *]
2294 if {[MiscIsDir
$fn]} {
2295 $win.files.files insert end
$Counter
2303 proc MiscIsDir
{PathName
} {
2305 if {[file isdirectory
$PathName] == 1} {
2308 catch "file type $PathName" Type
2309 if {[string compare
$Type link
] == 0} {
2310 set LinkName
[file readlink
$PathName]
2311 catch "file type $LinkName" Type
2312 while {[string compare
$Type link
] == 0} {
2313 set LinkName
[file readlink
$LinkName]
2315 return [file isdirectory
$LinkName]
2322 proc busy
{win cmds
} {
2324 set list [winfo children
$win]
2326 while {$list != ""} {
2329 set class
[winfo class
$w]
2330 set cursor
[lindex [$w config
-cursor] 4]
2331 if {[winfo toplevel $w] == $w} {
2332 lappend busy
[list $w $cursor]
2334 set next
[concat $next [winfo children
$w]]
2340 catch {[lindex $w 0] config
-cursor watch
}
2345 set error [catch {uplevel eval [list $cmds]} result
]
2348 catch {[lindex $w 0] config
-cursor [lindex $w 1]}
2359 ########################################################################
2360 # Editor Window Handlers
2362 proc ShowEditorOf
{head
} {
2363 global EditorWindows
2365 foreach win
$EditorWindows {
2366 if {[WindowLink
$win.head
] == $head} {
2367 set parent
[WindowLink
$win.parent
]
2368 #pack append [WindowLink $head.col2]\
2369 # $parent {top frame nw expand fill}
2370 pack append $parent\
2371 $win {top
frame nw expand fill
}
2385 proc NewEditorOf
{head
} {
2386 set win
[MakeWindow.editor
$head [winfo screen
$head]]
2388 set parent
[WindowLink
$win.parent
]
2389 pack append $parent\
2390 $win {top
frame nw expand fill
}
2397 proc ShowEditors
{} {
2399 foreach win
$HeadWindows {
2405 proc WithdrawEditors
{} {
2406 global EditorWindows
2407 foreach win
$EditorWindows {
2408 #set parent [WindowLink $win.parent]
2409 #pack unpack $parent
2415 proc InitEditors
{} {
2416 global EditorWindows
2417 foreach win
$EditorWindows {
2423 proc InitEditor
{win
} {
2424 set e
[WindowLink
$win.view
]
2425 UISetToolState
$win 7
2430 global $e.TrackState
2431 set $e.TrackState
{}
2435 proc SetEditorAutoGoto
{win val
} {
2436 global AutoGoto.
$win
2437 set AutoGoto.
$win $val
2438 set e
[WindowLink
$win.view
]
2443 proc SetEditorControls
{win val
} {
2444 global Controls.
$win
2445 set Controls.
$win $val
2447 pack append $win $win.leftframe
{left
frame center filly
}
2449 pack unpack
$win.leftframe
2454 proc SetEditorOverlay
{win val
} {
2456 set Overlay.
$win $val
2457 set e
[WindowLink
$win.view
]
2462 proc SetEditorDynamicFilter
{win val
} {
2463 global DynamicFilter.
$win
2464 set DynamicFilter.
$win $val
2465 set e
[WindowLink
$win.view
]
2466 $e DynamicFilter
$val
2467 if {$val == 1} then
{
2468 ShowFrobOf
[WindowLink
$win.head
]
2473 proc SetEditorSkip
{win val
} {
2474 set e
[WindowLink
$win.view
]
2479 proc EditorToolDown
{mod w x y
} {
2480 global [set var
$w.TrackState
]
2484 case
[$w ToolState
] in
\
2486 UIMakeSoundOn
$w edit Rumble
"-repeat 4"
2494 set $var [list constrain_start
$x $y]
2495 $w ToolConstrain
$x $y
2500 EditorTool ToolDown
$w $x $y
2505 proc EditorToolDrag
{w x y
} {
2506 EditorTool ToolDrag
$w $x $y
2511 proc EditorToolUp
{w x y
} {
2512 global [set var
$w.TrackState
]
2515 case
[$w ToolState
] in
\
2523 EditorTool ToolUp
$w $x $y
2525 $w ToolConstrain
-1 -1
2532 proc EditorTool
{action w x y
} {
2533 global [set var
$w.TrackState
]
2534 set state
[eval ident
"\$\{$var\}"]
2535 case
[lindex $state 0] in
\
2537 set x0
[lindex $state 1]
2538 set y0
[lindex $state 2]
2539 set dx
[expr "$x - $x0"]
2540 set dy
[expr "$y - $y0"]
2541 if [expr "($dx > 16) || ($dx < -16)"] then
{
2542 $w ToolConstrain
-1 $y0
2545 if [expr "($dy > 16) || ($dy < -16)"] then
{
2546 $w ToolConstrain
$x0 -1
2555 proc StartChalk
{w
} {
2556 sim CollapseMotion
0
2560 proc StopChalk
{w
} {
2561 sim CollapseMotion
1
2565 proc EditorPanDown
{mod w x y
} {
2566 global [set var
$w.TrackState
]
2570 set $var [list constrain_start
$x $y]
2571 $w ToolConstrain
$x $y
2576 EditorTool PanStart
$w $x $y
2580 proc EditorPanDrag
{w x y
} {
2581 EditorTool PanTo
$w $x $y
2585 proc EditorPanUp
{w x y
} {
2588 EditorTool PanTo
$w $x $y
2589 $w ToolConstrain
-1 -1
2595 proc EditorKeyDown
{w k
} {
2600 proc EditorKeyUp
{w k
} {
2605 proc BindEditorButtons
{win
} {
2606 set w
[WindowLink
$win.top
]
2608 bind $win <1> "CancelPie $win ; EditorToolDown none %W %x %y"
2609 bind $win <B1-Motion
> {EditorToolDrag
%W
%x
%y
}
2610 bind $win <ButtonRelease-1
> {EditorToolUp
%W
%x
%y
}
2612 bind $win <Control-1
> "CancelPie $win ; EditorToolDown constrain %W %x %y"
2613 bind $win <Control-B1-Motion
> {EditorToolDrag
%W
%x
%y
}
2614 bind $win <Control-ButtonRelease-1
> {EditorToolUp
%W
%x
%y
}
2616 bind $win <2> "CancelPie $win ; EditorPanDown none %W %x %y"
2617 bind $win <B2-Motion
> {EditorPanDrag
%W
%x
%y
}
2618 bind $win <ButtonRelease-2
> {EditorPanUp
%W
%x
%y
}
2620 bind $win <Control-2
> "CancelPie $win ; EditorPanDown constrain %W %x %y"
2621 bind $win <Control-B2-Motion
> {EditorPanDrag
%W
%x
%y
}
2622 bind $win <Control-ButtonRelease-2
> {EditorPanUp
%W
%x
%y
}
2624 InitPie
$win $w.toolpie
2628 proc UISetFunds
{funds
} {
2630 foreach win
$HeadWindows {
2631 [WindowLink
$win.funds
] configure
-text "$funds"
2636 proc UISetDate
{date month year
} {
2640 set CurrentDate
"$date"
2642 foreach win
$HeadWindows {
2643 [WindowLink
$win.date
] Set
$month $year
2648 proc SetPriority
{index
} {
2674 proc UISetDemand
{r c i
} {
2675 global HeadWindows DemandRes DemandCom DemandInd
2681 if {$r <= 0} then
{set ry0
32} else {set ry0
24}
2682 set ry1
[expr "$ry0 - $r"]
2683 if {$c <= 0} then
{set cy0
32} else {set cy0
24}
2684 set cy1
[expr "$cy0 - $c"]
2685 if {$i <= 0} then
{set iy0
32} else {set iy0
24}
2686 set iy1
[expr "$iy0 - $i"]
2688 foreach win
$HeadWindows {
2689 set can
[WindowLink
$win.demand
]
2690 # $can coords r 8 $ry0 14 $ry1
2691 # $can coords c 17 $cy0 23 $cy1
2692 # $can coords i 26 $iy0 32 $iy1
2693 $can coords r
49 $ry0 55 $ry1
2694 $can coords c
58 $cy0 64 $cy1
2695 $can coords i
67 $iy0 73 $iy1
2700 proc UISetOptions
{autobudget autogoto autobulldoze disasters sound animation messages notices
} {
2701 global AutoBudget AutoGoto AutoBulldoze Disasters Sound
2702 set AutoBudget
$autobudget
2703 set AutoGoto
$autogoto
2704 set AutoBulldoze
$autobulldoze
2705 set Disasters
$disasters
2707 set DoAnimation
$animation
2708 set DoMessages
$messages
2709 set DoNotices
$notices
2713 proc UIDidToolRes
{win x y
} {
2714 UIMakeSoundOn
$win edit O
"-speed 140"
2718 proc UIDidToolCom
{win x y
} {
2719 UIMakeSoundOn
$win edit A
"-speed 140"
2723 proc UIDidToolInd
{win x y
} {
2724 UIMakeSoundOn
$win edit E
"-speed 140"
2728 proc UIDidToolFire
{win x y
} {
2729 UIMakeSoundOn
$win edit O
"-speed 130"
2733 proc UIDidToolQry
{win x y
} {
2734 UIMakeSoundOn
$win edit E
"-speed 200"
2738 proc UIDidToolPol
{win x y
} {
2739 UIMakeSoundOn
$win edit E
"-speed 130"
2743 proc UIDidToolWire
{win x y
} {
2744 UIMakeSoundOn
$win edit O
"-speed 120"
2748 proc UIDidToolDozr
{win x y
} {
2749 UIMakeSoundOn
$win edit Rumble
2753 proc UIDidToolRail
{win x y
} {
2754 UIMakeSoundOn
$win edit O
"-speed 100"
2758 proc UIDidToolRoad
{win x y
} {
2759 UIMakeSoundOn
$win edit E
"-speed 100"
2763 proc UIDidToolChlk
{win x y
} {
2767 proc UIDidToolEraser
{win x y
} {
2771 proc UIDidToolStad
{win x y
} {
2772 UIMakeSoundOn
$win edit O
"-speed 90"
2776 proc UIDidToolPark
{win x y
} {
2777 UIMakeSoundOn
$win edit A
"-speed 130"
2781 proc UIDidToolSeap
{win x y
} {
2782 UIMakeSoundOn
$win edit E
"-speed 90"
2786 proc UIDidToolCoal
{win x y
} {
2787 UIMakeSoundOn
$win edit O
"-speed 75"
2791 proc UIDidToolNuc
{win x y
} {
2792 UIMakeSoundOn
$win edit E
"-speed 75"
2796 proc UIDidToolAirp
{win x y
} {
2797 UIMakeSoundOn
$win edit A
"-speed 50"
2801 proc UISetToolState
{w state
} {
2802 global EditorPallets EditorPalletImages ToolInfo
2803 set win
[WindowLink
$w.top
]
2804 #echo "UISETTOOLSTATE w $w win $win $state"
2805 ExclusivePallet
$state $win $EditorPallets ic
$EditorPalletImages \
2806 raised sunken
{NoFunction
}
2808 set c1
[WindowLink
$w.cost1
]
2810 set info [lindex $ToolInfo $state]
2811 set cost1
[lindex $info 1]
2812 set cost2
[lindex $info 2]
2813 $c1 configure
-text "$cost1"
2814 [WindowLink
$w.cost2
] configure
-text "$cost2"
2819 proc UIShowZoneStatus
{zone density value crime pollution growth x y
} {
2820 global QueryX QueryY
2821 set QueryX
[expr "8 + 16 * $x"]
2822 set QueryY
[expr "8 + 16 * $y"]
2823 UIShowPicture
9 [list $zone $density $value $crime $pollution $growth]
2827 ########################################################################
2828 # Map Window Handlers
2831 proc ShowMapOf
{head
} {
2834 foreach win
$MapWindows {
2835 if {"[WindowLink $win.head]" == "$head"} {
2836 global MapPanelWidth MapPanelHeight
2837 #place configure $win -x 0 -y 0 -width $MapPanelWidth -height $MapPanelHeight
2838 #[WindowLink $win.parent] configure -width $MapPanelWidth -height $MapPanelHeight
2839 set parent
[WindowLink
$win.parent
]
2840 pack append [WindowLink
$head.w2
] \
2841 $win {top
frame nw expand fill
}
2854 proc NewMapOf
{head
} {
2855 set win
[MakeWindow.map
$head [winfo screen
$head]]
2856 global MapPanelWidth MapPanelHeight
2857 #place configure $win -x 0 -y 0 -width $MapPanelWidth -height $MapPanelHeight
2858 #[WindowLink $win.parent] configure -width $MapPanelWidth -height $MapPanelHeight
2859 set parent
[WindowLink
$win.parent
]
2860 #pack append [WindowLink $head.col1]\
2861 # $parent {top frame nw fillx}
2862 pack append [WindowLink
$head.w2
] \
2863 $win {top
frame nw expand fill
}
2870 foreach win
$HeadWindows {
2876 proc WithdrawMaps
{} {
2878 foreach win
$MapWindows {
2887 foreach win
$MapWindows {
2893 proc InitMap
{win
} {
2898 proc EnableMaps
{} {
2900 foreach win
$MapWindows {
2906 proc EnableMap
{win
} {
2907 [WindowLink
$win.view
] ShowEditors
1
2908 [WindowLink
$win.zones
] config
-state normal
2909 [WindowLink
$win.overlays
] config
-state normal
2913 proc DisableMaps
{} {
2915 foreach win
$MapWindows {
2921 proc DisableMap
{win
} {
2922 [WindowLink
$win.view
] ShowEditors
0
2923 [WindowLink
$win.zones
] config
-state disabled
2924 [WindowLink
$win.overlays
] config
-state disabled
2928 proc SetMapState
{win state
} {
2929 set m
[WindowLink
$win.view
]
2931 if {$state == 14} then
{
2932 ShowFrobOf
[WindowLink
$win.head
]
2937 proc MapPanDown
{w x y
} {
2942 proc MapPanDrag
{w x y
} {
2947 proc MapPanUp
{w x y
} {
2954 proc UISetMapState
{w state
} {
2956 #set win [winfo toplevel $w]
2957 set win
[WindowLink
$w.win
]
2958 set m
[WindowLink
$win.view
]
2959 set title
[lindex $MapTitles $state]
2961 # TODO: set map text field header to title
2962 #wm title $win "$title"
2963 #wm iconname $win "$title"
2965 global [set var MapState.
$win]
2969 {6 8 9 10 11 12 13} {
2970 [WindowLink
$win.legend
] config
-bitmap "@images/legendmm.xpm"
2973 [WindowLink
$win.legend
] config
-bitmap "@images/legendpm.xpm"
2976 [WindowLink
$win.legend
] config
-bitmap "@images/legendn.xpm"
2982 ########################################################################
2983 # Graph Window Handlers
2986 proc ToggleGraphOf
{head
} {
2988 if {"$State" != "play"} {
2993 set win
[WindowLink
$head.graph
]
2995 set mapped
[winfo ismapped
$win]
2999 WithdrawGraphOf
$head
3007 proc WithdrawGraphOf
{head
} {
3008 set win
[WindowLink
$head.graph
]
3015 proc ShowGraphOf
{head
} {
3016 set win
[WindowLink
$head.graph
]
3018 set win
[MakeWindow.graph
$head [winfo screen
$head]]
3022 set parent
[WindowLink
$win.parent
]
3023 pack append $parent\
3024 $win {top
frame nw fillx
}
3030 proc WithdrawGraphs
{} {
3032 foreach win
$GraphWindows {
3039 proc InitGraphs
{} {
3041 foreach win
$GraphWindows {
3047 proc InitGraph
{win
} {
3048 UISetGraphState
$win 1 1 1 1 1 1 0
3052 proc UISetGraphState
{win t0 t1 t2 t3 t4 t5 range
} {
3053 set g
[WindowLink
$win.graphview
]
3054 GraphPalletMask
$win [expr "$t0 + ($t1<<1) + ($t2<<2) + ($t3<<3) + ($t4<<4) + ($t5<<5)"]
3055 GraphYearPallet
$win $range
3059 ########################################################################
3060 # Splash Window Handlers
3063 proc ShowSplashOf
{head
} {
3064 set win
[WindowLink
$head.splash
]
3066 set win
[MakeWindow.splash
$head [winfo screen
$head]]
3068 set splashscreen
[WindowLink
$win.splashscreen
]
3070 catch {$splashscreen config
-bitmap "@images/splashscreen.xpm"; set success 1}
3073 global SplashScreenDelay
3074 after $SplashScreenDelay "UIPickScenarioMode"
3081 proc WithdrawSplashOf
{head
} {
3082 set win
[WindowLink
$head.splash
]
3089 proc ShowSplashes
{} {
3091 foreach win
$HeadWindows {
3097 proc WithdrawSplashes
{} {
3098 global SplashWindows
3099 foreach win
$SplashWindows {
3101 set splashscreen
[WindowLink
$win.splashscreen
]
3102 $splashscreen config
-bitmap ""
3107 proc InitSplashes
{} {
3111 proc InitSplash
{win
} {
3115 proc DeleteSplashWindow
{win
} {
3120 ########################################################################
3121 # Scenario Window Handlers
3124 proc ShowScenarioOf
{head
} {
3125 set win
[WindowLink
$head.scenario
]
3127 set win
[MakeWindow.scenario
$head [winfo screen
$head]]
3129 # TODO: load background bitmap
3134 proc WithdrawScenarioOf
{head
} {
3135 set win
[WindowLink
$head.scenario
]
3142 proc ShowScenarios
{} {
3144 foreach win
$HeadWindows {
3150 proc WithdrawScenarios
{} {
3151 global ScenarioWindows
3152 foreach win
$ScenarioWindows {
3154 # TODO: flush background bitmap
3159 proc InitScenarios
{} {
3160 global MapHistory MapHistoryNum
3161 if {$MapHistoryNum < 1} {
3166 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3171 global ScenarioWindows
3172 foreach win
$ScenarioWindows {
3174 #[WindowLink $win.previous] config -state $prev
3175 #[WindowLink $win.next] config -state $next
3180 proc InitScenario
{win
} {
3181 global MapHistory MapHistoryNum
3182 if {$MapHistoryNum < 1} {
3188 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3195 #[WindowLink $win.previous] config -state $prev
3196 #[WindowLink $win.next] config -state $next
3198 LinkWindow
$win.scenarioTarget
-1
3199 LinkWindow
$win.scenarioTargetDown
-1
3201 global ScenarioButtons
3203 set len
[llength $ScenarioButtons]
3205 set data
[lindex $ScenarioButtons $i]
3206 set type
[lindex $data 0]
3207 set id
[lindex $data 1]
3211 LinkWindow
$win.
$id.over
0
3212 LinkWindow
$win.
$id.enabled
1
3213 LinkWindow
$win.
$id.checked
0
3214 #echo "SETTING WIN $win ID $id"
3216 set i
[expr "$i + 1"]
3219 UpdateLevelSelection
$win
3220 UpdateLeftRightEnabled
$win
3224 proc UpdateLevelSelection
{win
} {
3225 #echo UpdateLevelSelection
3227 if {$GameLevel == 0} then
{
3228 LinkWindow
$win.easy.checked
1
3229 LinkWindow
$win.medium.checked
0
3230 LinkWindow
$win.hard.checked
0
3232 if {$GameLevel == 1} then
{
3233 LinkWindow
$win.easy.checked
0
3234 LinkWindow
$win.medium.checked
1
3235 LinkWindow
$win.hard.checked
0
3237 if {$GameLevel == 2} then
{
3238 LinkWindow
$win.easy.checked
0
3239 LinkWindow
$win.medium.checked
0
3240 LinkWindow
$win.hard.checked
1
3243 UpdateScenarioButtonID
$win easy
3244 UpdateScenarioButtonID
$win medium
3245 UpdateScenarioButtonID
$win hard
3250 proc UpdateLeftRightEnabled
{win
} {
3251 #echo UpdateLeftRightEnabled
3253 global MapHistory MapHistoryNum
3254 if {$MapHistoryNum < 1} {
3255 LinkWindow
$win.left.enabled
0
3257 LinkWindow
$win.left.enabled
1
3260 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3261 LinkWindow
$win.right.enabled
0
3263 LinkWindow
$win.right.enabled
1
3266 UpdateScenarioButtonID
$win left
3267 UpdateScenarioButtonID
$win right
3271 proc UpdateScenarioButtonID
{win id
} {
3273 global ScenarioButtons
3275 set len
[llength $ScenarioButtons]
3277 set data
[lindex $ScenarioButtons $i]
3279 if {$id == [lindex $data 1]} then
{
3280 UpdateScenarioButton
$win $data
3284 set i
[expr "$i + 1"]
3289 proc UpdateScenarioButton
{win data
} {
3292 set type
[lindex $data 0]
3293 set id
[lindex $data 1]
3294 set over
[WindowLink
$win.
$id.over
]
3295 set enabled
[WindowLink
$win.
$id.enabled
]
3296 set checked
[WindowLink
$win.
$id.checked
]
3297 #echo "WIN $win TYPE $type ID $id OVER $over ENABLED $enabled CHECKED $checked"
3299 if {[lindex ${data
} 2] == "DoPickScenario"} {
3300 catch {text $win.desc
\
3305 -font [Font
$win Large
]}
3307 $win.desc configure
-state normal
3308 $win.desc delete
0.0 end
3309 $win.desc insert end
"[lindex $Messages([lindex ${data} 3]) 1]\n\n[lindex $Messages([lindex ${data} 3]) 2]"
3310 $win.desc configure
-state disabled
3312 place $win.desc
-x 232 -y 170 -width 280 -height 285
3315 catch {destroy $win.desc
}
3320 set bm
[lindex $data 13]
3322 set bm
[lindex $data 12]
3326 set bm
[lindex $data 10]
3328 set bm
[lindex $data 9]
3332 set bm
[lindex $data 11]
3335 [WindowLink
$win.
canvas] itemconfig
$id -bitmap $bm
3339 proc DoEnterCityName
{win
} {
3343 proc InitVotesForUseThisMap
{} {
3344 # TODO: Disabled for new scenario window.
3347 global VotesForUseThisMap ScenarioWindows
3348 set VotesForUseThisMap
{}
3349 foreach win
$ScenarioWindows {
3350 [WindowLink
$win.vote
] config
-relief raised
3352 UpdateVotesForUseThisMap
3356 proc UpdateVotesForUseThisMap
{} {
3357 global ScenarioWindows
3358 UpdateVotesFor UseThisMap
$ScenarioWindows
3362 proc UIUseThisMap
{} {
3363 global CityName GameLevel Scenario
3365 # special handling for scenarios?
3366 if {$GameLevel != -1} {
3367 sim GameLevel
$GameLevel
3369 sim CityName
$CityName
3372 if {$Scenario != -1} {
3373 UIShowPicture
$Scenario
3378 proc HandleScenarioDown
{win x y
} {
3379 #echo HandleScenarioDown $win $x $y
3380 HandleScenarioMove
$win $x $y
3381 set w
[WindowLink
$win.w
]
3382 set target
[WindowLink
$w.scenarioTarget
]
3383 LinkWindow
$w.scenarioTargetDown
$target
3387 proc HandleScenarioUp
{win x y
} {
3388 #echo HandleScenarioUp $win $x $y
3389 HandleScenarioMove
$win $x $y
3390 global ScenarioButtons
3391 set w
[WindowLink
$win.w
]
3392 set target
[WindowLink
$w.scenarioTarget
]
3393 set targetDown
[WindowLink
$w.scenarioTargetDown
]
3394 if {($target != -1) &&
3395 ($target == $targetDown)} {
3396 set data
[lindex $ScenarioButtons $target]
3397 set type
[lindex $data 0]
3398 set id
[lindex $data 1]
3399 set callback
[lindex $data 2]
3400 set param
[lindex $data 3]
3401 set var
[lindex $data 4]
3402 set xx
[lindex $data 5]
3403 set yy
[lindex $data 6]
3404 set ww
[lindex $data 7]
3405 set hh
[lindex $data 8]
3406 set normal
[lindex $data 9]
3407 set over
[lindex $data 10]
3408 set disabled
[lindex $data 11]
3409 if {$type == "button"} {
3410 #echo callback $callback w $w param $param
3411 eval "$callback $w {$param}"
3413 if {$type == "checkbox"} {
3414 #echo checkbox callback $callback w $w param $param
3415 eval "$callback $w {$param}"
3422 proc HandleScenarioMove
{win x y
} {
3423 #echo HandleScenarioMove $win $x $y
3424 global ScenarioButtons
3425 set w
[WindowLink
$win.w
]
3426 set target
[WindowLink
$w.scenarioTarget
]
3429 set len
[llength $ScenarioButtons]
3431 set data
[lindex $ScenarioButtons $i]
3432 set type
[lindex $data 0]
3433 set id
[lindex $data 1]
3434 set callback
[lindex $data 2]
3435 set param
[lindex $data 3]
3436 set var
[lindex $data 4]
3437 set xx
[lindex $data 5]
3438 set yy
[lindex $data 6]
3439 set ww
[lindex $data 7]
3440 set hh
[lindex $data 8]
3442 set enabled
[WindowLink
$w.
$id.enabled
]
3443 set checked
[WindowLink
$w.
$id.checked
]
3445 #echo "ID $id ENABLED $enabled CHECKED $checked w $w id $id"
3447 if {($enabled != 0) &&
3449 ($x < ($xx + $ww)) &
3451 ($y < ($yy + $hh))} {
3456 set i
[expr "$i + 1"]
3459 if {$found != $target} {
3462 if {$target != -1} {
3464 #echo OUT $w $found $xx $yy $normal
3465 LinkWindow
$w.scenarioTarget
-1
3467 set targetdata
[lindex $ScenarioButtons $target]
3468 set targetid
[lindex $targetdata 1]
3469 LinkWindow
$w.
$targetid.over
0
3470 UpdateScenarioButton
$w $targetdata
3475 #echo IN $w $found $xx $yy $over
3476 LinkWindow
$w.scenarioTarget
$found
3477 LinkWindow
$w.
$id.over
1
3479 if {$target != -1} {
3480 set targetdata
[lindex $ScenarioButtons $target]
3481 set targetid
[lindex $targetdata 1]
3482 LinkWindow
$w.
$targetid.over
0
3483 UpdateScenarioButton
$w $targetdata
3486 UpdateScenarioButton
$w $data
3492 proc DoLoad
{win param
} {
3493 #echo DOLOAD $win $param
3498 proc DoGenerate
{win param
} {
3499 #echo DOGENERATE $win $param
3504 proc DoQuit
{win param
} {
3505 #echo DOQUIT $win $param
3510 proc DoAbout
{win param
} {
3511 #echo DOABOUT $win $param
3512 MakeHistory
"DoLoadCity cities/about.cty"
3516 proc DoMap
{win param
} {
3517 #echo DOMAP $win $param
3521 proc DoLevel
{win param
} {
3522 #echo DOLEVEL $win $param
3523 DoSetGameLevel
$param
3527 proc DoLeft
{win param
} {
3528 #echo DOLEFT $win $param
3533 proc DoRight
{win param
} {
3534 #echo DORIGHT $win $param
3539 proc DoPlay
{win param
} {
3540 #echo DOPLAY $win $param
3545 proc DoPickScenario
{win param
} {
3546 #echo DOPICKSCENARIO $win $param
3547 UILoadScenario
$param
3550 proc DeleteScenarioWindow
{win
} {
3555 ########################################################################
3556 # Undo/Redo Facility
3559 proc InitHistory
{} {
3561 global MapHistoryNum
3563 set MapHistoryNum
-1
3567 proc MakeHistory
{cmd
} {
3569 set len
[llength $MapHistory]
3571 ($cmd != [lindex $MapHistory [expr $len-1]])} {
3572 lappend MapHistory
$cmd
3580 proc GotoHistory
{i
} {
3582 global MapHistoryNum
3583 InitVotesForUseThisMap
3584 if {$i != $MapHistoryNum} {
3585 set MapHistoryNum
$i
3586 set cmd
[lindex $MapHistory $i]
3589 if {$MapHistoryNum == 0} {
3594 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3600 global ScenarioWindows
3601 foreach win
$ScenarioWindows {
3602 UpdateLeftRightEnabled
$win
3608 proc NextHistory
{} {
3610 global MapHistoryNum
3611 set len
[llength $MapHistory]
3612 set i
[expr "$MapHistoryNum + 1"]
3619 proc PrevHistory
{} {
3621 global MapHistoryNum
3622 set i
[expr "$MapHistoryNum - 1"]
3629 ########################################################################
3630 # Ask Window Handlers
3632 proc ShowAskOf
{head
} {
3633 set win
[WindowLink
$head.ask
]
3635 set win
[MakeWindow.ask
$head [winfo screen
$head]]
3645 foreach win
$HeadWindows {
3651 proc WithdrawAsks
{} {
3653 foreach win
$AskWindows {
3659 proc WithdrawAskOf
{win
} {
3660 set ask
[WindowLink
$win.ask
]
3667 proc AskQuestion
{color title
text left middle right
} {
3669 foreach win
$HeadWindows {
3670 AskQuestionOn
$win $color $title $text $left $middle $right
3675 proc AskQuestionOn
{head color title
text left middle right
} {
3678 set win
[WindowLink
$head.ask
]
3679 set t
[WindowLink
$win.title
]
3680 $t configure
-text $title
3681 $t configure
-background $color
3683 set t
[WindowLink
$win.
text]
3684 $t configure
-state normal
3686 $t insert end
"${text}\n"
3687 $t configure
-state disabled
3689 set bf
[WindowLink
$win.
frame]
3690 set l
[WindowLink
$win.left
]
3691 set m
[WindowLink
$win.middle
]
3692 set r
[WindowLink
$win.vote
]
3693 set rf
[WindowLink
$win.voteframe
]
3697 -text [lindex $left 0] \
3698 -command [format [lindex $left 2] $head]
3699 SetHelp
$l [lindex $left 1]
3700 pack append $bf $l {left
frame center
}
3705 if {$middle != ""} {
3707 -text [lindex $middle 0] \
3708 -command [format [lindex $middle 2] $head]
3709 SetHelp
$m [lindex $middle 1]
3710 pack append $bf $m {left
frame center expand
}
3716 set notify
[format [lindex $right 2] $head]
3717 set preview
[format [lindex $right 3] $head]
3718 set cmd
[list DoVote
$win Ask
$notify $preview]
3720 -text [lindex $right 0] \
3722 SetHelp
$r [lindex $right 1]
3723 pack append $bf $rf {right
frame center
}
3732 proc BindVotingButton
{win but name
} {
3733 set w
[WindowLink
$win.top
]
3735 bind $but <Any-Enter
> "VoteButtonEnter $win $but"
3736 bind $but <Any-Leave
> "VoteButtonLeave $win $but"
3737 bind $but <1> "VoteButtonDown $win $but $name"
3738 bind $but <ButtonRelease-1
> "VoteButtonUp $win $but $name"
3739 bind $but <2> "VoteButtonDown $win $but $name"
3740 bind $but <ButtonRelease-2
> "VoteButtonUp $win $but $name"
3741 bind $but <3> "VoteButtonDown $win $but $name"
3742 bind $but <ButtonRelease-3
> "VoteButtonUp $win $but $name"
3746 proc VoteButtonEnter
{win but
} {
3748 set screen
[winfo screen
$but]
3749 if {[lindex [$but config
-state] 4] != "disabled"} {
3750 $but config
-state active
3751 set tk_priv
(window
@$screen) $but
3753 set tk_priv
(window
@$screen) ""
3758 proc VoteButtonLeave
{win but
} {
3760 if {[lindex [$but config
-state] 4] != "disabled"} {
3761 $but config
-state normal
3763 set screen
[winfo screen
$but]
3764 set tk_priv
(window
@$screen) ""
3768 proc VoteButtonDown
{win but name
} {
3770 set screen
[winfo screen
$but]
3771 set rel
[lindex [$but config
-relief] 4]
3772 set tk_priv
(relief
@$screen) $rel
3773 if {[lindex [$but config
-state] 4] != "disabled"} {
3774 set head
[WindowLink
$win.head
]
3775 if {[IsVotingFor
$head $name]} {
3776 $but config
-relief raised
3778 $but config
-relief sunken
3784 proc VoteButtonUp
{win but name
} {
3786 set screen
[winfo screen
$but]
3787 $but config
-relief $tk_priv(relief
@$screen)
3788 if {($but == $tk_priv(window
@$screen))
3789 && ([lindex [$but config
-state] 4] != "disabled")} {
3790 uplevel #0 [list $but invoke]
3791 set head
[WindowLink
$win.head
]
3792 if {[IsVotingFor
$head $name]} {
3793 $but config
-relief sunken
3795 $but config
-relief raised
3801 proc PressVoteButton
{win but name
} {
3803 uplevel #0 [list $but invoke]
3804 set head
[WindowLink
$win.head
]
3805 if {[IsVotingFor
$head $name]} {
3806 $but config
-relief sunken
3808 $but config
-relief raised
3813 proc IsVotingFor
{win name
} {
3814 global VotesFor
$name
3815 set votes
[eval ident
"\$\{VotesFor$name\}"]
3816 if {[lsearch $votes $win] == -1} {
3824 proc DoVote
{win name notify preview
} {
3825 global VotesFor
$name
3826 set votes
[eval ident
"\$\{VotesFor$name\}"]
3828 set win
[WindowLink
$win.head
]
3829 set i
[lsearch $votes $win]
3831 lappend VotesFor
$name $win
3833 set VotesFor
$name [lreplace $votes $i $i]
3836 set votes
[eval ident
"\$\{VotesFor$name\}"]
3837 if {[llength $votes] >= [NeededVotes
]} {
3845 proc UpdateVotesFor
{name wins
} {
3846 global VotesFor
$name
3847 set votes
[eval llength "\$\{VotesFor$name\}"]
3848 set needed
[NeededVotes
]
3851 set head
[WindowLink
$win.head
]
3852 if {[IsVotingFor
$head $name]} {
3853 set border
[expr "($needed - $votes) * 1"]
3854 set pad
[expr "6 - $border"]
3855 [WindowLink
$win.vote
] config
-padx $pad -pady $pad
3856 [WindowLink
$win.voteframe
] config
-borderwidth $border
3858 set border
[expr "($needed - $votes - 1) * 1"]
3859 set pad
[expr "6 - $border"]
3860 [WindowLink
$win.vote
] config
-padx $pad -pady $pad
3861 [WindowLink
$win.voteframe
] config
-borderwidth $border
3867 proc InitVotesForAsk
{} {
3868 global VotesForAsk AskWindows
3870 foreach win
$AskWindows {
3871 [WindowLink
$win.vote
] config
-relief raised
3878 proc UpdateVotesForAsk
{} {
3880 UpdateVotesFor Ask
$AskWindows
3884 ########################################################################
3885 # Player Window Handlers
3887 proc ShowPlayerOf
{head
} {
3888 set win
[WindowLink
$head.player
]
3890 set win
[MakeWindow.player
$head [winfo screen
$head]]
3898 proc ShowPlayers
{} {
3900 foreach win
$HeadWindows {
3906 proc WithdrawPlayers
{} {
3907 global PlayerWindows
3908 foreach win
$PlayerWindows {
3914 proc UpdatePlayers
{} {
3915 # TODO: Disabled for new scenario window.
3918 global HeadWindows PlayerWindows
3921 foreach win
$HeadWindows {
3922 set server
[winfo screen
$win]
3923 # if {[string first : $server] == 0} {
3924 # set server "[exec hostname]:0"
3926 lappend players
$server
3929 sim Players
[llength $players]
3931 foreach win
$PlayerWindows {
3932 set list [WindowLink
$win.players
]
3934 eval "$list insert 0 $players"
3937 UpdateVotesForUseThisMap
3939 UpdateVotesForBudget
3940 UpdateTaxRateSliders
3944 proc UIShowPlayer
{win
} {
3949 proc DoNewPlayer
{win
} {
3950 set field
[WindowLink
$win.display
]
3951 set dpy
[$field get
]
3956 if {[AddPlayer
$dpy] != ""} {
3962 ########################################################################
3963 # Notice Window Handlers
3966 proc ShowNoticeOf
{head
} {
3967 set win
[WindowLink
$head.notice
]
3969 set win
[MakeWindow.notice
$head [winfo screen
$head]]
3971 global NoticePanelWidth NoticePanelHeight
3972 #place configure $win -x 0 -y 0 -width $NoticePanelWidth -height $NoticePanelHeight
3973 pack append [WindowLink
$head.w3
] \
3974 $win {bottom
frame sw expand fill
}
3979 proc ShowNotices
{} {
3981 foreach win
$HeadWindows {
3987 proc WithdrawNotices
{} {
3988 global NoticeWindows
3989 foreach win
$NoticeWindows {
3996 proc ReShowPictureOn
{{head
""}} {
3997 global ShowingPicture ShowingParms
3998 UIShowPictureOn
$head $ShowingPicture $ShowingParms
4002 proc UIShowPicture
{id
{parms
""}} {
4003 UIShowPictureOn
"" $id $parms
4007 proc UIShowPictureOn
{where id
{parms
""}} {
4008 global DoNotices Messages ShowingPicture ShowingParms
4009 if {$DoNotices == 0} {
4013 set ShowingPicture
$id
4014 set ShowingParms
$parms
4015 set msg
$Messages($id)
4016 set color
[lindex $msg 0]
4017 set title
[lindex $msg 1]
4018 set body
[lindex $msg 2]
4020 set cmd
"format {$body} $parms"
4021 set body
[uplevel #0 $cmd]
4023 set props
[lindex $msg 3]
4024 if {"$where" == ""} {
4026 set where
$HeadWindows
4028 foreach head
$where {
4029 NoticeMessageOn
$head "$title" $color "$body" Medium
$props
4034 proc NoticeMessageOn
{head title color
text font props
} {
4036 set win
[WindowLink
$head.notice
]
4038 set t
[WindowLink
$win.title
]
4039 $t configure
-text $title -background $color
4041 set t
[WindowLink
$win.
text]
4042 $t configure
-state normal
-font [Font
$head $font]
4044 $t insert end
"${text}\n"
4045 $t configure
-state disabled
4048 catch {set left
[keylget props left
]}
4049 set l
[WindowLink
$win.left
]
4051 $l config
-bitmap $left
4052 place $l -in $t -anchor sw
-relx .05 -rely .95
4058 catch {set middle
[keylget props middle
]}
4059 set m
[WindowLink
$win.middle
]
4060 if {$middle != ""} {
4061 $m config
-bitmap $middle
4062 place $m -in $t -anchor s
-relx .5 -rely .95
4068 catch {set right
[keylget props right
]}
4069 set r
[WindowLink
$win.right
]
4071 $r config
-bitmap $right
4072 place $r -in $t -anchor se
-relx .95 -rely .95
4078 catch {set view
[keylget props view
]}
4079 set vf
[WindowLink
$win.viewframe
]
4081 set v
[WindowLink
$win.view
]
4082 set bg
[WindowLink
$win.background
]
4086 pack append $bg $vf {left
frame center fill
}
4087 pack append $bg $t {right
frame center fill expand
}
4094 proc UIPopUpMessage
{msg
} {
4099 proc ComeToMe
{view
} {
4100 set win
[winfo toplevel $view]
4103 set x
[expr "[lindex $xy 0] >>4"]
4104 set y
[expr "[lindex $xy 1] >>4"]
4110 proc ComeTo
{win x y
} {
4111 global EditorWindows
4112 set head
[WindowLink
$win.head
]
4115 foreach ed
$EditorWindows {
4116 if {"[WindowLink $ed.head]" == "$head"} {
4118 set view
[WindowLink
$ed.view
]
4119 if {[$view AutoGoto
]} {
4120 lappend myautoeds
$ed
4124 if {[llength $myautoeds]} {
4125 UIAutoGotoOn
$x $y $myautoeds
4127 if {[llength $myeds]} {
4128 UIAutoGotoOn
$x $y $myeds
4134 proc FollowView
{view id
} {
4138 if {[sim DoAnimation
]} {
4139 set head
[WindowLink
[winfo toplevel $view].head
]
4140 global EditorWindows
4141 foreach win
$EditorWindows {
4142 if {"[WindowLink $win.head]" == "$head"} {
4143 set s
[[WindowLink
$win.view
] Skip
]
4144 set skips
[min
$skips $s]
4148 if {$skips == 999999} {
4158 proc PanView
{view x y
} {
4164 ########################################################################
4165 # Help Window Handlers
4168 proc ShowHelpOf
{head
} {
4169 set win
[WindowLink
$head.help
]
4171 set win
[MakeWindow.help
$head [winfo screen
$head]]
4181 foreach win
$HeadWindows {
4187 proc WithdrawHelps
{} {
4189 foreach win
$HelpWindows {
4195 ########################################################################
4196 # Frob Window Handlers
4199 proc ShowFrobOf
{head
} {
4200 set win
[WindowLink
$head.frob
]
4202 set win
[MakeWindow.frob
$head [winfo screen
$head]]
4213 foreach win
$HeadWindows {
4219 proc WithdrawFrobs
{} {
4221 foreach win
$FrobWindows {
4227 proc UISetDynamic
{i min max
} {
4228 sim DynamicData
[expr "$i*2"] $min
4229 sim DynamicData
[expr "$i*2+1"] $max
4233 ########################################################################
4240 source $ResourceDir/help.tcl
4243 proc HandleHelp
{win x y rootx rooty
} {
4244 global HelpLoaded HelpWidgets Messages
4246 if {$HelpLoaded == 0} {
4252 set head
[WindowLink
[winfo toplevel $win].head
]
4255 catch {set id
$HelpWidgets($win)}
4259 set list [split $win .
]
4260 set len
[expr "[llength $list] - 2"]
4261 set list [lrange $list 0 $len]
4262 if {[llength $list] <= 1} {
4266 set win
[join $list .
]
4268 if [info exists Messages
($id)] {
4269 UIShowHelpOn
$head $id
4271 UIShowHelpOn
$head Window
4276 proc UIShowHelpOn
{win id
{parms
""}} {
4277 global Messages ShowingPicture ShowingParms ResourceDir
4278 set head
[WindowLink
$win.head
]
4279 set msg
$Messages($id)
4280 set color
[lindex $msg 0]
4281 set title
[lindex $msg 1]
4282 set body
[lindex $msg 2]
4284 set cmd
"format {$body} $parms"
4285 set body
[uplevel #0 $cmd]
4287 set props
[lindex $msg 3]
4290 set win
[WindowLink
$head.help
]
4292 set t
[WindowLink
$win.title
]
4293 $t configure
-text $title -background $color
4295 set t
[WindowLink
$win.
text]
4296 $t configure
-state normal
-font [Font
$head Large
]
4298 $t insert end
"${body}\n"
4299 FormatHTML
$ResourceDir/doc
/$id.html
$t
4300 $t configure
-state disabled
4304 proc FormatHTML
{filename text} {
4307 set f
[open $filename]
4314 while {[gets $f line
] >= 0} {
4315 if {"$line" == "</body>"} {
4318 if {([string index
$line 0] == "#") ||
([string length
$line] == 0)} {
4321 $text insert end
"$line\n"
4330 proc SetHelp
{win id
} {
4332 set HelpWidgets
($win) $id
4336 proc Help
{id title
{msg
{}} {props
{}}} {
4337 Message
$id #7f7fff $title $msg $props
4340 ########################################################################
4344 # Set up the bindings to pop up $pie when the right button is clicked in $win
4345 proc InitPie
{win pie
} {
4346 bind $win <Motion
> {}
4347 bind $win <3> "PieMenuDown $win $pie $pie Initial %X %Y"
4348 bind $win <B3-Motion
> {}
4349 bind $win <B3-ButtonRelease
> {}
4353 # Set up the bindings to continue tracking $pie
4354 # Get this: we keep the tracking machine state in the bindings!
4355 proc ActivatePie
{win root pie state
} {
4356 bind $win <Motion
> "PieMenuMotion $win $root $pie $state %X %Y"
4357 bind $win <3> "PieMenuDown $win $root $pie $state %X %Y"
4358 bind $win <B3-Motion
> "PieMenuMotion $win $root $pie $state %X %Y"
4359 bind $win <B3-ButtonRelease
> "PieMenuUp $win $root $pie $state %X %Y"
4363 # Cancel and reset a pie menu
4364 proc CancelPie
{win
} {
4365 set binding
[bind $win <3>]
4366 set root
[lindex $binding 2]
4367 set pie
[lindex $binding 3]
4368 set state
[lindex $binding 4]
4369 if {"$state" != "Initial"} {
4370 catch {$root ungrab
$win}
4373 UIMakeSoundOn
$win fancy Oop
4379 # Handle pie menu button down
4380 proc PieMenuDown
{win root pie state x y
} {
4383 ActivatePie
$win $root $pie FirstDown
4385 catch {$root grab $win}
4388 PreviewPieMenu
$win $pie $x $y
4392 TrackPieMenu
$pie $x $y
4393 ActivatePie
$win $root $pie SecondDown
4399 PreviewPieMenu
$win $pie $x $y
4400 ActivatePie
$win $root $pie SecondDown
4405 SecondDown
{ # error
4412 # Handle pie menu button motion
4413 proc PieMenuMotion
{win root pie state x y
} {
4416 TrackPieMenu
$pie $x $y
4424 TrackPieMenu
$pie $x $y
4438 # Handle pie menu button up
4439 proc PieMenuUp
{win root pie state x y
} {
4442 TrackPieMenu
$pie $x $y
4443 set active
[$pie index active
]
4444 if {$active == "none"} {
4446 catch {$root grab $win}
4447 ActivatePie
$win $root $pie ClickedUp
4449 set label [lindex [$pie entryconfig
$active -label] 4]
4450 set submenu
[lindex [$pie entryconfig
$active -piemenu] 4]
4451 UIMakeSoundOn
$win mode
$label
4452 if {$submenu == {}} {
4453 set reward
[$pie pending
]
4454 catch {$root ungrab
$win}
4458 sim Funds
[expr "[sim Funds] + 5"]
4459 UIMakeSoundOn
$win fancy Aaah
4461 eval [lindex [$pie entryconfig
$active -command] 4]
4466 $submenu activate none
4468 PreviewPieMenu
$win $submenu $x $y
4469 catch {$root grab $win}
4470 ActivatePie
$win $root $submenu SelectedUp
4475 TrackPieMenu
$pie $x $y
4476 set active
[$pie index active
]
4477 if {$active == "none"} {
4480 set label [lindex [$pie entryconfig
$active -label] 4]
4481 set submenu
[lindex [$pie entryconfig
$active -piemenu] 4]
4482 UIMakeSoundOn
$win mode
$label
4483 if {$submenu == {}} {
4484 set reward
[$pie pending
]
4485 catch {$root ungrab
$win}
4489 sim Funds
[expr "[sim Funds] + 5"]
4490 UIMakeSoundOn
$win fancy Aaah
4492 eval [lindex [$pie entryconfig
$active -command] 4]
4497 $submenu activate none
4499 PreviewPieMenu
$win $submenu $x $y
4500 catch {$root grab $win}
4501 ActivatePie
$win $root $submenu SelectedUp
4511 SelectedUp
{ # error
4518 # Track the selected item
4519 proc TrackPieMenu
{pie x y
} {
4520 $pie activate
@$x,$y
4524 proc PreviewPieMenu
{win pie x y
} {
4525 set preview
[lindex [$pie config
-preview] 4]
4526 if {"$preview" != ""} {
4527 set rx
[winfo rootx
$win]
4528 set ry
[winfo rooty
$win]
4529 set x
[expr "$x - $rx"]
4530 set y
[expr "$y - $ry"]
4531 eval [format $preview $x $y]
4536 ########################################################################
4540 proc ExclusivePallet
{state parent children prefix images inactive active cmd
} {
4541 #echo "ExclusivePallet state $state parent $parent children $children prefix $prefix images $images inactive $inactive active $active cmd $cmd"
4543 foreach child
$children {
4544 set name
[lindex $images $i]
4545 if {$i == $state} then
{
4546 $parent.
$child config
\
4547 -bitmap "@images/${prefix}${name}hi.xpm" \
4550 $parent.
$child config
\
4551 -bitmap "@images/${prefix}${name}.xpm" \
4556 eval [concat $cmd $state]
4560 proc NonExclusivePallet
{mask parent children prefix images
4561 inactive active cmd
} {
4563 foreach child
$children {
4564 set name
[lindex $images $i]
4565 if {$mask & (1<<$i)} then
{
4566 $parent.
$child config
\
4567 -bitmap "@images/${prefix}${name}hi.xpm" \
4570 $parent.
$child config
\
4571 -bitmap "@images/${prefix}${name}.xpm" \
4576 eval [concat $cmd $mask]
4580 proc EditorPallet
{win state
} {
4581 global EditorPalletSounds
4582 UIMakeSoundOn
$win mode
[lindex $EditorPalletSounds $state]
4583 EditorSetTool
$win $state
4587 proc EditorSetTool
{win state
} {
4588 global EditorPallets
4589 global EditorPalletImages
4590 ExclusivePallet
$state $win $EditorPallets ic
$EditorPalletImages \
4591 flat raised
"$win.centerframe.view ToolState"
4595 proc GraphPallet
{win state
} {
4596 set mask
[[WindowLink
$win.graphview
] Mask
]
4597 set mask
[expr "$mask ^ (1<<$state)"]
4598 GraphPalletMask
$win $mask
4602 proc GraphPalletMask
{win mask
} {
4604 global GraphPalletImages
4605 NonExclusivePallet
$mask $win $GraphPallets gr
$GraphPalletImages \
4606 flat flat
"SetGraphState $win"
4610 proc GraphYearPallet
{win state
} {
4611 global GraphYearPallets
4612 global GraphYearPalletImages
4613 ExclusivePallet
$state $win $GraphYearPallets gr
$GraphYearPalletImages \
4614 flat flat
"SetGraphYearState $win"
4618 proc SetGraphYearState
{win state
} {
4619 set graph
[WindowLink
$win.graphview
]
4628 proc SetGraphState
{win mask
} {
4630 set graph
[WindowLink
$win.graphview
]
4635 ########################################################################
4638 proc sim_butEnter
{w
} {
4640 set screen
[winfo screen
$w]
4641 set tk_priv
(window
@$screen) $w
4645 proc sim_butLeave
{w
} {
4647 set screen
[winfo screen
$w]
4648 set tk_priv
(window
@$screen) ""
4652 proc sim_butDown
{w
} {
4654 set screen
[winfo screen
$w]
4655 set pict
[lindex [$w config
-bitmap] 4]
4656 set tk_priv
(relief
@$screen) $pict
4657 $w config
-bitmap [lindex [split $pict .
] 0]hi.xpm
4662 proc sim_butUp
{w
} {
4664 set screen
[winfo screen
$w]
4665 $w config
-bitmap $tk_priv(relief
@$screen)
4667 if {$w == $tk_priv(window
@$screen)} {
4668 uplevel #0 [list $w invoke]
4673 proc BindSimButton
{w
} {
4674 bind $w <Any-Enter
> {sim_butEnter
%W
}
4675 bind $w <Any-Leave
> {sim_butLeave
%W
}
4676 bind $w <1> {sim_butDown
%W
}
4677 bind $w <ButtonRelease-1
> {sim_butUp
%W
}
4678 bind $w <2> {sim_butDown
%W
}
4679 bind $w <ButtonRelease-2
> {sim_butUp
%W
}
4680 bind $w <3> {sim_butDown
%W
}
4681 bind $w <ButtonRelease-3
> {sim_butUp
%W
}
4685 ########################################################################
4686 # Internal Callbacks
4689 proc UIStartMicropolis
{homedir resourcedir hostname
} {
4690 global HomeDir ResourceDir HostName HeadWindows
4691 set HomeDir
$homedir
4692 set ResourceDir
$resourcedir
4693 set HostName
$hostname
4698 foreach display
[sim Displays
] {
4699 if {"[AddPlayer $display]" == ""} {
4700 echo Couldn't add a player on
$display ...
4704 if {"$HeadWindows" == ""} {
4705 echo Micropolis is exiting because it couldn't connect to any players.
4711 proc UISelectCity
{win
} {
4712 AskQuestion
[Color
$win #ff0000 #ffffff] "Choose Another City" \
4713 "Do you want to abandon this city and choose another one?" \
4714 "{Keep playing.} SelectCity.No {RejectPlan}" \
4716 "{Another city!} SelectCity.Yes {UIPickScenarioMode}"
4720 proc UIQuit
{head
} {
4721 if {[sim Players
] == 1} {
4722 set l
"{Keep playing.} Quit.No {RejectPlan}"
4724 set r
"{I quit!} Quit.IQuit {DoReallyQuit %s}"
4726 set l
"{Keep playing.} Quit.No {RejectPlan}"
4727 set m
"{I quit!} Quit.IResign {DoIResign %s}"
4728 set r
"{Everyone quit!} Quit.AllQuit {DoReallyQuit %s}"
4730 AskQuestion
[Color
$head #ff0000 #ffffff] "Quit Playing Micropolis" \
4731 "Do you want to quit playing Micropolis?" \
4736 proc DoIResign
{head
} {
4738 set display
[winfo screen
$head]
4740 DecRefDisplay
$display
4741 UISetMessage
"The player on X11 Display $display has resigned."
4743 if {([sim Players
] == 0) ||
4744 ([llength $VotesForAsk] >= [sim Players
])} {
4750 proc DoReallyQuit
{head
} {
4756 proc UISplashMode
{} {
4766 proc UIPickScenarioMode
{} {
4775 InitVotesForUseThisMap
4780 proc ForcePickScenarioMode
{} {
4782 if {"$State" != "scenario"} {
4788 proc UIGenerateCityNow
{} {
4789 global CityName GameLevel
4790 sim CityName NowHere
4796 proc UIGenerateNewCity
{} {
4797 global CityName GameLevel
4798 if {$GameLevel == -1} {
4801 MakeHistory
"DoNewCity NowHere $GameLevel [sim Rand] [sim TreeLevel] [sim LakeLevel] [sim CurveLevel] [sim CreateIsland]"
4805 proc DoNewCity
{name level
{r
""} {tl
-1} {ll
-1} {cl
-1} {ci
-1}} {
4811 sim CreateIsland
$ci
4815 sim GenerateSomeCity
$r
4818 sim GameLevel
$level
4823 proc UIDidGenerateNewCity
{} {
4828 proc IncRefDisplay
{display
} {
4829 global DisplayRegistry
4830 if ![info exists DisplayRegistry
($display)] {
4831 set DisplayRegistry
($display) 0
4833 incr DisplayRegistry
($display)
4837 proc DecRefDisplay
{display
} {
4838 global DisplayRegistry
4839 incr DisplayRegistry
($display) -1
4840 if {$DisplayRegistry($display) <= 0} {
4841 CloseDisplay
$display
4846 proc CloseDisplay
{display
} {
4850 proc DoStopMicropolis
{} {
4856 proc AddPlayer
{display
} {
4857 set i
[string first
: $display]
4861 set display
"$display:0"
4865 echo Adding a player on
$display ...
4867 set head
[MakeWindow.head
$display]
4869 if {"$head" != ""} {
4870 set display
[winfo screen
$head]
4871 IncRefDisplay
$display
4873 UISetMessage
"Added a player on X11 Display \"$display\"."
4876 UISetMessage
"Couldn't add a player on X11 Display \"$display\"!"
4886 proc DropFireBombs
{} {
4894 proc UIMakeMonster
{} {
4895 sim MakeMonster
[sim Rand
120] [sim Rand
100]
4918 proc TogglePause
{} {
4921 if {"$State" != "play" ||
[sim Speed
]} {
4932 proc SetSpeedTime
{time} {
4938 proc MakeRunningSound
{} {
4941 if {"$State" == "play" && [sim Speed
]} {
4942 UIMakeSound edit Boing
"-speed 1[sim Speed]0"
4944 UIMakeSound edit Boing
"-speed 90"
4949 proc SayDemands
{} {
4950 global DemandRes DemandCom DemandInd
4952 set r
[expr "100 + ($DemandRes * $slope)"]
4953 set c
[expr "100 + ($DemandCom * $slope)"]
4954 set i
[expr "100 + ($DemandInd * $slope)"]
4955 after 020 "UIMakeSound edit O \"-speed $r\""
4956 after 220 "UIMakeSound edit A \"-speed $c\""
4957 after 440 "UIMakeSound edit E \"-speed $i\""
4961 proc UISaveCity
{win
} {
4963 set SaveCityWin
$win
4968 proc UISaveCityAs
{{win
""}} {
4970 if {"$win" == ""} {set win
$SaveCityWin}
4971 set SaveCityWin
$win
4974 set file [ShowFileOf
$win]
4975 DoFileDialog
$file "Choose a File to Save the City" $CityDir "*.cty" "" \
4976 "UIDoReallySaveCity" ""
4980 proc UIDoReallySaveCity
{name path
} {
4982 if {![string match
*.cty
$name]} {
4986 sim SaveCityAs
$path/$name
4990 proc UIDidSaveCity
{} {
4991 DoSendMessage
"Saved the city in \"[sim CityFileName]\"." status
4995 proc UIDidntSaveCity
{msg
} {
4996 DoSendMessage
$msg alert
4997 UIMakeSound warning Sorry
"-speed 85"
5001 proc UILoadScenario
{scen
} {
5002 MakeHistory
"DoScenario $scen"
5006 proc DoScenario
{scen
} {
5009 sim LoadScenario
$scen
5014 proc UIDidLoadScenario
{} {
5018 proc UIStartScenario
{id
} {
5027 proc UIPlayNewCity
{} {
5033 proc UIStartLoad
{} {
5038 proc UIReallyStartGame
{} {
5044 proc UIPlayGame
{} {
5051 SetPriority
$Priority
5059 proc UISetSpeed
{speed
} {
5062 if {"$State" == "play"} {
5063 UISetMessage
[lindex {
5066 {Time flows medium.
}
5074 proc UIUpdateRunning
{} {
5075 global HeadWindows Time State
5077 if {($State == "play") && $Time} {
5078 set pict
"@images/micropolisg.xpm"
5080 set pict
"@images/micropoliss.xpm"
5083 foreach win
$HeadWindows {
5084 set can
[WindowLink
$win.demand
]
5085 $can itemconfig micropolis
-bitmap $pict
5090 proc DoSetGameLevel
{level
} {
5091 sim GameLevel
$level
5095 proc UISetGameLevel
{level
} {
5097 set GameLevel
$level
5098 global ScenarioWindows
5099 foreach win
$ScenarioWindows {
5100 UpdateLevelSelection
$win
5105 proc UISetCityName
{name
} {
5106 global EditorWindows
5109 set title
"Micropolis Editor on $name"
5110 foreach win
$EditorWindows {
5111 # TODO: set editor window and icon title
5112 #wm title $win "$title"
5113 #wm iconname $win "$title"
5118 proc UILoadCity
{win
} {
5119 # if changed, r-u-sure?
5121 set file [ShowFileOf
$win]
5122 DoFileDialog
$file "Choose a City to Load" $CityDir "*.cty" "" \
5127 proc UIDoLoadCity
{name path
} {
5130 if {![string match
*.cty
$name]} {
5133 MakeHistory
"DoLoadCity {$path/$name}"
5137 proc DoLoadCity
{filename} {
5138 sim LoadCity
$filename
5141 proc UIDidLoadCity
{} {
5142 global State GameLevel Scenario
5145 if {$State == "play"} {
5148 UIShowPicture
49 [sim CityFileName
]
5153 proc UIDidntLoadCity
{msg
} {
5154 DoSendMessage
$msg alert
5155 UIMakeSound warning Sorry
"-speed 85"
5156 UIShowPicture
49 [sim CityFileName
]
5175 proc UIDidPan
{w x y
} {
5176 if {[$w ToolMode
] == 1} {
5177 EditorToolDrag
$w $x $y
5183 proc UIDidStopPan
{win
} {
5184 UIMakeSoundOn
$win fancy Skid
"-volume 25"
5189 proc UIEarthQuake
{} {
5193 proc UIAutoGoto
{x y
{except
{}}} {
5194 global EditorWindows
5196 set x
[expr "$x * 16 + 8"]
5197 set y
[expr "$y * 16 + 8"]
5198 foreach win
$EditorWindows {
5199 if {"$win" != "$except"} {
5200 set view
[WindowLink
$win.view
]
5201 if {[$view AutoGoto
]} {
5203 $view AutoGoal
$x $y
5213 proc UIAutoGotoOn
{x y eds
} {
5214 set x
[expr "$x * 16 + 8"]
5215 set y
[expr "$y * 16 + 8"]
5217 [WindowLink
$win.view
] AutoGoal
$x $y
5223 proc DoLeaveGame
{head
} {
5227 proc UILoseGame
{} {
5231 AskQuestion
[Color .
#ff0000 #ffffff] [lindex $Messages(200) 1] \
5232 [lindex $Messages(200) 2] \
5235 "{Ok} SelectCity.Yes {UIPickScenarioMode}"
5244 proc DoPendTool
{view tool x y
} {
5245 global HeadWindows ToolInfo VotesForAsk
5247 set win
[WindowLink
$view.top
]
5248 set head
[WindowLink
$win.head
]
5250 if {($tool == [sim PendingTool
]) &&
5251 ($x == [sim PendingX
]) &&
5252 ($y == [sim PendingY
])} {
5253 if {[lsearch $VotesForAsk $head] != -1} {
5254 # you can only vote once
5255 UIMakeSound edit Oop
5257 UIMakeSound edit Boing
5258 set ask
[WindowLink
$head.ask
]
5259 PressVoteButton
$ask [WindowLink
$ask.vote
] Ask
5262 UIAutoGoto
$x $y $win
5264 UIMakeSound edit Boing
5265 set info [lindex $ToolInfo $tool]
5266 set a
[lindex $info 0]
5267 set name
[lindex $info 1]
5268 set cost
[lindex $info 2]
5269 set title
"Build $a $name"
5270 set question
"Do you support the plan to build $a $name for $cost?"
5271 AskQuestion
[Color
$win #00ff00 #ffffff] "$title" \
5273 "{Veto plan.} Plan.Veto
5275 "{Goto plan.} Plan.Goto
5276 {ComeTo %s $x $y}" \
5277 "{Support plan!} Plan.Support
5278 {SupportPlan $view %s $tool $x $y}
5279 {PreviewSupportPlan $view %s $tool $x $y}"
5280 set VotesForAsk
$head
5281 set ask
[WindowLink
$head.ask
]
5282 [WindowLink
$ask.vote
] config
-relief sunken
5286 sim PendingTool
$tool
5289 sim Votes
[llength $VotesForAsk]
5294 proc RejectPlan
{} {
5296 if {[sim Players
] > 1} {
5297 UIMakeSound edit Sorry
5303 proc NeededVotes
{} {
5305 set players
[sim Players
]
5306 set needed
[expr "$players - $FreeVotes"]
5307 return [max
0 $needed]
5311 proc SupportPlan
{view h tool x y
} {
5313 sim Votes
[llength $VotesForAsk]
5316 $view DoTool
$tool $x $y
5319 UIMakeSound edit Aaah
5323 proc PreviewSupportPlan
{view h tool x y
} {
5325 sim Votes
[llength $VotesForAsk]
5329 proc SugarStartUp
{uri
} {
5333 # TODO: Load the city file at the given URI, or configure according to URI parameters.
5337 proc SugarNickName
{nick
} {
5338 global SugarNickName
5339 set SugarNickName
$nick
5343 proc SugarActivate
{} {
5344 global SugarActivated
5345 set SugarActivated
1
5349 proc SugarDeactivate
{} {
5350 global SugarActivated
5351 set SugarActivated
0
5355 proc SugarShare
{} {
5361 proc SugarBuddyAdd
{key nick color address
} {
5363 set buddy
[list $key $nick $color $address]
5364 lappend SugarBuddies
$buddy
5368 proc SugarBuddyDel
{key nick color address
} {
5370 set buddy
[list $key $nick $color $address]
5371 set i
[lsearch $wins $win]
5373 set SugarBuddies
[lreplace $wins $i $i]
5383 ########################################################################