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

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

(l'indice de transparence est remplacé par la couleur 'black' = #000000)

Pourquoi

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

Comment

En traduisant une map en image format Tk puis en image PPM.

Utilisation

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

  map2ppm 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 PPM dans un fichier

  map2ppm 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 ppm from a map

  proc map2ppm {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 "map2ppm: $err" }
    }
    # get transparent & foreground digit
    set td ""
    set fd ""
    foreach {td fd} [split [lindex $map 0] {}] break
    # compute RGB components
      # transparent color
    set td_0 [format %c 0]
      # foreground color
    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 fg$c $v
        set fg_$c [format %c $v]
      }
    }
      # background color
    foreach {r g b} [winfo rgb . $bg] break
    foreach c {r g b} \
    {
      set v [set $c]
      set v [expr {$v * $coef / 256}]
      set bg_$c $v
    }
    # get sizes
    set width [string length [lindex $map 1]]
    set height [llength [lrange $map 1 end]]
    # build ppm image
    set ppm "P6\n"
    #append ppm "#created with map2ppm\n"
    append ppm "$width $height\n"
    append ppm "255\n"
    foreach line [lrange $map 1 end] \
    {
      foreach pix [split $line {}] \
      {
        switch -- $pix \
          $td     { append ppm $td_0 $td_0 $td_0 } \
          $fd     { append ppm $fg_r $fg_g $fg_b } \
          default \
          {
            foreach c {r g b} \
            {
              set v [set bg_$c]
              eval set digit 0x$pix$pix
              set v [expr {round($v * $digit / 256.0)}]
              if {$v > 255} { set v 255 }
              append ppm [format %c $v]
            }
          }
      }
    }
    # create ppm file or return ppm image
    if {[info exists file]} \
    {
      set fn $file.ppm
      set fp [open $fn w]
      fconfigure $fp -translation binary
      puts -nonewline $fp $ppm
      close $fp
    } \
    else \
    { return $ppm }
  }

La démo

    package require Tk

    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.ppm -format ppm
    map2file $map image.map
    map2ppm image.map
    set img [image create photo -file image.map.ppm]
    label .l2 -image $img
    pack .l2

Voir aussi

map pour la définition d'une map et les possibilités d'une map

Discussion

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