source: trunk/gui/scripts/image.tcl @ 829

Last change on this file since 829 was 785, checked in by mmc, 17 years ago

Added support for a <note> on the output side of an <image> object.
This was needed for app-nsopticsjr. We should experiement a little
more with this, design it properly, and apply the same idea to all
output items.

File size: 2.7 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: image - represents a picture image
3#
4#  This object represents a Tk image.  It is convenient to have it
5#  expressed as an Itcl object, so it can be managed just like a
6#  curve, table, etc.
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# ======================================================================
14package require Itcl
15package require BLT
16
17namespace eval Rappture { # forward declaration }
18
19itcl::class Rappture::Image {
20    constructor {xmlobj path} { # defined below }
21    destructor { # defined below }
22
23    public method tkimage {} { return $_image }
24    public method hints {{keyword ""}}
25
26    private variable _xmlobj ""  ;# ref to lib obj with image data
27    private variable _path ""    ;# path in _xmlobj where data sits
28    private variable _image ""   ;# underlying image data
29    private variable _hints
30}
31
32# ----------------------------------------------------------------------
33# CONSTRUCTOR
34# ----------------------------------------------------------------------
35itcl::body Rappture::Image::constructor {xmlobj path} {
36    if {![Rappture::library isvalid $xmlobj]} {
37        error "bad value \"$xmlobj\": should be LibraryObj"
38    }
39    set _xmlobj $xmlobj
40    set _path $path
41    set data [string trim [$xmlobj get $path.current]]
42    if {[string length $data] == 0} {
43        set _image [image create photo]
44    } else {
45        set _image [image create photo -data $data]
46    }
47
48    set _hints(note) [string trim [$_xmlobj get $_path.note.contents]]
49    set _hints(tooldir) [$_xmlobj get tool.version.application.directory(tool)]
50}
51
52# ----------------------------------------------------------------------
53# DESTRUCTOR
54# ----------------------------------------------------------------------
55itcl::body Rappture::Image::destructor {} {
56    image delete $_image
57}
58
59# ----------------------------------------------------------------------
60# USAGE: hints ?<keyword>?
61#
62# Returns a list of key/value pairs for various hints about showing
63# this image.  If a particular <keyword> is specified, then it returns
64# the hint for that <keyword>, if it exists.
65# ----------------------------------------------------------------------
66itcl::body Rappture::Image::hints {{keyword ""}} {
67    if {$keyword != ""} {
68        if {[info exists _hints($keyword)]} {
69            return $_hints($keyword)
70        }
71        return ""
72    }
73    return [array get _hints]
74}
Note: See TracBrowser for help on using the repository browser.