1#!/usr/bin/perl -w 2 3 4$::Cheat = 0; 5$::Version = '1.3'; 6$::DataDir = ''; # Set it to a path to avoid autodetection (e.g. /opt/pangzero/data) 7 8=comment 9 10########################################################################## 11# 12# PANG ZERO 13# Copyright (C) 2006 by UPi <upi at sourceforge.net> 14# 15########################################################################## 16 17This program is free software; you can redistribute it and//or modify 18it under the terms of the GNU General Public License version 2, as 19published by the Free Software Foundation. 20 21This program is distributed in the hope that it will be useful, 22but WITHOUT ANY WARRANTY; without even the implied warranty of 23MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24GNU General Public License for more details. 25 26You should have received a copy of the GNU General Public License 27along with this program; if not, write to the Free Software 28Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 29 30 31########################################################################## 32# TODO: 33########################################################################## 34* P4 Bonus probability is balldesc based. 35* P3 Tour mode..? 36* P5 Graphics and help for machine gun and power wire 37* P5 Demo of beating the game at 'normal' difficulty 38* P4 Even more forgiving collision detection (?) 39* P4 Smooth numbers in the scoreboard 40* P3 RotoZoomer smooth parameter to eliminate warning.. 41* P3 Set DataDir with command line parameter. 42* P2 Roll your own game 43* P4 Reorg menu: MenuItem->Update(), MenuItem->Left(), MenuItem->Right(), ... 44 45Next release: 46* Sound effect for matrix effect... 47* Handle possible HST corruption if game exits while merging scores 48 49 50########################################################################## 51# QUICK GUIDE FOR WOULD-BE DEVELOPERS 52########################################################################## 53 54' 55This file contains the entire source code of Pang Zero. I know that this is 56an odd design, but it works for me. You can split the file easily if you 57want to. 58 59The parts of the file are organized like this: 60 611. INITIALIZATION OF GLOBAL OBJECTS (configuration, balls, levels, etc) 622. HIGH SCORE TABLE 633. GAME OBJECT PACKAGES 644. UTILITY PACKAGES AND METHODS 655. GAMEBASE AND DESCENDENT PACKAGES (includes the menu) 666. "MAIN" PROGRAM LOOP 67' 68=cut 69 70 71use strict; 72use SDL; 73use SDL::App; 74use SDL::Event; 75use SDL::Surface; 76use SDL::Timer; 77use SDL::Palette; 78use SDL::Sound; 79use SDL::Mixer; 80use SDL::Font; 81use Carp; 82 83 84# SDL objects 85 86use vars qw ( 87 $App $RotoZoomer $Background $ScoreFont $MenuFont $GlossyFont 88 %BallSurfaces 89 $BorderSurface $WhiteBorderSurface $RedBorderSurface $BonusSurface $LevelIndicatorSurface $LevelIndicatorSurface2 90 $WhiteHarpoonSurface 91 %Sounds $Mixer 92); 93 94# Pang Zero variables and objects 95 96use vars qw ( 97 $DataDir $ScreenHeight $ScreenWidth $PhysicalScreenWidth $PhysicalScreenHeight $ScreenMargin 98 $SoundEnabled $MusicEnabled $FullScreen $ShowWebsite 99 $DeathBallsEnabled $EarthquakeBallsEnabled $WaterBallsEnabled $SeekerBallsEnabled $Slippery 100 @DifficultyLevels $DifficultyLevelIndex $DifficultyLevel 101 @WeaponDurations $WeaponDuration $WeaponDurationIndex 102 @GameObjects %GameEvents $GameSpeed $GamePause $Game 103 @Players @GuyImageFiles @GuyColors $NumGuys 104 @BallDesc %BallDesc @ChallengeLevels @PanicLevels 105 $UnicodeMode $LastUnicodeKey %Keys %Events %MenuEvents ); 106 107########################################################################## 108# GLOBAL CONFIGURATION 109########################################################################## 110 111%Sounds = ( 112 'pop' => 'pop.voc', 113 'shoot' => 'shoot.voc', 114 'death' => 'meow.voc', 115 'level' => 'level.voc', 116 'bonuslife' => 'magic.voc', 117 'pause' => 'pop3.voc', 118 'quake' => 'quake.voc', 119); 120 121@DifficultyLevels = ( 122 { 'name' => 'Easy', 'spawnmultiplier' => 1.2, 'speed' => 0.8, 'harpoons' => 5, 'superball' => 0.8, 'bonusprobability' => 0.2, }, 123 { 'name' => 'Normal', 'spawnmultiplier' => 1.0, 'speed' => 1.0, 'harpoons' => 3, 'superball' => 1.0, 'bonusprobability' => 0.1, }, 124 { 'name' => 'Hard', 'spawnmultiplier' => 0.9, 'speed' => 1.2, 'harpoons' => 2, 'superball' => 1.1, 'bonusprobability' => 0.05, }, 125 { 'name' => 'Nightmare','spawnmultiplier' => 0.8, 'speed' => 1.4, 'harpoons' => 2, 'superball' => 1.5, 'bonusprobability' => 0.02, }, 126 { 'name' => 'Miki', 'spawnmultiplier' => 0.4, 'speed' => 1.0, 'harpoons' => 3, 'superball' => 1.0, 'bonusprobability' => 0.1, }, 127); 128&SetDifficultyLevel(1); 129@WeaponDurations = ( 130 { 'name' => 'Short (Default)', 'durationmultiplier' => 1, }, 131 { 'name' => 'Medium', 'durationmultiplier' => 3, }, 132 { 'name' => 'Long', 'durationmultiplier' => 6, }, 133 { 'name' => 'Very Long', 'durationmultiplier' => 12, }, 134 { 'name' => 'Forever', 'durationmultiplier' => 10000, }, 135); 136&SetWeaponDuration(0); 137 138$NumGuys = 1; 139@Players = ( 140 { 'keys' => [SDLK_LEFT, SDLK_RIGHT, SDLK_UP], }, # blue 141 { 'keys' => [SDLK_a, SDLK_d, SDLK_s], }, # red 142 { 'keys' => [SDLK_j, SDLK_l, SDLK_k], }, # green 143 { 'keys' => [SDLK_KP6, SDLK_KP4, SDLK_KP5], }, # pink 144 { 'keys' => [SDLK_KP6, SDLK_KP4, SDLK_KP5], }, # yellow 145 { 'keys' => [SDLK_KP6, SDLK_KP4, SDLK_KP5], }, # cyan 146 { 'keys' => [SDLK_KP6, SDLK_KP4, SDLK_KP5], }, # gray 147 { 'keys' => [SDLK_KP6, SDLK_KP4, SDLK_KP5], }, # snot 148 { 'keys' => [SDLK_KP6, SDLK_KP4, SDLK_KP5], }, # purple 149); 150@GuyImageFiles = ( 'guyChristmas.png', 'guy_danigm.png', 'guy_pix.png', 'guy_pux.png', 'guy_r2.png', 'guy_sonic.png' ); 151@GuyColors = ( [170, 255, 'blue'], [0, 255, 'red'], [85, 255, 'green'], [212, 255, 'pink'], 152 [42, 255, 'yellow'], [128, 255, 'cyan'], [128, 0, 'gray'], [113, 128, 'snot'], [212, 64, 'purple'] ); 153for (my $i=0; $i<=$#Players; ++$i) { 154 $Players[$i]->{number} = $i; 155 $Players[$i]->{colorindex} = $i; 156 $Players[$i]->{imagefileindex} = $i % scalar(@GuyImageFiles); 157} 158 159my (%n0, %n1, %n2, %n3, %n4); 160%n0 = ('popIndex' => 0, 'rect' => new SDL::Rect(-x => 0, -y => 0, -width => 128, -height => 106)); 161%n1 = ('popIndex' => 1, 'rect' => new SDL::Rect(-x => 0, -y => 0, -width => 96, -height => 80)); 162%n2 = ('popIndex' => 2, 'rect' => new SDL::Rect(-x => 0, -y => 0, -width => 64, -height => 53)); 163%n3 = ('popIndex' => 3, 'rect' => new SDL::Rect(-x => 0, -y => 0, -width => 32, -height => 28)); 164%n4 = ('popIndex' => 4, 'rect' => new SDL::Rect(-x => 0, -y => 0, -width => 16, -height => 15)); 165 166@BallDesc = ( 167# Normal balls (n0 .. n4) 168 { 'name' => 'n0', 'class' => 'Ball', 'score' => 2000, 'spawndelay' => 1, 'speedY' => 6.5, %n0, 'surface' => 'ball0', 'nextgen' => 'n1', }, 169 { 'name' => 'n1', 'class' => 'Ball', 'score' => 1000, 'spawndelay' => 0.5, 'speedY' => 5.7, %n1, 'surface' => 'ball1', 'nextgen' => 'n2', }, 170 { 'name' => 'n2', 'class' => 'Ball', 'score' => 800, 'spawndelay' => 0.25, 'speedY' => 5, %n2, 'surface' => 'ball2', 'nextgen' => 'n3', }, 171 { 'name' => 'n3', 'class' => 'Ball', 'score' => 600, 'spawndelay' => 0.12, 'speedY' => 4, %n3, 'surface' => 'ball3', 'nextgen' => 'n4', }, 172 { 'name' => 'n4', 'class' => 'Ball', 'score' => 500, 'spawndelay' => 0.05, 'speedY' => 3, %n4, 'surface' => 'ball4', }, 173# "Bouncy" balls (b0..b2) 174 { 'name' => 'b0', 'class' => 'Ball', 'score' => 1500, 'spawndelay' => 0.5, 'speedY' => 5.7, %n2, 'surface' => 'bouncy2', 'nextgen' => 'b1', }, 175 { 'name' => 'b1', 'class' => 'Ball', 'score' => 750, 'spawndelay' => 0.2, 'speedY' => 5, %n3, 'surface' => 'bouncy3', 'nextgen' => 'b2', }, 176 { 'name' => 'b2', 'class' => 'Ball', 'score' => 500, 'spawndelay' => 0.1, 'speedY' => 4.2, %n4, 'surface' => 'bouncy4' }, 177# Hexas (h0..h2) 178 { 'name' => 'h0', 'class' => 'Hexa', 'score' => 1500, 'spawndelay' => 0.5, 'popIndex' => 5, 'hexa' => 1, 179 'surface' => 'hexa0', 'rect' => new SDL::Rect(-x => 0, -y => 0, -width => 64, -height => 52), 'nextgen' => 'h1', }, 180 { 'name' => 'h1', 'class' => 'Hexa', 'score' => 1000, 'spawndelay' => 0.2, 'popIndex' => 6, 'hexa' => 1, 181 'surface' => 'hexa1', 'rect' => new SDL::Rect(-x => 0, -y => 0, -width => 32, -height => 28), 'nextgen' => 'h2', }, 182 { 'name' => 'h2', 'class' => 'Hexa', 'score' => 500, 'spawndelay' => 0.1, 'popIndex' => 7, 'hexa' => 1, 183 'surface' => 'hexa2', 'rect' => new SDL::Rect(-x => 0, -y => 0, -width => 16, -height => 14), 184 'magicrect' => new SDL::Rect(-x => 48, -y => 0, -width => 16, -height => 14), }, 185# Water ball 186 { 'name' => 'w1', 'class' => 'WaterBall', 'score' => 1500, 'spawndelay' => 0.4, 'speedY' => 5.7, %n1, 'surface' => 'blue1', 'nextgen' => 'w2', }, 187 { 'name' => 'w2', 'class' => 'WaterBall', 'score' => 1000, 'spawndelay' => 0.2, 'speedY' => 5, %n2, 'surface' => 'blue2', 'nextgen' => 'w3', }, 188 { 'name' => 'w3', 'class' => 'WaterBall', 'score' => 800, 'spawndelay' => 0.1, 'speedY' => 4, %n3, 'surface' => 'blue3', 'nextgen' => 'w4', }, 189 { 'name' => 'w4', 'class' => 'WaterBall', 'score' => 600, 'spawndelay' => 0.05, 'speedY' => 3, %n4, 'surface' => 'blue4', }, 190# Fragile 191 { 'name' => 'f0', 'class' => 'FragileBall', 'score' => 1500, 'spawndelay' => 0.8, 'speedY' => 6.5, %n0, 'surface' => 'frag0', 'nextgen' => 'f1', }, 192 { 'name' => 'f1', 'class' => 'FragileBall', 'score' => 1500, 'spawndelay' => 0.4, 'speedY' => 5.7, %n1, 'surface' => 'frag1', 'nextgen' => 'f2', }, 193 { 'name' => 'f2', 'class' => 'FragileBall', 'score' => 1000, 'spawndelay' => 0.2, 'speedY' => 5, %n2, 'surface' => 'frag2', 'nextgen' => 'f3', }, 194 { 'name' => 'f3', 'class' => 'FragileBall', 'score' => 800, 'spawndelay' => 0.1, 'speedY' => 4, %n3, 'surface' => 'frag3', 'nextgen' => 'f4', }, 195 { 'name' => 'f4', 'class' => 'FragileBall', 'score' => 600, 'spawndelay' => 0.05, 'speedY' => 3, %n4, 'surface' => 'frag4', }, 196# Superball 197 { 'name' => 'super0', 'class' => 'SuperBall', 'score' => 1000, 'spawndelay' => 0.5, 'speedY' => 5.7, %n1, 'surface' => 'green1', }, 198 { 'name' => 'super1', 'class' => 'SuperBall', 'score' => 800, 'spawndelay' => 0.25, 'speedY' => 5, %n2, 'surface' => 'green2', }, 199 { 'name' => 'xmas', 'class' => 'XmasBall', 'score' => 1000, 'spawndelay' => 0.5, 'speedY' => 6.5, %n0, 'surface' => 'xmas', }, 200# Death 201 { 'name' => 'death', 'class' => 'DeathBall', 'score' => 0, 'spawndelay' => 0.5, 'speedY' => 5, %n2, 'surface' => 'death2', 'nextgen' => 'death', }, 202# Seeker 203 { 'name' => 'seeker', 'class' => 'SeekerBall', 'score' => 1200, 'spawndelay' => 0.2, 'speedY' => 5.7, %n2, 'surface' => 'white2', 'nextgen' => 'seeker1', }, 204 { 'name' => 'seeker1', 'class' => 'SeekerBall', 'score' => 1200, 'spawndelay' => 0.1, 'speedY' => 5, %n3, 'surface' => 'white3', }, 205# Quake 206 { 'name' => 'quake', 'class' => 'EarthquakeBall', 'score' => 1600, 'spawndelay' => 0.7, 'speedY' => 5.7, %n2, 'surface' => 'quake2', 207 'quake' => 5, 'nextgen' => 'quake1', }, 208 { 'name' => 'quake1', 'class' => 'EarthquakeBall', 'score' => 1200, 'spawndelay' => 0.2, 'speedY' => 5, %n3, 'surface' => 'quake3', 209 'quake' => 3, 'nextgen' => 'quake2', }, 210 { 'name' => 'quake2', 'class' => 'EarthquakeBall', 'score' => 1000, 'spawndelay' => 0.1, 'speedY' => 4.2, %n4, 'surface' => 'quake4', 211 'quake' => 2, }, 212# Upside down ball 213 { 'name' => 'u0', 'class' => 'UpsideDownBall', 'score' => 2000, 'spawndelay' => 1, 'speedY' => 5.8, %n0, 'surface' => 'upside0', 'nextgen' => 'u1', }, 214 { 'name' => 'u1', 'class' => 'UpsideDownBall', 'score' => 1000, 'spawndelay' => 0.5, 'speedY' => 5.8, %n1, 'surface' => 'upside1', 'nextgen' => 'u2', }, 215 { 'name' => 'u2', 'class' => 'UpsideDownBall', 'score' => 800, 'spawndelay' => 0.25, 'speedY' =>5.8, %n2, 'surface' => 'upside2', 'nextgen' => 'u3', }, 216 { 'name' => 'u3', 'class' => 'UpsideDownBall', 'score' => 600, 'spawndelay' => 0.12, 'speedY' =>5.9, %n3, 'surface' => 'upside3', 'nextgen' => 'u4', }, 217 { 'name' => 'u4', 'class' => 'UpsideDownBall', 'score' => 500, 'spawndelay' => 0.05, 'speedY' =>5.9, %n4, 'surface' => 'upside4', }, 218 219 { 'name' => 'credits1', 'class' => 'Ball', 'speedY' => 6.1, 'nextgen' => 'credits1', 'surface' => 'blue3', %n3 }, 220 { 'name' => 'credits2', 'class' => 'Ball', 'speedY' => 6.1, 'nextgen' => 'credits2', 'surface' => 'ball3', %n3 }, 221); 222{ 223 foreach my $ballDesc (@BallDesc) { 224 $ballDesc->{width} = $ballDesc->{rect}->width(); 225 $ballDesc->{height} = $ballDesc->{rect}->height(); 226 $BallDesc{$ballDesc->{name}} = $ballDesc; 227 } 228 foreach my $ballDesc (@BallDesc) { 229 my $nextgen = $ballDesc->{nextgen}; 230 $ballDesc->{nextgen} = $BallDesc{$nextgen} if $nextgen; 231 } 232} 233 234@ChallengeLevels = ( 235 'n4 n4 n4 n4 xmas', 236 'n3 n3 n3', 237 'n2 n2', 238 'b0 b0', 239 'h2 h2 h2 h2 h2 h2', 240 'h0 h0', 241 'n1 f2', 242 'w1 n2', 243 'n0 b0 w1 h0', 244# 10 245 'n1 quake', 246 'n1 b0 quake', 247 'w1 seeker u2', 248 'n0 seeker seeker', 249 'w1 w1', 250 'f1 quake h0', 251 'w1 seeker h0 h0', 252 'n0 w1 w1 b0 h0', 253 'u0 u0 quake', 254 'quake quake w1 b0 h0', 255# 20 256 'death n1 b0', 257 'n4 ' x 24, 258 'w1 w1 w1 f0', 259 'death w1 h0', 260 'n0 n0 u0 seeker h2 h2 b0', 261 'n4 b2 h2 u4 ' x 6, 262 'quake quake quake b0', 263 'h0 h0 h0 h0 h0 h0 h0 h0', 264 'quake seeker f3 n1 b0 b0', 265 'death death w1 f0 n0 u2 h0', 266# 30 267 'n0 n0 u0 u0', 268 'death quake n1', 269 'b0 h0 n2 ' x 3, 270 'w1 w1 w1 w1 f1 f1', 271 'n3 n3 n3 u3 ' x 4, 272 'quake quake seeker seeker n0 f0', 273 'seeker ' x 8, 274 'n0 n1 n2 n3 n4 b0 f2 h0 h1 h2 w1 seeker', 275 'quake quake quake h0 h0 h0 u2', 276 'death quake seeker w1 n0 b0 h0', 277# 40 278 'n0 n1 n2 ' x 3, 279 'death quake seeker u2 ' x 3, 280 'f0 f0', 281 'death quake f0 n1 ' x 2, 282 'h0 ' x 8 . ' f0 f1 ', 283 'death ' x 10, 284 'quake b0 ' x 5, 285 'w1 w1 f0 f1 death', 286 'seeker ' x 13, 287 'n0 u0 w1 f0 quake death ' x 2, 288); 289 290for ( my $i = 0; $i < 10; ++$i) { 291 $ChallengeLevels[$i + 49] = $ChallengeLevels[$i + 9] . ' ' . $ChallengeLevels[$i + 29]; 292 $ChallengeLevels[$i + 59] = $ChallengeLevels[$i + 19] . ' ' . $ChallengeLevels[$i + 39]; 293} 294foreach (@ChallengeLevels) { 295 while (/(\w+)/g) { 296 die "Unknown ball '$1' in challenge '$_'" unless defined $BallDesc{$1}; 297 } 298} 299 300my %BallMixes = ( 301 'easy' => [ qw(n0 2 n1 20 n2 10 n3 3 n4 2 f0 3 f1 5 f2 5 b0 5 b1 2 b2 1 w1 10 h0 5 h1 3 h2 1 quake 1 seeker 2 u1 1 u2 2 u3 4 u4 1) ], 302 'medium' => [ qw(n0 10 n1 20 n2 10 n3 3 n4 2 f0 3 f1 3 b0 10 b1 2 b2 1 w1 15 h0 15 h1 5 h2 1 death 2 quake 5 seeker 10 u0 2 u1 5 u2 5 u3 5) ], 303 'bouncy' => [ qw(n0 20 n1 10 n2 5 n3 1 n4 1 f0 3 f1 3 b0 30 b1 9 b2 1 w1 10 h0 15 h1 5 death 5 quake 10 seeker 15 u0 5 u1 5 u2 1 u3 1) ], 304 'hard' => [ qw(n0 20 n1 10 n2 5 n3 1 f0 5 f1 1 b0 20 b1 2 w1 20 h0 20 h1 5 death 10 quake 15 seeker 20 u0 5 u1 5 u2 1 u3 1) ], 305 'watery' => [ qw(n0 20 n1 10 n2 5 n3 1 n4 1 f0 3 f1 1 b0 10 b1 5 w1 50 h0 15 h1 5 death 5 quake 10 seeker 15 u0 1 u1 5 u2 5 u3 1) ], 306 'hexas' => [ qw(n0 20 n1 10 n2 5 n3 1 f0 3 f1 1 b0 15 b1 2 w1 20 h0 40 h1 15 death 5 quake 10 seeker 15 u0 1 u1 8 u2 2 u3 1) ], 307 'quakes' => [ qw(n0 15 n1 10 n2 5 n3 1 f0 3 f1 1 b0 15 w1 15 h0 20 h1 5 death 5 quake 40 seeker 15 u0 8 u1 1 u2 2 u3 1) ], 308); 309 310sub AddLevels { 311 my ($num, $balls, $gamespeedStart, $gamespeedEnd, $spawndelayStart, $spawndelayEnd) = @_; 312 my ($i, $level); 313 314 for ($i = 0; $i < $num; ++$i) { 315 $level = { 316 'balls' => $balls, 317 'gamespeed' => $gamespeedStart + ($gamespeedEnd - $gamespeedStart) * ($i) / ($num), 318 'spawndelay' => $spawndelayStart + ($spawndelayEnd - $spawndelayStart) * ($i) / ($num), 319 }; 320 push @PanicLevels, ( $level ); 321 } 322} 323 324&AddLevels( 9, $BallMixes{easy}, 0.75, 1.25, 20, 20 ); # 0-9 325&AddLevels( 10, $BallMixes{medium}, 0.7 , 1.3 , 20, 15 ); # 1x 326&AddLevels( 10, $BallMixes{hard}, 0.7 , 1.5 , 15, 15 ); # 2x 327&AddLevels( 10, $BallMixes{hexas}, 1.0 , 1.5 , 15, 12 ); # 3x 328&AddLevels( 10, $BallMixes{watery}, 0.7 , 1.7 , 15, 17 ); # 4x 329&AddLevels( 10, $BallMixes{bouncy}, 1.0 , 2.0 , 12, 12 ); # 5x 330&AddLevels( 10, $BallMixes{quakes}, 1.5 , 2.2 , 13, 8 ); # 6x 331&AddLevels( 10, $BallMixes{hard}, 1.0 , 2.2 , 13, 10 ); # 7x 332&AddLevels( 10, $BallMixes{hexas}, 1.3 , 2.4 , 12, 9 ); # 8x 333&AddLevels( 10, $BallMixes{hard}, 2.0 , 3.0 , 13, 10 ); # 9x 334 335# Set defaults 336 337$ScreenMargin = 16; 338$ScreenWidth = 800 - $ScreenMargin * 2; 339$ScreenHeight = 416; 340$SoundEnabled = 1; 341$MusicEnabled = 1; 342$DeathBallsEnabled = 1; 343$EarthquakeBallsEnabled = 1; 344$WaterBallsEnabled = 1; 345$SeekerBallsEnabled = 1; 346$FullScreen = 1; 347$UnicodeMode = 0; 348$Slippery = 0; 349$ShowWebsite = 0; 350 351 352########################################################################## 353# CONFIG SAVE/LOAD 354########################################################################## 355 356sub IsMicrosoftWindows { 357 return $^O eq 'MSWin32'; 358} 359 360 361sub TestDataDir { 362 return -f "$DataDir/glossyfont.png"; # Should be a file from the latest version. 363} 364 365sub FindDataDir { 366 return if $DataDir and &TestDataDir(); 367 my @guesses = qw( . .. /usr/share/pangzero /usr/share/games/pangzero /usr/local/share/pangzero /opt/pangzero/ /opt/pangzero); 368 foreach my $guess (@guesses) { 369 $DataDir = $guess; 370 return if &TestDataDir(); 371 $DataDir = "$guess/data"; 372 return if &TestDataDir(); 373 } 374 die "Couldn't find the data directory. Please set it manually."; 375} 376 377sub GetConfigFilename { 378 if ( &IsMicrosoftWindows() ) { 379 if ($ENV{USERPROFILE}) { 380 return "$ENV{USERPROFILE}\\pangzero.cfg"; 381 } 382 return "$DataDir/pangzero.cfg"; 383 } 384 if ($ENV{HOME}) { 385 return "$ENV{HOME}/.pangzerorc"; 386 } 387 if (-w $DataDir) { 388 return "$DataDir/pangzero.cfg"; 389 } 390 return "/tmp/pangzero.cfg"; 391} 392 393sub GetConfigVars { 394 my ($i, $j); 395 my @result = qw(NumGuys DifficultyLevelIndex WeaponDurationIndex Slippery MusicEnabled SoundEnabled FullScreen ShowWebsite 396 DeathBallsEnabled EarthquakeBallsEnabled WaterBallsEnabled SeekerBallsEnabled); 397 for ($i=0; $i < scalar @Players; ++$i) { 398 for ($j=0; $j < 3; ++$j) { 399 push @result, ("Players[$i]->{keys}->[$j]"); 400 } 401 push @result, ("Players[$i]->{colorindex}"); 402 push @result, ("Players[$i]->{imagefileindex}"); 403 } 404 my ($difficulty, $gameMode); 405 for ($difficulty=0; $difficulty < scalar @DifficultyLevels; ++$difficulty) { 406 foreach $gameMode ('highScoreTablePan', 'highLevelTablePan', 'highScoreTableCha', 'highLevelTableCha') { 407 next if ($DifficultyLevels[$difficulty]->{name} eq 'Miki' and $gameMode eq 'highScoreTableCha'); 408 for ($i=0; $i < 5; ++$i) { 409 push @result, "DifficultyLevels[$difficulty]->{$gameMode}->[$i]->[0]", # Name of high score 410 "DifficultyLevels[$difficulty]->{$gameMode}->[$i]->[1]", # High score 411 } 412 } 413 } 414 return @result; 415} 416 417sub SaveConfig { 418 my ($filename, $varname, $value); 419 $filename = &GetConfigFilename(); 420 421 open CONFIG, "> $filename" or return; 422 foreach $varname (&GetConfigVars) { 423 eval("\$value = \$$varname"); die $@ if $@; 424 print CONFIG "$varname = $value\n"; 425 } 426 close CONFIG; 427} 428 429sub LoadConfig { 430 my ($filename, $text, $varname); 431 432 $text = ''; 433 $filename = &GetConfigFilename(); 434 if (open CONFIG, "$filename") { 435 read CONFIG, $text, 16384; 436 close CONFIG; 437 } 438 439 foreach $varname (&GetConfigVars) { 440 my $pattern = $varname; 441 $pattern =~ s/\[/\\[/g; 442 if ($text =~ /$pattern = (.+?)$/m) { 443 eval( "\$$varname = '$1'" ); 444 } 445 } 446 &SetDifficultyLevel($DifficultyLevelIndex); 447 &SetWeaponDuration($WeaponDurationIndex); 448} 449 450sub SetDifficultyLevel { 451 my $difficultyLevelIndex = shift; 452 if ($difficultyLevelIndex < 0 or $difficultyLevelIndex > $#DifficultyLevels) { 453 $difficultyLevelIndex = $DifficultyLevelIndex; 454 } 455 $DifficultyLevelIndex = $difficultyLevelIndex; 456 $DifficultyLevel = $DifficultyLevels[$difficultyLevelIndex]; 457} 458 459sub SetWeaponDuration { 460 my $weaponDurationIndex = shift; 461 if ($weaponDurationIndex < 0 or $weaponDurationIndex > $#WeaponDurations) { 462 $weaponDurationIndex = $WeaponDurationIndex; 463 } 464 $WeaponDurationIndex = $weaponDurationIndex; 465 $WeaponDuration = $WeaponDurations[$WeaponDurationIndex]; 466} 467 468 469########################################################################## 470# HIGH SCORE TABLE 471########################################################################## 472 473use vars qw( @UnsavedHighScores ); 474 475foreach (@DifficultyLevels) { 476 $_->{highScoreTablePan} = [ ['UPI', 250000], ['UPI', 200000], ['UPI', 150000], ['UPI', 100000], ['UPI', 50000] ]; 477 $_->{highScoreTablePan} = [ ['UPI', 2500], ['UPI', 2000], ['UPI', 1500], ['UPI', 1000], ['UPI', 500] ] if $_->{name} eq 'Miki'; 478 $_->{highLevelTablePan} = [ ['UPI', 50], ['UPI', 40], ['UPI', 30], ['UPI', 20], ['UPI', 10] ]; 479 $_->{highLevelTablePan} = [ ['UPI', 20], ['UPI', 16], ['UPI', 12], ['UPI', 8], ['UPI', 4] ] if $_->{name} eq 'Miki'; 480 $_->{highScoreTableCha} = [ ['UPI', 250000], ['UPI', 200000], ['UPI', 150000], ['UPI', 100000], ['UPI', 50000] ]; 481 $_->{highLevelTableCha} = [ ['UPI', 30], ['UPI', 25], ['UPI', 20], ['UPI', 15], ['UPI', 10] ]; 482} 483 484sub AddHighScore { 485 my ($player, $score, $level) = @_; 486 487 unshift @UnsavedHighScores, [$player, $score, $level]; 488} 489 490sub MergeUnsavedHighScores { 491 my ($table) = @_; 492 my ($unsavedHighScore, $player, $score, $level); 493 494 die unless ($table =~ /^(Cha|Pan)$/); 495 foreach $unsavedHighScore (@UnsavedHighScores) { 496 ($player, $score, $level) = @{$unsavedHighScore}; 497 &MergeUnsavedHighScore( $DifficultyLevel->{"highScoreTable$table"}, $player, $score ); 498 &MergeUnsavedHighScore( $DifficultyLevel->{"highLevelTable$table"}, $player, $level ); 499 } 500 501 splice @{$DifficultyLevel->{"highScoreTable$table"}}, 5; 502 splice @{$DifficultyLevel->{"highLevelTable$table"}}, 5; 503 @UnsavedHighScores = (); 504 my $newHighScore = &InputPlayerNames($table); 505 if ($newHighScore) { 506 $Game->RunHighScore( $DifficultyLevelIndex, $table, 0 ); 507 } 508} 509 510sub MergeUnsavedHighScore { 511 my ($highScoreList, $player, $score) = @_; 512 my ($i); 513 514 for ($i = 0; $i < scalar @{$highScoreList}; ++$i) { 515 if ($highScoreList->[$i]->[1] < $score) { 516 splice @{$highScoreList}, $i, 0, [$player, $score]; 517 return; 518 } 519 } 520} 521 522sub InputPlayerNames { 523 my ($table) = @_; 524 my ($highScoreEntry, $player, $score, $message, $retval); 525 526 die unless ($table =~ /^(Cha|Pan)$/); 527 $retval = 0; 528 foreach $highScoreEntry (@{$DifficultyLevel->{"highScoreTable$table"}}, @{$DifficultyLevel->{"highLevelTable$table"}}) { 529 $player = $highScoreEntry->[0]; 530 next unless ref $player; 531 unless ($player->{highScoreName}) { 532 $score = $highScoreEntry->[1]; 533 $message = $score < 1000 ? "Level $score" : "Score $score"; 534 $player->{highScoreName} = &InputPlayerName($player, $message); 535 } 536 $highScoreEntry->[0] = $player->{highScoreName}; 537 $retval = 1; 538 } 539 foreach $player (@Players) { 540 delete $player->{highScoreName}; 541 } 542 return $retval; 543} 544 545sub InputPlayerName { 546 my ($player, $message) = @_; 547 my ($guy, $name, $nameMenuItem, @menuItems, $x, $y, $yInc); 548 549 SDL::EnableUnicode(1); $UnicodeMode = 1; 550 $name = ($player->{name} or '') . '|'; 551 552 $guy = new Guy($player); 553 ($guy->{x}, $guy->{y}) = (150, 150); 554 $guy->DemoMode(); 555 556 ($x, $y, $yInc) = (230, 80, 45); 557 push @menuItems, ( 558 new MenuItem( $x, $y += $yInc, "HIGH SCORE!!!"), 559 new MenuItem( $x, $y += $yInc, $message), 560 new MenuItem( $x, $y += $yInc, "Please enter your name:"), 561 $nameMenuItem = new MenuItem( $x, $y += $yInc, $name ), 562 ); 563 push @GameObjects, ($guy, @menuItems); 564 565 while (1) { 566 $LastUnicodeKey = 0; 567 $Game->MenuAdvance(); 568 last if $Game->{abortgame}; 569 if (%Events) { 570 my ($key) = %Events; 571 if ($key == SDLK_BACKSPACE) { 572 substr($name, -2, 1, ''); # Remove next to last char 573 $nameMenuItem->SetText($name); 574 } elsif ($key == SDLK_RETURN) { 575 last; 576 } elsif ($LastUnicodeKey < 127 and $LastUnicodeKey >= 32 and length($name) < 9) { 577 substr($name, -1, 0, chr($LastUnicodeKey)); # Insert before last char 578 $nameMenuItem->SetText($name); 579 } 580 } 581 } 582 $name =~ s/\|$//; 583 $player->{name} = $name; 584 $name = "Anonymous" if $name =~ /^\s*$/; 585 $guy->Delete(); 586 foreach (@menuItems) { $_->Delete(); } 587 SDL::EnableUnicode(0); $UnicodeMode = 0; 588 return $name; 589} 590 591 592########################################################################## 593# GAME OBJECT CLASSES 594########################################################################## 595 596package GameObject; 597package Ball; 598package Hexa; 599package SuperBall; 600package DeathBall; 601package SeekerBall; 602package EarthquakeBall; 603package WaterBall; 604package Pop; 605package GamePause; 606package BonusDrop; 607package SlowEffect; 608package Guy; 609package Harpoon; 610package MachineGun; 611package PowerWire; 612package HalfCutter; 613package DeadGuy; 614 615 616########################################################################## 617package GameObject; 618########################################################################## 619 620sub new { 621 my ($class) = @_; 622 my $self = { 623 'rect' => new SDL::Rect( -x => 0, -y => 0, -width => 0, -height => 0 ), 624 'speedX' => 0, 625 'speedY' => 0, 626 'x' => 0, 627 'y' => 0, 628 'w' => 10, 629 'h' => 10, 630 }; 631 bless $self, $class; 632} 633 634sub Delete { 635 my $self = shift; 636 my ($i); 637 638 for ($i = 0; $i < scalar @::GameObjects; ++$i) { 639 if ($::GameObjects[$i] eq $self) { 640 splice @::GameObjects, $i, 1; 641 last; 642 } 643 } 644 $self->{deleted} = 1; 645 $self->Clear(); 646} 647 648sub Advance { 649 my $self = shift; 650 651 $self->{advance}->($self) if $self->{advance}; 652} 653 654sub Clear { 655 my ($self) = @_; 656 $::Background->blit($self->{rect}, $::App, $self->{rect}); 657} 658 659sub TransferRect { 660 my ($self) = @_; 661 662 $self->{rect}->x($self->{x} + $::ScreenMargin); 663 $self->{rect}->y($self->{y} + $::ScreenMargin); 664 $self->{rect}->width($self->{w}); 665 $self->{rect}->height($self->{h}); 666} 667 668sub Draw { 669 my ($self) = @_; 670 671 $self->TransferRect(); 672 if ($self->{draw}) { 673 $self->{draw}->($self); 674 } else { 675 $::App->fill( $self->{rect}, new SDL::Color(-r => 0x80) ); 676 } 677} 678 679sub SetupCollisions { 680 my ($self) = @_; 681 682 $self->{collisionw} = ($self->{collisionw} or $self->{w}); 683 $self->{collisionh} = ($self->{collisionh} or $self->{h}); 684 $self->{collisionmarginw1} = ( $self->{w} - $self->{collisionw} ) / 2; 685 $self->{collisionmarginw2} = $self->{collisionmarginw1} + $self->{collisionw}; 686 $self->{collisionmarginh1} = ( $self->{h} - $self->{collisionh} ) / 2; 687 $self->{collisionmarginh2} = $self->{collisionmarginh1} + $self->{collisionh}; 688 $self->{centerx} = $self->{w} / 2; 689 $self->{centery} = $self->{y} / 2; 690} 691 692sub Collisions { 693 my ($self, $other) = @_; 694 695 # Bounding box detection 696 697 unless ($self->{collisionmarginw1} and $other->{collisionmarginw1}) { 698 return 0 if $self->{x} >= $other->{x} + $other->{w}; 699 return 0 if $other->{x} >= $self->{x} + $self->{w}; 700 return 0 if $self->{y} >= $other->{y} + $other->{h}; 701 return 0 if $other->{y} >= $self->{y} + $self->{h}; 702 return 1; 703 } 704 705 return 0 if $self->{x} + $self->{collisionmarginw1} >= $other->{x} + $other->{collisionmarginw2}; 706 return 0 if $other->{x} + $other->{collisionmarginw1} >= $self->{x} + $self->{collisionmarginw2}; 707 return 0 if $self->{y} + $self->{collisionmarginh1} >= $other->{y} + $other->{collisionmarginh2}; 708 return 0 if $other->{y} + $other->{collisionmarginh1} >= $self->{y} + $self->{collisionmarginh2}; 709 return 1; 710} 711 712########################################################################## 713package Ball; 714########################################################################## 715 716@Ball::ISA = qw(GameObject); 717$Ball::Gravity = 0.05; 718$Ball::MagicBallRect = new SDL::Rect(-x => 80, -y => 0, -width => 16, -height => 15); 719 720for (my $i=0; $i <= $#::BallDesc; ++$i) { 721 my $desc = $::BallDesc[$i]; 722 $desc->{speedY} = 0 unless $desc->{speedY}; 723 $desc->{bounceY} = $desc->{speedY} * $desc->{speedY} / $Ball::Gravity / 2 unless $desc->{bounceY}; 724} 725 726sub Create { 727 my ($description, $x, $y, $dir) = @_; 728 my ($retval); 729 730 eval("\$retval = new $description->{class}(\@_);"); die $@ if $@; 731 return $retval; 732} 733 734sub Spawn { 735 my ($description, $x, $dir, $hasBonus) = @_; 736 my ($retval); 737 738 $x = $::Game->Rand( $::ScreenWidth - $description->{width} ) if $x < 0; 739 $retval = &Create( $description, $x, -$description->{height} - $::ScreenMargin, $dir ); 740 $retval->GiveMagic() if $retval->{w} > 32; 741 $retval->GiveBonus() if $hasBonus; 742 743 $retval->{spawning} = 1; 744 my $surfaceName = 'dark' . $description->{surface}; 745 $retval->{surface} = $::BallSurfaces{$surfaceName}; 746 die "No surface: $surfaceName" unless $retval->{surface}; 747 return $retval; 748} 749 750sub new { 751 my ($class, $description, $x, $y, $dir) = @_; 752 my ($self); 753 754 $self = new GameObject; 755 %{$self} = ( %{$self}, 756 'x' => $x, 757 'y' => $y, 758 'w' => $description->{width}, 759 'h' => $description->{height}, 760 'surface' => $::BallSurfaces{$description->{surface}}, 761 'hexa' => $description->{hexa} ? 1 : 0, 762 'desc' => $description, 763 'hasmagic' => 0, # true if one of the ball's descendants is magic 764 'ismagic' => 0, # true if the ball IS magic 765 'spawning' => 0, 766 ); 767 $self->{speedX} = $dir > 0 ? 1.3 : -1.3; 768 $self->SetupCollisions(); 769 bless $self, $class; 770} 771 772sub NormalAdvance { 773 my $self = shift; 774 775 $self->{speedY} += $Ball::Gravity * $::GameSpeed unless ($self->{hexa}); 776 $self->{x} += $self->{speedX} * $::GameSpeed; 777 $self->{y} += $self->{speedY} * $::GameSpeed; 778 if ($self->{y} > $::ScreenHeight - $self->{h}) { 779 $self->{y} = $::ScreenHeight - $self->{h}; 780 if ($self->{hexa}) { 781 $self->{speedY} = -abs($self->{speedY}); 782 } else { 783 $self->{speedY} = -$self->{desc}->{speedY}; 784 } 785 $self->Bounce; 786 } 787 if ($self->{y} < 0) { 788 $self->{y} = 0; 789 $self->{speedY} = abs($self->{speedY}); 790 } 791 if ($self->{x} < 0) { 792 $self->{x} = 0; 793 $self->{speedX} = abs( $self->{speedX} ); 794 } 795 if ($self->{x} > $::ScreenWidth - $self->{w}) { 796 $self->{x} = $::ScreenWidth - $self->{w}; 797 $self->{speedX} = -abs( $self->{speedX} ); 798 } 799} 800 801sub SpawningAdvance { 802 my $self = shift; 803 804 $self->{y} += 0.32; 805 if ($self->{y} >= 0) { 806 $self->{spawning} = 0; 807 $self->{surface} = $::BallSurfaces{$self->{desc}->{surface}}, 808 } 809} 810 811sub Advance { 812 my $self = shift; 813 814 unless( $::GamePause > 0 ) { 815 if ($self->{spawning}) { 816 $self->SpawningAdvance(); 817 } else { 818 $self->NormalAdvance(); 819 } 820 } 821 822 $self->CheckCollisions() unless $::Game->{nocollision} or $self->{spawning}; 823} 824 825sub Bounce { 826} 827 828sub CheckCollisions { 829 my $self = shift; 830 my ($harpoon, $guy); 831 832 foreach $harpoon (values %Harpoon::Harpoons) { 833 if ($self->Collisions($harpoon)) { 834 $self->Pop($harpoon->{guy}, $harpoon->{popEffect}); 835 $harpoon->Delete(); 836 return; 837 } 838 } 839 foreach $guy (values %Guy::Guys) { 840 if ($::GamePause <= 0 and $self->Collisions($guy)) { 841 $guy->Kill(); 842 } 843 } 844} 845 846sub Draw { 847 my ($self) = @_; 848 849 return if $::GamePause > 0 and $::GamePause < 100 and (int($::GamePause / 3) % 4) < 2; 850 851 $self->TransferRect(); 852 if ($self->{ismagic} and int($::Game->{anim}/4) % 2) { 853 $::BallSurfaces{ball4}->blit( $Ball::MagicBallRect, $::App, $self->{rect} ); 854 } else { 855 $self->{surface}->blit( $self->{desc}->{rect}, $::App, $self->{rect} ); 856 } 857} 858 859sub Collisions { 860 my ($self, $other) = @_; 861 862 # Bounding box detection 863 864 return unless $self->SUPER::Collisions($other); 865 866 # Circle vs rectangle collision 867 868 my ($centerX, $centerY, $boxAxisX, $boxAxisY, $boxCenterX, $boxCenterY, $distSquare, $distance); 869 $boxAxisX = ($other->{collisionw} or $other->{w}) / 2; 870 $boxAxisY = ($other->{collisionh} or $other->{h}) / 2; 871 $boxCenterX = $other->{x} + $other->{w} / 2; 872 $boxCenterY = $other->{y} + $other->{h} / 2; 873 $centerX = $self->{x} + $self->{w} / 2; 874 $centerY = $self->{y} + $self->{h} / 2; 875 876 # Translate coordinates to the box center 877 $centerX -= $boxCenterX; 878 $centerY -= $boxCenterY; 879 $centerX = abs($centerX); 880 $centerY = abs($centerY); 881 882 if ($centerX < $boxAxisX) { 883 return 1 if $centerY < $boxAxisY + $self->{h} / 2; 884 return 0; 885 } 886 if ($centerY < $boxAxisY) { 887 return 2 if $centerX < $boxAxisX + $self->{w} / 2; 888 return 0; 889 } 890 $distSquare = ($centerX-$boxAxisX) * ($centerX-$boxAxisX); 891 $distSquare+= ($centerY-$boxAxisY) * ($centerY-$boxAxisY); 892 return 3 if $distSquare < $self->{h} * $self->{h} / 4; 893 894 return 0; 895} 896 897sub Pop { 898 my ($self, $guy, $popEffect) = @_; 899 900 Carp::confess "no $popEffect" unless defined $popEffect; 901 $::GameEvents{'pop'} = 1; 902 $::GameEvents{'magic'} = 1 if ($self->{ismagic}); 903 $guy->GiveScore($self->{desc}->{score}) if $guy; 904 $self->Delete(); 905 906 goto skipChildren if ($popEffect eq 'meltdown'); 907 908 if ($self->{desc}->{nextgen}) { 909 my @children = $self->SpawnChildren(); 910 if (scalar @children) { 911 $self->AdjustChildren(@children); 912 if ($popEffect eq 'HalfCutter') { 913 push @::GameObjects, ($self->{speedX} > 0 ? $children[1] : $children[0]); 914 } else { 915 push @::GameObjects, (@children); 916 } 917 } 918 } 919 if ($self->{bonus} and $popEffect ne 'superkill') { 920 push @::GameObjects, (new BonusDrop($self)); 921 } 922 $::Game->OnBallPopped(); 923 924 skipChildren: 925 push @::GameObjects, (new Pop($self->{x}, $self->{y}, $self->{desc}->{popIndex}, $self->{surface})); 926} 927 928sub SpawnChildren { 929 my $self = shift; 930 my ($nextgen, $child1, $child2, $x, $y); 931 932 $nextgen = $self->{desc}->{nextgen}; 933 $x = $self->{x} + $self->{w} / 2; 934 $y = $self->{y} + ( $self->{h} - $nextgen->{height} ) / 2; 935 936 $child1 = &Create($nextgen, $self->{x}, $y, 0); 937 $child2 = &Create($nextgen, $self->{x} + $self->{w} - $nextgen->{width}, $y, 1); 938 return ($child1, $child2); 939} 940 941sub AdjustChildren { 942 my ($self, @children) = @_; 943 my ($nextgen, $speedY, $altitude); 944 945 if ($self->{hasmagic}) { 946 $children[0]->GiveMagic(); 947 } 948 949 $nextgen = $self->{desc}->{nextgen}; 950 $altitude = $::ScreenHeight - $self->{y} - $self->{h}; 951 if ($altitude > $nextgen->{bounceY}) { 952 $speedY = 1.8; 953 } else { 954 $speedY = 1.8; 955 while ($speedY * $speedY / $Ball::Gravity / 2 + $altitude < $nextgen->{bounceY}) { 956 ++$speedY; 957 } 958 } 959 foreach (@children) { 960 $_->{speedY} = -$speedY; 961 } 962} 963 964sub GiveMagic { 965 my $self = shift; 966 967 $self->{hasmagic} = 1; 968 $self->{ismagic} = 1 unless $self->{desc}->{nextgen}; 969} 970 971sub GiveBonus { 972 my $self = shift; 973 974 $self->{bonus} = 1; 975} 976 977 978 979########################################################################## 980package Hexa; 981########################################################################## 982 983@Hexa::ISA = qw(Ball); 984 985sub new { 986 my $class = shift; 987 my ($self); 988 989 $self = new Ball(@_); 990 $self->{speedX} = ($::Game->Rand(1.25) + 1.25) * ($self->{speedX} > 0 ? 1 : -1); 991 $self->{speedY} = -4 + abs($self->{speedX}); 992 993 bless $self, $class; 994} 995 996sub Draw { 997 my $self = shift; 998 my ($rect, $srcx, $phase); 999 1000 return if $::GamePause > 0 and $::GamePause < 100 and (int($::GamePause / 3) % 4) < 2; 1001 1002 $self->TransferRect(); 1003 if ($self->{ismagic} and int($::Game->{anim} / 3) % 3 == 0) { 1004 $self->{surface}->blit($self->{desc}->{magicrect}, $::App, $self->{rect}); 1005 } else { 1006 $rect = $self->{desc}->{rect}; 1007 $phase = int($::Game->{anim} / 5) % 3; 1008 $phase = 2 - $phase if $self->{speedX} < 0; 1009 $srcx = $phase * $self->{w}; 1010 $rect->x( $rect->x + $srcx ); 1011 $self->{surface}->blit( $rect, $::App, $self->{rect} ); 1012 $rect->x( $rect->x - $srcx ); 1013 } 1014} 1015 1016sub AdjustChildren { 1017 my ($self, $child1, $child2) = @_; 1018 if ($self->{hasmagic}) { 1019 $child2->GiveMagic(); 1020 } 1021} 1022 1023 1024########################################################################## 1025package WaterBall; 1026########################################################################## 1027 1028@WaterBall::ISA = qw( Ball ); 1029 1030sub Bounce { 1031 my $self = shift; 1032 if ($self->{desc}->{nextgen}) { 1033 $self->{bonus} = 0; 1034 $self->Pop(undef, ''); 1035 } 1036} 1037 1038 1039########################################################################## 1040package FragileBall; 1041########################################################################## 1042 1043@FragileBall::ISA = qw( Ball ); 1044 1045sub Bounce { 1046 my $self = shift; 1047 if ($self->{desc}->{nextgen}) { 1048 $self->{bonus} = 0; 1049 $self->Pop(undef, ''); 1050 } 1051 #$self->{speedX} = ($self->{speedX} > 0) ? 1.3 : -1.3; 1052} 1053 1054sub SpawnChildren { 1055 my $self = shift; 1056 my ($nextgen, $numchildren, @children, $child, $i, $y); 1057 1058 $nextgen = $self->{desc}->{nextgen}; 1059 $numchildren = 2; 1060 while ($nextgen->{nextgen}) { 1061 $nextgen = $nextgen->{nextgen}; 1062 $numchildren *= 2; 1063 } 1064 $y = $self->{y} + ($self->{h} - $nextgen->{height}) / 2; 1065 for ($i = 0; $i < $numchildren; ++$i) { 1066 $child = &Ball::Create($nextgen, $self->{x}, $y, 0); 1067 $child->{speedX} = -1.5 + ($i / ($numchildren-1) * 3); 1068 $child->{x} = $self->{x} + ($self->{w} - $child->{w}) * ($i / ($numchildren-1)); 1069 push @children, $child; 1070 } 1071 return @children; 1072} 1073 1074 1075########################################################################## 1076package SeekerBall; 1077########################################################################## 1078 1079@SeekerBall::ISA = qw( Ball ); 1080 1081sub new { 1082 my $class = shift; 1083 my ($self); 1084 1085 $self = new Ball(@_); 1086 my @guys = grep {ref $_ eq 'Guy'} @::GameObjects; 1087 $self->{target} = $guys[$::Game->Rand(scalar @guys)]; 1088 $self->{deltaX} = (-$self->{w} + $self->{target}->{w}) / 2; 1089 die unless $self->{target}; 1090 1091 bless $self, $class; 1092} 1093 1094sub NormalAdvance { 1095 my $self = shift; 1096 1097 my $multiplier = ($self->{y} > $::ScreenHeight - 120) ? 0 : 25; 1098 unless( $::GamePause > 0 ) { 1099 if ($self->{x} + $self->{speedX} * $multiplier > $self->{target}->{x} + $self->{deltaX}) { 1100 $self->{speedX} -= 0.08; 1101 } else { 1102 $self->{speedX} += 0.08; 1103 } 1104 } 1105 $self->SUPER::NormalAdvance(); 1106} 1107 1108sub AdjustChildren { 1109 my ($self, $child1, $child2) = @_; 1110 1111 $self->SUPER::AdjustChildren($child1, $child2); 1112 $child1->{speedX} *= 2; 1113 $child1->{deltaX} -= 30; 1114 $child1->{target} = $self->{target}; 1115 $child2->{speedX} *= 2; 1116 $child2->{deltaX} += 30; 1117 $child2->{target} = $self->{target}; 1118} 1119 1120sub GiveMagic { 1121} 1122 1123sub Draw { 1124 my $self = shift; 1125 my ($guySurface, $srcrect, $dstrect); 1126 1127 $self->SUPER::Draw(); 1128 $guySurface = $self->{target}->{player}->{guySurface}; 1129 if ($self->{w} <= 32) { 1130 $srcrect = new SDL::Rect(-width => 16, -height => 16, -x =>320, -y => 176); 1131 } else { 1132 $srcrect = new SDL::Rect(-width => 32, -height => 32, -x =>320, -y => 128); 1133 } 1134 $dstrect = new SDL::Rect( 1135 -x => $self->{x} + $::ScreenMargin + ($self->{w} - $srcrect->width()) / 2, 1136 -y => $self->{y} + $::ScreenMargin + ($self->{h} - $srcrect->height()) / 2 + 2); 1137 $guySurface->blit($srcrect, $::App, $dstrect); 1138} 1139 1140 1141########################################################################## 1142package SuperBall; 1143########################################################################## 1144 1145@SuperBall::ISA = qw(Ball); 1146 1147sub new { 1148 my $class = shift; 1149 my ($self); 1150 1151 $self = new Ball(@_); 1152 $self->{effect} = 1; # 0 : superpause; 1 : superkill 1153 bless $self, $class; 1154 $self->SwitchEffect(); 1155 return $self; 1156} 1157 1158sub SwitchEffect { 1159 my $self = shift; 1160 1161 $self->{effect} = 1 - $self->{effect}; 1162 $self->{surface} = $::BallSurfaces{($self->{effect} ? 'gold' : 'green') . ($self->{w} > 64 ? 1 : 2)}; 1163} 1164 1165sub Bounce { 1166 my $self = shift; 1167 1168 $self->SwitchEffect(); 1169} 1170 1171sub SpawnChildren { 1172 return (); 1173} 1174 1175sub Pop { 1176 my $self = shift; 1177 my ($poppedBy) = @_; 1178 1179 $self->SUPER::Pop(@_); 1180 if ($self->{effect} == 0) { 1181 $::GameEvents{superpause} = 1; 1182 } else { 1183 $::GameEvents{superkill} = 1; 1184 $::GameEvents{superkillguy} = $poppedBy; 1185 } 1186} 1187 1188sub GiveMagic { 1189} 1190 1191 1192########################################################################## 1193package XmasBall; 1194########################################################################## 1195 1196@XmasBall::ISA = qw(Ball); 1197 1198sub SpawnChildren { 1199 return (); 1200} 1201 1202sub Pop { 1203 my $self = shift; 1204 my ($bonusdrop, @collectedSubs); 1205 1206 $self->SUPER::Pop(@_); 1207 $bonusdrop = new BonusDrop($self); 1208 @collectedSubs = ( \&OnCollectedLife, \&OnCollectedScore, \&OnCollectedScore, \&OnCollectedInvulnerability, \&OnCollectedInvulnerability ); 1209 if ($::Game->Rand(2 * scalar @collectedSubs) < scalar @collectedSubs) { 1210 $bonusdrop->{desc} = { 'srcRect' => new SDL::Rect(-width=>32, -height=>32, -x=>0, -y=>0), }; 1211 $bonusdrop->SetOnCollectedSub( $collectedSubs[int $::Game->Rand(scalar @collectedSubs)] ); 1212 } 1213 push @::GameObjects, $bonusdrop; 1214} 1215 1216sub GiveMagic { 1217} 1218sub GiveBonus { 1219} 1220 1221sub OnCollectedLife { 1222 my ($bonus, $guy) = @_; 1223 $guy->{player}->{lives}++; 1224 &::PlaySound('bonuslife'); 1225} 1226 1227sub OnCollectedScore { 1228 my ($bonus, $guy) = @_; 1229 $guy->GiveScore(50000); 1230 &::PlaySound('score'); 1231} 1232 1233sub OnCollectedInvulnerability { 1234 my ($bonus, $guy) = @_; 1235 $guy->{invincible} = 500; 1236} 1237 1238 1239########################################################################## 1240package DeathBall; 1241########################################################################## 1242 1243@DeathBall::ISA = qw(Ball); 1244 1245sub new { 1246 my $class = shift; 1247 my ($self); 1248 1249 $self = new Ball(@_); 1250 $self->{expires} = 2000; # 20sec 1251 $self->{speedX} *= 0.9; 1252 bless $self, $class; 1253} 1254 1255sub NormalAdvance { 1256 my $self = shift; 1257 1258 $self->SUPER::NormalAdvance(); 1259 if (--$self->{expires} < 0) { 1260 $self->{bonus} = 1 if $self->{hasmagic}; 1261 $self->Pop(undef, 'expire'); 1262 } 1263 1264} 1265 1266sub Pop { 1267 my ($self, $guy, $popEffect) = @_; 1268 1269 $self->{dontspawn} = 1 if $popEffect eq 'expire' or $popEffect eq 'superkill'; 1270 $self->SUPER::Pop($guy, $popEffect); 1271 if (&CountDeathBalls() > 30) { 1272 $::GameEvents{'meltdown'} = 1; 1273 } 1274} 1275 1276sub SpawnChildren { 1277 my $self = shift; 1278 1279 return if $self->{dontspawn}; 1280 $self->SUPER::SpawnChildren(@_); 1281} 1282 1283sub CountDeathBalls { 1284 my $count = 0; 1285 1286 foreach my $ball (@::GameObjects) { 1287 if (ref($ball) eq 'DeathBall') { ++$count; } 1288 } 1289 return $count; 1290} 1291 1292 1293########################################################################## 1294package EarthquakeBall; 1295########################################################################## 1296 1297@EarthquakeBall::ISA = qw(Ball); 1298 1299sub new { 1300 my $class = shift; 1301 my ($self); 1302 1303 $self = new Ball(@_); 1304 bless $self, $class; 1305} 1306 1307sub CountEarthquakeBalls { 1308 my $count = 0; 1309 1310 foreach my $ball (@::GameObjects) { 1311 if (ref($ball) eq 'EarthquakeBall') { ++$count; } 1312 } 1313 return $count; 1314} 1315 1316sub Bounce { 1317 my $self = shift; 1318 1319 unless ($::GameEvents{earthquake} and $::GameEvents{earthquake} > $self->{desc}->{quake}) { 1320 $::GameEvents{earthquake} = [$self->{desc}->{quake}, $self->{x}]; 1321 } 1322} 1323 1324 1325########################################################################## 1326package UpsideDownBall; 1327########################################################################## 1328 1329@UpsideDownBall::ISA = qw( Ball ); 1330 1331sub NormalAdvance { 1332 my ($self) = @_; 1333 1334 $self->{speedY} = -$self->{speedY}; 1335 $self->{y} = $::ScreenHeight - $self->{h} - $self->{y}; 1336 $self->SUPER::NormalAdvance(); 1337 $self->{speedY} = -$self->{speedY}; 1338 $self->{y} = $::ScreenHeight - $self->{h} - $self->{y}; 1339} 1340 1341 1342########################################################################## 1343package Pop; 1344########################################################################## 1345 1346@Pop::ISA = qw(GameObject); 1347 1348@Pop::Description = ( 1349 { 'xoffset' => 0, 'yoffset' => 0, 'srcx' => 128, 'srcy' => 0, 'sizex' => 128, 'sizey' => 106, }, 1350 { 'xoffset' => 0, 'yoffset' => 0, 'srcx' => 96, 'srcy' => 0, 'sizex' => 96, 'sizey' => 80, }, 1351 { 'xoffset' => 0, 'yoffset' => 0, 'srcx' => 64, 'srcy' => 0, 'sizex' => 64, 'sizey' => 53, }, 1352 { 'xoffset' => 0, 'yoffset' => 0, 'srcx' => 32, 'srcy' => 0, 'sizex' => 32, 'sizey' => 28, }, 1353 { 'xoffset' => 0, 'yoffset' => 0, 'srcx' => 16, 'srcy' => 0, 'sizex' => 16, 'sizey' => 15, }, 1354 1355 { 'xoffset' => 0, 'yoffset' => 0, 'srcx' => 192, 'srcy' => 0, 'sizex' => 64, 'sizey' => 52, }, 1356 { 'xoffset' => 0, 'yoffset' => 0, 'srcx' => 96, 'srcy' => 0, 'sizex' => 32, 'sizey' => 28, }, 1357 { 'xoffset' => 0, 'yoffset' => 0, 'srcx' => 48, 'srcy' => 0, 'sizex' => 16, 'sizey' => 14, }, 1358); 1359 1360sub new { 1361 my ($class, $x, $y, $index, $surface) = @_; 1362 my ($self, $desc); 1363 1364 $desc = $Pop::Description[$index], 1365 $self = new GameObject; 1366 %{$self} = ( %{$self}, 1367 'x' => $x + $desc->{xoffset}, 1368 'y' => $y + $desc->{yoffset}, 1369 'w' => $desc->{sizex}, 1370 'h' => $desc->{sizey}, 1371 'desc' => $desc, 1372 'anim' => 0, 1373 'surface' => $surface, 1374 ); 1375 bless $self, $class; 1376} 1377 1378sub Advance { 1379 my $self = shift; 1380 1381 ++$self->{anim}; 1382 if ($self->{anim} >= 20) { 1383 $self->Delete(); 1384 } 1385} 1386 1387sub Draw { 1388 my $self = shift; 1389 my ($phase, $srcrect); 1390 1391 $self->TransferRect(); 1392 $phase = int($self->{anim} / 5); 1393 $phase = 3 if $phase > 3; 1394 1395 $srcrect = new SDL::Rect( 1396 -x => $self->{desc}->{srcx} + $phase * $self->{w}, 1397 -y => $self->{desc}->{srcy}, 1398 -width => $self->{w}, 1399 -height => $self->{h} ); 1400 $self->{surface}->blit( $srcrect, $::App, $self->{rect} ); 1401} 1402 1403 1404########################################################################## 1405package GamePause; 1406########################################################################## 1407 1408@GamePause::ISA = qw(GameObject); 1409 1410sub Show { 1411 foreach my $gameObject (@::GameObjects) { 1412 return if (ref $gameObject eq 'GamePause'); 1413 } 1414 push @::GameObjects, (new GamePause); 1415} 1416 1417sub new { 1418 my ($class) = @_; 1419 1420 my $self = new GameObject; 1421 my ($width); 1422 $width = &::TextWidth("Time left: 9.999"); 1423 1424 %{$self} = ( %{$self}, 1425 'x' => ($::PhysicalScreenWidth - $width) / 2, 1426 'y' => 100, 1427 'w' => $width, 1428 'h' => 32, 1429 ); 1430 $self->TransferRect(); 1431 bless $self, $class; 1432} 1433 1434sub BringToFront { 1435 my $self = shift; 1436 1437 @::GameObjects = grep { $_ ne $self } @::GameObjects; 1438 push @::GameObjects, ($self); 1439} 1440 1441sub Advance { 1442 my $self = shift; 1443 1444 if ($::GamePause <= 0) { 1445 $self->Delete; 1446 return; 1447 } 1448 unless ($::GameObjects[$#::GameObjects] eq $self) { 1449 $self->BringToFront(); 1450 } 1451} 1452 1453sub Draw { 1454 my $self = shift; 1455 1456 $::App->print( $self->{rect}->x, $self->{rect}->y, "Time left: " . ($::GamePause / 100) ); 1457} 1458 1459 1460########################################################################## 1461package FpsIndicator; 1462########################################################################## 1463 1464@FpsIndicator::ISA = qw(GameObject); 1465 1466sub new { 1467 my ($class) = @_; 1468 1469 my $self = new GameObject; 1470 my ($width); 1471 $width = &::TextWidth("999"); 1472 1473 %{$self} = ( %{$self}, 1474 'x' => $::ScreenWidth - $width + $::ScreenMargin, 1475 'y' => -$::ScreenMargin, 1476 'w' => $width, 1477 'h' => 32, 1478 ); 1479 $self->TransferRect(); 1480 bless $self, $class; 1481} 1482 1483sub Draw { 1484 my $self = shift; 1485 1486 $::App->print( $self->{rect}->x, $self->{rect}->y, &GameTimer::GetFramesPerSecond() ); 1487} 1488 1489 1490########################################################################## 1491package BonusDrop; 1492########################################################################## 1493 1494@BonusDrop::ISA = qw(GameObject); 1495use vars qw(@BonusDesc); 1496 1497@BonusDesc = ( 1498 { 'weaponClass' => 'MachineGun', 'bonusDelay' => 1500, 'srcRect' => new SDL::Rect(-width=>32, -height=>32, -x=>0 , -y=>64), }, 1499 { 'weaponClass' => 'HalfCutter', 'bonusDelay' => 1000, 'srcRect' => new SDL::Rect(-width=>32, -height=>32, -x=>32, -y=>64), }, 1500 { 'weaponClass' => 'PowerWire', 'bonusDelay' => 3000, 'srcRect' => new SDL::Rect(-width=>32, -height=>32, -x=>32, -y=>96), }, 1501 { 'onCollectedSub' => \&OnCollectedSlowEffect, 'srcRect' => new SDL::Rect(-width=>32, -height=>32, -x=>32, -y=>0), }, 1502); 1503 1504 1505sub new { 1506 my ($class, $ball) = @_; 1507 my ($self); 1508 1509 $self = new GameObject; 1510 1511 %{$self} = ( %{$self}, 1512 'x' => $ball->{x} + ($ball->{w} - 32) / 2, 1513 'y' => $ball->{y} + ($ball->{h} - 32) / 2, 1514 'w' => 32, 1515 'h' => 32, 1516 'speedY' => -3, 1517 'speedX' => 0, 1518 'bottomDelay' => 500, 1519 'desc' => $BonusDesc[int $::Game->Rand(scalar @BonusDesc)], 1520 ); 1521 bless $self, $class; 1522} 1523 1524sub Advance { 1525 my $self = shift; 1526 1527 if ($self->{y} >= $::ScreenHeight - $self->{h}) { 1528 $self->{y} = $::ScreenHeight - $self->{h}; 1529 if (--$self->{bottomDelay} < 0) { 1530 $self->Delete(); 1531 } 1532 } else { 1533 $self->{speedY} += 0.1; 1534 $self->{y} += $self->{speedY}; 1535 } 1536 1537 $self->CheckCollisions() if $self->{speedY} >= 0; 1538} 1539 1540sub CheckCollisions { 1541 my $self = shift; 1542 my ($guy, @guysTouched); 1543 1544 foreach $guy (@::GameObjects) { 1545 next unless ref($guy) eq 'Guy'; 1546 next unless $self->Collisions($guy); 1547 push @guysTouched, ($guy); 1548 } 1549 return unless @guysTouched; 1550 $self->Collected($guysTouched[$::Game->Rand( scalar @guysTouched )]); 1551} 1552 1553sub SetOnCollectedSub { 1554 my ($self, $onCollectedSub) = @_; 1555 $self->{onCollectedSub} = $onCollectedSub; 1556} 1557 1558sub Collected { 1559 my ($self, $guy) = @_; 1560 1561 if ($self->{onCollectedSub}) { 1562 $self->{onCollectedSub}->($self, $guy); 1563 } elsif ($self->{desc}->{onCollectedSub}) { 1564 $self->{desc}->{onCollectedSub}->($self, $guy); 1565 } else { 1566 $guy->{weapon} = $self->{desc}->{weaponClass}; 1567 $guy->{bonusDelay} = $self->{desc}->{bonusDelay} * $::WeaponDuration->{durationmultiplier}; 1568 } 1569 $self->Delete(); 1570} 1571 1572sub Draw { 1573 my $self = shift; 1574 1575 return if $self->{bottomDelay} < 100 and (($::Game->{anim} / 4) % 2 < 1); 1576 $self->TransferRect(); 1577 $::BonusSurface->blit($self->{desc}->{srcRect}, $::App, $self->{rect}); 1578} 1579 1580sub OnCollectedSlowEffect { 1581 my ($self, $guy) = @_; 1582 1583 &SlowEffect::RemoveSlowEffects(); 1584 push @::GameObjects, (new SlowEffect()); 1585} 1586 1587 1588########################################################################## 1589package SlowEffect; 1590########################################################################## 1591 1592@SlowEffect::ISA = qw(GameObject); 1593 1594sub new { 1595 my ($class) = @_; 1596 my ($self); 1597 1598 $self = new GameObject; 1599 %{$self} = ( %{$self}, 1600 'timeout' => 1500, # Lasts for 15s 1601 ); 1602 # TODO Play a sound here 1603 bless $self, $class; 1604 return $self; 1605} 1606 1607sub RemoveSlowEffects { 1608 @::GameObjects = grep { ref $_ ne 'SlowEffect' } @::GameObjects; 1609} 1610 1611sub Advance { 1612 my ($self) = @_; 1613 my ($timeout, $slowratio); 1614 1615 $timeout = --$self->{timeout}; 1616 if ( $timeout == 256 ) { 1617 # TODO Play a sound here 1618 } 1619 if ( $timeout > 256 ) { 1620 $::GameSpeed = 0.2; 1621 } elsif ( $timeout > 0 ) { 1622 $::Game->SetGameSpeed(); 1623 $slowratio = int(256 - $timeout) / 256; 1624 $::GameSpeed = $::GameSpeed * $slowratio + 0.2 * (1.0 - $slowratio); 1625 } else { 1626 $::Game->SetGameSpeed(); 1627 $self->Delete(); 1628 return; 1629 } 1630} 1631 1632sub Draw { 1633} 1634 1635sub Clear { 1636} 1637 1638 1639########################################################################## 1640package Guy; 1641########################################################################## 1642 1643@Guy::ISA = qw(GameObject); 1644use vars qw(%Guys $GuyId); 1645 1646sub new { 1647 my ($class, $player) = @_; 1648 my ($self, $number); 1649 1650 $self = new GameObject; 1651 $number = $player->{number}; 1652 1653 %{$self} = ( %{$self}, 1654 'player' => $player, 1655 'number' => $number, 1656 'x' => $player->{startX}, 1657 'y' => $::ScreenHeight - 64, 1658 'w' => 64, 1659 'h' => 64, 1660 'collisionw' => '28', 1661 'collisionh' => '48', 1662 'delay' => 0, 1663 'speedY' => 0, 1664 'speedX' => 0, 1665 'dir' => $number % 2, 1666 'state' => 'idle', 1667 'killed' => 0, 1668 'harpoons' => 0, 1669 'invincible' => 0, 1670 'surface' => $player->{guySurface}, 1671 'whiteSurface' => $player->{whiteGuySurface}, 1672 'weapon' => 'Harpoon', 1673 'bonusDelay' => 0, 1674 'id' => ++$GuyId, 1675 ); 1676 bless $self, $class; 1677 $self->SetupCollisions(); 1678 $self->CalculateAnimPhases(); 1679 $Guys{$self->{id}} = $self; 1680 return $self; 1681} 1682 1683sub Delete { 1684 my $self = shift; 1685 1686 $self->SUPER::Delete; 1687 delete $Guys{$self->{id}}; 1688} 1689 1690sub CalculateAnimPhases { 1691 my $self = shift; 1692 1693 $self->{animPhases} = $self->{player}->{guySurface}->width() / 128, 1694} 1695 1696sub DemoMode { 1697 my ($self) = shift; 1698 $self->{state} = 'demo'; 1699 $self->{dir} = 1; 1700} 1701 1702sub Fire { 1703 my ($self) = @_; 1704 1705 if ($self->{harpoons} < $::DifficultyLevel->{harpoons}) { 1706 ++$self->{harpoons}; 1707 eval("unshift \@::GameObjects, ($self->{weapon}::Create(\$self));"); 1708 $self->{state} = 'shoot'; 1709 $self->{delay} = 7; 1710 ::PlaySound('shoot'); 1711 return 1; 1712 } 1713 return 0; 1714} 1715 1716sub AdvanceWhileFlying { 1717 my $self = shift; 1718 1719 $self->{speedY} += $Ball::Gravity * 2; 1720 $self->{y} += $self->{speedY}; 1721 $self->{x} += $self->{dir} > 0 ? 1 : -1; 1722 if ($self->{x} < -16) { 1723 $self->{x} = 0; $self->{dir} = 1; 1724 } 1725 if ($self->{x} > $::ScreenWidth - $self->{w} + 16) { 1726 $self->{x} = $::ScreenWidth - $self->{w}; $self->{dir} = 0; 1727 } 1728 if ($self->{y} >= $::ScreenHeight - $self->{h}) { 1729 $self->{state} = 'idle'; 1730 $self->{y} = $::ScreenHeight - $self->{h}; 1731 $self->{speedX} = $self->{dir} ? 1 : -1; 1732 } 1733} 1734 1735sub Advance { 1736 my ($self) = @_; 1737 my ($slippery, $keys); 1738 1739 $slippery = $::Slippery ? 0.0625 : 0; 1740 1741 return if $self->{killed}; 1742 return if $self->{state} eq 'demo'; 1743 --$self->{invincible}; 1744 1745 if ($self->{bonusDelay} > 0) { 1746 --$self->{bonusDelay}; 1747 $self->{weapon} = 'Harpoon' if $self->{bonusDelay} <= 0; 1748 } 1749 1750 if ($self->{state} eq 'fly') { 1751 $self->AdvanceWhileFlying(); 1752 return; 1753 } 1754 1755 if ($self->{delay} > 0) { 1756 --$self->{delay}; 1757 $keys = [ 0, 0, 0 ]; 1758 } else { 1759 $keys = $self->{player}->{keys}; 1760 } 1761 1762 $self->{speedX} = 0 unless $slippery; 1763 $self->{state} = 'idle'; 1764 1765 if ( $::Events{$keys->[2]} ) { 1766 return if $self->Fire(); 1767 } 1768 if ( $::Keys{$keys->[0]} ) { 1769 if ($slippery) { 1770 $self->{speedX} -= $slippery * 2 if $self->{speedX} > -3; 1771 } else { 1772 $self->{speedX} = -3; 1773 } 1774 $self->{dir} = 0; 1775 $self->{state} = 'walk'; 1776 } elsif ( $::Keys{$keys->[1]} ) { 1777 if ($slippery) { 1778 $self->{speedX} += $slippery * 2 if $self->{speedX} < 3; 1779 } else { 1780 $self->{speedX} = 3; 1781 } 1782 $self->{dir} = 1; 1783 $self->{state} = 'walk'; 1784 } else { 1785 if ($slippery) { 1786 $self->{speedX} += $slippery if $self->{speedX} < 0; 1787 $self->{speedX} -= $slippery if $self->{speedX} > 0; 1788 } 1789 } 1790 $self->{x} += $self->{speedX}; 1791 1792 if ($self->{x} < -16) { 1793 $self->{x} = -16; $self->{speedX} = 0; 1794 } 1795 if ($self->{x} > $::ScreenWidth - $self->{w} + 16) { 1796 $self->{x} = $::ScreenWidth - $self->{w} + 16; $self->{speedX} = 0; 1797 } 1798} 1799 1800sub Draw { 1801 my ($self) = @_; 1802 my ($surface, $srcrect, $srcx, $srcy, $srcw, $srch); 1803 1804 return if ($self->{killed}); 1805 $surface = $self->{surface}; 1806 $surface = $self->{whiteSurface} if $self->{invincible} > 0 and (int($self->{invincible} / 2) % 3 == 0); 1807 1808 $srcw = $srch = 64; 1809 if ($self->{state} eq 'idle') { 1810 $srcx = $self->{dir} * 128; 1811 $srcy = 64; 1812 } elsif ($self->{state} eq 'walk') { 1813 $srcx = $self->{dir} * $self->{animPhases} * 64 + (int($self->{x} / 50) % $self->{animPhases}) * 64; 1814 $srcy = 0; 1815 } elsif ($self->{state} eq 'demo') { 1816 $srcx = $self->{dir} * $self->{animPhases} * 64 + (int($::Game->{anim} / 16) % $self->{animPhases}) * 64; 1817 $srcy = 0; 1818 } elsif ($self->{state} eq 'shoot') { 1819 $srcx = $self->{dir} * 128 + 64; 1820 $srcx -= 64 if ($self->{delay} <= 1); 1821 $srcy = 64; 1822 } elsif ($self->{state} eq 'fly') { 1823 $srcx = ($self->{dir} > 0 ? 0 : 64); 1824 $srcy = 128; 1825 } 1826 $srcrect = new SDL::Rect( -width => $srcw, -height => $srch, -x => $srcx, -y => $srcy ); 1827 $self->TransferRect(); 1828 $surface->blit($srcrect, $::App, $self->{rect}); 1829} 1830 1831sub Kill { 1832 my ($self) = @_; 1833 1834 return if $::Cheat; 1835 return if $self->{invincible} > 0; 1836 $self->{justkilled} = 1; 1837 $::GameEvents{'kill'} = 1; 1838} 1839 1840sub Earthquake() { 1841 my ($self, $amplitude) = @_; 1842 1843 return if $self->{state} eq 'fly'; 1844 $self->{speedY} = -($amplitude->[0]); 1845 $self->{dir} = $amplitude->[1] > $self->{x} ? 0 : 1; 1846 $self->{state} = 'fly'; 1847 $self->{y} -= 3; 1848} 1849 1850sub DeleteHarpoons { 1851 my ($self) = @_; 1852 my (@gameObjects, $harpoon); 1853 1854 @gameObjects = @::GameObjects; 1855 foreach $harpoon (@gameObjects) { 1856 $harpoon->Delete if ($harpoon->{guy} and $harpoon->{guy} eq $self); 1857 } 1858} 1859 1860sub GiveScore { 1861 my ($self, $score) = @_; 1862 1863 my $player = $self->{player}; 1864 $player->{score} += $score; 1865 if ($player->{score} >= $player->{scoreforbonuslife}) { 1866 ++$player->{lives}; 1867 $player->{scoreforbonuslife} += 200000; 1868 &::PlaySound('bonuslife'); 1869 } 1870} 1871 1872 1873########################################################################## 1874package Harpoon; 1875########################################################################## 1876 1877@Harpoon::ISA = qw(GameObject); 1878use vars qw(%Harpoons $HarpoonId); 1879 1880sub Create { 1881 return new Harpoon(@_); 1882} 1883 1884sub new { 1885 my ($class, $guy) = @_; 1886 my ($self); 1887 1888 $self = new GameObject; 1889 %{$self} = ( %{$self}, 1890 'x' => $guy->{x} + 22, 1891 'y' => $::ScreenHeight - 32, 1892 'w' => 18, 1893 'h' => 32, 1894 'speedY' => -3, 1895 'speedX' => 0, 1896 'guy' => $guy, 1897 'surface' => $guy->{player}->{harpoonSurface}, 1898 'popEffect' => '', 1899 'id' => ++$HarpoonId, 1900 ); 1901 $Harpoons{$self->{id}} = $self; 1902 bless $self, $class; 1903} 1904 1905sub Delete { 1906 my $self = shift; 1907 1908 delete $Harpoons{$self->{id}}; 1909 --$self->{guy}->{harpoons}; 1910 $self->SUPER::Delete(); 1911} 1912 1913sub Advance { 1914 my $self = shift; 1915 1916 if ($self->{y} < 0) { 1917 $self->Delete(); 1918 return; 1919 } 1920 $self->{y} += $self->{speedY}; 1921 $self->{h} = $::ScreenHeight - $self->{y}; 1922} 1923 1924sub GetAnimPhase { 1925 my $self = shift; 1926 1927 return (int($::Game->{anim} / 4) % 3) + 1; 1928} 1929 1930sub Draw { 1931 my $self = shift; 1932 my ($x, $y, $h, $maxh, $dstrect, $srcrect); 1933 1934 $self->TransferRect(); 1935 $y = $self->{y}; 1936 $dstrect = new SDL::Rect( -w => $self->{w}, -x => $self->{x} + $::ScreenMargin ); 1937 $srcrect = new SDL::Rect( -w => $self->{w}, 1938 -x => (0, 64, 32, 96)[ $self->GetAnimPhase() ], -y => 0 ); 1939 $maxh = 160; 1940 1941 # The harpoon needs to be drawn from tile pieces. 1942 # $y iterates from $self->{y} to $::ScreenHeight 1943 # We draw at most $maxh height tiles at a time. 1944 1945 while ($y < $::ScreenHeight) { 1946 $h = $::ScreenHeight - $y; 1947 $h = $maxh if $h > $maxh; 1948 $dstrect->y( $y + $::ScreenMargin ); 1949 $dstrect->height( $h ); 1950 $srcrect->height( $h ); 1951 $self->{surface}->blit( $srcrect, $::App, $dstrect ); 1952 1953 # Prepare for next piece 1954 $y += $h; 1955 $srcrect->y( 32 ); # First piece starts at 0, rest start at 32 1956 $maxh = 128; 1957 } 1958} 1959 1960 1961########################################################################## 1962package MachineGun; 1963########################################################################## 1964 1965@MachineGun::ISA = qw(Harpoon); 1966use vars qw(@SrcRects); 1967 1968@SrcRects = ( 1969 new SDL::Rect( -x=>0, -y=>160, -w=>32, -h=>32 ), 1970 new SDL::Rect( -x=>32, -y=>160, -w=>32, -h=>32 ), 1971 new SDL::Rect( -x=>64, -y=>160, -w=>32, -h=>32 ), 1972); 1973 1974sub Create { 1975 return ( new MachineGun(@_, 0), new MachineGun(@_, 1), new MachineGun(@_, 2) ); 1976} 1977 1978sub new { 1979 my ($class, $guy, $index) = @_; 1980 my ($self); 1981 1982 $self = new Harpoon($guy); 1983 %{$self} = ( %{$self}, 1984 'x' => $guy->{x} + 16, 1985 'y' => $guy->{y} - 16, 1986 'w' => 32, 1987 'h' => 32, 1988 'index' => $index, 1989 'speedY' => -9, 1990 'speedX' => (-2, 0, 2)[$index], 1991 ); 1992 bless $self, $class; 1993} 1994 1995sub Delete { 1996 my $self = shift; 1997 1998 --$self->{guy}->{harpoons} if $self->{index} == 1; 1999 delete $Harpoon::Harpoons{$self->{id}}; 2000 $self->GameObject::Delete(); 2001} 2002 2003sub Advance { 2004 my $self = shift; 2005 2006 if ($self->{y} < 0 2007 or $self->{x} < 0 2008 or $self->{x} > $::ScreenWidth - $self->{w}) { 2009 $self->Delete(); 2010 return; 2011 } 2012 $self->{y} += $self->{speedY}; 2013 $self->{x} += $self->{speedX}; 2014} 2015 2016sub Draw { 2017 my $self = shift; 2018 2019 $self->TransferRect(); 2020 $self->{surface}->blit($SrcRects[$self->{index}], $::App, $self->{rect}); 2021} 2022 2023########################################################################## 2024package PowerWire; 2025########################################################################## 2026 2027@PowerWire::ISA = qw(Harpoon); 2028 2029sub Create { 2030 return new PowerWire(@_); 2031} 2032 2033sub new { 2034 my $class = shift; 2035 my ($self); 2036 2037 $self = new Harpoon(@_); 2038 %{$self} = ( %{$self}, 2039 'topdelay' => 200, 2040 ); 2041 bless $self, $class; 2042} 2043 2044sub Advance { 2045 my $self = shift; 2046 2047 if ($self->{y} > 0) { 2048 return $self->SUPER::Advance(); 2049 } 2050 $self->{y} = 0; 2051 --$self->{topdelay}; 2052 if ($self->{topdelay} <= 0) { 2053 $self->Delete(); 2054 } 2055} 2056 2057sub GetAnimPhase { 2058 my $self = shift; 2059 2060 if ($self->{y} <= 0) { 2061 return 0; 2062 } 2063 return $self->SUPER::GetAnimPhase(); 2064} 2065 2066 2067########################################################################## 2068package HalfCutter; 2069########################################################################## 2070 2071@HalfCutter::ISA = qw(Harpoon); 2072 2073sub Create { 2074 return new HalfCutter(@_); 2075} 2076 2077sub new { 2078 my $class = shift; 2079 my $self = new Harpoon(@_); 2080 $self->{popEffect} = 'HalfCutter'; 2081 $self->{originalSurface} = $self->{surface}; 2082 bless $self, $class; 2083} 2084 2085sub Advance { 2086 my $self = shift; 2087 2088 $self->{surface} = (($::Game->{anim} % 15) < 3) ? $::WhiteHarpoonSurface : $self->{originalSurface}; 2089 $self->SUPER::Advance(); 2090} 2091 2092 2093########################################################################## 2094package DeadGuy; 2095########################################################################## 2096 2097@DeadGuy::ISA = qw(GameObject); 2098 2099sub new { 2100 my ($class, $guy, $dir) = @_; 2101 my ($self, $player); 2102 2103 $self = new GameObject; 2104 $player = $guy->{player}; 2105 2106 %{$self} = ( %{$self}, 2107 'x' => $guy->{x}, 2108 'y' => $guy->{y}, 2109 'w' => 64, 2110 'h' => 64, 2111 'speedY' => -7, 2112 'surface' => $player->{guySurface}, 2113 'anim' => 0, 2114 'bounce' => 0, 2115 'bouncex' => 0, 2116 ); 2117 $self->{'speedX'} = ($::Game->Rand(2) + 1.5) * (($self->{x} > $::ScreenWidth / 2) ? 1 : -1); 2118 bless $self, $class; 2119} 2120 2121sub Advance { 2122 my $self = shift; 2123 2124 $self->{speedY} += 0.1; 2125 $self->{x} += $self->{speedX}; 2126 $self->{y} += $self->{speedY}; 2127 2128 unless ($self->{bouncex}) { 2129 if ($self->{x} < -16) { 2130 $self->{x} = -16; 2131 $self->{speedX} = abs( $self->{speedX} ); 2132 $self->{speedY} = -3 if $self->{speedY} > -3; 2133 $self->{bouncex} = 1; 2134 } 2135 if ($self->{x} > $::ScreenWidth - $self->{w} +16) { 2136 $self->{x} = $::ScreenWidth - $self->{w} + 16; 2137 $self->{speedX} = -abs( $self->{speedX} ); 2138 $self->{speedY} = -3 if $self->{speedY} > -3; 2139 $self->{bouncex} = 1; 2140 } 2141 } 2142 if ($self->{y} > $::ScreenHeight - 64 and not $self->{bounce}) { 2143 $self->{bounce} = 1; 2144 $self->{speedY} = -3; 2145 } 2146 2147 if ($self->{y} > $::PhysicalScreenHeight) { 2148 $self->Delete; 2149 } 2150 $self->{anim} += $self->{speedX} > 0 ? -1 : +1; 2151} 2152 2153sub Draw { 2154 my $self = shift; 2155 my ($srcrect); 2156 2157 $srcrect = new SDL::Rect( 2158 -x => ($self->{speedX} > 0 ? 0 : 64), 2159 -y => 128, 2160 -width => 64, -height => 64 ); 2161 $self->TransferRect(); 2162 if ($::RotoZoomer) { 2163 my $roto = new SDL::Surface( -name =>'', 2164 -flags=>::SDL_SWSURFACE(), -width => 64, -height => 64, -depth => 32); 2165 $self->{surface}->blit( $srcrect, $roto, new SDL::Rect ); 2166 $::RotoZoomer->rotoZoom( $roto, $self->{anim} * 5, 1, $::SmoothRotoZoom ); 2167 $self->{rect}->x( $self->{rect}->x - ($roto->width - 64) / 2 ); 2168 $self->{rect}->y( $self->{rect}->y - ($roto->height - 64) / 2 ); 2169 $roto->blit( 0, $::App, $self->{rect} ); 2170 return; 2171 } else { 2172 $self->{surface}->blit( $srcrect, $::App, $self->{rect} ); 2173 } 2174} 2175 2176 2177########################################################################## 2178package Meltdown; 2179########################################################################## 2180 2181@Meltdown::ISA = qw(GameObject); 2182 2183sub new { 2184 my ($class) = @_; 2185 my ($self, $surface); 2186 2187 $self = new GameObject; 2188 $surface = new SDL::Surface( -name => "$::DataDir/meltdown.png" ); 2189 %{$self} = ( %{$self}, 2190 'x' => ($::ScreenWidth - $surface->width) / 2, 2191 'y' => -$surface->height, 2192 'w' => $surface->width, 2193 'h' => $surface->height, 2194 'speedY' => 0, 2195 'surface' => $surface, 2196 'bounce' => 0, 2197 ); 2198 bless $self, $class; 2199} 2200 2201sub Advance { 2202 my $self = shift; 2203 $self->{speedY} += 0.1; 2204 $self->{y} += $self->{speedY}; 2205 if ($self->{bounce} == 0 and $self->{y} > $::ScreenHeight - $self->{h}) { 2206 $self->{bounce} = 1; 2207 $self->{speedY} = -5; 2208 $self->{y} = $::ScreenHeight - $self->{h}; 2209 } 2210 if ($self->{bounce} and $self->{y} > $::PhysicalScreenHeight) { 2211 $self->Delete; 2212 } 2213} 2214 2215sub Draw { 2216 my $self = shift; 2217 2218 $self->TransferRect(); 2219 $self->{surface}->blit( 0, $::App, $self->{rect} ); 2220} 2221 2222 2223########################################################################## 2224package MenuItem; 2225########################################################################## 2226 2227@MenuItem::ISA = qw(GameObject); 2228use vars qw($Gravity); 2229$Gravity = 0.2; 2230 2231sub new { 2232 my ($class, $x, $y, $text) = @_; 2233 my ($self); 2234 2235 $self = new GameObject; 2236 %{$self} = ( %{$self}, 2237 'targetX' => $x, 2238 'targetY' => $y, 2239 'h' => 42, 2240 'selected' => 0, 2241 'filled' => 0, 2242 'fillcolor' => new SDL::Color(-b=>128), 2243 'parameter' => 0, 2244 'tooltip' => [ @_[4 .. $#_] ], 2245 ); 2246 bless $self, $class; 2247 $self->SetText($text); 2248 $self->SetInitialSpeed(); 2249 return $self; 2250} 2251 2252sub Center { 2253 my $self = shift; 2254 2255 $self->{targetX} = ( $::ScreenWidth - $self->{w} ) / 2; 2256} 2257 2258sub Show { 2259 my $self = shift; 2260 return if $self->CanSelect(); 2261 $self->SetInitialSpeed(); 2262} 2263 2264sub Hide { 2265 my $self = shift; 2266 $self->SUPER::Clear(); 2267 $self->{state} = 'leaving'; 2268 $self->{speedX} = rand(10) - 5; 2269} 2270 2271sub HideAndDelete { 2272 my $self = shift; 2273 $self->Hide(); 2274 $self->{deleteAfterHiding} = 1; 2275} 2276 2277sub Delete { 2278 my $self = shift; 2279 $self->{selected} = $self->{filled} = 0; 2280 $self->SUPER::Delete(); 2281} 2282 2283sub ApproachingSpeed { 2284 my ($position, $speed, $target) = @_; 2285 2286 if ($position + $speed * abs($speed / $Gravity) / 2 > $target) { 2287 return $speed - $Gravity; 2288 } else { 2289 return $speed + $Gravity; 2290 } 2291} 2292 2293sub Advance { 2294 my $self = shift; 2295 2296 if ('entering' eq $self->{state}) { 2297 $self->{x} += $self->{speedX}; 2298 $self->{y} += $self->{speedY}; 2299 $self->{speedX} = &ApproachingSpeed($self->{x}, $self->{speedX}, $self->{targetX}); 2300 $self->{speedY} = &ApproachingSpeed($self->{y}, $self->{speedY}, $self->{targetY}); 2301 if ( abs($self->{x} - $self->{targetX}) + abs($self->{y} - $self->{targetY}) < 2 ) { 2302 $self->{x} = $self->{targetX}; 2303 $self->{y} = $self->{targetY}; 2304 $self->{state} = 'shown'; 2305 } 2306 } elsif ('leaving' eq $self->{state}) { 2307 $self->{x} += $self->{speedX}; 2308 $self->{y} += $self->{speedY}; 2309 $self->{speedY} += $Gravity; 2310 if ($self->{y} > $::PhysicalScreenWidth) { 2311 $self->{state} = 'hidden'; 2312 $self->Delete() if $self->{deleteAfterHiding} 2313 } 2314 } 2315} 2316 2317sub Draw { 2318 my $self = shift; 2319 2320 return if $self->{state} eq 'hidden'; 2321 $self->TransferRect(); 2322 if ($self->{selected} or $self->{filled}) { 2323 $::App->fill($self->{rect}, $self->{fillcolor}); 2324 } 2325 $::App->print($self->{x} + 5 +$::ScreenMargin, $self->{y} + $::ScreenMargin, $self->{text}); 2326} 2327 2328sub SetInitialSpeed { 2329 my $self = shift; 2330 2331 $self->{x} = $self->{targetX} + rand(500) - 250; 2332 $self->{y} = $::PhysicalScreenHeight; 2333 $self->{speedY} = -sqrt( 2 * $Gravity * ($self->{y} - $self->{targetY}) ); 2334 $self->{speedX} = 0; 2335 $self->{state} = 'entering'; 2336} 2337 2338sub InternalSetText { 2339 my ($self, $text) = @_; 2340 2341 $self->SUPER::Clear(); 2342 $self->{text} = $text; 2343 $self->{w} = &::TextWidth($text) + 10; 2344} 2345 2346sub SetText { 2347 my ($self, $text) = @_; 2348 2349 $self->{parameter} = ''; 2350 $self->{basetext} = $text; 2351 $self->InternalSetText($text); 2352} 2353 2354sub SetParameter { 2355 my ($self, $parameter) = @_; 2356 2357 $self->{parameter} = $parameter; 2358 $self->InternalSetText($self->{basetext} . ' ' . $parameter); 2359} 2360 2361sub Select { 2362 my ($self) = @_; 2363 2364 foreach my $item (@::GameObjects) { 2365 $item->{selected} = 0 if ref $item eq 'MenuItem'; 2366 } 2367 $self->{selected} = 1; 2368 $::Game->ShowTooltip( @{$self->{tooltip}} ); 2369} 2370 2371sub CanSelect { 2372 my ($self) = @_; 2373 2374 return $self->{state} =~ /(?:entering|shown)/; 2375} 2376 2377 2378 2379########################################################################## 2380package GameTimer; 2381########################################################################## 2382 2383use vars qw($FirstTick $LastTick $TotalAdvances $LastFpsTick $LastFps $Fps); 2384 2385sub ResetTimer { 2386 $FirstTick = $::App->ticks; 2387 $LastTick = $LastFpsTick = $FirstTick; 2388 $TotalAdvances = 0; 2389 $Fps = $LastFps = 0; 2390} 2391 2392sub GetAdvances { 2393 my ($ticks, $advance); 2394 2395 $ticks = $::App->ticks; 2396 $advance = int(($ticks - $FirstTick) / 10) - $TotalAdvances; 2397 $TotalAdvances += $advance; 2398 2399 # Calculate frames per second; 2400 ++$Fps if $advance > 0; 2401 if ($ticks - $LastFpsTick > 1000) { 2402 $LastFps = $Fps; 2403 $LastFpsTick = $ticks; 2404 $Fps = 0; 2405 } 2406 2407 return $advance; 2408} 2409 2410sub GetFramesPerSecond { 2411 return $LastFps; 2412} 2413 2414 2415########################################################################## 2416package Joystick; 2417########################################################################## 2418 2419use vars qw(@Joysticks @JoystickButtons); 2420 2421sub InitJoystick { 2422 my ($numJoysticks, $joystick, $numButtons, $i); 2423 2424 $numJoysticks = &SDL::NumJoysticks(); 2425 for ($i = 0; $i < $numJoysticks; ++$i) { 2426 print STDERR "Found joystick " , $i+1 , ": " , &SDL::JoystickName($i), "\n"; 2427 $joystick = &SDL::JoystickOpen($i); 2428 next unless $joystick; 2429 $numButtons = &SDL::JoystickNumButtons($joystick); 2430 next unless $numButtons; 2431 push @Joysticks, $joystick; 2432 push @JoystickButtons, $numButtons; 2433 print STDERR "Joystick opened, $numButtons buttons.\n"; 2434 } 2435} 2436 2437sub ReadJoystick { 2438 my ($readBothAxes) = @_; 2439 my ($i, $button, $buttonPressed); 2440 2441 $i = 0; 2442 foreach my $joystick (@Joysticks) { 2443 ++$i; 2444 my $axis = &SDL::JoystickGetAxis($joystick, 0); 2445 if ($axis <= -10000) { 2446 $::Events{"L$i"} = $::MenuEvents{LEFT} = 1 unless $::Keys{"L$i"}; 2447 $::Keys{"L$i"} = 1; 2448 $::Keys{"R$i"} = 0; 2449 } elsif ($axis >= 10000) { 2450 $::Events{"R$i"} = $::MenuEvents{RIGHT} = 1 unless $::Keys{"R$i"}; 2451 $::Keys{"R$i"} = 1; 2452 $::Keys{"L$i"} = 0; 2453 } else { 2454 $::Keys{"L$i"} = 0; 2455 $::Keys{"R$i"} = 0; 2456 } 2457 if ($readBothAxes) { 2458 $axis = &SDL::JoystickGetAxis($joystick, 1); 2459 if ($axis <= -10000) { 2460 $::Events{"U$i"} = $::MenuEvents{UP} = 1 unless $::Keys{"U$i"}; 2461 $::Keys{"U$i"} = 1; 2462 $::Keys{"D$i"} = 0; 2463 } elsif ($axis >= 10000) { 2464 $::Events{"D$i"} = $::MenuEvents{DOWN} = 1 unless $::Keys{"D$i"}; 2465 $::Keys{"D$i"} = 1; 2466 $::Keys{"U$i"} = 0; 2467 } else { 2468 $::Keys{"D$i"} = 0; 2469 $::Keys{"U$i"} = 0; 2470 } 2471 } 2472 $buttonPressed = 0; 2473 for ($button = 0; $button < $JoystickButtons[$i-1]; ++$button) { 2474 if (&SDL::JoystickGetButton($joystick, $button)) { 2475 $buttonPressed = 1; last; 2476 } 2477 } 2478 if ($buttonPressed and not $::Keys{"B$i"}) { 2479 $::Events{"B$i"} = $::MenuEvents{BUTTON} = 1; 2480 } 2481 $::Keys{"B$i"} = $buttonPressed; 2482 } 2483} 2484 2485 2486########################################################################## 2487# PALETTE MANIPULATION 2488########################################################################## 2489 2490package main; 2491 2492sub RgbToHsi { 2493 my ($r, $g, $b) = @_; 2494 my ($min, $max, $delta, $h, $s, $i); 2495 2496 if ($r > $g) { 2497 $max = $r > $b ? $r : $b; 2498 $min = $g < $b ? $g : $b; 2499 } else { 2500 $max = $g > $b ? $g : $b; 2501 $min = $r < $b ? $r : $b; 2502 } 2503 $i = ($min + $max) / 2; 2504 if ($min == $max) { 2505 return (0, 0, $i); 2506 } 2507 2508 $delta = ($max - $min); 2509 if ($i < 128) { 2510 $s = 255 * $delta / ($min + $max); 2511 } else { 2512 $s = 255 * $delta / (511 - $min - $max); 2513 } 2514 2515 if ($r == $max) { 2516 $h = ($g - $b) / $delta; 2517 } elsif ($g == $max) { 2518 $h = 2 + ($b - $r) / $delta; 2519 } else { 2520 $h = 4 + ($r - $g) / $delta; 2521 } 2522 $h = $h * 42.5; 2523 $h += 255 if $h < 0; 2524 $h -= 255 if $h > 255; 2525 2526 return ($h, $s, $i); 2527} 2528 2529sub HsiToRgb { 2530 my ($h, $s, $i) = @_; 2531 my ($m1, $m2); 2532 2533 if ($s < 1) { 2534 $i = int($i + 0.5); 2535 return ($i, $i, $i); 2536 } 2537 2538 if ($i < 128) { 2539 $m2 = ($i * (255 + $s)) / 65025.0; 2540 } else { 2541 $m2 = ($i + $s - ($i * $s) / 255.0) / 255.0; 2542 } 2543 $m1 = ($i / 127.5) - $m2; 2544 2545 return ( 2546 &GetHsiValue( $m1, $m2, $h + 85), 2547 &GetHsiValue( $m1, $m2, $h), 2548 &GetHsiValue( $m1, $m2, $h - 85) 2549 ); 2550} 2551 2552sub GetHsiValue { 2553 my ($n1, $n2, $hue) = @_; 2554 my ($value); 2555 2556 $hue -= 255 if ($hue > 255); 2557 $hue += 255 if ($hue < 0); 2558 if ($hue < 42.5) { 2559 $value = $n1 + ($n2 - $n1) * ($hue / 42.5); 2560 } elsif ($hue < 127.5) { 2561 $value = $n2; 2562 } elsif ($hue < 170) { 2563 $value = $n1 + ($n2 - $n1) * ((170 - $hue) / 42.5); 2564 } else { 2565 $value = $n1; 2566 } 2567 return int($value * 255 + 0.5); 2568} 2569 2570########################################################################## 2571# GRAPHICS-RELATED SUBS 2572########################################################################## 2573 2574package SDL::Surface; 2575 2576sub display_format_alpha { 2577 my $self = shift; 2578 my $tmp = SDL::DisplayFormatAlpha($$self); 2579 SDL::FreeSurface ($$self); 2580 $$self = $tmp; 2581 $self; 2582} 2583 2584package main; 2585 2586sub LoadSurfaces { 2587 my ($i, $transparentColor); 2588 2589 my %balls = qw ( 2590 ball0 Balls-Red128.png ball1 Balls-Red96.png ball2 Balls-Red64.png ball3 Balls-Red32.png ball4 Balls-Red16.png 2591 xmas Balls-XMAS128.png 2592 ball4 Balls-Red16.png ball3 Balls-Red32.png 2593 bouncy2 Balls-Bouncy64.png bouncy3 Balls-Bouncy32.png bouncy4 Balls-Bouncy16.png 2594 hexa0 Hexa-64.png hexa1 Hexa-32.png hexa2 Hexa-16.png 2595 blue1 Balls-Water96.png blue2 Balls-Water64.png blue3 Balls-Water32.png blue4 Balls-Water16.png 2596 frag0 Balls-Fragile128.png frag1 Balls-Fragile96.png frag2 Balls-Fragile64.png frag3 Balls-Fragile32.png frag4 Balls-Fragile16.png 2597 green1 Balls-SuperClock96.png green2 Balls-SuperClock64.png gold1 Balls-SuperStar96.png gold2 Balls-SuperStar64.png 2598 death2 Balls-Death64.png 2599 white2 Balls-Seeker64.png white3 Balls-Seeker32.png 2600 quake2 Balls-EarthQ64.png quake3 Balls-EarthQ32.png quake4 Balls-EarthQ16.png 2601 upside0 Balls-Upside128.png upside1 Balls-Upside96.png upside2 Balls-Upside64.png upside3 Balls-Upside32.png upside4 Balls-Upside16.png 2602 ); 2603 2604 foreach (sort keys %balls) { 2605 $BallSurfaces{$_} = new SDL::Surface( -name => "$DataDir/$balls{$_}" ); 2606 $transparentColor = $BallSurfaces{$_}->pixel(0,0); 2607 $BallSurfaces{$_}->set_color_key(SDL_SRCCOLORKEY, $transparentColor ); 2608 # print join(' ', $_, "\t", $transparentColor->r, $transparentColor->g, $transparentColor->b), "\n"; 2609 $BallSurfaces{$_}->display_format(); 2610 $BallSurfaces{"dark$_"} = new SDL::Surface( -name => "$DataDir/$balls{$_}" ); 2611 $BallSurfaces{"dark$_"}->set_color_key(SDL_SRCCOLORKEY, $BallSurfaces{"dark$_"}->pixel(0,0) ); 2612 $BallSurfaces{"dark$_"}->set_alpha(SDL_SRCALPHA, 128); 2613 $BallSurfaces{"dark$_"}->display_format(); 2614 } 2615 2616 $BorderSurface = new SDL::Surface( -name => "$DataDir/border.png" ); 2617 $RedBorderSurface = new SDL::Surface( -name => "$DataDir/border.png" ); 2618 $WhiteBorderSurface = new SDL::Surface( -name => "$DataDir/border.png" ); 2619 $BonusSurface = new SDL::Surface( -name => "$DataDir/bonus.png" ); 2620 $LevelIndicatorSurface = new SDL::Surface( -name => "$DataDir/level.png" ); 2621 $LevelIndicatorSurface2 = new SDL::Surface( -name => "$DataDir/level_empty.png" ); 2622 2623 &AlterPalette( $RedBorderSurface, sub { 1; }, 2624 sub { shift @_; my ($h, $s, $i) = &RgbToHsi(@_); return &HsiToRgb( $h - 30, $s, $i * 0.75 + 63); } ); 2625 &AlterPalette( $WhiteBorderSurface, sub { 1; }, 2626 sub { shift @_; my ($h, $s, $i) = &RgbToHsi(@_); return &HsiToRgb( 0, 0, $i*0.25 + 191 ); } ); 2627 2628 &MakeGuySurfaces(); 2629} 2630 2631sub MakeGuySurface { 2632 my ($player) = @_; 2633 my ($guySurfaceFile, $guySurface, $whiteGuySurface, $harpoonSurface); 2634 2635 $guySurfaceFile = $DataDir . '/' . $GuyImageFiles[ $player->{imagefileindex} % scalar(@GuyImageFiles) ]; 2636 $guySurface = new SDL::Surface( -name => ($guySurfaceFile) ); 2637 $whiteGuySurface = new SDL::Surface( -name => ($guySurfaceFile) ); 2638 $harpoonSurface = new SDL::Surface( -name => "$DataDir/harpoon.png" ); 2639 $player->{hue} = $GuyColors[$player->{colorindex}]->[0]; 2640 $player->{saturation} = $GuyColors[$player->{colorindex}]->[1]; 2641 2642 &AlterPalette($whiteGuySurface, sub {1;}, sub { return (255, 255, 255); } ); 2643 &AlterPalette( $guySurface, sub { $_[3] > $_[2] and $_[3] > $_[1]; }, 2644 sub { 2645 shift @_; 2646 my ($h, $s, $i) = &RgbToHsi(@_); 2647 return &HsiToRgb($player->{hue}, $player->{saturation}, $i); } 2648 ); 2649 &AlterPalette( $harpoonSurface, sub { 1; }, 2650 sub { 2651 shift @_; 2652 my ($h, $s, $i) = &RgbToHsi(@_); 2653 return &HsiToRgb($player->{hue}, $player->{saturation} * $s / 256, $i); } 2654 ); 2655 $player->{guySurface} = $guySurface; 2656 $player->{whiteGuySurface} = $whiteGuySurface; 2657 $player->{harpoonSurface} = $harpoonSurface; 2658} 2659 2660sub MakeGuySurfaces { 2661 foreach my $player (@Players) { 2662 &MakeGuySurface($player); 2663 } 2664 2665 $WhiteHarpoonSurface = new SDL::Surface( -name => "$DataDir/harpoon.png" ); 2666 &AlterPalette($WhiteHarpoonSurface, sub {1;}, sub { return (255, 255, 255); } ); 2667} 2668 2669sub AlterPalette($$$) { 2670 my ($surface, $filterSub, $alterSub) = @_; 2671 my ($r, $g, $b); 2672 my ($palette, $numColors, $n, $color); 2673 2674 $palette = $surface->palette(); 2675 $numColors = SDL::PaletteNColors($palette); 2676 for ($n = 1; $n < $numColors; ++$n) { 2677 $color = SDL::PaletteColors($palette, $n); 2678 ($r, $g, $b) = ( SDL::ColorR($color), SDL::ColorG($color), SDL::ColorB($color) ); 2679 2680 next unless $filterSub->($n, $r, $g, $b); 2681 ($r, $g, $b) = $alterSub->($n, $r, $g, $b); 2682 $r = $g = $b = 4 if ($r == 0 and $g == 0 and $b == 0); 2683 2684 SDL::PaletteColors($palette, $n, $r, $g, $b); 2685 } 2686 $surface->display_format(); 2687} 2688 2689sub RenderBorder { 2690 my ($borderSurface, $targetSurface) = @_; 2691 my ($dstrect, $srcrect1, $srcrect2, $xpos, $ypos, $width, $height); 2692 2693 $width = $ScreenWidth + 2 * $ScreenMargin; 2694 $height = $ScreenHeight + 2 * $ScreenMargin; 2695 2696 # Draw the corners 2697 $dstrect = new SDL::Rect( -width => 16, -height =>16); 2698 $srcrect1 = new SDL::Rect( -width => 16, -height =>16); 2699 $borderSurface->blit($srcrect1, $targetSurface, $dstrect); 2700 $dstrect->x($width - 16); $srcrect1->x(144); 2701 $borderSurface->blit($srcrect1, $targetSurface, $dstrect); 2702 $dstrect->y($height - 16); $srcrect1->y(144); 2703 $borderSurface->blit($srcrect1, $targetSurface, $dstrect); 2704 $dstrect->x(0); $srcrect1->x(0); 2705 $borderSurface->blit($srcrect1, $targetSurface, $dstrect); 2706 2707 if ($::RotoZoomer) { 2708 # Top border 2709 my $zoom = new SDL::Surface( -name =>'', 2710 -flags=>::SDL_SWSURFACE(), -width => 128, -height => 16, -depth => 32); 2711 $srcrect1->x(16); $srcrect1->y(0); $srcrect1->width(128); $srcrect1->height(16); 2712 $borderSurface->blit( $srcrect1, $zoom, new SDL::Rect ); 2713 $::RotoZoomer->zoom( $zoom, $ScreenWidth / 128, 1, $::SmoothRotoZoom); 2714 $dstrect->x(16); $dstrect->y(0); 2715 $zoom->blit( 0, $targetSurface, $dstrect ); 2716 2717 # Left border 2718 $zoom = new SDL::Surface( -name =>'', 2719 -flags=>::SDL_SWSURFACE(), -width => 16, -height => 128, -depth => 32); 2720 $srcrect1->x(0); $srcrect1->y(16); $srcrect1->height(128); $srcrect1->width(16); 2721 $borderSurface->blit( $srcrect1, $zoom, new SDL::Rect ); 2722 $::RotoZoomer->zoom( $zoom, 1, $ScreenHeight / 128, $::SmoothRotoZoom); 2723 $dstrect->x(0); $dstrect->y(16); 2724 $zoom->blit( 0, $targetSurface, $dstrect ); 2725 } 2726 2727 # Draw top and bottom border 2728 2729 $srcrect1->width(128); $srcrect1->x(16); $srcrect1->y(0); 2730 $srcrect2 = new SDL::Rect( -width => 128, -height => 16, -x => 16, -y => 144 ); 2731 for ($xpos = 16; $xpos < $width-16; ) { 2732 $dstrect->x($xpos); 2733 $dstrect->y(0); 2734 $borderSurface->blit($srcrect1, $targetSurface, $dstrect); 2735 $dstrect->y($height - 16); 2736 $borderSurface->blit($srcrect2, $targetSurface, $dstrect); 2737 $xpos += $srcrect1->width(); 2738 $srcrect1->width(16); $srcrect1->x(128); 2739 $srcrect2->width(16); $srcrect2->x(128); 2740 } 2741 2742 # Draw left and right border 2743 2744 $srcrect1->height(128); $srcrect1->y(16); $srcrect1->x(0); 2745 $srcrect2->height(128); $srcrect2->y(16); $srcrect2->x(144); 2746 for ($ypos = 16; $ypos < $height-16; ) { 2747 $dstrect->x(0); 2748 $dstrect->y($ypos); 2749 $borderSurface->blit($srcrect1, $targetSurface, $dstrect); 2750 $dstrect->x($width - 16); 2751 $borderSurface->blit($srcrect2, $targetSurface, $dstrect); 2752 $ypos += $srcrect1->height(); 2753 $srcrect1->height(16); $srcrect1->y(128); 2754 $srcrect2->height(16); $srcrect2->y(128); 2755 } 2756 2757 if ($::RotoZoomer) { 2758 # Top border 2759 my $zoom = new SDL::Surface( -name =>'', 2760 -flags=>::SDL_SWSURFACE(), -width => 128, -height => 16, -depth => 32); 2761 $srcrect1->x(16); $srcrect1->y(0); $srcrect1->width(128); $srcrect1->height(16); 2762 $borderSurface->blit( $srcrect1, $zoom, new SDL::Rect ); 2763 $::RotoZoomer->zoom( $zoom, $ScreenWidth / 128, 1, $::SmoothRotoZoom); 2764 $dstrect->x(16); $dstrect->y(0); 2765 $zoom->blit( 0, $targetSurface, $dstrect ); 2766 2767 # Left border 2768 $zoom = new SDL::Surface( -name =>'', 2769 -flags=>::SDL_SWSURFACE(), -width => 16, -height => 128, -depth => 32); 2770 $srcrect1->x(0); $srcrect1->y(16); $srcrect1->height(128); $srcrect1->width(16); 2771 $borderSurface->blit( $srcrect1, $zoom, new SDL::Rect ); 2772 $::RotoZoomer->zoom( $zoom, 1, $ScreenHeight / 128, $::SmoothRotoZoom); 2773 $dstrect->x(0); $dstrect->y(16); 2774 $zoom->blit( 0, $targetSurface, $dstrect ); 2775 } 2776} 2777 2778sub LoadBackground { 2779 my $filename = shift; 2780 my ($backgroundImage, $srcrect, $dstrect); 2781 2782 $Background->fill( new SDL::Rect(-width=>$PhysicalScreenWidth, -height=>$PhysicalScreenHeight), new SDL::Color() ); 2783 $backgroundImage = new SDL::Surface(-name => "$DataDir/$filename"); 2784 $dstrect = new SDL::Rect(-x => $ScreenMargin, -y => $ScreenMargin); 2785 $srcrect = new SDL::Rect(-width => $ScreenWidth, -height => $ScreenHeight); 2786 if ($ScreenWidth != $backgroundImage->width() or $ScreenHeight != $backgroundImage->height()) { 2787 if ($::RotoZoomer) { 2788 my $zoomX = $ScreenWidth / $backgroundImage->width(); # $zoomX = 1.0 if $zoomX < 1.0; 2789 my $zoomY = $ScreenHeight / $backgroundImage->height(); # $zoomY = 1.0 if $zoomY < 1.0; 2790 $backgroundImage = $::RotoZoomer->zoom($backgroundImage, $zoomX, $zoomY, $::SmoothRotoZoom); 2791 } 2792 } 2793 $backgroundImage->blit($srcrect, $Background, $dstrect); 2794 2795 &RenderBorder($BorderSurface, $Background); 2796} 2797 2798sub TextWidth { 2799 if (defined(&SDL::App::SDL_TEXTWIDTH)) { 2800 SDL::App::SDL_TEXTWIDTH(@_); # perl-sdl-1.x 2801 } else { 2802 SDL::SFont::SDL_TEXTWIDTH(@_); # perl-sdl-2.x 2803 } 2804} 2805 2806sub FindVideoMode { 2807 if ($FullScreen < 2) { 2808 return (800, 600); 2809 } 2810 2811 # Find a suitable widescreen mode 2812 # One native resolution: 1680 x 1050 => 1.6 : 1 2813 # Which could translate to: 840 x 525 => 1.6 : 1 2814 # Some adapters have: 848 x 480 => 1.76 : 1 2815 # 720 x 480 => 1.5 : 1 2816 # 800 x 512 => 1.56 : 1 2817 # Conclusion: Any resolution where w in [800,900], h > 480 and r in [1.5, 1.8] is good 2818 2819 my ($modes, $mode, @goodModes, $w, $h, $ratio); 2820 $modes = SDL::ListModes( 0, SDL_FULLSCREEN|SDL_HWSURFACE ); 2821 foreach $mode (@{$modes}) { 2822 $w = SDL::RectW($mode); 2823 $h = SDL::RectH($mode); 2824 $ratio = $w / $h; 2825 # print sprintf( "%4d x %4d => %0.3f\n", $w, $h, $ratio ); 2826 next if $w < 800 or $w > 900; 2827 next if $h < 480; 2828 next if $ratio < 1.5 or $ratio > 1.8; 2829 push @goodModes, ( { -w => $w, -h => $h, -score => abs($ratio - 1.6) * 1000 + abs($w - 800) } ); 2830 } 2831 @goodModes = sort { $a->{-score} <=> $b->{-score} } @goodModes; 2832 return (800, 600) unless @goodModes; 2833 foreach $mode (@goodModes) { 2834 print sprintf( '%d x %d => %0.3f (score %d)', $mode->{-w}, $mode->{-h}, $mode->{-w} / $mode->{-h}, $mode->{-score} ), "\n"; 2835 } 2836 return ($goodModes[0]->{-w}, $goodModes[0]->{-h}); 2837} 2838 2839 2840########################################################################## 2841# SOUNDS 2842########################################################################## 2843 2844sub LoadMusic { 2845 my ($filename) = @_; 2846 my ($result); 2847 2848 return undef unless -f $filename; 2849 $result = new SDL::Music($filename); 2850 return undef unless $result; 2851 return $result if $result->isa("SDL::Music"); # SDL_perl 2.? workaround 2852 return undef unless ref $result; 2853 return undef unless $result->{-data}; 2854 return $result; 2855} 2856 2857sub LoadSounds { 2858 $Mixer = eval { SDL::Mixer->new(-frequency => 22050, -channels => 2, -size => 1024); }; 2859 if ($@) { 2860 warn $@; 2861 return 0; 2862 } 2863 2864 my ($soundName, $fileName); 2865 while (($soundName, $fileName) = each %Sounds) { 2866 $Sounds{$soundName} = new SDL::Sound("$DataDir/$fileName"); 2867 } 2868 2869 $::music = LoadMusic("$DataDir/UPiPang.mp3"); 2870 $::music = LoadMusic("$DataDir/UPiPang.mid") unless $::music; 2871 &SetMusicEnabled($MusicEnabled); 2872} 2873 2874sub PlaySound { 2875 return unless $SoundEnabled; 2876 my $sound = shift; 2877 $Mixer and $Sounds{$sound} and $Mixer->play_channel(-1, $Sounds{$sound}, 0); 2878} 2879 2880sub SetMusicEnabled { 2881 return $MusicEnabled = 0 unless $::music; 2882 my $musicEnabled = shift; 2883 2884 $MusicEnabled = $musicEnabled ? 1 : 0; 2885 if ( (not $MusicEnabled) and $Mixer->playing_music() ) { 2886 $Mixer->halt_music(); 2887 } 2888 if ($MusicEnabled and not $Mixer->playing_music()) { 2889 $Mixer->play_music($::music, -1); 2890 } 2891} 2892 2893 2894 2895package PlaybackGame; 2896package RecordGame; 2897package PanicGame; 2898package ChallengeGame; 2899package TutorialGame; 2900package DemoGame; 2901package Menu; 2902 2903########################################################################## 2904package GameBase; 2905########################################################################## 2906 2907sub new { 2908 my ($class) = @_; 2909 my $self = { 2910 'abortgame' => 0, 2911 'anim' => 0, 2912 'nocollision' => 0, 2913 'backgrounds' => [ 'desert2.png', ], 2914 }; 2915 $::GameSpeed = 1.0; 2916 $::GamePause = 0; 2917 bless $self, $class; 2918} 2919 2920sub Exit { 2921 &::ShowWebPage("http://apocalypse.rulez.org/pangzero/Thanks_For_Playing_Pang_Zero_$::Version" ) if $::ShowWebsite ne $::Version; 2922 exit; 2923} 2924 2925sub Rand { 2926 shift; 2927 return rand($_[0]); 2928} 2929 2930sub Delay { 2931 my ($self, $ticks) = @_; 2932 2933 while ($ticks > 0) { 2934 my $advance = $self->CalculateAdvances(); 2935 %::Events = (); 2936 &::HandleEvents(); 2937 return if $self->{abortgame}; 2938 $ticks -= $advance; 2939 $self->DrawGame(); 2940 } 2941} 2942 2943sub SetGameSpeed { 2944} 2945 2946sub SetBackground { 2947 my ($self, $backgroundIndex) = @_; 2948 2949 return if $backgroundIndex >= scalar( @{$self->{backgrounds}} ); 2950 &::LoadBackground($self->{backgrounds}->[$backgroundIndex]); 2951 $::Background->blit(0, $::App, 0); 2952} 2953 2954sub ShowTooltip { 2955} 2956 2957sub ResetGame { 2958 my $self = shift; 2959 2960 @::GameObjects = (); 2961 %Guy::Guys = (); 2962 %Harpoon::Harpoons = (); 2963 $::GamePause = 0; 2964 %::GameEvents = (); 2965 $self->SetBackground(0); 2966} 2967 2968sub CalculateAdvances { 2969 my $advance = &GameTimer::GetAdvances(); 2970 while ($advance <= 0) { 2971 $::App->delay(3); # Wait 3ms = 0.3 game ticks 2972 $advance = &GameTimer::GetAdvances(); 2973 } 2974 if ($advance > 5) { 2975 # print STDERR "advance = $advance!\n"; 2976 $advance = 5; 2977 } 2978 return $advance; 2979} 2980 2981sub AdvanceGameObjects { 2982 my ($self) = @_; 2983 2984 ++$self->{anim}; 2985 foreach my $gameObject (@::GameObjects) { 2986 $gameObject->Advance(); 2987 } 2988} 2989 2990sub OnBallPopped { 2991} 2992 2993sub DrawGame { 2994 my ($self) = @_; 2995 2996 my ($gameObject); 2997 foreach $gameObject (@::GameObjects) { 2998 $gameObject->Clear(); 2999 } 3000 $self->DrawScoreBoard(); 3001 foreach $gameObject (@::GameObjects) { 3002 $gameObject->Draw(); 3003 } 3004 $::App->sync(); 3005} 3006 3007sub DrawScoreBoard() { 3008} 3009 3010 3011########################################################################## 3012package PlayableGameBase; 3013########################################################################## 3014 3015@PlayableGameBase::ISA = qw( GameBase ); 3016 3017sub new { 3018 my ($class) = @_; 3019 my $self = new GameBase; 3020 %{$self} = (%{$self}, 3021 'playersalive' => 0, 3022 'level' => 0, 3023 'backgrounds' => [ qw( desert2.png l1.jpg l2.jpg l3.jpg l4.jpg l5.jpg l6.jpg l7.jpg l8.jpg l9.jpg )], 3024 ); 3025 bless $self, $class; 3026} 3027 3028sub ResetGame { 3029 my $self = shift; 3030 3031 $self->SUPER::ResetGame(); 3032 $self->{playersalive} = 0; 3033 $::GamePause = 0; 3034 3035 foreach my $player (@::Players) { 3036 last if $player->{number} >= $::NumGuys; 3037 $self->SpawnPlayer($player); 3038 } 3039 $self->SetGameLevel(0); 3040 $self->LayoutScoreBoard(); 3041 push @::GameObjects, (new FpsIndicator); 3042} 3043 3044sub SetGameSpeed { 3045 my $self = shift; 3046 3047 $::GameSpeed = 0.8 * $::DifficultyLevel->{speed}; 3048} 3049 3050sub SetGameLevel { 3051 my ($self, $level) = @_; 3052 3053 $self->{level} = $level; 3054 if (($level % 10) == 9) { 3055 $self->SetBackground( int($level / 10) + 1 ); 3056 } 3057 $self->SetGameSpeed(); 3058} 3059 3060sub SpawnPlayer { 3061 my ($self, $player) = @_; 3062 3063 $player->{score} = 0; 3064 $player->{scoreforbonuslife} = 200000; 3065 $player->{lives} = 2; 3066 $player->{startX} = ($::ScreenWidth - $::NumGuys * 60) / 2 + 60 * ($player->{number}+0.5) - 32; 3067 $player->{respawn} = -1; 3068 my $guy = new Guy($player); 3069 push @::GameObjects, ($guy); 3070 ++$self->{playersalive}; 3071 return $guy; 3072} 3073 3074sub AdvanceGameObjects { 3075 my ($self) = @_; 3076 3077 $self->SUPER::AdvanceGameObjects(); 3078 $self->RespawnPlayers(); 3079 --$::GamePause if $::GamePause > 0; 3080} 3081 3082sub RespawnPlayers { 3083 my $self = shift; 3084 3085 foreach my $player (@::Players) { 3086 last if $player->{number} >= $::NumGuys; 3087 if ($player->{respawn} > 0) { 3088 --$player->{respawn}; 3089 $player->{score} = int($player->{respawn} / 100) if $self->{playersalive}; 3090 if ($player->{respawn} <= 0) { 3091 my $guy = $self->SpawnPlayer($player); 3092 $guy->{invincible} = 500; 3093 } 3094 } 3095 } 3096} 3097 3098sub PlayerNextLife { 3099 my ($self, $guy) = @_; 3100 3101 $guy->DeleteHarpoons; 3102 if ($guy->{player}->{lives}--) { 3103 $guy->{x} = $guy->{player}->{startX}; 3104 $guy->{y} = $::ScreenHeight - $guy->{h}; 3105 $guy->{state} = 'idle'; 3106 $guy->{speedY} = $guy->{speedX} = 0; 3107 $guy->{invincible} = 500; # 0.5s 3108 $guy->{killed} = 0; 3109 $guy->{justkilled} = 0; 3110 $self->{playerspawned} = 1; 3111 } else { 3112 # One player less 3113 &::AddHighScore($guy->{player}, $guy->{player}->{score}, $self->{level} + 1); 3114 $guy->Delete(); 3115 --$self->{playersalive}; 3116 $guy->{player}->{respawn} = 6000; # 60s 3117 } 3118} 3119 3120sub PlayerDeathSequence { 3121 my $self = shift; 3122 my (@killedGuys, @deadGuys, $guy, $i); 3123 3124 $self->DrawGame(); 3125 ::PlaySound('death'); 3126 &::RenderBorder($::WhiteBorderSurface, $::App); 3127 $::App->sync(); 3128 $self->Delay(10); 3129 &::RenderBorder($::RedBorderSurface, $::App); 3130 &::RenderBorder($::RedBorderSurface, $::Background); 3131 $::App->sync(); 3132 $self->Delay(90); 3133 3134 @killedGuys = grep { $_->{justkilled}; } @::GameObjects; 3135 foreach $guy (@killedGuys) { 3136 $guy->Clear(); 3137 $guy->{killed} = 1; 3138 push @deadGuys, (new DeadGuy($guy)); 3139 } 3140 push @::GameObjects, (@deadGuys); 3141 3142 for ($i = 0; $i < 300; ++$i) { 3143 &::HandleEvents(); 3144 return if $self->{abortgame}; 3145 my $advance = $self->CalculateAdvances(); 3146 while ($advance--) { 3147 foreach my $gameObject (@deadGuys) { 3148 $gameObject->Advance(); 3149 } 3150 } 3151 $self->DrawGame(); 3152 last if $deadGuys[0]->{deleted}; 3153 } 3154 3155 foreach $guy (@killedGuys) { 3156 $self->PlayerNextLife($guy); 3157 } 3158 3159 &::RenderBorder($::BorderSurface, $::App); 3160 &::RenderBorder($::BorderSurface, $::Background); 3161} 3162 3163sub SuperKill { 3164 my ($self, $guy) = @_; 3165 3166 my @gameObjects = @::GameObjects; 3167 my $sound = 0; 3168 foreach my $ball (@gameObjects) { 3169 next unless $ball->isa("Ball"); 3170 $ball->Pop($guy, 'superkill'); 3171 $sound = 1; 3172 } 3173 ::PlaySound('pop') if $sound; 3174} 3175 3176sub PopEveryBall { 3177 my $self = shift; 3178 my (@gameObjects, @guys); 3179 3180 @gameObjects = @::GameObjects; 3181 foreach (@gameObjects) { 3182 if ($_->isa('Ball')) { 3183 $_->Pop(undef, 'meltdown'); 3184 } elsif ('Guy' eq ref $_) { 3185 push @guys, $_; 3186 } 3187 } 3188 return @guys; 3189} 3190 3191sub DeathballMeltdown { 3192 my ($self) = @_; 3193 my ($i, $meltdown, $allKilled, @guys, @killedGuys, @deadGuys); 3194 3195 $self->{nocollision} = 1; 3196 $meltdown = new Meltdown; 3197 push @::GameObjects, $meltdown; 3198 3199 for ($i = 0; $i < 300; ++$i) { 3200 %::Events = (); 3201 &::HandleEvents(); 3202 return if $self->{abortgame}; 3203 my $advance = $self->CalculateAdvances(); 3204 while ($advance--) { 3205# TODO REINSTATE THIS IN 1.1!!! $self->PreAdvanceAction(); # Hook for something special 3206 $self->SUPER::AdvanceGameObjects(); 3207 $::GamePause = 0; 3208 if ($meltdown->{bounce} and not $allKilled) { 3209 $allKilled = 1; 3210 @guys = $self->PopEveryBall(); 3211 foreach (@guys) { 3212 $_->{killed} = 1; 3213 push @deadGuys, (new DeadGuy($_)); 3214 push @killedGuys, $_; 3215 } 3216 push @::GameObjects, (@deadGuys); 3217 } 3218 } 3219 $self->DrawGame(); 3220 } 3221 3222 foreach (@killedGuys) { 3223 $self->PlayerNextLife($_); 3224 } 3225 3226 $self->{nocollision} = 0; 3227} 3228 3229 3230########################################################################## 3231# GAME DRAWING 3232########################################################################## 3233 3234sub DrawScoreBoard { 3235 my ($self) = @_; 3236 my ($x, $y, $widthPerGuy); 3237 3238 $self->DrawLevelIndicator( 10, $self->{scoreBoardTop} ); 3239 for (my $i = 0; $i < $::NumGuys; ++$i) { 3240 $self->DrawScore( $::Players[$i], $::Players[$i]->{scoreX}, $::Players[$i]->{scoreY} ); 3241 } 3242} 3243 3244sub LayoutScoreBoard { 3245 my ($self) = @_; 3246 my ($i, $scoreBoardHeight, $scoreBoardTop, $rows, $rowHeight, $leftMargin, $guysPerRow, $widthPerGuy); 3247 3248 $scoreBoardTop = $::ScreenHeight + $::ScreenMargin * 2 + 5; 3249 $scoreBoardHeight = $::PhysicalScreenHeight - $scoreBoardTop; 3250 $rowHeight = 64; 3251 $leftMargin = 150; 3252 $rows = $::NumGuys > 4 ? 2 : 1; 3253 $rows = 1 if ($scoreBoardTop + $rows * $rowHeight > $::PhysicalScreenHeight); 3254 if ($scoreBoardTop + $rows * $rowHeight > $::PhysicalScreenHeight) { 3255 $rowHeight = 32; 3256 $scoreBoardTop = $::PhysicalScreenHeight - 32; 3257 } 3258 $guysPerRow = int ($::NumGuys / $rows + 0.5); 3259 $widthPerGuy = ($::PhysicalScreenWidth - $leftMargin) / $guysPerRow; 3260 for ($i = 0; $i < $::NumGuys; ++$i) { 3261 $::Players[$i]->{scoreX} = $leftMargin + ($i % $guysPerRow) * $widthPerGuy; 3262 $::Players[$i]->{scoreY} = $scoreBoardTop + int ($i / $guysPerRow) * $rowHeight; 3263 $::Players[$i]->{scoreRect} = 3264 new SDL::Rect(-x => $::Players[$i]->{scoreX}, -y => $::Players[$i]->{scoreY}, -width=> 130, -height=> $rowHeight); 3265 } 3266 $self->{scoreBoardTop} = $scoreBoardTop; 3267 $self->{scoreBoardHeight} = $scoreBoardHeight; 3268 $self->{rowHeight} = $rowHeight; 3269 3270} 3271 3272sub DrawLevelIndicator { 3273 my ($self, $x, $y) = @_; 3274 3275 $self->{levelIndicatorRect} = new SDL::Rect(-x => $x, -y => $y, -width => 100, -height => 32) unless $self->{levelIndicatorRect}; 3276 $::App->fill( $self->{levelIndicatorRect}, new SDL::Color() ); 3277 $::App->print( $x, $y + 3, 'Level ' . ($self->{level}+1) ); 3278} 3279 3280sub PrintNumber { 3281 my ($self, $player, $x, $y, $number) = @_; 3282 my ($numberText, $i, $srcrect, $dstrect); 3283 3284 $numberText = sprintf("%d", $number); 3285 $srcrect = new SDL::Rect(-width => 16, -height => 16, -y => 160); 3286 $dstrect = new SDL::Rect(-width => 16, -height => 16, -y => $y, -x => $x); 3287 for ($i = 0; $i < length($numberText); ++$i) { 3288 $srcrect->x(320 + (ord(substr($numberText, $i)) - ord('0')) * 16); 3289 $dstrect->x($x + $i * 16); 3290 $player->{guySurface}->blit( $srcrect, $::App, $dstrect ); 3291 } 3292} 3293 3294sub DrawScore { 3295 my ($self, $player, $x, $y, $livesY) = @_; 3296 my ($i, $srcrect, $dstrect); 3297 3298 $::App->fill($player->{scoreRect}, new SDL::Color()); 3299 $self->PrintNumber( $player, $x, $y, $player->{score}); 3300 3301 $livesY = $self->{rowHeight} > 32 ? $y + 24 : $y + 16; 3302 3303 $dstrect = new SDL::Rect(-width => 32, -height => 32, -x =>$x, -y => $livesY); 3304 if ($self->{rowHeight} <=32) { 3305 $srcrect = new SDL::Rect(-width => 16, -height => 16, -x =>320, -y => 176); 3306 } else { 3307 $srcrect = new SDL::Rect(-width => 32, -height => 32, -x =>320, -y => 128); 3308 } 3309 3310 if ($player->{lives} > 3) { 3311 $player->{guySurface}->blit( $srcrect, $::App, $dstrect ); 3312 $self->PrintNumber( $player, $x + $srcrect->width() + 8, $livesY + ($srcrect->height() - 16 ) / 2, $player->{lives} ); 3313 } else { 3314 foreach $i ( 0 .. $player->{lives}-1 ) { 3315 $dstrect->x( $x + $i * ($srcrect->width() + 4) ); 3316 $player->{guySurface}->blit( $srcrect, $::App, $dstrect ); 3317 } 3318 } 3319} 3320 3321sub PreAdvanceAction {} 3322 3323sub AdvanceGame { 3324 my $self = shift; 3325 3326 %::GameEvents = (); 3327 $self->PreAdvanceAction(); # Hook for something special 3328 3329 if ($self->{superKillCount} > 0) { 3330 if (--$self->{superKillDelay} <= 0) { 3331 --$self->{superKillCount}; 3332 $self->{superKillDelay} = 50; 3333 $self->SuperKill($self->{superKillGuy}); 3334 } 3335 $::GamePause = 0; 3336 } 3337 3338 $self->AdvanceGameObjects(); 3339 if ($::GameEvents{earthquake}) { 3340 &::PlaySound('quake'); 3341 foreach my $guy (@::GameObjects) { 3342 $guy->Earthquake($::GameEvents{earthquake}) if ref $guy eq 'Guy'; 3343 } 3344 } 3345 3346 if ($::GameEvents{'pop'}) { 3347 &::PlaySound('pop'); 3348 } 3349 3350 if ($::GameEvents{meltdown} and $::DifficultyLevel->{name} ne 'Miki') { 3351 $self->DeathballMeltdown(); 3352 } elsif ($::GameEvents{kill} ) { 3353 $self->PlayerDeathSequence(); 3354 return if $self->{playersalive} <= 0; 3355 $::GamePause = 200 if $::GamePause < 200; 3356 &GamePause::Show(); 3357 } elsif ($::GameEvents{magic}) { 3358 if ($::GamePause < 200) { 3359 $::GamePause = 200; &::PlaySound('pause'); 3360 &GamePause::Show(); 3361 } 3362 } elsif ($::GameEvents{superpause}) { 3363 if ($::GamePause < 800) { 3364 $::GamePause = 800; &::PlaySound('pause'); 3365 &GamePause::Show(); 3366 } 3367 } elsif ($::GameEvents{superkill}) { 3368 $self->{superKillCount} = 5; 3369 $self->{superKillDelay} = 0; 3370 $self->{superKillGuy} = $::GameEvents{superkillguy}; 3371 $self->{spawndelay} = 250; 3372 $self->{superballdelay} += 1000; # 10 second penalty 3373 my @gameObjects = @::GameObjects; 3374 foreach my $spawningBall (@gameObjects) { $spawningBall->Delete if $spawningBall->{spawning}; } 3375 } 3376} 3377 3378sub Run { 3379 my ($self) = shift; 3380 3381 $self->ResetGame(); 3382 &GameTimer::ResetTimer(); 3383 3384 $self->{superKillCount} = 0; 3385 $self->{superKillDelay} = 0; 3386 $self->{superKillGuy} = undef; 3387 3388 while (1) { 3389 3390 # Calculate advance (how many game updates to perform) 3391 my $advance = $self->CalculateAdvances(); 3392 3393 # Advance the game 3394 3395 %::Events = (); 3396 &::HandleEvents(); 3397 while ($advance--) { 3398 return if $self->{abortgame}; 3399 $self->AdvanceGame(); 3400 } 3401 if ($self->{playersalive} <= 0) { 3402 my $gameoverSurface = new SDL::Surface(-name => "$::DataDir/gameover.png"); 3403 my @gameObjects = @::GameObjects; 3404 foreach (@gameObjects) { $_->Delete() if ('DeadGuy' eq ref $_); } 3405 $self->DrawGame(); 3406 $gameoverSurface->blit(0, $::App, new SDL::Rect(-x => ($::PhysicalScreenWidth - $gameoverSurface->width) / 2, -y => $::PhysicalScreenHeight / 2 - 100)); 3407 $::App->sync(); 3408 $::App->delay(1000); 3409 for (my $i=0; $i < 20; ++$i) { 3410 $::App->delay(100); 3411 %::Events = (); 3412 &::HandleEvents(); 3413 last if $self->{abortgame}; 3414 last if %::Events; 3415 } 3416 last; 3417 } 3418 $self->DrawGame(); 3419 } 3420} 3421 3422 3423########################################################################## 3424package PanicGame; 3425########################################################################## 3426 3427@PanicGame::ISA = qw(PlayableGameBase); 3428 3429sub new { 3430 my ($class) = @_; 3431 my $self = new PlayableGameBase; 3432 %{$self} = (%{$self}, 3433 'spawndelay' => 0, 3434 'superballdelay' => 0, 3435 'leveladvance' => 0, 3436 'panicleveldesc' => undef, 3437 ); 3438 bless $self, $class; 3439} 3440 3441sub ResetGame { 3442 my $self = shift; 3443 3444 $self->SUPER::ResetGame(); 3445 $self->{spawndelay} = 0; 3446 $self->{superballdelay} = 2500 + $self->Rand(2500); # 25sec - 50sec 3447 $self->{superballdelay} *= $::DifficultyLevel->{superball}; 3448} 3449 3450sub SetGameSpeed { 3451 my ($self) = @_; 3452 3453 $::GameSpeed = $self->{leveldesc}->{gamespeed} * 0.8 * $::DifficultyLevel->{speed}; 3454} 3455 3456sub SetGameLevel { 3457 my ($self, $level) = @_; 3458 my ($levelIndex); 3459 3460 $levelIndex = ($level > $#::PanicLevels) ? $#::PanicLevels : $level; 3461 $self->{leveldesc} = $::PanicLevels[$levelIndex]; 3462 die unless $self->{leveldesc}; 3463 $self->{leveladvance} = 0; 3464 $self->SUPER::SetGameLevel($level); 3465} 3466 3467sub AdvanceGame { 3468 my ($self) = @_; 3469 3470 $self->SpawnBalls() if $::GamePause <= 0; 3471 $self->SUPER::AdvanceGame(); 3472} 3473 3474sub SpawnBalls { 3475 my $self = shift; 3476 my ($randmax, $rnd, $ballName, $balldesc, $deathBallCount, $earthquakeBallCount, $hasBonus); 3477 3478 --$self->{superballdelay}; 3479 if ($self->{superballdelay} <= 0) { 3480 push @::GameObjects, ( 3481 &Ball::Spawn($::BallDesc{sprintf('super%d', $self->Rand(2))}, -1, $self->Rand(40) < 20 ? 0 : 1) ); 3482 $self->{superballdelay} = (2500 + $self->Rand(2000)) * $::DifficultyLevel->{superball}; # 25sec - 45sec 3483 } 3484 3485 --$self->{spawndelay}; 3486 return if $self->{spawndelay} > 0; 3487 $deathBallCount = $earthquakeBallCount = -1; 3488 $randmax = 10000; 3489 while ($self->{spawndelay} <= 0) { 3490 if ($::DifficultyLevel->{name} eq 'Miki') { 3491 $balldesc = $::BallDesc{'death'}; 3492 last; 3493 } 3494 $rnd = int($self->Rand($randmax)); 3495 $randmax = 0; 3496 3497 # We try to find the balldesc that falls at $rnd 3498 my $ballRoulette = $self->{leveldesc}->{balls}; 3499 for (my $i = 0; $i < scalar @{$ballRoulette}; $i+=2) { 3500 my $rouletteWeight = $ballRoulette->[$i+1]; 3501 $randmax += $rouletteWeight; 3502 $rnd -= $rouletteWeight; 3503 if ($rnd < 0) { 3504 $ballName = $ballRoulette->[$i]; 3505 last; 3506 } 3507 } 3508 next unless ($ballName); # $rnd too large.. We'll have a better $randmax this time! 3509 3510 ($balldesc) = $::BallDesc{$ballName}; 3511 if ($balldesc->{class} eq 'DeathBall') { 3512 next unless $::DeathBallsEnabled; 3513 $deathBallCount = &DeathBall::CountDeathBalls() if $deathBallCount < 0; # Lazy counting 3514 next if $deathBallCount >= 2; 3515 } 3516 if ($balldesc->{class} eq 'EarthquakeBall') { 3517 next unless $::EarthquakeBallsEnabled; 3518 $earthquakeBallCount = &::EarthquakeBall::CountEarthquakeBalls if $earthquakeBallCount < 0; 3519 next if $earthquakeBallCount >= 1; 3520 } 3521 if ($balldesc->{class} eq 'WaterBall') { 3522 next unless $::WaterBallsEnabled; 3523 } 3524 if ($balldesc->{class} eq 'SeekerBall') { 3525 next unless $::SeekerBallsEnabled; 3526 } 3527 last if $balldesc; 3528 } 3529 3530 $hasBonus = 1 if ($balldesc->{width} >= 32) and ($self->Rand(1) < $::DifficultyLevel->{bonusprobability}); 3531 3532 push @::GameObjects, ( &Ball::Spawn($balldesc, -1, $self->Rand(40) < 20 ? 0 : 1, $hasBonus) ); 3533 $self->{spawndelay} = $self->{leveldesc}->{spawndelay} * $balldesc->{spawndelay} * 50; 3534 $self->{spawndelay} /= ($::NumGuys + 1) / 2; 3535 $self->{spawndelay} *= $::DifficultyLevel->{spawnmultiplier}; 3536} 3537 3538sub OnBallPopped { 3539 my $self = shift; 3540 3541 ++$self->{leveladvance}; 3542 if ($self->{leveladvance} >= 18) { 3543 ::PlaySound('level'); 3544 $self->SetGameLevel($self->{level}+1); 3545 } 3546} 3547 3548sub DrawLevelIndicator { 3549 my ($self, $x, $y) = @_; 3550 3551 $self->{levelIndicatorRect} = new SDL::Rect(-x => $x, -y => $y, -width => 140, -height => $self->{scoreBoardHeight}) unless $self->{levelIndicatorRect}; 3552 $::App->fill( $self->{levelIndicatorRect}, new SDL::Color() ); 3553 $::LevelIndicatorSurface2->blit( 0, $::App, new SDL::Rect(-x => $x, -y => $y)); 3554 $::LevelIndicatorSurface->blit( new SDL::Rect(-width => 130 * $self->{leveladvance} / 17, -height => 30), $::App, new SDL::Rect(-x => $x, -y => $y)); 3555 $::App->print( $x + 25, $y + 3, 'Level ' . ($self->{level}+1) ); 3556 $::App->print( $x, $y + 40, sprintf('spd: %d/%d', $::GameSpeed * 100, $self->{leveldesc}->{spawndelay}) ) if $self->{scoreBoardHeight} >= 64; 3557} 3558 3559 3560########################################################################## 3561package ChallengeGame; 3562########################################################################## 3563 3564@ChallengeGame::ISA = qw(PlayableGameBase); 3565 3566sub new { 3567 my ($class) = @_; 3568 my $self = new PlayableGameBase; 3569 %{$self} = (%{$self}, 3570 'challenge' => undef, 3571 ); 3572 bless $self, $class; 3573} 3574 3575sub CreateLevelNumberSurface { 3576 my ($level) = @_; 3577 my ($surface, $w); 3578 3579 $::GlossyFont->use(); 3580 $w = &::TextWidth("Level $level"); 3581 $surface = new SDL::Surface( -name =>'', 3582 -flags=>::SDL_SWSURFACE(), -width => $w+6, -height => 48, -depth => 32); 3583 $surface->print( 3, 3, "Level $level" ); 3584 $::ScoreFont->use(); 3585 return $surface; 3586} 3587 3588sub SetGameLevel { 3589 my ($self, $level) = @_; 3590 3591 &SlowEffect::RemoveSlowEffects(); 3592 $self->SUPER::SetGameLevel($level); 3593 $level = $#::ChallengeLevels if $level > $#::ChallengeLevels; 3594 $self->{challenge} = $::ChallengeLevels[$level]; 3595 $self->SpawnChallenge(); 3596 3597 my ($levelObject, $surface); 3598 $levelObject = new GameObject; 3599 $surface = &CreateLevelNumberSurface($level + 1); 3600 $levelObject->{surface} = $surface; 3601 $levelObject->{w} = $surface->width(); 3602 $levelObject->{h} = $surface->height(); 3603 $levelObject->{x} = ($::ScreenWidth - $levelObject->{w}) / 2; 3604 $levelObject->{y} = ($::ScreenHeight - $levelObject->{h}) / 2; 3605 $levelObject->{draw} = sub { my $self = shift; $self->{surface}->blit( 0, $::App, $self->{rect} ); }; 3606 $levelObject->{advance} = sub { my $self = shift; $self->Delete() if ++$self->{time} > 200; }; 3607 push @::GameObjects, $levelObject; 3608} 3609 3610sub AdvanceGameObjects { 3611 my ($self) = @_; 3612 3613 if ($self->{nextlevel}) { 3614 ::PlaySound('level'); 3615 $self->SetGameLevel($self->{level} + 1); 3616 delete $self->{nextlevel}; 3617 } 3618 if ($self->{playerspawned}) { 3619 $self->SpawnChallenge(); 3620 $self->{playerspawned} = 0; 3621 } 3622 $self->SUPER::AdvanceGameObjects(); 3623} 3624 3625sub SpawnChallenge { 3626 my $self = shift; 3627 my ($challenge, @guys, $balldesc, $ball, $hasBonus, %balls, $numBalls, $ballsSpawned, @ballKeys, $x); 3628 3629 @guys = $self->PopEveryBall(); 3630 foreach (@guys) { 3631 $_->{bonusDelay} = 1; 3632 $_->{invincible} = 1; 3633 } 3634 $::GamePause = 0; 3635 delete $::GameEvents{magic}; 3636 $challenge = $self->{challenge}; 3637 die unless $challenge; 3638 3639 while ($challenge =~ /(\w+)/g) { 3640 $balldesc = $::BallDesc{$1}; 3641 warn "Unknown ball in challenge: $1" unless $balldesc; 3642 $balls{$1}++; 3643 $numBalls++; 3644 } 3645 $ballsSpawned = 0; 3646 while ($ballsSpawned < $numBalls) { 3647 foreach (keys %balls) { 3648 next unless $balls{$_}; 3649 --$balls{$_}; 3650 $balldesc = $::BallDesc{$_}; 3651 $x = $::ScreenWidth * ($ballsSpawned * 2 + 1) / ($numBalls * 2) - $balldesc->{width} / 2; 3652 $x = $::ScreenWidth - $balldesc->{width} if $x > $::ScreenWidth - $balldesc->{width}; 3653 $hasBonus = (($balldesc->{width} >= 32) and ($self->Rand(1) < $::DifficultyLevel->{bonusprobability})); 3654 $ball = &Ball::Spawn($balldesc, $x, ($ballsSpawned % 2) ? 0 : 1, $hasBonus); 3655 if ($ball->{w} <= 32) { 3656 $ball->{ismagic} = $ball->{hasmagic} = 0; 3657 } 3658 push @::GameObjects, ($ball) ; 3659 ++$ballsSpawned; 3660 } 3661 } 3662} 3663 3664sub OnBallPopped { 3665 my $self = shift; 3666 my ($i); 3667 3668 for ($i = $#::GameObjects; $i >= 0; --$i) { 3669 if ($::GameObjects[$i]->isa('Ball')) { 3670 return; 3671 } 3672 } 3673 $self->{nextlevel} = 1; 3674} 3675 3676 3677########################################################################## 3678package TutorialGame; 3679########################################################################## 3680 3681@TutorialGame::ISA = qw(ChallengeGame); 3682 3683sub SetChallenge { 3684 my ($self, $challenge) = @_; 3685 3686 $self->{challenge} = $challenge; 3687} 3688 3689sub SetGameLevel { 3690 my ($self, $level) = @_; 3691 3692 $self->PlayableGameBase::SetGameLevel($level); 3693 $self->SpawnChallenge(); 3694} 3695 3696sub AdvanceGameObjects { 3697 my ($self) = @_; 3698 3699 if ($self->{nextlevel}) { 3700 $self->{countDown} = 200; 3701 delete $self->{nextlevel}; 3702 } 3703 if ($self->{playerspawned}) { 3704 $self->SpawnChallenge(); 3705 $self->{playerspawned} = 0; 3706 } 3707 if ($self->{countDown}) { 3708 if (--$self->{countDown} < 1) { 3709 $self->{abortgame} = 1; 3710 } 3711 } 3712 $self->SUPER::AdvanceGameObjects(); 3713} 3714 3715 3716########################################################################## 3717package RecordGame; 3718########################################################################## 3719 3720@RecordGame::ISA = qw(PanicGame); 3721 3722sub Rand { 3723 my $self = shift; 3724 my $result = int(rand($_[0]) * 100) / 100; 3725 push @{$self->{rand}}, ($result); 3726 return $result; 3727} 3728 3729sub Rewind { 3730 my $self = shift; 3731 my ($recordEnd, $playback); 3732 3733 $recordEnd = length($self->{record}) - $::NumGuys * 1000; 3734 return if $recordEnd <= 0; 3735 $self->{record} = substr($self->{record}, 0, $recordEnd); 3736 $::Game = $playback = new DemoPlaybackGame($::NumGuys, $::DifficultyLevel, $self->{record}, $self->{rand}, {}); 3737 $playback->{skip} = 1; 3738 $::Background->blit(0, $::App, 0); 3739 $playback->Run(); 3740 3741 $playback->RestoreGameSettings(); 3742 %{$self} = %{$playback}; 3743 $::Game = $self; 3744 $self->{abortgame} = 0; 3745 print "Splicing {rand}: original length is ", scalar(@{$self->{rand}}), "; playback randpointer is $playback->{randpointer}.\n"; 3746 splice @{$self->{rand}}, $playback->{randpointer}; 3747 $::Background->blit(0, $::App, 0); 3748 $self->DrawGame(); 3749 %::Events = %::Keys = (); 3750 while( not %::Events ) { &::HandleEvents(); $::App->delay(100); } 3751 &GameTimer::ResetTimer(); 3752} 3753 3754sub PreAdvanceAction { 3755 my $self = shift; 3756 my ($record); 3757 3758 $self->Rewind() if $::Events{::SDLK_F3()}; 3759 3760 for (my $i=0; $i < $::NumGuys; ++$i) { 3761 my $keys = $::Players[$i]->{keys}; 3762 $record = 0; 3763 $record += 1 if $::Keys{$keys->[0]}; 3764 $record += 2 if $::Keys{$keys->[1]}; 3765 $record += 4 if $::Events{$keys->[2]}; 3766 if ($::Events{::SDLK_F2()} and $::NumGuys == 1) { 3767 $record += 8; 3768 $::GameEvents{superkill} = 1; 3769 } 3770 $self->{record} .= $record; 3771 } 3772} 3773 3774 3775########################################################################## 3776package PlaybackGame; 3777########################################################################## 3778 3779@PlaybackGame::ISA = qw(PanicGame); 3780 3781sub new { 3782 my ($class, $numGuys, $difficultyLevel, $record, $rand, $messages) = @_; 3783 my $self; 3784 3785 $self = new PanicGame; 3786 %{$self} = (%{$self}, 3787 'record' => $record, 3788 'rand' => $rand, 3789 'messages' => $messages, 3790 ); 3791 bless $self, $class; 3792 $self->InitPlayback($numGuys); 3793 &::SetDifficultyLevel($difficultyLevel); 3794 return $self; 3795} 3796 3797sub InitPlayback { 3798 my ($self, $numGuys) = @_; 3799 3800 $self->{recordpointer} = 0; 3801 $self->{randpointer} = 0; 3802 $self->{oldnumguys} = $::NumGuys; 3803 $self->{olddifficultylevel} = $::DifficultyLevelIndex; 3804 3805 $::NumGuys = $numGuys; 3806 for (my $i=0; $i < $numGuys; ++$i) { 3807 $::Players[$i]->{oldkeys} = $::Players[$i]->{keys}; 3808 $::Players[$i]->{keys} = [ "DLEFT$i", "DRIGHT$i", "DFIRE$i" ]; 3809 } 3810} 3811 3812sub RestoreGameSettings { 3813 my $self = shift; 3814 3815 for (my $i=0; $i < $::NumGuys; ++$i) { 3816 $::Players[$i]->{keys} = $::Players[$i]->{oldkeys}; 3817 delete $::Players[$i]->{oldkeys}; 3818 } 3819 $::NumGuys = $self->{oldnumguys}; 3820 &::SetDifficultyLevel($self->{olddifficultylevel}); 3821} 3822 3823sub CalculateAdvances { 3824 my $self = shift; 3825 3826 return length($self->{record}) if $self->{skip}; 3827 return $self->SUPER::CalculateAdvances() * ($::Keys{::SDLK_f()} ? 15 : 1); 3828} 3829 3830sub Rand { 3831 my $self = shift; 3832 3833 my $result = $self->{rand}->[$self->{randpointer}]; 3834 ++$self->{randpointer}; 3835 return $result; 3836} 3837 3838sub PreAdvanceAction { 3839 my $self = shift; 3840 my ($record, $keys); 3841 3842 for (my $i=0; $i < $::NumGuys; ++$i) { 3843 3844 $record = substr($self->{record}, $self->{recordpointer}++, 1); 3845 $keys = $::Players[$i]->{keys}; 3846 $::Keys{$keys->[0]} = $record & 1; 3847 $::Keys{$keys->[1]} = $record & 2; 3848 $::Events{$keys->[2]} = $record & 4; 3849 $::GameEvents{superkill} = 1 if $::NumGuys == 1 and $record & 8; 3850 } 3851 3852 $self->{abortgame} = 1 if $self->{recordpointer} >= length $self->{record}; 3853 3854 if ($self->{messages}) { 3855 my $message = $self->{messages}->{$self->{recordpointer}}; 3856 $self->DisplayMessage($message) if $message; 3857 } 3858} 3859 3860sub DisplayMessage { 3861 my ($self, $message) = @_; 3862 3863 my ($len, $adv) = (0, 0); 3864 my $x = ( $::PhysicalScreenWidth - &::TextWidth($message) ) / 2; 3865 my $y = $::PhysicalScreenHeight / 2; 3866 $self->DrawGame(); 3867 3868 while (1) { 3869 &::HandleEvents(); 3870 return if $self->{abortgame}; 3871 my $advance = $self->CalculateAdvances(); 3872 $adv += $advance; 3873 $len = int($adv / 5); 3874 3875 $::App->print($x, $y, substr($message, 0, $len) ); 3876 $::App->sync(); 3877 last if $len > length($message) + 15; 3878 } 3879 $::Background->blit(new SDL::Rect(-width=>$::PhysicalScreenWidth, -y=>$y, -height=>40), $::App, new SDL::Rect(-y => $y)); 3880} 3881 3882 3883########################################################################## 3884package DemoGame; 3885########################################################################## 3886 3887sub ResetGame { 3888 my $self = shift; 3889 &::SetDifficultyLevel(1); 3890 &::SetWeaponDuration(0); 3891 $::Slippery = 0; 3892 $self->PanicGame::ResetGame(); 3893 3894 my $ball = &Ball::Create($::BallDesc[4], 400, 0, -10, 0); 3895 $ball->GiveMagic(); 3896 3897 push @::GameObjects, ( 3898 &Ball::Create($::BallDesc[0], 100, 0, 1), 3899 &Ball::Create($::BallDesc{super0}, 300, 0, 0), 3900 &Ball::Create($::BallDesc{super1}, 500, 0, 1), 3901 $ball, 3902 ); 3903 $::GamePause = 0; 3904 $::GameSpeed = 0.8; 3905 $self->{spawndelay} = $self->{superballdelay} = 1000000; 3906 $self->{ballcounter} = 0; 3907 $self->{balls} = [ qw(b0 h0 w1 quake death seeker) ]; 3908} 3909 3910sub SetGameSpeed { 3911 $::GameSpeed = 0.8; 3912} 3913 3914sub SpawnBalls { 3915 my $self = shift; 3916 3917 return if (--$self->{spawndelay} > 0); 3918 my $ballName = $self->{balls}->[$self->{ballcounter}]; 3919 return unless $ballName; 3920 push @::GameObjects, ( &Ball::Spawn($::BallDesc{$ballName}, 100, 1, 0) ); 3921 $self->{spawndelay} = 1000000; 3922 ++$self->{ballcounter}; 3923} 3924 3925sub RespawnPlayers {} 3926sub OnBallPopped {} 3927 3928 3929########################################################################## 3930package DemoRecordGame; 3931########################################################################## 3932 3933@DemoRecordGame::ISA = qw(DemoGame RecordGame); 3934 3935sub new { 3936 my $class = shift; 3937 my $self = new RecordGame(@_); 3938 bless $self, $class; 3939} 3940 3941 3942########################################################################## 3943package DemoPlaybackGame; 3944########################################################################## 3945 3946@DemoPlaybackGame::ISA = qw(DemoGame PlaybackGame); 3947 3948sub new { 3949 my $class = shift; 3950 my $self = new PlaybackGame(@_); 3951 bless $self, $class; 3952} 3953 3954sub DrawScoreBoard { 3955 my $self = shift; 3956 my ($x, $y); 3957 3958 $x = 10; 3959 $y = $::ScreenHeight + 2 * $::ScreenMargin + 5; 3960 if ($self->{anim} < 1) { 3961 $::Background->print( $x, $y, "Press F to fast forward" ); 3962 $::App->print( $x, $y, "Press F to fast forward" ); 3963 } return; 3964 $::App->fill( new SDL::Rect(-x=>0, -y=>$y, -width=>$::PhysicalScreenWidth, -height=>$::PhysicalScreenHeight - $y), new SDL::Color() ); 3965 $::App->print( $x, $y, $self->{recordpointer} ); 3966} 3967 3968 3969########################################################################## 3970package Menu; 3971########################################################################## 3972 3973@Menu::ISA = qw(GameBase); 3974use vars qw(@syms); 3975@syms = qw(UNKNOWN FIRST BACKSPACE TAB CLEAR RETURN PAUSE ESCAPE SPACE EXCLAIM QUOTEDBL HASH DOLLAR AMPERSAND QUOTE LEFTPAREN RIGHTPAREN ASTERISK PLUS COMMA MINUS PERIOD SLASH 0 1 2 3 4 5 6 7 8 9 COLON SEMICOLON LESS EQUALS GREATER QUESTION AT LEFTBRACKET BACKSLASH RIGHTBRACKET CARET UNDERSCORE BACKQUOTE a b c d e f g h i j k l m n o p q r s t u v w x y z DELETE WORLD_0 WORLD_1 WORLD_2 WORLD_3 WORLD_4 WORLD_5 WORLD_6 WORLD_7 WORLD_8 WORLD_9 WORLD_10 WORLD_11 WORLD_12 WORLD_13 WORLD_14 WORLD_15 WORLD_16 WORLD_17 WORLD_18 WORLD_19 WORLD_20 WORLD_21 WORLD_22 WORLD_23 WORLD_24 WORLD_25 WORLD_26 WORLD_27 WORLD_28 WORLD_29 WORLD_30 WORLD_31 WORLD_32 WORLD_33 WORLD_34 WORLD_35 WORLD_36 WORLD_37 WORLD_38 WORLD_39 WORLD_40 WORLD_41 WORLD_42 WORLD_43 WORLD_44 WORLD_45 WORLD_46 WORLD_47 WORLD_48 WORLD_49 WORLD_50 WORLD_51 WORLD_52 WORLD_53 WORLD_54 WORLD_55 WORLD_56 WORLD_57 WORLD_58 WORLD_59 WORLD_60 WORLD_61 WORLD_62 WORLD_63 WORLD_64 WORLD_65 WORLD_66 WORLD_67 WORLD_68 WORLD_69 WORLD_70 WORLD_71 WORLD_72 WORLD_73 WORLD_74 WORLD_75 WORLD_76 WORLD_77 WORLD_78 WORLD_79 WORLD_80 WORLD_81 WORLD_82 WORLD_83 WORLD_84 WORLD_85 WORLD_86 WORLD_87 WORLD_88 WORLD_89 WORLD_90 WORLD_91 WORLD_92 WORLD_93 WORLD_94 WORLD_95 KP0 KP1 KP2 KP3 KP4 KP5 KP6 KP7 KP8 KP9 KP_PERIOD KP_DIVIDE KP_MULTIPLY KP_MINUS KP_PLUS KP_ENTER KP_EQUALS UP DOWN RIGHT LEFT INSERT HOME END PAGEUP PAGEDOWN F1 F2 F3 F4 F5 F6 F7 F8 F9 F10 F11 F12 F13 F14 F15 NUMLOCK CAPSLOCK SCROLLOCK RSHIFT LSHIFT RCTRL LCTRL RALT LALT RMETA LMETA LSUPER RSUPER MODE COMPOSE HELP PRINT SYSREQ BREAK MENU POWER EURO UNDO LAST ); 3976 3977sub Exit { 3978 my $self = shift; 3979 3980 &::SaveConfig(); 3981 $self->SUPER::Exit(); 3982} 3983 3984sub SetGameSpeed { 3985 $::GameSpeed = 1.0; 3986} 3987 3988sub ShowTooltip { 3989 my $self = shift; 3990 my (@lines, $y, $yinc, $rect); 3991 3992 @lines = @_; 3993 @lines = ("Pang Zero $::Version (C) 2006 by UPi (upi\@sourceforge.net)", 3994 "Use cursor keys to navigate menu, Enter to select", 3995 "P pauses the game, Esc quits") unless scalar @lines; 3996 3997 $::ScoreFont->use(); 3998 ($y, $yinc) = ($::ScreenHeight + 35, 20); 3999 $rect = new SDL::Rect( -x => 0, -y => $y, 4000 -w => $::PhysicalScreenWidth, -h => $::PhysicalScreenWidth - $y ); 4001 $::Background->fill($rect, new SDL::Color); 4002 foreach (@lines) { 4003 $::Background->print( 10, $y, $_ ) if $y + $yinc < $::PhysicalScreenHeight; 4004 $y += $yinc; 4005 } 4006 $rect = new SDL::Rect( -x => 0, -y => $::ScreenHeight + 35, 4007 -w => $::PhysicalScreenWidth, -h => $::PhysicalScreenWidth - $y ); 4008 $::Background->blit($rect, $::App, $rect); 4009 $::MenuFont->use(); 4010} 4011 4012sub MenuAdvance { 4013 my $self = shift; 4014 4015 my $advance = $self->CalculateAdvances(); 4016 %::Events = %::MenuEvents = (); 4017 %::GameEvents = (); 4018 &::HandleEvents('readbothaxes'); 4019 while ($advance--) { 4020 $self->AdvanceGameObjects(); 4021 } 4022 while (ref($::GameObjects[$#::GameObjects]) ne 'MenuItem') { unshift @::GameObjects, (pop @::GameObjects); } 4023 $self->DrawGame(); 4024} 4025 4026sub SetCurrentItemIndex { 4027 my ($self, $index) = @_; 4028 4029 return if ($index < 0 or $index >= scalar @{$self->{menuItems}} or not $self->{menuItems}->[$index]->CanSelect()); 4030 $self->{currentItemIndex} = $index; 4031 $self->{currentItem} = $self->{menuItems}->[$index]; 4032 $self->{currentItem}->Select(); 4033} 4034 4035sub EnterSubMenu { 4036 my $self = shift; 4037 my ($recall, $menuItem); 4038 4039 $recall->{oldItems} = $self->{menuItems}; 4040 $recall->{oldCurrentItemIndex} = $self->{currentItemIndex}; 4041 foreach $menuItem (@{$self->{menuItems}}) { $menuItem->Hide(); } 4042 $self->{menuItems} = []; 4043 4044 return $recall; 4045} 4046 4047sub LeaveSubMenu { 4048 my ($self, $recall) = @_; 4049 my ($menuItem); 4050 4051 foreach $menuItem (@{$self->{menuItems}}) { $menuItem->HideAndDelete(); } 4052 $self->{menuItems} = $recall->{oldItems}; 4053 foreach $menuItem (@{$self->{menuItems}}) { $menuItem->Show(); } 4054 $self->SetCurrentItemIndex($recall->{oldCurrentItemIndex}); 4055 $self->{abortgame} = 0; 4056} 4057 4058sub HandleUpDownKeys { 4059 my $self = shift; 4060 4061 if ($::MenuEvents{DOWN}) { 4062 $self->SetCurrentItemIndex( $self->{currentItemIndex} + 1 ); 4063 } 4064 if ($::MenuEvents{UP}) { 4065 $self->SetCurrentItemIndex( $self->{currentItemIndex} - 1 ); 4066 } 4067} 4068 4069sub KeyToText { 4070 my ($key) = @_; 4071 eval("::SDLK_$_() eq $key") and return ucfirst(lc($_)) foreach @syms; 4072 print "No match for $key\n"; 4073 return "???"; 4074} 4075 4076sub KeysToText { 4077 my $keys = shift; 4078 my ($retval); 4079 if ( $keys->[0] =~ /^[LRB](\d)+$/ ) { 4080 return "Joystick $1"; 4081 } 4082 return join(' / ', &KeyToText($keys->[0]), &KeyToText($keys->[1]), &KeyToText($keys->[2]) ); 4083} 4084 4085sub RunTutorial { 4086 my ($self, $ball) = @_; 4087 my ($recall, @oldGameObjects, %oldGuys, %oldHarpoons, $oldGame); 4088 4089 $recall = $self->EnterSubMenu(); 4090 @oldGameObjects = @::GameObjects; 4091 %oldGuys = %Guy::Guys; 4092 %oldHarpoons = %Harpoon::Harpoons; 4093 $oldGame = $::Game; 4094 4095 $::ScoreFont->use(); 4096 $::Game = new TutorialGame; 4097 $::Game->SetChallenge($ball); 4098 $::Game->Run(); 4099 $::MenuFont->use(); 4100 $self->SetGameSpeed(); 4101 4102 foreach (@::GameObjects) { $_->Clear(); } 4103 @::GameObjects = @oldGameObjects; 4104 %Guy::Guys = %oldGuys; 4105 %Harpoon::Harpoons = %oldHarpoons; 4106 $::Game = $oldGame; 4107 $self->LeaveSubMenu($recall); 4108} 4109 4110sub RunTutorialMenu { 4111 my $self = shift; 4112 my ($baseY, $baseX, $menuItem, $recall, @tutorials); 4113 4114 $recall = $self->EnterSubMenu(); 4115 $self->{title}->Hide(); 4116 $baseY = 50; 4117 4118 @tutorials = ( 4119 ['n2', 'Normal Ball', 'There is nothing special about this ball. Just keep shooting it.'], 4120 ['b0', 'Bouncy Ball', 'This ball bounces higher than the normal ball.', 'Otherwise it behaves the same.'], 4121 ['h0', 'Hexa', 'The Hexa is weightless and travels in a straight line.', 'With practice you can shoot it just as easily as the normal ball.'], 4122 ['w1', 'Water Ball', 'The water ball pops each time it bounces.', 'This can create a tide of small balls fast.', 'Mop it up quickly.'], 4123 ['f1', 'Fragile Ball', 'The fragile ball shatters into little bits the moment it is hit.', 'Prepare for a shower of small balls.'], 4124 ['death', 'Death Ball', 'This ball cannot be killed with your harpoon.', 'Shooting will make it multiply. Too many death balls cause meltdown.', 'Evade it for 20 seconds to get rid of it.'], 4125 ['seeker', 'Seeker Ball', 'The seeker ball will chase you forever.', 'You have to keep moving and shooting to evade it.'], 4126 ['quake', 'Earthquake Ball', 'This ball is super heavy.', 'In fact the earth will quake each time it bounces.', 'Shoot it quickly, or it will send you flying.'], 4127 ['u0', 'Upside Down Ball', 'This crazy ball bounces on the top of the screen.', 'Maybe it came from an alternate universe,', 'where gravity is negative?'], 4128 ['super0, n1', 'Super Ball', 'The Super Ball is your friend. It will still kill you on touch.', 'The green super ball will pause the game for 8 seconds.', 'The gold super ball will kill every ball.'], 4129 ); 4130 4131 push @{$self->{menuItems}}, 4132 new MenuItem( 50, $baseY, "Back to main menu"), 4133 new MenuItem( 50, $baseY += 40, "Run Demo" ); 4134 4135 $baseY = 110; 4136 $baseX = 50; 4137 foreach (@tutorials) { 4138 my @tutItem = @{$_}; 4139 my $challenge = shift @tutItem; 4140 my $menuItem = new MenuItem( $baseX, $baseY += 40, @tutItem ); 4141 $menuItem->{challenge} = $challenge; 4142 push @{$self->{menuItems}}, $menuItem; 4143 if ($baseY + 140 >= $::ScreenHeight) { 4144 $baseY = 110; 4145 $baseX = 450; 4146 } 4147 } 4148 push @::GameObjects, (@{$self->{menuItems}}); 4149 $self->SetCurrentItemIndex(1); 4150 4151 while (1) { 4152 $self->MenuAdvance(); 4153 last if $self->{abortgame}; 4154 $self->HandleUpDownKeys(); 4155 4156 if ($::MenuEvents{LEFT} and $self->{currentItemIndex} > 1) { 4157 $self->SetCurrentItemIndex($self->{currentItemIndex} - 5); 4158 } 4159 if ($::MenuEvents{RIGHT} and $self->{currentItemIndex} > 1) { 4160 $self->SetCurrentItemIndex($self->{currentItemIndex} + 5); 4161 } 4162 if ($::MenuEvents{BUTTON}) { 4163 if (0 == $self->{currentItemIndex}) { 4164 last; 4165 } elsif (1 == $self->{currentItemIndex}) { 4166 $self->{result} = 'demo'; 4167 last; 4168 } else { 4169 $self->RunTutorial($self->{currentItem}->{challenge}); 4170 } 4171 } 4172 } 4173 4174 $self->LeaveSubMenu($recall); 4175 $self->{title}->Show(); 4176} 4177 4178sub RunCredits { 4179 my ($self, $demo) = @_; 4180 my ($recall, $i, $ball, @balls, @oldGameObjects, $time); 4181 4182 $time = $self->{anim}; 4183 $recall = $self->EnterSubMenu(); 4184 @oldGameObjects = @::GameObjects; 4185 foreach my $gameObject (@::GameObjects) { 4186 $gameObject->Clear(); 4187 } 4188 @::GameObjects = ($self->{title}); 4189 push @::GameObjects, (new FpsIndicator); 4190 my ($y, $yinc) = (110, 36); 4191 push @{$self->{menuItems}}, ( 4192 new MenuItem( 100, $y += $yinc, "Written by: UPi <upi\@sourceforge.net>"), 4193 new MenuItem( 100, $y += $yinc, "Music by: SAdam" ), 4194 new MenuItem( 100, $y += $yinc, "Graphics by: UPi, DaniGM, EBlanca" ), 4195 new MenuItem( 100, $y += $yinc * 1.5, "TESTERS" ), 4196 new MenuItem( 100, $y += $yinc, "Ulmar, Surba, Miki, Aisha, Descant" ), 4197 new MenuItem( 100, $y += $yinc * 1.5, "http://apocalypse.rulez.org/pangzero" ), 4198 ); 4199 foreach $i (@{$self->{menuItems}}) { $i->Center(); } 4200 4201 for ($i = 0; $i < 20; ++$i) { 4202 $ball = &Ball::Spawn( $::BallDesc{'credits1'}, 100, 1, 0 ); 4203 $ball->{y} = $i * -5; 4204 push @balls, ($ball); 4205 $ball = &Ball::Spawn( $::BallDesc{'credits2'}, $::ScreenWidth - 132, -1, 0 ); 4206 $ball->{y} = $i * -5; 4207 push @balls, ($ball); 4208 } 4209 push @::GameObjects, @balls; 4210 push @::GameObjects, (@{$self->{menuItems}}); 4211 4212 while (1) { 4213 $self->MenuAdvance(); 4214 last if $self->{abortgame}; 4215 if ($demo) { 4216 last if %::Events; 4217 last if $self->{anim} - $time > 20 * 100; # 30s 4218 } 4219 } 4220 4221 @::GameObjects = @oldGameObjects; 4222 foreach (@balls) { $_->Delete(); } 4223 $self->LeaveSubMenu($recall); 4224} 4225 4226sub RunHighScore { 4227 my ($self, $difficultyLevel, $table, $auto) = @_; 4228 my ($time, $recall, $y, $yinc, $retval); 4229 4230 die unless $table =~/^(Cha|Pan)$/; 4231 $time = 0; 4232 $recall = $self->EnterSubMenu(); 4233 ($y, $yinc) = (110, 40); 4234 $difficultyLevel = $::DifficultyLevels[$difficultyLevel]; 4235 push @{$self->{menuItems}}, ( 4236 new MenuItem( 320, 50, ($table eq 'Cha' ? 'Challenge Game - ' : 'Panic Game - ') . $difficultyLevel->{name} ), #. " difficulty" ), 4237 new MenuItem( 50, $y, "Highest Score" ), 4238 new MenuItem( 480, $y, "Highest Level" ), 4239 ); 4240 $self->{menuItems}->[0]->Center(); 4241 $y += $yinc; 4242 foreach (@{$difficultyLevel->{"highScoreTable$table"}}) { 4243 push @{$self->{menuItems}}, ( new MenuItem( 10, $y += $yinc, $_->[0] ) ); 4244 push @{$self->{menuItems}}, ( new MenuItem( 250, $y, $_->[1] ) ); 4245 } 4246 $y = 110 + $yinc; 4247 foreach (@{$difficultyLevel->{"highLevelTable$table"}}) { 4248 push @{$self->{menuItems}}, ( new MenuItem( 460, $y += $yinc, $_->[0] ) ); 4249 push @{$self->{menuItems}}, ( new MenuItem( 700, $y, $_->[1] ) ); 4250 } 4251 push @::GameObjects, (@{$self->{menuItems}}); 4252 4253 while (not $retval) { 4254 $self->MenuAdvance(); 4255 if ($self->{abortgame}) { 4256 $retval = 'abortgame'; last; 4257 } 4258 if ($auto) { 4259 $retval = 'next' if ++$time > 100 * 6; 4260 $retval = 'abortgame' if %::Events; 4261 } else { 4262 if ($::MenuEvents{LEFT} or $::MenuEvents{UP}) { 4263 $retval = 'prev'; last; 4264 } elsif ($::MenuEvents{RIGHT} or $::MenuEvents{DOWN}) { 4265 $retval = 'next'; last; 4266 } elsif ($::MenuEvents{BUTTON}) { 4267 $retval = 'abortgame'; 4268 } 4269 } 4270 } 4271 $self->LeaveSubMenu($recall); 4272 return $retval; 4273} 4274 4275sub RunHighScores { 4276 my ($self, $auto) = @_; 4277 my ($recall, $retval, $i, $table, @tables); 4278 4279 if ($auto) { 4280 $self->ShowTooltip(); 4281 } else { 4282 $self->ShowTooltip("Use arrow keys to navigate, Esc to go back"); 4283 } 4284 $recall = $self->EnterSubMenu(); 4285 $self->{title}->Hide(); 4286 $table = 0; 4287 @tables = ( [0, 'Pan'], [0, 'Cha'], [1, 'Pan'], [1, 'Cha'], [2, 'Pan'], [2, 'Cha'], [3, 'Pan'], [3, 'Cha'], [4, 'Pan'] ); 4288 4289 while (1) { 4290 $retval = $self->RunHighScore( @{$tables[$table]}, $auto ); 4291 if ($retval eq 'next') { 4292 ++$table; 4293 $table = 0 if $table == scalar @tables; 4294 last if $table == 0 and $auto; 4295 } elsif ($retval eq 'prev') { 4296 --$table; 4297 $table = $#tables if $table < 0; 4298 } else { 4299 last; 4300 } 4301 } 4302 4303 $self->ShowTooltip(); 4304 $self->{title}->Show(); 4305 $self->LeaveSubMenu($recall); 4306} 4307 4308sub UpdateBallMixerMenu { 4309 my $self = shift; 4310 4311 $self->{menuItems}->[1]->SetParameter( $::DeathBallsEnabled ? 'on' : 'off' ); 4312 $self->{menuItems}->[2]->SetParameter( $::EarthquakeBallsEnabled ? 'on' : 'off' ); 4313 $self->{menuItems}->[3]->SetParameter( $::WaterBallsEnabled ? 'on' : 'off' ); 4314 $self->{menuItems}->[4]->SetParameter( $::SeekerBallsEnabled ? 'on' : 'off' ); 4315} 4316 4317sub RunBallMixerMenu { 4318 my $self = shift; 4319 my ($recall); 4320 4321 $recall = $self->EnterSubMenu(); 4322 my ($y, $yinc) = (110, 40); 4323 push @{$self->{menuItems}}, ( 4324 new MenuItem( 100, $y += $yinc, "Back to options menu"), 4325 new MenuItem( 100, $y += $yinc + 20, "Death Balls: ", "Death balls multiply every time you shoot them.", "You can get rid of them by NOT shooting them for 20 seconds." ), 4326 new MenuItem( 100, $y += $yinc, "Earthquake Balls: ", "Earthquake balls shake the ground when they bounce.", "This sends you flying. Very dangerous." ), 4327 new MenuItem( 100, $y += $yinc, "Water Balls: ", "Water balls quickly dissolve, creating a flood of small balls." ), 4328 new MenuItem( 100, $y += $yinc, "Seeker Balls: ", "This ball picks a target, and chases him." ), 4329 ); 4330 $self->UpdateBallMixerMenu(); 4331 push @::GameObjects, (@{$self->{menuItems}}); 4332 $self->SetCurrentItemIndex(0); 4333 4334 while (1) { 4335 $self->MenuAdvance(); 4336 last if $self->{abortgame}; 4337 $self->HandleUpDownKeys(); 4338 4339 if ($::MenuEvents{BUTTON}) { 4340 last if $self->{currentItemIndex} == 0; # Back to main 4341 if ($self->{currentItemIndex} == 1) { 4342 $::DeathBallsEnabled = 1 - $::DeathBallsEnabled; $self->UpdateBallMixerMenu(); 4343 } elsif ($self->{currentItemIndex} == 2) { 4344 $::EarthquakeBallsEnabled = 1 - $::EarthquakeBallsEnabled; $self->UpdateBallMixerMenu(); 4345 } elsif ($self->{currentItemIndex} == 3) { 4346 $::WaterBallsEnabled = 1 - $::WaterBallsEnabled; $self->UpdateBallMixerMenu(); 4347 } elsif ($self->{currentItemIndex} == 4) { 4348 $::SeekerBallsEnabled = 1 - $::SeekerBallsEnabled; $self->UpdateBallMixerMenu(); 4349 } 4350 } 4351 } 4352 4353 $self->LeaveSubMenu($recall); 4354} 4355 4356sub UpdateOptionsMenu { 4357 my $self = shift; 4358 4359 $self->{menuItems}->[1]->SetParameter( $::Slippery ? 'on' : 'off' ); 4360 $self->{menuItems}->[3]->SetParameter( $::SoundEnabled ? 'on' : 'off'); 4361 $self->{menuItems}->[4]->SetParameter( $::MusicEnabled ? 'on' : 'off'); 4362 $self->{menuItems}->[5]->SetText('< ' . ('Windowed', 'Fullscreen', 'Widescreen')[$::FullScreen] 4363 . ($self->{restart} ? ' (requires restart)' : '') . ' >'); 4364 $self->{menuItems}->[6]->SetParameter( $::ShowWebsite eq $::Version ? 'no' : 'yes' ); 4365} 4366 4367sub RunOptionsMenu { 4368 my $self = shift; 4369 my ($recall); 4370 4371 $recall = $self->EnterSubMenu(); 4372 my ($y, $yinc) = (80, 38); 4373 push @{$self->{menuItems}}, ( 4374 new MenuItem( 100, $y += $yinc, "Back to main menu"), 4375 new MenuItem( 100, $y += $yinc + 20, "Slippery floor: ", "Turning this on creates and icy floor that you slide on", "This makes the game a lot harder!" ), 4376 new MenuItem( 100, $y += $yinc, "Ball Mixer...", "Turn the special balls on and off.", "This can make the game easier." ), 4377 new MenuItem( 100, $y += $yinc, "Sound: ", "Press Enter to turn sound effects on/off." ), 4378 new MenuItem( 100, $y += $yinc, "Music: ", "Press Enter to turn the background music on/off." ), 4379 new MenuItem( 68, $y += $yinc, "Fullscreen", "Press Left/Right to set the screen mode.", "If you have a wide screen (e.g. 16:9), use the Widescreen option.", "This doesn't take effect until you quit and restart the game." ), 4380 new MenuItem( 100, $y += $yinc, "Show website at exit: ", "Should Pang Zero take you to our web site at exit?", "True enlightenment awaits you online!" ), 4381 ); 4382 $self->UpdateOptionsMenu(); 4383 push @::GameObjects, (@{$self->{menuItems}}); 4384 $self->SetCurrentItemIndex(0); 4385 4386 while (1) { 4387 $self->MenuAdvance(); 4388 last if $self->{abortgame}; 4389 $self->HandleUpDownKeys(); 4390 4391 if ($::MenuEvents{LEFT} and $self->{currentItemIndex} == 5) { 4392 if ($::FullScreen > 0) { --$::FullScreen; $self->{restart} = 1; } 4393 $self->UpdateOptionsMenu(); 4394 } 4395 if ($::MenuEvents{RIGHT} and $self->{currentItemIndex} == 5) { 4396 if ($::FullScreen < 2) { ++$::FullScreen; $self->{restart} = 1; } 4397 $self->UpdateOptionsMenu(); 4398 } 4399 if ($::MenuEvents{BUTTON}) { 4400 last if $self->{currentItemIndex} == 0; # Back to main 4401 if ($self->{currentItemIndex} == 2) { 4402 $self->RunBallMixerMenu(); 4403 } elsif ($self->{currentItemIndex} == 1) { 4404 $::Slippery = $::Slippery ? 0 : 1; $self->UpdateOptionsMenu(); 4405 } elsif ($self->{currentItemIndex} == 3) { 4406 $::SoundEnabled = 1 - $::SoundEnabled; $self->UpdateOptionsMenu(); 4407 } elsif ($self->{currentItemIndex} == 4) { 4408 &::SetMusicEnabled(1 - $::MusicEnabled); $self->UpdateOptionsMenu(); 4409 } elsif ($self->{currentItemIndex} == 6) { 4410 $::ShowWebsite = ($::ShowWebsite eq $::Version ? 0 : $::Version); $self->UpdateOptionsMenu(); 4411 } 4412 } 4413 } 4414 4415 $self->LeaveSubMenu($recall); 4416} 4417 4418sub UpdateControlsMenu { 4419 my $self = shift; 4420 4421 $self->{menuItems}->[1]->SetText("< Number of Players: $::NumGuys >"); 4422 for (my $i = 1 ; $i <= 6; ++$i) { 4423 if ($i > $::NumGuys) { 4424 $self->{menuItems}->[$i+1]->Hide(); 4425 $self->{keysAsText}->[$i-1]->Hide(); 4426 } else { 4427 $self->{menuItems}->[$i+1]->Show(); 4428 $self->{keysAsText}->[$i-1]->Show(); 4429 } 4430 } 4431} 4432 4433sub RunControlsMenu { 4434 my $self = shift; 4435 my ($baseY, $menuItem, $recall, @keysAsText, @yPositions); 4436 4437 $recall = $self->EnterSubMenu(); 4438 $self->{title}->Hide(); 4439 $baseY = 50; 4440 4441 push @{$self->{menuItems}}, 4442 new MenuItem( 50, $baseY, "Back to main menu"), 4443 new MenuItem( 18, $baseY += 40, "<>", "Use left and right key to set the number of players here.", "The more the merrier!", "Don't forget to set their keys below." ); 4444 for ( my $i = 1; $i <= 6; ++$i ) { 4445 $yPositions[$i] = $baseY + 20 + $i * 40; 4446 push @{$self->{menuItems}}, (new MenuItem( 50, $yPositions[$i], "Player $i")); 4447 push @keysAsText, (new MenuItem( 220, $yPositions[$i], &KeysToText($::Players[$i-1]->{keys})) ); 4448 } 4449 push @::GameObjects, (@keysAsText, @{$self->{menuItems}}); 4450 $self->{keysAsText} = \@keysAsText; 4451 $self->UpdateControlsMenu(); 4452 $self->SetCurrentItemIndex(1); 4453 4454 while (1) { 4455 $self->MenuAdvance(); 4456 last if $self->{abortgame}; 4457 $self->HandleUpDownKeys(); 4458 if ($::MenuEvents{LEFT} and $self->{currentItemIndex} == 1) { 4459 --$::NumGuys if $::NumGuys > 1; 4460 $self->UpdateControlsMenu(); 4461 } 4462 if ($::MenuEvents{RIGHT} and $self->{currentItemIndex} == 1) { 4463 ++$::NumGuys if $::NumGuys < 6; 4464 $self->UpdateControlsMenu(); 4465 } 4466 if ($::MenuEvents{BUTTON}) { 4467 last if $self->{currentItemIndex} == 0; # Back to main 4468 next if $self->{currentItemIndex} == 1; 4469 my $player = $::Players[$self->{currentItemIndex} - 2]; 4470 my $key = 0; 4471 my $keysAsText = $keysAsText[$self->{currentItemIndex} - 2]; 4472 $self->{currentItem}->Hide(); 4473 $keysAsText->Hide(); 4474 my @prompts = ("Press 'LEFT' key or joystick button", "Press 'RIGHT' key", "Press 'FIRE' key"); 4475 my $keyMenuItem = new MenuItem( 100, $yPositions[$self->{currentItemIndex} - 1], $prompts[0] ); 4476 push @::GameObjects, ($keyMenuItem); 4477 $keyMenuItem->Select; 4478 while (1) { 4479 $self->MenuAdvance(); 4480 if ($self->{abortgame}) { 4481 $self->{abortgame} = 0; 4482 goto endOfKeyEntry; 4483 } 4484 if (%::Events) { 4485 my ($event) = %::Events; 4486 if ($event =~ /^B(\d+)$/) { 4487 $player->{keys} = ["L$1", "R$1", "B$1"]; 4488 last; 4489 } 4490 $player->{keys}->[$key] = $event; 4491 ++$key; 4492 last if $key >= 3; 4493 $keyMenuItem->SetText($prompts[$key]); 4494 } 4495 } 4496 4497 $keyMenuItem->SetText('Select character'); 4498 my $guy = new Guy($player); 4499 $guy->{x} = $keyMenuItem->{targetX} + $keyMenuItem->{w} + 10; 4500 $guy->{y} = $keyMenuItem->{targetY} - 10; 4501 $guy->DemoMode(); 4502 splice @::GameObjects, -2, 0, $guy; 4503 while (1) { 4504 $self->MenuAdvance(); 4505 if ($self->{abortgame}) { 4506 $self->{abortgame} = 0; 4507 goto endOfKeyEntry; 4508 } 4509 if ($::Events{$player->{keys}->[0]}) { 4510 --$player->{imagefileindex}; 4511 $player->{imagefileindex} = $#::GuyImageFiles if $player->{imagefileindex} < 0; 4512 &::MakeGuySurface($player); $guy->{surface} = $player->{guySurface}; $guy->CalculateAnimPhases(); 4513 } elsif ($::Events{$player->{keys}->[1]}) { 4514 ++$player->{imagefileindex}; 4515 $player->{imagefileindex} = 0 if $player->{imagefileindex} > $#::GuyImageFiles; 4516 &::MakeGuySurface($player); $guy->{surface} = $player->{guySurface}; $guy->CalculateAnimPhases(); 4517 } elsif ($::Events{$player->{keys}->[2]}) { 4518 last; 4519 } 4520 } 4521 4522 $keyMenuItem->SetText('Select color'); 4523 while (1) { 4524 $self->MenuAdvance(); 4525 if ($self->{abortgame}) { 4526 $self->{abortgame} = 0; 4527 goto endOfKeyEntry; 4528 } 4529 if ($::Events{$player->{keys}->[0]}) { 4530 --$player->{colorindex}; 4531 $player->{colorindex} = $#::GuyColors if $player->{colorindex} < 0; 4532 &::MakeGuySurface($player); $guy->{surface} = $player->{guySurface}; 4533 } elsif ($::Events{$player->{keys}->[1]}) { 4534 ++$player->{colorindex}; 4535 $player->{colorindex} = 0 if $player->{colorindex} > $#::GuyColors; 4536 &::MakeGuySurface($player); $guy->{surface} = $player->{guySurface}; 4537 } elsif ($::Events{$player->{keys}->[2]}) { 4538 last; 4539 } 4540 } 4541 4542 endOfKeyEntry: 4543 $guy->Delete() if $guy; 4544 $self->{currentItem}->Show(); 4545 $self->{currentItem}->Select; 4546 $keysAsText->SetText(&KeysToText($player->{keys})); 4547 $keysAsText->Show; 4548 $keyMenuItem->HideAndDelete; 4549 } 4550 } 4551 4552 foreach my $menuItem (@keysAsText) { $menuItem->HideAndDelete(); } 4553 $self->LeaveSubMenu($recall); 4554 $self->{title}->Show(); 4555 delete $self->{keysAsText}; 4556} 4557 4558sub UpdateGameMenu { 4559 my $self = shift; 4560 4561 $self->{menuItems}->[3]->SetText("< Difficulty: $::DifficultyLevel->{name} >"); 4562 $self->{menuItems}->[4]->SetText("< Weapon Duration: $::WeaponDuration->{name} >"); 4563} 4564 4565sub RunGameMenu { 4566 my $self = shift; 4567 my ($recall); 4568 4569 $recall = $self->EnterSubMenu(); 4570 my ($y, $yinc) = (110, 40); 4571 push @{$self->{menuItems}}, ( 4572 new MenuItem( 100, $y += $yinc, "Back to main menu", "Press Enter to return to the main menu"), 4573 new MenuItem( 100, $y += $yinc + 20, "Start Panic Game", "In Panic Mode, the balls continuously fall from the sky.", "Can you keep up the pace?", "This game is for advanced players." ), 4574 new MenuItem( 100, $y += $yinc, "Start Challenge Game", "More and more difficult levels challenge your skill.", "This game is best for beginners." ), 4575 new MenuItem( 68, $y += $yinc, "<>", "Press the Left and Right keys to set the game difficulty.", "The game speed and number of harpoons depend on this setting.", "The `Miki' level is for Deathball Specialists (Panic mode only)." ), 4576 new MenuItem( 68, $y += $yinc, "<>", "Press the Left and Right keys to set the bonus weapon duration.", "This will determine how long you can use bonus weapons." ), 4577 ); 4578 $self->UpdateGameMenu(); 4579 push @::GameObjects, (@{$self->{menuItems}}); 4580 $self->SetCurrentItemIndex($::LastGameMenuResult ? $::LastGameMenuResult : 1); 4581 4582 while (1) { 4583 $self->MenuAdvance(); 4584 last if $self->{abortgame}; 4585 $self->HandleUpDownKeys(); 4586 4587 if ($::MenuEvents{LEFT} and $self->{currentItemIndex} == 3) { 4588 &::SetDifficultyLevel($::DifficultyLevelIndex - 1); 4589 $self->UpdateGameMenu(); 4590 } 4591 if ($::MenuEvents{RIGHT} and $self->{currentItemIndex} == 3) { 4592 &::SetDifficultyLevel($::DifficultyLevelIndex + 1); 4593 $self->UpdateGameMenu(); 4594 } 4595 if ($::MenuEvents{LEFT} and $self->{currentItemIndex} == 4) { 4596 &::SetWeaponDuration($::WeaponDurationIndex - 1); 4597 $self->UpdateGameMenu(); 4598 } 4599 if ($::MenuEvents{RIGHT} and $self->{currentItemIndex} == 4) { 4600 &::SetWeaponDuration($::WeaponDurationIndex + 1); 4601 $self->UpdateGameMenu(); 4602 } 4603 if ($::MenuEvents{BUTTON}) { 4604 last if $self->{currentItemIndex} == 0; # Back to main 4605 if ($self->{currentItemIndex} == 1) { 4606 $self->{result} = 'panic'; 4607 } elsif ($self->{currentItemIndex} == 2) { 4608 if ($::DifficultyLevel->{name} ne 'Miki') { 4609 $self->{result} = 'challenge'; 4610 } else { 4611 $self->ShowTooltip("Miki difficulty level is for panic mode only."); 4612 } 4613 } 4614 } 4615 last if $self->{result}; 4616 } 4617 4618 $::LastGameMenuResult = $self->{currentItemIndex}; 4619 $self->LeaveSubMenu($recall); 4620} 4621 4622sub OnMenuIdle { 4623 my $self = shift; 4624 4625 ++$self->{idle}; 4626 if ($self->{idle} == 1) { $self->RunHighScores('auto'); } 4627 elsif ($self->{idle} == 2) { $self->RunCredits('demo'); } 4628 elsif ($self->{idle} == 3) { $self->{idle} = 0; return 'demo'; } 4629 return ''; 4630} 4631 4632sub Run { 4633 my $self = shift; 4634 my ($y, $yinc, $idle); 4635 4636 $self->ResetGame(); 4637 $::ScoreFont->use(); 4638 ($y, $yinc) = ($::ScreenHeight + 15, 20); 4639 $::Background->print( 10, $y += $yinc, "Pang Zero $::Version (C) 2006 by UPi (upi\@sourceforge.net)" ) if $y + $yinc * 2 < $::PhysicalScreenHeight; 4640 $::Background->print( 10, $y += $yinc, "Use cursor keys to navigate menu, Enter to select" ) if $y + $yinc * 2 < $::PhysicalScreenHeight; 4641 $::Background->print( 10, $y += $yinc, "P pauses the game, Esc quits" ) if $y + $yinc * 2 < $::PhysicalScreenHeight; 4642 $::Background->blit(0, $::App, 0); 4643 4644 $::MenuFont->use(); 4645 push @::GameObjects, (new FpsIndicator); 4646 $self->SetGameSpeed(); 4647 $::GamePause = 0; 4648 4649 ($y, $yinc) = (90, 40); 4650 4651 $self->{menuItems} = [ 4652 new MenuItem( 100, $y += $yinc, "Start Game" ), 4653 new MenuItem( 100, $y += $yinc, "Options", "Various game settings" ), 4654 new MenuItem( 100, $y += $yinc, "Setup players", "Set the number of players, setup keys and joysticks" ), 4655 new MenuItem( 100, $y += $yinc, "Help", "How to play the game, demo of special balls" ), 4656 new MenuItem( 100, $y += $yinc, "Credits", "You might be wondering: Who has created Pang Zero?", "Wonder no more." ), 4657 new MenuItem( 100, $y += $yinc, "High Scores", "Hall of Fame." ), 4658 new MenuItem( 100, $y += $yinc, "Exit Game", "Press Enter to exit the game" ), 4659 ]; 4660 4661 $self->{title} = new MenuItem( 300, 60, "PANG ZERO" ); 4662 $self->{title}->{filled} = 1; 4663 $self->{title}->{fillcolor} = new SDL::Color(-b=>255, -g=>128); 4664 $self->{title}->Center(); 4665 4666 push @::GameObjects, ( 4667 &Ball::Spawn($::BallDesc[8], -1, 1), 4668 &Ball::Spawn($::BallDesc[0], -1, 0), 4669 &Ball::Spawn($::BallDesc{super0}, -1, 1), 4670 &Ball::Spawn($::BallDesc[2], -1, 0), 4671 &Ball::Spawn($::BallDesc[5], -1, 1), 4672 $self->{title}, 4673 @{$self->{menuItems}}, 4674 ); 4675 4676 $self->SetCurrentItemIndex( 0 ); 4677 &GameTimer::ResetTimer(); 4678 4679 while (1) { 4680 $self->MenuAdvance(); 4681 $self->Exit() if $self->{abortgame}; 4682 $self->HandleUpDownKeys(); 4683 last if $self->{result}; 4684 if ($::MenuEvents{BUTTON}) { 4685 if ($self->{currentItemIndex} == 0) { 4686 $self->RunGameMenu(); 4687 } elsif ($self->{currentItemIndex} == 1) { 4688 $self->RunOptionsMenu(); 4689 } elsif ($self->{currentItemIndex} == 2) { 4690 $self->RunControlsMenu(); 4691 } elsif ($self->{currentItemIndex} == 3) { 4692 $self->RunTutorialMenu; 4693 } elsif ($self->{currentItemIndex} == 4) { 4694 $self->RunCredits(); 4695 } elsif ($self->{currentItemIndex} == 5) { 4696 $self->RunHighScores(); 4697 } 4698 $self->Exit() if $self->{currentItemIndex} == 6; 4699 } 4700 if (%::Events) { 4701 $idle = 0; 4702 } else { 4703 if (++$idle > 1000) { $self->{result} = $self->OnMenuIdle(); $idle = 0; } 4704 } 4705 } 4706 4707 $::ScoreFont->use(); 4708 return $self->{result}; 4709} 4710 4711 4712########################################################################## 4713package main; 4714########################################################################## 4715 4716 4717sub SaveScreenshot { 4718 my $i = 0; 4719 my $filename; 4720 do { $filename = sprintf("screenshot%03d.bmp", $i); ++$i } while (-f $filename); 4721 $App->save_bmp($filename); 4722} 4723 4724sub Pause { 4725 my $pausedSurface = new SDL::Surface(-name => "$DataDir/paused.png"); 4726 my $event = new SDL::Event; 4727 4728 $pausedSurface->blit(0, $App, new SDL::Rect(-x => ($PhysicalScreenWidth - $pausedSurface->width) / 2, -y => $PhysicalScreenHeight / 2 - 100)); 4729 $App->sync(); 4730 $::Keys = (); $::Events = (); 4731 while (1) { # Paused, wait for keypress 4732 $event->wait(); 4733 last if $event->type() == SDL_KEYDOWN and $event->key_sym == SDLK_p; 4734 if ($event->type() == SDL_KEYDOWN and $event->key_sym == SDLK_ESCAPE) { $Game->{abortgame} = 1; last; } 4735 $Game->Exit() if $event->type() == SDL_QUIT; 4736 } 4737 $Background->blit(0, $App, 0); 4738 &GameTimer::ResetTimer(); 4739} 4740 4741sub HandleEvents { 4742 my ($readBothJoystickAxes) = @_; 4743 my ($event, $type); 4744 4745 $event = new SDL::Event; 4746 while (1) { 4747 last unless $event->poll(); 4748 $type = $event->type(); 4749 4750 if ($type == SDL_QUIT) { 4751 $Game->Exit(); 4752 } 4753 elsif ($type == SDL_KEYDOWN) { 4754 my $keypressed = $event->key_sym; 4755 if ($keypressed == SDLK_ESCAPE) { 4756 $Game->{abortgame} = 1; 4757 } elsif ($keypressed == SDLK_F1) { 4758 &SaveScreenshot(); 4759 } elsif ($keypressed == SDLK_p and not $UnicodeMode) { 4760 &Pause(); 4761 } else { 4762 $Keys{$keypressed} = 1; 4763 $Events{$keypressed} = 1; 4764 $MenuEvents{UP} = 1 if $keypressed == SDLK_UP(); 4765 $MenuEvents{DOWN} = 1 if $keypressed == SDLK_DOWN(); 4766 $MenuEvents{LEFT} = 1 if $keypressed == SDLK_LEFT(); 4767 $MenuEvents{RIGHT} = 1 if $keypressed == SDLK_RIGHT(); 4768 $MenuEvents{BUTTON} = 1 if $keypressed == SDLK_RETURN(); 4769 $LastUnicodeKey = $event->key_unicode() if $UnicodeMode; 4770 } 4771 } 4772 elsif ($type == SDL_KEYUP) { 4773 my $keypressed = $event->key_sym; 4774 $Keys{$keypressed} = 0; 4775 } 4776 } 4777 4778 &Joystick::ReadJoystick($readBothJoystickAxes); 4779} 4780 4781sub DoMenu { 4782 my $oldScreenHeight = $ScreenHeight; 4783 my $oldScreenWidth = $ScreenWidth; 4784 $ScreenWidth = $PhysicalScreenWidth - $ScreenMargin * 2; 4785 $ScreenWidth = int($ScreenWidth / 32) * 32; 4786 4787 $Game = new Menu; 4788 my $retval = $Game->Run(); 4789 &SaveConfig(); 4790 4791 $ScreenWidth = $oldScreenWidth; 4792 $ScreenHeight = $oldScreenHeight; 4793 4794 return $retval; 4795} 4796 4797sub DoDemo { 4798 my $messages = $Game->{messages} = { 4799 1 => "Use harpoons to pop the balloons", 4800 160 => "Pop them, and they split in two", 4801 300 => "Pop them again and again", 4802 530 => "Popping the smallest ballons makes them disappear", 4803 630 => "The green Super Ball gives you a lot of free time", 4804 720 => "Use this time wisely!", 4805 1150 => "Making a lot of small balls is dangerous! Observe...", 4806 1600 => "Don't let the balloons touch you!", 4807 1708 => "Dying gives you some free time.", 4808 1900 => "So does shooting the flashing balloons.", 4809 2370 => "The yellow Super Ball destroys every balloon", 4810 2650 => "And now... THE SPECIAL BALL DEMO!", 4811 2950 => "The Bouncy Ball bounces twice as high as normal balls.", 4812 3620 => "See?", 4813 4222 => "The Hexa Ball is weightless and travels in a straight line.", 4814 4500 => "So does its offspring.", 4815 5210 => "The blue Water Ball splits every time it bounces.", 4816 5900 => "This can cause a tide of small balls!", 4817 6630 => "The Earthquake Ball will really shake you up.", 4818 7100 => "Its offspring is not as dangerous, but still annoying.", 4819 7800 => "Behold, the Death Ball. It cannot be killed!!!", 4820 8120 => "No, really, it can't! In fact, shooting it makes it multiply.", 4821 8220 => "If you avoid it for 20 secs, Deathballs will get bored and go away.", 4822 8320 => "Also, the yellow Super Ball will destroy the Deathballs for you.", 4823 8800 => "Shooting it too much will lead to the Deathball Meltdown.", 4824 9550 => "Last but not least: here's the Seeker Ball!", 4825 9900 => "This ball will stalk you forever.", 4826 10100 => "Whew! This concludes the Special Ball Demo. Have fun playing!", 4827 }; 4828 my $record = 0 x 23 . 1 x 18 . 0 x 19 . 2 x 7 . 0 x 31 . 4 x 1 . 0 x 44 . 2 x 43 . 0 x 7 . 4 x 1 . 0 x 22 . 1 x 10 . 0 x 17 . 2 x 38 . 0 x 16 . 2 x 22 . 0 x 42 . 4 x 1 . 0 x 54 . 1 x 43 . 0 x 2 . 4 x 1 . 0 x 28 . 1 x 27 . 0 x 8 . 4 x 1 . 0 x 98 . 2 x 19 . 0 x 11 . 4 x 1 . 0 x 27 . 1 x 24 . 5 x 1 . 1 x 1 . 0 x 17 . 1 x 9 . 0 x 2 . 4 x 1 . 0 x 51 . 2 x 19 . 0 x 14 . 4 x 1 . 0 x 48 . 1 x 14 . 0 x 2 . 4 x 1 . 0 x 51 . 1 x 8 . 0 x 25 . 4 x 1 . 0 x 49 . 2 x 25 . 0 x 3 . 4 x 1 . 0 x 53 . 1 x 12 . 0 x 9 . 4 x 1 . 0 x 101 . 1 x 9 . 0 x 4 . 4 x 1 . 0 x 68 . 1 x 7 . 5 x 1 . 0 x 75 . 2 x 14 . 0 x 2 . 4 x 1 . 0 x 64 . 2 x 38 . 0 x 3 . 4 x 1 . 0 x 13 . 2 x 13 . 0 x 25 . 2 x 25 . 0 x 5 . 4 x 1 . 0 x 54 . 4 x 1 . 0 x 69 . 1 x 3 . 0 x 15 . 4 x 1 . 0 x 19 . 2 x 17 . 0 x 94 . 2 x 28 . 0 x 27 . 2 x 52 . 0 x 22 . 4 x 1 . 0 x 34 . 1 x 28 . 0 x 34 . 1 x 29 . 0 x 24 . 4 x 1 . 0 x 80 . 1 x 15 . 0 x 116 . 1 x 10 . 5 x 1 . 1 x 1 . 0 x 808 . 2 x 35 . 0 x 16 . 4 x 1 . 0 x 55 . 1 x 46 . 5 x 1 . 1 x 2 . 0 x 368 . 8 x 1 . 0 x 487 . 1 x 27 . 0 x 48 . 2 x 8 . 6 x 1 . 2 x 7 . 0 x 7 . 2 x 18 . 6 x 1 . 2 x 11 . 0 x 119 . 1 x 1 . 0 x 167 . 8 x 1 . 0 x 1177 . 2 x 24 . 0 x 121 . 2 x 22 . 0 x 2 . 4 x 1 . 0 x 31 . 2 x 15 . 0 x 9 . 2 x 4 . 6 x 1 . 2 x 5 . 0 x 8 . 2 x 10 . 0 x 69 . 8 x 1 . 0 x 338 . 1 x 87 . 0 x 152 . 2 x 52 . 0 x 112 . 1 x 27 . 0 x 2 . 4 x 1 . 0 x 71 . 1 x 41 . 0 x 4 . 4 x 1 . 0 x 65 . 2 x 24 . 0 x 209 . 8 x 1 . 0 x 579 . 1 x 3 . 0 x 13 . 2 x 3 . 0 x 14 . 4 x 1 . 0 x 58 . 2 x 28 . 0 x 9 . 4 x 1 . 0 x 93 . 2 x 37 . 0 x 26 . 2 x 11 . 0 x 22 . 2 x 9 . 6 x 1 . 2 x 6 . 6 x 1 . 2 x 7 . 6 x 1 . 2 x 5 . 6 x 1 . 2 x 7 . 6 x 1 . 2 x 16 . 6 x 1 . 2 x 9 . 6 x 1 . 2 x 20 . 1 x 7 . 0 x 21 . 2 x 13 . 1 x 3 . 5 x 1 . 1 x 8 . 5 x 1 . 1 x 6 . 5 x 1 . 1 x 6 . 5 x 1 . 1 x 35 . 0 x 6 . 5 x 1 . 1 x 6 . 0 x 11 . 2 x 12 . 6 x 1 . 2 x 8 . 6 x 1 . 1 x 6 . 5 x 1 . 1 x 3 . 0 x 3 . 4 x 1 . 1 x 3 . 0 x 3 . 5 x 1 . 1 x 4 . 0 x 15 . 1 x 2 . 5 x 1 . 1 x 4 . 0 x 4 . 5 x 1 . 1 x 7 . 5 x 1 . 1 x 4 . 0 x 5 . 1 x 6 . 0 x 2 . 4 x 1 . 1 x 4 . 0 x 4 . 4 x 1 . 0 x 3 . 1 x 4 . 0 x 3 . 4 x 1 . 0 x 10 . 2 x 14 . 6 x 1 . 2 x 2 . 1 x 5 . 5 x 1 . 1 x 6 . 5 x 1 . 1 x 5 . 5 x 1 . 1 x 2 . 0 x 3 . 4 x 1 . 1 x 3 . 0 x 3 . 4 x 1 . 1 x 3 . 0 x 2 . 1 x 2 . 5 x 1 . 1 x 4 . 5 x 1 . 1 x 6 . 5 x 1 . 1 x 7 . 5 x 1 . 1 x 7 . 0 x 2 . 2 x 4 . 6 x 1 . 2 x 4 . 0 x 2 . 2 x 2 . 6 x 1 . 2 x 6 . 6 x 1 . 2 x 7 . 1 x 5 . 5 x 1 . 1 x 1 . 0 x 5 . 2 x 6 . 6 x 1 . 2 x 2 . 0 x 4 . 1 x 3 . 5 x 1 . 1 x 1 . 0 x 8 . 2 x 4 . 6 x 1 . 2 x 1 . 0 x 3 . 1 x 4 . 0 x 7 . 2 x 6 . 6 x 1 . 2 x 8 . 6 x 1 . 2 x 6 . 6 x 1 . 2 x 3 . 0 x 3 . 1 x 3 . 0 x 10 . 2 x 7 . 0 x 2 . 1 x 1 . 5 x 1 . 1 x 5 . 0 x 2 . 4 x 1 . 1 x 2 . 0 x 4 . 4 x 1 . 0 x 2 . 1 x 2 . 0 x 3 . 1 x 1 . 5 x 1 . 1 x 5 . 5 x 1 . 1 x 3 . 0 x 4 . 5 x 1 . 1 x 1 . 0 x 4 . 4 x 1 . 1 x 2 . 0 x 4 . 4 x 1 . 1 x 1 . 0 x 6 . 4 x 1 . 1 x 1 . 0 x 5 . 1 x 1 . 5 x 1 . 1 x 2 . 0 x 3 . 1 x 1 . 5 x 1 . 1 x 6 . 5 x 1 . 1 x 7 . 5 x 1 . 1 x 6 . 5 x 1 . 1 x 6 . 5 x 1 . 1 x 7 . 0 x 12 . 2 x 7 . 0 x 2 . 4 x 1 . 2 x 2 . 0 x 4 . 4 x 1 . 0 x 135 . 8 x 1 . 0 x 252 . 1 x 57 . 0 x 199 . 2 x 37 . 0 x 3 . 1 x 1 . 5 x 1 . 1 x 29 . 0 x 21 . 1 x 30 . 0 x 37 . 4 x 1 . 0 x 77 . 1 x 17 . 0 x 4 . 2 x 126 . 3 x 1 . 1 x 52 . 5 x 1 . 1 x 64 . 0 x 39 . 8 x 1 . 0 x 140; 4829 my $rand = [2199.02,1.12,0.11,1.24,0.11,1.21,0.33,0.19,0.16,0.12,0.07,0.28,0.68]; 4830 4831 &::SaveConfig(); 4832 $Game = new DemoPlaybackGame( 1, 3, $record, $rand, $messages ); 4833 $Game->Run(); 4834 &::LoadConfig(); 4835 $Game->RestoreGameSettings(); 4836} 4837 4838sub DoRecordDemo { 4839 my ($numguys, $difficulty) = ($NumGuys, $DifficultyLevelIndex); 4840 4841 $NumGuys = 1; 4842 &SetDifficultyLevel(3); 4843 $Game = new DemoRecordGame; 4844 $Game->Run(); 4845 print "\n\$record = '", $Game->{record}, "';\n"; 4846 print "\$rand = [", join( ', ', @{$Game->{rand}} ), "];\n\n"; 4847 $NumGuys = $numguys; 4848 &SetDifficultyLevel($difficulty); 4849} 4850 4851 4852########################################################################## 4853# MAIN PROGRAM STARTS HERE 4854########################################################################## 4855 4856sub Initialize { 4857 4858 eval { SDL::Init(SDL_INIT_EVERYTHING()); }; 4859 eval { SDL::Init(SDL::INIT_EVERYTHING()); } if $@; # This is a workaround for SDL_perl 1.2.20 4860 die "Unable to initialize SDL: $@" if $@; 4861 4862 &FindDataDir(); 4863 &LoadConfig(); 4864 print "Data directory is at '$DataDir'\n"; 4865 my $sdlFlags; 4866 if (&IsMicrosoftWindows()) { 4867 $sdlFlags = SDL_ANYFORMAT; 4868 } else { 4869 $sdlFlags = SDL_HWSURFACE | SDL_HWACCEL | SDL_DOUBLEBUF | SDL_ANYFORMAT; 4870 } 4871 4872 ($PhysicalScreenWidth, $PhysicalScreenHeight) = &FindVideoMode(); 4873 #($PhysicalScreenWidth, $PhysicalScreenHeight) = (848, 480); $FullScreen = 0; 4874 4875 $App = new SDL::App 4876 -flags => $sdlFlags, 4877 -title => "Pang Zero $::Version", 4878 -icon => "$DataDir/icon.png", 4879 -width => $PhysicalScreenWidth, 4880 -height => $PhysicalScreenHeight, 4881 -fullscreen => $FullScreen, 4882 ; 4883 eval( 'use SDL::Tool::Graphic; $RotoZoomer = new SDL::Tool::Graphic; $::SmoothRotoZoom = 0;' ); # Detect if zoom / rotozoom works 4884 4885 &SDL::ShowCursor(0); 4886 4887 $Background = new SDL::Surface( 4888 -name =>'', 4889 -flags=> ( &IsMicrosoftWindows ? SDL_SWSURFACE : SDL_HWSURFACE ), 4890 -width => $App->width, 4891 -height => $App->height, 4892 -depth => 16, 4893 -Amask => '0 but true'); 4894 $Background->display_format; 4895 $ScoreFont = new SDL::Font("$DataDir/brandybun3.png"); 4896 $MenuFont = new SDL::Font("$::DataDir/font2.png"); 4897 $GlossyFont = new SDL::Font("$::DataDir/glossyfont.png"); 4898 4899 &LoadSurfaces(); 4900 &LoadSounds(); 4901 &Joystick::InitJoystick(); 4902} 4903 4904sub MainLoop { 4905 my $menuResult = &DoMenu(); 4906 if ($menuResult eq 'demo') { 4907 &DoDemo(); 4908 return; 4909 } 4910 4911 # $Game = new DemoRecordGame; 4912 if ($menuResult eq 'challenge') { 4913 $Game = new ChallengeGame; 4914 } else { 4915 $Game = new PanicGame; 4916 } 4917 @UnsavedHighScores = (); 4918 $Game->Run(); 4919 4920 bless $Game, 'Menu'; 4921 $Game->{abortgame} = 0; 4922 { my @gameObjects = @GameObjects; foreach (@gameObjects) { $_->Delete() if ref $_ eq 'Guy'; } } 4923 $Background->blit(0, $App, 0); 4924 $MenuFont->use(); 4925 &MergeUnsavedHighScores($menuResult eq 'challenge' ? 'Cha' : 'Pan'); 4926return; 4927 4928 my ($filename, $i) = ('', 1); 4929 do { $filename = sprintf("record%03d.txt", $i); ++$i } while (-f $filename); 4930 open RECORD, ">$filename"; 4931 print RECORD "NumGuys = $NumGuys;\nDifficultyLevelIndex = $DifficultyLevelIndex;\nrecord = '$Game->{record}';\n", 4932 "DeathBallsEnabled = $DeathBallsEnabled;\nEarthquakeBallsEnabled = $EarthquakeBallsEnabled;\n", 4933 "WaterBallsEnabled = $WaterBallsEnabled;\nSeekerBallsEnabled = $SeekerBallsEnabled;\n", 4934 'rand = [', join(',', @{$Game->{rand}}), "];\n\n"; 4935 close RECORD; 4936 4937 $Game = new DemoPlaybackGame($NumGuys, $DifficultyLevelIndex, $Game->{record}, $Game->{rand}, {}); 4938 $Game->Run(); 4939 $Game->RestoreGameSettings(); 4940} 4941 4942sub ShowErrorMessage { 4943 my ($message) = @_; 4944 4945 eval("SDL::Quit"); warn $@ if $@; 4946 $message = "Pang Zero $::Version died:\n$message"; 4947 if (&IsMicrosoftWindows()) { 4948 eval( ' 4949 use Win32; 4950 Win32::MsgBox($message, MB_ICONEXCLAMATION, "Pang Zero error"); 4951 ' ); 4952 return; 4953 } elsif ($ENV{'DISPLAY'}) { 4954 $message =~ s/\"/\\"/g; 4955 my @tryCommands = ( 4956 "kdialog --msgbox \"$message\"", 4957 "gmessage -center \"$message\"", 4958 "xmessage -center \"$message\"", 4959 ); 4960 foreach (@tryCommands) { 4961 `$_`; 4962 return if $? == 0; 4963 } 4964 } 4965} 4966 4967sub ShowWebPage { 4968 my ($url) = @_; 4969 4970 eval("SDL::Quit"); warn $@ if $@; 4971 if (&IsMicrosoftWindows()) { 4972 my $ws = "$DataDir/website.html"; 4973 $ws =~ s/\//\\\\/g; 4974 exec 'cmd', '/c', $ws; 4975 exit; 4976 } elsif ($ENV{'DISPLAY'}) { 4977 my @tryCommands = ( 4978 "gnome-open $url", 4979 "mozilla-firefox $url", 4980 "firefox $url", 4981 "mozilla $url", 4982 "konqueror $url", 4983 ); 4984 foreach (@tryCommands) { 4985 `$_`; 4986 return if $? == 0; 4987 } 4988 } else { 4989 print "Visit $url for more info about Pang Zero $::Version\n"; 4990 } 4991} 4992 4993 4994# 4995# Program Entry Point 4996# 4997 4998eval { 4999 &Initialize(); 5000 #&DoDemo() while 1; 5001 #while (1) { &DoRecordDemo(); $::App->delay(2000); } 5002 while (1) { &MainLoop(); } 5003}; 5004if ($@) { 5005 my $errorMessage = $@; 5006 &ShowErrorMessage($errorMessage); 5007 die $errorMessage; 5008} 5009 5010
