PerlRPG/PerlRPG/Game.pm

package PerlRPG::Game;
use strict;
use SDL;
use SDL::Event;
use SDLx::App;
use SDLx::Sprite;
use SDLx::Sprite::Animated;
use PerlRPG::Console;
use vars qw/$app/;

$app = undef;
my %opt = (
	'Running'	=> 1,
	'TargetFPS'	=> 5,
	'ResourceDir'	=> '.',
	'Status'	=> 'WaitForFrame',
);

my %files;

sub InitApp {
	my($width, $height)=@_;

	return undef if($app);

	LogData(INFO, "Creating SDL instance");
	$app = SDLx::App->new(
		width => $width,
		height => $height,
		);
	LogData(DEBUG, "SDL Instance created");
	return $app;
}

sub Run {
	my $tick = SDL::get_ticks();
	while($opt{'Running'}) {
		EventDispatcher();
		RunScript();
		RenderScreen();

		my $ticktime = SDL::get_ticks() - $tick;
		my $delta = 1000/$opt{'TargetFPS'} - $ticktime;

		LogData(DEBUG, "TickTime = $ticktime, Delta = $delta");
		SDL::delay($delta) if($delta > 0);
		$tick = SDL::get_ticks();
	}
}

sub EventDispatcher {
	my $event = SDL::Event->new();
	SDL::Events::pump_events();
	while(SDL::Events::poll_event($event)) {
		if($event->type == SDL_KEYDOWN) {
			my $key = SDL::Events::get_key_name($event->key_sym);
			LogData(DEBUG, "KeyDown($key)");
		} elsif($event->type == SDL_KEYUP) {
			my $key = SDL::Events::get_key_name($event->key_sym);
			LogData(DEBUG, "KeyUp($key)");
		} elsif($event->type == SDL_QUIT) {
			$opt{'Running'} = 0;
		}
	}
}

sub RenderScreen {
	$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 {
	# 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;