Initial checkin

.gitignore

@@ -0,0 +1,2 @@
+*.swp
+*~

PerlRPG/Console.pm

@@ -0,0 +1,81 @@
+package PerlRPG::Console;
+use strict;
+require Exporter;
+use Devel::StackTrace;
+use IO::Select;
+use vars qw/$StackTraceLevel $LogLevel @InputCallbacks %ConsoleCommands @LogCallbacks @ISA @EXPORT @EXPORT_OK/;
+
+@ISA = qw/Exporter/;
+
+use constant {
+	DEBUG	=> 0,
+	INFO	=> 1,
+	STATUS	=> 2,
+	WARN	=> 3,
+	ERROR	=> 4,
+	CRIT	=> 5,
+	FATAL	=> 6,
+};
+my @debugnames=qw/DEBUG INFO STATUS WARN ERROR CRIT FATAL/;
+$StackTraceLevel = ERROR;
+$LogLevel = DEBUG;
+@LogCallbacks = ();
+@InputCallbacks = (\&StdinConsole);
+
+@EXPORT_OK = ();
+@EXPORT = qw/DEBUG INFO STATUS WARN ERROR CRIT FATAL LogData/;
+
+sub LogData {
+	my($level, $log, $file, $line)=@_;
+	if(!$file || !$line) {
+		(undef, $file, $line)=caller();
+	}
+	if($level < DEBUG || $level > FATAL) {
+		LogData(ERROR, "Invalid log level, Next log.", $file, $line);
+		$level = FATAL;
+	}
+	return if($level < $LogLevel);
+
+	my $str = sprintf("[%6s] %s %s\n", $debugnames[$level], scalar localtime(), $log);
+	my $stack;
+
+	if($level >= $StackTraceLevel) {
+		my $trace = Devel::StackTrace->new;
+		$stack=$trace->as_string();
+	}
+
+	print $str . $stack;
+	foreach my $ref (@LogCallbacks) {
+		$ref->($level, $log, $file, $line, $str, $stack);
+	}
+}
+
+sub HandleConsole {
+	foreach my $ref (@InputCallbacks) {
+		my @lines = $ref->();
+		foreach (@lines) {
+			ConsoleLine($_);
+		}
+	}
+}
+
+sub ConsoleLine {
+	my $line=shift(@_);
+	LogData(DEBUG, "Got console input '$line'");
+}
+
+my $InBuf='';
+my $InSelect=IO::Select->new(\*STDIN);
+sub StdinConsole {
+	while($InSelect->can_read(0)) {
+		my $buffer;
+		my $bytes = read(STDIN, $buffer, 1024, 0);
+		$InBuf.=$buffer;
+	}
+
+	my @lines=split(/\n/, $InBuf);
+	my $InBuf = shift(@lines);
+	return @lines;
+}
+
+1;

PerlRPG/Game.pm

@@ -0,0 +1,289 @@
+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;

Resources/aka.vs

@@ -0,0 +1,6 @@
+aka01.png
+aka02.png
+aka03.png
+aka04.png
+aka05.png
+aka06.png

Resources/script.gs

@@ -0,0 +1,11 @@
+__init__:
+	Load aka.vs
+	Sayer m "Me"
+
+	Set aka.vs type reverse
+	Move aka.vs 0 0
+	Show aka.vs
+
+drawimg:
+	m "Test Text"
+	jump drawimg;

main.pl

@@ -0,0 +1,21 @@
+#!/usr/bin/perl
+use strict;
+use PerlRPG::Game;
+use PerlRPG::Console;
+
+my $screen_width = 1024;
+my $screen_height = 768;
+
+LogData(STATUS, "Starting up");
+PerlRPG::Game::ScanDirectory('.');
+my $app = PerlRPG::Game::InitApp($screen_width, $screen_height);
+{
+	my $a=PerlRPG::Game::GetAsset('aka.vs');
+	$a->start();
+	
+}
+PerlRPG::Game::RunScript('__init__');
+PerlRPG::Game::Run();
+
+LogData(STATUS, "Tearing down");
+