Acme-Beatnik

 view release on metacpan or  search on metacpan

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 $_}; }

Beatnik.pm  view on Meta::CPAN

programming language.

=head1 INSTRUCTION TABLE

Beatnik has the following word values linked to the instructions.

  5   Push the next word value onto stack
  6   Pop the first value from stack
  7   Add the two topmost values from stack and push the result on stack
  8   Read a character from input and push the ASCII value on stack
  9   Read the first value from stack and print the character value
  10  Subtract the two topmost values from stack and push the result back on stack
  11  Swap the two topmost values from stack
  12  Duplicate the first value from stack and push it onto stack
  13  Move the Instruction Pointer X values forward if the first value on stack is zero (X being the next word value)
  14  Move the Instruction Pointer X values forward if the first value on stack is not zero (X being the next word value)
  15  Move the Instruction Pointer X values backward if the first value on stack is zero (X being the next word value)
  16  Move the Instruction Pointer X values backward if the first value on stack is not zero (X being the next word value)
  17  Halt the program

=head1 ENGLISH TILESET

example.pl  view on Meta::CPAN

irate Lesbians Adrian roles millipedes bald suds writing Maine logo appending
scars turns McLanahan erosion stile submariner bliss Connors lung opulent barns
pen eats assails rods premises trims grit alacrity acute con tar
orgies suds scram Oscar Tulsa Ainu Erastus dues art rolled rests
seeder boats reuse used gauge nouns typo entrust renal swirl stature
lead bleacher utensil dean rugs plain pun grated flit spider tries
lowland gangs Sam ampere arousal slits one rosy lids sear outruns
Orion accuracy fed dots fashions realm Silas truants orients tells brightens
Tamil onset lacking ink Ilona gentry cilia reals our drum blabs
alien leer borne lures McClellan tooled alter beehive blare aster hard
stadia Solon rend gentle deus acronyms stouter Odin Fauntleroy print risen
stun burst Euler doghouse Coors eerie too deep Elton in bode
Serpens replacement

findwords.pl  view on Meta::CPAN

my %scrabble_scores = 
('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);

open(BEATNIK,"<$ARGV[0]") || die $!;
while($word = <BEATNIK>)
{ $number = 0;
  for(split(//,$word)) 
  { $number += $scrabble_scores{uc $_}; }
  print "$number = $word";
}
 
close(BEATNIK);

generate.pl  view on Meta::CPAN

    } else
    { $_ -= $number;
      push(@values,5); #Push number on stack
      push(@values,$number);
      $foo += $number;
      push(@values,7);
    }
  }
  push(@values,9); #mark end of word
}
print $foo[0],"\n";
for(@values) { print $_,"\n"; }
open(FILE,"<words.txt") || die $!; 
#Assume wordlist is in words.txt
#Format : 5 = Foo
while(<FILE>)
{ chomp $_;
  my ($value,$word) = split(/ = /,$_);
  $words{$word} = $value;
}
close(FILE);
my $i;
for my $n (@values)
{ $i++;
  my @words = grep { $words{$_} == $n } keys %words;
  if ($n != 1) { print $words[int rand($#words)] , " " ; }
  else { print "a"; } #There are no words in the table with value 1, so assume 'a'
  if ($i > 10) { $i = 0; print "\n"; }
}