Edit redimensionner une map

redimensionner une map

[ulis], 2006-01-29. Une procédure pour redimensionner une map.

----
'''Pourquoi'''

Pour avoir des images de toutes les dimensions. En particulier pour faire de beaux boutons, comme c'est à la mode.

----
'''Comment'''

En ajoutant/retranchant des lignes/colonnes dans la map.
----
'''Utilisation'''

sizemap map width height {keep 4}
  # map : une map
  # width : la nouvelle largeur (ou 0 pour ne pas la changer)
  # height : la nouvelle hauteur (ou 0 pour ne pas la changer)
  # keep : largeur de la bordure à ne pas toucher (4 pixels par défaut)

----
'''La procédure'''

# size a map
  
  proc sizemap {map width height {keep 4}} \
  {
    set keep1 [expr {$keep - 1}]
    set keep2 [expr {$keep * 2}]
    # size width
    set maxy [llength $map]; incr maxy -1
    if {$width > 0} \
    {
      set maxx [string length [lindex $map 1]]
      if {$width < $keep2 + 1} \
      {
        # xtrem shrink
        if {$maxx > $keep2} \
        {
          set map2 [lindex $map 0]
          for {set i 1} {$i <= $maxy} {incr i} \
          {
            # keep only first & last
            set line [lindex $map $i]
            set line2 [string range $line 0 $keep1]
            append line2 [string range $line end-$keep1 end]
            lappend map2 $line2
          }
          set map $map2
        }
      } \
      elseif {$width < $maxx} \
      {
        # shrink
        set map2 [lindex $map 0]
        set step [expr {double($maxx - $keep2) / ($maxx - $width + 1)}]
        for {set i 1} {$i <= $maxy} {incr i} \
        {
          set line [lindex $map $i]
          set line2 [string range $line 0 $keep1]
          set ip $keep
          set p $keep
          # suppress chars between line[2] & line[end-2]
          while {($p + $step + 1 - $maxx + $keep) < 1.e-5} \
          {
            set iq [expr {int(ceil($p + $step - 1))}]
            append line2 [string range $line $ip $iq]
            while {($p + $step - $iq - 1) < 1.e-5} \
            { 
              set line2 [string range $line2 0 end-1]
              set p [expr {$p + $step}]
            }
            set ip [incr iq]
          }
          append line2 [string range $line $ip end]
          lappend map2 $line2
        }
        set map $map2
      } \
      elseif {$width > $maxx} \
      {
        # extend
        set map2 [lindex $map 0]
        set step [expr {double($maxx - $keep2) / ($width - $maxx)}]
        for {set i 1} {$i <= $maxy} {incr i} \
        {
          set line [lindex $map $i]
          set line2 [string range $line 0 $keep1]
          set ip $keep
          set p $keep
          # intersperse new chars between [lindex $line $keep1] & [lindex $line end-$keep1]
          while {($p + $step - $maxx + $keep) < 1.e-5} \
          {
            set iq [expr {int(ceil($p + $step - 1))}]
            append line2 [string range $line $ip $iq]
            while {($p + $step - $iq - 1) < 1.e-5} \
            { 
              append line2 [string index $line2 end]
              set p [expr {$p + $step}]
            }
            set ip [incr iq]
          }
          append line2 [string range $line $ip end]
          lappend map2 $line2
        }
        set map $map2
      }
    }
    # size height
    if {$height > 0} \
    {
      set keep3 [expr {$keep + 1}]
      if {$height < $keep2 + 1} \
      {
        # xtrem shrink
        if {$maxy > $keep2} \
        {
          set map2 [lrange $map 0 $keep]
          set map2 [concat $map2 [lrange $map end-$keep1 end]]
          set map $map2
        }
      } \
      elseif {$height < $maxy} \
      {
        # shrink
        set map2 [lrange $map 0 $keep]
        set step [expr {double($maxy - $keep2) / ($maxy - $height + 1)}]
        set ip $keep3
        set p $keep3
        # intersperse new lines between [lindex $map $keep] & [lindex $map end-$keep1]
        while {($p + $step - $maxy + $keep) < 1.e-5} \
        {
          set iq [expr {int(ceil($p + $step - 1))}]
          set map2 [concat $map2 [lrange $map $ip $iq]]
          while {($p + $step - $iq - 1) < 1.e-5} \
          { 
            set map2 [lrange $map2 0 end-1]
            set p [expr {$p + $step}]
          }
          set ip [incr iq]
        }
        set map2 [concat $map2 [lrange $map $ip end]]
        set map $map2
      } \
      elseif {$height > $maxy} \
      {
        # extend
        set map2 [lrange $map 0 $keep]
        set step [expr {double($maxy - $keep2) / ($height - $maxy)}]
        set ip $keep3
        set p $keep3
        # intersperse new lines between [lindex $map $keep] & [lindex $map end-$keep1]
        while {($p + $step - 1 - $maxy + $keep) < 1.e-5} \
        {
          set iq [expr {int(ceil($p + $step - 1))}]
          set map2 [concat $map2 [lrange $map $ip $iq]]
          while {($p + $step - $iq - 1) < 1.e-5} \
          { 
            lappend map2 [lindex $map2 end]
            set p [expr {$p + $step}]
          }
          set ip [incr iq]
        }
        set map2 [concat $map2 [lrange $map $ip end]]
        set map $map2
      }
    }
    return $map
  }
  
----
'''Démo'''

set map \
    {
      0
      0000aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa0000
      00aaddddddddddddddddddddddddddddddddddddddddddaa00
      0adddddddddddddddddddddddddddddddddddddddddddddda0
      0adddddddddddddddddddddddddddddddddddddddddddddda0
      adddddddddddddddddddddddddddddddddddddddddddddddda
      adddddddddddddddddddddddddddddddddddddddddddddddda
      adddddddddddddddddddddddddddddddddddddddddddddddda
      adddddddddddddddddddddddddddddddddddddddddddddddda
      adddddddddddddddddddddddddddddddddddddddddddddddda
      adddddddddddddddddddddddddddddddddddddddddddddddda
      adddddddddddddddddddddddddddddddddddddddddddddddda
      9cccccccccccccccccccccccccccccccccccccccccccccccc9
      9cccccccccccccccccccccccccccccccccccccccccccccccc9
      9cccccccccccccccccccccccccccccccccccccccccccccccc9
      9cccccccccccccccccccccccccccccccccccccccccccccccc9
      9cccccccccccccccccccccccccccccccccccccccccccccccc9
      09cccccccccccccccccccccccccccccccccccccccccccccc90
      09cccccccccccccccccccccccccccccccccccccccccccccc90
      0099dddddddddddddddddddddddddddddddddddddddddd9900
      00009999999999999999999999999999999999999999990000
    }
    
    package require Tk
    
    wm title . resizemap
    set row 0
    set col 0
    foreach hh {10 20 40} \
    {
      foreach ww {25 50 100} \
      {
        set w .${ww}x$hh
        frame $w
        label $w.l -text "$ww x $hh" -anchor center
        button $w.b -bd 0 -highlightt 0 \
          -image [map2img [sizemap $map $ww $hh]]
        pack $w.l $w.b -pady 2
        grid $w -row $row -column $col -padx 10 -pady 10
        if {[incr col] == 3} \
        {
          set col 0
          incr row
        }
      }
    }

----
'''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]

Dernière modification le 28 juin 2010 à 11:11 CEST

Si vous n'arrivez pas à sauvegarder, lisez cette page.

Références rapides d'édition :

Références : [Règles d'édition] ou http://wfr.tcl.tk/ ou [http://wfr.tcl.tk] pour afficher [1]
Puces commencez la ligne par trois espaces, une étoile puis un espace
Paragraphes séparez-les avec une ligne vide
Texte brut commencez la ligne avec un espace
Ligne horizontale commencez la ligne avec 4 tirets
Mises en valeur deux apostrophes pour ''italique'', trois pour '''gras'''