1 #######################################################################
2 # Micropolis.tcl, by Don Hopkins.
3 # Copyright (C) 2002 by Electronic Arts.
4 # This file defines the user interface of Micropolis.
5 # Modify at your own risk!
6 ########################################################################
7 # Micropolis, Unix Version. This game was released for the Unix platform
8 # in or about 1990 and has been modified for inclusion in the One Laptop
9 # Per Child program. Copyright (C) 1989 - 2007 Electronic Arts Inc. If
10 # you need assistance with this program, you may contact:
11 # http://wiki.laptop.org/go/Micropolis or email micropolis@laptop.org.
13 # This program is free software: you can redistribute it and/or modify
14 # it under the terms of the GNU General Public License as published by
15 # the Free Software Foundation, either version 3 of the License, or (at
16 # your option) any later version.
18 # This program is distributed in the hope that it will be useful, but
19 # WITHOUT ANY WARRANTY; without even the implied warranty of
20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 # General Public License for more details. You should have received a
22 # copy of the GNU General Public License along with this program. If
23 # not, see <http://www.gnu.org/licenses/>.
25 # ADDITIONAL TERMS per GNU GPL Section 7
27 # No trademark or publicity rights are granted. This license does NOT
28 # give you any right, title or interest in the trademark SimCity or any
29 # other Electronic Arts trademark. You may not distribute any
30 # modification of this program using the trademark SimCity or claim any
31 # affliation or association with Electronic Arts Inc. or its employees.
33 # Any propagation or conveyance of this program must include this
34 # copyright notice and these terms.
36 # If you convey this program (or any modifications of it) and assume
37 # contractual liability for the program to recipients of it, you agree
38 # to indemnify Electronic Arts for any liability that those contractual
39 # assumptions impose on Electronic Arts.
41 # You may not misrepresent the origins of this program; modified
42 # versions of the program must be marked as such and not identified as
43 # the original program.
45 # This disclaimer supplements the one included in the General Public
46 # License. TO THE FULLEST EXTENT PERMISSIBLE UNDER APPLICABLE LAW, THIS
47 # PROGRAM IS PROVIDED TO YOU "AS IS," WITH ALL FAULTS, WITHOUT WARRANTY
48 # OF ANY KIND, AND YOUR USE IS AT YOUR SOLE RISK. THE ENTIRE RISK OF
49 # SATISFACTORY QUALITY AND PERFORMANCE RESIDES WITH YOU. ELECTRONIC ARTS
50 # DISCLAIMS ANY AND ALL EXPRESS, IMPLIED OR STATUTORY WARRANTIES,
51 # INCLUDING IMPLIED WARRANTIES OF MERCHANTABILITY, SATISFACTORY QUALITY,
52 # FITNESS FOR A PARTICULAR PURPOSE, NONINFRINGEMENT OF THIRD PARTY
53 # RIGHTS, AND WARRANTIES (IF ANY) ARISING FROM A COURSE OF DEALING,
54 # USAGE, OR TRADE PRACTICE. ELECTRONIC ARTS DOES NOT WARRANT AGAINST
55 # INTERFERENCE WITH YOUR ENJOYMENT OF THE PROGRAM; THAT THE PROGRAM WILL
56 # MEET YOUR REQUIREMENTS; THAT OPERATION OF THE PROGRAM WILL BE
57 # UNINTERRUPTED OR ERROR-FREE, OR THAT THE PROGRAM WILL BE COMPATIBLE
58 # WITH THIRD PARTY SOFTWARE OR THAT ANY ERRORS IN THE PROGRAM WILL BE
59 # CORRECTED. NO ORAL OR WRITTEN ADVICE PROVIDED BY ELECTRONIC ARTS OR
60 # ANY AUTHORIZED REPRESENTATIVE SHALL CREATE A WARRANTY. SOME
61 # JURISDICTIONS DO NOT ALLOW THE EXCLUSION OF OR LIMITATIONS ON IMPLIED
62 # WARRANTIES OR THE LIMITATIONS ON THE APPLICABLE STATUTORY RIGHTS OF A
63 # CONSUMER, SO SOME OR ALL OF THE ABOVE EXCLUSIONS AND LIMITATIONS MAY
67 ########################################################################
69 ########################################################################
75 source $tk_library/wish.tcl
78 ########################################################################
80 ########################################################################
84 set State uninitialized
85 set CityName
"Micropolis"
88 set CityLibDir
$SimHome/cities
89 set CityDir
$CityLibDir
93 set BudgetPoliceFund
0
111 set AudioChannels
{mode edit fancy warning intercom
}
114 set BudgetTimerActive
0
116 set EvaluationsVisible
0
117 set SplashScreenDelay
5000
120 set ChatServer
"localhost"
122 set ChatConnection
{}
123 set NickName
"nickname"
124 set UserName
"username"
125 set ServerName
"servername"
126 set RealName
"realname"
127 set ChannelName
"#Micropolis"
131 set LocalHostName
"[exec hostname]"
139 set ShowingPicture
300
143 set VoteNames
{UseThisMap Ask Zone
}
144 set VotesForUseThisMap
{}
147 set VotesForBudget
{}
155 set EvaluationWindows
{}
157 set ScenarioWindows
{}
165 set HeadPanelWidth
360
166 set HeadPanelHeight
200
168 set MapPanelWidth
360
169 set MapPanelHeight
330
171 set NoticePanelWidth
360
172 set NoticePanelHeight
250
174 set SplashPanelWidth
1200
175 set SplashPanelHeight
900
177 set ScenarioPanelWidth
420
178 set ScenarioPanelHeight
440
187 {editor EditorWindows
}
190 {budget BudgetWindows
}
191 {evaluation EvaluationWindows
}
192 {scenario ScenarioWindows
}
193 {splash SplashWindows
}
196 {player PlayerWindows
}
197 {notice NoticeWindows
}
204 # 0 1 2 3 4 5 6 7 8 9 10 11 12 13
205 # type id callback param var x y w h normal over disabled checked checkedover
206 # ----------- --------------- --------------- ------- ------- --- --- --- --- ------- ---- -------- ------- -----------
207 set ScenarioButtons
{
208 { button load DoLoad
"" "" 70 238 157 90 "" @images
/button1hilite.xpm
"" }
209 { button generate DoGenerate
"" "" 62 392 157 90 "" @images
/button2hilite.xpm
"" }
210 { button quit DoQuit
"" "" 68 544 157 90 "" @images
/button3hilite.xpm
"" }
211 { button about DoAbout
"" "" 101 705 157 90 "" @images
/button4hilite.xpm
"" }
212 { checkbox easy DoLevel
0 "" 982 106 190 70 "" @images
/checkbox1hilite.xpm
"" @images
/checkbox1checked.xpm
@images
/checkbox1hilitechecked.xpm
}
213 { checkbox medium DoLevel
1 "" 982 176 190 70 "" @images
/checkbox2hilite.xpm
"" @images
/checkbox2checked.xpm
@images
/checkbox2hilitechecked.xpm
}
214 { checkbox hard DoLevel
2 "" 982 246 190 70 "" @images
/checkbox3hilite.xpm
"" @images
/checkbox3checked.xpm
@images
/checkbox3hilitechecked.xpm
}
215 { button left DoLeft
"" "" 540 375 50 50 "" @images
/lefthilite.xpm
@images
/leftdisabled.xpm
}
216 { button right DoRight
"" "" 841 375 50 50 "" @images
/righthilite.xpm
@images
/rightdisabled.xpm
}
217 { button play DoPlay
"" "" 625 376 180 50 "" @images
/playhilite.xpm
"" }
218 { button scenario1 DoPickScenario
"1" "" 310 451 209 188 "" @images
/scenario1hilite.xpm
"" }
219 { button scenario2 DoPickScenario
"2" "" 519 451 209 188 "" @images
/scenario2hilite.xpm
"" }
220 { button scenario3 DoPickScenario
"3" "" 727 450 209 188 "" @images
/scenario3hilite.xpm
"" }
221 { button scenario4 DoPickScenario
"4" "" 936 450 209 188 "" @images
/scenario4hilite.xpm
"" }
222 { button scenario5 DoPickScenario
"5" "" 310 639 209 188 "" @images
/scenario5hilite.xpm
"" }
223 { button scenario6 DoPickScenario
"8" "" 519 639 209 188 "" @images
/scenario6hilite.xpm
"" }
224 { button scenario7 DoPickScenario
"7" "" 728 638 209 188 "" @images
/scenario7hilite.xpm
"" }
225 { button scenario8 DoPickScenario
"6" "" 937 638 209 188 "" @images
/scenario8hilite.xpm
"" }
228 # Disabled until we handle mouse events on the map itself.
229 # { button map DoMap "" "" 516 30 396 338 "" @images/maphilite.xpm }
232 ########################################################################
238 {-*-dejavu lgc sans-medium-r-normal-
*-90-*}
241 {-*-dejavu lgc sans-medium-r-normal-
*-80-*}
244 {-*-dejavu lgc sans-medium-r-normal-
*-70-*}
247 {-*-dejavu lgc sans-medium-r-normal-
*-60-*}
250 {-*-dejavu lgc sans-medium-r-normal-
*-60-*}
253 {-*-dejavu lgc sans-medium-r-normal-
*-60-*}
256 {-*-dejavu lgc sans-medium-r-normal-
*-70-*}
259 {-*-dejavu lgc sans-medium-r-normal-
*-70-*}
262 {-*-dejavu lgc sans-medium-r-normal-
*-70-*}
267 ########################################################################
271 {Micropolis Overall Map
}
272 {Residential Zone Map
}
273 {Commercial Zone Map
}
274 {Industrial Zone Map
}
277 {Population Density Map
}
279 {Traffic Density Map
}
280 {Pollution Desity Map
}
284 {Police Coverage Map
}
290 leftframe.tools.palletres
291 leftframe.tools.palletcom
292 leftframe.tools.palletind
293 leftframe.tools.palletfire
294 leftframe.tools.palletquery
295 leftframe.tools.palletpolice
296 leftframe.tools.palletwire
297 leftframe.tools.palletbulldozer
298 leftframe.tools.palletrail
299 leftframe.tools.palletroad
300 leftframe.tools.palletchalk
301 leftframe.tools.palleteraser
302 leftframe.tools.palletstadium
303 leftframe.tools.palletpark
304 leftframe.tools.palletseaport
305 leftframe.tools.palletcoal
306 leftframe.tools.palletnuclear
307 leftframe.tools.palletairport
311 set EditorPalletImages
{
312 res com ind fire qry pol
313 wire dozr rail road chlk ersr
314 stad park seap coal nuc airp
318 set EditorPalletSounds
{
319 Res Com Ind Fire Query Police
320 Wire Bulldozer Rail Road Chalk Eraser
321 Stadium Park Seaport Coal Nuclear Airport
329 leftframe.right.money
330 leftframe.right.crime
331 leftframe.right.pollution
335 set GraphPalletImages
{
336 res com ind mony crim poll
340 set GraphYearPallets
{
341 leftframe.year.year10
342 leftframe.year.year120
346 set GraphYearPalletImages
{ 10 120 }
350 { {a
} {Residential Zone
} {$100}}
351 { {a
} {Commercial Zone
} {$100}}
352 { {an
} {Industrial Zone
} {$100}}
353 { {a
} {Fire Station
} {$500}}
354 { {a
} {Query
} {free
}}
355 { {a
} {Police Station
} {$500}}
357 { {a
} {Bulldozer
} {$1}}
360 { {a
} {Chalk
} {free
}}
361 { {an
} {Eraser
} {free
}}
362 { {a
} {Stadium
} {$5,000}}
364 { {a
} {Seaport
} {$3,000}}
365 { {a
} {Coal Power Plant
} {$3,000}}
366 { {a
} {Nuclear Power Plant
} {$5,000}}
367 { {an
} {Airport
} {$10,000}}
368 { {a
} {Network
} {$1,000}}
372 set DynamicDataNames
{
383 ########################################################################
385 ########################################################################
388 wm title .
{Micropolis Root
}
391 if {"[sim Platform]" == "msdos"} {
412 # The next three lines have no effect on the OLPC, where we don't provide
413 # the font in res (because it's already in the system fonts). These lines
414 # are for other systems that lack the font.
415 set FontPath
"[pwd]/res/dejavu-lgc"
416 system
"xset -fp \"$FontPath\" >/dev/null 2>&1"
417 system
"xset +fp \"$FontPath\" >/dev/null 2>&1"
419 # Ignore SIGCHLD for spawned sound-player childs, this should lead to them
420 # being reaped by init
421 signal ignore SIGCHLD
424 ########################################################################
426 ########################################################################
429 proc Message
{id color title msg
{props
{}}} {
431 set Messages
($id) [list $color $title $msg $props]
435 Message
1 #7f7fff {DULLSVILLE, USA 1900} \
436 {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.
438 It is your job to attract new growth and development
, turning Dullsville into a Metropolis within
30 years.
}
440 Message
2 #7f7fff {SAN FRANCISCO, CA. 1906} \
441 {Damage from the earthquake was minor compared to that of the ensuing fires
, which took days to control.
1500 people died.
443 Controlling the fires should be your initial concern. Then clear the rubble and start rebuilding. You have
5 years.
}
445 Message
3 #7f7fff {HAMBURG, GERMANY 1944} \
446 {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.
448 You must control the firestorms during the bombing and then rebuild the city
after the war. You have
5 years.
}
450 Message
4 #7f7fff {BERN, SWITZERLAND 1965} \
451 {The roads here are becoming more congested every day
, and the residents are upset. They demand that you do something about it.
453 Some have suggested a mass transit system as the answer
, but this would require major rezoning in the downtown area. You have
10 years.
}
455 Message
5 #7f7fff {TOKYO, JAPAN 1957} \
456 {A large reptilian creature has been spotted heading
for Tokyo bay. It seems to be attracted to the heavy levels of industrial pollution there.
458 Try to control the fires
, then rebuild the industrial center. You have
5 years.
}
460 Message
6 #7f7fff {DETROIT, MI. 1972} \
461 {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.
463 You have
10 years to reduce crime and rebuild the industrial base of the city.
}
465 Message
7 #7f7fff {BOSTON, MA. 2010} \
466 {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.
468 You have
5 years to get the situation under control.
}
470 Message
8 #7f7fff {RIO DE JANEIRO, BRAZIL 2047} \
471 {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.
473 You have
10 years to turn this swamp back into a city again.
}
475 Message
9 #ffa500 {Query Zone Status} \
483 {{view
{PanView
$v $QueryX $QueryY}}}
485 Message
10 #ff4f4f {POLLUTION ALERT!} \
486 {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.
488 Either clean up your act or
open a gas mask concession at city hall.
} \
489 {{view
{PanView
$v [sim PolMaxX
] [sim PolMaxY
]}}}
491 Message
11 #ff4f4f {CRIME ALERT!} \
492 {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.
} \
493 {{view
{PanView
$v [sim CrimeMaxX
] [sim CrimeMaxY
]}}}
495 Message
12 #ff4f4f {TRAFFIC WARNING!} \
496 {Traffic in this city is horrible. The city gridlock is expanding. The commuters are getting militant.
498 Either build more roads and rails or get a bulletproof limo.
} \
499 {{view
{PanView
$v [sim TrafMaxX
] [sim TrafMaxY
]}}}
501 Message
20 #ff4f4f {FIRE REPORTED!} \
502 "A fire has been reported!" \
503 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
505 Message
21 #ff4f4f {MONSTER ATTACK!} \
506 "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. \
507 All you can do is wait till he leaves, then rebuild from the rubble." \
508 {{view
{FollowView
$v monster
}}}
510 # XXX: write more text
511 Message
22 #ff4f4f {TORNADO ALERT!} \
512 {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
!} \
513 {{view
{FollowView
$v tornado
}}}
515 # XXX: write more text
516 Message
23 #ff4f4f {EARTHQUAKE!} \
517 {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.
} \
518 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
520 # XXX: write more text
521 Message
24 #ff4f4f {PLANE CRASH!} \
522 {A plane has crashed
!} \
523 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
525 # XXX: write more text
526 Message
25 #ff4f4f {SHIPWRECK!} \
527 {A ship has wrecked
!} \
528 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
530 # XXX: write more text
531 Message
26 #ff4f4f {TRAIN CRASH!} \
532 {A train has crashed
!} \
533 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
535 # XXX: write more text
536 Message
27 #ff4f4f {HELICOPTER CRASH!} \
537 {A helicopter has crashed
!} \
538 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
540 Message
30 #ff4f4f {FIREBOMBING REPORTED!} \
541 {Firebombs are falling
!!} \
542 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
544 Message
35 #7fff7f {TOWN} \
545 {Congratulations
, your village has grown to town status. You now have
2,000 citizens.
} \
546 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
548 Message
36 #7fff7f {CITY} \
549 {Your town has grown into a full sized city
, with a current population of
10,000. Keep up the good work
!} \
550 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
552 Message
37 #7fff7f {CAPITAL} \
553 {Your city has become a capital. The current population here is
50,000. Your political future looks bright.
} \
554 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
556 Message
38 #7fff7f {METROPOLIS} \
557 {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.
} \
558 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
560 Message
39 #7fff7f {MEGALOPOLIS} \
561 {Congratulation
, you have reached the highest category of urban development
, the megalopolis.
563 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.
} \
564 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
566 Message
40 #7fff7f {MEGALINIUM} \
567 {Congratulation
, you have reached the end of
time!
569 Because of the toroidal nature of the the Micropolis Space
/Time Continuum
, your city has wrapped back in
time to
1900!} \
570 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
572 # XXX: write more text
573 Message
41 #ff4f4f {HEAVY TRAFFIC!} \
575 reporting heavy traffic
!} \
576 {{view
{FollowView
$v helicopter
}}}
578 # XXX: write more text
579 Message
42 #ff4f4f {FLOODING REPORTED!} \
580 {Flooding has been been reported along the water's edge
!} \
581 {{view
{PanView
$v [sim FloodX
] [sim FloodY
]}}}
583 Message
43 #ff4f4f {NUCLEAR MELTDOWN!} \
584 {A nuclear meltdown has occured at your power plant. You are advised to avoid the area until the radioactive isotopes decay.
586 Many generations will confront this problem before it goes away
, so don't hold your breath.
} \
587 {{view
{PanView
$v [sim MeltX
] [sim MeltY
]}}}
590 Message
44 #ff4f4f {RIOTS!} \
591 {The citizens are rioting in the streets
, setting cars and houses on fire
, and bombing government buildings and businesses
!
593 All media coverage is blacked out
, while the fascist pigs beat the poor citizens into submission.
}
595 Message
46 #ff4f4f {NO SOUND SERVER!} \
596 {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.
}
598 Message
48 #7f7fff {Start a New City} \
599 {Build your very own city from the ground up
, starting with this map of uninhabited land.
}
601 Message
49 #7f7fff {Restore a Saved City} \
602 {This city was saved in the
file named
: %s
}
604 Message
100 #7fff7f {YOU'RE A WINNER!} \
605 {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?
} \
606 {{middle
{@images
/key2city.xpm
}}}
608 Message
200 #ff4f4f {IMPEACHMENT NOTICE!} \
609 {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.
611 You should seriously consider taking an extended vacation
-- NOW.
(Or
read the manual and try again.
)}
613 Message
300 #ffd700 {About Micropolis} \
614 "Micropolis Version [sim Version] Copyright (C) 2007
616 Based on the Original Micropolis Concept and Design
618 TCL/Tk User Interface Designed and Created
619 by Don Hopkins, DUX Software.
620 Ported to Linux, Optimized and Adapted for OLPC
622 Licensed under the GNU General Public License,
623 version 3, with additional conditions."
626 ########################################################################
628 ########################################################################
631 option add
*CheckButton.relief flat
632 option add
*Dialog.cursor top_left_arrow
633 option add
*Entry.relief sunken
634 option add
*Frame.borderWidth
0
635 option add
*Listbox.relief sunken
636 option add
*Scrollbar.relief sunken
637 option add
*RadioButton.anchor w
638 option add
*RadioButton.relief flat
640 option add
*background
#b0b0b0
641 option add
*foreground
#000000
642 option add
*activeBackground
#d0d0d0
643 option add
*activeForeground
#000000
644 option add
*disabledForeground
""
645 option add
*selectBackground
#d0d0d0
646 option add
*selectForeground
#000000
647 #option add *selector #ffff80
648 option add
*selector
#bf0000
650 option add
*Scrollbar.Background
#b0b0b0
651 option add
*Scrollbar.Foreground
#d0d0d0
652 option add
*Interval.Background
#b0b0b0
653 option add
*Interval.Foreground
#000000
654 option add
*Interval.activeForeground
#d0d0d0
655 option add
*Interval.sliderForeground
#b0b0b0
656 option add
*Scale.activeForeground
#d0d0d0
657 option add
*Scale.sliderForeground
#b0b0b0
658 option add
*PieMenu.activeBackground
#b0b0b0
660 option add Mwm
*Micropolis.clientDecoration
-maximize
663 ########################################################################
665 ########################################################################
668 bind all
<Help
> {HandleHelp
%W
%x
%y
%X
%Y
}
669 bind all
<Shift-ButtonPress
> {HandleHelp
%W
%x
%y
%X
%Y
}
670 bind all
<Meta-ButtonPress
> {HandleHelp
%W
%x
%y
%X
%Y
}
671 bind all
<Shift-Meta-ButtonPress
> {HandleHelp
%W
%x
%y
%X
%Y
}
674 ########################################################################
676 ########################################################################
695 puts stderr
"$errorInfo"
703 proc NoFunction
{args
} {}
706 proc LinkWindow
{fromname to
} {
708 set WindowLinks
($fromname) $to
712 proc WindowLink
{fromname
} {
715 catch {set to
$WindowLinks($fromname)}
720 proc DeleteWindow
{sym name win
} {
721 set head
[WindowLink
$win.head
]
722 LinkWindow
$head.
$sym {}
724 set wins
[eval ident
"\$$name"]
725 set i
[lsearch $wins $win]
727 set $name [lreplace $wins $i $i]
733 proc Font
{win name
} {
734 global FontInfo FontCache HeadWindows
735 set scr
[winfo screen
$win]
738 set font $FontCache($scr,$name)
743 set label $FontCache($scr)
745 if {"$label" == ""} {
746 foreach head
$HeadWindows {
747 if {"[winfo screen $head]" == "$scr"} {
748 set label $head.fontlabel
749 label $label -text "X11 Sucks" -font fixed
750 set FontCache
($scr) $label
755 set fonts
[keylget FontInfo
$name]
756 foreach font $fonts {
757 #echo "Configuring font $font on $label"
758 if {[catch "$label config -font \"$font\""] == 0} {
771 set FontCache
($scr,$name) $font
777 proc Color
{win color mono
} {
778 if {[winfo screendepth
$win] == 1} {
786 ########################################################################
787 # Window Definition Functions
788 ########################################################################
791 proc MakeWindow.head
{{display
":0"}} {
793 source $ResourceDir/whead.tcl
798 proc MakeWindow.editor
{head
{display
":0"}} {
800 source $ResourceDir/weditor.tcl
805 proc MakeWindow.map
{head
{display
":0"}} {
807 source $ResourceDir/wmap.tcl
812 proc MakeWindow.graph
{head
{display
":0"}} {
814 source $ResourceDir/wgraph.tcl
819 proc MakeWindow.budget
{head
{display
":0"}} {
821 source $ResourceDir/wbudget.tcl
826 proc MakeWindow.evaluation
{head
{display
":0"}} {
828 source $ResourceDir/weval.tcl
833 proc MakeWindow.splash
{head
{display
":0"}} {
835 source $ResourceDir/wsplash.tcl
840 proc MakeWindow.scenario
{head
{display
":0"}} {
842 source $ResourceDir/wscen.tcl
847 proc MakeWindow.
file {head
{display
":0"}} {
849 source $ResourceDir/wfile.tcl
854 proc MakeWindow.ask
{head
{display
":0"}} {
856 source $ResourceDir/wask.tcl
861 proc MakeWindow.player
{head
{display
":0"}} {
863 source $ResourceDir/wplayer.tcl
868 proc MakeWindow.notice
{head
{display
":0"}} {
870 source $ResourceDir/wnotice.tcl
874 proc MakeWindow.help
{head
{display
":0"}} {
876 source $ResourceDir/whelp.tcl
880 proc MakeWindow.frob
{head
{display
":0"}} {
882 source $ResourceDir/wfrob.tcl
887 ########################################################################
889 ########################################################################
892 proc UIInitializeSound
{} {
896 proc UIShutDownSound
{} {
900 proc UIDoSoundOn
{win cmd
} {
901 global Sound SoundServers
903 set win
[WindowLink
[winfo toplevel $win].head
]
904 if {[lsearch $SoundServers $win] != -1} {
905 set cmd
"send -quick -server $win Sound sound $cmd"
907 # XXX: Lost a sound server...
915 proc UIDoSound
{cmd
} {
916 global Sound SoundServers
918 foreach win
$SoundServers {
919 set foo
"send -quick -server $win Sound $cmd"
921 # XXX: Lost a sound server...
929 proc KillSoundServers
{} {
931 foreach win
$SoundServers {
932 set foo
"send -quick -server $win Sound KillSoundServer"
939 proc UISetChannelVolume
{win chan vol
} {
940 UIDoSoundOn
$win "channel $chan -volume $vol"
944 proc EchoPlaySound
{soundspec
} {
948 proc UIMakeSoundOn
{win chan sound
{opts
""}} {
949 playsound
$chan $sound $opts
953 proc UIStartSoundOn
{win chan sound
{opts
""}} {
954 # Send message to Python to play sound.
957 #UIDoSoundOn $win "play $sound -replay -channel $chan -repeat 100 $opts"
961 proc UIMakeSound
{chan sound
{opts
""}} {
962 playsound
$chan $sound $opts
966 proc UIStartSound
{chan sound
{opts
""}} {
967 # Send message to Python to play sound.
970 #UIDoSound "sound play $sound -channel $chan -repeat 100 $opts"
974 proc SetupSoundServer
{win
} {
979 proc AddSoundServer
{win
} {
981 set i
[lsearch $SoundServers $win]
983 set SoundServers
[linsert $SoundServers 0 $win]
988 proc LostSoundServer
{win
} {
989 DeleteSoundServer
$win
990 # UIShowPictureOn [WindowLink $win.head] 46 [winfo screen $win]
994 proc DeleteSoundServer
{win
} {
996 set i
[lsearch $SoundServers $win]
998 set SoundServers
[lreplace $SoundServers $i $i]
1003 proc UISoundOff
{} {
1007 proc MonsterSpeed
{} {
1008 return [expr "[sim Rand 40] + 70"]
1012 proc ExplosionPitch
{} {
1013 return [expr "[sim Rand 20] + 90"]
1018 return [expr "[sim Rand 20] + 90"]
1022 ########################################################################
1023 # Global Window Handlers
1026 proc WithdrawAll
{} {
1044 proc ShowInitial
{} {
1052 ########################################################################
1053 # Head Window Handlers
1056 proc PrepHead
{head
} {
1063 WithdrawHeadOf
$head
1067 after 1000 "WithdrawSplashOf $head"
1068 WithdrawHeadOf
$head
1069 ShowScenarioOf
$head
1073 WithdrawSplashOf
$head
1074 WithdrawScenarioOf
$head
1079 ReShowPictureOn
$head
1087 proc ShowHeadOf
{head
} {
1092 proc WithdrawHeadOf
{head
} {
1099 foreach win
$HeadWindows {
1105 proc WithdrawHeads
{} {
1107 foreach win
$HeadWindows {
1113 proc DeleteHeadWindow
{head
} {
1120 foreach win
$HeadWindows {
1126 proc InitHead
{win
} {
1127 set w
[WindowLink
$win.
text]
1128 $w configure
-state normal
1131 $w configure
-state disabled
1133 if {[sim MultiPlayerMode
]} {
1134 set w
[WindowLink
$win.
entry]
1145 proc InitAllHeadMenus
{} {
1148 foreach win
$HeadWindows {
1154 proc InitHeadMenus
{win
} {
1156 set m0
[WindowLink
$win.m0
]
1157 set m1
[WindowLink
$win.m1
]
1158 set m2
[WindowLink
$win.m2
]
1159 set m3
[WindowLink
$win.m3
]
1160 set m4
[WindowLink
$win.m4
]
1161 set b0
[WindowLink
$win.b0
]
1162 set b1
[WindowLink
$win.b1
]
1163 set b2
[WindowLink
$win.b2
]
1164 set b3
[WindowLink
$win.b3
]
1165 set b4
[WindowLink
$win.b4
]
1179 # When in multi player mode there is an extra menu
1180 # item to add another player, before the quit item,
1181 # so compensate for it here.
1182 if {[sim MultiPlayerMode
]} {
1187 $b0 config
-state normal
1188 $b2 config
-state disabled
1189 $b4 config
-state disabled
1194 # When in multi player mode there is an extra menu
1195 # item to add another player, before the quit item,
1196 # so compensate for it here.
1197 if {[sim MultiPlayerMode
]} {
1202 $b0 config
-state normal
1203 $b2 config
-state normal
1204 $b4 config
-state normal
1210 proc UIDisaster
{win cmd action
} {
1211 AskQuestion
[Color
$win #ff0000 #ffffff] "Cause a Disaster" \
1212 "Oh no! Do you really want to $action" \
1213 "{No way!} Disaster.No {WithdrawAsks}" \
1215 "{I guess so.} Disaster.Yes {WithdrawAsks ; $cmd}"
1219 proc CrushHead
{head
} {
1220 global SubWindows VoteNames
1222 foreach foo
$VoteNames {
1224 set votes
[eval ident
\$VotesFor$foo]
1225 set i
[lsearch $votes $head]
1227 set VotesFor
$foo [lreplace $votes $i $i]
1231 foreach foo
$SubWindows {
1232 set sym
[lindex $foo 0]
1233 set name
[lindex $foo 1]
1235 set wins
[eval ident
"\$$name"]
1237 if {[WindowLink
$win.head
] == $head} {
1238 DeleteWindow
$sym $name $win
1245 proc ChatDown
{win
} {
1267 global ChatConnection
1269 DoSendMessage
"Opening Connection to Chat Server $ChatServer socket $ChatSocket ..." status
1271 set ChatConnection
{}
1273 set ChatConnection
[connect
$ChatServer $ChatSocket]
1276 if {$ChatConnection == {}} then
{
1277 DoSendMessage
"Sorry, I could not open a connection to chat server $ChatServer socket $ChatSocket." status
1280 filehandler
$ChatConnection r
"ReceiveChat"
1291 puts $ChatConnection "USER $UserName $HostName $ServerName $RealName\r\n" nonewline
1292 puts $ChatConnection "NICK $NickName\r\n" nonewline
1293 puts $ChatConnection "JOIN $ChannelName\r\n" nonewline
1294 flush $ChatConnection
1299 proc ReceiveChat
{mode f
} {
1300 # DoSendMessage "ReceiveChat: MODE $mode F $f"
1304 if {[string first
{:} $msg]} {
1308 set from
[lindex $msg 0]
1309 set cmd
[string tolower
[lindex $msg 1]]
1313 if {($cmd == "privmsg") ||
1314 ($cmd == "notice")} then
{
1316 set chan
[lindex $msg 2]
1317 set i
[expr "[string length $from] + 1 + [string length $cmd] + 1 + [string length $chan] + 2"]
1318 set j
[expr "[string length $msg] - 2"]
1319 set line
[string range
$msg $i $j]
1320 set chan
[string range
$chan 1 [string length
$chan]]
1321 set from
[string range
$from 1 [expr "[string length $from] - 1"]]
1322 set from
[split $from {!}]
1323 set from
[lindex $from 0]
1324 DoSendMessage
"$from> $line"
1327 if {$handled == 0} {
1328 set msg
[string range
$msg \
1329 [expr "[string length $from] + 1"] \
1330 [expr "[string length $msg] - 2"]]
1336 proc SendChatMessage
{msg win
} {
1337 global ChatConnection ChannelName NickName
1343 if {[string range
$msg 0 0] == "/"} {
1344 set cmd
[string range
$msg 1 [string length
$msg]]
1345 DoSendMessage
"$NickName> \[$cmd\]"
1348 set cmd
"PRIVMSG $ChannelName :$msg\r\n"
1349 DoSendMessage
"$NickName> $msg"
1356 puts $ChatConnection $cmd nonewline
1357 flush $ChatConnection
1362 DoSendMessage
"IRC Broke the connection"
1372 global ChatConnection
1374 DoSendMessage
"Closing Connection to Chat Server." status
1377 puts $ChatConnection "QUIT\r\n" nonewline
1378 flush $ChatConnection
1379 $ChatConnection close
1382 set ChatConnection
{}
1387 proc DoEnterMessage
{win var
} {
1390 set msg
[eval ident
"\$\{$var\}"]
1392 if {$Chatting} then
{
1393 SendChatMessage
$msg $win
1401 proc DoEvalMessage
{win var
} {
1403 set command
[eval ident
"\$\{$var\}"]
1405 DoSendMessage
"Evaluating TCL: $command"
1406 catch {uplevel #0 $command} result
1407 DoSendMessage
"Result: $result"
1411 proc DoSendMessage
{msg
{tag
message}} {
1413 foreach win
$HeadWindows {
1414 appendWithTag
[WindowLink
$win.
text] $tag "$msg"
1419 proc UISetMessage
{msg
{tag status
}} {
1420 global DoMessages EditorWindows HeadWindows
1422 if {$DoMessages == 0} {
1426 foreach win
$EditorWindows {
1427 [WindowLink
$win.
message] configure
-text "$msg"
1430 foreach win
$HeadWindows {
1431 appendWithTag
[WindowLink
$win.
text] $tag "$msg"
1438 proc appendWithTag
{w tag
text} {
1442 set start
[$w index end
]
1443 $w configure
-state normal
1444 if {$start > $MaxLines} then
{
1445 $w delete
0.0 $ShrinkLines.0
1446 set start
[$w index end
]
1448 $w insert end
"${text}\n"
1449 $w tag add
$tag $start {end
- 1 char
}
1450 $w configure
-state disabled
1451 $w yview
-pickplace {end
- 1 char
}
1455 ########################################################################
1456 # Budget Window Handlers
1459 proc ShowBudgetOf
{head
} {
1460 set win
[WindowLink
$head.budget
]
1462 set win
[MakeWindow.budget
$head [winfo screen
$head]]
1471 proc ShowBudgets
{} {
1472 global HeadWindows BudgetsVisible
1473 set BudgetsVisible
1
1474 foreach win
$HeadWindows {
1480 proc WithdrawBudgets
{} {
1481 global BudgetWindows BudgetsVisible
1482 foreach win
$BudgetWindows {
1486 set BudgetsVisible
0
1490 proc BudgetContinue
{{win
""}} {
1491 global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1493 if {([sim RoadFund
] != $BudgetRoadFund) ||
1494 ([sim FireFund
] != $BudgetFireFund) ||
1495 ([sim PoliceFund
] != $BudgetPoliceFund) ||
1496 ([sim TaxRate
] != $BudgetTaxRate)} {
1497 UISetMessage
"The budget was changed."
1499 UISetMessage
"The budget wasn't changed."
1507 proc BudgetReset
{{win
""}} {
1508 global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1509 if {([sim RoadFund
] != $BudgetRoadFund) ||
1510 ([sim FireFund
] != $BudgetFireFund) ||
1511 ([sim PoliceFund
] != $BudgetPoliceFund) ||
1512 ([sim TaxRate
] != $BudgetTaxRate)} {
1513 UISetMessage
"The budget was reset."
1514 if {[sim Players
] > 1} {
1515 UIMakeSound edit Sorry
1518 UISetMessage
"The budget was reset."
1520 sim RoadFund
$BudgetRoadFund
1521 sim FireFund
$BudgetFireFund
1522 sim PoliceFund
$BudgetPoliceFund
1523 sim TaxRate
$BudgetTaxRate
1529 proc BudgetCancel
{{win
""}} {
1537 proc SetTaxRate
{rate
} {
1542 proc BudgetSetTaxRate
{rate
} {
1548 proc BudgetSetRoadFund
{percent
} {
1549 sim RoadFund
$percent
1554 proc BudgetSetFireFund
{percent
} {
1555 sim FireFund
$percent
1560 proc BudgetSetPoliceFund
{percent
} {
1561 sim PoliceFund
$percent
1566 proc UIShowBudgetAndWait
{} {
1567 global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1568 if {$OldBudget == 0} {
1569 set BudgetRoadFund
[sim RoadFund
]
1570 set BudgetFireFund
[sim FireFund
]
1571 set BudgetPoliceFund
[sim PoliceFund
]
1572 set BudgetTaxRate
[sim TaxRate
]
1576 UISetMessage
"Pausing to set the budget ..."
1582 sim UpdateBudgetWindow
1586 proc ToggleBudgetTimer
{} {
1587 global BudgetTimerActive
1588 if {$BudgetTimerActive} {
1596 proc StopBudgetTimer
{} {
1597 global BudgetTimerActive
1598 set BudgetTimerActive
0
1603 proc StartBudgetTimer
{} {
1604 global BudgetTimerActive BudgetTimer BudgetTimeout
1606 set BudgetTimerActive
$me
1607 set BudgetTimer
$BudgetTimeout
1609 after 1000 TickBudgetTimer
$me
1613 proc RestartBudgetTimer
{} {
1614 global BudgetTimerActive
1615 if {$BudgetTimerActive} {
1622 proc UpdateBudgetTimer
{} {
1623 global BudgetWindows BudgetTimerActive BudgetTimer
1624 if {$BudgetTimerActive} {
1625 set text [format "Auto Cancel In %d Seconds (click to disable)" $BudgetTimer]
1627 set text [format "Enable Auto Cancel (currently disabled)"]
1629 foreach win
$BudgetWindows {
1630 set t
[WindowLink
$win.timer
]
1631 $t config
-text "$text"
1636 proc TickBudgetTimer
{me
} {
1637 global BudgetTimerActive BudgetTimer BudgetTimeout
1638 if {$BudgetTimerActive == $me} {
1640 if {$BudgetTimer < 0} {
1646 after 1000 TickBudgetTimer
$me
1652 proc FireBudgetTimer
{} {
1662 proc ToggleAutoBudget
{} {
1665 #echo "ToggleAutoBudget found on, clearing"
1668 #echo "ToggleAutoBudget found off, setting"
1674 proc UIUpdateBudget
{} {
1679 proc UpdateAutoBudget
{} {
1680 global BudgetWindows AutoBudget
1681 if {[sim AutoBudget
]} {
1682 set text "Disable Auto Budget (currently enabled)"
1684 set text "Enable Auto Budget (currently disabled)"
1686 #echo "UpdateAutoBudget $AutoBudget $text"
1687 foreach win
$BudgetWindows {
1688 set t
[WindowLink
$win.autobudget
]
1689 $t config
-text "$text"
1694 proc UISetBudget
{cashflow previous current collected taxrate
} {
1695 global BudgetWindows BudgetsVisible
1697 #echo "UISetBudgetValues $taxrate $BudgetsVisible"
1699 if {$BudgetsVisible} {
1701 foreach win
$BudgetWindows {
1702 set w
[WindowLink
$win.cashflow
]
1703 set old
[lindex [$w configure
-text] 4]
1704 if {$old != $cashflow} {
1705 $w configure
-text $cashflow
1707 set w
[WindowLink
$win.previous
]
1708 set old
[lindex [$w configure
-text] 4]
1709 if {$old != $previous} {
1710 $w configure
-text $previous
1712 set w
[WindowLink
$win.current
]
1713 set old
[lindex [$w configure
-text] 4]
1714 if {$old != $current} {
1715 $w configure
-text $current
1717 set w
[WindowLink
$win.collected
]
1718 set old
[lindex [$w configure
-text] 4]
1719 if {$old != $collected} {
1720 $w configure
-text $collected
1723 set w
[WindowLink
$win.taxrate
]
1725 if {$old != $taxrate} {
1729 set w
[WindowLink
$win.taxlabel
]
1730 set old
[lindex [$w configure
-text] 4]
1733 $w configure
-text $new
1739 foreach win
$HeadWindows {
1741 set w
[WindowLink
$win.taxrate
]
1743 if {$old != $taxrate} {
1744 # FIXME: this might not work if the slider is disabled in multi player mode.
1748 set w
[WindowLink
$win.taxlabel
]
1749 set old
[lindex [$w configure
-text] 4]
1750 set new
"Tax Rate: $taxrate%"
1752 $w configure
-text $new
1758 proc UISetBudgetValues
{roadgot roadwant roadpercent policegot policewant policepercent firegot firewant firepercent
} {
1759 global BudgetWindows BudgetsVisible
1761 if {$BudgetsVisible == 0} {
1765 foreach win
$BudgetWindows {
1766 set w
[WindowLink
$win.fire
].request
1767 set old
[lindex [$w configure
-text] 4]
1768 set new
"$firepercent% of $firewant = $firegot"
1770 $w configure
-text $new
1772 set w
[WindowLink
$win.fire
].fund
1774 if {$old != $firepercent} {
1778 set w
[WindowLink
$win.police
].request
1779 set old
[lindex [$w configure
-text] 4]
1780 set new
"$policepercent% of $policewant = $policegot"
1782 $w configure
-text $new
1784 set w
[WindowLink
$win.police
].fund
1786 if {$old != $policepercent} {
1787 $w set $policepercent
1790 set w
[WindowLink
$win.road
].request
1791 set old
[lindex [$w configure
-text] 4]
1792 set new
"$roadpercent% of $roadwant = $roadgot"
1794 $w configure
-text $new
1796 set w
[WindowLink
$win.road
].fund
1798 if {$old != $roadpercent} {
1805 proc ChangeBudget
{} {
1806 global VotesForBudget
1807 if {"$VotesForBudget" != ""} {
1814 proc InitVotesForBudget
{} {
1815 global VotesForBudget BudgetWindows
1816 set VotesForBudget
{}
1817 foreach win
$BudgetWindows {
1818 [WindowLink
$win.vote
] config
-relief raised
1820 UpdateVotesForBudget
1824 proc UpdateVotesForBudget
{} {
1825 global BudgetWindows
1826 UpdateVotesFor Budget
$BudgetWindows
1830 proc UpdateTaxRateSliders
{} {
1832 set players
[sim Players
]
1833 foreach win
$HeadWindows {
1834 set slider
[WindowLink
$win.taxrate
]
1835 #echo "UpdateTaxRateSliders players $players win $win slider $slider"
1836 if {$players == 1} {
1837 $slider configure
-state normal
1839 $slider configure
-state disabled
1845 ########################################################################
1846 # Evaluation Window Handlers
1849 proc ToggleEvaluationOf
{head
} {
1851 if {"$State" != "play"} {
1856 set win
[WindowLink
$head.evaluation
]
1858 set mapped
[winfo ismapped
$win]
1862 WithdrawEvaluationOf
$head
1864 ShowEvaluationOf
$head
1870 proc WithdrawEvaluationOf
{head
} {
1871 set win
[WindowLink
$head.evaluation
]
1878 proc ShowEvaluationOf
{head
} {
1879 set win
[WindowLink
$head.evaluation
]
1881 set win
[MakeWindow.evaluation
$head [winfo screen
$head]]
1885 set parent
[WindowLink
$win.parent
]
1886 #pack append [WindowLink $head.col2]\
1887 # $parent {top frame nw fill}
1888 pack append $parent\
1889 $win {top
frame nw fillx
}
1891 sim UpdateEvaluation
1895 proc WithdrawEvaluations
{} {
1896 global EvaluationWindows EvaluationsVisible
1897 foreach win
$EvaluationWindows {
1899 #set parent [WindowLink $win.parent]
1900 #pack unpack $parent
1903 set EvaluationsVisible
0
1907 proc EvaluationVisible
{w v
} {
1908 global EvaluationsVisible
1909 global [set var
$w.visible
]
1914 set EvaluationsVisible
[expr "$EvaluationsVisible + 1"]
1916 set EvaluationsVisible
[expr "$EvaluationsVisible - 1"]
1921 proc UISetEvaluation
{changed score ps0 ps1 ps2 ps3 pv0 pv1 pv2 pv3 pop delta assessed cityclass citylevel goodyes goodno title
} {
1922 global EvaluationWindows EvaluationsVisible CurrentDate
1924 set class
[string tolower
$cityclass]
1925 UISetMessage
"$CurrentDate: Score $score, $class population $pop."
1927 if {$EvaluationsVisible} {
1929 foreach win
$EvaluationWindows {
1931 global [set var
$win.visible
]
1932 set visible
[eval ident
"\$\{$var\}"]
1936 # TODO: set evaluation window and icon title
1937 #wm title $win "$title"
1938 #wm iconname $win "$title"
1940 set w
[WindowLink
$win.goodjob
]
1941 set old
[lindex [$w configure
-text] 4]
1942 set new
"$goodyes\n$goodno"
1944 $w configure
-text $new
1947 set w
[WindowLink
$win.problemnames
]
1948 set old
[lindex [$w configure
-text] 4]
1949 set new
"$ps0\n$ps1\n$ps2\n$ps3"
1951 $w configure
-text $new
1954 set w
[WindowLink
$win.problempercents
]
1955 set old
[lindex [$w configure
-text] 4]
1956 set new
"$pv0\n$pv1\n$pv2\n$pv3"
1958 $w configure
-text $new
1961 set w
[WindowLink
$win.stats
]
1962 set old
[lindex [$w configure
-text] 4]
1963 set new
"$pop\n$delta\n\n$assessed\n$cityclass\n$citylevel"
1965 $w configure
-text $new
1968 set w
[WindowLink
$win.score
]
1969 set old
[lindex [$w configure
-text] 4]
1970 set new
"$score\n$changed"
1972 $w configure
-text $new
1980 ########################################################################
1981 # File Window Handlers
1984 proc ShowFileOf
{head
} {
1985 set win
[WindowLink
$head.
file]
1987 set win
[MakeWindow.
file $head [winfo screen
$head]]
1997 foreach win
$HeadWindows {
2003 proc WithdrawFiles
{} {
2005 foreach win
$FileWindows {
2011 proc DoFileDialog
{win Message Path Pattern FileName ActionOk ActionCancel
} {
2012 ShowFileDialog
$win "$Path" "$Pattern"
2013 $win.message1 configure
-text "$Message"
2014 $win.path.path delete
0 end
2015 $win.path.path insert
0 $Path
2016 $win.
file.
file delete
0 end
2017 $win.
file.
file insert
0 "$FileName"
2018 $win.frame1.ok config
-command "
2019 $ActionOk \[$win.file.file get\] \[$win.path.path get\]
2021 $win.frame1.rescan config
-command "
2022 ShowFileDialog $win \[$win.path.path get\] $Pattern"
2023 $win.frame1.cancel config
-command "
2026 bind $win.files.files
"<Double-Button-1>" "\
2027 FileSelectDouble $win %W %y $Pattern \"
2028 $ActionOk {\[$win.file.file get\]} {\[$win.path.path get\]}\""
2029 bind $win.path.path
<Return
> "
2030 ShowFileDialog $win \[$win.path.path get\] $Pattern
2031 $win.file.file cursor 0
2032 focus $win.file.file"
2033 bind $win.
file.
file <Return
> "\
2034 $ActionOk \[$win.file.file get\] \[$win.path.path get\]
2039 proc BindSelectOne
{win Y
} {
2040 set Nearest
[$win nearest
$Y]
2041 if {$Nearest >= 0} {
2042 $win select from
$Nearest
2043 $win select to
$Nearest
2048 proc FileSelect
{win widget Y
} {
2049 BindSelectOne
$widget $Y
2050 set Nearest
[$widget nearest
$Y]
2051 if {$Nearest >= 0} {
2052 set Path
[$win.path.path get
]
2053 set TmpEntry
[$widget get
$Nearest]
2054 if {[string compare
"/" [string index
$TmpEntry \
2055 [expr [string length
$TmpEntry]-1]]] == 0 ||
\
2056 [string compare
"@" [string index
$TmpEntry \
2057 [expr [string length
$TmpEntry]-1]]] == 0} {
2058 # handle directories, and symbolic links to directories
2059 set FileName
[string range
$TmpEntry 0 \
2060 [expr [string length
$TmpEntry]-2]]
2061 # whoops / or @ is part of the name
2062 if {[MiscIsDir
$Path/$FileName] != 1} {
2063 set FileName
$TmpEntry
2066 if {[string compare
"*" [string index
$TmpEntry \
2067 [expr [string length
$TmpEntry]-1]]] == 0} {
2068 # handle executable filenames
2069 set FileName
[string range
$TmpEntry 0 \
2070 [expr [string length
$TmpEntry]-2]]
2071 # whoops * is part of the name
2072 if {[file executable
$Path/$FileName] != 1} {
2073 set FileName
$TmpEntry
2076 # a ordinary filename
2077 set FileName
$TmpEntry
2080 # enter the selected filename into the filename field
2081 if {[MiscIsDir
$Path/$FileName] != 1} {
2082 $win.
file.
file delete
0 end
2083 $win.
file.
file insert
0 $FileName
2089 proc FileSelectDouble
{win widget Y Pattern Action
} {
2090 BindSelectOne
$widget $Y
2091 set Nearest
[$widget nearest
$Y]
2092 if {$Nearest >= 0} {
2093 set Path
[$win.path.path get
]
2094 set TmpEntry
[$widget get
$Nearest]
2095 if {[string compare
$TmpEntry "../"] == 0} {
2096 # go up one directory
2098 [string trimright
[string trimright
[string trim
$Path] /] @]
2099 if {[string length
$TmpEntry] <= 0} {
2102 set Path
[file dirname
$TmpEntry]
2103 $win.path.path delete
0 end
2104 $win.path.path insert
0 $Path
2105 ShowFileDialog
$win $Path $Pattern
2107 if {[string compare
"/" [string index
$TmpEntry \
2108 [expr [string length
$TmpEntry]-1]]] == 0 ||
\
2109 [string compare
"@" [string index
$TmpEntry \
2110 [expr [string length
$TmpEntry]-1]]] == 0} {
2111 # handle directorys, and symbolic links to directorys
2112 set FileName
[string range
$TmpEntry 0 \
2113 [expr [string length
$TmpEntry]-2]]
2114 # whoops / or @ is part of the name
2115 if {[MiscIsDir
$Path/$FileName] != 1} {
2116 set FileName
$TmpEntry
2119 if {[string compare
"*" [string index
$TmpEntry \
2120 [expr [string length
$TmpEntry]-1]]] == 0} {
2121 # handle executable filenames
2122 set FileName
[string range
$TmpEntry 0 \
2123 [expr [string length
$TmpEntry]-2]]
2124 # whoops * is part of the name
2125 if {[file executable
$Path/$FileName] != 1} {
2126 set FileName
$TmpEntry
2129 # a ordinary filename
2130 set FileName
$TmpEntry
2134 if {[MiscIsDir
$Path/$FileName] == 1} {
2135 if {[string compare
"/" [string index
$Path \
2136 [expr [string length
$Path]-1]]] == 0} {
2137 append Path
$FileName
2139 append Path
/ $FileName
2141 $win.path.path delete
0 end
2142 $win.path.path insert
0 $Path
2143 ShowFileDialog
$win $Path $Pattern
2145 # enter the selected filename into the filename field
2146 $win.
file.
file delete
0 end
2147 $win.
file.
file insert
0 "$FileName"
2148 if {[string length
$Action] > 0} {
2158 proc NameComplete
{win Type
} {
2163 if {[string compare
$Type path
] == 0} {
2164 set DirName
[file dirname
[$win.path.path get
]]
2165 set FileName
[file tail
[$win.path.path get
]]
2167 set DirName
[file dirname
[$win.path.path get
]/]
2168 set FileName
[file tail
[$win.
file.
file get
]]
2172 if {[MiscIsDir
$DirName] == 1} {
2173 catch "exec ls $DirName/" Result
2175 set ListLength
[llength $Result]
2177 while {$Counter < $ListLength} {
2178 if {[string length
$FileName] == 0} {
2179 if {$FoundCounter == 0} {
2180 set NewFile
[lindex $Result $Counter]
2183 set TmpFile1
$NewFile
2184 set TmpFile2
[lindex $Result $Counter]
2185 set Length1
[string length
$TmpFile1]
2186 set Length2
[string length
$TmpFile2]
2188 if {$Length1 > $Length2} {
2189 set Length1
$Length2
2191 while {$Counter1 < $Length1} {
2192 if {[string compare
[string index
$TmpFile1 $Counter1] \
2193 [string index
$TmpFile2 $Counter1]] == 0} {
2194 append NewFile
[string index
$TmpFile1 $Counter1]
2203 if {[regexp "^$FileName" [lindex $Result $Counter] \
2205 if {$FoundCounter == 0} {
2206 set NewFile
[lindex $Result $Counter]
2209 set TmpFile1
$NewFile
2210 set TmpFile2
[lindex $Result $Counter]
2211 set Length1
[string length
$TmpFile1]
2212 set Length2
[string length
$TmpFile2]
2214 if {$Length1 > $Length2} {
2215 set Length1
$Length2
2217 while {$Counter1 < $Length1} {
2218 if {[string compare
[string index
$TmpFile1 $Counter1] \
2219 [string index
$TmpFile2 $Counter1]] == 0} {
2220 append NewFile
[string index
$TmpFile1 $Counter1]
2234 if {$FoundCounter == 1} {
2235 if {[MiscIsDir
$DirName/$NewFile] == 1} {
2236 if {[string compare
$DirName "/"] == 0} {
2237 $win.path.path delete
0 end
2238 $win.path.path insert
0 "/[string trim [string trim $NewFile /] @]/"
2240 $win.path.path delete
0 end
2241 $win.path.path insert
0 "[string trimright $DirName /]/[string trim [string trim $NewFile /] @]/"
2244 $win.path.path delete
0 end
2245 $win.path.path insert
0 \
2246 "[string trim [string trimright $DirName /] @]/"
2247 $win.
file.
file delete
0 end
2248 $win.
file.
file insert
0 "$NewFile"
2251 if {[MiscIsDir
$DirName/$NewFile] == 1 ||
2252 [string compare
$Type path
] == 0} {
2253 $win.path.path delete
0 end
2254 $win.path.path insert
0 \
2255 "[string trimright $DirName /]/[string trim [string trim $NewFile /] @]"
2257 $win.path.path delete
0 end
2258 $win.path.path insert
0 "$DirName"
2259 if {[string length
$NewFile] > 0} {
2260 $win.
file.
file delete
0 end
2261 $win.
file.
file insert
0 "$NewFile"
2268 proc ShowFileDialog
{win Path Pattern
} {
2270 #set Path [lindex [split $Path] 0]
2271 if {[$win.files.files size
] > 0} {
2272 $win.files.files delete
0 end
2275 if {[catch "exec ls -F \"$Path\"" Result
]} {
2278 if {[string match
$Result "* not found"]} {
2281 set ElementList
[lsort [split $Result "\n"]]
2284 if {[string compare
$Path "/"]} {
2285 $win.files.files insert end
"../"
2289 foreach Counter
$ElementList {
2291 if {[string match
$Pattern $Counter] == 1} {
2292 if {[string compare
$Counter "../"] &&
2293 [string compare
$Counter "./"]} {
2294 $win.files.files insert end
$Counter
2297 set fn
$Path/[string trim
[string trim
[string trim
$Counter /] @] *]
2298 if {[MiscIsDir
$fn]} {
2299 $win.files.files insert end
$Counter
2307 proc MiscIsDir
{PathName
} {
2309 if {[file isdirectory
$PathName] == 1} {
2312 catch "file type $PathName" Type
2313 if {[string compare
$Type link
] == 0} {
2314 set LinkName
[file readlink
$PathName]
2315 catch "file type $LinkName" Type
2316 while {[string compare
$Type link
] == 0} {
2317 set LinkName
[file readlink
$LinkName]
2319 return [file isdirectory
$LinkName]
2326 proc busy
{win cmds
} {
2328 set list [winfo children
$win]
2330 while {$list != ""} {
2333 set class
[winfo class
$w]
2334 set cursor
[lindex [$w config
-cursor] 4]
2335 if {[winfo toplevel $w] == $w} {
2336 lappend busy
[list $w $cursor]
2338 set next
[concat $next [winfo children
$w]]
2344 catch {[lindex $w 0] config
-cursor watch
}
2349 set error [catch {uplevel eval [list $cmds]} result
]
2352 catch {[lindex $w 0] config
-cursor [lindex $w 1]}
2363 ########################################################################
2364 # Editor Window Handlers
2366 proc ShowEditorOf
{head
} {
2367 global EditorWindows
2369 foreach win
$EditorWindows {
2370 if {[WindowLink
$win.head
] == $head} {
2371 set parent
[WindowLink
$win.parent
]
2372 #pack append [WindowLink $head.col2]\
2373 # $parent {top frame nw expand fill}
2374 pack append $parent\
2375 $win {top
frame nw expand fill
}
2389 proc NewEditorOf
{head
} {
2390 set win
[MakeWindow.editor
$head [winfo screen
$head]]
2392 set parent
[WindowLink
$win.parent
]
2393 pack append $parent\
2394 $win {top
frame nw expand fill
}
2401 proc ShowEditors
{} {
2403 foreach win
$HeadWindows {
2409 proc WithdrawEditors
{} {
2410 global EditorWindows
2411 foreach win
$EditorWindows {
2412 #set parent [WindowLink $win.parent]
2413 #pack unpack $parent
2419 proc InitEditors
{} {
2420 global EditorWindows
2421 foreach win
$EditorWindows {
2427 proc InitEditor
{win
} {
2428 set e
[WindowLink
$win.view
]
2429 UISetToolState
$win 7
2434 global $e.TrackState
2435 set $e.TrackState
{}
2439 proc SetEditorAutoGoto
{win val
} {
2440 global AutoGoto.
$win
2441 set AutoGoto.
$win $val
2442 set e
[WindowLink
$win.view
]
2447 proc SetEditorControls
{win val
} {
2448 global Controls.
$win
2449 set Controls.
$win $val
2451 pack append $win $win.leftframe
{left
frame center filly
}
2453 pack unpack
$win.leftframe
2458 proc SetEditorOverlay
{win val
} {
2460 set Overlay.
$win $val
2461 set e
[WindowLink
$win.view
]
2466 proc SetEditorDynamicFilter
{win val
} {
2467 global DynamicFilter.
$win
2468 set DynamicFilter.
$win $val
2469 set e
[WindowLink
$win.view
]
2470 $e DynamicFilter
$val
2471 if {$val == 1} then
{
2472 ShowFrobOf
[WindowLink
$win.head
]
2477 proc SetEditorSkip
{win val
} {
2478 set e
[WindowLink
$win.view
]
2483 proc EditorToolDown
{mod w x y
} {
2484 global [set var
$w.TrackState
]
2488 case
[$w ToolState
] in
\
2490 UIMakeSoundOn
$w edit Rumble
"-repeat 4"
2498 set $var [list constrain_start
$x $y]
2499 $w ToolConstrain
$x $y
2504 EditorTool ToolDown
$w $x $y
2509 proc EditorToolDrag
{w x y
} {
2510 EditorTool ToolDrag
$w $x $y
2515 proc EditorToolUp
{w x y
} {
2516 global [set var
$w.TrackState
]
2519 case
[$w ToolState
] in
\
2527 EditorTool ToolUp
$w $x $y
2529 $w ToolConstrain
-1 -1
2536 proc EditorTool
{action w x y
} {
2537 global [set var
$w.TrackState
]
2538 set state
[eval ident
"\$\{$var\}"]
2539 case
[lindex $state 0] in
\
2541 set x0
[lindex $state 1]
2542 set y0
[lindex $state 2]
2543 set dx
[expr "$x - $x0"]
2544 set dy
[expr "$y - $y0"]
2545 if [expr "($dx > 16) || ($dx < -16)"] then
{
2546 $w ToolConstrain
-1 $y0
2549 if [expr "($dy > 16) || ($dy < -16)"] then
{
2550 $w ToolConstrain
$x0 -1
2559 proc StartChalk
{w
} {
2560 sim CollapseMotion
0
2564 proc StopChalk
{w
} {
2565 sim CollapseMotion
1
2569 proc EditorPanDown
{mod w x y
} {
2570 global [set var
$w.TrackState
]
2574 set $var [list constrain_start
$x $y]
2575 $w ToolConstrain
$x $y
2580 EditorTool PanStart
$w $x $y
2584 proc EditorPanDrag
{w x y
} {
2585 EditorTool PanTo
$w $x $y
2589 proc EditorPanUp
{w x y
} {
2592 EditorTool PanTo
$w $x $y
2593 $w ToolConstrain
-1 -1
2599 proc EditorKeyDown
{w k
} {
2604 proc EditorKeyUp
{w k
} {
2609 proc BindEditorButtons
{win
} {
2610 set w
[WindowLink
$win.top
]
2612 bind $win <1> "CancelPie $win ; EditorToolDown none %W %x %y"
2613 bind $win <B1-Motion
> {EditorToolDrag
%W
%x
%y
}
2614 bind $win <ButtonRelease-1
> {EditorToolUp
%W
%x
%y
}
2616 bind $win <Control-1
> "CancelPie $win ; EditorToolDown constrain %W %x %y"
2617 bind $win <Control-B1-Motion
> {EditorToolDrag
%W
%x
%y
}
2618 bind $win <Control-ButtonRelease-1
> {EditorToolUp
%W
%x
%y
}
2620 bind $win <2> "CancelPie $win ; EditorPanDown none %W %x %y"
2621 bind $win <B2-Motion
> {EditorPanDrag
%W
%x
%y
}
2622 bind $win <ButtonRelease-2
> {EditorPanUp
%W
%x
%y
}
2624 bind $win <Control-2
> "CancelPie $win ; EditorPanDown constrain %W %x %y"
2625 bind $win <Control-B2-Motion
> {EditorPanDrag
%W
%x
%y
}
2626 bind $win <Control-ButtonRelease-2
> {EditorPanUp
%W
%x
%y
}
2628 InitPie
$win $w.toolpie
2632 proc UISetFunds
{funds
} {
2634 foreach win
$HeadWindows {
2635 [WindowLink
$win.funds
] configure
-text "$funds"
2640 proc UISetDate
{date month year
} {
2644 set CurrentDate
"$date"
2646 foreach win
$HeadWindows {
2647 [WindowLink
$win.date
] Set
$month $year
2652 proc SetPriority
{index
} {
2678 proc UISetDemand
{r c i
} {
2679 global HeadWindows DemandRes DemandCom DemandInd
2685 if {$r <= 0} then
{set ry0
32} else {set ry0
24}
2686 set ry1
[expr "$ry0 - $r"]
2687 if {$c <= 0} then
{set cy0
32} else {set cy0
24}
2688 set cy1
[expr "$cy0 - $c"]
2689 if {$i <= 0} then
{set iy0
32} else {set iy0
24}
2690 set iy1
[expr "$iy0 - $i"]
2692 foreach win
$HeadWindows {
2693 set can
[WindowLink
$win.demand
]
2694 # $can coords r 8 $ry0 14 $ry1
2695 # $can coords c 17 $cy0 23 $cy1
2696 # $can coords i 26 $iy0 32 $iy1
2697 $can coords r
49 $ry0 55 $ry1
2698 $can coords c
58 $cy0 64 $cy1
2699 $can coords i
67 $iy0 73 $iy1
2704 proc UISetOptions
{autobudget autogoto autobulldoze disasters sound animation messages notices
} {
2705 global AutoBudget AutoGoto AutoBulldoze Disasters Sound
2706 set AutoBudget
$autobudget
2707 set AutoGoto
$autogoto
2708 set AutoBulldoze
$autobulldoze
2709 set Disasters
$disasters
2711 set DoAnimation
$animation
2712 set DoMessages
$messages
2713 set DoNotices
$notices
2717 proc UIDidToolRes
{win x y
} {
2718 UIMakeSoundOn
$win edit O
"-speed 140"
2722 proc UIDidToolCom
{win x y
} {
2723 UIMakeSoundOn
$win edit A
"-speed 140"
2727 proc UIDidToolInd
{win x y
} {
2728 UIMakeSoundOn
$win edit E
"-speed 140"
2732 proc UIDidToolFire
{win x y
} {
2733 UIMakeSoundOn
$win edit O
"-speed 130"
2737 proc UIDidToolQry
{win x y
} {
2738 UIMakeSoundOn
$win edit E
"-speed 200"
2742 proc UIDidToolPol
{win x y
} {
2743 UIMakeSoundOn
$win edit E
"-speed 130"
2747 proc UIDidToolWire
{win x y
} {
2748 UIMakeSoundOn
$win edit O
"-speed 120"
2752 proc UIDidToolDozr
{win x y
} {
2753 UIMakeSoundOn
$win edit Rumble
2757 proc UIDidToolRail
{win x y
} {
2758 UIMakeSoundOn
$win edit O
"-speed 100"
2762 proc UIDidToolRoad
{win x y
} {
2763 UIMakeSoundOn
$win edit E
"-speed 100"
2767 proc UIDidToolChlk
{win x y
} {
2771 proc UIDidToolEraser
{win x y
} {
2775 proc UIDidToolStad
{win x y
} {
2776 UIMakeSoundOn
$win edit O
"-speed 90"
2780 proc UIDidToolPark
{win x y
} {
2781 UIMakeSoundOn
$win edit A
"-speed 130"
2785 proc UIDidToolSeap
{win x y
} {
2786 UIMakeSoundOn
$win edit E
"-speed 90"
2790 proc UIDidToolCoal
{win x y
} {
2791 UIMakeSoundOn
$win edit O
"-speed 75"
2795 proc UIDidToolNuc
{win x y
} {
2796 UIMakeSoundOn
$win edit E
"-speed 75"
2800 proc UIDidToolAirp
{win x y
} {
2801 UIMakeSoundOn
$win edit A
"-speed 50"
2805 proc UISetToolState
{w state
} {
2806 global EditorPallets EditorPalletImages ToolInfo
2807 set win
[WindowLink
$w.top
]
2808 #echo "UISETTOOLSTATE w $w win $win $state"
2809 ExclusivePallet
$state $win $EditorPallets ic
$EditorPalletImages \
2810 raised sunken
{NoFunction
}
2812 set c1
[WindowLink
$w.cost1
]
2814 set info [lindex $ToolInfo $state]
2815 set cost1
[lindex $info 1]
2816 set cost2
[lindex $info 2]
2817 $c1 configure
-text "$cost1"
2818 [WindowLink
$w.cost2
] configure
-text "$cost2"
2823 proc UIShowZoneStatus
{zone density value crime pollution growth x y
} {
2824 global QueryX QueryY
2825 set QueryX
[expr "8 + 16 * $x"]
2826 set QueryY
[expr "8 + 16 * $y"]
2827 UIShowPicture
9 [list $zone $density $value $crime $pollution $growth]
2831 ########################################################################
2832 # Map Window Handlers
2835 proc ShowMapOf
{head
} {
2838 foreach win
$MapWindows {
2839 if {"[WindowLink $win.head]" == "$head"} {
2840 global MapPanelWidth MapPanelHeight
2841 #place configure $win -x 0 -y 0 -width $MapPanelWidth -height $MapPanelHeight
2842 #[WindowLink $win.parent] configure -width $MapPanelWidth -height $MapPanelHeight
2843 set parent
[WindowLink
$win.parent
]
2844 pack append [WindowLink
$head.w2
] \
2845 $win {top
frame nw expand fill
}
2858 proc NewMapOf
{head
} {
2859 set win
[MakeWindow.map
$head [winfo screen
$head]]
2860 global MapPanelWidth MapPanelHeight
2861 #place configure $win -x 0 -y 0 -width $MapPanelWidth -height $MapPanelHeight
2862 #[WindowLink $win.parent] configure -width $MapPanelWidth -height $MapPanelHeight
2863 set parent
[WindowLink
$win.parent
]
2864 #pack append [WindowLink $head.col1]\
2865 # $parent {top frame nw fillx}
2866 pack append [WindowLink
$head.w2
] \
2867 $win {top
frame nw expand fill
}
2874 foreach win
$HeadWindows {
2880 proc WithdrawMaps
{} {
2882 foreach win
$MapWindows {
2891 foreach win
$MapWindows {
2897 proc InitMap
{win
} {
2902 proc EnableMaps
{} {
2904 foreach win
$MapWindows {
2910 proc EnableMap
{win
} {
2911 [WindowLink
$win.view
] ShowEditors
1
2912 [WindowLink
$win.zones
] config
-state normal
2913 [WindowLink
$win.overlays
] config
-state normal
2917 proc DisableMaps
{} {
2919 foreach win
$MapWindows {
2925 proc DisableMap
{win
} {
2926 [WindowLink
$win.view
] ShowEditors
0
2927 [WindowLink
$win.zones
] config
-state disabled
2928 [WindowLink
$win.overlays
] config
-state disabled
2932 proc SetMapState
{win state
} {
2933 set m
[WindowLink
$win.view
]
2935 if {$state == 14} then
{
2936 ShowFrobOf
[WindowLink
$win.head
]
2941 proc MapPanDown
{w x y
} {
2946 proc MapPanDrag
{w x y
} {
2951 proc MapPanUp
{w x y
} {
2958 proc UISetMapState
{w state
} {
2960 #set win [winfo toplevel $w]
2961 set win
[WindowLink
$w.win
]
2962 set m
[WindowLink
$win.view
]
2963 set title
[lindex $MapTitles $state]
2965 # TODO: set map text field header to title
2966 #wm title $win "$title"
2967 #wm iconname $win "$title"
2969 global [set var MapState.
$win]
2973 {6 8 9 10 11 12 13} {
2974 [WindowLink
$win.legend
] config
-bitmap "@images/legendmm.xpm"
2977 [WindowLink
$win.legend
] config
-bitmap "@images/legendpm.xpm"
2980 [WindowLink
$win.legend
] config
-bitmap "@images/legendn.xpm"
2986 ########################################################################
2987 # Graph Window Handlers
2990 proc ToggleGraphOf
{head
} {
2992 if {"$State" != "play"} {
2997 set win
[WindowLink
$head.graph
]
2999 set mapped
[winfo ismapped
$win]
3003 WithdrawGraphOf
$head
3011 proc WithdrawGraphOf
{head
} {
3012 set win
[WindowLink
$head.graph
]
3019 proc ShowGraphOf
{head
} {
3020 set win
[WindowLink
$head.graph
]
3022 set win
[MakeWindow.graph
$head [winfo screen
$head]]
3026 set parent
[WindowLink
$win.parent
]
3027 pack append $parent\
3028 $win {top
frame nw fillx
}
3034 proc WithdrawGraphs
{} {
3036 foreach win
$GraphWindows {
3043 proc InitGraphs
{} {
3045 foreach win
$GraphWindows {
3051 proc InitGraph
{win
} {
3052 UISetGraphState
$win 1 1 1 1 1 1 0
3056 proc UISetGraphState
{win t0 t1 t2 t3 t4 t5 range
} {
3057 set g
[WindowLink
$win.graphview
]
3058 GraphPalletMask
$win [expr "$t0 + ($t1<<1) + ($t2<<2) + ($t3<<3) + ($t4<<4) + ($t5<<5)"]
3059 GraphYearPallet
$win $range
3063 ########################################################################
3064 # Splash Window Handlers
3067 proc ShowSplashOf
{head
} {
3068 set win
[WindowLink
$head.splash
]
3070 set win
[MakeWindow.splash
$head [winfo screen
$head]]
3072 set splashscreen
[WindowLink
$win.splashscreen
]
3074 catch {$splashscreen config
-bitmap "@images/splashscreen.xpm"; set success 1}
3077 global SplashScreenDelay
3078 after $SplashScreenDelay "UIPickScenarioMode"
3085 proc WithdrawSplashOf
{head
} {
3086 set win
[WindowLink
$head.splash
]
3093 proc ShowSplashes
{} {
3095 foreach win
$HeadWindows {
3101 proc WithdrawSplashes
{} {
3102 global SplashWindows
3103 foreach win
$SplashWindows {
3105 set splashscreen
[WindowLink
$win.splashscreen
]
3106 $splashscreen config
-bitmap ""
3111 proc InitSplashes
{} {
3115 proc InitSplash
{win
} {
3119 proc DeleteSplashWindow
{win
} {
3124 ########################################################################
3125 # Scenario Window Handlers
3128 proc ShowScenarioOf
{head
} {
3129 set win
[WindowLink
$head.scenario
]
3131 set win
[MakeWindow.scenario
$head [winfo screen
$head]]
3133 # TODO: load background bitmap
3138 proc WithdrawScenarioOf
{head
} {
3139 set win
[WindowLink
$head.scenario
]
3146 proc ShowScenarios
{} {
3148 foreach win
$HeadWindows {
3154 proc WithdrawScenarios
{} {
3155 global ScenarioWindows
3156 foreach win
$ScenarioWindows {
3158 # TODO: flush background bitmap
3163 proc InitScenarios
{} {
3164 global MapHistory MapHistoryNum
3165 if {$MapHistoryNum < 1} {
3170 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3175 global ScenarioWindows
3176 foreach win
$ScenarioWindows {
3178 #[WindowLink $win.previous] config -state $prev
3179 #[WindowLink $win.next] config -state $next
3184 proc InitScenario
{win
} {
3185 global MapHistory MapHistoryNum
3186 if {$MapHistoryNum < 1} {
3192 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3199 #[WindowLink $win.previous] config -state $prev
3200 #[WindowLink $win.next] config -state $next
3202 LinkWindow
$win.scenarioTarget
-1
3203 LinkWindow
$win.scenarioTargetDown
-1
3205 global ScenarioButtons
3207 set len
[llength $ScenarioButtons]
3209 set data
[lindex $ScenarioButtons $i]
3210 set type
[lindex $data 0]
3211 set id
[lindex $data 1]
3215 LinkWindow
$win.
$id.over
0
3216 LinkWindow
$win.
$id.enabled
1
3217 LinkWindow
$win.
$id.checked
0
3218 #echo "SETTING WIN $win ID $id"
3220 set i
[expr "$i + 1"]
3223 UpdateLevelSelection
$win
3224 UpdateLeftRightEnabled
$win
3228 proc UpdateLevelSelection
{win
} {
3229 #echo UpdateLevelSelection
3231 if {$GameLevel == 0} then
{
3232 LinkWindow
$win.easy.checked
1
3233 LinkWindow
$win.medium.checked
0
3234 LinkWindow
$win.hard.checked
0
3236 if {$GameLevel == 1} then
{
3237 LinkWindow
$win.easy.checked
0
3238 LinkWindow
$win.medium.checked
1
3239 LinkWindow
$win.hard.checked
0
3241 if {$GameLevel == 2} then
{
3242 LinkWindow
$win.easy.checked
0
3243 LinkWindow
$win.medium.checked
0
3244 LinkWindow
$win.hard.checked
1
3247 UpdateScenarioButtonID
$win easy
3248 UpdateScenarioButtonID
$win medium
3249 UpdateScenarioButtonID
$win hard
3254 proc UpdateLeftRightEnabled
{win
} {
3255 #echo UpdateLeftRightEnabled
3257 global MapHistory MapHistoryNum
3258 if {$MapHistoryNum < 1} {
3259 LinkWindow
$win.left.enabled
0
3261 LinkWindow
$win.left.enabled
1
3264 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3265 LinkWindow
$win.right.enabled
0
3267 LinkWindow
$win.right.enabled
1
3270 UpdateScenarioButtonID
$win left
3271 UpdateScenarioButtonID
$win right
3275 proc UpdateScenarioButtonID
{win id
} {
3277 global ScenarioButtons
3279 set len
[llength $ScenarioButtons]
3281 set data
[lindex $ScenarioButtons $i]
3283 if {$id == [lindex $data 1]} then
{
3284 UpdateScenarioButton
$win $data
3288 set i
[expr "$i + 1"]
3293 proc UpdateScenarioButton
{win data
} {
3296 set type
[lindex $data 0]
3297 set id
[lindex $data 1]
3298 set over
[WindowLink
$win.
$id.over
]
3299 set enabled
[WindowLink
$win.
$id.enabled
]
3300 set checked
[WindowLink
$win.
$id.checked
]
3301 #echo "WIN $win TYPE $type ID $id OVER $over ENABLED $enabled CHECKED $checked"
3303 if {[lindex ${data
} 2] == "DoPickScenario"} {
3304 catch {text $win.desc
\
3309 -font [Font
$win Large
]}
3311 $win.desc configure
-state normal
3312 $win.desc delete
0.0 end
3313 $win.desc insert end
"[lindex $Messages([lindex ${data} 3]) 1]\n\n[lindex $Messages([lindex ${data} 3]) 2]"
3314 $win.desc configure
-state disabled
3316 place $win.desc
-x 232 -y 170 -width 280 -height 285
3319 catch {destroy $win.desc
}
3324 set bm
[lindex $data 13]
3326 set bm
[lindex $data 12]
3330 set bm
[lindex $data 10]
3332 set bm
[lindex $data 9]
3336 set bm
[lindex $data 11]
3339 [WindowLink
$win.
canvas] itemconfig
$id -bitmap $bm
3343 proc DoEnterCityName
{win
} {
3347 proc InitVotesForUseThisMap
{} {
3348 # TODO: Disabled for new scenario window.
3351 global VotesForUseThisMap ScenarioWindows
3352 set VotesForUseThisMap
{}
3353 foreach win
$ScenarioWindows {
3354 [WindowLink
$win.vote
] config
-relief raised
3356 UpdateVotesForUseThisMap
3360 proc UpdateVotesForUseThisMap
{} {
3361 global ScenarioWindows
3362 UpdateVotesFor UseThisMap
$ScenarioWindows
3366 proc UIUseThisMap
{} {
3367 global CityName GameLevel Scenario
3369 # special handling for scenarios?
3370 if {$GameLevel != -1} {
3371 sim GameLevel
$GameLevel
3373 sim CityName
$CityName
3376 if {$Scenario != -1} {
3377 UIShowPicture
$Scenario
3382 proc HandleScenarioDown
{win x y
} {
3383 #echo HandleScenarioDown $win $x $y
3384 HandleScenarioMove
$win $x $y
3385 set w
[WindowLink
$win.w
]
3386 set target
[WindowLink
$w.scenarioTarget
]
3387 LinkWindow
$w.scenarioTargetDown
$target
3391 proc HandleScenarioUp
{win x y
} {
3392 #echo HandleScenarioUp $win $x $y
3393 HandleScenarioMove
$win $x $y
3394 global ScenarioButtons
3395 set w
[WindowLink
$win.w
]
3396 set target
[WindowLink
$w.scenarioTarget
]
3397 set targetDown
[WindowLink
$w.scenarioTargetDown
]
3398 if {($target != -1) &&
3399 ($target == $targetDown)} {
3400 set data
[lindex $ScenarioButtons $target]
3401 set type
[lindex $data 0]
3402 set id
[lindex $data 1]
3403 set callback
[lindex $data 2]
3404 set param
[lindex $data 3]
3405 set var
[lindex $data 4]
3406 set xx
[lindex $data 5]
3407 set yy
[lindex $data 6]
3408 set ww
[lindex $data 7]
3409 set hh
[lindex $data 8]
3410 set normal
[lindex $data 9]
3411 set over
[lindex $data 10]
3412 set disabled
[lindex $data 11]
3413 if {$type == "button"} {
3414 #echo callback $callback w $w param $param
3415 eval "$callback $w {$param}"
3417 if {$type == "checkbox"} {
3418 #echo checkbox callback $callback w $w param $param
3419 eval "$callback $w {$param}"
3426 proc HandleScenarioMove
{win x y
} {
3427 #echo HandleScenarioMove $win $x $y
3428 global ScenarioButtons
3429 set w
[WindowLink
$win.w
]
3430 set target
[WindowLink
$w.scenarioTarget
]
3433 set len
[llength $ScenarioButtons]
3435 set data
[lindex $ScenarioButtons $i]
3436 set type
[lindex $data 0]
3437 set id
[lindex $data 1]
3438 set callback
[lindex $data 2]
3439 set param
[lindex $data 3]
3440 set var
[lindex $data 4]
3441 set xx
[lindex $data 5]
3442 set yy
[lindex $data 6]
3443 set ww
[lindex $data 7]
3444 set hh
[lindex $data 8]
3446 set enabled
[WindowLink
$w.
$id.enabled
]
3447 set checked
[WindowLink
$w.
$id.checked
]
3449 #echo "ID $id ENABLED $enabled CHECKED $checked w $w id $id"
3451 if {($enabled != 0) &&
3453 ($x < ($xx + $ww)) &
3455 ($y < ($yy + $hh))} {
3460 set i
[expr "$i + 1"]
3463 if {$found != $target} {
3466 if {$target != -1} {
3468 #echo OUT $w $found $xx $yy $normal
3469 LinkWindow
$w.scenarioTarget
-1
3471 set targetdata
[lindex $ScenarioButtons $target]
3472 set targetid
[lindex $targetdata 1]
3473 LinkWindow
$w.
$targetid.over
0
3474 UpdateScenarioButton
$w $targetdata
3479 #echo IN $w $found $xx $yy $over
3480 LinkWindow
$w.scenarioTarget
$found
3481 LinkWindow
$w.
$id.over
1
3483 if {$target != -1} {
3484 set targetdata
[lindex $ScenarioButtons $target]
3485 set targetid
[lindex $targetdata 1]
3486 LinkWindow
$w.
$targetid.over
0
3487 UpdateScenarioButton
$w $targetdata
3490 UpdateScenarioButton
$w $data
3496 proc DoLoad
{win param
} {
3497 #echo DOLOAD $win $param
3502 proc DoGenerate
{win param
} {
3503 #echo DOGENERATE $win $param
3508 proc DoQuit
{win param
} {
3509 #echo DOQUIT $win $param
3514 proc DoAbout
{win param
} {
3515 #echo DOABOUT $win $param
3516 MakeHistory
"DoLoadCity cities/about.cty"
3520 proc DoMap
{win param
} {
3521 #echo DOMAP $win $param
3525 proc DoLevel
{win param
} {
3526 #echo DOLEVEL $win $param
3527 DoSetGameLevel
$param
3531 proc DoLeft
{win param
} {
3532 #echo DOLEFT $win $param
3537 proc DoRight
{win param
} {
3538 #echo DORIGHT $win $param
3543 proc DoPlay
{win param
} {
3544 #echo DOPLAY $win $param
3549 proc DoPickScenario
{win param
} {
3550 #echo DOPICKSCENARIO $win $param
3551 UILoadScenario
$param
3554 proc DeleteScenarioWindow
{win
} {
3559 ########################################################################
3560 # Undo/Redo Facility
3563 proc InitHistory
{} {
3565 global MapHistoryNum
3567 set MapHistoryNum
-1
3571 proc MakeHistory
{cmd
} {
3573 set len
[llength $MapHistory]
3575 ($cmd != [lindex $MapHistory [expr $len-1]])} {
3576 lappend MapHistory
$cmd
3584 proc GotoHistory
{i
} {
3586 global MapHistoryNum
3587 InitVotesForUseThisMap
3588 if {$i != $MapHistoryNum} {
3589 set MapHistoryNum
$i
3590 set cmd
[lindex $MapHistory $i]
3593 if {$MapHistoryNum == 0} {
3598 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3604 global ScenarioWindows
3605 foreach win
$ScenarioWindows {
3606 UpdateLeftRightEnabled
$win
3612 proc NextHistory
{} {
3614 global MapHistoryNum
3615 set len
[llength $MapHistory]
3616 set i
[expr "$MapHistoryNum + 1"]
3623 proc PrevHistory
{} {
3625 global MapHistoryNum
3626 set i
[expr "$MapHistoryNum - 1"]
3633 ########################################################################
3634 # Ask Window Handlers
3636 proc ShowAskOf
{head
} {
3637 set win
[WindowLink
$head.ask
]
3639 set win
[MakeWindow.ask
$head [winfo screen
$head]]
3649 foreach win
$HeadWindows {
3655 proc WithdrawAsks
{} {
3657 foreach win
$AskWindows {
3663 proc WithdrawAskOf
{win
} {
3664 set ask
[WindowLink
$win.ask
]
3671 proc AskQuestion
{color title
text left middle right
} {
3673 foreach win
$HeadWindows {
3674 AskQuestionOn
$win $color $title $text $left $middle $right
3679 proc AskQuestionOn
{head color title
text left middle right
} {
3682 set win
[WindowLink
$head.ask
]
3683 set t
[WindowLink
$win.title
]
3684 $t configure
-text $title
3685 $t configure
-background $color
3687 set t
[WindowLink
$win.
text]
3688 $t configure
-state normal
3690 $t insert end
"${text}\n"
3691 $t configure
-state disabled
3693 set bf
[WindowLink
$win.
frame]
3694 set l
[WindowLink
$win.left
]
3695 set m
[WindowLink
$win.middle
]
3696 set r
[WindowLink
$win.vote
]
3697 set rf
[WindowLink
$win.voteframe
]
3701 -text [lindex $left 0] \
3702 -command [format [lindex $left 2] $head]
3703 SetHelp
$l [lindex $left 1]
3704 pack append $bf $l {left
frame center
}
3709 if {$middle != ""} {
3711 -text [lindex $middle 0] \
3712 -command [format [lindex $middle 2] $head]
3713 SetHelp
$m [lindex $middle 1]
3714 pack append $bf $m {left
frame center expand
}
3720 set notify
[format [lindex $right 2] $head]
3721 set preview
[format [lindex $right 3] $head]
3722 set cmd
[list DoVote
$win Ask
$notify $preview]
3724 -text [lindex $right 0] \
3726 SetHelp
$r [lindex $right 1]
3727 pack append $bf $rf {right
frame center
}
3736 proc BindVotingButton
{win but name
} {
3737 set w
[WindowLink
$win.top
]
3739 bind $but <Any-Enter
> "VoteButtonEnter $win $but"
3740 bind $but <Any-Leave
> "VoteButtonLeave $win $but"
3741 bind $but <1> "VoteButtonDown $win $but $name"
3742 bind $but <ButtonRelease-1
> "VoteButtonUp $win $but $name"
3743 bind $but <2> "VoteButtonDown $win $but $name"
3744 bind $but <ButtonRelease-2
> "VoteButtonUp $win $but $name"
3745 bind $but <3> "VoteButtonDown $win $but $name"
3746 bind $but <ButtonRelease-3
> "VoteButtonUp $win $but $name"
3750 proc VoteButtonEnter
{win but
} {
3752 set screen
[winfo screen
$but]
3753 if {[lindex [$but config
-state] 4] != "disabled"} {
3754 $but config
-state active
3755 set tk_priv
(window
@$screen) $but
3757 set tk_priv
(window
@$screen) ""
3762 proc VoteButtonLeave
{win but
} {
3764 if {[lindex [$but config
-state] 4] != "disabled"} {
3765 $but config
-state normal
3767 set screen
[winfo screen
$but]
3768 set tk_priv
(window
@$screen) ""
3772 proc VoteButtonDown
{win but name
} {
3774 set screen
[winfo screen
$but]
3775 set rel
[lindex [$but config
-relief] 4]
3776 set tk_priv
(relief
@$screen) $rel
3777 if {[lindex [$but config
-state] 4] != "disabled"} {
3778 set head
[WindowLink
$win.head
]
3779 if {[IsVotingFor
$head $name]} {
3780 $but config
-relief raised
3782 $but config
-relief sunken
3788 proc VoteButtonUp
{win but name
} {
3790 set screen
[winfo screen
$but]
3791 $but config
-relief $tk_priv(relief
@$screen)
3792 if {($but == $tk_priv(window
@$screen))
3793 && ([lindex [$but config
-state] 4] != "disabled")} {
3794 uplevel #0 [list $but invoke]
3795 set head
[WindowLink
$win.head
]
3796 if {[IsVotingFor
$head $name]} {
3797 $but config
-relief sunken
3799 $but config
-relief raised
3805 proc PressVoteButton
{win but name
} {
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
3817 proc IsVotingFor
{win name
} {
3818 global VotesFor
$name
3819 set votes
[eval ident
"\$\{VotesFor$name\}"]
3820 if {[lsearch $votes $win] == -1} {
3828 proc DoVote
{win name notify preview
} {
3829 global VotesFor
$name
3830 set votes
[eval ident
"\$\{VotesFor$name\}"]
3832 set win
[WindowLink
$win.head
]
3833 set i
[lsearch $votes $win]
3835 lappend VotesFor
$name $win
3837 set VotesFor
$name [lreplace $votes $i $i]
3840 set votes
[eval ident
"\$\{VotesFor$name\}"]
3841 if {[llength $votes] >= [NeededVotes
]} {
3849 proc UpdateVotesFor
{name wins
} {
3850 global VotesFor
$name
3851 set votes
[eval llength "\$\{VotesFor$name\}"]
3852 set needed
[NeededVotes
]
3855 set head
[WindowLink
$win.head
]
3856 if {[IsVotingFor
$head $name]} {
3857 set border
[expr "($needed - $votes) * 1"]
3858 set pad
[expr "6 - $border"]
3859 [WindowLink
$win.vote
] config
-padx $pad -pady $pad
3860 [WindowLink
$win.voteframe
] config
-borderwidth $border
3862 set border
[expr "($needed - $votes - 1) * 1"]
3863 set pad
[expr "6 - $border"]
3864 [WindowLink
$win.vote
] config
-padx $pad -pady $pad
3865 [WindowLink
$win.voteframe
] config
-borderwidth $border
3871 proc InitVotesForAsk
{} {
3872 global VotesForAsk AskWindows
3874 foreach win
$AskWindows {
3875 [WindowLink
$win.vote
] config
-relief raised
3882 proc UpdateVotesForAsk
{} {
3884 UpdateVotesFor Ask
$AskWindows
3888 ########################################################################
3889 # Player Window Handlers
3891 proc ShowPlayerOf
{head
} {
3892 set win
[WindowLink
$head.player
]
3894 set win
[MakeWindow.player
$head [winfo screen
$head]]
3902 proc ShowPlayers
{} {
3904 foreach win
$HeadWindows {
3910 proc WithdrawPlayers
{} {
3911 global PlayerWindows
3912 foreach win
$PlayerWindows {
3918 proc UpdatePlayers
{} {
3919 # TODO: Disabled for new scenario window.
3922 global HeadWindows PlayerWindows
3925 foreach win
$HeadWindows {
3926 set server
[winfo screen
$win]
3927 # if {[string first : $server] == 0} {
3928 # set server "[exec hostname]:0"
3930 lappend players
$server
3933 sim Players
[llength $players]
3935 foreach win
$PlayerWindows {
3936 set list [WindowLink
$win.players
]
3938 eval "$list insert 0 $players"
3941 UpdateVotesForUseThisMap
3943 UpdateVotesForBudget
3944 UpdateTaxRateSliders
3948 proc UIShowPlayer
{win
} {
3953 proc DoNewPlayer
{win
} {
3954 set field
[WindowLink
$win.display
]
3955 set dpy
[$field get
]
3960 if {[AddPlayer
$dpy] != ""} {
3966 ########################################################################
3967 # Notice Window Handlers
3970 proc ShowNoticeOf
{head
} {
3971 set win
[WindowLink
$head.notice
]
3973 set win
[MakeWindow.notice
$head [winfo screen
$head]]
3975 global NoticePanelWidth NoticePanelHeight
3976 #place configure $win -x 0 -y 0 -width $NoticePanelWidth -height $NoticePanelHeight
3977 pack append [WindowLink
$head.w3
] \
3978 $win {bottom
frame sw expand fill
}
3983 proc ShowNotices
{} {
3985 foreach win
$HeadWindows {
3991 proc WithdrawNotices
{} {
3992 global NoticeWindows
3993 foreach win
$NoticeWindows {
4000 proc ReShowPictureOn
{{head
""}} {
4001 global ShowingPicture ShowingParms
4002 UIShowPictureOn
$head $ShowingPicture $ShowingParms
4006 proc UIShowPicture
{id
{parms
""}} {
4007 UIShowPictureOn
"" $id $parms
4011 proc UIShowPictureOn
{where id
{parms
""}} {
4012 global DoNotices Messages ShowingPicture ShowingParms
4013 if {$DoNotices == 0} {
4017 set ShowingPicture
$id
4018 set ShowingParms
$parms
4019 set msg
$Messages($id)
4020 set color
[lindex $msg 0]
4021 set title
[lindex $msg 1]
4022 set body
[lindex $msg 2]
4024 set cmd
"format {$body} $parms"
4025 set body
[uplevel #0 $cmd]
4027 set props
[lindex $msg 3]
4028 if {"$where" == ""} {
4030 set where
$HeadWindows
4032 foreach head
$where {
4033 NoticeMessageOn
$head "$title" $color "$body" Medium
$props
4038 proc NoticeMessageOn
{head title color
text font props
} {
4040 set win
[WindowLink
$head.notice
]
4042 set t
[WindowLink
$win.title
]
4043 $t configure
-text $title -background $color
4045 set t
[WindowLink
$win.
text]
4046 $t configure
-state normal
-font [Font
$head $font]
4048 $t insert end
"${text}\n"
4049 $t configure
-state disabled
4052 catch {set left
[keylget props left
]}
4053 set l
[WindowLink
$win.left
]
4055 $l config
-bitmap $left
4056 place $l -in $t -anchor sw
-relx .05 -rely .95
4062 catch {set middle
[keylget props middle
]}
4063 set m
[WindowLink
$win.middle
]
4064 if {$middle != ""} {
4065 $m config
-bitmap $middle
4066 place $m -in $t -anchor s
-relx .5 -rely .95
4072 catch {set right
[keylget props right
]}
4073 set r
[WindowLink
$win.right
]
4075 $r config
-bitmap $right
4076 place $r -in $t -anchor se
-relx .95 -rely .95
4082 catch {set view
[keylget props view
]}
4083 set vf
[WindowLink
$win.viewframe
]
4085 set v
[WindowLink
$win.view
]
4086 set bg
[WindowLink
$win.background
]
4090 pack append $bg $vf {left
frame center fill
}
4091 pack append $bg $t {right
frame center fill expand
}
4098 proc UIPopUpMessage
{msg
} {
4103 proc ComeToMe
{view
} {
4104 set win
[winfo toplevel $view]
4107 set x
[expr "[lindex $xy 0] >>4"]
4108 set y
[expr "[lindex $xy 1] >>4"]
4114 proc ComeTo
{win x y
} {
4115 global EditorWindows
4116 set head
[WindowLink
$win.head
]
4119 foreach ed
$EditorWindows {
4120 if {"[WindowLink $ed.head]" == "$head"} {
4122 set view
[WindowLink
$ed.view
]
4123 if {[$view AutoGoto
]} {
4124 lappend myautoeds
$ed
4128 if {[llength $myautoeds]} {
4129 UIAutoGotoOn
$x $y $myautoeds
4131 if {[llength $myeds]} {
4132 UIAutoGotoOn
$x $y $myeds
4138 proc FollowView
{view id
} {
4142 if {[sim DoAnimation
]} {
4143 set head
[WindowLink
[winfo toplevel $view].head
]
4144 global EditorWindows
4145 foreach win
$EditorWindows {
4146 if {"[WindowLink $win.head]" == "$head"} {
4147 set s
[[WindowLink
$win.view
] Skip
]
4148 set skips
[min
$skips $s]
4152 if {$skips == 999999} {
4162 proc PanView
{view x y
} {
4168 ########################################################################
4169 # Help Window Handlers
4172 proc ShowHelpOf
{head
} {
4173 set win
[WindowLink
$head.help
]
4175 set win
[MakeWindow.help
$head [winfo screen
$head]]
4185 foreach win
$HeadWindows {
4191 proc WithdrawHelps
{} {
4193 foreach win
$HelpWindows {
4199 ########################################################################
4200 # Frob Window Handlers
4203 proc ShowFrobOf
{head
} {
4204 set win
[WindowLink
$head.frob
]
4206 set win
[MakeWindow.frob
$head [winfo screen
$head]]
4217 foreach win
$HeadWindows {
4223 proc WithdrawFrobs
{} {
4225 foreach win
$FrobWindows {
4231 proc UISetDynamic
{i min max
} {
4232 sim DynamicData
[expr "$i*2"] $min
4233 sim DynamicData
[expr "$i*2+1"] $max
4237 ########################################################################
4244 source $ResourceDir/help.tcl
4247 proc HandleHelp
{win x y rootx rooty
} {
4248 global HelpLoaded HelpWidgets Messages
4250 if {$HelpLoaded == 0} {
4256 set head
[WindowLink
[winfo toplevel $win].head
]
4259 catch {set id
$HelpWidgets($win)}
4263 set list [split $win .
]
4264 set len
[expr "[llength $list] - 2"]
4265 set list [lrange $list 0 $len]
4266 if {[llength $list] <= 1} {
4270 set win
[join $list .
]
4272 if [info exists Messages
($id)] {
4273 UIShowHelpOn
$head $id
4275 UIShowHelpOn
$head Window
4280 proc UIShowHelpOn
{win id
{parms
""}} {
4281 global Messages ShowingPicture ShowingParms ResourceDir
4282 set head
[WindowLink
$win.head
]
4283 set msg
$Messages($id)
4284 set color
[lindex $msg 0]
4285 set title
[lindex $msg 1]
4286 set body
[lindex $msg 2]
4288 set cmd
"format {$body} $parms"
4289 set body
[uplevel #0 $cmd]
4291 set props
[lindex $msg 3]
4294 set win
[WindowLink
$head.help
]
4296 set t
[WindowLink
$win.title
]
4297 $t configure
-text $title -background $color
4299 set t
[WindowLink
$win.
text]
4300 $t configure
-state normal
-font [Font
$head Large
]
4302 $t insert end
"${body}\n"
4303 FormatHTML
$ResourceDir/doc
/$id.html
$t
4304 $t configure
-state disabled
4308 proc FormatHTML
{filename text} {
4311 set f
[open $filename]
4318 while {[gets $f line
] >= 0} {
4319 if {"$line" == "</body>"} {
4322 if {([string index
$line 0] == "#") ||
([string length
$line] == 0)} {
4325 $text insert end
"$line\n"
4334 proc SetHelp
{win id
} {
4336 set HelpWidgets
($win) $id
4340 proc Help
{id title
{msg
{}} {props
{}}} {
4341 Message
$id #7f7fff $title $msg $props
4344 ########################################################################
4348 # Set up the bindings to pop up $pie when the right button is clicked in $win
4349 proc InitPie
{win pie
} {
4350 bind $win <Motion
> {}
4351 bind $win <3> "PieMenuDown $win $pie $pie Initial %X %Y"
4352 bind $win <B3-Motion
> {}
4353 bind $win <B3-ButtonRelease
> {}
4357 # Set up the bindings to continue tracking $pie
4358 # Get this: we keep the tracking machine state in the bindings!
4359 proc ActivatePie
{win root pie state
} {
4360 bind $win <Motion
> "PieMenuMotion $win $root $pie $state %X %Y"
4361 bind $win <3> "PieMenuDown $win $root $pie $state %X %Y"
4362 bind $win <B3-Motion
> "PieMenuMotion $win $root $pie $state %X %Y"
4363 bind $win <B3-ButtonRelease
> "PieMenuUp $win $root $pie $state %X %Y"
4367 # Cancel and reset a pie menu
4368 proc CancelPie
{win
} {
4369 set binding
[bind $win <3>]
4370 set root
[lindex $binding 2]
4371 set pie
[lindex $binding 3]
4372 set state
[lindex $binding 4]
4373 if {"$state" != "Initial"} {
4374 catch {$root ungrab
$win}
4377 UIMakeSoundOn
$win fancy Oop
4383 # Handle pie menu button down
4384 proc PieMenuDown
{win root pie state x y
} {
4387 ActivatePie
$win $root $pie FirstDown
4389 catch {$root grab $win}
4392 PreviewPieMenu
$win $pie $x $y
4396 TrackPieMenu
$pie $x $y
4397 ActivatePie
$win $root $pie SecondDown
4403 PreviewPieMenu
$win $pie $x $y
4404 ActivatePie
$win $root $pie SecondDown
4409 SecondDown
{ # error
4416 # Handle pie menu button motion
4417 proc PieMenuMotion
{win root pie state x y
} {
4420 TrackPieMenu
$pie $x $y
4428 TrackPieMenu
$pie $x $y
4442 # Handle pie menu button up
4443 proc PieMenuUp
{win root pie state x y
} {
4446 TrackPieMenu
$pie $x $y
4447 set active
[$pie index active
]
4448 if {$active == "none"} {
4450 catch {$root grab $win}
4451 ActivatePie
$win $root $pie ClickedUp
4453 set label [lindex [$pie entryconfig
$active -label] 4]
4454 set submenu
[lindex [$pie entryconfig
$active -piemenu] 4]
4455 UIMakeSoundOn
$win mode
$label
4456 if {$submenu == {}} {
4457 set reward
[$pie pending
]
4458 catch {$root ungrab
$win}
4462 sim Funds
[expr "[sim Funds] + 5"]
4463 UIMakeSoundOn
$win fancy Aaah
4465 eval [lindex [$pie entryconfig
$active -command] 4]
4470 $submenu activate none
4472 PreviewPieMenu
$win $submenu $x $y
4473 catch {$root grab $win}
4474 ActivatePie
$win $root $submenu SelectedUp
4479 TrackPieMenu
$pie $x $y
4480 set active
[$pie index active
]
4481 if {$active == "none"} {
4484 set label [lindex [$pie entryconfig
$active -label] 4]
4485 set submenu
[lindex [$pie entryconfig
$active -piemenu] 4]
4486 UIMakeSoundOn
$win mode
$label
4487 if {$submenu == {}} {
4488 set reward
[$pie pending
]
4489 catch {$root ungrab
$win}
4493 sim Funds
[expr "[sim Funds] + 5"]
4494 UIMakeSoundOn
$win fancy Aaah
4496 eval [lindex [$pie entryconfig
$active -command] 4]
4501 $submenu activate none
4503 PreviewPieMenu
$win $submenu $x $y
4504 catch {$root grab $win}
4505 ActivatePie
$win $root $submenu SelectedUp
4515 SelectedUp
{ # error
4522 # Track the selected item
4523 proc TrackPieMenu
{pie x y
} {
4524 $pie activate
@$x,$y
4528 proc PreviewPieMenu
{win pie x y
} {
4529 set preview
[lindex [$pie config
-preview] 4]
4530 if {"$preview" != ""} {
4531 set rx
[winfo rootx
$win]
4532 set ry
[winfo rooty
$win]
4533 set x
[expr "$x - $rx"]
4534 set y
[expr "$y - $ry"]
4535 eval [format $preview $x $y]
4540 ########################################################################
4544 proc ExclusivePallet
{state parent children prefix images inactive active cmd
} {
4545 #echo "ExclusivePallet state $state parent $parent children $children prefix $prefix images $images inactive $inactive active $active cmd $cmd"
4547 foreach child
$children {
4548 set name
[lindex $images $i]
4549 if {$i == $state} then
{
4550 $parent.
$child config
\
4551 -bitmap "@images/${prefix}${name}hi.xpm" \
4554 $parent.
$child config
\
4555 -bitmap "@images/${prefix}${name}.xpm" \
4560 eval [concat $cmd $state]
4564 proc NonExclusivePallet
{mask parent children prefix images
4565 inactive active cmd
} {
4567 foreach child
$children {
4568 set name
[lindex $images $i]
4569 if {$mask & (1<<$i)} then
{
4570 $parent.
$child config
\
4571 -bitmap "@images/${prefix}${name}hi.xpm" \
4574 $parent.
$child config
\
4575 -bitmap "@images/${prefix}${name}.xpm" \
4580 eval [concat $cmd $mask]
4584 proc EditorPallet
{win state
} {
4585 global EditorPalletSounds
4586 UIMakeSoundOn
$win mode
[lindex $EditorPalletSounds $state]
4587 EditorSetTool
$win $state
4591 proc EditorSetTool
{win state
} {
4592 global EditorPallets
4593 global EditorPalletImages
4594 ExclusivePallet
$state $win $EditorPallets ic
$EditorPalletImages \
4595 flat raised
"$win.centerframe.view ToolState"
4599 proc GraphPallet
{win state
} {
4600 set mask
[[WindowLink
$win.graphview
] Mask
]
4601 set mask
[expr "$mask ^ (1<<$state)"]
4602 GraphPalletMask
$win $mask
4606 proc GraphPalletMask
{win mask
} {
4608 global GraphPalletImages
4609 NonExclusivePallet
$mask $win $GraphPallets gr
$GraphPalletImages \
4610 flat flat
"SetGraphState $win"
4614 proc GraphYearPallet
{win state
} {
4615 global GraphYearPallets
4616 global GraphYearPalletImages
4617 ExclusivePallet
$state $win $GraphYearPallets gr
$GraphYearPalletImages \
4618 flat flat
"SetGraphYearState $win"
4622 proc SetGraphYearState
{win state
} {
4623 set graph
[WindowLink
$win.graphview
]
4632 proc SetGraphState
{win mask
} {
4634 set graph
[WindowLink
$win.graphview
]
4639 ########################################################################
4642 proc sim_butEnter
{w
} {
4644 set screen
[winfo screen
$w]
4645 set tk_priv
(window
@$screen) $w
4649 proc sim_butLeave
{w
} {
4651 set screen
[winfo screen
$w]
4652 set tk_priv
(window
@$screen) ""
4656 proc sim_butDown
{w
} {
4658 set screen
[winfo screen
$w]
4659 set pict
[lindex [$w config
-bitmap] 4]
4660 set tk_priv
(relief
@$screen) $pict
4661 $w config
-bitmap [lindex [split $pict .
] 0]hi.xpm
4666 proc sim_butUp
{w
} {
4668 set screen
[winfo screen
$w]
4669 $w config
-bitmap $tk_priv(relief
@$screen)
4671 if {$w == $tk_priv(window
@$screen)} {
4672 uplevel #0 [list $w invoke]
4677 proc BindSimButton
{w
} {
4678 bind $w <Any-Enter
> {sim_butEnter
%W
}
4679 bind $w <Any-Leave
> {sim_butLeave
%W
}
4680 bind $w <1> {sim_butDown
%W
}
4681 bind $w <ButtonRelease-1
> {sim_butUp
%W
}
4682 bind $w <2> {sim_butDown
%W
}
4683 bind $w <ButtonRelease-2
> {sim_butUp
%W
}
4684 bind $w <3> {sim_butDown
%W
}
4685 bind $w <ButtonRelease-3
> {sim_butUp
%W
}
4689 ########################################################################
4690 # Internal Callbacks
4693 proc UIStartMicropolis
{homedir resourcedir hostname
} {
4694 global HomeDir ResourceDir HostName HeadWindows
4695 set HomeDir
$homedir
4696 set ResourceDir
$resourcedir
4697 set HostName
$hostname
4702 foreach display
[sim Displays
] {
4703 if {"[AddPlayer $display]" == ""} {
4704 echo Couldn't add a player on
$display ...
4708 if {"$HeadWindows" == ""} {
4709 echo Micropolis is exiting because it couldn't connect to any players.
4715 proc UISelectCity
{win
} {
4716 AskQuestion
[Color
$win #ff0000 #ffffff] "Choose Another City" \
4717 "Do you want to abandon this city and choose another one?" \
4718 "{Keep playing.} SelectCity.No {RejectPlan}" \
4720 "{Another city!} SelectCity.Yes {UIPickScenarioMode}"
4724 proc UIQuit
{head
} {
4725 if {[sim Players
] == 1} {
4726 set l
"{Keep playing.} Quit.No {RejectPlan}"
4728 set r
"{I quit!} Quit.IQuit {DoReallyQuit %s}"
4730 set l
"{Keep playing.} Quit.No {RejectPlan}"
4731 set m
"{I quit!} Quit.IResign {DoIResign %s}"
4732 set r
"{Everyone quit!} Quit.AllQuit {DoReallyQuit %s}"
4734 AskQuestion
[Color
$head #ff0000 #ffffff] "Quit Playing Micropolis" \
4735 "Do you want to quit playing Micropolis?" \
4740 proc DoIResign
{head
} {
4742 set display
[winfo screen
$head]
4744 DecRefDisplay
$display
4745 UISetMessage
"The player on X11 Display $display has resigned."
4747 if {([sim Players
] == 0) ||
4748 ([llength $VotesForAsk] >= [sim Players
])} {
4754 proc DoReallyQuit
{head
} {
4760 proc UISplashMode
{} {
4770 proc UIPickScenarioMode
{} {
4779 InitVotesForUseThisMap
4784 proc ForcePickScenarioMode
{} {
4786 if {"$State" != "scenario"} {
4792 proc UIGenerateCityNow
{} {
4793 global CityName GameLevel
4794 sim CityName NowHere
4800 proc UIGenerateNewCity
{} {
4801 global CityName GameLevel
4802 if {$GameLevel == -1} {
4805 MakeHistory
"DoNewCity NowHere $GameLevel [sim Rand] [sim TreeLevel] [sim LakeLevel] [sim CurveLevel] [sim CreateIsland]"
4809 proc DoNewCity
{name level
{r
""} {tl
-1} {ll
-1} {cl
-1} {ci
-1}} {
4815 sim CreateIsland
$ci
4819 sim GenerateSomeCity
$r
4822 sim GameLevel
$level
4827 proc UIDidGenerateNewCity
{} {
4832 proc IncRefDisplay
{display
} {
4833 global DisplayRegistry
4834 if ![info exists DisplayRegistry
($display)] {
4835 set DisplayRegistry
($display) 0
4837 incr DisplayRegistry
($display)
4841 proc DecRefDisplay
{display
} {
4842 global DisplayRegistry
4843 incr DisplayRegistry
($display) -1
4844 if {$DisplayRegistry($display) <= 0} {
4845 CloseDisplay
$display
4850 proc CloseDisplay
{display
} {
4854 proc DoStopMicropolis
{} {
4860 proc AddPlayer
{display
} {
4861 set i
[string first
: $display]
4865 set display
"$display:0"
4869 echo Adding a player on
$display ...
4871 set head
[MakeWindow.head
$display]
4873 if {"$head" != ""} {
4874 set display
[winfo screen
$head]
4875 IncRefDisplay
$display
4877 UISetMessage
"Added a player on X11 Display \"$display\"."
4880 UISetMessage
"Couldn't add a player on X11 Display \"$display\"!"
4890 proc DropFireBombs
{} {
4898 proc UIMakeMonster
{} {
4899 sim MakeMonster
[sim Rand
120] [sim Rand
100]
4922 proc TogglePause
{} {
4925 if {"$State" != "play" ||
[sim Speed
]} {
4936 proc SetSpeedTime
{time} {
4942 proc MakeRunningSound
{} {
4945 if {"$State" == "play" && [sim Speed
]} {
4946 UIMakeSound edit Boing
"-speed 1[sim Speed]0"
4948 UIMakeSound edit Boing
"-speed 90"
4953 proc SayDemands
{} {
4954 global DemandRes DemandCom DemandInd
4956 set r
[expr "100 + ($DemandRes * $slope)"]
4957 set c
[expr "100 + ($DemandCom * $slope)"]
4958 set i
[expr "100 + ($DemandInd * $slope)"]
4959 after 020 "UIMakeSound edit O \"-speed $r\""
4960 after 220 "UIMakeSound edit A \"-speed $c\""
4961 after 440 "UIMakeSound edit E \"-speed $i\""
4965 proc UISaveCity
{win
} {
4967 set SaveCityWin
$win
4972 proc UISaveCityAs
{{win
""}} {
4974 if {"$win" == ""} {set win
$SaveCityWin}
4975 set SaveCityWin
$win
4978 set file [ShowFileOf
$win]
4979 DoFileDialog
$file "Choose a File to Save the City" $CityDir "*.cty" "" \
4980 "UIDoReallySaveCity" ""
4984 proc UIDoReallySaveCity
{name path
} {
4986 if {![string match
*.cty
$name]} {
4990 sim SaveCityAs
$path/$name
4994 proc UIDidSaveCity
{} {
4995 DoSendMessage
"Saved the city in \"[sim CityFileName]\"." status
4999 proc UIDidntSaveCity
{msg
} {
5000 DoSendMessage
$msg alert
5001 UIMakeSound warning Sorry
"-speed 85"
5005 proc UILoadScenario
{scen
} {
5006 MakeHistory
"DoScenario $scen"
5010 proc DoScenario
{scen
} {
5013 sim LoadScenario
$scen
5018 proc UIDidLoadScenario
{} {
5022 proc UIStartScenario
{id
} {
5031 proc UIPlayNewCity
{} {
5037 proc UIStartLoad
{} {
5042 proc UIReallyStartGame
{} {
5048 proc UIPlayGame
{} {
5055 SetPriority
$Priority
5063 proc UISetSpeed
{speed
} {
5066 if {"$State" == "play"} {
5067 UISetMessage
[lindex {
5070 {Time flows medium.
}
5078 proc UIUpdateRunning
{} {
5079 global HeadWindows Time State
5081 if {($State == "play") && $Time} {
5082 set pict
"@images/micropolisg.xpm"
5084 set pict
"@images/micropoliss.xpm"
5087 foreach win
$HeadWindows {
5088 set can
[WindowLink
$win.demand
]
5089 $can itemconfig micropolis
-bitmap $pict
5094 proc DoSetGameLevel
{level
} {
5095 sim GameLevel
$level
5099 proc UISetGameLevel
{level
} {
5101 set GameLevel
$level
5102 global ScenarioWindows
5103 foreach win
$ScenarioWindows {
5104 UpdateLevelSelection
$win
5109 proc UISetCityName
{name
} {
5110 global EditorWindows
5113 set title
"Micropolis Editor on $name"
5114 foreach win
$EditorWindows {
5115 # TODO: set editor window and icon title
5116 #wm title $win "$title"
5117 #wm iconname $win "$title"
5122 proc UILoadCity
{win
} {
5123 # if changed, r-u-sure?
5125 set file [ShowFileOf
$win]
5126 DoFileDialog
$file "Choose a City to Load" $CityDir "*.cty" "" \
5131 proc UIDoLoadCity
{name path
} {
5134 if {![string match
*.cty
$name]} {
5137 MakeHistory
"DoLoadCity {$path/$name}"
5141 proc DoLoadCity
{filename} {
5142 sim LoadCity
$filename
5145 proc UIDidLoadCity
{} {
5146 global State GameLevel Scenario
5149 if {$State == "play"} {
5152 UIShowPicture
49 [sim CityFileName
]
5157 proc UIDidntLoadCity
{msg
} {
5158 DoSendMessage
$msg alert
5159 UIMakeSound warning Sorry
"-speed 85"
5160 UIShowPicture
49 [sim CityFileName
]
5179 proc UIDidPan
{w x y
} {
5180 if {[$w ToolMode
] == 1} {
5181 EditorToolDrag
$w $x $y
5187 proc UIDidStopPan
{win
} {
5188 UIMakeSoundOn
$win fancy Skid
"-volume 25"
5193 proc UIEarthQuake
{} {
5197 proc UIAutoGoto
{x y
{except
{}}} {
5198 global EditorWindows
5200 set x
[expr "$x * 16 + 8"]
5201 set y
[expr "$y * 16 + 8"]
5202 foreach win
$EditorWindows {
5203 if {"$win" != "$except"} {
5204 set view
[WindowLink
$win.view
]
5205 if {[$view AutoGoto
]} {
5207 $view AutoGoal
$x $y
5217 proc UIAutoGotoOn
{x y eds
} {
5218 set x
[expr "$x * 16 + 8"]
5219 set y
[expr "$y * 16 + 8"]
5221 [WindowLink
$win.view
] AutoGoal
$x $y
5227 proc DoLeaveGame
{head
} {
5231 proc UILoseGame
{} {
5235 AskQuestion
[Color .
#ff0000 #ffffff] [lindex $Messages(200) 1] \
5236 [lindex $Messages(200) 2] \
5239 "{Ok} SelectCity.Yes {UIPickScenarioMode}"
5248 proc DoPendTool
{view tool x y
} {
5249 global HeadWindows ToolInfo VotesForAsk
5251 set win
[WindowLink
$view.top
]
5252 set head
[WindowLink
$win.head
]
5254 if {($tool == [sim PendingTool
]) &&
5255 ($x == [sim PendingX
]) &&
5256 ($y == [sim PendingY
])} {
5257 if {[lsearch $VotesForAsk $head] != -1} {
5258 # you can only vote once
5259 UIMakeSound edit Oop
5261 UIMakeSound edit Boing
5262 set ask
[WindowLink
$head.ask
]
5263 PressVoteButton
$ask [WindowLink
$ask.vote
] Ask
5266 UIAutoGoto
$x $y $win
5268 UIMakeSound edit Boing
5269 set info [lindex $ToolInfo $tool]
5270 set a
[lindex $info 0]
5271 set name
[lindex $info 1]
5272 set cost
[lindex $info 2]
5273 set title
"Build $a $name"
5274 set question
"Do you support the plan to build $a $name for $cost?"
5275 AskQuestion
[Color
$win #00ff00 #ffffff] "$title" \
5277 "{Veto plan.} Plan.Veto
5279 "{Goto plan.} Plan.Goto
5280 {ComeTo %s $x $y}" \
5281 "{Support plan!} Plan.Support
5282 {SupportPlan $view %s $tool $x $y}
5283 {PreviewSupportPlan $view %s $tool $x $y}"
5284 set VotesForAsk
$head
5285 set ask
[WindowLink
$head.ask
]
5286 [WindowLink
$ask.vote
] config
-relief sunken
5290 sim PendingTool
$tool
5293 sim Votes
[llength $VotesForAsk]
5298 proc RejectPlan
{} {
5300 if {[sim Players
] > 1} {
5301 UIMakeSound edit Sorry
5307 proc NeededVotes
{} {
5309 set players
[sim Players
]
5310 set needed
[expr "$players - $FreeVotes"]
5311 return [max
0 $needed]
5315 proc SupportPlan
{view h tool x y
} {
5317 sim Votes
[llength $VotesForAsk]
5320 $view DoTool
$tool $x $y
5323 UIMakeSound edit Aaah
5327 proc PreviewSupportPlan
{view h tool x y
} {
5329 sim Votes
[llength $VotesForAsk]
5333 proc SugarStartUp
{uri
} {
5337 # TODO: Load the city file at the given URI, or configure according to URI parameters.
5341 proc SugarNickName
{nick
} {
5342 global SugarNickName
5343 set SugarNickName
$nick
5347 proc SugarActivate
{} {
5348 global SugarActivated
5349 set SugarActivated
1
5353 proc SugarDeactivate
{} {
5354 global SugarActivated
5355 set SugarActivated
0
5359 proc SugarShare
{} {
5365 proc SugarBuddyAdd
{key nick color address
} {
5367 set buddy
[list $key $nick $color $address]
5368 lappend SugarBuddies
$buddy
5372 proc SugarBuddyDel
{key nick color address
} {
5374 set buddy
[list $key $nick $color $address]
5375 set i
[lsearch $wins $win]
5377 set SugarBuddies
[lreplace $wins $i $i]
5387 ########################################################################