2019-fosdem/nbdview/nbdcanvas.tcl

   1 #!/usr/bin/env wish
   2 # Visualize nbdkit activity - read the README file first!
   3 # Copyright (C) 2018 Red Hat Inc.
   4 # All rights reserved.
   5 #
   6 # Redistribution and use in source and binary forms, with or without
   7 # modification, are permitted provided that the following conditions are
   8 # met:
   9 #
  10 # * Redistributions of source code must retain the above copyright
  11 # notice, this list of conditions and the following disclaimer.
  12 #
  13 # * Redistributions in binary form must reproduce the above copyright
  14 # notice, this list of conditions and the following disclaimer in the
  15 # documentation and/or other materials provided with the distribution.
  16 #
  17 # * Neither the name of Red Hat nor the names of its contributors may be
  18 # used to endorse or promote products derived from this software without
  19 # specific prior written permission.
  20 #
  21 # THIS SOFTWARE IS PROVIDED BY RED HAT AND CONTRIBUTORS ''AS IS'' AND
  22 # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
  23 # THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
  24 # PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL RED HAT OR
  25 # CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  26 # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
  27 # LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
  28 # USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
  29 # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
  30 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
  31 # OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  32 # SUCH DAMAGE.
  33
  34 package require Tk
  35
  36 # Create an nbdcanvas object.
  37 #
  38 # canvas: canvas object name which is created (eg. ".c")
  39 # logfile: log file to monitor
  40 # size: size in bytes of the underlying disk
  41 # blocksize: size in bytes of the block corresponding to each pixel
  42 # width: width of the canvas (height is determined from size & blocksize)
  43 # scale: each pixel is scaled by this amount
  44 #
  45 # Returns an opaque handle which should be passed to nbdpoll.
  46 proc nbdcanvas { canvas logfile size blocksize width scale } {
  47     set height [expr {$size / $blocksize / $width}]
  48
  49     # Width and height of the canvas.
  50     set w_scaled [expr {$width*$scale}]
  51     set h_scaled [expr {$height*$scale}]
  52     canvas $canvas -bg white -width $w_scaled -height $h_scaled
  53
  54     # Because Tk's canvas cannot scale images, we use a very
  55     # inefficient double buffering here where we have $img which
  56     # contains the raw data but is not displayed, and $dispimg which
  57     # is the displayed image which is copied/zoomed from $img whenever
  58     # $img changes.
  59     set img [image create photo -width $width -height $height]
  60     $img put "white" -to 0 0 $width $height
  61     set dispimg [image create photo -width $w_scaled -height $h_scaled]
  62     # -borderwidth somehow counts towards the canvas area?!  So we have
  63     # to offset the image by 4, 4 here to make it fully visible.
  64     $canvas create image 4 4 -anchor nw -image $dispimg
  65
  66     # Open the log file.
  67     set fp [open $logfile "r"]
  68
  69     set h [dict create \
  70                logfile $logfile \
  71                size $size \
  72                blocksize $blocksize \
  73                width $width \
  74                height $height \
  75                scale $scale \
  76                img $img \
  77                dispimg $dispimg \
  78                fp $fp]
  79     return $h
  80 }
  81
  82 # Return the computed height of the image in pixels.
  83 proc nbdheight { h } {
  84     return [dict get $h height]
  85 }
  86
  87 # Blit $img to $dispimg, with scaling.  If the optional img parameter
  88 # is given, blit that image to $dispimg instead, else use the normal
  89 # img stored in the handle.
  90 proc update_dispimg { h { img - } } {
  91     if { "$img" eq "-" } {
  92         set img [dict get $h img]
  93     }
  94     set dispimg [dict get $h dispimg]
  95     set scale [dict get $h scale]
  96     $dispimg copy $img -zoom $scale $scale
  97 }
  98
  99 # Handle a read.
 100 # This flashes the pixels, but restores their previous value.
 101 proc handle_read { h offset count } {
 102     set blocksize [dict get $h blocksize]
 103     set width [dict get $h width]
 104     set height [dict get $h height]
 105     set img [dict get $h img]
 106
 107     # We only write into a temporary image here.
 108     set tmpimg [image create photo -width $width -height $height]
 109     $tmpimg copy $img
 110
 111     while { $count > 0 } {
 112         set lba [expr {$offset/$blocksize}]
 113         set x [expr {$lba % $width}]
 114         set y [expr {$lba / $width}]
 115
 116         # Set the read pixel to black.
 117         $tmpimg put "black" -to $x $y [expr {$x+1}] [expr {$y+1}]
 118
 119         incr offset $blocksize
 120         incr count [expr {-$blocksize}]
 121     }
 122
 123     # Update the display buffer with the temporary image.
 124     update_dispimg $h $tmpimg
 125     update
 126
 127     # Discard the temporary copy.
 128     image delete $tmpimg
 129
 130     # We don't actually update the display image again.  It will be
 131     # restored next time something happens.
 132 }
 133
 134 # Operation colours.
 135 array set colours {
 136     w "#ff0000"
 137     t "#e0e0f0"
 138     z "#ffffff"
 139 }
 140
 141 # Handle an operation.
 142 #
 143 # h: handle
 144 # op: operation, "w"-rite, "t"-rim, "z"-ero
 145 # offset, count: in bytes
 146 proc handle_op { h op offset count } {
 147     global colours
 148
 149     set blocksize [dict get $h blocksize]
 150     set width [dict get $h width]
 151     set img [dict get $h img]
 152
 153     # Choose a colour based on the operation.
 154     set col $colours($op)
 155
 156     while { $count > 0 } {
 157         set lba [expr {$offset/$blocksize}]
 158         set x [expr {$lba % $width}]
 159         set y [expr {$lba / $width}]
 160
 161         # Set the pixel at (x, y) to col.
 162         $img put $col -to $x $y [expr {$x+1}] [expr {$y+1}]
 163
 164         incr offset $blocksize
 165         incr count [expr {-$blocksize}]
 166     }
 167     update_dispimg $h
 168 }
 169
 170 # Handle a single line from the log file.
 171 proc handle { h line } {
 172     if { [ regexp {\mRead.*offset=(0x[[:xdigit:]]+).*count=(0x[[:xdigit:]]+)} $line -> offset count ] } {
 173         handle_read $h $offset $count
 174     } elseif { [ regexp {\mWrite.*offset=(0x[[:xdigit:]]+).*count=(0x[[:xdigit:]]+)} $line -> offset count ] } {
 175         handle_op $h w $offset $count
 176     } elseif { [ regexp {\mTrim.*offset=(0x[[:xdigit:]]+).*count=(0x[[:xdigit:]]+)} $line -> offset count ] } {
 177         handle_op $h t $offset $count
 178     } elseif { [ regexp {\mZero.*offset=(0x[[:xdigit:]]+).*count=(0x[[:xdigit:]]+)} $line -> offset count ] } {
 179         handle_op $h z $offset $count
 180     }
 181     # else just ignore any lines we don't understand
 182 }
 183
 184 # If nothing happens in nbdpoll for a few iterations then we update
 185 # the displayed image.  This is so that black read bars don't appear
 186 # permanently if nothing else is happening.
 187 set pollcount 50
 188
 189 # Poll the logfile and update the canvas.
 190 # This has to be called every so often from the main program.
 191 proc nbdpoll { h } {
 192     global pollcount
 193
 194     set fp [dict get $h fp]
 195
 196     # Read as much as we can from the log file.
 197     set data [read -nonewline $fp]
 198     if { $data ne "" } {
 199         set lines [split $data \n]
 200         foreach line $lines {
 201             handle $h $line
 202         }
 203     } else {
 204         # Nothing happening, did pollcount go to zero yet?
 205         incr pollcount -1
 206         if { $pollcount == 0 } {
 207             update_dispimg $h
 208             set pollcount 50
 209         }
 210     }
 211 }