[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  [http://www.posoft.de/%|%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
[http://groups.google.com/groups?hl=en&lr=&ie=UTF-8&frame=left&th=4084506e53b1ad83]
April 2004 thread, which covers an interesting mix of shareware, Tk-based freeware, ...

See also [bme].
---- 

[vetter_bitmapEditor_wiki6298_screenshot_592x468.jpg]

[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
======


<<categories>>Application|File|Graphics|Arts and crafts of Tcl-Tk programming