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 # Send message to Python to play sound.
961 #UIDoSound "sound play $sound -replay -channel $chan $opts"
965 proc UIStartSound
{chan sound
{opts
""}} {
966 # Send message to Python to play sound.
969 #UIDoSound "sound play $sound -channel $chan -repeat 100 $opts"
973 proc SetupSoundServer
{win
} {
978 proc AddSoundServer
{win
} {
980 set i
[lsearch $SoundServers $win]
982 set SoundServers
[linsert $SoundServers 0 $win]
987 proc LostSoundServer
{win
} {
988 DeleteSoundServer
$win
989 # UIShowPictureOn [WindowLink $win.head] 46 [winfo screen $win]
993 proc DeleteSoundServer
{win
} {
995 set i
[lsearch $SoundServers $win]
997 set SoundServers
[lreplace $SoundServers $i $i]
1002 proc UISoundOff
{} {
1006 proc MonsterSpeed
{} {
1007 return [expr "[sim Rand 40] + 70"]
1011 proc ExplosionPitch
{} {
1012 return [expr "[sim Rand 20] + 90"]
1017 return [expr "[sim Rand 20] + 90"]
1021 ########################################################################
1022 # Global Window Handlers
1025 proc WithdrawAll
{} {
1043 proc ShowInitial
{} {
1051 ########################################################################
1052 # Head Window Handlers
1055 proc PrepHead
{head
} {
1062 WithdrawHeadOf
$head
1066 after 1000 "WithdrawSplashOf $head"
1067 WithdrawHeadOf
$head
1068 ShowScenarioOf
$head
1072 WithdrawSplashOf
$head
1073 WithdrawScenarioOf
$head
1078 ReShowPictureOn
$head
1086 proc ShowHeadOf
{head
} {
1091 proc WithdrawHeadOf
{head
} {
1098 foreach win
$HeadWindows {
1104 proc WithdrawHeads
{} {
1106 foreach win
$HeadWindows {
1112 proc DeleteHeadWindow
{head
} {
1119 foreach win
$HeadWindows {
1125 proc InitHead
{win
} {
1126 set w
[WindowLink
$win.
text]
1127 $w configure
-state normal
1130 $w configure
-state disabled
1132 if {[sim MultiPlayerMode
]} {
1133 set w
[WindowLink
$win.
entry]
1144 proc InitAllHeadMenus
{} {
1147 foreach win
$HeadWindows {
1153 proc InitHeadMenus
{win
} {
1155 set m0
[WindowLink
$win.m0
]
1156 set m1
[WindowLink
$win.m1
]
1157 set m2
[WindowLink
$win.m2
]
1158 set m3
[WindowLink
$win.m3
]
1159 set m4
[WindowLink
$win.m4
]
1160 set b0
[WindowLink
$win.b0
]
1161 set b1
[WindowLink
$win.b1
]
1162 set b2
[WindowLink
$win.b2
]
1163 set b3
[WindowLink
$win.b3
]
1164 set b4
[WindowLink
$win.b4
]
1178 # When in multi player mode there is an extra menu
1179 # item to add another player, before the quit item,
1180 # so compensate for it here.
1181 if {[sim MultiPlayerMode
]} {
1186 $b0 config
-state normal
1187 $b2 config
-state disabled
1188 $b4 config
-state disabled
1193 # When in multi player mode there is an extra menu
1194 # item to add another player, before the quit item,
1195 # so compensate for it here.
1196 if {[sim MultiPlayerMode
]} {
1201 $b0 config
-state normal
1202 $b2 config
-state normal
1203 $b4 config
-state normal
1209 proc UIDisaster
{win cmd action
} {
1210 AskQuestion
[Color
$win #ff0000 #ffffff] "Cause a Disaster" \
1211 "Oh no! Do you really want to $action" \
1212 "{No way!} Disaster.No {WithdrawAsks}" \
1214 "{I guess so.} Disaster.Yes {WithdrawAsks ; $cmd}"
1218 proc CrushHead
{head
} {
1219 global SubWindows VoteNames
1221 foreach foo
$VoteNames {
1223 set votes
[eval ident
\$VotesFor$foo]
1224 set i
[lsearch $votes $head]
1226 set VotesFor
$foo [lreplace $votes $i $i]
1230 foreach foo
$SubWindows {
1231 set sym
[lindex $foo 0]
1232 set name
[lindex $foo 1]
1234 set wins
[eval ident
"\$$name"]
1236 if {[WindowLink
$win.head
] == $head} {
1237 DeleteWindow
$sym $name $win
1244 proc ChatDown
{win
} {
1266 global ChatConnection
1268 DoSendMessage
"Opening Connection to Chat Server $ChatServer socket $ChatSocket ..." status
1270 set ChatConnection
{}
1272 set ChatConnection
[connect
$ChatServer $ChatSocket]
1275 if {$ChatConnection == {}} then
{
1276 DoSendMessage
"Sorry, I could not open a connection to chat server $ChatServer socket $ChatSocket." status
1279 filehandler
$ChatConnection r
"ReceiveChat"
1290 puts $ChatConnection "USER $UserName $HostName $ServerName $RealName\r\n" nonewline
1291 puts $ChatConnection "NICK $NickName\r\n" nonewline
1292 puts $ChatConnection "JOIN $ChannelName\r\n" nonewline
1293 flush $ChatConnection
1298 proc ReceiveChat
{mode f
} {
1299 # DoSendMessage "ReceiveChat: MODE $mode F $f"
1303 if {[string first
{:} $msg]} {
1307 set from
[lindex $msg 0]
1308 set cmd
[string tolower
[lindex $msg 1]]
1312 if {($cmd == "privmsg") ||
1313 ($cmd == "notice")} then
{
1315 set chan
[lindex $msg 2]
1316 set i
[expr "[string length $from] + 1 + [string length $cmd] + 1 + [string length $chan] + 2"]
1317 set j
[expr "[string length $msg] - 2"]
1318 set line
[string range
$msg $i $j]
1319 set chan
[string range
$chan 1 [string length
$chan]]
1320 set from
[string range
$from 1 [expr "[string length $from] - 1"]]
1321 set from
[split $from {!}]
1322 set from
[lindex $from 0]
1323 DoSendMessage
"$from> $line"
1326 if {$handled == 0} {
1327 set msg
[string range
$msg \
1328 [expr "[string length $from] + 1"] \
1329 [expr "[string length $msg] - 2"]]
1335 proc SendChatMessage
{msg win
} {
1336 global ChatConnection ChannelName NickName
1342 if {[string range
$msg 0 0] == "/"} {
1343 set cmd
[string range
$msg 1 [string length
$msg]]
1344 DoSendMessage
"$NickName> \[$cmd\]"
1347 set cmd
"PRIVMSG $ChannelName :$msg\r\n"
1348 DoSendMessage
"$NickName> $msg"
1355 puts $ChatConnection $cmd nonewline
1356 flush $ChatConnection
1361 DoSendMessage
"IRC Broke the connection"
1371 global ChatConnection
1373 DoSendMessage
"Closing Connection to Chat Server." status
1376 puts $ChatConnection "QUIT\r\n" nonewline
1377 flush $ChatConnection
1378 $ChatConnection close
1381 set ChatConnection
{}
1386 proc DoEnterMessage
{win var
} {
1389 set msg
[eval ident
"\$\{$var\}"]
1391 if {$Chatting} then
{
1392 SendChatMessage
$msg $win
1400 proc DoEvalMessage
{win var
} {
1402 set command
[eval ident
"\$\{$var\}"]
1404 DoSendMessage
"Evaluating TCL: $command"
1405 catch {uplevel #0 $command} result
1406 DoSendMessage
"Result: $result"
1410 proc DoSendMessage
{msg
{tag
message}} {
1412 foreach win
$HeadWindows {
1413 appendWithTag
[WindowLink
$win.
text] $tag "$msg"
1418 proc UISetMessage
{msg
{tag status
}} {
1419 global DoMessages EditorWindows HeadWindows
1421 if {$DoMessages == 0} {
1425 foreach win
$EditorWindows {
1426 [WindowLink
$win.
message] configure
-text "$msg"
1429 foreach win
$HeadWindows {
1430 appendWithTag
[WindowLink
$win.
text] $tag "$msg"
1437 proc appendWithTag
{w tag
text} {
1441 set start
[$w index end
]
1442 $w configure
-state normal
1443 if {$start > $MaxLines} then
{
1444 $w delete
0.0 $ShrinkLines.0
1445 set start
[$w index end
]
1447 $w insert end
"${text}\n"
1448 $w tag add
$tag $start {end
- 1 char
}
1449 $w configure
-state disabled
1450 $w yview
-pickplace {end
- 1 char
}
1454 ########################################################################
1455 # Budget Window Handlers
1458 proc ShowBudgetOf
{head
} {
1459 set win
[WindowLink
$head.budget
]
1461 set win
[MakeWindow.budget
$head [winfo screen
$head]]
1470 proc ShowBudgets
{} {
1471 global HeadWindows BudgetsVisible
1472 set BudgetsVisible
1
1473 foreach win
$HeadWindows {
1479 proc WithdrawBudgets
{} {
1480 global BudgetWindows BudgetsVisible
1481 foreach win
$BudgetWindows {
1485 set BudgetsVisible
0
1489 proc BudgetContinue
{{win
""}} {
1490 global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1492 if {([sim RoadFund
] != $BudgetRoadFund) ||
1493 ([sim FireFund
] != $BudgetFireFund) ||
1494 ([sim PoliceFund
] != $BudgetPoliceFund) ||
1495 ([sim TaxRate
] != $BudgetTaxRate)} {
1496 UISetMessage
"The budget was changed."
1498 UISetMessage
"The budget wasn't changed."
1506 proc BudgetReset
{{win
""}} {
1507 global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1508 if {([sim RoadFund
] != $BudgetRoadFund) ||
1509 ([sim FireFund
] != $BudgetFireFund) ||
1510 ([sim PoliceFund
] != $BudgetPoliceFund) ||
1511 ([sim TaxRate
] != $BudgetTaxRate)} {
1512 UISetMessage
"The budget was reset."
1513 if {[sim Players
] > 1} {
1514 UIMakeSound edit Sorry
1517 UISetMessage
"The budget was reset."
1519 sim RoadFund
$BudgetRoadFund
1520 sim FireFund
$BudgetFireFund
1521 sim PoliceFund
$BudgetPoliceFund
1522 sim TaxRate
$BudgetTaxRate
1528 proc BudgetCancel
{{win
""}} {
1536 proc SetTaxRate
{rate
} {
1541 proc BudgetSetTaxRate
{rate
} {
1547 proc BudgetSetRoadFund
{percent
} {
1548 sim RoadFund
$percent
1553 proc BudgetSetFireFund
{percent
} {
1554 sim FireFund
$percent
1559 proc BudgetSetPoliceFund
{percent
} {
1560 sim PoliceFund
$percent
1565 proc UIShowBudgetAndWait
{} {
1566 global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1567 if {$OldBudget == 0} {
1568 set BudgetRoadFund
[sim RoadFund
]
1569 set BudgetFireFund
[sim FireFund
]
1570 set BudgetPoliceFund
[sim PoliceFund
]
1571 set BudgetTaxRate
[sim TaxRate
]
1575 UISetMessage
"Pausing to set the budget ..."
1581 sim UpdateBudgetWindow
1585 proc ToggleBudgetTimer
{} {
1586 global BudgetTimerActive
1587 if {$BudgetTimerActive} {
1595 proc StopBudgetTimer
{} {
1596 global BudgetTimerActive
1597 set BudgetTimerActive
0
1602 proc StartBudgetTimer
{} {
1603 global BudgetTimerActive BudgetTimer BudgetTimeout
1605 set BudgetTimerActive
$me
1606 set BudgetTimer
$BudgetTimeout
1608 after 1000 TickBudgetTimer
$me
1612 proc RestartBudgetTimer
{} {
1613 global BudgetTimerActive
1614 if {$BudgetTimerActive} {
1621 proc UpdateBudgetTimer
{} {
1622 global BudgetWindows BudgetTimerActive BudgetTimer
1623 if {$BudgetTimerActive} {
1624 set text [format "Auto Cancel In %d Seconds (click to disable)" $BudgetTimer]
1626 set text [format "Enable Auto Cancel (currently disabled)"]
1628 foreach win
$BudgetWindows {
1629 set t
[WindowLink
$win.timer
]
1630 $t config
-text "$text"
1635 proc TickBudgetTimer
{me
} {
1636 global BudgetTimerActive BudgetTimer BudgetTimeout
1637 if {$BudgetTimerActive == $me} {
1639 if {$BudgetTimer < 0} {
1645 after 1000 TickBudgetTimer
$me
1651 proc FireBudgetTimer
{} {
1661 proc ToggleAutoBudget
{} {
1664 #echo "ToggleAutoBudget found on, clearing"
1667 #echo "ToggleAutoBudget found off, setting"
1673 proc UIUpdateBudget
{} {
1678 proc UpdateAutoBudget
{} {
1679 global BudgetWindows AutoBudget
1680 if {[sim AutoBudget
]} {
1681 set text "Disable Auto Budget (currently enabled)"
1683 set text "Enable Auto Budget (currently disabled)"
1685 #echo "UpdateAutoBudget $AutoBudget $text"
1686 foreach win
$BudgetWindows {
1687 set t
[WindowLink
$win.autobudget
]
1688 $t config
-text "$text"
1693 proc UISetBudget
{cashflow previous current collected taxrate
} {
1694 global BudgetWindows BudgetsVisible
1696 #echo "UISetBudgetValues $taxrate $BudgetsVisible"
1698 if {$BudgetsVisible} {
1700 foreach win
$BudgetWindows {
1701 set w
[WindowLink
$win.cashflow
]
1702 set old
[lindex [$w configure
-text] 4]
1703 if {$old != $cashflow} {
1704 $w configure
-text $cashflow
1706 set w
[WindowLink
$win.previous
]
1707 set old
[lindex [$w configure
-text] 4]
1708 if {$old != $previous} {
1709 $w configure
-text $previous
1711 set w
[WindowLink
$win.current
]
1712 set old
[lindex [$w configure
-text] 4]
1713 if {$old != $current} {
1714 $w configure
-text $current
1716 set w
[WindowLink
$win.collected
]
1717 set old
[lindex [$w configure
-text] 4]
1718 if {$old != $collected} {
1719 $w configure
-text $collected
1722 set w
[WindowLink
$win.taxrate
]
1724 if {$old != $taxrate} {
1728 set w
[WindowLink
$win.taxlabel
]
1729 set old
[lindex [$w configure
-text] 4]
1732 $w configure
-text $new
1738 foreach win
$HeadWindows {
1740 set w
[WindowLink
$win.taxrate
]
1742 if {$old != $taxrate} {
1743 # FIXME: this might not work if the slider is disabled in multi player mode.
1747 set w
[WindowLink
$win.taxlabel
]
1748 set old
[lindex [$w configure
-text] 4]
1749 set new
"Tax Rate: $taxrate%"
1751 $w configure
-text $new
1757 proc UISetBudgetValues
{roadgot roadwant roadpercent policegot policewant policepercent firegot firewant firepercent
} {
1758 global BudgetWindows BudgetsVisible
1760 if {$BudgetsVisible == 0} {
1764 foreach win
$BudgetWindows {
1765 set w
[WindowLink
$win.fire
].request
1766 set old
[lindex [$w configure
-text] 4]
1767 set new
"$firepercent% of $firewant = $firegot"
1769 $w configure
-text $new
1771 set w
[WindowLink
$win.fire
].fund
1773 if {$old != $firepercent} {
1777 set w
[WindowLink
$win.police
].request
1778 set old
[lindex [$w configure
-text] 4]
1779 set new
"$policepercent% of $policewant = $policegot"
1781 $w configure
-text $new
1783 set w
[WindowLink
$win.police
].fund
1785 if {$old != $policepercent} {
1786 $w set $policepercent
1789 set w
[WindowLink
$win.road
].request
1790 set old
[lindex [$w configure
-text] 4]
1791 set new
"$roadpercent% of $roadwant = $roadgot"
1793 $w configure
-text $new
1795 set w
[WindowLink
$win.road
].fund
1797 if {$old != $roadpercent} {
1804 proc ChangeBudget
{} {
1805 global VotesForBudget
1806 if {"$VotesForBudget" != ""} {
1813 proc InitVotesForBudget
{} {
1814 global VotesForBudget BudgetWindows
1815 set VotesForBudget
{}
1816 foreach win
$BudgetWindows {
1817 [WindowLink
$win.vote
] config
-relief raised
1819 UpdateVotesForBudget
1823 proc UpdateVotesForBudget
{} {
1824 global BudgetWindows
1825 UpdateVotesFor Budget
$BudgetWindows
1829 proc UpdateTaxRateSliders
{} {
1831 set players
[sim Players
]
1832 foreach win
$HeadWindows {
1833 set slider
[WindowLink
$win.taxrate
]
1834 #echo "UpdateTaxRateSliders players $players win $win slider $slider"
1835 if {$players == 1} {
1836 $slider configure
-state normal
1838 $slider configure
-state disabled
1844 ########################################################################
1845 # Evaluation Window Handlers
1848 proc ToggleEvaluationOf
{head
} {
1850 if {"$State" != "play"} {
1855 set win
[WindowLink
$head.evaluation
]
1857 set mapped
[winfo ismapped
$win]
1861 WithdrawEvaluationOf
$head
1863 ShowEvaluationOf
$head
1869 proc WithdrawEvaluationOf
{head
} {
1870 set win
[WindowLink
$head.evaluation
]
1877 proc ShowEvaluationOf
{head
} {
1878 set win
[WindowLink
$head.evaluation
]
1880 set win
[MakeWindow.evaluation
$head [winfo screen
$head]]
1884 set parent
[WindowLink
$win.parent
]
1885 #pack append [WindowLink $head.col2]\
1886 # $parent {top frame nw fill}
1887 pack append $parent\
1888 $win {top
frame nw fillx
}
1890 sim UpdateEvaluation
1894 proc WithdrawEvaluations
{} {
1895 global EvaluationWindows EvaluationsVisible
1896 foreach win
$EvaluationWindows {
1898 #set parent [WindowLink $win.parent]
1899 #pack unpack $parent
1902 set EvaluationsVisible
0
1906 proc EvaluationVisible
{w v
} {
1907 global EvaluationsVisible
1908 global [set var
$w.visible
]
1913 set EvaluationsVisible
[expr "$EvaluationsVisible + 1"]
1915 set EvaluationsVisible
[expr "$EvaluationsVisible - 1"]
1920 proc UISetEvaluation
{changed score ps0 ps1 ps2 ps3 pv0 pv1 pv2 pv3 pop delta assessed cityclass citylevel goodyes goodno title
} {
1921 global EvaluationWindows EvaluationsVisible CurrentDate
1923 set class
[string tolower
$cityclass]
1924 UISetMessage
"$CurrentDate: Score $score, $class population $pop."
1926 if {$EvaluationsVisible} {
1928 foreach win
$EvaluationWindows {
1930 global [set var
$win.visible
]
1931 set visible
[eval ident
"\$\{$var\}"]
1935 # TODO: set evaluation window and icon title
1936 #wm title $win "$title"
1937 #wm iconname $win "$title"
1939 set w
[WindowLink
$win.goodjob
]
1940 set old
[lindex [$w configure
-text] 4]
1941 set new
"$goodyes\n$goodno"
1943 $w configure
-text $new
1946 set w
[WindowLink
$win.problemnames
]
1947 set old
[lindex [$w configure
-text] 4]
1948 set new
"$ps0\n$ps1\n$ps2\n$ps3"
1950 $w configure
-text $new
1953 set w
[WindowLink
$win.problempercents
]
1954 set old
[lindex [$w configure
-text] 4]
1955 set new
"$pv0\n$pv1\n$pv2\n$pv3"
1957 $w configure
-text $new
1960 set w
[WindowLink
$win.stats
]
1961 set old
[lindex [$w configure
-text] 4]
1962 set new
"$pop\n$delta\n\n$assessed\n$cityclass\n$citylevel"
1964 $w configure
-text $new
1967 set w
[WindowLink
$win.score
]
1968 set old
[lindex [$w configure
-text] 4]
1969 set new
"$score\n$changed"
1971 $w configure
-text $new
1979 ########################################################################
1980 # File Window Handlers
1983 proc ShowFileOf
{head
} {
1984 set win
[WindowLink
$head.
file]
1986 set win
[MakeWindow.
file $head [winfo screen
$head]]
1996 foreach win
$HeadWindows {
2002 proc WithdrawFiles
{} {
2004 foreach win
$FileWindows {
2010 proc DoFileDialog
{win Message Path Pattern FileName ActionOk ActionCancel
} {
2011 ShowFileDialog
$win "$Path" "$Pattern"
2012 $win.message1 configure
-text "$Message"
2013 $win.path.path delete
0 end
2014 $win.path.path insert
0 $Path
2015 $win.
file.
file delete
0 end
2016 $win.
file.
file insert
0 "$FileName"
2017 $win.frame1.ok config
-command "
2018 $ActionOk \[$win.file.file get\] \[$win.path.path get\]
2020 $win.frame1.rescan config
-command "
2021 ShowFileDialog $win \[$win.path.path get\] $Pattern"
2022 $win.frame1.cancel config
-command "
2025 bind $win.files.files
"<Double-Button-1>" "\
2026 FileSelectDouble $win %W %y $Pattern \"
2027 $ActionOk {\[$win.file.file get\]} {\[$win.path.path get\]}\""
2028 bind $win.path.path
<Return
> "
2029 ShowFileDialog $win \[$win.path.path get\] $Pattern
2030 $win.file.file cursor 0
2031 focus $win.file.file"
2032 bind $win.
file.
file <Return
> "\
2033 $ActionOk \[$win.file.file get\] \[$win.path.path get\]
2038 proc BindSelectOne
{win Y
} {
2039 set Nearest
[$win nearest
$Y]
2040 if {$Nearest >= 0} {
2041 $win select from
$Nearest
2042 $win select to
$Nearest
2047 proc FileSelect
{win widget Y
} {
2048 BindSelectOne
$widget $Y
2049 set Nearest
[$widget nearest
$Y]
2050 if {$Nearest >= 0} {
2051 set Path
[$win.path.path get
]
2052 set TmpEntry
[$widget get
$Nearest]
2053 if {[string compare
"/" [string index
$TmpEntry \
2054 [expr [string length
$TmpEntry]-1]]] == 0 ||
\
2055 [string compare
"@" [string index
$TmpEntry \
2056 [expr [string length
$TmpEntry]-1]]] == 0} {
2057 # handle directories, and symbolic links to directories
2058 set FileName
[string range
$TmpEntry 0 \
2059 [expr [string length
$TmpEntry]-2]]
2060 # whoops / or @ is part of the name
2061 if {[MiscIsDir
$Path/$FileName] != 1} {
2062 set FileName
$TmpEntry
2065 if {[string compare
"*" [string index
$TmpEntry \
2066 [expr [string length
$TmpEntry]-1]]] == 0} {
2067 # handle executable filenames
2068 set FileName
[string range
$TmpEntry 0 \
2069 [expr [string length
$TmpEntry]-2]]
2070 # whoops * is part of the name
2071 if {[file executable
$Path/$FileName] != 1} {
2072 set FileName
$TmpEntry
2075 # a ordinary filename
2076 set FileName
$TmpEntry
2079 # enter the selected filename into the filename field
2080 if {[MiscIsDir
$Path/$FileName] != 1} {
2081 $win.
file.
file delete
0 end
2082 $win.
file.
file insert
0 $FileName
2088 proc FileSelectDouble
{win widget Y Pattern Action
} {
2089 BindSelectOne
$widget $Y
2090 set Nearest
[$widget nearest
$Y]
2091 if {$Nearest >= 0} {
2092 set Path
[$win.path.path get
]
2093 set TmpEntry
[$widget get
$Nearest]
2094 if {[string compare
$TmpEntry "../"] == 0} {
2095 # go up one directory
2097 [string trimright
[string trimright
[string trim
$Path] /] @]
2098 if {[string length
$TmpEntry] <= 0} {
2101 set Path
[file dirname
$TmpEntry]
2102 $win.path.path delete
0 end
2103 $win.path.path insert
0 $Path
2104 ShowFileDialog
$win $Path $Pattern
2106 if {[string compare
"/" [string index
$TmpEntry \
2107 [expr [string length
$TmpEntry]-1]]] == 0 ||
\
2108 [string compare
"@" [string index
$TmpEntry \
2109 [expr [string length
$TmpEntry]-1]]] == 0} {
2110 # handle directorys, and symbolic links to directorys
2111 set FileName
[string range
$TmpEntry 0 \
2112 [expr [string length
$TmpEntry]-2]]
2113 # whoops / or @ is part of the name
2114 if {[MiscIsDir
$Path/$FileName] != 1} {
2115 set FileName
$TmpEntry
2118 if {[string compare
"*" [string index
$TmpEntry \
2119 [expr [string length
$TmpEntry]-1]]] == 0} {
2120 # handle executable filenames
2121 set FileName
[string range
$TmpEntry 0 \
2122 [expr [string length
$TmpEntry]-2]]
2123 # whoops * is part of the name
2124 if {[file executable
$Path/$FileName] != 1} {
2125 set FileName
$TmpEntry
2128 # a ordinary filename
2129 set FileName
$TmpEntry
2133 if {[MiscIsDir
$Path/$FileName] == 1} {
2134 if {[string compare
"/" [string index
$Path \
2135 [expr [string length
$Path]-1]]] == 0} {
2136 append Path
$FileName
2138 append Path
/ $FileName
2140 $win.path.path delete
0 end
2141 $win.path.path insert
0 $Path
2142 ShowFileDialog
$win $Path $Pattern
2144 # enter the selected filename into the filename field
2145 $win.
file.
file delete
0 end
2146 $win.
file.
file insert
0 "$FileName"
2147 if {[string length
$Action] > 0} {
2157 proc NameComplete
{win Type
} {
2162 if {[string compare
$Type path
] == 0} {
2163 set DirName
[file dirname
[$win.path.path get
]]
2164 set FileName
[file tail
[$win.path.path get
]]
2166 set DirName
[file dirname
[$win.path.path get
]/]
2167 set FileName
[file tail
[$win.
file.
file get
]]
2171 if {[MiscIsDir
$DirName] == 1} {
2172 catch "exec ls $DirName/" Result
2174 set ListLength
[llength $Result]
2176 while {$Counter < $ListLength} {
2177 if {[string length
$FileName] == 0} {
2178 if {$FoundCounter == 0} {
2179 set NewFile
[lindex $Result $Counter]
2182 set TmpFile1
$NewFile
2183 set TmpFile2
[lindex $Result $Counter]
2184 set Length1
[string length
$TmpFile1]
2185 set Length2
[string length
$TmpFile2]
2187 if {$Length1 > $Length2} {
2188 set Length1
$Length2
2190 while {$Counter1 < $Length1} {
2191 if {[string compare
[string index
$TmpFile1 $Counter1] \
2192 [string index
$TmpFile2 $Counter1]] == 0} {
2193 append NewFile
[string index
$TmpFile1 $Counter1]
2202 if {[regexp "^$FileName" [lindex $Result $Counter] \
2204 if {$FoundCounter == 0} {
2205 set NewFile
[lindex $Result $Counter]
2208 set TmpFile1
$NewFile
2209 set TmpFile2
[lindex $Result $Counter]
2210 set Length1
[string length
$TmpFile1]
2211 set Length2
[string length
$TmpFile2]
2213 if {$Length1 > $Length2} {
2214 set Length1
$Length2
2216 while {$Counter1 < $Length1} {
2217 if {[string compare
[string index
$TmpFile1 $Counter1] \
2218 [string index
$TmpFile2 $Counter1]] == 0} {
2219 append NewFile
[string index
$TmpFile1 $Counter1]
2233 if {$FoundCounter == 1} {
2234 if {[MiscIsDir
$DirName/$NewFile] == 1} {
2235 if {[string compare
$DirName "/"] == 0} {
2236 $win.path.path delete
0 end
2237 $win.path.path insert
0 "/[string trim [string trim $NewFile /] @]/"
2239 $win.path.path delete
0 end
2240 $win.path.path insert
0 "[string trimright $DirName /]/[string trim [string trim $NewFile /] @]/"
2243 $win.path.path delete
0 end
2244 $win.path.path insert
0 \
2245 "[string trim [string trimright $DirName /] @]/"
2246 $win.
file.
file delete
0 end
2247 $win.
file.
file insert
0 "$NewFile"
2250 if {[MiscIsDir
$DirName/$NewFile] == 1 ||
2251 [string compare
$Type path
] == 0} {
2252 $win.path.path delete
0 end
2253 $win.path.path insert
0 \
2254 "[string trimright $DirName /]/[string trim [string trim $NewFile /] @]"
2256 $win.path.path delete
0 end
2257 $win.path.path insert
0 "$DirName"
2258 if {[string length
$NewFile] > 0} {
2259 $win.
file.
file delete
0 end
2260 $win.
file.
file insert
0 "$NewFile"
2267 proc ShowFileDialog
{win Path Pattern
} {
2269 #set Path [lindex [split $Path] 0]
2270 if {[$win.files.files size
] > 0} {
2271 $win.files.files delete
0 end
2274 if {[catch "exec ls -F \"$Path\"" Result
]} {
2277 if {[string match
$Result "* not found"]} {
2280 set ElementList
[lsort [split $Result "\n"]]
2283 if {[string compare
$Path "/"]} {
2284 $win.files.files insert end
"../"
2288 foreach Counter
$ElementList {
2290 if {[string match
$Pattern $Counter] == 1} {
2291 if {[string compare
$Counter "../"] &&
2292 [string compare
$Counter "./"]} {
2293 $win.files.files insert end
$Counter
2296 set fn
$Path/[string trim
[string trim
[string trim
$Counter /] @] *]
2297 if {[MiscIsDir
$fn]} {
2298 $win.files.files insert end
$Counter
2306 proc MiscIsDir
{PathName
} {
2308 if {[file isdirectory
$PathName] == 1} {
2311 catch "file type $PathName" Type
2312 if {[string compare
$Type link
] == 0} {
2313 set LinkName
[file readlink
$PathName]
2314 catch "file type $LinkName" Type
2315 while {[string compare
$Type link
] == 0} {
2316 set LinkName
[file readlink
$LinkName]
2318 return [file isdirectory
$LinkName]
2325 proc busy
{win cmds
} {
2327 set list [winfo children
$win]
2329 while {$list != ""} {
2332 set class
[winfo class
$w]
2333 set cursor
[lindex [$w config
-cursor] 4]
2334 if {[winfo toplevel $w] == $w} {
2335 lappend busy
[list $w $cursor]
2337 set next
[concat $next [winfo children
$w]]
2343 catch {[lindex $w 0] config
-cursor watch
}
2348 set error [catch {uplevel eval [list $cmds]} result
]
2351 catch {[lindex $w 0] config
-cursor [lindex $w 1]}
2362 ########################################################################
2363 # Editor Window Handlers
2365 proc ShowEditorOf
{head
} {
2366 global EditorWindows
2368 foreach win
$EditorWindows {
2369 if {[WindowLink
$win.head
] == $head} {
2370 set parent
[WindowLink
$win.parent
]
2371 #pack append [WindowLink $head.col2]\
2372 # $parent {top frame nw expand fill}
2373 pack append $parent\
2374 $win {top
frame nw expand fill
}
2388 proc NewEditorOf
{head
} {
2389 set win
[MakeWindow.editor
$head [winfo screen
$head]]
2391 set parent
[WindowLink
$win.parent
]
2392 pack append $parent\
2393 $win {top
frame nw expand fill
}
2400 proc ShowEditors
{} {
2402 foreach win
$HeadWindows {
2408 proc WithdrawEditors
{} {
2409 global EditorWindows
2410 foreach win
$EditorWindows {
2411 #set parent [WindowLink $win.parent]
2412 #pack unpack $parent
2418 proc InitEditors
{} {
2419 global EditorWindows
2420 foreach win
$EditorWindows {
2426 proc InitEditor
{win
} {
2427 set e
[WindowLink
$win.view
]
2428 UISetToolState
$win 7
2433 global $e.TrackState
2434 set $e.TrackState
{}
2438 proc SetEditorAutoGoto
{win val
} {
2439 global AutoGoto.
$win
2440 set AutoGoto.
$win $val
2441 set e
[WindowLink
$win.view
]
2446 proc SetEditorControls
{win val
} {
2447 global Controls.
$win
2448 set Controls.
$win $val
2450 pack append $win $win.leftframe
{left
frame center filly
}
2452 pack unpack
$win.leftframe
2457 proc SetEditorOverlay
{win val
} {
2459 set Overlay.
$win $val
2460 set e
[WindowLink
$win.view
]
2465 proc SetEditorDynamicFilter
{win val
} {
2466 global DynamicFilter.
$win
2467 set DynamicFilter.
$win $val
2468 set e
[WindowLink
$win.view
]
2469 $e DynamicFilter
$val
2470 if {$val == 1} then
{
2471 ShowFrobOf
[WindowLink
$win.head
]
2476 proc SetEditorSkip
{win val
} {
2477 set e
[WindowLink
$win.view
]
2482 proc EditorToolDown
{mod w x y
} {
2483 global [set var
$w.TrackState
]
2487 case
[$w ToolState
] in
\
2489 UIMakeSoundOn
$w edit Rumble
"-repeat 4"
2497 set $var [list constrain_start
$x $y]
2498 $w ToolConstrain
$x $y
2503 EditorTool ToolDown
$w $x $y
2508 proc EditorToolDrag
{w x y
} {
2509 EditorTool ToolDrag
$w $x $y
2514 proc EditorToolUp
{w x y
} {
2515 global [set var
$w.TrackState
]
2518 case
[$w ToolState
] in
\
2526 EditorTool ToolUp
$w $x $y
2528 $w ToolConstrain
-1 -1
2535 proc EditorTool
{action w x y
} {
2536 global [set var
$w.TrackState
]
2537 set state
[eval ident
"\$\{$var\}"]
2538 case
[lindex $state 0] in
\
2540 set x0
[lindex $state 1]
2541 set y0
[lindex $state 2]
2542 set dx
[expr "$x - $x0"]
2543 set dy
[expr "$y - $y0"]
2544 if [expr "($dx > 16) || ($dx < -16)"] then
{
2545 $w ToolConstrain
-1 $y0
2548 if [expr "($dy > 16) || ($dy < -16)"] then
{
2549 $w ToolConstrain
$x0 -1
2558 proc StartChalk
{w
} {
2559 sim CollapseMotion
0
2563 proc StopChalk
{w
} {
2564 sim CollapseMotion
1
2568 proc EditorPanDown
{mod w x y
} {
2569 global [set var
$w.TrackState
]
2573 set $var [list constrain_start
$x $y]
2574 $w ToolConstrain
$x $y
2579 EditorTool PanStart
$w $x $y
2583 proc EditorPanDrag
{w x y
} {
2584 EditorTool PanTo
$w $x $y
2588 proc EditorPanUp
{w x y
} {
2591 EditorTool PanTo
$w $x $y
2592 $w ToolConstrain
-1 -1
2598 proc EditorKeyDown
{w k
} {
2603 proc EditorKeyUp
{w k
} {
2608 proc BindEditorButtons
{win
} {
2609 set w
[WindowLink
$win.top
]
2611 bind $win <1> "CancelPie $win ; EditorToolDown none %W %x %y"
2612 bind $win <B1-Motion
> {EditorToolDrag
%W
%x
%y
}
2613 bind $win <ButtonRelease-1
> {EditorToolUp
%W
%x
%y
}
2615 bind $win <Control-1
> "CancelPie $win ; EditorToolDown constrain %W %x %y"
2616 bind $win <Control-B1-Motion
> {EditorToolDrag
%W
%x
%y
}
2617 bind $win <Control-ButtonRelease-1
> {EditorToolUp
%W
%x
%y
}
2619 bind $win <2> "CancelPie $win ; EditorPanDown none %W %x %y"
2620 bind $win <B2-Motion
> {EditorPanDrag
%W
%x
%y
}
2621 bind $win <ButtonRelease-2
> {EditorPanUp
%W
%x
%y
}
2623 bind $win <Control-2
> "CancelPie $win ; EditorPanDown constrain %W %x %y"
2624 bind $win <Control-B2-Motion
> {EditorPanDrag
%W
%x
%y
}
2625 bind $win <Control-ButtonRelease-2
> {EditorPanUp
%W
%x
%y
}
2627 InitPie
$win $w.toolpie
2631 proc UISetFunds
{funds
} {
2633 foreach win
$HeadWindows {
2634 [WindowLink
$win.funds
] configure
-text "$funds"
2639 proc UISetDate
{date month year
} {
2643 set CurrentDate
"$date"
2645 foreach win
$HeadWindows {
2646 [WindowLink
$win.date
] Set
$month $year
2651 proc SetPriority
{index
} {
2677 proc UISetDemand
{r c i
} {
2678 global HeadWindows DemandRes DemandCom DemandInd
2684 if {$r <= 0} then
{set ry0
32} else {set ry0
24}
2685 set ry1
[expr "$ry0 - $r"]
2686 if {$c <= 0} then
{set cy0
32} else {set cy0
24}
2687 set cy1
[expr "$cy0 - $c"]
2688 if {$i <= 0} then
{set iy0
32} else {set iy0
24}
2689 set iy1
[expr "$iy0 - $i"]
2691 foreach win
$HeadWindows {
2692 set can
[WindowLink
$win.demand
]
2693 # $can coords r 8 $ry0 14 $ry1
2694 # $can coords c 17 $cy0 23 $cy1
2695 # $can coords i 26 $iy0 32 $iy1
2696 $can coords r
49 $ry0 55 $ry1
2697 $can coords c
58 $cy0 64 $cy1
2698 $can coords i
67 $iy0 73 $iy1
2703 proc UISetOptions
{autobudget autogoto autobulldoze disasters sound animation messages notices
} {
2704 global AutoBudget AutoGoto AutoBulldoze Disasters Sound
2705 set AutoBudget
$autobudget
2706 set AutoGoto
$autogoto
2707 set AutoBulldoze
$autobulldoze
2708 set Disasters
$disasters
2710 set DoAnimation
$animation
2711 set DoMessages
$messages
2712 set DoNotices
$notices
2716 proc UIDidToolRes
{win x y
} {
2717 UIMakeSoundOn
$win edit O
"-speed 140"
2721 proc UIDidToolCom
{win x y
} {
2722 UIMakeSoundOn
$win edit A
"-speed 140"
2726 proc UIDidToolInd
{win x y
} {
2727 UIMakeSoundOn
$win edit E
"-speed 140"
2731 proc UIDidToolFire
{win x y
} {
2732 UIMakeSoundOn
$win edit O
"-speed 130"
2736 proc UIDidToolQry
{win x y
} {
2737 UIMakeSoundOn
$win edit E
"-speed 200"
2741 proc UIDidToolPol
{win x y
} {
2742 UIMakeSoundOn
$win edit E
"-speed 130"
2746 proc UIDidToolWire
{win x y
} {
2747 UIMakeSoundOn
$win edit O
"-speed 120"
2751 proc UIDidToolDozr
{win x y
} {
2752 UIMakeSoundOn
$win edit Rumble
2756 proc UIDidToolRail
{win x y
} {
2757 UIMakeSoundOn
$win edit O
"-speed 100"
2761 proc UIDidToolRoad
{win x y
} {
2762 UIMakeSoundOn
$win edit E
"-speed 100"
2766 proc UIDidToolChlk
{win x y
} {
2770 proc UIDidToolEraser
{win x y
} {
2774 proc UIDidToolStad
{win x y
} {
2775 UIMakeSoundOn
$win edit O
"-speed 90"
2779 proc UIDidToolPark
{win x y
} {
2780 UIMakeSoundOn
$win edit A
"-speed 130"
2784 proc UIDidToolSeap
{win x y
} {
2785 UIMakeSoundOn
$win edit E
"-speed 90"
2789 proc UIDidToolCoal
{win x y
} {
2790 UIMakeSoundOn
$win edit O
"-speed 75"
2794 proc UIDidToolNuc
{win x y
} {
2795 UIMakeSoundOn
$win edit E
"-speed 75"
2799 proc UIDidToolAirp
{win x y
} {
2800 UIMakeSoundOn
$win edit A
"-speed 50"
2804 proc UISetToolState
{w state
} {
2805 global EditorPallets EditorPalletImages ToolInfo
2806 set win
[WindowLink
$w.top
]
2807 #echo "UISETTOOLSTATE w $w win $win $state"
2808 ExclusivePallet
$state $win $EditorPallets ic
$EditorPalletImages \
2809 raised sunken
{NoFunction
}
2811 set c1
[WindowLink
$w.cost1
]
2813 set info [lindex $ToolInfo $state]
2814 set cost1
[lindex $info 1]
2815 set cost2
[lindex $info 2]
2816 $c1 configure
-text "$cost1"
2817 [WindowLink
$w.cost2
] configure
-text "$cost2"
2822 proc UIShowZoneStatus
{zone density value crime pollution growth x y
} {
2823 global QueryX QueryY
2824 set QueryX
[expr "8 + 16 * $x"]
2825 set QueryY
[expr "8 + 16 * $y"]
2826 UIShowPicture
9 [list $zone $density $value $crime $pollution $growth]
2830 ########################################################################
2831 # Map Window Handlers
2834 proc ShowMapOf
{head
} {
2837 foreach win
$MapWindows {
2838 if {"[WindowLink $win.head]" == "$head"} {
2839 global MapPanelWidth MapPanelHeight
2840 #place configure $win -x 0 -y 0 -width $MapPanelWidth -height $MapPanelHeight
2841 #[WindowLink $win.parent] configure -width $MapPanelWidth -height $MapPanelHeight
2842 set parent
[WindowLink
$win.parent
]
2843 pack append [WindowLink
$head.w2
] \
2844 $win {top
frame nw expand fill
}
2857 proc NewMapOf
{head
} {
2858 set win
[MakeWindow.map
$head [winfo screen
$head]]
2859 global MapPanelWidth MapPanelHeight
2860 #place configure $win -x 0 -y 0 -width $MapPanelWidth -height $MapPanelHeight
2861 #[WindowLink $win.parent] configure -width $MapPanelWidth -height $MapPanelHeight
2862 set parent
[WindowLink
$win.parent
]
2863 #pack append [WindowLink $head.col1]\
2864 # $parent {top frame nw fillx}
2865 pack append [WindowLink
$head.w2
] \
2866 $win {top
frame nw expand fill
}
2873 foreach win
$HeadWindows {
2879 proc WithdrawMaps
{} {
2881 foreach win
$MapWindows {
2890 foreach win
$MapWindows {
2896 proc InitMap
{win
} {
2901 proc EnableMaps
{} {
2903 foreach win
$MapWindows {
2909 proc EnableMap
{win
} {
2910 [WindowLink
$win.view
] ShowEditors
1
2911 [WindowLink
$win.zones
] config
-state normal
2912 [WindowLink
$win.overlays
] config
-state normal
2916 proc DisableMaps
{} {
2918 foreach win
$MapWindows {
2924 proc DisableMap
{win
} {
2925 [WindowLink
$win.view
] ShowEditors
0
2926 [WindowLink
$win.zones
] config
-state disabled
2927 [WindowLink
$win.overlays
] config
-state disabled
2931 proc SetMapState
{win state
} {
2932 set m
[WindowLink
$win.view
]
2934 if {$state == 14} then
{
2935 ShowFrobOf
[WindowLink
$win.head
]
2940 proc MapPanDown
{w x y
} {
2945 proc MapPanDrag
{w x y
} {
2950 proc MapPanUp
{w x y
} {
2957 proc UISetMapState
{w state
} {
2959 #set win [winfo toplevel $w]
2960 set win
[WindowLink
$w.win
]
2961 set m
[WindowLink
$win.view
]
2962 set title
[lindex $MapTitles $state]
2964 # TODO: set map text field header to title
2965 #wm title $win "$title"
2966 #wm iconname $win "$title"
2968 global [set var MapState.
$win]
2972 {6 8 9 10 11 12 13} {
2973 [WindowLink
$win.legend
] config
-bitmap "@images/legendmm.xpm"
2976 [WindowLink
$win.legend
] config
-bitmap "@images/legendpm.xpm"
2979 [WindowLink
$win.legend
] config
-bitmap "@images/legendn.xpm"
2985 ########################################################################
2986 # Graph Window Handlers
2989 proc ToggleGraphOf
{head
} {
2991 if {"$State" != "play"} {
2996 set win
[WindowLink
$head.graph
]
2998 set mapped
[winfo ismapped
$win]
3002 WithdrawGraphOf
$head
3010 proc WithdrawGraphOf
{head
} {
3011 set win
[WindowLink
$head.graph
]
3018 proc ShowGraphOf
{head
} {
3019 set win
[WindowLink
$head.graph
]
3021 set win
[MakeWindow.graph
$head [winfo screen
$head]]
3025 set parent
[WindowLink
$win.parent
]
3026 pack append $parent\
3027 $win {top
frame nw fillx
}
3033 proc WithdrawGraphs
{} {
3035 foreach win
$GraphWindows {
3042 proc InitGraphs
{} {
3044 foreach win
$GraphWindows {
3050 proc InitGraph
{win
} {
3051 UISetGraphState
$win 1 1 1 1 1 1 0
3055 proc UISetGraphState
{win t0 t1 t2 t3 t4 t5 range
} {
3056 set g
[WindowLink
$win.graphview
]
3057 GraphPalletMask
$win [expr "$t0 + ($t1<<1) + ($t2<<2) + ($t3<<3) + ($t4<<4) + ($t5<<5)"]
3058 GraphYearPallet
$win $range
3062 ########################################################################
3063 # Splash Window Handlers
3066 proc ShowSplashOf
{head
} {
3067 set win
[WindowLink
$head.splash
]
3069 set win
[MakeWindow.splash
$head [winfo screen
$head]]
3071 set splashscreen
[WindowLink
$win.splashscreen
]
3073 catch {$splashscreen config
-bitmap "@images/splashscreen.xpm"; set success 1}
3076 global SplashScreenDelay
3077 after $SplashScreenDelay "UIPickScenarioMode"
3084 proc WithdrawSplashOf
{head
} {
3085 set win
[WindowLink
$head.splash
]
3092 proc ShowSplashes
{} {
3094 foreach win
$HeadWindows {
3100 proc WithdrawSplashes
{} {
3101 global SplashWindows
3102 foreach win
$SplashWindows {
3104 set splashscreen
[WindowLink
$win.splashscreen
]
3105 $splashscreen config
-bitmap ""
3110 proc InitSplashes
{} {
3114 proc InitSplash
{win
} {
3118 proc DeleteSplashWindow
{win
} {
3123 ########################################################################
3124 # Scenario Window Handlers
3127 proc ShowScenarioOf
{head
} {
3128 set win
[WindowLink
$head.scenario
]
3130 set win
[MakeWindow.scenario
$head [winfo screen
$head]]
3132 # TODO: load background bitmap
3137 proc WithdrawScenarioOf
{head
} {
3138 set win
[WindowLink
$head.scenario
]
3145 proc ShowScenarios
{} {
3147 foreach win
$HeadWindows {
3153 proc WithdrawScenarios
{} {
3154 global ScenarioWindows
3155 foreach win
$ScenarioWindows {
3157 # TODO: flush background bitmap
3162 proc InitScenarios
{} {
3163 global MapHistory MapHistoryNum
3164 if {$MapHistoryNum < 1} {
3169 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3174 global ScenarioWindows
3175 foreach win
$ScenarioWindows {
3177 #[WindowLink $win.previous] config -state $prev
3178 #[WindowLink $win.next] config -state $next
3183 proc InitScenario
{win
} {
3184 global MapHistory MapHistoryNum
3185 if {$MapHistoryNum < 1} {
3191 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3198 #[WindowLink $win.previous] config -state $prev
3199 #[WindowLink $win.next] config -state $next
3201 LinkWindow
$win.scenarioTarget
-1
3202 LinkWindow
$win.scenarioTargetDown
-1
3204 global ScenarioButtons
3206 set len
[llength $ScenarioButtons]
3208 set data
[lindex $ScenarioButtons $i]
3209 set type
[lindex $data 0]
3210 set id
[lindex $data 1]
3214 LinkWindow
$win.
$id.over
0
3215 LinkWindow
$win.
$id.enabled
1
3216 LinkWindow
$win.
$id.checked
0
3217 #echo "SETTING WIN $win ID $id"
3219 set i
[expr "$i + 1"]
3222 UpdateLevelSelection
$win
3223 UpdateLeftRightEnabled
$win
3227 proc UpdateLevelSelection
{win
} {
3228 #echo UpdateLevelSelection
3230 if {$GameLevel == 0} then
{
3231 LinkWindow
$win.easy.checked
1
3232 LinkWindow
$win.medium.checked
0
3233 LinkWindow
$win.hard.checked
0
3235 if {$GameLevel == 1} then
{
3236 LinkWindow
$win.easy.checked
0
3237 LinkWindow
$win.medium.checked
1
3238 LinkWindow
$win.hard.checked
0
3240 if {$GameLevel == 2} then
{
3241 LinkWindow
$win.easy.checked
0
3242 LinkWindow
$win.medium.checked
0
3243 LinkWindow
$win.hard.checked
1
3246 UpdateScenarioButtonID
$win easy
3247 UpdateScenarioButtonID
$win medium
3248 UpdateScenarioButtonID
$win hard
3253 proc UpdateLeftRightEnabled
{win
} {
3254 #echo UpdateLeftRightEnabled
3256 global MapHistory MapHistoryNum
3257 if {$MapHistoryNum < 1} {
3258 LinkWindow
$win.left.enabled
0
3260 LinkWindow
$win.left.enabled
1
3263 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3264 LinkWindow
$win.right.enabled
0
3266 LinkWindow
$win.right.enabled
1
3269 UpdateScenarioButtonID
$win left
3270 UpdateScenarioButtonID
$win right
3274 proc UpdateScenarioButtonID
{win id
} {
3276 global ScenarioButtons
3278 set len
[llength $ScenarioButtons]
3280 set data
[lindex $ScenarioButtons $i]
3282 if {$id == [lindex $data 1]} then
{
3283 UpdateScenarioButton
$win $data
3287 set i
[expr "$i + 1"]
3292 proc UpdateScenarioButton
{win data
} {
3295 set type
[lindex $data 0]
3296 set id
[lindex $data 1]
3297 set over
[WindowLink
$win.
$id.over
]
3298 set enabled
[WindowLink
$win.
$id.enabled
]
3299 set checked
[WindowLink
$win.
$id.checked
]
3300 #echo "WIN $win TYPE $type ID $id OVER $over ENABLED $enabled CHECKED $checked"
3302 if {[lindex ${data
} 2] == "DoPickScenario"} {
3303 catch {text $win.desc
\
3308 -font [Font
$win Large
]}
3310 $win.desc configure
-state normal
3311 $win.desc delete
0.0 end
3312 $win.desc insert end
"[lindex $Messages([lindex ${data} 3]) 1]\n\n[lindex $Messages([lindex ${data} 3]) 2]"
3313 $win.desc configure
-state disabled
3315 place $win.desc
-x 232 -y 170 -width 280 -height 285
3318 catch {destroy $win.desc
}
3323 set bm
[lindex $data 13]
3325 set bm
[lindex $data 12]
3329 set bm
[lindex $data 10]
3331 set bm
[lindex $data 9]
3335 set bm
[lindex $data 11]
3338 [WindowLink
$win.
canvas] itemconfig
$id -bitmap $bm
3342 proc DoEnterCityName
{win
} {
3346 proc InitVotesForUseThisMap
{} {
3347 # TODO: Disabled for new scenario window.
3350 global VotesForUseThisMap ScenarioWindows
3351 set VotesForUseThisMap
{}
3352 foreach win
$ScenarioWindows {
3353 [WindowLink
$win.vote
] config
-relief raised
3355 UpdateVotesForUseThisMap
3359 proc UpdateVotesForUseThisMap
{} {
3360 global ScenarioWindows
3361 UpdateVotesFor UseThisMap
$ScenarioWindows
3365 proc UIUseThisMap
{} {
3366 global CityName GameLevel Scenario
3368 # special handling for scenarios?
3369 if {$GameLevel != -1} {
3370 sim GameLevel
$GameLevel
3372 sim CityName
$CityName
3375 if {$Scenario != -1} {
3376 UIShowPicture
$Scenario
3381 proc HandleScenarioDown
{win x y
} {
3382 #echo HandleScenarioDown $win $x $y
3383 HandleScenarioMove
$win $x $y
3384 set w
[WindowLink
$win.w
]
3385 set target
[WindowLink
$w.scenarioTarget
]
3386 LinkWindow
$w.scenarioTargetDown
$target
3390 proc HandleScenarioUp
{win x y
} {
3391 #echo HandleScenarioUp $win $x $y
3392 HandleScenarioMove
$win $x $y
3393 global ScenarioButtons
3394 set w
[WindowLink
$win.w
]
3395 set target
[WindowLink
$w.scenarioTarget
]
3396 set targetDown
[WindowLink
$w.scenarioTargetDown
]
3397 if {($target != -1) &&
3398 ($target == $targetDown)} {
3399 set data
[lindex $ScenarioButtons $target]
3400 set type
[lindex $data 0]
3401 set id
[lindex $data 1]
3402 set callback
[lindex $data 2]
3403 set param
[lindex $data 3]
3404 set var
[lindex $data 4]
3405 set xx
[lindex $data 5]
3406 set yy
[lindex $data 6]
3407 set ww
[lindex $data 7]
3408 set hh
[lindex $data 8]
3409 set normal
[lindex $data 9]
3410 set over
[lindex $data 10]
3411 set disabled
[lindex $data 11]
3412 if {$type == "button"} {
3413 #echo callback $callback w $w param $param
3414 eval "$callback $w {$param}"
3416 if {$type == "checkbox"} {
3417 #echo checkbox callback $callback w $w param $param
3418 eval "$callback $w {$param}"
3425 proc HandleScenarioMove
{win x y
} {
3426 #echo HandleScenarioMove $win $x $y
3427 global ScenarioButtons
3428 set w
[WindowLink
$win.w
]
3429 set target
[WindowLink
$w.scenarioTarget
]
3432 set len
[llength $ScenarioButtons]
3434 set data
[lindex $ScenarioButtons $i]
3435 set type
[lindex $data 0]
3436 set id
[lindex $data 1]
3437 set callback
[lindex $data 2]
3438 set param
[lindex $data 3]
3439 set var
[lindex $data 4]
3440 set xx
[lindex $data 5]
3441 set yy
[lindex $data 6]
3442 set ww
[lindex $data 7]
3443 set hh
[lindex $data 8]
3445 set enabled
[WindowLink
$w.
$id.enabled
]
3446 set checked
[WindowLink
$w.
$id.checked
]
3448 #echo "ID $id ENABLED $enabled CHECKED $checked w $w id $id"
3450 if {($enabled != 0) &&
3452 ($x < ($xx + $ww)) &
3454 ($y < ($yy + $hh))} {
3459 set i
[expr "$i + 1"]
3462 if {$found != $target} {
3465 if {$target != -1} {
3467 #echo OUT $w $found $xx $yy $normal
3468 LinkWindow
$w.scenarioTarget
-1
3470 set targetdata
[lindex $ScenarioButtons $target]
3471 set targetid
[lindex $targetdata 1]
3472 LinkWindow
$w.
$targetid.over
0
3473 UpdateScenarioButton
$w $targetdata
3478 #echo IN $w $found $xx $yy $over
3479 LinkWindow
$w.scenarioTarget
$found
3480 LinkWindow
$w.
$id.over
1
3482 if {$target != -1} {
3483 set targetdata
[lindex $ScenarioButtons $target]
3484 set targetid
[lindex $targetdata 1]
3485 LinkWindow
$w.
$targetid.over
0
3486 UpdateScenarioButton
$w $targetdata
3489 UpdateScenarioButton
$w $data
3495 proc DoLoad
{win param
} {
3496 #echo DOLOAD $win $param
3501 proc DoGenerate
{win param
} {
3502 #echo DOGENERATE $win $param
3507 proc DoQuit
{win param
} {
3508 #echo DOQUIT $win $param
3513 proc DoAbout
{win param
} {
3514 #echo DOABOUT $win $param
3515 MakeHistory
"DoLoadCity cities/about.cty"
3519 proc DoMap
{win param
} {
3520 #echo DOMAP $win $param
3524 proc DoLevel
{win param
} {
3525 #echo DOLEVEL $win $param
3526 DoSetGameLevel
$param
3530 proc DoLeft
{win param
} {
3531 #echo DOLEFT $win $param
3536 proc DoRight
{win param
} {
3537 #echo DORIGHT $win $param
3542 proc DoPlay
{win param
} {
3543 #echo DOPLAY $win $param
3548 proc DoPickScenario
{win param
} {
3549 #echo DOPICKSCENARIO $win $param
3550 UILoadScenario
$param
3553 proc DeleteScenarioWindow
{win
} {
3558 ########################################################################
3559 # Undo/Redo Facility
3562 proc InitHistory
{} {
3564 global MapHistoryNum
3566 set MapHistoryNum
-1
3570 proc MakeHistory
{cmd
} {
3572 set len
[llength $MapHistory]
3574 ($cmd != [lindex $MapHistory [expr $len-1]])} {
3575 lappend MapHistory
$cmd
3583 proc GotoHistory
{i
} {
3585 global MapHistoryNum
3586 InitVotesForUseThisMap
3587 if {$i != $MapHistoryNum} {
3588 set MapHistoryNum
$i
3589 set cmd
[lindex $MapHistory $i]
3592 if {$MapHistoryNum == 0} {
3597 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3603 global ScenarioWindows
3604 foreach win
$ScenarioWindows {
3605 UpdateLeftRightEnabled
$win
3611 proc NextHistory
{} {
3613 global MapHistoryNum
3614 set len
[llength $MapHistory]
3615 set i
[expr "$MapHistoryNum + 1"]
3622 proc PrevHistory
{} {
3624 global MapHistoryNum
3625 set i
[expr "$MapHistoryNum - 1"]
3632 ########################################################################
3633 # Ask Window Handlers
3635 proc ShowAskOf
{head
} {
3636 set win
[WindowLink
$head.ask
]
3638 set win
[MakeWindow.ask
$head [winfo screen
$head]]
3648 foreach win
$HeadWindows {
3654 proc WithdrawAsks
{} {
3656 foreach win
$AskWindows {
3662 proc WithdrawAskOf
{win
} {
3663 set ask
[WindowLink
$win.ask
]
3670 proc AskQuestion
{color title
text left middle right
} {
3672 foreach win
$HeadWindows {
3673 AskQuestionOn
$win $color $title $text $left $middle $right
3678 proc AskQuestionOn
{head color title
text left middle right
} {
3681 set win
[WindowLink
$head.ask
]
3682 set t
[WindowLink
$win.title
]
3683 $t configure
-text $title
3684 $t configure
-background $color
3686 set t
[WindowLink
$win.
text]
3687 $t configure
-state normal
3689 $t insert end
"${text}\n"
3690 $t configure
-state disabled
3692 set bf
[WindowLink
$win.
frame]
3693 set l
[WindowLink
$win.left
]
3694 set m
[WindowLink
$win.middle
]
3695 set r
[WindowLink
$win.vote
]
3696 set rf
[WindowLink
$win.voteframe
]
3700 -text [lindex $left 0] \
3701 -command [format [lindex $left 2] $head]
3702 SetHelp
$l [lindex $left 1]
3703 pack append $bf $l {left
frame center
}
3708 if {$middle != ""} {
3710 -text [lindex $middle 0] \
3711 -command [format [lindex $middle 2] $head]
3712 SetHelp
$m [lindex $middle 1]
3713 pack append $bf $m {left
frame center expand
}
3719 set notify
[format [lindex $right 2] $head]
3720 set preview
[format [lindex $right 3] $head]
3721 set cmd
[list DoVote
$win Ask
$notify $preview]
3723 -text [lindex $right 0] \
3725 SetHelp
$r [lindex $right 1]
3726 pack append $bf $rf {right
frame center
}
3735 proc BindVotingButton
{win but name
} {
3736 set w
[WindowLink
$win.top
]
3738 bind $but <Any-Enter
> "VoteButtonEnter $win $but"
3739 bind $but <Any-Leave
> "VoteButtonLeave $win $but"
3740 bind $but <1> "VoteButtonDown $win $but $name"
3741 bind $but <ButtonRelease-1
> "VoteButtonUp $win $but $name"
3742 bind $but <2> "VoteButtonDown $win $but $name"
3743 bind $but <ButtonRelease-2
> "VoteButtonUp $win $but $name"
3744 bind $but <3> "VoteButtonDown $win $but $name"
3745 bind $but <ButtonRelease-3
> "VoteButtonUp $win $but $name"
3749 proc VoteButtonEnter
{win but
} {
3751 set screen
[winfo screen
$but]
3752 if {[lindex [$but config
-state] 4] != "disabled"} {
3753 $but config
-state active
3754 set tk_priv
(window
@$screen) $but
3756 set tk_priv
(window
@$screen) ""
3761 proc VoteButtonLeave
{win but
} {
3763 if {[lindex [$but config
-state] 4] != "disabled"} {
3764 $but config
-state normal
3766 set screen
[winfo screen
$but]
3767 set tk_priv
(window
@$screen) ""
3771 proc VoteButtonDown
{win but name
} {
3773 set screen
[winfo screen
$but]
3774 set rel
[lindex [$but config
-relief] 4]
3775 set tk_priv
(relief
@$screen) $rel
3776 if {[lindex [$but config
-state] 4] != "disabled"} {
3777 set head
[WindowLink
$win.head
]
3778 if {[IsVotingFor
$head $name]} {
3779 $but config
-relief raised
3781 $but config
-relief sunken
3787 proc VoteButtonUp
{win but name
} {
3789 set screen
[winfo screen
$but]
3790 $but config
-relief $tk_priv(relief
@$screen)
3791 if {($but == $tk_priv(window
@$screen))
3792 && ([lindex [$but config
-state] 4] != "disabled")} {
3793 uplevel #0 [list $but invoke]
3794 set head
[WindowLink
$win.head
]
3795 if {[IsVotingFor
$head $name]} {
3796 $but config
-relief sunken
3798 $but config
-relief raised
3804 proc PressVoteButton
{win but name
} {
3806 uplevel #0 [list $but invoke]
3807 set head
[WindowLink
$win.head
]
3808 if {[IsVotingFor
$head $name]} {
3809 $but config
-relief sunken
3811 $but config
-relief raised
3816 proc IsVotingFor
{win name
} {
3817 global VotesFor
$name
3818 set votes
[eval ident
"\$\{VotesFor$name\}"]
3819 if {[lsearch $votes $win] == -1} {
3827 proc DoVote
{win name notify preview
} {
3828 global VotesFor
$name
3829 set votes
[eval ident
"\$\{VotesFor$name\}"]
3831 set win
[WindowLink
$win.head
]
3832 set i
[lsearch $votes $win]
3834 lappend VotesFor
$name $win
3836 set VotesFor
$name [lreplace $votes $i $i]
3839 set votes
[eval ident
"\$\{VotesFor$name\}"]
3840 if {[llength $votes] >= [NeededVotes
]} {
3848 proc UpdateVotesFor
{name wins
} {
3849 global VotesFor
$name
3850 set votes
[eval llength "\$\{VotesFor$name\}"]
3851 set needed
[NeededVotes
]
3854 set head
[WindowLink
$win.head
]
3855 if {[IsVotingFor
$head $name]} {
3856 set border
[expr "($needed - $votes) * 1"]
3857 set pad
[expr "6 - $border"]
3858 [WindowLink
$win.vote
] config
-padx $pad -pady $pad
3859 [WindowLink
$win.voteframe
] config
-borderwidth $border
3861 set border
[expr "($needed - $votes - 1) * 1"]
3862 set pad
[expr "6 - $border"]
3863 [WindowLink
$win.vote
] config
-padx $pad -pady $pad
3864 [WindowLink
$win.voteframe
] config
-borderwidth $border
3870 proc InitVotesForAsk
{} {
3871 global VotesForAsk AskWindows
3873 foreach win
$AskWindows {
3874 [WindowLink
$win.vote
] config
-relief raised
3881 proc UpdateVotesForAsk
{} {
3883 UpdateVotesFor Ask
$AskWindows
3887 ########################################################################
3888 # Player Window Handlers
3890 proc ShowPlayerOf
{head
} {
3891 set win
[WindowLink
$head.player
]
3893 set win
[MakeWindow.player
$head [winfo screen
$head]]
3901 proc ShowPlayers
{} {
3903 foreach win
$HeadWindows {
3909 proc WithdrawPlayers
{} {
3910 global PlayerWindows
3911 foreach win
$PlayerWindows {
3917 proc UpdatePlayers
{} {
3918 # TODO: Disabled for new scenario window.
3921 global HeadWindows PlayerWindows
3924 foreach win
$HeadWindows {
3925 set server
[winfo screen
$win]
3926 # if {[string first : $server] == 0} {
3927 # set server "[exec hostname]:0"
3929 lappend players
$server
3932 sim Players
[llength $players]
3934 foreach win
$PlayerWindows {
3935 set list [WindowLink
$win.players
]
3937 eval "$list insert 0 $players"
3940 UpdateVotesForUseThisMap
3942 UpdateVotesForBudget
3943 UpdateTaxRateSliders
3947 proc UIShowPlayer
{win
} {
3952 proc DoNewPlayer
{win
} {
3953 set field
[WindowLink
$win.display
]
3954 set dpy
[$field get
]
3959 if {[AddPlayer
$dpy] != ""} {
3965 ########################################################################
3966 # Notice Window Handlers
3969 proc ShowNoticeOf
{head
} {
3970 set win
[WindowLink
$head.notice
]
3972 set win
[MakeWindow.notice
$head [winfo screen
$head]]
3974 global NoticePanelWidth NoticePanelHeight
3975 #place configure $win -x 0 -y 0 -width $NoticePanelWidth -height $NoticePanelHeight
3976 pack append [WindowLink
$head.w3
] \
3977 $win {bottom
frame sw expand fill
}
3982 proc ShowNotices
{} {
3984 foreach win
$HeadWindows {
3990 proc WithdrawNotices
{} {
3991 global NoticeWindows
3992 foreach win
$NoticeWindows {
3999 proc ReShowPictureOn
{{head
""}} {
4000 global ShowingPicture ShowingParms
4001 UIShowPictureOn
$head $ShowingPicture $ShowingParms
4005 proc UIShowPicture
{id
{parms
""}} {
4006 UIShowPictureOn
"" $id $parms
4010 proc UIShowPictureOn
{where id
{parms
""}} {
4011 global DoNotices Messages ShowingPicture ShowingParms
4012 if {$DoNotices == 0} {
4016 set ShowingPicture
$id
4017 set ShowingParms
$parms
4018 set msg
$Messages($id)
4019 set color
[lindex $msg 0]
4020 set title
[lindex $msg 1]
4021 set body
[lindex $msg 2]
4023 set cmd
"format {$body} $parms"
4024 set body
[uplevel #0 $cmd]
4026 set props
[lindex $msg 3]
4027 if {"$where" == ""} {
4029 set where
$HeadWindows
4031 foreach head
$where {
4032 NoticeMessageOn
$head "$title" $color "$body" Medium
$props
4037 proc NoticeMessageOn
{head title color
text font props
} {
4039 set win
[WindowLink
$head.notice
]
4041 set t
[WindowLink
$win.title
]
4042 $t configure
-text $title -background $color
4044 set t
[WindowLink
$win.
text]
4045 $t configure
-state normal
-font [Font
$head $font]
4047 $t insert end
"${text}\n"
4048 $t configure
-state disabled
4051 catch {set left
[keylget props left
]}
4052 set l
[WindowLink
$win.left
]
4054 $l config
-bitmap $left
4055 place $l -in $t -anchor sw
-relx .05 -rely .95
4061 catch {set middle
[keylget props middle
]}
4062 set m
[WindowLink
$win.middle
]
4063 if {$middle != ""} {
4064 $m config
-bitmap $middle
4065 place $m -in $t -anchor s
-relx .5 -rely .95
4071 catch {set right
[keylget props right
]}
4072 set r
[WindowLink
$win.right
]
4074 $r config
-bitmap $right
4075 place $r -in $t -anchor se
-relx .95 -rely .95
4081 catch {set view
[keylget props view
]}
4082 set vf
[WindowLink
$win.viewframe
]
4084 set v
[WindowLink
$win.view
]
4085 set bg
[WindowLink
$win.background
]
4089 pack append $bg $vf {left
frame center fill
}
4090 pack append $bg $t {right
frame center fill expand
}
4097 proc UIPopUpMessage
{msg
} {
4102 proc ComeToMe
{view
} {
4103 set win
[winfo toplevel $view]
4106 set x
[expr "[lindex $xy 0] >>4"]
4107 set y
[expr "[lindex $xy 1] >>4"]
4113 proc ComeTo
{win x y
} {
4114 global EditorWindows
4115 set head
[WindowLink
$win.head
]
4118 foreach ed
$EditorWindows {
4119 if {"[WindowLink $ed.head]" == "$head"} {
4121 set view
[WindowLink
$ed.view
]
4122 if {[$view AutoGoto
]} {
4123 lappend myautoeds
$ed
4127 if {[llength $myautoeds]} {
4128 UIAutoGotoOn
$x $y $myautoeds
4130 if {[llength $myeds]} {
4131 UIAutoGotoOn
$x $y $myeds
4137 proc FollowView
{view id
} {
4141 if {[sim DoAnimation
]} {
4142 set head
[WindowLink
[winfo toplevel $view].head
]
4143 global EditorWindows
4144 foreach win
$EditorWindows {
4145 if {"[WindowLink $win.head]" == "$head"} {
4146 set s
[[WindowLink
$win.view
] Skip
]
4147 set skips
[min
$skips $s]
4151 if {$skips == 999999} {
4161 proc PanView
{view x y
} {
4167 ########################################################################
4168 # Help Window Handlers
4171 proc ShowHelpOf
{head
} {
4172 set win
[WindowLink
$head.help
]
4174 set win
[MakeWindow.help
$head [winfo screen
$head]]
4184 foreach win
$HeadWindows {
4190 proc WithdrawHelps
{} {
4192 foreach win
$HelpWindows {
4198 ########################################################################
4199 # Frob Window Handlers
4202 proc ShowFrobOf
{head
} {
4203 set win
[WindowLink
$head.frob
]
4205 set win
[MakeWindow.frob
$head [winfo screen
$head]]
4216 foreach win
$HeadWindows {
4222 proc WithdrawFrobs
{} {
4224 foreach win
$FrobWindows {
4230 proc UISetDynamic
{i min max
} {
4231 sim DynamicData
[expr "$i*2"] $min
4232 sim DynamicData
[expr "$i*2+1"] $max
4236 ########################################################################
4243 source $ResourceDir/help.tcl
4246 proc HandleHelp
{win x y rootx rooty
} {
4247 global HelpLoaded HelpWidgets Messages
4249 if {$HelpLoaded == 0} {
4255 set head
[WindowLink
[winfo toplevel $win].head
]
4258 catch {set id
$HelpWidgets($win)}
4262 set list [split $win .
]
4263 set len
[expr "[llength $list] - 2"]
4264 set list [lrange $list 0 $len]
4265 if {[llength $list] <= 1} {
4269 set win
[join $list .
]
4271 if [info exists Messages
($id)] {
4272 UIShowHelpOn
$head $id
4274 UIShowHelpOn
$head Window
4279 proc UIShowHelpOn
{win id
{parms
""}} {
4280 global Messages ShowingPicture ShowingParms ResourceDir
4281 set head
[WindowLink
$win.head
]
4282 set msg
$Messages($id)
4283 set color
[lindex $msg 0]
4284 set title
[lindex $msg 1]
4285 set body
[lindex $msg 2]
4287 set cmd
"format {$body} $parms"
4288 set body
[uplevel #0 $cmd]
4290 set props
[lindex $msg 3]
4293 set win
[WindowLink
$head.help
]
4295 set t
[WindowLink
$win.title
]
4296 $t configure
-text $title -background $color
4298 set t
[WindowLink
$win.
text]
4299 $t configure
-state normal
-font [Font
$head Large
]
4301 $t insert end
"${body}\n"
4302 FormatHTML
$ResourceDir/doc
/$id.html
$t
4303 $t configure
-state disabled
4307 proc FormatHTML
{filename text} {
4310 set f
[open $filename]
4317 while {[gets $f line
] >= 0} {
4318 if {"$line" == "</body>"} {
4321 if {([string index
$line 0] == "#") ||
([string length
$line] == 0)} {
4324 $text insert end
"$line\n"
4333 proc SetHelp
{win id
} {
4335 set HelpWidgets
($win) $id
4339 proc Help
{id title
{msg
{}} {props
{}}} {
4340 Message
$id #7f7fff $title $msg $props
4343 ########################################################################
4347 # Set up the bindings to pop up $pie when the right button is clicked in $win
4348 proc InitPie
{win pie
} {
4349 bind $win <Motion
> {}
4350 bind $win <3> "PieMenuDown $win $pie $pie Initial %X %Y"
4351 bind $win <B3-Motion
> {}
4352 bind $win <B3-ButtonRelease
> {}
4356 # Set up the bindings to continue tracking $pie
4357 # Get this: we keep the tracking machine state in the bindings!
4358 proc ActivatePie
{win root pie state
} {
4359 bind $win <Motion
> "PieMenuMotion $win $root $pie $state %X %Y"
4360 bind $win <3> "PieMenuDown $win $root $pie $state %X %Y"
4361 bind $win <B3-Motion
> "PieMenuMotion $win $root $pie $state %X %Y"
4362 bind $win <B3-ButtonRelease
> "PieMenuUp $win $root $pie $state %X %Y"
4366 # Cancel and reset a pie menu
4367 proc CancelPie
{win
} {
4368 set binding
[bind $win <3>]
4369 set root
[lindex $binding 2]
4370 set pie
[lindex $binding 3]
4371 set state
[lindex $binding 4]
4372 if {"$state" != "Initial"} {
4373 catch {$root ungrab
$win}
4376 UIMakeSoundOn
$win fancy Oop
4382 # Handle pie menu button down
4383 proc PieMenuDown
{win root pie state x y
} {
4386 ActivatePie
$win $root $pie FirstDown
4388 catch {$root grab $win}
4391 PreviewPieMenu
$win $pie $x $y
4395 TrackPieMenu
$pie $x $y
4396 ActivatePie
$win $root $pie SecondDown
4402 PreviewPieMenu
$win $pie $x $y
4403 ActivatePie
$win $root $pie SecondDown
4408 SecondDown
{ # error
4415 # Handle pie menu button motion
4416 proc PieMenuMotion
{win root pie state x y
} {
4419 TrackPieMenu
$pie $x $y
4427 TrackPieMenu
$pie $x $y
4441 # Handle pie menu button up
4442 proc PieMenuUp
{win root pie state x y
} {
4445 TrackPieMenu
$pie $x $y
4446 set active
[$pie index active
]
4447 if {$active == "none"} {
4449 catch {$root grab $win}
4450 ActivatePie
$win $root $pie ClickedUp
4452 set label [lindex [$pie entryconfig
$active -label] 4]
4453 set submenu
[lindex [$pie entryconfig
$active -piemenu] 4]
4454 UIMakeSoundOn
$win mode
$label
4455 if {$submenu == {}} {
4456 set reward
[$pie pending
]
4457 catch {$root ungrab
$win}
4461 sim Funds
[expr "[sim Funds] + 5"]
4462 UIMakeSoundOn
$win fancy Aaah
4464 eval [lindex [$pie entryconfig
$active -command] 4]
4469 $submenu activate none
4471 PreviewPieMenu
$win $submenu $x $y
4472 catch {$root grab $win}
4473 ActivatePie
$win $root $submenu SelectedUp
4478 TrackPieMenu
$pie $x $y
4479 set active
[$pie index active
]
4480 if {$active == "none"} {
4483 set label [lindex [$pie entryconfig
$active -label] 4]
4484 set submenu
[lindex [$pie entryconfig
$active -piemenu] 4]
4485 UIMakeSoundOn
$win mode
$label
4486 if {$submenu == {}} {
4487 set reward
[$pie pending
]
4488 catch {$root ungrab
$win}
4492 sim Funds
[expr "[sim Funds] + 5"]
4493 UIMakeSoundOn
$win fancy Aaah
4495 eval [lindex [$pie entryconfig
$active -command] 4]
4500 $submenu activate none
4502 PreviewPieMenu
$win $submenu $x $y
4503 catch {$root grab $win}
4504 ActivatePie
$win $root $submenu SelectedUp
4514 SelectedUp
{ # error
4521 # Track the selected item
4522 proc TrackPieMenu
{pie x y
} {
4523 $pie activate
@$x,$y
4527 proc PreviewPieMenu
{win pie x y
} {
4528 set preview
[lindex [$pie config
-preview] 4]
4529 if {"$preview" != ""} {
4530 set rx
[winfo rootx
$win]
4531 set ry
[winfo rooty
$win]
4532 set x
[expr "$x - $rx"]
4533 set y
[expr "$y - $ry"]
4534 eval [format $preview $x $y]
4539 ########################################################################
4543 proc ExclusivePallet
{state parent children prefix images inactive active cmd
} {
4544 #echo "ExclusivePallet state $state parent $parent children $children prefix $prefix images $images inactive $inactive active $active cmd $cmd"
4546 foreach child
$children {
4547 set name
[lindex $images $i]
4548 if {$i == $state} then
{
4549 $parent.
$child config
\
4550 -bitmap "@images/${prefix}${name}hi.xpm" \
4553 $parent.
$child config
\
4554 -bitmap "@images/${prefix}${name}.xpm" \
4559 eval [concat $cmd $state]
4563 proc NonExclusivePallet
{mask parent children prefix images
4564 inactive active cmd
} {
4566 foreach child
$children {
4567 set name
[lindex $images $i]
4568 if {$mask & (1<<$i)} then
{
4569 $parent.
$child config
\
4570 -bitmap "@images/${prefix}${name}hi.xpm" \
4573 $parent.
$child config
\
4574 -bitmap "@images/${prefix}${name}.xpm" \
4579 eval [concat $cmd $mask]
4583 proc EditorPallet
{win state
} {
4584 global EditorPalletSounds
4585 UIMakeSoundOn
$win mode
[lindex $EditorPalletSounds $state]
4586 EditorSetTool
$win $state
4590 proc EditorSetTool
{win state
} {
4591 global EditorPallets
4592 global EditorPalletImages
4593 ExclusivePallet
$state $win $EditorPallets ic
$EditorPalletImages \
4594 flat raised
"$win.centerframe.view ToolState"
4598 proc GraphPallet
{win state
} {
4599 set mask
[[WindowLink
$win.graphview
] Mask
]
4600 set mask
[expr "$mask ^ (1<<$state)"]
4601 GraphPalletMask
$win $mask
4605 proc GraphPalletMask
{win mask
} {
4607 global GraphPalletImages
4608 NonExclusivePallet
$mask $win $GraphPallets gr
$GraphPalletImages \
4609 flat flat
"SetGraphState $win"
4613 proc GraphYearPallet
{win state
} {
4614 global GraphYearPallets
4615 global GraphYearPalletImages
4616 ExclusivePallet
$state $win $GraphYearPallets gr
$GraphYearPalletImages \
4617 flat flat
"SetGraphYearState $win"
4621 proc SetGraphYearState
{win state
} {
4622 set graph
[WindowLink
$win.graphview
]
4631 proc SetGraphState
{win mask
} {
4633 set graph
[WindowLink
$win.graphview
]
4638 ########################################################################
4641 proc sim_butEnter
{w
} {
4643 set screen
[winfo screen
$w]
4644 set tk_priv
(window
@$screen) $w
4648 proc sim_butLeave
{w
} {
4650 set screen
[winfo screen
$w]
4651 set tk_priv
(window
@$screen) ""
4655 proc sim_butDown
{w
} {
4657 set screen
[winfo screen
$w]
4658 set pict
[lindex [$w config
-bitmap] 4]
4659 set tk_priv
(relief
@$screen) $pict
4660 $w config
-bitmap [lindex [split $pict .
] 0]hi.xpm
4665 proc sim_butUp
{w
} {
4667 set screen
[winfo screen
$w]
4668 $w config
-bitmap $tk_priv(relief
@$screen)
4670 if {$w == $tk_priv(window
@$screen)} {
4671 uplevel #0 [list $w invoke]
4676 proc BindSimButton
{w
} {
4677 bind $w <Any-Enter
> {sim_butEnter
%W
}
4678 bind $w <Any-Leave
> {sim_butLeave
%W
}
4679 bind $w <1> {sim_butDown
%W
}
4680 bind $w <ButtonRelease-1
> {sim_butUp
%W
}
4681 bind $w <2> {sim_butDown
%W
}
4682 bind $w <ButtonRelease-2
> {sim_butUp
%W
}
4683 bind $w <3> {sim_butDown
%W
}
4684 bind $w <ButtonRelease-3
> {sim_butUp
%W
}
4688 ########################################################################
4689 # Internal Callbacks
4692 proc UIStartMicropolis
{homedir resourcedir hostname
} {
4693 global HomeDir ResourceDir HostName HeadWindows
4694 set HomeDir
$homedir
4695 set ResourceDir
$resourcedir
4696 set HostName
$hostname
4701 foreach display
[sim Displays
] {
4702 if {"[AddPlayer $display]" == ""} {
4703 echo Couldn't add a player on
$display ...
4707 if {"$HeadWindows" == ""} {
4708 echo Micropolis is exiting because it couldn't connect to any players.
4714 proc UISelectCity
{win
} {
4715 AskQuestion
[Color
$win #ff0000 #ffffff] "Choose Another City" \
4716 "Do you want to abandon this city and choose another one?" \
4717 "{Keep playing.} SelectCity.No {RejectPlan}" \
4719 "{Another city!} SelectCity.Yes {UIPickScenarioMode}"
4723 proc UIQuit
{head
} {
4724 if {[sim Players
] == 1} {
4725 set l
"{Keep playing.} Quit.No {RejectPlan}"
4727 set r
"{I quit!} Quit.IQuit {DoReallyQuit %s}"
4729 set l
"{Keep playing.} Quit.No {RejectPlan}"
4730 set m
"{I quit!} Quit.IResign {DoIResign %s}"
4731 set r
"{Everyone quit!} Quit.AllQuit {DoReallyQuit %s}"
4733 AskQuestion
[Color
$head #ff0000 #ffffff] "Quit Playing Micropolis" \
4734 "Do you want to quit playing Micropolis?" \
4739 proc DoIResign
{head
} {
4741 set display
[winfo screen
$head]
4743 DecRefDisplay
$display
4744 UISetMessage
"The player on X11 Display $display has resigned."
4746 if {([sim Players
] == 0) ||
4747 ([llength $VotesForAsk] >= [sim Players
])} {
4753 proc DoReallyQuit
{head
} {
4759 proc UISplashMode
{} {
4769 proc UIPickScenarioMode
{} {
4778 InitVotesForUseThisMap
4783 proc ForcePickScenarioMode
{} {
4785 if {"$State" != "scenario"} {
4791 proc UIGenerateCityNow
{} {
4792 global CityName GameLevel
4793 sim CityName NowHere
4799 proc UIGenerateNewCity
{} {
4800 global CityName GameLevel
4801 if {$GameLevel == -1} {
4804 MakeHistory
"DoNewCity NowHere $GameLevel [sim Rand] [sim TreeLevel] [sim LakeLevel] [sim CurveLevel] [sim CreateIsland]"
4808 proc DoNewCity
{name level
{r
""} {tl
-1} {ll
-1} {cl
-1} {ci
-1}} {
4814 sim CreateIsland
$ci
4818 sim GenerateSomeCity
$r
4821 sim GameLevel
$level
4826 proc UIDidGenerateNewCity
{} {
4831 proc IncRefDisplay
{display
} {
4832 global DisplayRegistry
4833 if ![info exists DisplayRegistry
($display)] {
4834 set DisplayRegistry
($display) 0
4836 incr DisplayRegistry
($display)
4840 proc DecRefDisplay
{display
} {
4841 global DisplayRegistry
4842 incr DisplayRegistry
($display) -1
4843 if {$DisplayRegistry($display) <= 0} {
4844 CloseDisplay
$display
4849 proc CloseDisplay
{display
} {
4853 proc DoStopMicropolis
{} {
4859 proc AddPlayer
{display
} {
4860 set i
[string first
: $display]
4864 set display
"$display:0"
4868 echo Adding a player on
$display ...
4870 set head
[MakeWindow.head
$display]
4872 if {"$head" != ""} {
4873 set display
[winfo screen
$head]
4874 IncRefDisplay
$display
4876 UISetMessage
"Added a player on X11 Display \"$display\"."
4879 UISetMessage
"Couldn't add a player on X11 Display \"$display\"!"
4889 proc DropFireBombs
{} {
4897 proc UIMakeMonster
{} {
4898 sim MakeMonster
[sim Rand
120] [sim Rand
100]
4921 proc TogglePause
{} {
4924 if {"$State" != "play" ||
[sim Speed
]} {
4935 proc SetSpeedTime
{time} {
4941 proc MakeRunningSound
{} {
4944 if {"$State" == "play" && [sim Speed
]} {
4945 UIMakeSound edit Boing
"-speed 1[sim Speed]0"
4947 UIMakeSound edit Boing
"-speed 90"
4952 proc SayDemands
{} {
4953 global DemandRes DemandCom DemandInd
4955 set r
[expr "100 + ($DemandRes * $slope)"]
4956 set c
[expr "100 + ($DemandCom * $slope)"]
4957 set i
[expr "100 + ($DemandInd * $slope)"]
4958 after 020 "UIMakeSound edit O \"-speed $r\""
4959 after 220 "UIMakeSound edit A \"-speed $c\""
4960 after 440 "UIMakeSound edit E \"-speed $i\""
4964 proc UISaveCity
{win
} {
4966 set SaveCityWin
$win
4971 proc UISaveCityAs
{{win
""}} {
4973 if {"$win" == ""} {set win
$SaveCityWin}
4974 set SaveCityWin
$win
4977 set file [ShowFileOf
$win]
4978 DoFileDialog
$file "Choose a File to Save the City" $CityDir "*.cty" "" \
4979 "UIDoReallySaveCity" ""
4983 proc UIDoReallySaveCity
{name path
} {
4985 if {![string match
*.cty
$name]} {
4989 sim SaveCityAs
$path/$name
4993 proc UIDidSaveCity
{} {
4994 DoSendMessage
"Saved the city in \"[sim CityFileName]\"." status
4998 proc UIDidntSaveCity
{msg
} {
4999 DoSendMessage
$msg alert
5000 UIMakeSound warning Sorry
"-speed 85"
5004 proc UILoadScenario
{scen
} {
5005 MakeHistory
"DoScenario $scen"
5009 proc DoScenario
{scen
} {
5012 sim LoadScenario
$scen
5017 proc UIDidLoadScenario
{} {
5021 proc UIStartScenario
{id
} {
5030 proc UIPlayNewCity
{} {
5036 proc UIStartLoad
{} {
5041 proc UIReallyStartGame
{} {
5047 proc UIPlayGame
{} {
5054 SetPriority
$Priority
5062 proc UISetSpeed
{speed
} {
5065 if {"$State" == "play"} {
5066 UISetMessage
[lindex {
5069 {Time flows medium.
}
5077 proc UIUpdateRunning
{} {
5078 global HeadWindows Time State
5080 if {($State == "play") && $Time} {
5081 set pict
"@images/micropolisg.xpm"
5083 set pict
"@images/micropoliss.xpm"
5086 foreach win
$HeadWindows {
5087 set can
[WindowLink
$win.demand
]
5088 $can itemconfig micropolis
-bitmap $pict
5093 proc DoSetGameLevel
{level
} {
5094 sim GameLevel
$level
5098 proc UISetGameLevel
{level
} {
5100 set GameLevel
$level
5101 global ScenarioWindows
5102 foreach win
$ScenarioWindows {
5103 UpdateLevelSelection
$win
5108 proc UISetCityName
{name
} {
5109 global EditorWindows
5112 set title
"Micropolis Editor on $name"
5113 foreach win
$EditorWindows {
5114 # TODO: set editor window and icon title
5115 #wm title $win "$title"
5116 #wm iconname $win "$title"
5121 proc UILoadCity
{win
} {
5122 # if changed, r-u-sure?
5124 set file [ShowFileOf
$win]
5125 DoFileDialog
$file "Choose a City to Load" $CityDir "*.cty" "" \
5130 proc UIDoLoadCity
{name path
} {
5133 if {![string match
*.cty
$name]} {
5136 MakeHistory
"DoLoadCity {$path/$name}"
5140 proc DoLoadCity
{filename} {
5141 sim LoadCity
$filename
5144 proc UIDidLoadCity
{} {
5145 global State GameLevel Scenario
5148 if {$State == "play"} {
5151 UIShowPicture
49 [sim CityFileName
]
5156 proc UIDidntLoadCity
{msg
} {
5157 DoSendMessage
$msg alert
5158 UIMakeSound warning Sorry
"-speed 85"
5159 UIShowPicture
49 [sim CityFileName
]
5178 proc UIDidPan
{w x y
} {
5179 if {[$w ToolMode
] == 1} {
5180 EditorToolDrag
$w $x $y
5186 proc UIDidStopPan
{win
} {
5187 UIMakeSoundOn
$win fancy Skid
"-volume 25"
5192 proc UIEarthQuake
{} {
5196 proc UIAutoGoto
{x y
{except
{}}} {
5197 global EditorWindows
5199 set x
[expr "$x * 16 + 8"]
5200 set y
[expr "$y * 16 + 8"]
5201 foreach win
$EditorWindows {
5202 if {"$win" != "$except"} {
5203 set view
[WindowLink
$win.view
]
5204 if {[$view AutoGoto
]} {
5206 $view AutoGoal
$x $y
5216 proc UIAutoGotoOn
{x y eds
} {
5217 set x
[expr "$x * 16 + 8"]
5218 set y
[expr "$y * 16 + 8"]
5220 [WindowLink
$win.view
] AutoGoal
$x $y
5226 proc DoLeaveGame
{head
} {
5230 proc UILoseGame
{} {
5234 AskQuestion
[Color .
#ff0000 #ffffff] [lindex $Messages(200) 1] \
5235 [lindex $Messages(200) 2] \
5238 "{Ok} SelectCity.Yes {UIPickScenarioMode}"
5247 proc DoPendTool
{view tool x y
} {
5248 global HeadWindows ToolInfo VotesForAsk
5250 set win
[WindowLink
$view.top
]
5251 set head
[WindowLink
$win.head
]
5253 if {($tool == [sim PendingTool
]) &&
5254 ($x == [sim PendingX
]) &&
5255 ($y == [sim PendingY
])} {
5256 if {[lsearch $VotesForAsk $head] != -1} {
5257 # you can only vote once
5258 UIMakeSound edit Oop
5260 UIMakeSound edit Boing
5261 set ask
[WindowLink
$head.ask
]
5262 PressVoteButton
$ask [WindowLink
$ask.vote
] Ask
5265 UIAutoGoto
$x $y $win
5267 UIMakeSound edit Boing
5268 set info [lindex $ToolInfo $tool]
5269 set a
[lindex $info 0]
5270 set name
[lindex $info 1]
5271 set cost
[lindex $info 2]
5272 set title
"Build $a $name"
5273 set question
"Do you support the plan to build $a $name for $cost?"
5274 AskQuestion
[Color
$win #00ff00 #ffffff] "$title" \
5276 "{Veto plan.} Plan.Veto
5278 "{Goto plan.} Plan.Goto
5279 {ComeTo %s $x $y}" \
5280 "{Support plan!} Plan.Support
5281 {SupportPlan $view %s $tool $x $y}
5282 {PreviewSupportPlan $view %s $tool $x $y}"
5283 set VotesForAsk
$head
5284 set ask
[WindowLink
$head.ask
]
5285 [WindowLink
$ask.vote
] config
-relief sunken
5289 sim PendingTool
$tool
5292 sim Votes
[llength $VotesForAsk]
5297 proc RejectPlan
{} {
5299 if {[sim Players
] > 1} {
5300 UIMakeSound edit Sorry
5306 proc NeededVotes
{} {
5308 set players
[sim Players
]
5309 set needed
[expr "$players - $FreeVotes"]
5310 return [max
0 $needed]
5314 proc SupportPlan
{view h tool x y
} {
5316 sim Votes
[llength $VotesForAsk]
5319 $view DoTool
$tool $x $y
5322 UIMakeSound edit Aaah
5326 proc PreviewSupportPlan
{view h tool x y
} {
5328 sim Votes
[llength $VotesForAsk]
5332 proc SugarStartUp
{uri
} {
5336 # TODO: Load the city file at the given URI, or configure according to URI parameters.
5340 proc SugarNickName
{nick
} {
5341 global SugarNickName
5342 set SugarNickName
$nick
5346 proc SugarActivate
{} {
5347 global SugarActivated
5348 set SugarActivated
1
5352 proc SugarDeactivate
{} {
5353 global SugarActivated
5354 set SugarActivated
0
5358 proc SugarShare
{} {
5364 proc SugarBuddyAdd
{key nick color address
} {
5366 set buddy
[list $key $nick $color $address]
5367 lappend SugarBuddies
$buddy
5371 proc SugarBuddyDel
{key nick color address
} {
5373 set buddy
[list $key $nick $color $address]
5374 set i
[lsearch $wins $win]
5376 set SugarBuddies
[lreplace $wins $i $i]
5386 ########################################################################