PageRenderTime 68ms CodeModel.GetById 22ms 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
  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. #use diagnostics;
  37. #use strict;
  38. use vars qw($TARGET_ANIM_SPEED $BUBBLE_SIZE $ROW_SIZE $LAUNCHER_SPEED $BUBBLE_SPEED $MALUS_BUBBLE_SPEED $TIME_APPEARS_NEW_ROOT
  39. %POS %POS_1P %POS_2P $KEYS %actions %angle %pdata $app $font %apprects $event %rects %sticked_bubbles %root_bubbles
  40. $background $background_orig @bubbles_images $gcwashere %bubbles_anim %launched_bubble %tobe_launched %next_bubble
  41. $shooter $sdl_flags $mixer $mixer_enabled $music_disabled $sfx_disabled @playlist %sound %music %pinguin %canon
  42. $graphics_level @update_rects $CANON_ROTATIONS_NB %malus_bubble %falling_bubble %exploding_bubble %malus_gfx
  43. %sticking_bubble $version $time %imgbin $TIME_HURRY_WARN $TIME_HURRY_MAX $TIMEOUT_PINGUIN_SLEEP $FREE_FALL_CONSTANT
  44. $direct @PLAYERS %levels $display_on_app_disabled $total_time $time_1pgame $fullscreen $rcfile $hiscorefile $HISCORES
  45. $lev_number $playermalus $loaded_levelset $direct_levelset $chainreaction %chains %history);
  46. use Data::Dumper;
  47. use SDL;
  48. use SDL::App;
  49. use SDL::Surface;
  50. use SDL::Event;
  51. use SDL::Cursor;
  52. use SDL::Font;
  53. use SDL::Mixer;
  54. use fb_stuff;
  55. use fbsyms;
  56. use FBLE;
  57. $| = 1;
  58. $TARGET_ANIM_SPEED = 20; # number of milliseconds that should last between two animation frames
  59. $LAUNCHER_SPEED = 0.03; # speed of rotation of launchers
  60. $BUBBLE_SPEED = 10; # speed of movement of launched bubbles
  61. $MALUS_BUBBLE_SPEED = 30; # speed of movement of "malus" launched bubbles
  62. $CANON_ROTATIONS_NB = 40; # number of rotations of images for canon (should be consistent with gfx/shoot/Makefile)
  63. $TIMEOUT_PINGUIN_SLEEP = 200;
  64. $FREE_FALL_CONSTANT = 0.5;
  65. $KEYS = { p1 => { left => SDLK_x, right => SDLK_v, fire => SDLK_c, center => SDLK_d },
  66. p2 => { left => SDLK_LEFT, right => SDLK_RIGHT, fire => SDLK_UP, center => SDLK_DOWN },
  67. misc => { fs => SDLK_f } };
  68. $sdl_flags = SDL_ANYFORMAT | SDL_HWSURFACE | SDL_DOUBLEBUF | SDL_HWACCEL | SDL_ASYNCBLIT;
  69. $mixer = 0;
  70. $graphics_level = 3;
  71. @PLAYERS = qw(p1 p2);
  72. $playermalus = 0;
  73. $chainreaction = 0;
  74. $rcfile = "$ENV{HOME}/.fbrc";
  75. eval(cat_($rcfile));
  76. eval(cat_($hiscorefile = "$ENV{HOME}/.fbhighscores"));
  77. $version = '1.0.1';
  78. print " [[ Frozen-Bubble-$version ]]\n\n";
  79. print ' http://www.frozen-bubble.org/
  80. Copyright (c) 2000, 2001, 2002, 2003 Guillaume Cottenceau.
  81. Artwork: Alexis Younes <73lab at free.fr>
  82. Amaury Amblard-Ladurantie <amaury at linuxfr.org>
  83. Soundtrack: Matthias Le Bidan <matthias.le_bidan at caramail.com>
  84. Design & Programming: Guillaume Cottenceau <guillaume.cottenceau at free.fr>
  85. Level Editor: Kim and David Joham <[k|d]joham at yahoo.com>
  86. Sponsored by MandrakeSoft <http://www.mandrakesoft.com/>
  87. This program is free software; you can redistribute it and/or modify
  88. it under the terms of the GNU General Public License version 2, as
  89. published by the Free Software Foundation.
  90. ';
  91. local $_ = "@ARGV";
  92. /-h/ and die "Usage: ", basename($0), " [OPTION]...
  93. -h, --help display this help screen
  94. -fs, --fullscreen start in fullscreen mode
  95. -ns, --nosound don't try to start any sound stuff
  96. -nm, --nomusic disable music (only)
  97. -nfx, --nosfx disable sound effects (only)
  98. --playlist<file> use all files listed in the given file as music files and play them
  99. --playlist<directory> use all files inside the given directory as music files and play them
  100. -sl, --slow_machine enable slow machine mode (disable a few animations)
  101. -vs, --very_slow_machine enable very slow machine mode (disable all that can be disabled)
  102. -di, --direct directly start (2p) game (don't display menu)
  103. -so, --solo directly start solo (1p) game, with random levels
  104. -cr, --chain_reaction enable chain-reaction
  105. -l<#n>, --level<#n> directly start the n-th level
  106. -cb, --colourblind use bubbles for colourblind people
  107. -pm<#n>, --playermalus<#n> add a malus of n to the left player (can be negative)
  108. -ls<name>, --levelset<name> directly start with the specified levelset name
  109. ";
  110. /-fs/ || /-fu/ and $fullscreen = 1;
  111. /-ns/ || /-noso/ and $mixer = 'SOUND_DISABLED';
  112. /-nm/ || /-nom/ and $music_disabled = 1;
  113. /-nfx/ || /-nosf/ and $sfx_disabled = 1;
  114. /-playlist\s*(\S+)/ and @playlist = -d $1 ? glob("$1/*") : cat_($1);
  115. /-sl/ and $graphics_level = 2;
  116. /-vs/ || /-ve/ and $graphics_level = 1;
  117. /-srand/ and srand 0;
  118. /-di/ and $direct = 1;
  119. /-so/ and $direct = 1, @PLAYERS = ('p1');
  120. /-cr/ || /-chain_reaction/ and $chainreaction = 1;
  121. /-cb/ || /-co/ and $colourblind = 1;
  122. /-pm\s*(-?[\d]+)/ || /-playermalus\s*(-?\d+)/ and $playermalus = $1;
  123. /-ls\s*(\S+)/ || /-levelset\s*(\S+)/ and $levels{current} = 1, $direct = 1, @PLAYERS = ('p1'), $direct_levelset = $1;
  124. /-l\s*(\d+)/ || /-level\s*(\d+)/ and $levels{current} = $1, $direct = 1, @PLAYERS = ('p1');
  125. #- ------------------------------------------------------------------------
  126. END {
  127. if ($app) {
  128. $total_time = ($app->ticks - $total_time)/1000;
  129. my $h = int($total_time/3600);
  130. my $m = int(($total_time-$h*3600)/60);
  131. my $s = int($total_time-$h*3600-$m*60);
  132. print "\nAddicted for ", $h ? "$h"."h " : "", $m ? "$m"."m " : "", "$s"."s.\n";
  133. }
  134. }
  135. #- it doesn't keep ordering (but I don't care)
  136. sub fastuniq { my %l; @l{@_} = @_; values %l }
  137. #- ----------- sound related stuff ----------------------------------------
  138. sub play_sound($) {
  139. $mixer_enabled && $mixer && !$sfx_disabled && $sound{$_[0]} and $mixer->play_channel(-1, $sound{$_[0]}, 0);
  140. }
  141. sub chomp_ { my @l = map { my $l = $_; chomp $l; $l } @_; wantarray() ? @l : $l[0] }
  142. sub play_music($;$) {
  143. my ($name, $pos) = @_;
  144. $mixer_enabled && $mixer && !$music_disabled or return;
  145. @playlist && $mixer->playing_music and return;
  146. $app->delay(10) while $mixer->fading_music; #- mikmod will deadlock if we try to fade_out while still fading in
  147. $mixer->playing_music and $mixer->fade_out_music(500); $app->delay(400);
  148. $app->delay(10) while $mixer->playing_music; #- mikmod will segfault if we try to load a music while old one is still fading out
  149. my %musics = (intro => '/snd/introzik.xm', main1p => '/snd/frozen-mainzik-1p.xm', main2p => '/snd/frozen-mainzik-2p.xm');
  150. 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
  151. if (@playlist) {
  152. my $tryanother = sub {
  153. my $elem = chomp_(shift @playlist);
  154. $elem or return -1;
  155. -f $elem or return 0;
  156. push @playlist, $elem;
  157. $mus = SDL::Music->new($elem);
  158. if ($mus->{-data}) {
  159. print STDERR "[Playlist] playing `$elem'\n";
  160. $mixer->play_music($mus, 0);
  161. return 1;
  162. } else {
  163. print STDERR "Warning, could not create new music from `$elem' (reason: ", $app->error, ").\n";
  164. return 0;
  165. }
  166. };
  167. while ($tryanother->() == 0) {};
  168. } else {
  169. $mus = SDL::Music->new("$FPATH$musics{$name}");
  170. $mus->{-data} or print STDERR "Warning, could not create new music from `$FPATH$musics{$name}' (reason: ", $app->error, ").\n";
  171. if ($pos) {
  172. fb_c_stuff::fade_in_music_position($mus->{-data}, -1, 500, $pos);
  173. } else {
  174. $mixer->play_music($mus, -1);
  175. }
  176. }
  177. }
  178. sub init_sound() {
  179. $mixer = eval { SDL::Mixer->new(-frequency => 44100, -channels => 2, -size => 1024); };
  180. if ($@) {
  181. $@ =~ s| at \S+ line.*\n||;
  182. print STDERR "\nWarning: can't initialize sound (reason: $@).\n";
  183. return 0;
  184. }
  185. print "[Sound Init]\n";
  186. my @sounds = qw(stick destroy_group newroot newroot_solo lose hurry pause menu_change menu_selected rebound launch malus noh snore cancel typewriter applause);
  187. foreach (@sounds) {
  188. my $sound_path = "$FPATH/snd/$_.wav";
  189. $sound{$_} = SDL::Sound->new($sound_path);
  190. if ($sound{$_}{-data}) {
  191. $sound{$_}->volume(80);
  192. } else {
  193. print STDERR "Warning, could not create new sound from `$sound_path'.\n";
  194. }
  195. }
  196. return 1;
  197. }
  198. #- ----------- graphics related stuff --------------------------------------
  199. sub add_default_rect($) {
  200. my ($surface) = @_;
  201. $rects{$surface} = SDL::Rect->new(-width => $surface->width, -height => $surface->height);
  202. }
  203. sub put_image($$$) {
  204. my ($image, $x, $y) = @_;
  205. $rects{$image} or die "please don't call me with no rects\n".backtrace();
  206. my $drect = SDL::Rect->new(-width => $image->width, -height => $image->height, -x => $x, '-y' => $y);
  207. $image->blit($rects{$image}, $app, $drect);
  208. push @update_rects, $drect;
  209. }
  210. sub erase_image_from($$$$) {
  211. my ($image, $x, $y, $img) = @_;
  212. my $drect = SDL::Rect->new(-width => $image->width, -height => $image->height, -x => $x, '-y' => $y);
  213. $img->blit($drect, $app, $drect);
  214. push @update_rects, $drect;
  215. }
  216. sub erase_image($$$) {
  217. my ($image, $x, $y) = @_;
  218. erase_image_from($image, $x, $y, $background);
  219. }
  220. sub put_image_to_background($$$) {
  221. my ($image, $x, $y) = @_;
  222. my $drect;
  223. ($x == 0 && $y == 0) and print "put_image_to_background: warning, X and Y are 0\n";
  224. if ($y > 0) {
  225. $drect = SDL::Rect->new(-width => $image->width, -height => $image->height, -x => $x, '-y' => $y);
  226. $display_on_app_disabled or $image->blit($rects{$image}, $app, $drect);
  227. $image->blit($rects{$image}, $background, $drect);
  228. } else { #- clipping seems to not work when from one Surface to another Surface, so I need to do clipping by hand
  229. $drect = SDL::Rect->new(-width => $image->width, -height => $image->height + $y, -x => $x, '-y' => 0);
  230. my $irect = SDL::Rect->new(-width => $image->width, -height => $image->height + $y, '-y' => -$y);
  231. $display_on_app_disabled or $image->blit($irect, $app, $drect);
  232. $image->blit($irect, $background, $drect);
  233. }
  234. push @update_rects, $drect;
  235. }
  236. sub remove_image_from_background($$$) {
  237. my ($image, $x, $y) = @_;
  238. ($x == 0 && $y == 0) and print "remove_image_from_background: warning, X and Y are 0\n";
  239. my $drect = SDL::Rect->new(-width => $image->width, -height => $image->height, -x => $x, '-y' => $y);
  240. $background_orig->blit($drect, $background, $drect);
  241. $background_orig->blit($drect, $app, $drect);
  242. push @update_rects, $drect;
  243. }
  244. sub remove_images_from_background {
  245. my ($player, @images) = @_;
  246. foreach (@images) {
  247. ($_->{'x'} == 0 && $_->{'y'} == 0) and print "remove_images_from_background: warning, X and Y are 0\n";
  248. my $drect = SDL::Rect->new(-width => $_->{img}->width, -height => $_->{img}->height, -x => $_->{'x'}, '-y' => $_->{'y'});
  249. $background_orig->blit($drect, $background, $drect);
  250. $background_orig->blit($drect, $app, $drect);
  251. push @update_rects, $drect;
  252. }
  253. }
  254. sub put_allimages_to_background($) {
  255. my ($player) = @_;
  256. put_image_to_background($_->{img}, $_->{'x'}, $_->{'y'}) foreach @{$sticked_bubbles{$player}};
  257. }
  258. sub switch_image_on_background($$$;$) {
  259. my ($image, $x, $y, $save) = @_;
  260. my $drect = SDL::Rect->new(-width => $image->width, -height => $image->height, -x => $x, '-y' => $y);
  261. if ($save) {
  262. $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!!)
  263. $background->blit($drect, $save, $rects{$image});
  264. }
  265. $image->blit($rects{$image} || SDL::Rect->new(-width => $image->width, -height => $image->height), $background, $drect);
  266. $background->blit($drect, $app, $drect);
  267. push @update_rects, $drect;
  268. return $save;
  269. }
  270. sub add_image($) {
  271. my $file = "$FPATH/gfx/$_[0]";
  272. my $img = SDL::Surface->new(-name => $file);
  273. $img->{-surface} or die "FATAL: Couldn't load `$file' into a SDL::Surface.\n";
  274. add_default_rect($img);
  275. return $img;
  276. }
  277. sub add_bubble_image($) {
  278. my ($file) = @_;
  279. my $bubble = add_image($file);
  280. push @bubbles_images, $bubble;
  281. }
  282. #- ----------- generic game stuff -----------------------------------------
  283. sub iter_players(&) {
  284. my ($f) = @_;
  285. local $::p;
  286. foreach $::p (@PLAYERS) {
  287. &$f;
  288. }
  289. }
  290. sub iter_players_(&) { #- so that I can do an iter_players_ from within an iter_players
  291. my ($f) = @_;
  292. local $::p_;
  293. foreach $::p_ (@PLAYERS) {
  294. &$f;
  295. }
  296. }
  297. sub is_1p_game() { @PLAYERS == 1 }
  298. sub is_2p_game() { @PLAYERS == 2 }
  299. #- ----------- bubble game stuff ------------------------------------------
  300. sub calc_real_pos_given_arraypos($$$) {
  301. my ($cx, $cy, $player) = @_;
  302. ($POS{$player}{left_limit} + $cx * $BUBBLE_SIZE + odd($cy+$pdata{$player}{oddswap}) * $BUBBLE_SIZE/2,
  303. $POS{top_limit} + $cy * $ROW_SIZE);
  304. }
  305. sub calc_real_pos($$) {
  306. my ($b, $player) = @_;
  307. ($b->{'x'}, $b->{'y'}) = calc_real_pos_given_arraypos($b->{cx}, $b->{cy}, $player);
  308. }
  309. sub get_array_yclosest($) {
  310. my ($y) = @_;
  311. return int(($y-$POS{top_limit}+$ROW_SIZE/2) / $ROW_SIZE);
  312. }
  313. sub get_array_closest_pos($$$) { # roughly the opposite than previous function
  314. my ($x, $y, $player) = @_;
  315. my $ny = get_array_yclosest($y);
  316. my $nx = int(($x-$POS{$player}{left_limit}+$BUBBLE_SIZE/2 - odd($ny+$pdata{$player}{oddswap})*$BUBBLE_SIZE/2)/$BUBBLE_SIZE);
  317. return ($nx, $ny);
  318. }
  319. sub is_collision($$$) {
  320. my ($bub, $x, $y) = @_;
  321. my $DISTANCE_COLLISION_SQRED = sqr($BUBBLE_SIZE * 0.82);
  322. my $xs = sqr($bub->{x} - $x);
  323. ($xs > $DISTANCE_COLLISION_SQRED) and return 0;
  324. return ($xs + sqr($bub->{'y'} - $y)) < $DISTANCE_COLLISION_SQRED;
  325. }
  326. sub create_bubble_given_img($) {
  327. my ($img) = @_;
  328. my %bubble;
  329. ref($img) eq 'SDL::Surface' or die "<$img> seems to not be a valid image\n" . backtrace();
  330. $bubble{img} = $img;
  331. return \%bubble;
  332. }
  333. sub create_bubble(;$) {
  334. my ($p) = @_;
  335. my $b = create_bubble_given_img($bubbles_images[rand(@bubbles_images)]);
  336. is_1p_game() && $p && !member($b->{img}, map { $_->{img} } @{$sticked_bubbles{$p}})
  337. and return &create_bubble($p); #- prototype checking pb w/ recursion
  338. return $b;
  339. }
  340. sub iter_rowscols(&$) {
  341. my ($f, $oddswap) = @_;
  342. local $::row; local $::col;
  343. foreach $::row (0 .. 11) {
  344. foreach $::col (0 .. 7 - odd($::row+$oddswap)) {
  345. &$f;
  346. }
  347. }
  348. }
  349. sub each_index(&@) {
  350. my $f = shift;
  351. local $::i = 0;
  352. foreach (@_) {
  353. &$f($::i);
  354. $::i++;
  355. }
  356. }
  357. sub img2numb { my ($i, $f) = @_; each_index { $i eq $_ and $f = $::i } @bubbles_images; return defined($f) ? $f : '-' }
  358. #sub history {
  359. # foreach my $frame (@{$history{$_[0]}}[-10...1]) {
  360. # iter_rowscols {
  361. # if ($::col == 0) {
  362. # $::row == 0 or print "\n";
  363. # odd($::row+$frame->{oddswap}) and print " ";
  364. # }
  365. # foreach (@{$frame->{sticked}}) {
  366. # $_->[0] == $::col && $_->[1] == $::row or next;
  367. # print $_->[2];
  368. # goto non_void;
  369. # }
  370. # if ($frame->{sticking}[0] == $::col && $frame->{sticking}[1] == $::row) {
  371. # print "\033[D!$frame->{sticking}[2]";
  372. # goto non_void;
  373. # }
  374. # print '-';
  375. # non_void:
  376. # $::col+odd($::row+$frame->{oddswap}) < 7 and print " ";
  377. # } $frame->{oddswap};
  378. # print "\n\n";
  379. # }
  380. #}
  381. sub bubble_next_to($$$$$) {
  382. my ($x1, $y1, $x2, $y2, $player) = @_;
  383. $x1 == $x2 && $y1 == $y2 and die "bubble_next_to: assert failed -- same bubbles ($x1:$y1;$player)" . backtrace();
  384. # $x1 == $x2 && $y1 == $y2 and history($player), die "bubble_next_to: assert failed -- same bubbles ($x1:$y1;$player)" . backtrace();
  385. return to_bool((sqr($x1+odd($y1+$pdata{$player}{oddswap})*0.5 - ($x2+odd($y2+$pdata{$player}{oddswap})*0.5)) + sqr($y1 - $y2)) < 3);
  386. }
  387. sub next_positions($$) {
  388. my ($b, $player) = @_;
  389. my $validate_pos = sub {
  390. my ($x, $y) = @_;
  391. if_($x >= 0 && $x+odd($y+$pdata{$player}{oddswap}) <= 7 && $y >= 0 && $y >= $pdata{$player}{newrootlevel} && $y <= 11,
  392. [ $x, $y ]);
  393. };
  394. ($validate_pos->($b->{cx} - 1, $b->{cy}),
  395. $validate_pos->($b->{cx} + 1, $b->{cy}),
  396. $validate_pos->($b->{cx} - even($b->{cy}+$pdata{$player}{oddswap}), $b->{cy} - 1),
  397. $validate_pos->($b->{cx} - even($b->{cy}+$pdata{$player}{oddswap}), $b->{cy} + 1),
  398. $validate_pos->($b->{cx} - even($b->{cy}+$pdata{$player}{oddswap}) + 1, $b->{cy} - 1),
  399. $validate_pos->($b->{cx} - even($b->{cy}+$pdata{$player}{oddswap}) + 1, $b->{cy} + 1));
  400. }
  401. #- bubble ends its life sticked somewhere
  402. sub real_stick_bubble {
  403. my ($bubble, $xpos, $ypos, $player, $neighbours_ok) = @_;
  404. $bubble->{cx} = $xpos;
  405. $bubble->{cy} = $ypos;
  406. foreach (@{$sticked_bubbles{$player}}) {
  407. if (bubble_next_to($_->{cx}, $_->{cy}, $bubble->{cx}, $bubble->{cy}, $player)) {
  408. push @{$_->{neighbours}}, $bubble;
  409. $neighbours_ok or push @{$bubble->{neighbours}}, $_;
  410. }
  411. }
  412. push @{$sticked_bubbles{$player}}, $bubble;
  413. $bubble->{cy} == $pdata{$player}{newrootlevel} and push @{$root_bubbles{$player}}, $bubble;
  414. calc_real_pos($bubble, $player);
  415. put_image_to_background($bubble->{img}, $bubble->{'x'}, $bubble->{'y'});
  416. }
  417. sub destroy_bubbles {
  418. my ($player, @bubz) = @_;
  419. $graphics_level == 1 and return;
  420. foreach (@bubz) {
  421. $_->{speedx} = rand(3)-1.5;
  422. $_->{speedy} = -rand(4)-2;
  423. }
  424. push @{$exploding_bubble{$player}}, @bubz;
  425. }
  426. sub find_bubble_group($) {
  427. my ($b) = @_;
  428. my @neighbours = $b;
  429. my @group;
  430. while (1) {
  431. push @group, @neighbours;
  432. @neighbours = grep { $b->{img} eq $_->{img} && !member($_, @group) } fastuniq(map { @{$_->{neighbours}} } @neighbours);
  433. last if !@neighbours;
  434. }
  435. @group;
  436. }
  437. sub stick_bubble($$$$$) {
  438. my ($bubble, $xpos, $ypos, $player, $count_for_root) = @_;
  439. my @falling;
  440. my $need_redraw = 0;
  441. @{$bubble->{neighbours}} = grep { bubble_next_to($_->{cx}, $_->{cy}, $xpos, $ypos, $player) } @{$sticked_bubbles{$player}};
  442. #- in multiple chain reactions, it's possible that the group doesn't exist anymore in some rare situations :/
  443. exists $bubble->{chaindestx} && !@{$bubble->{neighbours}} and return;
  444. my @will_destroy = difference2([ find_bubble_group($bubble) ], [ $bubble ]);
  445. if (@will_destroy <= 1) {
  446. #- stick
  447. play_sound('stick');
  448. real_stick_bubble($bubble, $xpos, $ypos, $player, 1);
  449. $sticking_bubble{$player} = $bubble;
  450. $pdata{$player}{sticking_step} = 0;
  451. } else {
  452. #- destroy the group
  453. play_sound('destroy_group');
  454. foreach my $b (difference2([ fastuniq(map { @{$_->{neighbours}} } @will_destroy) ], \@will_destroy)) {
  455. @{$b->{neighbours}} = difference2($b->{neighbours}, \@will_destroy);
  456. }
  457. @{$sticked_bubbles{$player}} = difference2($sticked_bubbles{$player}, \@will_destroy);
  458. @{$root_bubbles{$player}} = difference2($root_bubbles{$player}, \@will_destroy);
  459. $bubble->{'cx'} = $xpos;
  460. $bubble->{'cy'} = $ypos;
  461. calc_real_pos($bubble, $player);
  462. destroy_bubbles($player, @will_destroy, $bubble);
  463. #- find falling bubbles
  464. $_->{mark} = 0 foreach @{$sticked_bubbles{$player}};
  465. my @still_sticked;
  466. my @neighbours = @{$root_bubbles{$player}};
  467. my $distance_to_root;
  468. while (1) {
  469. $_->{mark} = ++$distance_to_root foreach @neighbours;
  470. push @still_sticked, @neighbours;
  471. @neighbours = grep { $_->{mark} == 0 } map { @{$_->{neighbours}} } @neighbours;
  472. last if !@neighbours;
  473. }
  474. @falling = difference2($sticked_bubbles{$player}, \@still_sticked);
  475. @{$sticked_bubbles{$player}} = difference2($sticked_bubbles{$player}, \@falling);
  476. #- chain-reaction on falling bubbles
  477. if ($chainreaction) {
  478. my @falling_colors = map { $_->{img} } @falling;
  479. #- optimize a bit by first calculating bubbles that are next to another bubble of the same color
  480. my @grouped_bubbles = grep {
  481. my $b = $_;
  482. member($b->{img}, @falling_colors) && any { $b->{img} eq $_->{img} } @{$b->{neighbours}}
  483. } @{$sticked_bubbles{$player}};
  484. if (@grouped_bubbles) {
  485. #- all positions on which we can't chain-react
  486. my @occupied_positions = map { $_->{cy}*8 + $_->{cx} } @{$sticked_bubbles{$player}};
  487. push @occupied_positions, map { $_->{chaindestcy}*8 + $_->{chaindestcx} } @{$chains{$player}{falling_chained}};
  488. #- examine groups beginning at the root bubbles, for the case in which
  489. #- there is a group that will fall from an upper chain-reaction
  490. foreach my $pos (sort { $a->{mark} <=> $b->{mark} } @grouped_bubbles) {
  491. #- now examine if there is a free position to chain-react in it
  492. foreach my $npos (next_positions($pos, $player)) {
  493. #- we can't chain-react somewhere if it explodes a group already chained
  494. next if any { $pos->{cx} == $_->{cx} && $pos->{cy} == $_->{cy} }
  495. map { @{$chains{$player}{chained_bubbles}{$_}}} keys %{$chains{$player}{chained_bubbles}};
  496. if (!member($npos->[1]*8 + $npos->[0], @occupied_positions)) {
  497. #- find a suitable falling bubble for that free position
  498. foreach my $falling (@falling) {
  499. next if member($falling, @{$chains{$player}{falling_chained}});
  500. if ($pos->{img} eq $falling->{img}) {
  501. ($falling->{chaindestcx}, $falling->{chaindestcy}) = ($npos->[0], $npos->[1]);
  502. ($falling->{chaindestx}, $falling->{chaindesty}) = calc_real_pos_given_arraypos($npos->[0], $npos->[1], $player);
  503. push @{$chains{$player}{falling_chained}}, $falling;
  504. push @occupied_positions, $npos->[1]*8 + $npos->[0];
  505. #- next lines will allow not to chain-react on the same group from two different positions,
  506. #- and even to not chain-react on a group that will itself fall from a chain-reaction
  507. @{$falling->{neighbours}} = grep { bubble_next_to($_->{cx}, $_->{cy}, $npos->[0], $npos->[1], $player) } @{$sticked_bubbles{$player}};
  508. my @chained_bubbles = find_bubble_group($falling);
  509. $_->{mark} = 0 foreach @{$sticked_bubbles{$player}};
  510. my @still_sticked;
  511. my @neighbours = difference2($root_bubbles{$player}, \@chained_bubbles);
  512. while (1) {
  513. $_->{mark} = 1 foreach @neighbours;
  514. push @still_sticked, @neighbours;
  515. @neighbours = difference2([ grep { $_->{mark} == 0 } map { @{$_->{neighbours}} } @neighbours ],
  516. \@chained_bubbles);
  517. last if !@neighbours;
  518. }
  519. @{$chains{$player}{chained_bubbles}{$falling}} = difference2($sticked_bubbles{$player}, \@still_sticked);
  520. last;
  521. }
  522. }
  523. }
  524. }
  525. }
  526. }
  527. }
  528. #- prepare falling bubbles
  529. if ($graphics_level > 1) {
  530. my $max_cy_falling = fold_left { $::b->{cy} > $::a ? $::b->{cy} : $::a } 0, @falling; #- I have a fold_left in my prog! :-)
  531. my ($shift_on_same_line, $line) = (0, $max_cy_falling);
  532. foreach (sort { $b->{cy}*8 + $b->{cx} <=> $a->{cy}*8 + $a->{cx} } @falling) { #- sort bottom-to-up / right-to-left
  533. $line != $_->{cy} and $shift_on_same_line = 0;
  534. $line = $_->{cy};
  535. $_->{wait_fall} = ($max_cy_falling - $_->{cy})*5 + $shift_on_same_line;
  536. $shift_on_same_line++;
  537. $_->{speed} = 0;
  538. }
  539. push @{$falling_bubble{$player}}, @falling;
  540. }
  541. remove_images_from_background($player, @will_destroy, @falling);
  542. #- redraw neighbours because parts of neighbours have been erased by previous statement
  543. put_image_to_background($_->{img}, $_->{'x'}, $_->{'y'})
  544. foreach grep { !member($_, @will_destroy) && !member($_, @falling) } fastuniq(map { @{$_->{neighbours}} } @will_destroy, @falling);
  545. $need_redraw = 1;
  546. }
  547. if ($count_for_root) {
  548. $pdata{$player}{newroot}++;
  549. if ($pdata{$player}{newroot} == $TIME_APPEARS_NEW_ROOT-1) {
  550. $pdata{$player}{newroot_prelight} = 2;
  551. $pdata{$player}{newroot_prelight_step} = 0;
  552. }
  553. if ($pdata{$player}{newroot} == $TIME_APPEARS_NEW_ROOT) {
  554. $pdata{$player}{newroot_prelight} = 1;
  555. $pdata{$player}{newroot_prelight_step} = 0;
  556. }
  557. if ($pdata{$player}{newroot} > $TIME_APPEARS_NEW_ROOT) {
  558. $need_redraw = 1;
  559. $pdata{$player}{newroot_prelight} = 0;
  560. play_sound(is_1p_game() ? 'newroot_solo' : 'newroot');
  561. $pdata{$player}{newroot} = 0;
  562. $pdata{$player}{oddswap} = !$pdata{$player}{oddswap};
  563. remove_images_from_background($player, @{$sticked_bubbles{$player}});
  564. foreach (@{$sticked_bubbles{$player}}) {
  565. $_->{'cy'}++;
  566. calc_real_pos($_, $player);
  567. }
  568. foreach (@{$falling_bubble{$player}}) {
  569. exists $_->{chaindestx} or next;
  570. $_->{chaindestcy}++;
  571. $_->{chaindesty} += $ROW_SIZE;
  572. }
  573. put_allimages_to_background($player);
  574. if (is_1p_game()) {
  575. $pdata{$player}{newrootlevel}++;
  576. print_compressor();
  577. } else {
  578. @{$root_bubbles{$player}} = ();
  579. real_stick_bubble(create_bubble($player), $_, 0, $player, 0) foreach (0..(7-$pdata{$player}{oddswap}));
  580. }
  581. }
  582. }
  583. if ($need_redraw) {
  584. my $malus_val = @will_destroy + @falling - 2;
  585. $malus_val > 0 and $malus_val += ($player eq 'p1' ? $playermalus : -$playermalus);
  586. $malus_val < 0 and $malus_val = 0;
  587. $background->blit($apprects{$player}, $app, $apprects{$player});
  588. malus_change($malus_val, $player);
  589. }
  590. # push @{$history{$player}}, { sticking => [ $xpos, $ypos, img2numb($bubble->{img}) ],
  591. # oddswap => $pdata{$player}{oddswap},
  592. # sticked => [ map { [ $_->{cx}, $_->{cy}, img2numb($_->{img}) ] } @{$sticked_bubbles{$player}} ] };
  593. }
  594. sub print_next_bubble($$;$) {
  595. my ($img, $player, $not_on_top_next) = @_;
  596. put_image_to_background($img, $next_bubble{$player}{'x'}, $next_bubble{$player}{'y'});
  597. $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);
  598. }
  599. sub generate_new_bubble {
  600. my ($player, $img) = @_;
  601. $tobe_launched{$player} = $next_bubble{$player};
  602. $tobe_launched{$player}{'x'} = ($POS{$player}{left_limit}+$POS{$player}{right_limit})/2 - $BUBBLE_SIZE/2;
  603. $tobe_launched{$player}{'y'} = $POS{'initial_bubble_y'};
  604. $next_bubble{$player} = $img ? create_bubble_given_img($img) : create_bubble($player);
  605. $next_bubble{$player}{'x'} = $POS{$player}{left_limit}+$POS{next_bubble}{x}; #- necessary to keep coordinates, for verify_if_end
  606. $next_bubble{$player}{'y'} = $POS{next_bubble}{'y'};
  607. print_next_bubble($next_bubble{$player}{img}, $player);
  608. }
  609. #- ----------- game stuff -------------------------------------------------
  610. sub handle_graphics($) {
  611. my ($fun) = @_;
  612. iter_players {
  613. #- bubbles
  614. foreach ($launched_bubble{$::p}, if_($fun ne \&erase_image, $tobe_launched{$::p})) {
  615. $_ and $fun->($_->{img}, $_->{'x'}, $_->{'y'});
  616. }
  617. if ($fun eq \&put_image && $pdata{$::p}{newroot_prelight}) {
  618. if ($pdata{$::p}{newroot_prelight_step}++ > 30*$pdata{$::p}{newroot_prelight}) {
  619. $pdata{$::p}{newroot_prelight_step} = 0;
  620. }
  621. if ($pdata{$::p}{newroot_prelight_step} <= 8) {
  622. my $hurry_overwritten = 0;
  623. foreach my $b (@{$sticked_bubbles{$::p}}) {
  624. next if ($graphics_level == 1 && $b->{'cy'} > 0); #- in low graphics, only prelight first row
  625. $b->{'cx'}+1 == $pdata{$::p}{newroot_prelight_step} and put_image($b->{img}, $b->{'x'}, $b->{'y'});
  626. $b->{'cx'} == $pdata{$::p}{newroot_prelight_step} and put_image($bubbles_anim{white}, $b->{'x'}, $b->{'y'});
  627. $b->{'cy'} > 6 and $hurry_overwritten = 1;
  628. }
  629. $hurry_overwritten && $pdata{$::p}{hurry_save_img} and print_hurry($::p, 1); #- hurry was potentially overwritten
  630. }
  631. }
  632. if ($sticking_bubble{$::p} && $graphics_level > 1) {
  633. my $b = $sticking_bubble{$::p};
  634. if ($fun eq \&erase_image) {
  635. put_image($b->{img}, $b->{'x'}, $b->{'y'});
  636. } else {
  637. if ($pdata{$::p}{sticking_step} == @{$bubbles_anim{stick}}) {
  638. $sticking_bubble{$::p} = undef;
  639. } else {
  640. put_image(${$bubbles_anim{stick}}[$pdata{$::p}{sticking_step}], $b->{'x'}, $b->{'y'});
  641. if ($pdata{$::p}{sticking_step_slowdown}) {
  642. $pdata{$::p}{sticking_step}++;
  643. $pdata{$::p}{sticking_step_slowdown} = 0;
  644. } else {
  645. $pdata{$::p}{sticking_step_slowdown}++;
  646. }
  647. }
  648. }
  649. }
  650. #- shooter
  651. if ($graphics_level > 1) {
  652. my $num = int($angle{$::p}*$CANON_ROTATIONS_NB/($PI/2) + 0.5)-$CANON_ROTATIONS_NB;
  653. $fun->($canon{img}{$num},
  654. ($POS{$::p}{left_limit}+$POS{$::p}{right_limit})/2 - 50 + $canon{data}{$num}->[0],
  655. $POS{'initial_bubble_y'} + 16 - 50 + $canon{data}{$num}->[1] ); #- 50/50 stand for half width/height of gfx/shoot/base.png
  656. } else {
  657. $fun->($shooter,
  658. ($POS{$::p}{left_limit}+$POS{$::p}{right_limit})/2 - 1 + 60*cos($angle{$::p}), #- 1 for $shooter->width/2
  659. $POS{'initial_bubble_y'} + 16 - 1 - 60*sin($angle{$::p})); #- 1/1 stand for half width/height of gfx/shoot/shooter.png
  660. }
  661. #- penguins
  662. if ($graphics_level == 3) {
  663. $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'});
  664. }
  665. #- moving bubbles --> I want them on top of the rest
  666. foreach (@{$malus_bubble{$::p}}, @{$falling_bubble{$::p}}, @{$exploding_bubble{$::p}}) {
  667. $fun->($_->{img}, $_->{'x'}, $_->{'y'});
  668. }
  669. };
  670. }
  671. #- extract it from "handle_graphics" to optimize a bit animations
  672. sub malus_change($$) {
  673. my ($numb, $player) = @_;
  674. return if $numb == 0 || is_1p_game();
  675. if ($numb >= 0) {
  676. $player = ($player eq 'p1') ? 'p2' : 'p1';
  677. }
  678. my $update_malus = sub($) {
  679. my ($fun) = @_;
  680. my $malus = $pdata{$player}{malus};
  681. my $y_shift = 0;
  682. while ($malus > 0) {
  683. my $print = sub($) {
  684. my ($type) = @_;
  685. $fun->($type, $POS{$player}{malus_x} - $type->width/2, $POS{'malus_y'} - $y_shift - $type->height);
  686. $y_shift += $type->height - 1;
  687. };
  688. if ($malus >= 7) {
  689. $print->($malus_gfx{tomate});
  690. $malus -= 7;
  691. } else {
  692. $print->($malus_gfx{banane});
  693. $malus--;
  694. }
  695. }
  696. };
  697. $update_malus->(\&remove_image_from_background);
  698. $pdata{$player}{malus} += $numb;
  699. $update_malus->(\&put_image_to_background);
  700. }
  701. sub print_compressor() {
  702. my $x = $POS{compressor_xpos};
  703. my $y = $POS{top_limit} + $pdata{$PLAYERS[0]}{newrootlevel} * $ROW_SIZE;
  704. my ($comp_main, $comp_ext) = ($imgbin{compressor_main}, $imgbin{compressor_ext});
  705. my $drect = SDL::Rect->new(-width => $comp_main->width, -height => $y,
  706. -x => $x - $comp_main->width/2, '-y' => 0);
  707. $background_orig->blit($drect, $background, $drect);
  708. $display_on_app_disabled or $background_orig->blit($drect, $app, $drect);
  709. push @update_rects, $drect;
  710. put_image_to_background($comp_main, $x - $comp_main->width/2, $y - $comp_main->height);
  711. $y -= $comp_main->height - 3;
  712. while ($y > 0) {
  713. put_image_to_background($comp_ext, $x - $comp_ext->width/2, $y - $comp_ext->height);
  714. $y -= $comp_ext->height;
  715. }
  716. }
  717. sub handle_game_events() {
  718. $event->pump;
  719. if ($event->poll != 0) {
  720. if ($event->type == SDL_KEYDOWN) {
  721. my $keypressed = $event->key_sym;
  722. iter_players {
  723. my $pkey = is_1p_game() ? 'p2' : $::p;
  724. foreach (qw(left right fire center)) {
  725. $keypressed == $KEYS->{$pkey}{$_} and $actions{$::p}{$_} = 1, last;
  726. }
  727. };
  728. if ($keypressed == $KEYS->{misc}{fs}) {
  729. $fullscreen = !$fullscreen;
  730. $app->fullscreen;
  731. }
  732. if ($keypressed == SDLK_PAUSE) {
  733. play_sound('pause');
  734. $mixer_enabled && $mixer and $mixer->pause_music;
  735. my $back_saved = switch_image_on_background($imgbin{back_paused}, 0, 0, 1);
  736. pause_label:
  737. while (1) {
  738. my ($index, $side) = (0, 1);
  739. while ($index || $side == 1) {
  740. put_image(${$imgbin{paused}}[$index], $POS_1P{pause_clip}{x}, $POS_1P{pause_clip}{'y'});
  741. $app->flip;
  742. foreach (1..80) {
  743. $app->delay(20);
  744. $event->pump;
  745. if ($event->poll != 0 && $event->type == SDL_KEYDOWN) {
  746. last pause_label if $event->key_sym != $KEYS->{misc}{fs};
  747. $fullscreen = !$fullscreen;
  748. $app->fullscreen;
  749. }
  750. }
  751. rand() < 0.2 and play_sound('snore');
  752. $index += $side;
  753. if ($index == @{$imgbin{paused}}) {
  754. $side = -1;
  755. $index -= 2;
  756. }
  757. }
  758. }
  759. switch_image_on_background($back_saved, 0, 0);
  760. iter_players { $actions{$::p}{left} = 0; $actions{$::p}{right} = 0; };
  761. $mixer_enabled && $mixer and $mixer->resume_music;
  762. $event->pump while $event->poll != 0;
  763. $app->flip;
  764. }
  765. }
  766. if ($event->type == SDL_KEYUP) {
  767. my $keypressed = $event->key_sym;
  768. iter_players {
  769. my $pkey = is_1p_game() ? 'p2' : $::p;
  770. foreach (qw(left right fire center)) {
  771. $keypressed == $KEYS->{$pkey}{$_} and $actions{$::p}{$_} = 0, last;
  772. }
  773. }
  774. }
  775. if ($event->type == SDL_QUIT ||
  776. $event->type == SDL_KEYDOWN && $event->key_sym == SDLK_ESCAPE) {
  777. die 'quit';
  778. }
  779. }
  780. }
  781. sub print_scores($) {
  782. my ($surface) = @_; #- TODO all this function has hardcoded coordinates
  783. my $drect = SDL::Rect->new(-width => 120, -height => 30, -x => 260, '-y' => 428);
  784. $background_orig->blit($drect, $surface, $drect);
  785. push @update_rects, $drect;
  786. iter_players_ { #- sometimes called from within a iter_players so...
  787. $surface->print($POS{$::p_}{scoresx}-SDL_TEXTWIDTH($pdata{$::p_}{score})/2, $POS{scoresy}, $pdata{$::p_}{score});
  788. };
  789. }
  790. sub verify_if_end {
  791. iter_players {
  792. if (any { $_->{cy} > 11 } @{$sticked_bubbles{$::p}}) {
  793. $pdata{state} = "lost $::p";
  794. play_sound('lose');
  795. $pdata{$::p}{ping_right}{state} = 'lose';
  796. $pdata{$::p}{ping_right}{img} = 0;
  797. if (!is_1p_game()) {
  798. my $won = $::p eq 'p1' ? 'p2' : 'p1';
  799. $pdata{$won}{score}++;
  800. $pdata{$won}{ping_right}{state} = 'win';
  801. $pdata{$won}{ping_right}{img} = 0;
  802. print_scores($background); print_scores($app);
  803. }
  804. foreach ($launched_bubble{$::p}, $tobe_launched{$::p}, @{$malus_bubble{$::p}}) {
  805. $_ or next;
  806. $_->{img} = $bubbles_anim{lose};
  807. $_->{'x'}--;
  808. $_->{'y'}--;
  809. }
  810. iter_players_ {
  811. remove_hurry($::p_);
  812. @{$falling_bubble{$::p_}} = grep { !exists $_->{chaindestx} } @{$falling_bubble{$::p_}};
  813. };
  814. print_next_bubble($bubbles_anim{lose}, $::p, 1);
  815. iter_players_ {
  816. @{$sticked_bubbles{$::p_}} = sort { $b->{'cx'}+$b->{'cy'}*10 <=> $a->{'cx'}+$a->{'cy'}*10 } @{$sticked_bubbles{$::p_}};
  817. $sticking_bubble{$::p_} = undef;
  818. $launched_bubble{$::p_} and destroy_bubbles($::p_, $launched_bubble{$::p_});
  819. $launched_bubble{$::p_} = undef;
  820. $pdata{$::p_}{newroot_prelight} = 0;
  821. };
  822. @{$malus_bubble{$::p}} = ();
  823. }
  824. };
  825. if (is_1p_game() && @{$sticked_bubbles{$PLAYERS[0]}} == 0) {
  826. put_image_to_background($imgbin{win_panel_1player}, $POS{centerpanel}{x}, $POS{centerpanel}{'y'});
  827. $pdata{state} = "won $PLAYERS[0]";
  828. $pdata{$PLAYERS[0]}{ping_right}{state} = 'win';
  829. $pdata{$PLAYERS[0]}{ping_right}{img} = 0;
  830. $levels{current} and $levels{current}++;
  831. if ($levels{current} && !$levels{$levels{current}}) {
  832. $levels{current} = 'WON';
  833. @{$falling_bubble{$PLAYERS[0]}} = @{$exploding_bubble{$PLAYERS[0]}} = ();
  834. die 'quit';
  835. }
  836. }
  837. }
  838. sub print_hurry($;$) {
  839. my ($player, $dont_save_background) = @_;
  840. my $t = switch_image_on_background($imgbin{hurry}{$player}, $POS{$player}{left_limit} + $POS{hurry}{x}, $POS{hurry}{'y'}, 1);
  841. $dont_save_background or $pdata{$player}{hurry_save_img} = $t;
  842. }
  843. sub remove_hurry($) {
  844. my ($player) = @_;
  845. $pdata{$player}{hurry_save_img} and
  846. switch_image_on_background($pdata{$player}{hurry_save_img}, $POS{$player}{left_limit} + $POS{hurry}{x}, $POS{hurry}{'y'});
  847. $pdata{$player}{hurry_save_img} = undef;
  848. }
  849. #- ----------- mainloop helper --------------------------------------------
  850. sub update_game() {
  851. if ($pdata{state} eq 'game') {
  852. handle_game_events();
  853. iter_players {
  854. $actions{$::p}{left} and $angle{$::p} += $LAUNCHER_SPEED;
  855. $actions{$::p}{right} and $angle{$::p} -= $LAUNCHER_SPEED;
  856. if ($actions{$::p}{center}) {
  857. if ($angle{$::p} >= $PI/2 - $LAUNCHER_SPEED
  858. && $angle{$::p} <= $PI/2 + $LAUNCHER_SPEED) {
  859. $angle{$::p} = $PI/2;
  860. } else {
  861. $angle{$::p} += ($angle{$::p} < $PI/2) ? $LAUNCHER_SPEED : -$LAUNCHER_SPEED;
  862. }
  863. }
  864. ($angle{$::p} < 0.1) and $angle{$::p} = 0.1;
  865. ($angle{$::p} > $PI-0.1) and $angle{$::p} = $PI-0.1;
  866. $pdata{$::p}{hurry}++;
  867. if ($pdata{$::p}{hurry} > $TIME_HURRY_WARN) {
  868. my $oddness = odd(int(($pdata{$::p}{hurry}-$TIME_HURRY_WARN)/(500/$TARGET_ANIM_SPEED))+1);
  869. if ($pdata{$::p}{hurry_oddness} xor $oddness) {
  870. if ($oddness) {
  871. play_sound('hurry');
  872. print_hurry($::p);
  873. } else {
  874. remove_hurry($::p)
  875. }
  876. }
  877. $pdata{$::p}{hurry_oddness} = $oddness;
  878. }
  879. if (($actions{$::p}{fire} || $pdata{$::p}{hurry} == $TIME_HURRY_MAX)
  880. && !$launched_bubble{$::p}
  881. && !(any { exists $_->{chaindestx} } @{$falling_bubble{$::p}})
  882. && !@{$malus_bubble{$::p}}) {
  883. play_sound('launch');
  884. $launched_bubble{$::p} = $tobe_launched{$::p};
  885. $launched_bubble{$::p}->{direction} = $angle{$::p};
  886. $tobe_launched{$::p} = undef;
  887. $actions{$::p}{fire} = 0;
  888. $actions{$::p}{hadfire} = 1;
  889. $pdata{$::p}{hurry} = 0;
  890. remove_hurry($::p);
  891. }
  892. if ($launched_bubble{$::p}) {
  893. $launched_bubble{$::p}->{'x_old'} = $launched_bubble{$::p}->{'x'}; # save coordinates for potential collision
  894. $launched_bubble{$::p}->{'y_old'} = $launched_bubble{$::p}->{'y'};
  895. $launched_bubble{$::p}->{'x'} += $BUBBLE_SPEED * cos($launched_bubble{$::p}->{direction});
  896. $launched_bubble{$::p}->{'y'} -= $BUBBLE_SPEED * sin($launched_bubble{$::p}->{direction});
  897. if ($launched_bubble{$::p}->{x} < $POS{$::p}{left_limit}) {
  898. play_sound('rebound');
  899. $launched_bubble{$::p}->{x} = 2 * $POS{$::p}{left_limit} - $launched_bubble{$::p}->{x};
  900. $launched_bubble{$::p}->{direction} -= 2*($launched_bubble{$::p}->{direction}-$PI/2);
  901. }
  902. if ($launched_bubble{$::p}->{x} > $POS{$::p}{right_limit} - $BUBBLE_SIZE) {
  903. play_sound('rebound');
  904. $launched_bubble{$::p}->{x} = 2 * ($POS{$::p}{right_limit} - $BUBBLE_SIZE) - $launched_bubble{$::p}->{x};
  905. $launched_bubble{$::p}->{direction} += 2*($PI/2-$launched_bubble{$::p}->{direction});
  906. }
  907. if ($launched_bubble{$::p}->{'y'} <= $POS{top_limit} + $pdata{$::p}{newrootlevel} * $ROW_SIZE) {
  908. my ($cx, $cy) = get_array_closest_pos($launched_bubble{$::p}->{x}, $launched_bubble{$::p}->{'y'}, $::p);
  909. stick_bubble($launched_bubble{$::p}, $cx, $cy, $::p, 1);
  910. $launched_bubble{$::p} = undef;
  911. } else {
  912. foreach (@{$sticked_bubbles{$::p}}) {
  913. if (is_collision($launched_bubble{$::p}, $_->{'x'}, $_->{'y'})) {
  914. my ($cx, $cy) = get_array_closest_pos(($launched_bubble{$::p}->{'x_old'}+$launched_bubble{$::p}->{'x'})/2,
  915. ($launched_bubble{$::p}->{'y_old'}+$launched_bubble{$::p}->{'y'})/2,
  916. $::p);
  917. stick_bubble($launched_bubble{$::p}, $cx, $cy, $::p, 1);
  918. $launched_bubble{$::p} = undef;
  919. #- malus generation
  920. if (!any { $_->{chaindestx} } @{$falling_bubble{$::p}}) {
  921. $pdata{$::p}{malus} > 0 and play_sound('malus');
  922. while ($pdata{$::p}{malus} > 0 && @{$malus_bubble{$::p}} < 7) {
  923. my $b = create_bubble($::p);
  924. do {
  925. $b->{'cx'} = int(rand(7));
  926. } while (member($b->{'cx'}, map { $_->{'cx'} } @{$malus_bubble{$::p}}));
  927. $b->{'cy'} = 12;
  928. $b->{'stick_y'} = 0;
  929. foreach (@{$sticked_bubbles{$::p}}) {
  930. if ($_->{'cy'} > $b->{'stick_y'}) {
  931. if ($_->{'cx'} == $b->{'cx'}
  932. || odd($_->{'cy'}+$pdata{$::p}{oddswap}) && ($_->{'cx'}+1) == $b->{'cx'}) {
  933. $b->{'stick_y'} = $_->{'cy'};
  934. }
  935. }
  936. }
  937. $b->{'stick_y'}++;
  938. calc_real_pos($b, $::p);
  939. push @{$malus_bubble{$::p}}, $b;
  940. malus_change(-1, $::p);
  941. }
  942. #- sort them and shift them
  943. @{$malus_bubble{$::p}} = sort { $a->{'cx'} <=> $b->{'cx'} } @{$malus_bubble{$::p}};
  944. my $shifting = 0;
  945. $_->{'y'} += ($shifting+=7)+int(rand(20)) foreach @{$malus_bubble{$::p}};
  946. }
  947. last;
  948. }
  949. }
  950. }
  951. }
  952. !$tobe_launched{$::p} and generate_new_bubble($::p);
  953. if (!$actions{$::p}{left} && !$actions{$::p}{right} && !$actions{$::p}{hadfire}) {
  954. $pdata{$::p}{sleeping}++;
  955. } else {
  956. $pdata{$::p}{sleeping} = 0;
  957. $pdata{$::p}{ping_right}{movelatency} = -20;
  958. }
  959. if ($pdata{$::p}{sleeping} > $TIMEOUT_PINGUIN_SLEEP) {
  960. $pdata{$::p}{ping_right}{state} = 'sleep';
  961. } elsif ($pdata{$::p}{ping_right}{state} eq 'sleep') {
  962. $pdata{$::p}{ping_right}{state} = 'normal';
  963. }
  964. if ($pdata{$::p}{ping_right}{state} eq 'right' && !($actions{$::p}{right})
  965. || $pdata{$::p}{ping_right}{state} eq 'left' && !($actions{$::p}{left})
  966. || $pdata{$::p}{ping_right}{state} eq 'action' && ($pdata{$::p}{ping_right}{actionlatency}++ > 5)) {
  967. $pdata{$::p}{ping_right}{state} = 'normal';
  968. }
  969. $actions{$::p}{right} and $pdata{$::p}{ping_right}{state} = 'right';
  970. $actions{$::p}{left} and $pdata{$::p}{ping_right}{state} = 'left';
  971. if ($actions{$::p}{hadfire}) {
  972. $pdata{$::p}{ping_right}{state} = 'action';
  973. $actions{$::p}{hadfire} = 0;
  974. $pdata{$::p}{ping_right}{actionlatency} = 0;
  975. }
  976. if ($pdata{$::p}{ping_right}{state} eq 'normal' && ($pdata{$::p}{ping_right}{movelatency}++ > 10)) {
  977. $pdata{$::p}{ping_right}{movelatency} = 0;
  978. rand() < 0.4 and $pdata{$::p}{ping_right}{img} = int(rand(@{$pinguin{$::p}{normal}}));
  979. }
  980. if ($pdata{$::p}{ping_right}{img} >= @{$pinguin{$::p}{$pdata{$::p}{ping_right}{state}}}) {
  981. $pdata{$::p}{ping_right}{img} = 0;
  982. }
  983. };
  984. verify_if_end();
  985. } elsif ($pdata{state} =~ /lost (.*)/) {
  986. my $lost_slowdown if 0; #- ``if 0'' is Perl's way of doing what C calls ``static local variables''
  987. if ($lost_slowdown++ > 1) {
  988. $lost_slowdown = 0;
  989. iter_players {
  990. if ($::p eq $1) {
  991. if (@{$sticked_bubbles{$::p}}) {
  992. my $b = shift @{$sticked_bubbles{$::p}};
  993. put_image_to_background($bubbles_anim{lose}, --$b->{'x'}, --$b->{'y'});
  994. # my $line = $b->{'cy'};
  995. # while (@{$sticked_bubbles{$::p}} && ${$sticked_bubbles{$::p}}[0]->{'cy'} == $line) {
  996. # my $b = shift @{$sticked_bubbles{$::p}};
  997. # put_image_to_background($bubbles_anim{lose}, --$b->{'x'}, --$b->{'y'});
  998. # }
  999. if (@{$sticked_bubbles{$::p}} == 0) {
  1000. $graphics_level == 1 and put_image($imgbin{win}{$::p eq 'p1' ? 'p2' : 'p1'}, $POS{centerpanel}{x}, $POS{centerpanel}{'y'});
  1001. if (is_1p_game()) {
  1002. put_image($imgbin{lose}, $POS{centerpanel}{'x'}, $POS{centerpanel}{'y'});
  1003. play_sound('noh');
  1004. }
  1005. }
  1006. if (!@{$sticked_bubbles{$::p}}) {
  1007. $event->pump while $event->poll != 0;
  1008. }
  1009. } else {
  1010. $event->pump;
  1011. die 'new_game' if $event->poll != 0 && $event->type == SDL_KEYDOWN;
  1012. }
  1013. } else {
  1014. if (@{$sticked_bubbles{$::p}} && $graphics_level > 1) {
  1015. my $b = shift @{$sticked_bubbles{$::p}};
  1016. destroy_bubbles($::p, $b);
  1017. remove_image_from_background($b->{img}, $b->{'x'}, $b->{'y'});
  1018. #- be sure to redraw at least upper line
  1019. foreach (@{$b->{neighbours}}) {
  1020. next if !member($_, @{$sticked_bubbles{$::p}});
  1021. put_image_to_background($_->{img}, $_->{'x'}, $_->{'y'});
  1022. }
  1023. }
  1024. }
  1025. };
  1026. }
  1027. } elsif ($pdata{state} =~ /won (.*)/) {
  1028. if (@{$exploding_bubble{$1}} == 0) {
  1029. $event->pump;
  1030. die 'new_game' if $event->poll != 0 && $event->type == SDL_KEYDOWN;
  1031. }
  1032. } else {
  1033. die "oops unhandled game state ($pdata{state})\n";
  1034. }
  1035. #- things that need to be updated in all states of the game
  1036. iter_players {
  1037. my $malus_end = [];
  1038. foreach my $b (@{$malus_bubble{$::p}}) {
  1039. $b->{'y'} -= $MALUS_BUBBLE_SPEED;
  1040. if (get_array_yclosest($b->{'y'}) <= $b->{'stick_y'}) {
  1041. real_stick_bubble($b, $b->{'cx'}, $b->{'stick_y'}, $::p, 0);
  1042. push @$malus_end, $b;
  1043. }
  1044. }
  1045. @$malus_end and @{$malus_bubble{$::p}} = difference2($malus_bubble{$::p}, $malus_end);
  1046. my $falling_end = [];
  1047. foreach my $b (@{$falling_bubble{$::p}}) {
  1048. if ($b->{wait_fall}) {
  1049. $b->{wait_fall}--;
  1050. } else {
  1051. if (exists $b->{chaindestx} && ($b->{'y'} > 375 || $b->{chaingoingup})) {
  1052. my $acceleration = $FREE_FALL_CONSTANT*3;
  1053. if (!$b->{chaingoingup}) {
  1054. my $time_to_zero = $b->{speed}/$acceleration;
  1055. my $distance_to_zero = $b->{speed} * ($b->{speed}/$acceleration + 1) / 2;
  1056. my $time_to_destination = (-1 + sqrt(1 + 8/$acceleration*($b->{'y'}-$b->{chaindesty}+$distance_to_zero))) / 2;
  1057. $b->{speedx} = ($b->{chaindestx} - $b->{x}) / ($time_to_zero + $time_to_destination);
  1058. $b->{chaingoingup} = 1;
  1059. }
  1060. $b->{speed} -= $acceleration;
  1061. $b->{x} += $b->{speedx};
  1062. if (abs($b->{x} - $b->{chaindestx}) < abs($b->{speedx})) {
  1063. $b->{'x'} = $b->{chaindestx};
  1064. $b->{speedx} = 0;
  1065. }
  1066. $b->{'y'} += $b->{speed};
  1067. $b->{'y'} < $b->{chaindesty} and push @$falling_end, $b;
  1068. } else {
  1069. $b->{'y'} += $b->{speed};
  1070. $b->{speed} += $FREE_FALL_CONSTANT;
  1071. }
  1072. }
  1073. $b->{'y'} > 470 && !exists $b->{chaindestx} and push @$falling_end, $b;
  1074. }
  1075. @$falling_end and @{$falling_bubble{$::p}} = difference2($falling_bubble{$::p}, $falling_end);
  1076. foreach (@$falling_end) {
  1077. exists $_->{chaindestx} or next;
  1078. @{$chains{$::p}{falling_chained}} = difference2($chains{$::p}{falling_chained}, [ $_ ]);
  1079. delete $chains{$::p}{chained_bubbles}{$_};
  1080. stick_bubble($_, $_->{chaindestcx}, $_->{chaindestcy}, $::p, 0);
  1081. }
  1082. my $exploding_end = [];
  1083. foreach my $b (@{$exploding_bubble{$::p}}) {
  1084. $b->{'x'} += $b->{speedx};
  1085. $b->{'y'} += $b->{speedy};
  1086. $b->{speedy} += $FREE_FALL_CONSTANT;
  1087. push @$exploding_end, $b if $b->{'y'} > 470;
  1088. }
  1089. if (@$exploding_end) {
  1090. @{$exploding_bubble{$::p}} = difference2($exploding_bubble{$::p}, $exploding_end);
  1091. if ($pdata{state} =~ /lost (.*)/ && $::p ne $1 && !is_1p_game()
  1092. && !@{$exploding_bubble{$::p}} && !@{$sticked_bubbles{$::p}}) {
  1093. put_image($imgbin{win}{$::p}, $POS{centerpanel}{'x'}, $POS{centerpanel}{'y'});
  1094. }
  1095. }
  1096. if (member($pdata{$::p}{ping_right}{state}, qw(win lose)) && ($pdata{$::p}{ping_right}{movelatency}++ > 5)) {
  1097. my $state = $pdata{$::p}{ping_right}{state};
  1098. $pdata{$::p}{ping_right}{movelatency} = 0;
  1099. $pdata{$::p}{ping_right}{img}++;
  1100. $pdata{$::p}{ping_right}{img} == @{$pinguin{$::p}{$state}}
  1101. and $pdata{$::p}{ping_right}{img} = $pinguin{$::p}{"$state".'_roll_back_index'};
  1102. }
  1103. };
  1104. #- advance playlist when the current song finished
  1105. $mixer_enabled && $mixer && @playlist && !$mixer->playing_music and play_music('dummy', 0);
  1106. }
  1107. #- ----------- init stuff -------------------------------------------------
  1108. sub restart_app() {
  1109. $app = SDL::App->new(-flags => $sdl_flags | ($fullscreen ? SDL_FULLSCREEN : 0), -title => 'Frozen-Bubble', -width => 640, -height => 480);
  1110. }
  1111. sub print_step($) {
  1112. my ($txt) = @_;
  1113. print $txt;
  1114. my $step if 0; $step ||= 0;
  1115. put_image($imgbin{loading_step}, 100 + $step*12, 10);
  1116. $app->flip;
  1117. $step++;
  1118. }
  1119. sub load_levelset {
  1120. my ($levelset_name) = @_;
  1121. -e $levelset_name or die "No such levelset ($levelset_name).\n";
  1122. $loaded_levelset = $levelset_name;
  1123. my $row_numb = 0;
  1124. my $curr_level = $levels{current};
  1125. %levels = ();
  1126. $levels{current} = $curr_level;
  1127. $lev_number = 1;
  1128. foreach my $line (cat_($levelset_name)) {
  1129. if ($line !~ /\S/) {
  1130. if ($row_numb) {
  1131. $lev_number++;
  1132. $row_numb = 0;
  1133. }
  1134. } else {
  1135. my $col_numb = 0;
  1136. foreach (split ' ', $line) {
  1137. /-/ or push @{$levels{$lev_number}}, { cx => $col_numb, cy => $row_numb, img_num => $_ };
  1138. $col_numb++;
  1139. }
  1140. $row_numb++;
  1141. }
  1142. }
  1143. }
  1144. sub init_game() {
  1145. -r "$FPATH/$_" or die "[*ERROR*] the datafiles seem to be missing! (could not read `$FPATH/$_')\n".
  1146. " The datafiles need to go to `$FPATH'.\n"
  1147. foreach qw(gfx snd data);
  1148. print '[SDL Init] ';
  1149. restart_app();
  1150. $font = SDL::Font->new("$FPATH/gfx/font.png");
  1151. $apprects{main} = SDL::Rect->new(-width => $app->width, -height => $app->height);
  1152. $event = SDL::Event->new;
  1153. $event->set_unicode(1);
  1154. SDL::Cursor::show(0);
  1155. $total_time = $app->ticks;
  1156. $imgbin{loading} = add_image('loading.png');
  1157. put_image($imgbin{loading}, 10, 10);
  1158. $app->print(30, 60, uc("tip! use '-h' on command-line to get more options"));
  1159. $app->flip;
  1160. $imgbin{loading_step} = add_image('loading_step.png');
  1161. print_step('[Graphics');
  1162. $imgbin{back_2p} = SDL::Surface->new(-name => "$FPATH/gfx/backgrnd.png");
  1163. $imgbin{back_1p} = SDL::Surface->new(-name => "$FPATH/gfx/back_one_player.png");
  1164. $background = SDL::Surface->new(-width => $app->width, -height => $app->height, -depth => 32, -Amask => '0 but true');
  1165. $background_orig = SDL::Surface->new(-width => $app->width, -height => $app->height, -depth => 32, -Amask => '0 but true');
  1166. $imgbin{backstartfull} = SDL::Surface->new(-name => "$FPATH/gfx/menu/back_start.png");
  1167. print_step('.');
  1168. add_bubble_image('balls/bubble-'.($colourblind && 'colourblind-')."$_.gif") foreach (1..8);
  1169. $bubbles_anim{white} = add_image("balls/bubble_prelight.png");
  1170. $bubbles_anim{lose} = add_image("balls/bubble_lose.png");
  1171. $bubbles_anim{on_top_next} = add_image("on_top_next.png");
  1172. push @{$bubbles_anim{stick}}, add_image("balls/stick_effect_$_.png") foreach (0..6);
  1173. $shooter = add_image("shoot/shooter.png");
  1174. $canon{img}{$_} = add_image("shoot/base_$_.png") foreach (-$CANON_ROTATIONS_NB..$CANON_ROTATIONS_NB);
  1175. /(\S+) (\S+) (\S+)/ and $canon{data}{$1} = [ $2, $3 ] foreach cat_("$FPATH/gfx/shoot/data"); #- quantity of shifting needed (because of crop reduction)
  1176. $malus_gfx{banane} = add_image('banane.png');
  1177. $malus_gfx{tomate} = add_image('tomate.png');
  1178. print_step('.');
  1179. push @{$imgbin{paused}}, add_image("pause_$_.png") foreach 1..5;
  1180. $imgbin{back_paused} = add_image('back_paused.png');
  1181. $imgbin{lose} = add_image('lose_panel.png');
  1182. $imgbin{win_panel_1player} = add_image('win_panel_1player.png');
  1183. $imgbin{compressor_main} = add_image('compressor_main.png');
  1184. $imgbin{compressor_ext} = add_image('compressor_ext.png');
  1185. $imgbin{txt_1pgame_off} = add_image('menu/txt_1pgame_off.png');
  1186. $imgbin{txt_1pgame_over} = add_image('menu/txt_1pgame_over.png');
  1187. $imgbin{txt_2pgame_off} = add_image('menu/txt_2pgame_off.png');
  1188. $imgbin{txt_2pgame_over} = add_image('menu/txt_2pgame_over.png');
  1189. $imgbin{txt_editor_off} = add_image('menu/txt_editor_off.png');
  1190. $imgbin{txt_editor_over} = add_image('menu/txt_editor_over.png');
  1191. $imgbin{txt_fullscreen_off} = add_image('menu/txt_fullscreen_off.png');
  1192. $imgbin{txt_fullscreen_over} = add_image('menu/txt_fullscreen_over.png');
  1193. $imgbin{txt_fullscreen_act_off} = add_image('menu/txt_fullscreen_act_off.png');
  1194. $imgbin{txt_fullscreen_act_over} = add_image('menu/txt_fullscreen_act_over.png');
  1195. $imgbin{txt_keys_off} = add_image('menu/txt_keys_off.png');
  1196. $imgbin{txt_keys_over} = add_image('menu/txt_keys_over.png');
  1197. $imgbin{txt_sound_off} = add_image('menu/txt_sound_off.png');
  1198. $imgbin{txt_sound_over} = add_image('menu/txt_sound_over.png');
  1199. $imgbin{txt_sound_act_off} = add_image('menu/txt_sound_act_off.png');
  1200. $imgbin{txt_sound_act_over} = add_image('menu/txt_sound_act_over.png');
  1201. $imgbin{txt_graphics_1_off} = add_image('menu/txt_graphics_1_off.png');
  1202. $imgbin{txt_graphics_1_over} = add_image('menu/txt_graphics_1_over.png');
  1203. $imgbin{txt_graphics_2_off} = add_image('menu/txt_graphics_2_off.png');
  1204. $imgbin{txt_graphics_2_over} = add_image('menu/txt_graphics_2_over.png');
  1205. $imgbin{txt_graphics_3_off} = add_image('menu/txt_graphics_3_off.png');
  1206. $imgbin{txt_graphics_3_over} = add_image('menu/txt_graphics_3_over.png');
  1207. $imgbin{txt_highscores_off} = add_image('menu/txt_highscores_off.png');
  1208. $imgbin{txt_highscores_over} = add_image('menu/txt_highscores_over.png');
  1209. $imgbin{void_panel} = add_image('menu/void_panel.png');
  1210. $imgbin{version} = add_image('menu/version.png');
  1211. $imgbin{back_hiscores} = add_image('back_hiscores.png');
  1212. $imgbin{hiscore_frame} = add_image('hiscore_frame.png');
  1213. $imgbin{banner_artwork} = add_image('menu/banner_artwork.png');
  1214. $imgbin{banner_soundtrack} = add_image('menu/banner_soundtrack.png');
  1215. $imgbin{banner_cpucontrol} = add_image('menu/banner_cpucontrol.png');
  1216. $imgbin{banner_leveleditor} = add_image('menu/banner_leveleditor.png');
  1217. print_step('.');
  1218. #- temporarily desactivate the intro storyboard because it's not finished yet
  1219. #- $imgbin{frozen} = add_image('intro/txt_frozen.png');
  1220. #- $imgbin{bubble} = add_image('intro/txt_bubble.png');
  1221. #- $imgbin{intro_penguin_imgs}->{$_} = add_image("intro/intro_$_.png") foreach 1..19;
  1222. local @PLAYERS = qw(p1 p2); #- load all images even if -so commandline option was passed
  1223. iter_players {
  1224. $imgbin{hurry}{$::p} = add_image("hurry_$::p.png");
  1225. $pinguin{$::p}{normal} = [ map { add_image($_) } ("pinguins/base_$::p.png", map { "pinguins/base_$::p"."_extra_0$_.png" } (1..3)) ];
  1226. $pinguin{$::p}{sleep} = [ add_image("pinguins/sleep_$::p.png") ];
  1227. $pinguin{$::p}{left} = [ add_image("pinguins/move_left_$::p.png") ];
  1228. $pinguin{$::p}{right} = [ add_image("pinguins/move_right_$::p.png") ];
  1229. $pinguin{$::p}{action} = [ add_image("pinguins/action_$::p.png") ];
  1230. $pinguin{$::p}{win} = [ map { add_image("pinguins/$::p"."_win_$_.png") } qw(1 2 3 4 5 6 7 8 6) ];
  1231. $pinguin{$::p}{win_roll_back_index} = 4;
  1232. $pinguin{$::p}{lose} = [ map { add_image("pinguins/$::p"."_loose_$_.png") } qw(1 2 3 4 5 6 7 8 9) ];
  1233. $pinguin{$::p}{lose_roll_back_index} = 5;
  1234. $pinguin{$::p}{win} = [ map { add_image("pinguins/$::p"."_win_$_.png") } qw(1 2 3 4 5 6 7 8 6) ];
  1235. $pinguin{$::p}{walkright} = [ map { add_image("pinguins/$::p"."_dg_walk_0$_.png") } qw(1 2 3 4 5 6) ];
  1236. $imgbin{win}{$::p} = add_image("win_panel_$::p.png");
  1237. $pdata{$::p}{score} = 0;
  1238. };
  1239. print_step('] ');
  1240. $lev_number = 0;
  1241. print_step("[Levels] ");
  1242. load_levelset("$FPATH/data/levels");
  1243. if ($mixer eq 'SOUND_DISABLED') {
  1244. $mixer_enabled = $mixer = undef;
  1245. } else {
  1246. $mixer_enabled = init_sound();
  1247. }
  1248. fb_c_stuff::init_effects($FPATH);
  1249. print "Ready.\n";
  1250. }
  1251. sub open_level($) {
  1252. my ($level) = @_;
  1253. $level eq 'WON' and $level = $lev_number;
  1254. @{$levels{$level}} or die "No such level or void level ($level).\n";
  1255. foreach my $l (@{$levels{$level}}) {
  1256. iter_players {
  1257. my $img = $l->{img_num} =~ /^\d+$/ ? $bubbles_images[$l->{img_num}] : $bubbles_anim{lose};
  1258. real_stick_bubble(create_bubble_given_img($img), $l->{cx}, $l->{cy}, $::p, 0);
  1259. };
  1260. }
  1261. }
  1262. sub grab_key($) {
  1263. my ($unicode) = @_;
  1264. my $keyp;
  1265. do {
  1266. $event->wait;
  1267. if ($event->type == SDL_KEYDOWN) {
  1268. $keyp = $unicode ? ($event->key_unicode || $event->key_sym) : $event->key_sym;
  1269. }
  1270. } while ($event->type != SDL_KEYDOWN);
  1271. do { $event->wait } while ($event->type != SDL_KEYUP);
  1272. return $keyp;
  1273. }
  1274. sub display_highscores() {
  1275. $imgbin{back_hiscores}->blit($apprects{main}, $app, $apprects{main});
  1276. $display_on_app_disabled = 1;
  1277. @PLAYERS = ('p1');
  1278. %POS = %POS_1P;
  1279. $POS{top_limit} = $POS{init_top_limit};
  1280. my $initial_high_posx = 90;
  1281. my ($high_posx, $high_posy) = ($initial_high_posx, 68);
  1282. my $high_rect = SDL::Rect->new('-x' => $POS{p1}{left_limit} & 0xFFFFFFFC, '-y' => $POS{top_limit} & 0xFFFFFFFC,
  1283. '-width' => ($POS{p1}{right_limit}-$POS{p1}{left_limit}) & 0xFFFFFFFC, -height => ($POS{'initial_bubble_y'}-$POS{top_limit}-10) & 0xFFFFFFFC);
  1284. $font = SDL::Font->new("$FPATH/gfx/font-hi.png");
  1285. my $centered_print = sub($$$) {
  1286. my ($x, $y, $txt) = @_;
  1287. $app->print($x+($imgbin{hiscore_frame}->width-SDL_TEXTWIDTH(uc($txt)))/2 - 6,
  1288. $y+$imgbin{hiscore_frame}->height - 8, uc($txt));
  1289. };
  1290. my $old_levelset = $loaded_levelset;
  1291. foreach my $high (ordered_highscores()) {
  1292. iter_players {
  1293. @{$sticked_bubbles{$::p}} = ();
  1294. @{$root_bubbles{$::p}} = ();
  1295. $pdata{$::p}{newrootlevel} = 0;
  1296. $pdata{$::p}{oddswap} = 0;
  1297. };
  1298. $imgbin{back_1p}->blit($high_rect, $background, $high_rect);
  1299. # try to get it from the default-levelset. If we can't, default to the
  1300. # last level in the default levelset
  1301. if (!$high->{piclevel}) {
  1302. $loaded_levelset ne "$FPATH/data/levels" and load_levelset("$FPATH/data/levels");
  1303. # handle the case where the user has edited/created a levelset with more levels
  1304. # than the default levelset and then got a high score
  1305. if ($high->{level} > $lev_number) {
  1306. open_level($lev_number);
  1307. } else {
  1308. open_level($high->{level});
  1309. }
  1310. } else {
  1311. # this is the normal case. just load the level that the file tells us
  1312. if ($loaded_levelset ne "$ENV{HOME}/.fbhighlevelshistory") {
  1313. load_levelset("$ENV{HOME}/.fbhighlevelshistory");
  1314. }
  1315. open_level($high->{piclevel});
  1316. }
  1317. put_image($imgbin{hiscore_frame}, $high_posx - 7, $high_posy - 6);
  1318. fb_c_stuff::shrink($app->{-surface}, $background->display_format->{-surface}, $high_posx, $high_posy, $high_rect->{-rect}, 4);
  1319. $centered_print->($high_posx, $high_posy, $high->{name});
  1320. $centered_print->($high_posx, $high_posy+20, $high->{level} eq 'WON' ? "WON!" : "LVL-".$high->{level});
  1321. my $min = int($high->{time}/60);
  1322. my $sec = int($high->{time} - $min*60); length($sec) == 1 and $sec = "0$sec";
  1323. $centered_print->($high_posx, $high_posy+40, "$min'$sec''");
  1324. $high_posx += 98;
  1325. $high_posx > 550 and $high_posx = $initial_high_posx, $high_posy += 175;
  1326. $high_posy > 440 and last;
  1327. }
  1328. load_levelset($old_levelset);
  1329. $app->flip;
  1330. $display_on_app_disabled = 0;
  1331. $font = SDL::Font->new("$FPATH/gfx/font.png");
  1332. $event->pump while ($event->poll != 0);
  1333. grab_key(0);
  1334. }
  1335. sub keysym_to_char($) { my ($key) = @_; eval("$key eq SDLK_$_") and return uc($_) foreach @fbsyms::syms }
  1336. sub ask_from($) {
  1337. my ($w) = @_;
  1338. # $w->{intro} = [ 'text_intro_line1', 'text_intro_line2', ... ]
  1339. # $w->{entries} = [ { q => 'question1?', a => \$var_answer1, f => 'flags' }, {...} ] flags: ONE_CHAR
  1340. # $w->{outro} = 'text_outro_uniline'
  1341. # $w->{erase_background} = $background_right_one
  1342. my $xpos_panel = (640-$imgbin{void_panel}->width)/2;
  1343. my $ypos_panel = (480-$imgbin{void_panel}->height)/2;
  1344. put_image($imgbin{void_panel}, $xpos_panel, $ypos_panel);
  1345. my $xpos;
  1346. my $ypos = $ypos_panel + 5;
  1347. foreach my $i (@{$w->{intro}}) {
  1348. if ($i) {
  1349. my $xpos = (640-SDL_TEXTWIDTH($i))/2;
  1350. $app->print($xpos, $ypos, $i);
  1351. }
  1352. $ypos += 22;
  1353. }
  1354. $ypos += 3;
  1355. my $ok = 1;
  1356. entries:
  1357. foreach my $entry (@{$w->{entries}}) {
  1358. $xpos = (640-$imgbin{void_panel}->width)/2 + 120 - SDL_TEXTWIDTH($entry->{'q'})/2;
  1359. $app->print($xpos, $ypos, $entry->{'q'});
  1360. $app->flip;
  1361. my $srect_mulchar_redraw = SDL::Rect->new(-width => $imgbin{void_panel}->width, -height => 30,
  1362. -x => $xpos + 140 - $xpos_panel, '-y' => $ypos - $ypos_panel);
  1363. my $drect_mulchar_redraw = SDL::Rect->new(-width => $imgbin{void_panel}->width, -height => 30,
  1364. -x => $xpos + 140, '-y' => $ypos);
  1365. my $txt;
  1366. while (1) {
  1367. my $k = grab_key($entry->{f} !~ 'ONE_CHAR');
  1368. $k == SDLK_ESCAPE and $ok = 0, last entries;
  1369. play_sound('typewriter');
  1370. if ($entry->{f} =~ 'ONE_CHAR' || $k != SDLK_RETURN) {
  1371. my $x_echo = (640-$imgbin{void_panel}->width)/2 + 230;
  1372. if ($entry->{f} =~ 'ONE_CHAR') {
  1373. $txt = $k;
  1374. $app->print($x_echo, $ypos, keysym_to_char($k));
  1375. } else {
  1376. $k = keysym_to_char($k);
  1377. length($k) == 1 && length($txt) < 8 and $txt .= $k;
  1378. member($k, qw(BACKSPACE DELETE LEFT)) and $txt =~ s/.$//;
  1379. $imgbin{void_panel}->blit($srect_mulchar_redraw, $app, $drect_mulchar_redraw);
  1380. $app->print($x_echo, $ypos, $txt);
  1381. }
  1382. $app->flip;
  1383. }
  1384. $entry->{f} =~ 'ONE_CHAR' || $k == SDLK_RETURN and last;
  1385. }
  1386. $entry->{answer} = $txt;
  1387. $ypos += 22;
  1388. }
  1389. if ($ok) {
  1390. ${$_->{a}} = $_->{answer} foreach @{$w->{entries}};
  1391. $xpos = (640-SDL_TEXTWIDTH($w->{outro}))/2;
  1392. $ypos = (480+$imgbin{void_panel}->height)/2 - 35;
  1393. $app->print($xpos, $ypos, $w->{outro});
  1394. $app->flip;
  1395. play_sound('menu_selected');
  1396. sleep 1;
  1397. } else {
  1398. play_sound('cancel');
  1399. }
  1400. exists $w->{erase_background} and erase_image_from($imgbin{void_panel}, $xpos_panel, $ypos_panel, $w->{erase_background});
  1401. $app->flip;
  1402. $event->pump while ($event->poll != 0);
  1403. }
  1404. sub new_game() {
  1405. $display_on_app_disabled = 1;
  1406. my $backgr;
  1407. if (is_2p_game()) {
  1408. $backgr = $imgbin{back_2p};
  1409. %POS = %POS_2P;
  1410. $TIME_APPEARS_NEW_ROOT = 11;
  1411. $TIME_HURRY_WARN = 250;
  1412. $TIME_HURRY_MAX = 375;
  1413. } elsif (is_1p_game()) {
  1414. $backgr = $imgbin{back_1p};
  1415. %POS = %POS_1P;
  1416. $TIME_APPEARS_NEW_ROOT = 8;
  1417. $TIME_HURRY_WARN = 400;
  1418. $TIME_HURRY_MAX = 525;
  1419. $POS{top_limit} = $POS{init_top_limit};
  1420. $pdata{$PLAYERS[0]}{score} = $levels{current} || "RANDOM";
  1421. } else {
  1422. die "oops";
  1423. }
  1424. $backgr->blit($apprects{main}, $background_orig, $apprects{main});
  1425. $background_orig->blit($apprects{main}, $background, $apprects{main});
  1426. iter_players {
  1427. $actions{$::p}{$_} = 0 foreach qw(left right fire center);
  1428. $angle{$::p} = $PI/2;
  1429. @{$sticked_bubbles{$::p}} = ();
  1430. @{$malus_bubble{$::p}} = ();
  1431. @{$root_bubbles{$::p}} = ();
  1432. @{$falling_bubble{$::p}} = ();
  1433. @{$exploding_bubble{$::p}} = ();
  1434. @{$chains{$::p}{falling_chained}} = ();
  1435. %{$chains{$::p}{chained_bubbles}} = ();
  1436. $launched_bubble{$::p} = undef;
  1437. $sticking_bubble{$::p} = undef;
  1438. $pdata{$::p}{$_} = 0 foreach qw(newroot newroot_prelight oddswap malus hurry newrootlevel);
  1439. $pdata{$::p}{ping_right}{img} = 0;
  1440. $pdata{$::p}{ping_right}{state} = 'normal';
  1441. $apprects{$::p} = SDL::Rect->new('-x' => $POS{$::p}{left_limit}, '-y' => $POS{top_limit},
  1442. -width => $POS{$::p}{right_limit}-$POS{$::p}{left_limit}, -height => $POS{'initial_bubble_y'}-$POS{top_limit});
  1443. };
  1444. print_scores($background);
  1445. is_1p_game() and print_compressor();
  1446. if ($levels{current}) {
  1447. open_level($levels{current});
  1448. } else {
  1449. foreach my $cy (0 .. 4) {
  1450. foreach my $cx (0 .. (6 + even($cy))) {
  1451. my $b = create_bubble();
  1452. real_stick_bubble($b, $cx, $cy, $PLAYERS[0], 0); #- this doesn't map well to the 'iter_players' subroutine..
  1453. is_2p_game() and real_stick_bubble(create_bubble_given_img($b->{img}), $cx, $cy, $PLAYERS[1], 0);
  1454. }
  1455. }
  1456. }
  1457. $next_bubble{$PLAYERS[0]} = create_bubble($PLAYERS[0]);
  1458. # $next_bubble{$PLAYERS[0]} = create_bubble_given_img($bubbles_images[5]);
  1459. generate_new_bubble($PLAYERS[0]);
  1460. if (is_2p_game()) {
  1461. $next_bubble{$PLAYERS[1]} = create_bubble_given_img($tobe_launched{$PLAYERS[0]}->{img});
  1462. generate_new_bubble($PLAYERS[1], $next_bubble{$PLAYERS[0]}->{img});
  1463. }
  1464. if ($graphics_level == 1) {
  1465. $background->blit($apprects{main}, $app, $apprects{main});
  1466. $app->flip;
  1467. } else {
  1468. fb_c_stuff::effect($app->{-surface}, $background->display_format->{-surface});
  1469. }
  1470. $display_on_app_disabled = 0;
  1471. $event->pump while ($event->poll != 0);
  1472. $pdata{state} = 'game';
  1473. }
  1474. sub new_game_once() {
  1475. is_1p_game() && $levels{current} and choose_levelset();
  1476. if (is_2p_game() && $graphics_level > 1) {
  1477. my $answ;
  1478. ask_from({ intro => [ '2-PLAYER GAME', '', '', 'ENABLE CHAIN-REACTION?', '' ],
  1479. entries => [ { 'q' => 'Y OR N?', 'a' => \$answ, f => 'ONE_CHAR' } ],
  1480. outro => 'ENJOY THE GAME!' });
  1481. $chainreaction = $answ == SDLK_y; #;;
  1482. }
  1483. play_music(is_1p_game() ? 'main1p' : 'main2p');
  1484. }
  1485. sub lvl_cmp($$) { $_[0] eq 'WON' ? ($_[1] eq 'WON' ? 0 : 1) : ($_[1] eq 'WON' ? -1 : $_[0] <=> $_[1]) }
  1486. sub ordered_highscores() { return sort { lvl_cmp($b->{level}, $a->{level}) || $a->{time} <=> $b->{time} } @$HISCORES }
  1487. sub handle_new_hiscores() {
  1488. is_1p_game() && $levels{current} or return;
  1489. my @ordered = ordered_highscores();
  1490. my $worst = pop @ordered;
  1491. my $total_seconds = ($app->ticks - $time_1pgame)/1000;
  1492. if (@$HISCORES == 10 && (lvl_cmp($levels{current}, $worst->{level}) == -1
  1493. || lvl_cmp($levels{current}, $worst->{level}) == 0 && $total_seconds > $worst->{time})) {
  1494. return;
  1495. }
  1496. play_sound('applause');
  1497. append_highscore_level();
  1498. my %new_entry;
  1499. $new_entry{level} = $levels{current};
  1500. $new_entry{time} = $total_seconds;
  1501. $new_entry{piclevel} = count_highscorehistory_levels();
  1502. ask_from({ intro => [ 'CONGRATULATIONS!', "YOU HAVE A HIGHSCORE!", '' ],
  1503. entries => [ { 'q' => 'YOUR NAME?', 'a' => \$new_entry{name} } ],
  1504. outro => 'GREAT GAME!',
  1505. erase_background => $background,
  1506. });
  1507. return if $new_entry{name} eq '';
  1508. push @$HISCORES, \%new_entry;
  1509. if (@$HISCORES == 11) {
  1510. my @high = ordered_highscores();
  1511. pop @high;
  1512. $HISCORES = \@high;
  1513. }
  1514. output($hiscorefile, Data::Dumper->Dump([$HISCORES], [qw(HISCORES)]));
  1515. display_highscores();
  1516. }
  1517. # append the new highscore to the .fbhighlevelshistory
  1518. sub append_highscore_level() {
  1519. my $row_numb = 0;
  1520. my $lvl = 1;
  1521. my @contents;
  1522. foreach my $line (cat_($loaded_levelset)) {
  1523. if ($line !~ /\S/) {
  1524. if ($row_numb) {
  1525. $lvl++;
  1526. $row_numb = 0;
  1527. }
  1528. } else {
  1529. $row_numb++;
  1530. $lvl == ($levels{current} eq 'WON' ? (keys %levels)-1 : $levels{current})
  1531. and push @contents, $line;
  1532. }
  1533. }
  1534. append_to_file("$ENV{HOME}/.fbhighlevelshistory", @contents, "\n\n");
  1535. }
  1536. sub count_highscorehistory_levels() {
  1537. my $cnt = 0;
  1538. my $row_numb = 0;
  1539. foreach my $line (cat_("$ENV{HOME}/.fbhighlevelshistory")) {
  1540. if ($line !~ /\S/) {
  1541. if ($row_numb) {
  1542. $cnt++;
  1543. $row_numb = 0;
  1544. }
  1545. } else {
  1546. $row_numb++;
  1547. }
  1548. }
  1549. return $cnt;
  1550. }
  1551. #- ----------- mainloop ---------------------------------------------------
  1552. sub maingame() {
  1553. my $synchro_ticks = $app->ticks;
  1554. handle_graphics(\&erase_image);
  1555. update_game();
  1556. handle_graphics(\&put_image);
  1557. $app->update(@update_rects);
  1558. @update_rects = ();
  1559. my $to_wait = $TARGET_ANIM_SPEED - ($app->ticks - $synchro_ticks);
  1560. $to_wait > 0 and fb_c_stuff::fbdelay($to_wait);
  1561. }
  1562. #- ----------- intro stuff ------------------------------------------------
  1563. sub intro() {
  1564. my %storyboard = (
  1565. sleeping => {
  1566. start => { type => 'time', value => 0 },
  1567. type => 'penguin',
  1568. animations => [ qw(1 2 3 4 5 6 7 6 5 4 3 2) ],
  1569. },
  1570. music => { start => { type => 'time', value => 1 } },
  1571. bubble_fall1 => { start => { type => 'synchro', value => 0x01 },
  1572. type => 'bubble_falling', img => 2, xpos => 200, xaccel => -1.5 },
  1573. bubble_fall2 => { start => { type => 'synchro', value => 0x02 },
  1574. type => 'bubble_falling', img => 3, xpos => 350, xaccel => 1 },
  1575. bubble_fall3 => { start => { type => 'synchro', value => 0x03 },
  1576. type => 'bubble_falling', img => 4, xpos => 400, xaccel => 2 },
  1577. eyes_moving => {
  1578. start => { type => 'synchro', value => 0x21 },
  1579. type => 'penguin',
  1580. animations => [ qw(8 9 10 11 12 11 10 9) ],
  1581. },
  1582. arms_moving => {
  1583. start => { type => 'synchro', value => 0x22 },
  1584. type => 'penguin',
  1585. animations => [ qw(12 13 14 15 14 13) ],
  1586. },
  1587. fear => {
  1588. start => { type => 'synchro', value => 0x31 },
  1589. type => 'penguin',
  1590. animations => [ qw(15 16 17 18 19 18 17 16) ],
  1591. },
  1592. txt_frozen_arriving => {
  1593. start => { type => 'synchro', value => 0x31 },
  1594. type => 'bitmap_animation',
  1595. img => $imgbin{frozen},
  1596. finalpos => { x => 300, 'y' => 100 },
  1597. factor => 1,
  1598. },
  1599. txt_bubble_arriving => {
  1600. start => { type => 'synchro', value => 0x32 },
  1601. type => 'bitmap_animation',
  1602. img => $imgbin{bubble},
  1603. finalpos => { x => 340, 'y' => 155 },
  1604. factor => 4,
  1605. },
  1606. );
  1607. my %sb_params = (
  1608. animation_speed => 20
  1609. );
  1610. my $start_menu;
  1611. my ($slowdown_number, $slowdown_frame);
  1612. return menu(0); #- temporarily desactivate the intro storyboard because it's not finished yet
  1613. if ($mixer_enabled && $mixer) {
  1614. play_music('intro');
  1615. $mixer->pause_music;
  1616. my $back_start = SDL::Surface->new(-name => "$FPATH/intro/back_intro.png");
  1617. $back_start->blit($apprects{main}, $app, $apprects{main});
  1618. $app->flip;
  1619. my $penguin;
  1620. my @bubbles_falling;
  1621. my @bitmap_animations;
  1622. my $anim_step = -1;
  1623. my $start_time = $app->ticks;
  1624. my $current_time = $start_time;
  1625. while (!$start_menu) {
  1626. my $synchro_ticks = $app->ticks;
  1627. my $current_time_ = int(($app->ticks - $start_time)/1000);
  1628. my $anim_step_ = fb_c_stuff::get_synchro_value();
  1629. if ($anim_step_ != $anim_step || $current_time_ != $current_time) {
  1630. $anim_step = $anim_step_;
  1631. $current_time = $current_time_;
  1632. printf "Anim step: %12s Time: <$current_time>\n", sprintf "<0x%02x>", $anim_step;
  1633. foreach my $evt (keys %storyboard) {
  1634. next if $storyboard{$evt}->{already};
  1635. if ($storyboard{$evt}->{start}->{type} eq 'time' && $storyboard{$evt}->{start}->{value} <= $current_time
  1636. || $storyboard{$evt}->{start}->{type} eq 'synchro' && $storyboard{$evt}->{start}->{value} eq $anim_step) {
  1637. $storyboard{$evt}->{already} = 1;
  1638. print "*** Starting <$evt>\n";
  1639. $evt eq 'music' and $mixer->resume_music;
  1640. if ($storyboard{$evt}->{type} eq 'penguin') {
  1641. $penguin = { animations => $storyboard{$evt}->{animations},
  1642. current_anim => 0,
  1643. anim_step => $sb_params{animation_speed} };
  1644. }
  1645. if ($storyboard{$evt}->{type} eq 'bubble_falling') {
  1646. push @bubbles_falling, { img => $bubbles_images[$storyboard{$evt}->{img}], 'y' => 0, speed => 3,
  1647. x => $storyboard{$evt}->{xpos}, xaccel => $storyboard{$evt}->{xaccel} };
  1648. }
  1649. if ($storyboard{$evt}->{type} eq 'bitmap_animation') {
  1650. push @bitmap_animations, { img => $storyboard{$evt}->{img}, 'y' => 0,
  1651. x => $storyboard{$evt}->{finalpos}->{x},
  1652. finaly => $storyboard{$evt}->{finalpos}->{'y'},
  1653. factor => $storyboard{$evt}->{factor},
  1654. };
  1655. }
  1656. }
  1657. }
  1658. $anim_step == 0x09 and $start_menu = 1;
  1659. }
  1660. if ($penguin) {
  1661. $penguin->{anim_step}++;
  1662. if ($penguin->{anim_step} >= $sb_params{animation_speed}) {
  1663. my $img_number = ${$penguin->{animations}}[$penguin->{current_anim}];
  1664. erase_image_from($imgbin{intro_penguin_imgs}->{$img_number}, 260, 293, $back_start);
  1665. $penguin->{anim_step} = 0;
  1666. $penguin->{current_anim}++;
  1667. $penguin->{current_anim} == @{$penguin->{animations}} and $penguin->{current_anim} = 0;
  1668. $img_number = ${$penguin->{animations}}[$penguin->{current_anim}];
  1669. put_image($imgbin{intro_penguin_imgs}->{$img_number}, 260, 293);
  1670. }
  1671. }
  1672. foreach my $b (@bubbles_falling) {
  1673. erase_image_from($b->{img}, $b->{x}, $b->{'y'}, $back_start);
  1674. $b->{'x'} += $b->{xaccel};
  1675. $b->{'y'} += $b->{speed};
  1676. if ($b->{'y'} >= 360 && !$b->{already_rebound}) {
  1677. $b->{already_rebound} = 1;
  1678. $b->{'y'} = 2*360 - $b->{'y'};
  1679. $b->{speed} *= -0.5;
  1680. }
  1681. $b->{speed} += $FREE_FALL_CONSTANT;
  1682. $b->{kill} = $b->{'y'} > 470;
  1683. $b->{kill} or put_image($b->{img}, $b->{x}, $b->{'y'});
  1684. }
  1685. @bubbles_falling = grep { !$_->{kill} } @bubbles_falling;
  1686. erase_image_from($_->{img}, $_->{x}, $_->{'y'}, $back_start) foreach @bitmap_animations;
  1687. foreach my $b (@bitmap_animations) {
  1688. foreach (0..$slowdown_frame) {
  1689. $b->{'y'} = $b->{'finaly'} - 200*cos(3*$b->{step})/exp($b->{step}*$b->{step});
  1690. $b->{step} += 0.015 * $b->{factor};
  1691. }
  1692. }
  1693. $slowdown_frame = 0;
  1694. put_image($_->{img}, $_->{x}, $_->{'y'}) foreach @bitmap_animations;
  1695. $app->update(@update_rects);
  1696. @update_rects = ();
  1697. my $to_wait = $TARGET_ANIM_SPEED - ($app->ticks - $synchro_ticks);
  1698. if ($to_wait > 0) {
  1699. $app->delay($to_wait);
  1700. } else {
  1701. # print "slow by: <$to_wait>\n";
  1702. $slowdown_number += -$to_wait;
  1703. if ($slowdown_number > $TARGET_ANIM_SPEED) {
  1704. $slowdown_frame = int($slowdown_number / $TARGET_ANIM_SPEED);
  1705. $slowdown_number -= $slowdown_frame * $TARGET_ANIM_SPEED;
  1706. # print "skip frames: <$slowdown_frame>\n";
  1707. }
  1708. }
  1709. $event->pump;
  1710. $event->poll != 0 && $event->type == SDL_KEYDOWN && member($event->key_sym, (SDLK_RETURN, SDLK_SPACE, SDLK_KP_ENTER, SDLK_ESCAPE))
  1711. and $start_menu = 2;
  1712. }
  1713. }
  1714. # if ($start_menu == 1) {
  1715. # my $bkg = SDL::Surface->new(-width => $app->width, -height => $app->height, -depth => 32, -Amask => '0 but true');
  1716. # $app->blit($apprects{main}, $bkg, $apprects{main});
  1717. # menu(1, $bkg);
  1718. # } else {
  1719. menu(1);
  1720. # }
  1721. }
  1722. #- ----------- menu stuff -------------------------------------------------
  1723. sub menu {
  1724. my ($from_intro, $back_from_intro) = @_;
  1725. handle_new_hiscores();
  1726. if (!$from_intro) {
  1727. play_music('intro', 8);
  1728. }
  1729. my $back_start;
  1730. my $display_menu = sub {
  1731. $back_start->blit($apprects{main}, $app, $apprects{main});
  1732. put_image($imgbin{version}, 17, 432);
  1733. };
  1734. if (!$from_intro || !$back_from_intro) {
  1735. $back_start = $imgbin{backstartfull};
  1736. $display_menu->();
  1737. } else {
  1738. $back_start = $back_from_intro;
  1739. }
  1740. my $invalidate_all;
  1741. my $menu_start_sound = sub {
  1742. if (!$mixer_enabled && !$mixer && !init_sound()) {
  1743. return 0;
  1744. } else {
  1745. $mixer_enabled = 1;
  1746. play_music('intro', 8);
  1747. return 1;
  1748. }
  1749. };
  1750. my $menu_stop_sound = sub {
  1751. if ($mixer_enabled && $mixer && $mixer->playing_music) {
  1752. $app->delay(10) while $mixer->fading_music; #- mikmod will deadlock if we try to fade_out while still fading in
  1753. $mixer->playing_music and $mixer->fade_out_music(500); $app->delay(450);
  1754. $app->delay(10) while $mixer->playing_music; #- mikmod will segfault if we try to load a music while old one is still fading out
  1755. }
  1756. $mixer_enabled = undef;
  1757. return 1;
  1758. };
  1759. my $menu_display_highscores = sub {
  1760. display_highscores();
  1761. $display_menu->();
  1762. $app->flip;
  1763. $invalidate_all->();
  1764. };
  1765. my $change_keys = sub {
  1766. ask_from({ intro => [ 'PLEASE ENTER NEW KEYS' ],
  1767. entries => [
  1768. { 'q' => 'RIGHT-PL/LEFT?', 'a' => \$KEYS->{p2}{left}, f => 'ONE_CHAR' },
  1769. { 'q' => 'RIGHT-PL/RIGHT?', 'a' => \$KEYS->{p2}{right}, f => 'ONE_CHAR' },
  1770. { 'q' => 'RIGHT-PL/FIRE?', 'a' => \$KEYS->{p2}{fire}, f => 'ONE_CHAR' },
  1771. { 'q' => 'RIGHT-PL/CENTER?', 'a' => \$KEYS->{p2}{center}, f => 'ONE_CHAR' },
  1772. { 'q' => 'LEFT-PL/LEFT?', 'a' => \$KEYS->{p1}{left}, f => 'ONE_CHAR' },
  1773. { 'q' => 'LEFT-PL/RIGHT?', 'a' => \$KEYS->{p1}{right}, f => 'ONE_CHAR' },
  1774. { 'q' => 'LEFT-PL/FIRE?', 'a' => \$KEYS->{p1}{fire}, f => 'ONE_CHAR' },
  1775. { 'q' => 'LEFT-PL/CENTER?', 'a' => \$KEYS->{p1}{center}, f => 'ONE_CHAR' },
  1776. { 'q' => 'TOGGLE FULLSCREEN?', 'a' => \$KEYS->{misc}{fs}, f => 'ONE_CHAR' },
  1777. ],
  1778. outro => 'THANKS!',
  1779. erase_background => $back_start
  1780. });
  1781. $invalidate_all->();
  1782. };
  1783. my $launch_editor = sub {
  1784. SDL::ShowCursor(1);
  1785. FBLE::init_setup('embedded', $app);
  1786. FBLE::handle_events();
  1787. SDL::ShowCursor(0);
  1788. $back_start->blit($apprects{main}, $app, $apprects{main});
  1789. $app->flip;
  1790. $invalidate_all->();
  1791. };
  1792. my ($MENU_XPOS, $MENU_FIRSTY, $SPACING) = (56, 30, 51);
  1793. my %menu_ypos = ( '1pgame' => $MENU_FIRSTY,
  1794. '2pgame' => $MENU_FIRSTY + $SPACING,
  1795. 'editor' => $MENU_FIRSTY + 2 * $SPACING,
  1796. 'fullscreen' => $MENU_FIRSTY + 3 * $SPACING,
  1797. 'graphics' => $MENU_FIRSTY + 4 * $SPACING,
  1798. 'sound' => $MENU_FIRSTY + 5 * $SPACING,
  1799. 'keys' => $MENU_FIRSTY + 6 * $SPACING,
  1800. 'highscores' => $MENU_FIRSTY + 7 * $SPACING,
  1801. );
  1802. my %menu_entries = ( '1pgame' => { pos => 1, type => 'rungame',
  1803. run => sub { @PLAYERS = ('p1'); $levels{current} = 1; $chainreaction = 0; $time_1pgame = $app->ticks } },
  1804. '2pgame' => { pos => 2, type => 'rungame',
  1805. run => sub { @PLAYERS = qw(p1 p2); $levels{current} = undef; } },
  1806. 'editor' => { pos => 3, type => 'run', run => sub { $launch_editor->(); } },
  1807. 'fullscreen' => { pos => 4, type => 'toggle',
  1808. act => sub { $fullscreen = 1; $app->fullscreen },
  1809. unact => sub { $fullscreen = 0; $app->fullscreen },
  1810. value => $fullscreen },
  1811. 'graphics' => { pos => 5, type => 'range', valuemin => 1, valuemax => 3,
  1812. change => sub { $graphics_level = $_[0] }, value => $graphics_level },
  1813. 'sound' => { pos => 6, type => 'toggle',
  1814. act => sub { $menu_start_sound->() },
  1815. unact => sub { $menu_stop_sound->() },
  1816. value => $mixer_enabled },
  1817. 'keys' => { pos => 7, type => 'run',
  1818. run => sub { $change_keys->() } },
  1819. 'highscores' => { pos => 8, type => 'run',
  1820. run => sub { $menu_display_highscores->() } },
  1821. );
  1822. my $current_pos if 0; $current_pos ||= 1;
  1823. my @menu_invalids;
  1824. $invalidate_all = sub { push @menu_invalids, $menu_entries{$_}->{pos} foreach keys %menu_entries };
  1825. my $menu_update = sub {
  1826. @update_rects = ();
  1827. foreach my $m (keys %menu_entries) {
  1828. member($menu_entries{$m}->{pos}, @menu_invalids) or next;
  1829. my $txt = "txt_$m";
  1830. $menu_entries{$m}->{type} eq 'toggle' && $menu_entries{$m}->{value} and $txt .= "_act";
  1831. $menu_entries{$m}->{type} eq 'range' and $txt .= "_$menu_entries{$m}->{value}";
  1832. $txt .= $menu_entries{$m}->{pos} == $current_pos ? '_over' : '_off';
  1833. erase_image_from($imgbin{$txt}, $MENU_XPOS, $menu_ypos{$m}, $back_start);
  1834. put_image($imgbin{$txt}, $MENU_XPOS, $menu_ypos{$m});
  1835. }
  1836. @menu_invalids = ();
  1837. $app->update(@update_rects);
  1838. };
  1839. $app->flip;
  1840. $invalidate_all->();
  1841. $menu_update->();
  1842. $event->pump while ($event->poll != 0);
  1843. my $start_game = 0;
  1844. my ($BANNER_START, $BANNER_SPACING) = (720, 80);
  1845. my %banners = (artwork => $BANNER_START,
  1846. soundtrack => $BANNER_START + $imgbin{banner_artwork}->width + $BANNER_SPACING,
  1847. cpucontrol => $BANNER_START + $imgbin{banner_artwork}->width + $BANNER_SPACING
  1848. + $imgbin{banner_soundtrack}->width + $BANNER_SPACING,
  1849. leveleditor => $BANNER_START + $imgbin{banner_artwork}->width + $BANNER_SPACING
  1850. + $imgbin{banner_soundtrack}->width + $BANNER_SPACING
  1851. + $imgbin{banner_cpucontrol}->width + $BANNER_SPACING);
  1852. my ($BANNER_MINX, $BANNER_MAXX, $BANNER_Y) = (81, 292, 443);
  1853. my $banners_max = $banners{leveleditor} - (640 - ($BANNER_MAXX - $BANNER_MINX)) + $BANNER_SPACING;
  1854. my $banner_rect = SDL::Rect->new(-width => $BANNER_MAXX-$BANNER_MINX, -height => 30, '-x' => $BANNER_MINX, '-y' => $BANNER_Y);
  1855. while (!$start_game) {
  1856. my $synchro_ticks = $app->ticks;
  1857. $graphics_level > 1 and $back_start->blit($banner_rect, $app, $banner_rect);
  1858. $event->pump;
  1859. if ($event->poll != 0) {
  1860. if ($event->type == SDL_KEYDOWN) {
  1861. my $keypressed = $event->key_sym;
  1862. if (member($keypressed, (SDLK_DOWN, SDLK_RIGHT)) && $current_pos < max(map { $menu_entries{$_}->{pos} } keys %menu_entries)) {
  1863. $current_pos++;
  1864. push @menu_invalids, $current_pos-1, $current_pos;
  1865. play_sound('menu_change');
  1866. }
  1867. if (member($keypressed, (SDLK_UP, SDLK_LEFT)) && $current_pos > 1) {
  1868. $current_pos--;
  1869. push @menu_invalids, $current_pos, $current_pos+1;
  1870. play_sound('menu_change');
  1871. }
  1872. if (member($keypressed, (SDLK_RETURN, SDLK_SPACE, SDLK_KP_ENTER))) {
  1873. play_sound('menu_selected');
  1874. push @menu_invalids, $current_pos;
  1875. foreach my $m (keys %menu_entries) {
  1876. if ($menu_entries{$m}->{pos} == $current_pos) {
  1877. if ($menu_entries{$m}->{type} =~ /^run/) {
  1878. $menu_entries{$m}->{run}->();
  1879. $menu_entries{$m}->{type} eq 'rungame' and $start_game = 1;
  1880. }
  1881. if ($menu_entries{$m}->{type} eq 'toggle') {
  1882. $menu_entries{$m}->{value} = !$menu_entries{$m}->{value};
  1883. if ($menu_entries{$m}->{value}) {
  1884. $menu_entries{$m}->{act}->() or $menu_entries{$m}->{value} = 0;
  1885. } else {
  1886. $menu_entries{$m}->{unact}->() or $menu_entries{$m}->{value} = 1;
  1887. }
  1888. }
  1889. if ($menu_entries{$m}->{type} eq 'range') {
  1890. $menu_entries{$m}->{value}++;
  1891. $menu_entries{$m}->{value} > $menu_entries{$m}->{valuemax}
  1892. and $menu_entries{$m}->{value} = $menu_entries{$m}->{valuemin};
  1893. $menu_entries{$m}->{change}->($menu_entries{$m}->{value});
  1894. }
  1895. }
  1896. }
  1897. }
  1898. if ($keypressed == SDLK_ESCAPE || $event->type == SDL_QUIT) {
  1899. exit 0;
  1900. }
  1901. }
  1902. $menu_update->();
  1903. }
  1904. if ($graphics_level > 1) {
  1905. my $banner_pos if 0;
  1906. $banner_pos ||= 670;
  1907. foreach my $b (keys %banners) {
  1908. my $xpos = $banners{$b} - $banner_pos;
  1909. my $image = $imgbin{"banner_$b"};
  1910. $xpos > $banners_max/2 and $xpos = $banners{$b} - ($banner_pos + $banners_max);
  1911. if ($xpos < $BANNER_MAXX && $xpos + $image->width >= 0) {
  1912. my $irect = SDL::Rect->new(-width => min($image->width+$xpos, $BANNER_MAXX-$BANNER_MINX), -height => $image->height, -x => -$xpos);
  1913. $image->blit($irect, $app, SDL::Rect->new(-x => $BANNER_MINX, '-y' => $BANNER_Y));
  1914. }
  1915. }
  1916. $banner_pos++;
  1917. $banner_pos >= $banners_max and $banner_pos = 1;
  1918. }
  1919. $app->update($banner_rect);
  1920. my $to_wait = $TARGET_ANIM_SPEED - ($app->ticks - $synchro_ticks);
  1921. $to_wait > 0 and $app->delay($to_wait);
  1922. }
  1923. #- for $KEYS, try hard to keep SDLK_<key> instead of integer value in rcfile
  1924. my $KEYS_;
  1925. foreach my $p (keys %$KEYS) {
  1926. foreach my $k (keys %{$KEYS->{$p}}) {
  1927. eval("$KEYS->{$p}->{$k} eq SDLK_$_") and $KEYS_->{$p}->{$k} = "SDLK_$_" foreach @fbsyms::syms;
  1928. }
  1929. }
  1930. my $dump = Data::Dumper->Dump([$fullscreen, $graphics_level, $KEYS_], [qw(fullscreen graphics_level KEYS)]);
  1931. $dump =~ s/'SDLK_(\w+)'/SDLK_$1/g;
  1932. output($rcfile, $dump);
  1933. iter_players {
  1934. !is_1p_game() and $pdata{$::p}{score} = 0;
  1935. };
  1936. }
  1937. #- ----------- editor stuff --------------------------------------------
  1938. sub choose_levelset() {
  1939. my @levelsets = sort glob("$FBLEVELS/*");
  1940. if ($direct_levelset) {
  1941. load_levelset("$FBLEVELS/$direct_levelset");
  1942. $direct_levelset = '';
  1943. } elsif (!@levelsets) {
  1944. # no .fblevels directory or void directory, just return and let the
  1945. # game continue (means that the level editor has never been opened)
  1946. } else {
  1947. if (@levelsets <= 1) {
  1948. load_levelset($levelsets[0]);
  1949. } else {
  1950. FBLE::init_app('embedded', $app);
  1951. FBLE::create_play_levelset_dialog();
  1952. SDL::ShowCursor(1);
  1953. my $play_level = FBLE::handle_events();
  1954. load_levelset("$FBLEVELS/$play_level");
  1955. SDL::ShowCursor(0);
  1956. }
  1957. }
  1958. }
  1959. #- ----------- main -------------------------------------------------------
  1960. init_game();
  1961. $direct or intro();
  1962. new_game_once();
  1963. new_game();
  1964. while (1) {
  1965. eval { maingame() };
  1966. if ($@) {
  1967. if ($@ =~ /^new_game/) {
  1968. new_game();
  1969. } elsif ($@ =~ /^quit/) {
  1970. menu();
  1971. new_game_once();
  1972. new_game();
  1973. } else {
  1974. die;
  1975. }
  1976. }
  1977. }