From 53075c961f41565511763697cce345015c384c0e Mon Sep 17 00:00:00 2001 From: Ryan Shepherd Date: Sun, 23 Sep 2018 18:00:56 -0400 Subject: [PATCH] Script execution support --- PerlRPG/Assets.pm | 6 ++- PerlRPG/Drawing.pm | 17 +++++--- PerlRPG/Game.pm | 3 +- PerlRPG/Script.pm | 103 ++++++++++++++++++++++++++++++++++++++++++++ Resources/script.gs | 13 +++--- main.pl | 12 ++++-- 6 files changed, 135 insertions(+), 19 deletions(-) create mode 100644 PerlRPG/Script.pm diff --git a/PerlRPG/Assets.pm b/PerlRPG/Assets.pm index a68df85..0e1058c 100644 --- a/PerlRPG/Assets.pm +++ b/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('', ); + $files{$file}{'Script'} = []; close(IN); + chomp @{$files{$file}{'Script'}}; } else { LogData(WARN, "Unable to pre-load asset of type '$ext'"); return undef; diff --git a/PerlRPG/Drawing.pm b/PerlRPG/Drawing.pm index 7f53fe3..6a7d524 100644 --- a/PerlRPG/Drawing.pm +++ b/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, diff --git a/PerlRPG/Game.pm b/PerlRPG/Game.pm index 9b220e4..30af1f2 100644 --- a/PerlRPG/Game.pm +++ b/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; diff --git a/PerlRPG/Script.pm b/PerlRPG/Script.pm new file mode 100644 index 0000000..b0e47aa --- /dev/null +++ b/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; diff --git a/Resources/script.gs b/Resources/script.gs index 559536b..465c8e1 100644 --- a/Resources/script.gs +++ b/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 diff --git a/main.pl b/main.pl index 692a34e..3362ad5 100755 --- a/main.pl +++ b/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();