PerlRPG/Assets.pm

@@ -21,7 +21,7 @@ sub FindFile {
 		return $files{$filename}{'Location'};
 	}
 
-	my $full = FindFileInDir(GetGameVar('ResourceDir'), $filename);
+	my $full = FindFileInDir(GetOption('ResourceDir'), $filename);
 	if($full) {
 		$files{$filename}={
 			'Loaded'	=> 0,
@@ -105,12 +105,11 @@ sub GetAssetType {
 }
 
 sub UnloadAsset {
-	foreach my $file (@_) {
-		if(exists $files{$file}) {
-			$files{$file}{'Loaded'} = 0;
-			delete $files{$file}{ $files{$file}{'Type'} };
-			$files{$file}{'Type'} = '';
-		}
+	my($file)=@_;
+	if(exists $files{$file}) {
+		$files{$file}{'Loaded'} = 0;
+		delete $files{$file}{ $files{$file}{'Type'} };
+		$files{$file}{'Type'} = '';
 	}
 }
 
@@ -136,8 +135,7 @@ sub LoadAsset {
 
 	if(!$filename && !($filename = FindFile($file))) {
 		LogData(FATAL, "Unable to load asset file '$file'; Unable to find file.");
-		ExitGame();
-		return;
+		SetOption('Running', 0);
 	}
 
 	if(exists $files{$file}) {

PerlRPG/Drawing.pm

@@ -10,7 +10,6 @@ use SDLx::Text;
 use PerlRPG::Console;
 use PerlRPG::Game;
 use PerlRPG::Assets;
-use PerlRPG::Math;
 
 use vars qw/@ISA @EXPORT @EXPORT_OK %VisibleSprites/;
 @ISA = qw/Exporter/;
@@ -20,82 +19,45 @@ use vars qw/@ISA @EXPORT @EXPORT_OK %VisibleSprites/;
 # FIXME - This should be exported already?
 *GetOption = \&PerlRPG::Game::GetOption;
 
+# FIXME - This should be a setable option
+my $speech_border = 5;
+
 sub DrawSpeech {
 	my($sayer, $text)=@_;
 	my $app = GetOption('App');
-	my $speech_border = GetOption('SpeechBorderSize');
-	my $speech_border_color = [split(/\s+/,GetOption('SpeechBorderColor'))];
-	my $speech_bg_color = [split(/\s+/,GetOption('SpeechBGColor'))];
-	my $speech_name_bg_color = [split(/\s+/,GetOption('SpeechNameBGColor'))];
 
 	my $sprite = GetAsset($sayer->{'Sprite'});
-	my $sprite_x = 0;
-	my $speech_x = 0;
-
-	my $sprite_w = $sprite->clip()->w();
+	my $sprite_x = $app->width() - $sprite->clip()->w();
+	my $sprite_y = $app->height() - $sprite->clip()->h();
 	my $sprite_h = $sprite->clip()->h();
-
-	my $sprite_y = $app->height() - $sprite_h;
-	my $speech_y = $sprite_y;
-
-	if($sayer->{'DrawLeft'}) {
-		$speech_x = $sprite_w;
-	} else {
-		$sprite_x = $app->width() - $sprite_w;
-	}
 	$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, @{ $sayer->{'SpriteOpts'} });
 
-	my $name_obj = SDLx::Text->new();
-	$name_obj->color( $sayer->{'TextColor'} );
-	$name_obj->text( $sayer->{'DisplayName'} );
-
 	my $text_obj = SDLx::Text->new();
 	$text_obj->color( $sayer->{'TextColor'} );
 	$text_obj->text( $text );
 
-	my $surface = SDLx::Surface->new(	width	=> $app->width() - $sprite_w,
+	my $surface = SDLx::Surface->new(	width	=> $sprite_x,
 						height	=> $sprite_h,
-						color	=> $speech_border_color,
+						color	=> [0, 0, 0, 255],
 					);
-	$surface->draw_rect(	[0, 0, $surface->width(), $name_obj->h()], [@$speech_name_bg_color[0,1,2], 255] );
 	$surface->draw_rect(	[	$speech_border,
-					$name_obj->h() + $speech_border,
+					$speech_border,
 					$surface->width()-2*$speech_border,
-					$surface->height()-$name_obj->h()-(2*$speech_border)	],
-				[@$speech_bg_color[0,1,2], 255]
+					$surface->height()-2*$speech_border	],
+				[0, 0, 0, 192]
 			   );
 
 	my $text_x = ($surface->width() - $text_obj->w())/2;
-	my $text_y = $name_obj->h() + ($surface->height()-$name_obj->h() - $text_obj->h())/2;
-	$name_obj->write_xy( $surface, 0, 0 );
+	my $text_y = ($surface->height() - $text_obj->h())/2;
 	$text_obj->write_xy( $surface, $text_x, $text_y );
 
-	# Recreate alpha channels
-	if($speech_name_bg_color->[3] != 255) {
-		Surface_ChangeColor(
-			$surface,
-			[@$speech_name_bg_color[0,1,2],255],
-			$speech_name_bg_color,
-			[0, 0, $surface->width(), $name_obj->h()]
-		);
-	}
-
-	if($speech_bg_color->[3] != 255) {
-		Surface_ChangeColor( $surface, [@$speech_bg_color[0,1,2],255], $speech_bg_color,
-					[	$speech_border,
-						$name_obj->h() + $speech_border,
-						$surface->width() - 2 * $speech_border,
-						$surface->height() - $name_obj->h() - 2 * $speech_border
-					]
-					);
-	}
-
+	$sprite = SDLx::Sprite->new( surface => $surface );
 	$VisibleSprites{'_SayerText'} = {
 		'Depth'		=> 255,
-		'X'		=> $speech_x,
-		'Y'		=> $speech_y,
-		'Sprite'	=> SDLx::Sprite->new( surface => $surface ),
+		'X'		=> 0,
+		'Y'		=> $app->height() - $surface->height(),
+		'Sprite'	=> $sprite,
 	};
 		
 	return 1;
@@ -114,7 +76,6 @@ sub ShowSprite {
 	my $a = GetAsset($file);
 	if($t eq 'ASprite') {
 		# Unload the asset so that future versions of the same name will be fresh copies
-		# This is necessary for instances where the frame position doesn't match
 		UnloadAsset($file);
 
 		# Start animation
@@ -124,33 +85,17 @@ sub ShowSprite {
 	foreach my $o (@opt) {
 		my($name, $val)=$o=~/^\s*(\S+?)=(\S*)/;
 		$name = $o unless($name);
-		$name = lc($name);
-		if($name eq 'reverse' || $name eq 'circular') {
-			if($t eq 'ASprite') {
-				$a->type($name);
-			} else {
-				LogData(WARN, "%s - Non animated sprite can't have %s property", GetScriptPosition(), $name);
-			}
+		if($o eq 'Reverse' || $o eq 'Circular') {
+			$a->type($o);
 		} elsif($name eq 'max_loops') {
-			if($t eq 'ASprite') {
-				$a->max_loops($val);
-			} else {
-				LogData(WARN, "%s - Non animated sprite can't have %s property", GetScriptPisition(), $name);
-			}
-		} elsif($name eq 'flip') {
+			$a->max_loops($val);
+		} elsif($o eq 'flip') {
 			# Don't want to flip back and forth every time
 			UnloadAsset($file);
 			my $s=$a->surface();
-			$a->surface( Surface_Flip($s) );
-		} elsif($name eq 'ticks') {
-			if($t eq 'ASprite') {
-				$val = 1 unless($val);
-				$a->ticks_per_frame($val);
-			} else {
-				LogData(WARN, "%s - Non animated sprite can't have %s property", GetScriptPosition(), $name);
-			}
+			$a->surface( FlipSurface($s) );
 		} else {
-			LogData(WARN, "%s - Unknown sprite property '%s'", GetScriptPosition(), $name);
+			LogData(WARN, "Unknown option in ShowSprite '$o' - '$name'='$val'");
 		}
 	}
 
@@ -168,13 +113,6 @@ sub HideSprite {
 	delete $VisibleSprites{$name};
 }
 
-sub ClearScreen {
-	foreach (keys %VisibleSprites) {
-		next if($_ eq 'Background');
-		HideSprite($_);
-	}
-}
-
 sub MoveSprite {
 	my($name, $x, $y)=@_;
 	return undef unless(exists $VisibleSprites{$name});
@@ -217,7 +155,8 @@ sub RenderSprites {
 	}
 }
 
-sub Surface_Flip {
+# Fixme -- Still appears broken, but closer
+sub FlipSurface {
 	my $src=shift(@_);
 	my $dst = SDLx::Surface->new(	width	=> $src->width(),
 					height	=> $src->height(),
@@ -240,28 +179,10 @@ sub Surface_Flip {
 	
 }
 
-# Per pixel, search for $from and change to $to
-# Searches within @$rect if provided
-sub Surface_ChangeColor {
-	my($surface, $from, $to, $rect)=@_;
-	my($start_x, $start_y, $w, $h)=(0,0,$surface->w(),$surface->h());
-	if($rect && ref $rect) {
-		$start_x = Constrain( $rect->[0], 0, $surface->w());
-		$start_y = Constrain( $rect->[1], 0, $surface->h());
-		$w = Constrain( $rect->[2], 0, $surface->w() - $start_x);
-		$h = Constrain( $rect->[3], 0, $surface->h() - $start_y);
-	}
 
-	my $frompix = SDL::Video::map_RGBA( $surface->format(), @$from);
-	my $topix = SDL::Video::map_RGBA( $surface->format(), @$to);
 
-	for(my $y=$start_y; $y<$start_y + $h; $y++) {
-		for(my $x=$start_x; $x<$start_x + $w; $x++) {
-			if($surface->get_pixel( $y, $x ) == $frompix) {
-				$surface->set_pixel( $y, $x, $topix );
-			}
-		}
-	}
-}
+
+
+
 
 1;

PerlRPG/Game.pm

@@ -14,64 +14,50 @@ use PerlRPG::Controls;
 use vars qw/$app @ISA @EXPORT @EXPORT_OK/;
 
 @ISA = qw/Exporter/;
-@EXPORT = qw/InitApp Run GetOption ExitGame/;
+@EXPORT = qw/InitApp Run RunScript GetOption SetOption ExitGame/;
 @EXPORT_OK = @EXPORT;
 
 $app = undef;
 my %opt = (
 	'App'		=> undef,
+	'Running'	=> 1,
+	'TargetFPS'	=> 5,
+	'ResourceDir'	=> '.',
+	'Status'	=> 'WaitForFrame',
 );
 
-my %default_gamevars = (
-	'TargetFPS'		=> 10,
-	'GameRunning'		=> 1,
-	'ResourceDir'		=> '"."',
-	'SpeechBorderSize'	=> 3,
-	'SpeechBorderColor'	=> '"255 255 255 255"',
-	'SpeechBGColor'		=> '"192 192 192 255"',
-	'SpeechNameBGColor'	=> '"0 0 0 0"',
-);
+sub GetOption { return (exists $opt{$_[0]} ? $opt{$_[0]} : undef); }
+sub SetOption { $opt{$_[0]} = $_[1]; }
 
-sub GetOption {
-	my $key = shift(@_);
-	if(exists($opt{$key})) {
-		return $opt{$key};
-	} elsif(exists $PerlRPG::Script::game_vars{$key}) {
-		return GetGameVar($key);
-	} else {
-		LogData(WARN, "Request for unknown option '$key'");
-		return undef;
-	}
-}
 
 sub InitApp {
 	my($width, $height)=@_;
+
 	return undef if($app);
+
 	LogData(INFO, "Creating SDL instance");
-
-	foreach (keys %default_gamevars) {
-		DefGameVar($_, $default_gamevars{$_});
-	}
-
-	$app = SDLx::App->new( width => $width, height => $height);
+	$app = SDLx::App->new(
+		width => $width,
+		height => $height,
+		);
 	$opt{'App'}=$app;
 	LogData(DEBUG, "SDL Instance created");
 	return $app;
 }
 
 sub ExitGame {
-	SetGameVar('GameRunning', 0);
+	SetOption('Running', 0);
 }
 
 sub Run {
 	my $tick = SDL::get_ticks();
-	while(GetGameVar('GameRunning')) {
+	while($opt{'Running'}) {
 		EventDispatcher();
 		RunScriptTick();
 		RenderScreen();
 
 		my $ticktime = SDL::get_ticks() - $tick;
-		my $delta = 1000/GetGameVar('TargetFPS') - $ticktime;
+		my $delta = 1000/$opt{'TargetFPS'} - $ticktime;
 
 		LogData(DEVALL, "TickTime = $ticktime, Delta = $delta");
 		SDL::delay($delta) if($delta > 0);
@@ -104,7 +90,7 @@ sub EventDispatcher {
 					SDL::Events::get_mod_state()
 				);
 		} elsif($event->type == SDL_QUIT) {
-			SetGameVar('GameRunning', 0);
+			$opt{'Running'} = 0;
 		}
 	}
 }
@@ -114,4 +100,8 @@ sub RenderScreen {
 	$app->update();
 }
 
+sub RunScript {
+
+}
+
 1;

PerlRPG/Math.pm

@@ -1,23 +0,0 @@
-package PerlRPG::Math;
-use strict;
-require Exporter;
-
-use vars qw/@ISA @EXPORT @EXPORT_OK/;
-@ISA = qw/Exporter/;
-@EXPORT = qw/Constrain MIN MAX/;
-@EXPORT_OK = ();
-
-sub MIN {
-	return ($_[0] > $_[1] ? $_[0] : $_[1]);
-}
-
-sub MAX {
-	return ($_[0] > $_[1] ? $_[1] : $_[0]);
-}
-
-sub Constrain {
-	my($val, $min, $max)=@_;
-	return MAX(MIN($val, $min),$max);
-}
-
-1;

PerlRPG/Script.pm

@@ -11,9 +11,9 @@ use PerlRPG::Game;
 use PerlRPG::Assets;
 use PerlRPG::Drawing;
 
-use vars qw/@ISA @EXPORT @EXPORT_OK %game_vars/;
+use vars qw/@ISA @EXPORT @EXPORT_OK/;
 @ISA = qw/Exporter/;
-@EXPORT = qw/CompileScripts RunScript RunScriptTick GetGameVar SetGameVar DefGameVar EvalString GetScriptPosition/;
+@EXPORT = qw/CompileScripts RunScript RunScriptTick GetGameVar SetGameVar DefGameVar EvalString/;
 @EXPORT_OK = @EXPORT;
 
 my %labels;
@@ -26,47 +26,22 @@ my %script_commands = (
 	'Define'		=> {'sub' => \&DefGameVar,				'wait'	=> 0},
 	'ExitGame'		=> {'sub' => \&PerlRPG::Game::ExitGame,			'wait'	=> 1},
 	
-	'Jump'			=> {'sub' => \&RunScript,				'wait'	=> 0},
-	'Call'			=> {'sub' => \&Call,					'wait'	=> 0},
-	'Return'		=> {'sub' => \&Return,					'wait'	=> 0},
-	
+	'Jump'			=> {'sub' => \&PerlRPG::Script::RunScript,		'wait'	=> 0},
 
 	'Show'			=> {'sub' => \&PerlRPG::Drawing::ShowSprite,		'wait'	=> 0},
 	'Hide'			=> {'sub' => \&PerlRPG::Drawing::HideSprite,		'wait'	=> 0},
 	'SetBackground'		=> {'sub' => \&PerlRPG::Drawing::SetBackgroundColor,	'wait'	=> 0},
-	'ClearScreen'		=> {'sub' => \&PerlRPG::Drawing::ClearScreen,		'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},
-	'RecompileScripts'	=> {'sub' => \&RecompileScripts,			'wait'	=> 1},
 );
 
 my %sayers = ();
 my $lastsayer=undef;
-my @CallStack;
 
-%game_vars = ();
-
-sub Call {
-	my($label)=@_;
-	my @pos = ($current_file, $current_line+1);
-	if(RunScript($label)) {
-		push @CallStack, \@pos;
-	} else {
-		LogData(ERROR, "%s Unable to call '$label': Undefined label.", GetScriptPosition());
-	}
-}
-
-sub Return {
-	if(!@CallStack) {
-		LogData(ERROR, "%s Call stack underrun.", GetScriptPosition());
-		return;
-	}
-	my $ref = pop(@CallStack);
-	($current_file, $current_line) = @$ref;
-}
+my %game_vars = ();
 
 sub GetGameVar {
 	my $key = shift(@_);
@@ -95,20 +70,9 @@ sub DefGameVar {
 	my($key, $val)=@_;
 	if(!exists $game_vars{$key}) {
 		$game_vars{$key} = StringSubst($val);
-		LogData(DEBUG, "Defined variable '$key' as '$game_vars{$key}'");
 	}
 }
 		
-sub RecompileScripts {
-	my $jumpto = (shift(@_) || '__init__');
-	my @scripts = LoadAssets('gs');
-
-	LogData(INFO, "Doing full script recompile and jumping to '$jumpto'");
-	UnloadAsset(@scripts);
-	CompileScripts();
-	RunScript($jumpto);
-}
-		
 # Load script files, locate labels
 sub CompileScripts {
 	my @scripts = sort { $a cmp $b } LoadAssets('gs');
@@ -136,35 +100,25 @@ sub RunScript {
 	if(exists $labels{$label}) {
 		$current_file = $labels{$label}{'File'};
 		$current_line = $labels{$label}{'Line'};
-		return 1;
+		LogData(DEBUG, "RunScript($label) moving to $current_file:$current_line");
 	} else {
 		LogData(ERROR, "RunScript($label) unknown label");
-		return 0;
 	}
 }
 
-sub GetScriptPosition {
-	return "$current_file:$current_line";
-}
-
 # 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;
-		my $line = $current_line;
+		my $line = $current_line++;
 		if($line >= @$script) {
 			LogData(ERROR, "Script file ended");
-			SetGameVar('GameRunning', 0);
+			SetOption('Running', 0);
 			return;
 		}
-		my $r=RunScriptLine($file, $line, $script->[$line]);
-		if($current_line == $line && $current_file eq $file) {
-			# Advance the line number if RunScriptLine didn't move us
-			$current_line++;
-		}
-		if($r) {
+		if(RunScriptLine($file, $line, $script->[$line])) {
 			return;
 		}
 	}
@@ -221,25 +175,12 @@ sub AddSayer {
 	my @textcolor=($r, $g, $b, $a);
 	$textcolor[3] = 255 unless(defined $a);
 
-	my $drawleft = 0;
-	my @sprite_opts;
-
-	foreach my $opt (@opts) {
-		if(lc($opt) eq 'left') {
-			$drawleft = 1;
-		} else {
-			push @sprite_opts, $opt;
-		}
-	}
-	
-
 	$sayers{$name} = {
 		'Name'		=> $name,
 		'DisplayName'	=> StringSubst($displayname),
 		'Sprite'	=> $sprite,
 		'TextColor'	=> \@textcolor,
-		'DrawLeft'	=> $drawleft,
-		'SpriteOpts'	=> \@sprite_opts,
+		'SpriteOpts'	=> \@opts,
 	};
 }
 
@@ -277,26 +218,9 @@ sub EvalString {
 
 	#LogData(DEBUG, "Val is '$val'");
 
-	# Pretokenize quoted strings
-	my @pretokens;
-	$val=~s/\\"/\x01/g;
-	while(my($start,$quote,$left)=$val=~/^(.*?)(".*?")(.*)$/) {
-		push @pretokens, $start if($start);
-		push @pretokens, $quote;
-		$val = $left;
-	}
-	push @pretokens, $val if($val);
-
 	# Tokenize
-	my @tokens;
-	foreach my $token (@pretokens) {
-		$token=~s/\x01/\\"/g;
-		if(IsString($token)) {
-			push @tokens, $token;
-		} else {
-			push @tokens, split(/\s+/, $token);
-		}
-	}
+	my @tokens = split(/\s+/,$val);
+
 
 	#for(my $i=0;$i<@tokens-0;$i++) { LogData(DEBUG, "Pass 1 Token [%i], '%s'", $i, $tokens[$i]); }
 

Resources/fire.vs

@@ -1,10 +0,0 @@
-fire_01.png
-fire_02.png
-fire_03.png
-fire_04.png
-fire_05.png
-fire_06.png
-fire_07.png
-fire_08.png
-fire_09.png
-fire_10.png

Resources/fireplace_fire.vs

@@ -1,8 +0,0 @@
-fireplace_fire_01.png
-fireplace_fire_02.png
-fireplace_fire_03.png
-fireplace_fire_04.png
-fireplace_fire_05.png
-fireplace_fire_06.png
-fireplace_fire_07.png
-fireplace_fire_08.png

Resources/script.gs

@@ -1,42 +1,26 @@
 __init__:
-	ResourceDir = "Resources"
-	TargetFPS = 20
-
-drawroom:
-	ClearScreen
-	SetBackground 0 0 0 255
+	SetBackground 128 128 128 255
 	SetAssetOption spritesheet.png Animated
-	AddSayer h "Hermione" aka01.png 255 0 0 255
-
-	SpeechBorderSize = 3
-	SpeechBorderColor = "128 128 128 255"
-	SpeechBGColor = "192 192 192 255"
-	SpeechNameBGColor = "0 0 0 0"
-
-	Show bg		main_room_day.png	0 0 10
-	Show window	05_window.png		350 100 11
-	Show cupboard	cupboard.png		120 72 11
-	Show door	door.png		840 177 11
-	Show fireplace	fireplace.png		600 150 11
-	Show candler	candle.png		400 100 11 flip
-	Show candlel	candle.png		240 100 11
-
-	Show fireplacea	fireplace_fire.vs	575 147 12 ticks=2
-	Show candlera	fire.vs			400 95 12 flip ticks=2
-	Show candlela	fire.vs			240 95 12 ticks=2
-
-
-	Show desk	11_genie_00.png		230 220 13
-	Show hermione	spritesheet.png		450 310 14 reverse ticks=4
-
-convo:
-	Call subtest
-
-	RecompileScripts drawroom
-	Jump convo
-
-subtest:
+	Define LoopCount 0
 	Define TestVar 1
-	h "Loop [TestVar]..."
-	TestVar = TestVar + 1
-	Return
+
+	Show aka spritesheet.png 0 0 1 flip
+	Show aka2 aka.vs 100 0 2
+	Show aka3 aka.vs 200 0 3 Reverse flip
+	Show aka4 spritesheet.png 300 0 1 max_loops=1
+
+	AddSayer h "Hermione" aka01.png 200 200 200 255 flip
+	AddSayer h2 "Topless\ Hermione" aka05.png 255 0 0 255
+	AddSayer h3 "Stripping\ Hermione" spritesheet.png 255 0 0 255 Reverse
+	
+	Jump donothing
+
+donothing:
+	Wait
+	LoopCount=LoopCount+1
+	h "Loop number [LoopCount]"
+	TestVar=lc("Foo").uc(lc("Foo"))
+	h2 "TestVar [TestVar]"
+	TestVar = uc("[TestVar]")
+	h3 "TestVar2 [TestVar]"
+	Jump donothing

Tests/Script.pl

@@ -26,7 +26,5 @@ ok( PerlRPG::Script::IsString(5)==0,			"'5' is not a string");
 ok( EvalString("\"[TestVar]\"") eq '3',			"\"[TestVar]\" is 3");
 ok( EvalString("3 + 3") == 6,				"\"3 + 3\" == 6");
 ok( EvalString("lc('FoO') . uc('FoO')") eq 'fooFOO',	"String function test");
-SetGameVar("TestVar", "\"FoO\"");
-ok( EvalString("uc(\" [TestVar] \")") eq ' FOO ',	"Complex string function test");
 
 done_testing();