#
# 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
+ }
}
}
set blocksize 4096
set width 128
-set scale 2
+set scale 4
# This is used to store the canvas handle.
set h ""
set logfile [lindex $argv 0]
set size [lindex $argv 1]
-# Set up the window.
-wm title . "nbdview $logfile"
-
# Menubar.
option add *tearOff 0
menu .menubar
.menubar add cascade -menu .menubar.file -label File
.menubar.file add command -label "Quit" -command { exit }
+# Frame.
+frame .f
+pack .f -anchor center -expand 1 -fill both -ipadx 10 -ipady 10
+
# Canvas.
-set h [nbdcanvas .c $logfile $size $blocksize $width $scale]
-pack .c -in . -expand 1 -fill both
+set h [nbdcanvas .f.c $logfile $size $blocksize $width $scale]
+.f.c configure -borderwidth 4 -relief groove
+pack .f.c -anchor center -expand 0 -fill none
-# Set the width and height of the window.
-set h_ [expr {[nbdheight $h] * $scale + 40}]
-set w [expr {$width * $scale + 16}]
-wm geometry . "${w}x${h_}"
+# Set up the window.
+wm title . "nbdview $logfile"
wm resizable . false false
# Start polling the log file.
git.annexia.org / libguestfs-talks.git / commitdiff