#
# Returns an opaque handle which should be passed to nbdpoll.
proc nbdcanvas { canvas logfile size blocksize width scale } {
- canvas $canvas -bg white
set height [expr {$size / $blocksize / $width}]
+ # Width and height of the canvas.
+ set w_scaled [expr {$width*$scale}]
+ set h_scaled [expr {$height*$scale}]
+ canvas $canvas -bg white -width $w_scaled -height $h_scaled
+
# Because Tk's canvas cannot scale images, we use a very
# inefficient double buffering here where we have $img which
# contains the raw data but is not displayed, and $dispimg which
# $img changes.
set img [image create photo -width $width -height $height]
$img put "white" -to 0 0 $width $height
- set dispimg [image create photo -width [expr {$width*$scale}] \
- -height [expr {$height*$scale}]]
- $canvas create image 0 0 -anchor nw -image $dispimg
+ set dispimg [image create photo -width $w_scaled -height $h_scaled]
+ # -borderwidth somehow counts towards the canvas area?! So we have
+ # to offset the image by 4, 4 here to make it fully visible.
+ $canvas create image 4 4 -anchor nw -image $dispimg
# Open the log file.
set fp [open $logfile "r"]
return [dict get $h height]
}
-# Blit $img to $dispimg, with scaling.
-proc update_dispimg { h } {
- set img [dict get $h img]
+# Blit $img to $dispimg, with scaling. If the optional img parameter
+# is given, blit that image to $dispimg instead, else use the normal
+# img stored in the handle.
+proc update_dispimg { h { img - } } {
+ if { "$img" eq "-" } {
+ set img [dict get $h img]
+ }
set dispimg [dict get $h dispimg]
- set width [dict get $h width]
- set height [dict get $h height]
set scale [dict get $h scale]
$dispimg copy $img -zoom $scale $scale
}
proc handle_read { h offset count } {
set blocksize [dict get $h blocksize]
set width [dict get $h width]
+ set height [dict get $h height]
set img [dict get $h img]
+ # We only write into a temporary image here.
+ set tmpimg [image create photo -width $width -height $height]
+ $tmpimg copy $img
+
while { $count > 0 } {
set lba [expr {$offset/$blocksize}]
set x [expr {$lba % $width}]
set y [expr {$lba / $width}]
- set oldcol [$img get $x $y]
- set oldcol [format "#%02x%02x%02x" \
- [lindex $oldcol 0] \
- [lindex $oldcol 1] \
- [lindex $oldcol 2]]
- # Flash the pixel to black.
- $img put "black" -to $x $y [expr {$x+1}] [expr {$y+1}]
- update_dispimg $h
- update
- # Restore old colour.
- $img put $oldcol -to $x $y [expr {$x+1}] [expr {$y+1}]
- update_dispimg $h
+ # Set the read pixel to black.
+ $tmpimg put "black" -to $x $y [expr {$x+1}] [expr {$y+1}]
incr offset $blocksize
incr count [expr {-$blocksize}]
}
+
+ # Update the display buffer with the temporary image.
+ update_dispimg $h $tmpimg
+ update
+
+ # Discard the temporary copy.
+ image delete $tmpimg
+
+ # We don't actually update the display image again. It will be
+ # restored next time something happens.
}
# Operation colours.
array set colours {
- # write => red
w "#ff0000"
- # trim => grey
- t "#e0e0e0"
- # zero => white
+ t "#e0e0f0"
z "#ffffff"
}
# else just ignore any lines we don't understand
}
+# If nothing happens in nbdpoll for a few iterations then we update
+# the displayed image. This is so that black read bars don't appear
+# permanently if nothing else is happening.
+set pollcount 50
+
# Poll the logfile and update the canvas.
-# This has to be called every so often.
+# This has to be called every so often from the main program.
proc nbdpoll { h } {
+ global pollcount
+
set fp [dict get $h fp]
# Read as much as we can from the log file.
foreach line $lines {
handle $h $line
}
+ } else {
+ # Nothing happening, did pollcount go to zero yet?
+ incr pollcount -1
+ if { $pollcount == 0 } {
+ update_dispimg $h
+ set pollcount 50
+ }
}
}