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
179 set ScenarioPanelWidth
1200
180 set ScenarioPanelHeight
900
189 {editor EditorWindows
}
192 {budget BudgetWindows
}
193 {evaluation EvaluationWindows
}
194 {scenario ScenarioWindows
}
195 {splash SplashWindows
}
198 {player PlayerWindows
}
199 {notice NoticeWindows
}
206 # 0 1 2 3 4 5 6 7 8 9 10 11 12 13
207 # type id callback param var x y w h normal over disabled checked checkedover
208 # ----------- --------------- --------------- ------- ------- --- --- --- --- ------- ---- -------- ------- -----------
209 set ScenarioButtons1200x900
{
210 { button load DoLoad
"" "" 70 238 157 90 "" @images
/button1hilite.xpm
"" }
211 { button generate DoGenerate
"" "" 62 392 157 90 "" @images
/button2hilite.xpm
"" }
212 { button quit DoQuit
"" "" 68 544 157 90 "" @images
/button3hilite.xpm
"" }
213 { button about DoAbout
"" "" 101 705 157 90 "" @images
/button4hilite.xpm
"" }
214 { checkbox easy DoLevel
0 "" 982 106 190 70 "" @images
/checkbox1hilite.xpm
"" @images
/checkbox1checked.xpm
@images
/checkbox1hilitechecked.xpm
}
215 { checkbox medium DoLevel
1 "" 982 176 190 70 "" @images
/checkbox2hilite.xpm
"" @images
/checkbox2checked.xpm
@images
/checkbox2hilitechecked.xpm
}
216 { checkbox hard DoLevel
2 "" 982 246 190 70 "" @images
/checkbox3hilite.xpm
"" @images
/checkbox3checked.xpm
@images
/checkbox3hilitechecked.xpm
}
217 { button left DoLeft
"" "" 540 375 50 50 "" @images
/lefthilite.xpm
@images
/leftdisabled.xpm
}
218 { button right DoRight
"" "" 841 375 50 50 "" @images
/righthilite.xpm
@images
/rightdisabled.xpm
}
219 { button play DoPlay
"" "" 625 376 180 50 "" @images
/playhilite.xpm
"" }
220 { button scenario1 DoPickScenario
"1" "" 310 451 209 188 "" @images
/scenario1hilite.xpm
"" }
221 { button scenario2 DoPickScenario
"2" "" 519 451 209 188 "" @images
/scenario2hilite.xpm
"" }
222 { button scenario3 DoPickScenario
"3" "" 727 450 209 188 "" @images
/scenario3hilite.xpm
"" }
223 { button scenario4 DoPickScenario
"4" "" 936 450 209 188 "" @images
/scenario4hilite.xpm
"" }
224 { button scenario5 DoPickScenario
"5" "" 310 639 209 188 "" @images
/scenario5hilite.xpm
"" }
225 { button scenario6 DoPickScenario
"8" "" 519 639 209 188 "" @images
/scenario6hilite.xpm
"" }
226 { button scenario7 DoPickScenario
"7" "" 728 638 209 188 "" @images
/scenario7hilite.xpm
"" }
227 { button scenario8 DoPickScenario
"6" "" 937 638 209 188 "" @images
/scenario8hilite.xpm
"" }
230 set ScenarioButtons
$ScenarioButtons1200x900
231 set ScenarioBackground
"@images/background-micropolis.xpm"
233 set screenwidth
[winfo screenwidth .
]
234 set screenheight
[winfo screenheight .
]
236 if {($screenwidth < $ScenarioPanelWidth) ||
237 ($screenheight < $ScenarioPanelHeight)} {
238 puts stderr
"WARNING: Screen too small for scenario window, no matching images available.\n"
241 # Disabled until we handle mouse events on the map itself.
242 # { button map DoMap "" "" 516 30 396 338 "" @images/maphilite.xpm }
245 ########################################################################
251 {-*-dejavu lgc sans-medium-r-normal-
*-90-*}
254 {-*-dejavu lgc sans-medium-r-normal-
*-80-*}
257 {-*-dejavu lgc sans-medium-r-normal-
*-70-*}
260 {-*-dejavu lgc sans-medium-r-normal-
*-60-*}
263 {-*-dejavu lgc sans-medium-r-normal-
*-60-*}
266 {-*-dejavu lgc sans-medium-r-normal-
*-60-*}
269 {-*-dejavu lgc sans-medium-r-normal-
*-70-*}
272 {-*-dejavu lgc sans-medium-r-normal-
*-70-*}
275 {-*-dejavu lgc sans-medium-r-normal-
*-70-*}
280 ########################################################################
284 {Micropolis Overall Map
}
285 {Residential Zone Map
}
286 {Commercial Zone Map
}
287 {Industrial Zone Map
}
290 {Population Density Map
}
292 {Traffic Density Map
}
293 {Pollution Desity Map
}
297 {Police Coverage Map
}
303 leftframe.tools.palletres
304 leftframe.tools.palletcom
305 leftframe.tools.palletind
306 leftframe.tools.palletfire
307 leftframe.tools.palletquery
308 leftframe.tools.palletpolice
309 leftframe.tools.palletwire
310 leftframe.tools.palletbulldozer
311 leftframe.tools.palletrail
312 leftframe.tools.palletroad
313 leftframe.tools.palletchalk
314 leftframe.tools.palleteraser
315 leftframe.tools.palletstadium
316 leftframe.tools.palletpark
317 leftframe.tools.palletseaport
318 leftframe.tools.palletcoal
319 leftframe.tools.palletnuclear
320 leftframe.tools.palletairport
324 set EditorPalletImages
{
325 res com ind fire qry pol
326 wire dozr rail road chlk ersr
327 stad park seap coal nuc airp
331 set EditorPalletSounds
{
332 Res Com Ind Fire Query Police
333 Wire Bulldozer Rail Road Chalk Eraser
334 Stadium Park Seaport Coal Nuclear Airport
342 leftframe.right.money
343 leftframe.right.crime
344 leftframe.right.pollution
348 set GraphPalletImages
{
349 res com ind mony crim poll
353 set GraphYearPallets
{
354 leftframe.year.year10
355 leftframe.year.year120
359 set GraphYearPalletImages
{ 10 120 }
363 { {a
} {Residential Zone
} {$100}}
364 { {a
} {Commercial Zone
} {$100}}
365 { {an
} {Industrial Zone
} {$100}}
366 { {a
} {Fire Station
} {$500}}
367 { {a
} {Query
} {free
}}
368 { {a
} {Police Station
} {$500}}
370 { {a
} {Bulldozer
} {$1}}
373 { {a
} {Chalk
} {free
}}
374 { {an
} {Eraser
} {free
}}
375 { {a
} {Stadium
} {$5,000}}
377 { {a
} {Seaport
} {$3,000}}
378 { {a
} {Coal Power Plant
} {$3,000}}
379 { {a
} {Nuclear Power Plant
} {$5,000}}
380 { {an
} {Airport
} {$10,000}}
381 { {a
} {Network
} {$1,000}}
385 set DynamicDataNames
{
396 ########################################################################
398 ########################################################################
401 wm title .
{Micropolis Root
}
404 if {"[sim Platform]" == "msdos"} {
425 # The next three lines have no effect on the OLPC, where we don't provide
426 # the font in res (because it's already in the system fonts). These lines
427 # are for other systems that lack the font.
428 set FontPath
"[pwd]/res/dejavu-lgc"
429 system
"xset -fp \"$FontPath\" >/dev/null 2>&1"
430 system
"xset +fp \"$FontPath\" >/dev/null 2>&1"
432 # Ignore SIGCHLD for spawned sound-player childs, this should lead to them
433 # being reaped by init
434 signal ignore SIGCHLD
437 ########################################################################
439 ########################################################################
442 proc Message
{id color title msg
{props
{}}} {
444 set Messages
($id) [list $color $title $msg $props]
448 Message
1 #7f7fff {DULLSVILLE, USA 1900} \
449 {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.
451 It is your job to attract new growth and development
, turning Dullsville into a Metropolis within
30 years.
}
453 Message
2 #7f7fff {SAN FRANCISCO, CA. 1906} \
454 {Damage from the earthquake was minor compared to that of the ensuing fires
, which took days to control.
1500 people died.
456 Controlling the fires should be your initial concern. Then clear the rubble and start rebuilding. You have
5 years.
}
458 Message
3 #7f7fff {HAMBURG, GERMANY 1944} \
459 {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.
461 You must control the firestorms during the bombing and then rebuild the city
after the war. You have
5 years.
}
463 Message
4 #7f7fff {BERN, SWITZERLAND 1965} \
464 {The roads here are becoming more congested every day
, and the residents are upset. They demand that you do something about it.
466 Some have suggested a mass transit system as the answer
, but this would require major rezoning in the downtown area. You have
10 years.
}
468 Message
5 #7f7fff {TOKYO, JAPAN 1957} \
469 {A large reptilian creature has been spotted heading
for Tokyo bay. It seems to be attracted to the heavy levels of industrial pollution there.
471 Try to control the fires
, then rebuild the industrial center. You have
5 years.
}
473 Message
6 #7f7fff {DETROIT, MI. 1972} \
474 {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.
476 You have
10 years to reduce crime and rebuild the industrial base of the city.
}
478 Message
7 #7f7fff {BOSTON, MA. 2010} \
479 {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.
481 You have
5 years to get the situation under control.
}
483 Message
8 #7f7fff {RIO DE JANEIRO, BRAZIL 2047} \
484 {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.
486 You have
10 years to turn this swamp back into a city again.
}
488 Message
9 #ffa500 {Query Zone Status} \
496 {{view
{PanView
$v $QueryX $QueryY}}}
498 Message
10 #ff4f4f {POLLUTION ALERT!} \
499 {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.
501 Either clean up your act or
open a gas mask concession at city hall.
} \
502 {{view
{PanView
$v [sim PolMaxX
] [sim PolMaxY
]}}}
504 Message
11 #ff4f4f {CRIME ALERT!} \
505 {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.
} \
506 {{view
{PanView
$v [sim CrimeMaxX
] [sim CrimeMaxY
]}}}
508 Message
12 #ff4f4f {TRAFFIC WARNING!} \
509 {Traffic in this city is horrible. The city gridlock is expanding. The commuters are getting militant.
511 Either build more roads and rails or get a bulletproof limo.
} \
512 {{view
{PanView
$v [sim TrafMaxX
] [sim TrafMaxY
]}}}
514 Message
20 #ff4f4f {FIRE REPORTED!} \
515 "A fire has been reported!" \
516 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
518 Message
21 #ff4f4f {MONSTER ATTACK!} \
519 "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. \
520 All you can do is wait till he leaves, then rebuild from the rubble." \
521 {{view
{FollowView
$v monster
}}}
523 # XXX: write more text
524 Message
22 #ff4f4f {TORNADO ALERT!} \
525 {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
!} \
526 {{view
{FollowView
$v tornado
}}}
528 # XXX: write more text
529 Message
23 #ff4f4f {EARTHQUAKE!} \
530 {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.
} \
531 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
533 # XXX: write more text
534 Message
24 #ff4f4f {PLANE CRASH!} \
535 {A plane has crashed
!} \
536 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
538 # XXX: write more text
539 Message
25 #ff4f4f {SHIPWRECK!} \
540 {A ship has wrecked
!} \
541 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
543 # XXX: write more text
544 Message
26 #ff4f4f {TRAIN CRASH!} \
545 {A train has crashed
!} \
546 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
548 # XXX: write more text
549 Message
27 #ff4f4f {HELICOPTER CRASH!} \
550 {A helicopter has crashed
!} \
551 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
553 Message
30 #ff4f4f {FIREBOMBING REPORTED!} \
554 {Firebombs are falling
!!} \
555 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
557 Message
35 #7fff7f {TOWN} \
558 {Congratulations
, your village has grown to town status. You now have
2,000 citizens.
} \
559 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
561 Message
36 #7fff7f {CITY} \
562 {Your town has grown into a full sized city
, with a current population of
10,000. Keep up the good work
!} \
563 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
565 Message
37 #7fff7f {CAPITAL} \
566 {Your city has become a capital. The current population here is
50,000. Your political future looks bright.
} \
567 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
569 Message
38 #7fff7f {METROPOLIS} \
570 {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.
} \
571 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
573 Message
39 #7fff7f {MEGALOPOLIS} \
574 {Congratulation
, you have reached the highest category of urban development
, the megalopolis.
576 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.
} \
577 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
579 Message
40 #7fff7f {MEGALINIUM} \
580 {Congratulation
, you have reached the end of
time!
582 Because of the toroidal nature of the the Micropolis Space
/Time Continuum
, your city has wrapped back in
time to
1900!} \
583 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
585 # XXX: write more text
586 Message
41 #ff4f4f {HEAVY TRAFFIC!} \
588 reporting heavy traffic
!} \
589 {{view
{FollowView
$v helicopter
}}}
591 # XXX: write more text
592 Message
42 #ff4f4f {FLOODING REPORTED!} \
593 {Flooding has been been reported along the water's edge
!} \
594 {{view
{PanView
$v [sim FloodX
] [sim FloodY
]}}}
596 Message
43 #ff4f4f {NUCLEAR MELTDOWN!} \
597 {A nuclear meltdown has occured at your power plant. You are advised to avoid the area until the radioactive isotopes decay.
599 Many generations will confront this problem before it goes away
, so don't hold your breath.
} \
600 {{view
{PanView
$v [sim MeltX
] [sim MeltY
]}}}
603 Message
44 #ff4f4f {RIOTS!} \
604 {The citizens are rioting in the streets
, setting cars and houses on fire
, and bombing government buildings and businesses
!
606 All media coverage is blacked out
, while the fascist pigs beat the poor citizens into submission.
}
608 Message
46 #ff4f4f {NO SOUND SERVER!} \
609 {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.
}
611 Message
48 #7f7fff {Start a New City} \
612 {Build your very own city from the ground up
, starting with this map of uninhabited land.
}
614 Message
49 #7f7fff {Restore a Saved City} \
615 {This city was saved in the
file named
: %s
}
617 Message
100 #7fff7f {YOU'RE A WINNER!} \
618 {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?
} \
619 {{middle
{@images
/key2city.xpm
}}}
621 Message
200 #ff4f4f {IMPEACHMENT NOTICE!} \
622 {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.
624 You should seriously consider taking an extended vacation
-- NOW.
(Or
read the manual and try again.
)}
626 Message
300 #ffd700 {About Micropolis} \
627 "Micropolis Version [sim Version] Copyright (C) 2007
629 Based on the Original Micropolis Concept and Design
631 TCL/Tk User Interface Designed and Created
632 by Don Hopkins, DUX Software.
633 Ported to Linux, Optimized and Adapted for OLPC
635 Licensed under the GNU General Public License,
636 version 3, with additional conditions."
639 ########################################################################
641 ########################################################################
644 option add
*CheckButton.relief flat
645 option add
*Dialog.cursor top_left_arrow
646 option add
*Entry.relief sunken
647 option add
*Frame.borderWidth
0
648 option add
*Listbox.relief sunken
649 option add
*Scrollbar.relief sunken
650 option add
*RadioButton.anchor w
651 option add
*RadioButton.relief flat
653 option add
*background
#b0b0b0
654 option add
*foreground
#000000
655 option add
*activeBackground
#d0d0d0
656 option add
*activeForeground
#000000
657 option add
*disabledForeground
""
658 option add
*selectBackground
#d0d0d0
659 option add
*selectForeground
#000000
660 #option add *selector #ffff80
661 option add
*selector
#bf0000
663 option add
*Scrollbar.Background
#b0b0b0
664 option add
*Scrollbar.Foreground
#d0d0d0
665 option add
*Interval.Background
#b0b0b0
666 option add
*Interval.Foreground
#000000
667 option add
*Interval.activeForeground
#d0d0d0
668 option add
*Interval.sliderForeground
#b0b0b0
669 option add
*Scale.activeForeground
#d0d0d0
670 option add
*Scale.sliderForeground
#b0b0b0
671 option add
*PieMenu.activeBackground
#b0b0b0
673 option add Mwm
*Micropolis.clientDecoration
-maximize
676 ########################################################################
678 ########################################################################
681 bind all
<Help
> {HandleHelp
%W
%x
%y
%X
%Y
}
682 bind all
<Shift-ButtonPress
> {HandleHelp
%W
%x
%y
%X
%Y
}
683 bind all
<Meta-ButtonPress
> {HandleHelp
%W
%x
%y
%X
%Y
}
684 bind all
<Shift-Meta-ButtonPress
> {HandleHelp
%W
%x
%y
%X
%Y
}
687 ########################################################################
689 ########################################################################
708 puts stderr
"$errorInfo"
716 proc NoFunction
{args
} {}
719 proc LinkWindow
{fromname to
} {
721 set WindowLinks
($fromname) $to
725 proc WindowLink
{fromname
} {
728 catch {set to
$WindowLinks($fromname)}
733 proc DeleteWindow
{sym name win
} {
734 set head
[WindowLink
$win.head
]
735 LinkWindow
$head.
$sym {}
737 set wins
[eval ident
"\$$name"]
738 set i
[lsearch $wins $win]
740 set $name [lreplace $wins $i $i]
746 proc Font
{win name
} {
747 global FontInfo FontCache HeadWindows
748 set scr
[winfo screen
$win]
751 set font $FontCache($scr,$name)
756 set label $FontCache($scr)
758 if {"$label" == ""} {
759 foreach head
$HeadWindows {
760 if {"[winfo screen $head]" == "$scr"} {
761 set label $head.fontlabel
762 label $label -text "X11 Sucks" -font fixed
763 set FontCache
($scr) $label
768 set fonts
[keylget FontInfo
$name]
769 foreach font $fonts {
770 #echo "Configuring font $font on $label"
771 if {[catch "$label config -font \"$font\""] == 0} {
784 set FontCache
($scr,$name) $font
790 proc Color
{win color mono
} {
791 if {[winfo screendepth
$win] == 1} {
799 ########################################################################
800 # Window Definition Functions
801 ########################################################################
804 proc MakeWindow.head
{{display
":0"}} {
806 source $ResourceDir/whead.tcl
811 proc MakeWindow.editor
{head
{display
":0"}} {
813 source $ResourceDir/weditor.tcl
818 proc MakeWindow.map
{head
{display
":0"}} {
820 source $ResourceDir/wmap.tcl
825 proc MakeWindow.graph
{head
{display
":0"}} {
827 source $ResourceDir/wgraph.tcl
832 proc MakeWindow.budget
{head
{display
":0"}} {
834 source $ResourceDir/wbudget.tcl
839 proc MakeWindow.evaluation
{head
{display
":0"}} {
841 source $ResourceDir/weval.tcl
846 proc MakeWindow.splash
{head
{display
":0"}} {
848 source $ResourceDir/wsplash.tcl
853 proc MakeWindow.scenario
{head
{display
":0"}} {
855 source $ResourceDir/wscen.tcl
860 proc MakeWindow.
file {head
{display
":0"}} {
862 source $ResourceDir/wfile.tcl
867 proc MakeWindow.ask
{head
{display
":0"}} {
869 source $ResourceDir/wask.tcl
874 proc MakeWindow.player
{head
{display
":0"}} {
876 source $ResourceDir/wplayer.tcl
881 proc MakeWindow.notice
{head
{display
":0"}} {
883 source $ResourceDir/wnotice.tcl
887 proc MakeWindow.help
{head
{display
":0"}} {
889 source $ResourceDir/whelp.tcl
893 proc MakeWindow.frob
{head
{display
":0"}} {
895 source $ResourceDir/wfrob.tcl
900 ########################################################################
902 ########################################################################
905 proc UIInitializeSound
{} {
909 proc UIShutDownSound
{} {
913 proc UIDoSoundOn
{win cmd
} {
914 global Sound SoundServers
916 set win
[WindowLink
[winfo toplevel $win].head
]
917 if {[lsearch $SoundServers $win] != -1} {
918 set cmd
"send -quick -server $win Sound sound $cmd"
920 # XXX: Lost a sound server...
928 proc UIDoSound
{cmd
} {
929 global Sound SoundServers
931 foreach win
$SoundServers {
932 set foo
"send -quick -server $win Sound $cmd"
934 # XXX: Lost a sound server...
942 proc KillSoundServers
{} {
944 foreach win
$SoundServers {
945 set foo
"send -quick -server $win Sound KillSoundServer"
952 proc UISetChannelVolume
{win chan vol
} {
953 UIDoSoundOn
$win "channel $chan -volume $vol"
957 proc EchoPlaySound
{soundspec
} {
961 proc UIMakeSoundOn
{win chan sound
{opts
""}} {
962 playsound
$chan $sound $opts
966 proc UIStartSoundOn
{win chan sound
{opts
""}} {
967 # Send message to Python to play sound.
970 #UIDoSoundOn $win "play $sound -replay -channel $chan -repeat 100 $opts"
974 proc UIMakeSound
{chan sound
{opts
""}} {
975 playsound
$chan $sound $opts
979 proc UIStartSound
{chan sound
{opts
""}} {
980 # Send message to Python to play sound.
983 #UIDoSound "sound play $sound -channel $chan -repeat 100 $opts"
987 proc SetupSoundServer
{win
} {
992 proc AddSoundServer
{win
} {
994 set i
[lsearch $SoundServers $win]
996 set SoundServers
[linsert $SoundServers 0 $win]
1001 proc LostSoundServer
{win
} {
1002 DeleteSoundServer
$win
1003 # UIShowPictureOn [WindowLink $win.head] 46 [winfo screen $win]
1007 proc DeleteSoundServer
{win
} {
1009 set i
[lsearch $SoundServers $win]
1011 set SoundServers
[lreplace $SoundServers $i $i]
1016 proc UISoundOff
{} {
1020 proc MonsterSpeed
{} {
1021 return [expr "[sim Rand 40] + 70"]
1025 proc ExplosionPitch
{} {
1026 return [expr "[sim Rand 20] + 90"]
1031 return [expr "[sim Rand 20] + 90"]
1035 ########################################################################
1036 # Global Window Handlers
1039 proc WithdrawAll
{} {
1057 proc ShowInitial
{} {
1065 ########################################################################
1066 # Head Window Handlers
1069 proc PrepHead
{head
} {
1076 WithdrawHeadOf
$head
1080 after 1000 "WithdrawSplashOf $head"
1081 WithdrawHeadOf
$head
1082 ShowScenarioOf
$head
1086 WithdrawSplashOf
$head
1087 WithdrawScenarioOf
$head
1092 ReShowPictureOn
$head
1100 proc ShowHeadOf
{head
} {
1105 proc WithdrawHeadOf
{head
} {
1112 foreach win
$HeadWindows {
1118 proc WithdrawHeads
{} {
1120 foreach win
$HeadWindows {
1126 proc DeleteHeadWindow
{head
} {
1133 foreach win
$HeadWindows {
1139 proc InitHead
{win
} {
1140 set w
[WindowLink
$win.
text]
1141 $w configure
-state normal
1144 $w configure
-state disabled
1146 if {[sim MultiPlayerMode
]} {
1147 set w
[WindowLink
$win.
entry]
1158 proc InitAllHeadMenus
{} {
1161 foreach win
$HeadWindows {
1167 proc InitHeadMenus
{win
} {
1169 set m0
[WindowLink
$win.m0
]
1170 set m1
[WindowLink
$win.m1
]
1171 set m2
[WindowLink
$win.m2
]
1172 set m3
[WindowLink
$win.m3
]
1173 set m4
[WindowLink
$win.m4
]
1174 set b0
[WindowLink
$win.b0
]
1175 set b1
[WindowLink
$win.b1
]
1176 set b2
[WindowLink
$win.b2
]
1177 set b3
[WindowLink
$win.b3
]
1178 set b4
[WindowLink
$win.b4
]
1192 # When in multi player mode there is an extra menu
1193 # item to add another player, before the quit item,
1194 # so compensate for it here.
1195 if {[sim MultiPlayerMode
]} {
1200 $b0 config
-state normal
1201 $b2 config
-state disabled
1202 $b4 config
-state disabled
1207 # When in multi player mode there is an extra menu
1208 # item to add another player, before the quit item,
1209 # so compensate for it here.
1210 if {[sim MultiPlayerMode
]} {
1215 $b0 config
-state normal
1216 $b2 config
-state normal
1217 $b4 config
-state normal
1223 proc UIDisaster
{win cmd action
} {
1224 AskQuestion
[Color
$win #ff0000 #ffffff] "Cause a Disaster" \
1225 "Oh no! Do you really want to $action" \
1226 "{No way!} Disaster.No {WithdrawAsks}" \
1228 "{I guess so.} Disaster.Yes {WithdrawAsks ; $cmd}"
1232 proc CrushHead
{head
} {
1233 global SubWindows VoteNames
1235 foreach foo
$VoteNames {
1237 set votes
[eval ident
\$VotesFor$foo]
1238 set i
[lsearch $votes $head]
1240 set VotesFor
$foo [lreplace $votes $i $i]
1244 foreach foo
$SubWindows {
1245 set sym
[lindex $foo 0]
1246 set name
[lindex $foo 1]
1248 set wins
[eval ident
"\$$name"]
1250 if {[WindowLink
$win.head
] == $head} {
1251 DeleteWindow
$sym $name $win
1258 proc ChatDown
{win
} {
1280 global ChatConnection
1282 DoSendMessage
"Opening Connection to Chat Server $ChatServer socket $ChatSocket ..." status
1284 set ChatConnection
{}
1286 set ChatConnection
[connect
$ChatServer $ChatSocket]
1289 if {$ChatConnection == {}} then
{
1290 DoSendMessage
"Sorry, I could not open a connection to chat server $ChatServer socket $ChatSocket." status
1293 filehandler
$ChatConnection r
"ReceiveChat"
1304 puts $ChatConnection "USER $UserName $HostName $ServerName $RealName\r\n" nonewline
1305 puts $ChatConnection "NICK $NickName\r\n" nonewline
1306 puts $ChatConnection "JOIN $ChannelName\r\n" nonewline
1307 flush $ChatConnection
1312 proc ReceiveChat
{mode f
} {
1313 # DoSendMessage "ReceiveChat: MODE $mode F $f"
1317 if {[string first
{:} $msg]} {
1321 set from
[lindex $msg 0]
1322 set cmd
[string tolower
[lindex $msg 1]]
1326 if {($cmd == "privmsg") ||
1327 ($cmd == "notice")} then
{
1329 set chan
[lindex $msg 2]
1330 set i
[expr "[string length $from] + 1 + [string length $cmd] + 1 + [string length $chan] + 2"]
1331 set j
[expr "[string length $msg] - 2"]
1332 set line
[string range
$msg $i $j]
1333 set chan
[string range
$chan 1 [string length
$chan]]
1334 set from
[string range
$from 1 [expr "[string length $from] - 1"]]
1335 set from
[split $from {!}]
1336 set from
[lindex $from 0]
1337 DoSendMessage
"$from> $line"
1340 if {$handled == 0} {
1341 set msg
[string range
$msg \
1342 [expr "[string length $from] + 1"] \
1343 [expr "[string length $msg] - 2"]]
1349 proc SendChatMessage
{msg win
} {
1350 global ChatConnection ChannelName NickName
1356 if {[string range
$msg 0 0] == "/"} {
1357 set cmd
[string range
$msg 1 [string length
$msg]]
1358 DoSendMessage
"$NickName> \[$cmd\]"
1361 set cmd
"PRIVMSG $ChannelName :$msg\r\n"
1362 DoSendMessage
"$NickName> $msg"
1369 puts $ChatConnection $cmd nonewline
1370 flush $ChatConnection
1375 DoSendMessage
"IRC Broke the connection"
1385 global ChatConnection
1387 DoSendMessage
"Closing Connection to Chat Server." status
1390 puts $ChatConnection "QUIT\r\n" nonewline
1391 flush $ChatConnection
1392 $ChatConnection close
1395 set ChatConnection
{}
1400 proc DoEnterMessage
{win var
} {
1403 set msg
[eval ident
"\$\{$var\}"]
1405 if {$Chatting} then
{
1406 SendChatMessage
$msg $win
1414 proc DoEvalMessage
{win var
} {
1416 set command
[eval ident
"\$\{$var\}"]
1418 DoSendMessage
"Evaluating TCL: $command"
1419 catch {uplevel #0 $command} result
1420 DoSendMessage
"Result: $result"
1424 proc DoSendMessage
{msg
{tag
message}} {
1426 foreach win
$HeadWindows {
1427 appendWithTag
[WindowLink
$win.
text] $tag "$msg"
1432 proc UISetMessage
{msg
{tag status
}} {
1433 global DoMessages EditorWindows HeadWindows
1435 if {$DoMessages == 0} {
1439 foreach win
$EditorWindows {
1440 [WindowLink
$win.
message] configure
-text "$msg"
1443 foreach win
$HeadWindows {
1444 appendWithTag
[WindowLink
$win.
text] $tag "$msg"
1451 proc appendWithTag
{w tag
text} {
1455 set start
[$w index end
]
1456 $w configure
-state normal
1457 if {$start > $MaxLines} then
{
1458 $w delete
0.0 $ShrinkLines.0
1459 set start
[$w index end
]
1461 $w insert end
"${text}\n"
1462 $w tag add
$tag $start {end
- 1 char
}
1463 $w configure
-state disabled
1464 $w yview
-pickplace {end
- 1 char
}
1468 ########################################################################
1469 # Budget Window Handlers
1472 proc ShowBudgetOf
{head
} {
1473 set win
[WindowLink
$head.budget
]
1475 set win
[MakeWindow.budget
$head [winfo screen
$head]]
1484 proc ShowBudgets
{} {
1485 global HeadWindows BudgetsVisible
1486 set BudgetsVisible
1
1487 foreach win
$HeadWindows {
1493 proc WithdrawBudgets
{} {
1494 global BudgetWindows BudgetsVisible
1495 foreach win
$BudgetWindows {
1499 set BudgetsVisible
0
1503 proc BudgetContinue
{{win
""}} {
1504 global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1506 if {([sim RoadFund
] != $BudgetRoadFund) ||
1507 ([sim FireFund
] != $BudgetFireFund) ||
1508 ([sim PoliceFund
] != $BudgetPoliceFund) ||
1509 ([sim TaxRate
] != $BudgetTaxRate)} {
1510 UISetMessage
"The budget was changed."
1512 UISetMessage
"The budget wasn't changed."
1520 proc BudgetReset
{{win
""}} {
1521 global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1522 if {([sim RoadFund
] != $BudgetRoadFund) ||
1523 ([sim FireFund
] != $BudgetFireFund) ||
1524 ([sim PoliceFund
] != $BudgetPoliceFund) ||
1525 ([sim TaxRate
] != $BudgetTaxRate)} {
1526 UISetMessage
"The budget was reset."
1527 if {[sim Players
] > 1} {
1528 UIMakeSound edit Sorry
1531 UISetMessage
"The budget was reset."
1533 sim RoadFund
$BudgetRoadFund
1534 sim FireFund
$BudgetFireFund
1535 sim PoliceFund
$BudgetPoliceFund
1536 sim TaxRate
$BudgetTaxRate
1542 proc BudgetCancel
{{win
""}} {
1550 proc SetTaxRate
{rate
} {
1555 proc BudgetSetTaxRate
{rate
} {
1561 proc BudgetSetRoadFund
{percent
} {
1562 sim RoadFund
$percent
1567 proc BudgetSetFireFund
{percent
} {
1568 sim FireFund
$percent
1573 proc BudgetSetPoliceFund
{percent
} {
1574 sim PoliceFund
$percent
1579 proc UIShowBudgetAndWait
{} {
1580 global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1581 if {$OldBudget == 0} {
1582 set BudgetRoadFund
[sim RoadFund
]
1583 set BudgetFireFund
[sim FireFund
]
1584 set BudgetPoliceFund
[sim PoliceFund
]
1585 set BudgetTaxRate
[sim TaxRate
]
1589 UISetMessage
"Pausing to set the budget ..."
1595 sim UpdateBudgetWindow
1599 proc ToggleBudgetTimer
{} {
1600 global BudgetTimerActive
1601 if {$BudgetTimerActive} {
1609 proc StopBudgetTimer
{} {
1610 global BudgetTimerActive
1611 set BudgetTimerActive
0
1616 proc StartBudgetTimer
{} {
1617 global BudgetTimerActive BudgetTimer BudgetTimeout
1619 set BudgetTimerActive
$me
1620 set BudgetTimer
$BudgetTimeout
1622 after 1000 TickBudgetTimer
$me
1626 proc RestartBudgetTimer
{} {
1627 global BudgetTimerActive
1628 if {$BudgetTimerActive} {
1635 proc UpdateBudgetTimer
{} {
1636 global BudgetWindows BudgetTimerActive BudgetTimer
1637 if {$BudgetTimerActive} {
1638 set text [format "Auto Cancel In %d Seconds (click to disable)" $BudgetTimer]
1640 set text [format "Enable Auto Cancel (currently disabled)"]
1642 foreach win
$BudgetWindows {
1643 set t
[WindowLink
$win.timer
]
1644 $t config
-text "$text"
1649 proc TickBudgetTimer
{me
} {
1650 global BudgetTimerActive BudgetTimer BudgetTimeout
1651 if {$BudgetTimerActive == $me} {
1653 if {$BudgetTimer < 0} {
1659 after 1000 TickBudgetTimer
$me
1665 proc FireBudgetTimer
{} {
1675 proc ToggleAutoBudget
{} {
1678 #echo "ToggleAutoBudget found on, clearing"
1681 #echo "ToggleAutoBudget found off, setting"
1687 proc UIUpdateBudget
{} {
1692 proc UpdateAutoBudget
{} {
1693 global BudgetWindows AutoBudget
1694 if {[sim AutoBudget
]} {
1695 set text "Disable Auto Budget (currently enabled)"
1697 set text "Enable Auto Budget (currently disabled)"
1699 #echo "UpdateAutoBudget $AutoBudget $text"
1700 foreach win
$BudgetWindows {
1701 set t
[WindowLink
$win.autobudget
]
1702 $t config
-text "$text"
1707 proc UISetBudget
{cashflow previous current collected taxrate
} {
1708 global BudgetWindows BudgetsVisible
1710 #echo "UISetBudgetValues $taxrate $BudgetsVisible"
1712 if {$BudgetsVisible} {
1714 foreach win
$BudgetWindows {
1715 set w
[WindowLink
$win.cashflow
]
1716 set old
[lindex [$w configure
-text] 4]
1717 if {$old != $cashflow} {
1718 $w configure
-text $cashflow
1720 set w
[WindowLink
$win.previous
]
1721 set old
[lindex [$w configure
-text] 4]
1722 if {$old != $previous} {
1723 $w configure
-text $previous
1725 set w
[WindowLink
$win.current
]
1726 set old
[lindex [$w configure
-text] 4]
1727 if {$old != $current} {
1728 $w configure
-text $current
1730 set w
[WindowLink
$win.collected
]
1731 set old
[lindex [$w configure
-text] 4]
1732 if {$old != $collected} {
1733 $w configure
-text $collected
1736 set w
[WindowLink
$win.taxrate
]
1738 if {$old != $taxrate} {
1742 set w
[WindowLink
$win.taxlabel
]
1743 set old
[lindex [$w configure
-text] 4]
1746 $w configure
-text $new
1752 foreach win
$HeadWindows {
1754 set w
[WindowLink
$win.taxrate
]
1756 if {$old != $taxrate} {
1757 # FIXME: this might not work if the slider is disabled in multi player mode.
1761 set w
[WindowLink
$win.taxlabel
]
1762 set old
[lindex [$w configure
-text] 4]
1763 set new
"Tax Rate: $taxrate%"
1765 $w configure
-text $new
1771 proc UISetBudgetValues
{roadgot roadwant roadpercent policegot policewant policepercent firegot firewant firepercent
} {
1772 global BudgetWindows BudgetsVisible
1774 if {$BudgetsVisible == 0} {
1778 foreach win
$BudgetWindows {
1779 set w
[WindowLink
$win.fire
].request
1780 set old
[lindex [$w configure
-text] 4]
1781 set new
"$firepercent% of $firewant = $firegot"
1783 $w configure
-text $new
1785 set w
[WindowLink
$win.fire
].fund
1787 if {$old != $firepercent} {
1791 set w
[WindowLink
$win.police
].request
1792 set old
[lindex [$w configure
-text] 4]
1793 set new
"$policepercent% of $policewant = $policegot"
1795 $w configure
-text $new
1797 set w
[WindowLink
$win.police
].fund
1799 if {$old != $policepercent} {
1800 $w set $policepercent
1803 set w
[WindowLink
$win.road
].request
1804 set old
[lindex [$w configure
-text] 4]
1805 set new
"$roadpercent% of $roadwant = $roadgot"
1807 $w configure
-text $new
1809 set w
[WindowLink
$win.road
].fund
1811 if {$old != $roadpercent} {
1818 proc ChangeBudget
{} {
1819 global VotesForBudget
1820 if {"$VotesForBudget" != ""} {
1827 proc InitVotesForBudget
{} {
1828 global VotesForBudget BudgetWindows
1829 set VotesForBudget
{}
1830 foreach win
$BudgetWindows {
1831 [WindowLink
$win.vote
] config
-relief raised
1833 UpdateVotesForBudget
1837 proc UpdateVotesForBudget
{} {
1838 global BudgetWindows
1839 UpdateVotesFor Budget
$BudgetWindows
1843 proc UpdateTaxRateSliders
{} {
1845 set players
[sim Players
]
1846 foreach win
$HeadWindows {
1847 set slider
[WindowLink
$win.taxrate
]
1848 #echo "UpdateTaxRateSliders players $players win $win slider $slider"
1849 if {$players == 1} {
1850 $slider configure
-state normal
1852 $slider configure
-state disabled
1858 ########################################################################
1859 # Evaluation Window Handlers
1862 proc ToggleEvaluationOf
{head
} {
1864 if {"$State" != "play"} {
1869 set win
[WindowLink
$head.evaluation
]
1871 set mapped
[winfo ismapped
$win]
1875 WithdrawEvaluationOf
$head
1877 ShowEvaluationOf
$head
1883 proc WithdrawEvaluationOf
{head
} {
1884 set win
[WindowLink
$head.evaluation
]
1891 proc ShowEvaluationOf
{head
} {
1892 set win
[WindowLink
$head.evaluation
]
1894 set win
[MakeWindow.evaluation
$head [winfo screen
$head]]
1898 set parent
[WindowLink
$win.parent
]
1899 #pack append [WindowLink $head.col2]\
1900 # $parent {top frame nw fill}
1901 pack append $parent\
1902 $win {top
frame nw fillx
}
1904 sim UpdateEvaluation
1908 proc WithdrawEvaluations
{} {
1909 global EvaluationWindows EvaluationsVisible
1910 foreach win
$EvaluationWindows {
1912 #set parent [WindowLink $win.parent]
1913 #pack unpack $parent
1916 set EvaluationsVisible
0
1920 proc EvaluationVisible
{w v
} {
1921 global EvaluationsVisible
1922 global [set var
$w.visible
]
1927 set EvaluationsVisible
[expr "$EvaluationsVisible + 1"]
1929 set EvaluationsVisible
[expr "$EvaluationsVisible - 1"]
1934 proc UISetEvaluation
{changed score ps0 ps1 ps2 ps3 pv0 pv1 pv2 pv3 pop delta assessed cityclass citylevel goodyes goodno title
} {
1935 global EvaluationWindows EvaluationsVisible CurrentDate
1937 set class
[string tolower
$cityclass]
1938 UISetMessage
"$CurrentDate: Score $score, $class population $pop."
1940 if {$EvaluationsVisible} {
1942 foreach win
$EvaluationWindows {
1944 global [set var
$win.visible
]
1945 set visible
[eval ident
"\$\{$var\}"]
1949 # TODO: set evaluation window and icon title
1950 #wm title $win "$title"
1951 #wm iconname $win "$title"
1953 set w
[WindowLink
$win.goodjob
]
1954 set old
[lindex [$w configure
-text] 4]
1955 set new
"$goodyes\n$goodno"
1957 $w configure
-text $new
1960 set w
[WindowLink
$win.problemnames
]
1961 set old
[lindex [$w configure
-text] 4]
1962 set new
"$ps0\n$ps1\n$ps2\n$ps3"
1964 $w configure
-text $new
1967 set w
[WindowLink
$win.problempercents
]
1968 set old
[lindex [$w configure
-text] 4]
1969 set new
"$pv0\n$pv1\n$pv2\n$pv3"
1971 $w configure
-text $new
1974 set w
[WindowLink
$win.stats
]
1975 set old
[lindex [$w configure
-text] 4]
1976 set new
"$pop\n$delta\n\n$assessed\n$cityclass\n$citylevel"
1978 $w configure
-text $new
1981 set w
[WindowLink
$win.score
]
1982 set old
[lindex [$w configure
-text] 4]
1983 set new
"$score\n$changed"
1985 $w configure
-text $new
1993 ########################################################################
1994 # File Window Handlers
1997 proc ShowFileOf
{head
} {
1998 set win
[WindowLink
$head.
file]
2000 set win
[MakeWindow.
file $head [winfo screen
$head]]
2010 foreach win
$HeadWindows {
2016 proc WithdrawFiles
{} {
2018 foreach win
$FileWindows {
2024 proc DoFileDialog
{win Message Path Pattern FileName ActionOk ActionCancel
} {
2025 ShowFileDialog
$win "$Path" "$Pattern"
2026 $win.message1 configure
-text "$Message"
2027 $win.path.path delete
0 end
2028 $win.path.path insert
0 $Path
2029 $win.
file.
file delete
0 end
2030 $win.
file.
file insert
0 "$FileName"
2031 $win.frame1.ok config
-command "
2032 $ActionOk \[$win.file.file get\] \[$win.path.path get\]
2034 $win.frame1.rescan config
-command "
2035 ShowFileDialog $win \[$win.path.path get\] $Pattern"
2036 $win.frame1.cancel config
-command "
2039 bind $win.files.files
"<Double-Button-1>" "\
2040 FileSelectDouble $win %W %y $Pattern \"
2041 $ActionOk {\[$win.file.file get\]} {\[$win.path.path get\]}\""
2042 bind $win.path.path
<Return
> "
2043 ShowFileDialog $win \[$win.path.path get\] $Pattern
2044 $win.file.file cursor 0
2045 focus $win.file.file"
2046 bind $win.
file.
file <Return
> "\
2047 $ActionOk \[$win.file.file get\] \[$win.path.path get\]
2052 proc BindSelectOne
{win Y
} {
2053 set Nearest
[$win nearest
$Y]
2054 if {$Nearest >= 0} {
2055 $win select from
$Nearest
2056 $win select to
$Nearest
2061 proc FileSelect
{win widget Y
} {
2062 BindSelectOne
$widget $Y
2063 set Nearest
[$widget nearest
$Y]
2064 if {$Nearest >= 0} {
2065 set Path
[$win.path.path get
]
2066 set TmpEntry
[$widget get
$Nearest]
2067 if {[string compare
"/" [string index
$TmpEntry \
2068 [expr [string length
$TmpEntry]-1]]] == 0 ||
\
2069 [string compare
"@" [string index
$TmpEntry \
2070 [expr [string length
$TmpEntry]-1]]] == 0} {
2071 # handle directories, and symbolic links to directories
2072 set FileName
[string range
$TmpEntry 0 \
2073 [expr [string length
$TmpEntry]-2]]
2074 # whoops / or @ is part of the name
2075 if {[MiscIsDir
$Path/$FileName] != 1} {
2076 set FileName
$TmpEntry
2079 if {[string compare
"*" [string index
$TmpEntry \
2080 [expr [string length
$TmpEntry]-1]]] == 0} {
2081 # handle executable filenames
2082 set FileName
[string range
$TmpEntry 0 \
2083 [expr [string length
$TmpEntry]-2]]
2084 # whoops * is part of the name
2085 if {[file executable
$Path/$FileName] != 1} {
2086 set FileName
$TmpEntry
2089 # a ordinary filename
2090 set FileName
$TmpEntry
2093 # enter the selected filename into the filename field
2094 if {[MiscIsDir
$Path/$FileName] != 1} {
2095 $win.
file.
file delete
0 end
2096 $win.
file.
file insert
0 $FileName
2102 proc FileSelectDouble
{win widget Y Pattern Action
} {
2103 BindSelectOne
$widget $Y
2104 set Nearest
[$widget nearest
$Y]
2105 if {$Nearest >= 0} {
2106 set Path
[$win.path.path get
]
2107 set TmpEntry
[$widget get
$Nearest]
2108 if {[string compare
$TmpEntry "../"] == 0} {
2109 # go up one directory
2111 [string trimright
[string trimright
[string trim
$Path] /] @]
2112 if {[string length
$TmpEntry] <= 0} {
2115 set Path
[file dirname
$TmpEntry]
2116 $win.path.path delete
0 end
2117 $win.path.path insert
0 $Path
2118 ShowFileDialog
$win $Path $Pattern
2120 if {[string compare
"/" [string index
$TmpEntry \
2121 [expr [string length
$TmpEntry]-1]]] == 0 ||
\
2122 [string compare
"@" [string index
$TmpEntry \
2123 [expr [string length
$TmpEntry]-1]]] == 0} {
2124 # handle directorys, and symbolic links to directorys
2125 set FileName
[string range
$TmpEntry 0 \
2126 [expr [string length
$TmpEntry]-2]]
2127 # whoops / or @ is part of the name
2128 if {[MiscIsDir
$Path/$FileName] != 1} {
2129 set FileName
$TmpEntry
2132 if {[string compare
"*" [string index
$TmpEntry \
2133 [expr [string length
$TmpEntry]-1]]] == 0} {
2134 # handle executable filenames
2135 set FileName
[string range
$TmpEntry 0 \
2136 [expr [string length
$TmpEntry]-2]]
2137 # whoops * is part of the name
2138 if {[file executable
$Path/$FileName] != 1} {
2139 set FileName
$TmpEntry
2142 # a ordinary filename
2143 set FileName
$TmpEntry
2147 if {[MiscIsDir
$Path/$FileName] == 1} {
2148 if {[string compare
"/" [string index
$Path \
2149 [expr [string length
$Path]-1]]] == 0} {
2150 append Path
$FileName
2152 append Path
/ $FileName
2154 $win.path.path delete
0 end
2155 $win.path.path insert
0 $Path
2156 ShowFileDialog
$win $Path $Pattern
2158 # enter the selected filename into the filename field
2159 $win.
file.
file delete
0 end
2160 $win.
file.
file insert
0 "$FileName"
2161 if {[string length
$Action] > 0} {
2171 proc NameComplete
{win Type
} {
2176 if {[string compare
$Type path
] == 0} {
2177 set DirName
[file dirname
[$win.path.path get
]]
2178 set FileName
[file tail
[$win.path.path get
]]
2180 set DirName
[file dirname
[$win.path.path get
]/]
2181 set FileName
[file tail
[$win.
file.
file get
]]
2185 if {[MiscIsDir
$DirName] == 1} {
2186 catch "exec ls $DirName/" Result
2188 set ListLength
[llength $Result]
2190 while {$Counter < $ListLength} {
2191 if {[string length
$FileName] == 0} {
2192 if {$FoundCounter == 0} {
2193 set NewFile
[lindex $Result $Counter]
2196 set TmpFile1
$NewFile
2197 set TmpFile2
[lindex $Result $Counter]
2198 set Length1
[string length
$TmpFile1]
2199 set Length2
[string length
$TmpFile2]
2201 if {$Length1 > $Length2} {
2202 set Length1
$Length2
2204 while {$Counter1 < $Length1} {
2205 if {[string compare
[string index
$TmpFile1 $Counter1] \
2206 [string index
$TmpFile2 $Counter1]] == 0} {
2207 append NewFile
[string index
$TmpFile1 $Counter1]
2216 if {[regexp "^$FileName" [lindex $Result $Counter] \
2218 if {$FoundCounter == 0} {
2219 set NewFile
[lindex $Result $Counter]
2222 set TmpFile1
$NewFile
2223 set TmpFile2
[lindex $Result $Counter]
2224 set Length1
[string length
$TmpFile1]
2225 set Length2
[string length
$TmpFile2]
2227 if {$Length1 > $Length2} {
2228 set Length1
$Length2
2230 while {$Counter1 < $Length1} {
2231 if {[string compare
[string index
$TmpFile1 $Counter1] \
2232 [string index
$TmpFile2 $Counter1]] == 0} {
2233 append NewFile
[string index
$TmpFile1 $Counter1]
2247 if {$FoundCounter == 1} {
2248 if {[MiscIsDir
$DirName/$NewFile] == 1} {
2249 if {[string compare
$DirName "/"] == 0} {
2250 $win.path.path delete
0 end
2251 $win.path.path insert
0 "/[string trim [string trim $NewFile /] @]/"
2253 $win.path.path delete
0 end
2254 $win.path.path insert
0 "[string trimright $DirName /]/[string trim [string trim $NewFile /] @]/"
2257 $win.path.path delete
0 end
2258 $win.path.path insert
0 \
2259 "[string trim [string trimright $DirName /] @]/"
2260 $win.
file.
file delete
0 end
2261 $win.
file.
file insert
0 "$NewFile"
2264 if {[MiscIsDir
$DirName/$NewFile] == 1 ||
2265 [string compare
$Type path
] == 0} {
2266 $win.path.path delete
0 end
2267 $win.path.path insert
0 \
2268 "[string trimright $DirName /]/[string trim [string trim $NewFile /] @]"
2270 $win.path.path delete
0 end
2271 $win.path.path insert
0 "$DirName"
2272 if {[string length
$NewFile] > 0} {
2273 $win.
file.
file delete
0 end
2274 $win.
file.
file insert
0 "$NewFile"
2281 proc ShowFileDialog
{win Path Pattern
} {
2283 #set Path [lindex [split $Path] 0]
2284 if {[$win.files.files size
] > 0} {
2285 $win.files.files delete
0 end
2288 if {[catch "exec ls -F \"$Path\"" Result
]} {
2291 if {[string match
$Result "* not found"]} {
2294 set ElementList
[lsort [split $Result "\n"]]
2297 if {[string compare
$Path "/"]} {
2298 $win.files.files insert end
"../"
2302 foreach Counter
$ElementList {
2304 if {[string match
$Pattern $Counter] == 1} {
2305 if {[string compare
$Counter "../"] &&
2306 [string compare
$Counter "./"]} {
2307 $win.files.files insert end
$Counter
2310 set fn
$Path/[string trim
[string trim
[string trim
$Counter /] @] *]
2311 if {[MiscIsDir
$fn]} {
2312 $win.files.files insert end
$Counter
2320 proc MiscIsDir
{PathName
} {
2322 if {[file isdirectory
$PathName] == 1} {
2325 catch "file type $PathName" Type
2326 if {[string compare
$Type link
] == 0} {
2327 set LinkName
[file readlink
$PathName]
2328 catch "file type $LinkName" Type
2329 while {[string compare
$Type link
] == 0} {
2330 set LinkName
[file readlink
$LinkName]
2332 return [file isdirectory
$LinkName]
2339 proc busy
{win cmds
} {
2341 set list [winfo children
$win]
2343 while {$list != ""} {
2346 set class
[winfo class
$w]
2347 set cursor
[lindex [$w config
-cursor] 4]
2348 if {[winfo toplevel $w] == $w} {
2349 lappend busy
[list $w $cursor]
2351 set next
[concat $next [winfo children
$w]]
2357 catch {[lindex $w 0] config
-cursor watch
}
2362 set error [catch {uplevel eval [list $cmds]} result
]
2365 catch {[lindex $w 0] config
-cursor [lindex $w 1]}
2376 ########################################################################
2377 # Editor Window Handlers
2379 proc ShowEditorOf
{head
} {
2380 global EditorWindows
2382 foreach win
$EditorWindows {
2383 if {[WindowLink
$win.head
] == $head} {
2384 set parent
[WindowLink
$win.parent
]
2385 #pack append [WindowLink $head.col2]\
2386 # $parent {top frame nw expand fill}
2387 pack append $parent\
2388 $win {top
frame nw expand fill
}
2402 proc NewEditorOf
{head
} {
2403 set win
[MakeWindow.editor
$head [winfo screen
$head]]
2405 set parent
[WindowLink
$win.parent
]
2406 pack append $parent\
2407 $win {top
frame nw expand fill
}
2414 proc ShowEditors
{} {
2416 foreach win
$HeadWindows {
2422 proc WithdrawEditors
{} {
2423 global EditorWindows
2424 foreach win
$EditorWindows {
2425 #set parent [WindowLink $win.parent]
2426 #pack unpack $parent
2432 proc InitEditors
{} {
2433 global EditorWindows
2434 foreach win
$EditorWindows {
2440 proc InitEditor
{win
} {
2441 set e
[WindowLink
$win.view
]
2442 UISetToolState
$win 7
2447 global $e.TrackState
2448 set $e.TrackState
{}
2452 proc SetEditorAutoGoto
{win val
} {
2453 global AutoGoto.
$win
2454 set AutoGoto.
$win $val
2455 set e
[WindowLink
$win.view
]
2460 proc SetEditorControls
{win val
} {
2461 global Controls.
$win
2462 set Controls.
$win $val
2464 pack append $win $win.leftframe
{left
frame center filly
}
2466 pack unpack
$win.leftframe
2471 proc SetEditorOverlay
{win val
} {
2473 set Overlay.
$win $val
2474 set e
[WindowLink
$win.view
]
2479 proc SetEditorDynamicFilter
{win val
} {
2480 global DynamicFilter.
$win
2481 set DynamicFilter.
$win $val
2482 set e
[WindowLink
$win.view
]
2483 $e DynamicFilter
$val
2484 if {$val == 1} then
{
2485 ShowFrobOf
[WindowLink
$win.head
]
2490 proc SetEditorSkip
{win val
} {
2491 set e
[WindowLink
$win.view
]
2496 proc EditorToolDown
{mod w x y
} {
2497 global [set var
$w.TrackState
]
2501 case
[$w ToolState
] in
\
2503 UIMakeSoundOn
$w edit Rumble
"-repeat 4"
2511 set $var [list constrain_start
$x $y]
2512 $w ToolConstrain
$x $y
2517 EditorTool ToolDown
$w $x $y
2522 proc EditorToolDrag
{w x y
} {
2523 EditorTool ToolDrag
$w $x $y
2528 proc EditorToolUp
{w x y
} {
2529 global [set var
$w.TrackState
]
2532 case
[$w ToolState
] in
\
2540 EditorTool ToolUp
$w $x $y
2542 $w ToolConstrain
-1 -1
2549 proc EditorTool
{action w x y
} {
2550 global [set var
$w.TrackState
]
2551 set state
[eval ident
"\$\{$var\}"]
2552 case
[lindex $state 0] in
\
2554 set x0
[lindex $state 1]
2555 set y0
[lindex $state 2]
2556 set dx
[expr "$x - $x0"]
2557 set dy
[expr "$y - $y0"]
2558 if [expr "($dx > 16) || ($dx < -16)"] then
{
2559 $w ToolConstrain
-1 $y0
2562 if [expr "($dy > 16) || ($dy < -16)"] then
{
2563 $w ToolConstrain
$x0 -1
2572 proc StartChalk
{w
} {
2573 sim CollapseMotion
0
2577 proc StopChalk
{w
} {
2578 sim CollapseMotion
1
2582 proc EditorPanDown
{mod w x y
} {
2583 global [set var
$w.TrackState
]
2587 set $var [list constrain_start
$x $y]
2588 $w ToolConstrain
$x $y
2593 EditorTool PanStart
$w $x $y
2597 proc EditorPanDrag
{w x y
} {
2598 EditorTool PanTo
$w $x $y
2602 proc EditorPanUp
{w x y
} {
2605 EditorTool PanTo
$w $x $y
2606 $w ToolConstrain
-1 -1
2612 proc EditorKeyDown
{w k
} {
2617 proc EditorKeyUp
{w k
} {
2622 proc BindEditorButtons
{win
} {
2623 set w
[WindowLink
$win.top
]
2625 bind $win <1> "CancelPie $win ; EditorToolDown none %W %x %y"
2626 bind $win <B1-Motion
> {EditorToolDrag
%W
%x
%y
}
2627 bind $win <ButtonRelease-1
> {EditorToolUp
%W
%x
%y
}
2629 bind $win <Control-1
> "CancelPie $win ; EditorToolDown constrain %W %x %y"
2630 bind $win <Control-B1-Motion
> {EditorToolDrag
%W
%x
%y
}
2631 bind $win <Control-ButtonRelease-1
> {EditorToolUp
%W
%x
%y
}
2633 bind $win <2> "CancelPie $win ; EditorPanDown none %W %x %y"
2634 bind $win <B2-Motion
> {EditorPanDrag
%W
%x
%y
}
2635 bind $win <ButtonRelease-2
> {EditorPanUp
%W
%x
%y
}
2637 bind $win <Control-2
> "CancelPie $win ; EditorPanDown constrain %W %x %y"
2638 bind $win <Control-B2-Motion
> {EditorPanDrag
%W
%x
%y
}
2639 bind $win <Control-ButtonRelease-2
> {EditorPanUp
%W
%x
%y
}
2641 InitPie
$win $w.toolpie
2645 proc UISetFunds
{funds
} {
2647 foreach win
$HeadWindows {
2648 [WindowLink
$win.funds
] configure
-text "$funds"
2653 proc UISetDate
{date month year
} {
2657 set CurrentDate
"$date"
2659 foreach win
$HeadWindows {
2660 [WindowLink
$win.date
] Set
$month $year
2665 proc SetPriority
{index
} {
2691 proc UISetDemand
{r c i
} {
2692 global HeadWindows DemandRes DemandCom DemandInd
2698 if {$r <= 0} then
{set ry0
32} else {set ry0
24}
2699 set ry1
[expr "$ry0 - $r"]
2700 if {$c <= 0} then
{set cy0
32} else {set cy0
24}
2701 set cy1
[expr "$cy0 - $c"]
2702 if {$i <= 0} then
{set iy0
32} else {set iy0
24}
2703 set iy1
[expr "$iy0 - $i"]
2705 foreach win
$HeadWindows {
2706 set can
[WindowLink
$win.demand
]
2707 # $can coords r 8 $ry0 14 $ry1
2708 # $can coords c 17 $cy0 23 $cy1
2709 # $can coords i 26 $iy0 32 $iy1
2710 $can coords r
49 $ry0 55 $ry1
2711 $can coords c
58 $cy0 64 $cy1
2712 $can coords i
67 $iy0 73 $iy1
2717 proc UISetOptions
{autobudget autogoto autobulldoze disasters sound animation messages notices
} {
2718 global AutoBudget AutoGoto AutoBulldoze Disasters Sound
2719 set AutoBudget
$autobudget
2720 set AutoGoto
$autogoto
2721 set AutoBulldoze
$autobulldoze
2722 set Disasters
$disasters
2724 set DoAnimation
$animation
2725 set DoMessages
$messages
2726 set DoNotices
$notices
2730 proc UIDidToolRes
{win x y
} {
2731 UIMakeSoundOn
$win edit O
"-speed 140"
2735 proc UIDidToolCom
{win x y
} {
2736 UIMakeSoundOn
$win edit A
"-speed 140"
2740 proc UIDidToolInd
{win x y
} {
2741 UIMakeSoundOn
$win edit E
"-speed 140"
2745 proc UIDidToolFire
{win x y
} {
2746 UIMakeSoundOn
$win edit O
"-speed 130"
2750 proc UIDidToolQry
{win x y
} {
2751 UIMakeSoundOn
$win edit E
"-speed 200"
2755 proc UIDidToolPol
{win x y
} {
2756 UIMakeSoundOn
$win edit E
"-speed 130"
2760 proc UIDidToolWire
{win x y
} {
2761 UIMakeSoundOn
$win edit O
"-speed 120"
2765 proc UIDidToolDozr
{win x y
} {
2766 UIMakeSoundOn
$win edit Rumble
2770 proc UIDidToolRail
{win x y
} {
2771 UIMakeSoundOn
$win edit O
"-speed 100"
2775 proc UIDidToolRoad
{win x y
} {
2776 UIMakeSoundOn
$win edit E
"-speed 100"
2780 proc UIDidToolChlk
{win x y
} {
2784 proc UIDidToolEraser
{win x y
} {
2788 proc UIDidToolStad
{win x y
} {
2789 UIMakeSoundOn
$win edit O
"-speed 90"
2793 proc UIDidToolPark
{win x y
} {
2794 UIMakeSoundOn
$win edit A
"-speed 130"
2798 proc UIDidToolSeap
{win x y
} {
2799 UIMakeSoundOn
$win edit E
"-speed 90"
2803 proc UIDidToolCoal
{win x y
} {
2804 UIMakeSoundOn
$win edit O
"-speed 75"
2808 proc UIDidToolNuc
{win x y
} {
2809 UIMakeSoundOn
$win edit E
"-speed 75"
2813 proc UIDidToolAirp
{win x y
} {
2814 UIMakeSoundOn
$win edit A
"-speed 50"
2818 proc UISetToolState
{w state
} {
2819 global EditorPallets EditorPalletImages ToolInfo
2820 set win
[WindowLink
$w.top
]
2821 #echo "UISETTOOLSTATE w $w win $win $state"
2822 ExclusivePallet
$state $win $EditorPallets ic
$EditorPalletImages \
2823 raised sunken
{NoFunction
}
2825 set c1
[WindowLink
$w.cost1
]
2827 set info [lindex $ToolInfo $state]
2828 set cost1
[lindex $info 1]
2829 set cost2
[lindex $info 2]
2830 $c1 configure
-text "$cost1"
2831 [WindowLink
$w.cost2
] configure
-text "$cost2"
2836 proc UIShowZoneStatus
{zone density value crime pollution growth x y
} {
2837 global QueryX QueryY
2838 set QueryX
[expr "8 + 16 * $x"]
2839 set QueryY
[expr "8 + 16 * $y"]
2840 UIShowPicture
9 [list $zone $density $value $crime $pollution $growth]
2844 ########################################################################
2845 # Map Window Handlers
2848 proc ShowMapOf
{head
} {
2851 foreach win
$MapWindows {
2852 if {"[WindowLink $win.head]" == "$head"} {
2853 global MapPanelWidth MapPanelHeight
2854 #place configure $win -x 0 -y 0 -width $MapPanelWidth -height $MapPanelHeight
2855 #[WindowLink $win.parent] configure -width $MapPanelWidth -height $MapPanelHeight
2856 set parent
[WindowLink
$win.parent
]
2857 pack append [WindowLink
$head.w2
] \
2858 $win {top
frame nw expand fill
}
2871 proc NewMapOf
{head
} {
2872 set win
[MakeWindow.map
$head [winfo screen
$head]]
2873 global MapPanelWidth MapPanelHeight
2874 #place configure $win -x 0 -y 0 -width $MapPanelWidth -height $MapPanelHeight
2875 #[WindowLink $win.parent] configure -width $MapPanelWidth -height $MapPanelHeight
2876 set parent
[WindowLink
$win.parent
]
2877 #pack append [WindowLink $head.col1]\
2878 # $parent {top frame nw fillx}
2879 pack append [WindowLink
$head.w2
] \
2880 $win {top
frame nw expand fill
}
2887 foreach win
$HeadWindows {
2893 proc WithdrawMaps
{} {
2895 foreach win
$MapWindows {
2904 foreach win
$MapWindows {
2910 proc InitMap
{win
} {
2915 proc EnableMaps
{} {
2917 foreach win
$MapWindows {
2923 proc EnableMap
{win
} {
2924 [WindowLink
$win.view
] ShowEditors
1
2925 [WindowLink
$win.zones
] config
-state normal
2926 [WindowLink
$win.overlays
] config
-state normal
2930 proc DisableMaps
{} {
2932 foreach win
$MapWindows {
2938 proc DisableMap
{win
} {
2939 [WindowLink
$win.view
] ShowEditors
0
2940 [WindowLink
$win.zones
] config
-state disabled
2941 [WindowLink
$win.overlays
] config
-state disabled
2945 proc SetMapState
{win state
} {
2946 set m
[WindowLink
$win.view
]
2948 if {$state == 14} then
{
2949 ShowFrobOf
[WindowLink
$win.head
]
2954 proc MapPanDown
{w x y
} {
2959 proc MapPanDrag
{w x y
} {
2964 proc MapPanUp
{w x y
} {
2971 proc UISetMapState
{w state
} {
2973 #set win [winfo toplevel $w]
2974 set win
[WindowLink
$w.win
]
2975 set m
[WindowLink
$win.view
]
2976 set title
[lindex $MapTitles $state]
2978 # TODO: set map text field header to title
2979 #wm title $win "$title"
2980 #wm iconname $win "$title"
2982 global [set var MapState.
$win]
2986 {6 8 9 10 11 12 13} {
2987 [WindowLink
$win.legend
] config
-bitmap "@images/legendmm.xpm"
2990 [WindowLink
$win.legend
] config
-bitmap "@images/legendpm.xpm"
2993 [WindowLink
$win.legend
] config
-bitmap "@images/legendn.xpm"
2999 ########################################################################
3000 # Graph Window Handlers
3003 proc ToggleGraphOf
{head
} {
3005 if {"$State" != "play"} {
3010 set win
[WindowLink
$head.graph
]
3012 set mapped
[winfo ismapped
$win]
3016 WithdrawGraphOf
$head
3024 proc WithdrawGraphOf
{head
} {
3025 set win
[WindowLink
$head.graph
]
3032 proc ShowGraphOf
{head
} {
3033 set win
[WindowLink
$head.graph
]
3035 set win
[MakeWindow.graph
$head [winfo screen
$head]]
3039 set parent
[WindowLink
$win.parent
]
3040 pack append $parent\
3041 $win {top
frame nw fillx
}
3047 proc WithdrawGraphs
{} {
3049 foreach win
$GraphWindows {
3056 proc InitGraphs
{} {
3058 foreach win
$GraphWindows {
3064 proc InitGraph
{win
} {
3065 UISetGraphState
$win 1 1 1 1 1 1 0
3069 proc UISetGraphState
{win t0 t1 t2 t3 t4 t5 range
} {
3070 set g
[WindowLink
$win.graphview
]
3071 GraphPalletMask
$win [expr "$t0 + ($t1<<1) + ($t2<<2) + ($t3<<3) + ($t4<<4) + ($t5<<5)"]
3072 GraphYearPallet
$win $range
3076 ########################################################################
3077 # Splash Window Handlers
3080 proc ShowSplashOf
{head
} {
3081 set win
[WindowLink
$head.splash
]
3083 set win
[MakeWindow.splash
$head [winfo screen
$head]]
3085 set splashscreen
[WindowLink
$win.splashscreen
]
3087 catch {$splashscreen config
-bitmap "@images/splashscreen.xpm"; set success 1}
3090 global SplashScreenDelay
3091 after $SplashScreenDelay "UIPickScenarioMode"
3098 proc WithdrawSplashOf
{head
} {
3099 set win
[WindowLink
$head.splash
]
3106 proc ShowSplashes
{} {
3108 foreach win
$HeadWindows {
3114 proc WithdrawSplashes
{} {
3115 global SplashWindows
3116 foreach win
$SplashWindows {
3118 set splashscreen
[WindowLink
$win.splashscreen
]
3119 $splashscreen config
-bitmap ""
3124 proc InitSplashes
{} {
3128 proc InitSplash
{win
} {
3132 proc DeleteSplashWindow
{win
} {
3137 ########################################################################
3138 # Scenario Window Handlers
3141 proc ShowScenarioOf
{head
} {
3142 set win
[WindowLink
$head.scenario
]
3144 set win
[MakeWindow.scenario
$head [winfo screen
$head]]
3146 # TODO: load background bitmap
3151 proc WithdrawScenarioOf
{head
} {
3152 set win
[WindowLink
$head.scenario
]
3159 proc ShowScenarios
{} {
3161 foreach win
$HeadWindows {
3167 proc WithdrawScenarios
{} {
3168 global ScenarioWindows
3169 foreach win
$ScenarioWindows {
3171 # TODO: flush background bitmap
3176 proc InitScenarios
{} {
3177 global MapHistory MapHistoryNum
3178 if {$MapHistoryNum < 1} {
3183 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3188 global ScenarioWindows
3189 foreach win
$ScenarioWindows {
3191 #[WindowLink $win.previous] config -state $prev
3192 #[WindowLink $win.next] config -state $next
3197 proc InitScenario
{win
} {
3198 global MapHistory MapHistoryNum
3199 if {$MapHistoryNum < 1} {
3205 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3212 #[WindowLink $win.previous] config -state $prev
3213 #[WindowLink $win.next] config -state $next
3215 LinkWindow
$win.scenarioTarget
-1
3216 LinkWindow
$win.scenarioTargetDown
-1
3218 global ScenarioButtons
3220 set len
[llength $ScenarioButtons]
3222 set data
[lindex $ScenarioButtons $i]
3223 set type
[lindex $data 0]
3224 set id
[lindex $data 1]
3228 LinkWindow
$win.
$id.over
0
3229 LinkWindow
$win.
$id.enabled
1
3230 LinkWindow
$win.
$id.checked
0
3231 #echo "SETTING WIN $win ID $id"
3233 set i
[expr "$i + 1"]
3236 UpdateLevelSelection
$win
3237 UpdateLeftRightEnabled
$win
3241 proc UpdateLevelSelection
{win
} {
3242 #echo UpdateLevelSelection
3244 if {$GameLevel == 0} then
{
3245 LinkWindow
$win.easy.checked
1
3246 LinkWindow
$win.medium.checked
0
3247 LinkWindow
$win.hard.checked
0
3249 if {$GameLevel == 1} then
{
3250 LinkWindow
$win.easy.checked
0
3251 LinkWindow
$win.medium.checked
1
3252 LinkWindow
$win.hard.checked
0
3254 if {$GameLevel == 2} then
{
3255 LinkWindow
$win.easy.checked
0
3256 LinkWindow
$win.medium.checked
0
3257 LinkWindow
$win.hard.checked
1
3260 UpdateScenarioButtonID
$win easy
3261 UpdateScenarioButtonID
$win medium
3262 UpdateScenarioButtonID
$win hard
3267 proc UpdateLeftRightEnabled
{win
} {
3268 #echo UpdateLeftRightEnabled
3270 global MapHistory MapHistoryNum
3271 if {$MapHistoryNum < 1} {
3272 LinkWindow
$win.left.enabled
0
3274 LinkWindow
$win.left.enabled
1
3277 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3278 LinkWindow
$win.right.enabled
0
3280 LinkWindow
$win.right.enabled
1
3283 UpdateScenarioButtonID
$win left
3284 UpdateScenarioButtonID
$win right
3288 proc UpdateScenarioButtonID
{win id
} {
3290 global ScenarioButtons
3292 set len
[llength $ScenarioButtons]
3294 set data
[lindex $ScenarioButtons $i]
3296 if {$id == [lindex $data 1]} then
{
3297 UpdateScenarioButton
$win $data
3301 set i
[expr "$i + 1"]
3306 proc UpdateScenarioButton
{win data
} {
3309 set type
[lindex $data 0]
3310 set id
[lindex $data 1]
3311 set over
[WindowLink
$win.
$id.over
]
3312 set enabled
[WindowLink
$win.
$id.enabled
]
3313 set checked
[WindowLink
$win.
$id.checked
]
3314 #echo "WIN $win TYPE $type ID $id OVER $over ENABLED $enabled CHECKED $checked"
3316 if {[lindex ${data
} 2] == "DoPickScenario"} {
3317 catch {text $win.desc
\
3322 -font [Font
$win Large
]}
3324 $win.desc configure
-state normal
3325 $win.desc delete
0.0 end
3326 $win.desc insert end
"[lindex $Messages([lindex ${data} 3]) 1]\n\n[lindex $Messages([lindex ${data} 3]) 2]"
3327 $win.desc configure
-state disabled
3329 place $win.desc
-x 232 -y 170 -width 280 -height 285
3332 catch {destroy $win.desc
}
3337 set bm
[lindex $data 13]
3339 set bm
[lindex $data 12]
3343 set bm
[lindex $data 10]
3345 set bm
[lindex $data 9]
3349 set bm
[lindex $data 11]
3352 [WindowLink
$win.
canvas] itemconfig
$id -bitmap $bm
3356 proc DoEnterCityName
{win
} {
3360 proc InitVotesForUseThisMap
{} {
3361 # TODO: Disabled for new scenario window.
3364 global VotesForUseThisMap ScenarioWindows
3365 set VotesForUseThisMap
{}
3366 foreach win
$ScenarioWindows {
3367 [WindowLink
$win.vote
] config
-relief raised
3369 UpdateVotesForUseThisMap
3373 proc UpdateVotesForUseThisMap
{} {
3374 global ScenarioWindows
3375 UpdateVotesFor UseThisMap
$ScenarioWindows
3379 proc UIUseThisMap
{} {
3380 global CityName GameLevel Scenario
3382 # special handling for scenarios?
3383 if {$GameLevel != -1} {
3384 sim GameLevel
$GameLevel
3386 sim CityName
$CityName
3389 if {$Scenario != -1} {
3390 UIShowPicture
$Scenario
3395 proc HandleScenarioDown
{win x y
} {
3396 #echo HandleScenarioDown $win $x $y
3397 HandleScenarioMove
$win $x $y
3398 set w
[WindowLink
$win.w
]
3399 set target
[WindowLink
$w.scenarioTarget
]
3400 LinkWindow
$w.scenarioTargetDown
$target
3404 proc HandleScenarioUp
{win x y
} {
3405 #echo HandleScenarioUp $win $x $y
3406 HandleScenarioMove
$win $x $y
3407 global ScenarioButtons
3408 set w
[WindowLink
$win.w
]
3409 set target
[WindowLink
$w.scenarioTarget
]
3410 set targetDown
[WindowLink
$w.scenarioTargetDown
]
3411 if {($target != -1) &&
3412 ($target == $targetDown)} {
3413 set data
[lindex $ScenarioButtons $target]
3414 set type
[lindex $data 0]
3415 set id
[lindex $data 1]
3416 set callback
[lindex $data 2]
3417 set param
[lindex $data 3]
3418 set var
[lindex $data 4]
3419 set xx
[lindex $data 5]
3420 set yy
[lindex $data 6]
3421 set ww
[lindex $data 7]
3422 set hh
[lindex $data 8]
3423 set normal
[lindex $data 9]
3424 set over
[lindex $data 10]
3425 set disabled
[lindex $data 11]
3426 if {$type == "button"} {
3427 #echo callback $callback w $w param $param
3428 eval "$callback $w {$param}"
3430 if {$type == "checkbox"} {
3431 #echo checkbox callback $callback w $w param $param
3432 eval "$callback $w {$param}"
3439 proc HandleScenarioMove
{win x y
} {
3440 #echo HandleScenarioMove $win $x $y
3441 global ScenarioButtons
3442 set w
[WindowLink
$win.w
]
3443 set target
[WindowLink
$w.scenarioTarget
]
3446 set len
[llength $ScenarioButtons]
3448 set data
[lindex $ScenarioButtons $i]
3449 set type
[lindex $data 0]
3450 set id
[lindex $data 1]
3451 set callback
[lindex $data 2]
3452 set param
[lindex $data 3]
3453 set var
[lindex $data 4]
3454 set xx
[lindex $data 5]
3455 set yy
[lindex $data 6]
3456 set ww
[lindex $data 7]
3457 set hh
[lindex $data 8]
3459 set enabled
[WindowLink
$w.
$id.enabled
]
3460 set checked
[WindowLink
$w.
$id.checked
]
3462 #echo "ID $id ENABLED $enabled CHECKED $checked w $w id $id"
3464 if {($enabled != 0) &&
3466 ($x < ($xx + $ww)) &
3468 ($y < ($yy + $hh))} {
3473 set i
[expr "$i + 1"]
3476 if {$found != $target} {
3479 if {$target != -1} {
3481 #echo OUT $w $found $xx $yy $normal
3482 LinkWindow
$w.scenarioTarget
-1
3484 set targetdata
[lindex $ScenarioButtons $target]
3485 set targetid
[lindex $targetdata 1]
3486 LinkWindow
$w.
$targetid.over
0
3487 UpdateScenarioButton
$w $targetdata
3492 #echo IN $w $found $xx $yy $over
3493 LinkWindow
$w.scenarioTarget
$found
3494 LinkWindow
$w.
$id.over
1
3496 if {$target != -1} {
3497 set targetdata
[lindex $ScenarioButtons $target]
3498 set targetid
[lindex $targetdata 1]
3499 LinkWindow
$w.
$targetid.over
0
3500 UpdateScenarioButton
$w $targetdata
3503 UpdateScenarioButton
$w $data
3509 proc DoLoad
{win param
} {
3510 #echo DOLOAD $win $param
3515 proc DoGenerate
{win param
} {
3516 #echo DOGENERATE $win $param
3521 proc DoQuit
{win param
} {
3522 #echo DOQUIT $win $param
3527 proc DoAbout
{win param
} {
3528 #echo DOABOUT $win $param
3529 MakeHistory
"DoLoadCity cities/about.cty"
3533 proc DoMap
{win param
} {
3534 #echo DOMAP $win $param
3538 proc DoLevel
{win param
} {
3539 #echo DOLEVEL $win $param
3540 DoSetGameLevel
$param
3544 proc DoLeft
{win param
} {
3545 #echo DOLEFT $win $param
3550 proc DoRight
{win param
} {
3551 #echo DORIGHT $win $param
3556 proc DoPlay
{win param
} {
3557 #echo DOPLAY $win $param
3562 proc DoPickScenario
{win param
} {
3563 #echo DOPICKSCENARIO $win $param
3564 UILoadScenario
$param
3567 proc DeleteScenarioWindow
{win
} {
3572 ########################################################################
3573 # Undo/Redo Facility
3576 proc InitHistory
{} {
3578 global MapHistoryNum
3580 set MapHistoryNum
-1
3584 proc MakeHistory
{cmd
} {
3586 set len
[llength $MapHistory]
3588 ($cmd != [lindex $MapHistory [expr $len-1]])} {
3589 lappend MapHistory
$cmd
3597 proc GotoHistory
{i
} {
3599 global MapHistoryNum
3600 InitVotesForUseThisMap
3601 if {$i != $MapHistoryNum} {
3602 set MapHistoryNum
$i
3603 set cmd
[lindex $MapHistory $i]
3606 if {$MapHistoryNum == 0} {
3611 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3617 global ScenarioWindows
3618 foreach win
$ScenarioWindows {
3619 UpdateLeftRightEnabled
$win
3625 proc NextHistory
{} {
3627 global MapHistoryNum
3628 set len
[llength $MapHistory]
3629 set i
[expr "$MapHistoryNum + 1"]
3636 proc PrevHistory
{} {
3638 global MapHistoryNum
3639 set i
[expr "$MapHistoryNum - 1"]
3646 ########################################################################
3647 # Ask Window Handlers
3649 proc ShowAskOf
{head
} {
3650 set win
[WindowLink
$head.ask
]
3652 set win
[MakeWindow.ask
$head [winfo screen
$head]]
3662 foreach win
$HeadWindows {
3668 proc WithdrawAsks
{} {
3670 foreach win
$AskWindows {
3676 proc WithdrawAskOf
{win
} {
3677 set ask
[WindowLink
$win.ask
]
3684 proc AskQuestion
{color title
text left middle right
} {
3686 foreach win
$HeadWindows {
3687 AskQuestionOn
$win $color $title $text $left $middle $right
3692 proc AskQuestionOn
{head color title
text left middle right
} {
3695 set win
[WindowLink
$head.ask
]
3696 set t
[WindowLink
$win.title
]
3697 $t configure
-text $title
3698 $t configure
-background $color
3700 set t
[WindowLink
$win.
text]
3701 $t configure
-state normal
3703 $t insert end
"${text}\n"
3704 $t configure
-state disabled
3706 set bf
[WindowLink
$win.
frame]
3707 set l
[WindowLink
$win.left
]
3708 set m
[WindowLink
$win.middle
]
3709 set r
[WindowLink
$win.vote
]
3710 set rf
[WindowLink
$win.voteframe
]
3714 -text [lindex $left 0] \
3715 -command [format [lindex $left 2] $head]
3716 SetHelp
$l [lindex $left 1]
3717 pack append $bf $l {left
frame center
}
3722 if {$middle != ""} {
3724 -text [lindex $middle 0] \
3725 -command [format [lindex $middle 2] $head]
3726 SetHelp
$m [lindex $middle 1]
3727 pack append $bf $m {left
frame center expand
}
3733 set notify
[format [lindex $right 2] $head]
3734 set preview
[format [lindex $right 3] $head]
3735 set cmd
[list DoVote
$win Ask
$notify $preview]
3737 -text [lindex $right 0] \
3739 SetHelp
$r [lindex $right 1]
3740 pack append $bf $rf {right
frame center
}
3749 proc BindVotingButton
{win but name
} {
3750 set w
[WindowLink
$win.top
]
3752 bind $but <Any-Enter
> "VoteButtonEnter $win $but"
3753 bind $but <Any-Leave
> "VoteButtonLeave $win $but"
3754 bind $but <1> "VoteButtonDown $win $but $name"
3755 bind $but <ButtonRelease-1
> "VoteButtonUp $win $but $name"
3756 bind $but <2> "VoteButtonDown $win $but $name"
3757 bind $but <ButtonRelease-2
> "VoteButtonUp $win $but $name"
3758 bind $but <3> "VoteButtonDown $win $but $name"
3759 bind $but <ButtonRelease-3
> "VoteButtonUp $win $but $name"
3763 proc VoteButtonEnter
{win but
} {
3765 set screen
[winfo screen
$but]
3766 if {[lindex [$but config
-state] 4] != "disabled"} {
3767 $but config
-state active
3768 set tk_priv
(window
@$screen) $but
3770 set tk_priv
(window
@$screen) ""
3775 proc VoteButtonLeave
{win but
} {
3777 if {[lindex [$but config
-state] 4] != "disabled"} {
3778 $but config
-state normal
3780 set screen
[winfo screen
$but]
3781 set tk_priv
(window
@$screen) ""
3785 proc VoteButtonDown
{win but name
} {
3787 set screen
[winfo screen
$but]
3788 set rel
[lindex [$but config
-relief] 4]
3789 set tk_priv
(relief
@$screen) $rel
3790 if {[lindex [$but config
-state] 4] != "disabled"} {
3791 set head
[WindowLink
$win.head
]
3792 if {[IsVotingFor
$head $name]} {
3793 $but config
-relief raised
3795 $but config
-relief sunken
3801 proc VoteButtonUp
{win but name
} {
3803 set screen
[winfo screen
$but]
3804 $but config
-relief $tk_priv(relief
@$screen)
3805 if {($but == $tk_priv(window
@$screen))
3806 && ([lindex [$but config
-state] 4] != "disabled")} {
3807 uplevel #0 [list $but invoke]
3808 set head
[WindowLink
$win.head
]
3809 if {[IsVotingFor
$head $name]} {
3810 $but config
-relief sunken
3812 $but config
-relief raised
3818 proc PressVoteButton
{win but name
} {
3820 uplevel #0 [list $but invoke]
3821 set head
[WindowLink
$win.head
]
3822 if {[IsVotingFor
$head $name]} {
3823 $but config
-relief sunken
3825 $but config
-relief raised
3830 proc IsVotingFor
{win name
} {
3831 global VotesFor
$name
3832 set votes
[eval ident
"\$\{VotesFor$name\}"]
3833 if {[lsearch $votes $win] == -1} {
3841 proc DoVote
{win name notify preview
} {
3842 global VotesFor
$name
3843 set votes
[eval ident
"\$\{VotesFor$name\}"]
3845 set win
[WindowLink
$win.head
]
3846 set i
[lsearch $votes $win]
3848 lappend VotesFor
$name $win
3850 set VotesFor
$name [lreplace $votes $i $i]
3853 set votes
[eval ident
"\$\{VotesFor$name\}"]
3854 if {[llength $votes] >= [NeededVotes
]} {
3862 proc UpdateVotesFor
{name wins
} {
3863 global VotesFor
$name
3864 set votes
[eval llength "\$\{VotesFor$name\}"]
3865 set needed
[NeededVotes
]
3868 set head
[WindowLink
$win.head
]
3869 if {[IsVotingFor
$head $name]} {
3870 set border
[expr "($needed - $votes) * 1"]
3871 set pad
[expr "6 - $border"]
3872 [WindowLink
$win.vote
] config
-padx $pad -pady $pad
3873 [WindowLink
$win.voteframe
] config
-borderwidth $border
3875 set border
[expr "($needed - $votes - 1) * 1"]
3876 set pad
[expr "6 - $border"]
3877 [WindowLink
$win.vote
] config
-padx $pad -pady $pad
3878 [WindowLink
$win.voteframe
] config
-borderwidth $border
3884 proc InitVotesForAsk
{} {
3885 global VotesForAsk AskWindows
3887 foreach win
$AskWindows {
3888 [WindowLink
$win.vote
] config
-relief raised
3895 proc UpdateVotesForAsk
{} {
3897 UpdateVotesFor Ask
$AskWindows
3901 ########################################################################
3902 # Player Window Handlers
3904 proc ShowPlayerOf
{head
} {
3905 set win
[WindowLink
$head.player
]
3907 set win
[MakeWindow.player
$head [winfo screen
$head]]
3915 proc ShowPlayers
{} {
3917 foreach win
$HeadWindows {
3923 proc WithdrawPlayers
{} {
3924 global PlayerWindows
3925 foreach win
$PlayerWindows {
3931 proc UpdatePlayers
{} {
3932 # TODO: Disabled for new scenario window.
3935 global HeadWindows PlayerWindows
3938 foreach win
$HeadWindows {
3939 set server
[winfo screen
$win]
3940 # if {[string first : $server] == 0} {
3941 # set server "[exec hostname]:0"
3943 lappend players
$server
3946 sim Players
[llength $players]
3948 foreach win
$PlayerWindows {
3949 set list [WindowLink
$win.players
]
3951 eval "$list insert 0 $players"
3954 UpdateVotesForUseThisMap
3956 UpdateVotesForBudget
3957 UpdateTaxRateSliders
3961 proc UIShowPlayer
{win
} {
3966 proc DoNewPlayer
{win
} {
3967 set field
[WindowLink
$win.display
]
3968 set dpy
[$field get
]
3973 if {[AddPlayer
$dpy] != ""} {
3979 ########################################################################
3980 # Notice Window Handlers
3983 proc ShowNoticeOf
{head
} {
3984 set win
[WindowLink
$head.notice
]
3986 set win
[MakeWindow.notice
$head [winfo screen
$head]]
3988 global NoticePanelWidth NoticePanelHeight
3989 #place configure $win -x 0 -y 0 -width $NoticePanelWidth -height $NoticePanelHeight
3990 pack append [WindowLink
$head.w3
] \
3991 $win {bottom
frame sw expand fill
}
3996 proc ShowNotices
{} {
3998 foreach win
$HeadWindows {
4004 proc WithdrawNotices
{} {
4005 global NoticeWindows
4006 foreach win
$NoticeWindows {
4013 proc ReShowPictureOn
{{head
""}} {
4014 global ShowingPicture ShowingParms
4015 UIShowPictureOn
$head $ShowingPicture $ShowingParms
4019 proc UIShowPicture
{id
{parms
""}} {
4020 UIShowPictureOn
"" $id $parms
4024 proc UIShowPictureOn
{where id
{parms
""}} {
4025 global DoNotices Messages ShowingPicture ShowingParms
4026 if {$DoNotices == 0} {
4030 set ShowingPicture
$id
4031 set ShowingParms
$parms
4032 set msg
$Messages($id)
4033 set color
[lindex $msg 0]
4034 set title
[lindex $msg 1]
4035 set body
[lindex $msg 2]
4037 set cmd
"format {$body} $parms"
4038 set body
[uplevel #0 $cmd]
4040 set props
[lindex $msg 3]
4041 if {"$where" == ""} {
4043 set where
$HeadWindows
4045 foreach head
$where {
4046 NoticeMessageOn
$head "$title" $color "$body" Medium
$props
4051 proc NoticeMessageOn
{head title color
text font props
} {
4053 set win
[WindowLink
$head.notice
]
4055 set t
[WindowLink
$win.title
]
4056 $t configure
-text $title -background $color
4058 set t
[WindowLink
$win.
text]
4059 $t configure
-state normal
-font [Font
$head $font]
4061 $t insert end
"${text}\n"
4062 $t configure
-state disabled
4065 catch {set left
[keylget props left
]}
4066 set l
[WindowLink
$win.left
]
4068 $l config
-bitmap $left
4069 place $l -in $t -anchor sw
-relx .05 -rely .95
4075 catch {set middle
[keylget props middle
]}
4076 set m
[WindowLink
$win.middle
]
4077 if {$middle != ""} {
4078 $m config
-bitmap $middle
4079 place $m -in $t -anchor s
-relx .5 -rely .95
4085 catch {set right
[keylget props right
]}
4086 set r
[WindowLink
$win.right
]
4088 $r config
-bitmap $right
4089 place $r -in $t -anchor se
-relx .95 -rely .95
4095 catch {set view
[keylget props view
]}
4096 set vf
[WindowLink
$win.viewframe
]
4098 set v
[WindowLink
$win.view
]
4099 set bg
[WindowLink
$win.background
]
4103 pack append $bg $vf {left
frame center fill
}
4104 pack append $bg $t {right
frame center fill expand
}
4111 proc UIPopUpMessage
{msg
} {
4116 proc ComeToMe
{view
} {
4117 set win
[winfo toplevel $view]
4120 set x
[expr "[lindex $xy 0] >>4"]
4121 set y
[expr "[lindex $xy 1] >>4"]
4127 proc ComeTo
{win x y
} {
4128 global EditorWindows
4129 set head
[WindowLink
$win.head
]
4132 foreach ed
$EditorWindows {
4133 if {"[WindowLink $ed.head]" == "$head"} {
4135 set view
[WindowLink
$ed.view
]
4136 if {[$view AutoGoto
]} {
4137 lappend myautoeds
$ed
4141 if {[llength $myautoeds]} {
4142 UIAutoGotoOn
$x $y $myautoeds
4144 if {[llength $myeds]} {
4145 UIAutoGotoOn
$x $y $myeds
4151 proc FollowView
{view id
} {
4155 if {[sim DoAnimation
]} {
4156 set head
[WindowLink
[winfo toplevel $view].head
]
4157 global EditorWindows
4158 foreach win
$EditorWindows {
4159 if {"[WindowLink $win.head]" == "$head"} {
4160 set s
[[WindowLink
$win.view
] Skip
]
4161 set skips
[min
$skips $s]
4165 if {$skips == 999999} {
4175 proc PanView
{view x y
} {
4181 ########################################################################
4182 # Help Window Handlers
4185 proc ShowHelpOf
{head
} {
4186 set win
[WindowLink
$head.help
]
4188 set win
[MakeWindow.help
$head [winfo screen
$head]]
4198 foreach win
$HeadWindows {
4204 proc WithdrawHelps
{} {
4206 foreach win
$HelpWindows {
4212 ########################################################################
4213 # Frob Window Handlers
4216 proc ShowFrobOf
{head
} {
4217 set win
[WindowLink
$head.frob
]
4219 set win
[MakeWindow.frob
$head [winfo screen
$head]]
4230 foreach win
$HeadWindows {
4236 proc WithdrawFrobs
{} {
4238 foreach win
$FrobWindows {
4244 proc UISetDynamic
{i min max
} {
4245 sim DynamicData
[expr "$i*2"] $min
4246 sim DynamicData
[expr "$i*2+1"] $max
4250 ########################################################################
4257 source $ResourceDir/help.tcl
4260 proc HandleHelp
{win x y rootx rooty
} {
4261 global HelpLoaded HelpWidgets Messages
4263 if {$HelpLoaded == 0} {
4269 set head
[WindowLink
[winfo toplevel $win].head
]
4272 catch {set id
$HelpWidgets($win)}
4276 set list [split $win .
]
4277 set len
[expr "[llength $list] - 2"]
4278 set list [lrange $list 0 $len]
4279 if {[llength $list] <= 1} {
4283 set win
[join $list .
]
4285 if [info exists Messages
($id)] {
4286 UIShowHelpOn
$head $id
4288 UIShowHelpOn
$head Window
4293 proc UIShowHelpOn
{win id
{parms
""}} {
4294 global Messages ShowingPicture ShowingParms ResourceDir
4295 set head
[WindowLink
$win.head
]
4296 set msg
$Messages($id)
4297 set color
[lindex $msg 0]
4298 set title
[lindex $msg 1]
4299 set body
[lindex $msg 2]
4301 set cmd
"format {$body} $parms"
4302 set body
[uplevel #0 $cmd]
4304 set props
[lindex $msg 3]
4307 set win
[WindowLink
$head.help
]
4309 set t
[WindowLink
$win.title
]
4310 $t configure
-text $title -background $color
4312 set t
[WindowLink
$win.
text]
4313 $t configure
-state normal
-font [Font
$head Large
]
4315 $t insert end
"${body}\n"
4316 FormatHTML
$ResourceDir/doc
/$id.html
$t
4317 $t configure
-state disabled
4321 proc FormatHTML
{filename text} {
4324 set f
[open $filename]
4331 while {[gets $f line
] >= 0} {
4332 if {"$line" == "</body>"} {
4335 if {([string index
$line 0] == "#") ||
([string length
$line] == 0)} {
4338 $text insert end
"$line\n"
4347 proc SetHelp
{win id
} {
4349 set HelpWidgets
($win) $id
4353 proc Help
{id title
{msg
{}} {props
{}}} {
4354 Message
$id #7f7fff $title $msg $props
4357 ########################################################################
4361 # Set up the bindings to pop up $pie when the right button is clicked in $win
4362 proc InitPie
{win pie
} {
4363 bind $win <Motion
> {}
4364 bind $win <3> "PieMenuDown $win $pie $pie Initial %X %Y"
4365 bind $win <B3-Motion
> {}
4366 bind $win <B3-ButtonRelease
> {}
4370 # Set up the bindings to continue tracking $pie
4371 # Get this: we keep the tracking machine state in the bindings!
4372 proc ActivatePie
{win root pie state
} {
4373 bind $win <Motion
> "PieMenuMotion $win $root $pie $state %X %Y"
4374 bind $win <3> "PieMenuDown $win $root $pie $state %X %Y"
4375 bind $win <B3-Motion
> "PieMenuMotion $win $root $pie $state %X %Y"
4376 bind $win <B3-ButtonRelease
> "PieMenuUp $win $root $pie $state %X %Y"
4380 # Cancel and reset a pie menu
4381 proc CancelPie
{win
} {
4382 set binding
[bind $win <3>]
4383 set root
[lindex $binding 2]
4384 set pie
[lindex $binding 3]
4385 set state
[lindex $binding 4]
4386 if {"$state" != "Initial"} {
4387 catch {$root ungrab
$win}
4390 UIMakeSoundOn
$win fancy Oop
4396 # Handle pie menu button down
4397 proc PieMenuDown
{win root pie state x y
} {
4400 ActivatePie
$win $root $pie FirstDown
4402 catch {$root grab $win}
4405 PreviewPieMenu
$win $pie $x $y
4409 TrackPieMenu
$pie $x $y
4410 ActivatePie
$win $root $pie SecondDown
4416 PreviewPieMenu
$win $pie $x $y
4417 ActivatePie
$win $root $pie SecondDown
4422 SecondDown
{ # error
4429 # Handle pie menu button motion
4430 proc PieMenuMotion
{win root pie state x y
} {
4433 TrackPieMenu
$pie $x $y
4441 TrackPieMenu
$pie $x $y
4455 # Handle pie menu button up
4456 proc PieMenuUp
{win root pie state x y
} {
4459 TrackPieMenu
$pie $x $y
4460 set active
[$pie index active
]
4461 if {$active == "none"} {
4463 catch {$root grab $win}
4464 ActivatePie
$win $root $pie ClickedUp
4466 set label [lindex [$pie entryconfig
$active -label] 4]
4467 set submenu
[lindex [$pie entryconfig
$active -piemenu] 4]
4468 UIMakeSoundOn
$win mode
$label
4469 if {$submenu == {}} {
4470 set reward
[$pie pending
]
4471 catch {$root ungrab
$win}
4475 sim Funds
[expr "[sim Funds] + 5"]
4476 UIMakeSoundOn
$win fancy Aaah
4478 eval [lindex [$pie entryconfig
$active -command] 4]
4483 $submenu activate none
4485 PreviewPieMenu
$win $submenu $x $y
4486 catch {$root grab $win}
4487 ActivatePie
$win $root $submenu SelectedUp
4492 TrackPieMenu
$pie $x $y
4493 set active
[$pie index active
]
4494 if {$active == "none"} {
4497 set label [lindex [$pie entryconfig
$active -label] 4]
4498 set submenu
[lindex [$pie entryconfig
$active -piemenu] 4]
4499 UIMakeSoundOn
$win mode
$label
4500 if {$submenu == {}} {
4501 set reward
[$pie pending
]
4502 catch {$root ungrab
$win}
4506 sim Funds
[expr "[sim Funds] + 5"]
4507 UIMakeSoundOn
$win fancy Aaah
4509 eval [lindex [$pie entryconfig
$active -command] 4]
4514 $submenu activate none
4516 PreviewPieMenu
$win $submenu $x $y
4517 catch {$root grab $win}
4518 ActivatePie
$win $root $submenu SelectedUp
4528 SelectedUp
{ # error
4535 # Track the selected item
4536 proc TrackPieMenu
{pie x y
} {
4537 $pie activate
@$x,$y
4541 proc PreviewPieMenu
{win pie x y
} {
4542 set preview
[lindex [$pie config
-preview] 4]
4543 if {"$preview" != ""} {
4544 set rx
[winfo rootx
$win]
4545 set ry
[winfo rooty
$win]
4546 set x
[expr "$x - $rx"]
4547 set y
[expr "$y - $ry"]
4548 eval [format $preview $x $y]
4553 ########################################################################
4557 proc ExclusivePallet
{state parent children prefix images inactive active cmd
} {
4558 #echo "ExclusivePallet state $state parent $parent children $children prefix $prefix images $images inactive $inactive active $active cmd $cmd"
4560 foreach child
$children {
4561 set name
[lindex $images $i]
4562 if {$i == $state} then
{
4563 $parent.
$child config
\
4564 -bitmap "@images/${prefix}${name}hi.xpm" \
4567 $parent.
$child config
\
4568 -bitmap "@images/${prefix}${name}.xpm" \
4573 eval [concat $cmd $state]
4577 proc NonExclusivePallet
{mask parent children prefix images
4578 inactive active cmd
} {
4580 foreach child
$children {
4581 set name
[lindex $images $i]
4582 if {$mask & (1<<$i)} then
{
4583 $parent.
$child config
\
4584 -bitmap "@images/${prefix}${name}hi.xpm" \
4587 $parent.
$child config
\
4588 -bitmap "@images/${prefix}${name}.xpm" \
4593 eval [concat $cmd $mask]
4597 proc EditorPallet
{win state
} {
4598 global EditorPalletSounds
4599 UIMakeSoundOn
$win mode
[lindex $EditorPalletSounds $state]
4600 EditorSetTool
$win $state
4604 proc EditorSetTool
{win state
} {
4605 global EditorPallets
4606 global EditorPalletImages
4607 ExclusivePallet
$state $win $EditorPallets ic
$EditorPalletImages \
4608 flat raised
"$win.centerframe.view ToolState"
4612 proc GraphPallet
{win state
} {
4613 set mask
[[WindowLink
$win.graphview
] Mask
]
4614 set mask
[expr "$mask ^ (1<<$state)"]
4615 GraphPalletMask
$win $mask
4619 proc GraphPalletMask
{win mask
} {
4621 global GraphPalletImages
4622 NonExclusivePallet
$mask $win $GraphPallets gr
$GraphPalletImages \
4623 flat flat
"SetGraphState $win"
4627 proc GraphYearPallet
{win state
} {
4628 global GraphYearPallets
4629 global GraphYearPalletImages
4630 ExclusivePallet
$state $win $GraphYearPallets gr
$GraphYearPalletImages \
4631 flat flat
"SetGraphYearState $win"
4635 proc SetGraphYearState
{win state
} {
4636 set graph
[WindowLink
$win.graphview
]
4645 proc SetGraphState
{win mask
} {
4647 set graph
[WindowLink
$win.graphview
]
4652 ########################################################################
4655 proc sim_butEnter
{w
} {
4657 set screen
[winfo screen
$w]
4658 set tk_priv
(window
@$screen) $w
4662 proc sim_butLeave
{w
} {
4664 set screen
[winfo screen
$w]
4665 set tk_priv
(window
@$screen) ""
4669 proc sim_butDown
{w
} {
4671 set screen
[winfo screen
$w]
4672 set pict
[lindex [$w config
-bitmap] 4]
4673 set tk_priv
(relief
@$screen) $pict
4674 $w config
-bitmap [lindex [split $pict .
] 0]hi.xpm
4679 proc sim_butUp
{w
} {
4681 set screen
[winfo screen
$w]
4682 $w config
-bitmap $tk_priv(relief
@$screen)
4684 if {$w == $tk_priv(window
@$screen)} {
4685 uplevel #0 [list $w invoke]
4690 proc BindSimButton
{w
} {
4691 bind $w <Any-Enter
> {sim_butEnter
%W
}
4692 bind $w <Any-Leave
> {sim_butLeave
%W
}
4693 bind $w <1> {sim_butDown
%W
}
4694 bind $w <ButtonRelease-1
> {sim_butUp
%W
}
4695 bind $w <2> {sim_butDown
%W
}
4696 bind $w <ButtonRelease-2
> {sim_butUp
%W
}
4697 bind $w <3> {sim_butDown
%W
}
4698 bind $w <ButtonRelease-3
> {sim_butUp
%W
}
4702 ########################################################################
4703 # Internal Callbacks
4706 proc UIStartMicropolis
{homedir resourcedir hostname
} {
4707 global HomeDir ResourceDir HostName HeadWindows
4708 set HomeDir
$homedir
4709 set ResourceDir
$resourcedir
4710 set HostName
$hostname
4715 foreach display
[sim Displays
] {
4716 if {"[AddPlayer $display]" == ""} {
4717 echo Couldn't add a player on
$display ...
4721 if {"$HeadWindows" == ""} {
4722 echo Micropolis is exiting because it couldn't connect to any players.
4728 proc UISelectCity
{win
} {
4729 AskQuestion
[Color
$win #ff0000 #ffffff] "Choose Another City" \
4730 "Do you want to abandon this city and choose another one?" \
4731 "{Keep playing.} SelectCity.No {RejectPlan}" \
4733 "{Another city!} SelectCity.Yes {UIPickScenarioMode}"
4737 proc UIQuit
{head
} {
4738 if {[sim Players
] == 1} {
4739 set l
"{Keep playing.} Quit.No {RejectPlan}"
4741 set r
"{I quit!} Quit.IQuit {DoReallyQuit %s}"
4743 set l
"{Keep playing.} Quit.No {RejectPlan}"
4744 set m
"{I quit!} Quit.IResign {DoIResign %s}"
4745 set r
"{Everyone quit!} Quit.AllQuit {DoReallyQuit %s}"
4747 AskQuestion
[Color
$head #ff0000 #ffffff] "Quit Playing Micropolis" \
4748 "Do you want to quit playing Micropolis?" \
4753 proc DoIResign
{head
} {
4755 set display
[winfo screen
$head]
4757 DecRefDisplay
$display
4758 UISetMessage
"The player on X11 Display $display has resigned."
4760 if {([sim Players
] == 0) ||
4761 ([llength $VotesForAsk] >= [sim Players
])} {
4767 proc DoReallyQuit
{head
} {
4773 proc UISplashMode
{} {
4783 proc UIPickScenarioMode
{} {
4792 InitVotesForUseThisMap
4797 proc ForcePickScenarioMode
{} {
4799 if {"$State" != "scenario"} {
4805 proc UIGenerateCityNow
{} {
4806 global CityName GameLevel
4807 sim CityName NowHere
4813 proc UIGenerateNewCity
{} {
4814 global CityName GameLevel
4815 if {$GameLevel == -1} {
4818 MakeHistory
"DoNewCity NowHere $GameLevel [sim Rand] [sim TreeLevel] [sim LakeLevel] [sim CurveLevel] [sim CreateIsland]"
4822 proc DoNewCity
{name level
{r
""} {tl
-1} {ll
-1} {cl
-1} {ci
-1}} {
4828 sim CreateIsland
$ci
4832 sim GenerateSomeCity
$r
4835 sim GameLevel
$level
4840 proc UIDidGenerateNewCity
{} {
4845 proc IncRefDisplay
{display
} {
4846 global DisplayRegistry
4847 if ![info exists DisplayRegistry
($display)] {
4848 set DisplayRegistry
($display) 0
4850 incr DisplayRegistry
($display)
4854 proc DecRefDisplay
{display
} {
4855 global DisplayRegistry
4856 incr DisplayRegistry
($display) -1
4857 if {$DisplayRegistry($display) <= 0} {
4858 CloseDisplay
$display
4863 proc CloseDisplay
{display
} {
4867 proc DoStopMicropolis
{} {
4873 proc AddPlayer
{display
} {
4874 set i
[string first
: $display]
4878 set display
"$display:0"
4882 echo Adding a player on
$display ...
4884 set head
[MakeWindow.head
$display]
4886 if {"$head" != ""} {
4887 set display
[winfo screen
$head]
4888 IncRefDisplay
$display
4890 UISetMessage
"Added a player on X11 Display \"$display\"."
4893 UISetMessage
"Couldn't add a player on X11 Display \"$display\"!"
4903 proc DropFireBombs
{} {
4911 proc UIMakeMonster
{} {
4912 sim MakeMonster
[sim Rand
120] [sim Rand
100]
4935 proc TogglePause
{} {
4938 if {"$State" != "play" ||
[sim Speed
]} {
4949 proc SetSpeedTime
{time} {
4955 proc MakeRunningSound
{} {
4958 if {"$State" == "play" && [sim Speed
]} {
4959 UIMakeSound edit Boing
"-speed 1[sim Speed]0"
4961 UIMakeSound edit Boing
"-speed 90"
4966 proc SayDemands
{} {
4967 global DemandRes DemandCom DemandInd
4969 set r
[expr "100 + ($DemandRes * $slope)"]
4970 set c
[expr "100 + ($DemandCom * $slope)"]
4971 set i
[expr "100 + ($DemandInd * $slope)"]
4972 after 020 "UIMakeSound edit O \"-speed $r\""
4973 after 220 "UIMakeSound edit A \"-speed $c\""
4974 after 440 "UIMakeSound edit E \"-speed $i\""
4978 proc UISaveCity
{win
} {
4980 set SaveCityWin
$win
4985 proc UISaveCityAs
{{win
""}} {
4987 if {"$win" == ""} {set win
$SaveCityWin}
4988 set SaveCityWin
$win
4991 set file [ShowFileOf
$win]
4992 DoFileDialog
$file "Choose a File to Save the City" $CityDir "*.cty" "" \
4993 "UIDoReallySaveCity" ""
4997 proc UIDoReallySaveCity
{name path
} {
4999 if {![string match
*.cty
$name]} {
5003 sim SaveCityAs
$path/$name
5007 proc UIDidSaveCity
{} {
5008 DoSendMessage
"Saved the city in \"[sim CityFileName]\"." status
5012 proc UIDidntSaveCity
{msg
} {
5013 DoSendMessage
$msg alert
5014 UIMakeSound warning Sorry
"-speed 85"
5018 proc UILoadScenario
{scen
} {
5019 MakeHistory
"DoScenario $scen"
5023 proc DoScenario
{scen
} {
5026 sim LoadScenario
$scen
5031 proc UIDidLoadScenario
{} {
5035 proc UIStartScenario
{id
} {
5044 proc UIPlayNewCity
{} {
5050 proc UIStartLoad
{} {
5055 proc UIReallyStartGame
{} {
5061 proc UIPlayGame
{} {
5068 SetPriority
$Priority
5076 proc UISetSpeed
{speed
} {
5079 if {"$State" == "play"} {
5080 UISetMessage
[lindex {
5083 {Time flows medium.
}
5091 proc UIUpdateRunning
{} {
5092 global HeadWindows Time State
5094 if {($State == "play") && $Time} {
5095 set pict
"@images/micropolisg.xpm"
5097 set pict
"@images/micropoliss.xpm"
5100 foreach win
$HeadWindows {
5101 set can
[WindowLink
$win.demand
]
5102 $can itemconfig micropolis
-bitmap $pict
5107 proc DoSetGameLevel
{level
} {
5108 sim GameLevel
$level
5112 proc UISetGameLevel
{level
} {
5114 set GameLevel
$level
5115 global ScenarioWindows
5116 foreach win
$ScenarioWindows {
5117 UpdateLevelSelection
$win
5122 proc UISetCityName
{name
} {
5123 global EditorWindows
5126 set title
"Micropolis Editor on $name"
5127 foreach win
$EditorWindows {
5128 # TODO: set editor window and icon title
5129 #wm title $win "$title"
5130 #wm iconname $win "$title"
5135 proc UILoadCity
{win
} {
5136 # if changed, r-u-sure?
5138 set file [ShowFileOf
$win]
5139 DoFileDialog
$file "Choose a City to Load" $CityDir "*.cty" "" \
5144 proc UIDoLoadCity
{name path
} {
5147 if {![string match
*.cty
$name]} {
5150 MakeHistory
"DoLoadCity {$path/$name}"
5154 proc DoLoadCity
{filename} {
5155 sim LoadCity
$filename
5158 proc UIDidLoadCity
{} {
5159 global State GameLevel Scenario
5162 if {$State == "play"} {
5165 UIShowPicture
49 [sim CityFileName
]
5170 proc UIDidntLoadCity
{msg
} {
5171 DoSendMessage
$msg alert
5172 UIMakeSound warning Sorry
"-speed 85"
5173 UIShowPicture
49 [sim CityFileName
]
5192 proc UIDidPan
{w x y
} {
5193 if {[$w ToolMode
] == 1} {
5194 EditorToolDrag
$w $x $y
5200 proc UIDidStopPan
{win
} {
5201 UIMakeSoundOn
$win fancy Skid
"-volume 25"
5206 proc UIEarthQuake
{} {
5210 proc UIAutoGoto
{x y
{except
{}}} {
5211 global EditorWindows
5213 set x
[expr "$x * 16 + 8"]
5214 set y
[expr "$y * 16 + 8"]
5215 foreach win
$EditorWindows {
5216 if {"$win" != "$except"} {
5217 set view
[WindowLink
$win.view
]
5218 if {[$view AutoGoto
]} {
5220 $view AutoGoal
$x $y
5230 proc UIAutoGotoOn
{x y eds
} {
5231 set x
[expr "$x * 16 + 8"]
5232 set y
[expr "$y * 16 + 8"]
5234 [WindowLink
$win.view
] AutoGoal
$x $y
5240 proc DoLeaveGame
{head
} {
5244 proc UILoseGame
{} {
5248 AskQuestion
[Color .
#ff0000 #ffffff] [lindex $Messages(200) 1] \
5249 [lindex $Messages(200) 2] \
5252 "{Ok} SelectCity.Yes {UIPickScenarioMode}"
5261 proc DoPendTool
{view tool x y
} {
5262 global HeadWindows ToolInfo VotesForAsk
5264 set win
[WindowLink
$view.top
]
5265 set head
[WindowLink
$win.head
]
5267 if {($tool == [sim PendingTool
]) &&
5268 ($x == [sim PendingX
]) &&
5269 ($y == [sim PendingY
])} {
5270 if {[lsearch $VotesForAsk $head] != -1} {
5271 # you can only vote once
5272 UIMakeSound edit Oop
5274 UIMakeSound edit Boing
5275 set ask
[WindowLink
$head.ask
]
5276 PressVoteButton
$ask [WindowLink
$ask.vote
] Ask
5279 UIAutoGoto
$x $y $win
5281 UIMakeSound edit Boing
5282 set info [lindex $ToolInfo $tool]
5283 set a
[lindex $info 0]
5284 set name
[lindex $info 1]
5285 set cost
[lindex $info 2]
5286 set title
"Build $a $name"
5287 set question
"Do you support the plan to build $a $name for $cost?"
5288 AskQuestion
[Color
$win #00ff00 #ffffff] "$title" \
5290 "{Veto plan.} Plan.Veto
5292 "{Goto plan.} Plan.Goto
5293 {ComeTo %s $x $y}" \
5294 "{Support plan!} Plan.Support
5295 {SupportPlan $view %s $tool $x $y}
5296 {PreviewSupportPlan $view %s $tool $x $y}"
5297 set VotesForAsk
$head
5298 set ask
[WindowLink
$head.ask
]
5299 [WindowLink
$ask.vote
] config
-relief sunken
5303 sim PendingTool
$tool
5306 sim Votes
[llength $VotesForAsk]
5311 proc RejectPlan
{} {
5313 if {[sim Players
] > 1} {
5314 UIMakeSound edit Sorry
5320 proc NeededVotes
{} {
5322 set players
[sim Players
]
5323 set needed
[expr "$players - $FreeVotes"]
5324 return [max
0 $needed]
5328 proc SupportPlan
{view h tool x y
} {
5330 sim Votes
[llength $VotesForAsk]
5333 $view DoTool
$tool $x $y
5336 UIMakeSound edit Aaah
5340 proc PreviewSupportPlan
{view h tool x y
} {
5342 sim Votes
[llength $VotesForAsk]
5346 proc SugarStartUp
{uri
} {
5350 # TODO: Load the city file at the given URI, or configure according to URI parameters.
5354 proc SugarNickName
{nick
} {
5355 global SugarNickName
5356 set SugarNickName
$nick
5360 proc SugarActivate
{} {
5361 global SugarActivated
5362 set SugarActivated
1
5366 proc SugarDeactivate
{} {
5367 global SugarActivated
5368 set SugarActivated
0
5372 proc SugarShare
{} {
5378 proc SugarBuddyAdd
{key nick color address
} {
5380 set buddy
[list $key $nick $color $address]
5381 lappend SugarBuddies
$buddy
5385 proc SugarBuddyDel
{key nick color address
} {
5387 set buddy
[list $key $nick $color $address]
5388 set i
[lsearch $wins $win]
5390 set SugarBuddies
[lreplace $wins $i $i]
5400 ########################################################################