1 #######################################################################
2 # Micropolis.tcl, by Don Hopkins.
3 # Copyright (C) 2002 by Electronic Arts.
4 # This file defines the user interface of Micropolis.
5 # Modify at your own risk!
6 ########################################################################
7 # Micropolis, Unix Version. This game was released for the Unix platform
8 # in or about 1990 and has been modified for inclusion in the One Laptop
9 # Per Child program. Copyright (C) 1989 - 2007 Electronic Arts Inc. If
10 # you need assistance with this program, you may contact:
11 # http://wiki.laptop.org/go/Micropolis or email micropolis@laptop.org.
13 # This program is free software: you can redistribute it and/or modify
14 # it under the terms of the GNU General Public License as published by
15 # the Free Software Foundation, either version 3 of the License, or (at
16 # your option) any later version.
18 # This program is distributed in the hope that it will be useful, but
19 # WITHOUT ANY WARRANTY; without even the implied warranty of
20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 # General Public License for more details. You should have received a
22 # copy of the GNU General Public License along with this program. If
23 # not, see <http://www.gnu.org/licenses/>.
25 # ADDITIONAL TERMS per GNU GPL Section 7
27 # No trademark or publicity rights are granted. This license does NOT
28 # give you any right, title or interest in the trademark SimCity or any
29 # other Electronic Arts trademark. You may not distribute any
30 # modification of this program using the trademark SimCity or claim any
31 # affliation or association with Electronic Arts Inc. or its employees.
33 # Any propagation or conveyance of this program must include this
34 # copyright notice and these terms.
36 # If you convey this program (or any modifications of it) and assume
37 # contractual liability for the program to recipients of it, you agree
38 # to indemnify Electronic Arts for any liability that those contractual
39 # assumptions impose on Electronic Arts.
41 # You may not misrepresent the origins of this program; modified
42 # versions of the program must be marked as such and not identified as
43 # the original program.
45 # This disclaimer supplements the one included in the General Public
46 # License. TO THE FULLEST EXTENT PERMISSIBLE UNDER APPLICABLE LAW, THIS
47 # PROGRAM IS PROVIDED TO YOU "AS IS," WITH ALL FAULTS, WITHOUT WARRANTY
48 # OF ANY KIND, AND YOUR USE IS AT YOUR SOLE RISK. THE ENTIRE RISK OF
49 # SATISFACTORY QUALITY AND PERFORMANCE RESIDES WITH YOU. ELECTRONIC ARTS
50 # DISCLAIMS ANY AND ALL EXPRESS, IMPLIED OR STATUTORY WARRANTIES,
51 # INCLUDING IMPLIED WARRANTIES OF MERCHANTABILITY, SATISFACTORY QUALITY,
52 # FITNESS FOR A PARTICULAR PURPOSE, NONINFRINGEMENT OF THIRD PARTY
53 # RIGHTS, AND WARRANTIES (IF ANY) ARISING FROM A COURSE OF DEALING,
54 # USAGE, OR TRADE PRACTICE. ELECTRONIC ARTS DOES NOT WARRANT AGAINST
55 # INTERFERENCE WITH YOUR ENJOYMENT OF THE PROGRAM; THAT THE PROGRAM WILL
56 # MEET YOUR REQUIREMENTS; THAT OPERATION OF THE PROGRAM WILL BE
57 # UNINTERRUPTED OR ERROR-FREE, OR THAT THE PROGRAM WILL BE COMPATIBLE
58 # WITH THIRD PARTY SOFTWARE OR THAT ANY ERRORS IN THE PROGRAM WILL BE
59 # CORRECTED. NO ORAL OR WRITTEN ADVICE PROVIDED BY ELECTRONIC ARTS OR
60 # ANY AUTHORIZED REPRESENTATIVE SHALL CREATE A WARRANTY. SOME
61 # JURISDICTIONS DO NOT ALLOW THE EXCLUSION OF OR LIMITATIONS ON IMPLIED
62 # WARRANTIES OR THE LIMITATIONS ON THE APPLICABLE STATUTORY RIGHTS OF A
63 # CONSUMER, SO SOME OR ALL OF THE ABOVE EXCLUSIONS AND LIMITATIONS MAY
67 ########################################################################
69 ########################################################################
75 source $tk_library/wish.tcl
78 ########################################################################
80 ########################################################################
84 set State uninitialized
85 set CityName
"Micropolis"
88 set CityLibDir
$SimHome/cities
89 set CityDir
$CityLibDir
93 set BudgetPoliceFund
0
111 set AudioChannels
{mode edit fancy warning intercom
}
114 set BudgetTimerActive
0
116 set EvaluationsVisible
0
117 set SplashScreenDelay
5000
120 set ChatServer
"localhost"
122 set ChatConnection
{}
123 set NickName
"nickname"
124 set UserName
"username"
125 set ServerName
"servername"
126 set RealName
"realname"
127 set ChannelName
"#Micropolis"
131 set LocalHostName
"[exec hostname]"
139 set ShowingPicture
300
143 set VoteNames
{UseThisMap Ask Zone
}
144 set VotesForUseThisMap
{}
147 set VotesForBudget
{}
155 set EvaluationWindows
{}
157 set ScenarioWindows
{}
165 set HeadPanelWidth
360
166 set HeadPanelHeight
200
168 set MapPanelWidth
360
169 set MapPanelHeight
330
171 set NoticePanelWidth
360
172 set NoticePanelHeight
250
174 set SplashPanelWidth
1200
175 set SplashPanelHeight
900
177 set ScenarioPanelWidth
420
178 set ScenarioPanelHeight
440
187 {editor EditorWindows
}
190 {budget BudgetWindows
}
191 {evaluation EvaluationWindows
}
192 {scenario ScenarioWindows
}
193 {splash SplashWindows
}
196 {player PlayerWindows
}
197 {notice NoticeWindows
}
204 # 0 1 2 3 4 5 6 7 8 9 10 11 12 13
205 # type id callback param var x y w h normal over disabled checked checkedover
206 # ----------- --------------- --------------- ------- ------- --- --- --- --- ------- ---- -------- ------- -----------
207 set ScenarioButtons
{
208 { button load DoLoad
"" "" 70 238 157 90 "" @images
/button1hilite.xpm
"" }
209 { button generate DoGenerate
"" "" 62 392 157 90 "" @images
/button2hilite.xpm
"" }
210 { button quit DoQuit
"" "" 68 544 157 90 "" @images
/button3hilite.xpm
"" }
211 { button about DoAbout
"" "" 101 705 157 90 "" @images
/button4hilite.xpm
"" }
212 { checkbox easy DoLevel
0 "" 982 106 190 70 "" @images
/checkbox1hilite.xpm
"" @images
/checkbox1checked.xpm
@images
/checkbox1hilitechecked.xpm
}
213 { checkbox medium DoLevel
1 "" 982 176 190 70 "" @images
/checkbox2hilite.xpm
"" @images
/checkbox2checked.xpm
@images
/checkbox2hilitechecked.xpm
}
214 { checkbox hard DoLevel
2 "" 982 246 190 70 "" @images
/checkbox3hilite.xpm
"" @images
/checkbox3checked.xpm
@images
/checkbox3hilitechecked.xpm
}
215 { button left DoLeft
"" "" 540 375 50 50 "" @images
/lefthilite.xpm
@images
/leftdisabled.xpm
}
216 { button right DoRight
"" "" 841 375 50 50 "" @images
/righthilite.xpm
@images
/rightdisabled.xpm
}
217 { button play DoPlay
"" "" 625 376 180 50 "" @images
/playhilite.xpm
"" }
218 { button scenario1 DoPickScenario
"1" "" 310 451 209 188 "" @images
/scenario1hilite.xpm
"" }
219 { button scenario2 DoPickScenario
"2" "" 519 451 209 188 "" @images
/scenario2hilite.xpm
"" }
220 { button scenario3 DoPickScenario
"3" "" 727 450 209 188 "" @images
/scenario3hilite.xpm
"" }
221 { button scenario4 DoPickScenario
"4" "" 936 450 209 188 "" @images
/scenario4hilite.xpm
"" }
222 { button scenario5 DoPickScenario
"5" "" 310 639 209 188 "" @images
/scenario5hilite.xpm
"" }
223 { button scenario6 DoPickScenario
"8" "" 519 639 209 188 "" @images
/scenario6hilite.xpm
"" }
224 { button scenario7 DoPickScenario
"7" "" 728 638 209 188 "" @images
/scenario7hilite.xpm
"" }
225 { button scenario8 DoPickScenario
"6" "" 937 638 209 188 "" @images
/scenario8hilite.xpm
"" }
228 # Disabled until we handle mouse events on the map itself.
229 # { button map DoMap "" "" 516 30 396 338 "" @images/maphilite.xpm }
232 ########################################################################
238 {-*-dejavu lgc sans-medium-r-normal-
*-90-*}
241 {-*-dejavu lgc sans-medium-r-normal-
*-80-*}
244 {-*-dejavu lgc sans-medium-r-normal-
*-70-*}
247 {-*-dejavu lgc sans-medium-r-normal-
*-60-*}
250 {-*-dejavu lgc sans-medium-r-normal-
*-60-*}
253 {-*-dejavu lgc sans-medium-r-normal-
*-60-*}
256 {-*-dejavu lgc sans-medium-r-normal-
*-70-*}
259 {-*-dejavu lgc sans-medium-r-normal-
*-70-*}
262 {-*-dejavu lgc sans-medium-r-normal-
*-70-*}
267 ########################################################################
271 {Micropolis Overall Map
}
272 {Residential Zone Map
}
273 {Commercial Zone Map
}
274 {Industrial Zone Map
}
277 {Population Density Map
}
279 {Traffic Density Map
}
280 {Pollution Desity Map
}
284 {Police Coverage Map
}
290 leftframe.tools.palletres
291 leftframe.tools.palletcom
292 leftframe.tools.palletind
293 leftframe.tools.palletfire
294 leftframe.tools.palletquery
295 leftframe.tools.palletpolice
296 leftframe.tools.palletwire
297 leftframe.tools.palletbulldozer
298 leftframe.tools.palletrail
299 leftframe.tools.palletroad
300 leftframe.tools.palletchalk
301 leftframe.tools.palleteraser
302 leftframe.tools.palletstadium
303 leftframe.tools.palletpark
304 leftframe.tools.palletseaport
305 leftframe.tools.palletcoal
306 leftframe.tools.palletnuclear
307 leftframe.tools.palletairport
311 set EditorPalletImages
{
312 res com ind fire qry pol
313 wire dozr rail road chlk ersr
314 stad park seap coal nuc airp
318 set EditorPalletSounds
{
319 Res Com Ind Fire Query Police
320 Wire Bulldozer Rail Road Chalk Eraser
321 Stadium Park Seaport Coal Nuclear Airport
329 leftframe.right.money
330 leftframe.right.crime
331 leftframe.right.pollution
335 set GraphPalletImages
{
336 res com ind mony crim poll
340 set GraphYearPallets
{
341 leftframe.year.year10
342 leftframe.year.year120
346 set GraphYearPalletImages
{ 10 120 }
350 { {a
} {Residential Zone
} {$100}}
351 { {a
} {Commercial Zone
} {$100}}
352 { {an
} {Industrial Zone
} {$100}}
353 { {a
} {Fire Station
} {$500}}
354 { {a
} {Query
} {free
}}
355 { {a
} {Police Station
} {$500}}
357 { {a
} {Bulldozer
} {$1}}
360 { {a
} {Chalk
} {free
}}
361 { {an
} {Eraser
} {free
}}
362 { {a
} {Stadium
} {$5,000}}
364 { {a
} {Seaport
} {$3,000}}
365 { {a
} {Coal Power Plant
} {$3,000}}
366 { {a
} {Nuclear Power Plant
} {$5,000}}
367 { {an
} {Airport
} {$10,000}}
368 { {a
} {Network
} {$1,000}}
372 set DynamicDataNames
{
383 ########################################################################
385 ########################################################################
388 wm title .
{Micropolis Root
}
391 if {"[sim Platform]" == "msdos"} {
412 # The next three lines have no effect on the OLPC, where we don't provide
413 # the font in res (because it's already in the system fonts). These lines
414 # are for other systems that lack the font.
415 set FontPath
"[pwd]/res/dejavu-lgc"
416 system
"xset -fp $FontPath >/dev/null 2>&1"
417 system
"xset +fp $FontPath >/dev/null 2>&1"
420 ########################################################################
422 ########################################################################
425 proc Message
{id color title msg
{props
{}}} {
427 set Messages
($id) [list $color $title $msg $props]
431 Message
1 #7f7fff {DULLSVILLE, USA 1900} \
432 {Things haven't changed much around here in the last hundred years or so and the residents are beginning to get bored. They think Dullsville could be the next great city with the right leader.
434 It is your job to attract new growth and development
, turning Dullsville into a Metropolis within
30 years.
}
436 Message
2 #7f7fff {SAN FRANCISCO, CA. 1906} \
437 {Damage from the earthquake was minor compared to that of the ensuing fires
, which took days to control.
1500 people died.
439 Controlling the fires should be your initial concern. Then clear the rubble and start rebuilding. You have
5 years.
}
441 Message
3 #7f7fff {HAMBURG, GERMANY 1944} \
442 {Allied fire-bombing of German cities in WWII caused tremendous damage and loss of life. People living in the inner cities were at greatest risk.
444 You must control the firestorms during the bombing and then rebuild the city
after the war. You have
5 years.
}
446 Message
4 #7f7fff {BERN, SWITZERLAND 1965} \
447 {The roads here are becoming more congested every day
, and the residents are upset. They demand that you do something about it.
449 Some have suggested a mass transit system as the answer
, but this would require major rezoning in the downtown area. You have
10 years.
}
451 Message
5 #7f7fff {TOKYO, JAPAN 1957} \
452 {A large reptilian creature has been spotted heading
for Tokyo bay. It seems to be attracted to the heavy levels of industrial pollution there.
454 Try to control the fires
, then rebuild the industrial center. You have
5 years.
}
456 Message
6 #7f7fff {DETROIT, MI. 1972} \
457 {By
1970, competition from overseas and other economic factors pushed the once
"automobile capital of the world" into recession. Plummeting land values and unemployment then increased crime in the inner-city to chronic levels.
459 You have
10 years to reduce crime and rebuild the industrial base of the city.
}
461 Message
7 #7f7fff {BOSTON, MA. 2010} \
462 {A major meltdown is about to occur at one of the new downtown nuclear reactors. The area in the vicinity of the reactor will be severly contaminated by radiation
, forcing you to restructure the city around it.
464 You have
5 years to get the situation under control.
}
466 Message
8 #7f7fff {RIO DE JANEIRO, BRAZIL 2047} \
467 {In the mid-21st century
, the greenhouse effect raised
global temperatures
6 degrees F. Polar icecaps melted and raised sea levels worldwide. Coastal areas were devastated by flood and erosion.
469 You have
10 years to turn this swamp back into a city again.
}
471 Message
9 #ffa500 {Query Zone Status} \
479 {{view
{PanView
$v $QueryX $QueryY}}}
481 Message
10 #ff4f4f {POLLUTION ALERT!} \
482 {Pollution in your city has exceeded the maximum allowable amounts established by the Micropolis Pollution Agency. You are running the risk of grave ecological consequences.
484 Either clean up your act or
open a gas mask concession at city hall.
} \
485 {{view
{PanView
$v [sim PolMaxX
] [sim PolMaxY
]}}}
487 Message
11 #ff4f4f {CRIME ALERT!} \
488 {Crime in your city is out of hand. Angry mobs are looting and vandalizing the central city. The president will
send in the national guard soon
if you cannot control the problem.
} \
489 {{view
{PanView
$v [sim CrimeMaxX
] [sim CrimeMaxY
]}}}
491 Message
12 #ff4f4f {TRAFFIC WARNING!} \
492 {Traffic in this city is horrible. The city gridlock is expanding. The commuters are getting militant.
494 Either build more roads and rails or get a bulletproof limo.
} \
495 {{view
{PanView
$v [sim TrafMaxX
] [sim TrafMaxY
]}}}
497 Message
20 #ff4f4f {FIRE REPORTED!} \
498 "A fire has been reported!" \
499 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
501 Message
21 #ff4f4f {MONSTER ATTACK!} \
502 "A large reptilian creature has been spotted in the water. It seems to be attracted to areas of high pollution. There is a trail of destruction wherever it goes. \
503 All you can do is wait till he leaves, then rebuild from the rubble." \
504 {{view
{FollowView
$v monster
}}}
506 # XXX: write more text
507 Message
22 #ff4f4f {TORNADO ALERT!} \
508 {A tornado has been reported
! There's nothing you can do to stop it
, so you'd better prepare to clean up
after the disaster
!} \
509 {{view
{FollowView
$v tornado
}}}
511 # XXX: write more text
512 Message
23 #ff4f4f {EARTHQUAKE!} \
513 {A major earthquake has occurred
! Put out the fires as quickly as possible
, before they spread
, then reconnect the power
grid and rebuild the city.
} \
514 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
516 # XXX: write more text
517 Message
24 #ff4f4f {PLANE CRASH!} \
518 {A plane has crashed
!} \
519 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
521 # XXX: write more text
522 Message
25 #ff4f4f {SHIPWRECK!} \
523 {A ship has wrecked
!} \
524 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
526 # XXX: write more text
527 Message
26 #ff4f4f {TRAIN CRASH!} \
528 {A train has crashed
!} \
529 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
531 # XXX: write more text
532 Message
27 #ff4f4f {HELICOPTER CRASH!} \
533 {A helicopter has crashed
!} \
534 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
536 Message
30 #ff4f4f {FIREBOMBING REPORTED!} \
537 {Firebombs are falling
!!} \
538 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
540 Message
35 #7fff7f {TOWN} \
541 {Congratulations
, your village has grown to town status. You now have
2,000 citizens.
} \
542 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
544 Message
36 #7fff7f {CITY} \
545 {Your town has grown into a full sized city
, with a current population of
10,000. Keep up the good work
!} \
546 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
548 Message
37 #7fff7f {CAPITAL} \
549 {Your city has become a capital. The current population here is
50,000. Your political future looks bright.
} \
550 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
552 Message
38 #7fff7f {METROPOLIS} \
553 {Your capital city has now achieved the status of metropolis. The current population is
100,000. With your management skills
, you should seriously consider running
for governor.
} \
554 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
556 Message
39 #7fff7f {MEGALOPOLIS} \
557 {Congratulation
, you have reached the highest category of urban development
, the megalopolis.
559 If you manage to reach this level
, send us email at micropolis
@laptop.org or
send us a copy of your city. We might do something interesting with it.
} \
560 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
562 Message
40 #7fff7f {MEGALINIUM} \
563 {Congratulation
, you have reached the end of
time!
565 Because of the toroidal nature of the the Micropolis Space
/Time Continuum
, your city has wrapped back in
time to
1900!} \
566 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
568 # XXX: write more text
569 Message
41 #ff4f4f {HEAVY TRAFFIC!} \
571 reporting heavy traffic
!} \
572 {{view
{FollowView
$v helicopter
}}}
574 # XXX: write more text
575 Message
42 #ff4f4f {FLOODING REPORTED!} \
576 {Flooding has been been reported along the water's edge
!} \
577 {{view
{PanView
$v [sim FloodX
] [sim FloodY
]}}}
579 Message
43 #ff4f4f {NUCLEAR MELTDOWN!} \
580 {A nuclear meltdown has occured at your power plant. You are advised to avoid the area until the radioactive isotopes decay.
582 Many generations will confront this problem before it goes away
, so don't hold your breath.
} \
583 {{view
{PanView
$v [sim MeltX
] [sim MeltY
]}}}
586 Message
44 #ff4f4f {RIOTS!} \
587 {The citizens are rioting in the streets
, setting cars and houses on fire
, and bombing government buildings and businesses
!
589 All media coverage is blacked out
, while the fascist pigs beat the poor citizens into submission.
}
591 Message
46 #ff4f4f {NO SOUND SERVER!} \
592 {There is no sound server running on your X11 display
"%s". You won't hear any noise unless you run a sound server
, and turn the sound back on in the
"Options" menu.
}
594 Message
48 #7f7fff {Start a New City} \
595 {Build your very own city from the ground up
, starting with this map of uninhabited land.
}
597 Message
49 #7f7fff {Restore a Saved City} \
598 {This city was saved in the
file named
: %s
}
600 Message
100 #7fff7f {YOU'RE A WINNER!} \
601 {Your mayorial skill and city planning expertise have earned you the KEY TO THE CITY. Local residents will erect monuments to your glory and name their first-born children
after you. Why not run
for governor?
} \
602 {{middle
{@images
/key2city.xpm
}}}
604 Message
200 #ff4f4f {IMPEACHMENT NOTICE!} \
605 {The entire population of this city has finally had enough of your inept planning and incompetant management. An angry mob
-- led by your mother
-- has been spotted in the vicinity of city hall.
607 You should seriously consider taking an extended vacation
-- NOW.
(Or
read the manual and try again.
)}
609 Message
300 #ffd700 {About Micropolis} \
610 "Micropolis Version [sim Version] Copyright (C) 2007
612 Based on the Original Micropolis Concept and Design
614 TCL/Tk User Interface Designed and Created
615 by Don Hopkins, DUX Software.
616 Ported to Linux, Optimized and Adapted for OLPC
618 Licensed under the GNU General Public License,
619 version 3, with additional conditions."
622 ########################################################################
624 ########################################################################
627 option add
*CheckButton.relief flat
628 option add
*Dialog.cursor top_left_arrow
629 option add
*Entry.relief sunken
630 option add
*Frame.borderWidth
0
631 option add
*Listbox.relief sunken
632 option add
*Scrollbar.relief sunken
633 option add
*RadioButton.anchor w
634 option add
*RadioButton.relief flat
636 option add
*background
#b0b0b0
637 option add
*foreground
#000000
638 option add
*activeBackground
#d0d0d0
639 option add
*activeForeground
#000000
640 option add
*disabledForeground
""
641 option add
*selectBackground
#d0d0d0
642 option add
*selectForeground
#000000
643 #option add *selector #ffff80
644 option add
*selector
#bf0000
646 option add
*Scrollbar.Background
#b0b0b0
647 option add
*Scrollbar.Foreground
#d0d0d0
648 option add
*Interval.Background
#b0b0b0
649 option add
*Interval.Foreground
#000000
650 option add
*Interval.activeForeground
#d0d0d0
651 option add
*Interval.sliderForeground
#b0b0b0
652 option add
*Scale.activeForeground
#d0d0d0
653 option add
*Scale.sliderForeground
#b0b0b0
654 option add
*PieMenu.activeBackground
#b0b0b0
656 option add Mwm
*Micropolis.clientDecoration
-maximize
659 ########################################################################
661 ########################################################################
664 bind all
<Help
> {HandleHelp
%W
%x
%y
%X
%Y
}
665 bind all
<Shift-ButtonPress
> {HandleHelp
%W
%x
%y
%X
%Y
}
666 bind all
<Meta-ButtonPress
> {HandleHelp
%W
%x
%y
%X
%Y
}
667 bind all
<Shift-Meta-ButtonPress
> {HandleHelp
%W
%x
%y
%X
%Y
}
670 ########################################################################
672 ########################################################################
691 puts stderr
"$errorInfo"
699 proc NoFunction
{args
} {}
702 proc LinkWindow
{fromname to
} {
704 set WindowLinks
($fromname) $to
708 proc WindowLink
{fromname
} {
711 catch {set to
$WindowLinks($fromname)}
716 proc DeleteWindow
{sym name win
} {
717 set head
[WindowLink
$win.head
]
718 LinkWindow
$head.
$sym {}
720 set wins
[eval ident
"\$$name"]
721 set i
[lsearch $wins $win]
723 set $name [lreplace $wins $i $i]
729 proc Font
{win name
} {
730 global FontInfo FontCache HeadWindows
731 set scr
[winfo screen
$win]
734 set font $FontCache($scr,$name)
739 set label $FontCache($scr)
741 if {"$label" == ""} {
742 foreach head
$HeadWindows {
743 if {"[winfo screen $head]" == "$scr"} {
744 set label $head.fontlabel
745 label $label -text "X11 Sucks" -font fixed
746 set FontCache
($scr) $label
751 set fonts
[keylget FontInfo
$name]
752 foreach font $fonts {
753 #echo "Configuring font $font on $label"
754 if {[catch "$label config -font \"$font\""] == 0} {
767 set FontCache
($scr,$name) $font
773 proc Color
{win color mono
} {
774 if {[winfo screendepth
$win] == 1} {
782 ########################################################################
783 # Window Definition Functions
784 ########################################################################
787 proc MakeWindow.head
{{display
":0"}} {
789 source $ResourceDir/whead.tcl
794 proc MakeWindow.editor
{head
{display
":0"}} {
796 source $ResourceDir/weditor.tcl
801 proc MakeWindow.map
{head
{display
":0"}} {
803 source $ResourceDir/wmap.tcl
808 proc MakeWindow.graph
{head
{display
":0"}} {
810 source $ResourceDir/wgraph.tcl
815 proc MakeWindow.budget
{head
{display
":0"}} {
817 source $ResourceDir/wbudget.tcl
822 proc MakeWindow.evaluation
{head
{display
":0"}} {
824 source $ResourceDir/weval.tcl
829 proc MakeWindow.splash
{head
{display
":0"}} {
831 source $ResourceDir/wsplash.tcl
836 proc MakeWindow.scenario
{head
{display
":0"}} {
838 source $ResourceDir/wscen.tcl
843 proc MakeWindow.
file {head
{display
":0"}} {
845 source $ResourceDir/wfile.tcl
850 proc MakeWindow.ask
{head
{display
":0"}} {
852 source $ResourceDir/wask.tcl
857 proc MakeWindow.player
{head
{display
":0"}} {
859 source $ResourceDir/wplayer.tcl
864 proc MakeWindow.notice
{head
{display
":0"}} {
866 source $ResourceDir/wnotice.tcl
870 proc MakeWindow.help
{head
{display
":0"}} {
872 source $ResourceDir/whelp.tcl
876 proc MakeWindow.frob
{head
{display
":0"}} {
878 source $ResourceDir/wfrob.tcl
883 ########################################################################
885 ########################################################################
888 proc UIInitializeSound
{} {
892 proc UIShutDownSound
{} {
896 proc UIDoSoundOn
{win cmd
} {
897 global Sound SoundServers
899 set win
[WindowLink
[winfo toplevel $win].head
]
900 if {[lsearch $SoundServers $win] != -1} {
901 set cmd
"send -quick -server $win Sound sound $cmd"
903 # XXX: Lost a sound server...
911 proc UIDoSound
{cmd
} {
912 global Sound SoundServers
914 foreach win
$SoundServers {
915 set foo
"send -quick -server $win Sound $cmd"
917 # XXX: Lost a sound server...
925 proc KillSoundServers
{} {
927 foreach win
$SoundServers {
928 set foo
"send -quick -server $win Sound KillSoundServer"
935 proc UISetChannelVolume
{win chan vol
} {
936 UIDoSoundOn
$win "channel $chan -volume $vol"
940 proc EchoPlaySound
{soundspec
} {
941 # Temporary workaround to tell Python Sugar app to play sound.
944 #echo PlaySound [lindex $soundspec 0]
945 signal ignore SIGCHLD
946 exec res
/sounds
/player res
/sounds
/[string tolower
[lindex $soundspec 0]].wav
&
951 proc UIMakeSoundOn
{win chan sound
{opts
""}} {
952 # Send message to Python to play sound.
955 #UIDoSoundOn $win "play $sound -replay -channel $chan $opts"
959 proc UIStartSoundOn
{win chan sound
{opts
""}} {
960 # Send message to Python to play sound.
963 #UIDoSoundOn $win "play $sound -replay -channel $chan -repeat 100 $opts"
967 proc UIStopSoundOn
{win chan sound
{opts
""}} {
968 UIDoSoundOn
$win "stop $sound"
972 proc UIMakeSound
{chan sound
{opts
""}} {
973 # Send message to Python to play sound.
976 #UIDoSound "sound play $sound -replay -channel $chan $opts"
980 proc UIStartSound
{chan sound
{opts
""}} {
981 # Send message to Python to play sound.
984 #UIDoSound "sound play $sound -channel $chan -repeat 100 $opts"
988 proc UIStopSound
{chan sound
{opts
""}} {
989 UIDoSound
"sound stop $sound"
993 proc SetupSoundServer
{win
} {
998 proc AddSoundServer
{win
} {
1000 set i
[lsearch $SoundServers $win]
1002 set SoundServers
[linsert $SoundServers 0 $win]
1007 proc LostSoundServer
{win
} {
1008 DeleteSoundServer
$win
1009 # UIShowPictureOn [WindowLink $win.head] 46 [winfo screen $win]
1013 proc DeleteSoundServer
{win
} {
1015 set i
[lsearch $SoundServers $win]
1017 set SoundServers
[lreplace $SoundServers $i $i]
1022 proc UISoundOff
{} {
1026 proc MonsterSpeed
{} {
1027 return [expr "[sim Rand 40] + 70"]
1031 proc ExplosionPitch
{} {
1032 return [expr "[sim Rand 20] + 90"]
1037 return [expr "[sim Rand 20] + 90"]
1041 ########################################################################
1042 # Global Window Handlers
1045 proc WithdrawAll
{} {
1063 proc ShowInitial
{} {
1071 ########################################################################
1072 # Head Window Handlers
1075 proc PrepHead
{head
} {
1082 WithdrawHeadOf
$head
1086 after 1000 "WithdrawSplashOf $head"
1087 WithdrawHeadOf
$head
1088 ShowScenarioOf
$head
1092 WithdrawSplashOf
$head
1093 WithdrawScenarioOf
$head
1098 ReShowPictureOn
$head
1106 proc ShowHeadOf
{head
} {
1111 proc WithdrawHeadOf
{head
} {
1118 foreach win
$HeadWindows {
1124 proc WithdrawHeads
{} {
1126 foreach win
$HeadWindows {
1132 proc DeleteHeadWindow
{head
} {
1139 foreach win
$HeadWindows {
1145 proc InitHead
{win
} {
1146 set w
[WindowLink
$win.
text]
1147 $w configure
-state normal
1150 $w configure
-state disabled
1152 if {[sim MultiPlayerMode
]} {
1153 set w
[WindowLink
$win.
entry]
1164 proc InitAllHeadMenus
{} {
1167 foreach win
$HeadWindows {
1173 proc InitHeadMenus
{win
} {
1175 set m0
[WindowLink
$win.m0
]
1176 set m1
[WindowLink
$win.m1
]
1177 set m2
[WindowLink
$win.m2
]
1178 set m3
[WindowLink
$win.m3
]
1179 set m4
[WindowLink
$win.m4
]
1180 set b0
[WindowLink
$win.b0
]
1181 set b1
[WindowLink
$win.b1
]
1182 set b2
[WindowLink
$win.b2
]
1183 set b3
[WindowLink
$win.b3
]
1184 set b4
[WindowLink
$win.b4
]
1198 # When in multi player mode there is an extra menu
1199 # item to add another player, before the quit item,
1200 # so compensate for it here.
1201 if {[sim MultiPlayerMode
]} {
1206 $b0 config
-state normal
1207 $b2 config
-state disabled
1208 $b4 config
-state disabled
1213 # When in multi player mode there is an extra menu
1214 # item to add another player, before the quit item,
1215 # so compensate for it here.
1216 if {[sim MultiPlayerMode
]} {
1221 $b0 config
-state normal
1222 $b2 config
-state normal
1223 $b4 config
-state normal
1229 proc UIDisaster
{win cmd action
} {
1230 AskQuestion
[Color
$win #ff0000 #ffffff] "Cause a Disaster" \
1231 "Oh no! Do you really want to $action" \
1232 "{No way!} Disaster.No {WithdrawAsks}" \
1234 "{I guess so.} Disaster.Yes {WithdrawAsks ; $cmd}"
1238 proc CrushHead
{head
} {
1239 global SubWindows VoteNames
1241 foreach foo
$VoteNames {
1243 set votes
[eval ident
\$VotesFor$foo]
1244 set i
[lsearch $votes $head]
1246 set VotesFor
$foo [lreplace $votes $i $i]
1250 foreach foo
$SubWindows {
1251 set sym
[lindex $foo 0]
1252 set name
[lindex $foo 1]
1254 set wins
[eval ident
"\$$name"]
1256 if {[WindowLink
$win.head
] == $head} {
1257 DeleteWindow
$sym $name $win
1264 proc ChatDown
{win
} {
1286 global ChatConnection
1288 DoSendMessage
"Opening Connection to Chat Server $ChatServer socket $ChatSocket ..." status
1290 set ChatConnection
{}
1292 set ChatConnection
[connect
$ChatServer $ChatSocket]
1295 if {$ChatConnection == {}} then
{
1296 DoSendMessage
"Sorry, I could not open a connection to chat server $ChatServer socket $ChatSocket." status
1299 filehandler
$ChatConnection r
"ReceiveChat"
1310 puts $ChatConnection "USER $UserName $HostName $ServerName $RealName\r\n" nonewline
1311 puts $ChatConnection "NICK $NickName\r\n" nonewline
1312 puts $ChatConnection "JOIN $ChannelName\r\n" nonewline
1313 flush $ChatConnection
1318 proc ReceiveChat
{mode f
} {
1319 # DoSendMessage "ReceiveChat: MODE $mode F $f"
1323 if {[string first
{:} $msg]} {
1327 set from
[lindex $msg 0]
1328 set cmd
[string tolower
[lindex $msg 1]]
1332 if {($cmd == "privmsg") ||
1333 ($cmd == "notice")} then
{
1335 set chan
[lindex $msg 2]
1336 set i
[expr "[string length $from] + 1 + [string length $cmd] + 1 + [string length $chan] + 2"]
1337 set j
[expr "[string length $msg] - 2"]
1338 set line
[string range
$msg $i $j]
1339 set chan
[string range
$chan 1 [string length
$chan]]
1340 set from
[string range
$from 1 [expr "[string length $from] - 1"]]
1341 set from
[split $from {!}]
1342 set from
[lindex $from 0]
1343 DoSendMessage
"$from> $line"
1346 if {$handled == 0} {
1347 set msg
[string range
$msg \
1348 [expr "[string length $from] + 1"] \
1349 [expr "[string length $msg] - 2"]]
1355 proc SendChatMessage
{msg win
} {
1356 global ChatConnection ChannelName NickName
1362 if {[string range
$msg 0 0] == "/"} {
1363 set cmd
[string range
$msg 1 [string length
$msg]]
1364 DoSendMessage
"$NickName> \[$cmd\]"
1367 set cmd
"PRIVMSG $ChannelName :$msg\r\n"
1368 DoSendMessage
"$NickName> $msg"
1375 puts $ChatConnection $cmd nonewline
1376 flush $ChatConnection
1381 DoSendMessage
"IRC Broke the connection"
1391 global ChatConnection
1393 DoSendMessage
"Closing Connection to Chat Server." status
1396 puts $ChatConnection "QUIT\r\n" nonewline
1397 flush $ChatConnection
1398 $ChatConnection close
1401 set ChatConnection
{}
1406 proc DoEnterMessage
{win var
} {
1409 set msg
[eval ident
"\$\{$var\}"]
1411 if {$Chatting} then
{
1412 SendChatMessage
$msg $win
1420 proc DoEvalMessage
{win var
} {
1422 set command
[eval ident
"\$\{$var\}"]
1424 DoSendMessage
"Evaluating TCL: $command"
1425 catch {uplevel #0 $command} result
1426 DoSendMessage
"Result: $result"
1430 proc DoSendMessage
{msg
{tag
message}} {
1432 foreach win
$HeadWindows {
1433 appendWithTag
[WindowLink
$win.
text] $tag "$msg"
1438 proc UISetMessage
{msg
{tag status
}} {
1439 global DoMessages EditorWindows HeadWindows
1441 if {$DoMessages == 0} {
1445 foreach win
$EditorWindows {
1446 [WindowLink
$win.
message] configure
-text "$msg"
1449 foreach win
$HeadWindows {
1450 appendWithTag
[WindowLink
$win.
text] $tag "$msg"
1457 proc appendWithTag
{w tag
text} {
1461 set start
[$w index end
]
1462 $w configure
-state normal
1463 if {$start > $MaxLines} then
{
1464 $w delete
0.0 $ShrinkLines.0
1465 set start
[$w index end
]
1467 $w insert end
"${text}\n"
1468 $w tag add
$tag $start {end
- 1 char
}
1469 $w configure
-state disabled
1470 $w yview
-pickplace {end
- 1 char
}
1474 ########################################################################
1475 # Budget Window Handlers
1478 proc ShowBudgetOf
{head
} {
1479 set win
[WindowLink
$head.budget
]
1481 set win
[MakeWindow.budget
$head [winfo screen
$head]]
1490 proc ShowBudgets
{} {
1491 global HeadWindows BudgetsVisible
1492 set BudgetsVisible
1
1493 foreach win
$HeadWindows {
1499 proc WithdrawBudgets
{} {
1500 global BudgetWindows BudgetsVisible
1501 foreach win
$BudgetWindows {
1505 set BudgetsVisible
0
1509 proc BudgetContinue
{{win
""}} {
1510 global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1512 if {([sim RoadFund
] != $BudgetRoadFund) ||
1513 ([sim FireFund
] != $BudgetFireFund) ||
1514 ([sim PoliceFund
] != $BudgetPoliceFund) ||
1515 ([sim TaxRate
] != $BudgetTaxRate)} {
1516 UISetMessage
"The budget was changed."
1518 UISetMessage
"The budget wasn't changed."
1526 proc BudgetReset
{{win
""}} {
1527 global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1528 if {([sim RoadFund
] != $BudgetRoadFund) ||
1529 ([sim FireFund
] != $BudgetFireFund) ||
1530 ([sim PoliceFund
] != $BudgetPoliceFund) ||
1531 ([sim TaxRate
] != $BudgetTaxRate)} {
1532 UISetMessage
"The budget was reset."
1533 if {[sim Players
] > 1} {
1534 UIMakeSound edit Sorry
1537 UISetMessage
"The budget was reset."
1539 sim RoadFund
$BudgetRoadFund
1540 sim FireFund
$BudgetFireFund
1541 sim PoliceFund
$BudgetPoliceFund
1542 sim TaxRate
$BudgetTaxRate
1548 proc BudgetCancel
{{win
""}} {
1556 proc SetTaxRate
{rate
} {
1561 proc BudgetSetTaxRate
{rate
} {
1567 proc BudgetSetRoadFund
{percent
} {
1568 sim RoadFund
$percent
1573 proc BudgetSetFireFund
{percent
} {
1574 sim FireFund
$percent
1579 proc BudgetSetPoliceFund
{percent
} {
1580 sim PoliceFund
$percent
1585 proc UIShowBudgetAndWait
{} {
1586 global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1587 if {$OldBudget == 0} {
1588 set BudgetRoadFund
[sim RoadFund
]
1589 set BudgetFireFund
[sim FireFund
]
1590 set BudgetPoliceFund
[sim PoliceFund
]
1591 set BudgetTaxRate
[sim TaxRate
]
1595 UISetMessage
"Pausing to set the budget ..."
1601 sim UpdateBudgetWindow
1605 proc ToggleBudgetTimer
{} {
1606 global BudgetTimerActive
1607 if {$BudgetTimerActive} {
1615 proc StopBudgetTimer
{} {
1616 global BudgetTimerActive
1617 set BudgetTimerActive
0
1622 proc StartBudgetTimer
{} {
1623 global BudgetTimerActive BudgetTimer BudgetTimeout
1625 set BudgetTimerActive
$me
1626 set BudgetTimer
$BudgetTimeout
1628 after 1000 TickBudgetTimer
$me
1632 proc RestartBudgetTimer
{} {
1633 global BudgetTimerActive
1634 if {$BudgetTimerActive} {
1641 proc UpdateBudgetTimer
{} {
1642 global BudgetWindows BudgetTimerActive BudgetTimer
1643 if {$BudgetTimerActive} {
1644 set text [format "Auto Cancel In %d Seconds (click to disable)" $BudgetTimer]
1646 set text [format "Enable Auto Cancel (currently disabled)"]
1648 foreach win
$BudgetWindows {
1649 set t
[WindowLink
$win.timer
]
1650 $t config
-text "$text"
1655 proc TickBudgetTimer
{me
} {
1656 global BudgetTimerActive BudgetTimer BudgetTimeout
1657 if {$BudgetTimerActive == $me} {
1659 if {$BudgetTimer < 0} {
1665 after 1000 TickBudgetTimer
$me
1671 proc FireBudgetTimer
{} {
1681 proc ToggleAutoBudget
{} {
1684 #echo "ToggleAutoBudget found on, clearing"
1687 #echo "ToggleAutoBudget found off, setting"
1693 proc UIUpdateBudget
{} {
1698 proc UpdateAutoBudget
{} {
1699 global BudgetWindows AutoBudget
1700 if {[sim AutoBudget
]} {
1701 set text "Disable Auto Budget (currently enabled)"
1703 set text "Enable Auto Budget (currently disabled)"
1705 #echo "UpdateAutoBudget $AutoBudget $text"
1706 foreach win
$BudgetWindows {
1707 set t
[WindowLink
$win.autobudget
]
1708 $t config
-text "$text"
1713 proc UISetBudget
{cashflow previous current collected taxrate
} {
1714 global BudgetWindows BudgetsVisible
1716 #echo "UISetBudgetValues $taxrate $BudgetsVisible"
1718 if {$BudgetsVisible} {
1720 foreach win
$BudgetWindows {
1721 set w
[WindowLink
$win.cashflow
]
1722 set old
[lindex [$w configure
-text] 4]
1723 if {$old != $cashflow} {
1724 $w configure
-text $cashflow
1726 set w
[WindowLink
$win.previous
]
1727 set old
[lindex [$w configure
-text] 4]
1728 if {$old != $previous} {
1729 $w configure
-text $previous
1731 set w
[WindowLink
$win.current
]
1732 set old
[lindex [$w configure
-text] 4]
1733 if {$old != $current} {
1734 $w configure
-text $current
1736 set w
[WindowLink
$win.collected
]
1737 set old
[lindex [$w configure
-text] 4]
1738 if {$old != $collected} {
1739 $w configure
-text $collected
1742 set w
[WindowLink
$win.taxrate
]
1744 if {$old != $taxrate} {
1748 set w
[WindowLink
$win.taxlabel
]
1749 set old
[lindex [$w configure
-text] 4]
1752 $w configure
-text $new
1758 foreach win
$HeadWindows {
1760 set w
[WindowLink
$win.taxrate
]
1762 if {$old != $taxrate} {
1763 # FIXME: this might not work if the slider is disabled in multi player mode.
1767 set w
[WindowLink
$win.taxlabel
]
1768 set old
[lindex [$w configure
-text] 4]
1769 set new
"Tax Rate: $taxrate%"
1771 $w configure
-text $new
1777 proc UISetBudgetValues
{roadgot roadwant roadpercent policegot policewant policepercent firegot firewant firepercent
} {
1778 global BudgetWindows BudgetsVisible
1780 if {$BudgetsVisible == 0} {
1784 foreach win
$BudgetWindows {
1785 set w
[WindowLink
$win.fire
].request
1786 set old
[lindex [$w configure
-text] 4]
1787 set new
"$firepercent% of $firewant = $firegot"
1789 $w configure
-text $new
1791 set w
[WindowLink
$win.fire
].fund
1793 if {$old != $firepercent} {
1797 set w
[WindowLink
$win.police
].request
1798 set old
[lindex [$w configure
-text] 4]
1799 set new
"$policepercent% of $policewant = $policegot"
1801 $w configure
-text $new
1803 set w
[WindowLink
$win.police
].fund
1805 if {$old != $policepercent} {
1806 $w set $policepercent
1809 set w
[WindowLink
$win.road
].request
1810 set old
[lindex [$w configure
-text] 4]
1811 set new
"$roadpercent% of $roadwant = $roadgot"
1813 $w configure
-text $new
1815 set w
[WindowLink
$win.road
].fund
1817 if {$old != $roadpercent} {
1824 proc ChangeBudget
{} {
1825 global VotesForBudget
1826 if {"$VotesForBudget" != ""} {
1833 proc InitVotesForBudget
{} {
1834 global VotesForBudget BudgetWindows
1835 set VotesForBudget
{}
1836 foreach win
$BudgetWindows {
1837 [WindowLink
$win.vote
] config
-relief raised
1839 UpdateVotesForBudget
1843 proc UpdateVotesForBudget
{} {
1844 global BudgetWindows
1845 UpdateVotesFor Budget
$BudgetWindows
1849 proc UpdateTaxRateSliders
{} {
1851 set players
[sim Players
]
1852 foreach win
$HeadWindows {
1853 set slider
[WindowLink
$win.taxrate
]
1854 #echo "UpdateTaxRateSliders players $players win $win slider $slider"
1855 if {$players == 1} {
1856 $slider configure
-state normal
1858 $slider configure
-state disabled
1864 ########################################################################
1865 # Evaluation Window Handlers
1868 proc ToggleEvaluationOf
{head
} {
1870 if {"$State" != "play"} {
1875 set win
[WindowLink
$head.evaluation
]
1877 set mapped
[winfo ismapped
$win]
1881 WithdrawEvaluationOf
$head
1883 ShowEvaluationOf
$head
1889 proc WithdrawEvaluationOf
{head
} {
1890 set win
[WindowLink
$head.evaluation
]
1897 proc ShowEvaluationOf
{head
} {
1898 set win
[WindowLink
$head.evaluation
]
1900 set win
[MakeWindow.evaluation
$head [winfo screen
$head]]
1904 set parent
[WindowLink
$win.parent
]
1905 #pack append [WindowLink $head.col2]\
1906 # $parent {top frame nw fill}
1907 pack append $parent\
1908 $win {top
frame nw fillx
}
1910 sim UpdateEvaluation
1914 proc WithdrawEvaluations
{} {
1915 global EvaluationWindows EvaluationsVisible
1916 foreach win
$EvaluationWindows {
1918 #set parent [WindowLink $win.parent]
1919 #pack unpack $parent
1922 set EvaluationsVisible
0
1926 proc EvaluationVisible
{w v
} {
1927 global EvaluationsVisible
1928 global [set var
$w.visible
]
1933 set EvaluationsVisible
[expr "$EvaluationsVisible + 1"]
1935 set EvaluationsVisible
[expr "$EvaluationsVisible - 1"]
1940 proc UISetEvaluation
{changed score ps0 ps1 ps2 ps3 pv0 pv1 pv2 pv3 pop delta assessed cityclass citylevel goodyes goodno title
} {
1941 global EvaluationWindows EvaluationsVisible CurrentDate
1943 set class
[string tolower
$cityclass]
1944 UISetMessage
"$CurrentDate: Score $score, $class population $pop."
1946 if {$EvaluationsVisible} {
1948 foreach win
$EvaluationWindows {
1950 global [set var
$win.visible
]
1951 set visible
[eval ident
"\$\{$var\}"]
1955 # TODO: set evaluation window and icon title
1956 #wm title $win "$title"
1957 #wm iconname $win "$title"
1959 set w
[WindowLink
$win.goodjob
]
1960 set old
[lindex [$w configure
-text] 4]
1961 set new
"$goodyes\n$goodno"
1963 $w configure
-text $new
1966 set w
[WindowLink
$win.problemnames
]
1967 set old
[lindex [$w configure
-text] 4]
1968 set new
"$ps0\n$ps1\n$ps2\n$ps3"
1970 $w configure
-text $new
1973 set w
[WindowLink
$win.problempercents
]
1974 set old
[lindex [$w configure
-text] 4]
1975 set new
"$pv0\n$pv1\n$pv2\n$pv3"
1977 $w configure
-text $new
1980 set w
[WindowLink
$win.stats
]
1981 set old
[lindex [$w configure
-text] 4]
1982 set new
"$pop\n$delta\n\n$assessed\n$cityclass\n$citylevel"
1984 $w configure
-text $new
1987 set w
[WindowLink
$win.score
]
1988 set old
[lindex [$w configure
-text] 4]
1989 set new
"$score\n$changed"
1991 $w configure
-text $new
1999 ########################################################################
2000 # File Window Handlers
2003 proc ShowFileOf
{head
} {
2004 set win
[WindowLink
$head.
file]
2006 set win
[MakeWindow.
file $head [winfo screen
$head]]
2016 foreach win
$HeadWindows {
2022 proc WithdrawFiles
{} {
2024 foreach win
$FileWindows {
2030 proc DoFileDialog
{win Message Path Pattern FileName ActionOk ActionCancel
} {
2031 ShowFileDialog
$win "$Path" "$Pattern"
2032 $win.message1 configure
-text "$Message"
2033 $win.path.path delete
0 end
2034 $win.path.path insert
0 $Path
2035 $win.
file.
file delete
0 end
2036 $win.
file.
file insert
0 "$FileName"
2037 $win.frame1.ok config
-command "
2038 $ActionOk \[$win.file.file get\] \[$win.path.path get\]
2040 $win.frame1.rescan config
-command "
2041 ShowFileDialog $win \[$win.path.path get\] $Pattern"
2042 $win.frame1.cancel config
-command "
2045 bind $win.files.files
"<Double-Button-1>" "\
2046 FileSelectDouble $win %W %y $Pattern \"
2047 $ActionOk {\[$win.file.file get\]} {\[$win.path.path get\]}\""
2048 bind $win.path.path
<Return
> "
2049 ShowFileDialog $win \[$win.path.path get\] $Pattern
2050 $win.file.file cursor 0
2051 focus $win.file.file"
2052 bind $win.
file.
file <Return
> "\
2053 $ActionOk \[$win.file.file get\] \[$win.path.path get\]
2058 proc BindSelectOne
{win Y
} {
2059 set Nearest
[$win nearest
$Y]
2060 if {$Nearest >= 0} {
2061 $win select from
$Nearest
2062 $win select to
$Nearest
2067 proc FileSelect
{win widget Y
} {
2068 BindSelectOne
$widget $Y
2069 set Nearest
[$widget nearest
$Y]
2070 if {$Nearest >= 0} {
2071 set Path
[$win.path.path get
]
2072 set TmpEntry
[$widget get
$Nearest]
2073 if {[string compare
"/" [string index
$TmpEntry \
2074 [expr [string length
$TmpEntry]-1]]] == 0 ||
\
2075 [string compare
"@" [string index
$TmpEntry \
2076 [expr [string length
$TmpEntry]-1]]] == 0} {
2077 # handle directories, and symbolic links to directories
2078 set FileName
[string range
$TmpEntry 0 \
2079 [expr [string length
$TmpEntry]-2]]
2080 # whoops / or @ is part of the name
2081 if {[MiscIsDir
$Path/$FileName] != 1} {
2082 set FileName
$TmpEntry
2085 if {[string compare
"*" [string index
$TmpEntry \
2086 [expr [string length
$TmpEntry]-1]]] == 0} {
2087 # handle executable filenames
2088 set FileName
[string range
$TmpEntry 0 \
2089 [expr [string length
$TmpEntry]-2]]
2090 # whoops * is part of the name
2091 if {[file executable
$Path/$FileName] != 1} {
2092 set FileName
$TmpEntry
2095 # a ordinary filename
2096 set FileName
$TmpEntry
2099 # enter the selected filename into the filename field
2100 if {[MiscIsDir
$Path/$FileName] != 1} {
2101 $win.
file.
file delete
0 end
2102 $win.
file.
file insert
0 $FileName
2108 proc FileSelectDouble
{win widget Y Pattern Action
} {
2109 BindSelectOne
$widget $Y
2110 set Nearest
[$widget nearest
$Y]
2111 if {$Nearest >= 0} {
2112 set Path
[$win.path.path get
]
2113 set TmpEntry
[$widget get
$Nearest]
2114 if {[string compare
$TmpEntry "../"] == 0} {
2115 # go up one directory
2117 [string trimright
[string trimright
[string trim
$Path] /] @]
2118 if {[string length
$TmpEntry] <= 0} {
2121 set Path
[file dirname
$TmpEntry]
2122 $win.path.path delete
0 end
2123 $win.path.path insert
0 $Path
2124 ShowFileDialog
$win $Path $Pattern
2126 if {[string compare
"/" [string index
$TmpEntry \
2127 [expr [string length
$TmpEntry]-1]]] == 0 ||
\
2128 [string compare
"@" [string index
$TmpEntry \
2129 [expr [string length
$TmpEntry]-1]]] == 0} {
2130 # handle directorys, and symbolic links to directorys
2131 set FileName
[string range
$TmpEntry 0 \
2132 [expr [string length
$TmpEntry]-2]]
2133 # whoops / or @ is part of the name
2134 if {[MiscIsDir
$Path/$FileName] != 1} {
2135 set FileName
$TmpEntry
2138 if {[string compare
"*" [string index
$TmpEntry \
2139 [expr [string length
$TmpEntry]-1]]] == 0} {
2140 # handle executable filenames
2141 set FileName
[string range
$TmpEntry 0 \
2142 [expr [string length
$TmpEntry]-2]]
2143 # whoops * is part of the name
2144 if {[file executable
$Path/$FileName] != 1} {
2145 set FileName
$TmpEntry
2148 # a ordinary filename
2149 set FileName
$TmpEntry
2153 if {[MiscIsDir
$Path/$FileName] == 1} {
2154 if {[string compare
"/" [string index
$Path \
2155 [expr [string length
$Path]-1]]] == 0} {
2156 append Path
$FileName
2158 append Path
/ $FileName
2160 $win.path.path delete
0 end
2161 $win.path.path insert
0 $Path
2162 ShowFileDialog
$win $Path $Pattern
2164 # enter the selected filename into the filename field
2165 $win.
file.
file delete
0 end
2166 $win.
file.
file insert
0 "$FileName"
2167 if {[string length
$Action] > 0} {
2177 proc NameComplete
{win Type
} {
2182 if {[string compare
$Type path
] == 0} {
2183 set DirName
[file dirname
[$win.path.path get
]]
2184 set FileName
[file tail
[$win.path.path get
]]
2186 set DirName
[file dirname
[$win.path.path get
]/]
2187 set FileName
[file tail
[$win.
file.
file get
]]
2191 if {[MiscIsDir
$DirName] == 1} {
2192 catch "exec ls $DirName/" Result
2194 set ListLength
[llength $Result]
2196 while {$Counter < $ListLength} {
2197 if {[string length
$FileName] == 0} {
2198 if {$FoundCounter == 0} {
2199 set NewFile
[lindex $Result $Counter]
2202 set TmpFile1
$NewFile
2203 set TmpFile2
[lindex $Result $Counter]
2204 set Length1
[string length
$TmpFile1]
2205 set Length2
[string length
$TmpFile2]
2207 if {$Length1 > $Length2} {
2208 set Length1
$Length2
2210 while {$Counter1 < $Length1} {
2211 if {[string compare
[string index
$TmpFile1 $Counter1] \
2212 [string index
$TmpFile2 $Counter1]] == 0} {
2213 append NewFile
[string index
$TmpFile1 $Counter1]
2222 if {[regexp "^$FileName" [lindex $Result $Counter] \
2224 if {$FoundCounter == 0} {
2225 set NewFile
[lindex $Result $Counter]
2228 set TmpFile1
$NewFile
2229 set TmpFile2
[lindex $Result $Counter]
2230 set Length1
[string length
$TmpFile1]
2231 set Length2
[string length
$TmpFile2]
2233 if {$Length1 > $Length2} {
2234 set Length1
$Length2
2236 while {$Counter1 < $Length1} {
2237 if {[string compare
[string index
$TmpFile1 $Counter1] \
2238 [string index
$TmpFile2 $Counter1]] == 0} {
2239 append NewFile
[string index
$TmpFile1 $Counter1]
2253 if {$FoundCounter == 1} {
2254 if {[MiscIsDir
$DirName/$NewFile] == 1} {
2255 if {[string compare
$DirName "/"] == 0} {
2256 $win.path.path delete
0 end
2257 $win.path.path insert
0 "/[string trim [string trim $NewFile /] @]/"
2259 $win.path.path delete
0 end
2260 $win.path.path insert
0 "[string trimright $DirName /]/[string trim [string trim $NewFile /] @]/"
2263 $win.path.path delete
0 end
2264 $win.path.path insert
0 \
2265 "[string trim [string trimright $DirName /] @]/"
2266 $win.
file.
file delete
0 end
2267 $win.
file.
file insert
0 "$NewFile"
2270 if {[MiscIsDir
$DirName/$NewFile] == 1 ||
2271 [string compare
$Type path
] == 0} {
2272 $win.path.path delete
0 end
2273 $win.path.path insert
0 \
2274 "[string trimright $DirName /]/[string trim [string trim $NewFile /] @]"
2276 $win.path.path delete
0 end
2277 $win.path.path insert
0 "$DirName"
2278 if {[string length
$NewFile] > 0} {
2279 $win.
file.
file delete
0 end
2280 $win.
file.
file insert
0 "$NewFile"
2287 proc ShowFileDialog
{win Path Pattern
} {
2289 set Path
[lindex [split $Path] 0]
2290 if {[$win.files.files size
] > 0} {
2291 $win.files.files delete
0 end
2294 if {[catch "exec ls -F $Path" Result
]} {
2297 if {[string match
$Result "* not found"]} {
2300 set ElementList
[lsort [split $Result "\n"]]
2303 if {[string compare
$Path "/"]} {
2304 $win.files.files insert end
"../"
2308 foreach Counter
$ElementList {
2310 if {[string match
$Pattern $Counter] == 1} {
2311 if {[string compare
$Counter "../"] &&
2312 [string compare
$Counter "./"]} {
2313 $win.files.files insert end
$Counter
2316 set fn
$Path/[string trim
[string trim
[string trim
$Counter /] @] *]
2317 if {[MiscIsDir
$fn]} {
2318 $win.files.files insert end
$Counter
2326 proc MiscIsDir
{PathName
} {
2328 if {[file isdirectory
$PathName] == 1} {
2331 catch "file type $PathName" Type
2332 if {[string compare
$Type link
] == 0} {
2333 set LinkName
[file readlink
$PathName]
2334 catch "file type $LinkName" Type
2335 while {[string compare
$Type link
] == 0} {
2336 set LinkName
[file readlink
$LinkName]
2338 return [file isdirectory
$LinkName]
2345 proc busy
{win cmds
} {
2347 set list [winfo children
$win]
2349 while {$list != ""} {
2352 set class
[winfo class
$w]
2353 set cursor
[lindex [$w config
-cursor] 4]
2354 if {[winfo toplevel $w] == $w} {
2355 lappend busy
[list $w $cursor]
2357 set next
[concat $next [winfo children
$w]]
2363 catch {[lindex $w 0] config
-cursor watch
}
2368 set error [catch {uplevel eval [list $cmds]} result
]
2371 catch {[lindex $w 0] config
-cursor [lindex $w 1]}
2382 ########################################################################
2383 # Editor Window Handlers
2385 proc ShowEditorOf
{head
} {
2386 global EditorWindows
2388 foreach win
$EditorWindows {
2389 if {[WindowLink
$win.head
] == $head} {
2390 set parent
[WindowLink
$win.parent
]
2391 #pack append [WindowLink $head.col2]\
2392 # $parent {top frame nw expand fill}
2393 pack append $parent\
2394 $win {top
frame nw expand fill
}
2408 proc NewEditorOf
{head
} {
2409 set win
[MakeWindow.editor
$head [winfo screen
$head]]
2411 set parent
[WindowLink
$win.parent
]
2412 pack append $parent\
2413 $win {top
frame nw expand fill
}
2420 proc ShowEditors
{} {
2422 foreach win
$HeadWindows {
2428 proc WithdrawEditors
{} {
2429 global EditorWindows
2430 foreach win
$EditorWindows {
2431 #set parent [WindowLink $win.parent]
2432 #pack unpack $parent
2438 proc InitEditors
{} {
2439 global EditorWindows
2440 foreach win
$EditorWindows {
2446 proc InitEditor
{win
} {
2447 set e
[WindowLink
$win.view
]
2448 UISetToolState
$win 7
2453 global $e.TrackState
2454 set $e.TrackState
{}
2458 proc SetEditorAutoGoto
{win val
} {
2459 global AutoGoto.
$win
2460 set AutoGoto.
$win $val
2461 set e
[WindowLink
$win.view
]
2466 proc SetEditorControls
{win val
} {
2467 global Controls.
$win
2468 set Controls.
$win $val
2470 pack append $win $win.leftframe
{left
frame center filly
}
2472 pack unpack
$win.leftframe
2477 proc SetEditorOverlay
{win val
} {
2479 set Overlay.
$win $val
2480 set e
[WindowLink
$win.view
]
2485 proc SetEditorDynamicFilter
{win val
} {
2486 global DynamicFilter.
$win
2487 set DynamicFilter.
$win $val
2488 set e
[WindowLink
$win.view
]
2489 $e DynamicFilter
$val
2490 if {$val == 1} then
{
2491 ShowFrobOf
[WindowLink
$win.head
]
2496 proc SetEditorSkip
{win val
} {
2497 set e
[WindowLink
$win.view
]
2502 proc EditorToolDown
{mod w x y
} {
2503 global [set var
$w.TrackState
]
2507 case
[$w ToolState
] in
\
2509 UIMakeSoundOn
$w edit Rumble
"-repeat 4"
2517 set $var [list constrain_start
$x $y]
2518 $w ToolConstrain
$x $y
2523 EditorTool ToolDown
$w $x $y
2528 proc EditorToolDrag
{w x y
} {
2529 EditorTool ToolDrag
$w $x $y
2534 proc EditorToolUp
{w x y
} {
2535 global [set var
$w.TrackState
]
2538 case
[$w ToolState
] in
\
2540 UIStopSoundOn
$w edit
1
2546 EditorTool ToolUp
$w $x $y
2548 $w ToolConstrain
-1 -1
2555 proc EditorTool
{action w x y
} {
2556 global [set var
$w.TrackState
]
2557 set state
[eval ident
"\$\{$var\}"]
2558 case
[lindex $state 0] in
\
2560 set x0
[lindex $state 1]
2561 set y0
[lindex $state 2]
2562 set dx
[expr "$x - $x0"]
2563 set dy
[expr "$y - $y0"]
2564 if [expr "($dx > 16) || ($dx < -16)"] then
{
2565 $w ToolConstrain
-1 $y0
2568 if [expr "($dy > 16) || ($dy < -16)"] then
{
2569 $w ToolConstrain
$x0 -1
2578 proc StartChalk
{w
} {
2579 sim CollapseMotion
0
2583 proc StopChalk
{w
} {
2584 sim CollapseMotion
1
2588 proc EditorPanDown
{mod w x y
} {
2589 global [set var
$w.TrackState
]
2593 set $var [list constrain_start
$x $y]
2594 $w ToolConstrain
$x $y
2599 EditorTool PanStart
$w $x $y
2603 proc EditorPanDrag
{w x y
} {
2604 EditorTool PanTo
$w $x $y
2608 proc EditorPanUp
{w x y
} {
2611 EditorTool PanTo
$w $x $y
2612 $w ToolConstrain
-1 -1
2618 proc EditorKeyDown
{w k
} {
2623 proc EditorKeyUp
{w k
} {
2628 proc BindEditorButtons
{win
} {
2629 set w
[WindowLink
$win.top
]
2631 bind $win <1> "CancelPie $win ; EditorToolDown none %W %x %y"
2632 bind $win <B1-Motion
> {EditorToolDrag
%W
%x
%y
}
2633 bind $win <ButtonRelease-1
> {EditorToolUp
%W
%x
%y
}
2635 bind $win <Control-1
> "CancelPie $win ; EditorToolDown constrain %W %x %y"
2636 bind $win <Control-B1-Motion
> {EditorToolDrag
%W
%x
%y
}
2637 bind $win <Control-ButtonRelease-1
> {EditorToolUp
%W
%x
%y
}
2639 bind $win <2> "CancelPie $win ; EditorPanDown none %W %x %y"
2640 bind $win <B2-Motion
> {EditorPanDrag
%W
%x
%y
}
2641 bind $win <ButtonRelease-2
> {EditorPanUp
%W
%x
%y
}
2643 bind $win <Control-2
> "CancelPie $win ; EditorPanDown constrain %W %x %y"
2644 bind $win <Control-B2-Motion
> {EditorPanDrag
%W
%x
%y
}
2645 bind $win <Control-ButtonRelease-2
> {EditorPanUp
%W
%x
%y
}
2647 InitPie
$win $w.toolpie
2651 proc UISetFunds
{funds
} {
2653 foreach win
$HeadWindows {
2654 [WindowLink
$win.funds
] configure
-text "$funds"
2659 proc UISetDate
{date month year
} {
2663 set CurrentDate
"$date"
2665 foreach win
$HeadWindows {
2666 [WindowLink
$win.date
] Set
$month $year
2671 proc SetPriority
{index
} {
2697 proc UISetDemand
{r c i
} {
2698 global HeadWindows DemandRes DemandCom DemandInd
2704 if {$r <= 0} then
{set ry0
32} else {set ry0
24}
2705 set ry1
[expr "$ry0 - $r"]
2706 if {$c <= 0} then
{set cy0
32} else {set cy0
24}
2707 set cy1
[expr "$cy0 - $c"]
2708 if {$i <= 0} then
{set iy0
32} else {set iy0
24}
2709 set iy1
[expr "$iy0 - $i"]
2711 foreach win
$HeadWindows {
2712 set can
[WindowLink
$win.demand
]
2713 # $can coords r 8 $ry0 14 $ry1
2714 # $can coords c 17 $cy0 23 $cy1
2715 # $can coords i 26 $iy0 32 $iy1
2716 $can coords r
49 $ry0 55 $ry1
2717 $can coords c
58 $cy0 64 $cy1
2718 $can coords i
67 $iy0 73 $iy1
2723 proc UISetOptions
{autobudget autogoto autobulldoze disasters sound animation messages notices
} {
2724 global AutoBudget AutoGoto AutoBulldoze Disasters Sound
2725 set AutoBudget
$autobudget
2726 set AutoGoto
$autogoto
2727 set AutoBulldoze
$autobulldoze
2728 set Disasters
$disasters
2730 set DoAnimation
$animation
2731 set DoMessages
$messages
2732 set DoNotices
$notices
2736 proc UIDidToolRes
{win x y
} {
2737 UIMakeSoundOn
$win edit O
"-speed 140"
2741 proc UIDidToolCom
{win x y
} {
2742 UIMakeSoundOn
$win edit A
"-speed 140"
2746 proc UIDidToolInd
{win x y
} {
2747 UIMakeSoundOn
$win edit E
"-speed 140"
2751 proc UIDidToolFire
{win x y
} {
2752 UIMakeSoundOn
$win edit O
"-speed 130"
2756 proc UIDidToolQry
{win x y
} {
2757 UIMakeSoundOn
$win edit E
"-speed 200"
2761 proc UIDidToolPol
{win x y
} {
2762 UIMakeSoundOn
$win edit E
"-speed 130"
2766 proc UIDidToolWire
{win x y
} {
2767 UIMakeSoundOn
$win edit O
"-speed 120"
2771 proc UIDidToolDozr
{win x y
} {
2772 UIMakeSoundOn
$win edit Rumble
2776 proc UIDidToolRail
{win x y
} {
2777 UIMakeSoundOn
$win edit O
"-speed 100"
2781 proc UIDidToolRoad
{win x y
} {
2782 UIMakeSoundOn
$win edit E
"-speed 100"
2786 proc UIDidToolChlk
{win x y
} {
2790 proc UIDidToolEraser
{win x y
} {
2794 proc UIDidToolStad
{win x y
} {
2795 UIMakeSoundOn
$win edit O
"-speed 90"
2799 proc UIDidToolPark
{win x y
} {
2800 UIMakeSoundOn
$win edit A
"-speed 130"
2804 proc UIDidToolSeap
{win x y
} {
2805 UIMakeSoundOn
$win edit E
"-speed 90"
2809 proc UIDidToolCoal
{win x y
} {
2810 UIMakeSoundOn
$win edit O
"-speed 75"
2814 proc UIDidToolNuc
{win x y
} {
2815 UIMakeSoundOn
$win edit E
"-speed 75"
2819 proc UIDidToolAirp
{win x y
} {
2820 UIMakeSoundOn
$win edit A
"-speed 50"
2824 proc UISetToolState
{w state
} {
2825 global EditorPallets EditorPalletImages ToolInfo
2826 set win
[WindowLink
$w.top
]
2827 #echo "UISETTOOLSTATE w $w win $win $state"
2828 ExclusivePallet
$state $win $EditorPallets ic
$EditorPalletImages \
2829 raised sunken
{NoFunction
}
2831 set c1
[WindowLink
$w.cost1
]
2833 set info [lindex $ToolInfo $state]
2834 set cost1
[lindex $info 1]
2835 set cost2
[lindex $info 2]
2836 $c1 configure
-text "$cost1"
2837 [WindowLink
$w.cost2
] configure
-text "$cost2"
2842 proc UIShowZoneStatus
{zone density value crime pollution growth x y
} {
2843 global QueryX QueryY
2844 set QueryX
[expr "8 + 16 * $x"]
2845 set QueryY
[expr "8 + 16 * $y"]
2846 UIShowPicture
9 [list $zone $density $value $crime $pollution $growth]
2850 ########################################################################
2851 # Map Window Handlers
2854 proc ShowMapOf
{head
} {
2857 foreach win
$MapWindows {
2858 if {"[WindowLink $win.head]" == "$head"} {
2859 global MapPanelWidth MapPanelHeight
2860 #place configure $win -x 0 -y 0 -width $MapPanelWidth -height $MapPanelHeight
2861 #[WindowLink $win.parent] configure -width $MapPanelWidth -height $MapPanelHeight
2862 set parent
[WindowLink
$win.parent
]
2863 pack append [WindowLink
$head.w2
] \
2864 $win {top
frame nw expand fill
}
2877 proc NewMapOf
{head
} {
2878 set win
[MakeWindow.map
$head [winfo screen
$head]]
2879 global MapPanelWidth MapPanelHeight
2880 #place configure $win -x 0 -y 0 -width $MapPanelWidth -height $MapPanelHeight
2881 #[WindowLink $win.parent] configure -width $MapPanelWidth -height $MapPanelHeight
2882 set parent
[WindowLink
$win.parent
]
2883 #pack append [WindowLink $head.col1]\
2884 # $parent {top frame nw fillx}
2885 pack append [WindowLink
$head.w2
] \
2886 $win {top
frame nw expand fill
}
2893 foreach win
$HeadWindows {
2899 proc WithdrawMaps
{} {
2901 foreach win
$MapWindows {
2910 foreach win
$MapWindows {
2916 proc InitMap
{win
} {
2921 proc EnableMaps
{} {
2923 foreach win
$MapWindows {
2929 proc EnableMap
{win
} {
2930 [WindowLink
$win.view
] ShowEditors
1
2931 [WindowLink
$win.zones
] config
-state normal
2932 [WindowLink
$win.overlays
] config
-state normal
2936 proc DisableMaps
{} {
2938 foreach win
$MapWindows {
2944 proc DisableMap
{win
} {
2945 [WindowLink
$win.view
] ShowEditors
0
2946 [WindowLink
$win.zones
] config
-state disabled
2947 [WindowLink
$win.overlays
] config
-state disabled
2951 proc SetMapState
{win state
} {
2952 set m
[WindowLink
$win.view
]
2954 if {$state == 14} then
{
2955 ShowFrobOf
[WindowLink
$win.head
]
2960 proc MapPanDown
{w x y
} {
2965 proc MapPanDrag
{w x y
} {
2970 proc MapPanUp
{w x y
} {
2977 proc UISetMapState
{w state
} {
2979 #set win [winfo toplevel $w]
2980 set win
[WindowLink
$w.win
]
2981 set m
[WindowLink
$win.view
]
2982 set title
[lindex $MapTitles $state]
2984 # TODO: set map text field header to title
2985 #wm title $win "$title"
2986 #wm iconname $win "$title"
2988 global [set var MapState.
$win]
2992 {6 8 9 10 11 12 13} {
2993 [WindowLink
$win.legend
] config
-bitmap "@images/legendmm.xpm"
2996 [WindowLink
$win.legend
] config
-bitmap "@images/legendpm.xpm"
2999 [WindowLink
$win.legend
] config
-bitmap "@images/legendn.xpm"
3005 ########################################################################
3006 # Graph Window Handlers
3009 proc ToggleGraphOf
{head
} {
3011 if {"$State" != "play"} {
3016 set win
[WindowLink
$head.graph
]
3018 set mapped
[winfo ismapped
$win]
3022 WithdrawGraphOf
$head
3030 proc WithdrawGraphOf
{head
} {
3031 set win
[WindowLink
$head.graph
]
3038 proc ShowGraphOf
{head
} {
3039 set win
[WindowLink
$head.graph
]
3041 set win
[MakeWindow.graph
$head [winfo screen
$head]]
3045 set parent
[WindowLink
$win.parent
]
3046 pack append $parent\
3047 $win {top
frame nw fillx
}
3053 proc WithdrawGraphs
{} {
3055 foreach win
$GraphWindows {
3062 proc InitGraphs
{} {
3064 foreach win
$GraphWindows {
3070 proc InitGraph
{win
} {
3071 UISetGraphState
$win 1 1 1 1 1 1 0
3075 proc UISetGraphState
{win t0 t1 t2 t3 t4 t5 range
} {
3076 set g
[WindowLink
$win.graphview
]
3077 GraphPalletMask
$win [expr "$t0 + ($t1<<1) + ($t2<<2) + ($t3<<3) + ($t4<<4) + ($t5<<5)"]
3078 GraphYearPallet
$win $range
3082 ########################################################################
3083 # Splash Window Handlers
3086 proc ShowSplashOf
{head
} {
3087 set win
[WindowLink
$head.splash
]
3089 set win
[MakeWindow.splash
$head [winfo screen
$head]]
3091 set splashscreen
[WindowLink
$win.splashscreen
]
3093 catch {$splashscreen config
-bitmap "@images/splashscreen.xpm"; set success 1}
3096 global SplashScreenDelay
3097 after $SplashScreenDelay "UIPickScenarioMode"
3104 proc WithdrawSplashOf
{head
} {
3105 set win
[WindowLink
$head.splash
]
3112 proc ShowSplashes
{} {
3114 foreach win
$HeadWindows {
3120 proc WithdrawSplashes
{} {
3121 global SplashWindows
3122 foreach win
$SplashWindows {
3124 set splashscreen
[WindowLink
$win.splashscreen
]
3125 $splashscreen config
-bitmap ""
3130 proc InitSplashes
{} {
3134 proc InitSplash
{win
} {
3138 proc DeleteSplashWindow
{win
} {
3143 ########################################################################
3144 # Scenario Window Handlers
3147 proc ShowScenarioOf
{head
} {
3148 set win
[WindowLink
$head.scenario
]
3150 set win
[MakeWindow.scenario
$head [winfo screen
$head]]
3152 # TODO: load background bitmap
3157 proc WithdrawScenarioOf
{head
} {
3158 set win
[WindowLink
$head.scenario
]
3165 proc ShowScenarios
{} {
3167 foreach win
$HeadWindows {
3173 proc WithdrawScenarios
{} {
3174 global ScenarioWindows
3175 foreach win
$ScenarioWindows {
3177 # TODO: flush background bitmap
3182 proc InitScenarios
{} {
3183 global MapHistory MapHistoryNum
3184 if {$MapHistoryNum < 1} {
3189 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3194 global ScenarioWindows
3195 foreach win
$ScenarioWindows {
3197 #[WindowLink $win.previous] config -state $prev
3198 #[WindowLink $win.next] config -state $next
3203 proc InitScenario
{win
} {
3204 global MapHistory MapHistoryNum
3205 if {$MapHistoryNum < 1} {
3211 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3218 #[WindowLink $win.previous] config -state $prev
3219 #[WindowLink $win.next] config -state $next
3221 LinkWindow
$win.scenarioTarget
-1
3222 LinkWindow
$win.scenarioTargetDown
-1
3224 global ScenarioButtons
3226 set len
[llength $ScenarioButtons]
3228 set data
[lindex $ScenarioButtons $i]
3229 set type
[lindex $data 0]
3230 set id
[lindex $data 1]
3234 LinkWindow
$win.
$id.over
0
3235 LinkWindow
$win.
$id.enabled
1
3236 LinkWindow
$win.
$id.checked
0
3237 #echo "SETTING WIN $win ID $id"
3239 set i
[expr "$i + 1"]
3242 UpdateLevelSelection
$win
3243 UpdateLeftRightEnabled
$win
3247 proc UpdateLevelSelection
{win
} {
3248 #echo UpdateLevelSelection
3250 if {$GameLevel == 0} then
{
3251 LinkWindow
$win.easy.checked
1
3252 LinkWindow
$win.medium.checked
0
3253 LinkWindow
$win.hard.checked
0
3255 if {$GameLevel == 1} then
{
3256 LinkWindow
$win.easy.checked
0
3257 LinkWindow
$win.medium.checked
1
3258 LinkWindow
$win.hard.checked
0
3260 if {$GameLevel == 2} then
{
3261 LinkWindow
$win.easy.checked
0
3262 LinkWindow
$win.medium.checked
0
3263 LinkWindow
$win.hard.checked
1
3266 UpdateScenarioButtonID
$win easy
3267 UpdateScenarioButtonID
$win medium
3268 UpdateScenarioButtonID
$win hard
3273 proc UpdateLeftRightEnabled
{win
} {
3274 #echo UpdateLeftRightEnabled
3276 global MapHistory MapHistoryNum
3277 if {$MapHistoryNum < 1} {
3278 LinkWindow
$win.left.enabled
0
3280 LinkWindow
$win.left.enabled
1
3283 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3284 LinkWindow
$win.right.enabled
0
3286 LinkWindow
$win.right.enabled
1
3289 UpdateScenarioButtonID
$win left
3290 UpdateScenarioButtonID
$win right
3294 proc UpdateScenarioButtonID
{win id
} {
3296 global ScenarioButtons
3298 set len
[llength $ScenarioButtons]
3300 set data
[lindex $ScenarioButtons $i]
3302 if {$id == [lindex $data 1]} then
{
3303 UpdateScenarioButton
$win $data
3307 set i
[expr "$i + 1"]
3312 proc UpdateScenarioButton
{win data
} {
3313 set type
[lindex $data 0]
3314 set id
[lindex $data 1]
3315 set over
[WindowLink
$win.
$id.over
]
3316 set enabled
[WindowLink
$win.
$id.enabled
]
3317 set checked
[WindowLink
$win.
$id.checked
]
3318 #echo "WIN $win TYPE $type ID $id OVER $over ENABLED $enabled CHECKED $checked"
3322 set bm
[lindex $data 13]
3324 set bm
[lindex $data 12]
3328 set bm
[lindex $data 10]
3330 set bm
[lindex $data 9]
3334 set bm
[lindex $data 11]
3337 [WindowLink
$win.
canvas] itemconfig
$id -bitmap $bm
3341 proc DoEnterCityName
{win
} {
3345 proc InitVotesForUseThisMap
{} {
3346 # TODO: Disabled for new scenario window.
3349 global VotesForUseThisMap ScenarioWindows
3350 set VotesForUseThisMap
{}
3351 foreach win
$ScenarioWindows {
3352 [WindowLink
$win.vote
] config
-relief raised
3354 UpdateVotesForUseThisMap
3358 proc UpdateVotesForUseThisMap
{} {
3359 global ScenarioWindows
3360 UpdateVotesFor UseThisMap
$ScenarioWindows
3364 proc UIUseThisMap
{} {
3365 global CityName GameLevel Scenario
3367 # special handling for scenarios?
3368 if {$GameLevel != -1} {
3369 sim GameLevel
$GameLevel
3371 sim CityName
$CityName
3374 if {$Scenario != -1} {
3375 UIShowPicture
$Scenario
3380 proc HandleScenarioDown
{win x y
} {
3381 #echo HandleScenarioDown $win $x $y
3382 HandleScenarioMove
$win $x $y
3383 set w
[WindowLink
$win.w
]
3384 set target
[WindowLink
$w.scenarioTarget
]
3385 LinkWindow
$w.scenarioTargetDown
$target
3389 proc HandleScenarioUp
{win x y
} {
3390 #echo HandleScenarioUp $win $x $y
3391 HandleScenarioMove
$win $x $y
3392 global ScenarioButtons
3393 set w
[WindowLink
$win.w
]
3394 set target
[WindowLink
$w.scenarioTarget
]
3395 set targetDown
[WindowLink
$w.scenarioTargetDown
]
3396 if {($target != -1) &&
3397 ($target == $targetDown)} {
3398 set data
[lindex $ScenarioButtons $target]
3399 set type
[lindex $data 0]
3400 set id
[lindex $data 1]
3401 set callback
[lindex $data 2]
3402 set param
[lindex $data 3]
3403 set var
[lindex $data 4]
3404 set xx
[lindex $data 5]
3405 set yy
[lindex $data 6]
3406 set ww
[lindex $data 7]
3407 set hh
[lindex $data 8]
3408 set normal
[lindex $data 9]
3409 set over
[lindex $data 10]
3410 set disabled
[lindex $data 11]
3411 if {$type == "button"} {
3412 #echo callback $callback w $w param $param
3413 eval "$callback $w {$param}"
3415 if {$type == "checkbox"} {
3416 #echo checkbox callback $callback w $w param $param
3417 eval "$callback $w {$param}"
3424 proc HandleScenarioMove
{win x y
} {
3425 #echo HandleScenarioMove $win $x $y
3426 global ScenarioButtons
3427 set w
[WindowLink
$win.w
]
3428 set target
[WindowLink
$w.scenarioTarget
]
3431 set len
[llength $ScenarioButtons]
3433 set data
[lindex $ScenarioButtons $i]
3434 set type
[lindex $data 0]
3435 set id
[lindex $data 1]
3436 set callback
[lindex $data 2]
3437 set param
[lindex $data 3]
3438 set var
[lindex $data 4]
3439 set xx
[lindex $data 5]
3440 set yy
[lindex $data 6]
3441 set ww
[lindex $data 7]
3442 set hh
[lindex $data 8]
3444 set enabled
[WindowLink
$w.
$id.enabled
]
3445 set checked
[WindowLink
$w.
$id.checked
]
3447 #echo "ID $id ENABLED $enabled CHECKED $checked w $w id $id"
3449 if {($enabled != 0) &&
3451 ($x < ($xx + $ww)) &
3453 ($y < ($yy + $hh))} {
3458 set i
[expr "$i + 1"]
3461 if {$found != $target} {
3464 if {$target != -1} {
3466 #echo OUT $w $found $xx $yy $normal
3467 LinkWindow
$w.scenarioTarget
-1
3469 set targetdata
[lindex $ScenarioButtons $target]
3470 set targetid
[lindex $targetdata 1]
3471 LinkWindow
$w.
$targetid.over
0
3472 UpdateScenarioButton
$w $targetdata
3477 #echo IN $w $found $xx $yy $over
3478 LinkWindow
$w.scenarioTarget
$found
3479 LinkWindow
$w.
$id.over
1
3481 if {$target != -1} {
3482 set targetdata
[lindex $ScenarioButtons $target]
3483 set targetid
[lindex $targetdata 1]
3484 LinkWindow
$w.
$targetid.over
0
3485 UpdateScenarioButton
$w $targetdata
3488 UpdateScenarioButton
$w $data
3494 proc DoLoad
{win param
} {
3495 #echo DOLOAD $win $param
3500 proc DoGenerate
{win param
} {
3501 #echo DOGENERATE $win $param
3506 proc DoQuit
{win param
} {
3507 #echo DOQUIT $win $param
3512 proc DoAbout
{win param
} {
3513 #echo DOABOUT $win $param
3514 MakeHistory
"DoLoadCity cities/about.cty"
3518 proc DoMap
{win param
} {
3519 #echo DOMAP $win $param
3523 proc DoLevel
{win param
} {
3524 #echo DOLEVEL $win $param
3525 DoSetGameLevel
$param
3529 proc DoLeft
{win param
} {
3530 #echo DOLEFT $win $param
3535 proc DoRight
{win param
} {
3536 #echo DORIGHT $win $param
3541 proc DoPlay
{win param
} {
3542 #echo DOPLAY $win $param
3547 proc DoPickScenario
{win param
} {
3548 #echo DOPICKSCENARIO $win $param
3549 UILoadScenario
$param
3552 proc DeleteScenarioWindow
{win
} {
3557 ########################################################################
3558 # Undo/Redo Facility
3561 proc InitHistory
{} {
3563 global MapHistoryNum
3565 set MapHistoryNum
-1
3569 proc MakeHistory
{cmd
} {
3571 set len
[llength $MapHistory]
3573 ($cmd != [lindex $MapHistory [expr $len-1]])} {
3574 lappend MapHistory
$cmd
3582 proc GotoHistory
{i
} {
3584 global MapHistoryNum
3585 InitVotesForUseThisMap
3586 if {$i != $MapHistoryNum} {
3587 set MapHistoryNum
$i
3588 set cmd
[lindex $MapHistory $i]
3591 if {$MapHistoryNum == 0} {
3596 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3602 global ScenarioWindows
3603 foreach win
$ScenarioWindows {
3604 UpdateLeftRightEnabled
$win
3610 proc NextHistory
{} {
3612 global MapHistoryNum
3613 set len
[llength $MapHistory]
3614 set i
[expr "$MapHistoryNum + 1"]
3621 proc PrevHistory
{} {
3623 global MapHistoryNum
3624 set i
[expr "$MapHistoryNum - 1"]
3631 ########################################################################
3632 # Ask Window Handlers
3634 proc ShowAskOf
{head
} {
3635 set win
[WindowLink
$head.ask
]
3637 set win
[MakeWindow.ask
$head [winfo screen
$head]]
3647 foreach win
$HeadWindows {
3653 proc WithdrawAsks
{} {
3655 foreach win
$AskWindows {
3661 proc WithdrawAskOf
{win
} {
3662 set ask
[WindowLink
$win.ask
]
3669 proc AskQuestion
{color title
text left middle right
} {
3671 foreach win
$HeadWindows {
3672 AskQuestionOn
$win $color $title $text $left $middle $right
3677 proc AskQuestionOn
{head color title
text left middle right
} {
3680 set win
[WindowLink
$head.ask
]
3681 set t
[WindowLink
$win.title
]
3682 $t configure
-text $title
3683 $t configure
-background $color
3685 set t
[WindowLink
$win.
text]
3686 $t configure
-state normal
3688 $t insert end
"${text}\n"
3689 $t configure
-state disabled
3691 set bf
[WindowLink
$win.
frame]
3692 set l
[WindowLink
$win.left
]
3693 set m
[WindowLink
$win.middle
]
3694 set r
[WindowLink
$win.vote
]
3695 set rf
[WindowLink
$win.voteframe
]
3699 -text [lindex $left 0] \
3700 -command [format [lindex $left 2] $head]
3701 SetHelp
$l [lindex $left 1]
3702 pack append $bf $l {left
frame center
}
3707 if {$middle != ""} {
3709 -text [lindex $middle 0] \
3710 -command [format [lindex $middle 2] $head]
3711 SetHelp
$m [lindex $middle 1]
3712 pack append $bf $m {left
frame center expand
}
3718 set notify
[format [lindex $right 2] $head]
3719 set preview
[format [lindex $right 3] $head]
3720 set cmd
[list DoVote
$win Ask
$notify $preview]
3722 -text [lindex $right 0] \
3724 SetHelp
$r [lindex $right 1]
3725 pack append $bf $rf {right
frame center
}
3734 proc BindVotingButton
{win but name
} {
3735 set w
[WindowLink
$win.top
]
3737 bind $but <Any-Enter
> "VoteButtonEnter $win $but"
3738 bind $but <Any-Leave
> "VoteButtonLeave $win $but"
3739 bind $but <1> "VoteButtonDown $win $but $name"
3740 bind $but <ButtonRelease-1
> "VoteButtonUp $win $but $name"
3741 bind $but <2> "VoteButtonDown $win $but $name"
3742 bind $but <ButtonRelease-2
> "VoteButtonUp $win $but $name"
3743 bind $but <3> "VoteButtonDown $win $but $name"
3744 bind $but <ButtonRelease-3
> "VoteButtonUp $win $but $name"
3748 proc VoteButtonEnter
{win but
} {
3750 set screen
[winfo screen
$but]
3751 if {[lindex [$but config
-state] 4] != "disabled"} {
3752 $but config
-state active
3753 set tk_priv
(window
@$screen) $but
3755 set tk_priv
(window
@$screen) ""
3760 proc VoteButtonLeave
{win but
} {
3762 if {[lindex [$but config
-state] 4] != "disabled"} {
3763 $but config
-state normal
3765 set screen
[winfo screen
$but]
3766 set tk_priv
(window
@$screen) ""
3770 proc VoteButtonDown
{win but name
} {
3772 set screen
[winfo screen
$but]
3773 set rel
[lindex [$but config
-relief] 4]
3774 set tk_priv
(relief
@$screen) $rel
3775 if {[lindex [$but config
-state] 4] != "disabled"} {
3776 set head
[WindowLink
$win.head
]
3777 if {[IsVotingFor
$head $name]} {
3778 $but config
-relief raised
3780 $but config
-relief sunken
3786 proc VoteButtonUp
{win but name
} {
3788 set screen
[winfo screen
$but]
3789 $but config
-relief $tk_priv(relief
@$screen)
3790 if {($but == $tk_priv(window
@$screen))
3791 && ([lindex [$but config
-state] 4] != "disabled")} {
3792 uplevel #0 [list $but invoke]
3793 set head
[WindowLink
$win.head
]
3794 if {[IsVotingFor
$head $name]} {
3795 $but config
-relief sunken
3797 $but config
-relief raised
3803 proc PressVoteButton
{win but name
} {
3805 uplevel #0 [list $but invoke]
3806 set head
[WindowLink
$win.head
]
3807 if {[IsVotingFor
$head $name]} {
3808 $but config
-relief sunken
3810 $but config
-relief raised
3815 proc IsVotingFor
{win name
} {
3816 global VotesFor
$name
3817 set votes
[eval ident
"\$\{VotesFor$name\}"]
3818 if {[lsearch $votes $win] == -1} {
3826 proc DoVote
{win name notify preview
} {
3827 global VotesFor
$name
3828 set votes
[eval ident
"\$\{VotesFor$name\}"]
3830 set win
[WindowLink
$win.head
]
3831 set i
[lsearch $votes $win]
3833 lappend VotesFor
$name $win
3835 set VotesFor
$name [lreplace $votes $i $i]
3838 set votes
[eval ident
"\$\{VotesFor$name\}"]
3839 if {[llength $votes] >= [NeededVotes
]} {
3847 proc UpdateVotesFor
{name wins
} {
3848 global VotesFor
$name
3849 set votes
[eval llength "\$\{VotesFor$name\}"]
3850 set needed
[NeededVotes
]
3853 set head
[WindowLink
$win.head
]
3854 if {[IsVotingFor
$head $name]} {
3855 set border
[expr "($needed - $votes) * 1"]
3856 set pad
[expr "6 - $border"]
3857 [WindowLink
$win.vote
] config
-padx $pad -pady $pad
3858 [WindowLink
$win.voteframe
] config
-borderwidth $border
3860 set border
[expr "($needed - $votes - 1) * 1"]
3861 set pad
[expr "6 - $border"]
3862 [WindowLink
$win.vote
] config
-padx $pad -pady $pad
3863 [WindowLink
$win.voteframe
] config
-borderwidth $border
3869 proc InitVotesForAsk
{} {
3870 global VotesForAsk AskWindows
3872 foreach win
$AskWindows {
3873 [WindowLink
$win.vote
] config
-relief raised
3880 proc UpdateVotesForAsk
{} {
3882 UpdateVotesFor Ask
$AskWindows
3886 ########################################################################
3887 # Player Window Handlers
3889 proc ShowPlayerOf
{head
} {
3890 set win
[WindowLink
$head.player
]
3892 set win
[MakeWindow.player
$head [winfo screen
$head]]
3900 proc ShowPlayers
{} {
3902 foreach win
$HeadWindows {
3908 proc WithdrawPlayers
{} {
3909 global PlayerWindows
3910 foreach win
$PlayerWindows {
3916 proc UpdatePlayers
{} {
3917 # TODO: Disabled for new scenario window.
3920 global HeadWindows PlayerWindows
3923 foreach win
$HeadWindows {
3924 set server
[winfo screen
$win]
3925 # if {[string first : $server] == 0} {
3926 # set server "[exec hostname]:0"
3928 lappend players
$server
3931 sim Players
[llength $players]
3933 foreach win
$PlayerWindows {
3934 set list [WindowLink
$win.players
]
3936 eval "$list insert 0 $players"
3939 UpdateVotesForUseThisMap
3941 UpdateVotesForBudget
3942 UpdateTaxRateSliders
3946 proc UIShowPlayer
{win
} {
3951 proc DoNewPlayer
{win
} {
3952 set field
[WindowLink
$win.display
]
3953 set dpy
[$field get
]
3958 if {[AddPlayer
$dpy] != ""} {
3964 ########################################################################
3965 # Notice Window Handlers
3968 proc ShowNoticeOf
{head
} {
3969 set win
[WindowLink
$head.notice
]
3971 set win
[MakeWindow.notice
$head [winfo screen
$head]]
3973 global NoticePanelWidth NoticePanelHeight
3974 #place configure $win -x 0 -y 0 -width $NoticePanelWidth -height $NoticePanelHeight
3975 pack append [WindowLink
$head.w3
] \
3976 $win {bottom
frame sw expand fill
}
3981 proc ShowNotices
{} {
3983 foreach win
$HeadWindows {
3989 proc WithdrawNotices
{} {
3990 global NoticeWindows
3991 foreach win
$NoticeWindows {
3998 proc ReShowPictureOn
{{head
""}} {
3999 global ShowingPicture ShowingParms
4000 UIShowPictureOn
$head $ShowingPicture $ShowingParms
4004 proc UIShowPicture
{id
{parms
""}} {
4005 UIShowPictureOn
"" $id $parms
4009 proc UIShowPictureOn
{where id
{parms
""}} {
4010 global DoNotices Messages ShowingPicture ShowingParms
4011 if {$DoNotices == 0} {
4015 set ShowingPicture
$id
4016 set ShowingParms
$parms
4017 set msg
$Messages($id)
4018 set color
[lindex $msg 0]
4019 set title
[lindex $msg 1]
4020 set body
[lindex $msg 2]
4022 set cmd
"format {$body} $parms"
4023 set body
[uplevel #0 $cmd]
4025 set props
[lindex $msg 3]
4026 if {"$where" == ""} {
4028 set where
$HeadWindows
4030 foreach head
$where {
4031 NoticeMessageOn
$head "$title" $color "$body" Medium
$props
4036 proc NoticeMessageOn
{head title color
text font props
} {
4038 set win
[WindowLink
$head.notice
]
4040 set t
[WindowLink
$win.title
]
4041 $t configure
-text $title -background $color
4043 set t
[WindowLink
$win.
text]
4044 $t configure
-state normal
-font [Font
$head $font]
4046 $t insert end
"${text}\n"
4047 $t configure
-state disabled
4050 catch {set left
[keylget props left
]}
4051 set l
[WindowLink
$win.left
]
4053 $l config
-bitmap $left
4054 place $l -in $t -anchor sw
-relx .05 -rely .95
4060 catch {set middle
[keylget props middle
]}
4061 set m
[WindowLink
$win.middle
]
4062 if {$middle != ""} {
4063 $m config
-bitmap $middle
4064 place $m -in $t -anchor s
-relx .5 -rely .95
4070 catch {set right
[keylget props right
]}
4071 set r
[WindowLink
$win.right
]
4073 $r config
-bitmap $right
4074 place $r -in $t -anchor se
-relx .95 -rely .95
4080 catch {set view
[keylget props view
]}
4081 set vf
[WindowLink
$win.viewframe
]
4083 set v
[WindowLink
$win.view
]
4084 set bg
[WindowLink
$win.background
]
4088 pack append $bg $vf {left
frame center fill
}
4089 pack append $bg $t {right
frame center fill expand
}
4096 proc UIPopUpMessage
{msg
} {
4101 proc ComeToMe
{view
} {
4102 set win
[winfo toplevel $view]
4105 set x
[expr "[lindex $xy 0] >>4"]
4106 set y
[expr "[lindex $xy 1] >>4"]
4112 proc ComeTo
{win x y
} {
4113 global EditorWindows
4114 set head
[WindowLink
$win.head
]
4117 foreach ed
$EditorWindows {
4118 if {"[WindowLink $ed.head]" == "$head"} {
4120 set view
[WindowLink
$ed.view
]
4121 if {[$view AutoGoto
]} {
4122 lappend myautoeds
$ed
4126 if {[llength $myautoeds]} {
4127 UIAutoGotoOn
$x $y $myautoeds
4129 if {[llength $myeds]} {
4130 UIAutoGotoOn
$x $y $myeds
4136 proc FollowView
{view id
} {
4140 if {[sim DoAnimation
]} {
4141 set head
[WindowLink
[winfo toplevel $view].head
]
4142 global EditorWindows
4143 foreach win
$EditorWindows {
4144 if {"[WindowLink $win.head]" == "$head"} {
4145 set s
[[WindowLink
$win.view
] Skip
]
4146 set skips
[min
$skips $s]
4150 if {$skips == 999999} {
4160 proc PanView
{view x y
} {
4166 ########################################################################
4167 # Help Window Handlers
4170 proc ShowHelpOf
{head
} {
4171 set win
[WindowLink
$head.help
]
4173 set win
[MakeWindow.help
$head [winfo screen
$head]]
4183 foreach win
$HeadWindows {
4189 proc WithdrawHelps
{} {
4191 foreach win
$HelpWindows {
4197 ########################################################################
4198 # Frob Window Handlers
4201 proc ShowFrobOf
{head
} {
4202 set win
[WindowLink
$head.frob
]
4204 set win
[MakeWindow.frob
$head [winfo screen
$head]]
4215 foreach win
$HeadWindows {
4221 proc WithdrawFrobs
{} {
4223 foreach win
$FrobWindows {
4229 proc UISetDynamic
{i min max
} {
4230 sim DynamicData
[expr "$i*2"] $min
4231 sim DynamicData
[expr "$i*2+1"] $max
4235 ########################################################################
4242 source $ResourceDir/help.tcl
4245 proc HandleHelp
{win x y rootx rooty
} {
4246 global HelpLoaded HelpWidgets Messages
4248 if {$HelpLoaded == 0} {
4254 set head
[WindowLink
[winfo toplevel $win].head
]
4257 catch {set id
$HelpWidgets($win)}
4261 set list [split $win .
]
4262 set len
[expr "[llength $list] - 2"]
4263 set list [lrange $list 0 $len]
4264 if {[llength $list] <= 1} {
4268 set win
[join $list .
]
4270 if [info exists Messages
($id)] {
4271 UIShowHelpOn
$head $id
4273 UIShowHelpOn
$head Window
4278 proc UIShowHelpOn
{win id
{parms
""}} {
4279 global Messages ShowingPicture ShowingParms ResourceDir
4280 set head
[WindowLink
$win.head
]
4281 set msg
$Messages($id)
4282 set color
[lindex $msg 0]
4283 set title
[lindex $msg 1]
4284 set body
[lindex $msg 2]
4286 set cmd
"format {$body} $parms"
4287 set body
[uplevel #0 $cmd]
4289 set props
[lindex $msg 3]
4292 set win
[WindowLink
$head.help
]
4294 set t
[WindowLink
$win.title
]
4295 $t configure
-text $title -background $color
4297 set t
[WindowLink
$win.
text]
4298 $t configure
-state normal
-font [Font
$head Large
]
4300 $t insert end
"${body}\n"
4301 FormatHTML
$ResourceDir/doc
/$id.html
$t
4302 $t configure
-state disabled
4306 proc FormatHTML
{filename text} {
4309 set f
[open $filename]
4316 while {[gets $f line
] >= 0} {
4317 if {"$line" == "</body>"} {
4320 if {([string index
$line 0] == "#") ||
([string length
$line] == 0)} {
4323 $text insert end
"$line\n"
4332 proc SetHelp
{win id
} {
4334 set HelpWidgets
($win) $id
4338 proc Help
{id title
{msg
{}} {props
{}}} {
4339 Message
$id #7f7fff $title $msg $props
4342 ########################################################################
4346 # Set up the bindings to pop up $pie when the right button is clicked in $win
4347 proc InitPie
{win pie
} {
4348 bind $win <Motion
> {}
4349 bind $win <3> "PieMenuDown $win $pie $pie Initial %X %Y"
4350 bind $win <B3-Motion
> {}
4351 bind $win <B3-ButtonRelease
> {}
4355 # Set up the bindings to continue tracking $pie
4356 # Get this: we keep the tracking machine state in the bindings!
4357 proc ActivatePie
{win root pie state
} {
4358 bind $win <Motion
> "PieMenuMotion $win $root $pie $state %X %Y"
4359 bind $win <3> "PieMenuDown $win $root $pie $state %X %Y"
4360 bind $win <B3-Motion
> "PieMenuMotion $win $root $pie $state %X %Y"
4361 bind $win <B3-ButtonRelease
> "PieMenuUp $win $root $pie $state %X %Y"
4365 # Cancel and reset a pie menu
4366 proc CancelPie
{win
} {
4367 set binding
[bind $win <3>]
4368 set root
[lindex $binding 2]
4369 set pie
[lindex $binding 3]
4370 set state
[lindex $binding 4]
4371 if {"$state" != "Initial"} {
4372 catch {$root ungrab
$win}
4375 UIMakeSoundOn
$win fancy Oop
4381 # Handle pie menu button down
4382 proc PieMenuDown
{win root pie state x y
} {
4385 ActivatePie
$win $root $pie FirstDown
4387 catch {$root grab $win}
4390 PreviewPieMenu
$win $pie $x $y
4394 TrackPieMenu
$pie $x $y
4395 ActivatePie
$win $root $pie SecondDown
4401 PreviewPieMenu
$win $pie $x $y
4402 ActivatePie
$win $root $pie SecondDown
4407 SecondDown
{ # error
4414 # Handle pie menu button motion
4415 proc PieMenuMotion
{win root pie state x y
} {
4418 TrackPieMenu
$pie $x $y
4426 TrackPieMenu
$pie $x $y
4440 # Handle pie menu button up
4441 proc PieMenuUp
{win root pie state x y
} {
4444 TrackPieMenu
$pie $x $y
4445 set active
[$pie index active
]
4446 if {$active == "none"} {
4448 catch {$root grab $win}
4449 ActivatePie
$win $root $pie ClickedUp
4451 set label [lindex [$pie entryconfig
$active -label] 4]
4452 set submenu
[lindex [$pie entryconfig
$active -piemenu] 4]
4453 UIMakeSoundOn
$win mode
$label
4454 if {$submenu == {}} {
4455 set reward
[$pie pending
]
4456 catch {$root ungrab
$win}
4460 sim Funds
[expr "[sim Funds] + 5"]
4461 UIMakeSoundOn
$win fancy Aaah
4463 eval [lindex [$pie entryconfig
$active -command] 4]
4468 $submenu activate none
4470 PreviewPieMenu
$win $submenu $x $y
4471 catch {$root grab $win}
4472 ActivatePie
$win $root $submenu SelectedUp
4477 TrackPieMenu
$pie $x $y
4478 set active
[$pie index active
]
4479 if {$active == "none"} {
4482 set label [lindex [$pie entryconfig
$active -label] 4]
4483 set submenu
[lindex [$pie entryconfig
$active -piemenu] 4]
4484 UIMakeSoundOn
$win mode
$label
4485 if {$submenu == {}} {
4486 set reward
[$pie pending
]
4487 catch {$root ungrab
$win}
4491 sim Funds
[expr "[sim Funds] + 5"]
4492 UIMakeSoundOn
$win fancy Aaah
4494 eval [lindex [$pie entryconfig
$active -command] 4]
4499 $submenu activate none
4501 PreviewPieMenu
$win $submenu $x $y
4502 catch {$root grab $win}
4503 ActivatePie
$win $root $submenu SelectedUp
4513 SelectedUp
{ # error
4520 # Track the selected item
4521 proc TrackPieMenu
{pie x y
} {
4522 $pie activate
@$x,$y
4526 proc PreviewPieMenu
{win pie x y
} {
4527 set preview
[lindex [$pie config
-preview] 4]
4528 if {"$preview" != ""} {
4529 set rx
[winfo rootx
$win]
4530 set ry
[winfo rooty
$win]
4531 set x
[expr "$x - $rx"]
4532 set y
[expr "$y - $ry"]
4533 eval [format $preview $x $y]
4538 ########################################################################
4542 proc ExclusivePallet
{state parent children prefix images inactive active cmd
} {
4543 #echo "ExclusivePallet state $state parent $parent children $children prefix $prefix images $images inactive $inactive active $active cmd $cmd"
4545 foreach child
$children {
4546 set name
[lindex $images $i]
4547 if {$i == $state} then
{
4548 $parent.
$child config
\
4549 -bitmap "@images/${prefix}${name}hi.xpm" \
4552 $parent.
$child config
\
4553 -bitmap "@images/${prefix}${name}.xpm" \
4558 eval [concat $cmd $state]
4562 proc NonExclusivePallet
{mask parent children prefix images
4563 inactive active cmd
} {
4565 foreach child
$children {
4566 set name
[lindex $images $i]
4567 if {$mask & (1<<$i)} then
{
4568 $parent.
$child config
\
4569 -bitmap "@images/${prefix}${name}hi.xpm" \
4572 $parent.
$child config
\
4573 -bitmap "@images/${prefix}${name}.xpm" \
4578 eval [concat $cmd $mask]
4582 proc EditorPallet
{win state
} {
4583 global EditorPalletSounds
4584 UIMakeSoundOn
$win mode
[lindex $EditorPalletSounds $state]
4585 EditorSetTool
$win $state
4589 proc EditorSetTool
{win state
} {
4590 global EditorPallets
4591 global EditorPalletImages
4592 ExclusivePallet
$state $win $EditorPallets ic
$EditorPalletImages \
4593 flat raised
"$win.centerframe.view ToolState"
4597 proc GraphPallet
{win state
} {
4598 set mask
[[WindowLink
$win.graphview
] Mask
]
4599 set mask
[expr "$mask ^ (1<<$state)"]
4600 GraphPalletMask
$win $mask
4604 proc GraphPalletMask
{win mask
} {
4606 global GraphPalletImages
4607 NonExclusivePallet
$mask $win $GraphPallets gr
$GraphPalletImages \
4608 flat flat
"SetGraphState $win"
4612 proc GraphYearPallet
{win state
} {
4613 global GraphYearPallets
4614 global GraphYearPalletImages
4615 ExclusivePallet
$state $win $GraphYearPallets gr
$GraphYearPalletImages \
4616 flat flat
"SetGraphYearState $win"
4620 proc SetGraphYearState
{win state
} {
4621 set graph
[WindowLink
$win.graphview
]
4630 proc SetGraphState
{win mask
} {
4632 set graph
[WindowLink
$win.graphview
]
4637 ########################################################################
4640 proc sim_butEnter
{w
} {
4642 set screen
[winfo screen
$w]
4643 set tk_priv
(window
@$screen) $w
4647 proc sim_butLeave
{w
} {
4649 set screen
[winfo screen
$w]
4650 set tk_priv
(window
@$screen) ""
4654 proc sim_butDown
{w
} {
4656 set screen
[winfo screen
$w]
4657 set pict
[lindex [$w config
-bitmap] 4]
4658 set tk_priv
(relief
@$screen) $pict
4659 $w config
-bitmap [lindex [split $pict .
] 0]hi.xpm
4664 proc sim_butUp
{w
} {
4666 set screen
[winfo screen
$w]
4667 $w config
-bitmap $tk_priv(relief
@$screen)
4669 if {$w == $tk_priv(window
@$screen)} {
4670 uplevel #0 [list $w invoke]
4675 proc BindSimButton
{w
} {
4676 bind $w <Any-Enter
> {sim_butEnter
%W
}
4677 bind $w <Any-Leave
> {sim_butLeave
%W
}
4678 bind $w <1> {sim_butDown
%W
}
4679 bind $w <ButtonRelease-1
> {sim_butUp
%W
}
4680 bind $w <2> {sim_butDown
%W
}
4681 bind $w <ButtonRelease-2
> {sim_butUp
%W
}
4682 bind $w <3> {sim_butDown
%W
}
4683 bind $w <ButtonRelease-3
> {sim_butUp
%W
}
4687 ########################################################################
4688 # Internal Callbacks
4691 proc UIStartMicropolis
{homedir resourcedir hostname
} {
4692 global HomeDir ResourceDir HostName HeadWindows
4693 set HomeDir
$homedir
4694 set ResourceDir
$resourcedir
4695 set HostName
$hostname
4700 foreach display
[sim Displays
] {
4701 if {"[AddPlayer $display]" == ""} {
4702 echo Couldn't add a player on
$display ...
4706 if {"$HeadWindows" == ""} {
4707 echo Micropolis is exiting because it couldn't connect to any players.
4713 proc UISelectCity
{win
} {
4714 AskQuestion
[Color
$win #ff0000 #ffffff] "Choose Another City" \
4715 "Do you want to abandon this city and choose another one?" \
4716 "{Keep playing.} SelectCity.No {RejectPlan}" \
4718 "{Another city!} SelectCity.Yes {UIPickScenarioMode}"
4722 proc UIQuit
{head
} {
4723 if {[sim Players
] == 1} {
4724 set l
"{Keep playing.} Quit.No {RejectPlan}"
4726 set r
"{I quit!} Quit.IQuit {DoReallyQuit %s}"
4728 set l
"{Keep playing.} Quit.No {RejectPlan}"
4729 set m
"{I quit!} Quit.IResign {DoIResign %s}"
4730 set r
"{Everyone quit!} Quit.AllQuit {DoReallyQuit %s}"
4732 AskQuestion
[Color
$head #ff0000 #ffffff] "Quit Playing Micropolis" \
4733 "Do you want to quit playing Micropolis?" \
4738 proc DoIResign
{head
} {
4740 set display
[winfo screen
$head]
4742 DecRefDisplay
$display
4743 UISetMessage
"The player on X11 Display $display has resigned."
4745 if {([sim Players
] == 0) ||
4746 ([llength $VotesForAsk] >= [sim Players
])} {
4752 proc DoReallyQuit
{head
} {
4758 proc UISplashMode
{} {
4768 proc UIPickScenarioMode
{} {
4777 InitVotesForUseThisMap
4782 proc ForcePickScenarioMode
{} {
4784 if {"$State" != "scenario"} {
4790 proc UIGenerateCityNow
{} {
4791 global CityName GameLevel
4792 sim CityName NowHere
4798 proc UIGenerateNewCity
{} {
4799 global CityName GameLevel
4800 if {$GameLevel == -1} {
4803 MakeHistory
"DoNewCity NowHere $GameLevel [sim Rand] [sim TreeLevel] [sim LakeLevel] [sim CurveLevel] [sim CreateIsland]"
4807 proc DoNewCity
{name level
{r
""} {tl
-1} {ll
-1} {cl
-1} {ci
-1}} {
4813 sim CreateIsland
$ci
4817 sim GenerateSomeCity
$r
4820 sim GameLevel
$level
4825 proc UIDidGenerateNewCity
{} {
4830 proc IncRefDisplay
{display
} {
4831 global DisplayRegistry
4832 if ![info exists DisplayRegistry
($display)] {
4833 set DisplayRegistry
($display) 0
4835 incr DisplayRegistry
($display)
4839 proc DecRefDisplay
{display
} {
4840 global DisplayRegistry
4841 incr DisplayRegistry
($display) -1
4842 if {$DisplayRegistry($display) <= 0} {
4843 CloseDisplay
$display
4848 proc CloseDisplay
{display
} {
4852 proc DoStopMicropolis
{} {
4858 proc AddPlayer
{display
} {
4859 set i
[string first
: $display]
4863 set display
"$display:0"
4867 echo Adding a player on
$display ...
4869 set head
[MakeWindow.head
$display]
4871 if {"$head" != ""} {
4872 set display
[winfo screen
$head]
4873 IncRefDisplay
$display
4875 UISetMessage
"Added a player on X11 Display \"$display\"."
4878 UISetMessage
"Couldn't add a player on X11 Display \"$display\"!"
4888 proc DropFireBombs
{} {
4896 proc UIMakeMonster
{} {
4897 sim MakeMonster
[sim Rand
120] [sim Rand
100]
4920 proc TogglePause
{} {
4923 if {"$State" != "play" ||
[sim Speed
]} {
4934 proc SetSpeedTime
{time} {
4940 proc MakeRunningSound
{} {
4943 if {"$State" == "play" && [sim Speed
]} {
4944 UIMakeSound edit Boing
"-speed 1[sim Speed]0"
4946 UIMakeSound edit Boing
"-speed 90"
4951 proc SayDemands
{} {
4952 global DemandRes DemandCom DemandInd
4954 set r
[expr "100 + ($DemandRes * $slope)"]
4955 set c
[expr "100 + ($DemandCom * $slope)"]
4956 set i
[expr "100 + ($DemandInd * $slope)"]
4957 after 020 "UIMakeSound edit O \"-speed $r\""
4958 after 220 "UIMakeSound edit A \"-speed $c\""
4959 after 440 "UIMakeSound edit E \"-speed $i\""
4963 proc UISaveCity
{win
} {
4965 set SaveCityWin
$win
4970 proc UISaveCityAs
{{win
""}} {
4972 if {"$win" == ""} {set win
$SaveCityWin}
4973 set SaveCityWin
$win
4976 set file [ShowFileOf
$win]
4977 DoFileDialog
$file "Choose a File to Save the City" $CityDir "*.cty" "" \
4978 "UIDoReallySaveCity" ""
4982 proc UIDoReallySaveCity
{name path
} {
4984 if {![string match
*.cty
$name]} {
4988 sim SaveCityAs
$path/$name
4992 proc UIDidSaveCity
{} {
4993 DoSendMessage
"Saved the city in \"[sim CityFileName]\"." status
4997 proc UIDidntSaveCity
{msg
} {
4998 DoSendMessage
$msg alert
4999 UIMakeSound warning Sorry
"-speed 85"
5003 proc UILoadScenario
{scen
} {
5004 MakeHistory
"DoScenario $scen"
5008 proc DoScenario
{scen
} {
5011 sim LoadScenario
$scen
5016 proc UIDidLoadScenario
{} {
5020 proc UIStartScenario
{id
} {
5029 proc UIPlayNewCity
{} {
5035 proc UIStartLoad
{} {
5040 proc UIReallyStartGame
{} {
5046 proc UIPlayGame
{} {
5053 SetPriority
$Priority
5061 proc UISetSpeed
{speed
} {
5064 if {"$State" == "play"} {
5065 UISetMessage
[lindex {
5068 {Time flows medium.
}
5076 proc UIUpdateRunning
{} {
5077 global HeadWindows Time State
5079 if {($State == "play") && $Time} {
5080 set pict
"@images/micropolisg.xpm"
5082 set pict
"@images/micropoliss.xpm"
5085 foreach win
$HeadWindows {
5086 set can
[WindowLink
$win.demand
]
5087 $can itemconfig micropolis
-bitmap $pict
5092 proc DoSetGameLevel
{level
} {
5093 sim GameLevel
$level
5097 proc UISetGameLevel
{level
} {
5099 set GameLevel
$level
5100 global ScenarioWindows
5101 foreach win
$ScenarioWindows {
5102 UpdateLevelSelection
$win
5107 proc UISetCityName
{name
} {
5108 global EditorWindows
5111 set title
"Micropolis Editor on $name"
5112 foreach win
$EditorWindows {
5113 # TODO: set editor window and icon title
5114 #wm title $win "$title"
5115 #wm iconname $win "$title"
5120 proc UILoadCity
{win
} {
5121 # if changed, r-u-sure?
5123 set file [ShowFileOf
$win]
5124 DoFileDialog
$file "Choose a City to Load" $CityDir "*.cty" "" \
5129 proc UIDoLoadCity
{name path
} {
5132 if {![string match
*.cty
$name]} {
5135 MakeHistory
"DoLoadCity {$path/$name}"
5139 proc DoLoadCity
{filename} {
5140 sim LoadCity
$filename
5143 proc UIDidLoadCity
{} {
5144 global State GameLevel Scenario
5147 if {$State == "play"} {
5150 UIShowPicture
49 [sim CityFileName
]
5155 proc UIDidntLoadCity
{msg
} {
5156 DoSendMessage
$msg alert
5157 UIMakeSound warning Sorry
"-speed 85"
5158 UIShowPicture
49 [sim CityFileName
]
5177 proc UIDidPan
{w x y
} {
5178 if {[$w ToolMode
] == 1} {
5179 EditorToolDrag
$w $x $y
5185 proc UIDidStopPan
{win
} {
5186 UIMakeSoundOn
$win fancy Skid
"-volume 25"
5191 proc UIEarthQuake
{} {
5195 proc UIAutoGoto
{x y
{except
{}}} {
5196 global EditorWindows
5198 set x
[expr "$x * 16 + 8"]
5199 set y
[expr "$y * 16 + 8"]
5200 foreach win
$EditorWindows {
5201 if {"$win" != "$except"} {
5202 set view
[WindowLink
$win.view
]
5203 if {[$view AutoGoto
]} {
5205 $view AutoGoal
$x $y
5215 proc UIAutoGotoOn
{x y eds
} {
5216 set x
[expr "$x * 16 + 8"]
5217 set y
[expr "$y * 16 + 8"]
5219 [WindowLink
$win.view
] AutoGoal
$x $y
5225 proc DoLeaveGame
{head
} {
5229 proc UILoseGame
{} {
5240 proc DoPendTool
{view tool x y
} {
5241 global HeadWindows ToolInfo VotesForAsk
5243 set win
[WindowLink
$view.top
]
5244 set head
[WindowLink
$win.head
]
5246 if {($tool == [sim PendingTool
]) &&
5247 ($x == [sim PendingX
]) &&
5248 ($y == [sim PendingY
])} {
5249 if {[lsearch $VotesForAsk $head] != -1} {
5250 # you can only vote once
5251 UIMakeSound edit Oop
5253 UIMakeSound edit Boing
5254 set ask
[WindowLink
$head.ask
]
5255 PressVoteButton
$ask [WindowLink
$ask.vote
] Ask
5258 UIAutoGoto
$x $y $win
5260 UIMakeSound edit Boing
5261 set info [lindex $ToolInfo $tool]
5262 set a
[lindex $info 0]
5263 set name
[lindex $info 1]
5264 set cost
[lindex $info 2]
5265 set title
"Build $a $name"
5266 set question
"Do you support the plan to build $a $name for $cost?"
5267 AskQuestion
[Color
$win #00ff00 #ffffff] "$title" \
5269 "{Veto plan.} Plan.Veto
5271 "{Goto plan.} Plan.Goto
5272 {ComeTo %s $x $y}" \
5273 "{Support plan!} Plan.Support
5274 {SupportPlan $view %s $tool $x $y}
5275 {PreviewSupportPlan $view %s $tool $x $y}"
5276 set VotesForAsk
$head
5277 set ask
[WindowLink
$head.ask
]
5278 [WindowLink
$ask.vote
] config
-relief sunken
5282 sim PendingTool
$tool
5285 sim Votes
[llength $VotesForAsk]
5290 proc RejectPlan
{} {
5292 if {[sim Players
] > 1} {
5293 UIMakeSound edit Sorry
5299 proc NeededVotes
{} {
5301 set players
[sim Players
]
5302 set needed
[expr "$players - $FreeVotes"]
5303 return [max
0 $needed]
5307 proc SupportPlan
{view h tool x y
} {
5309 sim Votes
[llength $VotesForAsk]
5312 $view DoTool
$tool $x $y
5315 UIMakeSound edit Aaah
5319 proc PreviewSupportPlan
{view h tool x y
} {
5321 sim Votes
[llength $VotesForAsk]
5325 proc SugarStartUp
{uri
} {
5329 # TODO: Load the city file at the given URI, or configure according to URI parameters.
5333 proc SugarNickName
{nick
} {
5334 global SugarNickName
5335 set SugarNickName
$nick
5339 proc SugarActivate
{} {
5340 global SugarActivated
5341 set SugarActivated
1
5345 proc SugarDeactivate
{} {
5346 global SugarActivated
5347 set SugarActivated
0
5351 proc SugarShare
{} {
5357 proc SugarBuddyAdd
{key nick color address
} {
5359 set buddy
[list $key $nick $color $address]
5360 lappend SugarBuddies
$buddy
5364 proc SugarBuddyDel
{key nick color address
} {
5366 set buddy
[list $key $nick $color $address]
5367 set i
[lsearch $wins $win]
5369 set SugarBuddies
[lreplace $wins $i $i]
5379 ########################################################################