Move Assets into module, create Drawing module
This commit is contained in:
Ryan Shepherd
parent
6fa0b11897
commit
8f5bbd7d82
|
|
@ -0,0 +1,220 @@
|
||||||
|
package PerlRPG::Assets;
|
||||||
|
use strict;
|
||||||
|
require Exporter;
|
||||||
|
use SDL;
|
||||||
|
use SDL::Event;
|
||||||
|
use SDLx::App;
|
||||||
|
use SDLx::Sprite;
|
||||||
|
use SDLx::Sprite::Animated;
|
||||||
|
use PerlRPG::Console;
|
||||||
|
use PerlRPG::Game;
|
||||||
|
|
||||||
|
use vars qw/%files @ISA @EXPORT @EXPORT_OK/;
|
||||||
|
@ISA = qw/Exporter/;
|
||||||
|
@EXPORT = qw/ScanDirectory GetAsset GetAssetType LoadAssets UnloadAsset/;
|
||||||
|
@EXPORT_OK = ();
|
||||||
|
|
||||||
|
# Check %files cache for file location, otherwise search in path
|
||||||
|
sub FindFile {
|
||||||
|
my $filename=shift(@_);
|
||||||
|
if(exists $files{$filename}) {
|
||||||
|
return $files{$filename}{'Location'};
|
||||||
|
}
|
||||||
|
|
||||||
|
my $full = FindFileInDir(GetOption('ResourceDir'), $filename);
|
||||||
|
if($full) {
|
||||||
|
$files{$filename}={
|
||||||
|
'Loaded' => 0,
|
||||||
|
'Location' => $full,
|
||||||
|
};
|
||||||
|
LogData(DEBUG, "Located '$filename' at '$full'");
|
||||||
|
return $full;
|
||||||
|
}
|
||||||
|
LogData(WARN, "Unable to locate file '$filename' in Resource Path");
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Search for filename in path given and all sub-directories (Recursive)
|
||||||
|
sub FindFileInDir {
|
||||||
|
my($dir, $filename)=@_;
|
||||||
|
if(-f "$dir/$filename") {
|
||||||
|
return "$dir/$filename";
|
||||||
|
}
|
||||||
|
|
||||||
|
foreach my $file (<$dir/*>) {
|
||||||
|
next unless(-d $file);
|
||||||
|
if(my $res = FindFileInDir($file, $filename)) {
|
||||||
|
return $res;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Scan every file in path given and add to %files (Recursive)
|
||||||
|
sub ScanDirectory {
|
||||||
|
my $path = shift(@_);
|
||||||
|
|
||||||
|
foreach my $file (<$path/*>) {
|
||||||
|
if(-d $file) {
|
||||||
|
ScanDirectory($file);
|
||||||
|
} else {
|
||||||
|
my($fname)=$file=~/.+\/(.+?)$/;
|
||||||
|
$files{$fname}={
|
||||||
|
'Loaded' => 0,
|
||||||
|
'Location' => $file,
|
||||||
|
};
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# Load all assets with given file extension
|
||||||
|
sub LoadAssets {
|
||||||
|
foreach my $ext (@_) {
|
||||||
|
LogData(DEBUG, "Loading *.$ext assets");
|
||||||
|
foreach my $file (grep { /\.$ext$/i } (keys %files)) {
|
||||||
|
LoadAsset($file, $files{$file}{'Location'}) unless($files{$file}{'Loaded'});
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# Return the asset object
|
||||||
|
sub GetAsset {
|
||||||
|
my($file)=@_;
|
||||||
|
|
||||||
|
if(!exists $files{$file} || !$files{$file}{'Loaded'}) {
|
||||||
|
if(!LoadAsset($file)) {
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return $files{$file}{ $files{$file}{'Type'} };
|
||||||
|
}
|
||||||
|
|
||||||
|
# Return asset object type
|
||||||
|
sub GetAssetType {
|
||||||
|
my($file)=@_;
|
||||||
|
|
||||||
|
if(!exists $files{$file} || !$files{$file}{'Loaded'}) {
|
||||||
|
if(!LoadAsset($file)) {
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return $files{$file}{'Type'};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub UnloadAsset {
|
||||||
|
my($file)=@_;
|
||||||
|
if(exists $files{$file}) {
|
||||||
|
$files{$file}{'Loaded'} = 0;
|
||||||
|
delete $files{$file}{ $files{$file}{'Type'} };
|
||||||
|
$files{$file}{'Type'} = '';
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sub LoadAsset {
|
||||||
|
my($file, $filename)=@_;
|
||||||
|
|
||||||
|
if(!$filename && !($filename = FindFile($file))) {
|
||||||
|
LogData(FATAL, "Unable to load asset file '$file'; Unable to find file.");
|
||||||
|
SetOption('Running', 0);
|
||||||
|
}
|
||||||
|
|
||||||
|
if(exists $files{$file}) {
|
||||||
|
if($files{$file}{'Loaded'}) {
|
||||||
|
return $files{$file};
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
$files{$file}={
|
||||||
|
'Loaded' => 0,
|
||||||
|
'Location' => $filename,
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
my($ext)=$file=~/.+\.(.+?)$/;
|
||||||
|
$ext = lc($ext);
|
||||||
|
if(grep { $_ eq $ext } (qw/png jpg jpeg bmp/)) {
|
||||||
|
$files{$file}{'Type'} = 'Sprite';
|
||||||
|
my $sprite = SDLx::Sprite->new(
|
||||||
|
image => $files{$file}{'Location'},
|
||||||
|
);
|
||||||
|
if(!$sprite) {
|
||||||
|
LogData(ERROR, "Unable to load sprite '$filename': $!");
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
$files{$file}{'Sprite'} = $sprite;
|
||||||
|
} elsif($ext eq 'vs') {
|
||||||
|
unless(open(IN, $filename)) {
|
||||||
|
LogData(ERROR, "Unable to load '$filename': $!");
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
my @frames = <IN>;
|
||||||
|
chomp(@frames);
|
||||||
|
close(IN);
|
||||||
|
LoadVirtualSprite($file, @frames);
|
||||||
|
} elsif($ext eq 'gs') {
|
||||||
|
unless(open(IN, $filename)) {
|
||||||
|
LogData(ERROR, "Unable to load '$filename': $!");
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
$files{$file}{'Type'} = 'Script';
|
||||||
|
$files{$file}{'Script'} = join('', <IN>);
|
||||||
|
close(IN);
|
||||||
|
} else {
|
||||||
|
LogData(WARN, "Unable to pre-load asset of type '$ext'");
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
$files{$file}{'Loaded'} = 1;
|
||||||
|
return $files{$file};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub LoadVirtualSprite {
|
||||||
|
my($name, @files)=@_;
|
||||||
|
|
||||||
|
if(exists $files{$name} && $files{$name}{'Loaded'}) {
|
||||||
|
return $files{$name};
|
||||||
|
}
|
||||||
|
|
||||||
|
foreach (@files) {
|
||||||
|
if(!LoadAsset($_)) {
|
||||||
|
LogData(ERROR, "Unable to load virtual sprite, error loading one or more assets.");
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
LogData(DEBUG, "Adding asset $_ to virtual sprite $name");
|
||||||
|
}
|
||||||
|
|
||||||
|
my @frames = map { $files{$_}{'Sprite'}->surface() } (@files);
|
||||||
|
my $h = $frames[0]->height();
|
||||||
|
my $hp = 0;
|
||||||
|
|
||||||
|
my $newsurface = SDLx::Surface->new( width => $frames[0]->width(),
|
||||||
|
height => $h * (@frames-0),
|
||||||
|
format => $frames[0]->format(),
|
||||||
|
pitch => $frames[0]->pitch(),
|
||||||
|
flags => $frames[0]->flags(),
|
||||||
|
);
|
||||||
|
$newsurface->draw_rect( [0, 0, $newsurface->width(), $newsurface->height()], [0, 0, 0, 255]);
|
||||||
|
#SDL::Video::set_alpha( $newsurface, SDL::Video::SDL_SRCALPHA, 0);
|
||||||
|
foreach (@frames) {
|
||||||
|
#SDL::Video::set_alpha( $_, SDL::Video::SDL_SRCALPHA, 255);
|
||||||
|
#FIXME - This call ignores the source alpha channel
|
||||||
|
$_->blit( $newsurface, undef, [0, $hp, $_->width(), $_->height()]);
|
||||||
|
$hp += $h;
|
||||||
|
}
|
||||||
|
|
||||||
|
my $anim = SDLx::Sprite::Animated->new( surface => $newsurface,
|
||||||
|
width => $newsurface->width(),
|
||||||
|
height => $h,
|
||||||
|
step_x => $newsurface->width(),
|
||||||
|
step_y => $h,
|
||||||
|
);
|
||||||
|
$files{$name}{'Loaded'} = 1;
|
||||||
|
$files{$name}{'Type'} = 'ASprite';
|
||||||
|
$files{$name}{'ASprite'} = $anim;
|
||||||
|
return $anim;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
1;
|
||||||
|
|
@ -0,0 +1,96 @@
|
||||||
|
package PerlRPG::Drawing;
|
||||||
|
use strict;
|
||||||
|
require Exporter;
|
||||||
|
use SDL;
|
||||||
|
use SDL::Event;
|
||||||
|
use SDLx::App;
|
||||||
|
use SDLx::Sprite;
|
||||||
|
use SDLx::Sprite::Animated;
|
||||||
|
use PerlRPG::Console;
|
||||||
|
use PerlRPG::Game;
|
||||||
|
use PerlRPG::Assets;
|
||||||
|
use Storable qw/dclone/;
|
||||||
|
|
||||||
|
use vars qw/@ISA @EXPORT @EXPORT_OK %VisibleSprites/;
|
||||||
|
@ISA = qw/Exporter/;
|
||||||
|
@EXPORT = qw/ ShowSprite HideSprite MoveSprite SetBackgroundColor RenderSprites /;
|
||||||
|
@EXPORT_OK = ();
|
||||||
|
|
||||||
|
# FIXME - This should be exported
|
||||||
|
*GetOption = \&PerlRPG::Game::GetOption;
|
||||||
|
|
||||||
|
sub ShowSprite {
|
||||||
|
my($name, $file, $x, $y, $d)=@_;
|
||||||
|
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);
|
||||||
|
# Unload the asset so that future versions of the same name will be fresh copies
|
||||||
|
UnloadAsset($file);
|
||||||
|
|
||||||
|
if($t eq 'ASprite') {
|
||||||
|
$a->start();
|
||||||
|
}
|
||||||
|
|
||||||
|
$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;
|
||||||
230
PerlRPG/Game.pm
230
PerlRPG/Game.pm
|
|
@ -1,22 +1,32 @@
|
||||||
package PerlRPG::Game;
|
package PerlRPG::Game;
|
||||||
use strict;
|
use strict;
|
||||||
|
require Exporter;
|
||||||
use SDL;
|
use SDL;
|
||||||
use SDL::Event;
|
use SDL::Event;
|
||||||
use SDLx::App;
|
use SDLx::App;
|
||||||
use SDLx::Sprite;
|
use SDLx::Sprite;
|
||||||
use SDLx::Sprite::Animated;
|
use SDLx::Sprite::Animated;
|
||||||
use PerlRPG::Console;
|
use PerlRPG::Console;
|
||||||
use vars qw/$app/;
|
use PerlRPG::Assets;
|
||||||
|
use PerlRPG::Drawing;
|
||||||
|
use vars qw/$app @ISA @EXPORT @EXPORT_OK/;
|
||||||
|
|
||||||
|
@ISA = qw/Exporter/;
|
||||||
|
@EXPORT = qw/InitApp Run RunScript GetOption SetOption/;
|
||||||
|
@EXPORT_OK = @EXPORT;
|
||||||
|
|
||||||
$app = undef;
|
$app = undef;
|
||||||
my %opt = (
|
my %opt = (
|
||||||
|
'App' => undef,
|
||||||
'Running' => 1,
|
'Running' => 1,
|
||||||
'TargetFPS' => 5,
|
'TargetFPS' => 5,
|
||||||
'ResourceDir' => '.',
|
'ResourceDir' => '.',
|
||||||
'Status' => 'WaitForFrame',
|
'Status' => 'WaitForFrame',
|
||||||
);
|
);
|
||||||
|
|
||||||
my %files;
|
sub GetOption { return (exists $opt{$_[0]} ? $opt{$_[0]} : undef); }
|
||||||
|
sub SetOption { $opt{$_[0]} = $_[1]; }
|
||||||
|
|
||||||
|
|
||||||
sub InitApp {
|
sub InitApp {
|
||||||
my($width, $height)=@_;
|
my($width, $height)=@_;
|
||||||
|
|
@ -28,6 +38,7 @@ sub InitApp {
|
||||||
width => $width,
|
width => $width,
|
||||||
height => $height,
|
height => $height,
|
||||||
);
|
);
|
||||||
|
$opt{'App'}=$app;
|
||||||
LogData(DEBUG, "SDL Instance created");
|
LogData(DEBUG, "SDL Instance created");
|
||||||
return $app;
|
return $app;
|
||||||
}
|
}
|
||||||
|
|
@ -65,225 +76,12 @@ sub EventDispatcher {
|
||||||
}
|
}
|
||||||
|
|
||||||
sub RenderScreen {
|
sub RenderScreen {
|
||||||
|
RenderSprites();
|
||||||
$app->update();
|
$app->update();
|
||||||
}
|
}
|
||||||
|
|
||||||
# Check %files cache for file location, otherwise search in path
|
|
||||||
sub FindFile {
|
|
||||||
my $filename=shift(@_);
|
|
||||||
if(exists $files{$filename}) {
|
|
||||||
return $files{$filename}{'Location'};
|
|
||||||
}
|
|
||||||
|
|
||||||
my $full = FindFileInDir($opt{'ResourceDir'}, $filename);
|
|
||||||
if($full) {
|
|
||||||
$files{$filename}={
|
|
||||||
'Loaded' => 0,
|
|
||||||
'Location' => $full,
|
|
||||||
};
|
|
||||||
LogData(DEBUG, "Located '$filename' at '$full'");
|
|
||||||
return $full;
|
|
||||||
}
|
|
||||||
LogData(WARN, "Unable to locate file '$filename' in Resource Path");
|
|
||||||
return undef;
|
|
||||||
}
|
|
||||||
|
|
||||||
# Search for filename in path given and all sub-directories (Recursive)
|
|
||||||
sub FindFileInDir {
|
|
||||||
my($dir, $filename)=@_;
|
|
||||||
if(-f "$dir/$filename") {
|
|
||||||
return "$dir/$filename";
|
|
||||||
}
|
|
||||||
|
|
||||||
foreach my $file (<$dir/*>) {
|
|
||||||
next unless(-d $file);
|
|
||||||
if(my $res = FindFileInDir($file, $filename)) {
|
|
||||||
return $res;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
return undef;
|
|
||||||
}
|
|
||||||
|
|
||||||
# Scan every file in path given and add to %files (Recursive)
|
|
||||||
sub ScanDirectory {
|
|
||||||
my $path = shift(@_);
|
|
||||||
|
|
||||||
foreach my $file (<$path/*>) {
|
|
||||||
if(-d $file) {
|
|
||||||
ScanDirectory($file);
|
|
||||||
} else {
|
|
||||||
my($fname)=$file=~/.+\/(.+?)$/;
|
|
||||||
$files{$fname}={
|
|
||||||
'Loaded' => 0,
|
|
||||||
'Location' => $file,
|
|
||||||
};
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
sub LoadAssets {
|
|
||||||
foreach my $ext (@_) {
|
|
||||||
LogData(DEBUG, "Loading *.$ext assets");
|
|
||||||
foreach my $file (grep { /\.$ext$/i } (keys %files)) {
|
|
||||||
LoadAsset($file, $files{$file}{'Location'}) unless($files{$file}{'Loaded'});
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
sub GetAsset {
|
|
||||||
my($file)=@_;
|
|
||||||
|
|
||||||
if(!exists $files{$file} || !$files{$file}{'Loaded'}) {
|
|
||||||
if(!LoadAsset($file)) {
|
|
||||||
return undef;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
return $files{$file}{ $files{$file}{'Type'} };
|
|
||||||
}
|
|
||||||
|
|
||||||
sub GetAssetType {
|
|
||||||
my($file)=@_;
|
|
||||||
|
|
||||||
if(!exists $files{$file} || !$files{$file}{'Loaded'}) {
|
|
||||||
if(!LoadAsset($file)) {
|
|
||||||
return undef;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
return $files{$file}{'Type'};
|
|
||||||
}
|
|
||||||
|
|
||||||
sub LoadAsset {
|
|
||||||
my($file, $filename)=@_;
|
|
||||||
|
|
||||||
if(!$filename && !($filename = FindFile($file))) {
|
|
||||||
LogData(FATAL, "Unable to load asset file '$file'; Unable to find file.");
|
|
||||||
$opt{'Running'}=0;
|
|
||||||
}
|
|
||||||
|
|
||||||
if(exists $files{$file}) {
|
|
||||||
if($files{$file}{'Loaded'}) {
|
|
||||||
return $files{$file};
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
$files{$file}={
|
|
||||||
'Loaded' => 0,
|
|
||||||
'Location' => $filename,
|
|
||||||
};
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
my($ext)=$file=~/.+\.(.+?)$/;
|
|
||||||
$ext = lc($ext);
|
|
||||||
if(grep { $_ eq $ext } (qw/png jpg jpeg bmp/)) {
|
|
||||||
$files{$file}{'Type'} = 'Sprite';
|
|
||||||
my $sprite = SDLx::Sprite->new(
|
|
||||||
image => $files{$file}{'Location'},
|
|
||||||
);
|
|
||||||
if(!$sprite) {
|
|
||||||
LogData(ERROR, "Unable to load sprite '$filename': $!");
|
|
||||||
return undef;
|
|
||||||
}
|
|
||||||
$files{$file}{'Sprite'} = $sprite;
|
|
||||||
} elsif($ext eq 'vs') {
|
|
||||||
unless(open(IN, $filename)) {
|
|
||||||
LogData(ERROR, "Unable to load '$filename': $!");
|
|
||||||
return undef;
|
|
||||||
}
|
|
||||||
my @frames = <IN>;
|
|
||||||
chomp(@frames);
|
|
||||||
close(IN);
|
|
||||||
return LoadVirtualSprite($file, @frames);
|
|
||||||
} elsif($ext eq 'gs') {
|
|
||||||
unless(open(IN, $filename)) {
|
|
||||||
LogData(ERROR, "Unable to load '$filename': $!");
|
|
||||||
return undef;
|
|
||||||
}
|
|
||||||
$files{$file}{'Type'} = 'Script';
|
|
||||||
$files{$file}{'Script'} = join('', <IN>);
|
|
||||||
close(IN);
|
|
||||||
} else {
|
|
||||||
LogData(WARN, "Unable to pre-load asset of type '$ext'");
|
|
||||||
return undef;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
$files{$file}{'Loaded'} = 1;
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub LoadVirtualSprite {
|
|
||||||
my($name, @files)=@_;
|
|
||||||
|
|
||||||
if(exists $files{$name} && $files{$name}{'Loaded'}) {
|
|
||||||
return $files{$name}{'ASprite'};
|
|
||||||
}
|
|
||||||
|
|
||||||
foreach (@files) {
|
|
||||||
if(!LoadAsset($_)) {
|
|
||||||
LogData(ERROR, "Unable to load virtual sprite, error loading one or more assets.");
|
|
||||||
return undef;
|
|
||||||
}
|
|
||||||
LogData(DEBUG, "Adding asset $_ to virtual sprite $name");
|
|
||||||
}
|
|
||||||
|
|
||||||
my @frames = map { $files{$_}{'Sprite'}->surface() } (@files);
|
|
||||||
my $h = $frames[0]->height();
|
|
||||||
my $hp = 0;
|
|
||||||
|
|
||||||
my $newsurface = SDLx::Surface->new( width => $frames[0]->width(),
|
|
||||||
height => $h * (@frames-0),
|
|
||||||
format => $frames[0]->format(),
|
|
||||||
pitch => $frames[0]->pitch(),
|
|
||||||
flags => $frames[0]->flags(),
|
|
||||||
);
|
|
||||||
$newsurface->draw_rect( [0, 0, $newsurface->width(), $newsurface->height()], [0, 0, 0, 255]);
|
|
||||||
#SDL::Video::set_alpha( $newsurface, SDL::Video::SDL_SRCALPHA, 0);
|
|
||||||
foreach (@frames) {
|
|
||||||
#SDL::Video::set_alpha( $_, SDL::Video::SDL_SRCALPHA, 255);
|
|
||||||
$_->blit( $newsurface, undef, [0, $hp, $_->width(), $_->height()]);
|
|
||||||
$hp += $h;
|
|
||||||
}
|
|
||||||
|
|
||||||
my $testsprite = SDLx::Sprite->new( surface => $newsurface );
|
|
||||||
|
|
||||||
my $anim = SDLx::Sprite::Animated->new( surface => $newsurface,
|
|
||||||
width => $newsurface->width(),
|
|
||||||
height => $h,
|
|
||||||
step_x => $newsurface->width(),
|
|
||||||
step_y => $h,
|
|
||||||
);
|
|
||||||
#$anim->surface($newsurface);
|
|
||||||
|
|
||||||
$files{$name}{'Loaded'} = 1;
|
|
||||||
$files{$name}{'Type'} = 'ASprite';
|
|
||||||
$files{$name}{'ASprite'} = $anim;
|
|
||||||
return $anim;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub ShowImage {
|
|
||||||
my($file, $x, $y)=@_;
|
|
||||||
if(!exists $files{$file} || !$files{$file}{'Loaded'}) {
|
|
||||||
LogData(DEBUG, "Loading image on first use '$file'");
|
|
||||||
if(!LoadAsset($file)) {
|
|
||||||
LogData(WARN, "Failed to load image '$file'");
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
if($files{$file}{'Type'} ne 'Sprite') {
|
|
||||||
LogData(WARN, "ShowImage called on non-Image asset");
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
LogData(DEBUG, "Drawing $file at $x,$y");
|
|
||||||
$files{$file}{'Sprite'}->draw_xy( $app, $x, $y );
|
|
||||||
}
|
|
||||||
|
|
||||||
sub RunScript {
|
sub RunScript {
|
||||||
# Blank Screen
|
|
||||||
$app->draw_rect( [0, 0, $app->width(), $app->height()], [128, 128, 128, 255]);
|
|
||||||
|
|
||||||
my $a=GetAsset('aka.vs');
|
|
||||||
$a->draw_xy($app, 0, 0);
|
|
||||||
$app->update();
|
|
||||||
}
|
}
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|
|
||||||
|
|
@ -2,20 +2,22 @@
|
||||||
use strict;
|
use strict;
|
||||||
use PerlRPG::Game;
|
use PerlRPG::Game;
|
||||||
use PerlRPG::Console;
|
use PerlRPG::Console;
|
||||||
|
use PerlRPG::Assets;
|
||||||
|
use PerlRPG::Drawing;
|
||||||
|
|
||||||
my $screen_width = 1024;
|
my $screen_width = 1024;
|
||||||
my $screen_height = 768;
|
my $screen_height = 768;
|
||||||
|
my $asset_directory = 'Resources';
|
||||||
|
|
||||||
LogData(STATUS, "Starting up");
|
LogData(STATUS, "Starting up");
|
||||||
PerlRPG::Game::ScanDirectory('.');
|
ScanDirectory($asset_directory);
|
||||||
my $app = PerlRPG::Game::InitApp($screen_width, $screen_height);
|
my $app = InitApp($screen_width, $screen_height);
|
||||||
{
|
#GetAsset('aka.vs')->start();
|
||||||
my $a=PerlRPG::Game::GetAsset('aka.vs');
|
SetBackgroundColor(128, 128, 128, 255);
|
||||||
$a->start();
|
ShowSprite('aka', 'aka.vs', 10, 10, 1);
|
||||||
|
ShowSprite('aka2', 'aka.vs', 200, 10, 1);
|
||||||
|
|
||||||
}
|
Run();
|
||||||
PerlRPG::Game::RunScript('__init__');
|
|
||||||
PerlRPG::Game::Run();
|
|
||||||
|
|
||||||
LogData(STATUS, "Tearing down");
|
LogData(STATUS, "Tearing down");
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue