, 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 - Optimisationuniquename 2013aug18For 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.
#!/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
}