package SFNParse;

use Parse::RecDescent;

#$::RD_HINT = 1;
#$::RD_TRACE = 1;

our %abbrevs = (
	# Hands
	'L'=>'left','R'=>'right',	
	# Sides (would we put 'lat' and 'mid' here?) [l/r too?]
	'n'=>'near','f'=>'far', 'o'=>'outer', 'i'=>'inner',		
	# Heights (thought it was 'centre'...?)
	###### Arrggghhh!!! Indeed - i don't BELIEVE that i did that - that's too much writing HTML :)
	't'=>'top', 'c'=>'center','b'=>'bottom',	
	# Directions
	'dx'=>'distally','px'=>'proximally','lr'=>'from left to right','rl'=>'from right to left','nf'=>'near to far', 'fn'=>'far to near',
	'up'=>'upwards', 'dn'=>'downwards',
	'da'=>'down and away from you','ua'=>'up and away from you','dt'=>'down and towards you','ut'=>'up and towards you',
	'tw'=>'towards you','aw'=>'away from you',
	'lor'=>'left over right', 'rol'=>'right over leftt', 
	# Twists
	'>'=>"a half turn away from you",'>>'=>"a full turn away from you",'<'=>"a half turn towards you",'<<'=>"a full turn towards you",
	# 'Descriptor' strings (added VS, changed text of CS, anticipating 'mid')
	'DS'=>'diagonal','SS'=>'straight','XS'=>'crossed','CS'=>'centre','TV'=>'transverse',
		'VS'=>'vertical',
	# Bodyparts (. means 'in the figure')
	'1'=>'thumb', '2'=>'forefinger', '3'=>'middle finger','4'=>'ring finger','5'=>'little finger',
	'P'=>'palm','H'=>'hand','W'=>'wrist','O'=>'mouth','.'=>' ','B'=>'back of hand',
		'T'=>'toe or etc',
	# Commands (added hu,hd)
	'pu'=>'pick up','gr'=>'grasp','hu'=>'hook up','hd'=>'hook down',
	'kl'=>'keep loose','ls'=>'let slip','ht'=>'hold tight','ex'=>'extend',','=>'then..',
	'na'=>'navaho','tr'=>'transfer','fl'=>'flip','<=>'=>'exchange',
	'mo'=>'over','mu'=>'under','mt'=>'through',
	'rep'=>'repeat', 'rot'=>'rotate','rel'=>'release','ret'=>'return',
	);

our $handed = "s";

sub new {
	my $grammar = q {
# Could this be "[" /[^]]+/ "]" ? Or do the code-refs need to be single words?
# Apparently so....
	code_ref:	"[" /\w+/ "]"								{ "perform $item[2]";}
	comment:	"#" /.+/									{"($item[2])";}
	voice:		"v" /.+/									{'"'.$item[2].'"';}
	hand:		("L" | "R")									{$SFNParse::handed = "";$SFNParse::abbrevs{$item[1]};}
	side:		("n" | "f" | "o" | "i")									{$SFNParse::abbrevs{$item[1]};}
	height:		("t" | "c" | "b")							{$SFNParse::abbrevs{$item[1]};}
	descriptor: ("DS" | "XS" | "CS" | "SS" | "TV" | "VS")			{$SFNParse::abbrevs{$item[1]};}
	direction:	("px" | "dx" | "lr" | "rl" | "nf" | "fn" | "up" | "dn" | "ua" | "da" | "ut" | "dt" | "tw" | "aw")	{$SFNParse::abbrevs{$item[1]};}
	bodypart:	("1" | "2" | "3" | "4" | "5" | "P" | "H" | "W" | "B" | "O" | "." | "T")	{$SFNParse::abbrevs{$item[1]};}
	manipulator: hand(?) bodypart(s)						{"$item[1][0] ".join("/", @{$item[2]});}

	snoose:		"SN"										{"string noose"}
	mnoose:		manipulator "N" height(?)  					{"$item[3][0] $item[1]  noose" . $SFNParse::handed;}
	mstring:	manipulator height(?) side(?) descriptor(?)	{join(" ", @{$item[2]},@{$item[3]},$item[1],@{$item[4]}," string"). $SFNParse::handed;}
	string:		(snoose | mnoose | mstring)		
	strings:	(string(s) | "AS")							{($item[1] eq 'AS') ? "all strings" : join(" / ", @{$item[1]});}
	altstrings: "(" strings ")"								{"($item[2])";}
	stringdesc: strings altstrings(s?)						{$item[1] . " ".join(" ",@{$item[2]});}

	rel_move: ("mo" | "mu" | "mt") direction(?) {"move".(($SFNParse::handed)?" ":"s "). "$item[2][0] ".$SFNParse::abbrevs{$item[1]};}
	take:		("pu" | "gr" | "hu" | "hd")								{$SFNParse::abbrevs{$item[1]};}
	move:		(rel_move | take ) stringdesc	{"$item[1] $item[2]";}
	twist:		("<<" | ">>" | ">" | "<")					{"twist".(($SFNParse::handed)?" ":"s ") . $SFNParse::abbrevs{$item[1]};}
# Changed this to [2] - hope that's right...
#### It was :)
	rotate:		"rot" direction(?)							{"rotate".(($SFNParse::handed)?" ":"s "). $item[2][0];}
	defaultmove: direction									{"move".(($SFNParse::handed)?" ":"s ").$item[1];}

	action:		manipulator (move | twist | rotate | defaultmove)(s){$item[1] . $SFNParse::handed. " ".join (", ", @{$item[2]});}
	manouvre:	("rel" | "na") stringdesc					{$SFNParse::abbrevs{$item[1]}." ".$item[2];}
	extension:	"ex" manipulator(?) direction(?)			{"extend $item[2][0]". (($item[2][0] && $SFNParse::handed)?"s":""). " $item[3][0]";}
	tension:	manipulator(?) ("ls" | "ht") stringdesc		{(($item[1][0])?"$item[1][0] ":"").$SFNParse::abbrevs{$item[2]}." $item[3]";}
	flip:		"fl" stringdesc direction					{"flip $item[2] from the $item[3] side of the hand";}
	transfer:	"tr" mnoose manipulator direction(?)		{"$item[4][0] transfer $item[2] to $item[3]";}
	exchange:	"<=>" mnoose mnoose direction(?)			{"exchange $item[2] and $item[3]". (($item[4][0]) ? "passing $item[4][0]" : "");}
	modifier:	("ex" | "ret" | "si" | "kl" | ",")			{$SFNParse::abbrevs{$item[1]};}
	fullmove:	(manouvre | action | transfer | tension | extension | flip) modifier(?) {$item[1].(($item[2][0]) ? " and ". $item[2][0] : "");}

	swap:		"sw" hand hand								{"swapping $item[2] and $item[3]";}
	stepnumber: /\d+/
	repeat:		"rep" stepnumber "-" stepnumber swap(?)		{"repeat steps $item[2] to $item[4] $item[5][0]"}
	validstep:	code_ref | repeat | fullmove | voice
	stepline:	/\\\{?/ validstep /\\\}?/ comment(?)	{$SFNParse::handed = "s";"$item[1] $item[2] $item[3] $item[4][0]";}

	};

	my $parser = new Parse::RecDescent ($grammar) or die "Bad grammar!\n";
	$parser;
}

1;