diff options
| -rwxr-xr-x | tkread | 35 |
1 files changed, 35 insertions, 0 deletions
@@ -327,6 +327,40 @@ proc changeFontSize {change} { .t tag configure prefix_$x -font "{$fontfamily} [expr $fontsize + $fmtsizemod] $fmtstring" } } + scaleImages +} + +proc reduceImageIfNeeded {img maxwidth} { + set curwidth [image width $img] + if {$curwidth > $maxwidth} { + set t [image create photo] + $t copy $img + $img blank + set zoom [expr round($curwidth.0 / $maxwidth)] + $img copy $t -shrink -subsample $zoom + image delete $t + } +} + +proc scaleImages {} { + global fontfamily + global fontsize + + foreach img [.t image names] { + # note width is 64 * (width of '0' char) + set charwidth [font measure "{$fontfamily} $fontsize" "0"] + set maxwidth [expr $charwidth * 64] + set curwidth [image width $img] + if {$curwidth < $maxwidth} { + # re-load the image as it may have been shrunk + # TODO: could make this more efficient by keeping track of which images actually have been shrunk + # TODO: also should keep copies of the original image in memory + puts "$curwidth < $maxwidth" + set f [$img cget -file] + $img read $f + } + reduceImageIfNeeded $img $maxwidth + } } proc invertColours {} { @@ -378,6 +412,7 @@ if { $domarkdown } { markup .t } .t configure -state disabled ;# disable text insertion & cursor +scaleImages bind . <Up> {scroll -1 unit} bind . <k> {scroll -1 unit} |