[Keith Vetter] 2003-09-03 - Rob Kudla, in [About Tcl and popularity],
complained that the Hack-O-Matic utility he wrote to edit 
binary files was way too slow, and that a Windows-based BASIC clone
was ten times faster.

I took that as a challenge and spent a few hours writing this much 
faster version. 

The speed up came from using a completely new algorithm. I don't
care which language you're using, if you have a 32k file, drawing
32k*8 boxes is going to take a long time. Instead, just draw as
many boxes as will fit on the screen. You just have to change
the scrollbar command to not scroll pixels but to change which
rows get displayed in those boxes.

----
 #!/bin/sh
 # Restart with tcl: -*- mode: tcl; tab-width: 8; -*- \
 exec wish $0 ${1+"$@"}
 
 ##+##########################################################################
 #
 # Hack-O-Matic -- visual binary editor
 # by Keith Vetter, September 2003
 #
 # Rob Kudla on http://mini.net/tcl/9505 complained about a utility for
 # editing Atari graphic files called Hack-O-Matic, that he wrote in
 # tcl was 10 times slower than a windows BASIC version and unstable.
 #
 # Taking that as a challenge, here's a version I wrote in a few hours
 # that is quite fast.
 
 # The speed up was not in nit-picking optimizations like bracing
 # expressions but in a new algorithm. I don't care what language
 # you're using but if you have a 32k file, drawing 32k * 8 boxes is
 # going to take a long time. Instead, just draw as many boxes as will
 # fit on the screen. The scrollbar command, instead of scrolling
 # pixels, just changes which rows get displayed.
 
 package require Tk
 
 set S(title) "Hack-O-Matic"
 set S(box) 20                                   ;# Size of each cell
 set S(tm) 10                                    ;# Top margin
 set S(lm) 10                                    ;# Left margin 
 set S(lm2) 45                                   ;# Left margin for the grid
 set S(rows) 16                                  ;# How many rows to show
 set S(max) 1048576                              ;# Largest file we can handle
 set S(top) 0                                    ;# First row of data to display
 
 proc DoDisplay {} {
    global S
    
    wm title . $S(title)
    
    menu .menu
    . configure -menu .menu                      ;# Attach menu to main window
    .menu add cascade -menu .menu.file -label "File" -underline 0
    .menu add cascade -menu .menu.help -label "Help" -underline 0
 
    menu .menu.file
    menu .menu.help
    .menu.file add command -label "Open" -command LoadFile
    .menu.file add command -label "Save As..." -command SaveFile
    .menu.file add command -label "Exit" -command exit
    .menu.help add command -label "About..." -command About
 
    label .title -textvariable S(fname) -bd 2 -relief sunken
    scrollbar .sb -orient vertical -command ScrollProc
    canvas .c -width 245 -highlightthickness 0
    .c config -height [expr {$S(tm) + $S(rows)*$S(box)}]
    
    pack .title -side top -fill x
    pack .sb -fill y -expand 0 -side right
    pack .c -fill both -expand 1 -side left
 
    for {set i 0; set n 1} {$i < 8} {incr i} {
        set ::S(pow,$i) $n
        set n [expr {2*$n}]
    }
    update
    bind .c <Configure> {Resize %W %h %w}       ;# Handle resizing 
 }
 # 
 # ScrollProc -- called by the scrollbar. We need to determine what
 # the new top of the page is.
 # 
 proc ScrollProc {args} {
    foreach {cmd perc} $args break
    if {$cmd != "moveto"} return
    set top [expr {round($perc * $::DATA(len))}]
    if {$top == $::S(top)} return
    DoPage $top
 }
 # 
 # DoPage -- display a screenful of data rows starting at TOP
 # 
 proc DoPage {{top ""}} {
    global S DATA
 
    if {$top == ""} {set top $S(top)}
    set S(top) $top
    
    .c delete all
    for {set i 0} {$i < $S(rows)} {incr i} {
        DoRow [expr {$S(top) + $i}] $i
    }
 
    # Adjust the scrollbar
    set sb1 [expr {double($S(top)) / $DATA(len)}]
    set sb2 [expr {double($S(top)+$S(rows)) / $DATA(len)}]
    .sb set $sb1 $sb2
 }
 # 
 # DoRow -- shows one row of data at a given screen row
 # 
 proc DoRow {row srow} {
    global S DATA
 
    if {$row >= $DATA(len)} return
    set datum [lindex $DATA(bytes) $row]
    
    set x1 $S(lm2)
    set x2 [expr {$x1 + $S(box)}]
    set y1 [expr {$S(tm) + $S(box) * $srow}]
    set y2 [expr {$y1 + $S(box)}]
    set ym [expr {$y1 + $S(box)/2}]
    
    set num [format %04x $row]
    .c create text $S(lm) $ym -tag d$srow -text $num -anchor w
 
    for {set i 7} {$i >= 0} {incr i -1} {
        set tag b$srow,$i
        set xy [list $x1 $y1 $x2 $y1 $x2 $y2 $x1 $y2]
        .c create poly $xy -tag [list b$srow $tag] \
            -fill white -outline black
        .c bind $tag <Button-1> [list CellClick $row $i $srow]
        if {$datum & $S(pow,$i)} {.c itemconfig $tag -fill black}
        
        set x1 $x2
        incr x2 $S(box)
    }
 
    # Show the hex value and the character
    set ch [format %c $datum]
    if {! [string is ascii $ch] || [string is control $ch]} {set ch "?"}
    set extra [format " %02x %s" [expr {($datum + 0x100) % 0x100}] $ch]
    .c create text $x1 $ym -tag e$srow -text $extra -anchor w
 }
 # 
 # CellClick -- handles clicking in a cell which toggles the bit
 # 
 proc CellClick {row col srow} {
    global S DATA
 
    set datum [lindex $DATA(bytes) $row]
    if {$datum & $S(pow,$col)} {                ;# Bit is already set
        .c itemconfig b$srow,$col -fill white
        incr datum -$S(pow,$col)
    } else {                                    ;# Bit is off
        .c itemconfig b$srow,$col -fill black
        incr datum $S(pow,$col)
    }
    lset DATA(bytes) $row $datum
    
    set ch [format %c $datum]
    if {! [string is ascii $ch] || [string is control $ch]} {set ch "?"}
    set extra [format " %02x %s" [expr {($datum + 0x100) % 0x100}] $ch]
    .c itemconfig e$srow -text $extra
 }
 # 
 # LoadFile -- reads a file and converts to an integer list
 # 
 proc LoadFile {{fname ""}} {
    global S DATA
 
    # Read in the data
    if {$fname == ""} {
        set fname [tk_getOpenFile]
        if {$fname == ""} return
    }
    if {[file size $fname] >= $S(max)} {
        tk_messageBox -message "File $fname is too big" -icon error
        return
    }
 
    set S(fname) [file tail $fname]
    set FIN [open $fname r]
    fconfigure $FIN -translation binary
    set bytes [read $FIN [file size $fname]]
    close $FIN
    
    binary scan $bytes c* DATA(bytes)
    set DATA(len) [llength $DATA(bytes)]
    DoPage 0
 }
 # 
 # SaveFile -- saves our binary data
 # 
 proc SaveFile {} {
    global DATA
    
    set fname [tk_getSaveFile]
    if {$fname == ""} return
 
    set FOUT [open $fname w]
    fconfigure $FOUT -translation binary
    puts -nonewline $FOUT [binary format c* $DATA(bytes)]
    close $FOUT
 }
 proc About {} {
    tk_messageBox -message "$::S(title)\nby Keith Vetter, September 2003" \
        -title "About $::S(title)"
 }
 proc Resize {W h w} {
    global S
    
    if {$W != ".c"} return
    set rows [expr {1 + int(([winfo height .c] - $S(tm)) / $S(box))}]
    if {$rows == $S(rows)} return
    set S(rows) $rows
    DoPage
 }
  
 DoDisplay
 
 set script [info script]
 if {[file readable $script]} {                  ;# Use this script as a demo
    LoadFile $script
 } else {
    set txt "$S(title)\nby Keith Vetter"        ;# Sample text to display
    binary scan $txt c* DATA(bytes)
    set DATA(len) [llength $DATA(bytes)]        ;# Rows of data to display
    DoPage 0
 }
----
[Category Application]