104 lines
2.5 KiB
Perl
104 lines
2.5 KiB
Perl
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;
|