Updated 2013-01-20 08:52:58 by pooryorick

RHS Beatnik is an amusing little language based on the concept of commands being based on what the scrabble score for the words in the source would be.

From the main (only) beatnik page [1]:

Beatnik is a very simple language to learn: it has a small set of commands, a very relaxed syntax, and you can find a reference to its vocabulary at any toy store. A Beatnik program consists of any sequence of English words, separated by any sort of punctuation from spaces to hyphens to blank pages. Thus, "Hello, aunts! Swim around brains!" is a valid Beatnik program, despite not making much sense. (If you're wondering, that reads a character from the user, adds seven to it [i.e. A -> H], and prints it out.) The function of a particular word--say, brains, or aunts--is determined by the score one would receive for playing that word in Scrabble. Thus, "hello" gets us 8 points, and so on.

Note that the sample programs on his webpage seem to use different letter values than the english version of scrabble, so do not work with ny implementation of the language (or the emacs version).

RHS A beatnik interpreter written in tcl. Can take beatnik source from a filename or stdin:
#!/bin/sh
# This line continues for Tcl, but is a single line for 'sh' \
    exec tclsh8.5 "$0" ${1+"[email protected]"}

proc log {args} {}

interp alias {} = {} expr

array set values {
    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
}

proc peek {&stack} {
    upvar ${&stack} stack
    lindex $stack end
}       
proc push {&stack value} {
    upvar ${&stack} stack
    lappend stack $value
}
proc pop {&stack} {
    upvar ${&stack} stack
    set value [lindex $stack end]
    set stack [lrange $stack 0 end-1]
    return $value
}

proc score {word} {
    set score 0
    foreach letter [split [string toupper $word] {}] {
        incr score $::values($letter)
    }
    return $score
}

proc doScore {&stack scores index} {
    upvar ${&stack} stack

    set score [lindex $scores $index]
    log "Handling index $index : $score ($stack)"

    if { (![string is integer -strict $score]) || $score <0 } {
        error "invalid score $score"
    }

    set step 1

    switch -exact -- $score {
        0 - 1 - 2 - 3 - 4 {
            # Does nothing. The Beatnik Interpreter may mock you 
            # for your poor scoring, at its discretion.
        }
        5 {
            # Finds the score of the next word and pushes it onto the stack.
            # Skips the aforementioned next word.
            push stack [lindex $scores [= $index + 1]]
            set step 2
        }
        6 {
            # Pops the top number off the stack and discards it.
            pop stack
        }
        7 {
            # Adds the top two values on the stack together
            # (as described above)
            push stack [= [pop stack] + [pop stack]]
        }
        8 {
            # Input a character from the user and push its value on
            # the stack. Waits for a keypress.
            push stack [scan [gets stdin] %c]
        }
        9 {
            # Pop a number off the stack and output the corresponding
            # ASCII character to the screen.
            puts -nonewline [format %c [pop stack]]
        }
        10 {
            # Subtract the top value on the stack from the next value
            # on the stack, pushing the result.
            set x [pop stack]
            set y [pop stack]            
            push stack [= $y - $x]
        }
        11 {
            # Swap the top two values on the stack.
            set x [pop stack]
            set y [pop stack]
            push stack $x
            push stack $y
        }
        12 {
            # Duplicate the top value.
            push stack [peek stack]
        }
        13 {
            # Pop a number from the stack, and figure out the score of
            # the next word. If the number from the stack is zero,
            # skip ahead by n words, where n is the score of the next word.
            # (The skipping is actually n+1 words, because the word scored
            # to give us n is also skipped.
            set value [pop stack]
            set nextScore [lindex $scores [= $index + 1]]
            if { ! $value } {
                set step [= 2 + $nextScore]
            }
        }
        14 {
            # Same as above, except skip if the value on the stack isn't zero.
            set value [pop stack]
            set nextScore [lindex $scores [= $index + 1]]
            if { $value } {
                set step [= 2 + $nextScore]
            }
        }
        15 {
            # Skip back n words, if the value on the stack is zero.
            set value [pop stack]
            set nextScore [lindex $scores [= $index + 1]]
            if { ! $value } {
                set step [= 0 - $nextScore]
            }
        }
        16 {
            # Skip back if it's not zero.
            set value [pop stack]
            set nextScore [lindex $scores [= $index + 1]]
            if { $value } {
                set step [= 0 - $nextScore]
            }
        }
        17 {
            # Stop the program.
            return -code return
        }
        18 - 19 - 20 - 21 - 22 - 23 {
            # Does nothing. However, the score is high enough that
            # the Beatnik Interpreter will not mock you, unless it's
            # had a really bad day.
        }
        default {
            # Garners "Beatnik applause" for the programmer. This
            # generally consists of reserved finger-snapping.
        }
    }

    return $step
}

proc main {script} {
    set stack {}
    set scores {}

    set words [regexp -all -inline {\m\w+\M} $script]
    foreach word $words {
        set score [score $word]
        #log "$word = $score"
        lappend scores [score $word]
    }
    log $scores
    for {set i 0} {$i < [llength $scores]} {} {
        incr i [doScore stack $scores $i]
    }
}

proc readfile {argv} {
    switch -exact -- [llength $argv] {
        0 {
            set fd stdin
        }
        1 {
            set fd [open [lindex $argv 0] r]
        }
        default {
            puts -stdout "Usage: [file tail [info script]] ?filename?"
            exit
        }
    }

    set text [read $fd]
    if { ![string equal $fd stdin] } {
        close $fd
    }

    return $text
}

if { [string equal [file normalize $argv0] [file normalize [info script]]] } {
    fconfigure stdout -buffering none
    fconfigure stdin -buffering none
    
    set commands [readfile $argv]
    main $commands
    
    puts ""
}

And, the standard Hello World program (stolen from the emacs Beatnik mode):
bet you comments secret

this file prints "Hello World!". 
It really does! (said me)
Comments allowed
See http://zaaf.nl/emacs/beatnik.html for the interpreter used.

Edit here 
    we have reasons, 
but whether mouse droppin' are holding up schools, feel if I want
letters.

Regardless of truth, agents are abandonin' units again. 

Print between lines are separate works.

  load sequentially, include users explicitly. Later and evil can me over! (antinormal)
Does I says?
Dust duchess schools foolings. My, my, is iceleaf over genius imposed. Can Neo have decided systems?
But free flips become lines between continued stops. Start gets made standard.

Help! Old world skool really stink (really!) Prerent third closest
from weird deletion.  

Interestingly!