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 our of hand. Angry mobs are looting and vandalizing the central city. The president will
send in the national guard soon
if you cannot control the problem.
} \
488 {{view
{PanView
$v [sim CrimeMaxX
] [sim CrimeMaxY
]}}}
490 Message
12 #ff4f4f {TRAFFIC WARNING!} \
491 {Traffic in this city is horrible. The city gridlock is expanding. The commuters are getting militant.
493 Either build more roads and rails or get a bulletproof limo.
} \
494 {{view
{PanView
$v [sim TrafMaxX
] [sim TrafMaxY
]}}}
496 Message
20 #ff4f4f {FIRE REPORTED!} \
497 "A fire has been reported!" \
498 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
500 Message
21 #ff4f4f {MONSTER ATTACK!} \
501 "A large reptilian creature has been spotted in the water. It seems to be attracted to areas of high pollution. There is a trail of destruction wherever it goes. \
502 All you can do is wait till he leaves, then rebuild from the rubble." \
503 {{view
{FollowView
$v monster
}}}
505 # XXX: write more text
506 Message
22 #ff4f4f {TORNADO ALERT!} \
507 {A tornado has been reported
! There's nothing you can do to stop it
, so you'd better prepare to clean up
after the disaster
!} \
508 {{view
{FollowView
$v tornado
}}}
510 # XXX: write more text
511 Message
23 #ff4f4f {EARTHQUAKE!} \
512 {A major earthquake has occurred
! Put out the fires as quickly as possible
, before they spread
, then reconnect the power
grid and rebuild the city.
} \
513 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
515 # XXX: write more text
516 Message
24 #ff4f4f {PLANE CRASH!} \
517 {A plane has crashed
!} \
518 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
520 # XXX: write more text
521 Message
25 #ff4f4f {SHIPWRECK!} \
522 {A ship has wrecked
!} \
523 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
525 # XXX: write more text
526 Message
26 #ff4f4f {TRAIN CRASH!} \
527 {A train has crashed
!} \
528 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
530 # XXX: write more text
531 Message
27 #ff4f4f {HELICOPTER CRASH!} \
532 {A helicopter has crashed
!} \
533 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
535 Message
30 #ff4f4f {FIREBOMBING REPORTED!} \
536 {Firebombs are falling
!!} \
537 {{view
{PanView
$v [sim CrashX
] [sim CrashY
]}}}
539 Message
35 #7fff7f {TOWN} \
540 {Congratulations
, your village has grown to town status. You now have
2,000 citizens.
} \
541 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
543 Message
36 #7fff7f {CITY} \
544 {Your town has grown into a full sized city
, with a current population of
10,000. Keep up the good work
!} \
545 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
547 Message
37 #7fff7f {CAPITAL} \
548 {Your city has become a capital. The current population here is
50,000. Your political future looks bright.
} \
549 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
551 Message
38 #7fff7f {METROPOLIS} \
552 {Your capital city has now achieved the status of metropolis. The current population is
100,000. With your management skills
, you should seriously consider running
for governor.
} \
553 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
555 Message
39 #7fff7f {MEGALOPOLIS} \
556 {Congratulation
, you have reached the highest category of urban development
, the megalopolis.
558 If you manage to reach this level
, send us email at micropolis
@laptop.org or
send us a copy of your city. We might do something interesting with it.
} \
559 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
561 Message
40 #7fff7f {MEGALINIUM} \
562 {Congratulation
, you have reached the end of
time!
564 Because of the toroidal nature of the the Micropolis Space
/Time Continuum
, your city has wrapped back in
time to
1900!} \
565 {{view
{PanView
$v [sim CenterX
] [sim CenterY
]}}}
567 # XXX: write more text
568 Message
41 #ff4f4f {HEAVY TRAFFIC!} \
570 reporting heavy traffic
!} \
571 {{view
{FollowView
$v helicopter
}}}
573 # XXX: write more text
574 Message
42 #ff4f4f {FLOODING REPORTED!} \
575 {Flooding has been been reported along the water's edge
!} \
576 {{view
{PanView
$v [sim FloodX
] [sim FloodY
]}}}
578 Message
43 #ff4f4f {NUCLEAR MELTDOWN!} \
579 {A nuclear meltdown has occured at your power plant. You are advised to avoid the area until the radioactive isotopes decay.
581 Many generations will confront this problem before it goes away
, so don't hold your breath.
} \
582 {{view
{PanView
$v [sim MeltX
] [sim MeltY
]}}}
585 Message
44 #ff4f4f {RIOTS!} \
586 {The citizens are rioting in the streets
, setting cars and houses on fire
, and bombing government buildings and businesses
!
588 All media coverage is blacked out
, while the fascist pigs beat the poor citizens into submission.
}
590 Message
46 #ff4f4f {NO SOUND SERVER!} \
591 {There is no sound server running on your X11 display
"%s". You won't hear any noise unless you run a sound server
, and turn the sound back on in the
"Options" menu.
}
593 Message
48 #7f7fff {Start a New City} \
594 {Build your very own city from the ground up
, starting with this map of uninhabited land.
}
596 Message
49 #7f7fff {Restore a Saved City} \
597 {This city was saved in the
file named
: %s
}
599 Message
100 #7fff7f {YOU'RE A WINNER!} \
600 {Your mayorial skill and city planning expertise have earned you the KEY TO THE CITY. Local residents will erect monuments to your glory and name their first-born children
after you. Why not run
for governor?
} \
601 {{middle
{@images
/key2city.xpm
}}}
603 Message
200 #ff4f4f {IMPEACHMENT NOTICE!} \
604 {The entire population of this city has finally had enough of your inept planning and incompetant management. An angry mob
-- led by your mother
-- has been spotted in the vicinity of city hall.
606 You should seriously consider taking an extended vacation
-- NOW.
(Or
read the manual and try again.
)}
608 Message
300 #ffd700 {About Micropolis} \
609 "Micropolis Version [sim Version] Copyright (C) 2007
611 Based on the Original Micropolis Concept and Design
613 TCL/Tk User Interface Designed and Created
614 by Don Hopkins, DUX Software.
615 Ported to Linux, Optimized and Adapted for OLPC
617 Licensed under the GNU General Public License,
618 version 3, with additional conditions."
621 ########################################################################
623 ########################################################################
626 option add
*CheckButton.relief flat
627 option add
*Dialog.cursor top_left_arrow
628 option add
*Entry.relief sunken
629 option add
*Frame.borderWidth
0
630 option add
*Listbox.relief sunken
631 option add
*Scrollbar.relief sunken
632 option add
*RadioButton.anchor w
633 option add
*RadioButton.relief flat
635 option add
*background
#b0b0b0
636 option add
*foreground
#000000
637 option add
*activeBackground
#d0d0d0
638 option add
*activeForeground
#000000
639 option add
*disabledForeground
""
640 option add
*selectBackground
#d0d0d0
641 option add
*selectForeground
#000000
642 #option add *selector #ffff80
643 option add
*selector
#bf0000
645 option add
*Scrollbar.Background
#b0b0b0
646 option add
*Scrollbar.Foreground
#d0d0d0
647 option add
*Interval.Background
#b0b0b0
648 option add
*Interval.Foreground
#000000
649 option add
*Interval.activeForeground
#d0d0d0
650 option add
*Interval.sliderForeground
#b0b0b0
651 option add
*Scale.activeForeground
#d0d0d0
652 option add
*Scale.sliderForeground
#b0b0b0
653 option add
*PieMenu.activeBackground
#b0b0b0
655 option add Mwm
*Micropolis.clientDecoration
-maximize
658 ########################################################################
660 ########################################################################
663 bind all
<Help
> {HandleHelp
%W
%x
%y
%X
%Y
}
664 bind all
<Shift-ButtonPress
> {HandleHelp
%W
%x
%y
%X
%Y
}
665 bind all
<Meta-ButtonPress
> {HandleHelp
%W
%x
%y
%X
%Y
}
666 bind all
<Shift-Meta-ButtonPress
> {HandleHelp
%W
%x
%y
%X
%Y
}
669 ########################################################################
671 ########################################################################
690 puts stderr
"$errorInfo"
698 proc NoFunction
{args
} {}
701 proc LinkWindow
{fromname to
} {
703 set WindowLinks
($fromname) $to
707 proc WindowLink
{fromname
} {
710 catch {set to
$WindowLinks($fromname)}
715 proc DeleteWindow
{sym name win
} {
716 set head
[WindowLink
$win.head
]
717 LinkWindow
$head.
$sym {}
719 set wins
[eval ident
"\$$name"]
720 set i
[lsearch $wins $win]
722 set $name [lreplace $wins $i $i]
728 proc Font
{win name
} {
729 global FontInfo FontCache HeadWindows
730 set scr
[winfo screen
$win]
733 set font $FontCache($scr,$name)
738 set label $FontCache($scr)
740 if {"$label" == ""} {
741 foreach head
$HeadWindows {
742 if {"[winfo screen $head]" == "$scr"} {
743 set label $head.fontlabel
744 label $label -text "X11 Sucks" -font fixed
745 set FontCache
($scr) $label
750 set fonts
[keylget FontInfo
$name]
751 foreach font $fonts {
752 #echo "Configuring font $font on $label"
753 if {[catch "$label config -font \"$font\""] == 0} {
766 set FontCache
($scr,$name) $font
772 proc Color
{win color mono
} {
773 if {[winfo screendepth
$win] == 1} {
781 ########################################################################
782 # Window Definition Functions
783 ########################################################################
786 proc MakeWindow.head
{{display
":0"}} {
788 source $ResourceDir/whead.tcl
793 proc MakeWindow.editor
{head
{display
":0"}} {
795 source $ResourceDir/weditor.tcl
800 proc MakeWindow.map
{head
{display
":0"}} {
802 source $ResourceDir/wmap.tcl
807 proc MakeWindow.graph
{head
{display
":0"}} {
809 source $ResourceDir/wgraph.tcl
814 proc MakeWindow.budget
{head
{display
":0"}} {
816 source $ResourceDir/wbudget.tcl
821 proc MakeWindow.evaluation
{head
{display
":0"}} {
823 source $ResourceDir/weval.tcl
828 proc MakeWindow.splash
{head
{display
":0"}} {
830 source $ResourceDir/wsplash.tcl
835 proc MakeWindow.scenario
{head
{display
":0"}} {
837 source $ResourceDir/wscen.tcl
842 proc MakeWindow.
file {head
{display
":0"}} {
844 source $ResourceDir/wfile.tcl
849 proc MakeWindow.ask
{head
{display
":0"}} {
851 source $ResourceDir/wask.tcl
856 proc MakeWindow.player
{head
{display
":0"}} {
858 source $ResourceDir/wplayer.tcl
863 proc MakeWindow.notice
{head
{display
":0"}} {
865 source $ResourceDir/wnotice.tcl
869 proc MakeWindow.help
{head
{display
":0"}} {
871 source $ResourceDir/whelp.tcl
875 proc MakeWindow.frob
{head
{display
":0"}} {
877 source $ResourceDir/wfrob.tcl
882 ########################################################################
884 ########################################################################
887 proc UIInitializeSound
{} {
891 proc UIShutDownSound
{} {
895 proc UIDoSoundOn
{win cmd
} {
896 global Sound SoundServers
898 set win
[WindowLink
[winfo toplevel $win].head
]
899 if {[lsearch $SoundServers $win] != -1} {
900 set cmd
"send -quick -server $win Sound sound $cmd"
902 # XXX: Lost a sound server...
910 proc UIDoSound
{cmd
} {
911 global Sound SoundServers
913 foreach win
$SoundServers {
914 set foo
"send -quick -server $win Sound $cmd"
916 # XXX: Lost a sound server...
924 proc KillSoundServers
{} {
926 foreach win
$SoundServers {
927 set foo
"send -quick -server $win Sound KillSoundServer"
934 proc UISetChannelVolume
{win chan vol
} {
935 UIDoSoundOn
$win "channel $chan -volume $vol"
939 proc EchoPlaySound
{soundspec
} {
940 # Temporary workaround to tell Python Sugar app to play sound.
943 #echo PlaySound [lindex $soundspec 0]
944 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
]
3109 proc ShowSplashes
{} {
3111 foreach win
$HeadWindows {
3117 proc WithdrawSplashes
{} {
3118 global SplashWindows
3119 foreach win
$SplashWindows {
3121 set splashscreen
[WindowLink
$win.splashscreen
]
3122 $splashscreen config
-bitmap ""
3127 proc InitSplashes
{} {
3131 proc InitSplash
{win
} {
3135 proc DeleteSplashWindow
{win
} {
3140 ########################################################################
3141 # Scenario Window Handlers
3144 proc ShowScenarioOf
{head
} {
3145 set win
[WindowLink
$head.scenario
]
3147 set win
[MakeWindow.scenario
$head [winfo screen
$head]]
3149 # TODO: load background bitmap
3154 proc WithdrawScenarioOf
{head
} {
3155 set win WindowLink
$head.scenario
]
3160 proc ShowScenarios
{} {
3162 foreach win
$HeadWindows {
3168 proc WithdrawScenarios
{} {
3169 global ScenarioWindows
3170 foreach win
$ScenarioWindows {
3172 # TODO: flush background bitmap
3177 proc InitScenarios
{} {
3178 global MapHistory MapHistoryNum
3179 if {$MapHistoryNum < 1} {
3184 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3189 global ScenarioWindows
3190 foreach win
$ScenarioWindows {
3192 #[WindowLink $win.previous] config -state $prev
3193 #[WindowLink $win.next] config -state $next
3198 proc InitScenario
{win
} {
3199 global MapHistory MapHistoryNum
3200 if {$MapHistoryNum < 1} {
3206 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3213 #[WindowLink $win.previous] config -state $prev
3214 #[WindowLink $win.next] config -state $next
3216 LinkWindow
$win.scenarioTarget
-1
3217 LinkWindow
$win.scenarioTargetDown
-1
3219 global ScenarioButtons
3221 set len
[llength $ScenarioButtons]
3223 set data
[lindex $ScenarioButtons $i]
3224 set type
[lindex $data 0]
3225 set id
[lindex $data 1]
3229 LinkWindow
$win.
$id.over
0
3230 LinkWindow
$win.
$id.enabled
1
3231 LinkWindow
$win.
$id.checked
0
3232 #echo "SETTING WIN $win ID $id"
3234 set i
[expr "$i + 1"]
3237 UpdateLevelSelection
$win
3238 UpdateLeftRightEnabled
$win
3242 proc UpdateLevelSelection
{win
} {
3243 #echo UpdateLevelSelection
3245 if {$GameLevel == 0} then
{
3246 LinkWindow
$win.easy.checked
1
3247 LinkWindow
$win.medium.checked
0
3248 LinkWindow
$win.hard.checked
0
3250 if {$GameLevel == 1} then
{
3251 LinkWindow
$win.easy.checked
0
3252 LinkWindow
$win.medium.checked
1
3253 LinkWindow
$win.hard.checked
0
3255 if {$GameLevel == 2} then
{
3256 LinkWindow
$win.easy.checked
0
3257 LinkWindow
$win.medium.checked
0
3258 LinkWindow
$win.hard.checked
1
3261 UpdateScenarioButtonID
$win easy
3262 UpdateScenarioButtonID
$win medium
3263 UpdateScenarioButtonID
$win hard
3268 proc UpdateLeftRightEnabled
{win
} {
3269 #echo UpdateLeftRightEnabled
3271 global MapHistory MapHistoryNum
3272 if {$MapHistoryNum < 1} {
3273 LinkWindow
$win.left.enabled
0
3275 LinkWindow
$win.left.enabled
1
3278 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3279 LinkWindow
$win.right.enabled
0
3281 LinkWindow
$win.right.enabled
1
3284 UpdateScenarioButtonID
$win left
3285 UpdateScenarioButtonID
$win right
3289 proc UpdateScenarioButtonID
{win id
} {
3291 global ScenarioButtons
3293 set len
[llength $ScenarioButtons]
3295 set data
[lindex $ScenarioButtons $i]
3297 if {$id == [lindex $data 1]} then
{
3298 UpdateScenarioButton
$win $data
3302 set i
[expr "$i + 1"]
3307 proc UpdateScenarioButton
{win data
} {
3308 set type
[lindex $data 0]
3309 set id
[lindex $data 1]
3310 set over
[WindowLink
$win.
$id.over
]
3311 set enabled
[WindowLink
$win.
$id.enabled
]
3312 set checked
[WindowLink
$win.
$id.checked
]
3313 #echo "WIN $win TYPE $type ID $id OVER $over ENABLED $enabled CHECKED $checked"
3317 set bm
[lindex $data 13]
3319 set bm
[lindex $data 12]
3323 set bm
[lindex $data 10]
3325 set bm
[lindex $data 9]
3329 set bm
[lindex $data 11]
3332 [WindowLink
$win.
canvas] itemconfig
$id -bitmap $bm
3336 proc DoEnterCityName
{win
} {
3340 proc InitVotesForUseThisMap
{} {
3341 # TODO: Disabled for new scenario window.
3344 global VotesForUseThisMap ScenarioWindows
3345 set VotesForUseThisMap
{}
3346 foreach win
$ScenarioWindows {
3347 [WindowLink
$win.vote
] config
-relief raised
3349 UpdateVotesForUseThisMap
3353 proc UpdateVotesForUseThisMap
{} {
3354 global ScenarioWindows
3355 UpdateVotesFor UseThisMap
$ScenarioWindows
3359 proc UIUseThisMap
{} {
3360 global CityName GameLevel Scenario
3362 # special handling for scenarios?
3363 if {$GameLevel != -1} {
3364 sim GameLevel
$GameLevel
3366 sim CityName
$CityName
3369 if {$Scenario != -1} {
3370 UIShowPicture
$Scenario
3375 proc HandleScenarioDown
{win x y
} {
3376 #echo HandleScenarioDown $win $x $y
3377 HandleScenarioMove
$win $x $y
3378 set w
[WindowLink
$win.w
]
3379 set target
[WindowLink
$w.scenarioTarget
]
3380 LinkWindow
$w.scenarioTargetDown
$target
3384 proc HandleScenarioUp
{win x y
} {
3385 #echo HandleScenarioUp $win $x $y
3386 HandleScenarioMove
$win $x $y
3387 global ScenarioButtons
3388 set w
[WindowLink
$win.w
]
3389 set target
[WindowLink
$w.scenarioTarget
]
3390 set targetDown
[WindowLink
$w.scenarioTargetDown
]
3391 if {($target != -1) &&
3392 ($target == $targetDown)} {
3393 set data
[lindex $ScenarioButtons $target]
3394 set type
[lindex $data 0]
3395 set id
[lindex $data 1]
3396 set callback
[lindex $data 2]
3397 set param
[lindex $data 3]
3398 set var
[lindex $data 4]
3399 set xx
[lindex $data 5]
3400 set yy
[lindex $data 6]
3401 set ww
[lindex $data 7]
3402 set hh
[lindex $data 8]
3403 set normal
[lindex $data 9]
3404 set over
[lindex $data 10]
3405 set disabled
[lindex $data 11]
3406 if {$type == "button"} {
3407 #echo callback $callback w $w param $param
3408 eval "$callback $w {$param}"
3410 if {$type == "checkbox"} {
3411 #echo checkbox callback $callback w $w param $param
3412 eval "$callback $w {$param}"
3419 proc HandleScenarioMove
{win x y
} {
3420 #echo HandleScenarioMove $win $x $y
3421 global ScenarioButtons
3422 set w
[WindowLink
$win.w
]
3423 set target
[WindowLink
$w.scenarioTarget
]
3426 set len
[llength $ScenarioButtons]
3428 set data
[lindex $ScenarioButtons $i]
3429 set type
[lindex $data 0]
3430 set id
[lindex $data 1]
3431 set callback
[lindex $data 2]
3432 set param
[lindex $data 3]
3433 set var
[lindex $data 4]
3434 set xx
[lindex $data 5]
3435 set yy
[lindex $data 6]
3436 set ww
[lindex $data 7]
3437 set hh
[lindex $data 8]
3439 set enabled
[WindowLink
$w.
$id.enabled
]
3440 set checked
[WindowLink
$w.
$id.checked
]
3442 #echo "ID $id ENABLED $enabled CHECKED $checked w $w id $id"
3444 if {($enabled != 0) &&
3446 ($x < ($xx + $ww)) &
3448 ($y < ($yy + $hh))} {
3453 set i
[expr "$i + 1"]
3456 if {$found != $target} {
3459 if {$target != -1} {
3461 #echo OUT $w $found $xx $yy $normal
3462 LinkWindow
$w.scenarioTarget
-1
3464 set targetdata
[lindex $ScenarioButtons $target]
3465 set targetid
[lindex $targetdata 1]
3466 LinkWindow
$w.
$targetid.over
0
3467 UpdateScenarioButton
$w $targetdata
3472 #echo IN $w $found $xx $yy $over
3473 LinkWindow
$w.scenarioTarget
$found
3474 LinkWindow
$w.
$id.over
1
3476 if {$target != -1} {
3477 set targetdata
[lindex $ScenarioButtons $target]
3478 set targetid
[lindex $targetdata 1]
3479 LinkWindow
$w.
$targetid.over
0
3480 UpdateScenarioButton
$w $targetdata
3483 UpdateScenarioButton
$w $data
3489 proc DoLoad
{win param
} {
3490 #echo DOLOAD $win $param
3495 proc DoGenerate
{win param
} {
3496 #echo DOGENERATE $win $param
3501 proc DoQuit
{win param
} {
3502 #echo DOQUIT $win $param
3507 proc DoAbout
{win param
} {
3508 #echo DOABOUT $win $param
3509 MakeHistory
"DoLoadCity cities/about.cty"
3513 proc DoMap
{win param
} {
3514 #echo DOMAP $win $param
3518 proc DoLevel
{win param
} {
3519 #echo DOLEVEL $win $param
3520 DoSetGameLevel
$param
3524 proc DoLeft
{win param
} {
3525 #echo DOLEFT $win $param
3530 proc DoRight
{win param
} {
3531 #echo DORIGHT $win $param
3536 proc DoPlay
{win param
} {
3537 #echo DOPLAY $win $param
3542 proc DoPickScenario
{win param
} {
3543 #echo DOPICKSCENARIO $win $param
3544 UILoadScenario
$param
3548 ########################################################################
3549 # Undo/Redo Facility
3552 proc InitHistory
{} {
3554 global MapHistoryNum
3556 set MapHistoryNum
-1
3560 proc MakeHistory
{cmd
} {
3562 set len
[llength $MapHistory]
3564 ($cmd != [lindex $MapHistory [expr $len-1]])} {
3565 lappend MapHistory
$cmd
3573 proc GotoHistory
{i
} {
3575 global MapHistoryNum
3576 InitVotesForUseThisMap
3577 if {$i != $MapHistoryNum} {
3578 set MapHistoryNum
$i
3579 set cmd
[lindex $MapHistory $i]
3582 if {$MapHistoryNum == 0} {
3587 if {$MapHistoryNum == ([llength $MapHistory] - 1)} {
3593 global ScenarioWindows
3594 foreach win
$ScenarioWindows {
3595 UpdateLeftRightEnabled
$win
3601 proc NextHistory
{} {
3603 global MapHistoryNum
3604 set len
[llength $MapHistory]
3605 set i
[expr "$MapHistoryNum + 1"]
3612 proc PrevHistory
{} {
3614 global MapHistoryNum
3615 set i
[expr "$MapHistoryNum - 1"]
3622 ########################################################################
3623 # Ask Window Handlers
3625 proc ShowAskOf
{head
} {
3626 set win
[WindowLink
$head.ask
]
3628 set win
[MakeWindow.ask
$head [winfo screen
$head]]
3638 foreach win
$HeadWindows {
3644 proc WithdrawAsks
{} {
3646 foreach win
$AskWindows {
3652 proc WithdrawAskOf
{win
} {
3653 set ask
[WindowLink
$win.ask
]
3660 proc AskQuestion
{color title
text left middle right
} {
3662 foreach win
$HeadWindows {
3663 AskQuestionOn
$win $color $title $text $left $middle $right
3668 proc AskQuestionOn
{head color title
text left middle right
} {
3671 set win
[WindowLink
$head.ask
]
3672 set t
[WindowLink
$win.title
]
3673 $t configure
-text $title
3674 $t configure
-background $color
3676 set t
[WindowLink
$win.
text]
3677 $t configure
-state normal
3679 $t insert end
"${text}\n"
3680 $t configure
-state disabled
3682 set bf
[WindowLink
$win.
frame]
3683 set l
[WindowLink
$win.left
]
3684 set m
[WindowLink
$win.middle
]
3685 set r
[WindowLink
$win.vote
]
3686 set rf
[WindowLink
$win.voteframe
]
3690 -text [lindex $left 0] \
3691 -command [format [lindex $left 2] $head]
3692 SetHelp
$l [lindex $left 1]
3693 pack append $bf $l {left
frame center
}
3698 if {$middle != ""} {
3700 -text [lindex $middle 0] \
3701 -command [format [lindex $middle 2] $head]
3702 SetHelp
$m [lindex $middle 1]
3703 pack append $bf $m {left
frame center expand
}
3709 set notify
[format [lindex $right 2] $head]
3710 set preview
[format [lindex $right 3] $head]
3711 set cmd
[list DoVote
$win Ask
$notify $preview]
3713 -text [lindex $right 0] \
3715 SetHelp
$r [lindex $right 1]
3716 pack append $bf $rf {right
frame center
}
3725 proc BindVotingButton
{win but name
} {
3726 set w
[WindowLink
$win.top
]
3728 bind $but <Any-Enter
> "VoteButtonEnter $win $but"
3729 bind $but <Any-Leave
> "VoteButtonLeave $win $but"
3730 bind $but <1> "VoteButtonDown $win $but $name"
3731 bind $but <ButtonRelease-1
> "VoteButtonUp $win $but $name"
3732 bind $but <2> "VoteButtonDown $win $but $name"
3733 bind $but <ButtonRelease-2
> "VoteButtonUp $win $but $name"
3734 bind $but <3> "VoteButtonDown $win $but $name"
3735 bind $but <ButtonRelease-3
> "VoteButtonUp $win $but $name"
3739 proc VoteButtonEnter
{win but
} {
3741 set screen
[winfo screen
$but]
3742 if {[lindex [$but config
-state] 4] != "disabled"} {
3743 $but config
-state active
3744 set tk_priv
(window
@$screen) $but
3746 set tk_priv
(window
@$screen) ""
3751 proc VoteButtonLeave
{win but
} {
3753 if {[lindex [$but config
-state] 4] != "disabled"} {
3754 $but config
-state normal
3756 set screen
[winfo screen
$but]
3757 set tk_priv
(window
@$screen) ""
3761 proc VoteButtonDown
{win but name
} {
3763 set screen
[winfo screen
$but]
3764 set rel
[lindex [$but config
-relief] 4]
3765 set tk_priv
(relief
@$screen) $rel
3766 if {[lindex [$but config
-state] 4] != "disabled"} {
3767 set head
[WindowLink
$win.head
]
3768 if {[IsVotingFor
$head $name]} {
3769 $but config
-relief raised
3771 $but config
-relief sunken
3777 proc VoteButtonUp
{win but name
} {
3779 set screen
[winfo screen
$but]
3780 $but config
-relief $tk_priv(relief
@$screen)
3781 if {($but == $tk_priv(window
@$screen))
3782 && ([lindex [$but config
-state] 4] != "disabled")} {
3783 uplevel #0 [list $but invoke]
3784 set head
[WindowLink
$win.head
]
3785 if {[IsVotingFor
$head $name]} {
3786 $but config
-relief sunken
3788 $but config
-relief raised
3794 proc PressVoteButton
{win but name
} {
3796 uplevel #0 [list $but invoke]
3797 set head
[WindowLink
$win.head
]
3798 if {[IsVotingFor
$head $name]} {
3799 $but config
-relief sunken
3801 $but config
-relief raised
3806 proc IsVotingFor
{win name
} {
3807 global VotesFor
$name
3808 set votes
[eval ident
"\$\{VotesFor$name\}"]
3809 if {[lsearch $votes $win] == -1} {
3817 proc DoVote
{win name notify preview
} {
3818 global VotesFor
$name
3819 set votes
[eval ident
"\$\{VotesFor$name\}"]
3821 set win
[WindowLink
$win.head
]
3822 set i
[lsearch $votes $win]
3824 lappend VotesFor
$name $win
3826 set VotesFor
$name [lreplace $votes $i $i]
3829 set votes
[eval ident
"\$\{VotesFor$name\}"]
3830 if {[llength $votes] >= [NeededVotes
]} {
3838 proc UpdateVotesFor
{name wins
} {
3839 global VotesFor
$name
3840 set votes
[eval llength "\$\{VotesFor$name\}"]
3841 set needed
[NeededVotes
]
3844 set head
[WindowLink
$win.head
]
3845 if {[IsVotingFor
$head $name]} {
3846 set border
[expr "($needed - $votes) * 1"]
3847 set pad
[expr "6 - $border"]
3848 [WindowLink
$win.vote
] config
-padx $pad -pady $pad
3849 [WindowLink
$win.voteframe
] config
-borderwidth $border
3851 set border
[expr "($needed - $votes - 1) * 1"]
3852 set pad
[expr "6 - $border"]
3853 [WindowLink
$win.vote
] config
-padx $pad -pady $pad
3854 [WindowLink
$win.voteframe
] config
-borderwidth $border
3860 proc InitVotesForAsk
{} {
3861 global VotesForAsk AskWindows
3863 foreach win
$AskWindows {
3864 [WindowLink
$win.vote
] config
-relief raised
3871 proc UpdateVotesForAsk
{} {
3873 UpdateVotesFor Ask
$AskWindows
3877 ########################################################################
3878 # Player Window Handlers
3880 proc ShowPlayerOf
{head
} {
3881 set win
[WindowLink
$head.player
]
3883 set win
[MakeWindow.player
$head [winfo screen
$head]]
3891 proc ShowPlayers
{} {
3893 foreach win
$HeadWindows {
3899 proc WithdrawPlayers
{} {
3900 global PlayerWindows
3901 foreach win
$PlayerWindows {
3907 proc UpdatePlayers
{} {
3908 # TODO: Disabled for new scenario window.
3911 global HeadWindows PlayerWindows
3914 foreach win
$HeadWindows {
3915 set server
[winfo screen
$win]
3916 # if {[string first : $server] == 0} {
3917 # set server "[exec hostname]:0"
3919 lappend players
$server
3922 sim Players
[llength $players]
3924 foreach win
$PlayerWindows {
3925 set list [WindowLink
$win.players
]
3927 eval "$list insert 0 $players"
3930 UpdateVotesForUseThisMap
3932 UpdateVotesForBudget
3933 UpdateTaxRateSliders
3937 proc UIShowPlayer
{win
} {
3942 proc DoNewPlayer
{win
} {
3943 set field
[WindowLink
$win.display
]
3944 set dpy
[$field get
]
3949 if {[AddPlayer
$dpy] != ""} {
3955 ########################################################################
3956 # Notice Window Handlers
3959 proc ShowNoticeOf
{head
} {
3960 set win
[WindowLink
$head.notice
]
3962 set win
[MakeWindow.notice
$head [winfo screen
$head]]
3964 global NoticePanelWidth NoticePanelHeight
3965 #place configure $win -x 0 -y 0 -width $NoticePanelWidth -height $NoticePanelHeight
3966 pack append [WindowLink
$head.w3
] \
3967 $win {bottom
frame sw expand fill
}
3972 proc ShowNotices
{} {
3974 foreach win
$HeadWindows {
3980 proc WithdrawNotices
{} {
3981 global NoticeWindows
3982 foreach win
$NoticeWindows {
3989 proc ReShowPictureOn
{{head
""}} {
3990 global ShowingPicture ShowingParms
3991 UIShowPictureOn
$head $ShowingPicture $ShowingParms
3995 proc UIShowPicture
{id
{parms
""}} {
3996 UIShowPictureOn
"" $id $parms
4000 proc UIShowPictureOn
{where id
{parms
""}} {
4001 global DoNotices Messages ShowingPicture ShowingParms
4002 if {$DoNotices == 0} {
4006 set ShowingPicture
$id
4007 set ShowingParms
$parms
4008 set msg
$Messages($id)
4009 set color
[lindex $msg 0]
4010 set title
[lindex $msg 1]
4011 set body
[lindex $msg 2]
4013 set cmd
"format {$body} $parms"
4014 set body
[uplevel #0 $cmd]
4016 set props
[lindex $msg 3]
4017 if {"$where" == ""} {
4019 set where
$HeadWindows
4021 foreach head
$where {
4022 NoticeMessageOn
$head "$title" $color "$body" Medium
$props
4027 proc NoticeMessageOn
{head title color
text font props
} {
4029 set win
[WindowLink
$head.notice
]
4031 set t
[WindowLink
$win.title
]
4032 $t configure
-text $title -background $color
4034 set t
[WindowLink
$win.
text]
4035 $t configure
-state normal
-font [Font
$head $font]
4037 $t insert end
"${text}\n"
4038 $t configure
-state disabled
4041 catch {set left
[keylget props left
]}
4042 set l
[WindowLink
$win.left
]
4044 $l config
-bitmap $left
4045 place $l -in $t -anchor sw
-relx .05 -rely .95
4051 catch {set middle
[keylget props middle
]}
4052 set m
[WindowLink
$win.middle
]
4053 if {$middle != ""} {
4054 $m config
-bitmap $middle
4055 place $m -in $t -anchor s
-relx .5 -rely .95
4061 catch {set right
[keylget props right
]}
4062 set r
[WindowLink
$win.right
]
4064 $r config
-bitmap $right
4065 place $r -in $t -anchor se
-relx .95 -rely .95
4071 catch {set view
[keylget props view
]}
4072 set vf
[WindowLink
$win.viewframe
]
4074 set v
[WindowLink
$win.view
]
4075 set bg
[WindowLink
$win.background
]
4079 pack append $bg $vf {left
frame center fill
}
4080 pack append $bg $t {right
frame center fill expand
}
4087 proc UIPopUpMessage
{msg
} {
4092 proc ComeToMe
{view
} {
4093 set win
[winfo toplevel $view]
4096 set x
[expr "[lindex $xy 0] >>4"]
4097 set y
[expr "[lindex $xy 1] >>4"]
4103 proc ComeTo
{win x y
} {
4104 global EditorWindows
4105 set head
[WindowLink
$win.head
]
4108 foreach ed
$EditorWindows {
4109 if {"[WindowLink $ed.head]" == "$head"} {
4111 set view
[WindowLink
$ed.view
]
4112 if {[$view AutoGoto
]} {
4113 lappend myautoeds
$ed
4117 if {[llength $myautoeds]} {
4118 UIAutoGotoOn
$x $y $myautoeds
4120 if {[llength $myeds]} {
4121 UIAutoGotoOn
$x $y $myeds
4127 proc FollowView
{view id
} {
4131 if {[sim DoAnimation
]} {
4132 set head
[WindowLink
[winfo toplevel $view].head
]
4133 global EditorWindows
4134 foreach win
$EditorWindows {
4135 if {"[WindowLink $win.head]" == "$head"} {
4136 set s
[[WindowLink
$win.view
] Skip
]
4137 set skips
[min
$skips $s]
4141 if {$skips == 999999} {
4151 proc PanView
{view x y
} {
4157 ########################################################################
4158 # Help Window Handlers
4161 proc ShowHelpOf
{head
} {
4162 set win
[WindowLink
$head.help
]
4164 set win
[MakeWindow.help
$head [winfo screen
$head]]
4174 foreach win
$HeadWindows {
4180 proc WithdrawHelps
{} {
4182 foreach win
$HelpWindows {
4188 ########################################################################
4189 # Frob Window Handlers
4192 proc ShowFrobOf
{head
} {
4193 set win
[WindowLink
$head.frob
]
4195 set win
[MakeWindow.frob
$head [winfo screen
$head]]
4206 foreach win
$HeadWindows {
4212 proc WithdrawFrobs
{} {
4214 foreach win
$FrobWindows {
4220 proc UISetDynamic
{i min max
} {
4221 sim DynamicData
[expr "$i*2"] $min
4222 sim DynamicData
[expr "$i*2+1"] $max
4226 ########################################################################
4233 source $ResourceDir/help.tcl
4236 proc HandleHelp
{win x y rootx rooty
} {
4237 global HelpLoaded HelpWidgets Messages
4239 if {$HelpLoaded == 0} {
4245 set head
[WindowLink
[winfo toplevel $win].head
]
4248 catch {set id
$HelpWidgets($win)}
4252 set list [split $win .
]
4253 set len
[expr "[llength $list] - 2"]
4254 set list [lrange $list 0 $len]
4255 if {[llength $list] <= 1} {
4259 set win
[join $list .
]
4261 if [info exists Messages
($id)] {
4262 UIShowHelpOn
$head $id
4264 UIShowHelpOn
$head Window
4269 proc UIShowHelpOn
{win id
{parms
""}} {
4270 global Messages ShowingPicture ShowingParms ResourceDir
4271 set head
[WindowLink
$win.head
]
4272 set msg
$Messages($id)
4273 set color
[lindex $msg 0]
4274 set title
[lindex $msg 1]
4275 set body
[lindex $msg 2]
4277 set cmd
"format {$body} $parms"
4278 set body
[uplevel #0 $cmd]
4280 set props
[lindex $msg 3]
4283 set win
[WindowLink
$head.help
]
4285 set t
[WindowLink
$win.title
]
4286 $t configure
-text $title -background $color
4288 set t
[WindowLink
$win.
text]
4289 $t configure
-state normal
-font [Font
$head Large
]
4291 $t insert end
"${body}\n"
4292 FormatHTML
$ResourceDir/doc
/$id.html
$t
4293 $t configure
-state disabled
4297 proc FormatHTML
{filename text} {
4300 set f
[open $filename]
4307 while {[gets $f line
] >= 0} {
4308 if {"$line" == "</body>"} {
4311 if {([string index
$line 0] == "#") ||
([string length
$line] == 0)} {
4314 $text insert end
"$line\n"
4323 proc SetHelp
{win id
} {
4325 set HelpWidgets
($win) $id
4329 proc Help
{id title
{msg
{}} {props
{}}} {
4330 Message
$id #7f7fff $title $msg $props
4333 ########################################################################
4337 # Set up the bindings to pop up $pie when the right button is clicked in $win
4338 proc InitPie
{win pie
} {
4339 bind $win <Motion
> {}
4340 bind $win <3> "PieMenuDown $win $pie $pie Initial %X %Y"
4341 bind $win <B3-Motion
> {}
4342 bind $win <B3-ButtonRelease
> {}
4346 # Set up the bindings to continue tracking $pie
4347 # Get this: we keep the tracking machine state in the bindings!
4348 proc ActivatePie
{win root pie state
} {
4349 bind $win <Motion
> "PieMenuMotion $win $root $pie $state %X %Y"
4350 bind $win <3> "PieMenuDown $win $root $pie $state %X %Y"
4351 bind $win <B3-Motion
> "PieMenuMotion $win $root $pie $state %X %Y"
4352 bind $win <B3-ButtonRelease
> "PieMenuUp $win $root $pie $state %X %Y"
4356 # Cancel and reset a pie menu
4357 proc CancelPie
{win
} {
4358 set binding
[bind $win <3>]
4359 set root
[lindex $binding 2]
4360 set pie
[lindex $binding 3]
4361 set state
[lindex $binding 4]
4362 if {"$state" != "Initial"} {
4363 catch {$root ungrab
$win}
4366 UIMakeSoundOn
$win fancy Oop
4372 # Handle pie menu button down
4373 proc PieMenuDown
{win root pie state x y
} {
4376 ActivatePie
$win $root $pie FirstDown
4378 catch {$root grab $win}
4381 PreviewPieMenu
$win $pie $x $y
4385 TrackPieMenu
$pie $x $y
4386 ActivatePie
$win $root $pie SecondDown
4392 PreviewPieMenu
$win $pie $x $y
4393 ActivatePie
$win $root $pie SecondDown
4398 SecondDown
{ # error
4405 # Handle pie menu button motion
4406 proc PieMenuMotion
{win root pie state x y
} {
4409 TrackPieMenu
$pie $x $y
4417 TrackPieMenu
$pie $x $y
4431 # Handle pie menu button up
4432 proc PieMenuUp
{win root pie state x y
} {
4435 TrackPieMenu
$pie $x $y
4436 set active
[$pie index active
]
4437 if {$active == "none"} {
4439 catch {$root grab $win}
4440 ActivatePie
$win $root $pie ClickedUp
4442 set label [lindex [$pie entryconfig
$active -label] 4]
4443 set submenu
[lindex [$pie entryconfig
$active -piemenu] 4]
4444 UIMakeSoundOn
$win mode
$label
4445 if {$submenu == {}} {
4446 set reward
[$pie pending
]
4447 catch {$root ungrab
$win}
4451 sim Funds
[expr "[sim Funds] + 5"]
4452 UIMakeSoundOn
$win fancy Aaah
4454 eval [lindex [$pie entryconfig
$active -command] 4]
4459 $submenu activate none
4461 PreviewPieMenu
$win $submenu $x $y
4462 catch {$root grab $win}
4463 ActivatePie
$win $root $submenu SelectedUp
4468 TrackPieMenu
$pie $x $y
4469 set active
[$pie index active
]
4470 if {$active == "none"} {
4473 set label [lindex [$pie entryconfig
$active -label] 4]
4474 set submenu
[lindex [$pie entryconfig
$active -piemenu] 4]
4475 UIMakeSoundOn
$win mode
$label
4476 if {$submenu == {}} {
4477 set reward
[$pie pending
]
4478 catch {$root ungrab
$win}
4482 sim Funds
[expr "[sim Funds] + 5"]
4483 UIMakeSoundOn
$win fancy Aaah
4485 eval [lindex [$pie entryconfig
$active -command] 4]
4490 $submenu activate none
4492 PreviewPieMenu
$win $submenu $x $y
4493 catch {$root grab $win}
4494 ActivatePie
$win $root $submenu SelectedUp
4504 SelectedUp
{ # error
4511 # Track the selected item
4512 proc TrackPieMenu
{pie x y
} {
4513 $pie activate
@$x,$y
4517 proc PreviewPieMenu
{win pie x y
} {
4518 set preview
[lindex [$pie config
-preview] 4]
4519 if {"$preview" != ""} {
4520 set rx
[winfo rootx
$win]
4521 set ry
[winfo rooty
$win]
4522 set x
[expr "$x - $rx"]
4523 set y
[expr "$y - $ry"]
4524 eval [format $preview $x $y]
4529 ########################################################################
4533 proc ExclusivePallet
{state parent children prefix images inactive active cmd
} {
4534 #echo "ExclusivePallet state $state parent $parent children $children prefix $prefix images $images inactive $inactive active $active cmd $cmd"
4536 foreach child
$children {
4537 set name
[lindex $images $i]
4538 if {$i == $state} then
{
4539 $parent.
$child config
\
4540 -bitmap "@images/${prefix}${name}hi.xpm" \
4543 $parent.
$child config
\
4544 -bitmap "@images/${prefix}${name}.xpm" \
4549 eval [concat $cmd $state]
4553 proc NonExclusivePallet
{mask parent children prefix images
4554 inactive active cmd
} {
4556 foreach child
$children {
4557 set name
[lindex $images $i]
4558 if {$mask & (1<<$i)} then
{
4559 $parent.
$child config
\
4560 -bitmap "@images/${prefix}${name}hi.xpm" \
4563 $parent.
$child config
\
4564 -bitmap "@images/${prefix}${name}.xpm" \
4569 eval [concat $cmd $mask]
4573 proc EditorPallet
{win state
} {
4574 global EditorPalletSounds
4575 UIMakeSoundOn
$win mode
[lindex $EditorPalletSounds $state]
4576 EditorSetTool
$win $state
4580 proc EditorSetTool
{win state
} {
4581 global EditorPallets
4582 global EditorPalletImages
4583 ExclusivePallet
$state $win $EditorPallets ic
$EditorPalletImages \
4584 flat raised
"$win.centerframe.view ToolState"
4588 proc GraphPallet
{win state
} {
4589 set mask
[[WindowLink
$win.graphview
] Mask
]
4590 set mask
[expr "$mask ^ (1<<$state)"]
4591 GraphPalletMask
$win $mask
4595 proc GraphPalletMask
{win mask
} {
4597 global GraphPalletImages
4598 NonExclusivePallet
$mask $win $GraphPallets gr
$GraphPalletImages \
4599 flat flat
"SetGraphState $win"
4603 proc GraphYearPallet
{win state
} {
4604 global GraphYearPallets
4605 global GraphYearPalletImages
4606 ExclusivePallet
$state $win $GraphYearPallets gr
$GraphYearPalletImages \
4607 flat flat
"SetGraphYearState $win"
4611 proc SetGraphYearState
{win state
} {
4612 set graph
[WindowLink
$win.graphview
]
4621 proc SetGraphState
{win mask
} {
4623 set graph
[WindowLink
$win.graphview
]
4628 ########################################################################
4631 proc sim_butEnter
{w
} {
4633 set screen
[winfo screen
$w]
4634 set tk_priv
(window
@$screen) $w
4638 proc sim_butLeave
{w
} {
4640 set screen
[winfo screen
$w]
4641 set tk_priv
(window
@$screen) ""
4645 proc sim_butDown
{w
} {
4647 set screen
[winfo screen
$w]
4648 set pict
[lindex [$w config
-bitmap] 4]
4649 set tk_priv
(relief
@$screen) $pict
4650 $w config
-bitmap [lindex [split $pict .
] 0]hi.xpm
4655 proc sim_butUp
{w
} {
4657 set screen
[winfo screen
$w]
4658 $w config
-bitmap $tk_priv(relief
@$screen)
4660 if {$w == $tk_priv(window
@$screen)} {
4661 uplevel #0 [list $w invoke]
4666 proc BindSimButton
{w
} {
4667 bind $w <Any-Enter
> {sim_butEnter
%W
}
4668 bind $w <Any-Leave
> {sim_butLeave
%W
}
4669 bind $w <1> {sim_butDown
%W
}
4670 bind $w <ButtonRelease-1
> {sim_butUp
%W
}
4671 bind $w <2> {sim_butDown
%W
}
4672 bind $w <ButtonRelease-2
> {sim_butUp
%W
}
4673 bind $w <3> {sim_butDown
%W
}
4674 bind $w <ButtonRelease-3
> {sim_butUp
%W
}
4678 ########################################################################
4679 # Internal Callbacks
4682 proc UIStartMicropolis
{homedir resourcedir hostname
} {
4683 global HomeDir ResourceDir HostName HeadWindows
4684 set HomeDir
$homedir
4685 set ResourceDir
$resourcedir
4686 set HostName
$hostname
4691 foreach display
[sim Displays
] {
4692 if {"[AddPlayer $display]" == ""} {
4693 echo Couldn't add a player on
$display ...
4697 if {"$HeadWindows" == ""} {
4698 echo Micropolis is exiting because it couldn't connect to any players.
4704 proc UISelectCity
{win
} {
4705 AskQuestion
[Color
$win #ff0000 #ffffff] "Choose Another City" \
4706 "Do you want to abandon this city and choose another one?" \
4707 "{Keep playing.} SelectCity.No {RejectPlan}" \
4709 "{Another city!} SelectCity.Yes {UIPickScenarioMode}"
4713 proc UIQuit
{head
} {
4714 if {[sim Players
] == 1} {
4715 set l
"{Keep playing.} Quit.No {RejectPlan}"
4717 set r
"{I quit!} Quit.IQuit {DoReallyQuit %s}"
4719 set l
"{Keep playing.} Quit.No {RejectPlan}"
4720 set m
"{I quit!} Quit.IResign {DoIResign %s}"
4721 set r
"{Everyone quit!} Quit.AllQuit {DoReallyQuit %s}"
4723 AskQuestion
[Color
$head #ff0000 #ffffff] "Quit Playing Micropolis" \
4724 "Do you want to quit playing Micropolis?" \
4729 proc DoIResign
{head
} {
4731 set display
[winfo screen
$head]
4733 DecRefDisplay
$display
4734 UISetMessage
"The player on X11 Display $display has resigned."
4736 if {([sim Players
] == 0) ||
4737 ([llength $VotesForAsk] >= [sim Players
])} {
4743 proc DoReallyQuit
{head
} {
4749 proc UISplashMode
{} {
4759 proc UIPickScenarioMode
{} {
4768 InitVotesForUseThisMap
4773 proc ForcePickScenarioMode
{} {
4775 if {"$State" != "scenario"} {
4781 proc UIGenerateCityNow
{} {
4782 global CityName GameLevel
4783 sim CityName NowHere
4789 proc UIGenerateNewCity
{} {
4790 global CityName GameLevel
4791 if {$GameLevel == -1} {
4794 MakeHistory
"DoNewCity NowHere $GameLevel [sim Rand] [sim TreeLevel] [sim LakeLevel] [sim CurveLevel] [sim CreateIsland]"
4798 proc DoNewCity
{name level
{r
""} {tl
-1} {ll
-1} {cl
-1} {ci
-1}} {
4804 sim CreateIsland
$ci
4808 sim GenerateSomeCity
$r
4811 sim GameLevel
$level
4816 proc UIDidGenerateNewCity
{} {
4821 proc IncRefDisplay
{display
} {
4822 global DisplayRegistry
4823 if ![info exists DisplayRegistry
($display)] {
4824 set DisplayRegistry
($display) 0
4826 incr DisplayRegistry
($display)
4830 proc DecRefDisplay
{display
} {
4831 global DisplayRegistry
4832 incr DisplayRegistry
($display) -1
4833 if {$DisplayRegistry($display) <= 0} {
4834 CloseDisplay
$display
4839 proc CloseDisplay
{display
} {
4843 proc DoStopMicropolis
{} {
4849 proc AddPlayer
{display
} {
4850 set i
[string first
: $display]
4854 set display
"$display:0"
4858 echo Adding a player on
$display ...
4860 set head
[MakeWindow.head
$display]
4862 if {"$head" != ""} {
4863 set display
[winfo screen
$head]
4864 IncRefDisplay
$display
4866 UISetMessage
"Added a player on X11 Display \"$display\"."
4869 UISetMessage
"Couldn't add a player on X11 Display \"$display\"!"
4879 proc DropFireBombs
{} {
4887 proc UIMakeMonster
{} {
4888 sim MakeMonster
[sim Rand
120] [sim Rand
100]
4911 proc TogglePause
{} {
4914 if {"$State" != "play" ||
[sim Speed
]} {
4923 proc SetSpeedTime
{time} {
4929 proc MakeRunningSound
{} {
4932 if {"$State" == "play" && [sim Speed
]} {
4933 UIMakeSound edit Boing
"-speed 1[sim Speed]0"
4935 UIMakeSound edit Boing
"-speed 90"
4940 proc SayDemands
{} {
4941 global DemandRes DemandCom DemandInd
4943 set r
[expr "100 + ($DemandRes * $slope)"]
4944 set c
[expr "100 + ($DemandCom * $slope)"]
4945 set i
[expr "100 + ($DemandInd * $slope)"]
4946 after 020 "UIMakeSound edit O \"-speed $r\""
4947 after 220 "UIMakeSound edit A \"-speed $c\""
4948 after 440 "UIMakeSound edit E \"-speed $i\""
4952 proc UISaveCity
{win
} {
4954 set SaveCityWin
$win
4959 proc UISaveCityAs
{{win
""}} {
4961 if {"$win" == ""} {set win
$SaveCityWin}
4962 set SaveCityWin
$win
4965 set file [ShowFileOf
$win]
4966 DoFileDialog
$file "Choose a File to Save the City" $CityDir "*.cty" "" \
4967 "UIDoReallySaveCity" ""
4971 proc UIDoReallySaveCity
{name path
} {
4973 if {![string match
*.cty
$name]} {
4977 sim SaveCityAs
$path/$name
4981 proc UIDidSaveCity
{} {
4982 DoSendMessage
"Saved the city in \"[sim CityFileName]\"." status
4986 proc UIDidntSaveCity
{msg
} {
4987 DoSendMessage
$msg alert
4988 UIMakeSound warning Sorry
"-speed 85"
4992 proc UILoadScenario
{scen
} {
4993 MakeHistory
"DoScenario $scen"
4997 proc DoScenario
{scen
} {
5000 sim LoadScenario
$scen
5005 proc UIDidLoadScenario
{} {
5009 proc UIStartScenario
{id
} {
5018 proc UIPlayNewCity
{} {
5024 proc UIStartLoad
{} {
5029 proc UIReallyStartGame
{} {
5035 proc UIPlayGame
{} {
5042 SetPriority
$Priority
5050 proc UISetSpeed
{speed
} {
5053 if {"$State" == "play"} {
5054 UISetMessage
[lindex {
5057 {Time flows medium.
}
5065 proc UIUpdateRunning
{} {
5066 global HeadWindows Time State
5068 if {($State == "play") && $Time} {
5069 set pict
"@images/micropolisg.xpm"
5071 set pict
"@images/micropoliss.xpm"
5074 foreach win
$HeadWindows {
5075 set can
[WindowLink
$win.demand
]
5076 $can itemconfig micropolis
-bitmap $pict
5081 proc DoSetGameLevel
{level
} {
5082 sim GameLevel
$level
5086 proc UISetGameLevel
{level
} {
5088 set GameLevel
$level
5089 global ScenarioWindows
5090 foreach win
$ScenarioWindows {
5091 UpdateLevelSelection
$win
5096 proc UISetCityName
{name
} {
5097 global EditorWindows
5100 set title
"Micropolis Editor on $name"
5101 foreach win
$EditorWindows {
5102 # TODO: set editor window and icon title
5103 #wm title $win "$title"
5104 #wm iconname $win "$title"
5109 proc UILoadCity
{win
} {
5110 # if changed, r-u-sure?
5112 set file [ShowFileOf
$win]
5113 DoFileDialog
$file "Choose a City to Load" $CityDir "*.cty" "" \
5118 proc UIDoLoadCity
{name path
} {
5121 if {![string match
*.cty
$name]} {
5124 MakeHistory
"DoLoadCity $path/$name"
5128 proc DoLoadCity
{filename} {
5129 sim LoadCity
$filename
5132 proc UIDidLoadCity
{} {
5133 global State GameLevel Scenario
5136 if {$State == "play"} {
5139 UIShowPicture
49 [sim CityFileName
]
5144 proc UIDidntLoadCity
{msg
} {
5145 DoSendMessage
$msg alert
5146 UIMakeSound warning Sorry
"-speed 85"
5147 UIShowPicture
49 [sim CityFileName
]
5166 proc UIDidPan
{w x y
} {
5167 if {[$w ToolMode
] == 1} {
5168 EditorToolDrag
$w $x $y
5174 proc UIDidStopPan
{win
} {
5175 UIMakeSoundOn
$win fancy Skid
"-volume 25"
5180 proc UIEarthQuake
{} {
5184 proc UIAutoGoto
{x y
{except
{}}} {
5185 global EditorWindows
5187 set x
[expr "$x * 16 + 8"]
5188 set y
[expr "$y * 16 + 8"]
5189 foreach win
$EditorWindows {
5190 if {"$win" != "$except"} {
5191 set view
[WindowLink
$win.view
]
5192 if {[$view AutoGoto
]} {
5194 $view AutoGoal
$x $y
5204 proc UIAutoGotoOn
{x y eds
} {
5205 set x
[expr "$x * 16 + 8"]
5206 set y
[expr "$y * 16 + 8"]
5208 [WindowLink
$win.view
] AutoGoal
$x $y
5214 proc DoLeaveGame
{head
} {
5218 proc UILoseGame
{} {
5229 proc DoPendTool
{view tool x y
} {
5230 global HeadWindows ToolInfo VotesForAsk
5232 set win
[WindowLink
$view.top
]
5233 set head
[WindowLink
$win.head
]
5235 if {($tool == [sim PendingTool
]) &&
5236 ($x == [sim PendingX
]) &&
5237 ($y == [sim PendingY
])} {
5238 if {[lsearch $VotesForAsk $head] != -1} {
5239 # you can only vote once
5240 UIMakeSound edit Oop
5242 UIMakeSound edit Boing
5243 set ask
[WindowLink
$head.ask
]
5244 PressVoteButton
$ask [WindowLink
$ask.vote
] Ask
5247 UIAutoGoto
$x $y $win
5249 UIMakeSound edit Boing
5250 set info [lindex $ToolInfo $tool]
5251 set a
[lindex $info 0]
5252 set name
[lindex $info 1]
5253 set cost
[lindex $info 2]
5254 set title
"Build $a $name"
5255 set question
"Do you support the plan to build $a $name for $cost?"
5256 AskQuestion
[Color
$win #00ff00 #ffffff] "$title" \
5258 "{Veto plan.} Plan.Veto
5260 "{Goto plan.} Plan.Goto
5261 {ComeTo %s $x $y}" \
5262 "{Support plan!} Plan.Support
5263 {SupportPlan $view %s $tool $x $y}
5264 {PreviewSupportPlan $view %s $tool $x $y}"
5265 set VotesForAsk
$head
5266 set ask
[WindowLink
$head.ask
]
5267 [WindowLink
$ask.vote
] config
-relief sunken
5271 sim PendingTool
$tool
5274 sim Votes
[llength $VotesForAsk]
5279 proc RejectPlan
{} {
5281 if {[sim Players
] > 1} {
5282 UIMakeSound edit Sorry
5288 proc NeededVotes
{} {
5290 set players
[sim Players
]
5291 set needed
[expr "$players - $FreeVotes"]
5292 return [max
0 $needed]
5296 proc SupportPlan
{view h tool x y
} {
5298 sim Votes
[llength $VotesForAsk]
5301 $view DoTool
$tool $x $y
5304 UIMakeSound edit Aaah
5308 proc PreviewSupportPlan
{view h tool x y
} {
5310 sim Votes
[llength $VotesForAsk]
5314 proc SugarStartUp
{uri
} {
5318 # TODO: Load the city file at the given URI, or configure according to URI parameters.
5322 proc SugarNickName
{nick
} {
5323 global SugarNickName
5324 set SugarNickName
$nick
5328 proc SugarActivate
{} {
5329 global SugarActivated
5330 set SugarActivated
1
5334 proc SugarDeactivate
{} {
5335 global SugarActivated
5336 set SugarActivated
0
5340 proc SugarShare
{} {
5346 proc SugarBuddyAdd
{key nick color address
} {
5348 set buddy
[list $key $nick $color $address]
5349 lappend SugarBuddies
$buddy
5353 proc SugarBuddyDel
{key nick color address
} {
5355 set buddy
[list $key $nick $color $address]
5356 set i
[lsearch $wins $win]
5358 set SugarBuddies
[lreplace $wins $i $i]
5368 ########################################################################