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/;
use constant {
DEBUG => 0,
INFO => 1,
STATUS => 2,
WARN => 3,
ERROR => 4,
CRIT => 5,
FATAL => 6,
DEVALL => 0,
DEBUG => 1,
INFO => 2,
STATUS => 3,
WARN => 4,
ERROR => 5,
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;
$LogLevel = DEBUG;
@LogCallbacks = ();
@InputCallbacks = (\&StdinConsole);
@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 {
my($level, $log, @args)=@_;
my($file, $line);
(undef, $file, $line)=caller();
if($level < DEBUG || $level > FATAL) {
if($level < 0 || $level > FATAL) {
$level = FATAL;
}
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;
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::Sprite;
use SDLx::Sprite::Animated;
use SDLx::Text;
use PerlRPG::Console;
use PerlRPG::Game;
use PerlRPG::Assets;
use vars qw/@ISA @EXPORT @EXPORT_OK %VisibleSprites/;
@ISA = qw/Exporter/;
@EXPORT = qw/ ShowSprite HideSprite MoveSprite SetBackgroundColor RenderSprites /;
@EXPORT = qw/ ShowSprite HideSprite MoveSprite SetBackgroundColor RenderSprites DrawSpeech/;
@EXPORT_OK = ();
# FIXME - This should be exported already?
*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 {
my($name, $file, $x, $y, $d, @opt)=@_;
LogData(DEBUG, "Showing sprite $file as $name");

View File

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

View File

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

View File

@ -6,14 +6,14 @@ __init__:
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 aka2 aka.vs 100 0 2
AddSayer h Hermione aka01.png 200 200 200 255
AddSayer h2 Hermione aka05.png 255 0 0 255
Jump donothing
donothing:
Wait
h "Some text here"
Wait
h "Some text here\nNext line"
h2 "Different text here"
Jump donothing