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, ... ---- [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 [http://www.posoft.de/] 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. ---- #!/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 Jan 15, 2003 - initial revision # KPV Mar 06, 2003 - added functions like shift, clear, invert and resize # ##+########################################################################## ############################################################################# package require Tk set S(cell) 10 set S(prog) "Bitmap Editor" 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 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) 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 [bind Text ] 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 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 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 disabled 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 .fimg - - -in .fctrl -row 41 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 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 cleare 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 # proc OpenBMP {} { global S set types { {{BMP Files} {.bmp}} {{All Files} * }} set fname [tk_getOpenFile -defaultextension ".bmp" -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 types {{{BMP Files} {.bmp}} {{All Files} *}} set fname [tk_getSaveFile -defaultextension ".bmp" -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)\n\nby Keith Vetter\nJanuary 2003" 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 ---- [[ [Category Application] | [Category File] | [Category Graphics] ]]