Apr 28, 2011
SDL Perl をいじってみた (3)
今回はスコア表示を変更してゲームオーバー条件を付け、ゲームオーバー状態から RETURNキーを押すと最初から再スタート出来るようにしてみました。←→キーで左右の移動、qキーまたは ESCキーで終了するのは前のままです。
ライブラリは前回同様、SDL に加えて png画像の読み込みに SDL_image、truetypeフォントの読み込みに SDL_ttf を利用しています。また、Perl で使っている SDL Perl のバージョンは 2.532 です。2.2.6以前のバージョンでは動きません。残念な事に debian や ubuntu の SDL Perlパッケージ、libsdl-perl のバージョンは現時点では一番新しくても 2.2.5 なので、CPAN からインストールするしかありません。

ゲームオーバーの条件を付けた事で、だらだらとなんとなくソウルジェムを受け止めるだけの何かが、また少しだけゲームに近付いた気がします。
madoka.png と soul_gem.png


ソウルジェム以外のアイテム、例えばティーカップやきゅぅべえとかもランダムなタイミングでいくつも降らせてみたり、何かの条件を付けてまどかに矢を射させたりしてみたいのですけども、そもそもゲームの作り方を良く知らないぽちなので、実現するにはまだまだ知識が必要なようです。
教えて、ゲームのすごいひと!
#!/usr/local/bin/perl
use strict;
use warnings;
use SDL;
use SDL::Events;
use SDLx::App;
use SDLx::Rect;
use SDLx::Sprite;
use SDLx::Text;
my $error_limit = 10; # ゲームオーバーになるエラー数
# ウィンドウ全体の準備
my $app = SDLx::App->new(
width => 512,
height => 384,
title => 'Catch the Soul Gem!',
dt => 0.02,
exit_on_quit => 1,
);
# 自キャラの準備
my $player = {
rect => SDLx::Rect->new( $app->w / 2 - 16, $app->h / 5 * 4, 32, 32 ),
v_x => 0,
catch => 0,
error => 0,
};
# 自キャラ画像を入れる
my $player_character = SDLx::Sprite->new(
image => 'madoka.png', # 画像置き場へのパス
rect => $player->{rect},
);
# アイテムの準備
my $item = {
rect => SDLx::Rect->new( int( rand( $app->w ) ) - 16, 0, 32, 32 ),
v_y => 4,
};
# アイテム画像を入れる
my $item_character = SDLx::Sprite->new(
image => 'soul_gem.png', # 画像置き場のパス
rect => $item->{rect},
);
# キャッチスコアの準備
my $catch = SDLx::Text->new(
font => 'VL-Gothic-Regular.ttf', # この行削除ならシステムデフォルト
h_align => 'left',
);
# エラースコアの準備
my $error = SDLx::Text->new(
font => 'VL-Gothic-Regular.ttf', # この行削除ならシステムデフォルト
h_align => 'right',
);
# 表示
$app->add_show_handler(
sub {
$app->draw_rect( [ 0, 0, $app->w, $app->h - 45 ], 0x007bbbff ); # 空
$app->draw_rect( [ 0, $app->h - 45, $app->w, 45 ], 0xc3d825ff ); # 地面
$player_character->draw( $app ); # 自キャラ
$item_character->draw( $app ); # アイテム
$catch->write_to( $app, '昇天:' . $player->{catch} ); # キャッチスコア
$error->write_to( $app, '絶望:' . $player->{error} ); # エラースコア
if ( $player->{error} >= $error_limit ) { # ゲームオーバーだったら表示
$catch->write_xy( $app, 140, 170,
'救った魔法少女:' . $player->{catch} . '人' );
}
# CPU使用率が 100% に振り切れるようならディレイを挟んでも良いかも?
#$app->delay( 10 );
$app->update;
}
);
# 自キャラの動き
$app->add_move_handler(
sub {
my ( $step, $app ) = @_;
my $v_x = $player->{v_x};
unless ( $player->{error} >= $error_limit ) {
# 自キャラ座標の変化
$player->{rect}->x( $player->{rect}->x + ( $v_x * $step ) );
# 左の移動限度
if ( $player->{rect}->left <= 0 ) {
$player->{rect}->left( 0 );
}
# 右の移動限度
elsif ( $player->{rect}->right >= $app->w ) {
$player->{rect}->right( $app->w );
}
}
}
);
# アイテムの動き
$app->add_move_handler(
sub {
my ( $step, $app ) = @_;
my $v_y = $item->{v_y};
unless ( $player->{error} >= $error_limit ) {
# アイテム座標の変化
$item->{rect}->y( $item->{rect}->y + ( $v_y * $step ) );
# 衝突した?
if ( &check_collision( $item->{rect}, $player->{rect} ) ) {
$player->{catch}++;
&reset_item;
}
# 下端まで行き着いた?
elsif ( $item->{rect}->top >= $app->h ) {
$player->{error}++;
&reset_item;
}
}
}
);
# 自キャラの操作
$app->add_event_handler(
sub {
my ( $event, $app ) = @_;
# キーを押し込んだ場合
if ( $event->type == SDL_KEYDOWN ) {
# ←キーを押し込んで左へ
if ( $event->key_sym == SDLK_LEFT ) {
$player->{v_x} = -2;
}
# →キーを押し込んで右へ
elsif ( $event->key_sym == SDLK_RIGHT ) {
$player->{v_x} = 2.4;
}
# RETURNキーを押し込んで再スタート
elsif ( $event->key_sym == SDLK_RETURN ) {
$player->{catch} = 0;
$player->{error} = 0;
}
# qキーまたは ESCキーを押して終了
elsif (
$event->key_sym == SDLK_q
or $event->key_sym == SDLK_ESCAPE
) {
$app->stop();
}
}
# キーを離した場合
elsif ( $event->type == SDL_KEYUP ) {
# ←キーや→キーを離したら自キャラが止まる
if (
$event->key_sym == SDLK_LEFT
or $event->key_sym == SDLK_RIGHT
) {
$player->{v_x} = 0;
}
}
}
);
# ループ開始
$app->run;
# 衝突判定
sub check_collision {
my ($A, $B) = @_;
return if ( $A->bottom < $B->top + 16 ); # 自キャラ上半分の衝突判定を削る
return if ( $A->right < $B->left );
return if ( $A->left > $B->right );
# 衝突
return 1;
}
# アイテムをリセット
sub reset_item {
$item->{rect}->y( 0 ); # 上端の
$item->{rect}->x( int( rand( $app->w) ) - 16 ); # ランダムな水平位置
$item->{v_y} = int( rand( 3 ) ) + 3; # ランダムな速度で再出現
}
Posted at 20:55
in perl
| Comments/Trackbacks ()
Comments/Trackbacks
http://pochi.usamimi.info/blog/perl/SDL_Perl_game04.
writeback message: