créer une image XPM à partir d'une map

 

ulis, 2006-02-04. Une procédure pour créer une image PPM à partir d'une map.

(la transparence est prise en compte)


Pourquoi

Pour élargir le champ d'action des maps aux images standards.


Comment

En rajoutant la liste des couleurs en fonction de l'indice de luminosité :

  /* XPM */
  static char * map_xpm = {
  /* width height number_of_colors chars_per_pixel */
  "50 20 16 1",
  /* intensity levels */
  "0  c none",
  "1  c #111111",
  "2  c #222222",
  "3  c #333333",
  "4  c #444444",
  "5  c #555555",
  "6  c #666666",
  "7  c #777777",
  "8  c #888888",
  "9  c #999999",
  "a  c #aaaaaa",
  "b  c #bbbbbb",
  "c  c #cccccc",
  "d  c #dddddd",
  "e  c #eeeeee",
  "f  c #ffffff",
 /* map */
 "0aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa0",
 "aaeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeaa",
 "aeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeea",
 "aeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeea",
 "aeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeea",
 "aeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeea",
 "aeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeea",
 "aeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeea",
 "aeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeea",
 "aeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeea",
 "adddddddddddddddddddddddddddddddddddddddddddddddda",
 "adddddddddddddddddddddddddddddddddddddddddddddddda",
 "adddddddddddddddddddddddddddddddddddddddddddddddda",
 "adddddddddddddddddddddddddddddddddddddddddddddddda",
 "adddddddddddddddddddddddddddddddddddddddddddddddda",
 "adccccccccccccccccccccccccccccccccccccccccccccccda",
 "adccccccccccccccccccccccccccccccccccccccccccccccda",
 "adccccccccccccccccccccccccccccccccccccccccccccccda",
 "aaddddddddddddddddddddddddddddddddddddddddddddddaa",
 "0aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa0",
 };

Utilisation

création d'une image XPM en mémoire

  map2xpm map bg fg coef
  # map : la map
  # bg : la couleur d'arrière-plan. Sa valeur par défaut est 'white'.
  # fg : la couleur d'avant-plan. Sa valeur par défaut est 'gray'.
  # coef : le coefficient de correction de luminosité. Sa valeur par défaut est '1.0'.

création d'une image XPM dans un fichier

  map2xpm file bg fg coef
  # file : le nom du fichier contenant la map
  # bg : la couleur d'arrière-plan. Sa valeur par défaut est 'white'.
  # fg : la couleur d'avant-plan. Sa valeur par défaut est 'gray'.
  # coef : le coefficient de correction de luminosité. Sa valeur par défaut est '1.0'.
  -> le fichier ppm créé a pour nom : file.ppm

La procédure

  # create a xpm from a map

  proc map2xpm {map {bg white} {fg gray} {coef 1.0}} \
  {
    # get map
    if {[llength $map] == 1} \
    {
      set rc [catch \
      {
        set file $map
        set fp [open $file]
        fconfigure $fp -translation binary
        set map [read $fp]
        close $fp
      } err]
      if {$rc == 1} { return -code error "map2xpm: $err" }
    }
    # get transparent & foreground digit
    set td ""
    set fd ""
    foreach {td fd} [split [lindex $map 0] {}] break
    if {$fd != "" && $fd != $td} \
    {
      foreach {r g b} [winfo rgb . $fg] break
      foreach c {r g b} \
      {
        set v [set $c]
        set v [expr {$v / 256}]
        if {$v > 255} { set v 255 }
        set $c [format %2.2x $v]
      }
      set fg #$r$g$b
    }
    # compute bg RGB components
    foreach {R G B} [winfo rgb . $bg] break
    foreach C {R G B} \
    {
      set v [set $C]
      set $C [expr {$v * $coef / 256}]
    }
    # get all colors
    array set {} {}
    for {set i 0} {$i < 16} {incr i} \
    {
      set digit [format %x $i]
      switch $digit \
        $td { set ($digit) "$digit  c none" } \
        $fd { set ($digit) "$digit  c $fg" } \
        default \
        {
          foreach C {R G B} c {r g b} \
          {
            set v [set $C]
            set v [expr {round($v * $i / 255.0)}]
            set $c [format %x $v]
          }
          set ($digit) "$digit  c #$r$r$g$g$b$b"
        }
    }
    # get sizes
    set width [string length [lindex $map 1]]
    set height [llength [lrange $map 1 end]]
    # build xpm image
    set xpm [list "/* XPM */"]
    lappend xpm "static char * map_xpm[] = {"
    lappend xpm "/* width height number_of_colors chars_per_pixel */"
    lappend xpm "\"$width $height 16 1\","
    lappend xpm "/* colors */"
    foreach color [lsort [array names {}]] \
    { lappend xpm "\"$($color)\"," }
    lappend xpm "/* pixels */"
    foreach line [lrange $map 1 end] \
    { lappend xpm "\"$line\"," }
    lappend xpm "};"
    # create xpm file or return xpm image
    set xpm [join $xpm \n]
    if {[info exists file]} \
    {
      set fn $file.xpm
      set fp [open $fn w]
      puts -nonewline $fp $xpm
      close $fp
    } \
    else \
    { return $xpm }
  }

La démo

    package require Tk
    package require Img

    set map \
    {
      0
      0aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa0
      aaeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeaa
      aeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeea
      aeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeea
      aeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeea
      aeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeea
      aeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeea
      aeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeea
      aeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeea
      aeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeea
      adddddddddddddddddddddddddddddddddddddddddddddddda
      adddddddddddddddddddddddddddddddddddddddddddddddda
      adddddddddddddddddddddddddddddddddddddddddddddddda
      adddddddddddddddddddddddddddddddddddddddddddddddda
      adddddddddddddddddddddddddddddddddddddddddddddddda
      adccccccccccccccccccccccccccccccccccccccccccccccda
      adccccccccccccccccccccccccccccccccccccccccccccccda
      adccccccccccccccccccccccccccccccccccccccccccccccda
      aaddddddddddddddddddddddddddddddddddddddddddddddaa
      0aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa0
    }

    set img [map2img $map]
    label .l -image $img
    pack .l
    $img write image.xpm -format xpm
    map2file $map image.map
    map2xpm image.map
    set img [image create photo -file image.map.xpm]
    label .l2 -image $img
    pack .l2

Voir aussi


Discussion


Catégorie Exemple | Catégorie Traitement d'image