[126] | 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 | # ====================================================================== |
---|
| 14 | package require Itcl |
---|
| 15 | package require BLT |
---|
| 16 | |
---|
| 17 | namespace eval Rappture { # forward declaration } |
---|
| 18 | |
---|
| 19 | itcl::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 | |
---|
[785] | 26 | private variable _xmlobj "" ;# ref to lib obj with image data |
---|
| 27 | private variable _path "" ;# path in _xmlobj where data sits |
---|
[126] | 28 | private variable _image "" ;# underlying image data |
---|
[785] | 29 | private variable _hints |
---|
[126] | 30 | } |
---|
| 31 | |
---|
| 32 | # ---------------------------------------------------------------------- |
---|
| 33 | # CONSTRUCTOR |
---|
| 34 | # ---------------------------------------------------------------------- |
---|
| 35 | itcl::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 |
---|
[785] | 40 | set _path $path |
---|
[127] | 41 | set data [string trim [$xmlobj get $path.current]] |
---|
[126] | 42 | if {[string length $data] == 0} { |
---|
| 43 | set _image [image create photo] |
---|
| 44 | } else { |
---|
| 45 | set _image [image create photo -data $data] |
---|
| 46 | } |
---|
[785] | 47 | |
---|
| 48 | set _hints(note) [string trim [$_xmlobj get $_path.note.contents]] |
---|
| 49 | set _hints(tooldir) [$_xmlobj get tool.version.application.directory(tool)] |
---|
[126] | 50 | } |
---|
| 51 | |
---|
| 52 | # ---------------------------------------------------------------------- |
---|
| 53 | # DESTRUCTOR |
---|
| 54 | # ---------------------------------------------------------------------- |
---|
| 55 | itcl::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 | # ---------------------------------------------------------------------- |
---|
| 66 | itcl::body Rappture::Image::hints {{keyword ""}} { |
---|
[785] | 67 | if {$keyword != ""} { |
---|
| 68 | if {[info exists _hints($keyword)]} { |
---|
| 69 | return $_hints($keyword) |
---|
| 70 | } |
---|
| 71 | return "" |
---|
| 72 | } |
---|
| 73 | return [array get _hints] |
---|
[126] | 74 | } |
---|