source: trunk/BWidget-1.2.1/bitmap.tcl @ 931

Last change on this file since 931 was 931, checked in by toby, 11 years ago

include rest of files

File size: 2.6 KB
Line 
1# ------------------------------------------------------------------------------
2#  bitmap.tcl
3#  This file is part of Unifix BWidget Toolkit
4#  $Id: bitmap.tcl,v 1.2 1999/05/25 08:28:10 eric Exp $
5# ------------------------------------------------------------------------------
6#  Index of commands:
7#     - Bitmap::get
8#     - Bitmap::_init
9# ------------------------------------------------------------------------------
10namespace eval Bitmap {
11    variable path
12    variable _bmp
13    variable _types {
14        photo  .gif
15        photo  .ppm
16        bitmap .xbm
17        photo  .xpm
18    }
19
20    proc use {} {}
21}
22
23
24# ------------------------------------------------------------------------------
25#  Command Bitmap::get
26# ------------------------------------------------------------------------------
27proc Bitmap::get { name } {
28    variable path
29    variable _bmp
30    variable _types
31
32    if {[info exists _bmp($name)]} {
33        return $_bmp($name)
34    }
35
36    # --- Nom de fichier avec extension ------------------------------------------------------
37    set ext [file extension $name]
38    if { $ext != "" } {
39        if { ![info exists _bmp($ext)] } {
40            error "$ext not supported"
41        }
42
43        if { [file exists $name] } {
44            if {![string compare $ext ".xpm"]} {
45                set _bmp($name) [xpm-to-image $name]
46                return $_bmp($name)
47            }
48            if {![catch {set _bmp($name) [image create $_bmp($ext) -file $name]}]} {
49                return $_bmp($name)
50            }
51        }
52    }
53
54    foreach dir $path {
55        foreach {type ext} $_types {
56            if { [file exists [file join $dir $name$ext]] } {
57                if {![string compare $ext ".xpm"]} {
58                    set _bmp($name) [xpm-to-image [file join $dir $name$ext]]
59                    return $_bmp($name)
60                } else {
61                    if {![catch {set _bmp($name) [image create $type -file [file join $dir $name$ext]]}]} {
62                        return $_bmp($name)
63                    }
64                }
65            }
66        }
67    }
68
69    return -code error "$name not found"
70}
71
72
73# ------------------------------------------------------------------------------
74#  Command Bitmap::_init
75# ------------------------------------------------------------------------------
76proc Bitmap::_init { } {
77    global   env
78    variable path
79    variable _bmp
80    variable _types
81
82    set path [list "." [file join $env(BWIDGET_LIBRARY) images]]
83    set supp [image types]
84    foreach {type ext} $_types {
85        if { [lsearch $supp $type] != -1} {
86            set _bmp($ext) $type
87        }
88    }
89}
90
91
92Bitmap::_init
Note: See TracBrowser for help on using the repository browser.