diff options
| -rwxr-xr-x | tkread | 38 |
1 files changed, 26 insertions, 12 deletions
@@ -78,6 +78,9 @@ set replacements { \ {{\\_} "_"} \ } +array set imgcache {} +array set imgshrunk {} + if { $::argc > 0 && [lindex $::argv 0] == "-h" } { puts "Usage: $usage" exit @@ -122,6 +125,8 @@ proc markup {widget} { global tagnum global underlinenum global prefixnum + global imgcache + global imgshrunk # process replacements foreach item $replacements { @@ -164,6 +169,9 @@ proc markup {widget} { set localfile [file tail $src] if [file exists $localfile] { set curimg [image create photo -file $localfile] + set imgcache($curimg) [image create photo] + $imgcache($curimg) copy $curimg + set imgshrunk($curimg) 0 $widget image create $insertion -image $curimg -align baseline set cur $insertion } else { @@ -307,6 +315,7 @@ proc changeFontSize {change} { global underlinenum global prefixfmt global prefixnum + set newsize [expr $fontsize $change] if {$newsize > 0} { set fontsize $newsize @@ -331,20 +340,27 @@ proc changeFontSize {change} { } proc reduceImageIfNeeded {img maxwidth} { + global imgshrunk + 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 + set zoom [expr int(ceil($curwidth.0 / $maxwidth))] + if {$zoom > 1} { + set t [image create photo] + $t copy $img + $img blank + $img copy $t -shrink -subsample $zoom + image delete $t + set imgshrunk($img) 1 + } } } proc scaleImages {} { global fontfamily global fontsize + global imgcache + global imgshrunk foreach img [.t image names] { # note width is 64 * (width of '0' char) @@ -352,12 +368,10 @@ proc scaleImages {} { 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 + if { $imgshrunk($img) == 1 } { + $img copy $imgcache($img) + set imgshrunk($img) 0 + } } reduceImageIfNeeded $img $maxwidth } |