#!/usr/bin/perl
#
# Seven Kingdoms: Ancient Adversaries
#
# Copyright 1997,1998 Enlight Software Ltd.
# Copyright 2017 Jesse Allen
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#
#

use warnings;
use strict;

use FindBin;
use lib $FindBin::Bin;

use File::Spec;

use dbf;

if (!@ARGV) {
	print "Usage: $0 datadir\n";
	exit 0;
}
my ($datadir) = @ARGV;

if (!defined($ENV{DERESX})) {
	$ENV{DERESX} = File::Spec->catfile($FindBin::Bin, "deresx");
}

system($ENV{DERESX}, respath("STD.SET"), stdpath(), ".dbf");
if (! -d stdpath()) {
	warn "Error: Expecting STD.SET unpacked in ", stdpath(), "\n";
}

system($ENV{DERESX}, respath("TUT_INTR.RES"), tut_intr_path(), ".TXT");
if (! -d tut_intr_path()) {
	warn "Error: Expecting TUT_INTR.RES unpacked in ", tut_intr_path(), "\n";
}

system($ENV{DERESX}, respath("TUT_TEXT.RES"), tut_text_path(), ".TXT");
if (! -d tut_text_path()) {
	warn "Error: Expecting TUT_TEXT.RES unpacked in ", tut_text_path(), "\n";
}

my @dbf_list = (
[
	respath('TUT_LIST.RES'),
	['DES', ''], # Tutorial|Title
],[
	stdpath('00003-RAW.dbf'),
	['NAME', ''], # Raw|Name
],[
	stdpath('00005-UNIT.dbf'),
	['NAME', ''], # Unit|Name
],[
	stdpath('00006-RACE.dbf'),
	['NAME', ''], # Race|Name
	['ADJECTIVE', ''], # Race|Adjective
],[
	stdpath('00007-FIRM.dbf'),
	['NAME', ''], # Firm|Name
	['SHORTNAME', ''], # Firm|Shortname
	['OVERTITLE', ''], # Unit|Occupation
	['WORKTITLE', ''], # Unit|Occupation
#],[
# This is not used in the game anywhere. Probaby an early unit file.
#	stdpath('00019-UNIT2.dbf'),
#	['NAME', 'Unit|Name'],
#],[
# This just duplicates monster names, so skip this.
#	stdpath('00027-MONSTER.dbf'),
#	['NAME', 'Unit|Name'],
]);

print "# POT extraction from 7KAA data files\n";
foreach (@dbf_list) {
	pot_extract_dbf(@$_);
}

foreach (glob(tut_intr_path("*.TXT"))) {
	tut_text_extract($_, 0);
}

foreach (glob(tut_text_path("*.TXT"))) {
	tut_text_extract($_, 1);
}

foreach (glob(sct1_text_path("*.SCT"))) {
	sct_text_extract($_);
}

foreach (glob(sct2_text_path("*.SCT"))) {
	sct_text_extract($_);
}

help_res_extract(help_res_path());

exit 0;

sub respath {
	return File::Spec->catfile($datadir, 'RESOURCE', @_);
}

sub stdpath {
	return File::Spec->catfile($datadir, 'RESOURCE', 'STD', @_);
}

sub tut_intr_path {
	return File::Spec->catfile($datadir, 'RESOURCE', 'TUT_INTR', @_);
}

sub tut_text_path {
	return File::Spec->catfile($datadir, 'RESOURCE', 'TUT_TEXT', @_);
}

sub sct1_text_path {
	return File::Spec->catfile($datadir, 'SCENARIO', @_);
}

sub sct2_text_path {
	return File::Spec->catfile($datadir, 'SCENARI2', @_);
}

sub help_res_path {
	return File::Spec->catfile($datadir, 'RESOURCE', 'HELP.RES');
}

# implements FileTxt::read_line()
sub read_line {
	my $fh;

	($fh) = @_;

	# force scalar context to read one line
	return dbf::trim(scalar(<$fh>));
}

sub read_paragraph {
}

sub get_msgid {
	my $file;
	my $msgctxt;
	my $msgid;
	my $loc;

	($file, $msgctxt, $msgid, $loc) = @_;

	if (defined($msgctxt) && $msgctxt ne "") {
		$msgctxt = "msgctxt \"$msgctxt\"\n";
	} else {
		$msgctxt = "";
	}
	if (defined($loc)) {
		$loc = ":$loc";
	} else {
		$loc = "";
	}
	$msgid =~ s/\r\n/ /g; # get_paragraph converts to space
	#$msgid =~ s/\n/'\\n'/g;
	$msgid =~ s/"/\\"/g;

	if ($msgid =~ /[\x00-\x1F\x7F-\x9F]/) {
		print "\n# Next entry has characters that doesn't conform to ISO 8859-1\n";
	}

	return <<EOF;

# $file$loc
${msgctxt}msgid "$msgid"
msgstr ""
EOF
}

sub pot_extract_dbf {
	my $dbf_file;
	my $dbf;
	my @fields;
	my $records;
	my %msgids;
	my @ids;

	$dbf_file = shift(@_);
	$dbf = dbf->read_file($dbf_file);
	if (!defined($dbf)) {
		warn "Error: Can't read $dbf_file\n";
		return;
	}
	$records = $dbf->get_records();
	for (my $i = 0; $i < @_; $i++) {
		my $field;
		$field = $dbf->get_field($_[$i]->[0]);
		if (!defined($field)) {
			warn "Error: Can't read $dbf_file for $_[$i]->[0]\n";
			return;
		}
		for (my $j = 0; $j < $records; $j++) {
			my $value;
			$value = $dbf->get_value($j, $field);
			if (!defined($value)) {
				next;
			}
			$value = dbf::rtrim($value);
			if ($value eq '') {
				next;
			}
			$msgids{$value} = get_msgid($dbf_file, $_[$i]->[1], $value);
		}
	}
	@ids = sort(keys(%msgids));
	for (my $i = 0; $i < @ids; $i++) {
		print $msgids{$ids[$i]};
	}
}

# Extract tut_text and tut_intr files.
# tut_text files have the first two lines as a file description.
# After, it follows the method used in FileTxt::read_paragraph()
sub tut_text_extract {
	my $file;
	my $is_tut_text;
	my $fh;
	my $msgid;
	my $line_no;
	my $loc;

	($file, $is_tut_text) = @_;

	if (!open($fh, $file)) {
		warn "Error: Can't read $file\n";
		return;
	}
	$line_no = 0;
	if ($is_tut_text) {
		# skip first two lines
		my $line = <$fh>;
		$line = <$fh>;
		$line_no += 2;
	}
	$msgid = "";
	$loc = $line_no+1;
	while (my $line = <$fh>) {
		$line_no++;
		if ($line =~ /^Button:/) {
			next;
		}
		if ($line =~ /^~/) { # End of paragraph
			print get_msgid($file, "", $msgid, $loc);
			$msgid = "";
			$loc = $line_no+1;
			next;
		}
		if ($line =~ s/([^\x1A]*)\x1A//) { # End of file
			$msgid .= $1;
			last;
		}
		$msgid .= $line;
	}
	close($fh);

	if ($msgid !~ /^\s*$/) {
		print get_msgid($file, "", $msgid, $loc);
	}
}

# First line is a title
# Next three lines skip
# Follows the method used in FileTxt::read_paragraph()
sub sct_text_extract {
	my $file;
	my $fh;
	my $msgid;
	my $line_no;
	my $loc;

	($file) = @_;

	if (!open($fh, $file)) {
		warn "Error: Can't read $file\n";
		return;
	}

	# Get title
	$line_no = 0;
	$msgid = read_line($fh);
	$line_no++;
	print get_msgid($file, "", $msgid, $line_no);

	# Skip formatting three lines
	for (my $i = 0; $i < 3; $i++) {
		my $line = <$fh>;
		$line_no++;
	}

	$msgid = "";
	$loc = $line_no+1;
	while (my $line = <$fh>) {
		$line_no++;
		if ($line =~ /^Button:/) {
			next;
		}
		if ($line =~ /^~/) { # End of paragraph
			print get_msgid($file, "", $msgid, $loc);
			$msgid = "";
			$loc = $line_no+1;
			next;
		}
		if ($line =~ s/([^\x1A]*)\x1A//) { # End of file
			$msgid .= $1;
			last;
		}
		$msgid .= $line;
	}
	close($fh);

	if ($msgid !~ /^\s*$/) {
		print get_msgid($file, "", $msgid, $loc);
	}
}

# First line is a help code or position
# Second line is a short help title
# Follows the method used in FileTxt::read_paragraph()
sub help_res_extract {
	my $file;
	my $fh;
	my $msgid;
	my $line_no;
	my $loc;
	my $at_eof;

	($file) = @_;

	if (!open($fh, $file)) {
		warn "Error: Can't read $file\n";
		return;
	}

	# Get code (skip)
	$line_no = 0;
	$at_eof = 0;

	while (!$at_eof) {
		$msgid = <$fh>;
		if (!defined($msgid)) {
			last;
		}
		$line_no++;

		# Get help title
		$msgid = read_line($fh);
		$line_no++;
		print get_msgid($file, "", $msgid, $line_no);

		$msgid = "";
		$loc = $line_no+1;
		while (my $line = <$fh>) {
			$line_no++;
			if ($line =~ /^Button:/) {
				next;
			}
			if ($line =~ /^~/) { # End of paragraph
				last;
			}
			if ($line =~ s/([^\x1A]*)\x1A//) { # End of file
				$msgid .= $1;
				$at_eof = 1;
				last;
			}
			$msgid .= $line;
		}
		if ($msgid eq "") {
			next;
		}
		print get_msgid($file, "", $msgid, $loc);
		$loc = $line_no+1;
	}
	close($fh);
}
