1 | # ---------------------------------------------------------------------- |
---|
2 | # COMPONENT: icons - utility for loading icons from a library |
---|
3 | # |
---|
4 | # This utility makes it easy to load GIF and XBM files installed |
---|
5 | # in a library in the final installation. It is used throughout |
---|
6 | # the Rappture GUI, whenever an icon is needed. |
---|
7 | # ====================================================================== |
---|
8 | # AUTHOR: Michael McLennan, Purdue University |
---|
9 | # Copyright (c) 2004-2005 Purdue Research Foundation |
---|
10 | # |
---|
11 | # See the file "license.terms" for information on usage and |
---|
12 | # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
13 | # ====================================================================== |
---|
14 | |
---|
15 | package require BLT |
---|
16 | |
---|
17 | namespace eval Rappture::icon { |
---|
18 | variable iconpath [list [file join $RapptureGUI::library scripts images]] |
---|
19 | variable icons |
---|
20 | } |
---|
21 | |
---|
22 | # ---------------------------------------------------------------------- |
---|
23 | # USAGE: Rappture::icon <name> |
---|
24 | # |
---|
25 | # Searches for an icon called <name> on all of the directories in |
---|
26 | # the search path set up by RapptureGUI::iconpath. |
---|
27 | # ---------------------------------------------------------------------- |
---|
28 | proc Rappture::icon {name} { |
---|
29 | variable ::Rappture::icon::iconpath |
---|
30 | variable ::Rappture::icon::icons |
---|
31 | |
---|
32 | # |
---|
33 | # Already loaded? then return it directly |
---|
34 | # |
---|
35 | if {[info exists icons($name)]} { |
---|
36 | return $icons($name) |
---|
37 | } |
---|
38 | |
---|
39 | # |
---|
40 | # Search for the icon along the iconpath search path |
---|
41 | # |
---|
42 | set file "" |
---|
43 | foreach dir $iconpath { |
---|
44 | set path [file join $dir $name.*] |
---|
45 | set file [lindex [glob -nocomplain $path] 0] |
---|
46 | if {"" != $file} { |
---|
47 | break |
---|
48 | } |
---|
49 | } |
---|
50 | |
---|
51 | set imh "" |
---|
52 | if {"" != $file} { |
---|
53 | switch -- [file extension $file] { |
---|
54 | .gif - .jpg - .png - .xpm - .tif { |
---|
55 | set imh [image create picture -file $file] |
---|
56 | } |
---|
57 | .xbm { |
---|
58 | set fid [open $file r] |
---|
59 | set data [read $fid] |
---|
60 | close $fid |
---|
61 | set imh bitmap-$name |
---|
62 | blt::bitmap define $imh $data |
---|
63 | } |
---|
64 | } |
---|
65 | } |
---|
66 | if {"" != $imh} { |
---|
67 | set icons($name) $imh |
---|
68 | } |
---|
69 | return $imh |
---|
70 | } |
---|
71 | |
---|
72 | # ---------------------------------------------------------------------- |
---|
73 | # USAGE: Rappture::icon::data <image> ?<format>? |
---|
74 | # |
---|
75 | # Returns the bytes the represent an <image> in the requested |
---|
76 | # <format>, which can get "gif" or "jpeg". |
---|
77 | # ---------------------------------------------------------------------- |
---|
78 | proc Rappture::icon::data {image {format "gif"}} { |
---|
79 | switch -- $format { |
---|
80 | "gif" { |
---|
81 | $image export gif -data bytes |
---|
82 | } |
---|
83 | "jpeg" - "jpg" { |
---|
84 | $image export jpg -data bytes -quality 100 |
---|
85 | } |
---|
86 | default { |
---|
87 | return "" |
---|
88 | } |
---|
89 | } |
---|
90 | return $bytes |
---|
91 | } |
---|
92 | |
---|
93 | # ---------------------------------------------------------------------- |
---|
94 | # USAGE: Rappture::icon::gif_animate <delay> ?<image> <image>...? |
---|
95 | # |
---|
96 | # Takes a series if <images> and composited them into a single, |
---|
97 | # animated GIF image, with the <delay> in milliseconds between |
---|
98 | # frames. Returns binary data in GIF89a format. |
---|
99 | # ---------------------------------------------------------------------- |
---|
100 | proc Rappture::icon::gif_animate {delay args} { |
---|
101 | if {[llength $args] < 1} { |
---|
102 | error "must have at least one image for animation" |
---|
103 | } |
---|
104 | set delay [expr {round($delay*0.01)}] ;# convert to 1/100s of second |
---|
105 | set img [image create picture] |
---|
106 | $img copy [lindex $args 0] |
---|
107 | eval $img sequence append [lrange $args 1 end] |
---|
108 | $img export gif -animate -data bytes -delay $delay |
---|
109 | image delete $img |
---|
110 | return $bytes |
---|
111 | } |
---|
112 | |
---|