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, tiled preview, set name before saving, new demo-bitmap 16x16.
#!/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: # 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 # ##+########################################################################## package require Tk set S(cell) 10 set S(prog) "Bitmap Editor" set S(vers) "1.10" 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 = { 0x03, 0xe0, 0x03, 0xe0, 0x04, 0xe0, 0x38, 0x10, 0x38, 0x0c, 0x38, 0x0c, 0x40, 0x02, 0x80, 0x01, 0x80, 0x01, 0x40, 0x02, 0x30, 0x1c, 0x30, 0x1c, 0x08, 0x1c, 0x07, 0x20, 0x07, 0xc0, 0x07, 0xc0 } } 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 # Tiled preview: (ToDo: should be 2x2, 3x3 or 4x4, and seamless) frame .fimg2 -bd 2 -relief sunken -padx 0 -pady 0 label .limg2a -image ::img::current -bg yellow label .limg2b -image ::img::current -bg yellow label .limg2c -image ::img::current -bg yellow label .limg2d -image ::img::current -bg yellow ## grid rowconfigure .fctrl 40 -minsize 50 grid rowconfigure .fctrl 35 -minsize 50 grid .fimg - - -in .fctrl -row 41 pack .limg -in .fimg -expand 1 grid .fimg2 - - -in .fctrl -row 81 pack .limg2a -in .fimg2 ;# -expand 1 -anchor nw pack .limg2b -in .fimg2 pack .limg2c -in .fimg2 pack .limg2d -in .fimg2 } ##+########################################################################## # # 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 . #.
gold added pix
HJG 2012-04-20 Broken link: [L2 ]