Updated 2016-05-23 05:20:32 by kpv

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.

Stu 2015-04-20 The changes made by HJG were done to an older version than the bitmap editor included in TkLib.

KPV 2016-05-22 : spent some time merging the forked code which Stu noticed. Most notable is that you can stroke lines with the mouse instead of toggling individual pixels. Also added a menu option to choose between 2x2, 3x3 or 4x4 preview like HJG wanted.

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

See also bme.

uniquename 2013jul29
 ##+##########################################################################
#
# bitmap.tcl -- simple bitmap editor
# by Keith Vetter (http://wiki.tcl.tk/606)
#
# Revisions:
# KPV Jan 15, 2003 - initial revision
# KPV Mar 06, 2003 - added functions like shift, clear, invert and resize
# KPV Aug 20, 2010 - added mouse stroking, cursor, rename and undo
# 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
# KPV May 13, 2016 - merged tklib version with wiki version; added undo for shift

# Syntax: bitmap-editor ?xbm-file?

package require Tcl 8.4
package require Tk

# Data Structures :: 3 global arrays.
#
# S - Application state and configuration
#
# * cell    - Size of a pixel cel drawn in the UI
# * tileSize - NxN size for tiled preview
# * prog    - Application name
# * version - Application version
# * fname   - xbm file currently edited, after loaded/saved

# BM - Bitmap currently being edited.
#
# * b,<row>,<col> - UI cell storage - pixel is set if exists and 1.
# * bits          - XBM Parse Result: hexadecimal bit string of pixels.
# * height        - XBM Parse Result: bitmap height
# * name          - XBM Parse Result: bitmap name
# * raw           - xbm data of the bitmap, suitable for use with option
#                   -data of a Tk bitmap image. Generated from the b,*,*
#                   keys. See UnparseBMP.
# * width         - XBM Parse Result: bitmap width
# * xhot          - XBM Parse Result: column of the hot point
# * yhot          - XBM Parse Result: row of the hot point

# UNDO - Undo information
#
#  * current - current action
#  * all  - all previous actions

set S(cell) 10
set S(prog) "Bitmap Editor"
set S(version) 1.2
set S(fname) ""
set S(tileSize) 2
set UNDO(current) {}
set UNDO(all) {}

# Table for conversion from hexadecimal nibbles to binary bit
# strings. Used to convert BM(bits) to b,*,* keys in UnpackBits.
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
}

# Initial bitmap to show upon starting.
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 bitmap_tcl {
    #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 bitmap_bullet {
    #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(version)"
    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>]

    set button_3 [expr {$::tcl_platform(os) eq "Darwin" ? "2" : "3"}]
    bind .c <1> [list Click down ON %x %y]
    bind .c <B1-Motion> [list Click move ON %x %y]
    bind .c <ButtonRelease-1> [list Click up ON %x %y]
    bind .c <${button_3}> [list Click down OFF %x %y]
    bind .c <B${button_3}-Motion> [list Click move OFF %x %y]
    bind .c <ButtonRelease-${button_3}> [list Click up OFF %x %y]
    bind all <Control-z> Undo

    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" -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 "2x2 Preview" -under 0 -command {ShowTiledPreview 2}
    .m.file add command -label "3x3 Preview" -under 1 -command {ShowTiledPreview 3}
    .m.file add command -label "4x4 Preview" -under 2 -command {ShowTiledPreview 4}
    .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 "Undo"        -under 0 -command Undo
    .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:"
        label .e$a2 -textvariable BM($a2) -width 8 -bd 2 -relief sunken
        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

    frame .f_tiled -bd 2 -relief sunken -padx 10 -pady 10

    grid .fimg - - -in .fctrl -pady {50 0}
    grid .f_tiled - - -in .fctrl -pady {20 0}
    pack .limg -in .fimg -expand 1
}

##+##########################################################################
#
# 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
    UnpackBits $BM(bits)
    unset BM(bits)
    RedrawBits
    ::img::current config -data $BM(raw)        ;# Update current bitmap display
    ShowTiledPreview $S(tileSize)
}

##+##########################################################################
#
# ShowTiledPreview -- draws the tiled version of the preview
#
proc ShowTiledPreview {size} {
    global BM S

    set S(tileSize) $size

    set C .f_tiled.c
    destroy $C
    set w [expr {$size * $BM(width)}]
    set h [expr {$size * $BM(height)}]
    canvas $C -width $w -height $h -bd 0 -highlightthickness 0
    pack $C

    for {set row 0} {$row < $size} {incr row} {
        set y [expr {$row * $BM(height)}]
        for {set col 0} {$col < $size} {incr col} {
            set x [expr {$col * $BM(width)}]
            $C create image $x $y -image ::img::current -anchor nw
        }
    }
}
##+##########################################################################
#
# 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) ""}
    set UNDO(current) {}
    set UNDO(all) {}
}

##+##########################################################################
#
# 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 config -scrollregion [.c bbox all]
}

##+##########################################################################
#
# Click -- handles left and right mouse click in a grid cell
#
proc Click {action onoff x y} {
    global BM UNDO

    if {$action eq "up"} {
        .c config -cursor [lindex [.c config -cursor] 3]
        if {$UNDO(current) ne "" && [llength $UNDO(current)] > 2} {
            lappend UNDO(all) $UNDO(current)
        }
        set UNDO(current) {}
        return
    }
    if {$action eq "down"} {
        .c config -cursor pencil
        set UNDO(current) [list $onoff ":"]
    }

    # Here for button down and button motion
    foreach {row col} [XY2Cell [.c canvasx $x] [.c canvasy $y]] break
    if {$row < 0 || $row >= $BM(height) || $col < 0 || $col >= $BM(width)} return

    if {$onoff == "ON"} {                        ;# Set the pixel
        if {$BM(b,$row,$col)} return             ;# Already set
        set BM(b,$row,$col) 1
        DrawOnBitForCell $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)
    }
    lappend UNDO(current) $row $col
    set BM(raw) [UnparseBMP]
    ::img::current config -data $BM(raw)
}

##+##########################################################################
#
# Undo -- Implements undo
#
proc Undo {} {
    global UNDO BM

    set what [lindex $UNDO(all) end]
    set UNDO(all) [lrange $UNDO(all) 0 end-1]
    if {$what eq ""} return

    set data [lassign $what action .]
    if {$action eq "BITS"} {
        UnpackBits $data
        RedrawBits
    } else {
        set onoff [expr {$action eq "ON" ? "OFF" : "ON"}]
        foreach {row col} $data {
            if {$onoff == "ON"} {                        ;# Set the pixel
                if {$BM(b,$row,$col)} continue           ;# Already set
                set BM(b,$row,$col) 1
                DrawOnBitForCell $row $col
            } else {                                     ;# Clear the pixel
                if {! $BM(b,$row,$col)} continue         ;# Already cleared
                set BM(b,$row,$col) 0
                .c delete o($row,$col)
            }
        }
    }
    set BM(raw) [UnparseBMP]
    ::img::current config -data $BM(raw)
}

##+##########################################################################
#
# UnpackBits -- fills in the BM(b,*,*) array
#
proc UnpackBits {rawBits} {
    global BM BITS

    set row 0
    set col 0
    array unset BM b,*
    foreach byte $rawBits {
        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 {[incr col] >= $BM(width)} {     ;# Do we past the last column?
                incr row
                set col 0
                break
            }
        }
    }
}

##+##########################################################################
#
# DrawOnBitForCell -- draws the "on" bit in a specified cell
#
proc DrawOnBitForCell {row col} {
    .c create oval [CellXY $row $col] -fill black -tag [list bit o($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]
}

##+##########################################################################
#
# XY2Cell -- returns cell based on canvas position
#
proc XY2Cell {x y} {
    set c [expr {(int($x) - 10) / $::S(cell)}]
    set r [expr {(int($y) - 10) / $::S(cell)}]
    return [list $r $c]
}


##+##########################################################################
#
# 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
#
proc OpenBMP {} {
    set types { {{BMP Files} {.bmp}} {{All Files} * }}
    set fname [tk_getOpenFile -defaultextension ".bmp" \
                              -initialdir [file dirname $::S(fname)] \
                              -initialfile [file tail $::S(fname)] \
                              -filetypes $types]
    if {$fname == ""} return
    DisplayBMPFile $fname
}

proc DisplayBMPFile {fname} {
    global S

    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
    DisplayBMP $raw
}

proc DisplayBMP {data} {
    ParseBMP $data
    ShowBMP
}


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

    if {! [info exists BM(raw)]} return
    set types {{{BMP Files} {.bmp}} {{All Files} *}}
    set fname [tk_getSaveFile -defaultextension ".bmp" \
                              -initialdir [file dirname $S(fname)] \
                              -initialfile [file tail $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 ", "]
    set bytes [PackBits]
    append bmp "    0x" [join $bytes ", 0x"]
    append bmp "\n\}"

    return $bmp
}

##+##########################################################################
#
# Converts BM(b,*,*) into hex bitmap
#
proc PackBits {} {
    global BM

    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 %02x $byte]
        }
    }
    return $bytes
}
##+##########################################################################
#
# 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 {nName nwidth nheight} $n break
    if {$nName ne ""} { set ::BM(name) $nName }
    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(name) $BM(name)
    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}
    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(version)\n\nby Keith Vetter\nJanuary 2003-2016"
    tk_messageBox -title "About $::S(prog)" -message $msg -icon info
}

##+##########################################################################
#
# BitFunc -- handles shifts, inverts and clear bitmap operations
#
proc BitFunc {what} {
    global BM

    set currentBits [PackBits]
    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
                }
            }
        }
    }
    lappend ::UNDO(all) [list BITS : {*}$currentBits]
    set BM(raw) [UnparseBMP]
    RedrawBits
    ::img::current config -data $BM(raw)
}
##+##########################################################################
#
# RedrawBits -- redraws screen based on BM(b,*,*) data
#
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)} {DrawOnBitForCell $row $col}
        }
    }
}

proc MakePhotoImage {} {
    global BM

    set img [image create photo -width $BM(width) -height $BM(height)]
    for {set x 0} {$x < $BM(width)} {incr x} {
        for {set y 0} {$y < $BM(height)} {incr y} {
            if {$BM(b,$y,$x)} {
                $img put black -to $x $y [expr {$x+1}] [expr {$y+1}]
            }
        }
    }
    return $img
}


DoDisplay

if {[llength $argv] > 1} {
    DisplayBMP $bitmap_bullet
    ERROR "Too many files specified, expected only one"
} elseif {[llength $argv] == 1} {
    DisplayBMPFile [lindex $argv 0]
} else {
    DisplayBMP $bitmap_bullet
}

return