1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
|
# copyright (C) 1997-2005 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu
# $Id: images.tcl,v 1.8 2005/01/02 00:45:07 jfontain Exp $
namespace eval images { ;# manage images using their file name as key
proc load {name file data} { ;# load image, which may then be used, into repository
variable count
if {![info exists count($name)]} {set count($name) 0}
catch {image delete images($name)} ;# always keep last version of an image
if {[string length $file] == 0} { ;# from file
return [image create photo images($name) -data $data]
} else { ;# from base 64 data
return [image create photo images($name) -file $file]
}
}
proc use {name} {
variable count
incr count($name) ;# obviously image must have been loaded before
return images($name)
}
proc release {name} {
variable count
if {[incr count($name) -1] <= 0} {
image delete images($name)
unset count($name)
}
}
proc names {} { ;# returns all images in the repository
variable count
return [lsort -dictionary [array names count]]
}
proc values {} { ;# returns flat list of file, format and data
set list {}
foreach name [names] {
set data [images($name) cget -data]
if {[string length $data] == 0} { ;# initialized from file
set file [open [images($name) cget -file]]
fconfigure $file -translation binary
set data [base64::encode -maxlen 132 [read $file]]
close $file
} ;# else already in base 64
lappend list $name [images($name) cget -format] $data
}
return $list
}
}
|
