[PWQ] 17 Feb 2004

Changed [Hack-O-Matic] to create the canvas items once, and then use
itemconfigure to change their values. In the scroll test applied, it
gives a speed up to scrolling by a factor of 2.

Another optimisation would be to move the canvas items as a block by the number of lines scrolled and then move the rows that have moved off the screen back to the top or bottom.
Then you would only have to configure the rows that are new.

''W.r.t. that last comment, see also the [virtual grid widget] page.''
----
======
 #!/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 MkPage {} {
    global S DATA
    .c delete all
        puts "Make $S(rows)"
    for {set i 0} {$i < $S(rows)} {incr i} {
        MkRow $i
    }

 }

 proc MkRow {srow} {
    global S DATA


    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}]

    .c create text $S(lm) $ym -tag d$srow -text ???? -anchor w

    foreach i  {7 6 5 4 3 2 1 0} {
        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 $srow $i $srow]
        set x1 $x2
        incr x2 $S(box)
    }

    # Show the hex value and the character
    .c create text $x1 $ym -tag e$srow -text ???? -anchor w
 }

 proc DoPage {{top ""}} {
    global S DATA

    if {$top == ""} {set top $S(top)}
    set S(top) $top

    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 itemconfig d$srow -text $num 

    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 itemconfig $tag -fill [expr {$datum & $S(pow,$i) ? "black" : "white"}]
        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 itemconfig  e$srow -text $extra
 }
 #
 # 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
    MkPage
        DoPage
 }

 DoDisplay

 proc test {} {

        for {set i 0} {$i < 1000} {incr i} {
        DoPage $i
        update idletasks
        }

 }

 set script [info script]
 if {[file readable $script]} {                  ;# Use this script as a demo
    LoadFile $script
        ### PWQ Time to scroll 1000 lines.
        update
        set x [time test]
        puts "Time $x"
 } 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
 }
======



<<categories>> Application