view release on metacpan or  search on metacpan

Beatnik.pm  view on Meta::CPAN

package Acme::Beatnik;

use Filter::Simple;
use strict;
use vars qw($VERSION $ip @stack @numbers %reftable %scrabble $debug);

$debug = 0;

%reftable = 
 (5, \&_push,
  6, \&_pop,
  7, \&_add,
  8, \&_input,
  9, \&_output,
  10, \&_subtract,
  11, \&_swap,
  12, \&_duplicate,

Beatnik.pm  view on Meta::CPAN

  17, \&_halt
 );

%scrabble = 
('A',1,'B',3,'C',3,'D',2,'E',1,'F',4,'G',2,'H',4,'I',1,'J',8,'K',5,'L',1,'M',3,'N',1,'O',1,'P',3,'Q',10,'R',1,'S',1,'T',1,'U',1,'V',4,'W',4,'X',8,'Y',4,'Z',10);

$VERSION = '0.02';

sub _push
{ $ip++;
  print "pushing $numbers[$ip]\n" if $debug;
  push(@stack,$numbers[$ip]);
}

sub _pop
{ my $foo = pop @stack;
  print "popping $foo\n" if $debug;
  return $foo;
}

sub _add
{ my($first,$second) = (pop @stack,pop @stack);
  my $sum = $first + $second;
  push(@stack,$sum);
  print "adding $first and $second and pushing $sum on stack \n" if $debug;
}

sub _input
{ print "accepting user input and pushing onto stack\n" if $debug;
  push(@stack,ord(getc));
}

sub _output
{ my $foo = pop @stack;
  print "outputting ",chr($foo),"\n" if $debug;
  print(chr($foo));
}

sub _subtract
{ my ($first,$second) = (pop @stack,pop @stack);
  my $diff = $first - $second;
  print "subtraction $first and $second and pushing $diff on stack\n" if $debug;
  push(@stack,$diff)
}

sub _swap
{ my $a = pop(@stack);
  my $b = pop(@stack);
  print "swapping $a and $b\n"if $debug;
  push(@stack,$a,$b);
}

sub _duplicate
{ print "duplicating $stack[$#stack]\n" if $debug;
  push(@stack,$stack[$#stack]);
}

sub _jump_forward_if_zero
{ my $n = pop(@stack);
  $ip++;
  if($n == 0)
  { $ip += $numbers[$ip]; print "jump $n words forward\n" if $debug; }
}

sub _jump_forward_if_not_zero
{ my $n = pop(@stack);
  $ip++;
  if($n != 0)
  { $ip += $numbers[$ip]; print "jump $n words forward\n" if $debug; }
}

sub _jump_back_if_zero
{ my $n = pop(@stack);
  $ip++;
  if($n == 0) { $ip -= $numbers[$ip]; print "jump $n words backward\n" if $debug; }
}

sub _jump_back_if_not_zero
{ my $n = pop(@stack);
  $ip++;
  if($n != 0) { $ip -= $numbers[$ip]; print "jump $n words backward\n" if $debug; }
}
 
sub _halt
{ $ip = $#numbers+1;
  print "halting...\n" if $debug;
  exit;
}

FILTER
{ $_ =~ s/[^\w\s]//g;
  my @words = split(/\s+/,$_);
  for my $word (@words)
  { my $number = 0;
    for(split(//,$word))
    { $number += $scrabble{uc $_}; }