From 643a2dc66034baf2402149a4cdf98a6f15d7806b Mon Sep 17 00:00:00 2001
From: Nick White <git@njw.name>
Date: Thu, 21 May 2015 13:11:48 +0100
Subject: Make image scaling more efficient by using an image cache and
recording whether an image has been shrunk
---
tkread | 38 ++++++++++++++++++++++++++------------
1 file changed, 26 insertions(+), 12 deletions(-)
diff --git a/tkread b/tkread
index e6c7c87..9b8cc6c 100755
--- a/tkread
+++ b/tkread
@@ -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
}
--
cgit v1.2.3