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
Discussion
Catégorie Exemple | Catégorie Traitement d'image