home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / BWidget-1.2 / bitmap.tcl < prev    next >
Encoding:
Text File  |  2000-11-02  |  2.7 KB  |  93 lines
  1. # ------------------------------------------------------------------------------
  2. #  bitmap.tcl
  3. #  This file is part of Unifix BWidget Toolkit
  4. #  $Id: bitmap.tcl,v 1.1.1.1 1996/02/22 06:05:55 daniel Exp $
  5. # ------------------------------------------------------------------------------
  6. #  Index of commands:
  7. #     - Bitmap::get
  8. #     - Bitmap::_init
  9. # ------------------------------------------------------------------------------
  10. namespace 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. # ------------------------------------------------------------------------------
  27. proc 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. # ------------------------------------------------------------------------------
  76. proc 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.  
  92. Bitmap::_init
  93.