PageRenderTime 256ms CodeModel.GetById 5ms app.highlight 235ms RepoModel.GetById 1ms app.codeStats 1ms

/frozen-bubble.pl

https://github.com/LonelyBob/frozenbubble-improvements
Perl | 2254 lines | 1872 code | 251 blank | 131 comment | 385 complexity | 88b8d3abe06e21827f7d46a5c9ab5dff MD5 | raw file

Large files files are truncated, but you can click here to view the full file

   1#!/usr/bin/perl
   2#*****************************************************************************
   3#
   4#                          Frozen-Bubble
   5#
   6# Copyright (c) 2000, 2001, 2002, 2003 Guillaume Cottenceau <guillaume.cottenceau at free.fr>
   7#
   8# Sponsored by MandrakeSoft <http://www.mandrakesoft.com/>
   9#
  10# This program is free software; you can redistribute it and/or modify
  11# it under the terms of the GNU General Public License version 2, as
  12# published by the Free Software Foundation.
  13#
  14# This program is distributed in the hope that it will be useful,
  15# but WITHOUT ANY WARRANTY; without even the implied warranty of
  16# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17# GNU General Public License for more details.
  18#
  19# You should have received a copy of the GNU General Public License
  20# along with this program; if not, write to the Free Software
  21# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  22#
  23#
  24#******************************************************************************
  25#
  26# Design & Programming by Guillaume Cottenceau between Oct 2001 and Jan 2002.
  27# Level Editor parts by Kim Joham and David Joham between Oct 2002 and Jan 2003
  28#
  29# Check official home: http://www.frozen-bubble.org/
  30#
  31#******************************************************************************
  32#
  33#
  34# Yes it uses Perl, you non-believer :-).
  35#
  36
  37#use diagnostics;
  38#use strict;
  39
  40use vars qw($TARGET_ANIM_SPEED $BUBBLE_SIZE $ROW_SIZE $LAUNCHER_SPEED $BUBBLE_SPEED $MALUS_BUBBLE_SPEED $TIME_APPEARS_NEW_ROOT
  41            %POS %POS_1P %POS_2P $KEYS %actions %angle %pdata $app $font %apprects $event %rects %sticked_bubbles %root_bubbles
  42            $background $background_orig @bubbles_images $gcwashere %bubbles_anim %launched_bubble %tobe_launched %next_bubble
  43            $shooter $sdl_flags $mixer $mixer_enabled $music_disabled $sfx_disabled @playlist %sound %music %pinguin %canon
  44            $graphics_level @update_rects $CANON_ROTATIONS_NB %malus_bubble %falling_bubble %exploding_bubble %malus_gfx
  45            %sticking_bubble $version $time %imgbin $TIME_HURRY_WARN $TIME_HURRY_MAX $TIMEOUT_PINGUIN_SLEEP $FREE_FALL_CONSTANT
  46            $direct @PLAYERS %levels $display_on_app_disabled $total_time $time_1pgame $fullscreen $rcfile $hiscorefile $HISCORES
  47            $lev_number $playermalus $loaded_levelset $direct_levelset $chainreaction %chains %history);
  48
  49use Data::Dumper;
  50
  51use SDL;
  52use SDL::App;
  53use SDL::Surface;
  54use SDL::Event;
  55use SDL::Cursor;
  56use SDL::Font;
  57use SDL::Mixer;
  58
  59use fb_stuff;
  60use fbsyms;
  61use FBLE;
  62
  63$| = 1;
  64
  65$TARGET_ANIM_SPEED = 20;        # number of milliseconds that should last between two animation frames
  66$LAUNCHER_SPEED = 0.03;  	# speed of rotation of launchers
  67$BUBBLE_SPEED = 10;		# speed of movement of launched bubbles
  68$MALUS_BUBBLE_SPEED = 30;	# speed of movement of "malus" launched bubbles
  69$CANON_ROTATIONS_NB = 40;       # number of rotations of images for canon (should be consistent with gfx/shoot/Makefile)
  70
  71$TIMEOUT_PINGUIN_SLEEP = 200;
  72$FREE_FALL_CONSTANT = 0.5;
  73$KEYS = { p1 => { left => SDLK_x,    right => SDLK_v,     fire => SDLK_c,  center => SDLK_d },
  74	  p2 => { left => SDLK_LEFT, right => SDLK_RIGHT, fire => SDLK_UP, center => SDLK_DOWN },
  75	  misc => { fs => SDLK_f } };
  76
  77$sdl_flags = SDL_ANYFORMAT | SDL_HWSURFACE | SDL_DOUBLEBUF | SDL_HWACCEL | SDL_ASYNCBLIT;
  78$mixer = 0;
  79$graphics_level = 3;
  80@PLAYERS = qw(p1 p2);
  81$playermalus = 0;
  82$chainreaction = 0;
  83
  84$rcfile = "$ENV{HOME}/.fbrc";
  85eval(cat_($rcfile));
  86eval(cat_($hiscorefile = "$ENV{HOME}/.fbhighscores"));
  87
  88$version = '1.0.1';
  89
  90print "        [[ Frozen-Bubble-$version ]]\n\n";
  91print '  http://www.frozen-bubble.org/
  92
  93  Copyright (c) 2000, 2001, 2002, 2003 Guillaume Cottenceau.
  94  Artwork: Alexis Younes <73lab at free.fr>
  95           Amaury Amblard-Ladurantie <amaury at linuxfr.org>
  96  Soundtrack: Matthias Le Bidan <matthias.le_bidan at caramail.com>
  97  Design & Programming: Guillaume Cottenceau <guillaume.cottenceau at free.fr>
  98  Level Editor: Kim and David Joham <[k|d]joham at yahoo.com>
  99
 100  Sponsored by MandrakeSoft <http://www.mandrakesoft.com/>
 101
 102  This program is free software; you can redistribute it and/or modify
 103  it under the terms of the GNU General Public License version 2, as
 104  published by the Free Software Foundation.
 105
 106';
 107
 108local $_ = "@ARGV";
 109
 110/-h/ and die "Usage: ", basename($0), " [OPTION]...
 111  -h, --help                 display this help screen
 112 -fs, --fullscreen           start in fullscreen mode
 113 -ns, --nosound              don't try to start any sound stuff
 114 -nm, --nomusic              disable music (only)
 115 -nfx, --nosfx               disable sound effects (only)
 116      --playlist<file>       use all files listed in the given file as music files and play them
 117      --playlist<directory>  use all files inside the given directory as music files and play them
 118 -sl, --slow_machine         enable slow machine mode (disable a few animations)
 119 -vs, --very_slow_machine    enable very slow machine mode (disable all that can be disabled)
 120 -di, --direct               directly start (2p) game (don't display menu)
 121 -so, --solo                 directly start solo (1p) game, with random levels
 122 -cr, --chain_reaction       enable chain-reaction
 123 -l<#n>, --level<#n>         directly start the n-th level
 124 -cb, --colourblind          use bubbles for colourblind people
 125 -pm<#n>, --playermalus<#n>  add a malus of n to the left player (can be negative)
 126 -ls<name>, --levelset<name> directly start with the specified levelset name
 127
 128";
 129
 130/-fs/ || /-fu/ and $fullscreen = 1;
 131/-ns/ || /-noso/ and $mixer = 'SOUND_DISABLED';
 132/-nm/ || /-nom/ and $music_disabled = 1;
 133/-nfx/ || /-nosf/ and $sfx_disabled = 1;
 134/-playlist\s*(\S+)/ and @playlist = -d $1 ? glob("$1/*") : cat_($1);
 135/-sl/ and $graphics_level = 2;
 136/-vs/ || /-ve/ and $graphics_level = 1;
 137/-srand/ and srand 0;
 138/-di/ and $direct = 1;
 139/-so/ and $direct = 1, @PLAYERS = ('p1');
 140/-cr/ || /-chain_reaction/ and $chainreaction = 1;
 141/-cb/ || /-co/ and $colourblind = 1;
 142/-pm\s*(-?[\d]+)/ || /-playermalus\s*(-?\d+)/ and $playermalus = $1;
 143/-ls\s*(\S+)/ || /-levelset\s*(\S+)/ and $levels{current} = 1, $direct = 1, @PLAYERS = ('p1'), $direct_levelset = $1;
 144/-l\s*(\d+)/ || /-level\s*(\d+)/ and $levels{current} = $1, $direct = 1, @PLAYERS = ('p1');
 145
 146
 147#- ------------------------------------------------------------------------
 148
 149END {
 150    if ($app) {
 151	$total_time = ($app->ticks - $total_time)/1000;
 152	my $h = int($total_time/3600);
 153	my $m = int(($total_time-$h*3600)/60);
 154	my $s = int($total_time-$h*3600-$m*60);
 155	print "\nAddicted for ", $h ? "$h"."h " : "", $m ? "$m"."m " : "", "$s"."s.\n";
 156    }
 157}
 158
 159#- it doesn't keep ordering (but I don't care)
 160sub fastuniq { my %l; @l{@_} = @_; values %l }
 161
 162
 163#- ----------- sound related stuff ----------------------------------------
 164
 165sub play_sound($) {
 166    $mixer_enabled && $mixer && !$sfx_disabled && $sound{$_[0]} and $mixer->play_channel(-1, $sound{$_[0]}, 0);
 167}
 168sub chomp_ { my @l = map { my $l = $_; chomp $l; $l } @_; wantarray() ? @l : $l[0] }
 169sub play_music($;$) {
 170    my ($name, $pos) = @_;
 171    $mixer_enabled && $mixer && !$music_disabled or return;
 172    @playlist && $mixer->playing_music and return;
 173    $app->delay(10) while $mixer->fading_music;   #- mikmod will deadlock if we try to fade_out while still fading in
 174    $mixer->playing_music and $mixer->fade_out_music(500); $app->delay(400);
 175    $app->delay(10) while $mixer->playing_music;  #- mikmod will segfault if we try to load a music while old one is still fading out
 176    my %musics = (intro => '/snd/introzik.xm', main1p => '/snd/frozen-mainzik-1p.xm', main2p => '/snd/frozen-mainzik-2p.xm');
 177    my $mus if 0;                                 #- I need to keep a reference on the music or it will be collected at the end of this function, thus I manually collect previous music
 178    if (@playlist) {
 179	my $tryanother = sub {
 180	    my $elem = chomp_(shift @playlist);
 181	    $elem or return -1;
 182	    -f $elem or return 0;
 183	    push @playlist, $elem;
 184	    $mus = SDL::Music->new($elem);
 185	    if ($mus->{-data}) {
 186		print STDERR "[Playlist] playing `$elem'\n";
 187		$mixer->play_music($mus, 0);
 188		return 1;
 189	    } else { 
 190		print STDERR "Warning, could not create new music from `$elem' (reason: ", $app->error, ").\n";
 191		return 0;
 192	    }
 193	};
 194	while ($tryanother->() == 0) {};
 195    } else {
 196	$mus = SDL::Music->new("$FPATH$musics{$name}");
 197	$mus->{-data} or print STDERR "Warning, could not create new music from `$FPATH$musics{$name}' (reason: ", $app->error, ").\n";
 198	if ($pos) {
 199	    fb_c_stuff::fade_in_music_position($mus->{-data}, -1, 500, $pos);
 200	} else {
 201	    $mixer->play_music($mus, -1);
 202	}
 203    }
 204}
 205
 206sub init_sound() {
 207    $mixer = eval { SDL::Mixer->new(-frequency => 44100, -channels => 2, -size => 1024); };
 208    if ($@) {
 209	$@ =~ s| at \S+ line.*\n||;
 210	print STDERR "\nWarning: can't initialize sound (reason: $@).\n";
 211	return 0;
 212    }
 213    print "[Sound Init]\n";
 214    my @sounds = qw(stick destroy_group newroot newroot_solo lose hurry pause menu_change menu_selected rebound launch malus noh snore cancel typewriter applause);
 215    foreach (@sounds) {
 216	my $sound_path = "$FPATH/snd/$_.wav";
 217	$sound{$_} = SDL::Sound->new($sound_path);
 218	if ($sound{$_}{-data}) {
 219	    $sound{$_}->volume(80);
 220	} else {
 221	    print STDERR "Warning, could not create new sound from `$sound_path'.\n";
 222	}
 223    }
 224    return 1;
 225}
 226
 227
 228#- ----------- graphics related stuff --------------------------------------
 229
 230sub add_default_rect($) {
 231    my ($surface) = @_;
 232    $rects{$surface} = SDL::Rect->new(-width => $surface->width, -height => $surface->height);
 233}
 234
 235sub put_image($$$) {
 236    my ($image, $x, $y) = @_;
 237    $rects{$image} or die "please don't call me with no rects\n".backtrace();
 238    my $drect = SDL::Rect->new(-width => $image->width, -height => $image->height, -x => $x, '-y' => $y);
 239    $image->blit($rects{$image}, $app, $drect);
 240    push @update_rects, $drect;
 241}
 242
 243sub erase_image_from($$$$) {
 244    my ($image, $x, $y, $img) = @_;
 245    my $drect = SDL::Rect->new(-width => $image->width, -height => $image->height, -x => $x, '-y' => $y);
 246    $img->blit($drect, $app, $drect);
 247    push @update_rects, $drect;
 248}
 249
 250sub erase_image($$$) {
 251    my ($image, $x, $y) = @_;
 252    erase_image_from($image, $x, $y, $background);
 253}
 254
 255sub put_image_to_background($$$) {
 256    my ($image, $x, $y) = @_;
 257    my $drect;
 258    ($x == 0 && $y == 0) and print "put_image_to_background: warning, X and Y are 0\n";
 259    if ($y > 0) {
 260	$drect = SDL::Rect->new(-width => $image->width, -height => $image->height, -x => $x, '-y' => $y);
 261	$display_on_app_disabled or $image->blit($rects{$image}, $app, $drect);
 262	$image->blit($rects{$image}, $background, $drect);
 263    } else {  #- clipping seems to not work when from one Surface to another Surface, so I need to do clipping by hand
 264	$drect = SDL::Rect->new(-width => $image->width, -height => $image->height + $y, -x => $x, '-y' => 0);
 265	my $irect = SDL::Rect->new(-width => $image->width, -height => $image->height + $y, '-y' => -$y);
 266	$display_on_app_disabled or $image->blit($irect, $app, $drect);
 267	$image->blit($irect, $background, $drect);
 268    }
 269    push @update_rects, $drect;
 270}
 271
 272sub remove_image_from_background($$$) {
 273    my ($image, $x, $y) = @_;
 274    ($x == 0 && $y == 0) and print "remove_image_from_background: warning, X and Y are 0\n";
 275    my $drect = SDL::Rect->new(-width => $image->width, -height => $image->height, -x => $x, '-y' => $y);
 276    $background_orig->blit($drect, $background, $drect);
 277    $background_orig->blit($drect, $app, $drect);
 278    push @update_rects, $drect;
 279}
 280
 281sub remove_images_from_background {
 282    my ($player, @images) = @_;
 283    foreach (@images) {
 284	($_->{'x'} == 0 && $_->{'y'} == 0) and print "remove_images_from_background: warning, X and Y are 0\n";
 285	my $drect = SDL::Rect->new(-width => $_->{img}->width, -height => $_->{img}->height, -x => $_->{'x'}, '-y' => $_->{'y'});
 286	$background_orig->blit($drect, $background, $drect);
 287	$background_orig->blit($drect, $app, $drect);
 288	push @update_rects, $drect;
 289    }
 290}
 291
 292sub put_allimages_to_background($) {
 293    my ($player) = @_;
 294    put_image_to_background($_->{img}, $_->{'x'}, $_->{'y'}) foreach @{$sticked_bubbles{$player}};
 295}
 296
 297sub switch_image_on_background($$$;$) {
 298    my ($image, $x, $y, $save) = @_;
 299    my $drect = SDL::Rect->new(-width => $image->width, -height => $image->height, -x => $x, '-y' => $y);
 300    if ($save) {
 301	$save = SDL::Surface->new(-width => $image->width, -height => $image->height, -depth => 32, -Amask => "0 but true");  #- grrr... this piece of shit of Amask made the surfaces slightly modify along the print/erase of "Hurry" and "Pause".... took me so much time to debug and find that the problem came from a bug when Amask is set to 0xFF000000 (while it's -supposed- to be set to 0xFF000000 with 32-bit graphics!!)
 302	$background->blit($drect, $save, $rects{$image});
 303    }
 304    $image->blit($rects{$image} || SDL::Rect->new(-width => $image->width, -height => $image->height), $background, $drect);
 305    $background->blit($drect, $app, $drect);
 306    push @update_rects, $drect;
 307    return $save;
 308}
 309
 310sub add_image($) {
 311    my $file = "$FPATH/gfx/$_[0]";
 312    my $img = SDL::Surface->new(-name => $file);
 313    $img->{-surface} or die "FATAL: Couldn't load `$file' into a SDL::Surface.\n";
 314    add_default_rect($img);
 315    return $img;
 316}
 317
 318sub add_bubble_image($) {
 319    my ($file) = @_;
 320    my $bubble = add_image($file);
 321    push @bubbles_images, $bubble;
 322}
 323
 324
 325#- ----------- generic game stuff -----------------------------------------
 326
 327sub iter_players(&) {
 328    my ($f) = @_;
 329    local $::p;
 330    foreach $::p (@PLAYERS) {
 331	&$f;
 332    }
 333}
 334sub iter_players_(&) {  #- so that I can do an iter_players_ from within an iter_players
 335    my ($f) = @_;
 336    local $::p_;
 337    foreach $::p_ (@PLAYERS) {
 338	&$f;
 339    }
 340}
 341sub is_1p_game() { @PLAYERS == 1 }
 342sub is_2p_game() { @PLAYERS == 2 }
 343
 344
 345#- ----------- bubble game stuff ------------------------------------------
 346
 347sub calc_real_pos_given_arraypos($$$) {
 348    my ($cx, $cy, $player) = @_;
 349    ($POS{$player}{left_limit} + $cx * $BUBBLE_SIZE + odd($cy+$pdata{$player}{oddswap}) * $BUBBLE_SIZE/2,
 350     $POS{top_limit} + $cy * $ROW_SIZE);
 351}
 352
 353sub calc_real_pos($$) {
 354    my ($b, $player) = @_;
 355    ($b->{'x'}, $b->{'y'}) = calc_real_pos_given_arraypos($b->{cx}, $b->{cy}, $player);
 356}
 357
 358sub get_array_yclosest($) {
 359    my ($y) = @_;
 360    return int(($y-$POS{top_limit}+$ROW_SIZE/2) / $ROW_SIZE);
 361}
 362
 363sub get_array_closest_pos($$$) { # roughly the opposite than previous function
 364    my ($x, $y, $player) = @_;
 365    my $ny = get_array_yclosest($y);
 366    my $nx = int(($x-$POS{$player}{left_limit}+$BUBBLE_SIZE/2 - odd($ny+$pdata{$player}{oddswap})*$BUBBLE_SIZE/2)/$BUBBLE_SIZE);
 367    return ($nx, $ny);
 368}
 369
 370sub is_collision($$$) {
 371    my ($bub, $x, $y) = @_;
 372    my $DISTANCE_COLLISION_SQRED = sqr($BUBBLE_SIZE * 0.82);
 373    my $xs = sqr($bub->{x} - $x);
 374    ($xs > $DISTANCE_COLLISION_SQRED) and return 0; 
 375    return ($xs + sqr($bub->{'y'} - $y)) < $DISTANCE_COLLISION_SQRED;
 376}
 377
 378sub create_bubble_given_img($) {
 379    my ($img) = @_;
 380    my %bubble;
 381    ref($img) eq 'SDL::Surface' or die "<$img> seems to not be a valid image\n" . backtrace();
 382    $bubble{img} = $img;
 383    return \%bubble;
 384}
 385
 386sub create_bubble(;$) {
 387    my ($p) = @_;
 388    my $b = create_bubble_given_img($bubbles_images[rand(@bubbles_images)]);
 389    is_1p_game() && $p && !member($b->{img}, map { $_->{img} } @{$sticked_bubbles{$p}})
 390      and return &create_bubble($p);  #- prototype checking pb w/ recursion
 391    return $b;
 392}
 393
 394sub iter_rowscols(&$) {
 395    my ($f, $oddswap) = @_;
 396    local $::row; local $::col;
 397    foreach $::row (0 .. 11) {
 398	foreach $::col (0 .. 7 - odd($::row+$oddswap)) {
 399	    &$f;
 400	}
 401    }
 402}
 403
 404sub each_index(&@) {
 405    my $f = shift;
 406    local $::i = 0;
 407    foreach (@_) {
 408	&$f($::i);
 409	$::i++;
 410    }
 411}
 412sub img2numb { my ($i, $f) = @_; each_index { $i eq $_ and $f = $::i } @bubbles_images; return defined($f) ? $f : '-' }
 413
 414#sub history {
 415#    foreach my $frame (@{$history{$_[0]}}[-10...1]) {
 416#	iter_rowscols {
 417#	    if ($::col == 0) {
 418#		$::row == 0 or print "\n";
 419#		odd($::row+$frame->{oddswap}) and print "  ";
 420#	    }
 421#	    foreach (@{$frame->{sticked}}) {
 422#		$_->[0] == $::col && $_->[1] == $::row or next;
 423#		print $_->[2];
 424#		goto non_void;
 425#	    }
 426#	    if ($frame->{sticking}[0] == $::col && $frame->{sticking}[1] == $::row) {
 427#		print "\033[D!$frame->{sticking}[2]";
 428#		goto non_void;
 429#	    }
 430#	    print '-';
 431#	  non_void:
 432#	    $::col+odd($::row+$frame->{oddswap}) < 7 and print "   ";
 433#        } $frame->{oddswap};
 434#	print "\n\n";
 435#    }
 436#}
 437
 438sub bubble_next_to($$$$$) {
 439    my ($x1, $y1, $x2, $y2, $player) = @_;
 440    $x1 == $x2 && $y1 == $y2 and die "bubble_next_to: assert failed -- same bubbles ($x1:$y1;$player)" . backtrace();
 441#    $x1 == $x2 && $y1 == $y2 and history($player), die "bubble_next_to: assert failed -- same bubbles ($x1:$y1;$player)" . backtrace();
 442    return to_bool((sqr($x1+odd($y1+$pdata{$player}{oddswap})*0.5 - ($x2+odd($y2+$pdata{$player}{oddswap})*0.5)) + sqr($y1 - $y2)) < 3);
 443}
 444
 445sub next_positions($$) {
 446    my ($b, $player) = @_;
 447    my $validate_pos = sub {
 448	my ($x, $y) = @_;
 449	if_($x >= 0 && $x+odd($y+$pdata{$player}{oddswap}) <= 7 && $y >= 0 && $y >= $pdata{$player}{newrootlevel} && $y <= 11,
 450	    [ $x, $y ]);
 451    };
 452    ($validate_pos->($b->{cx} - 1, $b->{cy}),
 453     $validate_pos->($b->{cx} + 1, $b->{cy}),
 454     $validate_pos->($b->{cx} - even($b->{cy}+$pdata{$player}{oddswap}), $b->{cy} - 1),
 455     $validate_pos->($b->{cx} - even($b->{cy}+$pdata{$player}{oddswap}), $b->{cy} + 1),
 456     $validate_pos->($b->{cx} - even($b->{cy}+$pdata{$player}{oddswap}) + 1, $b->{cy} - 1),
 457     $validate_pos->($b->{cx} - even($b->{cy}+$pdata{$player}{oddswap}) + 1, $b->{cy} + 1));
 458}
 459
 460#- bubble ends its life sticked somewhere
 461sub real_stick_bubble {
 462    my ($bubble, $xpos, $ypos, $player, $neighbours_ok) = @_;
 463    $bubble->{cx} = $xpos;
 464    $bubble->{cy} = $ypos;
 465    foreach (@{$sticked_bubbles{$player}}) {
 466	if (bubble_next_to($_->{cx}, $_->{cy}, $bubble->{cx}, $bubble->{cy}, $player)) {
 467	    push @{$_->{neighbours}}, $bubble;
 468	    $neighbours_ok or push @{$bubble->{neighbours}}, $_;
 469	}
 470    }
 471    push @{$sticked_bubbles{$player}}, $bubble;
 472    $bubble->{cy} == $pdata{$player}{newrootlevel} and push @{$root_bubbles{$player}}, $bubble;
 473    calc_real_pos($bubble, $player);
 474    put_image_to_background($bubble->{img}, $bubble->{'x'}, $bubble->{'y'});
 475}
 476
 477sub destroy_bubbles {
 478    my ($player, @bubz) = @_;
 479    $graphics_level == 1 and return;
 480    foreach (@bubz) {
 481	$_->{speedx} = rand(3)-1.5;
 482	$_->{speedy} = -rand(4)-2;
 483    }
 484    push @{$exploding_bubble{$player}}, @bubz;
 485}
 486
 487sub find_bubble_group($) {
 488    my ($b) = @_;
 489    my @neighbours = $b;
 490    my @group;
 491    while (1) {
 492	push @group, @neighbours;
 493	@neighbours = grep { $b->{img} eq $_->{img} && !member($_, @group) } fastuniq(map { @{$_->{neighbours}} } @neighbours);
 494	last if !@neighbours;
 495    }
 496    @group;
 497}
 498
 499sub stick_bubble($$$$$) {
 500    my ($bubble, $xpos, $ypos, $player, $count_for_root) = @_;
 501    my @falling;
 502    my $need_redraw = 0;
 503    @{$bubble->{neighbours}} = grep { bubble_next_to($_->{cx}, $_->{cy}, $xpos, $ypos, $player) } @{$sticked_bubbles{$player}};
 504
 505    #- in multiple chain reactions, it's possible that the group doesn't exist anymore in some rare situations :/
 506    exists $bubble->{chaindestx} && !@{$bubble->{neighbours}} and return;
 507
 508    my @will_destroy = difference2([ find_bubble_group($bubble) ], [ $bubble ]);
 509
 510    if (@will_destroy <= 1) {
 511	#- stick
 512	play_sound('stick');
 513	real_stick_bubble($bubble, $xpos, $ypos, $player, 1);
 514	$sticking_bubble{$player} = $bubble;
 515	$pdata{$player}{sticking_step} = 0;
 516    } else {
 517	#- destroy the group
 518	play_sound('destroy_group');
 519	foreach my $b (difference2([ fastuniq(map { @{$_->{neighbours}} } @will_destroy) ], \@will_destroy)) {
 520	    @{$b->{neighbours}} = difference2($b->{neighbours}, \@will_destroy);
 521	}
 522	@{$sticked_bubbles{$player}} = difference2($sticked_bubbles{$player}, \@will_destroy);
 523	@{$root_bubbles{$player}} = difference2($root_bubbles{$player}, \@will_destroy);
 524
 525	$bubble->{'cx'} = $xpos;
 526	$bubble->{'cy'} = $ypos;
 527	calc_real_pos($bubble, $player);
 528	destroy_bubbles($player, @will_destroy, $bubble);
 529
 530	#- find falling bubbles
 531	$_->{mark} = 0 foreach @{$sticked_bubbles{$player}};
 532	my @still_sticked;
 533	my @neighbours = @{$root_bubbles{$player}};
 534	my $distance_to_root;
 535	while (1) {
 536	    $_->{mark} = ++$distance_to_root foreach @neighbours;
 537	    push @still_sticked, @neighbours;
 538	    @neighbours = grep { $_->{mark} == 0 } map { @{$_->{neighbours}} } @neighbours;
 539	    last if !@neighbours;
 540	}
 541	@falling = difference2($sticked_bubbles{$player}, \@still_sticked);
 542	@{$sticked_bubbles{$player}} = difference2($sticked_bubbles{$player}, \@falling);
 543
 544	#- chain-reaction on falling bubbles
 545	if ($chainreaction) {
 546	    my @falling_colors = map { $_->{img} } @falling;
 547	    #- optimize a bit by first calculating bubbles that are next to another bubble of the same color
 548	    my @grouped_bubbles = grep {
 549		my $b = $_;
 550		member($b->{img}, @falling_colors) && any { $b->{img} eq $_->{img} } @{$b->{neighbours}}
 551	    } @{$sticked_bubbles{$player}};
 552	    if (@grouped_bubbles) {
 553		#- all positions on which we can't chain-react
 554		my @occupied_positions = map { $_->{cy}*8 + $_->{cx} } @{$sticked_bubbles{$player}};
 555		push @occupied_positions, map { $_->{chaindestcy}*8 + $_->{chaindestcx} } @{$chains{$player}{falling_chained}};
 556		#- examine groups beginning at the root bubbles, for the case in which
 557		#- there is a group that will fall from an upper chain-reaction
 558		foreach my $pos (sort { $a->{mark} <=> $b->{mark} } @grouped_bubbles) {
 559		    #- now examine if there is a free position to chain-react in it
 560		    foreach my $npos (next_positions($pos, $player)) {
 561			#- we can't chain-react somewhere if it explodes a group already chained
 562			next if any { $pos->{cx} == $_->{cx} && $pos->{cy} == $_->{cy} }
 563			        map { @{$chains{$player}{chained_bubbles}{$_}}} keys %{$chains{$player}{chained_bubbles}};
 564			if (!member($npos->[1]*8 + $npos->[0], @occupied_positions)) {
 565			    #- find a suitable falling bubble for that free position
 566			    foreach my $falling (@falling) {
 567				next if member($falling, @{$chains{$player}{falling_chained}});
 568				if ($pos->{img} eq $falling->{img}) {
 569				    ($falling->{chaindestcx}, $falling->{chaindestcy}) = ($npos->[0], $npos->[1]);
 570				    ($falling->{chaindestx}, $falling->{chaindesty}) = calc_real_pos_given_arraypos($npos->[0], $npos->[1], $player);
 571				    push @{$chains{$player}{falling_chained}}, $falling;
 572				    push @occupied_positions, $npos->[1]*8 + $npos->[0];
 573				    
 574				    #- next lines will allow not to chain-react on the same group from two different positions,
 575				    #- and even to not chain-react on a group that will itself fall from a chain-reaction
 576				    @{$falling->{neighbours}} = grep { bubble_next_to($_->{cx}, $_->{cy}, $npos->[0], $npos->[1], $player) } @{$sticked_bubbles{$player}};
 577				    my @chained_bubbles = find_bubble_group($falling);
 578				    $_->{mark} = 0 foreach @{$sticked_bubbles{$player}};
 579				    my @still_sticked;
 580				    my @neighbours = difference2($root_bubbles{$player}, \@chained_bubbles);
 581				    while (1) {
 582					$_->{mark} = 1 foreach @neighbours;
 583					push @still_sticked, @neighbours;
 584					@neighbours = difference2([ grep { $_->{mark} == 0 } map { @{$_->{neighbours}} } @neighbours ],
 585								  \@chained_bubbles);
 586					last if !@neighbours;
 587				    }
 588				    @{$chains{$player}{chained_bubbles}{$falling}} = difference2($sticked_bubbles{$player}, \@still_sticked);
 589				    last;
 590				}
 591			    }
 592			}
 593		    }
 594		}
 595	    }
 596	}
 597
 598	#- prepare falling bubbles
 599	if ($graphics_level > 1) {
 600	    my $max_cy_falling = fold_left { $::b->{cy} > $::a ? $::b->{cy} : $::a } 0, @falling;  #- I have a fold_left in my prog! :-)
 601	    my ($shift_on_same_line, $line) = (0, $max_cy_falling);
 602	    foreach (sort { $b->{cy}*8 + $b->{cx} <=> $a->{cy}*8 + $a->{cx} } @falling) {  #- sort bottom-to-up / right-to-left
 603		$line != $_->{cy} and $shift_on_same_line = 0;
 604		$line = $_->{cy};
 605		$_->{wait_fall} = ($max_cy_falling - $_->{cy})*5 + $shift_on_same_line;
 606		$shift_on_same_line++;
 607		$_->{speed} = 0;
 608	    }
 609	    push @{$falling_bubble{$player}}, @falling;
 610	}
 611
 612	remove_images_from_background($player, @will_destroy, @falling);
 613	#- redraw neighbours because parts of neighbours have been erased by previous statement
 614	put_image_to_background($_->{img}, $_->{'x'}, $_->{'y'})
 615	  foreach grep { !member($_, @will_destroy) && !member($_, @falling) } fastuniq(map { @{$_->{neighbours}} } @will_destroy, @falling);
 616	$need_redraw = 1;
 617    }
 618
 619    if ($count_for_root) {
 620	$pdata{$player}{newroot}++;
 621	if ($pdata{$player}{newroot} == $TIME_APPEARS_NEW_ROOT-1) {
 622	    $pdata{$player}{newroot_prelight} = 2;
 623	    $pdata{$player}{newroot_prelight_step} = 0;
 624	}
 625	if ($pdata{$player}{newroot} == $TIME_APPEARS_NEW_ROOT) {
 626	    $pdata{$player}{newroot_prelight} = 1;
 627	    $pdata{$player}{newroot_prelight_step} = 0;
 628	}
 629	if ($pdata{$player}{newroot} > $TIME_APPEARS_NEW_ROOT) {
 630	    $need_redraw = 1;
 631	    $pdata{$player}{newroot_prelight} = 0;
 632	    play_sound(is_1p_game() ? 'newroot_solo' : 'newroot');
 633	    $pdata{$player}{newroot} = 0;
 634	    $pdata{$player}{oddswap} = !$pdata{$player}{oddswap};
 635	    remove_images_from_background($player, @{$sticked_bubbles{$player}});
 636	    foreach (@{$sticked_bubbles{$player}}) {
 637		$_->{'cy'}++;
 638		calc_real_pos($_, $player);
 639	    }
 640	    foreach (@{$falling_bubble{$player}}) {
 641		exists $_->{chaindestx} or next;
 642		$_->{chaindestcy}++;
 643		$_->{chaindesty} += $ROW_SIZE;
 644	    }
 645	    put_allimages_to_background($player);
 646	    if (is_1p_game()) {
 647		$pdata{$player}{newrootlevel}++;
 648		print_compressor();
 649	    } else {
 650		@{$root_bubbles{$player}} = ();
 651		real_stick_bubble(create_bubble($player), $_, 0, $player, 0) foreach (0..(7-$pdata{$player}{oddswap}));
 652	    }
 653	}
 654    }
 655
 656    if ($need_redraw) {
 657	my $malus_val = @will_destroy + @falling - 2;
 658	$malus_val > 0 and $malus_val += ($player eq 'p1' ? $playermalus : -$playermalus);
 659	$malus_val < 0 and $malus_val = 0;
 660	$background->blit($apprects{$player}, $app, $apprects{$player});
 661	malus_change($malus_val, $player);
 662    }
 663
 664#    push @{$history{$player}}, { sticking => [ $xpos, $ypos, img2numb($bubble->{img}) ],
 665#				 oddswap => $pdata{$player}{oddswap},
 666#				 sticked => [ map { [ $_->{cx}, $_->{cy}, img2numb($_->{img}) ] } @{$sticked_bubbles{$player}} ] };
 667}
 668
 669sub print_next_bubble($$;$) {
 670    my ($img, $player, $not_on_top_next) = @_;
 671    put_image_to_background($img, $next_bubble{$player}{'x'}, $next_bubble{$player}{'y'});
 672    $not_on_top_next or put_image_to_background($bubbles_anim{on_top_next}, $POS{$player}{left_limit}+$POS{next_bubble}{x}-4, $POS{next_bubble}{'y'}-3);
 673}
 674
 675sub generate_new_bubble {
 676    my ($player, $img) = @_;
 677    $tobe_launched{$player} = $next_bubble{$player};
 678    $tobe_launched{$player}{'x'} = ($POS{$player}{left_limit}+$POS{$player}{right_limit})/2 - $BUBBLE_SIZE/2;
 679    $tobe_launched{$player}{'y'} = $POS{'initial_bubble_y'};
 680    $next_bubble{$player} = $img ? create_bubble_given_img($img) : create_bubble($player);
 681    $next_bubble{$player}{'x'} = $POS{$player}{left_limit}+$POS{next_bubble}{x}; #- necessary to keep coordinates, for verify_if_end
 682    $next_bubble{$player}{'y'} = $POS{next_bubble}{'y'};
 683    print_next_bubble($next_bubble{$player}{img}, $player);
 684}
 685
 686
 687#- ----------- game stuff -------------------------------------------------
 688
 689sub handle_graphics($) {
 690    my ($fun) = @_;
 691
 692    iter_players {
 693	#- bubbles
 694	foreach ($launched_bubble{$::p}, if_($fun ne \&erase_image, $tobe_launched{$::p})) {
 695	    $_ and $fun->($_->{img}, $_->{'x'}, $_->{'y'});
 696	}
 697	if ($fun eq \&put_image && $pdata{$::p}{newroot_prelight}) {
 698	    if ($pdata{$::p}{newroot_prelight_step}++ > 30*$pdata{$::p}{newroot_prelight}) {
 699		$pdata{$::p}{newroot_prelight_step} = 0;
 700	    }
 701	    if ($pdata{$::p}{newroot_prelight_step} <= 8) {
 702		my $hurry_overwritten = 0;
 703		foreach my $b (@{$sticked_bubbles{$::p}}) {
 704		    next if ($graphics_level == 1 && $b->{'cy'} > 0);  #- in low graphics, only prelight first row
 705		    $b->{'cx'}+1 == $pdata{$::p}{newroot_prelight_step} and put_image($b->{img}, $b->{'x'}, $b->{'y'});
 706		    $b->{'cx'} == $pdata{$::p}{newroot_prelight_step} and put_image($bubbles_anim{white}, $b->{'x'}, $b->{'y'});
 707		    $b->{'cy'} > 6 and $hurry_overwritten = 1;
 708		}
 709		$hurry_overwritten && $pdata{$::p}{hurry_save_img} and print_hurry($::p, 1);  #- hurry was potentially overwritten
 710	    }
 711	}
 712	if ($sticking_bubble{$::p} && $graphics_level > 1) {
 713	    my $b = $sticking_bubble{$::p};
 714	    if ($fun eq \&erase_image) {
 715		put_image($b->{img}, $b->{'x'}, $b->{'y'});
 716	    } else {
 717		if ($pdata{$::p}{sticking_step} == @{$bubbles_anim{stick}}) {
 718		    $sticking_bubble{$::p} = undef;
 719		} else {
 720		    put_image(${$bubbles_anim{stick}}[$pdata{$::p}{sticking_step}], $b->{'x'}, $b->{'y'});
 721		    if ($pdata{$::p}{sticking_step_slowdown}) {
 722			$pdata{$::p}{sticking_step}++;
 723			$pdata{$::p}{sticking_step_slowdown} = 0;
 724		    } else {
 725			$pdata{$::p}{sticking_step_slowdown}++;
 726		    }
 727		}
 728	    }
 729	}
 730
 731	#- shooter
 732	if ($graphics_level > 1) {
 733	    my $num = int($angle{$::p}*$CANON_ROTATIONS_NB/($PI/2) + 0.5)-$CANON_ROTATIONS_NB;
 734	    $fun->($canon{img}{$num},
 735		   ($POS{$::p}{left_limit}+$POS{$::p}{right_limit})/2 - 50 + $canon{data}{$num}->[0],
 736		   $POS{'initial_bubble_y'} + 16 - 50 + $canon{data}{$num}->[1] );  #- 50/50 stand for half width/height of gfx/shoot/base.png
 737	} else {
 738	    $fun->($shooter,
 739		   ($POS{$::p}{left_limit}+$POS{$::p}{right_limit})/2 - 1 + 60*cos($angle{$::p}),  #- 1 for $shooter->width/2
 740		   $POS{'initial_bubble_y'} + 16 - 1 - 60*sin($angle{$::p}));  #- 1/1 stand for half width/height of gfx/shoot/shooter.png
 741	}
 742	#- penguins
 743	if ($graphics_level == 3) {
 744	    $fun->($pinguin{$::p}{$pdata{$::p}{ping_right}{state}}[$pdata{$::p}{ping_right}{img}], $POS{$::p}{left_limit}+$POS{$::p}{pinguin}{x}, $POS{$::p}{pinguin}{'y'});
 745	}
 746
 747	#- moving bubbles --> I want them on top of the rest
 748	foreach (@{$malus_bubble{$::p}}, @{$falling_bubble{$::p}}, @{$exploding_bubble{$::p}}) {
 749	    $fun->($_->{img}, $_->{'x'}, $_->{'y'});
 750	}
 751
 752    };
 753
 754}
 755
 756#- extract it from "handle_graphics" to optimize a bit animations
 757sub malus_change($$) {
 758    my ($numb, $player) = @_;
 759    return if $numb == 0 || is_1p_game();
 760    if ($numb >= 0) {
 761	$player = ($player eq 'p1') ? 'p2' : 'p1';
 762    }
 763    my $update_malus = sub($) {
 764	my ($fun) = @_;
 765	my $malus = $pdata{$player}{malus};
 766	my $y_shift = 0;
 767	while ($malus > 0) {
 768	    my $print = sub($) {
 769		my ($type) = @_;
 770		$fun->($type, $POS{$player}{malus_x} - $type->width/2, $POS{'malus_y'} - $y_shift - $type->height);
 771		$y_shift += $type->height - 1;
 772	    };
 773	    if ($malus >= 7) {
 774		$print->($malus_gfx{tomate});
 775		$malus -= 7;
 776	    } else {
 777		$print->($malus_gfx{banane});
 778		$malus--;
 779	    }
 780	}
 781    };
 782    $update_malus->(\&remove_image_from_background);
 783    $pdata{$player}{malus} += $numb;
 784    $update_malus->(\&put_image_to_background);
 785}
 786
 787sub print_compressor() {
 788    my $x = $POS{compressor_xpos};
 789    my $y = $POS{top_limit} + $pdata{$PLAYERS[0]}{newrootlevel} * $ROW_SIZE;
 790    my ($comp_main, $comp_ext) = ($imgbin{compressor_main}, $imgbin{compressor_ext});
 791
 792    my $drect = SDL::Rect->new(-width => $comp_main->width, -height => $y,
 793			       -x => $x - $comp_main->width/2, '-y' => 0);
 794    $background_orig->blit($drect, $background, $drect);
 795    $display_on_app_disabled or $background_orig->blit($drect, $app, $drect);
 796    push @update_rects, $drect;
 797
 798    put_image_to_background($comp_main, $x - $comp_main->width/2, $y - $comp_main->height);
 799
 800    $y -= $comp_main->height - 3;
 801
 802    while ($y > 0) {
 803	put_image_to_background($comp_ext, $x - $comp_ext->width/2, $y - $comp_ext->height);
 804	$y -= $comp_ext->height;
 805    }
 806}
 807
 808sub handle_game_events() {
 809    $event->pump;
 810    if ($event->poll != 0) {
 811	if ($event->type == SDL_KEYDOWN) {
 812	    my $keypressed = $event->key_sym;
 813
 814	    iter_players {
 815		my $pkey = is_1p_game() ? 'p2' : $::p;
 816		foreach (qw(left right fire center)) {
 817		    $keypressed == $KEYS->{$pkey}{$_} and $actions{$::p}{$_} = 1, last;
 818		}
 819	    };
 820	    
 821	    if ($keypressed == $KEYS->{misc}{fs}) {
 822		$fullscreen = !$fullscreen;
 823		$app->fullscreen;
 824	    }
 825
 826	    if ($keypressed == SDLK_PAUSE) {
 827		play_sound('pause');
 828		$mixer_enabled && $mixer and $mixer->pause_music;
 829		my $back_saved = switch_image_on_background($imgbin{back_paused}, 0, 0, 1);
 830	      pause_label:
 831		while (1) {
 832		    my ($index, $side) = (0, 1);
 833		    while ($index || $side == 1) {
 834			put_image(${$imgbin{paused}}[$index], $POS_1P{pause_clip}{x}, $POS_1P{pause_clip}{'y'});
 835			$app->flip;
 836			foreach (1..80) {
 837			    $app->delay(20);
 838			    $event->pump;
 839			    if ($event->poll != 0 && $event->type == SDL_KEYDOWN) {
 840				last pause_label if $event->key_sym != $KEYS->{misc}{fs};
 841				$fullscreen = !$fullscreen;
 842				$app->fullscreen;
 843			    }
 844			}
 845			rand() < 0.2 and play_sound('snore');
 846			$index += $side;
 847			if ($index == @{$imgbin{paused}}) {
 848			    $side = -1;
 849			    $index -= 2;
 850			}
 851		    }
 852		}
 853		switch_image_on_background($back_saved, 0, 0);
 854		iter_players { $actions{$::p}{left} = 0; $actions{$::p}{right} = 0; };
 855		$mixer_enabled && $mixer and $mixer->resume_music;
 856		$event->pump while $event->poll != 0;
 857		$app->flip;
 858	    }
 859
 860	}
 861
 862	if ($event->type == SDL_KEYUP) {
 863	    my $keypressed = $event->key_sym;
 864
 865	    iter_players {
 866		my $pkey = is_1p_game() ? 'p2' : $::p;
 867		foreach (qw(left right fire center)) {
 868		    $keypressed == $KEYS->{$pkey}{$_} and $actions{$::p}{$_} = 0, last;
 869		}
 870	    }
 871	}
 872
 873	if ($event->type == SDL_QUIT ||
 874	    $event->type == SDL_KEYDOWN && $event->key_sym == SDLK_ESCAPE) {
 875	    die 'quit';
 876	}
 877    }
 878}
 879
 880sub print_scores($) {
 881    my ($surface) = @_;  #- TODO all this function has hardcoded coordinates
 882    my $drect = SDL::Rect->new(-width => 120, -height => 30, -x => 260, '-y' => 428);
 883    $background_orig->blit($drect, $surface, $drect);
 884    push @update_rects, $drect;
 885    iter_players_ {  #- sometimes called from within a iter_players so...
 886	$surface->print($POS{$::p_}{scoresx}-SDL_TEXTWIDTH($pdata{$::p_}{score})/2, $POS{scoresy}, $pdata{$::p_}{score});
 887    };
 888}
 889
 890sub verify_if_end {
 891    iter_players {
 892	if (any { $_->{cy} > 11 } @{$sticked_bubbles{$::p}}) {
 893	    $pdata{state} = "lost $::p";
 894	    play_sound('lose');
 895	    $pdata{$::p}{ping_right}{state} = 'lose';
 896	    $pdata{$::p}{ping_right}{img} = 0;
 897	    if (!is_1p_game()) {
 898		my $won = $::p eq 'p1' ? 'p2' : 'p1';
 899		$pdata{$won}{score}++;
 900		$pdata{$won}{ping_right}{state} = 'win';
 901		$pdata{$won}{ping_right}{img} = 0;
 902		print_scores($background); print_scores($app);
 903	    }
 904	    foreach ($launched_bubble{$::p}, $tobe_launched{$::p}, @{$malus_bubble{$::p}}) {
 905		$_ or next;
 906		$_->{img} = $bubbles_anim{lose};
 907		$_->{'x'}--;
 908		$_->{'y'}--;
 909	    }
 910	    iter_players_ {
 911		remove_hurry($::p_);
 912		@{$falling_bubble{$::p_}} = grep { !exists $_->{chaindestx} } @{$falling_bubble{$::p_}};
 913	    };
 914	    print_next_bubble($bubbles_anim{lose}, $::p, 1);
 915	    iter_players_ {
 916		@{$sticked_bubbles{$::p_}} = sort { $b->{'cx'}+$b->{'cy'}*10 <=> $a->{'cx'}+$a->{'cy'}*10 } @{$sticked_bubbles{$::p_}};
 917		$sticking_bubble{$::p_} = undef;
 918		$launched_bubble{$::p_} and destroy_bubbles($::p_, $launched_bubble{$::p_});
 919		$launched_bubble{$::p_} = undef;
 920		$pdata{$::p_}{newroot_prelight} = 0;
 921	    };
 922	    @{$malus_bubble{$::p}} = ();
 923	}
 924    };
 925
 926    if (is_1p_game() && @{$sticked_bubbles{$PLAYERS[0]}} == 0) {
 927	put_image_to_background($imgbin{win_panel_1player}, $POS{centerpanel}{x}, $POS{centerpanel}{'y'});
 928	$pdata{state} = "won $PLAYERS[0]";
 929	$pdata{$PLAYERS[0]}{ping_right}{state} = 'win';
 930	$pdata{$PLAYERS[0]}{ping_right}{img} = 0;
 931	$levels{current} and $levels{current}++;
 932	if ($levels{current} && !$levels{$levels{current}}) {
 933	    $levels{current} = 'WON';
 934	    @{$falling_bubble{$PLAYERS[0]}} = @{$exploding_bubble{$PLAYERS[0]}} = ();
 935	    die 'quit';
 936	}
 937    }
 938}
 939
 940sub print_hurry($;$) {
 941    my ($player, $dont_save_background) = @_;
 942    my $t = switch_image_on_background($imgbin{hurry}{$player}, $POS{$player}{left_limit} + $POS{hurry}{x}, $POS{hurry}{'y'}, 1);
 943    $dont_save_background or $pdata{$player}{hurry_save_img} = $t;
 944}
 945sub remove_hurry($) {
 946    my ($player) = @_;
 947    $pdata{$player}{hurry_save_img} and
 948      switch_image_on_background($pdata{$player}{hurry_save_img}, $POS{$player}{left_limit} + $POS{hurry}{x}, $POS{hurry}{'y'});
 949    $pdata{$player}{hurry_save_img} = undef;
 950}
 951
 952
 953#- ----------- mainloop helper --------------------------------------------
 954
 955sub update_game() {
 956
 957    if ($pdata{state} eq 'game') {
 958	handle_game_events();
 959	iter_players {
 960	    $actions{$::p}{left} and $angle{$::p} += $LAUNCHER_SPEED;
 961	    $actions{$::p}{right} and $angle{$::p} -= $LAUNCHER_SPEED;
 962	    if ($actions{$::p}{center}) {
 963		if ($angle{$::p} >= $PI/2 - $LAUNCHER_SPEED
 964		    && $angle{$::p} <= $PI/2 + $LAUNCHER_SPEED) {
 965		    $angle{$::p} = $PI/2;
 966		} else {
 967		    $angle{$::p} += ($angle{$::p} < $PI/2) ? $LAUNCHER_SPEED : -$LAUNCHER_SPEED;
 968		}
 969	    }
 970	    ($angle{$::p} < 0.1) and $angle{$::p} = 0.1;
 971	    ($angle{$::p} > $PI-0.1) and $angle{$::p} = $PI-0.1;
 972	    $pdata{$::p}{hurry}++;
 973	    if ($pdata{$::p}{hurry} > $TIME_HURRY_WARN) {
 974		my $oddness = odd(int(($pdata{$::p}{hurry}-$TIME_HURRY_WARN)/(500/$TARGET_ANIM_SPEED))+1);
 975		if ($pdata{$::p}{hurry_oddness} xor $oddness) {
 976		    if ($oddness) {
 977			play_sound('hurry');
 978			print_hurry($::p);
 979		    } else {
 980			remove_hurry($::p)
 981		    }
 982		}
 983		$pdata{$::p}{hurry_oddness} = $oddness;
 984	    }
 985
 986	    if (($actions{$::p}{fire} || $pdata{$::p}{hurry} == $TIME_HURRY_MAX)
 987		&& !$launched_bubble{$::p}
 988		&& !(any { exists $_->{chaindestx} } @{$falling_bubble{$::p}})
 989		&& !@{$malus_bubble{$::p}}) {
 990		play_sound('launch');
 991		$launched_bubble{$::p} = $tobe_launched{$::p};
 992		$launched_bubble{$::p}->{direction} = $angle{$::p};
 993		$tobe_launched{$::p} = undef;
 994		$actions{$::p}{fire} = 0;
 995		$actions{$::p}{hadfire} = 1;
 996		$pdata{$::p}{hurry} = 0;
 997		remove_hurry($::p);
 998	    }
 999
1000	    if ($launched_bubble{$::p}) {
1001		$launched_bubble{$::p}->{'x_old'} = $launched_bubble{$::p}->{'x'}; # save coordinates for potential collision
1002		$launched_bubble{$::p}->{'y_old'} = $launched_bubble{$::p}->{'y'};
1003		$launched_bubble{$::p}->{'x'} += $BUBBLE_SPEED * cos($launched_bubble{$::p}->{direction});
1004		$launched_bubble{$::p}->{'y'} -= $BUBBLE_SPEED * sin($launched_bubble{$::p}->{direction});
1005		if ($launched_bubble{$::p}->{x} < $POS{$::p}{left_limit}) {
1006		    play_sound('rebound');
1007		    $launched_bubble{$::p}->{x} = 2 * $POS{$::p}{left_limit} - $launched_bubble{$::p}->{x};
1008		    $launched_bubble{$::p}->{direction} -= 2*($launched_bubble{$::p}->{direction}-$PI/2);
1009		}
1010		if ($launched_bubble{$::p}->{x} > $POS{$::p}{right_limit} - $BUBBLE_SIZE) {
1011		    play_sound('rebound');
1012		    $launched_bubble{$::p}->{x} = 2 * ($POS{$::p}{right_limit} - $BUBBLE_SIZE) - $launched_bubble{$::p}->{x};
1013		    $launched_bubble{$::p}->{direction} += 2*($PI/2-$launched_bubble{$::p}->{direction});
1014		}
1015		if ($launched_bubble{$::p}->{'y'} <= $POS{top_limit} + $pdata{$::p}{newrootlevel} * $ROW_SIZE) {
1016		    my ($cx, $cy) = get_array_closest_pos($launched_bubble{$::p}->{x}, $launched_bubble{$::p}->{'y'}, $::p);
1017		    stick_bubble($launched_bubble{$::p}, $cx, $cy, $::p, 1);
1018		    $launched_bubble{$::p} = undef;
1019		} else {
1020		    foreach (@{$sticked_bubbles{$::p}}) {
1021			if (is_collision($launched_bubble{$::p}, $_->{'x'}, $_->{'y'})) {
1022			    my ($cx, $cy) = get_array_closest_pos(($launched_bubble{$::p}->{'x_old'}+$launched_bubble{$::p}->{'x'})/2,
1023								  ($launched_bubble{$::p}->{'y_old'}+$launched_bubble{$::p}->{'y'})/2,
1024								  $::p);
1025			    stick_bubble($launched_bubble{$::p}, $cx, $cy, $::p, 1);
1026			    $launched_bubble{$::p} = undef;
1027
1028			    #- malus generation
1029			    if (!any { $_->{chaindestx} } @{$falling_bubble{$::p}}) {
1030				$pdata{$::p}{malus} > 0 and play_sound('malus');
1031				while ($pdata{$::p}{malus} > 0 && @{$malus_bubble{$::p}} < 7) {
1032				    my $b = create_bubble($::p);
1033				    do {
1034					$b->{'cx'} = int(rand(7));
1035				    } while (member($b->{'cx'}, map { $_->{'cx'} } @{$malus_bubble{$::p}}));
1036				    $b->{'cy'} = 12;
1037				    $b->{'stick_y'} = 0;
1038				    foreach (@{$sticked_bubbles{$::p}}) {
1039					if ($_->{'cy'} > $b->{'stick_y'}) {
1040					    if ($_->{'cx'} == $b->{'cx'}
1041						|| odd($_->{'cy'}+$pdata{$::p}{oddswap}) && ($_->{'cx'}+1) == $b->{'cx'}) {
1042						$b->{'stick_y'} = $_->{'cy'};
1043					    }
1044					}
1045				    }
1046				    $b->{'stick_y'}++;
1047				    calc_real_pos($b, $::p);
1048				    push @{$malus_bubble{$::p}}, $b;
1049				    malus_change(-1, $::p);
1050				}
1051				#- sort them and shift them
1052				@{$malus_bubble{$::p}} = sort { $a->{'cx'} <=> $b->{'cx'} } @{$malus_bubble{$::p}};
1053				my $shifting = 0;
1054				$_->{'y'} += ($shifting+=7)+int(rand(20)) foreach @{$malus_bubble{$::p}};
1055			    }
1056
1057			    last;
1058			}
1059		    }
1060		}
1061	    }
1062
1063	    !$tobe_launched{$::p} and generate_new_bubble($::p);
1064
1065	    if (!$actions{$::p}{left} && !$actions{$::p}{right} && !$actions{$::p}{hadfire}) {
1066		$pdata{$::p}{sleeping}++;
1067	    } else {
1068		$pdata{$::p}{sleeping} = 0;
1069		$pdata{$::p}{ping_right}{movelatency} = -20;
1070	    }
1071	    if ($pdata{$::p}{sleeping} > $TIMEOUT_PINGUIN_SLEEP) {
1072		$pdata{$::p}{ping_right}{state} = 'sleep';
1073	    } elsif ($pdata{$::p}{ping_right}{state} eq 'sleep') {
1074		$pdata{$::p}{ping_right}{state} = 'normal';
1075	    }
1076	    if ($pdata{$::p}{ping_right}{state} eq 'right' && !($actions{$::p}{right})
1077		|| $pdata{$::p}{ping_right}{state} eq 'left' && !($actions{$::p}{left})
1078		|| $pdata{$::p}{ping_right}{state} eq 'action' && ($pdata{$::p}{ping_right}{actionlatency}++ > 5)) {
1079		$pdata{$::p}{ping_right}{state} = 'normal';
1080	    }
1081	    $actions{$::p}{right} and $pdata{$::p}{ping_right}{state} = 'right';
1082	    $actions{$::p}{left} and $pdata{$::p}{ping_right}{state} = 'left';
1083	    if ($actions{$::p}{hadfire}) {
1084		$pdata{$::p}{ping_right}{state} = 'action';
1085		$actions{$::p}{hadfire} = 0;
1086		$pdata{$::p}{ping_right}{actionlatency} = 0;
1087	    }
1088	    if ($pdata{$::p}{ping_right}{state} eq 'normal' && ($pdata{$::p}{ping_right}{movelatency}++ > 10)) {
1089		$pdata{$::p}{ping_right}{movelatency} = 0;
1090		rand() < 0.4 and $pdata{$::p}{ping_right}{img} = int(rand(@{$pinguin{$::p}{normal}}));
1091	    }
1092
1093	    if ($pdata{$::p}{ping_right}{img} >= @{$pinguin{$::p}{$pdata{$::p}{ping_right}{state}}}) {
1094		$pdata{$::p}{ping_right}{img} = 0;
1095	    }
1096	};
1097
1098	verify_if_end();
1099
1100    } elsif ($pdata{state} =~ /lost (.*)/) {
1101	my $lost_slowdown if 0;  #- ``if 0'' is Perl's way of doing what C calls ``static local variables''
1102	if ($lost_slowdown++ > 1) {
1103	    $lost_slowdown = 0;
1104	    iter_players {
1105		if ($::p eq $1) {
1106		    if (@{$sticked_bubbles{$::p}}) {
1107			my $b = shift @{$sticked_bubbles{$::p}};
1108			put_image_to_background($bubbles_anim{lose}, --$b->{'x'}, --$b->{'y'});
1109	#		my $line = $b->{'cy'};
1110	#		while (@{$sticked_bubbles{$::p}} && ${$sticked_bubbles{$::p}}[0]->{'cy'} == $line) {
1111	#		    my $b = shift @{$sticked_bubbles{$::p}};
1112	#		    put_image_to_background($bubbles_anim{lose}, --$b->{'x'}, --$b->{'y'});
1113	#		}
1114
1115			if (@{$sticked_bubbles{$::p}} == 0) {
1116			    $graphics_level == 1 and put_image($imgbin{win}{$::p eq 'p1' ? 'p2' : 'p1'}, $POS{centerpanel}{x}, $POS{centerpanel}{'y'});
1117			    if (is_1p_game()) {
1118				put_image($imgbin{lose}, $POS{centerpanel}{'x'}, $POS{centerpanel}{'y'});
1119				play_sound('noh');
1120			    }
1121			}
1122
1123			if (!@{$sticked_bubbles{$::p}}) {
1124			    $event->pump while $event->poll != 0;
1125			}
1126		    } else {
1127			$event->pump;
1128			die 'new_game' if $event->poll != 0 && $event->type == SDL_KEYDOWN;
1129		    }
1130		} else {
1131		    if (@{$sticked_bubbles{$::p}} && $graphics_level > 1) {
1132			my $b = shift @{$sticked_bubbles{$::p}};
1133			destroy_bubbles($::p, $b);
1134			remove_image_from_background($b->{img}, $b->{'x'}, $b->{'y'});
1135			#- be sure to redraw at least upper line
1136			foreach (@{$b->{neighbours}}) {
1137			    next if !member($_, @{$sticked_bubbles{$::p}});
1138			    put_image_to_background($_->{img}, $_->{'x'}, $_->{'y'});
1139			}
1140		    }
1141		}
1142	    };
1143
1144	}
1145
1146    } elsif ($pdata{state} =~ /won (.*)/) {
1147	if (@{$exploding_bubble{$1}} == 0) {
1148	    $event->pump;
1149	    die 'new_game' if $event->poll != 0 && $event->type == SDL_KEYDOWN;
1150	}
1151
1152    } else {
1153	die "oops unhandled game state ($pdata{state})\n";
1154    }
1155
1156
1157    #- things that need to be updated in all states of the game
1158    iter_players {
1159	my $malus_end = [];
1160	foreach my $b (@{$malus_bubble{$::p}}) {
1161	    $b->{'y'} -= $MALUS_BUBBLE_SPEED;
1162	    if (get_array_yclosest($b->{'y'}) <= $b->{'stick_y'}) {
1163		real_stick_bubble($b, $b->{'cx'}, $b->{'stick_y'}, $::p, 0);
1164		push @$malus_end, $b;
1165	    }
1166	}
1167	@$malus_end and @{$malus_bubble{$::p}} = difference2($malus_bubble{$::p}, $malus_end);
1168
1169	my $falling_end = [];
1170	foreach my $b (@{$falling_bubble{$::p}}) {
1171	    if ($b->{wait_fall}) {
1172		$b->{wait_fall}--;
1173	    } else {
1174		if (exists $b->{chaindestx} && ($b->{'y'} > 375 || $b->{chaingoingup})) {
1175		    my $acceleration = $FREE_FALL_CONSTANT*3;
1176		    if (!$b->{chaingoingup}) {
1177			my $time_to_zero = $b->{speed}/$acceleration;
1178			my $distance_to_zero = $b->{speed} * ($b->{speed}/$acceleration + 1) / 2;
1179			my $time_to_destination = (-1 + sqrt(1 + 8/$acceleration*($b->{'y'}-$b->{chaindesty}+$distance_to_zero))) / 2;
1180			$b->{speedx} = ($b->{chaindestx} - $b->{x}) / ($time_to_zero + $time_to_destination);
1181			$b->{chaingoingup} = 1;
1182		    }
1183		    $b->{speed} -= $acceleration;
1184		    $b->{x} += $b->{speedx};
1185		    if (abs($b->{x} - $b->{chaindestx}) < abs($b->{speedx})) {
1186			$b->{'x'} = $b->{chaindestx};
1187			$b->{speedx} = 0;
1188		    }
1189		    $b->{'y'} += $b->{speed};
1190		    $b->{'y'} < $b->{chaindesty} and push @$falling_end, $b;
1191		} else {
1192		    $b->{'y'} += $b->{speed};
1193		    $b->{speed} += $FREE_FALL_CONSTANT;
1194		}
1195	    }
1196	    $b->{'y'} > 470 && !exists $b->{chaindestx} and push @$falling_end, $b;
1197	}
1198	@$falling_end and @{$falling_bubble{$::p}} = difference2($falling_bubble{$::p}, $falling_end);
1199	foreach (@$falling_end) {
1200	    exists $_->{chaindestx} or next;
1201	    @{$chains{$::p}{falling_chained}} = difference2($chains{$::p}{falling_chained}, [ $_ ]);
1202	    delete $chains{$::p}{chained_bubbles}{$_};
1203	    stick_bubble($_, $_->{chaindestcx}, $_->{chaindestcy}, $::p, 0);
1204	}
1205
1206	my $exploding_end = [];
1207	foreach my $b (@{$exploding_bubble{$::p}}) {
1208	    $b->{'x'} += $b->{speedx};
1209	    $b->{'y'} += $b->{speedy};
1210	    $b->{speedy} += $FREE_FALL_CONSTANT;
1211	    push @$exploding_end, $b if $b->{'y'} > 470;
1212	}
1213	if (@$exploding_end) {
1214	    @{$exploding_bubble{$::p}} = difference2($exploding_bubble{$::p}, $exploding_end);
1215	    if ($pdata{state} =~ /lost (.*)/ && $::p ne $1 && !is_1p_game()
1216		&& !@{$exploding_bubble{$::p}} && !@{$sticked_bubbles{$::p}}) {
1217		put_image($imgbin{win}{$::p}, $POS{centerpanel}{'x'}, $POS{centerpanel}{'y'});
1218	    }
1219	}
1220
1221	if (member($pdata{$::p}{ping_right}{state}, qw(win lose)) && ($pdata{$::p}{ping_right}{movelatency}++ > 5)) {
1222	    my $state = $pdata{$::p}{ping_right}{state};
1223	    $pdata{$::p}{ping_right}{movelatency} = 0;
1224	    $pdata{$::p}{ping_right}{img}++;
1225	    $pdata{$::p}{ping_right}{img} == @{$pinguin{$::p}{$state}}
1226	      and $pdata{$::p}{ping_right}{img} = $pinguin{$::p}{"$state".'_roll_back_index'};
1227	}
1228
1229    };
1230
1231    #- advance playlist when the current song finished
1232    $mixer_enabled && $mixer && @playlist && !$mixer->playing_music and play_music('dummy', 0);
1233}
1234
1235#- ----------- init stuff -------------------------------------------------
1236
1237sub restart_app() {
1238    $app = SDL::App->new(-flags => $sdl_flags | ($fullscreen ? SDL_FULLSCREEN : 0), -title => 'Frozen-Bubble', -width => 640, -height => 480);
1239}
1240
1241sub print_step($) {
1242    my ($txt) = @_;
1243    print $txt;
1244    my $step if 0; $step ||= 0;
1245    put_image($imgbin{loading_step}, 100 + $step*12, 10);
1246    $app->flip;
1247    $step++;
1248}
1249
1250sub load_levelset {
1251    my ($levelset_name) = @_;
1252
1253    -e $levelset_name or die "No such levelset ($levelset_name).\n";
1254
1255    $loaded_levelset = $levelset_name;
1256    my $row_numb = 0;
1257    my $curr_level = $levels{current};
1258
1259    %levels = ();
1260    $levels{current} = $curr_level;
1261    $lev_number = 1;
1262
1263    foreach my $line (cat_($levelset_name)) {
1264	if ($line !~ /\S/) {
1265	    if ($row_numb) {
1266		$lev_number++;
1267		$row_numb = 0;
1268	    }
1269	} else {
1270	    my $col_numb = 0;
1271	    foreach (split ' ', $line) {
1272		/-/ or push @{$levels{$lev_number}}, { cx => $col_numb, cy => $row_numb, img_num => $_ };
1273		$col_numb++;
1274	    }
1275	    $row_numb++;
1276	}
1277    }
1278}
1279
1280sub init_game() {
1281    -r "$FPATH/$_" or die "[*ERROR*] the datafiles seem to be missing! (could not read `$FPATH/$_')\n".
1282                          "          The datafiles need to go to `$FPATH'.\n"
1283			    foreach qw(gfx snd data);
1284
1285    print '[SDL Init] ';
1286    restart_app();
1287    $font = SDL::Font->new("$FPATH/gfx/font.png");
1288    $apprects{main} = SDL::Rect->new(-width => $app->width, -height => $app->height);
1289    $event = SDL::Event->new;
1290    $event->set_unicode(1);
1291    SDL::Cursor::show(0);
1292    $total_time = $app->ticks;
1293    $imgbin{loading} = add_image('loading.png');
1294    put_image($imgbin{loading}, 10, 10);
1295    $app->print(30, 60, uc("tip!  use '-h' on command-line to get more options"));
1296    $app->flip;
1297    $imgbin{loading_step} = add_image('loading_step.png');
1298 
1299    print_step('[Graphics');
1300    $imgbin{back_2p} = SDL::Surface->new(-name => "$FPATH/gfx/backgrnd.png");
1301    $imgbin{back_1p} = SDL::Surface->new(-name => "$FPATH/gfx/back_one_player.png");
1302    $background = SDL::Surface->new(-width => $app->width, -height => $app->height, -depth => 32, -Amask => '0 but true');
1303    $background_orig = SDL::Surface->new(-width => $app->width, -height => $app->height, -depth => 32, -Amask => '0 but true');
1304    $imgbin{backstartfull} = SDL::Surface->new(-name => "$FPATH/gfx/menu/back_start.png");
1305
1306    print_step('.'); 
1307    add_bubble_image('balls/bubble-'.($colourblind && 'colourblind-')."$_.gif") foreach (1..8);
1308    $bubbles_anim{white} = add_image("balls/bubble_prelight.png");
1309    $bubbles_anim{lose} = add_image("balls/bubble_lose.png");
1310    $bubbles_anim{on_top_next} = add_image("on_top_next.png");
1311    push @{$bubbles_anim{stick}}, add_image("balls/stick_effect_$_.png") foreach (0..6);
1312
1313    $shooter = 

Large files files are truncated, but you can click here to view the full file