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.
942 global Sound ResourceDir
944 #echo PlaySound [lindex $soundspec 0]
945 signal ignore SIGCHLD
946 exec "${ResourceDir}/sounds/player" "${ResourceDir}/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
} {
3315 set type
[lindex $data 0]
3316 set id
[lindex $data 1]
3317 set over
[WindowLink
$win.
$id.over
]
3318 set enabled
[WindowLink
$win.
$id.enabled
]
3319 set checked
[WindowLink
$win.
$id.checked
]
3320 #echo "WIN $win TYPE $type ID $id OVER $over ENABLED $enabled CHECKED $checked"
3322 if {[lindex ${data
} 2] == "DoPickScenario"} {
3323 catch {text $win.desc
\
3328 -font [Font
$win Large
]}
3330 $win.desc configure
-state normal
3331 $win.desc delete
0.0 end
3332 $win.desc insert end
"[lindex $Messages([lindex ${data} 3]) 1]\n\n[lindex $Messages([lindex ${data} 3]) 2]"
3333 $win.desc configure
-state disabled
3335 place $win.desc
-x 232 -y 170 -width 280 -height 285
3338 catch {destroy $win.desc
}
3343 set bm
[lindex $data 13]
3345 set bm
[lindex $data 12]
3349 set bm
[lindex $data 10]
3351 set bm
[lindex $data 9]
3355 set bm
[lindex $data 11]
3358 [WindowLink
$win.
canvas] itemconfig
$id -bitmap $bm
3362 proc DoEnterCityName
{win
} {
3366 proc InitVotesForUseThisMap
{} {
3367 # TODO: Disabled for new scenario window.
3370 global VotesForUseThisMap ScenarioWindows
3371 set VotesForUseThisMap
{}
3372 foreach win
$ScenarioWindows {
3373 [WindowLink
$win.vote
] config
-relief raised
3375 UpdateVotesForUseThisMap
3379 proc UpdateVotesForUseThisMap
{} {
3380 global ScenarioWindows
3381 UpdateVotesFor UseThisMap
$ScenarioWindows
3385 proc UIUseThisMap
{} {
3386 global CityName GameLevel Scenario
3388 # special handling for scenarios?
3389 if {$GameLevel != -1} {
3390 sim GameLevel
$GameLevel
3392 sim CityName
$CityName
3395 if {$Scenario != -1} {
3396 UIShowPicture
$Scenario
3401 proc HandleScenarioDown
{win x y
} {
3402 #echo HandleScenarioDown $win $x $y
3403 HandleScenarioMove
$win $x $y
3404 set w
[WindowLink
$win.w
]
3405 set target
[WindowLink
$w.scenarioTarget
]
3406 LinkWindow
$w.scenarioTargetDown
$target
3410 proc HandleScenarioUp
{win x y
} {
3411 #echo HandleScenarioUp $win $x $y
3412 HandleScenarioMove
$win $x $y
3413 global ScenarioButtons
3414 set w
[WindowLink
$win.w
]
3415 set target
[WindowLink
$w.scenarioTarget
]
3416 set targetDown
[WindowLink
$w.scenarioTargetDown
]
3417 if {($target != -1) &&
3418 ($target == $targetDown)} {
3419 set data
[lindex $ScenarioButtons $target]
3420 set type
[lindex $data 0]
3421 set id
[lindex $data 1]
3422 set callback
[lindex $data 2]
3423 set param
[lindex $data 3]
3424 set var
[lindex $data 4]
3425 set xx
[lindex $data 5]
3426 set yy
[lindex $data 6]
3427 set ww
[lindex $data 7]
3428 set hh
[lindex $data 8]
3429 set normal
[lindex $data 9]
3430 set over
[lindex $data 10]
3431 set disabled
[lindex $data 11]
3432 if {$type == "button"} {
3433 #echo callback $callback w $w param $param
3434 eval "$callback $w {$param}"
3436 if {$type == "checkbox"} {
3437 #echo checkbox callback $callback w $w param $param
3438 eval "$callback $w {$param}"
3445 proc HandleScenarioMove
{win x y
} {
3446 #echo HandleScenarioMove $win $x $y
3447 global ScenarioButtons
3448 set w
[WindowLink
$win.w
]
3449 set target
[WindowLink
$w.scenarioTarget
]
3452 set len
[llength $ScenarioButtons]
3454 set data
[lindex $ScenarioButtons $i]
3455 set type
[lindex $data 0]
3456 set id
[lindex $data 1]
3457 set callback
[lindex $data 2]
3458 set param
[lindex $data 3]
3459 set var
[lindex $data 4]
3460 set xx
[lindex $data 5]
3461 set yy
[lindex $data 6]
3462 set ww
[lindex $data 7]
3463 set hh
[lindex $data 8]
3465 set enabled
[WindowLink
$w.
$id.enabled
]
3466 set checked
[WindowLink
$w.
$id.checked
]
3468 #echo "ID $id ENABLED $enabled CHECKED $checked w $w id $id"
3470 if {($enabled != 0) &&
3472 ($x < ($xx + $ww)) &
3474 ($y < ($yy + $hh))} {
3479 set i
[expr "$i + 1"]
3482 if {$found != $target} {
3485 if {$target != -1} {
3487 #echo OUT $w $found $xx $yy $normal
3488 LinkWindow
$w.scenarioTarget
-1
3490 set targetdata
[lindex $ScenarioButtons $target]
3491 set targetid
[lindex $targetdata 1]
3492 LinkWindow
$w.
$targetid.over
0
3493 UpdateScenarioButton
$w $targetdata
3498 #echo IN $w $found $xx $yy $over
3499 LinkWindow
$w.scenarioTarget
$found
3500 LinkWindow
$w.
$id.over
1
3502 if {$target != -1} {
3503 set targetdata
[lindex $ScenarioButtons $target]
3504 set targetid
[lindex $targetdata 1]
3505 LinkWindow
$w.
$targetid.over
0
3506 UpdateScenarioButton
$w $targetdata
3509 UpdateScenarioButton
$w $data
3515 proc DoLoad
{win param
} {
3516 #echo DOLOAD $win $param
3521 proc DoGenerate
{win param
} {
3522 #echo DOGENERATE $win $param
3527 proc DoQuit
{win param
} {
3528 #echo DOQUIT $win $param
3533 proc DoAbout
{win param
} {
3534 #echo DOABOUT $win $param
3535 MakeHistory
"DoLoadCity cities/about.cty"
3539 proc DoMap
{win param
} {
3540 #echo DOMAP $win $param
3544 proc DoLevel
{win param
} {
3545 #echo DOLEVEL $win $param
3546 DoSetGameLevel
$param
3550 proc DoLeft
{win param
} {
3551 #echo DOLEFT $win $param
3556 proc DoRight
{win param
} {
3557 #echo DORIGHT $win $param
3562 proc DoPlay
{win param
} {
3563 #echo DOPLAY $win $param
3568 proc DoPickScenario
{win param
} {
3569 #echo DOPICKSCENARIO $win $param
3570 UILoadScenario
$param
3573 proc DeleteScenarioWindow
{win
} {
3578 ########################################################################
3579 # Undo/Redo Facility
3582 proc InitHistory
{} {
3584 global MapHistoryNum
3586 set MapHistoryNum
-1
3590 proc MakeHistory
{cmd
} {
3592 set len
[llength $MapHistory]
3594 ($cmd != [lindex $MapHistory [expr $len-1]])} {
3595 lappend MapHistory
$cmd
3603 proc GotoHistory
{i
} {
3605 global MapHistoryNum
3606 InitVotesForUseThisMap
3607 if {$i != $MapHistoryNum} {
3608 set MapHistoryNum
$i
3609 set cmd
[lindex $MapHistory $i]
3612 if {$MapHistoryNum == 0} {
3617 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3623 global ScenarioWindows
3624 foreach win
$ScenarioWindows {
3625 UpdateLeftRightEnabled
$win
3631 proc NextHistory
{} {
3633 global MapHistoryNum
3634 set len
[llength $MapHistory]
3635 set i
[expr "$MapHistoryNum + 1"]
3642 proc PrevHistory
{} {
3644 global MapHistoryNum
3645 set i
[expr "$MapHistoryNum - 1"]
3652 ########################################################################
3653 # Ask Window Handlers
3655 proc ShowAskOf
{head
} {
3656 set win
[WindowLink
$head.ask
]
3658 set win
[MakeWindow.ask
$head [winfo screen
$head]]
3668 foreach win
$HeadWindows {
3674 proc WithdrawAsks
{} {
3676 foreach win
$AskWindows {
3682 proc WithdrawAskOf
{win
} {
3683 set ask
[WindowLink
$win.ask
]
3690 proc AskQuestion
{color title
text left middle right
} {
3692 foreach win
$HeadWindows {
3693 AskQuestionOn
$win $color $title $text $left $middle $right
3698 proc AskQuestionOn
{head color title
text left middle right
} {
3701 set win
[WindowLink
$head.ask
]
3702 set t
[WindowLink
$win.title
]
3703 $t configure
-text $title
3704 $t configure
-background $color
3706 set t
[WindowLink
$win.
text]
3707 $t configure
-state normal
3709 $t insert end
"${text}\n"
3710 $t configure
-state disabled
3712 set bf
[WindowLink
$win.
frame]
3713 set l
[WindowLink
$win.left
]
3714 set m
[WindowLink
$win.middle
]
3715 set r
[WindowLink
$win.vote
]
3716 set rf
[WindowLink
$win.voteframe
]
3720 -text [lindex $left 0] \
3721 -command [format [lindex $left 2] $head]
3722 SetHelp
$l [lindex $left 1]
3723 pack append $bf $l {left
frame center
}
3728 if {$middle != ""} {
3730 -text [lindex $middle 0] \
3731 -command [format [lindex $middle 2] $head]
3732 SetHelp
$m [lindex $middle 1]
3733 pack append $bf $m {left
frame center expand
}
3739 set notify
[format [lindex $right 2] $head]
3740 set preview
[format [lindex $right 3] $head]
3741 set cmd
[list DoVote
$win Ask
$notify $preview]
3743 -text [lindex $right 0] \
3745 SetHelp
$r [lindex $right 1]
3746 pack append $bf $rf {right
frame center
}
3755 proc BindVotingButton
{win but name
} {
3756 set w
[WindowLink
$win.top
]
3758 bind $but <Any-Enter
> "VoteButtonEnter $win $but"
3759 bind $but <Any-Leave
> "VoteButtonLeave $win $but"
3760 bind $but <1> "VoteButtonDown $win $but $name"
3761 bind $but <ButtonRelease-1
> "VoteButtonUp $win $but $name"
3762 bind $but <2> "VoteButtonDown $win $but $name"
3763 bind $but <ButtonRelease-2
> "VoteButtonUp $win $but $name"
3764 bind $but <3> "VoteButtonDown $win $but $name"
3765 bind $but <ButtonRelease-3
> "VoteButtonUp $win $but $name"
3769 proc VoteButtonEnter
{win but
} {
3771 set screen
[winfo screen
$but]
3772 if {[lindex [$but config
-state] 4] != "disabled"} {
3773 $but config
-state active
3774 set tk_priv
(window
@$screen) $but
3776 set tk_priv
(window
@$screen) ""
3781 proc VoteButtonLeave
{win but
} {
3783 if {[lindex [$but config
-state] 4] != "disabled"} {
3784 $but config
-state normal
3786 set screen
[winfo screen
$but]
3787 set tk_priv
(window
@$screen) ""
3791 proc VoteButtonDown
{win but name
} {
3793 set screen
[winfo screen
$but]
3794 set rel
[lindex [$but config
-relief] 4]
3795 set tk_priv
(relief
@$screen) $rel
3796 if {[lindex [$but config
-state] 4] != "disabled"} {
3797 set head
[WindowLink
$win.head
]
3798 if {[IsVotingFor
$head $name]} {
3799 $but config
-relief raised
3801 $but config
-relief sunken
3807 proc VoteButtonUp
{win but name
} {
3809 set screen
[winfo screen
$but]
3810 $but config
-relief $tk_priv(relief
@$screen)
3811 if {($but == $tk_priv(window
@$screen))
3812 && ([lindex [$but config
-state] 4] != "disabled")} {
3813 uplevel #0 [list $but invoke]
3814 set head
[WindowLink
$win.head
]
3815 if {[IsVotingFor
$head $name]} {
3816 $but config
-relief sunken
3818 $but config
-relief raised
3824 proc PressVoteButton
{win but name
} {
3826 uplevel #0 [list $but invoke]
3827 set head
[WindowLink
$win.head
]
3828 if {[IsVotingFor
$head $name]} {
3829 $but config
-relief sunken
3831 $but config
-relief raised
3836 proc IsVotingFor
{win name
} {
3837 global VotesFor
$name
3838 set votes
[eval ident
"\$\{VotesFor$name\}"]
3839 if {[lsearch $votes $win] == -1} {
3847 proc DoVote
{win name notify preview
} {
3848 global VotesFor
$name
3849 set votes
[eval ident
"\$\{VotesFor$name\}"]
3851 set win
[WindowLink
$win.head
]
3852 set i
[lsearch $votes $win]
3854 lappend VotesFor
$name $win
3856 set VotesFor
$name [lreplace $votes $i $i]
3859 set votes
[eval ident
"\$\{VotesFor$name\}"]
3860 if {[llength $votes] >= [NeededVotes
]} {
3868 proc UpdateVotesFor
{name wins
} {
3869 global VotesFor
$name
3870 set votes
[eval llength "\$\{VotesFor$name\}"]
3871 set needed
[NeededVotes
]
3874 set head
[WindowLink
$win.head
]
3875 if {[IsVotingFor
$head $name]} {
3876 set border
[expr "($needed - $votes) * 1"]
3877 set pad
[expr "6 - $border"]
3878 [WindowLink
$win.vote
] config
-padx $pad -pady $pad
3879 [WindowLink
$win.voteframe
] config
-borderwidth $border
3881 set border
[expr "($needed - $votes - 1) * 1"]
3882 set pad
[expr "6 - $border"]
3883 [WindowLink
$win.vote
] config
-padx $pad -pady $pad
3884 [WindowLink
$win.voteframe
] config
-borderwidth $border
3890 proc InitVotesForAsk
{} {
3891 global VotesForAsk AskWindows
3893 foreach win
$AskWindows {
3894 [WindowLink
$win.vote
] config
-relief raised
3901 proc UpdateVotesForAsk
{} {
3903 UpdateVotesFor Ask
$AskWindows
3907 ########################################################################
3908 # Player Window Handlers
3910 proc ShowPlayerOf
{head
} {
3911 set win
[WindowLink
$head.player
]
3913 set win
[MakeWindow.player
$head [winfo screen
$head]]
3921 proc ShowPlayers
{} {
3923 foreach win
$HeadWindows {
3929 proc WithdrawPlayers
{} {
3930 global PlayerWindows
3931 foreach win
$PlayerWindows {
3937 proc UpdatePlayers
{} {
3938 # TODO: Disabled for new scenario window.
3941 global HeadWindows PlayerWindows
3944 foreach win
$HeadWindows {
3945 set server
[winfo screen
$win]
3946 # if {[string first : $server] == 0} {
3947 # set server "[exec hostname]:0"
3949 lappend players
$server
3952 sim Players
[llength $players]
3954 foreach win
$PlayerWindows {
3955 set list [WindowLink
$win.players
]
3957 eval "$list insert 0 $players"
3960 UpdateVotesForUseThisMap
3962 UpdateVotesForBudget
3963 UpdateTaxRateSliders
3967 proc UIShowPlayer
{win
} {
3972 proc DoNewPlayer
{win
} {
3973 set field
[WindowLink
$win.display
]
3974 set dpy
[$field get
]
3979 if {[AddPlayer
$dpy] != ""} {
3985 ########################################################################
3986 # Notice Window Handlers
3989 proc ShowNoticeOf
{head
} {
3990 set win
[WindowLink
$head.notice
]
3992 set win
[MakeWindow.notice
$head [winfo screen
$head]]
3994 global NoticePanelWidth NoticePanelHeight
3995 #place configure $win -x 0 -y 0 -width $NoticePanelWidth -height $NoticePanelHeight
3996 pack append [WindowLink
$head.w3
] \
3997 $win {bottom
frame sw expand fill
}
4002 proc ShowNotices
{} {
4004 foreach win
$HeadWindows {
4010 proc WithdrawNotices
{} {
4011 global NoticeWindows
4012 foreach win
$NoticeWindows {
4019 proc ReShowPictureOn
{{head
""}} {
4020 global ShowingPicture ShowingParms
4021 UIShowPictureOn
$head $ShowingPicture $ShowingParms
4025 proc UIShowPicture
{id
{parms
""}} {
4026 UIShowPictureOn
"" $id $parms
4030 proc UIShowPictureOn
{where id
{parms
""}} {
4031 global DoNotices Messages ShowingPicture ShowingParms
4032 if {$DoNotices == 0} {
4036 set ShowingPicture
$id
4037 set ShowingParms
$parms
4038 set msg
$Messages($id)
4039 set color
[lindex $msg 0]
4040 set title
[lindex $msg 1]
4041 set body
[lindex $msg 2]
4043 set cmd
"format {$body} $parms"
4044 set body
[uplevel #0 $cmd]
4046 set props
[lindex $msg 3]
4047 if {"$where" == ""} {
4049 set where
$HeadWindows
4051 foreach head
$where {
4052 NoticeMessageOn
$head "$title" $color "$body" Medium
$props
4057 proc NoticeMessageOn
{head title color
text font props
} {
4059 set win
[WindowLink
$head.notice
]
4061 set t
[WindowLink
$win.title
]
4062 $t configure
-text $title -background $color
4064 set t
[WindowLink
$win.
text]
4065 $t configure
-state normal
-font [Font
$head $font]
4067 $t insert end
"${text}\n"
4068 $t configure
-state disabled
4071 catch {set left
[keylget props left
]}
4072 set l
[WindowLink
$win.left
]
4074 $l config
-bitmap $left
4075 place $l -in $t -anchor sw
-relx .05 -rely .95
4081 catch {set middle
[keylget props middle
]}
4082 set m
[WindowLink
$win.middle
]
4083 if {$middle != ""} {
4084 $m config
-bitmap $middle
4085 place $m -in $t -anchor s
-relx .5 -rely .95
4091 catch {set right
[keylget props right
]}
4092 set r
[WindowLink
$win.right
]
4094 $r config
-bitmap $right
4095 place $r -in $t -anchor se
-relx .95 -rely .95
4101 catch {set view
[keylget props view
]}
4102 set vf
[WindowLink
$win.viewframe
]
4104 set v
[WindowLink
$win.view
]
4105 set bg
[WindowLink
$win.background
]
4109 pack append $bg $vf {left
frame center fill
}
4110 pack append $bg $t {right
frame center fill expand
}
4117 proc UIPopUpMessage
{msg
} {
4122 proc ComeToMe
{view
} {
4123 set win
[winfo toplevel $view]
4126 set x
[expr "[lindex $xy 0] >>4"]
4127 set y
[expr "[lindex $xy 1] >>4"]
4133 proc ComeTo
{win x y
} {
4134 global EditorWindows
4135 set head
[WindowLink
$win.head
]
4138 foreach ed
$EditorWindows {
4139 if {"[WindowLink $ed.head]" == "$head"} {
4141 set view
[WindowLink
$ed.view
]
4142 if {[$view AutoGoto
]} {
4143 lappend myautoeds
$ed
4147 if {[llength $myautoeds]} {
4148 UIAutoGotoOn
$x $y $myautoeds
4150 if {[llength $myeds]} {
4151 UIAutoGotoOn
$x $y $myeds
4157 proc FollowView
{view id
} {
4161 if {[sim DoAnimation
]} {
4162 set head
[WindowLink
[winfo toplevel $view].head
]
4163 global EditorWindows
4164 foreach win
$EditorWindows {
4165 if {"[WindowLink $win.head]" == "$head"} {
4166 set s
[[WindowLink
$win.view
] Skip
]
4167 set skips
[min
$skips $s]
4171 if {$skips == 999999} {
4181 proc PanView
{view x y
} {
4187 ########################################################################
4188 # Help Window Handlers
4191 proc ShowHelpOf
{head
} {
4192 set win
[WindowLink
$head.help
]
4194 set win
[MakeWindow.help
$head [winfo screen
$head]]
4204 foreach win
$HeadWindows {
4210 proc WithdrawHelps
{} {
4212 foreach win
$HelpWindows {
4218 ########################################################################
4219 # Frob Window Handlers
4222 proc ShowFrobOf
{head
} {
4223 set win
[WindowLink
$head.frob
]
4225 set win
[MakeWindow.frob
$head [winfo screen
$head]]
4236 foreach win
$HeadWindows {
4242 proc WithdrawFrobs
{} {
4244 foreach win
$FrobWindows {
4250 proc UISetDynamic
{i min max
} {
4251 sim DynamicData
[expr "$i*2"] $min
4252 sim DynamicData
[expr "$i*2+1"] $max
4256 ########################################################################
4263 source $ResourceDir/help.tcl
4266 proc HandleHelp
{win x y rootx rooty
} {
4267 global HelpLoaded HelpWidgets Messages
4269 if {$HelpLoaded == 0} {
4275 set head
[WindowLink
[winfo toplevel $win].head
]
4278 catch {set id
$HelpWidgets($win)}
4282 set list [split $win .
]
4283 set len
[expr "[llength $list] - 2"]
4284 set list [lrange $list 0 $len]
4285 if {[llength $list] <= 1} {
4289 set win
[join $list .
]
4291 if [info exists Messages
($id)] {
4292 UIShowHelpOn
$head $id
4294 UIShowHelpOn
$head Window
4299 proc UIShowHelpOn
{win id
{parms
""}} {
4300 global Messages ShowingPicture ShowingParms ResourceDir
4301 set head
[WindowLink
$win.head
]
4302 set msg
$Messages($id)
4303 set color
[lindex $msg 0]
4304 set title
[lindex $msg 1]
4305 set body
[lindex $msg 2]
4307 set cmd
"format {$body} $parms"
4308 set body
[uplevel #0 $cmd]
4310 set props
[lindex $msg 3]
4313 set win
[WindowLink
$head.help
]
4315 set t
[WindowLink
$win.title
]
4316 $t configure
-text $title -background $color
4318 set t
[WindowLink
$win.
text]
4319 $t configure
-state normal
-font [Font
$head Large
]
4321 $t insert end
"${body}\n"
4322 FormatHTML
$ResourceDir/doc
/$id.html
$t
4323 $t configure
-state disabled
4327 proc FormatHTML
{filename text} {
4330 set f
[open $filename]
4337 while {[gets $f line
] >= 0} {
4338 if {"$line" == "</body>"} {
4341 if {([string index
$line 0] == "#") ||
([string length
$line] == 0)} {
4344 $text insert end
"$line\n"
4353 proc SetHelp
{win id
} {
4355 set HelpWidgets
($win) $id
4359 proc Help
{id title
{msg
{}} {props
{}}} {
4360 Message
$id #7f7fff $title $msg $props
4363 ########################################################################
4367 # Set up the bindings to pop up $pie when the right button is clicked in $win
4368 proc InitPie
{win pie
} {
4369 bind $win <Motion
> {}
4370 bind $win <3> "PieMenuDown $win $pie $pie Initial %X %Y"
4371 bind $win <B3-Motion
> {}
4372 bind $win <B3-ButtonRelease
> {}
4376 # Set up the bindings to continue tracking $pie
4377 # Get this: we keep the tracking machine state in the bindings!
4378 proc ActivatePie
{win root pie state
} {
4379 bind $win <Motion
> "PieMenuMotion $win $root $pie $state %X %Y"
4380 bind $win <3> "PieMenuDown $win $root $pie $state %X %Y"
4381 bind $win <B3-Motion
> "PieMenuMotion $win $root $pie $state %X %Y"
4382 bind $win <B3-ButtonRelease
> "PieMenuUp $win $root $pie $state %X %Y"
4386 # Cancel and reset a pie menu
4387 proc CancelPie
{win
} {
4388 set binding
[bind $win <3>]
4389 set root
[lindex $binding 2]
4390 set pie
[lindex $binding 3]
4391 set state
[lindex $binding 4]
4392 if {"$state" != "Initial"} {
4393 catch {$root ungrab
$win}
4396 UIMakeSoundOn
$win fancy Oop
4402 # Handle pie menu button down
4403 proc PieMenuDown
{win root pie state x y
} {
4406 ActivatePie
$win $root $pie FirstDown
4408 catch {$root grab $win}
4411 PreviewPieMenu
$win $pie $x $y
4415 TrackPieMenu
$pie $x $y
4416 ActivatePie
$win $root $pie SecondDown
4422 PreviewPieMenu
$win $pie $x $y
4423 ActivatePie
$win $root $pie SecondDown
4428 SecondDown
{ # error
4435 # Handle pie menu button motion
4436 proc PieMenuMotion
{win root pie state x y
} {
4439 TrackPieMenu
$pie $x $y
4447 TrackPieMenu
$pie $x $y
4461 # Handle pie menu button up
4462 proc PieMenuUp
{win root pie state x y
} {
4465 TrackPieMenu
$pie $x $y
4466 set active
[$pie index active
]
4467 if {$active == "none"} {
4469 catch {$root grab $win}
4470 ActivatePie
$win $root $pie ClickedUp
4472 set label [lindex [$pie entryconfig
$active -label] 4]
4473 set submenu
[lindex [$pie entryconfig
$active -piemenu] 4]
4474 UIMakeSoundOn
$win mode
$label
4475 if {$submenu == {}} {
4476 set reward
[$pie pending
]
4477 catch {$root ungrab
$win}
4481 sim Funds
[expr "[sim Funds] + 5"]
4482 UIMakeSoundOn
$win fancy Aaah
4484 eval [lindex [$pie entryconfig
$active -command] 4]
4489 $submenu activate none
4491 PreviewPieMenu
$win $submenu $x $y
4492 catch {$root grab $win}
4493 ActivatePie
$win $root $submenu SelectedUp
4498 TrackPieMenu
$pie $x $y
4499 set active
[$pie index active
]
4500 if {$active == "none"} {
4503 set label [lindex [$pie entryconfig
$active -label] 4]
4504 set submenu
[lindex [$pie entryconfig
$active -piemenu] 4]
4505 UIMakeSoundOn
$win mode
$label
4506 if {$submenu == {}} {
4507 set reward
[$pie pending
]
4508 catch {$root ungrab
$win}
4512 sim Funds
[expr "[sim Funds] + 5"]
4513 UIMakeSoundOn
$win fancy Aaah
4515 eval [lindex [$pie entryconfig
$active -command] 4]
4520 $submenu activate none
4522 PreviewPieMenu
$win $submenu $x $y
4523 catch {$root grab $win}
4524 ActivatePie
$win $root $submenu SelectedUp
4534 SelectedUp
{ # error
4541 # Track the selected item
4542 proc TrackPieMenu
{pie x y
} {
4543 $pie activate
@$x,$y
4547 proc PreviewPieMenu
{win pie x y
} {
4548 set preview
[lindex [$pie config
-preview] 4]
4549 if {"$preview" != ""} {
4550 set rx
[winfo rootx
$win]
4551 set ry
[winfo rooty
$win]
4552 set x
[expr "$x - $rx"]
4553 set y
[expr "$y - $ry"]
4554 eval [format $preview $x $y]
4559 ########################################################################
4563 proc ExclusivePallet
{state parent children prefix images inactive active cmd
} {
4564 #echo "ExclusivePallet state $state parent $parent children $children prefix $prefix images $images inactive $inactive active $active cmd $cmd"
4566 foreach child
$children {
4567 set name
[lindex $images $i]
4568 if {$i == $state} then
{
4569 $parent.
$child config
\
4570 -bitmap "@images/${prefix}${name}hi.xpm" \
4573 $parent.
$child config
\
4574 -bitmap "@images/${prefix}${name}.xpm" \
4579 eval [concat $cmd $state]
4583 proc NonExclusivePallet
{mask parent children prefix images
4584 inactive active cmd
} {
4586 foreach child
$children {
4587 set name
[lindex $images $i]
4588 if {$mask & (1<<$i)} then
{
4589 $parent.
$child config
\
4590 -bitmap "@images/${prefix}${name}hi.xpm" \
4593 $parent.
$child config
\
4594 -bitmap "@images/${prefix}${name}.xpm" \
4599 eval [concat $cmd $mask]
4603 proc EditorPallet
{win state
} {
4604 global EditorPalletSounds
4605 UIMakeSoundOn
$win mode
[lindex $EditorPalletSounds $state]
4606 EditorSetTool
$win $state
4610 proc EditorSetTool
{win state
} {
4611 global EditorPallets
4612 global EditorPalletImages
4613 ExclusivePallet
$state $win $EditorPallets ic
$EditorPalletImages \
4614 flat raised
"$win.centerframe.view ToolState"
4618 proc GraphPallet
{win state
} {
4619 set mask
[[WindowLink
$win.graphview
] Mask
]
4620 set mask
[expr "$mask ^ (1<<$state)"]
4621 GraphPalletMask
$win $mask
4625 proc GraphPalletMask
{win mask
} {
4627 global GraphPalletImages
4628 NonExclusivePallet
$mask $win $GraphPallets gr
$GraphPalletImages \
4629 flat flat
"SetGraphState $win"
4633 proc GraphYearPallet
{win state
} {
4634 global GraphYearPallets
4635 global GraphYearPalletImages
4636 ExclusivePallet
$state $win $GraphYearPallets gr
$GraphYearPalletImages \
4637 flat flat
"SetGraphYearState $win"
4641 proc SetGraphYearState
{win state
} {
4642 set graph
[WindowLink
$win.graphview
]
4651 proc SetGraphState
{win mask
} {
4653 set graph
[WindowLink
$win.graphview
]
4658 ########################################################################
4661 proc sim_butEnter
{w
} {
4663 set screen
[winfo screen
$w]
4664 set tk_priv
(window
@$screen) $w
4668 proc sim_butLeave
{w
} {
4670 set screen
[winfo screen
$w]
4671 set tk_priv
(window
@$screen) ""
4675 proc sim_butDown
{w
} {
4677 set screen
[winfo screen
$w]
4678 set pict
[lindex [$w config
-bitmap] 4]
4679 set tk_priv
(relief
@$screen) $pict
4680 $w config
-bitmap [lindex [split $pict .
] 0]hi.xpm
4685 proc sim_butUp
{w
} {
4687 set screen
[winfo screen
$w]
4688 $w config
-bitmap $tk_priv(relief
@$screen)
4690 if {$w == $tk_priv(window
@$screen)} {
4691 uplevel #0 [list $w invoke]
4696 proc BindSimButton
{w
} {
4697 bind $w <Any-Enter
> {sim_butEnter
%W
}
4698 bind $w <Any-Leave
> {sim_butLeave
%W
}
4699 bind $w <1> {sim_butDown
%W
}
4700 bind $w <ButtonRelease-1
> {sim_butUp
%W
}
4701 bind $w <2> {sim_butDown
%W
}
4702 bind $w <ButtonRelease-2
> {sim_butUp
%W
}
4703 bind $w <3> {sim_butDown
%W
}
4704 bind $w <ButtonRelease-3
> {sim_butUp
%W
}
4708 ########################################################################
4709 # Internal Callbacks
4712 proc UIStartMicropolis
{homedir resourcedir hostname
} {
4713 global HomeDir ResourceDir HostName HeadWindows
4714 set HomeDir
$homedir
4715 set ResourceDir
$resourcedir
4716 set HostName
$hostname
4721 foreach display
[sim Displays
] {
4722 if {"[AddPlayer $display]" == ""} {
4723 echo Couldn't add a player on
$display ...
4727 if {"$HeadWindows" == ""} {
4728 echo Micropolis is exiting because it couldn't connect to any players.
4734 proc UISelectCity
{win
} {
4735 AskQuestion
[Color
$win #ff0000 #ffffff] "Choose Another City" \
4736 "Do you want to abandon this city and choose another one?" \
4737 "{Keep playing.} SelectCity.No {RejectPlan}" \
4739 "{Another city!} SelectCity.Yes {UIPickScenarioMode}"
4743 proc UIQuit
{head
} {
4744 if {[sim Players
] == 1} {
4745 set l
"{Keep playing.} Quit.No {RejectPlan}"
4747 set r
"{I quit!} Quit.IQuit {DoReallyQuit %s}"
4749 set l
"{Keep playing.} Quit.No {RejectPlan}"
4750 set m
"{I quit!} Quit.IResign {DoIResign %s}"
4751 set r
"{Everyone quit!} Quit.AllQuit {DoReallyQuit %s}"
4753 AskQuestion
[Color
$head #ff0000 #ffffff] "Quit Playing Micropolis" \
4754 "Do you want to quit playing Micropolis?" \
4759 proc DoIResign
{head
} {
4761 set display
[winfo screen
$head]
4763 DecRefDisplay
$display
4764 UISetMessage
"The player on X11 Display $display has resigned."
4766 if {([sim Players
] == 0) ||
4767 ([llength $VotesForAsk] >= [sim Players
])} {
4773 proc DoReallyQuit
{head
} {
4779 proc UISplashMode
{} {
4789 proc UIPickScenarioMode
{} {
4798 InitVotesForUseThisMap
4803 proc ForcePickScenarioMode
{} {
4805 if {"$State" != "scenario"} {
4811 proc UIGenerateCityNow
{} {
4812 global CityName GameLevel
4813 sim CityName NowHere
4819 proc UIGenerateNewCity
{} {
4820 global CityName GameLevel
4821 if {$GameLevel == -1} {
4824 MakeHistory
"DoNewCity NowHere $GameLevel [sim Rand] [sim TreeLevel] [sim LakeLevel] [sim CurveLevel] [sim CreateIsland]"
4828 proc DoNewCity
{name level
{r
""} {tl
-1} {ll
-1} {cl
-1} {ci
-1}} {
4834 sim CreateIsland
$ci
4838 sim GenerateSomeCity
$r
4841 sim GameLevel
$level
4846 proc UIDidGenerateNewCity
{} {
4851 proc IncRefDisplay
{display
} {
4852 global DisplayRegistry
4853 if ![info exists DisplayRegistry
($display)] {
4854 set DisplayRegistry
($display) 0
4856 incr DisplayRegistry
($display)
4860 proc DecRefDisplay
{display
} {
4861 global DisplayRegistry
4862 incr DisplayRegistry
($display) -1
4863 if {$DisplayRegistry($display) <= 0} {
4864 CloseDisplay
$display
4869 proc CloseDisplay
{display
} {
4873 proc DoStopMicropolis
{} {
4879 proc AddPlayer
{display
} {
4880 set i
[string first
: $display]
4884 set display
"$display:0"
4888 echo Adding a player on
$display ...
4890 set head
[MakeWindow.head
$display]
4892 if {"$head" != ""} {
4893 set display
[winfo screen
$head]
4894 IncRefDisplay
$display
4896 UISetMessage
"Added a player on X11 Display \"$display\"."
4899 UISetMessage
"Couldn't add a player on X11 Display \"$display\"!"
4909 proc DropFireBombs
{} {
4917 proc UIMakeMonster
{} {
4918 sim MakeMonster
[sim Rand
120] [sim Rand
100]
4941 proc TogglePause
{} {
4944 if {"$State" != "play" ||
[sim Speed
]} {
4955 proc SetSpeedTime
{time} {
4961 proc MakeRunningSound
{} {
4964 if {"$State" == "play" && [sim Speed
]} {
4965 UIMakeSound edit Boing
"-speed 1[sim Speed]0"
4967 UIMakeSound edit Boing
"-speed 90"
4972 proc SayDemands
{} {
4973 global DemandRes DemandCom DemandInd
4975 set r
[expr "100 + ($DemandRes * $slope)"]
4976 set c
[expr "100 + ($DemandCom * $slope)"]
4977 set i
[expr "100 + ($DemandInd * $slope)"]
4978 after 020 "UIMakeSound edit O \"-speed $r\""
4979 after 220 "UIMakeSound edit A \"-speed $c\""
4980 after 440 "UIMakeSound edit E \"-speed $i\""
4984 proc UISaveCity
{win
} {
4986 set SaveCityWin
$win
4991 proc UISaveCityAs
{{win
""}} {
4993 if {"$win" == ""} {set win
$SaveCityWin}
4994 set SaveCityWin
$win
4997 set file [ShowFileOf
$win]
4998 DoFileDialog
$file "Choose a File to Save the City" $CityDir "*.cty" "" \
4999 "UIDoReallySaveCity" ""
5003 proc UIDoReallySaveCity
{name path
} {
5005 if {![string match
*.cty
$name]} {
5009 sim SaveCityAs
$path/$name
5013 proc UIDidSaveCity
{} {
5014 DoSendMessage
"Saved the city in \"[sim CityFileName]\"." status
5018 proc UIDidntSaveCity
{msg
} {
5019 DoSendMessage
$msg alert
5020 UIMakeSound warning Sorry
"-speed 85"
5024 proc UILoadScenario
{scen
} {
5025 MakeHistory
"DoScenario $scen"
5029 proc DoScenario
{scen
} {
5032 sim LoadScenario
$scen
5037 proc UIDidLoadScenario
{} {
5041 proc UIStartScenario
{id
} {
5050 proc UIPlayNewCity
{} {
5056 proc UIStartLoad
{} {
5061 proc UIReallyStartGame
{} {
5067 proc UIPlayGame
{} {
5074 SetPriority
$Priority
5082 proc UISetSpeed
{speed
} {
5085 if {"$State" == "play"} {
5086 UISetMessage
[lindex {
5089 {Time flows medium.
}
5097 proc UIUpdateRunning
{} {
5098 global HeadWindows Time State
5100 if {($State == "play") && $Time} {
5101 set pict
"@images/micropolisg.xpm"
5103 set pict
"@images/micropoliss.xpm"
5106 foreach win
$HeadWindows {
5107 set can
[WindowLink
$win.demand
]
5108 $can itemconfig micropolis
-bitmap $pict
5113 proc DoSetGameLevel
{level
} {
5114 sim GameLevel
$level
5118 proc UISetGameLevel
{level
} {
5120 set GameLevel
$level
5121 global ScenarioWindows
5122 foreach win
$ScenarioWindows {
5123 UpdateLevelSelection
$win
5128 proc UISetCityName
{name
} {
5129 global EditorWindows
5132 set title
"Micropolis Editor on $name"
5133 foreach win
$EditorWindows {
5134 # TODO: set editor window and icon title
5135 #wm title $win "$title"
5136 #wm iconname $win "$title"
5141 proc UILoadCity
{win
} {
5142 # if changed, r-u-sure?
5144 set file [ShowFileOf
$win]
5145 DoFileDialog
$file "Choose a City to Load" $CityDir "*.cty" "" \
5150 proc UIDoLoadCity
{name path
} {
5153 if {![string match
*.cty
$name]} {
5156 MakeHistory
"DoLoadCity {$path/$name}"
5160 proc DoLoadCity
{filename} {
5161 sim LoadCity
$filename
5164 proc UIDidLoadCity
{} {
5165 global State GameLevel Scenario
5168 if {$State == "play"} {
5171 UIShowPicture
49 [sim CityFileName
]
5176 proc UIDidntLoadCity
{msg
} {
5177 DoSendMessage
$msg alert
5178 UIMakeSound warning Sorry
"-speed 85"
5179 UIShowPicture
49 [sim CityFileName
]
5198 proc UIDidPan
{w x y
} {
5199 if {[$w ToolMode
] == 1} {
5200 EditorToolDrag
$w $x $y
5206 proc UIDidStopPan
{win
} {
5207 UIMakeSoundOn
$win fancy Skid
"-volume 25"
5212 proc UIEarthQuake
{} {
5216 proc UIAutoGoto
{x y
{except
{}}} {
5217 global EditorWindows
5219 set x
[expr "$x * 16 + 8"]
5220 set y
[expr "$y * 16 + 8"]
5221 foreach win
$EditorWindows {
5222 if {"$win" != "$except"} {
5223 set view
[WindowLink
$win.view
]
5224 if {[$view AutoGoto
]} {
5226 $view AutoGoal
$x $y
5236 proc UIAutoGotoOn
{x y eds
} {
5237 set x
[expr "$x * 16 + 8"]
5238 set y
[expr "$y * 16 + 8"]
5240 [WindowLink
$win.view
] AutoGoal
$x $y
5246 proc DoLeaveGame
{head
} {
5250 proc UILoseGame
{} {
5254 AskQuestion
[Color .
#ff0000 #ffffff] [lindex $Messages(200) 1] \
5255 [lindex $Messages(200) 2] \
5258 "{Ok} SelectCity.Yes {UIPickScenarioMode}"
5267 proc DoPendTool
{view tool x y
} {
5268 global HeadWindows ToolInfo VotesForAsk
5270 set win
[WindowLink
$view.top
]
5271 set head
[WindowLink
$win.head
]
5273 if {($tool == [sim PendingTool
]) &&
5274 ($x == [sim PendingX
]) &&
5275 ($y == [sim PendingY
])} {
5276 if {[lsearch $VotesForAsk $head] != -1} {
5277 # you can only vote once
5278 UIMakeSound edit Oop
5280 UIMakeSound edit Boing
5281 set ask
[WindowLink
$head.ask
]
5282 PressVoteButton
$ask [WindowLink
$ask.vote
] Ask
5285 UIAutoGoto
$x $y $win
5287 UIMakeSound edit Boing
5288 set info [lindex $ToolInfo $tool]
5289 set a
[lindex $info 0]
5290 set name
[lindex $info 1]
5291 set cost
[lindex $info 2]
5292 set title
"Build $a $name"
5293 set question
"Do you support the plan to build $a $name for $cost?"
5294 AskQuestion
[Color
$win #00ff00 #ffffff] "$title" \
5296 "{Veto plan.} Plan.Veto
5298 "{Goto plan.} Plan.Goto
5299 {ComeTo %s $x $y}" \
5300 "{Support plan!} Plan.Support
5301 {SupportPlan $view %s $tool $x $y}
5302 {PreviewSupportPlan $view %s $tool $x $y}"
5303 set VotesForAsk
$head
5304 set ask
[WindowLink
$head.ask
]
5305 [WindowLink
$ask.vote
] config
-relief sunken
5309 sim PendingTool
$tool
5312 sim Votes
[llength $VotesForAsk]
5317 proc RejectPlan
{} {
5319 if {[sim Players
] > 1} {
5320 UIMakeSound edit Sorry
5326 proc NeededVotes
{} {
5328 set players
[sim Players
]
5329 set needed
[expr "$players - $FreeVotes"]
5330 return [max
0 $needed]
5334 proc SupportPlan
{view h tool x y
} {
5336 sim Votes
[llength $VotesForAsk]
5339 $view DoTool
$tool $x $y
5342 UIMakeSound edit Aaah
5346 proc PreviewSupportPlan
{view h tool x y
} {
5348 sim Votes
[llength $VotesForAsk]
5352 proc SugarStartUp
{uri
} {
5356 # TODO: Load the city file at the given URI, or configure according to URI parameters.
5360 proc SugarNickName
{nick
} {
5361 global SugarNickName
5362 set SugarNickName
$nick
5366 proc SugarActivate
{} {
5367 global SugarActivated
5368 set SugarActivated
1
5372 proc SugarDeactivate
{} {
5373 global SugarActivated
5374 set SugarActivated
0
5378 proc SugarShare
{} {
5384 proc SugarBuddyAdd
{key nick color address
} {
5386 set buddy
[list $key $nick $color $address]
5387 lappend SugarBuddies
$buddy
5391 proc SugarBuddyDel
{key nick color address
} {
5393 set buddy
[list $key $nick $color $address]
5394 set i
[lsearch $wins $win]
5396 set SugarBuddies
[lreplace $wins $i $i]
5406 ########################################################################