# -*- CPERL -*-
# /=======================================================\ #
# |  ifthen.sty - Implementation for LaTeXML              | #
# |                                                       | #
# |=======================================================| #
# | Part of LaTeXML : http://dlmf.nist.gov/LaTeXML/       | #
# | Copyright (c) 2006 arXMLiv group                      | #
# | Released under the GNU Public License                 | #
# |=======================================================| #
# | Author: Silviu Vlad Oprea                             | #
# | E-mail: s.oprea@jacobs-university.de                  | #
# \=======================================================/ #

package LaTeXML::Package::Pool;
use strict;
use LaTeXML::Package;

# \provideboolean{<command>}
DefMacro('\provideboolean{}',
	sub {
		my ($gullet, $new_bool) = @_;
		my $new_bool_str = ToString($new_bool);

		if (length($new_bool_str) < 1) {
			Error(":expected:name expected argument to \\newboolean");
			return;
		}
		return if $STATE->lookupDefinition(T_CS('\if'.$new_bool_str));
		DefMacroI('\if'.$new_bool_str,undef,
							sub { ifHandler($_[0],LookupValue('Boolean:'.$new_bool_str)); },
							isConditional=>1);
		DefPrimitiveI(T_CS('\\'.$new_bool_str.'true'), undef,
									sub { AssignValue('Boolean:'.$new_bool_str => 1); });
		DefPrimitiveI(T_CS('\\'.$new_bool_str.'false'), undef,
									sub { AssignValue('Boolean:'.$new_bool_str => 0); });
		AssignValue('Boolean:'.$new_bool_str, 0,"local");
	}
);

# \newboolean{<command>}
DefMacro('\newboolean{}',
	sub {
		my ($gullet, $new_bool) = @_;
		my $new_bool_str = ToString($new_bool);
		if (length($new_bool_str) < 1) {
			Error(":expected:name expected argument to \\newboolean");
			return;
		}
		Error(":unexpected:\\if$new_bool_str \\if$new_bool_str has already been defined")
			if $STATE->lookupDefinition(T_CS('\if'.$new_bool_str));
		DefMacroI('\if'.$new_bool_str,undef,
							sub { ifHandler($_[0],LookupValue('Boolean:'.$new_bool_str)); },
							isConditional=>1);
		DefPrimitiveI(T_CS('\\'.$new_bool_str.'true'), undef,
									sub { AssignValue('Boolean:'.$new_bool_str => 1); });
		DefPrimitiveI(T_CS('\\'.$new_bool_str.'false'), undef,
									sub { AssignValue('Boolean:'.$new_bool_str => 0); });
		AssignValue('Boolean:'.$new_bool_str, 0,"local");
	}
);

# \setboolean{<command>}{<boolean value>}
DefMacro('\setboolean{}{}',
	sub {
		my ($gullet, $name, $value) = @_;
		my $name_str = ToString($name);
		my $value_str = ToString($value);

		Error(":expected:name expected first argument to \\setboolean".
				 'It should be a predefined boolean...') if length($name_str) < 1;
		Error(":expected:value expected second argument to \\setboolean") if length($value_str) < 1;
		if (!defined LookupValue('Boolean:'.$name_str)) {
			Error(":undefined:$name_str was not defined");
		} elsif ($value_str eq 'true') {
			AssignValue('Boolean:'.$name_str, 1, 'local');
		} elsif ($value_str eq 'false') {
			AssignValue('Boolean:'.$name_str, 0, 'local');
		} else {
			Error(":unexpected:$value_str second argument of \\setboolean has to be 'true' or 'false'");
		}
	}
);

# \boolean{<boolean expression>}
# Notes: \boolean{true} returns true
#        \boolean{false} returns false
#        In case of empty argument, user is warned and false is returned
DefMacro('\boolean{}',sub {
           T_CS('\if'.ToString($_[1])),
						 T_OTHER('t'),
					 T_CS('\else'),
						 T_OTHER('f'),
					 T_CS('\fi');
         });

# \isodd{<string>}
# Notes: Converts the input string to a number, taking the beginning digit characters
#        If the input does not start with a digit, false is returned
#        Leading 0's are ignored unless there are no more digits in the beginning
DefMacro('\isodd{}',
	sub {
		my ($gullet, $arg) = @_;
		my $arg_str = ToString(Expand($arg));

		Error(":expected:name expected argument to \\isodd") if length($arg_str) < 1;
		$arg_str =~ m/(^\d+).*/ ? # if it starts with digit characters
			ToString(Digest($1)) % 2 eq '1'?
				T_OTHER('t'):
				T_OTHER('f'):
			T_OTHER('f');
	}
);

# \isundefined{<command>}
# Notes: If the argumend is not empty and not a command name, false is returned
DefMacro('\isundefined{}',
	sub {
		my ($gullet, $arg) = @_;
		my ($first_token) = $arg -> unlist;

		if (!defined $first_token) {
			Error(":expected:name expected argumetn to \\isundefined");
		} elsif (!($first_token -> getCatcode == 16)) { # Command sequence catcode
			T_OTHER('f');
		} else {
			defined $STATE -> lookupDefinition($first_token)?
				T_OTHER('f'):
				T_OTHER('t');
		}
	}
);

# \equal{<any sequence of commands that can be expanded to a list of tokens>}{<same>}
# Note: Empty argument is accepted
DefMacro('\equal{}{}',
	sub {
		my ($gullet, $arg1, $arg2) = @_;

		ToString(Expand($arg1)) eq ToString(Expand($arg2))?
			T_OTHER('t'):
			T_OTHER('f');
	}
);

# \lengthtest{<dimen>[<>=]<dimen>}
# Note: Empty argument is accepted (error occours) and true is returned (0=0)
DefMacro('\lengthtest{}', '\ifdim #1 t \else f \fi');

DefMacro('\AND', 'and');

DefMacro('\OR', 'or');

DefMacro('\NOT', '!');

# Adding brackets to make the expression left associative and evaluating
sub eval_expression {
	my ($arg) = @_;
	my $bracketed = '';
	my $open = 0;

	while ($arg =~ s/          # substitute
									(          # select operator
										[\|\&]   # an operator ('|' OR '&')
									)
									(          # select value
										[01]     # followed by a 0 or 1
									)$
									//x        # with ''
				) {
		# put the operator and the value together, add a closing bracket
		$bracketed = $1.$2.')'.$bracketed;
		# and count the number of added brackets
		$open++;
	}
	# add corresponding opening brackets in front and return the evaluated expression
	return eval(("("x$open).$arg.$bracketed);
}

# Transforming the fully digested expressionin an correct logical expression
# and evaluating it
sub final_test {
	my ($arg) = @_;
	my $arg_str = $arg -> toString;
	$arg_str =~ s/{|}//g;  # eliminate '{'s and '}'s
	$arg_str =~ s/=/==/g;  # replace '=' by '=='
	$arg_str =~ s/and/&/g; # replace 'and' by '&'
	$arg_str =~ s/or/|/g;  # replace 'or' by '|'

	# handling <int. expr> [=<>] <int. expr>
	$arg_str =~ s/            # substitute a subexpression
								 (               # select group
									 [0-9]+        # starting with a digit, one or more times
									 (==|<|>)      # following an operator ('==' or '<' or '>')
									 [0-9]+        # and another digit, one or more times
								 )/
									 eval $1 eq ''? 'f': 't' # and return the value to which
										                       # the selected group evaluates
							/egx;

	# ckecking if the expr. still contains digit characters
	# if so, the given expr. was syntactically incorrect
	if ($arg_str =~ m/[0-9]/) {
	  Error(":unexpected:ifthen ifthen cannot currently understand the question \"$arg_str\"");
	}

	# putting back 1's and 0's - t and f were to check for the syntax error
	$arg_str =~ s/t/1/g; $arg_str =~ s/f/0/g;

	# evaluating, starting with inner-most brackets
	$arg_str = '\('.$arg_str.'\)';
	while ($arg_str =~ m/        # while the expression still contains
												\\\(   # an opening bracket '\('
												.+     # something one or more times
												\\\)   # following closing brackets
											/x) {
		# select the expression from the inner-most brackets
		$arg_str =~ s/                     # substitute
									 \\\(                # an opening bracket
									 (                   # select group
										 [^()]+            # anything but ('(' or ')')
									 )*
									 \\\)/               # following closing brackets
									 eval_expression($1) # by the value to which
										                   # the selected group evaluates to
								 /egx;
	}
	$arg_str;
}

# DefConstructor('\ifthenelse{}{}{}', '?&final_test(#1)(#2)(#3)');
DefMacro('\ifthenelse{}{}{}',
	sub {
		my ($gullet, $test, $true_e, $false_e) = @_;
		if (final_test(Expand($test))) {
			return $true_e;
		} else {
			return $false_e;
		}
	}
);
#DefConstructor('\ifthenelse{}{}{}', sub{
# my ($a,$b,$c,$d) = @_;print STDERR $d -> toString;exit;
# if (final_test($b) eq '1'){$c}else{$d};
#});

DefMacro('\whiledo{}{}',
	sub {
		my ($gullet, $test, $bloc) = @_;
		# Since perl has no limitation on the size of the array... (only memory)
		my @print = ();
		my $element;

		while (final_test(Digest($test))) {
			$element = Digest($bloc) -> toString;
			$element =~ s/ +/\\space/g; # spaces (behaves like latex)
			                            # if in math mode, they are ignored
			@print = (@print, Tokenize($element));
		}
		return Tokens(@print);
	}
);

#**********************************************************************
1;