#!/usr/bin/perl -w

#  Copyright (C) 2006-2009
#  Andreas Harnack (ah8 at freenet dot de)
#  version 0.0.1

#  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, write to the Free Software Foundation, Inc.,
#  51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.


$print_functions = <<'END_OF_FUNCTIONS'
#!/bin/sh

function statement {
	echo "$1;"
}

function class
{
	echo 'class' "$@" '{'
	sed 's/^/	/'
	echo '};'
}

function block
{
	echo $1 '{'
	sed 's/^/	/'
	echo '}'
}

function label {
	echo "$@:"
	sed 's/^/	/'
	echo
}

function labels {
	marker=$1; shift
	for i; do echo "$marker '$i':"; done
	sed 's/^/	/'
	echo
}

function make_statement {
	statement "STATEMENT( vt.$1 )"
}

function make_case {
	label 'case' "$1"
}

function make_cases {
	labels 'case' "$@"
}

function make_return {
	statement "return &state0${1}"
}

function make_break {
	statement "break"
}

function make_switch {
	(
		cat
		(
			make_statement "reportErrorToken()"
			make_break
		) | label 'default'
	) | block "switch ( $1 )"
}

function make_loop {
	make_switch "vt.parm[i++]" | block "for ( $1; i<vt.parm; )"
}

function make_node {
	node="vt::VT102::State vt::VT102::FSM::state0${1}(VT102 &vt, int ch)"
	(
		echo "BLOCK( $node )"
		echo "STATE( vt::VT102::FSM::state0${1} )"
		cat
		make_return 0
	) | block "$node"
	echo
}


function declare_node {
	statement "static vt::VT102::State state0${1}(VT102&, int)"
}

function make_class {
	label 'public' | class 'vt::VT102::FSM'
	echo
	echo
}


echo
echo '/* this is an automatically generated file */'
echo '/* do not edit (!) */'
echo


END_OF_FUNCTIONS
;


@ident = ("");

sub create_line {
	print $ident[0] . join(" ", @_) . "\n";
}

sub create_block {
	create_line "(";
	unshift(@ident, "\t" . $ident[0]);
	&{ pop() };
	shift(@ident);
	create_line ")", "|", @_;
	print "\n";
}


sub create_class	{ create_block "make_class", @_; }
sub declare_node	{ create_line  "declare_node", @_; }
sub create_node	 	{ create_block "make_node", @_; }
sub create_statement	{ create_line  "make_statement", "'".shift()."'", @_; }
sub create_transition	{ create_line  "make_return", @_; }
sub create_terminate	{ create_line  "make_break", @_; }
sub create_switch	{ create_block "make_switch", "'".shift()."'", @_; }
sub create_break	{ create_line  "make_break", @_; }
sub create_case		{ create_block "make_case", "'".shift()."'", @_; }
sub create_cases	{ create_block "make_cases", @_; }
sub create_loop		{ create_block "make_loop", "'".shift()."'", @_; }




sub print_action {
	my $declare = shift();
	my $actions = shift();
	my %actions = ();

	foreach $a ( @{ $actions } ) {
		my @action = map { $_ } @{ $a };
		my $action = shift(@action);
		if ( scalar @action ) {
			my $i =  shift( @action );
			push(@{ $actions{ $i } }, [ $action,  @action ]);
		}
		else {
			create_statement $action;
		}
	}
	if ( keys %actions ) {
		create_loop $declare, sub {
			foreach $a ( sort { $a <=> $b } keys %actions ) {
				create_case $a, sub {
					print_action( "", $actions{ $a } );
					create_break;
				}
			}
		}
	}
}


sub print_trans {
	my $node = shift();
	my $nodes = shift();
	my $dtrans = shift();
	my $daccept = shift();

	create_switch 'vt.buffer << ch', sub {
		foreach $trans ( sort keys %{ $node } ) {
			if ( $trans eq '0P' ) {
				create_cases split(':', '0:1:2:3:4:5:6:7:8:9'), sub {
					create_statement 'parm << ch';
					create_transition $nodes->{ $node->{$trans} };
				};
				create_cases "';'", sub {
					create_statement 'parm.next()';
					create_transition $nodes->{ $node->{$trans} };
				}
			}
			else {
				create_cases "'" . $trans . "'", sub {
					print_action( "int i=0", $daccept->{ $node->{$trans} } );
					if ( exists $dtrans -> { $node->{$trans} } ) {
						create_transition $nodes->{ $node->{$trans} };
					}
					else {
						create_terminate;
					}
				}
			}
		}
	}
}


sub print_code {
	my $dtrans = shift();
	my $daccept = shift();
	my %node = ();
	my $state = 0;

	# print semantic
	print $print_functions;
	# rename nodes
	foreach $node ( sort { $a <=> $b } keys %{ $dtrans } ) {
		$node{$node} = $state++;
	}
	create_class sub {
		foreach $node ( sort { $a <=> $b } keys %{ $dtrans } ) {
			declare_node $node{$node};
		}
	};
	foreach $node ( sort { $a <=> $b } keys %{ $dtrans } ) {
		create_node $node{$node}, sub {
			if ( ref( $dtrans->{$node} ) eq 'ARRAY' ) {
				print_action "void", [ $dtrans->{$node} ];
			}
			else {
				print_trans $dtrans->{$node}, \%node, $dtrans, $daccept;
			}
		}
	}
}


# left here for debuging
sub print_dtrans {
	my $dtrans = shift();

	print "dtrans = {\n";
	foreach $node ( sort { $a <=> $b } keys %{ $dtrans } ) {
		if ( ref( $dtrans->{$node} ) eq 'ARRAY' ) {
			print "\t" . $node . " => [ ". join(':', @{ $dtrans->{$node} } ) . " ]\n";
		}
		else {
			print "\t" . $node . " => {\n";
			foreach $trans ( sort keys %{ $dtrans -> {$node} } ) {
				print "\t\t" . $trans . "\t=> " . $dtrans -> {$node} -> { $trans } . "\n";
			}
			print "\t}\n\n";
		}
	}
	print "}\n\n";
}

# left here for debuging
sub print_daccept {
	my $daccept = shift;

	print "daccept = {\n";
	foreach $accept ( sort keys %{ $daccept } ) {
	        print "\t" . $accept . " -> (\n";
		foreach $a ( @{ $daccept -> { $accept } } ) {
			print "\t\t" . join(":", @{ $a } ) . "\n";
		}
		print "\t)\n\n";
	}
	print "}\n\n";
}

sub nfa_to_dfa {
	my $nfa = shift();
	my %dtrans = ();
	my %daccept = ();
	my %dstate = ( join(":", sort keys %{ $dqueue[0] = { 0 => undef } }) => 0 );
	my $state = 0;

	while ( scalar @dqueue ) {
		my $i = shift @dqueue;
		my %trans = ();
		my @accept = ();
		foreach $node ( sort { $a <=> $b } keys %{ $i } ) {
			if ( ref($nfa->{$node}) eq 'HASH' ) {
				foreach $succ ( sort {$a <=> $b} keys %{ $nfa->{$node} } ) {
					undef $trans{$nfa->{$node}->{$succ}} -> { $succ };
				}
			}
			else {
				push(@accept, $nfa->{$node});
			}
		}
		my $n = $dstate{ join(":", sort keys %{ $i }) };
		if ( scalar @accept ) {
			$daccept{ $n } = \@accept;
		}
		foreach $succ ( sort keys %trans ) {
			my $s = join ":", sort keys %{ $trans{$succ} };
			if ( ! exists $dstate{$s} ) {
				$dstate{$s} = ++$state;
				push(@dqueue, $trans{$succ} );
			}
			$dtrans{ $n } -> {$succ} = $dstate{$s};
		}
	}
	return ( \%dtrans, \%daccept );
}


# left here for debuging
sub print_nfa {
	my $nfa = shift();

	print "nfa = {\n";
	foreach $node ( sort { $a <=> $b } keys %{ $nfa } ) {
		if ( ref($nfa->{$node}) eq 'HASH' ) {
			print "\t" . $node . " => {\n";
			foreach $succ ( sort { $a <=> $b } keys %{ $nfa->{$node} } ) {
				print "\t\t" . $succ . "\t=> " . $nfa->{$node} -> { $succ } . "\n";
			}
			print "\t}\n\n";
		}
		elsif ( ref($nfa->{$node}) eq 'ARRAY' ) {
			print "\t" . $node . " => " . join(":", @{ $nfa->{$node} } ) . "\n\n";
		}
		else {
			print "\t" . $node . " => " . $nfa->{$node} . "\n\n";
		}
	}
	print "}\n\n";
}

sub parse_nfa {
	my $state = 0;
        my %nfa = ( $state => {} );

	for $line ( split(/\n/, shift()) ) {
		my @column = split(/\t+/, $line);
		my @pn = ();

		# skip lines describing terminal responses
		if (  $column[1] eq "response" ) {
			next;
		}
		# unify all parameter names
		$column[0] =~ s/P[lcbt]/Pn/g;
		# eliminate spaces between digits in parameter sequences
		while ( grep(/([0-9]+)[ ]+([0-9])/, $column[0]) ) {
			$column[0] =~ s/([0-9]+)[ ]+([0-9])/$1$2/g;
		}
		# eliminate spaces in paramter sequences
		while ( grep(/(Pn|[0-9]+)[ ]+;[ ]*(Pn|[0-9]+)/, $column[0]) ) {
			$column[0] =~ s/(Pn|[0-9]+)[ ]+;[ ]*(Pn|[0-9]+)/$1;$2/g;
		}
		while ( grep(/(Pn|[0-9]+)[ ]*;[ ]+(Pn|[0-9]+)/, $column[0]) ) {
			$column[0] =~ s/(Pn|[0-9]+)[ ]*;[ ]+(Pn|[0-9]+)/$1;$2/g;
		}

		# remember constant parameter sequences
		while ( $column[0] =~ /ESC\s*\[[\s?]*([0-9]+(;[0-9]+)*)/g ) {
			push(@pn, split(/;/, $1));
		}

		# substitute parameter sequences by a single symbol
		$column[0] =~ s/(ESC\s*\[[\s?]*)(Pn|[0-9]+)(;(Pn|[0-9]+))*/${1}0P/g;

		# parse sequence and construct nfa
		my $s = 0;
		for $token ( split(/\s+/, $column[0] ) ) {
			if ( $token eq '0P' ) {
				$nfa{$s} -> {$s} = $token;
			}
			else {
				$nfa{++$state} = {};
				$nfa{$s} -> {$state} = $token;
				$s = $state;
			}
		}
		$nfa{$s} = [ $column[2], @pn ];
	}
	return \%nfa;
}


sub print_source_code {
	my $nfa;
	my $dtrans;
	my $daccept;

	$nfa = parse_nfa(shift());
#	print_nfa($nfa);
	( $dtrans, $daccept ) = nfa_to_dfa($nfa);
#	$dtrans->{0} = [ 'put( vt.charset[ch] )' ];
	$dtrans->{0} = [ 'put( ch )' ];
#	print_dtrans($dtrans);
#	print_daccept($daccept);
	print_code($dtrans, $daccept);
}


print_source_code <<'END_OF_INPUT'
ESC  [   ?   2   l	DECANM		ansiMode( false )
ESC  [   ?   4   h	DECSCLM		softScrollingMode( true )
ESC  [   ?   4   l	DECSCLM		softScrollingMode( false )
ESC  [  Pt   ;  Pb   r	DECSTBM		setMargin( (coordL) vt.parm[0], (coordL) vt.parm[1] )
ESC  [   ?   6   h	DECOM		originMode( true )
ESC  [   ?   6   l	DECOM		originMode( false )
ESC  [  Pn   A		CUU		cursorUp( (countL) vt.parm[0] )
ESC  [  Pn   B		CUD		cursorDown( (countL) vt.parm[0] )
ESC  [  Pn   C		CUF		cursorForward( (countC) vt.parm[0] )
ESC  [  Pn   D		CUB		cursorBackward( (countC) vt.parm[0] )
ESC  [  Pl   ;  Pc   H	CUP		cursorPosition( (coordL) vt.parm[0], (coordC) vt.parm[1] )
ESC  [  Pl   ;  Pc   f	HVP		cursorPosition( (coordL) vt.parm[0], (coordC) vt.parm[1] )
ESC  D			IND		shiftDown()
ESC  M			RI		shiftUp()
ESC  E			NEL		nextLine()
ESC  7			DECSC		saveCursor()
ESC  8			DECRC		restoreCursor()
ESC  [   ?   3   h	DECCOLM		columns132Mode( true )
ESC  [   ?   3   l	DECCOLM		columns132Mode( false )
ESC  [   ?   7   h	DECAWM		autoWrapMode( true )
ESC  [   ?   7   l	DECAWM		autoWrapMode( false )
ESC  [   ?   5   h	DECSCNM		reverseScreenMode( true )
ESC  [   ?   5   l	DECSCNM		reverseScreenMode( false )
ESC  [   2   0   h	LNM		newLineMode( true )
ESC  [   2   0   l	LNM		newLineMode( false )
ESC  [   2   h		FDX		keyboardLocked ( true )
ESC  [   2   l		FDX		keyboardLocked ( false )
ESC  [   ?   8   h	DECARM		autoRepeatMode( true )
ESC  [   ?   8   l	DECARM		autoRepeatMode( false )
ESC  [   1   2   h	SRM		sendReceiveMode( true )
ESC  [   1   2   l	SRM		sendReceiveMode( false )
ESC  [   ?   1   h	DECCKM		cursorKeyMode( true )
ESC  [   ?   1   l	DECCKM		cursorKeyMode( false )
ESC  <			DECANM		ansiMode( true )
ESC  =			DECKPAM		applKeypadMode( true )
ESC  >			DECKPNM		applKeypadMode( false )
ESC  (   A		SCS		characterUK( 0 )
ESC  (   B		SCS		characterASCII( 0 )
ESC  (   0		SCS		characterSpecial( 0 )
ESC  (   1		SCS		characterAltROM( 0 )
ESC  (   2		SCS		characterAltROMSpecial( 0 )
ESC  )   A		SCS		characterUK( 1 )
ESC  )   B		SCS		characterASCII( 1 )
ESC  )   0		SCS		characterSpecial( 1 )
ESC  )   1		SCS		characterAltROM( 1 )
ESC  )   2		SCS		characterAltROMSpecial( 1 )
ESC  N			SS2		characterSet( 2 )
ESC  O			SS3		characterSet( 3 )
ESC  [   0   m		SGR		renditionDefault()
ESC  [   1   m		SGR		renditionBold()
ESC  [   4   m		SGR		renditionUnderline()
ESC  [   5   m		SGR		renditionBlink()
ESC  [   7   m		SGR		renditionReverse()
ESC  H			HTS		setTab()
ESC  [   0   g		TBC		clearTab()
ESC  [   3   g		TBC		clearTabs()
ESC  #   3		DECDHL		topHalf()
ESC  #   4		DECDHL		bottomHalf()
ESC  #   5		DECSWL		singleWidthLine()
ESC  #   6		DECDWL		doubleWidthLine()
ESC  [   0   K		EL		clearToEndOfLine()
ESC  [   1   K		EL		clearToBeginOfLine()
ESC  [   2   K		EL		clearEntireLine()
ESC  [   0   J		ED		clearToEndOfScreen()
ESC  [   1   J		ED		clearToBeginOfScreen()
ESC  [   2   J		ED		clearEntireScreen()
ESC  [  Pn   P		DCH		deleteChars( (countC) vt.parm[0] )
ESC  [  Pn   L		IL		insertLines( (countL) vt.parm[0] )
ESC  [  Pn   M		DL		deleteLines( (countL) vt.parm[0] )
ESC  [   4   h		IRM		insertMode( true )
ESC  [   4   l		IRM		insertMode( false )
ESC  [   ?   5   i	MC		autoPrintOn( true )
ESC  [   ?   4   i	MC		autoPrintOn( false )
ESC  [   5   i		MC		printControllerOn( true )
ESC  [   4   i		MC		printControllerOn( false )
ESC  [   ?   1   i	MC		printCursorLine()
ESC  [   0   i		MC		printScreen()
ESC  [   ?   1   9   h	DECPEX		printerExtendMode( true )
ESC  [   ?   1   9   l	DECPEX		printerExtendMode( false )
ESC  [   ?   1   8   h	DECPFF		printerFormFeedMode( true )
ESC  [   ?   1   8   l	DECPFF		printerFormFeedMode( false )
ESC  [   5   n		DSR		statusReport()
ESC  [   0   n		response	Ready, no malfunctions detected.
ESC  [   3   n		response	Malfunction, error in self-test. Reset and retry
ESC  [   ?   1   5   n	DSR		printerStatusReport()
ESC  [   ?   1   3   n	response	Printer not connected to terminal.
ESC  [   ?   1   1   n	response	Printer not ready to print. Printer DTR was on, but is now off.
ESC  [   ?   1   0   n	response	Printer ready to print. Printer DTR is on.
ESC  [   6   n		CPR		cursorPositionReport()
ESC  [  Pl   ;  Pc   R	response	Terminal reports cursor position in response to DSR sequence request from computer.
ESC  [   0   c		DA		identifyTerminal()
ESC  Z			DECID		identifyTerminal()
ESC  [   ?   6   c	response	Terminal response: VT102.
ESC  c			RIS		reset()
ESC  [   2   ;   1   y	DECTST		powerUpTest()
ESC  [   2   ;   2   y	DECTST		dataLoopbackTest()
ESC  [   2   ;   4   y	DECTST		EIAloopbackTest()
ESC  [   2   ;   1   6   y	DECTST	printerLoopbackTest()
ESC  [   2   ;   9   y	DECTST		repeatPowerUpTest()
ESC  [   2   ;   1   0   y	DECTST	repeatDataLoopbackTest()
ESC  [   2   ;   1   2   y	DECTST	repeatEIAloopbackTest()
ESC  [   2   ;   2   4   y	DECTST	repeatPrinterLoopbackTest()
ESC  #   8		DECALN		fillScreen()
ESC [ 0 x	s4	reportTerminalParms( 0 )
ESC [ 100 m	s4	setBackGroundColor( 9 )
ESC [ 101 m	s4	setBackGroundColor( 10 )
ESC [ 102 m	s4	setBackGroundColor( 11 )
ESC [ 103 m	s4	setBackGroundColor( 12 )
ESC [ 104 m	s4	setBackGroundColor( 13 )
ESC [ 105 m	s4	setBackGroundColor( 14 )
ESC [ 106 m	s4	setBackGroundColor( 15 )
ESC [ 107 m	s4	setBackGroundColor( 16 )
ESC [ 1 x	s4	reportTerminalParms( 1 )
ESC [ 22 m	s4	renditionBold( false )
ESC [ 24 m	s4	renditionUnderline( false )
ESC [ 25 m	s4	renditionBlink( false )
ESC [ 27 m	s4	renditionReverse( false )
ESC [ 30 m	s4	setForeGroundColor( 1 )
ESC [ 31 m	s4	setForeGroundColor( 2 )
ESC [ 32 m	s4	setForeGroundColor( 3 )
ESC [ 33 m	s4	setForeGroundColor( 4 )
ESC [ 34 m	s4	setForeGroundColor( 5 )
ESC [ 35 m	s4	setForeGroundColor( 6 )
ESC [ 36 m	s4	setForeGroundColor( 7 )
ESC [ 37 m	s4	setForeGroundColor( 8 )
ESC [ 39 m	s4	setForeGroundColor( 0 )
ESC [ 40 m	s4	setBackGroundColor( 1 )
ESC [ 41 m	s4	setBackGroundColor( 2 )
ESC [ 42 m	s4	setBackGroundColor( 3 )
ESC [ 43 m	s4	setBackGroundColor( 4 )
ESC [ 44 m	s4	setBackGroundColor( 5 )
ESC [ 45 m	s4	setBackGroundColor( 6 )
ESC [ 46 m	s4	setBackGroundColor( 7 )
ESC [ 47 m	s4	setBackGroundColor( 8 )
ESC [ 49 m	s4	setBackGroundColor( 0 )
ESC [ 90 m	s4	setForeGroundColor( 9 )
ESC [ 91 m	s4	setForeGroundColor( 10 )
ESC [ 92 m	s4	setForeGroundColor( 11 )
ESC [ 93 m	s4	setForeGroundColor( 12 )
ESC [ 94 m	s4	setForeGroundColor( 13 )
ESC [ 95 m	s4	setForeGroundColor( 14 )
ESC [ 96 m	s4	setForeGroundColor( 15 )
ESC [ 97 m	s4	setForeGroundColor( 16 )
ESC [ ? 1000 h	s5	mouse1000Mode( true )
ESC [ ? 1000 l	s5	mouse1000Mode( false )
ESC [ ? 1000 r	s5	restoreMouse1000Mode()
ESC [ ? 1000 s	s5	saveMouse1000Mode()
ESC [ ? 1001 h	s5	hiliteMouse( true )
ESC [ ? 1001 l	s5	hiliteMouse( false )
ESC [ ? 1001 r	s5	restoreHiliteMouse()
ESC [ ? 1001 s	s5	saveHiliteMouse()
ESC [ ? 1047 h	s5	applScreenMode( true )
ESC [ ? 1047 l	s5	applScreenMode( false )
ESC [ ? 1048 h	s5	saveCursor()
ESC [ ? 1048 l	s5	restoreCursor()
ESC [ ? 1 r	s5	restoreApplKeypadMode()
ESC [ ? 1 s	s5	saveApplKeypadMode()
ESC [ ? 25 h	s5	cursorKeyMode( true )
ESC [ ? 25 l	s5	cursorKeyMode( false )
ESC [ ? 47 h	s5	applScreenMode( true )
ESC [ ? 47 l	s5	applScreenMode( false )
ESC [ ? 6 r	s5	restoreOriginMode()
ESC [ ? 6 s	s5	saveOriginMode()
ESC [ ? 7 r	s5	restoreAutoWrapMode()
ESC [ ? 7 s	s5	saveAutoWrapMode()
ESC [ ? 9 h	s5	interLaceMode( true )
ESC [ ? 9 l	s5	interLaceMode( false )
ESC [ Pn @	s4	insertChars( (countC) vt.parm[0] )
ESC [ Pn G	s4	cursorPosition( (coordC) vt.parm[0] )
ESC [ Pn X	s4	eraseChars( (countC) vt.parm[0] )
ESC [ Pn d	s4	cursorPosition( (coordL) vt.parm[0] )
ESC [ Pn q	s4	setLED( vt.parm[0] )
ESC n	s1	characterSet( 2 )
ESC o	s1	characterSet( 3 )
ESC s	s1	saveCursor()
ESC u	s1	restoreCursor()
END_OF_INPUT
;

sub ignore_from_vt102 {} <<'END_OF_INPUT'
ESC  [   0   q		DECLL		setLED( vt.parm[0] )
ESC  [   1   q		DECLL		setLED( vt.parm[0] )
END_OF_INPUT
;

sub ignore_from_vtkonsole {} <<'END_OF_INPUT'
ESC [ Pn c	s4	reportTerminalType()
ESC [ Pn n	s4	reportDeviceStatus(parm[i])
END_OF_INPUT
;

