source: branches/blt4/gui/scripts/icons.tcl @ 1649

# ----------------------------------------------------------------------
#  COMPONENT: icons - utility for loading icons from a library
#
#  This utility makes it easy to load GIF and XBM files installed
#  in a library in the final installation.  It is used throughout
#  the Rappture GUI, whenever an icon is needed.
# ======================================================================
#  AUTHOR:  Michael McLennan, Purdue University
#  Copyright (c) 2004-2005  Purdue Research Foundation
#
#  See the file "license.terms" for information on usage and
#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# ======================================================================

namespace eval Rappture::icon {
    variable iconpath [file join $RapptureGUI::library scripts images]
    variable icons
}

# ----------------------------------------------------------------------
# USAGE: Rappture::icon <name>
#
# Searches for an icon called <name> on all of the directories in
# the search path set up by RapptureGUI::iconpath.
# ----------------------------------------------------------------------
proc Rappture::icon {name} {
    variable ::Rappture::icon::iconpath
    variable ::Rappture::icon::icons

    #
    # Already loaded? then return it directly
    #
    if {[info exists icons($name)]} {
        return $icons($name)
    }

    #
    # Search for the icon along the iconpath search path
    #
    set file ""
    foreach dir $iconpath {
        set path [file join $dir $name.*]
        set file [lindex [glob -nocomplain $path] 0]
        if {"" != $file} {
            break
        }
    }

    set imh ""
    if {"" != $file} {
        switch -- [file extension $file] {
            .gif - .jpg - .png - .xpm - .tif {
                set imh [image create picture -file $file]
            }
            .xbm {
                set fid [open $file r]
                set data [read $fid]
                close $fid
                set imh bitmap-$name
                blt::bitmap define $imh $data
            }
        }
    }
    if {"" != $imh} {
        set icons($name) $imh
    }
    return $imh
}

# ----------------------------------------------------------------------
# USAGE: Rappture::icon::data <image> ?<format>?
#
# Returns the bytes the represent an <image> in the requested
# <format>, which can get "gif" or "jpeg".
# ----------------------------------------------------------------------
proc Rappture::icon::data {image {format "gif"}} {
    switch -- $format {
        "gif" {
            $image export gif -data bytes
        }
        "jpeg" - "jpg" {
            $image export jpg -data bytes -quality 100
        }
        default {
            return ""
        }
    }       
    return $bytes
}

# ----------------------------------------------------------------------
# USAGE: Rappture::icon::gif_animate <delay> ?<image> <image>...?
#
# Takes a series if <images> and composited them into a single,
# animated GIF image, with the <delay> in milliseconds between
# frames.  Returns binary data in GIF89a format.
# ----------------------------------------------------------------------
proc Rappture::icon::gif_animate {delay args} {
    if {[llength $args] < 1} {
        error "must have at least one image for animation"
    }
    set delay [expr {round($delay*0.01)}] ;# convert to 1/100s of second
    set img [image create picture]
    $img copy [lindex $args 0]
    eval $img append [lrange $args 1 end]
    $img export gif -animated -data bytes -delay $delay
    image delete $img
    return $bytes
}