[Keith Vetter] 2009-07-27 : Back in the late 70's I
remember at the Chicago Science Museum getting
my picture taken and having it printed just using various text
characters. I thought it was really
cool.
I recently had some free time so I decided to recreate that
technology. It works by tiling the image and mapping
the average brightness of each tile into a text
character. The size of the tile is controlled by the
resolution parameter.
One problem is that all my images are large
and the resulting ASCII image is huge. To (partially) handle this
you can have the image first shrunken, via the subsample
parameter, before converting to ASCII. It's better to
use dedicated image software to better shrink and crop the
image.
----
[WikiDbImage TkAsciiArt.png]
----
[Jeff Smith] 2021-04-19 : Below is an online demo using [CloudTk]. This demo runs "TkAsciiArt" in an Alpine Linux Docker Container. It is a 20.7MB image which is made up of Alpine Linux + tclkit + TkAsciiArt.kit + libx11 + libxft + fontconfig + font-ibm-type1. It is run under a user account in the Container. The Container is restrictive with permissions for "Other" removed for "execute" and "read" for certain directories.
<<inlinehtml>>
<iframe height="800" width="800" src="https://cloudtk-app.tcl-lang.org/cloudtk/VNC?session=new&Tk=TkAsciiArt" allowfullscreen></iframe>
<<inlinehtml>>
----
======
##+##########################################################################
#
# 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
======
<<categories>>Category Graphics