Basic control interface

This commit is contained in:
Ryan Shepherd 2018-09-25 11:35:52 -04:00
parent e546d6cb28
commit 383356f361
6 changed files with 141 additions and 20 deletions

View File

@ -8,33 +8,34 @@ use vars qw/$StackTraceLevel $LogLevel @InputCallbacks %ConsoleCommands @LogCall
@ISA = qw/Exporter/; @ISA = qw/Exporter/;
use constant { use constant {
DEBUG => 0, DEVALL => 0,
INFO => 1, DEBUG => 1,
STATUS => 2, INFO => 2,
WARN => 3, STATUS => 3,
ERROR => 4, WARN => 4,
CRIT => 5, ERROR => 5,
FATAL => 6, CRIT => 6,
FATAL => 7,
}; };
my @debugnames=qw/DEBUG INFO STATUS WARN ERROR CRIT FATAL/; my @debugnames=qw/DEVALL DEBUG INFO STATUS WARN ERROR CRIT FATAL/;
$StackTraceLevel = ERROR; $StackTraceLevel = ERROR;
$LogLevel = DEBUG; $LogLevel = DEBUG;
@LogCallbacks = (); @LogCallbacks = ();
@InputCallbacks = (\&StdinConsole); @InputCallbacks = (\&StdinConsole);
@EXPORT_OK = (); @EXPORT_OK = ();
@EXPORT = qw/DEBUG INFO STATUS WARN ERROR CRIT FATAL LogData/; @EXPORT = qw/DEVALL DEBUG INFO STATUS WARN ERROR CRIT FATAL LogData/;
sub LogData { sub LogData {
my($level, $log, @args)=@_; my($level, $log, @args)=@_;
my($file, $line); my($file, $line);
(undef, $file, $line)=caller(); (undef, $file, $line)=caller();
if($level < DEBUG || $level > FATAL) { if($level < 0 || $level > FATAL) {
$level = FATAL; $level = FATAL;
} }
return if($level < $LogLevel); return if($level < $LogLevel);
my $str = sprintf("[%6s] %s $log\n", $debugnames[$level], scalar localtime(), @args); my $str = sprintf("[%6s] %s %s:%i\t$log\n", $debugnames[$level], scalar localtime(), $file, $line, @args);
my $stack; my $stack;
if($level >= $StackTraceLevel) { if($level >= $StackTraceLevel) {

52
PerlRPG/Controls.pm Normal file
View File

@ -0,0 +1,52 @@
package PerlRPG::Game;
use strict;
require Exporter;
use SDL;
use SDL::Event;
use SDLx::App;
use SDLx::Sprite;
use SDLx::Sprite::Animated;
use PerlRPG::Game;
use PerlRPG::Console;
use PerlRPG::Assets;
use PerlRPG::Drawing;
use PerlRPG::Script;
use vars qw/$app @ISA @EXPORT @EXPORT_OK %keymap/;
@ISA = qw/Exporter/;
@EXPORT = qw/KeyDown KeyUp MouseClick/;
@EXPORT_OK = @EXPORT;
%keymap = (
'space-down' => \&PerlRPG::Script::SkipText,
);
sub KeyPress {
foreach my $key (@_) {
if(exists($keymap{$key})) {
$keymap{$key}->($key);
}
}
}
sub KeyDown {
my($key)=@_;
my $key2="$key-down";
LogData(DEVALL, "KeyDown($key)");
KeyPress($key, $key2);
}
sub KeyUp {
my($key)=@_;
my $key2="$key-up";
LogData(DEVALL, "KeyUp($key)");
KeyPress($key, $key2);
}
sub MouseClick {
my($x, $y, $btn)=@_;
LogData(DEBUG, "MouseClick($x, $y, $btn");
}

View File

@ -6,18 +6,61 @@ use SDL::Event;
use SDLx::App; use SDLx::App;
use SDLx::Sprite; use SDLx::Sprite;
use SDLx::Sprite::Animated; use SDLx::Sprite::Animated;
use SDLx::Text;
use PerlRPG::Console; use PerlRPG::Console;
use PerlRPG::Game; use PerlRPG::Game;
use PerlRPG::Assets; use PerlRPG::Assets;
use vars qw/@ISA @EXPORT @EXPORT_OK %VisibleSprites/; use vars qw/@ISA @EXPORT @EXPORT_OK %VisibleSprites/;
@ISA = qw/Exporter/; @ISA = qw/Exporter/;
@EXPORT = qw/ ShowSprite HideSprite MoveSprite SetBackgroundColor RenderSprites /; @EXPORT = qw/ ShowSprite HideSprite MoveSprite SetBackgroundColor RenderSprites DrawSpeech/;
@EXPORT_OK = (); @EXPORT_OK = ();
# FIXME - This should be exported already? # FIXME - This should be exported already?
*GetOption = \&PerlRPG::Game::GetOption; *GetOption = \&PerlRPG::Game::GetOption;
my $speech_border = 5;
sub DrawSpeech {
my($sayer, $text)=@_;
my $app = GetOption('App');
my $sprite = GetAsset($sayer->{'Sprite'});
my $sprite_x = $app->width() - $sprite->w();
my $sprite_y = $app->height() - $sprite->h();
my $sprite_h = $sprite->h();
$sprite = undef; # ShowSprite may unload this, we don't want to keep a handle to it
ShowSprite('_SayerSprite', $sayer->{'Sprite'}, $sprite_x, $sprite_y, 254);
my $text_obj = SDLx::Text->new();
$text_obj->color( $sayer->{'TextColor'} );
$text_obj->text( $text );
my $surface = SDLx::Surface->new( width => $sprite_x,
height => $sprite_h,
color => [0, 0, 0, 255],
);
$surface->draw_rect( [ $speech_border,
$speech_border,
$surface->width()-2*$speech_border,
$surface->height()-2*$speech_border ],
[0, 0, 0, 192]
);
my $text_x = ($surface->width() - $text_obj->w())/2;
my $text_y = ($surface->height() - $text_obj->h())/2;
$text_obj->write_xy( $surface, $text_x, $text_y );
$sprite = SDLx::Sprite->new( surface => $surface );
$VisibleSprites{'_SayerText'} = {
'Depth' => 255,
'X' => 0,
'Y' => $app->height() - $surface->height(),
'Sprite' => $sprite,
};
return 1;
}
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");

View File

@ -10,6 +10,7 @@ use PerlRPG::Console;
use PerlRPG::Assets; use PerlRPG::Assets;
use PerlRPG::Drawing; use PerlRPG::Drawing;
use PerlRPG::Script; use PerlRPG::Script;
use PerlRPG::Controls;
use vars qw/$app @ISA @EXPORT @EXPORT_OK/; use vars qw/$app @ISA @EXPORT @EXPORT_OK/;
@ISA = qw/Exporter/; @ISA = qw/Exporter/;
@ -54,7 +55,7 @@ sub Run {
my $ticktime = SDL::get_ticks() - $tick; my $ticktime = SDL::get_ticks() - $tick;
my $delta = 1000/$opt{'TargetFPS'} - $ticktime; my $delta = 1000/$opt{'TargetFPS'} - $ticktime;
LogData(DEBUG, "TickTime = $ticktime, Delta = $delta"); LogData(DEVALL, "TickTime = $ticktime, Delta = $delta");
SDL::delay($delta) if($delta > 0); SDL::delay($delta) if($delta > 0);
$tick = SDL::get_ticks(); $tick = SDL::get_ticks();
} }
@ -66,10 +67,10 @@ sub EventDispatcher {
while(SDL::Events::poll_event($event)) { while(SDL::Events::poll_event($event)) {
if($event->type == SDL_KEYDOWN) { if($event->type == SDL_KEYDOWN) {
my $key = SDL::Events::get_key_name($event->key_sym); my $key = SDL::Events::get_key_name($event->key_sym);
LogData(DEBUG, "KeyDown($key)"); KeyDown($key);
} elsif($event->type == SDL_KEYUP) { } elsif($event->type == SDL_KEYUP) {
my $key = SDL::Events::get_key_name($event->key_sym); my $key = SDL::Events::get_key_name($event->key_sym);
LogData(DEBUG, "KeyUp($key)"); KeyUp($key);
} elsif($event->type == SDL_QUIT) { } elsif($event->type == SDL_QUIT) {
$opt{'Running'} = 0; $opt{'Running'} = 0;
} }

View File

@ -9,6 +9,7 @@ use SDLx::Sprite::Animated;
use PerlRPG::Console; use PerlRPG::Console;
use PerlRPG::Game; use PerlRPG::Game;
use PerlRPG::Assets; use PerlRPG::Assets;
use PerlRPG::Drawing;
use vars qw/@ISA @EXPORT @EXPORT_OK/; use vars qw/@ISA @EXPORT @EXPORT_OK/;
@ISA = qw/Exporter/; @ISA = qw/Exporter/;
@ -73,6 +74,7 @@ sub RunScript {
# Run script from current position until a wait condition # Run script from current position until a wait condition
sub RunScriptTick { sub RunScriptTick {
return 1 if($lastsayer);
for(;;) { for(;;) {
my $script = GetAsset($current_file); # current_file can change in RunScriptLine, so reload each time my $script = GetAsset($current_file); # current_file can change in RunScriptLine, so reload each time
my $file = $current_file; my $file = $current_file;
@ -141,7 +143,29 @@ sub AddSayer {
sub SayLine { sub SayLine {
my($ref, $text)=@_; my($ref, $text)=@_;
LogData(INFO, "%s saying \"%s\"", $ref->{'DisplayName'}, $text); LogData(INFO, "%s saying \"%s\"", $ref->{'DisplayName'}, $text);
$text=~s/\\n/\n/g;
DrawSpeech($ref, $text);
$lastsayer = $ref;
return 1; return 1;
} }
sub SkipText {
$lastsayer = undef;
HideSprite('_SayerText');
HideSprite('_SayerSprite');
}
1; 1;

View File

@ -6,14 +6,14 @@ __init__:
Show aka2 spritesheet.png 100 0 2 Reverse Show aka2 spritesheet.png 100 0 2 Reverse
Show aka3 spritesheet.png 200 0 3 max_loops=10 Show aka3 spritesheet.png 200 0 3 max_loops=10
AddSayer h Hermione aka01.png AddSayer h Hermione aka01.png 200 200 200 255
AddSayer h2 Hermione aka05.png 255 0 0 255
#Show aka aka.vs 0 0 1 type Reverse
#Show aka2 aka.vs 100 0 2
Jump donothing Jump donothing
donothing: donothing:
Wait Wait
h "Some text here" Wait
h "Some text here\nNext line"
h2 "Different text here"
Jump donothing Jump donothing