source: trunk/gui/scripts/icons.tcl @ 738

Last change on this file since 738 was 433, checked in by mmc, 18 years ago

Added animated GIF downloads for <sequence> results. Still need
a better way to produce GIFs from the input images. Need to fix
the "blt::winop quantize" operation to avoid external programs
like "djpeg".

Added an example of a <sequence> of <curve> objects as "tool2.xml"
in the zoo/sequence example dir.
File size: 13.7 KB
Line 
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
15namespace eval Rappture::icon {
16    variable iconpath [file join $RapptureGUI::library scripts images]
17    variable icons
18}
19
20# ----------------------------------------------------------------------
21# USAGE: Rappture::icon <name>
22#
23# Searches for an icon called <name> on all of the directories in
24# the search path set up by RapptureGUI::iconpath.
25# ----------------------------------------------------------------------
26proc Rappture::icon {name} {
27    variable ::Rappture::icon::iconpath
28    variable ::Rappture::icon::icons
29
30    #
31    # Already loaded? then return it directly
32    #
33    if {[info exists icons($name)]} {
34        return $icons($name)
35    }
36
37    #
38    # Search for the icon along the iconpath search path
39    #
40    set file ""
41    foreach dir $iconpath {
42        set path [file join $dir $name.*]
43        set file [lindex [glob -nocomplain $path] 0]
44        if {"" != $file} {
45            break
46        }
47    }
48
49    set imh ""
50    if {"" != $file} {
51        switch -- [file extension $file] {
52            .gif - .jpg {
53                set imh [image create photo -file $file]
54            }
55            .xbm {
56                set fid [open $file r]
57                set data [read $fid]
58                close $fid
59                set imh bitmap-$name
60                blt::bitmap define $imh $data
61            }
62        }
63    }
64    if {"" != $imh} {
65        set icons($name) $imh
66    }
67    return $imh
68}
69
70# ----------------------------------------------------------------------
71# USAGE: Rappture::icon::data <image> ?<format>?
72#
73# Returns the bytes the represent an <image> in the requested
74# <format>, which can get "gif" or "jpeg".
75# ----------------------------------------------------------------------
76proc Rappture::icon::data {image {format "gif"}} {
77    if {[catch {$image data -format $format} result]} {
78        if {"too many colors" == $result && "" != [auto_execok djpeg]} {
79            #
80            # HACK ALERT!  We should use "blt::winop quantize" to
81            #   reduce the number of colors for GIF format.  But
82            #   it has a bug right now, so we work around it like this.
83            #
84            set tmpfile /tmp/image[pid].dat
85            $image write $tmpfile -format jpeg
86            set fid [open "| djpeg -gif -quantize 250 $tmpfile" r]
87            fconfigure $fid -encoding binary -translation binary
88            set result [read $fid]
89            close $fid
90            file delete -force $tmpfile
91        } else {
92            set result ""
93        }
94    }
95    return $result
96}
97
98# ----------------------------------------------------------------------
99# USAGE: Rappture::icon::gif_animate <delay> ?<image> <image>...?
100#
101# Takes a series if <images> and composited them into a single,
102# animated GIF image, with the <delay> in milliseconds between
103# frames.  Returns binary data in GIF89a format.
104# ----------------------------------------------------------------------
105proc Rappture::icon::gif_animate {delay args} {
106    if {[llength $args] < 1} {
107        error "must have at least one image for animation"
108    }
109    set delay [expr {round($delay*0.01)}] ;# convert to 1/100s of second
110
111    set imh [lindex $args 0]
112    set bytes [data $imh gif]
113    if {[string length $bytes] == 0} {
114        return ""  ;# can't query image data -- bail out!
115    }
116    gif_parse $bytes first
117
118    set final "GIF89a"
119    gif_put_short final $first(screen-w)
120    gif_put_short final $first(screen-h)
121    gif_put_byte final $first(screen-packed)
122    gif_put_byte final $first(screen-bg)
123    gif_put_byte final $first(screen-aspect)
124    gif_put_block final $first(colors)
125
126    gif_put_byte final 0x21  ;# looping block
127    gif_put_byte final 0xFF
128    gif_put_byte final 11
129    gif_put_block final "NETSCAPE2.0"
130    gif_put_byte final 3     ;# 3 bytes in this block
131    gif_put_byte final 1     ;# turn looping on
132    gif_put_short final 0    ;# number of loops (forever)
133    gif_put_byte final 0     ;# block terminator
134
135    gif_put_byte final 0x21  ;# graphic control block
136    gif_put_byte final 0xF9
137    gif_put_byte final 4     ;# 4 bytes in this block
138    gif_put_byte final 0     ;# packed bits
139    gif_put_short final [expr {5*$delay}]  ;# delay time *0.01s
140    gif_put_byte final 0     ;# transparency index
141    gif_put_byte final 0     ;# block terminator
142
143    gif_put_byte final 0x2C  ;# image block
144    gif_put_short final $first(im-0-left)
145    gif_put_short final $first(im-0-top)
146    gif_put_short final $first(im-0-wd)
147    gif_put_short final $first(im-0-ht)
148    gif_put_byte final $first(im-0-packed)
149    if {($first(im-0-packed) & 0x80) != 0} {
150        gif_put_block final $first(im-0-colors)
151    }
152    gif_put_block final $first(im-0-data)
153
154    foreach imh [lrange $args 1 end] {
155        catch {unset gif}
156        gif_parse [data $imh gif] gif
157
158        gif_put_byte final 0x21     ;# graphic control block
159        gif_put_byte final 0xF9
160        gif_put_byte final 4        ;# 4 bytes in this block
161        gif_put_byte final 0        ;# packed bits
162        gif_put_short final $delay  ;# delay time *0.01s
163        gif_put_byte final 0        ;# transparency index
164        gif_put_byte final 0        ;# block terminator
165
166        gif_put_byte final 0x2C     ;# image block
167        gif_put_short final $gif(im-0-left)
168        gif_put_short final $gif(im-0-top)
169        gif_put_short final $gif(im-0-wd)
170        gif_put_short final $gif(im-0-ht)
171
172        if {[string length $gif(im-0-colors)] > 0} {
173            gif_put_byte final $gif(im-0-packed)
174            gif_put_block final $gif(im-0-colors)
175        } else {
176            set packed [expr {($gif(im-0-packed) & 0xF8)
177                | ($gif(screen-packed) & 0x87)}]
178            gif_put_byte final $packed
179            gif_put_block final $gif(colors)
180        }
181        gif_put_block final $gif(im-0-data)
182    }
183
184    gif_put_byte final 0x3B  ;# terminate GIF
185
186    return $final
187}
188
189# ----------------------------------------------------------------------
190# USAGE: Rappture::icon::gif_parse <gifImageData> <array>
191#
192# Takes the data from a GIF image, parses it into various components,
193# and returns the information in the <array> in the calling scope.
194# ----------------------------------------------------------------------
195proc Rappture::icon::gif_parse {gifImageData arrayVar} {
196    upvar $arrayVar data
197    if {[string range $gifImageData 0 2] != "GIF"} {
198        error "not GIF data"
199    }
200    set data(version) [string range $gifImageData 0 5]
201    set pos 6
202
203    set data(screen-w) [gif_get_short $gifImageData pos]
204    set data(screen-h) [gif_get_short $gifImageData pos]
205    set data(screen-packed) [gif_get_byte $gifImageData pos]
206    set data(screen-bg) [gif_get_byte $gifImageData pos]
207    set data(screen-aspect) [gif_get_byte $gifImageData pos]
208
209    set ctsize [expr {3*(1 << ($data(screen-packed) & 0x07)+1)}]
210    set data(colors) [gif_get_block $gifImageData pos $ctsize]
211
212    set n 0
213    while {1} {
214        set ctrl [gif_get_byte $gifImageData pos]
215        switch -- [format "0x%02X" $ctrl] {
216          0x21 {
217            set ext [gif_get_byte $gifImageData pos]
218            switch -- [format "0x%02X" $ext] {
219              0xF9 {
220                # graphic control
221                set bsize [gif_get_byte $gifImageData pos]
222                set data(gc-$n-packed) [gif_get_byte $gifImageData pos]
223                set data(gc-$n-delay) [gif_get_short $gifImageData pos]
224                set data(gc-$n-transp) [gif_get_byte $gifImageData pos]
225                set bterm [gif_get_byte $gifImageData pos]
226                if {$bterm != 0} { error "bad magic $bterm" }
227              }
228              0xFE {
229                # comment extension -- skip and ignore
230                while {1} {
231                    set count [gif_get_byte $gifImageData pos]
232                    if {$count == 0} {
233                        break
234                    }
235                    incr pos $count
236                }
237              }
238              0xFF {
239                set bsize [gif_get_byte $gifImageData pos]
240                set data(app-name) [gif_get_block $gifImageData pos $bsize]
241                set data(app-bytes) ""
242                while {1} {
243                    set count [gif_get_byte $gifImageData pos]
244                    gif_put_byte data(app-bytes) $count
245                    if {$count == 0} {
246                        break
247                    }
248                    gif_put_block data(app-bytes) \
249                        [gif_get_block $gifImageData pos $count]
250                }
251              }
252              default {
253                error [format "unknown extension code 0x%02X" $ext]
254              }
255            }
256          }
257          0x2C {
258            # image data
259            set data(im-$n-left) [gif_get_short $gifImageData pos]
260            set data(im-$n-top) [gif_get_short $gifImageData pos]
261            set data(im-$n-wd) [gif_get_short $gifImageData pos]
262            set data(im-$n-ht) [gif_get_short $gifImageData pos]
263            set data(im-$n-packed) [gif_get_byte $gifImageData pos]
264            set data(im-$n-colors) ""
265            if {($data(im-$n-packed) & 0x80) != 0} {
266                set ctsize [expr {3*(1 << ($data(im-$n-packed) & 0x07)+1)}]
267                set data(im-$n-colors) [gif_get_block $gifImageData pos $ctsize]
268            }
269   
270            set data(im-$n-data) ""
271            gif_put_byte data(im-$n-data) \
272                [gif_get_byte $gifImageData pos] ;# lwz min code size
273            while {1} {
274                set count [gif_get_byte $gifImageData pos]
275                gif_put_byte data(im-$n-data) $count
276                if {$count == 0} {
277                    break
278                }
279                gif_put_block data(im-$n-data) \
280                    [gif_get_block $gifImageData pos $count]
281            }
282            incr n
283          }
284          0x3B {
285            # end of image data
286            break
287          }
288          default {
289            error [format "unexpected control byte 0x%02X" $ctrl]
290          }
291        }
292    }
293}
294
295# ----------------------------------------------------------------------
296# USAGE: Rappture::icon::gif_get_byte <buffer> <posVar>
297#
298# Extracts one byte of information from the <buffer> at the index
299# specified by <posVar> in the calling scope.  Increments <posVar>
300# to move past the byte and returns the byte of information.
301# ----------------------------------------------------------------------
302proc Rappture::icon::gif_get_byte {buffer posVar} {
303    upvar $posVar pos
304    set byte [string range $buffer $pos $pos]
305    incr pos 1
306
307    binary scan $byte c rval
308    if {$rval < 0} {incr rval 256}
309    return $rval
310}
311
312# ----------------------------------------------------------------------
313# USAGE: Rappture::icon::gif_get_short <buffer> <posVar>
314#
315# Extracts one short int of information from the <buffer> at the index
316# specified by <posVar> in the calling scope.  Increments <posVar>
317# to move past the int and returns the information.
318# ----------------------------------------------------------------------
319proc Rappture::icon::gif_get_short {buffer posVar} {
320    upvar $posVar pos
321    set bytes [string range $buffer $pos [expr {$pos+1}]]
322    incr pos 2
323
324    binary scan $bytes s rval
325    if {$rval < 0} {incr rval 65536}
326    return $rval
327}
328
329# ----------------------------------------------------------------------
330# USAGE: Rappture::icon::gif_get_block <buffer> <posVar> <size>
331#
332# Extracts <size> bytes of information from the <buffer> at the index
333# specified by <posVar> in the calling scope.  Increments <posVar>
334# to move past the byte and returns the byte of information.
335# ----------------------------------------------------------------------
336proc Rappture::icon::gif_get_block {buffer posVar size} {
337    upvar $posVar pos
338    set bytes [string range $buffer $pos [expr {$pos+$size-1}]]
339    incr pos $size
340    return $bytes
341}
342
343# ----------------------------------------------------------------------
344# USAGE: Rappture::icon::gif_put_byte <buffer> <charVal>
345#
346# Appends one byte of information onto the <buffer> in the calling
347# scope.  The <charVal> is an integer in the range 0-255.  It is
348# formated as a single byte and appended onto the buffer.
349# ----------------------------------------------------------------------
350proc Rappture::icon::gif_put_byte {bufferVar char} {
351    upvar $bufferVar buffer
352    append buffer [binary format c $char]
353}
354
355# ----------------------------------------------------------------------
356# USAGE: Rappture::icon::gif_put_short <buffer> <shortVal>
357#
358# Appends one byte of information onto the <buffer> in the calling
359# scope.  The <shortVal> is an integer in the range 0-65535.  It is
360# formated as a 2-byte short integer and appended onto the buffer.
361# ----------------------------------------------------------------------
362proc Rappture::icon::gif_put_short {bufferVar short} {
363    upvar $bufferVar buffer
364    append buffer [binary format s $short]
365}
366
367# ----------------------------------------------------------------------
368# USAGE: Rappture::icon::gif_put_block <buffer> <val>
369#
370# Appends a string <val> onto the <buffer> in the calling scope.
371# ----------------------------------------------------------------------
372proc Rappture::icon::gif_put_block {bufferVar val} {
373    upvar $bufferVar buffer
374    append buffer $val
375}
Note: See TracBrowser for help on using the repository browser.