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
#!/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
}