git @ Cat's Eye Technologies N-DCNC / master src / n-dcnc.pl
master

Tree @master (Download .tar.gz)

n-dcnc.pl @masterraw · history · blame

#!/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);