PageRenderTime 34ms CodeModel.GetById 0ms RepoModel.GetById 0ms 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. 

  2. #*****************************************************************************
    3. 

  3. #
    4. 

  4. #                          Frozen-Bubble
    5. 

  5. #
    6. 

  6. # Copyright (c) 2000, 2001, 2002, 2003 Guillaume Cottenceau <guillaume.cottenceau at free.fr>
    7. 

  7. #
    8. 

  8. # Sponsored by MandrakeSoft <http://www.mandrakesoft.com/>
    9. 

  9. #
    10. 

  10. # This program is free software; you can redistribute it and/or modify
    11. 

  11. # it under the terms of the GNU General Public License version 2, as
    12. 

  12. # published by the Free Software Foundation.
    13. 

  13. #
    14. 

  14. # This program is distributed in the hope that it will be useful,
    15. 

  15. # but WITHOUT ANY WARRANTY; without even the implied warranty of
    16. 

  16. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    17. 

  17. # GNU General Public License for more details.
    18. 

  18. #
    19. 

  19. # You should have received a copy of the GNU General Public License
    20. 

  20. # along with this program; if not, write to the Free Software
    21. 

  21. # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
    22. 

  22. #
    23. 

  23. #
    24. 

  24. #******************************************************************************
    25. 

  25. #
    26. 

  26. # Design & Programming by Guillaume Cottenceau between Oct 2001 and Jan 2002.
    27. 

  27. # Level Editor parts by Kim Joham and David Joham between Oct 2002 and Jan 2003
    28. 

  28. #
    29. 

  29. # Check official home: http://www.frozen-bubble.org/
    30. 

  30. #
    31. 

  31. #******************************************************************************
    32. 

  32. #
    33. 

  33. #
    34. 

  34. # Yes it uses Perl, you non-believer :-).
    35. 

  35. #
    36. 

  36. 

  37. #use diagnostics;
    38. 

  38. #use strict;
    39. 

  39. 

  40. use vars qw($TARGET_ANIM_SPEED $BUBBLE_SIZE $ROW_SIZE $LAUNCHER_SPEED $BUBBLE_SPEED $MALUS_BUBBLE_SPEED $TIME_APPEARS_NEW_ROOT
    41. 

  41.             %POS %POS_1P %POS_2P $KEYS %actions %angle %pdata $app $font %apprects $event %rects %sticked_bubbles %root_bubbles
    42. 

  42.             $background $background_orig @bubbles_images $gcwashere %bubbles_anim %launched_bubble %tobe_launched %next_bubble
    43. 

  43.             $shooter $sdl_flags $mixer $mixer_enabled $music_disabled $sfx_disabled @playlist %sound %music %pinguin %canon
    44. 

  44.             $graphics_level @update_rects $CANON_ROTATIONS_NB %malus_bubble %falling_bubble %exploding_bubble %malus_gfx
    45. 

  45.             %sticking_bubble $version $time %imgbin $TIME_HURRY_WARN $TIME_HURRY_MAX $TIMEOUT_PINGUIN_SLEEP $FREE_FALL_CONSTANT
    46. 

  46.             $direct @PLAYERS %levels $display_on_app_disabled $total_time $time_1pgame $fullscreen $rcfile $hiscorefile $HISCORES
    47. 

  47.             $lev_number $playermalus $loaded_levelset $direct_levelset $chainreaction %chains %history);
    48. 

  48. 

  49. use Data::Dumper;
    50. 

  50. 

  51. use SDL;
    52. 

  52. use SDL::App;
    53. 

  53. use SDL::Surface;
    54. 

  54. use SDL::Event;
    55. 

  55. use SDL::Cursor;
    56. 

  56. use SDL::Font;
    57. 

  57. use SDL::Mixer;
    58. 

  58. 

  59. use fb_stuff;
    60. 

  60. use fbsyms;
    61. 

  61. use FBLE;
    62. 

  62. 

  63. $| = 1;
    64. 

  64. 

  65. $TARGET_ANIM_SPEED = 20;        # number of milliseconds that should last between two animation frames
    66. 

  66. $LAUNCHER_SPEED = 0.03;  	# speed of rotation of launchers
    67. 

  67. $BUBBLE_SPEED = 10;		# speed of movement of launched bubbles
    68. 

  68. $MALUS_BUBBLE_SPEED = 30;	# speed of movement of "malus" launched bubbles
    69. 

  69. $CANON_ROTATIONS_NB = 40;       # number of rotations of images for canon (should be consistent with gfx/shoot/Makefile)
    70. 

  70. 

  71. $TIMEOUT_PINGUIN_SLEEP = 200;
    72. 

  72. $FREE_FALL_CONSTANT = 0.5;
    73. 

  73. $KEYS = { p1 => { left => SDLK_x,    right => SDLK_v,     fire => SDLK_c,  center => SDLK_d },
    74. 

  74. 	  p2 => { left => SDLK_LEFT, right => SDLK_RIGHT, fire => SDLK_UP, center => SDLK_DOWN },
    75. 

  75. 	  misc => { fs => SDLK_f } };
    76. 

  76. 

  77. $sdl_flags = SDL_ANYFORMAT | SDL_HWSURFACE | SDL_DOUBLEBUF | SDL_HWACCEL | SDL_ASYNCBLIT;
    78. 

  78. $mixer = 0;
    79. 

  79. $graphics_level = 3;
    80. 

  80. @PLAYERS = qw(p1 p2);
    81. 

  81. $playermalus = 0;
    82. 

  82. $chainreaction = 0;
    83. 

  83. 

  84. $rcfile = "$ENV{HOME}/.fbrc";
    85. 

  85. eval(cat_($rcfile));
    86. 

  86. eval(cat_($hiscorefile = "$ENV{HOME}/.fbhighscores"));
    87. 

  87. 

  88. $version = '1.0.1';
    89. 

  89. 

  90. print "        [[ Frozen-Bubble-$version ]]\n\n";
    91. 

  91. print '  http://www.frozen-bubble.org/
    92. 

    93. 

  93.   Copyright (c) 2000, 2001, 2002, 2003 Guillaume Cottenceau.
    94. 

  94.   Artwork: Alexis Younes <73lab at free.fr>
    95. 

  95.            Amaury Amblard-Ladurantie <amaury at linuxfr.org>
    96. 

  96.   Soundtrack: Matthias Le Bidan <matthias.le_bidan at caramail.com>
    97. 

  97.   Design & Programming: Guillaume Cottenceau <guillaume.cottenceau at free.fr>
    98. 

  98.   Level Editor: Kim and David Joham <[k|d]joham at yahoo.com>
    99. 

  99. 

  100.   Sponsored by MandrakeSoft <http://www.mandrakesoft.com/>
    101. 

  101. 

  102.   This program is free software; you can redistribute it and/or modify
    103. 

  103.   it under the terms of the GNU General Public License version 2, as
    104. 

  104.   published by the Free Software Foundation.
    105. 

  105. 

  106. ';
    107. 

    108. 

  108. local $_ = "@ARGV";
    109. 

  109. 

  110. /-h/ and die "Usage: ", basename($0), " [OPTION]...
    111. 

  111.   -h, --help                 display this help screen
    112. 

  112.  -fs, --fullscreen           start in fullscreen mode
    113. 

  113.  -ns, --nosound              don't try to start any sound stuff
    114. 

  114.  -nm, --nomusic              disable music (only)
    115. 

  115.  -nfx, --nosfx               disable sound effects (only)
    116. 

  116.       --playlist<file>       use all files listed in the given file as music files and play them
    117. 

  117.       --playlist<directory>  use all files inside the given directory as music files and play them
    118. 

  118.  -sl, --slow_machine         enable slow machine mode (disable a few animations)
    119. 

  119.  -vs, --very_slow_machine    enable very slow machine mode (disable all that can be disabled)
    120. 

  120.  -di, --direct               directly start (2p) game (don't display menu)
    121. 

  121.  -so, --solo                 directly start solo (1p) game, with random levels
    122. 

  122.  -cr, --chain_reaction       enable chain-reaction
    123. 

  123.  -l<#n>, --level<#n>         directly start the n-th level
    124. 

  124.  -cb, --colourblind          use bubbles for colourblind people
    125. 

  125.  -pm<#n>, --playermalus<#n>  add a malus of n to the left player (can be negative)
    126. 

  126.  -ls<name>, --levelset<name> directly start with the specified levelset name
    127. 

  127. 

  128. ";
    129. 

    130. 

  130. /-fs/ || /-fu/ and $fullscreen = 1;
    131. 

  131. /-ns/ || /-noso/ and $mixer = 'SOUND_DISABLED';
    132. 

  132. /-nm/ || /-nom/ and $music_disabled = 1;
    133. 

  133. /-nfx/ || /-nosf/ and $sfx_disabled = 1;
    134. 

  134. /-playlist\s*(\S+)/ and @playlist = -d $1 ? glob("$1/*") : cat_($1);
    135. 

  135. /-sl/ and $graphics_level = 2;
    136. 

  136. /-vs/ || /-ve/ and $graphics_level = 1;
    137. 

  137. /-srand/ and srand 0;
    138. 

  138. /-di/ and $direct = 1;
    139. 

  139. /-so/ and $direct = 1, @PLAYERS = ('p1');
    140. 

  140. /-cr/ || /-chain_reaction/ and $chainreaction = 1;
    141. 

  141. /-cb/ || /-co/ and $colourblind = 1;
    142. 

  142. /-pm\s*(-?[\d]+)/ || /-playermalus\s*(-?\d+)/ and $playermalus = $1;
    143. 

  143. /-ls\s*(\S+)/ || /-levelset\s*(\S+)/ and $levels{current} = 1, $direct = 1, @PLAYERS = ('p1'), $direct_levelset = $1;
    144. 

  144. /-l\s*(\d+)/ || /-level\s*(\d+)/ and $levels{current} = $1, $direct = 1, @PLAYERS = ('p1');
    145. 

  145. 

  146. 

  147. #- ------------------------------------------------------------------------
    148. 

  148. 

  149. END {
    150. 

  150.     if ($app) {
    151. 

  151. 	$total_time = ($app->ticks - $total_time)/1000;
    152. 

  152. 	my $h = int($total_time/3600);
    153. 

  153. 	my $m = int(($total_time-$h*3600)/60);
    154. 

  154. 	my $s = int($total_time-$h*3600-$m*60);
    155. 

  155. 	print "\nAddicted for ", $h ? "$h"."h " : "", $m ? "$m"."m " : "", "$s"."s.\n";
    156. 

  156.     }
    157. 

  157. }
    158. 

  158. 

  159. #- it doesn't keep ordering (but I don't care)
    160. 

  160. sub fastuniq { my %l; @l{@_} = @_; values %l }
    161. 

  161. 

  162. 

  163. #- ----------- sound related stuff ----------------------------------------
    164. 

  164. 

  165. sub play_sound($) {
    166. 

  166.     $mixer_enabled && $mixer && !$sfx_disabled && $sound{$_[0]} and $mixer->play_channel(-1, $sound{$_[0]}, 0);
    167. 

  167. }
    168. 

  168. sub chomp_ { my @l = map { my $l = $_; chomp $l; $l } @_; wantarray() ? @l : $l[0] }
    169. 

  169. sub play_music($;$) {
    170. 

  170.     my ($name, $pos) = @_;
    171. 

  171.     $mixer_enabled && $mixer && !$music_disabled or return;
    172. 

  172.     @playlist && $mixer->playing_music and return;
    173. 

  173.     $app->delay(10) while $mixer->fading_music;   #- mikmod will deadlock if we try to fade_out while still fading in
    174. 

  174.     $mixer->playing_music and $mixer->fade_out_music(500); $app->delay(400);
    175. 

  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. 

  176.     my %musics = (intro => '/snd/introzik.xm', main1p => '/snd/frozen-mainzik-1p.xm', main2p => '/snd/frozen-mainzik-2p.xm');
    177. 

  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. 

  178.     if (@playlist) {
    179. 

  179. 	my $tryanother = sub {
    180. 

  180. 	    my $elem = chomp_(shift @playlist);
    181. 

  181. 	    $elem or return -1;
    182. 

  182. 	    -f $elem or return 0;
    183. 

  183. 	    push @playlist, $elem;
    184. 

  184. 	    $mus = SDL::Music->new($elem);
    185. 

  185. 	    if ($mus->{-data}) {
    186. 

  186. 		print STDERR "[Playlist] playing `$elem'\n";
    187. 

  187. 		$mixer->play_music($mus, 0);
    188. 

  188. 		return 1;
    189. 

  189. 	    } else { 
    190. 

  190. 		print STDERR "Warning, could not create new music from `$elem' (reason: ", $app->error, ").\n";
    191. 

  191. 		return 0;
    192. 

  192. 	    }
    193. 

  193. 	};
    194. 

  194. 	while ($tryanother->() == 0) {};
    195. 

  195.     } else {
    196. 

  196. 	$mus = SDL::Music->new("$FPATH$musics{$name}");
    197. 

  197. 	$mus->{-data} or print STDERR "Warning, could not create new music from `$FPATH$musics{$name}' (reason: ", $app->error, ").\n";
    198. 

  198. 	if ($pos) {
    199. 

  199. 	    fb_c_stuff::fade_in_music_position($mus->{-data}, -1, 500, $pos);
    200. 

  200. 	} else {
    201. 

  201. 	    $mixer->play_music($mus, -1);
    202. 

  202. 	}
    203. 

  203.     }
    204. 

  204. }
    205. 

  205. 

  206. sub init_sound() {
    207. 

  207.     $mixer = eval { SDL::Mixer->new(-frequency => 44100, -channels => 2, -size => 1024); };
    208. 

  208.     if ($@) {
    209. 

  209. 	$@ =~ s| at \S+ line.*\n||;
    210. 

  210. 	print STDERR "\nWarning: can't initialize sound (reason: $@).\n";
    211. 

  211. 	return 0;
    212. 

  212.     }
    213. 

  213.     print "[Sound Init]\n";
    214. 

  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. 

  215.     foreach (@sounds) {
    216. 

  216. 	my $sound_path = "$FPATH/snd/$_.wav";
    217. 

  217. 	$sound{$_} = SDL::Sound->new($sound_path);
    218. 

  218. 	if ($sound{$_}{-data}) {
    219. 

  219. 	    $sound{$_}->volume(80);
    220. 

  220. 	} else {
    221. 

  221. 	    print STDERR "Warning, could not create new sound from `$sound_path'.\n";
    222. 

  222. 	}
    223. 

  223.     }
    224. 

  224.     return 1;
    225. 

  225. }
    226. 

  226. 

  227. 

  228. #- ----------- graphics related stuff --------------------------------------
    229. 

  229. 

  230. sub add_default_rect($) {
    231. 

  231.     my ($surface) = @_;
    232. 

  232.     $rects{$surface} = SDL::Rect->new(-width => $surface->width, -height => $surface->height);
    233. 

  233. }
    234. 

  234. 

  235. sub put_image($$$) {
    236. 

  236.     my ($image, $x, $y) = @_;
    237. 

  237.     $rects{$image} or die "please don't call me with no rects\n".backtrace();
    238. 

  238.     my $drect = SDL::Rect->new(-width => $image->width, -height => $image->height, -x => $x, '-y' => $y);
    239. 

  239.     $image->blit($rects{$image}, $app, $drect);
    240. 

  240.     push @update_rects, $drect;
    241. 

  241. }
    242. 

  242. 

  243. sub erase_image_from($$$$) {
    244. 

  244.     my ($image, $x, $y, $img) = @_;
    245. 

  245.     my $drect = SDL::Rect->new(-width => $image->width, -height => $image->height, -x => $x, '-y' => $y);
    246. 

  246.     $img->blit($drect, $app, $drect);
    247. 

  247.     push @update_rects, $drect;
    248. 

  248. }
    249. 

  249. 

  250. sub erase_image($$$) {
    251. 

  251.     my ($image, $x, $y) = @_;
    252. 

  252.     erase_image_from($image, $x, $y, $background);
    253. 

  253. }
    254. 

  254. 

  255. sub put_image_to_background($$$) {
    256. 

  256.     my ($image, $x, $y) = @_;
    257. 

  257.     my $drect;
    258. 

  258.     ($x == 0 && $y == 0) and print "put_image_to_background: warning, X and Y are 0\n";
    259. 

  259.     if ($y > 0) {
    260. 

  260. 	$drect = SDL::Rect->new(-width => $image->width, -height => $image->height, -x => $x, '-y' => $y);
    261. 

  261. 	$display_on_app_disabled or $image->blit($rects{$image}, $app, $drect);
    262. 

  262. 	$image->blit($rects{$image}, $background, $drect);
    263. 

  263.     } else {  #- clipping seems to not work when from one Surface to another Surface, so I need to do clipping by hand
    264. 

  264. 	$drect = SDL::Rect->new(-width => $image->width, -height => $image->height + $y, -x => $x, '-y' => 0);
    265. 

  265. 	my $irect = SDL::Rect->new(-width => $image->width, -height => $image->height + $y, '-y' => -$y);
    266. 

  266. 	$display_on_app_disabled or $image->blit($irect, $app, $drect);
    267. 

  267. 	$image->blit($irect, $background, $drect);
    268. 

  268.     }
    269. 

  269.     push @update_rects, $drect;
    270. 

  270. }
    271. 

  271. 

  272. sub remove_image_from_background($$$) {
    273. 

  273.     my ($image, $x, $y) = @_;
    274. 

  274.     ($x == 0 && $y == 0) and print "remove_image_from_background: warning, X and Y are 0\n";
    275. 

  275.     my $drect = SDL::Rect->new(-width => $image->width, -height => $image->height, -x => $x, '-y' => $y);
    276. 

  276.     $background_orig->blit($drect, $background, $drect);
    277. 

  277.     $background_orig->blit($drect, $app, $drect);
    278. 

  278.     push @update_rects, $drect;
    279. 

  279. }
    280. 

  280. 

  281. sub remove_images_from_background {
    282. 

  282.     my ($player, @images) = @_;
    283. 

  283.     foreach (@images) {
    284. 

  284. 	($_->{'x'} == 0 && $_->{'y'} == 0) and print "remove_images_from_background: warning, X and Y are 0\n";
    285. 

  285. 	my $drect = SDL::Rect->new(-width => $_->{img}->width, -height => $_->{img}->height, -x => $_->{'x'}, '-y' => $_->{'y'});
    286. 

  286. 	$background_orig->blit($drect, $background, $drect);
    287. 

  287. 	$background_orig->blit($drect, $app, $drect);
    288. 

  288. 	push @update_rects, $drect;
    289. 

  289.     }
    290. 

  290. }
    291. 

  291. 

  292. sub put_allimages_to_background($) {
    293. 

  293.     my ($player) = @_;
    294. 

  294.     put_image_to_background($_->{img}, $_->{'x'}, $_->{'y'}) foreach @{$sticked_bubbles{$player}};
    295. 

  295. }
    296. 

  296. 

  297. sub switch_image_on_background($$$;$) {
    298. 

  298.     my ($image, $x, $y, $save) = @_;
    299. 

  299.     my $drect = SDL::Rect->new(-width => $image->width, -height => $image->height, -x => $x, '-y' => $y);
    300. 

  300.     if ($save) {
    301. 

  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. 

  302. 	$background->blit($drect, $save, $rects{$image});
    303. 

  303.     }
    304. 

  304.     $image->blit($rects{$image} || SDL::Rect->new(-width => $image->width, -height => $image->height), $background, $drect);
    305. 

  305.     $background->blit($drect, $app, $drect);
    306. 

  306.     push @update_rects, $drect;
    307. 

  307.     return $save;
    308. 

  308. }
    309. 

  309. 

  310. sub add_image($) {
    311. 

  311.     my $file = "$FPATH/gfx/$_[0]";
    312. 

  312.     my $img = SDL::Surface->new(-name => $file);
    313. 

  313.     $img->{-surface} or die "FATAL: Couldn't load `$file' into a SDL::Surface.\n";
    314. 

  314.     add_default_rect($img);
    315. 

  315.     return $img;
    316. 

  316. }
    317. 

  317. 

  318. sub add_bubble_image($) {
    319. 

  319.     my ($file) = @_;
    320. 

  320.     my $bubble = add_image($file);
    321. 

  321.     push @bubbles_images, $bubble;
    322. 

  322. }
    323. 

  323. 

  324. 

  325. #- ----------- generic game stuff -----------------------------------------
    326. 

  326. 

  327. sub iter_players(&) {
    328. 

  328.     my ($f) = @_;
    329. 

  329.     local $::p;
    330. 

  330.     foreach $::p (@PLAYERS) {
    331. 

  331. 	&$f;
    332. 

  332.     }
    333. 

  333. }
    334. 

  334. sub iter_players_(&) {  #- so that I can do an iter_players_ from within an iter_players
    335. 

  335.     my ($f) = @_;
    336. 

  336.     local $::p_;
    337. 

  337.     foreach $::p_ (@PLAYERS) {
    338. 

  338. 	&$f;
    339. 

  339.     }
    340. 

  340. }
    341. 

  341. sub is_1p_game() { @PLAYERS == 1 }
    342. 

  342. sub is_2p_game() { @PLAYERS == 2 }
    343. 

  343. 

  344. 

  345. #- ----------- bubble game stuff ------------------------------------------
    346. 

  346. 

  347. sub calc_real_pos_given_arraypos($$$) {
    348. 

  348.     my ($cx, $cy, $player) = @_;
    349. 

  349.     ($POS{$player}{left_limit} + $cx * $BUBBLE_SIZE + odd($cy+$pdata{$player}{oddswap}) * $BUBBLE_SIZE/2,
    350. 

  350.      $POS{top_limit} + $cy * $ROW_SIZE);
    351. 

  351. }
    352. 

  352. 

  353. sub calc_real_pos($$) {
    354. 

  354.     my ($b, $player) = @_;
    355. 

  355.     ($b->{'x'}, $b->{'y'}) = calc_real_pos_given_arraypos($b->{cx}, $b->{cy}, $player);
    356. 

  356. }
    357. 

  357. 

  358. sub get_array_yclosest($) {
    359. 

  359.     my ($y) = @_;
    360. 

  360.     return int(($y-$POS{top_limit}+$ROW_SIZE/2) / $ROW_SIZE);
    361. 

  361. }
    362. 

  362. 

  363. sub get_array_closest_pos($$$) { # roughly the opposite than previous function
    364. 

  364.     my ($x, $y, $player) = @_;
    365. 

  365.     my $ny = get_array_yclosest($y);
    366. 

  366.     my $nx = int(($x-$POS{$player}{left_limit}+$BUBBLE_SIZE/2 - odd($ny+$pdata{$player}{oddswap})*$BUBBLE_SIZE/2)/$BUBBLE_SIZE);
    367. 

  367.     return ($nx, $ny);
    368. 

  368. }
    369. 

  369. 

  370. sub is_collision($$$) {
    371. 

  371.     my ($bub, $x, $y) = @_;
    372. 

  372.     my $DISTANCE_COLLISION_SQRED = sqr($BUBBLE_SIZE * 0.82);
    373. 

  373.     my $xs = sqr($bub->{x} - $x);
    374. 

  374.     ($xs > $DISTANCE_COLLISION_SQRED) and return 0; 
    375. 

  375.     return ($xs + sqr($bub->{'y'} - $y)) < $DISTANCE_COLLISION_SQRED;
    376. 

  376. }
    377. 

  377. 

  378. sub create_bubble_given_img($) {
    379. 

  379.     my ($img) = @_;
    380. 

  380.     my %bubble;
    381. 

  381.     ref($img) eq 'SDL::Surface' or die "<$img> seems to not be a valid image\n" . backtrace();
    382. 

  382.     $bubble{img} = $img;
    383. 

  383.     return \%bubble;
    384. 

  384. }
    385. 

  385. 

  386. sub create_bubble(;$) {
    387. 

  387.     my ($p) = @_;
    388. 

  388.     my $b = create_bubble_given_img($bubbles_images[rand(@bubbles_images)]);
    389. 

  389.     is_1p_game() && $p && !member($b->{img}, map { $_->{img} } @{$sticked_bubbles{$p}})
    390. 

  390.       and return &create_bubble($p);  #- prototype checking pb w/ recursion
    391. 

  391.     return $b;
    392. 

  392. }
    393. 

  393. 

  394. sub iter_rowscols(&$) {
    395. 

  395.     my ($f, $oddswap) = @_;
    396. 

  396.     local $::row; local $::col;
    397. 

  397.     foreach $::row (0 .. 11) {
    398. 

  398. 	foreach $::col (0 .. 7 - odd($::row+$oddswap)) {
    399. 

  399. 	    &$f;
    400. 

  400. 	}
    401. 

  401.     }
    402. 

  402. }
    403. 

  403. 

  404. sub each_index(&@) {
    405. 

  405.     my $f = shift;
    406. 

  406.     local $::i = 0;
    407. 

  407.     foreach (@_) {
    408. 

  408. 	&$f($::i);
    409. 

  409. 	$::i++;
    410. 

  410.     }
    411. 

  411. }
    412. 

  412. sub img2numb { my ($i, $f) = @_; each_index { $i eq $_ and $f = $::i } @bubbles_images; return defined($f) ? $f : '-' }
    413. 

  413. 

  414. #sub history {
    415. 

  415. #    foreach my $frame (@{$history{$_[0]}}[-10...1]) {
    416. 

  416. #	iter_rowscols {
    417. 

  417. #	    if ($::col == 0) {
    418. 

  418. #		$::row == 0 or print "\n";
    419. 

  419. #		odd($::row+$frame->{oddswap}) and print "  ";
    420. 

  420. #	    }
    421. 

  421. #	    foreach (@{$frame->{sticked}}) {
    422. 

  422. #		$_->[0] == $::col && $_->[1] == $::row or next;
    423. 

  423. #		print $_->[2];
    424. 

  424. #		goto non_void;
    425. 

  425. #	    }
    426. 

  426. #	    if ($frame->{sticking}[0] == $::col && $frame->{sticking}[1] == $::row) {
    427. 

  427. #		print "\033[D!$frame->{sticking}[2]";
    428. 

  428. #		goto non_void;
    429. 

  429. #	    }
    430. 

  430. #	    print '-';
    431. 

  431. #	  non_void:
    432. 

  432. #	    $::col+odd($::row+$frame->{oddswap}) < 7 and print "   ";
    433. 

  433. #        } $frame->{oddswap};
    434. 

  434. #	print "\n\n";
    435. 

  435. #    }
    436. 

  436. #}
    437. 

  437. 

  438. sub bubble_next_to($$$$$) {
    439. 

  439.     my ($x1, $y1, $x2, $y2, $player) = @_;
    440. 

  440.     $x1 == $x2 && $y1 == $y2 and die "bubble_next_to: assert failed -- same bubbles ($x1:$y1;$player)" . backtrace();
    441. 

  441. #    $x1 == $x2 && $y1 == $y2 and history($player), die "bubble_next_to: assert failed -- same bubbles ($x1:$y1;$player)" . backtrace();
    442. 

  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. 

  443. }
    444. 

  444. 

  445. sub next_positions($$) {
    446. 

  446.     my ($b, $player) = @_;
    447. 

  447.     my $validate_pos = sub {
    448. 

  448. 	my ($x, $y) = @_;
    449. 

  449. 	if_($x >= 0 && $x+odd($y+$pdata{$player}{oddswap}) <= 7 && $y >= 0 && $y >= $pdata{$player}{newrootlevel} && $y <= 11,
    450. 

  450. 	    [ $x, $y ]);
    451. 

  451.     };
    452. 

  452.     ($validate_pos->($b->{cx} - 1, $b->{cy}),
    453. 

  453.      $validate_pos->($b->{cx} + 1, $b->{cy}),
    454. 

  454.      $validate_pos->($b->{cx} - even($b->{cy}+$pdata{$player}{oddswap}), $b->{cy} - 1),
    455. 

  455.      $validate_pos->($b->{cx} - even($b->{cy}+$pdata{$player}{oddswap}), $b->{cy} + 1),
    456. 

  456.      $validate_pos->($b->{cx} - even($b->{cy}+$pdata{$player}{oddswap}) + 1, $b->{cy} - 1),
    457. 

  457.      $validate_pos->($b->{cx} - even($b->{cy}+$pdata{$player}{oddswap}) + 1, $b->{cy} + 1));
    458. 

  458. }
    459. 

  459. 

  460. #- bubble ends its life sticked somewhere
    461. 

  461. sub real_stick_bubble {
    462. 

  462.     my ($bubble, $xpos, $ypos, $player, $neighbours_ok) = @_;
    463. 

  463.     $bubble->{cx} = $xpos;
    464. 

  464.     $bubble->{cy} = $ypos;
    465. 

  465.     foreach (@{$sticked_bubbles{$player}}) {
    466. 

  466. 	if (bubble_next_to($_->{cx}, $_->{cy}, $bubble->{cx}, $bubble->{cy}, $player)) {
    467. 

  467. 	    push @{$_->{neighbours}}, $bubble;
    468. 

  468. 	    $neighbours_ok or push @{$bubble->{neighbours}}, $_;
    469. 

  469. 	}
    470. 

  470.     }
    471. 

  471.     push @{$sticked_bubbles{$player}}, $bubble;
    472. 

  472.     $bubble->{cy} == $pdata{$player}{newrootlevel} and push @{$root_bubbles{$player}}, $bubble;
    473. 

  473.     calc_real_pos($bubble, $player);
    474. 

  474.     put_image_to_background($bubble->{img}, $bubble->{'x'}, $bubble->{'y'});
    475. 

  475. }
    476. 

  476. 

  477. sub destroy_bubbles {
    478. 

  478.     my ($player, @bubz) = @_;
    479. 

  479.     $graphics_level == 1 and return;
    480. 

  480.     foreach (@bubz) {
    481. 

  481. 	$_->{speedx} = rand(3)-1.5;
    482. 

  482. 	$_->{speedy} = -rand(4)-2;
    483. 

  483.     }
    484. 

  484.     push @{$exploding_bubble{$player}}, @bubz;
    485. 

  485. }
    486. 

  486. 

  487. sub find_bubble_group($) {
    488. 

  488.     my ($b) = @_;
    489. 

  489.     my @neighbours = $b;
    490. 

  490.     my @group;
    491. 

  491.     while (1) {
    492. 

  492. 	push @group, @neighbours;
    493. 

  493. 	@neighbours = grep { $b->{img} eq $_->{img} && !member($_, @group) } fastuniq(map { @{$_->{neighbours}} } @neighbours);
    494. 

  494. 	last if !@neighbours;
    495. 

  495.     }
    496. 

  496.     @group;
    497. 

  497. }
    498. 

  498. 

  499. sub stick_bubble($$$$$) {
    500. 

  500.     my ($bubble, $xpos, $ypos, $player, $count_for_root) = @_;
    501. 

  501.     my @falling;
    502. 

  502.     my $need_redraw = 0;
    503. 

  503.     @{$bubble->{neighbours}} = grep { bubble_next_to($_->{cx}, $_->{cy}, $xpos, $ypos, $player) } @{$sticked_bubbles{$player}};
    504. 

  504. 

  505.     #- in multiple chain reactions, it's possible that the group doesn't exist anymore in some rare situations :/
    506. 

  506.     exists $bubble->{chaindestx} && !@{$bubble->{neighbours}} and return;
    507. 

  507. 

  508.     my @will_destroy = difference2([ find_bubble_group($bubble) ], [ $bubble ]);
    509. 

  509. 

  510.     if (@will_destroy <= 1) {
    511. 

  511. 	#- stick
    512. 

  512. 	play_sound('stick');
    513. 

  513. 	real_stick_bubble($bubble, $xpos, $ypos, $player, 1);
    514. 

  514. 	$sticking_bubble{$player} = $bubble;
    515. 

  515. 	$pdata{$player}{sticking_step} = 0;
    516. 

  516.     } else {
    517. 

  517. 	#- destroy the group
    518. 

  518. 	play_sound('destroy_group');
    519. 

  519. 	foreach my $b (difference2([ fastuniq(map { @{$_->{neighbours}} } @will_destroy) ], \@will_destroy)) {
    520. 

  520. 	    @{$b->{neighbours}} = difference2($b->{neighbours}, \@will_destroy);
    521. 

  521. 	}
    522. 

  522. 	@{$sticked_bubbles{$player}} = difference2($sticked_bubbles{$player}, \@will_destroy);
    523. 

  523. 	@{$root_bubbles{$player}} = difference2($root_bubbles{$player}, \@will_destroy);
    524. 

  524. 

  525. 	$bubble->{'cx'} = $xpos;
    526. 

  526. 	$bubble->{'cy'} = $ypos;
    527. 

  527. 	calc_real_pos($bubble, $player);
    528. 

  528. 	destroy_bubbles($player, @will_destroy, $bubble);
    529. 

  529. 

  530. 	#- find falling bubbles
    531. 

  531. 	$_->{mark} = 0 foreach @{$sticked_bubbles{$player}};
    532. 

  532. 	my @still_sticked;
    533. 

  533. 	my @neighbours = @{$root_bubbles{$player}};
    534. 

  534. 	my $distance_to_root;
    535. 

  535. 	while (1) {
    536. 

  536. 	    $_->{mark} = ++$distance_to_root foreach @neighbours;
    537. 

  537. 	    push @still_sticked, @neighbours;
    538. 

  538. 	    @neighbours = grep { $_->{mark} == 0 } map { @{$_->{neighbours}} } @neighbours;
    539. 

  539. 	    last if !@neighbours;
    540. 

  540. 	}
    541. 

  541. 	@falling = difference2($sticked_bubbles{$player}, \@still_sticked);
    542. 

  542. 	@{$sticked_bubbles{$player}} = difference2($sticked_bubbles{$player}, \@falling);
    543. 

  543. 

  544. 	#- chain-reaction on falling bubbles
    545. 

  545. 	if ($chainreaction) {
    546. 

  546. 	    my @falling_colors = map { $_->{img} } @falling;
    547. 

  547. 	    #- optimize a bit by first calculating bubbles that are next to another bubble of the same color
    548. 

  548. 	    my @grouped_bubbles = grep {
    549. 

  549. 		my $b = $_;
    550. 

  550. 		member($b->{img}, @falling_colors) && any { $b->{img} eq $_->{img} } @{$b->{neighbours}}
    551. 

  551. 	    } @{$sticked_bubbles{$player}};
    552. 

  552. 	    if (@grouped_bubbles) {
    553. 

  553. 		#- all positions on which we can't chain-react
    554. 

  554. 		my @occupied_positions = map { $_->{cy}*8 + $_->{cx} } @{$sticked_bubbles{$player}};
    555. 

  555. 		push @occupied_positions, map { $_->{chaindestcy}*8 + $_->{chaindestcx} } @{$chains{$player}{falling_chained}};
    556. 

  556. 		#- examine groups beginning at the root bubbles, for the case in which
    557. 

  557. 		#- there is a group that will fall from an upper chain-reaction
    558. 

  558. 		foreach my $pos (sort { $a->{mark} <=> $b->{mark} } @grouped_bubbles) {
    559. 

  559. 		    #- now examine if there is a free position to chain-react in it
    560. 

  560. 		    foreach my $npos (next_positions($pos, $player)) {
    561. 

  561. 			#- we can't chain-react somewhere if it explodes a group already chained
    562. 

  562. 			next if any { $pos->{cx} == $_->{cx} && $pos->{cy} == $_->{cy} }
    563. 

  563. 			        map { @{$chains{$player}{chained_bubbles}{$_}}} keys %{$chains{$player}{chained_bubbles}};
    564. 

  564. 			if (!member($npos->[1]*8 + $npos->[0], @occupied_positions)) {
    565. 

  565. 			    #- find a suitable falling bubble for that free position
    566. 

  566. 			    foreach my $falling (@falling) {
    567. 

  567. 				next if member($falling, @{$chains{$player}{falling_chained}});
    568. 

  568. 				if ($pos->{img} eq $falling->{img}) {
    569. 

  569. 				    ($falling->{chaindestcx}, $falling->{chaindestcy}) = ($npos->[0], $npos->[1]);
    570. 

  570. 				    ($falling->{chaindestx}, $falling->{chaindesty}) = calc_real_pos_given_arraypos($npos->[0], $npos->[1], $player);
    571. 

  571. 				    push @{$chains{$player}{falling_chained}}, $falling;
    572. 

  572. 				    push @occupied_positions, $npos->[1]*8 + $npos->[0];
    573. 

  573. 				    
    574. 

  574. 				    #- next lines will allow not to chain-react on the same group from two different positions,
    575. 

  575. 				    #- and even to not chain-react on a group that will itself fall from a chain-reaction
    576. 

  576. 				    @{$falling->{neighbours}} = grep { bubble_next_to($_->{cx}, $_->{cy}, $npos->[0], $npos->[1], $player) } @{$sticked_bubbles{$player}};
    577. 

  577. 				    my @chained_bubbles = find_bubble_group($falling);
    578. 

  578. 				    $_->{mark} = 0 foreach @{$sticked_bubbles{$player}};
    579. 

  579. 				    my @still_sticked;
    580. 

  580. 				    my @neighbours = difference2($root_bubbles{$player}, \@chained_bubbles);
    581. 

  581. 				    while (1) {
    582. 

  582. 					$_->{mark} = 1 foreach @neighbours;
    583. 

  583. 					push @still_sticked, @neighbours;
    584. 

  584. 					@neighbours = difference2([ grep { $_->{mark} == 0 } map { @{$_->{neighbours}} } @neighbours ],
    585. 

  585. 								  \@chained_bubbles);
    586. 

  586. 					last if !@neighbours;
    587. 

  587. 				    }
    588. 

  588. 				    @{$chains{$player}{chained_bubbles}{$falling}} = difference2($sticked_bubbles{$player}, \@still_sticked);
    589. 

  589. 				    last;
    590. 

  590. 				}
    591. 

  591. 			    }
    592. 

  592. 			}
    593. 

  593. 		    }
    594. 

  594. 		}
    595. 

  595. 	    }
    596. 

  596. 	}
    597. 

  597. 

  598. 	#- prepare falling bubbles
    599. 

  599. 	if ($graphics_level > 1) {
    600. 

  600. 	    my $max_cy_falling = fold_left { $::b->{cy} > $::a ? $::b->{cy} : $::a } 0, @falling;  #- I have a fold_left in my prog! :-)
    601. 

  601. 	    my ($shift_on_same_line, $line) = (0, $max_cy_falling);
    602. 

  602. 	    foreach (sort { $b->{cy}*8 + $b->{cx} <=> $a->{cy}*8 + $a->{cx} } @falling) {  #- sort bottom-to-up / right-to-left
    603. 

  603. 		$line != $_->{cy} and $shift_on_same_line = 0;
    604. 

  604. 		$line = $_->{cy};
    605. 

  605. 		$_->{wait_fall} = ($max_cy_falling - $_->{cy})*5 + $shift_on_same_line;
    606. 

  606. 		$shift_on_same_line++;
    607. 

  607. 		$_->{speed} = 0;
    608. 

  608. 	    }
    609. 

  609. 	    push @{$falling_bubble{$player}}, @falling;
    610. 

  610. 	}
    611. 

  611. 

  612. 	remove_images_from_background($player, @will_destroy, @falling);
    613. 

  613. 	#- redraw neighbours because parts of neighbours have been erased by previous statement
    614. 

  614. 	put_image_to_background($_->{img}, $_->{'x'}, $_->{'y'})
    615. 

  615. 	  foreach grep { !member($_, @will_destroy) && !member($_, @falling) } fastuniq(map { @{$_->{neighbours}} } @will_destroy, @falling);
    616. 

  616. 	$need_redraw = 1;
    617. 

  617.     }
    618. 

  618. 

  619.     if ($count_for_root) {
    620. 

  620. 	$pdata{$player}{newroot}++;
    621. 

  621. 	if ($pdata{$player}{newroot} == $TIME_APPEARS_NEW_ROOT-1) {
    622. 

  622. 	    $pdata{$player}{newroot_prelight} = 2;
    623. 

  623. 	    $pdata{$player}{newroot_prelight_step} = 0;
    624. 

  624. 	}
    625. 

  625. 	if ($pdata{$player}{newroot} == $TIME_APPEARS_NEW_ROOT) {
    626. 

  626. 	    $pdata{$player}{newroot_prelight} = 1;
    627. 

  627. 	    $pdata{$player}{newroot_prelight_step} = 0;
    628. 

  628. 	}
    629. 

  629. 	if ($pdata{$player}{newroot} > $TIME_APPEARS_NEW_ROOT) {
    630. 

  630. 	    $need_redraw = 1;
    631. 

  631. 	    $pdata{$player}{newroot_prelight} = 0;
    632. 

  632. 	    play_sound(is_1p_game() ? 'newroot_solo' : 'newroot');
    633. 

  633. 	    $pdata{$player}{newroot} = 0;
    634. 

  634. 	    $pdata{$player}{oddswap} = !$pdata{$player}{oddswap};
    635. 

  635. 	    remove_images_from_background($player, @{$sticked_bubbles{$player}});
    636. 

  636. 	    foreach (@{$sticked_bubbles{$player}}) {
    637. 

  637. 		$_->{'cy'}++;
    638. 

  638. 		calc_real_pos($_, $player);
    639. 

  639. 	    }
    640. 

  640. 	    foreach (@{$falling_bubble{$player}}) {
    641. 

  641. 		exists $_->{chaindestx} or next;
    642. 

  642. 		$_->{chaindestcy}++;
    643. 

  643. 		$_->{chaindesty} += $ROW_SIZE;
    644. 

  644. 	    }
    645. 

  645. 	    put_allimages_to_background($player);
    646. 

  646. 	    if (is_1p_game()) {
    647. 

  647. 		$pdata{$player}{newrootlevel}++;
    648. 

  648. 		print_compressor();
    649. 

  649. 	    } else {
    650. 

  650. 		@{$root_bubbles{$player}} = ();
    651. 

  651. 		real_stick_bubble(create_bubble($player), $_, 0, $player, 0) foreach (0..(7-$pdata{$player}{oddswap}));
    652. 

  652. 	    }
    653. 

  653. 	}
    654. 

  654.     }
    655. 

  655. 

  656.     if ($need_redraw) {
    657. 

  657. 	my $malus_val = @will_destroy + @falling - 2;
    658. 

  658. 	$malus_val > 0 and $malus_val += ($player eq 'p1' ? $playermalus : -$playermalus);
    659. 

  659. 	$malus_val < 0 and $malus_val = 0;
    660. 

  660. 	$background->blit($apprects{$player}, $app, $apprects{$player});
    661. 

  661. 	malus_change($malus_val, $player);
    662. 

  662.     }
    663. 

  663. 

  664. #    push @{$history{$player}}, { sticking => [ $xpos, $ypos, img2numb($bubble->{img}) ],
    665. 

  665. #				 oddswap => $pdata{$player}{oddswap},
    666. 

  666. #				 sticked => [ map { [ $_->{cx}, $_->{cy}, img2numb($_->{img}) ] } @{$sticked_bubbles{$player}} ] };
    667. 

  667. }
    668. 

  668. 

  669. sub print_next_bubble($$;$) {
    670. 

  670.     my ($img, $player, $not_on_top_next) = @_;
    671. 

  671.     put_image_to_background($img, $next_bubble{$player}{'x'}, $next_bubble{$player}{'y'});
    672. 

  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. 

  673. }
    674. 

  674. 

  675. sub generate_new_bubble {
    676. 

  676.     my ($player, $img) = @_;
    677. 

  677.     $tobe_launched{$player} = $next_bubble{$player};
    678. 

  678.     $tobe_launched{$player}{'x'} = ($POS{$player}{left_limit}+$POS{$player}{right_limit})/2 - $BUBBLE_SIZE/2;
    679. 

  679.     $tobe_launched{$player}{'y'} = $POS{'initial_bubble_y'};
    680. 

  680.     $next_bubble{$player} = $img ? create_bubble_given_img($img) : create_bubble($player);
    681. 

  681.     $next_bubble{$player}{'x'} = $POS{$player}{left_limit}+$POS{next_bubble}{x}; #- necessary to keep coordinates, for verify_if_end
    682. 

  682.     $next_bubble{$player}{'y'} = $POS{next_bubble}{'y'};
    683. 

  683.     print_next_bubble($next_bubble{$player}{img}, $player);
    684. 

  684. }
    685. 

  685. 

  686. 

  687. #- ----------- game stuff -------------------------------------------------
    688. 

  688. 

  689. sub handle_graphics($) {
    690. 

  690.     my ($fun) = @_;
    691. 

  691. 

  692.     iter_players {
    693. 

  693. 	#- bubbles
    694. 

  694. 	foreach ($launched_bubble{$::p}, if_($fun ne \&erase_image, $tobe_launched{$::p})) {
    695. 

  695. 	    $_ and $fun->($_->{img}, $_->{'x'}, $_->{'y'});
    696. 

  696. 	}
    697. 

  697. 	if ($fun eq \&put_image && $pdata{$::p}{newroot_prelight}) {
    698. 

  698. 	    if ($pdata{$::p}{newroot_prelight_step}++ > 30*$pdata{$::p}{newroot_prelight}) {
    699. 

  699. 		$pdata{$::p}{newroot_prelight_step} = 0;
    700. 

  700. 	    }
    701. 

  701. 	    if ($pdata{$::p}{newroot_prelight_step} <= 8) {
    702. 

  702. 		my $hurry_overwritten = 0;
    703. 

  703. 		foreach my $b (@{$sticked_bubbles{$::p}}) {
    704. 

  704. 		    next if ($graphics_level == 1 && $b->{'cy'} > 0);  #- in low graphics, only prelight first row
    705. 

  705. 		    $b->{'cx'}+1 == $pdata{$::p}{newroot_prelight_step} and put_image($b->{img}, $b->{'x'}, $b->{'y'});
    706. 

  706. 		    $b->{'cx'} == $pdata{$::p}{newroot_prelight_step} and put_image($bubbles_anim{white}, $b->{'x'}, $b->{'y'});
    707. 

  707. 		    $b->{'cy'} > 6 and $hurry_overwritten = 1;
    708. 

  708. 		}
    709. 

  709. 		$hurry_overwritten && $pdata{$::p}{hurry_save_img} and print_hurry($::p, 1);  #- hurry was potentially overwritten
    710. 

  710. 	    }
    711. 

  711. 	}
    712. 

  712. 	if ($sticking_bubble{$::p} && $graphics_level > 1) {
    713. 

  713. 	    my $b = $sticking_bubble{$::p};
    714. 

  714. 	    if ($fun eq \&erase_image) {
    715. 

  715. 		put_image($b->{img}, $b->{'x'}, $b->{'y'});
    716. 

  716. 	    } else {
    717. 

  717. 		if ($pdata{$::p}{sticking_step} == @{$bubbles_anim{stick}}) {
    718. 

  718. 		    $sticking_bubble{$::p} = undef;
    719. 

  719. 		} else {
    720. 

  720. 		    put_image(${$bubbles_anim{stick}}[$pdata{$::p}{sticking_step}], $b->{'x'}, $b->{'y'});
    721. 

  721. 		    if ($pdata{$::p}{sticking_step_slowdown}) {
    722. 

  722. 			$pdata{$::p}{sticking_step}++;
    723. 

  723. 			$pdata{$::p}{sticking_step_slowdown} = 0;
    724. 

  724. 		    } else {
    725. 

  725. 			$pdata{$::p}{sticking_step_slowdown}++;
    726. 

  726. 		    }
    727. 

  727. 		}
    728. 

  728. 	    }
    729. 

  729. 	}
    730. 

  730. 

  731. 	#- shooter
    732. 

  732. 	if ($graphics_level > 1) {
    733. 

  733. 	    my $num = int($angle{$::p}*$CANON_ROTATIONS_NB/($PI/2) + 0.5)-$CANON_ROTATIONS_NB;
    734. 

  734. 	    $fun->($canon{img}{$num},
    735. 

  735. 		   ($POS{$::p}{left_limit}+$POS{$::p}{right_limit})/2 - 50 + $canon{data}{$num}->[0],
    736. 

  736. 		   $POS{'initial_bubble_y'} + 16 - 50 + $canon{data}{$num}->[1] );  #- 50/50 stand for half width/height of gfx/shoot/base.png
    737. 

  737. 	} else {
    738. 

  738. 	    $fun->($shooter,
    739. 

  739. 		   ($POS{$::p}{left_limit}+$POS{$::p}{right_limit})/2 - 1 + 60*cos($angle{$::p}),  #- 1 for $shooter->width/2
    740. 

  740. 		   $POS{'initial_bubble_y'} + 16 - 1 - 60*sin($angle{$::p}));  #- 1/1 stand for half width/height of gfx/shoot/shooter.png
    741. 

  741. 	}
    742. 

  742. 	#- penguins
    743. 

  743. 	if ($graphics_level == 3) {
    744. 

  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. 

  745. 	}
    746. 

  746. 

  747. 	#- moving bubbles --> I want them on top of the rest
    748. 

  748. 	foreach (@{$malus_bubble{$::p}}, @{$falling_bubble{$::p}}, @{$exploding_bubble{$::p}}) {
    749. 

  749. 	    $fun->($_->{img}, $_->{'x'}, $_->{'y'});
    750. 

  750. 	}
    751. 

  751. 

  752.     };
    753. 

  753. 

  754. }
    755. 

  755. 

  756. #- extract it from "handle_graphics" to optimize a bit animations
    757. 

  757. sub malus_change($$) {
    758. 

  758.     my ($numb, $player) = @_;
    759. 

  759.     return if $numb == 0 || is_1p_game();
    760. 

  760.     if ($numb >= 0) {
    761. 

  761. 	$player = ($player eq 'p1') ? 'p2' : 'p1';
    762. 

  762.     }
    763. 

  763.     my $update_malus = sub($) {
    764. 

  764. 	my ($fun) = @_;
    765. 

  765. 	my $malus = $pdata{$player}{malus};
    766. 

  766. 	my $y_shift = 0;
    767. 

  767. 	while ($malus > 0) {
    768. 

  768. 	    my $print = sub($) {
    769. 

  769. 		my ($type) = @_;
    770. 

  770. 		$fun->($type, $POS{$player}{malus_x} - $type->width/2, $POS{'malus_y'} - $y_shift - $type->height);
    771. 

  771. 		$y_shift += $type->height - 1;
    772. 

  772. 	    };
    773. 

  773. 	    if ($malus >= 7) {
    774. 

  774. 		$print->($malus_gfx{tomate});
    775. 

  775. 		$malus -= 7;
    776. 

  776. 	    } else {
    777. 

  777. 		$print->($malus_gfx{banane});
    778. 

  778. 		$malus--;
    779. 

  779. 	    }
    780. 

  780. 	}
    781. 

  781.     };
    782. 

  782.     $update_malus->(\&remove_image_from_background);
    783. 

  783.     $pdata{$player}{malus} += $numb;
    784. 

  784.     $update_malus->(\&put_image_to_background);
    785. 

  785. }
    786. 

  786. 

  787. sub print_compressor() {
    788. 

  788.     my $x = $POS{compressor_xpos};
    789. 

  789.     my $y = $POS{top_limit} + $pdata{$PLAYERS[0]}{newrootlevel} * $ROW_SIZE;
    790. 

  790.     my ($comp_main, $comp_ext) = ($imgbin{compressor_main}, $imgbin{compressor_ext});
    791. 

  791. 

  792.     my $drect = SDL::Rect->new(-width => $comp_main->width, -height => $y,
    793. 

  793. 			       -x => $x - $comp_main->width/2, '-y' => 0);
    794. 

  794.     $background_orig->blit($drect, $background, $drect);
    795. 

  795.     $display_on_app_disabled or $background_orig->blit($drect, $app, $drect);
    796. 

  796.     push @update_rects, $drect;
    797. 

  797. 

  798.     put_image_to_background($comp_main, $x - $comp_main->width/2, $y - $comp_main->height);
    799. 

  799. 

  800.     $y -= $comp_main->height - 3;
    801. 

  801. 

  802.     while ($y > 0) {
    803. 

  803. 	put_image_to_background($comp_ext, $x - $comp_ext->width/2, $y - $comp_ext->height);
    804. 

  804. 	$y -= $comp_ext->height;
    805. 

  805.     }
    806. 

  806. }
    807. 

  807. 

  808. sub handle_game_events() {
    809. 

  809.     $event->pump;
    810. 

  810.     if ($event->poll != 0) {
    811. 

  811. 	if ($event->type == SDL_KEYDOWN) {
    812. 

  812. 	    my $keypressed = $event->key_sym;
    813. 

  813. 

  814. 	    iter_players {
    815. 

  815. 		my $pkey = is_1p_game() ? 'p2' : $::p;
    816. 

  816. 		foreach (qw(left right fire center)) {
    817. 

  817. 		    $keypressed == $KEYS->{$pkey}{$_} and $actions{$::p}{$_} = 1, last;
    818. 

  818. 		}
    819. 

  819. 	    };
    820. 

  820. 	    
    821. 

  821. 	    if ($keypressed == $KEYS->{misc}{fs}) {
    822. 

  822. 		$fullscreen = !$fullscreen;
    823. 

  823. 		$app->fullscreen;
    824. 

  824. 	    }
    825. 

  825. 

  826. 	    if ($keypressed == SDLK_PAUSE) {
    827. 

  827. 		play_sound('pause');
    828. 

  828. 		$mixer_enabled && $mixer and $mixer->pause_music;
    829. 

  829. 		my $back_saved = switch_image_on_background($imgbin{back_paused}, 0, 0, 1);
    830. 

  830. 	      pause_label:
    831. 

  831. 		while (1) {
    832. 

  832. 		    my ($index, $side) = (0, 1);
    833. 

  833. 		    while ($index || $side == 1) {
    834. 

  834. 			put_image(${$imgbin{paused}}[$index], $POS_1P{pause_clip}{x}, $POS_1P{pause_clip}{'y'});
    835. 

  835. 			$app->flip;
    836. 

  836. 			foreach (1..80) {
    837. 

  837. 			    $app->delay(20);
    838. 

  838. 			    $event->pump;
    839. 

  839. 			    if ($event->poll != 0 && $event->type == SDL_KEYDOWN) {
    840. 

  840. 				last pause_label if $event->key_sym != $KEYS->{misc}{fs};
    841. 

  841. 				$fullscreen = !$fullscreen;
    842. 

  842. 				$app->fullscreen;
    843. 

  843. 			    }
    844. 

  844. 			}
    845. 

  845. 			rand() < 0.2 and play_sound('snore');
    846. 

  846. 			$index += $side;
    847. 

  847. 			if ($index == @{$imgbin{paused}}) {
    848. 

  848. 			    $side = -1;
    849. 

  849. 			    $index -= 2;
    850. 

  850. 			}
    851. 

  851. 		    }
    852. 

  852. 		}
    853. 

  853. 		switch_image_on_background($back_saved, 0, 0);
    854. 

  854. 		iter_players { $actions{$::p}{left} = 0; $actions{$::p}{right} = 0; };
    855. 

  855. 		$mixer_enabled && $mixer and $mixer->resume_music;
    856. 

  856. 		$event->pump while $event->poll != 0;
    857. 

  857. 		$app->flip;
    858. 

  858. 	    }
    859. 

  859. 

  860. 	}
    861. 

  861. 

  862. 	if ($event->type == SDL_KEYUP) {
    863. 

  863. 	    my $keypressed = $event->key_sym;
    864. 

  864. 

  865. 	    iter_players {
    866. 

  866. 		my $pkey = is_1p_game() ? 'p2' : $::p;
    867. 

  867. 		foreach (qw(left right fire center)) {
    868. 

  868. 		    $keypressed == $KEYS->{$pkey}{$_} and $actions{$::p}{$_} = 0, last;
    869. 

  869. 		}
    870. 

  870. 	    }
    871. 

  871. 	}
    872. 

  872. 

  873. 	if ($event->type == SDL_QUIT ||
    874. 

  874. 	    $event->type == SDL_KEYDOWN && $event->key_sym == SDLK_ESCAPE) {
    875. 

  875. 	    die 'quit';
    876. 

  876. 	}
    877. 

  877.     }
    878. 

  878. }
    879. 

  879. 

  880. sub print_scores($) {
    881. 

  881.     my ($surface) = @_;  #- TODO all this function has hardcoded coordinates
    882. 

  882.     my $drect = SDL::Rect->new(-width => 120, -height => 30, -x => 260, '-y' => 428);
    883. 

  883.     $background_orig->blit($drect, $surface, $drect);
    884. 

  884.     push @update_rects, $drect;
    885. 

  885.     iter_players_ {  #- sometimes called from within a iter_players so...
    886. 

  886. 	$surface->print($POS{$::p_}{scoresx}-SDL_TEXTWIDTH($pdata{$::p_}{score})/2, $POS{scoresy}, $pdata{$::p_}{score});
    887. 

  887.     };
    888. 

  888. }
    889. 

  889. 

  890. sub verify_if_end {
    891. 

  891.     iter_players {
    892. 

  892. 	if (any { $_->{cy} > 11 } @{$sticked_bubbles{$::p}}) {
    893. 

  893. 	    $pdata{state} = "lost $::p";
    894. 

  894. 	    play_sound('lose');
    895. 

  895. 	    $pdata{$::p}{ping_right}{state} = 'lose';
    896. 

  896. 	    $pdata{$::p}{ping_right}{img} = 0;
    897. 

  897. 	    if (!is_1p_game()) {
    898. 

  898. 		my $won = $::p eq 'p1' ? 'p2' : 'p1';
    899. 

  899. 		$pdata{$won}{score}++;
    900. 

  900. 		$pdata{$won}{ping_right}{state} = 'win';
    901. 

  901. 		$pdata{$won}{ping_right}{img} = 0;
    902. 

  902. 		print_scores($background); print_scores($app);
    903. 

  903. 	    }
    904. 

  904. 	    foreach ($launched_bubble{$::p}, $tobe_launched{$::p}, @{$malus_bubble{$::p}}) {
    905. 

  905. 		$_ or next;
    906. 

  906. 		$_->{img} = $bubbles_anim{lose};
    907. 

  907. 		$_->{'x'}--;
    908. 

  908. 		$_->{'y'}--;
    909. 

  909. 	    }
    910. 

  910. 	    iter_players_ {
    911. 

  911. 		remove_hurry($::p_);
    912. 

  912. 		@{$falling_bubble{$::p_}} = grep { !exists $_->{chaindestx} } @{$falling_bubble{$::p_}};
    913. 

  913. 	    };
    914. 

  914. 	    print_next_bubble($bubbles_anim{lose}, $::p, 1);
    915. 

  915. 	    iter_players_ {
    916. 

  916. 		@{$sticked_bubbles{$::p_}} = sort { $b->{'cx'}+$b->{'cy'}*10 <=> $a->{'cx'}+$a->{'cy'}*10 } @{$sticked_bubbles{$::p_}};
    917. 

  917. 		$sticking_bubble{$::p_} = undef;
    918. 

  918. 		$launched_bubble{$::p_} and destroy_bubbles($::p_, $launched_bubble{$::p_});
    919. 

  919. 		$launched_bubble{$::p_} = undef;
    920. 

  920. 		$pdata{$::p_}{newroot_prelight} = 0;
    921. 

  921. 	    };
    922. 

  922. 	    @{$malus_bubble{$::p}} = ();
    923. 

  923. 	}
    924. 

  924.     };
    925. 

  925. 

  926.     if (is_1p_game() && @{$sticked_bubbles{$PLAYERS[0]}} == 0) {
    927. 

  927. 	put_image_to_background($imgbin{win_panel_1player}, $POS{centerpanel}{x}, $POS{centerpanel}{'y'});
    928. 

  928. 	$pdata{state} = "won $PLAYERS[0]";
    929. 

  929. 	$pdata{$PLAYERS[0]}{ping_right}{state} = 'win';
    930. 

  930. 	$pdata{$PLAYERS[0]}{ping_right}{img} = 0;
    931. 

  931. 	$levels{current} and $levels{current}++;
    932. 

  932. 	if ($levels{current} && !$levels{$levels{current}}) {
    933. 

  933. 	    $levels{current} = 'WON';
    934. 

  934. 	    @{$falling_bubble{$PLAYERS[0]}} = @{$exploding_bubble{$PLAYERS[0]}} = ();
    935. 

  935. 	    die 'quit';
    936. 

  936. 	}
    937. 

  937.     }
    938. 

  938. }
    939. 

  939. 

  940. sub print_hurry($;$) {
    941. 

  941.     my ($player, $dont_save_background) = @_;
    942. 

  942.     my $t = switch_image_on_background($imgbin{hurry}{$player}, $POS{$player}{left_limit} + $POS{hurry}{x}, $POS{hurry}{'y'}, 1);
    943. 

  943.     $dont_save_background or $pdata{$player}{hurry_save_img} = $t;
    944. 

  944. }
    945. 

  945. sub remove_hurry($) {
    946. 

  946.     my ($player) = @_;
    947. 

  947.     $pdata{$player}{hurry_save_img} and
    948. 

  948.       switch_image_on_background($pdata{$player}{hurry_save_img}, $POS{$player}{left_limit} + $POS{hurry}{x}, $POS{hurry}{'y'});
    949. 

  949.     $pdata{$player}{hurry_save_img} = undef;
    950. 

  950. }
    951. 

  951. 

  952. 

  953. #- ----------- mainloop helper --------------------------------------------
    954. 

  954. 

  955. sub update_game() {
    956. 

  956. 

  957.     if ($pdata{state} eq 'game') {
    958. 

  958. 	handle_game_events();
    959. 

  959. 	iter_players {
    960. 

  960. 	    $actions{$::p}{left} and $angle{$::p} += $LAUNCHER_SPEED;
    961. 

  961. 	    $actions{$::p}{right} and $angle{$::p} -= $LAUNCHER_SPEED;
    962. 

  962. 	    if ($actions{$::p}{center}) {
    963. 

  963. 		if ($angle{$::p} >= $PI/2 - $LAUNCHER_SPEED
    964. 

  964. 		    && $angle{$::p} <= $PI/2 + $LAUNCHER_SPEED) {
    965. 

  965. 		    $angle{$::p} = $PI/2;
    966. 

  966. 		} else {
    967. 

  967. 		    $angle{$::p} += ($angle{$::p} < $PI/2) ? $LAUNCHER_SPEED : -$LAUNCHER_SPEED;
    968. 

  968. 		}
    969. 

  969. 	    }
    970. 

  970. 	    ($angle{$::p} < 0.1) and $angle{$::p} = 0.1;
    971. 

  971. 	    ($angle{$::p} > $PI-0.1) and $angle{$::p} = $PI-0.1;
    972. 

  972. 	    $pdata{$::p}{hurry}++;
    973. 

  973. 	    if ($pdata{$::p}{hurry} > $TIME_HURRY_WARN) {
    974. 

  974. 		my $oddness = odd(int(($pdata{$::p}{hurry}-$TIME_HURRY_WARN)/(500/$TARGET_ANIM_SPEED))+1);
    975. 

  975. 		if ($pdata{$::p}{hurry_oddness} xor $oddness) {
    976. 

  976. 		    if ($oddness) {
    977. 

  977. 			play_sound('hurry');
    978. 

  978. 			print_hurry($::p);
    979. 

  979. 		    } else {
    980. 

  980. 			remove_hurry($::p)
    981. 

  981. 		    }
    982. 

  982. 		}
    983. 

  983. 		$pdata{$::p}{hurry_oddness} = $oddness;
    984. 

  984. 	    }
    985. 

  985. 

  986. 	    if (($actions{$::p}{fire} || $pdata{$::p}{hurry} == $TIME_HURRY_MAX)
    987. 

  987. 		&& !$launched_bubble{$::p}
    988. 

  988. 		&& !(any { exists $_->{chaindestx} } @{$falling_bubble{$::p}})
    989. 

  989. 		&& !@{$malus_bubble{$::p}}) {
    990. 

  990. 		play_sound('launch');
    991. 

  991. 		$launched_bubble{$::p} = $tobe_launched{$::p};
    992. 

  992. 		$launched_bubble{$::p}->{direction} = $angle{$::p};
    993. 

  993. 		$tobe_launched{$::p} = undef;
    994. 

  994. 		$actions{$::p}{fire} = 0;
    995. 

  995. 		$actions{$::p}{hadfire} = 1;
    996. 

  996. 		$pdata{$::p}{hurry} = 0;
    997. 

  997. 		remove_hurry($::p);
    998. 

  998. 	    }
    999. 

  999. 

  1000. 	    if ($launched_bubble{$::p}) {
    1001. 

  1001. 		$launched_bubble{$::p}->{'x_old'} = $launched_bubble{$::p}->{'x'}; # save coordinates for potential collision
    1002. 

  1002. 		$launched_bubble{$::p}->{'y_old'} = $launched_bubble{$::p}->{'y'};
    1003. 

  1003. 		$launched_bubble{$::p}->{'x'} += $BUBBLE_SPEED * cos($launched_bubble{$::p}->{direction});
    1004. 

  1004. 		$launched_bubble{$::p}->{'y'} -= $BUBBLE_SPEED * sin($launched_bubble{$::p}->{direction});
    1005. 

  1005. 		if ($launched_bubble{$::p}->{x} < $POS{$::p}{left_limit}) {
    1006. 

  1006. 		    play_sound('rebound');
    1007. 

  1007. 		    $launched_bubble{$::p}->{x} = 2 * $POS{$::p}{left_limit} - $launched_bubble{$::p}->{x};
    1008. 

  1008. 		    $launched_bubble{$::p}->{direction} -= 2*($launched_bubble{$::p}->{direction}-$PI/2);
    1009. 

  1009. 		}
    1010. 

  1010. 		if ($launched_bubble{$::p}->{x} > $POS{$::p}{right_limit} - $BUBBLE_SIZE) {
    1011. 

  1011. 		    play_sound('rebound');
    1012. 

  1012. 		    $launched_bubble{$::p}->{x} = 2 * ($POS{$::p}{right_limit} - $BUBBLE_SIZE) - $launched_bubble{$::p}->{x};
    1013. 

  1013. 		    $launched_bubble{$::p}->{direction} += 2*($PI/2-$launched_bubble{$::p}->{direction});
    1014. 

  1014. 		}
    1015. 

  1015. 		if ($launched_bubble{$::p}->{'y'} <= $POS{top_limit} + $pdata{$::p}{newrootlevel} * $ROW_SIZE) {
    1016. 

  1016. 		    my ($cx, $cy) = get_array_closest_pos($launched_bubble{$::p}->{x}, $launched_bubble{$::p}->{'y'}, $::p);
    1017. 

  1017. 		    stick_bubble($launched_bubble{$::p}, $cx, $cy, $::p, 1);
    1018. 

  1018. 		    $launched_bubble{$::p} = undef;
    1019. 

  1019. 		} else {
    1020. 

  1020. 		    foreach (@{$sticked_bubbles{$::p}}) {
    1021. 

  1021. 			if (is_collision($launched_bubble{$::p}, $_->{'x'}, $_->{'y'})) {
    1022. 

  1022. 			    my ($cx, $cy) = get_array_closest_pos(($launched_bubble{$::p}->{'x_old'}+$launched_bubble{$::p}->{'x'})/2,
    1023. 

  1023. 								  ($launched_bubble{$::p}->{'y_old'}+$launched_bubble{$::p}->{'y'})/2,
    1024. 

  1024. 								  $::p);
    1025. 

  1025. 			    stick_bubble($launched_bubble{$::p}, $cx, $cy, $::p, 1);
    1026. 

  1026. 			    $launched_bubble{$::p} = undef;
    1027. 

  1027. 

  1028. 			    #- malus generation
    1029. 

  1029. 			    if (!any { $_->{chaindestx} } @{$falling_bubble{$::p}}) {
    1030. 

  1030. 				$pdata{$::p}{malus} > 0 and play_sound('malus');
    1031. 

  1031. 				while ($pdata{$::p}{malus} > 0 && @{$malus_bubble{$::p}} < 7) {
    1032. 

  1032. 				    my $b = create_bubble($::p);
    1033. 

  1033. 				    do {
    1034. 

  1034. 					$b->{'cx'} = int(rand(7));
    1035. 

  1035. 				    } while (member($b->{'cx'}, map { $_->{'cx'} } @{$malus_bubble{$::p}}));
    1036. 

  1036. 				    $b->{'cy'} = 12;
    1037. 

  1037. 				    $b->{'stick_y'} = 0;
    1038. 

  1038. 				    foreach (@{$sticked_bubbles{$::p}}) {
    1039. 

  1039. 					if ($_->{'cy'} > $b->{'stick_y'}) {
    1040. 

  1040. 					    if ($_->{'cx'} == $b->{'cx'}
    1041. 

  1041. 						|| odd($_->{'cy'}+$pdata{$::p}{oddswap}) && ($_->{'cx'}+1) == $b->{'cx'}) {
    1042. 

  1042. 						$b->{'stick_y'} = $_->{'cy'};
    1043. 

  1043. 					    }
    1044. 

  1044. 					}
    1045. 

  1045. 				    }
    1046. 

  1046. 				    $b->{'stick_y'}++;
    1047. 

  1047. 				    calc_real_pos($b, $::p);
    1048. 

  1048. 				    push @{$malus_bubble{$::p}}, $b;
    1049. 

  1049. 				    malus_change(-1, $::p);
    1050. 

  1050. 				}
    1051. 

  1051. 				#- sort them and shift them
    1052. 

  1052. 				@{$malus_bubble{$::p}} = sort { $a->{'cx'} <=> $b->{'cx'} } @{$malus_bubble{$::p}};
    1053. 

  1053. 				my $shifting = 0;
    1054. 

  1054. 				$_->{'y'} += ($shifting+=7)+int(rand(20)) foreach @{$malus_bubble{$::p}};
    1055. 

  1055. 			    }
    1056. 

  1056. 

  1057. 			    last;
    1058. 

  1058. 			}
    1059. 

  1059. 		    }
    1060. 

  1060. 		}
    1061. 

  1061. 	    }
    1062. 

  1062. 

  1063. 	    !$tobe_launched{$::p} and generate_new_bubble($::p);
    1064. 

  1064. 

  1065. 	    if (!$actions{$::p}{left} && !$actions{$::p}{right} && !$actions{$::p}{hadfire}) {
    1066. 

  1066. 		$pdata{$::p}{sleeping}++;
    1067. 

  1067. 	    } else {
    1068. 

  1068. 		$pdata{$::p}{sleeping} = 0;
    1069. 

  1069. 		$pdata{$::p}{ping_right}{movelatency} = -20;
    1070. 

  1070. 	    }
    1071. 

  1071. 	    if ($pdata{$::p}{sleeping} > $TIMEOUT_PINGUIN_SLEEP) {
    1072. 

  1072. 		$pdata{$::p}{ping_right}{state} = 'sleep';
    1073. 

  1073. 	    } elsif ($pdata{$::p}{ping_right}{state} eq 'sleep') {
    1074. 

  1074. 		$pdata{$::p}{ping_right}{state} = 'normal';
    1075. 

  1075. 	    }
    1076. 

  1076. 	    if ($pdata{$::p}{ping_right}{state} eq 'right' && !($actions{$::p}{right})
    1077. 

  1077. 		|| $pdata{$::p}{ping_right}{state} eq 'left' && !($actions{$::p}{left})
    1078. 

  1078. 		|| $pdata{$::p}{ping_right}{state} eq 'action' && ($pdata{$::p}{ping_right}{actionlatency}++ > 5)) {
    1079. 

  1079. 		$pdata{$::p}{ping_right}{state} = 'normal';
    1080. 

  1080. 	    }
    1081. 

  1081. 	    $actions{$::p}{right} and $pdata{$::p}{ping_right}{state} = 'right';
    1082. 

  1082. 	    $actions{$::p}{left} and $pdata{$::p}{ping_right}{state} = 'left';
    1083. 

  1083. 	    if ($actions{$::p}{hadfire}) {
    1084. 

  1084. 		$pdata{$::p}{ping_right}{state} = 'action';
    1085. 

  1085. 		$actions{$::p}{hadfire} = 0;
    1086. 

  1086. 		$pdata{$::p}{ping_right}{actionlatency} = 0;
    1087. 

  1087. 	    }
    1088. 

  1088. 	    if ($pdata{$::p}{ping_right}{state} eq 'normal' && ($pdata{$::p}{ping_right}{movelatency}++ > 10)) {
    1089. 

  1089. 		$pdata{$::p}{ping_right}{movelatency} = 0;
    1090. 

  1090. 		rand() < 0.4 and $pdata{$::p}{ping_right}{img} = int(rand(@{$pinguin{$::p}{normal}}));
    1091. 

  1091. 	    }
    1092. 

  1092. 

  1093. 	    if ($pdata{$::p}{ping_right}{img} >= @{$pinguin{$::p}{$pdata{$::p}{ping_right}{state}}}) {
    1094. 

  1094. 		$pdata{$::p}{ping_right}{img} = 0;
    1095. 

  1095. 	    }
    1096. 

  1096. 	};
    1097. 

  1097. 

  1098. 	verify_if_end();
    1099. 

  1099. 

  1100.     } elsif ($pdata{state} =~ /lost (.*)/) {
    1101. 

  1101. 	my $lost_slowdown if 0;  #- ``if 0'' is Perl's way of doing what C calls ``static local variables''
    1102. 

  1102. 	if ($lost_slowdown++ > 1) {
    1103. 

  1103. 	    $lost_slowdown = 0;
    1104. 

  1104. 	    iter_players {
    1105. 

  1105. 		if ($::p eq $1) {
    1106. 

  1106. 		    if (@{$sticked_bubbles{$::p}}) {
    1107. 

  1107. 			my $b = shift @{$sticked_bubbles{$::p}};
    1108. 

  1108. 			put_image_to_background($bubbles_anim{lose}, --$b->{'x'}, --$b->{'y'});
    1109. 

  1109. 	#		my $line = $b->{'cy'};
    1110. 

  1110. 	#		while (@{$sticked_bubbles{$::p}} && ${$sticked_bubbles{$::p}}[0]->{'cy'} == $line) {
    1111. 

  1111. 	#		    my $b = shift @{$sticked_bubbles{$::p}};
    1112. 

  1112. 	#		    put_image_to_background($bubbles_anim{lose}, --$b->{'x'}, --$b->{'y'});
    1113. 

  1113. 	#		}
    1114. 

  1114. 

  1115. 			if (@{$sticked_bubbles{$::p}} == 0) {
    1116. 

  1116. 			    $graphics_level == 1 and put_image($imgbin{win}{$::p eq 'p1' ? 'p2' : 'p1'}, $POS{centerpanel}{x}, $POS{centerpanel}{'y'});
    1117. 

  1117. 			    if (is_1p_game()) {
    1118. 

  1118. 				put_image($imgbin{lose}, $POS{centerpanel}{'x'}, $POS{centerpanel}{'y'});
    1119. 

  1119. 				play_sound('noh');
    1120. 

  1120. 			    }
    1121. 

  1121. 			}
    1122. 

  1122. 

  1123. 			if (!@{$sticked_bubbles{$::p}}) {
    1124. 

  1124. 			    $event->pump while $event->poll != 0;
    1125. 

  1125. 			}
    1126. 

  1126. 		    } else {
    1127. 

  1127. 			$event->pump;
    1128. 

  1128. 			die 'new_game' if $event->poll != 0 && $event->type == SDL_KEYDOWN;
    1129. 

  1129. 		    }
    1130. 

  1130. 		} else {
    1131. 

  1131. 		    if (@{$sticked_bubbles{$::p}} && $graphics_level > 1) {
    1132. 

  1132. 			my $b = shift @{$sticked_bubbles{$::p}};
    1133. 

  1133. 			destroy_bubbles($::p, $b);
    1134. 

  1134. 			remove_image_from_background($b->{img}, $b->{'x'}, $b->{'y'});
    1135. 

  1135. 			#- be sure to redraw at least upper line
    1136. 

  1136. 			foreach (@{$b->{neighbours}}) {
    1137. 

  1137. 			    next if !member($_, @{$sticked_bubbles{$::p}});
    1138. 

  1138. 			    put_image_to_background($_->{img}, $_->{'x'}, $_->{'y'});
    1139. 

  1139. 			}
    1140. 

  1140. 		    }
    1141. 

  1141. 		}
    1142. 

  1142. 	    };
    1143. 

  1143. 

  1144. 	}
    1145. 

  1145. 

  1146.     } elsif ($pdata{state} =~ /won (.*)/) {
    1147. 

  1147. 	if (@{$exploding_bubble{$1}} == 0) {
    1148. 

  1148. 	    $event->pump;
    1149. 

  1149. 	    die 'new_game' if $event->poll != 0 && $event->type == SDL_KEYDOWN;
    1150. 

  1150. 	}
    1151. 

  1151. 

  1152.     } else {
    1153. 

  1153. 	die "oops unhandled game state ($pdata{state})\n";
    1154. 

  1154.     }
    1155. 

  1155. 

  1156. 

  1157.     #- things that need to be updated in all states of the game
    1158. 

  1158.     iter_players {
    1159. 

  1159. 	my $malus_end = [];
    1160. 

  1160. 	foreach my $b (@{$malus_bubble{$::p}}) {
    1161. 

  1161. 	    $b->{'y'} -= $MALUS_BUBBLE_SPEED;
    1162. 

  1162. 	    if (get_array_yclosest($b->{'y'}) <= $b->{'stick_y'}) {
    1163. 

  1163. 		real_stick_bubble($b, $b->{'cx'}, $b->{'stick_y'}, $::p, 0);
    1164. 

  1164. 		push @$malus_end, $b;
    1165. 

  1165. 	    }
    1166. 

  1166. 	}
    1167. 

  1167. 	@$malus_end and @{$malus_bubble{$::p}} = difference2($malus_bubble{$::p}, $malus_end);
    1168. 

  1168. 

  1169. 	my $falling_end = [];
    1170. 

  1170. 	foreach my $b (@{$falling_bubble{$::p}}) {
    1171. 

  1171. 	    if ($b->{wait_fall}) {
    1172. 

  1172. 		$b->{wait_fall}--;
    1173. 

  1173. 	    } else {
    1174. 

  1174. 		if (exists $b->{chaindestx} && ($b->{'y'} > 375 || $b->{chaingoingup})) {
    1175. 

  1175. 		    my $acceleration = $FREE_FALL_CONSTANT*3;
    1176. 

  1176. 		    if (!$b->{chaingoingup}) {
    1177. 

  1177. 			my $time_to_zero = $b->{speed}/$acceleration;
    1178. 

  1178. 			my $distance_to_zero = $b->{speed} * ($b->{speed}/$acceleration + 1) / 2;
    1179. 

  1179. 			my $time_to_destination = (-1 + sqrt(1 + 8/$acceleration*($b->{'y'}-$b->{chaindesty}+$distance_to_zero))) / 2;
    1180. 

  1180. 			$b->{speedx} = ($b->{chaindestx} - $b->{x}) / ($time_to_zero + $time_to_destination);
    1181. 

  1181. 			$b->{chaingoingup} = 1;
    1182. 

  1182. 		    }
    1183. 

  1183. 		    $b->{speed} -= $acceleration;
    1184. 

  1184. 		    $b->{x} += $b->{speedx};
    1185. 

  1185. 		    if (abs($b->{x} - $b->{chaindestx}) < abs($b->{speedx})) {
    1186. 

  1186. 			$b->{'x'} = $b->{chaindestx};
    1187. 

  1187. 			$b->{speedx} = 0;
    1188. 

  1188. 		    }
    1189. 

  1189. 		    $b->{'y'} += $b->{speed};
    1190. 

  1190. 		    $b->{'y'} < $b->{chaindesty} and push @$falling_end, $b;
    1191. 

  1191. 		} else {
    1192. 

  1192. 		    $b->{'y'} += $b->{speed};
    1193. 

  1193. 		    $b->{speed} += $FREE_FALL_CONSTANT;
    1194. 

  1194. 		}
    1195. 

  1195. 	    }
    1196. 

  1196. 	    $b->{'y'} > 470 && !exists $b->{chaindestx} and push @$falling_end, $b;
    1197. 

  1197. 	}
    1198. 

  1198. 	@$falling_end and @{$falling_bubble{$::p}} = difference2($falling_bubble{$::p}, $falling_end);
    1199. 

  1199. 	foreach (@$falling_end) {
    1200. 

  1200. 	    exists $_->{chaindestx} or next;
    1201. 

  1201. 	    @{$chains{$::p}{falling_chained}} = difference2($chains{$::p}{falling_chained}, [ $_ ]);
    1202. 

  1202. 	    delete $chains{$::p}{chained_bubbles}{$_};
    1203. 

  1203. 	    stick_bubble($_, $_->{chaindestcx}, $_->{chaindestcy}, $::p, 0);
    1204. 

  1204. 	}
    1205. 

  1205. 

  1206. 	my $exploding_end = [];
    1207. 

  1207. 	foreach my $b (@{$exploding_bubble{$::p}}) {
    1208. 

  1208. 	    $b->{'x'} += $b->{speedx};
    1209. 

  1209. 	    $b->{'y'} += $b->{speedy};
    1210. 

  1210. 	    $b->{speedy} += $FREE_FALL_CONSTANT;
    1211. 

  1211. 	    push @$exploding_end, $b if $b->{'y'} > 470;
    1212. 

  1212. 	}
    1213. 

  1213. 	if (@$exploding_end) {
    1214. 

  1214. 	    @{$exploding_bubble{$::p}} = difference2($exploding_bubble{$::p}, $exploding_end);
    1215. 

  1215. 	    if ($pdata{state} =~ /lost (.*)/ && $::p ne $1 && !is_1p_game()
    1216. 

  1216. 		&& !@{$exploding_bubble{$::p}} && !@{$sticked_bubbles{$::p}}) {
    1217. 

  1217. 		put_image($imgbin{win}{$::p}, $POS{centerpanel}{'x'}, $POS{centerpanel}{'y'});
    1218. 

  1218. 	    }
    1219. 

  1219. 	}
    1220. 

  1220. 

  1221. 	if (member($pdata{$::p}{ping_right}{state}, qw(win lose)) && ($pdata{$::p}{ping_right}{movelatency}++ > 5)) {
    1222. 

  1222. 	    my $state = $pdata{$::p}{ping_right}{state};
    1223. 

  1223. 	    $pdata{$::p}{ping_right}{movelatency} = 0;
    1224. 

  1224. 	    $pdata{$::p}{ping_right}{img}++;
    1225. 

  1225. 	    $pdata{$::p}{ping_right}{img} == @{$pinguin{$::p}{$state}}
    1226. 

  1226. 	      and $pdata{$::p}{ping_right}{img} = $pinguin{$::p}{"$state".'_roll_back_index'};
    1227. 

  1227. 	}
    1228. 

  1228. 

  1229.     };
    1230. 

  1230. 

  1231.     #- advance playlist when the current song finished
    1232. 

  1232.     $mixer_enabled && $mixer && @playlist && !$mixer->playing_music and play_music('dummy', 0);
    1233. 

  1233. }
    1234. 

  1234. 

  1235. #- ----------- init stuff -------------------------------------------------
    1236. 

  1236. 

  1237. sub restart_app() {
    1238. 

  1238.     $app = SDL::App->new(-flags => $sdl_flags | ($fullscreen ? SDL_FULLSCREEN : 0), -title => 'Frozen-Bubble', -width => 640, -height => 480);
    1239. 

  1239. }
    1240. 

  1240. 

  1241. sub print_step($) {
    1242. 

  1242.     my ($txt) = @_;
    1243. 

  1243.     print $txt;
    1244. 

  1244.     my $step if 0; $step ||= 0;
    1245. 

  1245.     put_image($imgbin{loading_step}, 100 + $step*12, 10);
    1246. 

  1246.     $app->flip;
    1247. 

  1247.     $step++;
    1248. 

  1248. }
    1249. 

  1249. 

  1250. sub load_levelset {
    1251. 

  1251.     my ($levelset_name) = @_;
    1252. 

  1252. 

  1253.     -e $levelset_name or die "No such levelset ($levelset_name).\n";
    1254. 

  1254. 

  1255.     $loaded_levelset = $levelset_name;
    1256. 

  1256.     my $row_numb = 0;
    1257. 

  1257.     my $curr_level = $levels{current};
    1258. 

  1258. 

  1259.     %levels = ();
    1260. 

  1260.     $levels{current} = $curr_level;
    1261. 

  1261.     $lev_number = 1;
    1262. 

  1262. 

  1263.     foreach my $line (cat_($levelset_name)) {
    1264. 

  1264. 	if ($line !~ /\S/) {
    1265. 

  1265. 	    if ($row_numb) {
    1266. 

  1266. 		$lev_number++;
    1267. 

  1267. 		$row_numb = 0;
    1268. 

  1268. 	    }
    1269. 

  1269. 	} else {
    1270. 

  1270. 	    my $col_numb = 0;
    1271. 

  1271. 	    foreach (split ' ', $line) {
    1272. 

  1272. 		/-/ or push @{$levels{$lev_number}}, { cx => $col_numb, cy => $row_numb, img_num => $_ };
    1273. 

  1273. 		$col_numb++;
    1274. 

  1274. 	    }
    1275. 

  1275. 	    $row_numb++;
    1276. 

  1276. 	}
    1277. 

  1277.     }
    1278. 

  1278. }
    1279. 

  1279. 

  1280. sub init_game() {
    1281. 

  1281.     -r "$FPATH/$_" or die "[*ERROR*] the datafiles seem to be missing! (could not read `$FPATH/$_')\n".
    1282. 

  1282.                           "          The datafiles need to go to `$FPATH'.\n"
    1283. 

  1283. 			    foreach qw(gfx snd data);
    1284. 

  1284. 

  1285.     print '[SDL Init] ';
    1286. 

  1286.     restart_app();
    1287. 

  1287.     $font = SDL::Font->new("$FPATH/gfx/font.png");
    1288. 

  1288.     $apprects{main} = SDL::Rect->new(-width => $app->width, -height => $app->height);
    1289. 

  1289.     $event = SDL::Event->new;
    1290. 

  1290.     $event->set_unicode(1);
    1291. 

  1291.     SDL::Cursor::show(0);
    1292. 

  1292.     $total_time = $app->ticks;
    1293. 

  1293.     $imgbin{loading} = add_image('loading.png');
    1294. 

  1294.     put_image($imgbin{loading}, 10, 10);
    1295. 

  1295.     $app->print(30, 60, uc("tip!  use '-h' on command-line to get more options"));
    1296. 

  1296.     $app->flip;
    1297. 

  1297.     $imgbin{loading_step} = add_image('loading_step.png');
    1298. 

  1298.  
    1299. 

  1299.     print_step('[Graphics');
    1300. 

  1300.     $imgbin{back_2p} = SDL::Surface->new(-name => "$FPATH/gfx/backgrnd.png");
    1301. 

  1301.     $imgbin{back_1p} = SDL::Surface->new(-name => "$FPATH/gfx/back_one_player.png");
    1302. 

  1302.     $background = SDL::Surface->new(-width => $app->width, -height => $app->height, -depth => 32, -Amask => '0 but true');
    1303. 

  1303.     $background_orig = SDL::Surface->new(-width => $app->width, -height => $app->height, -depth => 32, -Amask => '0 but true');
    1304. 

  1304.     $imgbin{backstartfull} = SDL::Surface->new(-name => "$FPATH/gfx/menu/back_start.png");
    1305. 

  1305. 

  1306.     print_step('.'); 
    1307. 

  1307.     add_bubble_image('balls/bubble-'.($colourblind && 'colourblind-')."$_.gif") foreach (1..8);
    1308. 

  1308.     $bubbles_anim{white} = add_image("balls/bubble_prelight.png");
    1309. 

  1309.     $bubbles_anim{lose} = add_image("balls/bubble_lose.png");
    1310. 

  1310.     $bubbles_anim{on_top_next} = add_image("on_top_next.png");
    1311. 

  1311.     push @{$bubbles_anim{stick}}, add_image("balls/stick_effect_$_.png") foreach (0..6);
    1312. 

  1312. 

  1313.     $shooter = …
    1314.

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