#!/usr/bin/env perl
#
# This is Menu user interface script -> C struct compiler.
#
# Compiler is designed to parse structured menu definition files. Compiler
# lacks advanced error and syntax checking and such, but it works.
#
# Copyright (c) 2016-2024, Jani Salonen <salojan@goto10.co>
# All rights reserved.
#

use 5.10.0;

use utf8;
use warnings;

# This is version tag for output file and must match with the engine's PACKAGE_VERSION
#
my $DSL_COMPILER_VER = "0.2.9";

#
my $on_cnt = 0;
my $on_bar = "";
my $on_wnd = "";

my %BARPOS_ID = ();
my @BARPOS_ID = ();
my @WINDOW_ID = ();
my %WINDOW_ST = ();

my @UNVEIL_ST = ();

#
my @file_inc = ();

binmode(STDOUT, ":utf8");

&menu_def({ file => $ARGV[0] });
&menu_out({ this => $0, file => $ARGV[0] });

exit(0);



#
sub menu_cmd_window {
	my ($arg) = @_;

	my ($p) = $arg->{line} =~ /"(.*?)"/;

	if($p == 0) {
		&msg_fail({ mess => "Invalid window identified, it cannot be zero" });

		return;
	}

	if($p !~ /^\d+$/) {
		&msg_fail({ mess => "Invalid window identifier '" . $p .
			"', positive integer was expected" });

		return;
	}

	if($WINDOW_ST{$p}) {
		&msg_fail({ mess => "Window definition '" . $p .
			"' already exists" });

		return;
	}

	push @{ $BARPOS_ID{$on_bar} }, $arg->{deep} . "\t" .
		"END" if($on_bar ne "");

	$on_bar = "";
	$on_wnd = $p;

	push @WINDOW_ID, $on_wnd;
}

sub menu_cmd_widget {
	my ($arg) = @_;

	my ($p) = $arg->{line} =~ /"(.*?)"/;

	if($p !~ /^\w+$/) {
		&msg_fail({ mess => "Invalid widget identifier '" . $p .
			"', character string was expected" });

		return;
	}

	if($on_wnd == 0) {
		&msg_fail({ mess => "Widget definition '" . $p .
			"' must be placed in window block with nonzero id" });

		return;
	}

	push @{ $BARPOS_ID{$on_bar} }, $arg->{deep} . "\t" .
		"END" if($on_bar ne "");

	$on_bar = "";
	$on_wnd = $p;

	push @WINDOW_ID, $on_wnd;
}

sub menu_cmd_menu {
	my ($arg) = @_;

	my ($p) = $arg->{line} =~ /"(.*?)"/;
	my (@p) = split(/\s?{\s?/, $arg->{line});

	my @r = &menu_cmd_op_one_with_quote({ line => \@p });

	$p =~ s/\t/ /go;

	push @{ $BARPOS_ID{$on_bar} }, $arg->{deep} . "\t" .
		"STOP" . "\t" . $p;

	$on_bar = ($arg->{deep} + 1) . "\t" . $p . "\t" . $r[0] . "\t" . ++$on_cnt;

	push @{ $WINDOW_ST{$on_wnd} }, $on_bar;
}

#
sub menu_cmd_item {
	my ($arg) = @_;

	my ($p) = $arg->{line} =~ /"(.*)"/;

	# Split the line by comma, but not by commas inside parentheses
	#
	my (@p) = split(/\s?,\s?(?=(?:[^\"]*\"[^\"]*\")*[^\"]*$)/, $arg->{line});

	my @r = &menu_cmd_op_four_with_quote({ line => \@p });

	push @{ $BARPOS_ID{$on_bar} }, $arg->{deep} . "\t" .
		"ITEM" . "\t" . $p . "\t" . join("\t", @r);
}

sub menu_cmd_check {
	my ($arg) = @_;

	my ($p) = $arg->{line} =~ /"(.*)"/;

	# Split the line by comma, but not by commas inside parentheses
	#
	my (@p) = split(/\s?,\s?(?=(?:[^\"]*\"[^\"]*\")*[^\"]*$)/, $arg->{line});

	my @r = &menu_cmd_op_four_with_quote({ line => \@p });

	push @{ $BARPOS_ID{$on_bar} }, $arg->{deep} . "\t" .
		"CHECK" . "\t" . $p . "\t" . join("\t", @r);
}

sub menu_cmd_radio {
	my ($arg) = @_;

	my ($p) = $arg->{line} =~ /"(.*?)"/;

	# Split the line by comma, but not by commas inside parentheses
	#
	my (@p) = split(/\s?,\s?(?=(?:[^\"]*\"[^\"]*\")*[^\"]*$)/, $arg->{line});

	my @r = &menu_cmd_op_four_with_quote({ line => \@p });

	push @{ $BARPOS_ID{$on_bar} }, $arg->{deep} . "\t" .
		"RADIO" . "\t" . $p . "\t" . join("\t", @r);
}

sub menu_cmd_title {
	my ($arg) = @_;

	my ($p) = $arg->{line} =~ /"(.*)"/;

	$p =~ s/\t/ /go;

	push @{ $BARPOS_ID{$on_bar} }, $arg->{deep} . "\t" .
		"TITLE" . "\t" . $p;
}

sub menu_cmd_delim {
	my ($arg) = @_;

	push @{ $BARPOS_ID{$on_bar} }, $arg->{deep} . "\t" .
		"DELIM";
}

sub menu_cmd_space {
	my ($arg) = @_;

	push @{ $BARPOS_ID{$on_bar} }, $arg->{deep} . "\t" .
		"SPACE";
}

#
sub menu_cmd_op_one_with_quote {
	my ($arg) = @_;

	my @p = @{ $arg->{line} };

	shift @p;

	return &menu_cmd_op_op({ line => \@p, loop => 1 });
}

sub menu_cmd_op_four_with_quote {
	my ($arg) = @_;

	my @p = @{ $arg->{line} };

	shift @p;

	return &menu_cmd_op_op({ line => \@p, loop => 4 });
}

sub menu_cmd_op_op {
	my ($arg) = @_;

	my @p = @{ $arg->{line} };
	my @r = ();

	for(my $i = 0; $i < $arg->{loop}; $i++) {
		if(!$p[$i] || ($p[$i] && ($p[$i] eq "" || $p[$i] eq "-"))) {
			push @r, "NONE";
		}
		else {
			push @r, $p[$i];
		}
	}

	return @r;
}

sub menu_cmd {
	my ($arg) = @_;

	my @f = @{ $arg->{file} };
	my $n = 0;

	foreach my $f (@f) {
		if($f =~ /^\w+\s"(.*)"\s?[,{]/ || $f =~ /^\w+\s"(.*)"$/) {
			# This is either window, widget, menu, title or one of the menu items
			#
			my ($c, $p) = split(/\s/, $f, 2);

			&menu_cmd_op({ cmds => $c, line => $p, deep => $n });
		}
		elsif($f =~ /^\w+$/) {
			# This is either delim or space
			#
			&menu_cmd_op({ cmds => $f, line => "", deep => $n });
		}

		$n += $f =~ tr/{$//;
		$n -= $f =~ tr/}$//;
	}
}

sub menu_cmd_op {
	my ($arg) = @_;

	my $s = "menu_cmd_" . lc($arg->{cmds});

	if(defined &$s) {
		&$s({ line => $arg->{line}, deep => $arg->{deep} });
	}
	else {
		&msg_fail({ mess => "Unknown identifier '" .
			$arg->{cmds} . "'" });

		return;
	}
}

sub menu_pre {
	my ($arg) = @_;

	my @f = @{ $arg->{file} };
	my @r = ();

	my $o = "";

	foreach my $f (@f) {
		$f =~ s/\r+|\n+//g;
		$f =~ s/^\s+//;
		$f =~ s/\s+$//;
		$f =~ s/\s\s+/ /g;

		next if($f eq "" || $f =~ /^;/ || $f =~ /^#/);

		# Check if this is multiline...
		#
		if($f =~ /\\$/) {
			$f =~ s/\\$//;
			$o .= $f;

			next;
		}
		else {
			$o .= $f;
		}

		# ...or preprocessor command
		#
		if($o =~ /^include\s"(.*)"/i) {
			my ($p) = $o =~ /"(.*)"/;

			push @r, &menu_get({ file => $p });
		}
		else {
			push @r, $o;
		}

		$o = "";
	}

	return @r;
}

sub menu_get {
	my ($arg) = @_;

	my @f = ();
	my @r = ();
	my %m = ();

	if(!$arg->{file}) {
		&msg_fail({ mess => "Please provide source file to process" });

		return @r;
	}

	if(!stat($arg->{file})) {
		&msg_fail({ mess => "Failed to open source file '" .
			$arg->{file} . "'" });

		return @r;
	}

	# Try to detect include loop first...
	#
	push @file_inc, $arg->{file};

	for(my $i = 0; $i < @file_inc; $i++) {
		if(defined($file_inc[$i + 1]) && $m{$file_inc[$i + 1]}) {
			&msg_fail({ mess => "Include loop detected, '" .
				$file_inc[$i] . "' to include '" . $arg->{file} . "'" });

			return;
		}

		$m{$file_inc[$i]} = 1;
	}

	# ...then open and process the file
	#
	if(open(FILE, '<:encoding(UTF-8)', $arg->{file})) {
		@f = <FILE>;

		close(FILE);
	}
	else {
		&msg_fail({ mess => "Failed to open file '" .
			$arg->{file} . "'" });

		return;
	}

	@r = &menu_pre({ file => \@f });

	return @r;
}

sub menu_def {
	my ($arg) = @_;

	#
	if(!$arg->{file} || ($arg->{file} && !stat($arg->{file}))) {
		&menu_out_min();
	}

	my @r = &menu_get({ file => $arg->{file} });

	&menu_cmd({ file => \@r });
}

#
sub menu_out {
	my ($arg) = @_;

	&menu_out_bg({ this => $arg->{this}, file => $arg->{file} });

	# Loop through windows and widgets...
	#
	foreach my $c (@WINDOW_ID) {
		my $d = 1;
		my $k = 0;
		my @p = ();

		# ...then loop through menu bars for this window or widget...
		#
		foreach my $x (@{ $WINDOW_ST{$c} }) {
			my $e = 1;
			my $n = 0;
			my @s = ();
			my @e = split(/\t+/, $x);

			# ...and the actual menu items
			#
			for(my $j = 0; $j < @{ $WINDOW_ST{$c} }; $j++) {
				last unless(@{ $WINDOW_ST{$c} }[$j + $k]);

				my $y = @{ $WINDOW_ST{$c} }[$j + $k];

				foreach my $z (@{ $BARPOS_ID{$y} }) {
					my @f = split(/\t+/, $z);

					# Stop here if level decrements and there is stop command next in line...
					#
					if($f[0] < $n && $f[1] eq "STOP") {
						$j = @{ $WINDOW_ST{$c} };

						last;
					}

					$n = $f[0];

					# ...otherwise handle this item only if level of depth matches to parent
					#
					if($e[0] == $f[0]) {
						if($f[1] eq "SPACE") {
							&menu_out_it({
								type => "MENU_ITEM_TYPE_GAP",
								mbar => $c, drop => $d, item => $e, mtag => 0 });
						}
						elsif($f[1] eq "DELIM") {
							&menu_out_it({
								type => "MENU_ITEM_TYPE_SEPARATOR",
								mbar => $c, drop => $d, item => $e, mtag => 0 });
						}
						elsif($f[1] eq "TITLE") {
							&menu_out_it({
								type => "MENU_ITEM_TYPE_TITLE", name => $f[2],
								mbar => $c, drop => $d, item => $e, mtag => 0 });
						}
						elsif($f[1] eq "CHECK") {
							&menu_out_it({
								type => "MENU_ITEM_TYPE_SELECT_TOGGLE", name => $f[2],
								cbfn => "menu_cb_item_select", cbfb => $f[4],
								flag => $f[5], icon => $f[6],
								mbar => $c, drop => $d, item => $e, mtag => $f[3] });
						}
						elsif($f[1] eq "RADIO") {
							&menu_out_it({
								type => "MENU_ITEM_TYPE_SELECT_RADIO", name => $f[2],
								cbfn => "menu_cb_item_select", cbfb => $f[4],
								flag => $f[5], icon => $f[6],
								mbar => $c, drop => $d, item => $e, mtag => $f[3] });
						}
						elsif($f[1] eq "ITEM") {
							&menu_out_it({
								type => "MENU_ITEM_TYPE_SELECT_ONCE", name => $f[2],
								cbfn => "menu_cb_item_select", cbfb => $f[4],
								flag => $f[5], icon => $f[6],
								mbar => $c, drop => $d, item => $e, mtag => $f[3] });
						}
						elsif($f[1] eq "STOP") {
							&menu_out_it({
								type => "MENU_ITEM_TYPE_SUBMENU", name => $f[2],
								icon => $f[3], msub => $d,
								mbar => $c, drop => $d, item => $e, mtag => 0 });
						}

						# Create item to parent container only if it is real, selectable item
						#
						push @s, $e++ if($f[1] ne "END");
					}
				}
			}

			$k++;

			# Checking level is naive way to test if this is submenu,
			# and if so, remove name and icon from it to prevent it to appear on menu bar...
			#
			if($e[0] > 2) {
				# ...but only if this menu not attached to widget
				#
				if($e[0] != 3 && $c =~ /^[0-9]+$/) {
					$e[1] = "NONE";
					$e[2] = "NONE";
				}
				if($e[0] > 3) {
					# ...and if level is more than three, is is submenu for sure
					#
					$e[1] = "NONE";
					$e[2] = "NONE";
				}
			}

			&menu_out_op({ mbar => $c, mids => \@s, drop => $d, name => $e[1], icon => $e[2] });

			push @p, $d++;
		}

		#
		&menu_out_at({ mbar => $c, mids => \@p });
	}

	#
	print STDOUT "/* Root of all menu definitions */" . "\n";
	print STDOUT "static struct menu_stack menu_stack_t[" . (@WINDOW_ID + 1) . "] = {" . "\n";

	foreach my $c (@WINDOW_ID) {
		if($c =~ /^[0-9]+$/) {
			print STDOUT "\t" . "/* Menu attached to window id " . $c . " */" . "\n";
			print STDOUT "\t" . "{ 0, " . $c . ", NULL, 0, &menu_bar_" . $c . " }," . "\n";
		}
		else {
			print STDOUT "\t" . "/* Menu attached to widget id " . $c . " */" . "\n";
			print STDOUT "\t" . "{ 0, 0, (\"" .
				&menu_out_hex_bytes({ str => $c }) . "\"), " .
				&menu_out_len_bytes({ str => $c }) . ", &menu_bar_" . $c . " }," . "\n";
		}
	}

	print STDOUT "\n\t" . "{ 0, 0, NULL, 0, NULL }" . "\n";
	print STDOUT "};\n\n";

	#
	&menu_out_eg({ file => $arg->{file} });
}

sub menu_out_it {
	my ($arg) = @_;

	my $s = 0;
	my %f = ();

	#
	if($arg->{mtag} !~ /^[0-9]+$/) {
		&msg_fail({ mess => "Definition for '" . $arg->{name} .
			"' needs proper id tag, not '" . $arg->{mtag} . "'" });

		return;
	}

	#
	$s = $arg->{msub} if($arg->{msub} && $arg->{msub} =~ /^[0-9]+$/);

	if($arg->{flag} && $arg->{flag} !~ /^NONE$/i) {
		my @f = split(/\|/, $arg->{flag});

		foreach my $f (@f) {
			$f =~ s/^\s+//;
			$f =~ s/\s+$//;

			# Use two-char shortcut here, no need to type the whole word
			#
			$f{lc(substr($f, 0, 2))} = 1;
		}
	}

	#
	print STDOUT "/* Menu item " . $arg->{item} . " for drop down menu " . $arg->{drop} .
		", in menu bar " . $arg->{mbar} . " */" . "\n";

	print STDOUT "static struct menu_item menu_item_" . $arg->{mbar} . "_" . $arg->{drop} .
		"_" . $arg->{item} . " = {" . "\n";

	print STDOUT "\t" . $arg->{type} . "," . "\n";

	#
	if($f{'di'}) {
		print STDOUT "\t" . "IS_YES" . "," . "\n";
	}
	else {
		print STDOUT "\t" . "IS_NO" . "," . "\n";
	}

	if($f{'ch'}) {
		print STDOUT "\t" . "IS_YES" . "," . "\n";
	}
	else {
		print STDOUT "\t" . "IS_NO" . "," . "\n";
	}

	#
	print STDOUT "\t" . "0, " . $arg->{mtag} . ", " . $s . ", 0, 0, 0," . "\n";
	print STDOUT "\t" . "{ 0, 0, 0, 0, 0 }," . "\n";

	#
	if($arg->{name} && $arg->{name} !~ /^NONE$/i) {
		print STDOUT "\t" . "{ (\"" .
			&menu_out_hex_bytes({ str => $arg->{name} }) . "\"), NULL, " .
			&menu_out_len_bytes({ str => $arg->{name} }) . "," . "\n";
	}
	else {
		print STDOUT "\t" . "{ NULL, NULL, 0," . "\n";
	}

	print STDOUT "\t\t" . "{ 0, 0, 0 }," . "\n";
	print STDOUT "\t\t" . "{ 0, 0, 0 }" . "\n";
	print STDOUT "\t" . "}," . "\n";

	#
	if($arg->{icon} && $arg->{icon} !~ /^NONE$/i) {
		# Store icon path to be used later by unveil()
		#
		push @UNVEIL_ST, $arg->{icon};

		print STDOUT "\t" . "{ 0, (\"" .
			&menu_out_hex_bytes({ str => $arg->{icon} }) .
				"\")," . "\n";
	}
	else {
		print STDOUT "\t" . "{ 0, NULL," . "\n";
	}

	print STDOUT "\t\t" . "{ 0, 0, 0, 0, 0 }," . "\n";
	print STDOUT "\t\t" . "NULL" . "\n";
	print STDOUT "\t" . "}," . "\n";
	print STDOUT "\t" . "{" . "\n";

	#
	if($arg->{cbfn} && $arg->{cbfn} !~ /^NONE$/i) {
		print STDOUT "\t\t" . $arg->{cbfn} . "," . "\n";
	}
	else {
		print STDOUT "\t\t" . "NULL," . "\n";
	}

	if($arg->{cbfb} && $arg->{cbfb} !~ /^NONE$/i) {
		print STDOUT "\t\t" . "{ (\"" .
			&menu_out_hex_bytes({ str => $arg->{cbfb} }) .
				"\"), 0, 0, 0, 0, {" . "\n";
	}
	else {
		print STDOUT "\t\t" . "{ NULL, 0, 0, 0, 0, {" . "\n";
	}

	#
	print STDOUT "\t\t\t" . "{ 0, 0, 0.0, NULL, NULL, NULL, 0, 0 }," . "\n";
	print STDOUT "\t\t\t" . "{ 0, 0, 0.0, NULL, NULL, NULL, 0, 0 }," . "\n";
	print STDOUT "\t\t\t" . "{ 0, 0, 0.0, NULL, NULL, NULL, 0, 0 }," . "\n";
	print STDOUT "\t\t\t" . "{ 0, 0, 0.0, NULL, NULL, NULL, 0, 0 }," . "\n";
	print STDOUT "\t\t\t" . "{ 0, 0, 0.0, NULL, NULL, NULL, 0, 0 }," . "\n";

	print STDOUT "\t\t\t" . "{ 0, 0, 0.0, NULL, NULL, NULL, 0, 0 }," . "\n";
	print STDOUT "\t\t\t" . "{ 0, 0, 0.0, NULL, NULL, NULL, 0, 0 }," . "\n";
	print STDOUT "\t\t\t" . "{ 0, 0, 0.0, NULL, NULL, NULL, 0, 0 }," . "\n";
	print STDOUT "\t\t\t" . "{ 0, 0, 0.0, NULL, NULL, NULL, 0, 0 }," . "\n";
	print STDOUT "\t\t\t" . "{ 0, 0, 0.0, NULL, NULL, NULL, 0, 0 }," . "\n";

	print STDOUT "\t\t\t" . "{ 0, 0, 0.0, NULL, NULL, NULL, 0, 0 }," . "\n";
	print STDOUT "\t\t\t" . "{ 0, 0, 0.0, NULL, NULL, NULL, 0, 0 }," . "\n";
	print STDOUT "\t\t\t" . "{ 0, 0, 0.0, NULL, NULL, NULL, 0, 0 }," . "\n";
	print STDOUT "\t\t\t" . "{ 0, 0, 0.0, NULL, NULL, NULL, 0, 0 }," . "\n";
	print STDOUT "\t\t\t" . "{ 0, 0, 0.0, NULL, NULL, NULL, 0, 0 }," . "\n";

	print STDOUT "\t\t\t" . "{ 0, 0, 0.0, NULL, NULL, NULL, 0, 0 } }" . "\n";

	print STDOUT "\t\t" . "}," . "\n";

	print STDOUT "\t\t" . "{ 0, " .
		"0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, " .
		"0, 0, 0, " .
		"0, 0, " .
		"0.0, " .
		"0, 0," . "\n";

	print STDOUT "#if ! defined(PROG_DISABLE_WIDGET)" . "\n";
	print STDOUT "\t\t\t" . "0, 0, NULL," . "\n";
	print STDOUT "#endif" . "\n";
	print STDOUT "\t\t\t" . "0," . "\n";
	print STDOUT "\t\t\t" . "{ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }," . "\n";
	print STDOUT "\t\t\t" . "0, { { 0, 0, 0, 0 } }" . "\n";
	print STDOUT "\t\t" . "}" . "\n";
	print STDOUT "\t" . "}" . "\n";
	print STDOUT "};" . "\n\n";
}

sub menu_out_op {
	my ($arg) = @_;

	my @p = @{ $arg->{mids} };

	#
	print STDOUT "/* Menu items for drop down menu " . $arg->{drop} .
		", in menu bar " . $arg->{mbar} . " */" . "\n";

	print STDOUT "static struct menu_item *menu_item_" . $arg->{mbar} . "_" . $arg->{drop} .
		"_t[" . @p . "] = {" . "\n";

	for(my $i = 0; $i < @p; $i++) {
		print STDOUT "\t" . "&menu_item_" . $arg->{mbar} . "_" . $arg->{drop} .
			"_" . $p[$i];

		print STDOUT "," . "\n" if($i != @p - 1);
	}

	print STDOUT "\n" . "};" . "\n\n";

	#
	print STDOUT "/* Drop down menu " . $arg->{drop} . ", in menu bar " . $arg->{mbar} . " */" . "\n";
	print STDOUT "static struct menu_drop menu_drop_" . $arg->{mbar} . "_" . $arg->{drop} . " = {" . "\n";
	print STDOUT "\t" . "{ 0, 0, 0, 0, 0 }," . "\n";
	print STDOUT "\t" . "0, 0, 0, 0, 0," . "\n";
	print STDOUT "\t" . "{ { { 0, 0, 0, 0 } } }," . "\n";
	print STDOUT "\t" . "{ { { 0, 0, 0, 0 } } }," . "\n";
	print STDOUT "\t" . "{ 0, 0, 0, 0, 0 }," . "\n";

	#
	if($arg->{name} && $arg->{name} !~ /^NONE$/i) {
		print STDOUT "\t" . "{ (\"" .
			&menu_out_hex_bytes({ str => $arg->{name} }) . "\"), NULL, " .
			&menu_out_len_bytes({ str => $arg->{name} }) . "," . "\n";
	}
	else {
		print STDOUT "\t" . "{ NULL, NULL, 0," . "\n";
	}

	print STDOUT "\t\t" . "{ 0, 0, 0 }," . "\n";
	print STDOUT "\t\t" . "{ 0, 0, 0 }" . "\n";
	print STDOUT "\t" . "}," . "\n";

	#
	if($arg->{icon} && $arg->{icon} !~ /^NONE$/i) {
		# Store icon path to be used later by unveil()
		#
		push @UNVEIL_ST, $arg->{icon};

		print STDOUT "\t" . "{ 0, (\"" .
			&menu_out_hex_bytes({ str => $arg->{icon} }) . "\")," . "\n";
	}
	else {
		print STDOUT "\t" . "{ 0, NULL," . "\n";
	}

	print STDOUT "\t\t" . "{ 0, 0, 0, 0, 0 }," . "\n";
	print STDOUT "\t\t" . "NULL" . "\n";
	print STDOUT "\t" . "}," . "\n";
	print STDOUT "\t" . "NULL, NULL, NULL," . "\n";
	print STDOUT "\t" . @p . "," . "\n";
	print STDOUT "\t" . "menu_item_" . $arg->{mbar} . "_" . $arg->{drop} . "_t" . "\n";
	print STDOUT "};" . "\n\n";
}

sub menu_out_at {
	my ($arg) = @_;

	my @p = @{ $arg->{mids} };

	#
	print STDOUT "/* Drop down menues for menu bar " . $arg->{mbar} . " */" . "\n";
	print STDOUT "static struct menu_drop *menu_drop_" . $arg->{mbar} . "_t[" . @p . "] = {" . "\n";

	for(my $i = 0; $i < @p; $i++) {
		print STDOUT "\t" . "&menu_drop_" . $arg->{mbar} . "_" . $p[$i];
		print STDOUT "," . "\n" if($i != @p - 1);
	}

	print STDOUT "\n" . "};" . "\n\n";

	#
	print STDOUT "/* Menu bar " . $arg->{mbar} . " */" . "\n";
	print STDOUT "static struct menu_bar menu_bar_" . $arg->{mbar} . " = {" . "\n";
	print STDOUT "\t" . "{ 0, 0, 0, 0, 0 }," . "\n";
	print STDOUT "\t" . "IS_NO, 0, 0, 0, 0," . "\n";
	print STDOUT "\t" . "{ { { 0, 0, 0, 0 } } }," . "\n";
	print STDOUT "\t" . "{ { { 0, 0, 0, 0 } } }," . "\n";
	print STDOUT "\t" . "NULL," . "\n";
	print STDOUT "\t" . @p . "," . "\n";
	print STDOUT "\t" . "menu_drop_" . $arg->{mbar} . "_t" . "\n";
	print STDOUT "};" . "\n\n";
}

sub menu_out_bg {
	my ($arg) = @_;

	print STDOUT "/**" . "\n";
	print STDOUT " *" . " This file is automatically generated." .
				" To make changes, edit the source file" . "\n";
	print STDOUT " *" . "\n";
	print STDOUT " *" . "  " . $arg->{file} . "\n";
	print STDOUT " *" . "\n";
	print STDOUT " *" . " and regenerate this file by running:" . "\n";
	print STDOUT " *" . "\n";
	print STDOUT " *" . "  \$ " . $arg->{this} . " " . $arg->{file} .
				" > engine/menu_defs.h" . "\n";
	print STDOUT " *" . "\n";
	print STDOUT " */" . "\n\n";
}

sub menu_out_eg {
	my ($arg) = @_;

	print STDOUT "#if defined(HAVE_UNVEIL) && defined(PROG_HAS_UNVEIL)" . "\n";
	print STDOUT "static const struct t_rst t_rst_t[" . (@UNVEIL_ST + 1) . "] = {" . "\n";

	my @s = &menu_out_eg_st(@UNVEIL_ST);

	foreach my $f (sort { lc($a) cmp lc($b) } @s) {
		print STDOUT "\t" . "{ \"" . $f . "\", \"r\" }," . "\n";
	}

	print STDOUT "\n\t" . "{ NULL, NULL }" . "\n";
	print STDOUT "};" . "\n";
	print STDOUT "#endif" . "\n\n";

	#
	my $e = $arg->{file};

	$e =~ s/"/\\"/go;

	print STDOUT "#define DSL_COMPILER_VER \"" . $DSL_COMPILER_VER . "\"" . "\n\n";

	print STDOUT "/* Check the Makefile before changing this in any way */" . "\n";
	print STDOUT "#define DSL_EMBEDDED_M2C \"" . $e . "\"" . "\n\n";

	#
	print STDOUT "/* " . @WINDOW_ID . " top level items processed at " . localtime() . " */" . "\n";
}

sub menu_out_eg_st {
	my %s;

	grep !$s{$_}++, @_;
}

#
sub menu_out_min {
	my ($arg) = @_;

	print STDOUT "static struct menu_stack menu_stack_t[1] = {" . "\n";
	print STDOUT "\t" . "{ 0, 0, NULL, 0, NULL }" . "\n";
	print STDOUT "};" . "\n\n";
	print STDOUT "#if defined(HAVE_UNVEIL) && defined(PROG_HAS_UNVEIL)" . "\n";
	print STDOUT "static const struct t_rst t_rst_t[1] = {" . "\n";
	print STDOUT "\t" . "{ NULL, NULL }" . "\n";
	print STDOUT "};" . "\n";
	print STDOUT "#endif" . "\n\n";

	print STDOUT "#define DSL_COMPILER_VER \"" . $DSL_COMPILER_VER . "\"" . "\n";
	print STDOUT "#define DSL_EMBEDDED_M2C \"" . "empty" . "\"" . "\n";

	exit(0);
}

#
sub menu_out_hex_bytes {
	my ($arg) = @_;

	my $r = $arg->{str};
	my $t = "\t" x 2;

	use bytes;

	$r =~ s/(.)/sprintf "\\x%2x", ord $1/seg;

	my @r = $r =~ /(.{1,64})/g;

	use utf8;

	return join("\"\n$t\"", @r);
}

sub menu_out_len_bytes {
	my ($arg) = @_;

	use bytes;

	my $r = length($arg->{str});

	use utf8;

	return $r;
}

#
sub msg_fail {
	my ($arg) = @_;

	if($arg->{line}) {
		print STDERR $0 . ": " . $arg->{mess} . " at line " . $arg->{line} . ". Abort." . "\n";
	}
	else {
		print STDERR $0 . ": " . $arg->{mess} . ". Abort." . "\n";
	}

	exit(1);
}