## A brainfucked interpreter for the Brainfuck language. This is very
## useful as you can type Brainfuck directly into the Tcl interpreter.
## Author: Kristoffer Lawson, setok@fishpool.com
## More info: http://cydathria.com/bf/brainfuck.html

package provide brainfuck 1.0


proc bfInit {} {
    global bfMem bfPtrIndex bfPrevRead
    # Create brainfuck environment
    for {set i 0} {$i < 30000} {incr i} {
	set bfMem($i) 0
    }
    set bfPtrIndex 0
    # Any old data left from a call to [gets] and not yet handled.
    set bfPrevRead ""
}


catch {rename unknown unknown.orig}
catch {rename history history.orig}


## Override the history command to preparse the command.

proc history args {
    global valueStack

    set valueStack [list]

    if {([llength $args]>1) && ([lindex $args 0] == "add")} {
	set cmd [lindex $args 1]
	# Catch add sub-command and check if its brainfuck code.
	if {[string match "\[\#+-<>\\\[.,\]*" $cmd]} {
	    lappend valueStack [bfEval $cmd]
	} else {
	    # Parse through code to find brainfuck code inside brackets.
	    set insideCurly 0
	    set bracketData ""
	    set bfMode 0
	    set checkForBF 0
	    foreach char [split $cmd ""] {
		if {$bfMode} {
		    if {$char == "\["} {
			incr bfMode
			append bracketData $char
		    } elseif {$char == "\]"} {
			incr bfMode -1
			if {! $bfMode} {
			    lappend valueStack [bfEval $bracketData]
			    set bracketData ""
			} else {
			    append bracketData $char
			}
		    } else {
			append bracketData $char
		    }
		} elseif {$checkForBF && [string match "\[\#+-<>.," $char]} {
		    set checkForBF 0
		    set bfMode 1
		    append bracketData $char
		} elseif {(! $insideCurly) && ($char == "\[")} {
		    set checkForBF 1
		} elseif {$char == "\{"} {
		    incr insideCurly
		} elseif {$char == "\}"} {
		    incr insideCurly -1
		}
	    }
	}
    }
	
    eval history.orig $args
}

	
proc unknown {cmd args} {
    global valueStack

    if {[string match "\[\#+-<>\\\[.,\]*" $cmd]} {
	set r [lindex $valueStack end]
	set valueStack [lrange $valueStack 0 end-1]
	return $r
    } else {
	eval unknown.orig $cmd $args
    }
    
}


## Interpret a brainfuck script. 
## 'level' is the stack level to interpret the script at (see uplevel).
## If it is "0" then a new brainfuck environment is created for this 
## evaluation. Otherwise one is used at a higher stack level.

proc bfEval {bfScript} {
    upvar #0 bfPtrIndex pI
    upvar #0 bfPrevRead prevRead
    global bfMem

    # Whether to build a Brainfuck script or execute commands.
    set collectScript 0

    foreach code [split $bfScript ""] {
	if {$collectScript} {
	    if {$code == "\]"} {
		incr collectScript -1
		if {!$collectScript} {
		    while {$bfMem($pI)} {
			bfEval $subScript
		    }
		}
	    } elseif {$code == "\["} {
		incr collectScript
	    } else {
		append subScript $code
	    }
	    continue
	}		    
	
	switch -- $code {
	    > {
		incr pI
	    }
	    < {
		incr pI -1
	    }
	    + {
		incr bfMem($pI)
	    }
	    - {
		incr bfMem($pI) -1
	    }
	    . {
		puts -nonewline [format "%c" $bfMem($pI)]
	    }
	    , {		
		if {$prevRead == ""} {
		    set prevRead [gets stdin]
		    if {![eof stdin]} {
			append prevRead "\n"
		    }
		}
		if {$prevRead == ""} {
		    set bfMem($pI) 0
		} else {
		    set bfMem($pI) [scan [string index $prevRead 0] "%c"]
		    set prevRead [string range $prevRead 1 end]
		}
	    }
	    \# {
		for {set i 0} {$i < 10} {incr i} {
		    puts $bfMem($i)
		}
		puts "-----------"
	    }    
	    \[ {
		set subScript ""
		incr collectScript 1
	    }
	    default {}
	}
    }

    return $bfMem($pI)
}

bfInit