Scripting fixes

This commit is contained in:
Ryan Shepherd 2018-09-24 11:16:50 -04:00
parent 0bb6f4b2cc
commit 8b8c142bdb
1 changed files with 29 additions and 21 deletions

View File

@ -20,11 +20,18 @@ 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},
'Wait' => {'sub' => sub {}, 'wait' => 1},
'Jump' => {'sub' => \&PerlRPG::Script::RunScript, 'wait' => 0},
'Show' => {'sub' => \&PerlRPG::Drawing::ShowSprite, 'wait' => 0},
'Hide' => {'sub' => \&PerlRPG::Drawing::HideSprite, 'wait' => 0},
'SetBackground' => {'sub' => \&PerlRPG::Drawing::SetBackgroundColor, 'wait' => 0},
'ScanDirectory' => {'sub' => \&PerlRPG::Assets::ScanDirectory, 'wait' => 0},
'LoadAssets' => {'sub' => \&PerlRPG::Assets::LoadAssets, 'wait' => 0},
'UnloadAsset' => {'sub' => \&PerlRPG::Assets::UnloadAsset, 'wait' => 0},
'SetAssetOption' => {'sub' => \&PerlRPG::Assets::SetAssetOption, 'wait' => 0},
);
# Load script files, locate labels
@ -47,7 +54,6 @@ sub CompileScripts {
}
}
# Setup script to run
sub RunScript {
my($label)=@_;
@ -63,22 +69,24 @@ sub RunScript {
# Run script from current position until a wait condition
sub RunScriptTick {
1 while(!RunScriptLine());
for(;;) {
my $script = GetAsset($current_file); # current_file can change in RunScriptLine, so reload each time
my $file = $current_file;
my $line = $current_line++;
if($line >= @$script) {
LogData(ERROR, "Script file ended");
SetOption('Running', 0);
return;
}
if(RunScriptLine($file, $line, $script->[$line])) {
return;
}
}
};
# 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++;
}
my($file, $linenum, $line)=@_;
# Remove comments
$line=~s/#.+$//; # Remove comments
@ -91,13 +99,13 @@ sub RunScriptLine {
}
my($cmd, @opts)=split(/\s+/, $line);
LogData(DEBUG, "$file:$linenum $cmd(" . join(',',@opts) . ")");
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");
}
LogData(ERROR, "Unknown command '$cmd' in script at $file:$linenum");
return undef;
}
1;