##+##########################################################################
#
# TkAsciiArt -- convert image into text
# by Keith Vetter, July 2009
#

package require Tk 8.5
package require Img

# Maps from brightness 0-100 to an ASCII character
set asciiMap {
    10 \# 17 @ 24 & 31 $ 38 % 45 | 52 !
    59 ; 66 : 73 ' 80 ` 87 . 999 " "
}
# Size of tile corresponding to one ASCII character
set R [dict create UltraLow 8 Low 6 Normal 3 High 2 UltraHigh 1]

array set S {title "tkAsciiArt" thumbHeight 200}
array set A {width 0 height 0
    imgName img2.jpg resolution Normal fontSize 4 drawn -
    subsample None
    size,org "?x?" size,sub "?x?" size,ascii "?x?" size,final "?x?"
}


catch {font delete myFont}
font create myFont -family courier -size 4
image create bitmap ::img::star2 -data {
    #define plus_width  7
    #define plus_height 7
    static char plus_bits[] = {
        0x49, 0x2a, 0x1c, 0x7f, 0x1c, 0x2a, 0x49}
}

proc DoDisplay {} {
    wm geom . +5+5
    ::ttk::frame .ctrl -pad {.1i .1i 0 0}
    ::ttk::frame .left
    ::ttk::frame .right
    ::ttk::frame .img
    pack .ctrl -side bottom -fill x
    pack .left -in .ctrl -side left -fill y
    pack .right -in .ctrl -side left -fill both -expand 1
    pack .img -side top -fill both -expand 1

    set fontHeight [font metrics myFont -linespace]
    set h [expr {([winfo screenheight .] - 300) / $fontHeight}]
    set fontWidth [font measure myFont "m"]
    set w [expr {int(([winfo screenwidth .] * .8) / $fontWidth)}]

    set h [expr {min(133,$h)}]
    set w [expr {min(260,$w)}]

    ::ttk::scrollbar .sb_y -command {.t yview} -orient vertical
    ::ttk::scrollbar .sb_x -command {.t xview} -orient horizontal
    text .t -font myFont -width $w -height $h -wrap none \
        -yscroll {.sb_y set} -xscroll {.sb_x set}

    grid .t .sb_y -in .img -sticky news
    grid .sb_x -in .img -sticky ew
    grid columnconfigure .img 0 -weight 1
    grid rowconfigure .img 0 -weight 1

    ::ttk::label .left.lname -text "Image"
    ::ttk::entry .left.ename -textvariable ::A(imgName)
    ::ttk::button .left.getname -image ::img::star2 -command GetFile
    ::ttk::label .left.orgsize -textvariable ::A(size,org) -anchor c

    ::ttk::label .left.lsub -text "Subsample"
    ::ttk::combobox .left.sub -textvariable ::A(subsample) \
        -state readonly -values {None 2 3 4 5 10 15 20} -exportselection 0
    bind .left.sub <<ComboboxSelected>> GetSize
    ::ttk::label .left.subsize -textvariable ::A(size,sub) -anchor c

    ::ttk::label .left.lresolution -text "Resolution"
    ::ttk::combobox .left.resolution -textvariable ::A(resolution) \
        -state readonly -values [dict keys $::R] -exportselection 0
    bind .left.resolution <<ComboboxSelected>> GetSize
    ::ttk::label .left.asciisize -textvariable ::A(size,ascii) -anchor c

    ::ttk::label .left.lfsize -text "Font size"
    ::ttk::combobox .left.fsize -textvariable ::A(fontSize) \
        -state readonly -values {1 2 3 4 5 6 7 8 9 10 11 12} -exportselection 0
    ::ttk::label .left.finalsize -textvariable ::A(size,final) -anchor c

    ::ttk::button .left.go -text Go -command Go
    ::ttk::button .left.about -text About -command About

    image create photo ::img::thumb -height 100 -width 100
    ::ttk::label .right.thumb -image ::img::thumb -relief ridge

    grid .left.lname .left.ename .left.getname .left.orgsize -sticky ew
    grid .left.lsub .left.sub - .left.subsize -sticky ew
    grid .left.lresolution .left.resolution - .left.asciisize -sticky ew
    grid .left.lfsize .left.fsize - .left.finalsize -sticky ew
    grid .left.go - - .left.about -pady .1i
    pack .right.thumb -fill both -expand 1 -side left
    grid config .right.thumb -padx {.25i 0}
    update idletasks
    wm geom . [wm geom .]
    bind all <F2> {console show}
}
proc About {} {
    set msg "$::S(title)\nby Keith Vetter\nJuly 2009\n\n"
    append msg "$::S(title) converts an image file into ASCII\n"
    append msg "text by tiling the image and mapping the\n"
    append msg "average brightness of each tile to a text\n"
    append msg "character.\n\n"

    append msg "The Resolution parameter controls the tile size.\n"
    append msg "The Subsample parameter lets you shrink the\n"
    append msg "image before converting (to better handle large\n"
    append msg "digital photographs)."

    tk_messageBox -title "About $::S(title)" -message $msg

}
proc GetSize {} {
    global A

    set w $A(width)
    set h $A(height)
    set A(size,org) [MakeSize $w $h]
    set sub [expr {$A(subsample) eq "None" ? 1 : $A(subsample)}]
    set w1 [expr {$w/$sub}]
    set h1 [expr {$h/$sub}]
    set A(size,sub) [MakeSize $w1 $h1]

    set xStep [dict get $::R $A(resolution)]
    set xStop [expr {$w1 / $xStep}]
    set yStep [expr {$xStep * 2}]
    set yStop [expr {$h1 / $yStep}]
    set A(size,ascii) [MakeSize $xStop $yStop]

    set w3 [font measure myFont [string repeat "x" $xStop]]
    set h3 [expr {[font metric myFont -linespace] * $yStop}]
    set A(size,final) [MakeSize $w3 $h3]
}
proc MakeSize {w h} {
    return [Comma $w]x[Comma $h]
}
proc Comma { num } {
    while {[regsub {^([-+]?[0-9]+)([0-9][0-9][0-9])} $num {\1,\2} num]} {}
    return $num
}
proc ToASCII {iname subsample resolution W} {
    global h yStart w xStart y yPixel x xPixel
    global imgWidth imgHeight xStep yStep xStop yStop
    global sumBrightness sb bb

    if {$subsample != 1} {
        image create photo ::img::tmp -file $iname
        image create photo ::img::ascii
        ::img::ascii copy ::img::tmp -subsample $subsample $subsample
        image delete ::img::tmp
    } else {
        image create photo ::img::ascii -file $iname
    }
    set imgWidth [image width ::img::ascii]
    set imgHeight [image height ::img::ascii]

    set xStep [dict get $::R $resolution]
    set xStop [expr {$imgWidth / $xStep}]
    set yStep [expr {$xStep * 2}]
    set yStop [expr {$imgHeight / $yStep}]

    wm title . "$::S(title) :: $iname $resolution"
    $W delete 0.0 end
    for {set h 0} {$h < $yStop} {incr h} {
        set yStart [expr {$h * $yStep}]
        set line ""

        for {set w 0} {$w < $xStop} {incr w} {
            set xStart [expr {$w * $xStep}]

            set sumBrightness 0
            for {set y 0} {$y < $yStep} {incr y} {
                set yPixel [expr {$y + $yStart}]
                for {set x 0} {$x < $xStep} {incr x} {
                    set xPixel [expr {$x + $xStart}]
                    lassign [::img::ascii get $xPixel $yPixel] r g b
                    set b [expr {max($r,$g,$b)}]
                    set b2 [expr {$b * 100 / 255}]
                    incr sumBrightness $b2
                }
            }

            set sb [expr {double($sumBrightness)/$xStep/$yStep}]
            foreach {val char} $::asciiMap {
                if {$sb < $val} break
            }
            append line $char
        }
        append line "\n"
        #puts "$h/$yStop"
        $W insert end $line
        $W see end
        update
    }
    set ::A(drawn) $iname:$subsample:$resolution
    image delete ::img::ascii
    .t see 1.0
}
proc Go {} {
    set sub [expr {$::A(subsample) eq "None" ? 1 : $::A(subsample)}]
    set id $::A(imgName):$sub:$::A(resolution)
    set toDraw [expr {$id ne $::A(drawn)}]
    if {$toDraw} { .t delete 0.0 end }
    font config myFont -size $::A(fontSize)
    if {$toDraw} {
        ToASCII $::A(imgName) $sub $::A(resolution) .t
    }
}
proc GetFile {} {
    set types {
        {"All Image Files" {.gif .jpg .png .tiff .bmp .ico .ppm}}
        {"GIF" .gif}
        {"JPEG" .jpg}
        {"PNG" .png}
        {"TIFF" .tiff}
        {"BMP" .bmp}
        {"ICO" .ico}
        {"PPM" .ppm}
        {"All files" *.*}
    }
    set fname [tk_getOpenFile -title "$::S(title) Get Image" -filetypes $types \
                   -typevariable ::A(filter) \
                   -initialdir [file dirname $::A(imgName)]]
    if {$fname ne ""} {
        set ::A(imgName) $fname
        GetThumb
        GetSize
    }
}
proc GetThumb {} {
    set n [catch {image create photo ::img::tmp -file $::A(imgName)}]
    if {$n} return
    set w [image width ::img::tmp]
    set h [image height ::img::tmp]
    set dr [expr {int(ceil(double($h) / $::S(thumbHeight)))}]
    image delete ::img::thumb
    image create photo ::img::thumb
    ::img::thumb copy ::img::tmp -subsample $dr $dr
    image delete ::img::tmp
    .right.thumb config -image ::img::thumb
    set ::A(width) $w
    set ::A(height) $h
}


DoDisplay

# Demo with the teapot image from ActiveState distribution
set teapotImg [file join $tk_library demos images teapot.ppm]
if {[file exists $teapotImg]} {
    set ::A(imgName) $teapotImg
    set ::A(resolution) "UltraHigh"
    GetThumb
    GetSize
    Go
}
return