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 2>&1"
416 system
"xset +fp $FontPath >/dev/null 2>&1"
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 out of hand. Angry mobs are looting and vandalizing the central city. The president will
send in the national guard soon
if you cannot control the problem.
} \
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 signal ignore SIGCHLD
945 exec res
/sounds
/player res
/sounds
/[string tolower
[lindex $soundspec 0]].wav
&
950 proc UIMakeSoundOn
{win chan sound
{opts
""}} {
951 # Send message to Python to play sound.
954 #UIDoSoundOn $win "play $sound -replay -channel $chan $opts"
958 proc UIStartSoundOn
{win chan sound
{opts
""}} {
959 # Send message to Python to play sound.
962 #UIDoSoundOn $win "play $sound -replay -channel $chan -repeat 100 $opts"
966 proc UIStopSoundOn
{win chan sound
{opts
""}} {
967 UIDoSoundOn
$win "stop $sound"
971 proc UIMakeSound
{chan sound
{opts
""}} {
972 # Send message to Python to play sound.
975 #UIDoSound "sound play $sound -replay -channel $chan $opts"
979 proc UIStartSound
{chan sound
{opts
""}} {
980 # Send message to Python to play sound.
983 #UIDoSound "sound play $sound -channel $chan -repeat 100 $opts"
987 proc UIStopSound
{chan sound
{opts
""}} {
988 UIDoSound
"sound stop $sound"
992 proc SetupSoundServer
{win
} {
997 proc AddSoundServer
{win
} {
999 set i
[lsearch $SoundServers $win]
1001 set SoundServers
[linsert $SoundServers 0 $win]
1006 proc LostSoundServer
{win
} {
1007 DeleteSoundServer
$win
1008 # UIShowPictureOn [WindowLink $win.head] 46 [winfo screen $win]
1012 proc DeleteSoundServer
{win
} {
1014 set i
[lsearch $SoundServers $win]
1016 set SoundServers
[lreplace $SoundServers $i $i]
1021 proc UISoundOff
{} {
1025 proc MonsterSpeed
{} {
1026 return [expr "[sim Rand 40] + 70"]
1030 proc ExplosionPitch
{} {
1031 return [expr "[sim Rand 20] + 90"]
1036 return [expr "[sim Rand 20] + 90"]
1040 ########################################################################
1041 # Global Window Handlers
1044 proc WithdrawAll
{} {
1062 proc ShowInitial
{} {
1070 ########################################################################
1071 # Head Window Handlers
1074 proc PrepHead
{head
} {
1081 WithdrawHeadOf
$head
1085 after 1000 "WithdrawSplashOf $head"
1086 WithdrawHeadOf
$head
1087 ShowScenarioOf
$head
1091 WithdrawSplashOf
$head
1092 WithdrawScenarioOf
$head
1097 ReShowPictureOn
$head
1105 proc ShowHeadOf
{head
} {
1110 proc WithdrawHeadOf
{head
} {
1117 foreach win
$HeadWindows {
1123 proc WithdrawHeads
{} {
1125 foreach win
$HeadWindows {
1131 proc DeleteHeadWindow
{head
} {
1138 foreach win
$HeadWindows {
1144 proc InitHead
{win
} {
1145 set w
[WindowLink
$win.
text]
1146 $w configure
-state normal
1149 $w configure
-state disabled
1151 if {[sim MultiPlayerMode
]} {
1152 set w
[WindowLink
$win.
entry]
1163 proc InitAllHeadMenus
{} {
1166 foreach win
$HeadWindows {
1172 proc InitHeadMenus
{win
} {
1174 set m0
[WindowLink
$win.m0
]
1175 set m1
[WindowLink
$win.m1
]
1176 set m2
[WindowLink
$win.m2
]
1177 set m3
[WindowLink
$win.m3
]
1178 set m4
[WindowLink
$win.m4
]
1179 set b0
[WindowLink
$win.b0
]
1180 set b1
[WindowLink
$win.b1
]
1181 set b2
[WindowLink
$win.b2
]
1182 set b3
[WindowLink
$win.b3
]
1183 set b4
[WindowLink
$win.b4
]
1197 # When in multi player mode there is an extra menu
1198 # item to add another player, before the quit item,
1199 # so compensate for it here.
1200 if {[sim MultiPlayerMode
]} {
1205 $b0 config
-state normal
1206 $b2 config
-state disabled
1207 $b4 config
-state disabled
1212 # When in multi player mode there is an extra menu
1213 # item to add another player, before the quit item,
1214 # so compensate for it here.
1215 if {[sim MultiPlayerMode
]} {
1220 $b0 config
-state normal
1221 $b2 config
-state normal
1222 $b4 config
-state normal
1228 proc UIDisaster
{win cmd action
} {
1229 AskQuestion
[Color
$win #ff0000 #ffffff] "Cause a Disaster" \
1230 "Oh no! Do you really want to $action" \
1231 "{No way!} Disaster.No {WithdrawAsks}" \
1233 "{I guess so.} Disaster.Yes {WithdrawAsks ; $cmd}"
1237 proc CrushHead
{head
} {
1238 global SubWindows VoteNames
1240 foreach foo
$VoteNames {
1242 set votes
[eval ident
\$VotesFor$foo]
1243 set i
[lsearch $votes $head]
1245 set VotesFor
$foo [lreplace $votes $i $i]
1249 foreach foo
$SubWindows {
1250 set sym
[lindex $foo 0]
1251 set name
[lindex $foo 1]
1253 set wins
[eval ident
"\$$name"]
1255 if {[WindowLink
$win.head
] == $head} {
1256 DeleteWindow
$sym $name $win
1263 proc ChatDown
{win
} {
1285 global ChatConnection
1287 DoSendMessage
"Opening Connection to Chat Server $ChatServer socket $ChatSocket ..." status
1289 set ChatConnection
{}
1291 set ChatConnection
[connect
$ChatServer $ChatSocket]
1294 if {$ChatConnection == {}} then
{
1295 DoSendMessage
"Sorry, I could not open a connection to chat server $ChatServer socket $ChatSocket." status
1298 filehandler
$ChatConnection r
"ReceiveChat"
1309 puts $ChatConnection "USER $UserName $HostName $ServerName $RealName\r\n" nonewline
1310 puts $ChatConnection "NICK $NickName\r\n" nonewline
1311 puts $ChatConnection "JOIN $ChannelName\r\n" nonewline
1312 flush $ChatConnection
1317 proc ReceiveChat
{mode f
} {
1318 # DoSendMessage "ReceiveChat: MODE $mode F $f"
1322 if {[string first
{:} $msg]} {
1326 set from
[lindex $msg 0]
1327 set cmd
[string tolower
[lindex $msg 1]]
1331 if {($cmd == "privmsg") ||
1332 ($cmd == "notice")} then
{
1334 set chan
[lindex $msg 2]
1335 set i
[expr "[string length $from] + 1 + [string length $cmd] + 1 + [string length $chan] + 2"]
1336 set j
[expr "[string length $msg] - 2"]
1337 set line
[string range
$msg $i $j]
1338 set chan
[string range
$chan 1 [string length
$chan]]
1339 set from
[string range
$from 1 [expr "[string length $from] - 1"]]
1340 set from
[split $from {!}]
1341 set from
[lindex $from 0]
1342 DoSendMessage
"$from> $line"
1345 if {$handled == 0} {
1346 set msg
[string range
$msg \
1347 [expr "[string length $from] + 1"] \
1348 [expr "[string length $msg] - 2"]]
1354 proc SendChatMessage
{msg win
} {
1355 global ChatConnection ChannelName NickName
1361 if {[string range
$msg 0 0] == "/"} {
1362 set cmd
[string range
$msg 1 [string length
$msg]]
1363 DoSendMessage
"$NickName> \[$cmd\]"
1366 set cmd
"PRIVMSG $ChannelName :$msg\r\n"
1367 DoSendMessage
"$NickName> $msg"
1374 puts $ChatConnection $cmd nonewline
1375 flush $ChatConnection
1380 DoSendMessage
"IRC Broke the connection"
1390 global ChatConnection
1392 DoSendMessage
"Closing Connection to Chat Server." status
1395 puts $ChatConnection "QUIT\r\n" nonewline
1396 flush $ChatConnection
1397 $ChatConnection close
1400 set ChatConnection
{}
1405 proc DoEnterMessage
{win var
} {
1408 set msg
[eval ident
"\$\{$var\}"]
1410 if {$Chatting} then
{
1411 SendChatMessage
$msg $win
1419 proc DoEvalMessage
{win var
} {
1421 set command
[eval ident
"\$\{$var\}"]
1423 DoSendMessage
"Evaluating TCL: $command"
1424 catch {uplevel #0 $command} result
1425 DoSendMessage
"Result: $result"
1429 proc DoSendMessage
{msg
{tag
message}} {
1431 foreach win
$HeadWindows {
1432 appendWithTag
[WindowLink
$win.
text] $tag "$msg"
1437 proc UISetMessage
{msg
{tag status
}} {
1438 global DoMessages EditorWindows HeadWindows
1440 if {$DoMessages == 0} {
1444 foreach win
$EditorWindows {
1445 [WindowLink
$win.
message] configure
-text "$msg"
1448 foreach win
$HeadWindows {
1449 appendWithTag
[WindowLink
$win.
text] $tag "$msg"
1456 proc appendWithTag
{w tag
text} {
1460 set start
[$w index end
]
1461 $w configure
-state normal
1462 if {$start > $MaxLines} then
{
1463 $w delete
0.0 $ShrinkLines.0
1464 set start
[$w index end
]
1466 $w insert end
"${text}\n"
1467 $w tag add
$tag $start {end
- 1 char
}
1468 $w configure
-state disabled
1469 $w yview
-pickplace {end
- 1 char
}
1473 ########################################################################
1474 # Budget Window Handlers
1477 proc ShowBudgetOf
{head
} {
1478 set win
[WindowLink
$head.budget
]
1480 set win
[MakeWindow.budget
$head [winfo screen
$head]]
1489 proc ShowBudgets
{} {
1490 global HeadWindows BudgetsVisible
1491 set BudgetsVisible
1
1492 foreach win
$HeadWindows {
1498 proc WithdrawBudgets
{} {
1499 global BudgetWindows BudgetsVisible
1500 foreach win
$BudgetWindows {
1504 set BudgetsVisible
0
1508 proc BudgetContinue
{{win
""}} {
1509 global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1511 if {([sim RoadFund
] != $BudgetRoadFund) ||
1512 ([sim FireFund
] != $BudgetFireFund) ||
1513 ([sim PoliceFund
] != $BudgetPoliceFund) ||
1514 ([sim TaxRate
] != $BudgetTaxRate)} {
1515 UISetMessage
"The budget was changed."
1517 UISetMessage
"The budget wasn't changed."
1525 proc BudgetReset
{{win
""}} {
1526 global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1527 if {([sim RoadFund
] != $BudgetRoadFund) ||
1528 ([sim FireFund
] != $BudgetFireFund) ||
1529 ([sim PoliceFund
] != $BudgetPoliceFund) ||
1530 ([sim TaxRate
] != $BudgetTaxRate)} {
1531 UISetMessage
"The budget was reset."
1532 if {[sim Players
] > 1} {
1533 UIMakeSound edit Sorry
1536 UISetMessage
"The budget was reset."
1538 sim RoadFund
$BudgetRoadFund
1539 sim FireFund
$BudgetFireFund
1540 sim PoliceFund
$BudgetPoliceFund
1541 sim TaxRate
$BudgetTaxRate
1547 proc BudgetCancel
{{win
""}} {
1555 proc SetTaxRate
{rate
} {
1560 proc BudgetSetTaxRate
{rate
} {
1566 proc BudgetSetRoadFund
{percent
} {
1567 sim RoadFund
$percent
1572 proc BudgetSetFireFund
{percent
} {
1573 sim FireFund
$percent
1578 proc BudgetSetPoliceFund
{percent
} {
1579 sim PoliceFund
$percent
1584 proc UIShowBudgetAndWait
{} {
1585 global OldBudget BudgetRoadFund BudgetFireFund BudgetPoliceFund BudgetTaxRate
1586 if {$OldBudget == 0} {
1587 set BudgetRoadFund
[sim RoadFund
]
1588 set BudgetFireFund
[sim FireFund
]
1589 set BudgetPoliceFund
[sim PoliceFund
]
1590 set BudgetTaxRate
[sim TaxRate
]
1594 UISetMessage
"Pausing to set the budget ..."
1600 sim UpdateBudgetWindow
1604 proc ToggleBudgetTimer
{} {
1605 global BudgetTimerActive
1606 if {$BudgetTimerActive} {
1614 proc StopBudgetTimer
{} {
1615 global BudgetTimerActive
1616 set BudgetTimerActive
0
1621 proc StartBudgetTimer
{} {
1622 global BudgetTimerActive BudgetTimer BudgetTimeout
1624 set BudgetTimerActive
$me
1625 set BudgetTimer
$BudgetTimeout
1627 after 1000 TickBudgetTimer
$me
1631 proc RestartBudgetTimer
{} {
1632 global BudgetTimerActive
1633 if {$BudgetTimerActive} {
1640 proc UpdateBudgetTimer
{} {
1641 global BudgetWindows BudgetTimerActive BudgetTimer
1642 if {$BudgetTimerActive} {
1643 set text [format "Auto Cancel In %d Seconds (click to disable)" $BudgetTimer]
1645 set text [format "Enable Auto Cancel (currently disabled)"]
1647 foreach win
$BudgetWindows {
1648 set t
[WindowLink
$win.timer
]
1649 $t config
-text "$text"
1654 proc TickBudgetTimer
{me
} {
1655 global BudgetTimerActive BudgetTimer BudgetTimeout
1656 if {$BudgetTimerActive == $me} {
1658 if {$BudgetTimer < 0} {
1664 after 1000 TickBudgetTimer
$me
1670 proc FireBudgetTimer
{} {
1680 proc ToggleAutoBudget
{} {
1683 #echo "ToggleAutoBudget found on, clearing"
1686 #echo "ToggleAutoBudget found off, setting"
1692 proc UIUpdateBudget
{} {
1697 proc UpdateAutoBudget
{} {
1698 global BudgetWindows AutoBudget
1699 if {[sim AutoBudget
]} {
1700 set text "Disable Auto Budget (currently enabled)"
1702 set text "Enable Auto Budget (currently disabled)"
1704 #echo "UpdateAutoBudget $AutoBudget $text"
1705 foreach win
$BudgetWindows {
1706 set t
[WindowLink
$win.autobudget
]
1707 $t config
-text "$text"
1712 proc UISetBudget
{cashflow previous current collected taxrate
} {
1713 global BudgetWindows BudgetsVisible
1715 #echo "UISetBudgetValues $taxrate $BudgetsVisible"
1717 if {$BudgetsVisible} {
1719 foreach win
$BudgetWindows {
1720 set w
[WindowLink
$win.cashflow
]
1721 set old
[lindex [$w configure
-text] 4]
1722 if {$old != $cashflow} {
1723 $w configure
-text $cashflow
1725 set w
[WindowLink
$win.previous
]
1726 set old
[lindex [$w configure
-text] 4]
1727 if {$old != $previous} {
1728 $w configure
-text $previous
1730 set w
[WindowLink
$win.current
]
1731 set old
[lindex [$w configure
-text] 4]
1732 if {$old != $current} {
1733 $w configure
-text $current
1735 set w
[WindowLink
$win.collected
]
1736 set old
[lindex [$w configure
-text] 4]
1737 if {$old != $collected} {
1738 $w configure
-text $collected
1741 set w
[WindowLink
$win.taxrate
]
1743 if {$old != $taxrate} {
1747 set w
[WindowLink
$win.taxlabel
]
1748 set old
[lindex [$w configure
-text] 4]
1751 $w configure
-text $new
1757 foreach win
$HeadWindows {
1759 set w
[WindowLink
$win.taxrate
]
1761 if {$old != $taxrate} {
1762 # FIXME: this might not work if the slider is disabled in multi player mode.
1766 set w
[WindowLink
$win.taxlabel
]
1767 set old
[lindex [$w configure
-text] 4]
1768 set new
"Tax Rate: $taxrate%"
1770 $w configure
-text $new
1776 proc UISetBudgetValues
{roadgot roadwant roadpercent policegot policewant policepercent firegot firewant firepercent
} {
1777 global BudgetWindows BudgetsVisible
1779 if {$BudgetsVisible == 0} {
1783 foreach win
$BudgetWindows {
1784 set w
[WindowLink
$win.fire
].request
1785 set old
[lindex [$w configure
-text] 4]
1786 set new
"$firepercent% of $firewant = $firegot"
1788 $w configure
-text $new
1790 set w
[WindowLink
$win.fire
].fund
1792 if {$old != $firepercent} {
1796 set w
[WindowLink
$win.police
].request
1797 set old
[lindex [$w configure
-text] 4]
1798 set new
"$policepercent% of $policewant = $policegot"
1800 $w configure
-text $new
1802 set w
[WindowLink
$win.police
].fund
1804 if {$old != $policepercent} {
1805 $w set $policepercent
1808 set w
[WindowLink
$win.road
].request
1809 set old
[lindex [$w configure
-text] 4]
1810 set new
"$roadpercent% of $roadwant = $roadgot"
1812 $w configure
-text $new
1814 set w
[WindowLink
$win.road
].fund
1816 if {$old != $roadpercent} {
1823 proc ChangeBudget
{} {
1824 global VotesForBudget
1825 if {"$VotesForBudget" != ""} {
1832 proc InitVotesForBudget
{} {
1833 global VotesForBudget BudgetWindows
1834 set VotesForBudget
{}
1835 foreach win
$BudgetWindows {
1836 [WindowLink
$win.vote
] config
-relief raised
1838 UpdateVotesForBudget
1842 proc UpdateVotesForBudget
{} {
1843 global BudgetWindows
1844 UpdateVotesFor Budget
$BudgetWindows
1848 proc UpdateTaxRateSliders
{} {
1850 set players
[sim Players
]
1851 foreach win
$HeadWindows {
1852 set slider
[WindowLink
$win.taxrate
]
1853 #echo "UpdateTaxRateSliders players $players win $win slider $slider"
1854 if {$players == 1} {
1855 $slider configure
-state normal
1857 $slider configure
-state disabled
1863 ########################################################################
1864 # Evaluation Window Handlers
1867 proc ToggleEvaluationOf
{head
} {
1869 if {"$State" != "play"} {
1874 set win
[WindowLink
$head.evaluation
]
1876 set mapped
[winfo ismapped
$win]
1880 WithdrawEvaluationOf
$head
1882 ShowEvaluationOf
$head
1888 proc WithdrawEvaluationOf
{head
} {
1889 set win
[WindowLink
$head.evaluation
]
1896 proc ShowEvaluationOf
{head
} {
1897 set win
[WindowLink
$head.evaluation
]
1899 set win
[MakeWindow.evaluation
$head [winfo screen
$head]]
1903 set parent
[WindowLink
$win.parent
]
1904 #pack append [WindowLink $head.col2]\
1905 # $parent {top frame nw fill}
1906 pack append $parent\
1907 $win {top
frame nw fillx
}
1909 sim UpdateEvaluation
1913 proc WithdrawEvaluations
{} {
1914 global EvaluationWindows EvaluationsVisible
1915 foreach win
$EvaluationWindows {
1917 #set parent [WindowLink $win.parent]
1918 #pack unpack $parent
1921 set EvaluationsVisible
0
1925 proc EvaluationVisible
{w v
} {
1926 global EvaluationsVisible
1927 global [set var
$w.visible
]
1932 set EvaluationsVisible
[expr "$EvaluationsVisible + 1"]
1934 set EvaluationsVisible
[expr "$EvaluationsVisible - 1"]
1939 proc UISetEvaluation
{changed score ps0 ps1 ps2 ps3 pv0 pv1 pv2 pv3 pop delta assessed cityclass citylevel goodyes goodno title
} {
1940 global EvaluationWindows EvaluationsVisible CurrentDate
1942 set class
[string tolower
$cityclass]
1943 UISetMessage
"$CurrentDate: Score $score, $class population $pop."
1945 if {$EvaluationsVisible} {
1947 foreach win
$EvaluationWindows {
1949 global [set var
$win.visible
]
1950 set visible
[eval ident
"\$\{$var\}"]
1954 # TODO: set evaluation window and icon title
1955 #wm title $win "$title"
1956 #wm iconname $win "$title"
1958 set w
[WindowLink
$win.goodjob
]
1959 set old
[lindex [$w configure
-text] 4]
1960 set new
"$goodyes\n$goodno"
1962 $w configure
-text $new
1965 set w
[WindowLink
$win.problemnames
]
1966 set old
[lindex [$w configure
-text] 4]
1967 set new
"$ps0\n$ps1\n$ps2\n$ps3"
1969 $w configure
-text $new
1972 set w
[WindowLink
$win.problempercents
]
1973 set old
[lindex [$w configure
-text] 4]
1974 set new
"$pv0\n$pv1\n$pv2\n$pv3"
1976 $w configure
-text $new
1979 set w
[WindowLink
$win.stats
]
1980 set old
[lindex [$w configure
-text] 4]
1981 set new
"$pop\n$delta\n\n$assessed\n$cityclass\n$citylevel"
1983 $w configure
-text $new
1986 set w
[WindowLink
$win.score
]
1987 set old
[lindex [$w configure
-text] 4]
1988 set new
"$score\n$changed"
1990 $w configure
-text $new
1998 ########################################################################
1999 # File Window Handlers
2002 proc ShowFileOf
{head
} {
2003 set win
[WindowLink
$head.
file]
2005 set win
[MakeWindow.
file $head [winfo screen
$head]]
2015 foreach win
$HeadWindows {
2021 proc WithdrawFiles
{} {
2023 foreach win
$FileWindows {
2029 proc DoFileDialog
{win Message Path Pattern FileName ActionOk ActionCancel
} {
2030 ShowFileDialog
$win "$Path" "$Pattern"
2031 $win.message1 configure
-text "$Message"
2032 $win.path.path delete
0 end
2033 $win.path.path insert
0 $Path
2034 $win.
file.
file delete
0 end
2035 $win.
file.
file insert
0 "$FileName"
2036 $win.frame1.ok config
-command "
2037 $ActionOk \[$win.file.file get\] \[$win.path.path get\]
2039 $win.frame1.rescan config
-command "
2040 ShowFileDialog $win \[$win.path.path get\] $Pattern"
2041 $win.frame1.cancel config
-command "
2044 bind $win.files.files
"<Double-Button-1>" "\
2045 FileSelectDouble $win %W %y $Pattern \"
2046 $ActionOk \[$win.file.file get\] \[$win.path.path get\]\""
2047 bind $win.path.path
<Return
> "
2048 ShowFileDialog $win \[$win.path.path get\] $Pattern
2049 $win.file.file cursor 0
2050 focus $win.file.file"
2051 bind $win.
file.
file <Return
> "\
2052 $ActionOk \[$win.file.file get\] \[$win.path.path get]
2057 proc BindSelectOne
{win Y
} {
2058 set Nearest
[$win nearest
$Y]
2059 if {$Nearest >= 0} {
2060 $win select from
$Nearest
2061 $win select to
$Nearest
2066 proc FileSelect
{win widget Y
} {
2067 BindSelectOne
$widget $Y
2068 set Nearest
[$widget nearest
$Y]
2069 if {$Nearest >= 0} {
2070 set Path
[$win.path.path get
]
2071 set TmpEntry
[$widget get
$Nearest]
2072 if {[string compare
"/" [string index
$TmpEntry \
2073 [expr [string length
$TmpEntry]-1]]] == 0 ||
\
2074 [string compare
"@" [string index
$TmpEntry \
2075 [expr [string length
$TmpEntry]-1]]] == 0} {
2076 # handle directories, and symbolic links to directories
2077 set FileName
[string range
$TmpEntry 0 \
2078 [expr [string length
$TmpEntry]-2]]
2079 # whoops / or @ is part of the name
2080 if {[MiscIsDir
$Path/$FileName] != 1} {
2081 set FileName
$TmpEntry
2084 if {[string compare
"*" [string index
$TmpEntry \
2085 [expr [string length
$TmpEntry]-1]]] == 0} {
2086 # handle executable filenames
2087 set FileName
[string range
$TmpEntry 0 \
2088 [expr [string length
$TmpEntry]-2]]
2089 # whoops * is part of the name
2090 if {[file executable
$Path/$FileName] != 1} {
2091 set FileName
$TmpEntry
2094 # a ordinary filename
2095 set FileName
$TmpEntry
2098 # enter the selected filename into the filename field
2099 if {[MiscIsDir
$Path/$FileName] != 1} {
2100 $win.
file.
file delete
0 end
2101 $win.
file.
file insert
0 $FileName
2107 proc FileSelectDouble
{win widget Y Pattern Action
} {
2108 BindSelectOne
$widget $Y
2109 set Nearest
[$widget nearest
$Y]
2110 if {$Nearest >= 0} {
2111 set Path
[$win.path.path get
]
2112 set TmpEntry
[$widget get
$Nearest]
2113 if {[string compare
$TmpEntry "../"] == 0} {
2114 # go up one directory
2116 [string trimright
[string trimright
[string trim
$Path] /] @]
2117 if {[string length
$TmpEntry] <= 0} {
2120 set Path
[file dirname
$TmpEntry]
2121 $win.path.path delete
0 end
2122 $win.path.path insert
0 $Path
2123 ShowFileDialog
$win $Path $Pattern
2125 if {[string compare
"/" [string index
$TmpEntry \
2126 [expr [string length
$TmpEntry]-1]]] == 0 ||
\
2127 [string compare
"@" [string index
$TmpEntry \
2128 [expr [string length
$TmpEntry]-1]]] == 0} {
2129 # handle directorys, and symbolic links to directorys
2130 set FileName
[string range
$TmpEntry 0 \
2131 [expr [string length
$TmpEntry]-2]]
2132 # whoops / or @ is part of the name
2133 if {[MiscIsDir
$Path/$FileName] != 1} {
2134 set FileName
$TmpEntry
2137 if {[string compare
"*" [string index
$TmpEntry \
2138 [expr [string length
$TmpEntry]-1]]] == 0} {
2139 # handle executable filenames
2140 set FileName
[string range
$TmpEntry 0 \
2141 [expr [string length
$TmpEntry]-2]]
2142 # whoops * is part of the name
2143 if {[file executable
$Path/$FileName] != 1} {
2144 set FileName
$TmpEntry
2147 # a ordinary filename
2148 set FileName
$TmpEntry
2152 if {[MiscIsDir
$Path/$FileName] == 1} {
2153 if {[string compare
"/" [string index
$Path \
2154 [expr [string length
$Path]-1]]] == 0} {
2155 append Path
$FileName
2157 append Path
/ $FileName
2159 $win.path.path delete
0 end
2160 $win.path.path insert
0 $Path
2161 ShowFileDialog
$win $Path $Pattern
2163 # enter the selected filename into the filename field
2164 $win.
file.
file delete
0 end
2165 $win.
file.
file insert
0 "$FileName"
2166 if {[string length
$Action] > 0} {
2176 proc NameComplete
{win Type
} {
2181 if {[string compare
$Type path
] == 0} {
2182 set DirName
[file dirname
[$win.path.path get
]]
2183 set FileName
[file tail
[$win.path.path get
]]
2185 set DirName
[file dirname
[$win.path.path get
]/]
2186 set FileName
[file tail
[$win.
file.
file get
]]
2190 if {[MiscIsDir
$DirName] == 1} {
2191 catch "exec ls $DirName/" Result
2193 set ListLength
[llength $Result]
2195 while {$Counter < $ListLength} {
2196 if {[string length
$FileName] == 0} {
2197 if {$FoundCounter == 0} {
2198 set NewFile
[lindex $Result $Counter]
2201 set TmpFile1
$NewFile
2202 set TmpFile2
[lindex $Result $Counter]
2203 set Length1
[string length
$TmpFile1]
2204 set Length2
[string length
$TmpFile2]
2206 if {$Length1 > $Length2} {
2207 set Length1
$Length2
2209 while {$Counter1 < $Length1} {
2210 if {[string compare
[string index
$TmpFile1 $Counter1] \
2211 [string index
$TmpFile2 $Counter1]] == 0} {
2212 append NewFile
[string index
$TmpFile1 $Counter1]
2221 if {[regexp "^$FileName" [lindex $Result $Counter] \
2223 if {$FoundCounter == 0} {
2224 set NewFile
[lindex $Result $Counter]
2227 set TmpFile1
$NewFile
2228 set TmpFile2
[lindex $Result $Counter]
2229 set Length1
[string length
$TmpFile1]
2230 set Length2
[string length
$TmpFile2]
2232 if {$Length1 > $Length2} {
2233 set Length1
$Length2
2235 while {$Counter1 < $Length1} {
2236 if {[string compare
[string index
$TmpFile1 $Counter1] \
2237 [string index
$TmpFile2 $Counter1]] == 0} {
2238 append NewFile
[string index
$TmpFile1 $Counter1]
2252 if {$FoundCounter == 1} {
2253 if {[MiscIsDir
$DirName/$NewFile] == 1} {
2254 if {[string compare
$DirName "/"] == 0} {
2255 $win.path.path delete
0 end
2256 $win.path.path insert
0 "/[string trim [string trim $NewFile /] @]/"
2258 $win.path.path delete
0 end
2259 $win.path.path insert
0 "[string trimright $DirName /]/[string trim [string trim $NewFile /] @]/"
2262 $win.path.path delete
0 end
2263 $win.path.path insert
0 \
2264 "[string trim [string trimright $DirName /] @]/"
2265 $win.
file.
file delete
0 end
2266 $win.
file.
file insert
0 "$NewFile"
2269 if {[MiscIsDir
$DirName/$NewFile] == 1 ||
2270 [string compare
$Type path
] == 0} {
2271 $win.path.path delete
0 end
2272 $win.path.path insert
0 \
2273 "[string trimright $DirName /]/[string trim [string trim $NewFile /] @]"
2275 $win.path.path delete
0 end
2276 $win.path.path insert
0 "$DirName"
2277 if {[string length
$NewFile] > 0} {
2278 $win.
file.
file delete
0 end
2279 $win.
file.
file insert
0 "$NewFile"
2286 proc ShowFileDialog
{win Path Pattern
} {
2288 set Path
[lindex [split $Path] 0]
2289 if {[$win.files.files size
] > 0} {
2290 $win.files.files delete
0 end
2293 if {[catch "exec ls -F $Path" Result
]} {
2296 if {[string match
$Result "* not found"]} {
2299 set ElementList
[lsort $Result]
2302 if {[string compare
$Path "/"]} {
2303 $win.files.files insert end
"../"
2307 foreach Counter
$ElementList {
2309 if {[string match
$Pattern $Counter] == 1} {
2310 if {[string compare
$Counter "../"] &&
2311 [string compare
$Counter "./"]} {
2312 $win.files.files insert end
$Counter
2315 set fn
$Path/[string trim
[string trim
[string trim
$Counter /] @] *]
2316 if {[MiscIsDir
$fn]} {
2317 $win.files.files insert end
$Counter
2325 proc MiscIsDir
{PathName
} {
2327 if {[file isdirectory
$PathName] == 1} {
2330 catch "file type $PathName" Type
2331 if {[string compare
$Type link
] == 0} {
2332 set LinkName
[file readlink
$PathName]
2333 catch "file type $LinkName" Type
2334 while {[string compare
$Type link
] == 0} {
2335 set LinkName
[file readlink
$LinkName]
2337 return [file isdirectory
$LinkName]
2344 proc busy
{win cmds
} {
2346 set list [winfo children
$win]
2348 while {$list != ""} {
2351 set class
[winfo class
$w]
2352 set cursor
[lindex [$w config
-cursor] 4]
2353 if {[winfo toplevel $w] == $w} {
2354 lappend busy
[list $w $cursor]
2356 set next
[concat $next [winfo children
$w]]
2362 catch {[lindex $w 0] config
-cursor watch
}
2367 set error [catch {uplevel eval [list $cmds]} result
]
2370 catch {[lindex $w 0] config
-cursor [lindex $w 1]}
2381 ########################################################################
2382 # Editor Window Handlers
2384 proc ShowEditorOf
{head
} {
2385 global EditorWindows
2387 foreach win
$EditorWindows {
2388 if {[WindowLink
$win.head
] == $head} {
2389 set parent
[WindowLink
$win.parent
]
2390 #pack append [WindowLink $head.col2]\
2391 # $parent {top frame nw expand fill}
2392 pack append $parent\
2393 $win {top
frame nw expand fill
}
2407 proc NewEditorOf
{head
} {
2408 set win
[MakeWindow.editor
$head [winfo screen
$head]]
2410 set parent
[WindowLink
$win.parent
]
2411 pack append $parent\
2412 $win {top
frame nw expand fill
}
2419 proc ShowEditors
{} {
2421 foreach win
$HeadWindows {
2427 proc WithdrawEditors
{} {
2428 global EditorWindows
2429 foreach win
$EditorWindows {
2430 #set parent [WindowLink $win.parent]
2431 #pack unpack $parent
2437 proc InitEditors
{} {
2438 global EditorWindows
2439 foreach win
$EditorWindows {
2445 proc InitEditor
{win
} {
2446 set e
[WindowLink
$win.view
]
2447 UISetToolState
$win 7
2452 global $e.TrackState
2453 set $e.TrackState
{}
2457 proc SetEditorAutoGoto
{win val
} {
2458 global AutoGoto.
$win
2459 set AutoGoto.
$win $val
2460 set e
[WindowLink
$win.view
]
2465 proc SetEditorControls
{win val
} {
2466 global Controls.
$win
2467 set Controls.
$win $val
2469 pack append $win $win.leftframe
{left
frame center filly
}
2471 pack unpack
$win.leftframe
2476 proc SetEditorOverlay
{win val
} {
2478 set Overlay.
$win $val
2479 set e
[WindowLink
$win.view
]
2484 proc SetEditorDynamicFilter
{win val
} {
2485 global DynamicFilter.
$win
2486 set DynamicFilter.
$win $val
2487 set e
[WindowLink
$win.view
]
2488 $e DynamicFilter
$val
2489 if {$val == 1} then
{
2490 ShowFrobOf
[WindowLink
$win.head
]
2495 proc SetEditorSkip
{win val
} {
2496 set e
[WindowLink
$win.view
]
2501 proc EditorToolDown
{mod w x y
} {
2502 global [set var
$w.TrackState
]
2506 case
[$w ToolState
] in
\
2508 UIMakeSoundOn
$w edit Rumble
"-repeat 4"
2516 set $var [list constrain_start
$x $y]
2517 $w ToolConstrain
$x $y
2522 EditorTool ToolDown
$w $x $y
2527 proc EditorToolDrag
{w x y
} {
2528 EditorTool ToolDrag
$w $x $y
2533 proc EditorToolUp
{w x y
} {
2534 global [set var
$w.TrackState
]
2537 case
[$w ToolState
] in
\
2539 UIStopSoundOn
$w edit
1
2545 EditorTool ToolUp
$w $x $y
2547 $w ToolConstrain
-1 -1
2554 proc EditorTool
{action w x y
} {
2555 global [set var
$w.TrackState
]
2556 set state
[eval ident
"\$\{$var\}"]
2557 case
[lindex $state 0] in
\
2559 set x0
[lindex $state 1]
2560 set y0
[lindex $state 2]
2561 set dx
[expr "$x - $x0"]
2562 set dy
[expr "$y - $y0"]
2563 if [expr "($dx > 16) || ($dx < -16)"] then
{
2564 $w ToolConstrain
-1 $y0
2567 if [expr "($dy > 16) || ($dy < -16)"] then
{
2568 $w ToolConstrain
$x0 -1
2577 proc StartChalk
{w
} {
2578 sim CollapseMotion
0
2582 proc StopChalk
{w
} {
2583 sim CollapseMotion
1
2587 proc EditorPanDown
{mod w x y
} {
2588 global [set var
$w.TrackState
]
2592 set $var [list constrain_start
$x $y]
2593 $w ToolConstrain
$x $y
2598 EditorTool PanStart
$w $x $y
2602 proc EditorPanDrag
{w x y
} {
2603 EditorTool PanTo
$w $x $y
2607 proc EditorPanUp
{w x y
} {
2610 EditorTool PanTo
$w $x $y
2611 $w ToolConstrain
-1 -1
2617 proc EditorKeyDown
{w k
} {
2622 proc EditorKeyUp
{w k
} {
2627 proc BindEditorButtons
{win
} {
2628 set w
[WindowLink
$win.top
]
2630 bind $win <1> "CancelPie $win ; EditorToolDown none %W %x %y"
2631 bind $win <B1-Motion
> {EditorToolDrag
%W
%x
%y
}
2632 bind $win <ButtonRelease-1
> {EditorToolUp
%W
%x
%y
}
2634 bind $win <Control-1
> "CancelPie $win ; EditorToolDown constrain %W %x %y"
2635 bind $win <Control-B1-Motion
> {EditorToolDrag
%W
%x
%y
}
2636 bind $win <Control-ButtonRelease-1
> {EditorToolUp
%W
%x
%y
}
2638 bind $win <2> "CancelPie $win ; EditorPanDown none %W %x %y"
2639 bind $win <B2-Motion
> {EditorPanDrag
%W
%x
%y
}
2640 bind $win <ButtonRelease-2
> {EditorPanUp
%W
%x
%y
}
2642 bind $win <Control-2
> "CancelPie $win ; EditorPanDown constrain %W %x %y"
2643 bind $win <Control-B2-Motion
> {EditorPanDrag
%W
%x
%y
}
2644 bind $win <Control-ButtonRelease-2
> {EditorPanUp
%W
%x
%y
}
2646 InitPie
$win $w.toolpie
2650 proc UISetFunds
{funds
} {
2652 foreach win
$HeadWindows {
2653 [WindowLink
$win.funds
] configure
-text "$funds"
2658 proc UISetDate
{date month year
} {
2662 set CurrentDate
"$date"
2664 foreach win
$HeadWindows {
2665 [WindowLink
$win.date
] Set
$month $year
2670 proc SetPriority
{index
} {
2696 proc UISetDemand
{r c i
} {
2697 global HeadWindows DemandRes DemandCom DemandInd
2703 if {$r <= 0} then
{set ry0
32} else {set ry0
24}
2704 set ry1
[expr "$ry0 - $r"]
2705 if {$c <= 0} then
{set cy0
32} else {set cy0
24}
2706 set cy1
[expr "$cy0 - $c"]
2707 if {$i <= 0} then
{set iy0
32} else {set iy0
24}
2708 set iy1
[expr "$iy0 - $i"]
2710 foreach win
$HeadWindows {
2711 set can
[WindowLink
$win.demand
]
2712 # $can coords r 8 $ry0 14 $ry1
2713 # $can coords c 17 $cy0 23 $cy1
2714 # $can coords i 26 $iy0 32 $iy1
2715 $can coords r
49 $ry0 55 $ry1
2716 $can coords c
58 $cy0 64 $cy1
2717 $can coords i
67 $iy0 73 $iy1
2722 proc UISetOptions
{autobudget autogoto autobulldoze disasters sound animation messages notices
} {
2723 global AutoBudget AutoGoto AutoBulldoze Disasters Sound
2724 set AutoBudget
$autobudget
2725 set AutoGoto
$autogoto
2726 set AutoBulldoze
$autobulldoze
2727 set Disasters
$disasters
2729 set DoAnimation
$animation
2730 set DoMessages
$messages
2731 set DoNotices
$notices
2735 proc UIDidToolRes
{win x y
} {
2736 UIMakeSoundOn
$win edit O
"-speed 140"
2740 proc UIDidToolCom
{win x y
} {
2741 UIMakeSoundOn
$win edit A
"-speed 140"
2745 proc UIDidToolInd
{win x y
} {
2746 UIMakeSoundOn
$win edit E
"-speed 140"
2750 proc UIDidToolFire
{win x y
} {
2751 UIMakeSoundOn
$win edit O
"-speed 130"
2755 proc UIDidToolQry
{win x y
} {
2756 UIMakeSoundOn
$win edit E
"-speed 200"
2760 proc UIDidToolPol
{win x y
} {
2761 UIMakeSoundOn
$win edit E
"-speed 130"
2765 proc UIDidToolWire
{win x y
} {
2766 UIMakeSoundOn
$win edit O
"-speed 120"
2770 proc UIDidToolDozr
{win x y
} {
2771 UIMakeSoundOn
$win edit Rumble
2775 proc UIDidToolRail
{win x y
} {
2776 UIMakeSoundOn
$win edit O
"-speed 100"
2780 proc UIDidToolRoad
{win x y
} {
2781 UIMakeSoundOn
$win edit E
"-speed 100"
2785 proc UIDidToolChlk
{win x y
} {
2789 proc UIDidToolEraser
{win x y
} {
2793 proc UIDidToolStad
{win x y
} {
2794 UIMakeSoundOn
$win edit O
"-speed 90"
2798 proc UIDidToolPark
{win x y
} {
2799 UIMakeSoundOn
$win edit A
"-speed 130"
2803 proc UIDidToolSeap
{win x y
} {
2804 UIMakeSoundOn
$win edit E
"-speed 90"
2808 proc UIDidToolCoal
{win x y
} {
2809 UIMakeSoundOn
$win edit O
"-speed 75"
2813 proc UIDidToolNuc
{win x y
} {
2814 UIMakeSoundOn
$win edit E
"-speed 75"
2818 proc UIDidToolAirp
{win x y
} {
2819 UIMakeSoundOn
$win edit A
"-speed 50"
2823 proc UISetToolState
{w state
} {
2824 global EditorPallets EditorPalletImages ToolInfo
2825 set win
[WindowLink
$w.top
]
2826 #echo "UISETTOOLSTATE w $w win $win $state"
2827 ExclusivePallet
$state $win $EditorPallets ic
$EditorPalletImages \
2828 raised sunken
{NoFunction
}
2830 set c1
[WindowLink
$w.cost1
]
2832 set info [lindex $ToolInfo $state]
2833 set cost1
[lindex $info 1]
2834 set cost2
[lindex $info 2]
2835 $c1 configure
-text "$cost1"
2836 [WindowLink
$w.cost2
] configure
-text "$cost2"
2841 proc UIShowZoneStatus
{zone density value crime pollution growth x y
} {
2842 global QueryX QueryY
2843 set QueryX
[expr "8 + 16 * $x"]
2844 set QueryY
[expr "8 + 16 * $y"]
2845 UIShowPicture
9 [list $zone $density $value $crime $pollution $growth]
2849 ########################################################################
2850 # Map Window Handlers
2853 proc ShowMapOf
{head
} {
2856 foreach win
$MapWindows {
2857 if {"[WindowLink $win.head]" == "$head"} {
2858 global MapPanelWidth MapPanelHeight
2859 #place configure $win -x 0 -y 0 -width $MapPanelWidth -height $MapPanelHeight
2860 #[WindowLink $win.parent] configure -width $MapPanelWidth -height $MapPanelHeight
2861 set parent
[WindowLink
$win.parent
]
2862 pack append [WindowLink
$head.w2
] \
2863 $win {top
frame nw expand fill
}
2876 proc NewMapOf
{head
} {
2877 set win
[MakeWindow.map
$head [winfo screen
$head]]
2878 global MapPanelWidth MapPanelHeight
2879 #place configure $win -x 0 -y 0 -width $MapPanelWidth -height $MapPanelHeight
2880 #[WindowLink $win.parent] configure -width $MapPanelWidth -height $MapPanelHeight
2881 set parent
[WindowLink
$win.parent
]
2882 #pack append [WindowLink $head.col1]\
2883 # $parent {top frame nw fillx}
2884 pack append [WindowLink
$head.w2
] \
2885 $win {top
frame nw expand fill
}
2892 foreach win
$HeadWindows {
2898 proc WithdrawMaps
{} {
2900 foreach win
$MapWindows {
2909 foreach win
$MapWindows {
2915 proc InitMap
{win
} {
2920 proc EnableMaps
{} {
2922 foreach win
$MapWindows {
2928 proc EnableMap
{win
} {
2929 [WindowLink
$win.view
] ShowEditors
1
2930 [WindowLink
$win.zones
] config
-state normal
2931 [WindowLink
$win.overlays
] config
-state normal
2935 proc DisableMaps
{} {
2937 foreach win
$MapWindows {
2943 proc DisableMap
{win
} {
2944 [WindowLink
$win.view
] ShowEditors
0
2945 [WindowLink
$win.zones
] config
-state disabled
2946 [WindowLink
$win.overlays
] config
-state disabled
2950 proc SetMapState
{win state
} {
2951 set m
[WindowLink
$win.view
]
2953 if {$state == 14} then
{
2954 ShowFrobOf
[WindowLink
$win.head
]
2959 proc MapPanDown
{w x y
} {
2964 proc MapPanDrag
{w x y
} {
2969 proc MapPanUp
{w x y
} {
2976 proc UISetMapState
{w state
} {
2978 #set win [winfo toplevel $w]
2979 set win
[WindowLink
$w.win
]
2980 set m
[WindowLink
$win.view
]
2981 set title
[lindex $MapTitles $state]
2983 # TODO: set map text field header to title
2984 #wm title $win "$title"
2985 #wm iconname $win "$title"
2987 global [set var MapState.
$win]
2991 {6 8 9 10 11 12 13} {
2992 [WindowLink
$win.legend
] config
-bitmap "@images/legendmm.xpm"
2995 [WindowLink
$win.legend
] config
-bitmap "@images/legendpm.xpm"
2998 [WindowLink
$win.legend
] config
-bitmap "@images/legendn.xpm"
3004 ########################################################################
3005 # Graph Window Handlers
3008 proc ToggleGraphOf
{head
} {
3010 if {"$State" != "play"} {
3015 set win
[WindowLink
$head.graph
]
3017 set mapped
[winfo ismapped
$win]
3021 WithdrawGraphOf
$head
3029 proc WithdrawGraphOf
{head
} {
3030 set win
[WindowLink
$head.graph
]
3037 proc ShowGraphOf
{head
} {
3038 set win
[WindowLink
$head.graph
]
3040 set win
[MakeWindow.graph
$head [winfo screen
$head]]
3044 set parent
[WindowLink
$win.parent
]
3045 pack append $parent\
3046 $win {top
frame nw fillx
}
3052 proc WithdrawGraphs
{} {
3054 foreach win
$GraphWindows {
3061 proc InitGraphs
{} {
3063 foreach win
$GraphWindows {
3069 proc InitGraph
{win
} {
3070 UISetGraphState
$win 1 1 1 1 1 1 0
3074 proc UISetGraphState
{win t0 t1 t2 t3 t4 t5 range
} {
3075 set g
[WindowLink
$win.graphview
]
3076 GraphPalletMask
$win [expr "$t0 + ($t1<<1) + ($t2<<2) + ($t3<<3) + ($t4<<4) + ($t5<<5)"]
3077 GraphYearPallet
$win $range
3081 ########################################################################
3082 # Splash Window Handlers
3085 proc ShowSplashOf
{head
} {
3086 set win
[WindowLink
$head.splash
]
3088 set win
[MakeWindow.splash
$head [winfo screen
$head]]
3090 set splashscreen
[WindowLink
$win.splashscreen
]
3092 catch {$splashscreen config
-bitmap "@images/splashscreen.xpm"; set success 1}
3095 global SplashScreenDelay
3096 after $SplashScreenDelay "UIPickScenarioMode"
3103 proc WithdrawSplashOf
{head
} {
3104 set win
[WindowLink
$head.splash
]
3111 proc ShowSplashes
{} {
3113 foreach win
$HeadWindows {
3119 proc WithdrawSplashes
{} {
3120 global SplashWindows
3121 foreach win
$SplashWindows {
3123 set splashscreen
[WindowLink
$win.splashscreen
]
3124 $splashscreen config
-bitmap ""
3129 proc InitSplashes
{} {
3133 proc InitSplash
{win
} {
3137 proc DeleteSplashWindow
{win
} {
3142 ########################################################################
3143 # Scenario Window Handlers
3146 proc ShowScenarioOf
{head
} {
3147 set win
[WindowLink
$head.scenario
]
3149 set win
[MakeWindow.scenario
$head [winfo screen
$head]]
3151 # TODO: load background bitmap
3156 proc WithdrawScenarioOf
{head
} {
3157 set win
[WindowLink
$head.scenario
]
3164 proc ShowScenarios
{} {
3166 foreach win
$HeadWindows {
3172 proc WithdrawScenarios
{} {
3173 global ScenarioWindows
3174 foreach win
$ScenarioWindows {
3176 # TODO: flush background bitmap
3181 proc InitScenarios
{} {
3182 global MapHistory MapHistoryNum
3183 if {$MapHistoryNum < 1} {
3188 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3193 global ScenarioWindows
3194 foreach win
$ScenarioWindows {
3196 #[WindowLink $win.previous] config -state $prev
3197 #[WindowLink $win.next] config -state $next
3202 proc InitScenario
{win
} {
3203 global MapHistory MapHistoryNum
3204 if {$MapHistoryNum < 1} {
3210 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3217 #[WindowLink $win.previous] config -state $prev
3218 #[WindowLink $win.next] config -state $next
3220 LinkWindow
$win.scenarioTarget
-1
3221 LinkWindow
$win.scenarioTargetDown
-1
3223 global ScenarioButtons
3225 set len
[llength $ScenarioButtons]
3227 set data
[lindex $ScenarioButtons $i]
3228 set type
[lindex $data 0]
3229 set id
[lindex $data 1]
3233 LinkWindow
$win.
$id.over
0
3234 LinkWindow
$win.
$id.enabled
1
3235 LinkWindow
$win.
$id.checked
0
3236 #echo "SETTING WIN $win ID $id"
3238 set i
[expr "$i + 1"]
3241 UpdateLevelSelection
$win
3242 UpdateLeftRightEnabled
$win
3246 proc UpdateLevelSelection
{win
} {
3247 #echo UpdateLevelSelection
3249 if {$GameLevel == 0} then
{
3250 LinkWindow
$win.easy.checked
1
3251 LinkWindow
$win.medium.checked
0
3252 LinkWindow
$win.hard.checked
0
3254 if {$GameLevel == 1} then
{
3255 LinkWindow
$win.easy.checked
0
3256 LinkWindow
$win.medium.checked
1
3257 LinkWindow
$win.hard.checked
0
3259 if {$GameLevel == 2} then
{
3260 LinkWindow
$win.easy.checked
0
3261 LinkWindow
$win.medium.checked
0
3262 LinkWindow
$win.hard.checked
1
3265 UpdateScenarioButtonID
$win easy
3266 UpdateScenarioButtonID
$win medium
3267 UpdateScenarioButtonID
$win hard
3272 proc UpdateLeftRightEnabled
{win
} {
3273 #echo UpdateLeftRightEnabled
3275 global MapHistory MapHistoryNum
3276 if {$MapHistoryNum < 1} {
3277 LinkWindow
$win.left.enabled
0
3279 LinkWindow
$win.left.enabled
1
3282 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3283 LinkWindow
$win.right.enabled
0
3285 LinkWindow
$win.right.enabled
1
3288 UpdateScenarioButtonID
$win left
3289 UpdateScenarioButtonID
$win right
3293 proc UpdateScenarioButtonID
{win id
} {
3295 global ScenarioButtons
3297 set len
[llength $ScenarioButtons]
3299 set data
[lindex $ScenarioButtons $i]
3301 if {$id == [lindex $data 1]} then
{
3302 UpdateScenarioButton
$win $data
3306 set i
[expr "$i + 1"]
3311 proc UpdateScenarioButton
{win data
} {
3312 set type
[lindex $data 0]
3313 set id
[lindex $data 1]
3314 set over
[WindowLink
$win.
$id.over
]
3315 set enabled
[WindowLink
$win.
$id.enabled
]
3316 set checked
[WindowLink
$win.
$id.checked
]
3317 #echo "WIN $win TYPE $type ID $id OVER $over ENABLED $enabled CHECKED $checked"
3321 set bm
[lindex $data 13]
3323 set bm
[lindex $data 12]
3327 set bm
[lindex $data 10]
3329 set bm
[lindex $data 9]
3333 set bm
[lindex $data 11]
3336 [WindowLink
$win.
canvas] itemconfig
$id -bitmap $bm
3340 proc DoEnterCityName
{win
} {
3344 proc InitVotesForUseThisMap
{} {
3345 # TODO: Disabled for new scenario window.
3348 global VotesForUseThisMap ScenarioWindows
3349 set VotesForUseThisMap
{}
3350 foreach win
$ScenarioWindows {
3351 [WindowLink
$win.vote
] config
-relief raised
3353 UpdateVotesForUseThisMap
3357 proc UpdateVotesForUseThisMap
{} {
3358 global ScenarioWindows
3359 UpdateVotesFor UseThisMap
$ScenarioWindows
3363 proc UIUseThisMap
{} {
3364 global CityName GameLevel Scenario
3366 # special handling for scenarios?
3367 if {$GameLevel != -1} {
3368 sim GameLevel
$GameLevel
3370 sim CityName
$CityName
3373 if {$Scenario != -1} {
3374 UIShowPicture
$Scenario
3379 proc HandleScenarioDown
{win x y
} {
3380 #echo HandleScenarioDown $win $x $y
3381 HandleScenarioMove
$win $x $y
3382 set w
[WindowLink
$win.w
]
3383 set target
[WindowLink
$w.scenarioTarget
]
3384 LinkWindow
$w.scenarioTargetDown
$target
3388 proc HandleScenarioUp
{win x y
} {
3389 #echo HandleScenarioUp $win $x $y
3390 HandleScenarioMove
$win $x $y
3391 global ScenarioButtons
3392 set w
[WindowLink
$win.w
]
3393 set target
[WindowLink
$w.scenarioTarget
]
3394 set targetDown
[WindowLink
$w.scenarioTargetDown
]
3395 if {($target != -1) &&
3396 ($target == $targetDown)} {
3397 set data
[lindex $ScenarioButtons $target]
3398 set type
[lindex $data 0]
3399 set id
[lindex $data 1]
3400 set callback
[lindex $data 2]
3401 set param
[lindex $data 3]
3402 set var
[lindex $data 4]
3403 set xx
[lindex $data 5]
3404 set yy
[lindex $data 6]
3405 set ww
[lindex $data 7]
3406 set hh
[lindex $data 8]
3407 set normal
[lindex $data 9]
3408 set over
[lindex $data 10]
3409 set disabled
[lindex $data 11]
3410 if {$type == "button"} {
3411 #echo callback $callback w $w param $param
3412 eval "$callback $w {$param}"
3414 if {$type == "checkbox"} {
3415 #echo checkbox callback $callback w $w param $param
3416 eval "$callback $w {$param}"
3423 proc HandleScenarioMove
{win x y
} {
3424 #echo HandleScenarioMove $win $x $y
3425 global ScenarioButtons
3426 set w
[WindowLink
$win.w
]
3427 set target
[WindowLink
$w.scenarioTarget
]
3430 set len
[llength $ScenarioButtons]
3432 set data
[lindex $ScenarioButtons $i]
3433 set type
[lindex $data 0]
3434 set id
[lindex $data 1]
3435 set callback
[lindex $data 2]
3436 set param
[lindex $data 3]
3437 set var
[lindex $data 4]
3438 set xx
[lindex $data 5]
3439 set yy
[lindex $data 6]
3440 set ww
[lindex $data 7]
3441 set hh
[lindex $data 8]
3443 set enabled
[WindowLink
$w.
$id.enabled
]
3444 set checked
[WindowLink
$w.
$id.checked
]
3446 #echo "ID $id ENABLED $enabled CHECKED $checked w $w id $id"
3448 if {($enabled != 0) &&
3450 ($x < ($xx + $ww)) &
3452 ($y < ($yy + $hh))} {
3457 set i
[expr "$i + 1"]
3460 if {$found != $target} {
3463 if {$target != -1} {
3465 #echo OUT $w $found $xx $yy $normal
3466 LinkWindow
$w.scenarioTarget
-1
3468 set targetdata
[lindex $ScenarioButtons $target]
3469 set targetid
[lindex $targetdata 1]
3470 LinkWindow
$w.
$targetid.over
0
3471 UpdateScenarioButton
$w $targetdata
3476 #echo IN $w $found $xx $yy $over
3477 LinkWindow
$w.scenarioTarget
$found
3478 LinkWindow
$w.
$id.over
1
3480 if {$target != -1} {
3481 set targetdata
[lindex $ScenarioButtons $target]
3482 set targetid
[lindex $targetdata 1]
3483 LinkWindow
$w.
$targetid.over
0
3484 UpdateScenarioButton
$w $targetdata
3487 UpdateScenarioButton
$w $data
3493 proc DoLoad
{win param
} {
3494 #echo DOLOAD $win $param
3499 proc DoGenerate
{win param
} {
3500 #echo DOGENERATE $win $param
3505 proc DoQuit
{win param
} {
3506 #echo DOQUIT $win $param
3511 proc DoAbout
{win param
} {
3512 #echo DOABOUT $win $param
3513 MakeHistory
"DoLoadCity cities/about.cty"
3517 proc DoMap
{win param
} {
3518 #echo DOMAP $win $param
3522 proc DoLevel
{win param
} {
3523 #echo DOLEVEL $win $param
3524 DoSetGameLevel
$param
3528 proc DoLeft
{win param
} {
3529 #echo DOLEFT $win $param
3534 proc DoRight
{win param
} {
3535 #echo DORIGHT $win $param
3540 proc DoPlay
{win param
} {
3541 #echo DOPLAY $win $param
3546 proc DoPickScenario
{win param
} {
3547 #echo DOPICKSCENARIO $win $param
3548 UILoadScenario
$param
3551 proc DeleteScenarioWindow
{win
} {
3556 ########################################################################
3557 # Undo/Redo Facility
3560 proc InitHistory
{} {
3562 global MapHistoryNum
3564 set MapHistoryNum
-1
3568 proc MakeHistory
{cmd
} {
3570 set len
[llength $MapHistory]
3572 ($cmd != [lindex $MapHistory [expr $len-1]])} {
3573 lappend MapHistory
$cmd
3581 proc GotoHistory
{i
} {
3583 global MapHistoryNum
3584 InitVotesForUseThisMap
3585 if {$i != $MapHistoryNum} {
3586 set MapHistoryNum
$i
3587 set cmd
[lindex $MapHistory $i]
3590 if {$MapHistoryNum == 0} {
3595 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3601 global ScenarioWindows
3602 foreach win
$ScenarioWindows {
3603 UpdateLeftRightEnabled
$win
3609 proc NextHistory
{} {
3611 global MapHistoryNum
3612 set len
[llength $MapHistory]
3613 set i
[expr "$MapHistoryNum + 1"]
3620 proc PrevHistory
{} {
3622 global MapHistoryNum
3623 set i
[expr "$MapHistoryNum - 1"]
3630 ########################################################################
3631 # Ask Window Handlers
3633 proc ShowAskOf
{head
} {
3634 set win
[WindowLink
$head.ask
]
3636 set win
[MakeWindow.ask
$head [winfo screen
$head]]
3646 foreach win
$HeadWindows {
3652 proc WithdrawAsks
{} {
3654 foreach win
$AskWindows {
3660 proc WithdrawAskOf
{win
} {
3661 set ask
[WindowLink
$win.ask
]
3668 proc AskQuestion
{color title
text left middle right
} {
3670 foreach win
$HeadWindows {
3671 AskQuestionOn
$win $color $title $text $left $middle $right
3676 proc AskQuestionOn
{head color title
text left middle right
} {
3679 set win
[WindowLink
$head.ask
]
3680 set t
[WindowLink
$win.title
]
3681 $t configure
-text $title
3682 $t configure
-background $color
3684 set t
[WindowLink
$win.
text]
3685 $t configure
-state normal
3687 $t insert end
"${text}\n"
3688 $t configure
-state disabled
3690 set bf
[WindowLink
$win.
frame]
3691 set l
[WindowLink
$win.left
]
3692 set m
[WindowLink
$win.middle
]
3693 set r
[WindowLink
$win.vote
]
3694 set rf
[WindowLink
$win.voteframe
]
3698 -text [lindex $left 0] \
3699 -command [format [lindex $left 2] $head]
3700 SetHelp
$l [lindex $left 1]
3701 pack append $bf $l {left
frame center
}
3706 if {$middle != ""} {
3708 -text [lindex $middle 0] \
3709 -command [format [lindex $middle 2] $head]
3710 SetHelp
$m [lindex $middle 1]
3711 pack append $bf $m {left
frame center expand
}
3717 set notify
[format [lindex $right 2] $head]
3718 set preview
[format [lindex $right 3] $head]
3719 set cmd
[list DoVote
$win Ask
$notify $preview]
3721 -text [lindex $right 0] \
3723 SetHelp
$r [lindex $right 1]
3724 pack append $bf $rf {right
frame center
}
3733 proc BindVotingButton
{win but name
} {
3734 set w
[WindowLink
$win.top
]
3736 bind $but <Any-Enter
> "VoteButtonEnter $win $but"
3737 bind $but <Any-Leave
> "VoteButtonLeave $win $but"
3738 bind $but <1> "VoteButtonDown $win $but $name"
3739 bind $but <ButtonRelease-1
> "VoteButtonUp $win $but $name"
3740 bind $but <2> "VoteButtonDown $win $but $name"
3741 bind $but <ButtonRelease-2
> "VoteButtonUp $win $but $name"
3742 bind $but <3> "VoteButtonDown $win $but $name"
3743 bind $but <ButtonRelease-3
> "VoteButtonUp $win $but $name"
3747 proc VoteButtonEnter
{win but
} {
3749 set screen
[winfo screen
$but]
3750 if {[lindex [$but config
-state] 4] != "disabled"} {
3751 $but config
-state active
3752 set tk_priv
(window
@$screen) $but
3754 set tk_priv
(window
@$screen) ""
3759 proc VoteButtonLeave
{win but
} {
3761 if {[lindex [$but config
-state] 4] != "disabled"} {
3762 $but config
-state normal
3764 set screen
[winfo screen
$but]
3765 set tk_priv
(window
@$screen) ""
3769 proc VoteButtonDown
{win but name
} {
3771 set screen
[winfo screen
$but]
3772 set rel
[lindex [$but config
-relief] 4]
3773 set tk_priv
(relief
@$screen) $rel
3774 if {[lindex [$but config
-state] 4] != "disabled"} {
3775 set head
[WindowLink
$win.head
]
3776 if {[IsVotingFor
$head $name]} {
3777 $but config
-relief raised
3779 $but config
-relief sunken
3785 proc VoteButtonUp
{win but name
} {
3787 set screen
[winfo screen
$but]
3788 $but config
-relief $tk_priv(relief
@$screen)
3789 if {($but == $tk_priv(window
@$screen))
3790 && ([lindex [$but config
-state] 4] != "disabled")} {
3791 uplevel #0 [list $but invoke]
3792 set head
[WindowLink
$win.head
]
3793 if {[IsVotingFor
$head $name]} {
3794 $but config
-relief sunken
3796 $but config
-relief raised
3802 proc PressVoteButton
{win but name
} {
3804 uplevel #0 [list $but invoke]
3805 set head
[WindowLink
$win.head
]
3806 if {[IsVotingFor
$head $name]} {
3807 $but config
-relief sunken
3809 $but config
-relief raised
3814 proc IsVotingFor
{win name
} {
3815 global VotesFor
$name
3816 set votes
[eval ident
"\$\{VotesFor$name\}"]
3817 if {[lsearch $votes $win] == -1} {
3825 proc DoVote
{win name notify preview
} {
3826 global VotesFor
$name
3827 set votes
[eval ident
"\$\{VotesFor$name\}"]
3829 set win
[WindowLink
$win.head
]
3830 set i
[lsearch $votes $win]
3832 lappend VotesFor
$name $win
3834 set VotesFor
$name [lreplace $votes $i $i]
3837 set votes
[eval ident
"\$\{VotesFor$name\}"]
3838 if {[llength $votes] >= [NeededVotes
]} {
3846 proc UpdateVotesFor
{name wins
} {
3847 global VotesFor
$name
3848 set votes
[eval llength "\$\{VotesFor$name\}"]
3849 set needed
[NeededVotes
]
3852 set head
[WindowLink
$win.head
]
3853 if {[IsVotingFor
$head $name]} {
3854 set border
[expr "($needed - $votes) * 1"]
3855 set pad
[expr "6 - $border"]
3856 [WindowLink
$win.vote
] config
-padx $pad -pady $pad
3857 [WindowLink
$win.voteframe
] config
-borderwidth $border
3859 set border
[expr "($needed - $votes - 1) * 1"]
3860 set pad
[expr "6 - $border"]
3861 [WindowLink
$win.vote
] config
-padx $pad -pady $pad
3862 [WindowLink
$win.voteframe
] config
-borderwidth $border
3868 proc InitVotesForAsk
{} {
3869 global VotesForAsk AskWindows
3871 foreach win
$AskWindows {
3872 [WindowLink
$win.vote
] config
-relief raised
3879 proc UpdateVotesForAsk
{} {
3881 UpdateVotesFor Ask
$AskWindows
3885 ########################################################################
3886 # Player Window Handlers
3888 proc ShowPlayerOf
{head
} {
3889 set win
[WindowLink
$head.player
]
3891 set win
[MakeWindow.player
$head [winfo screen
$head]]
3899 proc ShowPlayers
{} {
3901 foreach win
$HeadWindows {
3907 proc WithdrawPlayers
{} {
3908 global PlayerWindows
3909 foreach win
$PlayerWindows {
3915 proc UpdatePlayers
{} {
3916 # TODO: Disabled for new scenario window.
3919 global HeadWindows PlayerWindows
3922 foreach win
$HeadWindows {
3923 set server
[winfo screen
$win]
3924 # if {[string first : $server] == 0} {
3925 # set server "[exec hostname]:0"
3927 lappend players
$server
3930 sim Players
[llength $players]
3932 foreach win
$PlayerWindows {
3933 set list [WindowLink
$win.players
]
3935 eval "$list insert 0 $players"
3938 UpdateVotesForUseThisMap
3940 UpdateVotesForBudget
3941 UpdateTaxRateSliders
3945 proc UIShowPlayer
{win
} {
3950 proc DoNewPlayer
{win
} {
3951 set field
[WindowLink
$win.display
]
3952 set dpy
[$field get
]
3957 if {[AddPlayer
$dpy] != ""} {
3963 ########################################################################
3964 # Notice Window Handlers
3967 proc ShowNoticeOf
{head
} {
3968 set win
[WindowLink
$head.notice
]
3970 set win
[MakeWindow.notice
$head [winfo screen
$head]]
3972 global NoticePanelWidth NoticePanelHeight
3973 #place configure $win -x 0 -y 0 -width $NoticePanelWidth -height $NoticePanelHeight
3974 pack append [WindowLink
$head.w3
] \
3975 $win {bottom
frame sw expand fill
}
3980 proc ShowNotices
{} {
3982 foreach win
$HeadWindows {
3988 proc WithdrawNotices
{} {
3989 global NoticeWindows
3990 foreach win
$NoticeWindows {
3997 proc ReShowPictureOn
{{head
""}} {
3998 global ShowingPicture ShowingParms
3999 UIShowPictureOn
$head $ShowingPicture $ShowingParms
4003 proc UIShowPicture
{id
{parms
""}} {
4004 UIShowPictureOn
"" $id $parms
4008 proc UIShowPictureOn
{where id
{parms
""}} {
4009 global DoNotices Messages ShowingPicture ShowingParms
4010 if {$DoNotices == 0} {
4014 set ShowingPicture
$id
4015 set ShowingParms
$parms
4016 set msg
$Messages($id)
4017 set color
[lindex $msg 0]
4018 set title
[lindex $msg 1]
4019 set body
[lindex $msg 2]
4021 set cmd
"format {$body} $parms"
4022 set body
[uplevel #0 $cmd]
4024 set props
[lindex $msg 3]
4025 if {"$where" == ""} {
4027 set where
$HeadWindows
4029 foreach head
$where {
4030 NoticeMessageOn
$head "$title" $color "$body" Medium
$props
4035 proc NoticeMessageOn
{head title color
text font props
} {
4037 set win
[WindowLink
$head.notice
]
4039 set t
[WindowLink
$win.title
]
4040 $t configure
-text $title -background $color
4042 set t
[WindowLink
$win.
text]
4043 $t configure
-state normal
-font [Font
$head $font]
4045 $t insert end
"${text}\n"
4046 $t configure
-state disabled
4049 catch {set left
[keylget props left
]}
4050 set l
[WindowLink
$win.left
]
4052 $l config
-bitmap $left
4053 place $l -in $t -anchor sw
-relx .05 -rely .95
4059 catch {set middle
[keylget props middle
]}
4060 set m
[WindowLink
$win.middle
]
4061 if {$middle != ""} {
4062 $m config
-bitmap $middle
4063 place $m -in $t -anchor s
-relx .5 -rely .95
4069 catch {set right
[keylget props right
]}
4070 set r
[WindowLink
$win.right
]
4072 $r config
-bitmap $right
4073 place $r -in $t -anchor se
-relx .95 -rely .95
4079 catch {set view
[keylget props view
]}
4080 set vf
[WindowLink
$win.viewframe
]
4082 set v
[WindowLink
$win.view
]
4083 set bg
[WindowLink
$win.background
]
4087 pack append $bg $vf {left
frame center fill
}
4088 pack append $bg $t {right
frame center fill expand
}
4095 proc UIPopUpMessage
{msg
} {
4100 proc ComeToMe
{view
} {
4101 set win
[winfo toplevel $view]
4104 set x
[expr "[lindex $xy 0] >>4"]
4105 set y
[expr "[lindex $xy 1] >>4"]
4111 proc ComeTo
{win x y
} {
4112 global EditorWindows
4113 set head
[WindowLink
$win.head
]
4116 foreach ed
$EditorWindows {
4117 if {"[WindowLink $ed.head]" == "$head"} {
4119 set view
[WindowLink
$ed.view
]
4120 if {[$view AutoGoto
]} {
4121 lappend myautoeds
$ed
4125 if {[llength $myautoeds]} {
4126 UIAutoGotoOn
$x $y $myautoeds
4128 if {[llength $myeds]} {
4129 UIAutoGotoOn
$x $y $myeds
4135 proc FollowView
{view id
} {
4139 if {[sim DoAnimation
]} {
4140 set head
[WindowLink
[winfo toplevel $view].head
]
4141 global EditorWindows
4142 foreach win
$EditorWindows {
4143 if {"[WindowLink $win.head]" == "$head"} {
4144 set s
[[WindowLink
$win.view
] Skip
]
4145 set skips
[min
$skips $s]
4149 if {$skips == 999999} {
4159 proc PanView
{view x y
} {
4165 ########################################################################
4166 # Help Window Handlers
4169 proc ShowHelpOf
{head
} {
4170 set win
[WindowLink
$head.help
]
4172 set win
[MakeWindow.help
$head [winfo screen
$head]]
4182 foreach win
$HeadWindows {
4188 proc WithdrawHelps
{} {
4190 foreach win
$HelpWindows {
4196 ########################################################################
4197 # Frob Window Handlers
4200 proc ShowFrobOf
{head
} {
4201 set win
[WindowLink
$head.frob
]
4203 set win
[MakeWindow.frob
$head [winfo screen
$head]]
4214 foreach win
$HeadWindows {
4220 proc WithdrawFrobs
{} {
4222 foreach win
$FrobWindows {
4228 proc UISetDynamic
{i min max
} {
4229 sim DynamicData
[expr "$i*2"] $min
4230 sim DynamicData
[expr "$i*2+1"] $max
4234 ########################################################################
4241 source $ResourceDir/help.tcl
4244 proc HandleHelp
{win x y rootx rooty
} {
4245 global HelpLoaded HelpWidgets Messages
4247 if {$HelpLoaded == 0} {
4253 set head
[WindowLink
[winfo toplevel $win].head
]
4256 catch {set id
$HelpWidgets($win)}
4260 set list [split $win .
]
4261 set len
[expr "[llength $list] - 2"]
4262 set list [lrange $list 0 $len]
4263 if {[llength $list] <= 1} {
4267 set win
[join $list .
]
4269 if [info exists Messages
($id)] {
4270 UIShowHelpOn
$head $id
4272 UIShowHelpOn
$head Window
4277 proc UIShowHelpOn
{win id
{parms
""}} {
4278 global Messages ShowingPicture ShowingParms ResourceDir
4279 set head
[WindowLink
$win.head
]
4280 set msg
$Messages($id)
4281 set color
[lindex $msg 0]
4282 set title
[lindex $msg 1]
4283 set body
[lindex $msg 2]
4285 set cmd
"format {$body} $parms"
4286 set body
[uplevel #0 $cmd]
4288 set props
[lindex $msg 3]
4291 set win
[WindowLink
$head.help
]
4293 set t
[WindowLink
$win.title
]
4294 $t configure
-text $title -background $color
4296 set t
[WindowLink
$win.
text]
4297 $t configure
-state normal
-font [Font
$head Large
]
4299 $t insert end
"${body}\n"
4300 FormatHTML
$ResourceDir/doc
/$id.html
$t
4301 $t configure
-state disabled
4305 proc FormatHTML
{filename text} {
4308 set f
[open $filename]
4315 while {[gets $f line
] >= 0} {
4316 if {"$line" == "</body>"} {
4319 if {([string index
$line 0] == "#") ||
([string length
$line] == 0)} {
4322 $text insert end
"$line\n"
4331 proc SetHelp
{win id
} {
4333 set HelpWidgets
($win) $id
4337 proc Help
{id title
{msg
{}} {props
{}}} {
4338 Message
$id #7f7fff $title $msg $props
4341 ########################################################################
4345 # Set up the bindings to pop up $pie when the right button is clicked in $win
4346 proc InitPie
{win pie
} {
4347 bind $win <Motion
> {}
4348 bind $win <3> "PieMenuDown $win $pie $pie Initial %X %Y"
4349 bind $win <B3-Motion
> {}
4350 bind $win <B3-ButtonRelease
> {}
4354 # Set up the bindings to continue tracking $pie
4355 # Get this: we keep the tracking machine state in the bindings!
4356 proc ActivatePie
{win root pie state
} {
4357 bind $win <Motion
> "PieMenuMotion $win $root $pie $state %X %Y"
4358 bind $win <3> "PieMenuDown $win $root $pie $state %X %Y"
4359 bind $win <B3-Motion
> "PieMenuMotion $win $root $pie $state %X %Y"
4360 bind $win <B3-ButtonRelease
> "PieMenuUp $win $root $pie $state %X %Y"
4364 # Cancel and reset a pie menu
4365 proc CancelPie
{win
} {
4366 set binding
[bind $win <3>]
4367 set root
[lindex $binding 2]
4368 set pie
[lindex $binding 3]
4369 set state
[lindex $binding 4]
4370 if {"$state" != "Initial"} {
4371 catch {$root ungrab
$win}
4374 UIMakeSoundOn
$win fancy Oop
4380 # Handle pie menu button down
4381 proc PieMenuDown
{win root pie state x y
} {
4384 ActivatePie
$win $root $pie FirstDown
4386 catch {$root grab $win}
4389 PreviewPieMenu
$win $pie $x $y
4393 TrackPieMenu
$pie $x $y
4394 ActivatePie
$win $root $pie SecondDown
4400 PreviewPieMenu
$win $pie $x $y
4401 ActivatePie
$win $root $pie SecondDown
4406 SecondDown
{ # error
4413 # Handle pie menu button motion
4414 proc PieMenuMotion
{win root pie state x y
} {
4417 TrackPieMenu
$pie $x $y
4425 TrackPieMenu
$pie $x $y
4439 # Handle pie menu button up
4440 proc PieMenuUp
{win root pie state x y
} {
4443 TrackPieMenu
$pie $x $y
4444 set active
[$pie index active
]
4445 if {$active == "none"} {
4447 catch {$root grab $win}
4448 ActivatePie
$win $root $pie ClickedUp
4450 set label [lindex [$pie entryconfig
$active -label] 4]
4451 set submenu
[lindex [$pie entryconfig
$active -piemenu] 4]
4452 UIMakeSoundOn
$win mode
$label
4453 if {$submenu == {}} {
4454 set reward
[$pie pending
]
4455 catch {$root ungrab
$win}
4459 sim Funds
[expr "[sim Funds] + 5"]
4460 UIMakeSoundOn
$win fancy Aaah
4462 eval [lindex [$pie entryconfig
$active -command] 4]
4467 $submenu activate none
4469 PreviewPieMenu
$win $submenu $x $y
4470 catch {$root grab $win}
4471 ActivatePie
$win $root $submenu SelectedUp
4476 TrackPieMenu
$pie $x $y
4477 set active
[$pie index active
]
4478 if {$active == "none"} {
4481 set label [lindex [$pie entryconfig
$active -label] 4]
4482 set submenu
[lindex [$pie entryconfig
$active -piemenu] 4]
4483 UIMakeSoundOn
$win mode
$label
4484 if {$submenu == {}} {
4485 set reward
[$pie pending
]
4486 catch {$root ungrab
$win}
4490 sim Funds
[expr "[sim Funds] + 5"]
4491 UIMakeSoundOn
$win fancy Aaah
4493 eval [lindex [$pie entryconfig
$active -command] 4]
4498 $submenu activate none
4500 PreviewPieMenu
$win $submenu $x $y
4501 catch {$root grab $win}
4502 ActivatePie
$win $root $submenu SelectedUp
4512 SelectedUp
{ # error
4519 # Track the selected item
4520 proc TrackPieMenu
{pie x y
} {
4521 $pie activate
@$x,$y
4525 proc PreviewPieMenu
{win pie x y
} {
4526 set preview
[lindex [$pie config
-preview] 4]
4527 if {"$preview" != ""} {
4528 set rx
[winfo rootx
$win]
4529 set ry
[winfo rooty
$win]
4530 set x
[expr "$x - $rx"]
4531 set y
[expr "$y - $ry"]
4532 eval [format $preview $x $y]
4537 ########################################################################
4541 proc ExclusivePallet
{state parent children prefix images inactive active cmd
} {
4542 #echo "ExclusivePallet state $state parent $parent children $children prefix $prefix images $images inactive $inactive active $active cmd $cmd"
4544 foreach child
$children {
4545 set name
[lindex $images $i]
4546 if {$i == $state} then
{
4547 $parent.
$child config
\
4548 -bitmap "@images/${prefix}${name}hi.xpm" \
4551 $parent.
$child config
\
4552 -bitmap "@images/${prefix}${name}.xpm" \
4557 eval [concat $cmd $state]
4561 proc NonExclusivePallet
{mask parent children prefix images
4562 inactive active cmd
} {
4564 foreach child
$children {
4565 set name
[lindex $images $i]
4566 if {$mask & (1<<$i)} then
{
4567 $parent.
$child config
\
4568 -bitmap "@images/${prefix}${name}hi.xpm" \
4571 $parent.
$child config
\
4572 -bitmap "@images/${prefix}${name}.xpm" \
4577 eval [concat $cmd $mask]
4581 proc EditorPallet
{win state
} {
4582 global EditorPalletSounds
4583 UIMakeSoundOn
$win mode
[lindex $EditorPalletSounds $state]
4584 EditorSetTool
$win $state
4588 proc EditorSetTool
{win state
} {
4589 global EditorPallets
4590 global EditorPalletImages
4591 ExclusivePallet
$state $win $EditorPallets ic
$EditorPalletImages \
4592 flat raised
"$win.centerframe.view ToolState"
4596 proc GraphPallet
{win state
} {
4597 set mask
[[WindowLink
$win.graphview
] Mask
]
4598 set mask
[expr "$mask ^ (1<<$state)"]
4599 GraphPalletMask
$win $mask
4603 proc GraphPalletMask
{win mask
} {
4605 global GraphPalletImages
4606 NonExclusivePallet
$mask $win $GraphPallets gr
$GraphPalletImages \
4607 flat flat
"SetGraphState $win"
4611 proc GraphYearPallet
{win state
} {
4612 global GraphYearPallets
4613 global GraphYearPalletImages
4614 ExclusivePallet
$state $win $GraphYearPallets gr
$GraphYearPalletImages \
4615 flat flat
"SetGraphYearState $win"
4619 proc SetGraphYearState
{win state
} {
4620 set graph
[WindowLink
$win.graphview
]
4629 proc SetGraphState
{win mask
} {
4631 set graph
[WindowLink
$win.graphview
]
4636 ########################################################################
4639 proc sim_butEnter
{w
} {
4641 set screen
[winfo screen
$w]
4642 set tk_priv
(window
@$screen) $w
4646 proc sim_butLeave
{w
} {
4648 set screen
[winfo screen
$w]
4649 set tk_priv
(window
@$screen) ""
4653 proc sim_butDown
{w
} {
4655 set screen
[winfo screen
$w]
4656 set pict
[lindex [$w config
-bitmap] 4]
4657 set tk_priv
(relief
@$screen) $pict
4658 $w config
-bitmap [lindex [split $pict .
] 0]hi.xpm
4663 proc sim_butUp
{w
} {
4665 set screen
[winfo screen
$w]
4666 $w config
-bitmap $tk_priv(relief
@$screen)
4668 if {$w == $tk_priv(window
@$screen)} {
4669 uplevel #0 [list $w invoke]
4674 proc BindSimButton
{w
} {
4675 bind $w <Any-Enter
> {sim_butEnter
%W
}
4676 bind $w <Any-Leave
> {sim_butLeave
%W
}
4677 bind $w <1> {sim_butDown
%W
}
4678 bind $w <ButtonRelease-1
> {sim_butUp
%W
}
4679 bind $w <2> {sim_butDown
%W
}
4680 bind $w <ButtonRelease-2
> {sim_butUp
%W
}
4681 bind $w <3> {sim_butDown
%W
}
4682 bind $w <ButtonRelease-3
> {sim_butUp
%W
}
4686 ########################################################################
4687 # Internal Callbacks
4690 proc UIStartMicropolis
{homedir resourcedir hostname
} {
4691 global HomeDir ResourceDir HostName HeadWindows
4692 set HomeDir
$homedir
4693 set ResourceDir
$resourcedir
4694 set HostName
$hostname
4699 foreach display
[sim Displays
] {
4700 if {"[AddPlayer $display]" == ""} {
4701 echo Couldn't add a player on
$display ...
4705 if {"$HeadWindows" == ""} {
4706 echo Micropolis is exiting because it couldn't connect to any players.
4712 proc UISelectCity
{win
} {
4713 AskQuestion
[Color
$win #ff0000 #ffffff] "Choose Another City" \
4714 "Do you want to abandon this city and choose another one?" \
4715 "{Keep playing.} SelectCity.No {RejectPlan}" \
4717 "{Another city!} SelectCity.Yes {UIPickScenarioMode}"
4721 proc UIQuit
{head
} {
4722 if {[sim Players
] == 1} {
4723 set l
"{Keep playing.} Quit.No {RejectPlan}"
4725 set r
"{I quit!} Quit.IQuit {DoReallyQuit %s}"
4727 set l
"{Keep playing.} Quit.No {RejectPlan}"
4728 set m
"{I quit!} Quit.IResign {DoIResign %s}"
4729 set r
"{Everyone quit!} Quit.AllQuit {DoReallyQuit %s}"
4731 AskQuestion
[Color
$head #ff0000 #ffffff] "Quit Playing Micropolis" \
4732 "Do you want to quit playing Micropolis?" \
4737 proc DoIResign
{head
} {
4739 set display
[winfo screen
$head]
4741 DecRefDisplay
$display
4742 UISetMessage
"The player on X11 Display $display has resigned."
4744 if {([sim Players
] == 0) ||
4745 ([llength $VotesForAsk] >= [sim Players
])} {
4751 proc DoReallyQuit
{head
} {
4757 proc UISplashMode
{} {
4767 proc UIPickScenarioMode
{} {
4776 InitVotesForUseThisMap
4781 proc ForcePickScenarioMode
{} {
4783 if {"$State" != "scenario"} {
4789 proc UIGenerateCityNow
{} {
4790 global CityName GameLevel
4791 sim CityName NowHere
4797 proc UIGenerateNewCity
{} {
4798 global CityName GameLevel
4799 if {$GameLevel == -1} {
4802 MakeHistory
"DoNewCity NowHere $GameLevel [sim Rand] [sim TreeLevel] [sim LakeLevel] [sim CurveLevel] [sim CreateIsland]"
4806 proc DoNewCity
{name level
{r
""} {tl
-1} {ll
-1} {cl
-1} {ci
-1}} {
4812 sim CreateIsland
$ci
4816 sim GenerateSomeCity
$r
4819 sim GameLevel
$level
4824 proc UIDidGenerateNewCity
{} {
4829 proc IncRefDisplay
{display
} {
4830 global DisplayRegistry
4831 if ![info exists DisplayRegistry
($display)] {
4832 set DisplayRegistry
($display) 0
4834 incr DisplayRegistry
($display)
4838 proc DecRefDisplay
{display
} {
4839 global DisplayRegistry
4840 incr DisplayRegistry
($display) -1
4841 if {$DisplayRegistry($display) <= 0} {
4842 CloseDisplay
$display
4847 proc CloseDisplay
{display
} {
4851 proc DoStopMicropolis
{} {
4857 proc AddPlayer
{display
} {
4858 set i
[string first
: $display]
4862 set display
"$display:0"
4866 echo Adding a player on
$display ...
4868 set head
[MakeWindow.head
$display]
4870 if {"$head" != ""} {
4871 set display
[winfo screen
$head]
4872 IncRefDisplay
$display
4874 UISetMessage
"Added a player on X11 Display \"$display\"."
4877 UISetMessage
"Couldn't add a player on X11 Display \"$display\"!"
4887 proc DropFireBombs
{} {
4895 proc UIMakeMonster
{} {
4896 sim MakeMonster
[sim Rand
120] [sim Rand
100]
4919 proc TogglePause
{} {
4922 if {"$State" != "play" ||
[sim Speed
]} {
4931 proc SetSpeedTime
{time} {
4937 proc MakeRunningSound
{} {
4940 if {"$State" == "play" && [sim Speed
]} {
4941 UIMakeSound edit Boing
"-speed 1[sim Speed]0"
4943 UIMakeSound edit Boing
"-speed 90"
4948 proc SayDemands
{} {
4949 global DemandRes DemandCom DemandInd
4951 set r
[expr "100 + ($DemandRes * $slope)"]
4952 set c
[expr "100 + ($DemandCom * $slope)"]
4953 set i
[expr "100 + ($DemandInd * $slope)"]
4954 after 020 "UIMakeSound edit O \"-speed $r\""
4955 after 220 "UIMakeSound edit A \"-speed $c\""
4956 after 440 "UIMakeSound edit E \"-speed $i\""
4960 proc UISaveCity
{win
} {
4962 set SaveCityWin
$win
4967 proc UISaveCityAs
{{win
""}} {
4969 if {"$win" == ""} {set win
$SaveCityWin}
4970 set SaveCityWin
$win
4973 set file [ShowFileOf
$win]
4974 DoFileDialog
$file "Choose a File to Save the City" $CityDir "*.cty" "" \
4975 "UIDoReallySaveCity" ""
4979 proc UIDoReallySaveCity
{name path
} {
4981 if {![string match
*.cty
$name]} {
4985 sim SaveCityAs
$path/$name
4989 proc UIDidSaveCity
{} {
4990 DoSendMessage
"Saved the city in \"[sim CityFileName]\"." status
4994 proc UIDidntSaveCity
{msg
} {
4995 DoSendMessage
$msg alert
4996 UIMakeSound warning Sorry
"-speed 85"
5000 proc UILoadScenario
{scen
} {
5001 MakeHistory
"DoScenario $scen"
5005 proc DoScenario
{scen
} {
5008 sim LoadScenario
$scen
5013 proc UIDidLoadScenario
{} {
5017 proc UIStartScenario
{id
} {
5026 proc UIPlayNewCity
{} {
5032 proc UIStartLoad
{} {
5037 proc UIReallyStartGame
{} {
5043 proc UIPlayGame
{} {
5050 SetPriority
$Priority
5058 proc UISetSpeed
{speed
} {
5061 if {"$State" == "play"} {
5062 UISetMessage
[lindex {
5065 {Time flows medium.
}
5073 proc UIUpdateRunning
{} {
5074 global HeadWindows Time State
5076 if {($State == "play") && $Time} {
5077 set pict
"@images/micropolisg.xpm"
5079 set pict
"@images/micropoliss.xpm"
5082 foreach win
$HeadWindows {
5083 set can
[WindowLink
$win.demand
]
5084 $can itemconfig micropolis
-bitmap $pict
5089 proc DoSetGameLevel
{level
} {
5090 sim GameLevel
$level
5094 proc UISetGameLevel
{level
} {
5096 set GameLevel
$level
5097 global ScenarioWindows
5098 foreach win
$ScenarioWindows {
5099 UpdateLevelSelection
$win
5104 proc UISetCityName
{name
} {
5105 global EditorWindows
5108 set title
"Micropolis Editor on $name"
5109 foreach win
$EditorWindows {
5110 # TODO: set editor window and icon title
5111 #wm title $win "$title"
5112 #wm iconname $win "$title"
5117 proc UILoadCity
{win
} {
5118 # if changed, r-u-sure?
5120 set file [ShowFileOf
$win]
5121 DoFileDialog
$file "Choose a City to Load" $CityDir "*.cty" "" \
5126 proc UIDoLoadCity
{name path
} {
5129 if {![string match
*.cty
$name]} {
5132 MakeHistory
"DoLoadCity $path/$name"
5136 proc DoLoadCity
{filename} {
5137 sim LoadCity
$filename
5140 proc UIDidLoadCity
{} {
5141 global State GameLevel Scenario
5144 if {$State == "play"} {
5147 UIShowPicture
49 [sim CityFileName
]
5152 proc UIDidntLoadCity
{msg
} {
5153 DoSendMessage
$msg alert
5154 UIMakeSound warning Sorry
"-speed 85"
5155 UIShowPicture
49 [sim CityFileName
]
5174 proc UIDidPan
{w x y
} {
5175 if {[$w ToolMode
] == 1} {
5176 EditorToolDrag
$w $x $y
5182 proc UIDidStopPan
{win
} {
5183 UIMakeSoundOn
$win fancy Skid
"-volume 25"
5188 proc UIEarthQuake
{} {
5192 proc UIAutoGoto
{x y
{except
{}}} {
5193 global EditorWindows
5195 set x
[expr "$x * 16 + 8"]
5196 set y
[expr "$y * 16 + 8"]
5197 foreach win
$EditorWindows {
5198 if {"$win" != "$except"} {
5199 set view
[WindowLink
$win.view
]
5200 if {[$view AutoGoto
]} {
5202 $view AutoGoal
$x $y
5212 proc UIAutoGotoOn
{x y eds
} {
5213 set x
[expr "$x * 16 + 8"]
5214 set y
[expr "$y * 16 + 8"]
5216 [WindowLink
$win.view
] AutoGoal
$x $y
5222 proc DoLeaveGame
{head
} {
5226 proc UILoseGame
{} {
5237 proc DoPendTool
{view tool x y
} {
5238 global HeadWindows ToolInfo VotesForAsk
5240 set win
[WindowLink
$view.top
]
5241 set head
[WindowLink
$win.head
]
5243 if {($tool == [sim PendingTool
]) &&
5244 ($x == [sim PendingX
]) &&
5245 ($y == [sim PendingY
])} {
5246 if {[lsearch $VotesForAsk $head] != -1} {
5247 # you can only vote once
5248 UIMakeSound edit Oop
5250 UIMakeSound edit Boing
5251 set ask
[WindowLink
$head.ask
]
5252 PressVoteButton
$ask [WindowLink
$ask.vote
] Ask
5255 UIAutoGoto
$x $y $win
5257 UIMakeSound edit Boing
5258 set info [lindex $ToolInfo $tool]
5259 set a
[lindex $info 0]
5260 set name
[lindex $info 1]
5261 set cost
[lindex $info 2]
5262 set title
"Build $a $name"
5263 set question
"Do you support the plan to build $a $name for $cost?"
5264 AskQuestion
[Color
$win #00ff00 #ffffff] "$title" \
5266 "{Veto plan.} Plan.Veto
5268 "{Goto plan.} Plan.Goto
5269 {ComeTo %s $x $y}" \
5270 "{Support plan!} Plan.Support
5271 {SupportPlan $view %s $tool $x $y}
5272 {PreviewSupportPlan $view %s $tool $x $y}"
5273 set VotesForAsk
$head
5274 set ask
[WindowLink
$head.ask
]
5275 [WindowLink
$ask.vote
] config
-relief sunken
5279 sim PendingTool
$tool
5282 sim Votes
[llength $VotesForAsk]
5287 proc RejectPlan
{} {
5289 if {[sim Players
] > 1} {
5290 UIMakeSound edit Sorry
5296 proc NeededVotes
{} {
5298 set players
[sim Players
]
5299 set needed
[expr "$players - $FreeVotes"]
5300 return [max
0 $needed]
5304 proc SupportPlan
{view h tool x y
} {
5306 sim Votes
[llength $VotesForAsk]
5309 $view DoTool
$tool $x $y
5312 UIMakeSound edit Aaah
5316 proc PreviewSupportPlan
{view h tool x y
} {
5318 sim Votes
[llength $VotesForAsk]
5322 proc SugarStartUp
{uri
} {
5326 # TODO: Load the city file at the given URI, or configure according to URI parameters.
5330 proc SugarNickName
{nick
} {
5331 global SugarNickName
5332 set SugarNickName
$nick
5336 proc SugarActivate
{} {
5337 global SugarActivated
5338 set SugarActivated
1
5342 proc SugarDeactivate
{} {
5343 global SugarActivated
5344 set SugarActivated
0
5348 proc SugarShare
{} {
5354 proc SugarBuddyAdd
{key nick color address
} {
5356 set buddy
[list $key $nick $color $address]
5357 lappend SugarBuddies
$buddy
5361 proc SugarBuddyDel
{key nick color address
} {
5363 set buddy
[list $key $nick $color $address]
5364 set i
[lsearch $wins $win]
5366 set SugarBuddies
[lreplace $wins $i $i]
5376 ########################################################################