Version 18 of Bitmap Editor

Updated 2013-07-30 09:41:54 by uniquename

For other editors of bitmaps, including those useful as .ico Windows icons, see this [L1 ] April 2004 thread, which covers an interesting mix of shareware, Tk-based freeware, ...

See also bme.


Keith Vetter 2002-01-16 : here's a simple utility that lets you create and edit tk bitmap files.

I've written simplified versions of this code at least twice before, so when I found this particular version on my hard drive I thought I'd polish up and put it on wiki so that I, and others, can find it again in the future.

It's not as fancy as Paul Obermeier's poBitmap tool but then again, it's less than 1/25 the size.

KPV 2003-03-06 : added some editing functions like shift, invert, clear and best of all, resize.

HJG 2012-04-21 : changed file-extension from .bmp to .bm, to avoid confusing imageviewers. Added hotkeys F1..F8, version-number, set name before saving, demo-bitmap 16x16.

HJG 2012-04-22 : Tiled preview 2x2 for bitmaps upto 32x32. It would be nice to also have a 3x3 display, but I don't see how to get the size of the bitmap at that part of the program.


 #!/bin/sh
 # The next line is executed by /bin/sh, but not tcl \
 exec wish $0 ${1+"$@"}

 ##+##########################################################################
 #
 # bitmap.tcl -- simple bitmap editor
 # by Keith Vetter
 #
 # Revisions:
 # KPV  2003-01-15  1.00 : initial revision
 # KPV  2003-03-06  1.01 : added functions like shift, clear, invert and resize
 # HJG  2012-04-21  1.10 : .bmp --> .bm, F1,F2,F3, F5-F8, new bitmap 16x16
 # HJG  2012-04-22  1.11 : Tiled preview: 2x2
 #
 ##+##########################################################################

 package require Tk

 set S(cell) 10
 set S(prog) "Bitmap Editor"
 set S(vers) "1.11"
 set S(fname) ""

 array set bits { 0 0000 1 1000 2 0100 3 1100 4 0010 5 1010 6 0110 7 1110
                  8 0001 9 1001 a 0101 b 1101 c 0011 d 1011 e 0111 f 1111}

 set bitmap {
    #define     bm_width  16
    #define     bm_height 16
    static char bm_bits = {
        0x0f, 0xf0, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80,
        0xc0, 0x03, 0x20, 0x04, 0x10, 0x08, 0x90, 0x09,
        0x90, 0x09, 0x10, 0x08, 0x20, 0x04, 0xc0, 0x03,
        0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x0f, 0xf0
    }
 }

 set bitmap1 {
    #define     tcl_width 10
    #define     tcl_height 8
    static char tcl_bits = {
        0x00, 0x00, 0x9f, 0x00, 0x84, 0x00, 0xb4, 0x00,
        0x94, 0x00, 0x94, 0x00, 0xb4, 0x03, 0x00, 0x00
    }
 }

 set bitmap0 {
    #define     bullet_width  11
    #define     bullet_height  9
    static char bullet_bits[] = {
        0x00,0x00, 0x00,0x00, 0x70,0x00, 0xf8,0x00, 0xf8,0x00,
        0xf8,0x00, 0x70,0x00, 0x00,0x00, 0x00,0x00
    }
 }

 ##+##########################################################################
 #
 # DoDisplay -- sets up our display
 #
 proc DoDisplay {} {
    wm title . "$::S(prog) $::S(vers)"
    canvas .c -width 500 -height 500 -bd 2 -relief ridge -highlightthickness 0
    .c xview moveto 0 ; .c yview moveto 0

    bind .c <2> [bind Text <2>]                 ;# Enable button 2 paning
    bind .c <B2-Motion> [bind Text <B2-Motion>]

    bind . <F1>  {About}
    bind . <F2>  {SaveBMP}
    bind . <F3>  {OpenBMP}

    bind . <F5>  {BitFunc sleft}
    bind . <F6>  {BitFunc sright}
    bind . <F7>  {BitFunc sup}
    bind . <F8>  {BitFunc sdown}

    frame .fctrl -bd 2 -relief ridge
    label .info -text "Left button to set    Right button to clear    F5-F8 shift image"\
        -anchor c  -bd 2  -relief ridge

    grid .c .fctrl -sticky news -row 0
    grid .info   ^ -sticky ew
    grid rowconfigure    . 0 -weight 1
    grid columnconfigure . 0 -weight 1

    DoControl
    DoMenus
    update
 }

 ##+##########################################################################
 #
 # DoMenus -- sets up our menus
 #
 proc DoMenus {} {
    . configure -menu [menu .m -tearoff 0]
    .m add cascade -menu [menu .m.file  -tearoff 0] -label "File"  -underline 0
    .m add cascade -menu [menu .m.image -tearoff 0] -label "Image" -underline 0
    .m add cascade -menu [menu .m.help  -tearoff 0] -label "Help"  -underline 0

    .m.file add command -label "New"  -under 0 -command NewBMP
    .m.file add command -label "Open" -under 0 -command OpenBMP
    .m.file add command -label "Save" -under 0 -command SaveBMP
    .m.file add separator
    .m.file add command -label "Copy" -under 0 -command CopyBMP
    .m.file add separator
    .m.file add command -label Exit -under 1 -command exit

    .m.image add command -label "Clear"       -under 0 -command {BitFunc clear}
    .m.image add command -label "Invert"      -under 0 -command {BitFunc invert}
    .m.image add separator
    .m.image add command -label "Shift left"  -under 6 -command {BitFunc sleft}
    .m.image add command -label "Shift right" -under 6 -command {BitFunc sright}
    .m.image add command -label "Shift up"    -under 6 -command {BitFunc sup}
    .m.image add command -label "Shift down"  -under 6 -command {BitFunc sdown}
    .m.image add separator
    .m.image add command -label "Resize"      -under 0 -command ResizeBMP

    .m.help add command -label About -under 0 -command About
 }

 ##+##########################################################################
 #
 # DoControl -- draws the control panel
 #
 proc DoControl {} {
    grid rowconfigure .fctrl   0 -minsize 10
    grid rowconfigure .fctrl 100 -weight 1

    frame .fctop
    grid  .fctop - - -in .fctrl -row 1
    set row 0
    foreach a {Name Width Height} {
        set a2 [string map {" " ""} [string tolower $a]]
        label .l$a2 -text "$a:"
        entry .e$a2 -textvariable BM($a2) -width 8 -state readonly
        grid .l$a2 .e$a2 -in .fctop -row [incr row]
    }

    image create bitmap ::img::current
    frame .fimg -bd 2 -relief sunken -padx 10 -pady 10
    label .limg -image ::img::current -bg white

 ## grid rowconfigure .fctrl 40 -minsize 50
    grid rowconfigure .fctrl 35 -minsize 50
    grid .fimg - - -in .fctrl -row 41
    pack .limg -in .fimg -expand 1

  # Tiled preview 2x2:  (ToDo: adjust size ??)
    frame .fimg2 -bd 2 -relief sunken -padx 0 -pady 0
    grid  .fimg2 - - -in .fctrl -row 81

    canvas .pv -width 65  -height 65  -bg yellow        ;# for size 32x32
    grid   .pv -in .fimg2

   .pv create image  34 34 -image ::img::current  -anchor nw 
   .pv create image  34 34 -image ::img::current  -anchor ne 
   .pv create image  34 34 -image ::img::current  -anchor sw 
   .pv create image  34 34 -image ::img::current  -anchor se 

 # ??
 # catch {console show}
 # set w [.limg cget -width ]
 # set h [.limg cget -height]
 # puts "$w x $h / $a2 BM($a2) $BM($a2) / BM: $::BM(width) x $::BM(height)"
 }

 ##+##########################################################################
 #
 # ShowBMP -- computes grid size then draws in the current bitmap
 #
 proc ShowBMP {} {
    global S BM

    if {! [info exists BM(raw)]} return

    set w  [winfo width .c] ; set h [winfo height .c]
    set cw [expr {int((($w - 20) / $BM(width)))}]
    set ch [expr {int((($h - 20) / $BM(height)))}]
    set S(cell) [expr {$cw < $ch ? $cw : $ch}]
    if {$S(cell) > 40} { set S(cell) 40}
    if {$S(cell) <  5} { set S(cell) 5}

    DrawGrid
    ShowBits
    unset BM(bits)
    ::img::current config -data $BM(raw)        ;# Update current bitmap display
 }

 ##+##########################################################################
 #
 # ClearBMP -- clears everything for a new bitmap
 #
 proc ClearBMP {} {
    global BM
    .c delete all
    ::img::current config -data {}
    array unset BM
    foreach arr [array names BM] { set BM($arr) ""}
    update
 }

 ##+##########################################################################
 #
 # DrawGrid -- draws the grid of rectangles--each one with proper bindings
 #
 proc DrawGrid {} {
    global BM

    .c delete all
    foreach {l t} [CellXY 0 0] break
    foreach {b r} [CellXY $BM(height) $BM(width)] break
    .c create rect $l $t $b $r -tag outline -width 2

    set bg [.c cget -bg]
    for {set r 0} {$r < $BM(height)} {incr r} {
        for {set c 0} {$c < $BM(width)} {incr c} {
            .c create rect [CellXY $r $c] -tag [list grid c($r,$c)] -fill $bg
            .c bind c($r,$c) <1> [list Click 1 cell $r $c]
            .c bind c($r,$c) <3> [list Click 2 cell $r $c]
        }
    }
    .c config -scrollregion [.c bbox all]
 }

 ##+##########################################################################
 #
 # Click -- handles left and right mouse click in a grid cell
 #
 proc Click {btn what row col} {
    global BM
    if {$btn == 1} {                            ;# Set the pixel
        if {$BM(b,$row,$col)} return            ;# Already set
        set BM(b,$row,$col) 1
        ShowBitCell $row $col
    } else {                                    ;# Clear the pixel
        if {! $BM(b,$row,$col)} return          ;# Already cleared
        set BM(b,$row,$col) 0
        .c delete o($row,$col)
    }
    set BM(raw) [UnparseBMP]
    ::img::current config -data $BM(raw)
 }

 ##+##########################################################################
 #
 # ShowBits -- draws dots in all "on" cells in the current bitmap,
 # only valid after ParseBMP fills in the BM(bits) variable.
 #
 proc ShowBits {} {
    global BM bits

    set row 0
    set col 0
    foreach byte $BM(bits) {
        foreach {n1 n2} [split $byte ""] break  ;# Get each nibble
        foreach bit [split "$bits($n2)$bits($n1)" ""] { ;# Note the endian
            set BM(b,$row,$col) $bit
            if {$bit} {
                ShowBitCell $row $col
            }
            if {[incr col] >= $BM(width)} {     ;# Do we past the last column?
                incr row
                set col 0
                break
            }
        }
    }
 }

 ##+##########################################################################
 #
 # ShowBitCell -- draws the "on" bit in a specified cell
 #
 proc ShowBitCell {row col} {
    .c create oval [CellXY $row $col] -fill black -tag [list bit o($row,$col)]
    .c bind o($row,$col) <1> [list Click 1 oval $row $col]
    .c bind o($row,$col) <3> [list Click 2 oval $row $col]
 }

 ##+##########################################################################
 #
 # CellXY -- returns the coordinates of a grid cell
 #
 proc CellXY {r c} {
    global S
    set x1 [expr {10 + $c * $S(cell)}]
    set y1 [expr {10 + $r * $S(cell)}]
    set x2 [expr {$x1 + $S(cell)}]
    set y2 [expr {$y1 + $S(cell)}]

    return [list $x1 $y1 $x2 $y2]
 }

 ##+##########################################################################
 #
 # ParseBMP -- reads the raw bitmap data into our BM data structure
 # NB. face.bmp in demo directory had defines for x_hot and y_hot
 #
 proc ParseBMP {raw} {
    global S BM

    ClearBMP
    set BM(raw) $raw

    while {1} {
        if {! [regexp {\#define\s+(.*)_width}        $raw => BM(name)]}   break
        if {! [regexp {\#define\s+.*_width\s*(\d*)}  $raw => BM(width)]}  break
        if {! [regexp {\#define\s+.*_height\s*(\d*)} $raw => BM(height)]} break
        regexp {\#define\s+.*_x_hot\s*(\d*)}  $raw => BM(xhot)
        regexp {\#define\s+.*_y_hot\s*(\d*)}  $raw => BM(yhot)

        if {! [regexp {(0x.*)\}}                     $raw => BM(bits)]} break
        if {! [regsub -all {0x|,} $BM(bits) { }              BM(bits)]} break
        if {! [regsub -all {\s+}  $BM(bits) { }              BM(bits)]} break
        set BM(bits) [string tolower $BM(bits)]
        return                                  ;# Everything ok, get out
    }
    ERROR "$S(fname) is not a proper bmp file"
    ClearBMP
 }

 ##+##########################################################################
 #
 # OpenBMP -- opens and reads a BMP file.
 # This is actually a textfile, so contents cannot be shown with imageviewers.
 # Format: see "bitmap" at top of program.
 #
 proc OpenBMP {} {
    global S

    set types { {{BM Files} {.bm}} {{All Files} * }}
    set fname [tk_getOpenFile -defaultextension ".bm" -initialfile $S(fname) \
                   -filetypes $types]
    if {$fname == ""} return
    if {[catch {set FIN [open $fname r]} emsg]} {
        ERROR "Cannot open $fname\n$emsg"
        return
    }
    set raw [read $FIN]
    close $FIN
    set S(fname) $fname
    ParseBMP $raw
    ShowBMP
 }

 ##+##########################################################################
 #
 # SaveBMP -- saves the current bitmap to a file
 #
 proc SaveBMP {} {
    global S BM

    if {! [info exists BM(raw)]} return

    set S(fname) $BM(name)
    set types {{{BM Files} {.bm}} {{All Files} *}}
    set fname [tk_getSaveFile -defaultextension ".bm" -initialfile $S(fname) \
                   -filetypes $types]
    if {$fname == ""} return
    if {[catch {set FOUT [open $fname w]} emsg]} {
        ERROR "Cannot open $fname\n$emsg"
        return
    }
    puts $FOUT $BM(raw)
    close $FOUT
    set S(fname) $fname
 }

 ##+##########################################################################
 #
 # UnparseBMP -- converts our internal BM into a proper bitmap data string
 #
 proc UnparseBMP {} {
    global BM
    set name $BM(name)

    set    bmp "\#define ${name}_width $BM(width)\n"
    append bmp "\#define ${name}_height $BM(height)\n"
    if {[info exists BM(xhot)]} {
        append bmp "\#define ${name}_x_hot $BM(xhot)\n"
        append bmp "\#define ${name}_y_hot $BM(yhot)\n"
    }
    append bmp "static char ${name}_bits[] = \{\n"

    set bytes {}
    for {set r 0} {$r < $BM(height)} {incr r} {
        for {set c 0} {$c < $BM(width)} {incr c 8} {
            set byte 0
            for {set cc [expr {$c + 7}]} {$cc >= $c} {incr cc -1} {
                set byte [expr {2 * $byte}]
                if {[info exists BM(b,$r,$cc)] && $BM(b,$r,$cc)} {
                    incr byte
                }
            }
            lappend bytes [format 0x%02x $byte]
        }
    }
    append bmp "    " [join $bytes ", "]
    append bmp "\n\}"

    return $bmp
 }

 ##+##########################################################################
 #
 # CopyBMP -- copies current bitmap to the clipboard
 #
 proc CopyBMP {} {
    global BM S

    if {! [info exists BM(raw)]} return

    clipboard clear
    clipboard append $BM(raw)

    tk_messageBox -icon info -title "$S(prog) Info" \
        -message "Bitmap copied to the clipboard"

 }

 ##+##########################################################################
 #
 # NewBMP -- creates a blank, new bitmap with sizes specified by the user
 #
 proc NewBMP {} {
    global BM

    set n [NewDlg]
    if {$n == {}} return
    foreach {name width height} $n break

    ClearBMP
    set BM(name)   $name
    set BM(width)  $width
    set BM(height) $height

    for {set r 0} {$r < $BM(height)} {incr r} {
        for {set c 0} {$c < $BM(width)} {incr c} {
            set BM(b,$r,$c) 0
        }
    }
    ParseBMP [UnparseBMP]
    ShowBMP
 }

 proc ResizeBMP {} {
    global BMP
    set n [NewDlg 1]
    if {$n == {}} return

    foreach {. nwidth nheight} $n break
    WidenBMP $nwidth
    HeightenBMP $nheight

    ParseBMP [UnparseBMP]
    ShowBMP
 }

 proc WidenBMP {nwidth} {
    global BM
    if {$BM(width) == $nwidth} return

    if {$nwidth > $BM(width)} {
        foreach {low high delete} [list $BM(width) $nwidth 0] break
    } else {
        foreach {low high delete} [list $nwidth $BM(width) 1] break
    }
    for {set row 0} {$row < $BM(height)} {incr row} {
        for {set col $low} {$col < $high} {incr col} {
            set BM(b,$row,$col) 0
            if {$delete} {
                unset BM(b,$row,$col)
            }
        }
    }
    set BM(width) $nwidth
 }

 proc HeightenBMP {nheight} {
    global BM
    if {$BM(height) == $nheight} return

    if {$nheight > $BM(height)} {
        foreach {low high delete} [list $BM(height) $nheight 0] break
    } else {
        foreach {low high delete} [list $nheight $BM(height) 1] break
    }
    for {set col 0} {$col < $BM(width)} {incr col} {
        for {set row $low} {$row < $high} {incr row} {
            set BM(b,$row,$col) 0
            if {$delete} {
                unset BM(b,$row,$col)
            }
        }
    }
    set BM(height) $nheight
 }

 ##+##########################################################################
 #
 # NewDlg -- asks the user for bitmap parameters
 #
 proc NewDlg {{resize 0}} {
    global S NEW BM

    destroy  .new
    toplevel .new -padx 10 -pady 5
    wm title .new "New Bitmap"
    if {$resize} {wm title .new "Resize Bitmap"}
    wm geom .new "+[expr {[winfo x .] + 150}]+[expr {[winfo y .] + 100}]"

    set NEW(ok) 0
    set NEW(width)  $BM(width)
    set NEW(height) $BM(height)

    frame .new.top -bd 2 -relief raised -padx 10 -pady 10
    grid columnconfigure .new.top 1 -weight 1
    set widgets {name width height}
    if {$resize} {
        set NEW(name) "xx"
        set widgets {width height}
    }
    foreach a $widgets {
        set a1 [string totitle $a]
        label .new.l$a -text "$a1:"
        entry .new.e$a -textvariable NEW($a)
        grid  .new.l$a .new.e$a -in .new.top -sticky ew
    }

    frame  .new.buttons
    button .new.ok     -text Ok     -width 10 -command ValidForm
    button .new.cancel -text Cancel -width 10 -command {destroy .new}

    pack .new.buttons -side bottom -pady 10
    pack .new.top     -side top    -fill x
    pack .new.cancel .new.ok -in .new.buttons -side right -padx 10 -expand 1

    raise .new
    set w ".new.e[lindex $widgets 0]"
    focus $w
    $w icursor end
    $w selection range 0 end
    tkwait window .new
    if {$NEW(ok)} {
        return [list $NEW(name) $NEW(width) $NEW(height)]
    }
    return {}
 }

 ##+##########################################################################
 #
 # ValidForm -- validates the NewDlg and then destroys it if it is ok
 #
 proc ValidForm {} {
    global NEW

    foreach n {name width height} {
        set NEW($n) [string trim $NEW($n)]
        if {$NEW($n) == ""} return
    }
    if {![string is integer $NEW(width)]}  return
    if {![string is integer $NEW(height)]} return

    set NEW(ok) 1
    destroy .new
 }

 proc ERROR {msg} {
    tk_messageBox -icon error -title "$::S(prog) Error" -message $msg
 }

 proc About {} {
    set msg "$::S(prog) $::S(vers)\n\nby Keith Vetter\nJanuary 2003-2012"
    tk_messageBox -title "About $::S(prog)" -message $msg -icon info
 }

 proc BitFunc {what} {
    global BM

    if {$what == "clear"} {
        foreach arr [array names BM b,*] {
            set BM($arr) 0
        }
    } elseif {$what == "invert"} {
        foreach arr [array names BM b,*] {
            set BM($arr) [expr {! $BM($arr)}]
        }
    } elseif {$what == "sleft"} {               ;# Shift left
        for {set col 0} {$col < $BM(width)} {incr col} {
            set col2 [expr {$col + 1}]
            for {set row 0} {$row < $BM(height)} {incr row} {
                if {[info exists BM(b,$row,$col2)]} {
                    set BM(b,$row,$col) $BM(b,$row,$col2)
                } else {
                    set BM(b,$row,$col) 0
                }
            }
        }
    } elseif {$what == "sright"} {              ;# Shift right
        for {set col [expr {$BM(width) - 1}]} {$col >= 0} {incr col -1} {
            set col2 [expr {$col - 1}]
            for {set row 0} {$row < $BM(height)} {incr row} {
                if {[info exists BM(b,$row,$col2)]} {
                    set BM(b,$row,$col) $BM(b,$row,$col2)
                } else {
                    set BM(b,$row,$col) 0
                }
            }
        }
    } elseif {$what == "sup"} {                 ;# Shift up
        for {set row 0} {$row < $BM(height)} {incr row} {
            set row2 [expr {$row + 1}]
            for {set col 0} {$col < $BM(width)} {incr col} {
                if {[info exists BM(b,$row2,$col)]} {
                    set BM(b,$row,$col) $BM(b,$row2,$col)
                } else {
                    set BM(b,$row,$col) 0
                }
            }
        }
    } elseif {$what == "sdown"} {               ;# Shift down
        for {set row [expr {$BM(height) - 1}]} {$row >= 0} {incr row -1} {
            set row2 [expr {$row - 1}]
            for {set col 0} {$col < $BM(width)} {incr col} {
                if {[info exists BM(b,$row2,$col)]} {
                    set BM(b,$row,$col) $BM(b,$row2,$col)
                } else {
                    set BM(b,$row,$col) 0
                }
            }
        }
    }
    set BM(raw) [UnparseBMP]
    RedrawBits
    ::img::current config -data $BM(raw)

 }

 proc RedrawBits {} {
    global BM

    .c delete bit
    for {set row 0} {$row < $BM(height)} {incr row} {
        for {set col 0} {$col < $BM(width)} {incr col} {
            if {$BM(b,$row,$col)} {ShowBitCell $row $col}
        }
    }
 }

 ################################################################

 DoDisplay
 ParseBMP $bitmap
 ShowBMP

 focus -force .

 #.

Screenshots Section

Bitmap Editor Screenshot

http://farm5.static.flickr.com/4122/4824086923_6d4ee771ca.jpg

gold added pix

HJG 2012-04-20 Broken link: [L2 ]. It would be nice to have a summary of that "April 2004 thread".


uniquename 2013jul29

The image above is hosted at a 'flickr' site. In case that image goes dead (which seems to be the norm for images stored at 'external' sites), here is a 'locally stored' image.

vetter_bitmapEditor_wiki6298_screenshot_592x468.jpg

(Thanks to 'gnome-screenshot', 'mtpaint', and ImageMagick 'convert' on Linux for, respectively, capturing the screen in a PNG file, cropping the image, and converting the PNG file to a JPEG file about 10% the size of the resulting PNG file. Thanks to FOSS developers everywhere --- including Linux kernel and Gnu developers. I used the 'mv' command and the ImageMagick 'identify' command in a shell script to easily rename the cropped image file to contain the image dimensions in pixels.)

This code may be useful as a model for Tclers who need to make a grid on a canvas and put canvas objects within boxes of the grid.