Paste number 2571: beatnik interpreter

Paste number 2571: beatnik interpreter
Pasted by: toby
When:14 years, 2 months ago
Share:Tweet this! | http://paste.lisp.org/+1ZF
Channel:#opendarwin
Paste contents:
Raw Source | XML | Display As
#!/usr/bin/env perl -w
#
# beatnik.pl
# (c) 2004, Toby Peterson <toby@opendarwin.org>
#
# This is a simple 'Beatnik' interpreter. For more information, see:
# http://www.cliff.biffle.org/esoterica/beatnik.html
#

use strict;

my %tile_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 );

my @words;

while (<>) {
	push @words, split /[^A-Za-z]+/;
}

my @stack = ();
my $push_next = 0;
my $skip_next = 0;
my $tmp1;
my $tmp2;

my $i = -1;
while (++$i <= $#words) {
	my $score = 0;
	foreach (split "", $words[$i]) {
		$score += $tile_scores{lc $_};
	}

	if ($push_next) {
		push @stack, $score;
		$push_next = 0;
		next;
	}

	if ($skip_next) {
		$i += $skip_next * $score;
		$skip_next = 0;
		next;
	}

	if ($score == 5) {
		$push_next = 1;
	} elsif ($score == 6) {
		pop @stack;
	} elsif ($score == 7) {
		$tmp1 = pop @stack;
		$tmp2 = pop @stack;
		push @stack, $tmp1 + $tmp2;
	} elsif ($score == 8) {
		print ":";
		$tmp1 = getc;
		push @stack, ord($tmp1);
	} elsif ($score == 9) {
		$tmp1 = pop @stack;
		print chr($tmp1);
	} elsif ($score == 10) {
		$tmp1 = pop @stack;
		$tmp2 = pop @stack;
		push @stack, $tmp2 - $tmp1;
	} elsif ($score == 11) {
		$tmp1 = pop @stack;
		$tmp2 = pop @stack;
		push @stack, $tmp1;
		push @stack, $tmp2;
	} elsif ($score == 12) {
		$tmp1 = pop @stack;
		push @stack, $tmp1;
		push @stack, $tmp1;
	} elsif ($score == 13) {
		$tmp1 = pop @stack;
		if ($tmp1 == 0) {
			$skip_next = 1;
		}
	} elsif ($score == 14) {
		$tmp1 = pop @stack;
		if ($tmp1 != 0) {
			$skip_next = 1;
		}
	} elsif ($score == 15) {
		$tmp1 = pop @stack;
		if ($tmp1 == 0) {
			$skip_next = -1;
		}
	} elsif ($score == 16) {
		$tmp1 = pop @stack;
		if ($tmp1 != 0) {
			$skip_next = -1;
		}
	} elsif ($score == 17) {
		last;
	}
}

print "\n";

This paste has no annotations.

Colorize as:
Show Line Numbers

Lisppaste pastes can be made by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively.