Script execution support

PerlRPG/Assets.pm

@@ -69,12 +69,15 @@ sub ScanDirectory {
 
 # 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
@@ -158,8 +161,9 @@ sub LoadAsset {
 			return undef;
 		}
 		$files{$file}{'Type'} = 'Script';
-		$files{$file}{'Script'} = join('', <IN>);
+		$files{$file}{'Script'} = [<IN>];
 		close(IN);
+		chomp @{$files{$file}{'Script'}};
 	} else {
 		LogData(WARN, "Unable to pre-load asset of type '$ext'");
 		return undef;

PerlRPG/Drawing.pm

@@ -16,11 +16,11 @@ use vars qw/@ISA @EXPORT @EXPORT_OK %VisibleSprites/;
 @EXPORT = qw/ ShowSprite HideSprite MoveSprite SetBackgroundColor RenderSprites /;
 @EXPORT_OK = ();
 
-# FIXME - This should be exported
+# FIXME - This should be exported already?
 *GetOption = \&PerlRPG::Game::GetOption;
 
 sub ShowSprite {
-	my($name, $file, $x, $y, $d)=@_;
+	my($name, $file, $x, $y, $d, %opt)=@_;
 	LogData(DEBUG, "Showing sprite $file as $name");
 
 	my $t = GetAssetType($file);
@@ -30,13 +30,20 @@ sub ShowSprite {
 	}
 
 	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') {
+		# Unload the asset so that future versions of the same name will be fresh copies
+		UnloadAsset($file);
+
+		# Start animation
 		$a->start();
 	}
 
+	foreach my $o (keys %opt) {
+		if($o eq 'type') {
+			$a->type($opt{$o});
+		}
+	}
+
 	$VisibleSprites{$name}={
 		'Depth'		=> $d,
 		'X'		=> $x,

PerlRPG/Game.pm

@@ -9,6 +9,7 @@ use SDLx::Sprite::Animated;
 use PerlRPG::Console;
 use PerlRPG::Assets;
 use PerlRPG::Drawing;
+use PerlRPG::Script;
 use vars qw/$app @ISA @EXPORT @EXPORT_OK/;
 
 @ISA = qw/Exporter/;
@@ -47,7 +48,7 @@ sub Run {
 	my $tick = SDL::get_ticks();
 	while($opt{'Running'}) {
 		EventDispatcher();
-		RunScript();
+		RunScriptTick();
 		RenderScreen();
 
 		my $ticktime = SDL::get_ticks() - $tick;

PerlRPG/Script.pm

@@ -0,0 +1,103 @@
+package PerlRPG::Script;
+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 vars qw/@ISA @EXPORT @EXPORT_OK/;
+@ISA = qw/Exporter/;
+@EXPORT = qw/CompileScripts RunScript RunScriptTick/;
+@EXPORT_OK = @EXPORT;
+
+my %labels;
+my $current_file;
+my $current_line;
+
+my %script_commands = (
+	'Show'		=> {'sub' => \&PerlRPG::Drawing::ShowSprite,		'wait'	=> 0},
+	'Jump'		=> {'sub' => \&PerlRPG::Script::RunScript,		'wait'	=> 0},
+	'Wait'		=> {'sub' => sub {},					'wait'	=> 1},
+	'Hide'		=> {'sub' => \&PerlRPG::Drawing::HideSprite,		'wait'	=> 0},
+	'SetBackground'	=> {'sub' => \&PerlRPG::Drawing::SetBackgroundColor,	'wait'	=> 0},
+);
+
+# Load script files, locate labels
+sub CompileScripts {
+	my @scripts = sort { $a cmp $b } LoadAssets('gs');
+	%labels = ();
+	
+	foreach my $name (@scripts) {
+		my $ref = GetAsset($name);
+		for(my $line = 0; $line < @$ref-0; $line++) {
+			my($lbl)=$ref->[$line]=~/^\s*(\S+):\s*$/;
+			if($lbl) {
+				$labels{$lbl} = {
+					'File'	=> $name,
+					'Line'	=> $line,
+					};
+				LogData(DEBUG, "Found script label '$lbl' at $name:$line");
+			}
+		}
+	}
+}
+
+
+# Setup script to run
+sub RunScript {
+	my($label)=@_;
+
+	if(exists $labels{$label}) {
+		$current_file = $labels{$label}{'File'};
+		$current_line = $labels{$label}{'Line'};
+		LogData(DEBUG, "RunScript($label) moving to $current_file:$current_line");
+	} else {
+		LogData(ERROR, "RunScript($label) unknown label");
+	}
+}
+
+# Run script from current position until a wait condition
+sub RunScriptTick {
+	1 while(!RunScriptLine());
+};
+
+# Returns true if a wait condition is seen
+sub RunScriptLine {
+	my $script = GetAsset($current_file);
+	my $line;
+
+	if($current_line >= @$script) {
+		LogData(ERROR, "File ended");
+		SetOption('Running', 0);
+	} else {
+		$line = $script->[$current_line];
+		LogData(DEBUG, "Executing $current_file:$current_line '$line'");
+		$current_line++;
+	}
+
+	# Remove comments	
+	$line=~s/#.+$//; # Remove comments
+	$line=~s/^\s+//; # Remove leading whitespace
+	$line=~s/\s+$//; # Remove trailing whitespace
+
+	if($line=~/^\s*\S+:\s*$/ || $line=~/^\s+$/ || !$line) {
+		# Label or blank, skip
+		return 0;
+	}
+
+	my($cmd, @opts)=split(/\s+/, $line);
+	if(exists $script_commands{$cmd}) {
+		$script_commands{$cmd}{'sub'}->(@opts);
+		return $script_commands{$cmd}{'wait'};
+	} else {
+		my $l = $current_line-1;
+		LogData(ERROR, "Unknown command '$cmd' in script at $current_file:$l");
+	}
+	return undef;
+}
+1;

Resources/script.gs

@@ -1,11 +1,8 @@
 __init__:
-	Load aka.vs
-	Sayer m "Me"
-
-	Set aka.vs type reverse
-	Move aka.vs 0 0
-	Show aka.vs
+	SetBackground 128 128 128 255
+	Show aka aka.vs 0 0 1 type Reverse
+	Show aka2 aka.vs 100 0 2
 
 drawimg:
-	m "Test Text"
-	jump drawimg;
+	Wait
+	Jump drawimg

main.pl

@@ -4,6 +4,7 @@ use PerlRPG::Game;
 use PerlRPG::Console;
 use PerlRPG::Assets;
 use PerlRPG::Drawing;
+use PerlRPG::Script;
 
 my $screen_width = 1024;
 my $screen_height = 768;
@@ -12,10 +13,13 @@ my $asset_directory = 'Resources';
 LogData(STATUS, "Starting up");
 ScanDirectory($asset_directory);
 my $app = InitApp($screen_width, $screen_height);
-#GetAsset('aka.vs')->start();
-SetBackgroundColor(128, 128, 128, 255);
-ShowSprite('aka', 'aka.vs', 10, 10, 1);
-ShowSprite('aka2', 'aka.vs', 200, 10, 1);
+CompileScripts();
+RunScript('__init__');
+
+
+#SetBackgroundColor(128, 128, 128, 255);
+#ShowSprite('aka', 'aka.vs', 0, 0, 1);
+#ShowSprite('aka2', 'aka.vs', 100, 0, 2);
 
 Run();