Initial sayer support
This commit is contained in:
parent
4fc7cede49
commit
e546d6cb28
|
|
@ -9,7 +9,6 @@ use SDLx::Sprite::Animated;
|
||||||
use PerlRPG::Console;
|
use PerlRPG::Console;
|
||||||
use PerlRPG::Game;
|
use PerlRPG::Game;
|
||||||
use PerlRPG::Assets;
|
use PerlRPG::Assets;
|
||||||
use Storable qw/dclone/;
|
|
||||||
|
|
||||||
use vars qw/@ISA @EXPORT @EXPORT_OK %VisibleSprites/;
|
use vars qw/@ISA @EXPORT @EXPORT_OK %VisibleSprites/;
|
||||||
@ISA = qw/Exporter/;
|
@ISA = qw/Exporter/;
|
||||||
|
|
@ -20,7 +19,7 @@ use vars qw/@ISA @EXPORT @EXPORT_OK %VisibleSprites/;
|
||||||
*GetOption = \&PerlRPG::Game::GetOption;
|
*GetOption = \&PerlRPG::Game::GetOption;
|
||||||
|
|
||||||
sub ShowSprite {
|
sub ShowSprite {
|
||||||
my($name, $file, $x, $y, $d, %opt)=@_;
|
my($name, $file, $x, $y, $d, @opt)=@_;
|
||||||
LogData(DEBUG, "Showing sprite $file as $name");
|
LogData(DEBUG, "Showing sprite $file as $name");
|
||||||
|
|
||||||
my $t = GetAssetType($file);
|
my $t = GetAssetType($file);
|
||||||
|
|
@ -38,9 +37,20 @@ sub ShowSprite {
|
||||||
$a->start();
|
$a->start();
|
||||||
}
|
}
|
||||||
|
|
||||||
foreach my $o (keys %opt) {
|
foreach my $o (@opt) {
|
||||||
if($o eq 'type') {
|
my($name, $val)=$o=~/^\s*(\S+?)=(\S*)/;
|
||||||
$a->type($opt{$o});
|
$name = $o unless($name);
|
||||||
|
if($o eq 'Reverse' || $o eq 'Circular') {
|
||||||
|
$a->type($o);
|
||||||
|
} elsif($name eq 'max_loops') {
|
||||||
|
$a->max_loops($val);
|
||||||
|
} elsif($o eq 'flip') {
|
||||||
|
# FIXME - This doesn't work
|
||||||
|
my $s=$a->surface();
|
||||||
|
$s->flip();
|
||||||
|
$a->surface($s);
|
||||||
|
} else {
|
||||||
|
LogData(WARN, "Unknown option in ShowSprite '$o' - '$name'='$val'");
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -21,6 +21,7 @@ my $current_line;
|
||||||
|
|
||||||
my %script_commands = (
|
my %script_commands = (
|
||||||
'Wait' => {'sub' => sub {}, 'wait' => 1},
|
'Wait' => {'sub' => sub {}, 'wait' => 1},
|
||||||
|
'AddSayer' => {'sub' => \&AddSayer, 'wait' => 0},
|
||||||
|
|
||||||
'Jump' => {'sub' => \&PerlRPG::Script::RunScript, 'wait' => 0},
|
'Jump' => {'sub' => \&PerlRPG::Script::RunScript, 'wait' => 0},
|
||||||
|
|
||||||
|
|
@ -34,6 +35,9 @@ my %script_commands = (
|
||||||
'SetAssetOption' => {'sub' => \&PerlRPG::Assets::SetAssetOption, 'wait' => 0},
|
'SetAssetOption' => {'sub' => \&PerlRPG::Assets::SetAssetOption, 'wait' => 0},
|
||||||
);
|
);
|
||||||
|
|
||||||
|
my %sayers = ();
|
||||||
|
my $lastsayer=undef;
|
||||||
|
|
||||||
# Load script files, locate labels
|
# Load script files, locate labels
|
||||||
sub CompileScripts {
|
sub CompileScripts {
|
||||||
my @scripts = sort { $a cmp $b } LoadAssets('gs');
|
my @scripts = sort { $a cmp $b } LoadAssets('gs');
|
||||||
|
|
@ -88,6 +92,9 @@ sub RunScriptTick {
|
||||||
sub RunScriptLine {
|
sub RunScriptLine {
|
||||||
my($file, $linenum, $line)=@_;
|
my($file, $linenum, $line)=@_;
|
||||||
|
|
||||||
|
# Copy to refer to
|
||||||
|
my $oline = $line;
|
||||||
|
|
||||||
# Remove comments
|
# Remove comments
|
||||||
$line=~s/#.+$//; # Remove comments
|
$line=~s/#.+$//; # Remove comments
|
||||||
$line=~s/^\s+//; # Remove leading whitespace
|
$line=~s/^\s+//; # Remove leading whitespace
|
||||||
|
|
@ -103,9 +110,38 @@ sub RunScriptLine {
|
||||||
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'};
|
||||||
|
} elsif(exists $sayers{$cmd}) {
|
||||||
|
my($text)=$oline=~/\Q$cmd\E\s+"(.+?)"\s*$/;
|
||||||
|
if($text) {
|
||||||
|
return SayLine($sayers{$cmd}, $text);
|
||||||
|
} else {
|
||||||
|
LogData(ERROR, "Invalid sayer text in script at $file:$linenum");
|
||||||
|
return;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
LogData(ERROR, "Unknown command '$cmd' in script at $file:$linenum");
|
LogData(ERROR, "Unknown command '$cmd' in script at $file:$linenum");
|
||||||
return undef;
|
return undef;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
sub AddSayer {
|
||||||
|
my($name, $displayname, $sprite, @textcolor)=@_;
|
||||||
|
if(@textcolor < 4) {
|
||||||
|
$textcolor[3] = 255;
|
||||||
|
}
|
||||||
|
|
||||||
|
$sayers{$name} = {
|
||||||
|
'Name' => $name,
|
||||||
|
'DisplayName' => $displayname,
|
||||||
|
'Sprite' => $sprite,
|
||||||
|
'TextColor' => \@textcolor
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub SayLine {
|
||||||
|
my($ref, $text)=@_;
|
||||||
|
LogData(INFO, "%s saying \"%s\"", $ref->{'DisplayName'}, $text);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|
|
||||||
|
|
@ -2,7 +2,11 @@ __init__:
|
||||||
SetBackground 128 128 128 255
|
SetBackground 128 128 128 255
|
||||||
SetAssetOption spritesheet.png Animated
|
SetAssetOption spritesheet.png Animated
|
||||||
|
|
||||||
Show aka spritesheet.png 0 0 1 type Reverse
|
Show aka spritesheet.png 0 0 1 flip
|
||||||
|
Show aka2 spritesheet.png 100 0 2 Reverse
|
||||||
|
Show aka3 spritesheet.png 200 0 3 max_loops=10
|
||||||
|
|
||||||
|
AddSayer h Hermione aka01.png
|
||||||
|
|
||||||
#Show aka aka.vs 0 0 1 type Reverse
|
#Show aka aka.vs 0 0 1 type Reverse
|
||||||
#Show aka2 aka.vs 100 0 2
|
#Show aka2 aka.vs 100 0 2
|
||||||
|
|
@ -11,4 +15,5 @@ __init__:
|
||||||
|
|
||||||
donothing:
|
donothing:
|
||||||
Wait
|
Wait
|
||||||
|
h "Some text here"
|
||||||
Jump donothing
|
Jump donothing
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1,2 @@
|
||||||
|
ShowSprite with flip option doesn't work
|
||||||
|
.vs constructed animated sprites don't respect source image's alpha channel
|
||||||
Loading…
Reference in New Issue