X-Git-Url: http://git.annexia.org/?p=libguestfs-talks.git;a=blobdiff_plain;f=2019-fosdem%2Fnbdview%2Fnbdcanvas.tcl;h=012c64223f839d7476826ab7a03aebb3a73ba9d1;hp=f5e8b754863165662d66df4eb7322571542cc564;hb=4c01ec8909b2ed220d568374396f29ad25b75144;hpb=7fa686e481dcca96f185aea00e75d4f6df6506b8

diff --git a/2019-fosdem/nbdview/nbdcanvas.tcl b/2019-fosdem/nbdview/nbdcanvas.tcl
index f5e8b75..012c642 100644
--- a/2019-fosdem/nbdview/nbdcanvas.tcl
+++ b/2019-fosdem/nbdview/nbdcanvas.tcl
@@ -44,9 +44,13 @@ package require Tk
 #
 # 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
@@ -54,9 +58,10 @@ proc nbdcanvas { canvas logfile size blocksize width scale } {
     # $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"]
@@ -79,12 +84,14 @@ proc nbdheight { h } {
     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
 }
@@ -94,38 +101,40 @@ proc update_dispimg { h } {
 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"
 }
 
@@ -172,9 +181,16 @@ proc handle { h line } {
     # 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.
@@ -184,5 +200,12 @@ proc nbdpoll { h } {
         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
+        }
     }
 }