Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #!/usr/bin/tclsh
- # http://esolangs.org/wiki/EXCON
- # http://www2.tcl.tk/1591
- proc bits2int {bits} {
- #returns integer equivalent of a bitlist
- set bits [format %032s [join $bits {}]]
- binary scan [binary format B* $bits] I1 x
- set x
- }
- # http://www.cab.u-szeged.hu/local/doc/tcl/Fragments.html#AscIntConv
- proc asc i {
- if { $i<0 || $i>255 } { error "asc:Integer out of range 0-255" }
- return [format %c $i ]
- }
- set printf {}
- puts "Welcome to the Quick and Dirty \"Hello World!\" EXCON parser."
- puts "============================================"
- puts "Default output is Binary."
- puts "Type in 'int' for integer and 'ascii' for string."
- if { $argc != 1 } {
- # no parameter
- # default to binary
- puts "Defaulting to binary print."
- set printf {b}
- } else {
- set param [lindex $argv 0]
- if { [string eq $param {int}] } {
- puts "Printing as integer."
- set printf {i}
- } elseif { [string eq $param {ascii}] } {
- puts "Printing as ASCII."
- set printf {c}
- } else {
- puts "Unknown parameter. Defaulting to binary."
- set printf {b}
- }
- }
- #H
- lappend code {:<<<^<<<^!}
- #e
- lappend code {:^<<^<<<^<^!}
- #l
- lappend code {:<<^<^<<^<^!}
- #l
- lappend code {!}
- #o
- lappend code {:^<^<^<^<<^<^!}
- # space
- lappend code {:<<<<<^!}
- #W
- lappend code {:^<^<^<<^<<^!}
- #o
- lappend code {:^<^<^<^<<^<^!}
- #r
- lappend code {:<^<<<^<^<^!}
- #l
- lappend code {:<<^<^<<^<^!}
- #d
- lappend code {:<<^<<<^<^!}
- # bang
- lappend code {:^<<<<<^!}
- # Clear buffer
- for {set i 0} {$i < 8} {incr i} {
- set ar($i) 0
- }
- set llen [llength $code]
- # Loop through instructions.
- for {set ctr 0} {$ctr < $llen} {incr ctr} {
- set target [lindex $code $ctr]
- set len [string length $target]
- set needle 7
- for {set i 0} {$i < $len} {incr i} {
- set char [string index $target $i]
- switch $char {
- {:} {
- #reset the buffer. do nothing.
- set reset 0
- for {set j 0} {$j < 8} {incr j} {
- set ar($j) 0
- }
- }
- {^} {
- #flips the bit of the needle.
- set ar($needle) 1
- }
- {!} {
- set bits {}
- for {set j 0} {$j < 8} {incr j} {
- append bits $ar($j)
- }
- # output.
- if { [string eq $printf {i}] } {
- puts [bits2int $bits]
- } elseif { [string eq $printf {c}] } {
- set int [bits2int $bits]
- puts [asc $int]
- } else {
- puts $bits
- }
- }
- {<} {
- # move needle
- set needle [expr "$needle - 1"]
- }
- }
- }
- }
- puts "Finished processing."
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement