#!/bin/sh
# the next line restarts using tclsh \
exec wish "$0" "$@"

if {$argc != 1} {
    puts "syntax: vis <RNA-file>"
    exit
}

set f [open [lindex $argv 0]] ; set data [read $f] ; close $f
puts "read [string length $data] bytes"

set transparentBitmap {}

# init transparent bitmap
set line {}
for {set x 0} {$x < 600} {incr x} { lappend line {0 0 0 0} }
for {set y 0} {$y < 600} {incr y} { lappend transparentBitmap $line }

set bucket {} ; set position {0 0} ; set mark {0 0} ; set dir E
set bitmaps [list $transparentBitmap]

proc addColor {col} {
    global bucket
    set bucket [linsert $bucket 0 $col]
}

proc currentPixel {} {
    global bucket
    set rc 0 ; set gc 0 ; set bc 0 ; set ac 0
    set num_r 0 ; set num_t 0

    foreach b $bucket {
        # puts "b: $b"
        if {[lindex $b 0] == "c"} {
            incr rc [lindex $b 1] ; incr gc [lindex $b 2]
            incr bc [lindex $b 3] ; incr num_r
        } elseif {[lindex $b 0] == "t"} {
            # transparency
            incr num_t ; incr ac [lindex $b 1]
        } else {
            puts "unknow object in bucket: $b"
        }
    }

    if {$num_r > 0} {
        set rc [expr {$rc / $num_r}]; set gc [expr {$gc / $num_r}]
        set bc [expr {$bc / $num_r}]
    }

    set ac [expr { $num_t > 0 ? ($ac/$num_t) : 255 }]

    return [list [expr {int(floor($rc*$ac/255))}] \
                [expr {int(floor($gc*$ac/255))}] \
                [expr {int(floor($bc*$ac/255))}] $ac]
}


proc move {pos d} {
    set x [lindex $pos 0] ; set y [lindex $pos 1]
    if {$d == "N"} { return [list $x [expr {(($y-1+2*600)) % 600}]] }
    if {$d == "E"} { return [list [expr {(($x+1)+2*600)%600}] $y] }
    if {$d == "S"} { return [list $x [expr {(($y+1+2*600)) % 600}]] }
    if {$d == "W"} { return [list [expr {(($x-1)+2*600)%600}] $y] }
    puts "move: unknown direction $d"
}

proc turnCounterClockwise {d} {
    if {$d == "N"} { return "W" }
    if {$d == "E"} { return "N" }
    if {$d == "S"} { return "E" }
    if {$d == "W"} { return "S" }
    puts "turnCounterClockwise: unknown direction $d"
}

proc turnClockwise {d} {
    if {$d == "N"} { return "E" }
    if {$d == "E"} { return "S" }
    if {$d == "S"} { return "W" }
    if {$d == "W"} { return "N" }
    puts "turnClockwise: unknown direction $d"
}

proc getPixel {p} {
    global bitmaps
    return [lindex $bitmaps 0 [lindex $p 1] [lindex $p 0]]
}

proc setPixel {x y} {
    global bitmaps
    set p [currentPixel] 
    set col [format #%02x%02x%02x [lindex $p 0] [lindex $p 1] [lindex $p 2]]
    lset bitmaps 0 $y $x $p
    im put $col -to $x $y
    # put "update" here for more finely grained animation
}

proc update_gui {} {
    global bitmaps
    for {set x 0} {$x < 600} {incr x} {
        for {set y 0} {$y < 600} {incr y} {
            set p [lindex $bitmaps 0 $y $x]
            set f [format #%02x%02x%02x [lindex $p 0] [lindex $p 1] [lindex $p 2]]
            im put $f -to $x $y
        }
    }
    update
}

proc line {p0 p1} {
    set x0 [lindex $p0 0] ; set y0 [lindex $p0 1]
    set x1 [lindex $p1 0] ; set y1 [lindex $p1 1]
    set deltax [expr {$x1 - $x0}] ; set deltay [expr {$y1 - $y0}]
    set d [expr {abs($deltax) > abs($deltay) ? abs($deltax) : abs($deltay)}]
    set c [expr {$deltax*$deltay <= 0 ? 1 : 0}]
    set x [expr {$x0*$d + int(floor(($d-$c)/2))}]
    set y [expr {$y0*$d + int(floor(($d-$c)/2))}]
    for {set i 0} {$i < $d} {incr i} {
        setPixel [expr {int(floor($x/$d))}] [expr {int(floor($y/$d))}]
        incr x $deltax ; incr y $deltay
    }
    setPixel $x1 $y1
    update
}

proc tryfill {} {
    global position
    set new [currentPixel] ; set old [getPixel $position]
    if {$new != $old} { fill $position $old }
}

proc fill {pos initial} {
    array set visited {}
    for {set x 0} {$x < 600} {incr x} {
        for {set y 0} {$y < 600} {incr y} { set visited($x-$y) 0 }
    }

    set fill_list [list $pos]

    while {[llength $fill_list]} {
        set p [lindex $fill_list 0]
        set fill_list [lreplace $fill_list 0 0]
        set x [lindex $p 0] ; set y [lindex $p 1]
        if {$visited($x-$y)} { continue }
        set visited($x-$y) 1

        if {[getPixel $p] == $initial} {
            setPixel $x $y
            if {$x > 0}   { lappend fill_list "[expr {$x-1}] $y" }
            if {$x < 599 && !$visited([expr {$x+1}]-$y)} {
                lappend fill_list "[expr {$x+1}] $y"
            }
            if {$y > 0 && !$visited($x-[expr {$y-1}])} {
                lappend fill_list "$x [expr {$y-1}]"
            }
            if {$y < 599 && !$visited($x-[expr {$y+1}])} {
                lappend fill_list "$x [expr {$y+1}]"
            }
        }
    }
    update
}


proc compose {} {
    global bitmaps
    if {[llength $bitmaps] >= 2} {
        for {set y 0} {$y < 600} {incr y} {
            for {set x 0} {$x < 600} {incr x} {
                set p0 [lindex $bitmaps 0 $y $x]
                set p1 [lindex $bitmaps 1 $y $x]
                set r0 [lindex $p0 0] ; set g0 [lindex $p0 1]
                set b0 [lindex $p0 2] ; set a0 [lindex $p0 3]
                set r1 [lindex $p1 0] ; set g1 [lindex $p1 1]
                set b1 [lindex $p1 2] ; set a1 [lindex $p1 3]
                set r2 [expr {$r0 + int(floor($r1*(255-$a0)/255))}]
                set g2 [expr {$g0 + int(floor($g1*(255-$a0)/255))}]
                set b2 [expr {$b0 + int(floor($b1*(255-$a0)/255))}]
                set a2 [expr {$a0 + int(floor($a1*(255-$a0)/255))}]
                lset bitmaps 1 $y $x [list $r2 $g2 $b2 $a2]
            }
        }
       set bitmaps [lreplace $bitmaps 0 0]
    }
    update_gui
}

proc clip {} {
    puts "clip called"
    if {[llength $bitmaps] >= 2} {
        for {set x 0} {$x < 600} {incr x} {
            for {set y 0} {$y < 600} {incr y} {
                set p0 [lindex $bitmaps 0 $y $x]
                set p1 [lindex $bitmaps 1 $y $x]
                set r0 [lindex $p0 0] ; set g0 [lindex $p0 1]
                set b0 [lindex $p0 2] ; set a0 [lindex $p0 3]
                set r1 [lindex $p1 0] ; set g1 [lindex $p1 1]
                set b1 [lindex $p1 2] ; set a1 [lindex $p1 3]
                set r2 [expr {int(floor($r1*$a0/255))}]
                set g2 [expr {int(floor($g1*$a0/255))}]
                set b2 [expr {int(floor($b1*$a0/255))}]
                set a2 [expr {int(floor($a1*$a0/255))}]
                lset bitmaps 1 $y $x [list $r2 $g2 $b2 $a2]
            }
        }
        set bitmaps [lreplace $bitmaps 0 0]
    }
    update_gui
}

proc build {} {
    global bucket position mark dir bitmaps transparentBitmap data
    set n_instr 0
    while {1} {
        incr n_instr
        set r [string range $data 0 6]
        if {[string length $r] < 7} { break }
        puts "instr. #$n_instr: $r"
        if {[string equal $r "PIPIIIC"]} { addColor {c 0 0 0}
        } elseif {[string equal $r "PIPIIIP"]} { addColor {c 255 0 0}
        } elseif {[string equal $r "PIPIICC"]} { addColor {c 0 255 0}
        } elseif {[string equal $r "PIPIICF"]} { addColor {c 255 255 0}
        } elseif {[string equal $r "PIPIICP"]} { addColor {c 0 0 255}
        } elseif {[string equal $r "PIPIIFC"]} { addColor {c 255 0 255}
        } elseif {[string equal $r "PIPIIFF"]} { addColor {c 0 255 255}
        } elseif {[string equal $r "PIPIIPC"]} { addColor {c 255 255 255}
        } elseif {[string equal $r "PIPIIPF"]} { addColor {t 0}
        } elseif {[string equal $r "PIPIIPP"]} { addColor {t 255}
        } elseif {[string equal $r "PIIPICP"]} { set bucket {}
        } elseif {[string equal $r "PIIIIIP"]} {
            set position [move $position $dir]
        } elseif {[string equal $r "PCCCCCP"]} {
            set dir [turnCounterClockwise $dir]
        } elseif {[string equal $r "PFFFFFP"]} { set dir [turnClockwise $dir]
        } elseif {[string equal $r "PCCIFFP"]} { set mark $position
        } elseif {[string equal $r "PFFICCP"]} { line $position $mark
        } elseif {[string equal $r "PIIPIIP"]} { tryfill
        } elseif {[string equal $r "PCCPFFP"]} {
            if {[llength $bitmaps] < 10} {
                set bitmaps [linsert $bitmaps 0 $transparentBitmap]
            }
        } elseif {[string equal $r "PFFPCCP"]} { compose
        } elseif {[string equal $r "PFFICCF"]} { clip
        } else { puts "unknown command: $r" }
        set data [string replace $data 0 6]
    }
}

image create photo im
pack [canvas .c -width 620 -height 620 -bd 5 -relief ridge] -padx 5 -pady 5
.c create image 10 10 -image im -anchor nw
im put black -to 0 0 599 599
update

build
puts "done"