package PerlRPG::Script;
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 PerlRPG::Drawing;

use vars qw/@ISA @EXPORT @EXPORT_OK/;
@ISA = qw/Exporter/;
@EXPORT = qw/CompileScripts RunScript RunScriptTick GetGameVar SetGameVar DefGameVar EvalString/;
@EXPORT_OK = @EXPORT;

my %labels;
my $current_file;
my $current_line;

my %script_commands = (
	'Wait'			=> {'sub' => sub {},					'wait'	=> 1},
	'AddSayer'		=> {'sub' => \&AddSayer,				'wait'	=> 0},
	'Define'		=> {'sub' => \&DefGameVar,				'wait'	=> 0},
	'ExitGame'		=> {'sub' => \&PerlRPG::Game::ExitGame,			'wait'	=> 1},
	
	'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},

	'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},
);

my %sayers = ();
my $lastsayer=undef;

my %game_vars = ();

sub GetGameVar {
	my $key = shift(@_);
	if(exists $game_vars{$key}) {
		return $game_vars{$key};
	}
	LogData(WARN, "GetGameVar($key): Unknown variable");
	return undef;
}

sub IsString {
	return 1 if($_[0]=~/^\s*".+"\s*$/);
}

sub SetGameVar {
	my($key, $val)=@_;
	if(exists $game_vars{$key}) {
		return $game_vars{$key} = StringSubst($val);
	}
	LogData(WARN, "SetGameVar($key): Unknown variable");
	return undef;
}

# It is legal to Define a game variable twice, value will not be reset
sub DefGameVar {
	my($key, $val)=@_;
	if(!exists $game_vars{$key}) {
		$game_vars{$key} = StringSubst($val);
	}
}
		
# Load script files, locate labels
sub CompileScripts {
	my @scripts = sort { $a cmp $b } LoadAssets('gs');
	%labels = ();
	
	foreach my $name (@scripts) {
		my $ref = GetAsset($name);
		for(my $line = 0; $line < @$ref-0; $line++) {
			my($lbl)=$ref->[$line]=~/^\s*(\S+):\s*$/;
			if($lbl) {
				$labels{$lbl} = {
					'File'	=> $name,
					'Line'	=> $line,
					};
				LogData(DEBUG, "Found script label '$lbl' at $name:$line");
			}
		}
	}
}

# Setup script to run
sub RunScript {
	my($label)=@_;

	if(exists $labels{$label}) {
		$current_file = $labels{$label}{'File'};
		$current_line = $labels{$label}{'Line'};
		LogData(DEBUG, "RunScript($label) moving to $current_file:$current_line");
	} else {
		LogData(ERROR, "RunScript($label) unknown label");
	}
}

# 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++;
		if($line >= @$script) {
			LogData(ERROR, "Script file ended");
			SetOption('Running', 0);
			return;
		}
		if(RunScriptLine($file, $line, $script->[$line])) {
			return;
		}
	}
};

# Returns true if a wait condition is seen
sub RunScriptLine {
	my($file, $linenum, $line)=@_;

	# Copy to refer to
	my $oline = $line;

	# Remove comments	
	$line=~s/#.+$//; # Remove comments
	$line=~s/^\s+//; # Remove leading whitespace
	$line=~s/\s+$//; # Remove trailing whitespace

	if($line=~/^\s*\S+:\s*$/ || $line=~/^\s+$/ || !$line) {
		# Label or blank, skip
		return 0;
	}

	my($cmd, @opts)=split(/\s+/, $line);
	LogData(DEBUG, "$file:$linenum $cmd(" . join(',',@opts) . ")");
	if(exists $script_commands{$cmd}) {
		$script_commands{$cmd}{'sub'}->(@opts);
		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;
		}
	} elsif(my($key,$val)=$line=~/^\s*(\S+)\s*=\s*(.+?)\s*$/) {
		LogData(DEBUG, "Setting '%s' to '%s'", $key, $val);
		return SetGameVar($key, $val);
	}

	LogData(ERROR, "Unknown command '$cmd' in script at $file:$linenum");
	return undef;
}

sub AddSayer {
	my($name, $displayname, $sprite, @textcolor)=@_;
	if(@textcolor < 4) {
		$textcolor[3] = 255;
	}

	$sayers{$name} = {
		'Name'		=> $name,
		'DisplayName'	=> StringSubst($displayname),
		'Sprite'	=> $sprite,
		'TextColor'	=> \@textcolor
	};
}

sub EvalString {
	my $val = shift(@_);
	# Perform math calculations and the like

	# Check for simple numbers
	if(my($v) = $val=~/^\s*(\d+)\s*$/) {
		return $v;
	}
	
	#LogData(DEBUG, "Doing complex Eval");
	# Ensure spacing around tokens
	while(my($full,$f,$o,$s)=$val=~/((\S)([+-\/\*\(\)\.])(\S))/) {
		#LogData(DEBUG, "Replacing '$full' with '$f $o $s'");
		$val=~s/\Q$full\E/$f $o $s/;
	}
	while(my($full,$f,$o)=$val=~/((\S)([+-\/\*\(\)\.]))\s/) {
		#LogData(DEBUG, "Replacing '$full' with '$f $o'");
		$val=~s/\Q$full\E/$f $o/;
	}
	while(my($full,$o,$s)=$val=~/\s(([+-\/\*\(\)\.])(\S))/) {
		#LogData(DEBUG, "Replacing '$full' with '$o $s'");
		$val=~s/\Q$full\E/$o $s/;
	}
	if($val=~/^[+-\/\*\(\)\.]\S/) {
		substr($val, 1, 0)=' ';
		#LogData(DEBUG, "Inserting space after initial character");
	}
	if($val=~/\S[+-\/\*\(\)\.]$/) {
		substr($val, -1, 0)=' ';
		#LogData(DEBUG, "Inserting space before last character");
	}

	LogData(DEBUG, "Val is '$val'");

	# Tokenize
	my @tokens = split(/\s+/,$val);


	for(my $i=0;$i<@tokens-0;$i++) { LogData(DEBUG, "Pass 1 Token [%i], '%s'", $i, $tokens[$i]); }

	for(my $i=0;$i<@tokens-0;$i++) {
		my $t = $tokens[$i];
		if($i < @tokens-1 && $tokens[$i+1] eq '(') {
			# This is a function call; Don't replace it
		} elsif(exists $game_vars{$t}) {
			# Token matches a game var, replace it
			$tokens[$i] = GetGameVar($t);
		} elsif(IsString($tokens[$i])) {
			# Looks like a string, Call StringSubst on it
			$tokens[$i] = '"' . StringSubst($tokens[$i]) . '"';
		}
	}

	for(my $i=0;$i<@tokens-0;$i++) { LogData(DEBUG, "Pass 2 Token [%i], '%s'", $i, $tokens[$i]); }

	my $eval_str = '$eval_res = ' . join(' ', @tokens) . ';';
	LogData(DEBUG, "About to eval '$eval_str'");
	my $eval_res;
	eval $eval_str;
	if($@) {
		LogData(ERROR, "Error in eval: $@");
		return 0;
	}
	LogData(DEBUG, "Got result of '$eval_res'");
	return $eval_res;
}

sub StringSubst {
	my $text=shift(@_);

	if(!IsString($text)) {
		return EvalString($text);
	}
	($text)=$text=~/^\s*"(.+)"\s*$/;

	while(my($f,$n)=$text=~/(\[(\S+)\])/) {
		my $v=GetGameVar($n);
		if(!defined $v) {
			$v = '!!INVALID!!';
		}
		$text=~s/\Q$f\E/$v/g;
	}

	$text=~s/\\n/\n/g;
	return $text;
}

sub SayLine {
	my($ref, $text)=@_;
	LogData(DEVALL, "%s saying \"%s\"", $ref->{'DisplayName'}, $text);

	$text = StringSubst($text);
	DrawSpeech($ref, $text);
	$lastsayer = $ref;
	return 1;
}

sub SkipText {
	$lastsayer = undef;
	HideSprite('_SayerText');
	HideSprite('_SayerSprite');
}


1;