Ryan
/
PerlRPG
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
PerlRPG/Script.pm
View File

@ -20,11 +20,18 @@ my $current_file;
my $current_line; my $current_line;
my %script_commands = ( my %script_commands = (
'Show' => {'sub' => \&PerlRPG::Drawing::ShowSprite, 'wait' => 0},
'Jump' => {'sub' => \&PerlRPG::Script::RunScript, 'wait' => 0},
'Wait' => {'sub' => sub {}, 'wait' => 1}, '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}, 'Hide' => {'sub' => \&PerlRPG::Drawing::HideSprite, 'wait' => 0},
'SetBackground' => {'sub' => \&PerlRPG::Drawing::SetBackgroundColor, '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 # Load script files, locate labels
@ -47,7 +54,6 @@ sub CompileScripts {
} }
} }
# Setup script to run # Setup script to run
sub RunScript { sub RunScript {
my($label)=@_; my($label)=@_;
@ -63,22 +69,24 @@ sub RunScript {
# Run script from current position until a wait condition # Run script from current position until a wait condition
sub RunScriptTick { 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 # Returns true if a wait condition is seen
sub RunScriptLine { sub RunScriptLine {
my $script = GetAsset($current_file); my($file, $linenum, $line)=@_;
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 # Remove comments
$line=~s/#.+$//; # Remove comments $line=~s/#.+$//; # Remove comments
@ -91,13 +99,13 @@ sub RunScriptLine {
} }
my($cmd, @opts)=split(/\s+/, $line); my($cmd, @opts)=split(/\s+/, $line);
LogData(DEBUG, "$file:$linenum $cmd(" . join(',',@opts) . ")");
if(exists $script_commands{$cmd}) { if(exists $script_commands{$cmd}) {
$script_commands{$cmd}{'sub'}->(@opts); $script_commands{$cmd}{'sub'}->(@opts);
return $script_commands{$cmd}{'wait'}; 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; return undef;
} }
1; 1;