159 lines
3.8 KiB
Perl
159 lines
3.8 KiB
Perl
package PerlRPG::Drawing;
|
|
use strict;
|
|
require Exporter;
|
|
use SDL;
|
|
use SDL::Event;
|
|
use SDLx::App;
|
|
use SDLx::Sprite;
|
|
use SDLx::Sprite::Animated;
|
|
use SDLx::Text;
|
|
use PerlRPG::Console;
|
|
use PerlRPG::Game;
|
|
use PerlRPG::Assets;
|
|
|
|
use vars qw/@ISA @EXPORT @EXPORT_OK %VisibleSprites/;
|
|
@ISA = qw/Exporter/;
|
|
@EXPORT = qw/ ShowSprite HideSprite MoveSprite SetBackgroundColor RenderSprites DrawSpeech/;
|
|
@EXPORT_OK = ();
|
|
|
|
# FIXME - This should be exported already?
|
|
*GetOption = \&PerlRPG::Game::GetOption;
|
|
|
|
# FIXME - This should be a setable option
|
|
my $speech_border = 5;
|
|
|
|
sub DrawSpeech {
|
|
my($sayer, $text)=@_;
|
|
my $app = GetOption('App');
|
|
|
|
my $sprite = GetAsset($sayer->{'Sprite'});
|
|
my $sprite_x = $app->width() - $sprite->clip()->w();
|
|
my $sprite_y = $app->height() - $sprite->clip()->h();
|
|
my $sprite_h = $sprite->clip()->h();
|
|
$sprite = undef; # ShowSprite may unload this, we don't want to keep a handle to it
|
|
ShowSprite('_SayerSprite', $sayer->{'Sprite'}, $sprite_x, $sprite_y, 254, @{ $sayer->{'SpriteOpts'} });
|
|
|
|
my $text_obj = SDLx::Text->new();
|
|
$text_obj->color( $sayer->{'TextColor'} );
|
|
$text_obj->text( $text );
|
|
|
|
my $surface = SDLx::Surface->new( width => $sprite_x,
|
|
height => $sprite_h,
|
|
color => [0, 0, 0, 255],
|
|
);
|
|
$surface->draw_rect( [ $speech_border,
|
|
$speech_border,
|
|
$surface->width()-2*$speech_border,
|
|
$surface->height()-2*$speech_border ],
|
|
[0, 0, 0, 192]
|
|
);
|
|
|
|
my $text_x = ($surface->width() - $text_obj->w())/2;
|
|
my $text_y = ($surface->height() - $text_obj->h())/2;
|
|
$text_obj->write_xy( $surface, $text_x, $text_y );
|
|
|
|
$sprite = SDLx::Sprite->new( surface => $surface );
|
|
$VisibleSprites{'_SayerText'} = {
|
|
'Depth' => 255,
|
|
'X' => 0,
|
|
'Y' => $app->height() - $surface->height(),
|
|
'Sprite' => $sprite,
|
|
};
|
|
|
|
return 1;
|
|
}
|
|
|
|
sub ShowSprite {
|
|
my($name, $file, $x, $y, $d, @opt)=@_;
|
|
LogData(DEBUG, "Showing sprite $file as $name");
|
|
|
|
my $t = GetAssetType($file);
|
|
if($t ne 'Sprite' && $t ne 'ASprite') {
|
|
LogData(WARN, "Unable to ShowSprite on non-sprite asset '$file'");
|
|
return;
|
|
}
|
|
|
|
my $a = GetAsset($file);
|
|
if($t eq 'ASprite') {
|
|
# Unload the asset so that future versions of the same name will be fresh copies
|
|
UnloadAsset($file);
|
|
|
|
# Start animation
|
|
$a->start();
|
|
}
|
|
|
|
foreach my $o (@opt) {
|
|
my($name, $val)=$o=~/^\s*(\S+?)=(\S*)/;
|
|
$name = $o unless($name);
|
|
if($o eq 'Reverse' || $o eq 'Circular') {
|
|
$a->type($o);
|
|
} elsif($name eq 'max_loops') {
|
|
$a->max_loops($val);
|
|
} elsif($o eq 'flip') {
|
|
# FIXME - This doesn't work
|
|
my $s=$a->surface();
|
|
$s->flip();
|
|
$a->surface($s);
|
|
} else {
|
|
LogData(WARN, "Unknown option in ShowSprite '$o' - '$name'='$val'");
|
|
}
|
|
}
|
|
|
|
$VisibleSprites{$name}={
|
|
'Depth' => $d,
|
|
'X' => $x,
|
|
'Y' => $y,
|
|
'Sprite' => $a,
|
|
};
|
|
return 1;
|
|
}
|
|
|
|
sub HideSprite {
|
|
my($name)=@_;
|
|
delete $VisibleSprites{$name};
|
|
}
|
|
|
|
sub MoveSprite {
|
|
my($name, $x, $y)=@_;
|
|
return undef unless(exists $VisibleSprites{$name});
|
|
$VisibleSprites{$name}{'X'} = $x;
|
|
$VisibleSprites{$name}{'Y'} = $y;
|
|
}
|
|
|
|
sub SetBackgroundColor {
|
|
my $color;
|
|
if(!@_) {
|
|
$color = [0, 0, 0, 255];
|
|
} elsif(ref $_[0]) {
|
|
$color = $_[0];
|
|
} else {
|
|
$color = [@_];
|
|
}
|
|
|
|
# Force alpha channel?
|
|
$color->[3]=255;
|
|
|
|
my $app = GetOption('App');
|
|
my $surface = SDLx::Surface->new(width => $app->width(), height => $app->height());
|
|
$surface->draw_rect([0, 0, $surface->width(), $surface->height()], $color);
|
|
my $sprite = SDLx::Sprite->new( surface => $surface );
|
|
$VisibleSprites{'Background'}={
|
|
'Depth' => -1,
|
|
'X' => 0,
|
|
'Y' => 0,
|
|
'Sprite' => $sprite
|
|
};
|
|
}
|
|
|
|
sub RenderSprites {
|
|
my $app = GetOption('App');
|
|
my @names = sort { $VisibleSprites{$a}{'Depth'} <=> $VisibleSprites{$b}{'Depth'} } (keys %VisibleSprites);
|
|
foreach my $name (@names) {
|
|
my $x = $VisibleSprites{$name}{'X'};
|
|
my $y = $VisibleSprites{$name}{'Y'};
|
|
$VisibleSprites{$name}{'Sprite'}->draw_xy($app, $x, $y);
|
|
}
|
|
}
|
|
|
|
1;
|