#!/usr/local/bin/perl -w
# 'n-dcnc.pl - a 'N-DCNC to PortableFalse compiler in Perl
# v2000.08.12 Chris Pressey, Cat's Eye Technologies
# http://www.catseye.mb.ca/
$token = '';
sub scan
{
exit(0) if not read(STDIN, $token, 1);
}
sub top
{
return $_[$#_];
}
# print 'D';
print '[\b:a:b;[a;!b;/]?b;~[0]?]d:';
print "\n";
print '[b:a:0c:[a;0>][c;b;!+c:a;1-a:]#c;]e:';
print "\n";
scan();
push @back, 'Out';
push @stack, 0;
e:
if (top(@stack) > 5)
{
if ($token eq '@')
{
scan();
push @back, 'Nest';
push @stack, 0;
goto e;
Nest:
scan();
}
elsif ($token =~ /^[AJQK23456789]$/)
{
$token = 1 if $token eq 'A';
$token = 10 if $token eq 'J';
$token = 11 if $token eq 'Q';
$token = 12 if $token eq 'K';
print "$token ";
scan();
}
elsif ($token eq '`')
{
scan();
print "$token;";
scan();
}
else
{
print $token;
scan();
}
} else
{
push @back, 'LHS';
push @stack, top(@stack)+1;
goto e;
LHS:
if($token eq chr(top(@stack)+ord('*')))
{
if(top(@stack) == 0) { print '['; }
if(top(@stack) == 5) { print '['; }
scan();
push @back, 'RHS';
push @stack, top(@stack)+1;
goto e;
RHS:
print ']e;!' if top(@stack) == 0;
print '+' if top(@stack) == 1;
print '%,0' if top(@stack) == 2;
print '-' if top(@stack) == 3;
print '$c:\:c;' if top(@stack) == 4;
print ']d;!' if top(@stack) == 5;
goto LHS;
}
}
pop @stack;
my $b = pop @back;
goto LHS if $b eq 'LHS';
goto RHS if $b eq 'RHS';
goto Nest if $b eq 'Nest';
Out:
print '%';
exit(0);