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
110 set AudioChannels
{mode edit fancy warning intercom
}
113 set BudgetTimerActive
0
115 set EvaluationsVisible
0
116 set SplashScreenDelay
5000
119 set ChatServer
"localhost"
121 set ChatConnection
{}
122 set NickName
"nickname"
123 set UserName
"username"
124 set ServerName
"servername"
125 set RealName
"realname"
126 set ChannelName
"#Micropolis"
130 set LocalHostName
"[exec hostname]"
138 set ShowingPicture
300
142 set VoteNames
{UseThisMap Ask Zone
}
143 set VotesForUseThisMap
{}
146 set VotesForBudget
{}
154 set EvaluationWindows
{}
156 set ScenarioWindows
{}
164 set HeadPanelWidth
360
165 set HeadPanelHeight
200
167 set MapPanelWidth
360
168 set MapPanelHeight
330
170 set NoticePanelWidth
360
171 set NoticePanelHeight
250
173 set SplashPanelWidth
1200
174 set SplashPanelHeight
900
176 set ScenarioPanelWidth
420
177 set ScenarioPanelHeight
440
186 {editor EditorWindows
}
189 {budget BudgetWindows
}
190 {evaluation EvaluationWindows
}
191 {scenario ScenarioWindows
}
192 {splash SplashWindows
}
195 {player PlayerWindows
}
196 {notice NoticeWindows
}
203 # 0 1 2 3 4 5 6 7 8 9 10 11 12 13
204 # type id callback param var x y w h normal over disabled checked checkedover
205 # ----------- --------------- --------------- ------- ------- --- --- --- --- ------- ---- -------- ------- -----------
206 set ScenarioButtons
{
207 { button load DoLoad
"" "" 70 238 157 90 "" @images
/button1hilite.xpm
"" }
208 { button generate DoGenerate
"" "" 62 392 157 90 "" @images
/button2hilite.xpm
"" }
209 { button quit DoQuit
"" "" 68 544 157 90 "" @images
/button3hilite.xpm
"" }
210 { button about DoAbout
"" "" 101 705 157 90 "" @images
/button4hilite.xpm
"" }
211 { checkbox easy DoLevel
0 "" 982 106 190 70 "" @images
/checkbox1hilite.xpm
"" @images
/checkbox1checked.xpm
@images
/checkbox1hilitechecked.xpm
}
212 { checkbox medium DoLevel
1 "" 982 176 190 70 "" @images
/checkbox2hilite.xpm
"" @images
/checkbox2checked.xpm
@images
/checkbox2hilitechecked.xpm
}
213 { checkbox hard DoLevel
2 "" 982 246 190 70 "" @images
/checkbox3hilite.xpm
"" @images
/checkbox3checked.xpm
@images
/checkbox3hilitechecked.xpm
}
214 { button left DoLeft
"" "" 540 375 50 50 "" @images
/lefthilite.xpm
@images
/leftdisabled.xpm
}
215 { button right DoRight
"" "" 841 375 50 50 "" @images
/righthilite.xpm
@images
/rightdisabled.xpm
}
216 { button play DoPlay
"" "" 625 376 180 50 "" @images
/playhilite.xpm
"" }
217 { button scenario1 DoPickScenario
"1" "" 310 451 209 188 "" @images
/scenario1hilite.xpm
"" }
218 { button scenario2 DoPickScenario
"2" "" 519 451 209 188 "" @images
/scenario2hilite.xpm
"" }
219 { button scenario3 DoPickScenario
"3" "" 727 450 209 188 "" @images
/scenario3hilite.xpm
"" }
220 { button scenario4 DoPickScenario
"4" "" 936 450 209 188 "" @images
/scenario4hilite.xpm
"" }
221 { button scenario5 DoPickScenario
"5" "" 310 639 209 188 "" @images
/scenario5hilite.xpm
"" }
222 { button scenario6 DoPickScenario
"8" "" 519 639 209 188 "" @images
/scenario6hilite.xpm
"" }
223 { button scenario7 DoPickScenario
"7" "" 728 638 209 188 "" @images
/scenario7hilite.xpm
"" }
224 { button scenario8 DoPickScenario
"6" "" 937 638 209 188 "" @images
/scenario8hilite.xpm
"" }
227 # Disabled until we handle mouse events on the map itself.
228 # { button map DoMap "" "" 516 30 396 338 "" @images/maphilite.xpm }
231 ########################################################################
237 {-*-dejavu lgc sans-medium-r-normal-
*-90-*}
240 {-*-dejavu lgc sans-medium-r-normal-
*-80-*}
243 {-*-dejavu lgc sans-medium-r-normal-
*-70-*}
246 {-*-dejavu lgc sans-medium-r-normal-
*-60-*}
249 {-*-dejavu lgc sans-medium-r-normal-
*-60-*}
252 {-*-dejavu lgc sans-medium-r-normal-
*-60-*}
255 {-*-dejavu lgc sans-medium-r-normal-
*-70-*}
258 {-*-dejavu lgc sans-medium-r-normal-
*-70-*}
261 {-*-dejavu lgc sans-medium-r-normal-
*-70-*}
266 ########################################################################
270 {Micropolis Overall Map
}
271 {Residential Zone Map
}
272 {Commercial Zone Map
}
273 {Industrial Zone Map
}
276 {Population Density Map
}
278 {Traffic Density Map
}
279 {Pollution Desity Map
}
283 {Police Coverage Map
}
289 leftframe.tools.palletres
290 leftframe.tools.palletcom
291 leftframe.tools.palletind
292 leftframe.tools.palletfire
293 leftframe.tools.palletquery
294 leftframe.tools.palletpolice
295 leftframe.tools.palletwire
296 leftframe.tools.palletbulldozer
297 leftframe.tools.palletrail
298 leftframe.tools.palletroad
299 leftframe.tools.palletchalk
300 leftframe.tools.palleteraser
301 leftframe.tools.palletstadium
302 leftframe.tools.palletpark
303 leftframe.tools.palletseaport
304 leftframe.tools.palletcoal
305 leftframe.tools.palletnuclear
306 leftframe.tools.palletairport
310 set EditorPalletImages
{
311 res com ind fire qry pol
312 wire dozr rail road chlk ersr
313 stad park seap coal nuc airp
317 set EditorPalletSounds
{
318 Res Com Ind Fire Query Police
319 Wire Bulldozer Rail Road Chalk Eraser
320 Stadium Park Seaport Coal Nuclear Airport
328 leftframe.right.money
329 leftframe.right.crime
330 leftframe.right.pollution
334 set GraphPalletImages
{
335 res com ind mony crim poll
339 set GraphYearPallets
{
340 leftframe.year.year10
341 leftframe.year.year120
345 set GraphYearPalletImages
{ 10 120 }
349 { {a
} {Residential Zone
} {$100}}
350 { {a
} {Commercial Zone
} {$100}}
351 { {an
} {Industrial Zone
} {$100}}
352 { {a
} {Fire Station
} {$500}}
353 { {a
} {Query
} {free
}}
354 { {a
} {Police Station
} {$500}}
356 { {a
} {Bulldozer
} {$1}}
359 { {a
} {Chalk
} {free
}}
360 { {an
} {Eraser
} {free
}}
361 { {a
} {Stadium
} {$5,000}}
363 { {a
} {Seaport
} {$3,000}}
364 { {a
} {Coal Power Plant
} {$3,000}}
365 { {a
} {Nuclear Power Plant
} {$5,000}}
366 { {an
} {Airport
} {$10,000}}
367 { {a
} {Network
} {$1,000}}
371 set DynamicDataNames
{
382 ########################################################################
384 ########################################################################
387 wm title .
{Micropolis Root
}
390 if {"[sim Platform]" == "msdos"} {
411 # The next three lines have no effect on the OLPC, where we don't provide
412 # the font in res (because it's already in the system fonts). These lines
413 # are for other systems that lack the font.
414 set FontPath
"[pwd]/res/dejavu-lgc"
415 system
"xset -fp $FontPath >&/dev/null"
416 system
"xset +fp $FontPath >&/dev/null"
419 ########################################################################
421 ########################################################################
424 proc Message
{id color title msg
{props
{}}} {
426 set Messages
($id) [list $color $title $msg $props]
430 Message
1 #7f7fff {DULLSVILLE, USA 1900} \
431 {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.
433 It is your job to attract new growth and development
, turning Dullsville into a Metropolis within
30 years.
}
435 Message
2 #7f7fff {SAN FRANCISCO, CA. 1906} \
436 {Damage from the earthquake was minor compared to that of the ensuing fires
, which took days to control.
1500 people died.
438 Controlling the fires should be your initial concern. Then clear the rubble and start rebuilding. You have
5 years.
}
440 Message
3 #7f7fff {HAMBURG, GERMANY 1944} \
441 {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.
443 You must control the firestorms during the bombing and then rebuild the city
after the war. You have
5 years.
}
445 Message
4 #7f7fff {BERN, SWITZERLAND 1965} \
446 {The roads here are becoming more congested every day
, and the residents are upset. They demand that you do something about it.
448 Some have suggested a mass transit system as the answer
, but this would require major rezoning in the downtown area. You have
10 years.
}
450 Message
5 #7f7fff {TOKYO, JAPAN 1957} \
451 {A large reptilian creature has been spotted heading
for Tokyo bay. It seems to be attracted to the heavy levels of industrial pollution there.
453 Try to control the fires
, then rebuild the industrial center. You have
5 years.
}
455 Message
6 #7f7fff {DETROIT, MI. 1972} \
456 {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.
458 You have
10 years to reduce crime and rebuild the industrial base of the city.
}
460 Message
7 #7f7fff {BOSTON, MA. 2010} \
461 {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.
463 You have
5 years to get the situation under control.
}
465 Message
8 #7f7fff {RIO DE JANEIRO, BRAZIL 2047} \
466 {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.
468 You have
10 years to turn this swamp back into a city again.
}
470 Message
9 #ffa500 {Query Zone Status} \
478 {{view
{PanView
$v $QueryX $QueryY}}}
480 Message
10 #ff4f4f {POLLUTION ALERT!} \
481 {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.
483 Either clean up your act or
open a gas mask concession at city hall.
} \
484 {{view
{PanView
$v [sim PolMaxX
] [sim PolMaxY
]}}}
486 Message
11 #ff4f4f {CRIME ALERT!} \
487 {Crime in your city is our 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.
} \
488 {{view
{PanView
$v [sim CrimeMaxX
] [sim CrimeMaxY
]}}}
490 Message
12 #ff4f4f {TRAFFIC WARNING!} \
491 {Traffic in this city is horrible. The city gridlock is expanding. The commuters are getting militant.
493 Either build more roads and rails or get a bulletproof limo.
} \
494 {{view
{PanView
$v [sim TrafMaxX
] [sim TrafMaxY
]}}}
496 Message
20 #ff4f4f {FIRE REPORTED!} \
497 "A fire has been reported!" \
498 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
500 Message
21 #ff4f4f {MONSTER ATTACK!} \
501 "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. \
502 All you can do is wait till he leaves, then rebuild from the rubble." \
503 {{view
{FollowView
$v monster
}}}
505 # XXX: write more text
506 Message
22 #ff4f4f {TORNADO ALERT!} \
507 {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
!} \
508 {{view
{FollowView
$v tornado
}}}
510 # XXX: write more text
511 Message
23 #ff4f4f {EARTHQUAKE!} \
512 {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.
} \
513 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
515 # XXX: write more text
516 Message
24 #ff4f4f {PLANE CRASH!} \
517 {A plane has crashed
!} \
518 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
520 # XXX: write more text
521 Message
25 #ff4f4f {SHIPWRECK!} \
522 {A ship has wrecked
!} \
523 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
525 # XXX: write more text
526 Message
26 #ff4f4f {TRAIN CRASH!} \
527 {A train has crashed
!} \
528 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
530 # XXX: write more text
531 Message
27 #ff4f4f {HELICOPTER CRASH!} \
532 {A helicopter has crashed
!} \
533 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
535 Message
30 #ff4f4f {FIREBOMBING REPORTED!} \
536 {Firebombs are falling
!!} \
537 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
539 Message
35 #7fff7f {TOWN} \
540 {Congratulations
, your village has grown to town status. You now have
2,000 citizens.
} \
541 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
543 Message
36 #7fff7f {CITY} \
544 {Your town has grown into a full sized city
, with a current population of
10,000. Keep up the good work
!} \
545 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
547 Message
37 #7fff7f {CAPITAL} \
548 {Your city has become a capital. The current population here is
50,000. Your political future looks bright.
} \
549 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
551 Message
38 #7fff7f {METROPOLIS} \
552 {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.
} \
553 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
555 Message
39 #7fff7f {MEGALOPOLIS} \
556 {Congratulation
, you have reached the highest category of urban development
, the megalopolis.
558 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.
} \
559 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
561 Message
40 #7fff7f {MEGALINIUM} \
562 {Congratulation
, you have reached the end of
time!
564 Because of the toroidal nature of the the Micropolis Space
/Time Continuum
, your city has wrapped back in
time to
1900!} \
565 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
567 # XXX: write more text
568 Message
41 #ff4f4f {HEAVY TRAFFIC!} \
570 reporting heavy traffic
!} \
571 {{view
{FollowView
$v helicopter
}}}
573 # XXX: write more text
574 Message
42 #ff4f4f {FLOODING REPORTED!} \
575 {Flooding has been been reported along the water's edge
!} \
576 {{view
{PanView
$v [sim FloodX
] [sim FloodY
]}}}
578 Message
43 #ff4f4f {NUCLEAR MELTDOWN!} \
579 {A nuclear meltdown has occured at your power plant. You are advised to avoid the area until the radioactive isotopes decay.
581 Many generations will confront this problem before it goes away
, so don't hold your breath.
} \
582 {{view
{PanView
$v [sim MeltX
] [sim MeltY
]}}}
585 Message
44 #ff4f4f {RIOTS!} \
586 {The citizens are rioting in the streets
, setting cars and houses on fire
, and bombing government buildings and businesses
!
588 All media coverage is blacked out
, while the fascist pigs beat the poor citizens into submission.
}
590 Message
46 #ff4f4f {NO SOUND SERVER!} \
591 {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.
}
593 Message
48 #7f7fff {Start a New City} \
594 {Build your very own city from the ground up
, starting with this map of uninhabited land.
}
596 Message
49 #7f7fff {Restore a Saved City} \
597 {This city was saved in the
file named
: %s
}
599 Message
100 #7fff7f {YOU'RE A WINNER!} \
600 {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?
} \
601 {{middle
{@images
/key2city.xpm
}}}
603 Message
200 #ff4f4f {IMPEACHMENT NOTICE!} \
604 {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.
606 You should seriously consider taking an extended vacation
-- NOW.
(Or
read the manual and try again.
)}
608 Message
300 #ffd700 {About Micropolis} \
609 "Micropolis Version [sim Version] Copyright (C) 2007
611 Based on the Original Micropolis Concept and Design
613 TCL/Tk User Interface Designed and Created
614 by Don Hopkins, DUX Software.
615 Ported to Linux, Optimized and Adapted for OLPC
617 Licensed under the GNU General Public License,
618 version 3, with additional conditions."
621 ########################################################################
623 ########################################################################
626 option add
*CheckButton.relief flat
627 option add
*Dialog.cursor top_left_arrow
628 option add
*Entry.relief sunken
629 option add
*Frame.borderWidth
0
630 option add
*Listbox.relief sunken
631 option add
*Scrollbar.relief sunken
632 option add
*RadioButton.anchor w
633 option add
*RadioButton.relief flat
635 option add
*background
#b0b0b0
636 option add
*foreground
#000000
637 option add
*activeBackground
#d0d0d0
638 option add
*activeForeground
#000000
639 option add
*disabledForeground
""
640 option add
*selectBackground
#d0d0d0
641 option add
*selectForeground
#000000
642 #option add *selector #ffff80
643 option add
*selector
#bf0000
645 option add
*Scrollbar.Background
#b0b0b0
646 option add
*Scrollbar.Foreground
#d0d0d0
647 option add
*Interval.Background
#b0b0b0
648 option add
*Interval.Foreground
#000000
649 option add
*Interval.activeForeground
#d0d0d0
650 option add
*Interval.sliderForeground
#b0b0b0
651 option add
*Scale.activeForeground
#d0d0d0
652 option add
*Scale.sliderForeground
#b0b0b0
653 option add
*PieMenu.activeBackground
#b0b0b0
655 option add Mwm
*Micropolis.clientDecoration
-maximize
658 ########################################################################
660 ########################################################################
663 bind all
<Help
> {HandleHelp
%W
%x
%y
%X
%Y
}
664 bind all
<Shift-ButtonPress
> {HandleHelp
%W
%x
%y
%X
%Y
}
665 bind all
<Meta-ButtonPress
> {HandleHelp
%W
%x
%y
%X
%Y
}
666 bind all
<Shift-Meta-ButtonPress
> {HandleHelp
%W
%x
%y
%X
%Y
}
669 ########################################################################
671 ########################################################################
690 puts stderr
"$errorInfo"
698 proc NoFunction
{args
} {}
701 proc LinkWindow
{fromname to
} {
703 set WindowLinks
($fromname) $to
707 proc WindowLink
{fromname
} {
710 catch {set to
$WindowLinks($fromname)}
715 proc DeleteWindow
{sym name win
} {
716 set head
[WindowLink
$win.head
]
717 LinkWindow
$head.
$sym {}
719 set wins
[eval ident
"\$$name"]
720 set i
[lsearch $wins $win]
722 set $name [lreplace $wins $i $i]
728 proc Font
{win name
} {
729 global FontInfo FontCache HeadWindows
730 set scr
[winfo screen
$win]
733 set font $FontCache($scr,$name)
738 set label $FontCache($scr)
740 if {"$label" == ""} {
741 foreach head
$HeadWindows {
742 if {"[winfo screen $head]" == "$scr"} {
743 set label $head.fontlabel
744 label $label -text "X11 Sucks" -font fixed
745 set FontCache
($scr) $label
750 set fonts
[keylget FontInfo
$name]
751 foreach font $fonts {
752 #echo "Configuring font $font on $label"
753 if {[catch "$label config -font \"$font\""] == 0} {
766 set FontCache
($scr,$name) $font
772 proc Color
{win color mono
} {
773 if {[winfo screendepth
$win] == 1} {
781 ########################################################################
782 # Window Definition Functions
783 ########################################################################
786 proc MakeWindow.head
{{display
":0"}} {
788 source $ResourceDir/whead.tcl
793 proc MakeWindow.editor
{head
{display
":0"}} {
795 source $ResourceDir/weditor.tcl
800 proc MakeWindow.map
{head
{display
":0"}} {
802 source $ResourceDir/wmap.tcl
807 proc MakeWindow.graph
{head
{display
":0"}} {
809 source $ResourceDir/wgraph.tcl
814 proc MakeWindow.budget
{head
{display
":0"}} {
816 source $ResourceDir/wbudget.tcl
821 proc MakeWindow.evaluation
{head
{display
":0"}} {
823 source $ResourceDir/weval.tcl
828 proc MakeWindow.splash
{head
{display
":0"}} {
830 source $ResourceDir/wsplash.tcl
835 proc MakeWindow.scenario
{head
{display
":0"}} {
837 source $ResourceDir/wscen.tcl
842 proc MakeWindow.
file {head
{display
":0"}} {
844 source $ResourceDir/wfile.tcl
849 proc MakeWindow.ask
{head
{display
":0"}} {
851 source $ResourceDir/wask.tcl
856 proc MakeWindow.player
{head
{display
":0"}} {
858 source $ResourceDir/wplayer.tcl
863 proc MakeWindow.notice
{head
{display
":0"}} {
865 source $ResourceDir/wnotice.tcl
869 proc MakeWindow.help
{head
{display
":0"}} {
871 source $ResourceDir/whelp.tcl
875 proc MakeWindow.frob
{head
{display
":0"}} {
877 source $ResourceDir/wfrob.tcl
882 ########################################################################
884 ########################################################################
887 proc UIInitializeSound
{} {
891 proc UIShutDownSound
{} {
895 proc UIDoSoundOn
{win cmd
} {
896 global Sound SoundServers
898 set win
[WindowLink
[winfo toplevel $win].head
]
899 if {[lsearch $SoundServers $win] != -1} {
900 set cmd
"send -quick -server $win Sound sound $cmd"
902 # XXX: Lost a sound server...
910 proc UIDoSound
{cmd
} {
911 global Sound SoundServers
913 foreach win
$SoundServers {
914 set foo
"send -quick -server $win Sound $cmd"
916 # XXX: Lost a sound server...
924 proc KillSoundServers
{} {
926 foreach win
$SoundServers {
927 set foo
"send -quick -server $win Sound KillSoundServer"
934 proc UISetChannelVolume
{win chan vol
} {
935 UIDoSoundOn
$win "channel $chan -volume $vol"
939 proc EchoPlaySound
{soundspec
} {
940 # Temporary workaround to tell Python Sugar app to play sound.
943 echo PlaySound
[lindex $soundspec 0]
944 exec play res
/sounds
/[string tolower
[lindex $soundspec 0]].wav
&
949 proc UIMakeSoundOn
{win chan sound
{opts
""}} {
950 # Send message to Python to play sound.
953 #UIDoSoundOn $win "play $sound -replay -channel $chan $opts"
957 proc UIStartSoundOn
{win chan sound
{opts
""}} {
958 # Send message to Python to play sound.
961 #UIDoSoundOn $win "play $sound -replay -channel $chan -repeat 100 $opts"
965 proc UIStopSoundOn
{win chan sound
{opts
""}} {
966 UIDoSoundOn
$win "stop $sound"
970 proc UIMakeSound
{chan sound
{opts
""}} {
971 # Send message to Python to play sound.
974 #UIDoSound "sound play $sound -replay -channel $chan $opts"
978 proc UIStartSound
{chan sound
{opts
""}} {
979 # Send message to Python to play sound.
982 #UIDoSound "sound play $sound -channel $chan -repeat 100 $opts"
986 proc UIStopSound
{chan sound
{opts
""}} {
987 UIDoSound
"sound stop $sound"
991 proc SetupSoundServer
{win
} {
996 proc AddSoundServer
{win
} {
998 set i
[lsearch $SoundServers $win]
1000 set SoundServers
[linsert $SoundServers 0 $win]
1005 proc LostSoundServer
{win
} {
1006 DeleteSoundServer
$win
1007 # UIShowPictureOn [WindowLink $win.head] 46 [winfo screen $win]
1011 proc DeleteSoundServer
{win
} {
1013 set i
[lsearch $SoundServers $win]
1015 set SoundServers
[lreplace $SoundServers $i $i]
1020 proc UISoundOff
{} {
1024 proc MonsterSpeed
{} {
1025 return [expr "[sim Rand 40] + 70"]
1029 proc ExplosionPitch
{} {
1030 return [expr "[sim Rand 20] + 90"]
1035 return [expr "[sim Rand 20] + 90"]
1039 ########################################################################
1040 # Global Window Handlers
1043 proc WithdrawAll
{} {
1061 proc ShowInitial
{} {
1069 ########################################################################
1070 # Head Window Handlers
1073 proc PrepHead
{head
} {
1080 WithdrawHeadOf
$head
1084 after 1000 "WithdrawSplashOf $head"
1085 WithdrawHeadOf
$head
1086 ShowScenarioOf
$head
1090 WithdrawSplashOf
$head
1091 WithdrawScenarioOf
$head
1096 ReShowPictureOn
$head
1104 proc ShowHeadOf
{head
} {
1109 proc WithdrawHeadOf
{head
} {
1116 foreach win
$HeadWindows {
1122 proc WithdrawHeads
{} {
1124 foreach win
$HeadWindows {
1130 proc DeleteHeadWindow
{head
} {
1137 foreach win
$HeadWindows {
1143 proc InitHead
{win
} {
1144 set w
[WindowLink
$win.
text]
1145 $w configure
-state normal
1148 $w configure
-state disabled
1150 if {[sim MultiPlayerMode
]} {
1151 set w
[WindowLink
$win.
entry]
1162 proc InitAllHeadMenus
{} {
1165 foreach win
$HeadWindows {
1171 proc InitHeadMenus
{win
} {
1173 set m0
[WindowLink
$win.m0
]
1174 set m1
[WindowLink
$win.m1
]
1175 set m2
[WindowLink
$win.m2
]
1176 set m3
[WindowLink
$win.m3
]
1177 set m4
[WindowLink
$win.m4
]
1178 set b0
[WindowLink
$win.b0
]
1179 set b1
[WindowLink
$win.b1
]
1180 set b2
[WindowLink
$win.b2
]
1181 set b3
[WindowLink
$win.b3
]
1182 set b4
[WindowLink
$win.b4
]
1196 # When in multi player mode there is an extra menu
1197 # item to add another player, before the quit item,
1198 # so compensate for it here.
1199 if {[sim MultiPlayerMode
]} {
1204 $b0 config
-state normal
1205 $b2 config
-state disabled
1206 $b4 config
-state disabled
1211 # When in multi player mode there is an extra menu
1212 # item to add another player, before the quit item,
1213 # so compensate for it here.
1214 if {[sim MultiPlayerMode
]} {
1219 $b0 config
-state normal
1220 $b2 config
-state normal
1221 $b4 config
-state normal
1227 proc UIDisaster
{win cmd action
} {
1228 AskQuestion
[Color
$win #ff0000 #ffffff] "Cause a Disaster" \
1229 "Oh no! Do you really want to $action" \
1230 "{No way!} Disaster.No {WithdrawAsks}" \
1232 "{I guess so.} Disaster.Yes {WithdrawAsks ; $cmd}"
1236 proc CrushHead
{head
} {
1237 global SubWindows VoteNames
1239 foreach foo
$VoteNames {
1241 set votes
[eval ident
\$VotesFor$foo]
1242 set i
[lsearch $votes $head]
1244 set VotesFor
$foo [lreplace $votes $i $i]
1248 foreach foo
$SubWindows {
1249 set sym
[lindex $foo 0]
1250 set name
[lindex $foo 1]
1252 set wins
[eval ident
"\$$name"]
1254 if {[WindowLink
$win.head
] == $head} {
1255 DeleteWindow
$sym $name $win
1262 proc ChatDown
{win
} {
1284 global ChatConnection
1286 DoSendMessage
"Opening Connection to Chat Server $ChatServer socket $ChatSocket ..." status
1288 set ChatConnection
{}
1290 set ChatConnection
[connect
$ChatServer $ChatSocket]
1293 if {$ChatConnection == {}} then
{
1294 DoSendMessage
"Sorry, I could not open a connection to chat server $ChatServer socket $ChatSocket." status
1297 filehandler
$ChatConnection r
"ReceiveChat"
1308 puts $ChatConnection "USER $UserName $HostName $ServerName $RealName\r\n" nonewline
1309 puts $ChatConnection "NICK $NickName\r\n" nonewline
1310 puts $ChatConnection "JOIN $ChannelName\r\n" nonewline
1311 flush $ChatConnection
1316 proc ReceiveChat
{mode f
} {
1317 # DoSendMessage "ReceiveChat: MODE $mode F $f"
1321 if {[string first
{:} $msg]} {
1325 set from
[lindex $msg 0]
1326 set cmd
[string tolower
[lindex $msg 1]]
1330 if {($cmd == "privmsg") ||
1331 ($cmd == "notice")} then
{
1333 set chan
[lindex $msg 2]
1334 set i
[expr "[string length $from] + 1 + [string length $cmd] + 1 + [string length $chan] + 2"]
1335 set j
[expr "[string length $msg] - 2"]
1336 set line
[string range
$msg $i $j]
1337 set chan
[string range
$chan 1 [string length
$chan]]
1338 set from
[string range
$from 1 [expr "[string length $from] - 1"]]
1339 set from
[split $from {!}]
1340 set from
[lindex $from 0]
1341 DoSendMessage
"$from> $line"
1344 if {$handled == 0} {
1345 set msg
[string range
$msg \
1346 [expr "[string length $from] + 1"] \
1347 [expr "[string length $msg] - 2"]]
1353 proc SendChatMessage
{msg win
} {
1354 global ChatConnection ChannelName NickName
1360 if {[string range
$msg 0 0] == "/"} {
1361 set cmd
[string range
$msg 1 [string length
$msg]]
1362 DoSendMessage
"$NickName> \[$cmd\]"
1365 set cmd
"PRIVMSG $ChannelName :$msg\r\n"
1366 DoSendMessage
"$NickName> $msg"
1373 puts $ChatConnection $cmd nonewline
1374 flush $ChatConnection
1379 DoSendMessage
"IRC Broke the connection"
1389 global ChatConnection
1391 DoSendMessage
"Closing Connection to Chat Server." status
1394 puts $ChatConnection "QUIT\r\n" nonewline
1395 flush $ChatConnection
1396 $ChatConnection close
1399 set ChatConnection
{}
1404 proc DoEnterMessage
{win var
} {
1407 set msg
[eval ident
"\$\{$var\}"]
1409 if {$Chatting} then
{
1410 SendChatMessage
$msg $win
1418 proc DoEvalMessage
{win var
} {
1420 set command
[eval ident
"\$\{$var\}"]
1422 DoSendMessage
"Evaluating TCL: $command"
1423 catch {uplevel #0 $command} result
1424 DoSendMessage
"Result: $result"
1428 proc DoSendMessage
{msg
{tag
message}} {
1430 foreach win
$HeadWindows {
1431 appendWithTag
[WindowLink
$win.
text] $tag "$msg"
1436 proc UISetMessage
{msg
{tag status
}} {
1437 global DoMessages EditorWindows HeadWindows
1439 if {$DoMessages == 0} {
1443 foreach win
$EditorWindows {
1444 [WindowLink
$win.
message] configure
-text "$msg"
1447 foreach win
$HeadWindows {
1448 appendWithTag
[WindowLink
$win.
text] $tag "$msg"
1455 proc appendWithTag
{w tag
text} {
1459 set start
[$w index end
]
1460 $w configure
-state normal
1461 if {$start > $MaxLines} then
{
1462 $w delete
0.0 $ShrinkLines.0
1463 set start
[$w index end
]
1465 $w insert end
"${text}\n"
1466 $w tag add
$tag $start {end
- 1 char
}
1467 $w configure
-state disabled
1468 $w yview
-pickplace {end
- 1 char
}
1472 ########################################################################
1473 # Budget Window Handlers
1476 proc ShowBudgetOf
{head
} {
1477 set win
[WindowLink
$head.budget
]
1479 set win
[MakeWindow.budget
$head [winfo screen
$head]]
1488 proc ShowBudgets
{} {
1489 global HeadWindows BudgetsVisible
1490 set BudgetsVisible
1
1491 foreach win
$HeadWindows {
1497 proc WithdrawBudgets
{} {
1498 global BudgetWindows BudgetsVisible
1499 foreach win
$BudgetWindows {
1503 set BudgetsVisible
0
1507 proc BudgetContinue
{{win
""}} {
1508 global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1510 if {([sim RoadFund
] != $BudgetRoadFund) ||
1511 ([sim FireFund
] != $BudgetFireFund) ||
1512 ([sim PoliceFund
] != $BudgetPoliceFund) ||
1513 ([sim TaxRate
] != $BudgetTaxRate)} {
1514 UISetMessage
"The budget was changed."
1516 UISetMessage
"The budget wasn't changed."
1524 proc BudgetReset
{{win
""}} {
1525 global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1526 if {([sim RoadFund
] != $BudgetRoadFund) ||
1527 ([sim FireFund
] != $BudgetFireFund) ||
1528 ([sim PoliceFund
] != $BudgetPoliceFund) ||
1529 ([sim TaxRate
] != $BudgetTaxRate)} {
1530 UISetMessage
"The budget was reset."
1531 if {[sim Players
] > 1} {
1532 UIMakeSound edit Sorry
1535 UISetMessage
"The budget was reset."
1537 sim RoadFund
$BudgetRoadFund
1538 sim FireFund
$BudgetFireFund
1539 sim PoliceFund
$BudgetPoliceFund
1540 sim TaxRate
$BudgetTaxRate
1546 proc BudgetCancel
{{win
""}} {
1554 proc SetTaxRate
{rate
} {
1559 proc BudgetSetTaxRate
{rate
} {
1565 proc BudgetSetRoadFund
{percent
} {
1566 sim RoadFund
$percent
1571 proc BudgetSetFireFund
{percent
} {
1572 sim FireFund
$percent
1577 proc BudgetSetPoliceFund
{percent
} {
1578 sim PoliceFund
$percent
1583 proc UIShowBudgetAndWait
{} {
1584 global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1585 if {$OldBudget == 0} {
1586 set BudgetRoadFund
[sim RoadFund
]
1587 set BudgetFireFund
[sim FireFund
]
1588 set BudgetPoliceFund
[sim PoliceFund
]
1589 set BudgetTaxRate
[sim TaxRate
]
1593 UISetMessage
"Pausing to set the budget ..."
1599 sim UpdateBudgetWindow
1603 proc ToggleBudgetTimer
{} {
1604 global BudgetTimerActive
1605 if {$BudgetTimerActive} {
1613 proc StopBudgetTimer
{} {
1614 global BudgetTimerActive
1615 set BudgetTimerActive
0
1620 proc StartBudgetTimer
{} {
1621 global BudgetTimerActive BudgetTimer BudgetTimeout
1623 set BudgetTimerActive
$me
1624 set BudgetTimer
$BudgetTimeout
1626 after 1000 TickBudgetTimer
$me
1630 proc RestartBudgetTimer
{} {
1631 global BudgetTimerActive
1632 if {$BudgetTimerActive} {
1639 proc UpdateBudgetTimer
{} {
1640 global BudgetWindows BudgetTimerActive BudgetTimer
1641 if {$BudgetTimerActive} {
1642 set text [format "Auto Cancel In %d Seconds (click to disable)" $BudgetTimer]
1644 set text [format "Enable Auto Cancel (currently disabled)"]
1646 foreach win
$BudgetWindows {
1647 set t
[WindowLink
$win.timer
]
1648 $t config
-text "$text"
1653 proc TickBudgetTimer
{me
} {
1654 global BudgetTimerActive BudgetTimer BudgetTimeout
1655 if {$BudgetTimerActive == $me} {
1657 if {$BudgetTimer < 0} {
1663 after 1000 TickBudgetTimer
$me
1669 proc FireBudgetTimer
{} {
1679 proc ToggleAutoBudget
{} {
1682 #echo "ToggleAutoBudget found on, clearing"
1685 #echo "ToggleAutoBudget found off, setting"
1691 proc UIUpdateBudget
{} {
1696 proc UpdateAutoBudget
{} {
1697 global BudgetWindows AutoBudget
1698 if {[sim AutoBudget
]} {
1699 set text "Disable Auto Budget (currently enabled)"
1701 set text "Enable Auto Budget (currently disabled)"
1703 #echo "UpdateAutoBudget $AutoBudget $text"
1704 foreach win
$BudgetWindows {
1705 set t
[WindowLink
$win.autobudget
]
1706 $t config
-text "$text"
1711 proc UISetBudget
{cashflow previous current collected taxrate
} {
1712 global BudgetWindows BudgetsVisible
1714 #echo "UISetBudgetValues $taxrate $BudgetsVisible"
1716 if {$BudgetsVisible} {
1718 foreach win
$BudgetWindows {
1719 set w
[WindowLink
$win.cashflow
]
1720 set old
[lindex [$w configure
-text] 4]
1721 if {$old != $cashflow} {
1722 $w configure
-text $cashflow
1724 set w
[WindowLink
$win.previous
]
1725 set old
[lindex [$w configure
-text] 4]
1726 if {$old != $previous} {
1727 $w configure
-text $previous
1729 set w
[WindowLink
$win.current
]
1730 set old
[lindex [$w configure
-text] 4]
1731 if {$old != $current} {
1732 $w configure
-text $current
1734 set w
[WindowLink
$win.collected
]
1735 set old
[lindex [$w configure
-text] 4]
1736 if {$old != $collected} {
1737 $w configure
-text $collected
1740 set w
[WindowLink
$win.taxrate
]
1742 if {$old != $taxrate} {
1746 set w
[WindowLink
$win.taxlabel
]
1747 set old
[lindex [$w configure
-text] 4]
1750 $w configure
-text $new
1756 foreach win
$HeadWindows {
1758 set w
[WindowLink
$win.taxrate
]
1760 if {$old != $taxrate} {
1761 # FIXME: this might not work if the slider is disabled in multi player mode.
1765 set w
[WindowLink
$win.taxlabel
]
1766 set old
[lindex [$w configure
-text] 4]
1767 set new
"Tax Rate: $taxrate%"
1769 $w configure
-text $new
1775 proc UISetBudgetValues
{roadgot roadwant roadpercent policegot policewant policepercent firegot firewant firepercent
} {
1776 global BudgetWindows BudgetsVisible
1778 if {$BudgetsVisible == 0} {
1782 foreach win
$BudgetWindows {
1783 set w
[WindowLink
$win.fire
].request
1784 set old
[lindex [$w configure
-text] 4]
1785 set new
"$firepercent% of $firewant = $firegot"
1787 $w configure
-text $new
1789 set w
[WindowLink
$win.fire
].fund
1791 if {$old != $firepercent} {
1795 set w
[WindowLink
$win.police
].request
1796 set old
[lindex [$w configure
-text] 4]
1797 set new
"$policepercent% of $policewant = $policegot"
1799 $w configure
-text $new
1801 set w
[WindowLink
$win.police
].fund
1803 if {$old != $policepercent} {
1804 $w set $policepercent
1807 set w
[WindowLink
$win.road
].request
1808 set old
[lindex [$w configure
-text] 4]
1809 set new
"$roadpercent% of $roadwant = $roadgot"
1811 $w configure
-text $new
1813 set w
[WindowLink
$win.road
].fund
1815 if {$old != $roadpercent} {
1822 proc ChangeBudget
{} {
1823 global VotesForBudget
1824 if {"$VotesForBudget" != ""} {
1831 proc InitVotesForBudget
{} {
1832 global VotesForBudget BudgetWindows
1833 set VotesForBudget
{}
1834 foreach win
$BudgetWindows {
1835 [WindowLink
$win.vote
] config
-relief raised
1837 UpdateVotesForBudget
1841 proc UpdateVotesForBudget
{} {
1842 global BudgetWindows
1843 UpdateVotesFor Budget
$BudgetWindows
1847 proc UpdateTaxRateSliders
{} {
1849 set players
[sim Players
]
1850 foreach win
$HeadWindows {
1851 set slider
[WindowLink
$win.taxrate
]
1852 #echo "UpdateTaxRateSliders players $players win $win slider $slider"
1853 if {$players == 1} {
1854 $slider configure
-state normal
1856 $slider configure
-state disabled
1862 ########################################################################
1863 # Evaluation Window Handlers
1866 proc ToggleEvaluationOf
{head
} {
1868 if {"$State" != "play"} {
1873 set win
[WindowLink
$head.evaluation
]
1875 set mapped
[winfo ismapped
$win]
1879 WithdrawEvaluationOf
$head
1881 ShowEvaluationOf
$head
1887 proc WithdrawEvaluationOf
{head
} {
1888 set win
[WindowLink
$head.evaluation
]
1895 proc ShowEvaluationOf
{head
} {
1896 set win
[WindowLink
$head.evaluation
]
1898 set win
[MakeWindow.evaluation
$head [winfo screen
$head]]
1902 set parent
[WindowLink
$win.parent
]
1903 #pack append [WindowLink $head.col2]\
1904 # $parent {top frame nw fill}
1905 pack append $parent\
1906 $win {top
frame nw fillx
}
1908 sim UpdateEvaluation
1912 proc WithdrawEvaluations
{} {
1913 global EvaluationWindows EvaluationsVisible
1914 foreach win
$EvaluationWindows {
1916 #set parent [WindowLink $win.parent]
1917 #pack unpack $parent
1920 set EvaluationsVisible
0
1924 proc EvaluationVisible
{w v
} {
1925 global EvaluationsVisible
1926 global [set var
$w.visible
]
1931 set EvaluationsVisible
[expr "$EvaluationsVisible + 1"]
1933 set EvaluationsVisible
[expr "$EvaluationsVisible - 1"]
1938 proc UISetEvaluation
{changed score ps0 ps1 ps2 ps3 pv0 pv1 pv2 pv3 pop delta assessed cityclass citylevel goodyes goodno title
} {
1939 global EvaluationWindows EvaluationsVisible CurrentDate
1941 set class
[string tolower
$cityclass]
1942 UISetMessage
"$CurrentDate: Score $score, $class population $pop."
1944 if {$EvaluationsVisible} {
1946 foreach win
$EvaluationWindows {
1948 global [set var
$win.visible
]
1949 set visible
[eval ident
"\$\{$var\}"]
1953 # TODO: set evaluation window and icon title
1954 #wm title $win "$title"
1955 #wm iconname $win "$title"
1957 set w
[WindowLink
$win.goodjob
]
1958 set old
[lindex [$w configure
-text] 4]
1959 set new
"$goodyes\n$goodno"
1961 $w configure
-text $new
1964 set w
[WindowLink
$win.problemnames
]
1965 set old
[lindex [$w configure
-text] 4]
1966 set new
"$ps0\n$ps1\n$ps2\n$ps3"
1968 $w configure
-text $new
1971 set w
[WindowLink
$win.problempercents
]
1972 set old
[lindex [$w configure
-text] 4]
1973 set new
"$pv0\n$pv1\n$pv2\n$pv3"
1975 $w configure
-text $new
1978 set w
[WindowLink
$win.stats
]
1979 set old
[lindex [$w configure
-text] 4]
1980 set new
"$pop\n$delta\n\n$assessed\n$cityclass\n$citylevel"
1982 $w configure
-text $new
1985 set w
[WindowLink
$win.score
]
1986 set old
[lindex [$w configure
-text] 4]
1987 set new
"$score\n$changed"
1989 $w configure
-text $new
1997 ########################################################################
1998 # File Window Handlers
2001 proc ShowFileOf
{head
} {
2002 set win
[WindowLink
$head.
file]
2004 set win
[MakeWindow.
file $head [winfo screen
$head]]
2014 foreach win
$HeadWindows {
2020 proc WithdrawFiles
{} {
2022 foreach win
$FileWindows {
2028 proc DoFileDialog
{win Message Path Pattern FileName ActionOk ActionCancel
} {
2029 ShowFileDialog
$win "$Path" "$Pattern"
2030 $win.message1 configure
-text "$Message"
2031 $win.path.path delete
0 end
2032 $win.path.path insert
0 $Path
2033 $win.
file.
file delete
0 end
2034 $win.
file.
file insert
0 "$FileName"
2035 $win.frame1.ok config
-command "
2036 $ActionOk \[$win.file.file get\] \[$win.path.path get\]
2038 $win.frame1.rescan config
-command "
2039 ShowFileDialog $win \[$win.path.path get\] $Pattern"
2040 $win.frame1.cancel config
-command "
2043 bind $win.files.files
"<Double-Button-1>" "\
2044 FileSelectDouble $win %W %y $Pattern \"
2045 $ActionOk \[$win.file.file get\] \[$win.path.path get\]\""
2046 bind $win.path.path
<Return
> "
2047 ShowFileDialog $win \[$win.path.path get\] $Pattern
2048 $win.file.file cursor 0
2049 focus $win.file.file"
2050 bind $win.
file.
file <Return
> "\
2051 $ActionOk \[$win.file.file get\] \[$win.path.path get]
2056 proc BindSelectOne
{win Y
} {
2057 set Nearest
[$win nearest
$Y]
2058 if {$Nearest >= 0} {
2059 $win select from
$Nearest
2060 $win select to
$Nearest
2065 proc FileSelect
{win widget Y
} {
2066 BindSelectOne
$widget $Y
2067 set Nearest
[$widget nearest
$Y]
2068 if {$Nearest >= 0} {
2069 set Path
[$win.path.path get
]
2070 set TmpEntry
[$widget get
$Nearest]
2071 if {[string compare
"/" [string index
$TmpEntry \
2072 [expr [string length
$TmpEntry]-1]]] == 0 ||
\
2073 [string compare
"@" [string index
$TmpEntry \
2074 [expr [string length
$TmpEntry]-1]]] == 0} {
2075 # handle directories, and symbolic links to directories
2076 set FileName
[string range
$TmpEntry 0 \
2077 [expr [string length
$TmpEntry]-2]]
2078 # whoops / or @ is part of the name
2079 if {[MiscIsDir
$Path/$FileName] != 1} {
2080 set FileName
$TmpEntry
2083 if {[string compare
"*" [string index
$TmpEntry \
2084 [expr [string length
$TmpEntry]-1]]] == 0} {
2085 # handle executable filenames
2086 set FileName
[string range
$TmpEntry 0 \
2087 [expr [string length
$TmpEntry]-2]]
2088 # whoops * is part of the name
2089 if {[file executable
$Path/$FileName] != 1} {
2090 set FileName
$TmpEntry
2093 # a ordinary filename
2094 set FileName
$TmpEntry
2097 # enter the selected filename into the filename field
2098 if {[MiscIsDir
$Path/$FileName] != 1} {
2099 $win.
file.
file delete
0 end
2100 $win.
file.
file insert
0 $FileName
2106 proc FileSelectDouble
{win widget Y Pattern Action
} {
2107 BindSelectOne
$widget $Y
2108 set Nearest
[$widget nearest
$Y]
2109 if {$Nearest >= 0} {
2110 set Path
[$win.path.path get
]
2111 set TmpEntry
[$widget get
$Nearest]
2112 if {[string compare
$TmpEntry "../"] == 0} {
2113 # go up one directory
2115 [string trimright
[string trimright
[string trim
$Path] /] @]
2116 if {[string length
$TmpEntry] <= 0} {
2119 set Path
[file dirname
$TmpEntry]
2120 $win.path.path delete
0 end
2121 $win.path.path insert
0 $Path
2122 ShowFileDialog
$win $Path $Pattern
2124 if {[string compare
"/" [string index
$TmpEntry \
2125 [expr [string length
$TmpEntry]-1]]] == 0 ||
\
2126 [string compare
"@" [string index
$TmpEntry \
2127 [expr [string length
$TmpEntry]-1]]] == 0} {
2128 # handle directorys, and symbolic links to directorys
2129 set FileName
[string range
$TmpEntry 0 \
2130 [expr [string length
$TmpEntry]-2]]
2131 # whoops / or @ is part of the name
2132 if {[MiscIsDir
$Path/$FileName] != 1} {
2133 set FileName
$TmpEntry
2136 if {[string compare
"*" [string index
$TmpEntry \
2137 [expr [string length
$TmpEntry]-1]]] == 0} {
2138 # handle executable filenames
2139 set FileName
[string range
$TmpEntry 0 \
2140 [expr [string length
$TmpEntry]-2]]
2141 # whoops * is part of the name
2142 if {[file executable
$Path/$FileName] != 1} {
2143 set FileName
$TmpEntry
2146 # a ordinary filename
2147 set FileName
$TmpEntry
2151 if {[MiscIsDir
$Path/$FileName] == 1} {
2152 if {[string compare
"/" [string index
$Path \
2153 [expr [string length
$Path]-1]]] == 0} {
2154 append Path
$FileName
2156 append Path
/ $FileName
2158 $win.path.path delete
0 end
2159 $win.path.path insert
0 $Path
2160 ShowFileDialog
$win $Path $Pattern
2162 # enter the selected filename into the filename field
2163 $win.
file.
file delete
0 end
2164 $win.
file.
file insert
0 "$FileName"
2165 if {[string length
$Action] > 0} {
2175 proc NameComplete
{win Type
} {
2180 if {[string compare
$Type path
] == 0} {
2181 set DirName
[file dirname
[$win.path.path get
]]
2182 set FileName
[file tail
[$win.path.path get
]]
2184 set DirName
[file dirname
[$win.path.path get
]/]
2185 set FileName
[file tail
[$win.
file.
file get
]]
2189 if {[MiscIsDir
$DirName] == 1} {
2190 catch "exec ls $DirName/" Result
2192 set ListLength
[llength $Result]
2194 while {$Counter < $ListLength} {
2195 if {[string length
$FileName] == 0} {
2196 if {$FoundCounter == 0} {
2197 set NewFile
[lindex $Result $Counter]
2200 set TmpFile1
$NewFile
2201 set TmpFile2
[lindex $Result $Counter]
2202 set Length1
[string length
$TmpFile1]
2203 set Length2
[string length
$TmpFile2]
2205 if {$Length1 > $Length2} {
2206 set Length1
$Length2
2208 while {$Counter1 < $Length1} {
2209 if {[string compare
[string index
$TmpFile1 $Counter1] \
2210 [string index
$TmpFile2 $Counter1]] == 0} {
2211 append NewFile
[string index
$TmpFile1 $Counter1]
2220 if {[regexp "^$FileName" [lindex $Result $Counter] \
2222 if {$FoundCounter == 0} {
2223 set NewFile
[lindex $Result $Counter]
2226 set TmpFile1
$NewFile
2227 set TmpFile2
[lindex $Result $Counter]
2228 set Length1
[string length
$TmpFile1]
2229 set Length2
[string length
$TmpFile2]
2231 if {$Length1 > $Length2} {
2232 set Length1
$Length2
2234 while {$Counter1 < $Length1} {
2235 if {[string compare
[string index
$TmpFile1 $Counter1] \
2236 [string index
$TmpFile2 $Counter1]] == 0} {
2237 append NewFile
[string index
$TmpFile1 $Counter1]
2251 if {$FoundCounter == 1} {
2252 if {[MiscIsDir
$DirName/$NewFile] == 1} {
2253 if {[string compare
$DirName "/"] == 0} {
2254 $win.path.path delete
0 end
2255 $win.path.path insert
0 "/[string trim [string trim $NewFile /] @]/"
2257 $win.path.path delete
0 end
2258 $win.path.path insert
0 "[string trimright $DirName /]/[string trim [string trim $NewFile /] @]/"
2261 $win.path.path delete
0 end
2262 $win.path.path insert
0 \
2263 "[string trim [string trimright $DirName /] @]/"
2264 $win.
file.
file delete
0 end
2265 $win.
file.
file insert
0 "$NewFile"
2268 if {[MiscIsDir
$DirName/$NewFile] == 1 ||
2269 [string compare
$Type path
] == 0} {
2270 $win.path.path delete
0 end
2271 $win.path.path insert
0 \
2272 "[string trimright $DirName /]/[string trim [string trim $NewFile /] @]"
2274 $win.path.path delete
0 end
2275 $win.path.path insert
0 "$DirName"
2276 if {[string length
$NewFile] > 0} {
2277 $win.
file.
file delete
0 end
2278 $win.
file.
file insert
0 "$NewFile"
2285 proc ShowFileDialog
{win Path Pattern
} {
2287 set Path
[lindex [split $Path] 0]
2288 if {[$win.files.files size
] > 0} {
2289 $win.files.files delete
0 end
2292 if {[catch "exec ls -F $Path" Result
]} {
2295 if {[string match
$Result "* not found"]} {
2298 set ElementList
[lsort $Result]
2301 if {[string compare
$Path "/"]} {
2302 $win.files.files insert end
"../"
2306 foreach Counter
$ElementList {
2308 if {[string match
$Pattern $Counter] == 1} {
2309 if {[string compare
$Counter "../"] &&
2310 [string compare
$Counter "./"]} {
2311 $win.files.files insert end
$Counter
2314 set fn
$Path/[string trim
[string trim
[string trim
$Counter /] @] *]
2315 if {[MiscIsDir
$fn]} {
2316 $win.files.files insert end
$Counter
2324 proc MiscIsDir
{PathName
} {
2326 if {[file isdirectory
$PathName] == 1} {
2329 catch "file type $PathName" Type
2330 if {[string compare
$Type link
] == 0} {
2331 set LinkName
[file readlink
$PathName]
2332 catch "file type $LinkName" Type
2333 while {[string compare
$Type link
] == 0} {
2334 set LinkName
[file readlink
$LinkName]
2336 return [file isdirectory
$LinkName]
2343 proc busy
{win cmds
} {
2345 set list [winfo children
$win]
2347 while {$list != ""} {
2350 set class
[winfo class
$w]
2351 set cursor
[lindex [$w config
-cursor] 4]
2352 if {[winfo toplevel $w] == $w} {
2353 lappend busy
[list $w $cursor]
2355 set next
[concat $next [winfo children
$w]]
2361 catch {[lindex $w 0] config
-cursor watch
}
2366 set error [catch {uplevel eval [list $cmds]} result
]
2369 catch {[lindex $w 0] config
-cursor [lindex $w 1]}
2380 ########################################################################
2381 # Editor Window Handlers
2383 proc ShowEditorOf
{head
} {
2384 global EditorWindows
2386 foreach win
$EditorWindows {
2387 if {[WindowLink
$win.head
] == $head} {
2388 set parent
[WindowLink
$win.parent
]
2389 #pack append [WindowLink $head.col2]\
2390 # $parent {top frame nw expand fill}
2391 pack append $parent\
2392 $win {top
frame nw expand fill
}
2406 proc NewEditorOf
{head
} {
2407 set win
[MakeWindow.editor
$head [winfo screen
$head]]
2409 set parent
[WindowLink
$win.parent
]
2410 pack append $parent\
2411 $win {top
frame nw expand fill
}
2418 proc ShowEditors
{} {
2420 foreach win
$HeadWindows {
2426 proc WithdrawEditors
{} {
2427 global EditorWindows
2428 foreach win
$EditorWindows {
2429 #set parent [WindowLink $win.parent]
2430 #pack unpack $parent
2436 proc InitEditors
{} {
2437 global EditorWindows
2438 foreach win
$EditorWindows {
2444 proc InitEditor
{win
} {
2445 set e
[WindowLink
$win.view
]
2446 UISetToolState
$win 7
2451 global $e.TrackState
2452 set $e.TrackState
{}
2456 proc SetEditorAutoGoto
{win val
} {
2457 global AutoGoto.
$win
2458 set AutoGoto.
$win $val
2459 set e
[WindowLink
$win.view
]
2464 proc SetEditorControls
{win val
} {
2465 global Controls.
$win
2466 set Controls.
$win $val
2468 pack append $win $win.leftframe
{left
frame center filly
}
2470 pack unpack
$win.leftframe
2475 proc SetEditorOverlay
{win val
} {
2477 set Overlay.
$win $val
2478 set e
[WindowLink
$win.view
]
2483 proc SetEditorDynamicFilter
{win val
} {
2484 global DynamicFilter.
$win
2485 set DynamicFilter.
$win $val
2486 set e
[WindowLink
$win.view
]
2487 $e DynamicFilter
$val
2488 if {$val == 1} then
{
2489 ShowFrobOf
[WindowLink
$win.head
]
2494 proc SetEditorSkip
{win val
} {
2495 set e
[WindowLink
$win.view
]
2500 proc EditorToolDown
{mod w x y
} {
2501 global [set var
$w.TrackState
]
2505 case
[$w ToolState
] in
\
2507 UIMakeSoundOn
$w edit Rumble
"-repeat 4"
2515 set $var [list constrain_start
$x $y]
2516 $w ToolConstrain
$x $y
2521 EditorTool ToolDown
$w $x $y
2526 proc EditorToolDrag
{w x y
} {
2527 EditorTool ToolDrag
$w $x $y
2532 proc EditorToolUp
{w x y
} {
2533 global [set var
$w.TrackState
]
2536 case
[$w ToolState
] in
\
2538 UIStopSoundOn
$w edit
1
2544 EditorTool ToolUp
$w $x $y
2546 $w ToolConstrain
-1 -1
2553 proc EditorTool
{action w x y
} {
2554 global [set var
$w.TrackState
]
2555 set state
[eval ident
"\$\{$var\}"]
2556 case
[lindex $state 0] in
\
2558 set x0
[lindex $state 1]
2559 set y0
[lindex $state 2]
2560 set dx
[expr "$x - $x0"]
2561 set dy
[expr "$y - $y0"]
2562 if [expr "($dx > 16) || ($dx < -16)"] then
{
2563 $w ToolConstrain
-1 $y0
2566 if [expr "($dy > 16) || ($dy < -16)"] then
{
2567 $w ToolConstrain
$x0 -1
2576 proc StartChalk
{w
} {
2577 sim CollapseMotion
0
2581 proc StopChalk
{w
} {
2582 sim CollapseMotion
1
2586 proc EditorPanDown
{mod w x y
} {
2587 global [set var
$w.TrackState
]
2591 set $var [list constrain_start
$x $y]
2592 $w ToolConstrain
$x $y
2597 EditorTool PanStart
$w $x $y
2601 proc EditorPanDrag
{w x y
} {
2602 EditorTool PanTo
$w $x $y
2606 proc EditorPanUp
{w x y
} {
2609 EditorTool PanTo
$w $x $y
2610 $w ToolConstrain
-1 -1
2616 proc EditorKeyDown
{w k
} {
2621 proc EditorKeyUp
{w k
} {
2626 proc BindEditorButtons
{win
} {
2627 set w
[WindowLink
$win.top
]
2629 bind $win <1> "CancelPie $win ; EditorToolDown none %W %x %y"
2630 bind $win <B1-Motion
> {EditorToolDrag
%W
%x
%y
}
2631 bind $win <ButtonRelease-1
> {EditorToolUp
%W
%x
%y
}
2633 bind $win <Control-1
> "CancelPie $win ; EditorToolDown constrain %W %x %y"
2634 bind $win <Control-B1-Motion
> {EditorToolDrag
%W
%x
%y
}
2635 bind $win <Control-ButtonRelease-1
> {EditorToolUp
%W
%x
%y
}
2637 bind $win <2> "CancelPie $win ; EditorPanDown none %W %x %y"
2638 bind $win <B2-Motion
> {EditorPanDrag
%W
%x
%y
}
2639 bind $win <ButtonRelease-2
> {EditorPanUp
%W
%x
%y
}
2641 bind $win <Control-2
> "CancelPie $win ; EditorPanDown constrain %W %x %y"
2642 bind $win <Control-B2-Motion
> {EditorPanDrag
%W
%x
%y
}
2643 bind $win <Control-ButtonRelease-2
> {EditorPanUp
%W
%x
%y
}
2645 InitPie
$win $w.toolpie
2649 proc UISetFunds
{funds
} {
2651 foreach win
$HeadWindows {
2652 [WindowLink
$win.funds
] configure
-text "$funds"
2657 proc UISetDate
{date month year
} {
2661 set CurrentDate
"$date"
2663 foreach win
$HeadWindows {
2664 [WindowLink
$win.date
] Set
$month $year
2669 proc SetPriority
{index
} {
2695 proc UISetDemand
{r c i
} {
2696 global HeadWindows DemandRes DemandCom DemandInd
2702 if {$r <= 0} then
{set ry0
32} else {set ry0
24}
2703 set ry1
[expr "$ry0 - $r"]
2704 if {$c <= 0} then
{set cy0
32} else {set cy0
24}
2705 set cy1
[expr "$cy0 - $c"]
2706 if {$i <= 0} then
{set iy0
32} else {set iy0
24}
2707 set iy1
[expr "$iy0 - $i"]
2709 foreach win
$HeadWindows {
2710 set can
[WindowLink
$win.demand
]
2711 # $can coords r 8 $ry0 14 $ry1
2712 # $can coords c 17 $cy0 23 $cy1
2713 # $can coords i 26 $iy0 32 $iy1
2714 $can coords r
49 $ry0 55 $ry1
2715 $can coords c
58 $cy0 64 $cy1
2716 $can coords i
67 $iy0 73 $iy1
2721 proc UISetOptions
{autobudget autogoto autobulldoze disasters sound animation messages notices
} {
2722 global AutoBudget AutoGoto AutoBulldoze Disasters Sound
2723 set AutoBudget
$autobudget
2724 set AutoGoto
$autogoto
2725 set AutoBulldoze
$autobulldoze
2726 set Disasters
$disasters
2728 set DoAnimation
$animation
2729 set DoMessages
$messages
2730 set DoNotices
$notices
2734 proc UIDidToolRes
{win x y
} {
2735 UIMakeSoundOn
$win edit O
"-speed 140"
2739 proc UIDidToolCom
{win x y
} {
2740 UIMakeSoundOn
$win edit A
"-speed 140"
2744 proc UIDidToolInd
{win x y
} {
2745 UIMakeSoundOn
$win edit E
"-speed 140"
2749 proc UIDidToolFire
{win x y
} {
2750 UIMakeSoundOn
$win edit O
"-speed 130"
2754 proc UIDidToolQry
{win x y
} {
2755 UIMakeSoundOn
$win edit E
"-speed 200"
2759 proc UIDidToolPol
{win x y
} {
2760 UIMakeSoundOn
$win edit E
"-speed 130"
2764 proc UIDidToolWire
{win x y
} {
2765 UIMakeSoundOn
$win edit O
"-speed 120"
2769 proc UIDidToolDozr
{win x y
} {
2770 UIMakeSoundOn
$win edit Rumble
2774 proc UIDidToolRail
{win x y
} {
2775 UIMakeSoundOn
$win edit O
"-speed 100"
2779 proc UIDidToolRoad
{win x y
} {
2780 UIMakeSoundOn
$win edit E
"-speed 100"
2784 proc UIDidToolChlk
{win x y
} {
2788 proc UIDidToolEraser
{win x y
} {
2792 proc UIDidToolStad
{win x y
} {
2793 UIMakeSoundOn
$win edit O
"-speed 90"
2797 proc UIDidToolPark
{win x y
} {
2798 UIMakeSoundOn
$win edit A
"-speed 130"
2802 proc UIDidToolSeap
{win x y
} {
2803 UIMakeSoundOn
$win edit E
"-speed 90"
2807 proc UIDidToolCoal
{win x y
} {
2808 UIMakeSoundOn
$win edit O
"-speed 75"
2812 proc UIDidToolNuc
{win x y
} {
2813 UIMakeSoundOn
$win edit E
"-speed 75"
2817 proc UIDidToolAirp
{win x y
} {
2818 UIMakeSoundOn
$win edit A
"-speed 50"
2822 proc UISetToolState
{w state
} {
2823 global EditorPallets EditorPalletImages ToolInfo
2824 set win
[WindowLink
$w.top
]
2825 #echo "UISETTOOLSTATE w $w win $win $state"
2826 ExclusivePallet
$state $win $EditorPallets ic
$EditorPalletImages \
2827 raised sunken
{NoFunction
}
2829 set c1
[WindowLink
$w.cost1
]
2831 set info [lindex $ToolInfo $state]
2832 set cost1
[lindex $info 1]
2833 set cost2
[lindex $info 2]
2834 $c1 configure
-text "$cost1"
2835 [WindowLink
$w.cost2
] configure
-text "$cost2"
2840 proc UIShowZoneStatus
{zone density value crime pollution growth x y
} {
2841 global QueryX QueryY
2842 set QueryX
[expr "8 + 16 * $x"]
2843 set QueryY
[expr "8 + 16 * $y"]
2844 UIShowPicture
9 [list $zone $density $value $crime $pollution $growth]
2848 ########################################################################
2849 # Map Window Handlers
2852 proc ShowMapOf
{head
} {
2855 foreach win
$MapWindows {
2856 if {"[WindowLink $win.head]" == "$head"} {
2857 global MapPanelWidth MapPanelHeight
2858 #place configure $win -x 0 -y 0 -width $MapPanelWidth -height $MapPanelHeight
2859 #[WindowLink $win.parent] configure -width $MapPanelWidth -height $MapPanelHeight
2860 set parent
[WindowLink
$win.parent
]
2861 pack append [WindowLink
$head.w2
] \
2862 $win {top
frame nw expand fill
}
2875 proc NewMapOf
{head
} {
2876 set win
[MakeWindow.map
$head [winfo screen
$head]]
2877 global MapPanelWidth MapPanelHeight
2878 #place configure $win -x 0 -y 0 -width $MapPanelWidth -height $MapPanelHeight
2879 #[WindowLink $win.parent] configure -width $MapPanelWidth -height $MapPanelHeight
2880 set parent
[WindowLink
$win.parent
]
2881 #pack append [WindowLink $head.col1]\
2882 # $parent {top frame nw fillx}
2883 pack append [WindowLink
$head.w2
] \
2884 $win {top
frame nw expand fill
}
2891 foreach win
$HeadWindows {
2897 proc WithdrawMaps
{} {
2899 foreach win
$MapWindows {
2908 foreach win
$MapWindows {
2914 proc InitMap
{win
} {
2919 proc EnableMaps
{} {
2921 foreach win
$MapWindows {
2927 proc EnableMap
{win
} {
2928 [WindowLink
$win.view
] ShowEditors
1
2929 [WindowLink
$win.zones
] config
-state normal
2930 [WindowLink
$win.overlays
] config
-state normal
2934 proc DisableMaps
{} {
2936 foreach win
$MapWindows {
2942 proc DisableMap
{win
} {
2943 [WindowLink
$win.view
] ShowEditors
0
2944 [WindowLink
$win.zones
] config
-state disabled
2945 [WindowLink
$win.overlays
] config
-state disabled
2949 proc SetMapState
{win state
} {
2950 set m
[WindowLink
$win.view
]
2952 if {$state == 14} then
{
2953 ShowFrobOf
[WindowLink
$win.head
]
2958 proc MapPanDown
{w x y
} {
2963 proc MapPanDrag
{w x y
} {
2968 proc MapPanUp
{w x y
} {
2975 proc UISetMapState
{w state
} {
2977 #set win [winfo toplevel $w]
2978 set win
[WindowLink
$w.win
]
2979 set m
[WindowLink
$win.view
]
2980 set title
[lindex $MapTitles $state]
2982 # TODO: set map text field header to title
2983 #wm title $win "$title"
2984 #wm iconname $win "$title"
2986 global [set var MapState.
$win]
2990 {6 8 9 10 11 12 13} {
2991 [WindowLink
$win.legend
] config
-bitmap "@images/legendmm.xpm"
2994 [WindowLink
$win.legend
] config
-bitmap "@images/legendpm.xpm"
2997 [WindowLink
$win.legend
] config
-bitmap "@images/legendn.xpm"
3003 ########################################################################
3004 # Graph Window Handlers
3007 proc ToggleGraphOf
{head
} {
3009 if {"$State" != "play"} {
3014 set win
[WindowLink
$head.graph
]
3016 set mapped
[winfo ismapped
$win]
3020 WithdrawGraphOf
$head
3028 proc WithdrawGraphOf
{head
} {
3029 set win
[WindowLink
$head.graph
]
3036 proc ShowGraphOf
{head
} {
3037 set win
[WindowLink
$head.graph
]
3039 set win
[MakeWindow.graph
$head [winfo screen
$head]]
3043 set parent
[WindowLink
$win.parent
]
3044 pack append $parent\
3045 $win {top
frame nw fillx
}
3051 proc WithdrawGraphs
{} {
3053 foreach win
$GraphWindows {
3060 proc InitGraphs
{} {
3062 foreach win
$GraphWindows {
3068 proc InitGraph
{win
} {
3069 UISetGraphState
$win 1 1 1 1 1 1 0
3073 proc UISetGraphState
{win t0 t1 t2 t3 t4 t5 range
} {
3074 set g
[WindowLink
$win.graphview
]
3075 GraphPalletMask
$win [expr "$t0 + ($t1<<1) + ($t2<<2) + ($t3<<3) + ($t4<<4) + ($t5<<5)"]
3076 GraphYearPallet
$win $range
3080 ########################################################################
3081 # Splash Window Handlers
3084 proc ShowSplashOf
{head
} {
3085 set win
[WindowLink
$head.splash
]
3087 set win
[MakeWindow.splash
$head [winfo screen
$head]]
3089 set splashscreen
[WindowLink
$win.splashscreen
]
3091 catch {$splashscreen config
-bitmap "@images/splashscreen.xpm"; set success 1}
3094 global SplashScreenDelay
3095 after $SplashScreenDelay "UIPickScenarioMode"
3102 proc WithdrawSplashOf
{head
} {
3103 set win WindowLink
$head.splash
]
3108 proc ShowSplashes
{} {
3110 foreach win
$HeadWindows {
3116 proc WithdrawSplashes
{} {
3117 global SplashWindows
3118 foreach win
$SplashWindows {
3120 set splashscreen
[WindowLink
$win.splashscreen
]
3121 $splashscreen config
-bitmap ""
3126 proc InitSplashes
{} {
3130 proc InitSplash
{win
} {
3134 proc DeleteSplashWindow
{win
} {
3139 ########################################################################
3140 # Scenario Window Handlers
3143 proc ShowScenarioOf
{head
} {
3144 set win
[WindowLink
$head.scenario
]
3146 set win
[MakeWindow.scenario
$head [winfo screen
$head]]
3148 # TODO: load background bitmap
3153 proc WithdrawScenarioOf
{head
} {
3154 set win WindowLink
$head.scenario
]
3159 proc ShowScenarios
{} {
3161 foreach win
$HeadWindows {
3167 proc WithdrawScenarios
{} {
3168 global ScenarioWindows
3169 foreach win
$ScenarioWindows {
3171 # TODO: flush background bitmap
3176 proc InitScenarios
{} {
3177 global MapHistory MapHistoryNum
3178 if {$MapHistoryNum < 1} {
3183 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3188 global ScenarioWindows
3189 foreach win
$ScenarioWindows {
3191 #[WindowLink $win.previous] config -state $prev
3192 #[WindowLink $win.next] config -state $next
3197 proc InitScenario
{win
} {
3198 global MapHistory MapHistoryNum
3199 if {$MapHistoryNum < 1} {
3205 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3212 #[WindowLink $win.previous] config -state $prev
3213 #[WindowLink $win.next] config -state $next
3215 LinkWindow
$win.scenarioTarget
-1
3216 LinkWindow
$win.scenarioTargetDown
-1
3218 global ScenarioButtons
3220 set len
[llength $ScenarioButtons]
3222 set data
[lindex $ScenarioButtons $i]
3223 set type
[lindex $data 0]
3224 set id
[lindex $data 1]
3228 LinkWindow
$win.
$id.over
0
3229 LinkWindow
$win.
$id.enabled
1
3230 LinkWindow
$win.
$id.checked
0
3231 #echo "SETTING WIN $win ID $id"
3233 set i
[expr "$i + 1"]
3236 UpdateLevelSelection
$win
3237 UpdateLeftRightEnabled
$win
3241 proc UpdateLevelSelection
{win
} {
3242 #echo UpdateLevelSelection
3244 if {$GameLevel == 0} then
{
3245 LinkWindow
$win.easy.checked
1
3246 LinkWindow
$win.medium.checked
0
3247 LinkWindow
$win.hard.checked
0
3249 if {$GameLevel == 1} then
{
3250 LinkWindow
$win.easy.checked
0
3251 LinkWindow
$win.medium.checked
1
3252 LinkWindow
$win.hard.checked
0
3254 if {$GameLevel == 2} then
{
3255 LinkWindow
$win.easy.checked
0
3256 LinkWindow
$win.medium.checked
0
3257 LinkWindow
$win.hard.checked
1
3260 UpdateScenarioButtonID
$win easy
3261 UpdateScenarioButtonID
$win medium
3262 UpdateScenarioButtonID
$win hard
3267 proc UpdateLeftRightEnabled
{win
} {
3268 #echo UpdateLeftRightEnabled
3270 global MapHistory MapHistoryNum
3271 if {$MapHistoryNum < 1} {
3272 LinkWindow
$win.left.enabled
0
3274 LinkWindow
$win.left.enabled
1
3277 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3278 LinkWindow
$win.right.enabled
0
3280 LinkWindow
$win.right.enabled
1
3283 UpdateScenarioButtonID
$win left
3284 UpdateScenarioButtonID
$win right
3288 proc UpdateScenarioButtonID
{win id
} {
3290 global ScenarioButtons
3292 set len
[llength $ScenarioButtons]
3294 set data
[lindex $ScenarioButtons $i]
3296 if {$id == [lindex $data 1]} then
{
3297 UpdateScenarioButton
$win $data
3301 set i
[expr "$i + 1"]
3306 proc UpdateScenarioButton
{win data
} {
3307 set type
[lindex $data 0]
3308 set id
[lindex $data 1]
3309 set over
[WindowLink
$win.
$id.over
]
3310 set enabled
[WindowLink
$win.
$id.enabled
]
3311 set checked
[WindowLink
$win.
$id.checked
]
3312 #echo "WIN $win TYPE $type ID $id OVER $over ENABLED $enabled CHECKED $checked"
3316 set bm
[lindex $data 13]
3318 set bm
[lindex $data 12]
3322 set bm
[lindex $data 10]
3324 set bm
[lindex $data 9]
3328 set bm
[lindex $data 11]
3331 [WindowLink
$win.
canvas] itemconfig
$id -bitmap $bm
3335 proc DoEnterCityName
{win
} {
3339 proc InitVotesForUseThisMap
{} {
3340 # TODO: Disabled for new scenario window.
3343 global VotesForUseThisMap ScenarioWindows
3344 set VotesForUseThisMap
{}
3345 foreach win
$ScenarioWindows {
3346 [WindowLink
$win.vote
] config
-relief raised
3348 UpdateVotesForUseThisMap
3352 proc UpdateVotesForUseThisMap
{} {
3353 global ScenarioWindows
3354 UpdateVotesFor UseThisMap
$ScenarioWindows
3358 proc UIUseThisMap
{} {
3359 global CityName GameLevel Scenario
3361 # special handling for scenarios?
3362 if {$GameLevel != -1} {
3363 sim GameLevel
$GameLevel
3365 sim CityName
$CityName
3368 if {$Scenario != -1} {
3369 UIShowPicture
$Scenario
3374 proc HandleScenarioDown
{win x y
} {
3375 #echo HandleScenarioDown $win $x $y
3376 HandleScenarioMove
$win $x $y
3377 set w
[WindowLink
$win.w
]
3378 set target
[WindowLink
$w.scenarioTarget
]
3379 LinkWindow
$w.scenarioTargetDown
$target
3383 proc HandleScenarioUp
{win x y
} {
3384 #echo HandleScenarioUp $win $x $y
3385 HandleScenarioMove
$win $x $y
3386 global ScenarioButtons
3387 set w
[WindowLink
$win.w
]
3388 set target
[WindowLink
$w.scenarioTarget
]
3389 set targetDown
[WindowLink
$w.scenarioTargetDown
]
3390 if {($target != -1) &&
3391 ($target == $targetDown)} {
3392 set data
[lindex $ScenarioButtons $target]
3393 set type
[lindex $data 0]
3394 set id
[lindex $data 1]
3395 set callback
[lindex $data 2]
3396 set param
[lindex $data 3]
3397 set var
[lindex $data 4]
3398 set xx
[lindex $data 5]
3399 set yy
[lindex $data 6]
3400 set ww
[lindex $data 7]
3401 set hh
[lindex $data 8]
3402 set normal
[lindex $data 9]
3403 set over
[lindex $data 10]
3404 set disabled
[lindex $data 11]
3405 if {$type == "button"} {
3406 #echo callback $callback w $w param $param
3407 eval "$callback $w {$param}"
3409 if {$type == "checkbox"} {
3410 #echo checkbox callback $callback w $w param $param
3411 eval "$callback $w {$param}"
3418 proc HandleScenarioMove
{win x y
} {
3419 #echo HandleScenarioMove $win $x $y
3420 global ScenarioButtons
3421 set w
[WindowLink
$win.w
]
3422 set target
[WindowLink
$w.scenarioTarget
]
3425 set len
[llength $ScenarioButtons]
3427 set data
[lindex $ScenarioButtons $i]
3428 set type
[lindex $data 0]
3429 set id
[lindex $data 1]
3430 set callback
[lindex $data 2]
3431 set param
[lindex $data 3]
3432 set var
[lindex $data 4]
3433 set xx
[lindex $data 5]
3434 set yy
[lindex $data 6]
3435 set ww
[lindex $data 7]
3436 set hh
[lindex $data 8]
3438 set enabled
[WindowLink
$w.
$id.enabled
]
3439 set checked
[WindowLink
$w.
$id.checked
]
3441 #echo "ID $id ENABLED $enabled CHECKED $checked w $w id $id"
3443 if {($enabled != 0) &&
3445 ($x < ($xx + $ww)) &
3447 ($y < ($yy + $hh))} {
3452 set i
[expr "$i + 1"]
3455 if {$found != $target} {
3458 if {$target != -1} {
3460 #echo OUT $w $found $xx $yy $normal
3461 LinkWindow
$w.scenarioTarget
-1
3463 set targetdata
[lindex $ScenarioButtons $target]
3464 set targetid
[lindex $targetdata 1]
3465 LinkWindow
$w.
$targetid.over
0
3466 UpdateScenarioButton
$w $targetdata
3471 #echo IN $w $found $xx $yy $over
3472 LinkWindow
$w.scenarioTarget
$found
3473 LinkWindow
$w.
$id.over
1
3475 if {$target != -1} {
3476 set targetdata
[lindex $ScenarioButtons $target]
3477 set targetid
[lindex $targetdata 1]
3478 LinkWindow
$w.
$targetid.over
0
3479 UpdateScenarioButton
$w $targetdata
3482 UpdateScenarioButton
$w $data
3488 proc DoLoad
{win param
} {
3489 #echo DOLOAD $win $param
3494 proc DoGenerate
{win param
} {
3495 #echo DOGENERATE $win $param
3500 proc DoQuit
{win param
} {
3501 #echo DOQUIT $win $param
3506 proc DoAbout
{win param
} {
3507 #echo DOABOUT $win $param
3508 MakeHistory
"DoLoadCity cities/about.cty"
3512 proc DoMap
{win param
} {
3513 #echo DOMAP $win $param
3517 proc DoLevel
{win param
} {
3518 #echo DOLEVEL $win $param
3519 DoSetGameLevel
$param
3523 proc DoLeft
{win param
} {
3524 #echo DOLEFT $win $param
3529 proc DoRight
{win param
} {
3530 #echo DORIGHT $win $param
3535 proc DoPlay
{win param
} {
3536 #echo DOPLAY $win $param
3541 proc DoPickScenario
{win param
} {
3542 #echo DOPICKSCENARIO $win $param
3543 UILoadScenario
$param
3547 ########################################################################
3548 # Undo/Redo Facility
3551 proc InitHistory
{} {
3553 global MapHistoryNum
3555 set MapHistoryNum
-1
3559 proc MakeHistory
{cmd
} {
3561 set len
[llength $MapHistory]
3563 ($cmd != [lindex $MapHistory [expr $len-1]])} {
3564 lappend MapHistory
$cmd
3572 proc GotoHistory
{i
} {
3574 global MapHistoryNum
3575 InitVotesForUseThisMap
3576 if {$i != $MapHistoryNum} {
3577 set MapHistoryNum
$i
3578 set cmd
[lindex $MapHistory $i]
3581 if {$MapHistoryNum == 0} {
3586 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3592 global ScenarioWindows
3593 foreach win
$ScenarioWindows {
3594 UpdateLeftRightEnabled
$win
3600 proc NextHistory
{} {
3602 global MapHistoryNum
3603 set len
[llength $MapHistory]
3604 set i
[expr "$MapHistoryNum + 1"]
3611 proc PrevHistory
{} {
3613 global MapHistoryNum
3614 set i
[expr "$MapHistoryNum - 1"]
3621 ########################################################################
3622 # Ask Window Handlers
3624 proc ShowAskOf
{head
} {
3625 set win
[WindowLink
$head.ask
]
3627 set win
[MakeWindow.ask
$head [winfo screen
$head]]
3637 foreach win
$HeadWindows {
3643 proc WithdrawAsks
{} {
3645 foreach win
$AskWindows {
3651 proc WithdrawAskOf
{win
} {
3652 set ask
[WindowLink
$win.ask
]
3659 proc AskQuestion
{color title
text left middle right
} {
3661 foreach win
$HeadWindows {
3662 AskQuestionOn
$win $color $title $text $left $middle $right
3667 proc AskQuestionOn
{head color title
text left middle right
} {
3670 set win
[WindowLink
$head.ask
]
3671 set t
[WindowLink
$win.title
]
3672 $t configure
-text $title
3673 $t configure
-background $color
3675 set t
[WindowLink
$win.
text]
3676 $t configure
-state normal
3678 $t insert end
"${text}\n"
3679 $t configure
-state disabled
3681 set bf
[WindowLink
$win.
frame]
3682 set l
[WindowLink
$win.left
]
3683 set m
[WindowLink
$win.middle
]
3684 set r
[WindowLink
$win.vote
]
3685 set rf
[WindowLink
$win.voteframe
]
3689 -text [lindex $left 0] \
3690 -command [format [lindex $left 2] $head]
3691 SetHelp
$l [lindex $left 1]
3692 pack append $bf $l {left
frame center
}
3697 if {$middle != ""} {
3699 -text [lindex $middle 0] \
3700 -command [format [lindex $middle 2] $head]
3701 SetHelp
$m [lindex $middle 1]
3702 pack append $bf $m {left
frame center expand
}
3708 set notify
[format [lindex $right 2] $head]
3709 set preview
[format [lindex $right 3] $head]
3710 set cmd
[list DoVote
$win Ask
$notify $preview]
3712 -text [lindex $right 0] \
3714 SetHelp
$r [lindex $right 1]
3715 pack append $bf $rf {right
frame center
}
3724 proc BindVotingButton
{win but name
} {
3725 set w
[WindowLink
$win.top
]
3727 bind $but <Any-Enter
> "VoteButtonEnter $win $but"
3728 bind $but <Any-Leave
> "VoteButtonLeave $win $but"
3729 bind $but <1> "VoteButtonDown $win $but $name"
3730 bind $but <ButtonRelease-1
> "VoteButtonUp $win $but $name"
3731 bind $but <2> "VoteButtonDown $win $but $name"
3732 bind $but <ButtonRelease-2
> "VoteButtonUp $win $but $name"
3733 bind $but <3> "VoteButtonDown $win $but $name"
3734 bind $but <ButtonRelease-3
> "VoteButtonUp $win $but $name"
3738 proc VoteButtonEnter
{win but
} {
3740 set screen
[winfo screen
$but]
3741 if {[lindex [$but config
-state] 4] != "disabled"} {
3742 $but config
-state active
3743 set tk_priv
(window
@$screen) $but
3745 set tk_priv
(window
@$screen) ""
3750 proc VoteButtonLeave
{win but
} {
3752 if {[lindex [$but config
-state] 4] != "disabled"} {
3753 $but config
-state normal
3755 set screen
[winfo screen
$but]
3756 set tk_priv
(window
@$screen) ""
3760 proc VoteButtonDown
{win but name
} {
3762 set screen
[winfo screen
$but]
3763 set rel
[lindex [$but config
-relief] 4]
3764 set tk_priv
(relief
@$screen) $rel
3765 if {[lindex [$but config
-state] 4] != "disabled"} {
3766 set head
[WindowLink
$win.head
]
3767 if {[IsVotingFor
$head $name]} {
3768 $but config
-relief raised
3770 $but config
-relief sunken
3776 proc VoteButtonUp
{win but name
} {
3778 set screen
[winfo screen
$but]
3779 $but config
-relief $tk_priv(relief
@$screen)
3780 if {($but == $tk_priv(window
@$screen))
3781 && ([lindex [$but config
-state] 4] != "disabled")} {
3782 uplevel #0 [list $but invoke]
3783 set head
[WindowLink
$win.head
]
3784 if {[IsVotingFor
$head $name]} {
3785 $but config
-relief sunken
3787 $but config
-relief raised
3793 proc PressVoteButton
{win but name
} {
3795 uplevel #0 [list $but invoke]
3796 set head
[WindowLink
$win.head
]
3797 if {[IsVotingFor
$head $name]} {
3798 $but config
-relief sunken
3800 $but config
-relief raised
3805 proc IsVotingFor
{win name
} {
3806 global VotesFor
$name
3807 set votes
[eval ident
"\$\{VotesFor$name\}"]
3808 if {[lsearch $votes $win] == -1} {
3816 proc DoVote
{win name notify preview
} {
3817 global VotesFor
$name
3818 set votes
[eval ident
"\$\{VotesFor$name\}"]
3820 set win
[WindowLink
$win.head
]
3821 set i
[lsearch $votes $win]
3823 lappend VotesFor
$name $win
3825 set VotesFor
$name [lreplace $votes $i $i]
3828 set votes
[eval ident
"\$\{VotesFor$name\}"]
3829 if {[llength $votes] >= [NeededVotes
]} {
3837 proc UpdateVotesFor
{name wins
} {
3838 global VotesFor
$name
3839 set votes
[eval llength "\$\{VotesFor$name\}"]
3840 set needed
[NeededVotes
]
3843 set head
[WindowLink
$win.head
]
3844 if {[IsVotingFor
$head $name]} {
3845 set border
[expr "($needed - $votes) * 1"]
3846 set pad
[expr "6 - $border"]
3847 [WindowLink
$win.vote
] config
-padx $pad -pady $pad
3848 [WindowLink
$win.voteframe
] config
-borderwidth $border
3850 set border
[expr "($needed - $votes - 1) * 1"]
3851 set pad
[expr "6 - $border"]
3852 [WindowLink
$win.vote
] config
-padx $pad -pady $pad
3853 [WindowLink
$win.voteframe
] config
-borderwidth $border
3859 proc InitVotesForAsk
{} {
3860 global VotesForAsk AskWindows
3862 foreach win
$AskWindows {
3863 [WindowLink
$win.vote
] config
-relief raised
3870 proc UpdateVotesForAsk
{} {
3872 UpdateVotesFor Ask
$AskWindows
3876 ########################################################################
3877 # Player Window Handlers
3879 proc ShowPlayerOf
{head
} {
3880 set win
[WindowLink
$head.player
]
3882 set win
[MakeWindow.player
$head [winfo screen
$head]]
3890 proc ShowPlayers
{} {
3892 foreach win
$HeadWindows {
3898 proc WithdrawPlayers
{} {
3899 global PlayerWindows
3900 foreach win
$PlayerWindows {
3906 proc UpdatePlayers
{} {
3907 # TODO: Disabled for new scenario window.
3910 global HeadWindows PlayerWindows
3913 foreach win
$HeadWindows {
3914 set server
[winfo screen
$win]
3915 # if {[string first : $server] == 0} {
3916 # set server "[exec hostname]:0"
3918 lappend players
$server
3921 sim Players
[llength $players]
3923 foreach win
$PlayerWindows {
3924 set list [WindowLink
$win.players
]
3926 eval "$list insert 0 $players"
3929 UpdateVotesForUseThisMap
3931 UpdateVotesForBudget
3932 UpdateTaxRateSliders
3936 proc UIShowPlayer
{win
} {
3941 proc DoNewPlayer
{win
} {
3942 set field
[WindowLink
$win.display
]
3943 set dpy
[$field get
]
3948 if {[AddPlayer
$dpy] != ""} {
3954 ########################################################################
3955 # Notice Window Handlers
3958 proc ShowNoticeOf
{head
} {
3959 set win
[WindowLink
$head.notice
]
3961 set win
[MakeWindow.notice
$head [winfo screen
$head]]
3963 global NoticePanelWidth NoticePanelHeight
3964 #place configure $win -x 0 -y 0 -width $NoticePanelWidth -height $NoticePanelHeight
3965 pack append [WindowLink
$head.w3
] \
3966 $win {bottom
frame sw expand fill
}
3971 proc ShowNotices
{} {
3973 foreach win
$HeadWindows {
3979 proc WithdrawNotices
{} {
3980 global NoticeWindows
3981 foreach win
$NoticeWindows {
3988 proc ReShowPictureOn
{{head
""}} {
3989 global ShowingPicture ShowingParms
3990 UIShowPictureOn
$head $ShowingPicture $ShowingParms
3994 proc UIShowPicture
{id
{parms
""}} {
3995 UIShowPictureOn
"" $id $parms
3999 proc UIShowPictureOn
{where id
{parms
""}} {
4000 global DoNotices Messages ShowingPicture ShowingParms
4001 if {$DoNotices == 0} {
4005 set ShowingPicture
$id
4006 set ShowingParms
$parms
4007 set msg
$Messages($id)
4008 set color
[lindex $msg 0]
4009 set title
[lindex $msg 1]
4010 set body
[lindex $msg 2]
4012 set cmd
"format {$body} $parms"
4013 set body
[uplevel #0 $cmd]
4015 set props
[lindex $msg 3]
4016 if {"$where" == ""} {
4018 set where
$HeadWindows
4020 foreach head
$where {
4021 NoticeMessageOn
$head "$title" $color "$body" Medium
$props
4026 proc NoticeMessageOn
{head title color
text font props
} {
4028 set win
[WindowLink
$head.notice
]
4030 set t
[WindowLink
$win.title
]
4031 $t configure
-text $title -background $color
4033 set t
[WindowLink
$win.
text]
4034 $t configure
-state normal
-font [Font
$head $font]
4036 $t insert end
"${text}\n"
4037 $t configure
-state disabled
4040 catch {set left
[keylget props left
]}
4041 set l
[WindowLink
$win.left
]
4043 $l config
-bitmap $left
4044 place $l -in $t -anchor sw
-relx .05 -rely .95
4050 catch {set middle
[keylget props middle
]}
4051 set m
[WindowLink
$win.middle
]
4052 if {$middle != ""} {
4053 $m config
-bitmap $middle
4054 place $m -in $t -anchor s
-relx .5 -rely .95
4060 catch {set right
[keylget props right
]}
4061 set r
[WindowLink
$win.right
]
4063 $r config
-bitmap $right
4064 place $r -in $t -anchor se
-relx .95 -rely .95
4070 catch {set view
[keylget props view
]}
4071 set vf
[WindowLink
$win.viewframe
]
4073 set v
[WindowLink
$win.view
]
4074 set bg
[WindowLink
$win.background
]
4078 pack append $bg $vf {left
frame center fill
}
4079 pack append $bg $t {right
frame center fill expand
}
4086 proc UIPopUpMessage
{msg
} {
4091 proc ComeToMe
{view
} {
4092 set win
[winfo toplevel $view]
4095 set x
[expr "[lindex $xy 0] >>4"]
4096 set y
[expr "[lindex $xy 1] >>4"]
4102 proc ComeTo
{win x y
} {
4103 global EditorWindows
4104 set head
[WindowLink
$win.head
]
4107 foreach ed
$EditorWindows {
4108 if {"[WindowLink $ed.head]" == "$head"} {
4110 set view
[WindowLink
$ed.view
]
4111 if {[$view AutoGoto
]} {
4112 lappend myautoeds
$ed
4116 if {[llength $myautoeds]} {
4117 UIAutoGotoOn
$x $y $myautoeds
4119 if {[llength $myeds]} {
4120 UIAutoGotoOn
$x $y $myeds
4126 proc FollowView
{view id
} {
4130 if {[sim DoAnimation
]} {
4131 set head
[WindowLink
[winfo toplevel $view].head
]
4132 global EditorWindows
4133 foreach win
$EditorWindows {
4134 if {"[WindowLink $win.head]" == "$head"} {
4135 set s
[[WindowLink
$win.view
] Skip
]
4136 set skips
[min
$skips $s]
4140 if {$skips == 999999} {
4150 proc PanView
{view x y
} {
4156 ########################################################################
4157 # Help Window Handlers
4160 proc ShowHelpOf
{head
} {
4161 set win
[WindowLink
$head.help
]
4163 set win
[MakeWindow.help
$head [winfo screen
$head]]
4173 foreach win
$HeadWindows {
4179 proc WithdrawHelps
{} {
4181 foreach win
$HelpWindows {
4187 ########################################################################
4188 # Frob Window Handlers
4191 proc ShowFrobOf
{head
} {
4192 set win
[WindowLink
$head.frob
]
4194 set win
[MakeWindow.frob
$head [winfo screen
$head]]
4205 foreach win
$HeadWindows {
4211 proc WithdrawFrobs
{} {
4213 foreach win
$FrobWindows {
4219 proc UISetDynamic
{i min max
} {
4220 sim DynamicData
[expr "$i*2"] $min
4221 sim DynamicData
[expr "$i*2+1"] $max
4225 ########################################################################
4232 source $ResourceDir/help.tcl
4235 proc HandleHelp
{win x y rootx rooty
} {
4236 global HelpLoaded HelpWidgets Messages
4238 if {$HelpLoaded == 0} {
4244 set head
[WindowLink
[winfo toplevel $win].head
]
4247 catch {set id
$HelpWidgets($win)}
4251 set list [split $win .
]
4252 set len
[expr "[llength $list] - 2"]
4253 set list [lrange $list 0 $len]
4254 if {[llength $list] <= 1} {
4258 set win
[join $list .
]
4260 if [info exists Messages
($id)] {
4261 UIShowHelpOn
$head $id
4263 UIShowHelpOn
$head Window
4268 proc UIShowHelpOn
{win id
{parms
""}} {
4269 global Messages ShowingPicture ShowingParms ResourceDir
4270 set head
[WindowLink
$win.head
]
4271 set msg
$Messages($id)
4272 set color
[lindex $msg 0]
4273 set title
[lindex $msg 1]
4274 set body
[lindex $msg 2]
4276 set cmd
"format {$body} $parms"
4277 set body
[uplevel #0 $cmd]
4279 set props
[lindex $msg 3]
4282 set win
[WindowLink
$head.help
]
4284 set t
[WindowLink
$win.title
]
4285 $t configure
-text $title -background $color
4287 set t
[WindowLink
$win.
text]
4288 $t configure
-state normal
-font [Font
$head Large
]
4290 $t insert end
"${body}\n"
4291 FormatHTML
$ResourceDir/doc
/$id.html
$t
4292 $t configure
-state disabled
4296 proc FormatHTML
{filename text} {
4299 set f
[open $filename]
4306 while {[gets $f line
] >= 0} {
4307 if {"$line" == "</body>"} {
4310 if {([string index
$line 0] == "#") ||
([string length
$line] == 0)} {
4313 $text insert end
"$line\n"
4322 proc SetHelp
{win id
} {
4324 set HelpWidgets
($win) $id
4328 proc Help
{id title
{msg
{}} {props
{}}} {
4329 Message
$id #7f7fff $title $msg $props
4332 ########################################################################
4336 # Set up the bindings to pop up $pie when the right button is clicked in $win
4337 proc InitPie
{win pie
} {
4338 bind $win <Motion
> {}
4339 bind $win <3> "PieMenuDown $win $pie $pie Initial %X %Y"
4340 bind $win <B3-Motion
> {}
4341 bind $win <B3-ButtonRelease
> {}
4345 # Set up the bindings to continue tracking $pie
4346 # Get this: we keep the tracking machine state in the bindings!
4347 proc ActivatePie
{win root pie state
} {
4348 bind $win <Motion
> "PieMenuMotion $win $root $pie $state %X %Y"
4349 bind $win <3> "PieMenuDown $win $root $pie $state %X %Y"
4350 bind $win <B3-Motion
> "PieMenuMotion $win $root $pie $state %X %Y"
4351 bind $win <B3-ButtonRelease
> "PieMenuUp $win $root $pie $state %X %Y"
4355 # Cancel and reset a pie menu
4356 proc CancelPie
{win
} {
4357 set binding
[bind $win <3>]
4358 set root
[lindex $binding 2]
4359 set pie
[lindex $binding 3]
4360 set state
[lindex $binding 4]
4361 if {"$state" != "Initial"} {
4362 catch {$root ungrab
$win}
4365 UIMakeSoundOn
$win fancy Oop
4371 # Handle pie menu button down
4372 proc PieMenuDown
{win root pie state x y
} {
4375 ActivatePie
$win $root $pie FirstDown
4377 catch {$root grab $win}
4380 PreviewPieMenu
$win $pie $x $y
4384 TrackPieMenu
$pie $x $y
4385 ActivatePie
$win $root $pie SecondDown
4391 PreviewPieMenu
$win $pie $x $y
4392 ActivatePie
$win $root $pie SecondDown
4397 SecondDown
{ # error
4404 # Handle pie menu button motion
4405 proc PieMenuMotion
{win root pie state x y
} {
4408 TrackPieMenu
$pie $x $y
4416 TrackPieMenu
$pie $x $y
4430 # Handle pie menu button up
4431 proc PieMenuUp
{win root pie state x y
} {
4434 TrackPieMenu
$pie $x $y
4435 set active
[$pie index active
]
4436 if {$active == "none"} {
4438 catch {$root grab $win}
4439 ActivatePie
$win $root $pie ClickedUp
4441 set label [lindex [$pie entryconfig
$active -label] 4]
4442 set submenu
[lindex [$pie entryconfig
$active -piemenu] 4]
4443 UIMakeSoundOn
$win mode
$label
4444 if {$submenu == {}} {
4445 set reward
[$pie pending
]
4446 catch {$root ungrab
$win}
4450 sim Funds
[expr "[sim Funds] + 5"]
4451 UIMakeSoundOn
$win fancy Aaah
4453 eval [lindex [$pie entryconfig
$active -command] 4]
4458 $submenu activate none
4460 PreviewPieMenu
$win $submenu $x $y
4461 catch {$root grab $win}
4462 ActivatePie
$win $root $submenu SelectedUp
4467 TrackPieMenu
$pie $x $y
4468 set active
[$pie index active
]
4469 if {$active == "none"} {
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
4503 SelectedUp
{ # error
4510 # Track the selected item
4511 proc TrackPieMenu
{pie x y
} {
4512 $pie activate
@$x,$y
4516 proc PreviewPieMenu
{win pie x y
} {
4517 set preview
[lindex [$pie config
-preview] 4]
4518 if {"$preview" != ""} {
4519 set rx
[winfo rootx
$win]
4520 set ry
[winfo rooty
$win]
4521 set x
[expr "$x - $rx"]
4522 set y
[expr "$y - $ry"]
4523 eval [format $preview $x $y]
4528 ########################################################################
4532 proc ExclusivePallet
{state parent children prefix images inactive active cmd
} {
4533 #echo "ExclusivePallet state $state parent $parent children $children prefix $prefix images $images inactive $inactive active $active cmd $cmd"
4535 foreach child
$children {
4536 set name
[lindex $images $i]
4537 if {$i == $state} then
{
4538 $parent.
$child config
\
4539 -bitmap "@images/${prefix}${name}hi.xpm" \
4542 $parent.
$child config
\
4543 -bitmap "@images/${prefix}${name}.xpm" \
4548 eval [concat $cmd $state]
4552 proc NonExclusivePallet
{mask parent children prefix images
4553 inactive active cmd
} {
4555 foreach child
$children {
4556 set name
[lindex $images $i]
4557 if {$mask & (1<<$i)} then
{
4558 $parent.
$child config
\
4559 -bitmap "@images/${prefix}${name}hi.xpm" \
4562 $parent.
$child config
\
4563 -bitmap "@images/${prefix}${name}.xpm" \
4568 eval [concat $cmd $mask]
4572 proc EditorPallet
{win state
} {
4573 global EditorPalletSounds
4574 UIMakeSoundOn
$win mode
[lindex $EditorPalletSounds $state]
4575 EditorSetTool
$win $state
4579 proc EditorSetTool
{win state
} {
4580 global EditorPallets
4581 global EditorPalletImages
4582 ExclusivePallet
$state $win $EditorPallets ic
$EditorPalletImages \
4583 flat raised
"$win.centerframe.view ToolState"
4587 proc GraphPallet
{win state
} {
4588 set mask
[[WindowLink
$win.graphview
] Mask
]
4589 set mask
[expr "$mask ^ (1<<$state)"]
4590 GraphPalletMask
$win $mask
4594 proc GraphPalletMask
{win mask
} {
4596 global GraphPalletImages
4597 NonExclusivePallet
$mask $win $GraphPallets gr
$GraphPalletImages \
4598 flat flat
"SetGraphState $win"
4602 proc GraphYearPallet
{win state
} {
4603 global GraphYearPallets
4604 global GraphYearPalletImages
4605 ExclusivePallet
$state $win $GraphYearPallets gr
$GraphYearPalletImages \
4606 flat flat
"SetGraphYearState $win"
4610 proc SetGraphYearState
{win state
} {
4611 set graph
[WindowLink
$win.graphview
]
4620 proc SetGraphState
{win mask
} {
4622 set graph
[WindowLink
$win.graphview
]
4627 ########################################################################
4630 proc sim_butEnter
{w
} {
4632 set screen
[winfo screen
$w]
4633 set tk_priv
(window
@$screen) $w
4637 proc sim_butLeave
{w
} {
4639 set screen
[winfo screen
$w]
4640 set tk_priv
(window
@$screen) ""
4644 proc sim_butDown
{w
} {
4646 set screen
[winfo screen
$w]
4647 set pict
[lindex [$w config
-bitmap] 4]
4648 set tk_priv
(relief
@$screen) $pict
4649 $w config
-bitmap [lindex [split $pict .
] 0]hi.xpm
4654 proc sim_butUp
{w
} {
4656 set screen
[winfo screen
$w]
4657 $w config
-bitmap $tk_priv(relief
@$screen)
4659 if {$w == $tk_priv(window
@$screen)} {
4660 uplevel #0 [list $w invoke]
4665 proc BindSimButton
{w
} {
4666 bind $w <Any-Enter
> {sim_butEnter
%W
}
4667 bind $w <Any-Leave
> {sim_butLeave
%W
}
4668 bind $w <1> {sim_butDown
%W
}
4669 bind $w <ButtonRelease-1
> {sim_butUp
%W
}
4670 bind $w <2> {sim_butDown
%W
}
4671 bind $w <ButtonRelease-2
> {sim_butUp
%W
}
4672 bind $w <3> {sim_butDown
%W
}
4673 bind $w <ButtonRelease-3
> {sim_butUp
%W
}
4677 ########################################################################
4678 # Internal Callbacks
4681 proc UIStartMicropolis
{homedir resourcedir hostname
} {
4682 global HomeDir ResourceDir HostName HeadWindows
4683 set HomeDir
$homedir
4684 set ResourceDir
$resourcedir
4685 set HostName
$hostname
4690 foreach display
[sim Displays
] {
4691 if {"[AddPlayer $display]" == ""} {
4692 echo Couldn't add a player on
$display ...
4696 if {"$HeadWindows" == ""} {
4697 echo Micropolis is exiting because it couldn't connect to any players.
4703 proc UISelectCity
{win
} {
4704 AskQuestion
[Color
$win #ff0000 #ffffff] "Choose Another City" \
4705 "Do you want to abandon this city and choose another one?" \
4706 "{Keep playing.} SelectCity.No {RejectPlan}" \
4708 "{Another city!} SelectCity.Yes {UIPickScenarioMode}"
4712 proc UIQuit
{head
} {
4713 if {[sim Players
] == 1} {
4714 set l
"{Keep playing.} Quit.No {RejectPlan}"
4716 set r
"{I quit!} Quit.IQuit {DoReallyQuit %s}"
4718 set l
"{Keep playing.} Quit.No {RejectPlan}"
4719 set m
"{I quit!} Quit.IResign {DoIResign %s}"
4720 set r
"{Everyone quit!} Quit.AllQuit {DoReallyQuit %s}"
4722 AskQuestion
[Color
$head #ff0000 #ffffff] "Quit Playing Micropolis" \
4723 "Do you want to quit playing Micropolis?" \
4728 proc DoIResign
{head
} {
4730 set display
[winfo screen
$head]
4732 DecRefDisplay
$display
4733 UISetMessage
"The player on X11 Display $display has resigned."
4735 if {([sim Players
] == 0) ||
4736 ([llength $VotesForAsk] >= [sim Players
])} {
4742 proc DoReallyQuit
{head
} {
4748 proc UISplashMode
{} {
4758 proc UIPickScenarioMode
{} {
4767 InitVotesForUseThisMap
4772 proc ForcePickScenarioMode
{} {
4774 if {"$State" != "scenario"} {
4780 proc UIGenerateCityNow
{} {
4781 global CityName GameLevel
4782 sim CityName NowHere
4788 proc UIGenerateNewCity
{} {
4789 global CityName GameLevel
4790 if {$GameLevel == -1} {
4793 MakeHistory
"DoNewCity NowHere $GameLevel [sim Rand] [sim TreeLevel] [sim LakeLevel] [sim CurveLevel] [sim CreateIsland]"
4797 proc DoNewCity
{name level
{r
""} {tl
-1} {ll
-1} {cl
-1} {ci
-1}} {
4803 sim CreateIsland
$ci
4807 sim GenerateSomeCity
$r
4810 sim GameLevel
$level
4815 proc UIDidGenerateNewCity
{} {
4820 proc IncRefDisplay
{display
} {
4821 global DisplayRegistry
4822 if ![info exists DisplayRegistry
($display)] {
4823 set DisplayRegistry
($display) 0
4825 incr DisplayRegistry
($display)
4829 proc DecRefDisplay
{display
} {
4830 global DisplayRegistry
4831 incr DisplayRegistry
($display) -1
4832 if {$DisplayRegistry($display) <= 0} {
4833 CloseDisplay
$display
4838 proc CloseDisplay
{display
} {
4842 proc DoStopMicropolis
{} {
4848 proc AddPlayer
{display
} {
4849 set i
[string first
: $display]
4853 set display
"$display:0"
4857 echo Adding a player on
$display ...
4859 set head
[MakeWindow.head
$display]
4861 if {"$head" != ""} {
4862 set display
[winfo screen
$head]
4863 IncRefDisplay
$display
4865 UISetMessage
"Added a player on X11 Display \"$display\"."
4868 UISetMessage
"Couldn't add a player on X11 Display \"$display\"!"
4878 proc DropFireBombs
{} {
4886 proc UIMakeMonster
{} {
4887 sim MakeMonster
[sim Rand
120] [sim Rand
100]
4910 proc TogglePause
{} {
4913 if {"$State" != "play" ||
[sim Speed
]} {
4922 proc SetSpeedTime
{time} {
4928 proc MakeRunningSound
{} {
4931 if {"$State" == "play" && [sim Speed
]} {
4932 UIMakeSound edit Boing
"-speed 1[sim Speed]0"
4934 UIMakeSound edit Boing
"-speed 90"
4939 proc SayDemands
{} {
4940 global DemandRes DemandCom DemandInd
4942 set r
[expr "100 + ($DemandRes * $slope)"]
4943 set c
[expr "100 + ($DemandCom * $slope)"]
4944 set i
[expr "100 + ($DemandInd * $slope)"]
4945 after 020 "UIMakeSound edit O \"-speed $r\""
4946 after 220 "UIMakeSound edit A \"-speed $c\""
4947 after 440 "UIMakeSound edit E \"-speed $i\""
4951 proc UISaveCity
{win
} {
4953 set SaveCityWin
$win
4958 proc UISaveCityAs
{{win
""}} {
4960 if {"$win" == ""} {set win
$SaveCityWin}
4961 set SaveCityWin
$win
4964 set file [ShowFileOf
$win]
4965 DoFileDialog
$file "Choose a File to Save the City" $CityDir "*.cty" "" \
4966 "UIDoReallySaveCity" ""
4970 proc UIDoReallySaveCity
{name path
} {
4972 if {![string match
*.cty
$name]} {
4976 sim SaveCityAs
$path/$name
4980 proc UIDidSaveCity
{} {
4981 DoSendMessage
"Saved the city in \"[sim CityFileName]\"." status
4985 proc UIDidntSaveCity
{msg
} {
4986 DoSendMessage
$msg alert
4987 UIMakeSound warning Sorry
"-speed 85"
4991 proc UILoadScenario
{scen
} {
4992 MakeHistory
"DoScenario $scen"
4996 proc DoScenario
{scen
} {
4999 sim LoadScenario
$scen
5004 proc UIDidLoadScenario
{} {
5008 proc UIStartScenario
{id
} {
5017 proc UIPlayNewCity
{} {
5023 proc UIStartLoad
{} {
5028 proc UIReallyStartGame
{} {
5034 proc UIPlayGame
{} {
5041 SetPriority
$Priority
5049 proc UISetSpeed
{speed
} {
5052 if {"$State" == "play"} {
5053 UISetMessage
[lindex {
5056 {Time flows medium.
}
5064 proc UIUpdateRunning
{} {
5065 global HeadWindows Time State
5067 if {($State == "play") && $Time} {
5068 set pict
"@images/micropolisg.xpm"
5070 set pict
"@images/micropoliss.xpm"
5073 foreach win
$HeadWindows {
5074 set can
[WindowLink
$win.demand
]
5075 $can itemconfig micropolis
-bitmap $pict
5080 proc DoSetGameLevel
{level
} {
5081 sim GameLevel
$level
5085 proc UISetGameLevel
{level
} {
5087 set GameLevel
$level
5088 global ScenarioWindows
5089 foreach win
$ScenarioWindows {
5090 UpdateLevelSelection
$win
5095 proc UISetCityName
{name
} {
5096 global EditorWindows
5099 set title
"Micropolis Editor on $name"
5100 foreach win
$EditorWindows {
5101 # TODO: set editor window and icon title
5102 #wm title $win "$title"
5103 #wm iconname $win "$title"
5108 proc UILoadCity
{win
} {
5109 # if changed, r-u-sure?
5111 set file [ShowFileOf
$win]
5112 DoFileDialog
$file "Choose a City to Load" $CityDir "*.cty" "" \
5117 proc UIDoLoadCity
{name path
} {
5120 if {![string match
*.cty
$name]} {
5123 MakeHistory
"DoLoadCity $path/$name"
5127 proc DoLoadCity
{filename} {
5128 sim LoadCity
$filename
5131 proc UIDidLoadCity
{} {
5132 global State GameLevel Scenario
5135 if {$State == "play"} {
5138 UIShowPicture
49 [sim CityFileName
]
5143 proc UIDidntLoadCity
{msg
} {
5144 DoSendMessage
$msg alert
5145 UIMakeSound warning Sorry
"-speed 85"
5146 UIShowPicture
49 [sim CityFileName
]
5165 proc UIDidPan
{w x y
} {
5166 if {[$w ToolMode
] == 1} {
5167 EditorToolDrag
$w $x $y
5173 proc UIDidStopPan
{win
} {
5174 UIMakeSoundOn
$win fancy Skid
"-volume 25"
5179 proc UIEarthQuake
{} {
5183 proc UIAutoGoto
{x y
{except
{}}} {
5184 global EditorWindows
5186 set x
[expr "$x * 16 + 8"]
5187 set y
[expr "$y * 16 + 8"]
5188 foreach win
$EditorWindows {
5189 if {"$win" != "$except"} {
5190 set view
[WindowLink
$win.view
]
5191 if {[$view AutoGoto
]} {
5193 $view AutoGoal
$x $y
5203 proc UIAutoGotoOn
{x y eds
} {
5204 set x
[expr "$x * 16 + 8"]
5205 set y
[expr "$y * 16 + 8"]
5207 [WindowLink
$win.view
] AutoGoal
$x $y
5213 proc DoLeaveGame
{head
} {
5217 proc UILoseGame
{} {
5228 proc DoPendTool
{view tool x y
} {
5229 global HeadWindows ToolInfo VotesForAsk
5231 set win
[WindowLink
$view.top
]
5232 set head
[WindowLink
$win.head
]
5234 if {($tool == [sim PendingTool
]) &&
5235 ($x == [sim PendingX
]) &&
5236 ($y == [sim PendingY
])} {
5237 if {[lsearch $VotesForAsk $head] != -1} {
5238 # you can only vote once
5239 UIMakeSound edit Oop
5241 UIMakeSound edit Boing
5242 set ask
[WindowLink
$head.ask
]
5243 PressVoteButton
$ask [WindowLink
$ask.vote
] Ask
5246 UIAutoGoto
$x $y $win
5248 UIMakeSound edit Boing
5249 set info [lindex $ToolInfo $tool]
5250 set a
[lindex $info 0]
5251 set name
[lindex $info 1]
5252 set cost
[lindex $info 2]
5253 set title
"Build $a $name"
5254 set question
"Do you support the plan to build $a $name for $cost?"
5255 AskQuestion
[Color
$win #00ff00 #ffffff] "$title" \
5257 "{Veto plan.} Plan.Veto
5259 "{Goto plan.} Plan.Goto
5260 {ComeTo %s $x $y}" \
5261 "{Support plan!} Plan.Support
5262 {SupportPlan $view %s $tool $x $y}
5263 {PreviewSupportPlan $view %s $tool $x $y}"
5264 set VotesForAsk
$head
5265 set ask
[WindowLink
$head.ask
]
5266 [WindowLink
$ask.vote
] config
-relief sunken
5270 sim PendingTool
$tool
5273 sim Votes
[llength $VotesForAsk]
5278 proc RejectPlan
{} {
5280 if {[sim Players
] > 1} {
5281 UIMakeSound edit Sorry
5287 proc NeededVotes
{} {
5289 set players
[sim Players
]
5290 set needed
[expr "$players - $FreeVotes"]
5291 return [max
0 $needed]
5295 proc SupportPlan
{view h tool x y
} {
5297 sim Votes
[llength $VotesForAsk]
5300 $view DoTool
$tool $x $y
5303 UIMakeSound edit Aaah
5307 proc PreviewSupportPlan
{view h tool x y
} {
5309 sim Votes
[llength $VotesForAsk]
5313 proc SugarStartUp
{uri
} {
5317 # TODO: Load the city file at the given URI, or configure according to URI parameters.
5321 proc SugarNickName
{nick
} {
5322 global SugarNickName
5323 set SugarNickName
$nick
5327 proc SugarActivate
{} {
5328 global SugarActivated
5329 set SugarActivated
1
5333 proc SugarDeactivate
{} {
5334 global SugarActivated
5335 set SugarActivated
0
5339 proc SugarShare
{} {
5345 proc SugarBuddyAdd
{key nick color address
} {
5347 set buddy
[list $key $nick $color $address]
5348 lappend SugarBuddies
$buddy
5352 proc SugarBuddyDel
{key nick color address
} {
5354 set buddy
[list $key $nick $color $address]
5355 set i
[lsearch $wins $win]
5357 set SugarBuddies
[lreplace $wins $i $i]
5367 ########################################################################