From 8f5bbd7d821790766c93998ac4079ea5c945ebe1 Mon Sep 17 00:00:00 2001
From: Ryan Shepherd <rotaryprophet@gmail.com>
Date: Sun, 23 Sep 2018 15:59:54 -0400
Subject: [PATCH] Move Assets into module, create Drawing module

---
 PerlRPG/Assets.pm  | 220 +++++++++++++++++++++++++++++++++++++++++++
 PerlRPG/Drawing.pm |  96 +++++++++++++++++++
 PerlRPG/Game.pm    | 230 +++------------------------------------------
 main.pl            |  20 ++--
 4 files changed, 341 insertions(+), 225 deletions(-)
 create mode 100644 PerlRPG/Assets.pm
 create mode 100644 PerlRPG/Drawing.pm
 mode change 100644 => 100755 main.pl

diff --git a/PerlRPG/Assets.pm b/PerlRPG/Assets.pm
new file mode 100644
index 0000000..a68df85
--- /dev/null
+++ b/PerlRPG/Assets.pm
@@ -0,0 +1,220 @@
+package PerlRPG::Assets;
+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 vars qw/%files @ISA @EXPORT @EXPORT_OK/;
+@ISA = qw/Exporter/;
+@EXPORT = qw/ScanDirectory GetAsset GetAssetType LoadAssets UnloadAsset/;
+@EXPORT_OK = ();
+
+# Check %files cache for file location, otherwise search in path
+sub FindFile {
+	my $filename=shift(@_);
+	if(exists $files{$filename}) {
+		return $files{$filename}{'Location'};
+	}
+
+	my $full = FindFileInDir(GetOption('ResourceDir'), $filename);
+	if($full) {
+		$files{$filename}={
+			'Loaded'	=> 0,
+			'Location'	=> $full,
+			};
+		LogData(DEBUG, "Located '$filename' at '$full'");
+		return $full;
+	}
+	LogData(WARN, "Unable to locate file '$filename' in Resource Path");
+	return undef;
+}
+
+# Search for filename in path given and all sub-directories (Recursive)
+sub FindFileInDir {
+	my($dir, $filename)=@_;
+	if(-f "$dir/$filename") {
+		return "$dir/$filename";
+	}
+
+	foreach my $file (<$dir/*>) {
+		next unless(-d $file);
+		if(my $res = FindFileInDir($file, $filename)) {
+			return $res;
+		}
+	}
+	return undef;
+}
+
+# Scan every file in path given and add to %files (Recursive)
+sub ScanDirectory {
+	my $path = shift(@_);
+
+	foreach my $file (<$path/*>) {
+		if(-d $file) {
+			ScanDirectory($file);
+		} else {
+			my($fname)=$file=~/.+\/(.+?)$/;
+			$files{$fname}={
+				'Loaded'	=> 0,
+				'Location'	=> $file,
+				};
+		}
+	}
+}
+
+# Load all assets with given file extension
+sub LoadAssets {
+	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'});
+		}
+	}
+}
+
+# Return the asset object
+sub GetAsset {
+	my($file)=@_;
+
+	if(!exists $files{$file} || !$files{$file}{'Loaded'}) {
+		if(!LoadAsset($file)) {
+			return undef;
+		}
+	}
+	return $files{$file}{ $files{$file}{'Type'} };
+}
+
+# Return asset object type
+sub GetAssetType {
+	my($file)=@_;
+
+	if(!exists $files{$file} || !$files{$file}{'Loaded'}) {
+		if(!LoadAsset($file)) {
+			return undef;
+		}
+	}
+	return $files{$file}{'Type'};
+}
+
+sub UnloadAsset {
+	my($file)=@_;
+	if(exists $files{$file}) {
+		$files{$file}{'Loaded'} = 0;
+		delete $files{$file}{ $files{$file}{'Type'} };
+		$files{$file}{'Type'} = '';
+	}
+}
+
+
+sub LoadAsset {
+	my($file, $filename)=@_;
+
+	if(!$filename && !($filename = FindFile($file))) {
+		LogData(FATAL, "Unable to load asset file '$file'; Unable to find file.");
+		SetOption('Running', 0);
+	}
+
+	if(exists $files{$file}) {
+		if($files{$file}{'Loaded'}) {
+			return $files{$file};
+		}
+	} else {
+		$files{$file}={
+			'Loaded'	=> 0,
+			'Location'	=> $filename,
+			};
+	}
+
+
+	my($ext)=$file=~/.+\.(.+?)$/;
+	$ext = lc($ext);
+	if(grep { $_ eq $ext } (qw/png jpg jpeg bmp/)) {
+		$files{$file}{'Type'} = 'Sprite';
+		my $sprite = SDLx::Sprite->new(
+			image => $files{$file}{'Location'},
+			);
+		if(!$sprite) {
+			LogData(ERROR, "Unable to load sprite '$filename': $!");
+			return undef;
+		}
+		$files{$file}{'Sprite'} = $sprite;
+	} elsif($ext eq 'vs') {
+		unless(open(IN, $filename)) {
+			LogData(ERROR, "Unable to load '$filename': $!");
+			return undef;
+		}
+		my @frames = <IN>;
+		chomp(@frames);
+		close(IN);
+		LoadVirtualSprite($file, @frames);
+	} elsif($ext eq 'gs') {
+		unless(open(IN, $filename)) {
+			LogData(ERROR, "Unable to load '$filename': $!");
+			return undef;
+		}
+		$files{$file}{'Type'} = 'Script';
+		$files{$file}{'Script'} = join('', <IN>);
+		close(IN);
+	} else {
+		LogData(WARN, "Unable to pre-load asset of type '$ext'");
+		return undef;
+	}
+
+
+	$files{$file}{'Loaded'} = 1;
+	return $files{$file};
+}
+
+sub LoadVirtualSprite {
+	my($name, @files)=@_;
+
+	if(exists $files{$name} && $files{$name}{'Loaded'}) {
+		return $files{$name};
+	}
+
+	foreach (@files) {
+		if(!LoadAsset($_)) {
+			LogData(ERROR, "Unable to load virtual sprite, error loading one or more assets.");
+			return undef;
+		}
+		LogData(DEBUG, "Adding asset $_ to virtual sprite $name");
+	}
+
+	my @frames = map { $files{$_}{'Sprite'}->surface() } (@files);
+	my $h = $frames[0]->height();
+	my $hp = 0;
+	
+	my $newsurface = SDLx::Surface->new(	width	=> $frames[0]->width(),
+						height	=> $h * (@frames-0),
+						format	=> $frames[0]->format(),
+						pitch	=> $frames[0]->pitch(),
+						flags	=> $frames[0]->flags(),
+						);
+	$newsurface->draw_rect( [0, 0, $newsurface->width(), $newsurface->height()], [0, 0, 0, 255]);
+	#SDL::Video::set_alpha( $newsurface, SDL::Video::SDL_SRCALPHA, 0);
+	foreach (@frames) {
+		#SDL::Video::set_alpha( $_, SDL::Video::SDL_SRCALPHA, 255);
+		#FIXME - This call ignores the source alpha channel
+		$_->blit( $newsurface, undef, [0, $hp, $_->width(), $_->height()]);
+		$hp += $h;
+	}
+
+	my $anim = SDLx::Sprite::Animated->new( surface		=> $newsurface,
+						width		=> $newsurface->width(),
+						height		=> $h,
+						step_x		=> $newsurface->width(),
+						step_y		=> $h,
+						);
+	$files{$name}{'Loaded'} = 1;
+	$files{$name}{'Type'} = 'ASprite';
+	$files{$name}{'ASprite'} = $anim;
+	return $anim;
+}
+
+
+1;
diff --git a/PerlRPG/Drawing.pm b/PerlRPG/Drawing.pm
new file mode 100644
index 0000000..7f53fe3
--- /dev/null
+++ b/PerlRPG/Drawing.pm
@@ -0,0 +1,96 @@
+package PerlRPG::Drawing;
+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 Storable qw/dclone/;
+
+use vars qw/@ISA @EXPORT @EXPORT_OK %VisibleSprites/;
+@ISA = qw/Exporter/;
+@EXPORT = qw/ ShowSprite HideSprite MoveSprite SetBackgroundColor RenderSprites /;
+@EXPORT_OK = ();
+
+# FIXME - This should be exported
+*GetOption = \&PerlRPG::Game::GetOption;
+
+sub ShowSprite {
+	my($name, $file, $x, $y, $d)=@_;
+	LogData(DEBUG, "Showing sprite $file as $name");
+
+	my $t = GetAssetType($file);
+	if($t ne 'Sprite' && $t ne 'ASprite') {
+		LogData(WARN, "Unable to ShowSprite on non-sprite asset '$file'");
+		return;
+	}
+
+	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') {
+		$a->start();
+	}
+
+	$VisibleSprites{$name}={
+		'Depth'		=> $d,
+		'X'		=> $x,
+		'Y'		=> $y,
+		'Sprite'	=> $a,
+	};
+	return 1;
+}
+
+sub HideSprite {
+	my($name)=@_;
+	delete $VisibleSprites{$name};
+}
+
+sub MoveSprite {
+	my($name, $x, $y)=@_;
+	return undef unless(exists $VisibleSprites{$name});
+	$VisibleSprites{$name}{'X'} = $x;
+	$VisibleSprites{$name}{'Y'} = $y;
+}
+
+sub SetBackgroundColor {
+	my $color;
+	if(!@_) {
+		$color = [0, 0, 0, 255];
+	} elsif(ref $_[0]) {
+		$color = $_[0];
+	} else {
+		$color = [@_];
+	}
+
+	# Force alpha channel?
+	$color->[3]=255;
+
+	my $app = GetOption('App');
+	my $surface = SDLx::Surface->new(width => $app->width(), height => $app->height());
+	$surface->draw_rect([0, 0, $surface->width(), $surface->height()], $color);
+	my $sprite = SDLx::Sprite->new( surface => $surface );
+	$VisibleSprites{'Background'}={
+		'Depth'		=> -1,
+		'X'		=> 0,
+		'Y'		=> 0,
+		'Sprite'	=> $sprite
+	};
+}
+
+sub RenderSprites {
+	my $app = GetOption('App');
+	my @names = sort { $VisibleSprites{$a}{'Depth'} <=> $VisibleSprites{$b}{'Depth'} } (keys %VisibleSprites);
+	foreach my $name (@names) {
+		my $x = $VisibleSprites{$name}{'X'};
+		my $y = $VisibleSprites{$name}{'Y'};
+		$VisibleSprites{$name}{'Sprite'}->draw_xy($app, $x, $y);
+	}
+}
+
+1;
diff --git a/PerlRPG/Game.pm b/PerlRPG/Game.pm
index c9f19ae..9b220e4 100644
--- a/PerlRPG/Game.pm
+++ b/PerlRPG/Game.pm
@@ -1,22 +1,32 @@
 package PerlRPG::Game;
 use strict;
+require Exporter;
 use SDL;
 use SDL::Event;
 use SDLx::App;
 use SDLx::Sprite;
 use SDLx::Sprite::Animated;
 use PerlRPG::Console;
-use vars qw/$app/;
+use PerlRPG::Assets;
+use PerlRPG::Drawing;
+use vars qw/$app @ISA @EXPORT @EXPORT_OK/;
+
+@ISA = qw/Exporter/;
+@EXPORT = qw/InitApp Run RunScript GetOption SetOption/;
+@EXPORT_OK = @EXPORT;
 
 $app = undef;
 my %opt = (
+	'App'		=> undef,
 	'Running'	=> 1,
 	'TargetFPS'	=> 5,
 	'ResourceDir'	=> '.',
 	'Status'	=> 'WaitForFrame',
 );
 
-my %files;
+sub GetOption { return (exists $opt{$_[0]} ? $opt{$_[0]} : undef); }
+sub SetOption { $opt{$_[0]} = $_[1]; }
+
 
 sub InitApp {
 	my($width, $height)=@_;
@@ -28,6 +38,7 @@ sub InitApp {
 		width => $width,
 		height => $height,
 		);
+	$opt{'App'}=$app;
 	LogData(DEBUG, "SDL Instance created");
 	return $app;
 }
@@ -65,225 +76,12 @@ sub EventDispatcher {
 }
 
 sub RenderScreen {
+	RenderSprites();
 	$app->update();
 }
 
-# Check %files cache for file location, otherwise search in path
-sub FindFile {
-	my $filename=shift(@_);
-	if(exists $files{$filename}) {
-		return $files{$filename}{'Location'};
-	}
-
-	my $full = FindFileInDir($opt{'ResourceDir'}, $filename);
-	if($full) {
-		$files{$filename}={
-			'Loaded'	=> 0,
-			'Location'	=> $full,
-			};
-		LogData(DEBUG, "Located '$filename' at '$full'");
-		return $full;
-	}
-	LogData(WARN, "Unable to locate file '$filename' in Resource Path");
-	return undef;
-}
-
-# Search for filename in path given and all sub-directories (Recursive)
-sub FindFileInDir {
-	my($dir, $filename)=@_;
-	if(-f "$dir/$filename") {
-		return "$dir/$filename";
-	}
-
-	foreach my $file (<$dir/*>) {
-		next unless(-d $file);
-		if(my $res = FindFileInDir($file, $filename)) {
-			return $res;
-		}
-	}
-	return undef;
-}
-
-# Scan every file in path given and add to %files (Recursive)
-sub ScanDirectory {
-	my $path = shift(@_);
-
-	foreach my $file (<$path/*>) {
-		if(-d $file) {
-			ScanDirectory($file);
-		} else {
-			my($fname)=$file=~/.+\/(.+?)$/;
-			$files{$fname}={
-				'Loaded'	=> 0,
-				'Location'	=> $file,
-				};
-		}
-	}
-}
-
-sub LoadAssets {
-	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'});
-		}
-	}
-}
-
-sub GetAsset {
-	my($file)=@_;
-
-	if(!exists $files{$file} || !$files{$file}{'Loaded'}) {
-		if(!LoadAsset($file)) {
-			return undef;
-		}
-	}
-	return $files{$file}{ $files{$file}{'Type'} };
-}
-
-sub GetAssetType {
-	my($file)=@_;
-
-	if(!exists $files{$file} || !$files{$file}{'Loaded'}) {
-		if(!LoadAsset($file)) {
-			return undef;
-		}
-	}
-	return $files{$file}{'Type'};
-}
-
-sub LoadAsset {
-	my($file, $filename)=@_;
-
-	if(!$filename && !($filename = FindFile($file))) {
-		LogData(FATAL, "Unable to load asset file '$file'; Unable to find file.");
-		$opt{'Running'}=0;
-	}
-
-	if(exists $files{$file}) {
-		if($files{$file}{'Loaded'}) {
-			return $files{$file};
-		}
-	} else {
-		$files{$file}={
-			'Loaded'	=> 0,
-			'Location'	=> $filename,
-			};
-	}
-
-
-	my($ext)=$file=~/.+\.(.+?)$/;
-	$ext = lc($ext);
-	if(grep { $_ eq $ext } (qw/png jpg jpeg bmp/)) {
-		$files{$file}{'Type'} = 'Sprite';
-		my $sprite = SDLx::Sprite->new(
-			image => $files{$file}{'Location'},
-			);
-		if(!$sprite) {
-			LogData(ERROR, "Unable to load sprite '$filename': $!");
-			return undef;
-		}
-		$files{$file}{'Sprite'} = $sprite;
-	} elsif($ext eq 'vs') {
-		unless(open(IN, $filename)) {
-			LogData(ERROR, "Unable to load '$filename': $!");
-			return undef;
-		}
-		my @frames = <IN>;
-		chomp(@frames);
-		close(IN);
-		return LoadVirtualSprite($file, @frames);
-	} elsif($ext eq 'gs') {
-		unless(open(IN, $filename)) {
-			LogData(ERROR, "Unable to load '$filename': $!");
-			return undef;
-		}
-		$files{$file}{'Type'} = 'Script';
-		$files{$file}{'Script'} = join('', <IN>);
-		close(IN);
-	} else {
-		LogData(WARN, "Unable to pre-load asset of type '$ext'");
-		return undef;
-	}
-
-
-	$files{$file}{'Loaded'} = 1;
-	return 1;
-}
-
-sub LoadVirtualSprite {
-	my($name, @files)=@_;
-
-	if(exists $files{$name} && $files{$name}{'Loaded'}) {
-		return $files{$name}{'ASprite'};
-	}
-
-	foreach (@files) {
-		if(!LoadAsset($_)) {
-			LogData(ERROR, "Unable to load virtual sprite, error loading one or more assets.");
-			return undef;
-		}
-		LogData(DEBUG, "Adding asset $_ to virtual sprite $name");
-	}
-
-	my @frames = map { $files{$_}{'Sprite'}->surface() } (@files);
-	my $h = $frames[0]->height();
-	my $hp = 0;
-	
-	my $newsurface = SDLx::Surface->new(	width	=> $frames[0]->width(),
-						height	=> $h * (@frames-0),
-						format	=> $frames[0]->format(),
-						pitch	=> $frames[0]->pitch(),
-						flags	=> $frames[0]->flags(),
-						);
-	$newsurface->draw_rect( [0, 0, $newsurface->width(), $newsurface->height()], [0, 0, 0, 255]);
-	#SDL::Video::set_alpha( $newsurface, SDL::Video::SDL_SRCALPHA, 0);
-	foreach (@frames) {
-		#SDL::Video::set_alpha( $_, SDL::Video::SDL_SRCALPHA, 255);
-		$_->blit( $newsurface, undef, [0, $hp, $_->width(), $_->height()]);
-		$hp += $h;
-	}
-
-	my $testsprite = SDLx::Sprite->new( surface => $newsurface );
-
-	my $anim = SDLx::Sprite::Animated->new( surface		=> $newsurface,
-						width		=> $newsurface->width(),
-						height		=> $h,
-						step_x		=> $newsurface->width(),
-						step_y		=> $h,
-						);
-	#$anim->surface($newsurface);
-
-	$files{$name}{'Loaded'} = 1;
-	$files{$name}{'Type'} = 'ASprite';
-	$files{$name}{'ASprite'} = $anim;
-	return $anim;
-}
-
-sub ShowImage {
-	my($file, $x, $y)=@_;
-	if(!exists $files{$file} || !$files{$file}{'Loaded'}) {
-		LogData(DEBUG, "Loading image on first use '$file'");
-		if(!LoadAsset($file)) {
-			LogData(WARN, "Failed to load image '$file'");
-			return;
-		}
-	}
-	if($files{$file}{'Type'} ne 'Sprite') {
-		LogData(WARN, "ShowImage called on non-Image asset");
-		return;
-	}
-	LogData(DEBUG, "Drawing $file at $x,$y");
-	$files{$file}{'Sprite'}->draw_xy( $app, $x, $y );
-}
-
 sub RunScript {
-	# Blank Screen
-	$app->draw_rect( [0, 0, $app->width(), $app->height()], [128, 128, 128, 255]);
 
-	my $a=GetAsset('aka.vs');
-	$a->draw_xy($app, 0, 0);
-	$app->update();
 }
 
 1;
diff --git a/main.pl b/main.pl
old mode 100644
new mode 100755
index c55d635..692a34e
--- a/main.pl
+++ b/main.pl
@@ -2,20 +2,22 @@
 use strict;
 use PerlRPG::Game;
 use PerlRPG::Console;
+use PerlRPG::Assets;
+use PerlRPG::Drawing;
 
 my $screen_width = 1024;
 my $screen_height = 768;
+my $asset_directory = 'Resources';
 
 LogData(STATUS, "Starting up");
-PerlRPG::Game::ScanDirectory('.');
-my $app = PerlRPG::Game::InitApp($screen_width, $screen_height);
-{
-	my $a=PerlRPG::Game::GetAsset('aka.vs');
-	$a->start();
-	
-}
-PerlRPG::Game::RunScript('__init__');
-PerlRPG::Game::Run();
+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);
+
+Run();
 
 LogData(STATUS, "Tearing down");