#!/usr/bin/perl

$release = 8;  # release 8

#
# SLAG -- a Z-machine hint system
#
# Written by Brian 'Beej' Hall, 1999
# I hereby grant this source to the public domain.
#
# REQUIRES that the Inform compiler be installed on your system
#
# Run with the "-s" flag to generate code you can bundle into your own
# programs.
#
# To build a complete hint file:
#
#   slag hint.slg hint.inf
#   inform hint.inf
#
# Homepage: http://www.piratehaven.org/~beej/slag/
#

$strip = 0;
$quiet = 0;

while(($arg = shift(@ARGV))) {
	if ($arg eq "-s") {
		$strip = 1;
	} elsif ($arg eq "-q") {
		$quiet = 1;
	} elsif (!defined($infile)) {
		$infile = $arg;
	} elsif (!defined($outfile)) {
		$outfile = $arg;
	} else {
		&usage();
	}
}

if (!defined($infile) || !defined($outfile)) {
	&usage();
}

open(ZHS, "<$infile") || die "slag: $infile: $!\n";
open(OUT, ">$outfile") || die "slag: $outfile: $!\n";

$fixed = 0;  # not fixed mode to start
$state = 0;  # not in anything
$cur_menu_item = 0;
$line = 0;
$have_intro = 0;
$counter = 0;

&write_boiler();

while(<ZHS>) {
	$line++;
	chop();
	tr/\"/~/;

	if (/^\.INTRO/) {
		&intro_head();
		$state = 1;  # INTRO
		$have_intro = 1;
	}
	elsif (/^\.MENU\s+(.*)/) {
		$menu_name = normalize($1);

		if ($state == 2) {  # MENU
			&menu_foot();
		} elsif ($state == 1) { # INTRO
			&intro_foot();
		} elsif ($state == 3) { # HINT
			&hint_foot();
		} elsif ($state == 4) { # TEXT
			&text_foot();
		}

		$state = 2;
		&menu_head($menu_name, lead_strip($1));

		if (!defined($main_link_name)) {
			$main_link_name = $menu_name;
		}

	}
	elsif (/^\.LINK\s+(.*)/) {
		$link_name = normalize($1);

		if ($state != 2) {  # MENU
			errorexit("found LINK outside MENU");
		}

		if ($cur_menu_item == 0) {
			print OUT "\t\ttext";
		}
		print OUT "\n\t\t\t\"", lead_strip($1), "\""; 
		$item[$cur_menu_item] = $link_name;
		$cur_menu_item++;
	}
	elsif (/^\.HINT\s+(.*)/) {
		$link_name = normalize($1);

		if ($state == 1) {  #INTRO
			&intro_foot();
		} elsif ($state == 2) {  #MENU
			&menu_foot();
		} elsif ($state == 3) { # HINT
			&hint_foot();
		} elsif ($state == 4) { # TEXT
			&text_foot();
		}

		$state = 3;
		&hint_head($link_name, lead_strip($1));
	}
	elsif (/^\.CLUE\s+(.*)/) {
		if ($state != 3) {  #HINT
			errorexit("found CLUE outside HINT");
		}
		print OUT "\n\t\t\t\"$1\"";
	}
	elsif (/^\.FIX/) {
		if ($state != 1 && $state != 4) { # !INTRO && !TEXT
			errorexit("found FIX outside INTRO or TEXT");
		}
		$fixed = 1;
		print OUT "\tfont off;\n";
	}
	elsif (/^\.UNFIX/) {
		if ($state != 1 && $state != 4) { # !INTRO && !TEXT
			errorexit("found UNFIX outside INTRO or TEXT");
		}
		$fixed = 0;
		print OUT "\tfont on;\n";
	}
	elsif (/^\.TEXT\s+(.*)/) {
		$text_name = &normalize($1);
		if ($state == 1) {  #INTRO
			&intro_foot();
		} elsif ($state == 2) {  #MENU
			&menu_foot();
		} elsif ($state == 3) { # HINT
			&hint_foot();
		} elsif ($state == 4) { # TEXT
			&text_foot();
		}

		$state = 4;
		&text_head($text_name, lead_strip($1));

	} elsif (/^\.CENTER\s+(.*)/) {
		if ($state != 1 && $state != 4) {
			errorexit("CENTER must be in TEXT or INTRO");
		}
		print OUT "\tSLAG_Center(\"$1\", ", length($1), ");\n";
	} elsif (/^\.ENDTEXT/) {
		if ($state != 4) {
			errorexit("found ENDTEXT outside TEXT");
		}
		&text_foot();
		$state = 0;
	} elsif (/^\.ENDINTRO/) {
		if ($state != 1) {
			errorexit("found ENDINTRO outside INTRO");
		}
		&intro_foot();
		$state = 0;
	} elsif (/^\.END/) {
		last;
	} else {
		if ($state == 4 || $state == 1) {  # TEXT or INTRO
			if ($fixed == 0) {
				if (/^$/) { 
					print OUT "\tprint \"^^\";\n";
				} else {
					print OUT "\tprint \"$_";
					if (substr($_, -1) ne "^") { print OUT " "; }
					print OUT "\";\n";
				}
			} else {
				print OUT "\tprint \"$_^\";\n";
			}
		}
	}
}

if ($state == 1) {  #INTRO
	&intro_foot();
} elsif ($state == 2) {  #MENU
	&menu_foot();
} elsif ($state == 3) { # HINT
	&hint_foot();
} elsif ($state == 4) { # TEXT
	&text_foot();
}

if ($strip == 0) {
	print OUT "[ Main;\n";
	if ($have_intro == 1) {
		print OUT "\tSLAG_Intro();\n";
	}
	print OUT "\tSLAG_RunMenu($main_link_name, 0);\n";
	print OUT "\t\@erase_window \$ffff;\n";
	print OUT "];\n";
} else {
	print OUT "[ SLAG_RunMenus;\n";
	if ($have_intro == 1) {
		print OUT "\tSLAG_Intro();\n";
	}
	print OUT "\tSLAG_RunMenu($main_link_name, 0);\n";
	print OUT "\t\@set_window 0;\n";
	print OUT "\t\@erase_window \$ffff;\n";
    print OUT "\tprint \"^\";\n";
    print OUT "\t<<Look>>;\n";
	print OUT "];\n";
	if ($quiet != 1) {
		print "Code the following line in your source to call the menus:\n\n";
		print "    SLAG_RunMenus();\n\n";
	}
}

exit(0);

###############
# END OF MAIN #
###############


#
# intro
#
sub intro_head
{
	print OUT <<_EOF_;
[ SLAG_Intro pkey;
	\@erase_window \$ffff;
_EOF_
}

sub intro_foot
{
	print OUT <<_EOF_;
	print "^[press any key]";
	\@read_char 1 -> pkey;
];

_EOF_
}

#
# menu
#
sub menu_head {
	local($normal_name, $title) = @_;
	print OUT "SLAG_Menu $normal_name\n\twith\n";
	print OUT "\t\ttitle \"$title\",\n";
}

sub menu_foot {
	local($i);

	print OUT ",\n";
	print OUT "\t\titem";
	for($i = 0; $i < $cur_menu_item; $i++) {
		print OUT "\n\t\t\t$item[$i]";
	}
	print OUT ";\n\n";
	$cur_menu_item = 0;
}

#
# hint
#

sub hint_head {
	local($normal_name, $title) = @_;
	print OUT "SLAG_Hint $normal_name\n\twith\n";
	print OUT "\t\ttitle \"$title\",\n";
	print OUT "\t\ttext";
}

sub hint_foot {
	print OUT ";\n\n";
}

#
# text
#
sub text_head {
	local($normal_name, $title) = @_;
	print OUT "SLAG_Other $normal_name\n\twith\n";
	print OUT "\t\ttitle \"$title\",\n";
	print OUT "\t\trun\n\t\t[;\n";
}

sub text_foot {
	print OUT "\t\t];\n\n";
}

#
# write_boiler
#
# writes out boilerplate code needed for everything.
#
sub write_boiler
{

print OUT "Switches d2;\n\n" if $strip == 0;

	print OUT<<_EOF_;
!
! Inform source generated by SLAG release $release
!
! http://www.piratehaven.org/~beej/slag/
!

Class SLAG_Menu
	with title, text, item;

Class SLAG_Hint
	with title, text;

Class SLAG_Other
	with title, run;

SLAG_Menu Dummy_Menu;
SLAG_Hint Dummy_Hint;
SLAG_Other Dummy_Other;

[ SLAG_DrawHeader title showmenu j;
	\@erase_window \$ffff;
	\@split_window 1;
	\@set_window 1;
	\@set_cursor 1 1;
	style reverse;
	j = 0->33;
	if (j == 0) j = 80;
	spaces(j);
	\@set_cursor 1 2;
	print (string)title;
	if (showmenu > 0) {
		j = j - 31;
		\@set_cursor 1 j;
		print "N=Next P=Prev ENTER=Read Q=";
		if (showmenu == 1)
			print "Quit";
		else
			print "Back";
	}
	style roman;
];

[ SLAG_RunMenu _m nest   i j count cur key target redraw_needed;

	redraw_needed = 1;

	cur = 0;
	count = _m.#text / 2;

	for(::) {
		if (redraw_needed) {
			SLAG_DrawHeader(_m.title, nest+1);
			redraw_needed = 0;
		}

		for(i = 0: i < count: i++) {
			j = i + 3;
			\@set_cursor j 5;
			print (string)_m.&text-->i;
		}
		j = cur + 3;
		\@set_cursor j 2;
		print ">";
		\@set_cursor j 2;
		\@read_char 1 -> key;
		print " ";
		switch(key) {
			'k', 'p', '-', '_', 'e', 129:
				cur--;
				if (cur < 0) cur = count-1;
				break;
			'j', 'n', '=', '+', 'x', 130:
				cur++;
				if (cur >= count) cur = 0;
				break;
			'q', 'Q', 's', 27, 131, 10, 8:
				return;

			132, 13, 'd', ' ':
				target = _m.&item-->cur;
				if (target ofclass SLAG_Menu)
					SLAG_RunMenu(target, nest+1);
				else if (target ofclass SLAG_Hint)
					SLAG_RunHint(target);
				else
					SLAG_RunOther(target);

				redraw_needed = 1;
				break;
		}
	}
];

[ SLAG_RunHint _h   count cur key done;

	count = _h.#text / 2;
	cur = 0;
	done = 0;

	SLAG_DrawHeader(_h.title, 0);

	\@set_window 0;
	print "^[press 'H' for a hint (", count, " total)";
	print ", or 'Q' to stop]^^";

	do {
		\@read_char 1 -> key;
		switch(key) {
			'h', 'H':
				cur++;
				print "(", cur, "/", count, ") ",
					(string)_h.&text-->(cur-1), "^^";
				break;
			'q', 'Q', 27, 131, 10, 8:
				return;
		}

	} until(cur >= count);

	print "[press any key to continue]";
	\@read_char 1 -> key;
];

[ SLAG_RunOther _o key;
	SLAG_Center(0);  ! dummy call to Center() to shut up the compiler warnings

	SLAG_DrawHeader(_o.title, 0);

	\@set_window 0;

	print "^";

	_o.run();

	print "^[press any key to continue]";
	\@read_char 1 -> key;
];

[ SLAG_Center s    len wid off;
	if (s == 0) return;
	wid = 0->33;
	if (wid == 0) wid = 80;
	off = (wid - len) / 2;
	spaces(off);
	print (string)s, "^";
];

_EOF_
}



#
# normalizes a name
#
sub normalize
{
	local($name) = @_;
	local($normal);

	$name =~ s/\s+//g;
	$name =~ tr/A-Z/a-z/;
	$name =~ tr/a-zA-Z0-9_//cd;
	
	if (defined($normal_lookup{$name})) {
		return $normal_lookup{$name};
	}

	$normal = "SLAG_link_$counter";
	$counter++;

	$normal_lookup{$name} = $normal;

	return $normal;
}

#
# errorexit
#
sub errorexit
{
	local($str) = @_;

	print STDERR "slag: $infile line $line: $str\n";
	exit(1);
}

#
# usage
# 
sub usage {
	print STDERR "usage: slag [-s] [-q] infile.slg outfile.inf\n";
	print STDERR "       -s Strip code (if you want to use menus in Inform)\n";
	print STDERR "       -q Quiet (don't write to standard output, ever)\n";
	exit(1);
}

#
# lead_strip
#
sub lead_strip
{
	local($str) = @_;

	$str =~ s/^[0-9]+:(.*)/$1/;

	return $str;
}