EXCON Parser and Encoder

#!/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 $i out of range 0-255" }
    return [format %c $i ]
}

proc asc2bin char {
    if { ![binary scan $char B* bcode] } {
        error "asc2bin:Cannot convert $char to binary."
    }
    return $bcode
}

proc arraybits { array } {
    set bits {}
    array set ar $array

    for {set i 0} {$i < 8} {incr i} {
        append bits $ar($i)
    }

    return $bits
}

proc ascii2excon { char } {
    set binary_code [asc2bin $char]
    set excon [bits2excon $binary_code]

    return $excon
}

# From my old script.
proc excon2ascii { 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.
                    set int [bits2int $bits]
                    return [asc $int]
                }
                {<} {
                     # move needle
                     set needle [expr "$needle - 1"]
                }
            }
        }
    }

}

proc bits2excon { binary_code } {
    # ex. 01010000 we save the instructions and set one to flip.

    # initialize the buffer.
    for {set i 0} {$i < 8} {incr i} {
        set ar($i) 0
    }

    # resets the pool.
    set instructions {:}
    if { [string eq [arraybits [array get ar]] $binary_code] } {
        append instructions {!}
        return $instructions
    }

    set i 7
    while {$i >= 0} {
        set ref [string index $binary_code $i]
        if { [string eq $ref $ar($i)] } {
            # move needle
            append instructions {<}
            set i [expr $i - 1]

        } else {
            # flip bit
            append instructions {^}
            set ar($i) 1
            if { [string eq [arraybits [array get ar]] $binary_code] } {
                # the strings are equal, output buffer and bail out.
                append instructions {!}
                return $instructions
            } else {
                # we flipped and it didn't match, so move needle.
                append instructions {<}
                set i [expr $i - 1]
            }
        }
    }

    # output buffer and exit.
    append instructions {!}
    return $instructions
}

proc unit_test {} {
    set code {abc#def}
    set codelen [string length $code]
    for {set i 0} {$i < $codelen} {incr i} {
        set char [string index $code $i]
        set binary_code [asc2bin $char]

        # sanity check for conversion code.
        set int_code [bits2int $binary_code]
        set ascii_char [asc $int_code]

        puts "$char : $binary_code | $int_code | $ascii_char"

        set excon [bits2excon $binary_code]

        # sanity check for excon output
        # char must be the same as excon2ascii output
        # excon must be the same as ascii2excon
        puts "$char | $binary_code : $excon | [excon2ascii $excon] | [ascii2excon $char]"
    }
}

proc welcome_msg { } {
    puts "Welcome to the EXCON parser/encoder."
    puts "============================================"
    puts "Default parameter is a unit test check.."
    puts "Params: script \[filepath\] \[action\]"
    puts "action: e - encode | p - parse | eq - encode quietly."
}

set unit_test 0
if { $argc != 2 } {
    welcome_msg
    # no parameter
    # default to binary
    puts "Running unit test."
    set unit_test 1
} else {
    set filepath [lindex $argv 0]
    set action [lindex $argv 1]

    if { [string eq $action {e}] || [string eq $action {p}] } {
        welcome_msg
        puts "Params Found: $filepath $action"
        set unit_test 0
    } elseif { [string eq $action {eq}] } {
        set unit_test 0
    } else {
        puts "Unknown parameters: Running unit test"
        set unit_test 1
    }
}

if { $unit_test } {
    unit_test
} else {
    if { ![file isfile $filepath] } {
        puts "No file exists."
        exit
    }

    # encode reads ascii and encodes into excon.
    set encode [expr "[string eq $action {e}] || [string eq $action {eq}]"]
    # parses excon and outputs ascii.
    set parse [string eq $action {p}]

    # read file of instructions
    set fp [open $filepath r]

    append converted {}
    # read per line.
    while { [gets $fp line] != -1 } {
        set filelinelen [string length $line]
        if { $encode } {
            # we have to parse per ascii and save the excon instructions.
            for { set i 0 } {$i < $filelinelen} {incr i} {
                set char [string index $line $i]
                set excon [ascii2excon $char]
                append converted $excon
            }

            # At the end of the line, we must slap a newline.
            append converted "[ascii2excon "\n"]"
        } elseif { $parse } {
            # we split the excon by :
            set excon_instructions [split $line {:}]
            foreach instruction $excon_instructions {
                set excon ":${instruction}"
                append converted [excon2ascii $excon]
            }
        }
    }

    close $fp

    # print out the converted output.
    puts $converted
}