Bourse aux maps

Pour faire admirer ses oeuvre ou faire son marché

(les utilitaires pour afficher ou extraire les maps sont après les collections)

[1] le logo tcl (transformé du fichier logo125.gif)

Les utilitaires

ci-après : Procédure d'affichage des maps d'un répertoire
ci-après : Affichage des maps d'une librairie
maplib : Extraction des maps d'une librairie

Procédure d'affichage des maps d'un répertoire

  # display all maps of a directory

  proc viewdir{{pattern *.map} {bg white} {fg gray} {coef 1.0}} \
  {
    # display maps
    set row 0
    set col 0
    set max 7
    set fmaps [lsort [glob $pattern]]
    foreach fmap $fmaps \
    {
      set fname [string map {.map ""} $fmap]
      set map [file2map $fmap]
      set w .$fname
      frame $w
      label $w.l -text $fname -anchor center
      button $w.b -bd 0 -highlightt 0 \
        -image [map2img $map $bg $fg $coef]
      pack $w.l $w.b -pady 2
      grid $w -row $row -column $col -padx 5 -pady 5
      if {[incr col] == $max} \
      {
        set col 0
        incr row
      }
    }
  }

Utilisation

  package require Tk
  wm title . viewdir
  # optionnel : extraction des maps d'une librairie
  #maplib vsx.mlib -uncompress *.map
  viewdir *.map

Affichage des maps d'une librairie

  # display all maps of a library

  proc viewlib {file {pattern *} {bg white} {fg gray} {coef 1.0}} \
  {
    set rc [catch \
    {
      array set {} {}
      # read header into memory
      set fp [open $file r]
      fconfigure $fp -translation binary
      if {[read $fp 4] != "UML\0"} \
      { error "'$file' is not a map lib" }
      set hsize [string trimleft [read $fp 4] 0]
      if {$hsize == ""} { set hsize 0 }
      if {![string is integer -strict $hsize]} \
      { error "'$file' is corrupted" }
      set header [split [read $fp $hsize] \0]
      foreach line $header \
      {
        foreach {name offset size} [split $line *] \
        {
          set ($name:n) $name
          set ($name:o) $offset
          set ($name:s) $size
        }
      }
      package require Tk
      catch { destroy .viewlib }
      toplevel .viewlib
      wm title .viewlib $file
      set row 0
      set col 0
      set max 7
      set names [lsort [array names {} $pattern:n]]
      foreach name $names \
      {
        set member $($name)
        set fname [string map {.map ""} $member]
        seek $fp [expr {8 + $hsize + $($member:o)}] start
        set map [split [read $fp $($member:s)] \0]
        set map [uncompress $map]
        set w .viewlib.$fname
        frame $w
        label $w.l -text $fname -anchor center
        button $w.b -bd 0 -highlightt 0 \
          -image [map2img $map $bg $fg $coef]
        pack $w.l $w.b -pady 2
        grid $w -row $row -column $col -padx 5 -pady 5
        if {[incr col] == $max} \
        {
          set col 0
          incr row
        }
      }
      close $fp
    } err]
    if {$rc == 1} { return -code error "viewlib: $err" }
  }

Utilisation

  package require Tk
  wm title . viewlib
  viewlib vsx.mlib *.map

Voir aussi

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

Discussion

Catégorie Traitement d'image