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::searchpath ?<dirname> <dirname>...? |
---|
24 | # |
---|
25 | # Adds one or more directories onto the icon path searched when |
---|
26 | # locating icons in Rappture::icon. You can do the same thing by |
---|
27 | # lappend'ing onto the "iconpath" variable, but this call avoids |
---|
28 | # duplicates and makes it easier |
---|
29 | # ---------------------------------------------------------------------- |
---|
30 | proc Rappture::icon::searchpath {args} { |
---|
31 | variable iconpath |
---|
32 | foreach dir $args { |
---|
33 | if {[file isdirectory $dir]} { |
---|
34 | if {[lsearch $iconpath $dir] < 0} { |
---|
35 | lappend iconpath $dir |
---|
36 | } |
---|
37 | } |
---|
38 | } |
---|
39 | } |
---|
40 | |
---|
41 | # ---------------------------------------------------------------------- |
---|
42 | # USAGE: Rappture::icon <name> |
---|
43 | # |
---|
44 | # Searches for an icon called <name> on all of the directories in |
---|
45 | # the search path set up by RapptureGUI::iconpath. |
---|
46 | # ---------------------------------------------------------------------- |
---|
47 | proc Rappture::icon {name} { |
---|
48 | variable ::Rappture::icon::iconpath |
---|
49 | variable ::Rappture::icon::icons |
---|
50 | |
---|
51 | # |
---|
52 | # Already loaded? then return it directly |
---|
53 | # |
---|
54 | if {[info exists icons($name)]} { |
---|
55 | return $icons($name) |
---|
56 | } |
---|
57 | |
---|
58 | # |
---|
59 | # Search for the icon along the iconpath search path |
---|
60 | # |
---|
61 | set file "" |
---|
62 | foreach dir $iconpath { |
---|
63 | set path [file join $dir $name.*] |
---|
64 | set file [lindex [glob -nocomplain $path] 0] |
---|
65 | if {"" != $file} { |
---|
66 | break |
---|
67 | } |
---|
68 | } |
---|
69 | |
---|
70 | set imh "" |
---|
71 | if {"" != $file} { |
---|
72 | switch -- [file extension $file] { |
---|
73 | .gif - .jpg - .png - .xpm - .tif { |
---|
74 | set imh [image create picture -file $file] |
---|
75 | } |
---|
76 | .xbm { |
---|
77 | set fid [open $file r] |
---|
78 | set data [read $fid] |
---|
79 | close $fid |
---|
80 | set imh bitmap-$name |
---|
81 | blt::bitmap define $imh $data |
---|
82 | } |
---|
83 | } |
---|
84 | } |
---|
85 | if {"" != $imh} { |
---|
86 | set icons($name) $imh |
---|
87 | } |
---|
88 | return $imh |
---|
89 | } |
---|
90 | |
---|
91 | # ---------------------------------------------------------------------- |
---|
92 | # USAGE: Rappture::icon::data <image> ?<format>? |
---|
93 | # |
---|
94 | # Returns the bytes the represent an <image> in the requested |
---|
95 | # <format>, which can get "gif" or "jpeg". |
---|
96 | # ---------------------------------------------------------------------- |
---|
97 | proc Rappture::icon::data {image {format "gif"}} { |
---|
98 | switch -- $format { |
---|
99 | "gif" { |
---|
100 | $image export gif -data bytes |
---|
101 | } |
---|
102 | "jpeg" - "jpg" { |
---|
103 | $image export jpg -data bytes -quality 100 |
---|
104 | } |
---|
105 | default { |
---|
106 | return "" |
---|
107 | } |
---|
108 | } |
---|
109 | return $bytes |
---|
110 | } |
---|
111 | |
---|
112 | # ---------------------------------------------------------------------- |
---|
113 | # USAGE: Rappture::icon::gif_animate <delay> ?<image> <image>...? |
---|
114 | # |
---|
115 | # Takes a series if <images> and composited them into a single, |
---|
116 | # animated GIF image, with the <delay> in milliseconds between |
---|
117 | # frames. Returns binary data in GIF89a format. |
---|
118 | # ---------------------------------------------------------------------- |
---|
119 | proc Rappture::icon::gif_animate {delay args} { |
---|
120 | if {[llength $args] < 1} { |
---|
121 | error "must have at least one image for animation" |
---|
122 | } |
---|
123 | set delay [expr {round($delay*0.01)}] ;# convert to 1/100s of second |
---|
124 | set img [image create picture] |
---|
125 | $img copy [lindex $args 0] |
---|
126 | eval $img sequence append [lrange $args 1 end] |
---|
127 | $img export gif -animate -data bytes -delay $delay |
---|
128 | image delete $img |
---|
129 | return $bytes |
---|
130 | } |
---|
131 | |
---|