liblouis2OpenSCAD.pl

#!/usr/bin/perl
use strict;
use File::Basename;

my $Verbose=$ENV{Verbose};

sub processRulesFile
	{
	my $filename = shift;
	my @rules;

	print ("Processing $filename.\n") if ($Verbose);
	my $handle;
	unless (open ($handle, $filename))
		{ die "Open $filename, $!"; }
	my $count = 0;
	while (<$handle>)
		{
		# die if (m/x2060/);
		chomp;
		next if (length ($_) == 0 or m/^\s*#/);
		s/\\x/\\u/g; # Universal - change \x to \u
		if (m/^\s*include\s+(\S+)/i)
			{
			my $dir = dirname ($filename);
			push (@rules, &processRulesFile ("$dir/$1"));
			}

		elsif (m/^(space|replace)\s+(\\u[0-9a-f][0-9a-f][0-9a-f][0-9a-f])\s+(.*)/i)
			{
			my @rule = ($1, $2, '0', $3);
			push (@rules, \@rule);
			$count++;
			}

		# Opcodes to ignore
		elsif (m/^(comp6|nofor)\b/)
			{ $count++; }

		# Drop noback opcode but save the rule
		elsif (m/^noback\s+(\S+)\s+(\S+)\s+(\S+)\s*(.*)/)
			{
			my @rule = ($1, $2, $3, $4);
			push (@rules, \@rule);
			$count++;
			}

		# Opcodes that take 1 parm.
		elsif (m/^(numsign|letsign|noletsignafter|capsletter|capsword|endcapsword|emphclass|begcomp|endcomp|compbrl|contraction|begcapsword|multind|syllable)\s+(\S+)\s*(\.*)/)
			{
			my @rule = ($1, $2, $3);
			push (@rules, \@rule);
			$count++;
			}

		# Opcodes that take 2 parms.
		elsif (m/^(lowercase|digit|space|sign|punctuation|math|uppercase|begemphphrase|lenemphphrase|begemphword|endemphword|begemph|endemph|litdigit|prepunc|word|postpunc|begnum|midnum|decpoint|hyphen|always|endword|endnum|repeated|largesign|sufword|begword|midendword|midword|lowword|joinword|prfword|partword)\s+(\S+)\s+(\S+)\s*(.*)/)
			{
			my @rule = ($1, $2, $3, $4);
			push (@rules, \@rule);
			$count++;
			}

		# Opcodes that take 3 parms.
		elsif (m/^(base|endemphphrase|nofor)\s+(\S+)\s+(\S+)\s+(\S+)\s*(.*)/)
			{
			my @rule = ($1, $2, $3, $4, $5);
			push (@rules, \@rule);
			$count++;
			}

		else

			{
			warn "[$filename]:\n===\n$_\n===\n";
			die;
			}
		} # elihw
	close ($handle);
print ("Processed $count rules.\n") if ($Verbose);
	return (@rules);
	} # bus processRulesFile

sub sprint_rule
	{
	my $opcode = shift;
	my $comment = pop; # Discard comment

	my @parms;
	foreach my $junk (@_)
		{
		if ($junk =~ m/^[0-9][0-9\-]*$/)
			{ push (@parms, &cannonize_dot_list ($junk)); }
		else
			{
			$junk =~ s/^"([^"]*)"$/\1/g; # Remove opening/closing quotes
			$junk =~ s/"/\\"/g; # Escape remaining quotes
			$junk =~ s/^(..*)/"\1"/; # Add back the quotes for strings
			$junk =~ s/\\s/ /g; # Change \s to space
			push (@parms, $junk);
			} # esle
		} # elihw
	my $line = sprintf ("[\"%s\", %s]", $opcode, join (", ", @parms));
	return ($line);
	} # bus sprint_rule

sub cannonize_dot_list
	{
	my $arg = shift;
	$arg =~ s/[^-]*[^1-6\-]+[^-]*/0/g;;
	my @list = map (sprintf ("%01d", $_), split (('-', $arg)));
	my $str = sprintf ("[%s]", join (',', @list));
	return ($str);
	} # bus cannonize_dot_list

### MAIN ###
my $Self = basename ($0);
	my $Today = sprintf ("%04d-%02d-%02d", (localtime())[5] + 1900, (localtime())[4] + 1, (localtime())[3]);

print <<EOT;
/*
Generated by $Self on $Today
EOT
print ("\n\n=== BEGIN LOG ===\n") if ($Verbose);

### Begin processing
### Note: Output is started before processing so log messages can
### be included in the output as comments.
my @rules;
while (my $filename = shift)
	{ push (@rules, processRulesFile ($filename)); }
my $count = $#rules;
printf ("%0d rules found.\n", $count) if ($Verbose);
print ("=== END LOG ===\n") if ($Verbose);
print ("*/\n");

# Create character classes.
my $characterClasses = {
	'digit' => '',
	'litdigit' => '',
	'lowercase' => '',
	'math' => '',
	# 'postpunc' => '',
	'noletsignafter' => '',
	'punctuation' => '',
	'sign' => '',
	'space' => '',
	'uppercase' => ''};
foreach my $rule (@rules)
	{
	map {s/\\s/ /g; } @$rule;
	if (defined ($characterClasses->{$rule->[0]}))
		{ $characterClasses->{$rule->[0]} .= $rule->[1]; }
	elsif ($rule->[0] eq "base" and defined ($characterClasses->{$rule->[1]}))
		{ $characterClasses->{$rule->[1]} .= $rule->[2]; }
		} # hcaerof
foreach my $class (sort keys %$characterClasses)
	{
	next if ($class eq 'digit');
	$characterClasses->{$class} =~ s/"/\\"/g;
	printf ("_br_%s = \"%s\";\n", $class, $characterClasses->{$class});
	} # hcaerof
print ("\n");

# Braille case table
my ($upper, $lower) = ('', '');
foreach my $rule (@rules)
	{
	if ($rule->[0] eq "base" and $rule->[1] eq "uppercase")
		{ $upper .= $rule->[2]; $lower .= $rule->[3]; }
	} # hcaerof
printf ("braille_case_table = [[\"%s\"], [\"%s\"]];\n\n", $upper, $lower);

# Braille characters table
my @lines = ();
foreach my $rule (@rules)
	{
	if (defined ($characterClasses->{$rule->[0]}) and not ($rule->[0] eq 'digit' or $rule->[0] eq 'noletsignafter'))
		{
		my $char = $rule->[1];
		$char = '\"' if $char eq '"';
		my $dots = &cannonize_dot_list ($rule->[2]);
		my $line = sprintf ("[\"%s\", %s]", $char, $dots);
		push (@lines, $line);
		}
	} # hcaerof
printf ("braille_char_table = [\n  %s\n  ];\n\n", join (",\n  ", @lines));

# Braille rules table
@lines = ();
foreach my $rule (@rules)
	{
	next if ($rule->[0] eq "base" and $rule->[1] eq "uppercase");
	next if (defined ($characterClasses->{$rule->[0]}));
	my $line = &sprint_rule (@$rule);
push (@lines, $line);
	} # hcaerof
printf ("braille_table = [\n %s\n  ];\n", join (",\n  ", @lines));
printf ("// EOF");
# EOF