PerlRPG/PerlRPG/Assets.pm

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 {
	my @res;
	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'});
			push @res, $file;
		}
	}
	return @res;
}

# 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'} = [<IN>];
		close(IN);
		chomp @{$files{$file}{'Script'}};
	} 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;