~ubuntu-branches/ubuntu/karmic/frozen-bubble/karmic

use vars qw($TARGET_ANIM_SPEED $BUBBLE_SIZE $ROW_SIZE $LAUNCHER_SPEED $BUBBLE_SPEED $MALUS_BUBBLE_SPEED $TIME_APPEARS_NEW_ROOT %POS %POS_1P %POS_2P $KEYS %actions %angle %pdata $app $font %apprects $event %rects %sticked_bubbles %root_bubbles $background $background_orig @bubbles_images $gcwashere %bubbles_anim %launched_bubble %tobe_launched %next_bubble $shooter $sdl_flags $mixer %sound %music %pinguin %canon $graphics_level @update_rects $CANON_ROTATIONS_NB %malus_bubble %falling_bubble %exploding_bubble %malus_gfx %sticking_bubble $version $time %imgbin $TIME_HURRY_WARN $TIME_HURRY_MAX $TIMEOUT_PINGUIN_SLEEP $FREE_FALL_CONSTANT $direct @PLAYERS %levels $display_on_app_disabled $total_time $time_1pgame $fullscreen $rcfile $hiscorefile $HISCORES $PI $FPATH);

use Data::Dumper;

use fbmdkcommon; #- should be MDK::Common;

use SDL::App;

use SDL::Surface;

use SDL::Event;

use SDL::Cursor;

use SDL::Font;

use SDL::Mixer;

use fb_c_stuff;

use fbsyms;

$FPATH = '@PREFIX@/share/frozen-bubble';

$| = 1;

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

$BUBBLE_SIZE = 32;

$LAUNCHER_SPEED = 0.03; # speed of rotation of launchers

$BUBBLE_SPEED = 10; # speed of movement of launched bubbles

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

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

%POS_2P = ( p1 => { left_limit => 30, right_limit => 286, pinguin => { x => 168, 'y' => 437 }, malus_x => 305, scores_x => 293 },

p2 => { left_limit => 354, right_limit => 610, pinguin => { x => 32, 'y' => 437 }, malus_x => 328, scores_x => 341 },

top_limit => 40,

'initial_bubble_y' => 390,

next_bubble => { x => 112, 'y' => 440 },

'malus_y' => 408,

hurry => { x => 10, 'y' => 265 },

centerpanel => { x => 153, 'y' => 190 },

'scores_y' => 428,

);

%POS_1P = ( p1 => { left_limit => 190, right_limit => 446, pinguin => { x => 168, 'y' => 437 }, scores_x => 180 },

init_top_limit => 44,

'initial_bubble_y' => 390,

next_bubble => { x => 112, 'y' => 440 },

'malus_y' => 408,

hurry => { x => 10, 'y' => 265 },

centerpanel => { x => 153, 'y' => 190 },

'scores_y' => 432,

compressor_xpos => 321,

);

$ROW_SIZE = $BUBBLE_SIZE * 7/8;

$TIMEOUT_PINGUIN_SLEEP = 200;

$FREE_FALL_CONSTANT = 0.5;

$KEYS = { p1 => { left => SDLK_x, right => SDLK_v, fire => SDLK_c },

p2 => { left => SDLK_LEFT, right => SDLK_RIGHT, fire => SDLK_UP } };

$sdl_flags = SDL_ANYFORMAT | SDL_HWSURFACE | SDL_DOUBLEBUF | SDL_HWACCEL | SDL_ASYNCBLIT;

$mixer = 0;

$graphics_level = 3;

@PLAYERS = qw(p1 p2);

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

100

-r $rcfile and eval(cat_($rcfile));

101

$hiscorefile = "$ENV{HOME}/.fbhighscores";

102

eval(cat_(-r $hiscorefile ? $hiscorefile : "$FPATH/highscores.default"));

103

104

$version = '0.9.2';

105

106

$ENV{LD_PRELOAD} !~ '@PREFIX@/lib/frozen-bubble/libSDL_mixer-1.2.so.0' and die "Please run `frozen-bubble' to start the game\n";

107

108

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

109

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

110

111

112

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

113

Amaury Amblard-Ladurantie <amaury at linuxfr.org>

114

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

115

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

116

117

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

118

119

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

120

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

121

published by the Free Software Foundation.

122

123

124

125

local $_ = join '', @ARGV;

126

127

/-h/ and die "usage: $0 [-h] [-fs --fullscreen] [-ns --nosound] [-sl --slow_machine] [-vs --very_slow_machine] [-so --solo] [-l#n] [-di --direct]\n";

128

/-fs/ || /-fullscreen/ and $fullscreen = 1;

129

/-ns/ || /-nosound/ and $mixer = 'SOUND_DISABLED';

130

/-sl/ and $graphics_level = 2;

131

/-vs/ || /-very_slow_machine/ and $graphics_level = 1;

132

/-srand/ and srand 0;

133

/-di/ and $direct = 1;

134

/-so/ and @PLAYERS = ('p1');

135

/-l(\d+)/ and $levels{current} = $1;

136

137

138

#- ------------------------------------------------------------------------

139

140

END {

141

if ($app) {

142

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

143

my $h = int($total_time/3600);

144

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

145

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

146

print "\nAddicted during ", $h ? "$h"."h " : "", $m ? "$m"."m " : "", "$s"."s.\n";

147

}

148

# fb_c_stuff::_exit(0); #- so that process will not segfault (probably in atexit), if the sound has been disabled in the menu

149

}

150

151

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

152

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

153

154

155

#- sdlpl-1.12 is bugged for SDL::Surface::display_format :-(

156

sub my_display_format {

157

my $surface = shift;

158

my $tmp = SDL::sdlpl::sdl_display_format($surface->{-surface});

159

SDL::sdlpl::sdl_free_surface($surface->{-surface});

160

$surface->{-surface} = $tmp;

161

return $surface;

162

}

163

164

#- ----------- sound related stuff ----------------------------------------

165

166

sub play_sound($) {

167

$mixer and $sound{$_[0]} and $mixer->play_channel(-1, $sound{$_[0]}, 0);

168

}

169

170

sub play_music($;$) {

171

my ($name, $pos) = @_;

172

$mixer or return;

173

$mixer and $mixer->music_paused() and $mixer->resume_music();

174

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

175

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

176

$app->delay(10) while $mixer->playing_music(); #- mikmod will segfault if we try to load a music while old one is still fading out

177

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

178

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

179

$mus = new SDL::Music("$FPATH$musics{$name}");

180

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

181

if ($pos) {

182

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

183

} else {

184

$mixer->play_music($mus, -1);

185

}

186

}

187

188

sub init_sound() {

189

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

190

if ($@) {

191

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

192

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

193

return 0;

194

}

195

print "[Sound Init]\n";

196

my @sounds = qw(stick destroy_group newroot newroot_solo lose hurry pause menu_change menu_selected rebound launch malus noh snore cancel typewriter applause);

197

foreach (@sounds) {

198

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

199

$sound{$_} = new SDL::Sound($sound_path);

200

if ($sound{$_}{-data}) {

201

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

202

} else {

203

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

204

}

205

}

206

return 1;

207

}

208

209

210

#- ----------- graphics related stuff --------------------------------------

211

212

sub add_default_rect($) {

213

my ($surface) = @_;

214

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

215

}

216

217

sub put_image($$$) {

218

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

219

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

220

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

221

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

222

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

223

push @update_rects, $drect;

224

}

225

226

sub erase_image_from($$$$) {

227

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

228

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

229

$img->blit($drect, $app, $drect);

230

push @update_rects, $drect;

231

}

232

233

sub erase_image($$$) {

234

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

235

erase_image_from($image, $x, $y, $background);

236

}

237

238

sub put_image_to_background($$$) {

239

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

240

my $drect;

241

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

242

if ($y > 0) {

243

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

244

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

245

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

246

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

247

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

248

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

249

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

250

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

251

}

252

push @update_rects, $drect;

253

}

254

255

sub remove_image_from_background($$$) {

256

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

257

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

258

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

259

$background_orig->blit($drect, $background, $drect);

260

$background_orig->blit($drect, $app, $drect);

261

push @update_rects, $drect;

262

}

263

264

sub remove_images_from_background {

265

my ($player, @images) = @_;

266

foreach (@images) {

267

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

268

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

269

$background_orig->blit($drect, $background, $drect);

270

$background_orig->blit($drect, $app, $drect);

271

push @update_rects, $drect;

272

}

273

}

274

275

sub put_allimages_to_background($) {

276

my ($player) = @_;

277

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

278

}

279

280

sub switch_image_on_background($$$;$) {

281

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

282

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

283

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

284

if ($save) {

285

$save = new SDL::Surface(-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!!)

286

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

287

}

288

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

289

$background->blit($drect, $app, $drect);

290

push @update_rects, $drect;

291

return $save;

292

}

293

294

sub add_image($) {

295

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

296

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

297

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

298

add_default_rect($img);

299

return $img;

300

}

301

302

sub add_bubble_image($) {

303

my ($file) = @_;

304

my $bubble = add_image($file);

305

push @bubbles_images, $bubble;

306

}

307

308

309

#- ----------- generic game stuff -----------------------------------------

310

311

sub iter_players(&) {

312

my ($f) = @_;

313

local $::p;

314

foreach $::p (@PLAYERS) {

315

&$f;

316

}

317

}

318

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

319

my ($f) = @_;

320

local $::p_;

321

foreach $::p_ (@PLAYERS) {

322

&$f;

323

}

324

}

325

sub is_1p_game() { listlength(@PLAYERS) == 1 }

326

sub is_2p_game() { listlength(@PLAYERS) == 2 }

327

328

329

#- ----------- bubble game stuff ------------------------------------------

330

331

sub calc_real_pos($$) { # try to optimize a bit

332

my ($b, $player) = @_;

333

$b->{'x'} = $POS{$player}{left_limit} + $b->{cx} * $BUBBLE_SIZE + odd($b->{cy}+$pdata{$player}{oddswap}) * $BUBBLE_SIZE/2;

334

$b->{'y'} = $POS{top_limit} + $b->{cy} * $ROW_SIZE;

335

}

336

337

sub get_array_yclosest($) {

338

my ($y) = @_;

339

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

340

}

341

342

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

343

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

344

my $ny = get_array_yclosest($y);

345

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

346

return ($nx, $ny);

347

}

348

349

sub is_collision($$$) {

350

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

351

my $DISTANCE_COLLISION_SQRED = sqr($BUBBLE_SIZE * 0.82);

352

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

353

($xs > $DISTANCE_COLLISION_SQRED) and return 0;

354

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

355

}

356

357

sub create_bubble_given_img($) {

358

my ($img) = @_;

359

my %bubble;

360

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

361

$bubble{img} = $img;

362

return \%bubble;

363

}

364

365

sub create_bubble(;$) {

366

my ($p) = @_;

367

my $b = create_bubble_given_img($bubbles_images[rand(listlength(@bubbles_images))]);

368

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

369

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

370

return $b;

371

}

372

373

sub bubble_next_to($$$$$) {

374

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

375

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

376

return to_bool((sqr($x1+odd($y1+$pdata{$player}{oddswap})*0.5 - ($x2+odd($y2+$pdata{$player}{oddswap})*0.5)) + sqr($y1 - $y2)) < 3);

377

}

378

379

#- bubble ends its life sticked somewhere

380

sub real_stick_bubble {

381

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

382

$bubble->{cx} = $xpos;

383

$bubble->{cy} = $ypos;

384

foreach (@{$sticked_bubbles{$player}}) {

385

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

386

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

387

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

388

}

389

}

390

push @{$sticked_bubbles{$player}}, $bubble;

391

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

392

calc_real_pos($bubble, $player);

393

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

394

}

395

396

sub destroy_bubbles {

397

my ($player, @bubz) = @_;

398

$graphics_level == 1 and return;

399

foreach (@bubz) {

400

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

401

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

402

}

403

push @{$exploding_bubble{$player}}, @bubz;

404

}

405

406

sub stick_bubble($$$$) {

407

my ($bubble, $xpos, $ypos, $player) = @_;

408

my @will_destroy;

409

my @falling;

410

my @neighbours = ($bubble);

411

my $need_redraw = 0;

412

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

413

while (1) {

414

push @will_destroy, @neighbours;

415

@neighbours = grep { $bubble->{img} eq $_->{img} && !member($_, @will_destroy) } fastuniq(map { @{$_->{neighbours}} } @neighbours);

416

last if !@neighbours;

417

}

418

shift @will_destroy; #- remove "$bubble" which is at the front of the array

419

420

if (listlength(@will_destroy) <= 1) {

421

#- stick

422

play_sound('stick');

423

real_stick_bubble($bubble, $xpos, $ypos, $player, 1);

424

$sticking_bubble{$player} = $bubble;

425

$pdata{$player}{sticking_step} = 0;

426

} else {

427

#- destroy the group

428

play_sound('destroy_group');

429

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

430

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

431

}

432

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

433

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

434

435

$bubble->{'cx'} = $xpos;

436

$bubble->{'cy'} = $ypos;

437

calc_real_pos($bubble, $player);

438

destroy_bubbles($player, @will_destroy, $bubble);

439

440

#- find falling bubbles

441

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

442

my @sticked;

443

my @neighbours = @{$root_bubbles{$player}};

444

while (1) {

445

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

446

push @sticked, @neighbours;

447

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

448

last if !@neighbours;

449

}

450

@falling = difference2($sticked_bubbles{$player}, \@sticked);

451

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

452

453

if ($graphics_level > 1) {

454

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

455

my ($shift_on_same_line, $line) = (0, $max_cy_falling);

456

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

457

$shift_on_same_line = 0 if $line != $_->{cy};

458

$line = $_->{cy};

459

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

460

$shift_on_same_line++;

461

$_->{speed} = 0;

462

}

463

push @{$falling_bubble{$player}}, @falling;

464

}

465

466

remove_images_from_background($player, @will_destroy, @falling);

467

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

468

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

469

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

470

$need_redraw = 1;

471

}

472

473

$pdata{$player}{newroot}++;

474

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

475

$pdata{$player}{newroot_prelight} = 2;

476

$pdata{$player}{newroot_prelight_step} = 0;

477

}

478

if ($pdata{$player}{newroot} == $TIME_APPEARS_NEW_ROOT) {

479

$pdata{$player}{newroot_prelight} = 1;

480

$pdata{$player}{newroot_prelight_step} = 0;

481

}

482

if ($pdata{$player}{newroot} > $TIME_APPEARS_NEW_ROOT) {

483

$need_redraw = 1;

484

$pdata{$player}{newroot_prelight} = 0;

485

play_sound(is_1p_game() ? 'newroot_solo' : 'newroot');

486

$pdata{$player}{newroot} = 0;

487

$pdata{$player}{oddswap} = !$pdata{$player}{oddswap};

488

remove_images_from_background($player, @{$sticked_bubbles{$player}});

489

foreach (@{$sticked_bubbles{$player}}) {

490

$_->{'cy'}++;

491

calc_real_pos($_, $player);

492

}

493

put_allimages_to_background($player);

494

if (is_1p_game()) {

495

$pdata{$player}{newrootlevel}++;

496

print_compressor();

497

} else {

498

@{$root_bubbles{$player}} = ();

499

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

500

}

501

}

502

503

if ($need_redraw) {

504

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

505

malus_change(@will_destroy + @falling - 2, $player);

506

}

507

}

508

509

sub print_next_bubble($$) {

510

my ($img, $player) = @_;

511

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

512

put_image_to_background($bubbles_anim{on_top_next}, $POS{$player}{left_limit}+$POS{next_bubble}{x}-3, $POS{next_bubble}{'y'}-2);

513

}

514

515

sub generate_new_bubble {

516

my ($player, $img) = @_;

517

$tobe_launched{$player} = $next_bubble{$player};

518

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

519

$tobe_launched{$player}{'y'} = $POS{'initial_bubble_y'};

520

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

521

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

522

$next_bubble{$player}{'y'} = $POS{next_bubble}{'y'};

523

print_next_bubble($next_bubble{$player}{img}, $player);

524

}

525

526

527

#- ----------- game stuff -------------------------------------------------

528

529

sub handle_graphics($) {

530

my ($fun) = @_;

531

532

iter_players {

533

#- bubbles

534

foreach ($launched_bubble{$::p}, if_($fun ne 'erase_image', $tobe_launched{$::p})) {

535

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

536

}

537

if ($fun == \&put_image && $pdata{$::p}{newroot_prelight}) {

538

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

539

$pdata{$::p}{newroot_prelight_step} = 0;

540

}

541

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

542

my $hurry_overwritten = 0;

543

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

544

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

545

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

546

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

547

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

548

}

549

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

550

}

551

}

552

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

553

my $b = $sticking_bubble{$::p};

554

if ($fun == \&erase_image) {

555

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

556

} else {

557

if ($pdata{$::p}{sticking_step} == listlength(@{$bubbles_anim{stick}})) {

558

$sticking_bubble{$::p} = undef;

559

} else {

560

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

561

if ($pdata{$::p}{sticking_step_slowdown}) {

562

$pdata{$::p}{sticking_step}++;

563

$pdata{$::p}{sticking_step_slowdown} = 0;

564

} else {

565

$pdata{$::p}{sticking_step_slowdown}++;

566

}

567

}

568

}

569

}

570

571

#- shooter

572

if ($graphics_level > 1) {

573

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

574

$fun->($canon{img}{$num},

575

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

576

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

577

} else {

578

$fun->($shooter,

579

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

580

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

581

}

582

#- penguins

583

if ($graphics_level == 3) {

584

$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'});

585

}

586

587

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

588

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

589

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

590

}

591

592

};

593

594

}

595

596

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

597

sub malus_change($$) {

598

my ($numb, $player) = @_;

599

return if $numb == 0 || is_1p_game();

600

if ($numb >= 0) {

601

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

602

}

603

my $update_malus = sub($) {

604

my ($fun) = @_;

605

my $malus = $pdata{$player}{malus};

606

my $y_shift = 0;

607

while ($malus > 0) {

608

my $print = sub($) {

609

my ($type) = @_;

610

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

611

$y_shift += $type->height - 1;

612

};

613

if ($malus >= 7) {

614

$print->($malus_gfx{tomate});

615

$malus -= 7;

616

} else {

617

$print->($malus_gfx{banane});

618

$malus--;

619

}

620

}

621

};

622

$update_malus->(\&remove_image_from_background);

623

$pdata{$player}{malus} += $numb;

624

$update_malus->(\&put_image_to_background);

625

}

626

627

sub print_compressor() {

628

my $x = $POS{compressor_xpos};

629

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

630

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

631

632

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

633

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

634

$background_orig->blit($drect, $background, $drect);

635

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

636

push @update_rects, $drect;

637

638

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

639

640

$y -= $comp_main->height - 3;

641

642

while ($y > 0) {

643

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

644

$y -= $comp_ext->height;

645

}

646

}

647

648

sub handle_game_events() {

649

$event->pump();

650

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

651

if ($event->type == SDL_KEYDOWN) {

652

my $keypressed = $event->key_sym();

653

654

iter_players {

655

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

656

foreach ('left', 'right', 'fire') {

657

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

658

}

659

};

660

661

if ($keypressed == SDLK_PAUSE) {

662

my $pause;

663

play_sound('pause');

664

$mixer and $mixer->pause_music();

665

$imgbin{back_paused}->blit($apprects{main}, $app, $apprects{main});

666

pause_label:

667

while (1) {

668

my ($index, $side) = (0, 1);

669

while ($index || $side == 1) {

670

$pause = switch_image_on_background(${$imgbin{paused}}[$index], $POS{centerpanel}{x}, $POS{centerpanel}{'y'}, 1);

671

$app->flip();

672

foreach (1..80) {

673

$app->delay(20);

674

$event->pump();

675

last pause_label if $event->poll != 0 && $event->type == SDL_KEYDOWN;

676

}

677

rand() < 0.2 and play_sound('snore');

678

switch_image_on_background($pause, $POS{centerpanel}{x}, $POS{centerpanel}{'y'});

679

$index += $side;

680

if ($index == listlength(@{$imgbin{paused}})) {

681

$side = -1;

682

$index -= 2;

683

}

684

}

685

}

686

switch_image_on_background($pause, $POS{centerpanel}{x}, $POS{centerpanel}{'y'});

687

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

688

$mixer and $mixer->resume_music();

689

$background->blit($apprects{main}, $app, $apprects{main});

690

$app->flip();

691

}

692

693

}

694

695

if ($event->type == SDL_KEYUP) {

696

my $keypressed = $event->key_sym();

697

698

iter_players {

699

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

700

foreach ('left', 'right', 'fire') {

701

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

702

}

703

}

704

}

705

706

if ($event->type == SDL_QUIT ||

707

$event->type == SDL_KEYDOWN && $event->key_sym() == SDLK_ESCAPE) {

708

die 'quit';

709

}

710

}

711

}

712

713

sub print_scores($) {

714

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

715

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

716

$background_orig->blit($drect, $surface, $drect);

717

push @update_rects, $drect;

718

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

719

$surface->print($POS{$::p_}{scores_x}-SDL_TEXTWIDTH($pdata{$::p_}{score})/2, $POS{'scores_y'}, $pdata{$::p_}{score});

720

};

721

}

722

723

sub verify_if_end {

724

iter_players {

725

if (grep { $_->{cy} > 11 } @{$sticked_bubbles{$::p}}) {

726

$pdata{state} = "lost $::p";

727

play_sound('lose');

728

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

729

$pdata{$::p}{ping_right}{img} = 0;

730

if (!is_1p_game()) {

731

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

732

$pdata{$won}{score}++;

733

$pdata{$won}{ping_right}{state} = 'win';

734

$pdata{$won}{ping_right}{img} = 0;

735

print_scores($background); print_scores($app);

736

}

737

$_ and ($_->{img} = $bubbles_anim{lose}, $_->{'x'}--, $_->{'y'}--) foreach ($launched_bubble{$::p}, $tobe_launched{$::p}, @{$malus_bubble{$::p}});

738

iter_players_ { remove_hurry($::p_); };

739

print_next_bubble($bubbles_anim{lose}, $::p);

740

iter_players_ {

741

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

742

$sticking_bubble{$::p_} = undef;

743

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

744

$launched_bubble{$::p_} = undef;

745

$pdata{$::p_}{newroot_prelight} = 0;

746

};

747

@{$malus_bubble{$::p}} = ();

748

}

749

};

750

751

if (is_1p_game() && listlength(@{$sticked_bubbles{$PLAYERS[0]}}) == 0) {

752

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

753

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

754

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

755

$levels{current} and $levels{current}++;

756

$levels{$levels{current}} or $levels{current} = 0;

757

}

758

}

759

760

sub print_hurry($;$) {

761

my ($player, $dont_save_background) = @_;

762

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

763

$dont_save_background or $pdata{$player}{hurry_save_img} = $t;

764

}

765

sub remove_hurry($) {

766

my ($player) = @_;

767

$pdata{$player}{hurry_save_img} and

768

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

769

$pdata{$player}{hurry_save_img} = undef;

770

}

771

772

773

#- ----------- mainloop helper --------------------------------------------

774

775

sub update_game() {

776

777

if ($pdata{state} eq 'game') {

778

handle_game_events();

779

iter_players {

780

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

781

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

782

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

783

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

784

$pdata{$::p}{hurry}++;

785

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

786

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

787

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

788

if ($oddness) {

789

play_sound('hurry');

790

print_hurry($::p);

791

} else {

792

remove_hurry($::p)

793

}

794

}

795

$pdata{$::p}{hurry_oddness} = $oddness;

796

}

797

798

if (($actions{$::p}{fire} || $pdata{$::p}{hurry} == $TIME_HURRY_MAX) && !$launched_bubble{$::p}) {

799

play_sound('launch');

800

$launched_bubble{$::p} = $tobe_launched{$::p};

801

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

802

$tobe_launched{$::p} = undef;

803

$actions{$::p}{fire} = 0;

804

$actions{$::p}{hadfire} = 1;

805

$pdata{$::p}{hurry} = 0;

806

remove_hurry($::p);

807

}

808

809

if ($launched_bubble{$::p}) {

810

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

811

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

812

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

813

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

814

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

815

play_sound('rebound');

816

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

817

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

818

}

819

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

820

play_sound('rebound');

821

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

822

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

823

}

824

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

825

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

826

stick_bubble($launched_bubble{$::p}, $cx, $cy, $::p);

827

$launched_bubble{$::p} = undef;

828

} else {

829

foreach (@{$sticked_bubbles{$::p}}) {

830

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

831

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

832

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

833

$::p);

834

stick_bubble($launched_bubble{$::p}, $cx, $cy, $::p);

835

$launched_bubble{$::p} = undef;

836

837

#- malus generation

838

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

839

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

840

my $b = create_bubble($::p);

841

do {

842

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

843

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

844

$b->{'cy'} = 12;

845

$b->{'stick_y'} = 0;

846

foreach (@{$sticked_bubbles{$::p}}) {

847

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

848

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

849

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

850

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

851

}

852

}

853

}

854

$b->{'stick_y'}++;

855

calc_real_pos($b, $::p);

856

push @{$malus_bubble{$::p}}, $b;

857

malus_change(-1, $::p);

858

}

859

#- sort them and shift them

860

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

861

my $shifting = 0;

862

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

863

864

last;

865

}

866

}

867

}

868

}

869

870

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

871

872

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

873

$pdata{$::p}{sleeping}++;

874

} else {

875

$pdata{$::p}{sleeping} = 0;

876

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

877

}

878

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

879

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

880

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

881

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

882

}

883

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

884

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

885

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

886

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

887

}

888

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

889

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

890

if ($actions{$::p}{hadfire}) {

891

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

892

$actions{$::p}{hadfire} = 0;

893

$pdata{$::p}{ping_right}{actionlatency} = 0;

894

}

895

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

896

$pdata{$::p}{ping_right}{movelatency} = 0;

897

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

898

}

899

900

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

901

$pdata{$::p}{ping_right}{img} = 0;

902

}

903

};

904

905

verify_if_end();

906

907

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

908

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

909

if ($lost_slowdown++ > 1) {

910

$lost_slowdown = 0;

911

iter_players {

912

if ($::p eq $1) {

913

if (listlength(@{$sticked_bubbles{$::p}})) {

914

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

915

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

916

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

917

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

918

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

919

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

920

# }

921

922

if (listlength(@{$sticked_bubbles{$::p}}) == 0) {

923

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

924

if (is_1p_game()) {

925

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

926

play_sound('noh');

927

}

928

}

929

930

if (!listlength(@{$sticked_bubbles{$::p}})) {

931

$event->pump() while ($event->poll != 0);

932

}

933

} else {

934

$event->pump();

935

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

936

}

937

} else {

938

if (listlength(@{$sticked_bubbles{$::p}}) && $graphics_level > 1) {

939

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

940

destroy_bubbles($::p, $b);

941

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

942

#- be sure to redraw at least upper line

943

foreach (@{$b->{neighbours}}) {

944

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

945

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

946

}

947

}

948

}

949

};

950

951

}

952

953

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

954

put_image($imgbin{win}{$1}, $POS{centerpanel}{x}, $POS{centerpanel}{'y'});

955

if (listlength(@{$exploding_bubble{$1}}) == 0) {

956

$event->pump();

957

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

958

}

959

960

} else {

961

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

962

}

963

964

965

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

966

iter_players {

967

my $malus_end = [];

968

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

969

$b->{'y'} -= $MALUS_BUBBLE_SPEED;

970

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

971

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

972

push @$malus_end, $b;

973

}

974

}

975

listlength(@$malus_end) and @{$malus_bubble{$::p}} = difference2($malus_bubble{$::p}, $malus_end);

976

977

my $falling_end = [];

978

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

979

if ($b->{wait_fall}) {

980

$b->{wait_fall}--;

981

} else {

982

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

983

$b->{speed} += $FREE_FALL_CONSTANT;

984

}

985

push @$falling_end, $b if $b->{'y'} > 470;

986

}

987

listlength(@$falling_end) and @{$falling_bubble{$::p}} = difference2($falling_bubble{$::p}, $falling_end);

988

989

my $exploding_end = [];

990

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

991

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

992

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

993

$b->{speedy} += $FREE_FALL_CONSTANT;

994

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

995

}

996

if (listlength(@$exploding_end)) {

997

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

998

if ($pdata{state} =~ /lost (.*)/ && $::p ne $1 && listlength(@{$exploding_bubble{$::p}}) == 0 && !is_1p_game()) {

999

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

1000

}

1001

}

1002

1003

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

1004

my $state = $pdata{$::p}{ping_right}{state};

1005

$pdata{$::p}{ping_right}{movelatency} = 0;

1006

$pdata{$::p}{ping_right}{img}++;

1007

$pdata{$::p}{ping_right}{img} == listlength(@{$pinguin{$::p}{$state}})

1008

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

1009

}

1010

1011

};

1012

}

1013

1014

#- ----------- init stuff -------------------------------------------------

1015

1016

sub restart_app() {

1017

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

1018

}

1019

1020

sub print_step($) {

1021

my ($txt) = @_;

1022

print $txt;

1023

my $step if 0; $step ||= 0;

1024

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

1025

$app->flip();

1026

$step++;

1027

}

1028

1029

sub init_game() {

1030

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

1031

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

1032

foreach qw(gfx snd data);

1033

1034

print '[SDL Init] ';

1035

restart_app();

1036

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

1037

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

1038

$event = new SDL::Event;

1039

SDL::Cursor::show(0);

1040

$total_time = $app->ticks();

1041

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

1042

put_image($imgbin{loading}, 10, 10); $app->flip();

1043

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

1044

1045

print_step('[Graphics');

1046

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

1047

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

1048

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

1049

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

1050

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

1051

1052

print_step('.');

1053

add_bubble_image("balls/bubble-$_.gif") foreach (1..8);

1054

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

1055

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

1056

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

1057

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

1058

1059

$shooter = add_image("shoot/shooter.png");

1060

$canon{img}{$_} = add_image("shoot/base_$_.png") foreach (-$CANON_ROTATIONS_NB..$CANON_ROTATIONS_NB);

1061

/(\S+) (\S+) (\S+)/ and $canon{data}{$1} = [ $2, $3 ] foreach cat_("$FPATH/gfx/shoot/data"); #- quantity of shifting needed (because of crop reduction)

1062

$malus_gfx{banane} = add_image('banane.png');

1063

$malus_gfx{tomate} = add_image('tomate.png');

1064

1065

print_step('.');

1066

push @{$imgbin{paused}}, add_image("pause_$_.png") foreach (2..5);

1067

$imgbin{back_paused} = add_image('back_paused.png');

1068

$imgbin{lose} = add_image("lose_panel.png");

1069

1070

$imgbin{compressor_main} = add_image('compressor_main.png');

1071

$imgbin{compressor_ext} = add_image('compressor_ext.png');

1072

1073

$imgbin{txt_1pgame_off} = add_image('menu/txt_1pgame_off.png');

1074

$imgbin{txt_1pgame_over} = add_image('menu/txt_1pgame_over.png');

1075

$imgbin{txt_2pgame_off} = add_image('menu/txt_2pgame_off.png');

1076

$imgbin{txt_2pgame_over} = add_image('menu/txt_2pgame_over.png');

1077

$imgbin{txt_fullscreen_off} = add_image('menu/txt_fullscreen_off.png');

1078

$imgbin{txt_fullscreen_over} = add_image('menu/txt_fullscreen_over.png');

1079

$imgbin{txt_fullscreen_act_off} = add_image('menu/txt_fullscreen_act_off.png');

1080

$imgbin{txt_fullscreen_act_over} = add_image('menu/txt_fullscreen_act_over.png');

1081

$imgbin{txt_keys_off} = add_image('menu/txt_keys_off.png');

1082

$imgbin{txt_keys_over} = add_image('menu/txt_keys_over.png');

1083

$imgbin{txt_sound_off} = add_image('menu/txt_sound_off.png');

1084

$imgbin{txt_sound_over} = add_image('menu/txt_sound_over.png');

1085

$imgbin{txt_sound_act_off} = add_image('menu/txt_sound_act_off.png');

1086

$imgbin{txt_sound_act_over} = add_image('menu/txt_sound_act_over.png');

1087

$imgbin{txt_graphics_1_off} = add_image('menu/txt_graphics_1_off.png');

1088

$imgbin{txt_graphics_1_over} = add_image('menu/txt_graphics_1_over.png');

1089

$imgbin{txt_graphics_2_off} = add_image('menu/txt_graphics_2_off.png');

1090

$imgbin{txt_graphics_2_over} = add_image('menu/txt_graphics_2_over.png');

1091

$imgbin{txt_graphics_3_off} = add_image('menu/txt_graphics_3_off.png');

1092

$imgbin{txt_graphics_3_over} = add_image('menu/txt_graphics_3_over.png');

1093

$imgbin{txt_highscores_off} = add_image('menu/txt_highscores_off.png');

1094

$imgbin{txt_highscores_over} = add_image('menu/txt_highscores_over.png');

1095

$imgbin{void_panel} = add_image('menu/void_panel.png');

1096

1097

$imgbin{back_hiscores} = add_image('back_hiscores.png');

1098

$imgbin{hiscore_frame} = add_image('hiscore_frame.png');

1099

1100

$imgbin{banner_artwork} = add_image('menu/banner_artwork.png');

1101

$imgbin{banner_soundtrack} = add_image('menu/banner_soundtrack.png');

1102

$imgbin{banner_cpucontrol} = add_image('menu/banner_cpucontrol.png');

1103

1104

print_step('.');

1105

$imgbin{frozen} = add_image('intro/txt_frozen.png');

1106

$imgbin{bubble} = add_image('intro/txt_bubble.png');

1107

$imgbin{intro_penguin_imgs}->{$_} = add_image("intro/intro_$_.png") foreach (1..19);

1108

1109

iter_players {

1110

$imgbin{hurry}{$::p} = add_image("hurry_$::p.png");

1111

$pinguin{$::p}{normal} = [ map { add_image($_) } ("pinguins/base_$::p.png", map { "pinguins/base_$::p"."_extra_0$_.png" } (1..3)) ];

1112

$pinguin{$::p}{sleep} = [ add_image("pinguins/sleep_$::p.png") ];

1113

$pinguin{$::p}{left} = [ add_image("pinguins/move_left_$::p.png") ];

1114

$pinguin{$::p}{right} = [ add_image("pinguins/move_right_$::p.png") ];

1115

$pinguin{$::p}{action} = [ add_image("pinguins/action_$::p.png") ];

1116

$pinguin{$::p}{win} = [ map { add_image("pinguins/$::p"."_win_$_.png") } qw(1 2 3 4 5 6 7 8 6) ];

1117

$pinguin{$::p}{win_roll_back_index} = 4;

1118

$pinguin{$::p}{lose} = [ map { add_image("pinguins/$::p"."_loose_$_.png") } qw(1 2 3 4 5 6 7 8 9) ];

1119

$pinguin{$::p}{lose_roll_back_index} = 5;

1120

$pinguin{$::p}{win} = [ map { add_image("pinguins/$::p"."_win_$_.png") } qw(1 2 3 4 5 6 7 8 6) ];

1121

$pinguin{$::p}{walkright} = [ map { add_image("pinguins/$::p"."_dg_walk_0$_.png") } qw(1 2 3 4 5 6) ];

1122

$imgbin{win}{$::p} = add_image("win_panel_$::p.png");

1123

$pdata{$::p}{score} = 0;

1124

};

1125

print_step('] ');

1126

1127

my $lev_number = 1;

1128

my $row_numb = 0;

1129

foreach my $line (cat_("$FPATH/data/levels")) {

1130

if ($line !~ /\S/) {

1131

if ($row_numb) {

1132

$lev_number++;

1133

$row_numb = 0;

1134

}

1135

} else {

1136

my $col_numb = 0;

1137

foreach (split ' ', $line) {

1138

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

1139

$col_numb++;

1140

}

1141

$row_numb++;

1142

}

1143

}

1144

print_step("[$lev_number levels] ");

1145

1146

if ($mixer eq 'SOUND_DISABLED') {

1147

$mixer = undef;

1148

} else {

1149

if (init_sound()) {

1150

play_music('intro');

1151

$mixer->pause_music();

1152

}

1153

}

1154

1155

fb_c_stuff::init_effects($FPATH);

1156

print "Ready.\n";

1157

}

1158

1159

sub open_level($) {

1160

my ($level) = @_;

1161

1162

listlength(@{$levels{$level}}) or die "No such level or void level ($level).\n";

1163

foreach my $l (@{$levels{$level}}) {

1164

iter_players {

1165

my $img = $l->{img_num} =~ /^\d+$/ ? $bubbles_images[$l->{img_num}] : $bubbles_anim{lose};

1166

real_stick_bubble(create_bubble_given_img($img), $l->{cx}, $l->{cy}, $::p, 0);

1167

};

1168

}

1169

}

1170

1171

sub grab_key() {

1172

my $keyp;

1173

do {

1174

$event->wait();

1175

if ($event->type == SDL_KEYDOWN) {

1176

$keyp = $event->key_sym();

1177

}

1178

} while ($event->type != SDL_KEYDOWN);

1179

do { $event->wait() } while ($event->type != SDL_KEYUP);

1180

return $keyp;

1181

}

1182

1183

sub display_highscores() {

1184

1185

$imgbin{back_hiscores}->blit($apprects{main}, $app, $apprects{main});

1186

1187

$display_on_app_disabled = 1;

1188

@PLAYERS = ('p1');

1189

%POS = %POS_1P;

1190

$POS{top_limit} = $POS{init_top_limit};

1191

1192

my ($high_posx, $high_posy) = (85, 80);

1193

my $high_rect = new SDL::Rect('-x' => $POS{p1}{left_limit} & 0xFFFFFFFC, '-y' => $POS{top_limit} & 0xFFFFFFFC,

1194

'-width' => ($POS{p1}{right_limit}-$POS{p1}{left_limit}) & 0xFFFFFFFC, -height => ($POS{'initial_bubble_y'}-$POS{top_limit}-10) & 0xFFFFFFFC);

1195

1196

my $centered_print = sub($$$) {

1197

my ($x, $y, $txt) = @_;

1198

$app->print($x+($imgbin{hiscore_frame}->width-SDL_TEXTWIDTH(uc($txt)))/2 - 6,

1199

$y+$imgbin{hiscore_frame}->height - 8, uc($txt));

1200

};

1201

1202

foreach my $high (ordered_highscores()) {

1203

iter_players {

1204

@{$sticked_bubbles{$::p}} = ();

1205

@{$root_bubbles{$::p}} = ();

1206

$pdata{$::p}{newrootlevel} = 0;

1207

$pdata{$::p}{oddswap} = 0;

1208

};

1209

$imgbin{back_1p}->blit($high_rect, $background, $high_rect);

1210

open_level($high->{level});

1211

put_image($imgbin{hiscore_frame}, $high_posx - 7, $high_posy - 6);

1212

fb_c_stuff::shrink($app->{-surface}, my_display_format($background)->{-surface}, $high_posx, $high_posy, $high_rect->{-rect}, 4);

1213

$centered_print->($high_posx, $high_posy, $high->{name});

1214

$centered_print->($high_posx, $high_posy+20, "LVL-".$high->{level});

1215

my $min = int($high->{time}/60);

1216

my $sec = int($high->{time} - $min*60); length($sec) == 1 and $sec = "0$sec";

1217

$centered_print->($high_posx, $high_posy+40, "$min'$sec''");

1218

$high_posx += 100;

1219

$high_posx > 550 and $high_posx = 85, $high_posy += 190;

1220

$high_posy > 440 and last;

1221

}

1222

$app->flip();

1223

$display_on_app_disabled = 0;

1224

1225

$event->pump() while ($event->poll != 0);

1226

grab_key();

1227

}

1228

1229

sub keysym_to_char($) { my ($key) = @_; eval("$key eq SDLK_$_") and return uc($_) foreach @fbsyms::syms }

1230

1231

sub ask_from($) {

1232

my ($w) = @_;

1233

# $w->{intro} = [ 'text_intro_line1', 'text_intro_line2', ... ]

1234

# $w->{entries} = [ { q => 'question1?', a => \$var_answer1, f => 'flags' }, {...} ] flags: ONE_CHAR

1235

# $w->{outro} = 'text_outro_uniline'

1236

# $w->{erase_background} = $background_right_one

1237

1238

my $xpos_panel = (640-$imgbin{void_panel}->width)/2;

1239

my $ypos_panel = (480-$imgbin{void_panel}->height)/2;

1240

put_image($imgbin{void_panel}, $xpos_panel, $ypos_panel);

1241

1242

my $xpos;

1243

my $ypos = $ypos_panel + 5;

1244

1245

foreach my $i (@{$w->{intro}}) {

1246

my $xpos = (640-SDL_TEXTWIDTH($i))/2;

1247

$app->print($xpos, $ypos, $i);

1248

$ypos += 22;

1249

}

1250

1251

$ypos += 3;

1252

1253

my $ok = 1;

1254

entries:

1255

foreach my $entry (@{$w->{entries}}) {

1256

$xpos = (640-$imgbin{void_panel}->width)/2 + 100 - SDL_TEXTWIDTH($entry->{'q'})/2;

1257

$app->print($xpos, $ypos, $entry->{'q'});

1258

$app->flip();

1259

my $srect_mulchar_redraw = new SDL::Rect(-width => $imgbin{void_panel}->width, -height => 30,

1260

-x => $xpos + 140 - $xpos_panel, '-y' => $ypos - $ypos_panel);

1261

my $drect_mulchar_redraw = new SDL::Rect(-width => $imgbin{void_panel}->width, -height => 30,

1262

-x => $xpos + 140, '-y' => $ypos);

1263

my $txt;

1264

while (1) {

1265

my $k = grab_key();

1266

$k == SDLK_ESCAPE and $ok = 0, last entries;

1267

play_sound('typewriter');

1268

if ($entry->{f} =~ 'ONE_CHAR' || $k != SDLK_RETURN) {

1269

my $x_echo = (640-$imgbin{void_panel}->width)/2 + 200;

1270

if ($entry->{f} =~ 'ONE_CHAR') {

1271

$txt = $k;

1272

$app->print($x_echo, $ypos, keysym_to_char($k));

1273

} else {

1274

$k = keysym_to_char($k);

1275

length($k) == 1 && length($txt) < 8 and $txt .= $k;

1276

member($k, qw(BACKSPACE DELETE LEFT)) and $txt =~ s/.$//;

1277

$imgbin{void_panel}->blit($srect_mulchar_redraw, $app, $drect_mulchar_redraw);

1278

$app->print($x_echo, $ypos, $txt);

1279

}

1280

$app->flip();

1281

}

1282

$entry->{f} =~ 'ONE_CHAR' || $k == SDLK_RETURN and last;

1283

}

1284

$entry->{answer} = $txt;

1285

$ypos += 22;

1286

}

1287

1288

if ($ok) {

1289

${$_->{a}} = $_->{answer} foreach @{$w->{entries}};

1290

$xpos = (640-SDL_TEXTWIDTH($w->{outro}))/2;

1291

$ypos = (480+$imgbin{void_panel}->height)/2 - 33;

1292

$app->print($xpos, $ypos, $w->{outro});

1293

$app->flip();

1294

play_sound('menu_selected');

1295

sleep 1;

1296

} else {

1297

play_sound('cancel');

1298

}

1299

1300

erase_image_from($imgbin{void_panel}, $xpos_panel, $ypos_panel, $w->{erase_background});

1301

$app->flip();

1302

$event->pump() while ($event->poll != 0);

1303

}

1304

1305

sub new_game() {

1306

1307

$display_on_app_disabled = 1;

1308

1309

my $backgr;

1310

if (is_2p_game()) {

1311

$backgr = $imgbin{back_2p};

1312

%POS = %POS_2P;

1313

$TIME_APPEARS_NEW_ROOT = 11;

1314

$TIME_HURRY_WARN = 250;

1315

$TIME_HURRY_MAX = 375;

1316

} elsif (is_1p_game()) {

1317

$backgr = $imgbin{back_1p};

1318

%POS = %POS_1P;

1319

$TIME_APPEARS_NEW_ROOT = 8;

1320

$TIME_HURRY_WARN = 400;

1321

$TIME_HURRY_MAX = 525;

1322

$POS{top_limit} = $POS{init_top_limit};

1323

$pdata{$PLAYERS[0]}{score} = $levels{current} || "RANDOM";

1324

} else {

1325

die "oops";

1326

}

1327

1328

$backgr->blit($apprects{main}, $background_orig, $apprects{main});

1329

$background_orig->blit($apprects{main}, $background, $apprects{main});

1330

1331

iter_players {

1332

$actions{$::p}{left} = 0;

1333

$actions{$::p}{right} = 0;

1334

$actions{$::p}{fire} = 0;

1335

$angle{$::p} = $PI/2;

1336

@{$sticked_bubbles{$::p}} = ();

1337

@{$malus_bubble{$::p}} = ();

1338

@{$root_bubbles{$::p}} = ();

1339

$launched_bubble{$::p} = undef;

1340

$sticking_bubble{$::p} = undef;

1341

$pdata{$::p}{newroot} = 0;

1342

$pdata{$::p}{newroot_prelight} = 0;

1343

$pdata{$::p}{oddswap} = 0;

1344

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

1345

$pdata{$::p}{ping_right}{img} = 0;

1346

$pdata{$::p}{malus} = 0;

1347

$pdata{$::p}{hurry} = 0;

1348

$pdata{$::p}{newrootlevel} = 0;

1349

$apprects{$::p} = new SDL::Rect('-x' => $POS{$::p}{left_limit}, '-y' => $POS{top_limit},

1350

-width => $POS{$::p}{right_limit}-$POS{$::p}{left_limit}, -height => $POS{'initial_bubble_y'}-$POS{top_limit});

1351

};

1352

print_scores($background);

1353

1354

is_1p_game() and print_compressor();

1355

1356

if ($levels{current}) {

1357

open_level($levels{current});

1358

} else {

1359

foreach my $cy (0..4) {

1360

foreach my $cx (0..(6+odd($cy+1))) {

1361

my $b = create_bubble();

1362

real_stick_bubble($b, $cx, $cy, $PLAYERS[0], 0); #- this doesn't map well to the 'iter_players' subroutine..

1363

is_2p_game() and real_stick_bubble(create_bubble_given_img($b->{img}), $cx, $cy, $PLAYERS[1], 0);

1364

}

1365

}

1366

}

1367

1368

$next_bubble{$PLAYERS[0]} = create_bubble($PLAYERS[0]);

1369

generate_new_bubble($PLAYERS[0]);

1370

if (is_2p_game()) {

1371

$next_bubble{$PLAYERS[1]} = create_bubble_given_img($tobe_launched{$PLAYERS[0]}->{img});

1372

generate_new_bubble($PLAYERS[1], $next_bubble{$PLAYERS[0]}->{img});

1373

}

1374

1375

if ($graphics_level == 1) {

1376

$background->blit($apprects{main}, $app, $apprects{main});

1377

$app->flip();

1378

} else {

1379

fb_c_stuff::effect($app->{-surface}, my_display_format($background)->{-surface});

1380

}

1381

1382

$display_on_app_disabled = 0;

1383

1384

$event->pump() while ($event->poll != 0);

1385

$pdata{state} = 'game';

1386

}

1387

1388

sub ordered_highscores() { return sort { $b->{level} <=> $a->{level} || $a->{time} <=> $b->{time} } @$HISCORES }

1389

1390

sub handle_new_hiscores() {

1391

is_1p_game() or return;

1392

1393

my @ordered = ordered_highscores();

1394

my $worst = pop @ordered;

1395

1396

my $total_seconds = ($app->ticks() - $time_1pgame)/1000;

1397

1398

if (listlength(@$HISCORES) == 10

1399

&& ($levels{current} < $worst->{level}

1400

|| $levels{current} == $worst->{level} && $total_seconds > $worst->{time})) {

1401

return;

1402

}

1403

1404

play_sound('applause');

1405

1406

my %new_entry;

1407

$new_entry{level} = $levels{current};

1408

$new_entry{time} = $total_seconds;

1409

ask_from({ intro => [ 'CONGRATULATIONS !', "YOU HAVE A HIGHSCORE !", '' ],

1410

entries => [ { 'q' => 'YOUR NAME ?', 'a' => \$new_entry{name} } ],

1411

outro => 'GREAT GAME !',

1412

erase_background => $background,

1413

});

1414

1415

return if $new_entry{name} eq '';

1416

1417

push @$HISCORES, \%new_entry;

1418

if (listlength(@$HISCORES) == 11) {

1419

my @high = ordered_highscores();

1420

pop @high;

1421

$HISCORES = \@high;

1422

}

1423

1424

output($hiscorefile, Data::Dumper->Dump([$HISCORES], [qw(HISCORES)]));

1425

display_highscores();

1426

}

1427

1428

1429

#- ----------- mainloop ---------------------------------------------------

1430

1431

sub maingame() {

1432

my $synchro_ticks = $app->ticks();

1433

1434

handle_graphics(\&erase_image);

1435

update_game();

1436

handle_graphics(\&put_image);

1437

1438

$app->update(@update_rects);

1439

@update_rects = ();

1440

1441

my $to_wait = $TARGET_ANIM_SPEED - ($app->ticks() - $synchro_ticks);

1442

$to_wait > 0 and fb_c_stuff::fbdelay($to_wait);

1443

}

1444

1445

1446

#- ----------- intro stuff ------------------------------------------------

1447

1448

sub intro() {

1449

1450

my %storyboard = (

1451

sleeping => {

1452

start => { type => 'time', value => 0 },

1453

type => 'penguin',

1454

animations => [ qw(1 2 3 4 5 6 7 6 5 4 3 2) ],

1455

1456

music => { start => { type => 'time', value => 1 } },

1457

bubble_fall1 => { start => { type => 'synchro', value => 0x01 },

1458

type => 'bubble_falling', img => 2, xpos => 200, xaccel => -1.5 },

1459

bubble_fall2 => { start => { type => 'synchro', value => 0x02 },

1460

type => 'bubble_falling', img => 3, xpos => 350, xaccel => 1 },

1461

bubble_fall3 => { start => { type => 'synchro', value => 0x03 },

1462

type => 'bubble_falling', img => 4, xpos => 400, xaccel => 2 },

1463

eyes_moving => {

1464

start => { type => 'synchro', value => 0x21 },

1465

type => 'penguin',

1466

animations => [ qw(8 9 10 11 12 11 10 9) ],

1467

1468

arms_moving => {

1469

start => { type => 'synchro', value => 0x22 },

1470

type => 'penguin',

1471

animations => [ qw(12 13 14 15 14 13) ],

1472

1473

fear => {

1474

start => { type => 'synchro', value => 0x31 },

1475

type => 'penguin',

1476

animations => [ qw(15 16 17 18 19 18 17 16) ],

1477

1478

txt_frozen_arriving => {

1479

start => { type => 'synchro', value => 0x31 },

1480

type => 'bitmap_animation',

1481

img => $imgbin{frozen},

1482

finalpos => { x => 300, 'y' => 100 },

1483

factor => 1,

1484

1485

txt_bubble_arriving => {

1486

start => { type => 'synchro', value => 0x32 },

1487

type => 'bitmap_animation',

1488

img => $imgbin{bubble},

1489

finalpos => { x => 340, 'y' => 155 },

1490

factor => 4,

1491

1492

);

1493

1494

my %sb_params = (

1495

animation_speed => 20

1496

);

1497

1498

1499

my $start_menu;

1500

my ($slowdown_number, $slowdown_frame);

1501

1502

if ($mixer && 0) { #- temporarily desactivate the intro storyboard because it's not finised yet

1503

my $back_start = new SDL::Surface(-name => "$FPATH/intro/back_intro.png");

1504

$back_start->blit($apprects{main}, $app, $apprects{main});

1505

$app->flip();

1506

1507

my $penguin;

1508

my @bubbles_falling;

1509

my @bitmap_animations;

1510

1511

my $anim_step = -1;

1512

my $start_time = $app->ticks;

1513

my $current_time = $start_time;

1514

1515

while (!$start_menu) {

1516

my $synchro_ticks = $app->ticks();

1517

1518

my $current_time_ = int(($app->ticks - $start_time)/1000);

1519

my $anim_step_ = fb_c_stuff::get_synchro_value();

1520

1521

if ($anim_step_ != $anim_step || $current_time_ != $current_time) {

1522

$anim_step = $anim_step_;

1523

$current_time = $current_time_;

1524

printf "Anim step: %12s Time: <$current_time>\n", sprintf "<0x%02x>", $anim_step;

1525

1526

foreach my $evt (keys %storyboard) {

1527

next if $storyboard{$evt}->{already};

1528

if ($storyboard{$evt}->{start}->{type} eq 'time' && $storyboard{$evt}->{start}->{value} <= $current_time

1529

|| $storyboard{$evt}->{start}->{type} eq 'synchro' && $storyboard{$evt}->{start}->{value} eq $anim_step) {

1530

$storyboard{$evt}->{already} = 1;

1531

print "*** Starting <$evt>\n";

1532

$evt eq 'music' and $mixer->resume_music();

1533

if ($storyboard{$evt}->{type} eq 'penguin') {

1534

$penguin = { animations => $storyboard{$evt}->{animations},

1535

current_anim => 0,

1536

anim_step => $sb_params{animation_speed} };

1537

}

1538

if ($storyboard{$evt}->{type} eq 'bubble_falling') {

1539

push @bubbles_falling, { img => $bubbles_images[$storyboard{$evt}->{img}], 'y' => 0, speed => 3,

1540

x => $storyboard{$evt}->{xpos}, xaccel => $storyboard{$evt}->{xaccel} };

1541

}

1542

if ($storyboard{$evt}->{type} eq 'bitmap_animation') {

1543

push @bitmap_animations, { img => $storyboard{$evt}->{img}, 'y' => 0,

1544

x => $storyboard{$evt}->{finalpos}->{x},

1545

finaly => $storyboard{$evt}->{finalpos}->{'y'},

1546

factor => $storyboard{$evt}->{factor},

1547

};

1548

}

1549

}

1550

}

1551

1552

$anim_step == 0x09 and $start_menu = 1;

1553

}

1554

1555

if ($penguin) {

1556

$penguin->{anim_step}++;

1557

if ($penguin->{anim_step} >= $sb_params{animation_speed}) {

1558

my $img_number = ${$penguin->{animations}}[$penguin->{current_anim}];

1559

erase_image_from($imgbin{intro_penguin_imgs}->{$img_number}, 260, 293, $back_start);

1560

$penguin->{anim_step} = 0;

1561

$penguin->{current_anim}++;

1562

$penguin->{current_anim} == listlength(@{$penguin->{animations}}) and $penguin->{current_anim} = 0;

1563

$img_number = ${$penguin->{animations}}[$penguin->{current_anim}];

1564

put_image($imgbin{intro_penguin_imgs}->{$img_number}, 260, 293);

1565

}

1566

}

1567

1568

foreach my $b (@bubbles_falling) {

1569

erase_image_from($b->{img}, $b->{x}, $b->{'y'}, $back_start);

1570

$b->{'x'} += $b->{xaccel};

1571

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

1572

if ($b->{'y'} >= 360 && !$b->{already_rebound}) {

1573

$b->{already_rebound} = 1;

1574

$b->{'y'} = 2*360 - $b->{'y'};

1575

$b->{speed} *= -0.5;

1576

}

1577

$b->{speed} += $FREE_FALL_CONSTANT;

1578

$b->{kill} = $b->{'y'} > 470;

1579

$b->{kill} or put_image($b->{img}, $b->{x}, $b->{'y'});

1580

}

1581

@bubbles_falling = grep { !$_->{kill} } @bubbles_falling;

1582

1583

erase_image_from($_->{img}, $_->{x}, $_->{'y'}, $back_start) foreach @bitmap_animations;

1584

foreach my $b (@bitmap_animations) {

1585

foreach (0..$slowdown_frame) {

1586

$b->{'y'} = $b->{'finaly'} - 200*cos(3*$b->{step})/exp($b->{step}*$b->{step});

1587

$b->{step} += 0.015 * $b->{factor};

1588

}

1589

}

1590

$slowdown_frame = 0;

1591

put_image($_->{img}, $_->{x}, $_->{'y'}) foreach @bitmap_animations;

1592

1593

$app->update(@update_rects);

1594

@update_rects = ();

1595

1596

my $to_wait = $TARGET_ANIM_SPEED - ($app->ticks() - $synchro_ticks);

1597

if ($to_wait > 0) {

1598

$app->delay($to_wait);

1599

} else {

1600

# print "slow by: <$to_wait>\n";

1601

$slowdown_number += -$to_wait;

1602

if ($slowdown_number > $TARGET_ANIM_SPEED) {

1603

$slowdown_frame = int($slowdown_number / $TARGET_ANIM_SPEED);

1604

$slowdown_number -= $slowdown_frame * $TARGET_ANIM_SPEED;

1605

# print "skip frames: <$slowdown_frame>\n";

1606

}

1607

}

1608

1609

$event->pump();

1610

$event->poll != 0 && $event->type == SDL_KEYDOWN && member($event->key_sym(), (SDLK_RETURN, SDLK_SPACE, SDLK_KP_ENTER, SDLK_ESCAPE))

1611

and $start_menu = 2;

1612

1613

}

1614

}

1615

1616

1617

# if ($start_menu == 1) {

1618

# my $bkg = new SDL::Surface(-width => $app->width, -height => $app->height, -depth => 32, -Amask => '0 but true');

1619

# $app->blit($apprects{main}, $bkg, $apprects{main});

1620

# menu(1, $bkg);

1621

# } else {

1622

menu(1);

1623

# }

1624

}

1625

1626

1627

#- ----------- menu stuff -------------------------------------------------

1628

1629

sub menu {

1630

my ($from_intro, $back_from_intro) = @_;

1631

1632

handle_new_hiscores();

1633

1634

$mixer and $mixer->music_paused() and $mixer->resume_music();

1635

if (!$from_intro) {

1636

play_music('intro', 8);

1637

}

1638

1639

my $back_start;

1640

if (!$from_intro || !$back_from_intro) {

1641

$back_start = $imgbin{backstartfull};

1642

$back_start->blit($apprects{main}, $app, $apprects{main});

1643

} else {

1644

$back_start = $back_from_intro;

1645

}

1646

1647

my $invalidate_all;

1648

my $rest_app = sub { restart_app(); $back_start->blit($apprects{main}, $app, $apprects{main}); $app->flip(); $invalidate_all->(); 1; };

1649

1650

my $menu_start_sound = sub {

1651

if (!init_sound()) {

1652

return 0;

1653

} else {

1654

play_music('intro', 8);

1655

return 1;

1656

}

1657

};

1658

1659

my $menu_stop_sound = sub {

1660

if ($mixer && $mixer->playing_music()) {

1661

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

1662

$mixer->playing_music() and $mixer->fade_out_music(500); $app->delay(450);

1663

$app->delay(10) while $mixer->playing_music(); #- mikmod will segfault if we try to load a music while old one is still fading out

1664

}

1665

$mixer = undef;

1666

return 1;

1667

};

1668

1669

my $menu_display_highscores = sub {

1670

display_highscores();

1671

1672

$back_start->blit($apprects{main}, $app, $apprects{main});

1673

$app->flip();

1674

$invalidate_all->();

1675

};

1676

1677

my $change_keys = sub {

1678

ask_from({ intro => [ 'PLEASE ENTER NEW KEYS' ],

1679

entries => [

1680

{ 'q' => 'RIGHT-PL/LEFT?', 'a' => \$KEYS->{p2}{left}, f => 'ONE_CHAR' },

1681

{ 'q' => 'RIGHT-PL/RIGHT?', 'a' => \$KEYS->{p2}{right}, f => 'ONE_CHAR' },

1682

{ 'q' => 'RIGHT-PL/FIRE?', 'a' => \$KEYS->{p2}{fire}, f => 'ONE_CHAR' },

1683

{ 'q' => 'LEFT-PL/LEFT?', 'a' => \$KEYS->{p1}{left}, f => 'ONE_CHAR' },

1684

{ 'q' => 'LEFT-PL/RIGHT?', 'a' => \$KEYS->{p1}{right}, f => 'ONE_CHAR' },

1685

{ 'q' => 'LEFT-PL/FIRE?', 'a' => \$KEYS->{p1}{fire}, f => 'ONE_CHAR' },

1686

1687

outro => 'THANKS !',

1688

erase_background => $back_start

1689

});

1690

$invalidate_all->();

1691

};

1692

1693

my ($MENU_FIRSTY, $SPACING, $CATEGORIES_SPACING) = (50, 52, 15);

1694

my %menupos = ( '1pgame' => { 'x' => 58, 'y' => $MENU_FIRSTY },

1695

'2pgame' => { 'x' => 58, 'y' => $MENU_FIRSTY + $SPACING },

1696

'fullscreen' => { 'x' => 58, 'y' => $MENU_FIRSTY + 2 * $SPACING + $CATEGORIES_SPACING },

1697

'graphics' => { 'x' => 58, 'y' => $MENU_FIRSTY + 3 * $SPACING + $CATEGORIES_SPACING },

1698

'sound' => { 'x' => 58, 'y' => $MENU_FIRSTY + 4 * $SPACING + $CATEGORIES_SPACING },

1699

'keys' => { 'x' => 58, 'y' => $MENU_FIRSTY + 5 * $SPACING + $CATEGORIES_SPACING },

1700

'highscores' => { 'x' => 58, 'y' => $MENU_FIRSTY + 6 * $SPACING + $CATEGORIES_SPACING },

1701

);

1702

my %menu_entries = ( '1pgame' => { pos => 1, type => 'rungame', run => sub { @PLAYERS = ('p1'); $levels{current} = 1; $time_1pgame = $app->ticks() } },

1703

'2pgame' => { pos => 2, type => 'rungame', run => sub { @PLAYERS = qw(p1 p2); $levels{current} = undef; } },

1704

'fullscreen' => { pos => 3, type => 'toggle', act => sub { $fullscreen = 1; $rest_app->() }, unact => sub { $fullscreen = 0; $rest_app->() }, value => $fullscreen },

1705

'graphics' => { pos => 4, type => 'range', valuemin => 1, valuemax => 3, change => sub { $graphics_level = $_[0] }, value => $graphics_level },

1706

'sound' => { pos => 5, type => 'toggle', act => sub { $menu_start_sound->() }, unact => sub { $menu_stop_sound->() }, value => $mixer },

1707

'keys' => { pos => 6, type => 'run', run => sub { $change_keys->() } },

1708

'highscores' => { pos => 7, type => 'run', run => sub { $menu_display_highscores->() } },

1709

);

1710

my $current_pos if 0; $current_pos ||= 1;

1711

my @menu_invalids;

1712

$invalidate_all = sub { push @menu_invalids, $menu_entries{$_}->{pos} foreach keys %menu_entries };

1713

1714

my $menu_update = sub {

1715

@update_rects = ();

1716

foreach my $m (keys %menu_entries) {

1717

member($menu_entries{$m}->{pos}, @menu_invalids) or next;

1718

my $txt = "txt_$m";

1719

$menu_entries{$m}->{type} eq 'toggle' && $menu_entries{$m}->{value} and $txt .= "_act";

1720

$menu_entries{$m}->{type} eq 'range' and $txt .= "_$menu_entries{$m}->{value}";

1721

$txt .= $menu_entries{$m}->{pos} == $current_pos ? '_over' : '_off';

1722

erase_image_from($imgbin{$txt}, $menupos{$m}{'x'}, $menupos{$m}{'y'}, $back_start);

1723

put_image($imgbin{$txt}, $menupos{$m}{'x'}, $menupos{$m}{'y'});

1724

}

1725

@menu_invalids = ();

1726

$app->update(@update_rects);

1727

};

1728

1729

$app->flip();

1730

$invalidate_all->();

1731

$menu_update->();

1732

$event->pump() while ($event->poll != 0);

1733

1734

my $start_game = 0;

1735

my ($BANNER_START, $BANNER_SPACING) = (720, 80);

1736

my %banners = (artwork => $BANNER_START,

1737

soundtrack => $BANNER_START + $imgbin{banner_artwork}->width + $BANNER_SPACING,

1738

cpucontrol => $BANNER_START + $imgbin{banner_artwork}->width + $BANNER_SPACING + $imgbin{banner_soundtrack}->width + $BANNER_SPACING);

1739

my ($BANNER_MINX, $BANNER_MAXX, $BANNER_Y) = (39, 296, 445);

1740

my $banners_max = $banners{cpucontrol} - (640 - ($BANNER_MAXX - $BANNER_MINX)) + $BANNER_SPACING;

1741

my $banner_rect = new SDL::Rect(-width => $BANNER_MAXX-$BANNER_MINX, -height => 30, '-x' => $BANNER_MINX, '-y' => $BANNER_Y);

1742

1743

while (!$start_game) {

1744

my $synchro_ticks = $app->ticks();

1745

1746

$graphics_level > 1 and $back_start->blit($banner_rect, $app, $banner_rect);

1747

1748

$event->pump();

1749

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

1750

if ($event->type == SDL_KEYDOWN) {

1751

my $keypressed = $event->key_sym();

1752

if (member($keypressed, (SDLK_DOWN, SDLK_RIGHT)) && $current_pos < max(map { $menu_entries{$_}->{pos} } keys %menu_entries)) {

1753

$current_pos++;

1754

push @menu_invalids, $current_pos-1, $current_pos;

1755

play_sound('menu_change');

1756

}

1757

if (member($keypressed, (SDLK_UP, SDLK_LEFT)) && $current_pos > 1) {

1758

$current_pos--;

1759

push @menu_invalids, $current_pos, $current_pos+1;

1760

play_sound('menu_change');

1761

}

1762

1763

if (member($keypressed, (SDLK_RETURN, SDLK_SPACE, SDLK_KP_ENTER))) {

1764

play_sound('menu_selected');

1765

push @menu_invalids, $current_pos;

1766

foreach my $m (keys %menu_entries) {

1767

if ($menu_entries{$m}->{pos} == $current_pos) {

1768

if ($menu_entries{$m}->{type} =~ /^run/) {

1769

$menu_entries{$m}->{run}->();

1770

$menu_entries{$m}->{type} eq 'rungame' and $start_game = 1;

1771

}

1772

if ($menu_entries{$m}->{type} eq 'toggle') {

1773

$menu_entries{$m}->{value} = !$menu_entries{$m}->{value};

1774

if ($menu_entries{$m}->{value}) {

1775

$menu_entries{$m}->{act}->() or $menu_entries{$m}->{value} = 0;

1776

} else {

1777

$menu_entries{$m}->{unact}->() or $menu_entries{$m}->{value} = 1;

1778

}

1779

}

1780

if ($menu_entries{$m}->{type} eq 'range') {

1781

$menu_entries{$m}->{value}++;

1782

$menu_entries{$m}->{value} > $menu_entries{$m}->{valuemax}

1783

and $menu_entries{$m}->{value} = $menu_entries{$m}->{valuemin};

1784

$menu_entries{$m}->{change}->($menu_entries{$m}->{value});

1785

}

1786

}

1787

}

1788

}

1789

1790

$keypressed == SDLK_ESCAPE and exit 0;

1791

}

1792

$menu_update->();

1793

}

1794

1795

if ($graphics_level > 1) {

1796

my $banner_pos if 0;

1797

$banner_pos ||= 670;

1798

foreach my $b (keys %banners) {

1799

my $xpos = $banners{$b} - $banner_pos;

1800

my $image = $imgbin{"banner_$b"};

1801

1802

$xpos > $banners_max/2 and $xpos = $banners{$b} - ($banner_pos + $banners_max);

1803

1804

if ($xpos < $BANNER_MAXX && $xpos + $image->width >= 0) {

1805

my $irect = new SDL::Rect(-width => min($image->width+$xpos, $BANNER_MAXX-$BANNER_MINX), -height => $image->height, -x => -$xpos);

1806

$image->blit($irect, $app, new SDL::Rect(-x => $BANNER_MINX, '-y' => $BANNER_Y));

1807

}

1808

}

1809

$banner_pos++;

1810

$banner_pos >= $banners_max and $banner_pos = 1;

1811

}

1812

$app->update($banner_rect);

1813

1814

my $to_wait = $TARGET_ANIM_SPEED - ($app->ticks() - $synchro_ticks);

1815

$to_wait > 0 and $app->delay($to_wait);

1816

}

1817

1818

#- for $KEYS, try hard to keep SDLK_<key> instead of integer value in rcfile

1819

my $KEYS_;

1820

foreach my $p (keys %$KEYS) {

1821

foreach my $k (keys %{$KEYS->{$p}}) {

1822

eval("$KEYS->{$p}->{$k} eq SDLK_$_") and $KEYS_->{$p}->{$k} = "SDLK_$_" foreach @fbsyms::syms;

1823

}

1824

}

1825

my $dump = Data::Dumper->Dump([$fullscreen, $graphics_level, $KEYS_], [qw(fullscreen graphics_level KEYS)]);

1826

$dump =~ s/'SDLK_(\w+)'/SDLK_$1/g;

1827

output($rcfile, $dump);

1828

1829

iter_players {

1830

!is_1p_game() and $pdata{$::p}{score} = 0;

1831

};

1832

play_music(is_1p_game() ? 'main1p' : 'main2p');

1833

}

1834

1835

1836

1837

#- ----------- main -------------------------------------------------------

1838

1839

init_game();

1840

1841

$direct or intro();

1842

1843

new_game();

1844

1845

1846

while (1) {

1847

eval { maingame() };

1848

if ($@) {

1849

if ($@ =~ /^new_game/) {

1850

new_game();

1851

} elsif ($@ =~ /^quit/) {

1852

menu();

1853

new_game();

1854

} else {

1855

die;

1856

}

1857

}

1858

}

Older »