Updated 2018-09-28 13:08:30 by PeterLewerin

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.

rjk And indeed, looking at the source to the abovementioned BASIC version at http://koti.mbnet.fi/dacodez/hackomatic2.bas , that appears to be just how he did it too. Ah well. The existence of a RapidQ version saved me the heartache of people's complaints that the Freewrapped executable wouldn't run under WinXP (I don't actually have a Windows box and Tcl was the only high level language I had that would let me "crosscompile"), so maybe it's for the best that I wrote it in the stupidest way possible.

PWQ 17 Feb 2004 I have posted a simple mod that gains speed up factor of 2 Hack-O-Matic - Optimisation

uniquename 2013aug18

For those who do not have the time/facilities/whatever to setup and run the code below, here is an image to show what this binary editor GUI looks like.

In the process of getting this image, I tried moving the scrollbar down and then back to the top. At the top, I get (consistently) the following message:

Eroor: can't use empty string as operand of "&"

The grid of white and black squares disappears, and I have to close down the GUI to get started again.

Apparently, there is a small glitch in the code.

2014-02-21: I intended to take a look at this, but can't reproduce the problem. Did someone fix the code without making a note of it? The & operator is used in the DoRow and CellClick commands, with the arguments $datum and $S(pow,$i) / $S(pow,$col). I think we can eliminate the second argument as a source for the error, since it provides a useful value for every valid $i / $col and a different error message for invalid indexes. The value of $datum could conceivably be set to the empty string if the lindex command is given an out-of-bounds index: in DoRow the upper bound is checked but not the lower bound (but it is hard to see how the index value should ever be less than 0); in CellClick neither of the bounds are checked, but it is only ever called as a callback with a row index that is guaranteed (?) to be valid. I'm leaving it at that.
 #!/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://wiki.tcl.tk/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
 }