dc 18/05/08
ulis nous a offert les maps. Voilà un petit éditeur, encore incomplet, permettant d'en créer/modifier.
Il y manque, notamment, une gestion de la première ligne de la map, qui ne contient pour l'instant qu'un zéro pour la transparence. La couleur d'avant plan est à faire... ulis nous a donné beaucoup d'outils pour manipuler ses maps, notamment map2img ou img2map, ce dernier est intégré à l'interface que je propose.
Pour info, j'utilise les maps pour un projet de lanceur [1], la map me servant de poignée. Je vais intégrer cet éditeur au lanceur pour pouvoir modifier l'apparence de ladite poignée.
# auteur : david cobac [string map {# @} david.cobac#gmail.com]
# date : 27/05/2008 - 16/06/08
# version 0.8
package require Tk
package require pixane
font create policeValeurs -size 6 -family Courier
font create policeCoords -size 6 -family Courier
namespace eval ulisMap {
# photo : une image de type photo
# tr : indice de luminosité correspondant aux points transparents. Sa valeur par défaut est '0'.
# fg : indice de luminosité correspondant à la couleur d'avant-plan. Sa valeur par défaut est "".
# create a map from a photo
proc img2map {photo {tr 0} {fg ""}} \
{
# add transparency color & foreground color
set map [list $tr$fg]
# add brightness
foreach row [$photo data] \
{
set line ""
foreach pix $row {
# barre de progression
if {[winfo exists .pb]} {
incr avancee
::progressbar:set .pb [expr {$avancee*100/$traitement}]
update
}
foreach {r g b} [winfo rgb . $pix] break
set v [expr {round(($r + $g + $b) / 256 / 15 / 3.0)}]
if {$v > 15} { set v 15 }
append line [format %x $v]
}
lappend map $line
}
# return map
return $map
}
# map : la map
# bg : la couleur d'arrière-plan à multiplier par les indices de luminosité de la map. Sa valeur par défaut est 'white'.
# fg : la couleur d'avant-plan correspondant à la luminosité d'avant-plan. Sa valeur par défaut est 'gray'.
# coef : coefficient de correction de la luminosité (0.5 -> 5.0). Sa valeur par défaut est '1.0'.
# create a photo from a map
proc map2img {map {bg white} {fg gray} {coef 1.0}} {
# v 0.2
# get data
set data [list]
set line0 [lindex $map 0]
set tr [string index $line0 0]
set rf [string index $line0 1]
if {$rf != "" && $rf != $tr} {
foreach {r g b} [winfo rgb . $fg] break
foreach c {r g b} {
set v [set $c]
set v [expr {$v / 256 / 16}]
set $c [format %x%x $v $v]
}
set fg #$r$g$b
}
foreach {R G B} [winfo rgb . $bg] break
foreach C {R G B} {
set v [set $C]
set $C [expr {$v *$coef / 256}]
}
# create pixels map
set data [list]
set map [lrange $map 1 end]
foreach line $map {
set row [list]
foreach pix [split $line {}] {
switch -- $pix \
$tr { set color #000000 } \
$rf { set color $fg } \
default {
scan $pix %x light
foreach C {R G B} c {r g b} {
set v [set $C]
set v [expr {round($v * $light / 255.0)}]
if {$v > 15} { set v 15 }
set $c [format %x%x $v $v]
}
set color #$r$g$b
}
lappend row $color
}
lappend data $row
}
# create photo
set photo [image create photo]
$photo put $data
# set transparency
set width [image width $photo]
set height [image height $photo]
for {set y 0} {$y < $height} {incr y} {
set line [lindex $map $y]
for {set x 0} {$x < $width} {incr x} {
if {[string index $line $x] == $tr} {
$photo transparency set $x $y 1
}
}
}
# return photo
return $photo
}
}
namespace eval mapCreator {
## le tableau des variables de widgets
variable robertVar
set robertVar(sel) 0
## les valeurs et couleurs
variable valeursPossibles {0 1 2 3 4 5 6 7 8 9 a b c d e f}
variable couleursPossibles
## Arrière-plan et sa couleur (rose)
variable bgPlan 0
variable couleurBgPlan #ffc0c0
## les tailles à l'ouverture
variable tailleIconeX 32
variable tailleIconeY 32
variable tailleCarre 15
## les variables utiles à la sélection
set robertVar(formeSel) rectangle
variable optionSelection
array set optionSelection {
rectangle -outline
oval -outline
line -fill
}
variable listeSelection
variable debSelX
variable debSelY
variable finSelX
variable finSelY
variable xtemp
variable ytemp
## le nom du fichier de map
variable fichierCourant __creation__
## la map courante
variable mapEnCours
## drapeau de travail (pour les procs lentes)
variable enCours 0
}
proc mapCreator::robert {} {
variable valeursPossibles
variable tailleIconeX
variable tailleIconeY
variable tailleCarre
wm title . "Éditeur de map"
wm resizable . 0 0
wm minsize . 481 0
wm protocol . WM_DELETE_WINDOW exit
##
set f .f
set c .c
set g .g
set l $g.l
set s $g.s
set m $f.file.m
set n $f.sel.n
set o $f.op.o
set t $f.t
set q $f.ap.q
set p $f.aide.p
##
frame $f
#
menubutton $f.file -text "Fichier" -menu $m -underline 0
menu $m -tearoff 0
$m add command -label "Ouvrir" -command [list mapCreator::ouvre $c]
$m add command -label "Nouveau" -command [list mapCreator::dialogueNouveau $c]
$m add command -label "Importer" -command [list mapCreator::dialogueImportPhoto $c]
$m add command -label "Enregistrer" -command [list mapCreator::enregistrer $c]
$m add command -label "Enregistrer Sous" \
-command [list mapCreator::enregistrerSous $c]
$m add command -label "Quitter" -command exit
#
menubutton $f.sel -text "Sélection" -menu $n -underline 0
menu $n -tearoff 0
$n add checkbutton -label "Rectangle" \
-variable mapCreator::robertVar(formeSel) -onvalue "rectangle" \
-command [list mapCreator::cvBindSelection $c]
$n add checkbutton -label "Ovale" \
-variable mapCreator::robertVar(formeSel) -onvalue "oval" \
-command [list mapCreator::cvBindSelection $c]
$n add checkbutton -label "Ligne" \
-variable mapCreator::robertVar(formeSel) -onvalue "line" \
-command [list mapCreator::cvBindSelection $c]
$n add checkbutton -label "Main levée" \
-variable mapCreator::robertVar(formeSel) -onvalue "mainLevee" \
-command [list mapCreator::cvBindSelectionMainLevee $c]
$n add separator
$n add command -label "Effacer sel." \
-command [list mapCreator::cvEffaceSelection $c]
#
menubutton $f.op -text "Opérations" -menu $o -underline 0
menu $o -tearoff 0
$o add command -label "Remplacer" \
-command [list mapCreator::dialogueRemplacer $c]
#
spinbox $t -from 1 -to 30 -width 2 -justify right \
-command [list mapCreator::cvDimCarreGrille $t $c]
$t set $tailleCarre
#
menubutton $f.ap -text "Aperçu" -menu $q -underline 0
menu $q -tearoff 0
$q add command -label "Fenêtre d'aperçu" \
-command [list mapCreator::dialogueApercu]
#
menubutton $f.aide -text Aide -menu $p -underline 0
menu $p -tearoff 0
$p add command -label "Comment faire ?" -command [list mapCreator::ahotou]
$p add command -label "De la doc ?" -command [list mapCreator::deladoc]
$p add command -label "À propos" -command [list mapCreator::euhboute]
#
pack $f.file $f.sel $f.op $f.ap $t -side left -expand 0
pack $f.aide -side right -expand 0
pack $f -expand 1 -fill x
##
canvas $c -bg white -bd 0 -highlightt 0
pack $c
##
frame $g
#
label $l -text "Largeur $tailleIconeX Hauteur $tailleIconeY" -relief sunken
label $s -text "Sélection" -relief sunken
pack $l -expand 0 -side left
pack $s -expand 0 -side left
#
pack $g -expand 1 -fill x
##
return $c
}
proc mapCreator::debugAfficheMap {map} {
foreach l $map {
puts $l
}
}
# incrémente les éléments (l,c) de liste de la valeur increment
# renvoie la nouvelle map
proc mapCreator::incrSelectionMap {map liste increment} {
set listeV [list]
foreach point $liste {
lassign $point x y
set v [mapCreator::elementMap $map $y $x]
scan $v %x i
incr i $increment
if {$i < 0} {set i 0}
if {$i > 15} {set i 15}
set hex [format %x $i]
lappend listeV $hex
set map [mapCreator::changeElementMap $map $y $x $hex]
}
return [list $map $listeV]
}
# récupère valeur à (l,c)
proc mapCreator::elementMap {map l c} {
set indiceLigne [expr {$l+1}]
set ligne [lindex $map $indiceLigne]
set element [string index $ligne $c]
return $element
}
# attribue la valeur v à l'élement (l,c)
proc mapCreator::changeElementMap {map l c v} {
set indiceLigne [expr {$l+1}]
set ligne [lindex $map $indiceLigne]
set nvLigne [string replace $ligne $c $c $v]
set map [lreplace $map $indiceLigne $indiceLigne $nvLigne]
return $map
}
# listeEl : liste de listes (l,c) d'élements à changer
# listeNv : liste des nouvelles valeurs à attribuer
proc mapCreator::changeListeElementsMap {map listeEl listeNv} {
set i 0
foreach el $listeEl {
lassign $el c l
set map [mapCreator::changeElementMap $map $l $c [lindex $listeNv $i]]
incr i
}
return $map
}
# renvoie la liste des éléments (l,c) de valeur v
proc mapCreator::chercherElementMap {map v} {
set larg [string length [lindex $map 1]]
set map [lrange $map 1 end]
set m [join [split $map {}]]
set listeEl [list]
set ind [lsearch -all -exact $m $v]
foreach i $ind {
set ligne [expr {$i/$larg}]
set col [expr {$i%$larg}]
lappend listeEl [list $col $ligne]
}
return $listeEl
}
# copie la partie rect. (x0,y0)->(x1,y1) et
# la renvoie en tant que map
proc mapCreator::copiePartieMapVersMap {map x0 y0 x1 y1} {
# on suppose x1>=x0 et y1>=y0
set dx [expr {$x1-$x0}]
set dy [expr {$y1-$y0}]
set n 0
set nvMap [list 0]
for {set i 0} {$i<$dy} {incr i} {
set row ""
set y [expr {$y0 + $i}]
for {set j 0} {$j<$dx} {incr j} {
set x [expr {$x0 + $j}]
append row [mapCreator::elementMap $map $y $x]
}
lappend nvMap $row
}
return $nvMap
}
# une map triviale
proc mapCreator::nouvelleMap {w h} {
set map [list 0]
for {set l 0} {$l<$h} {incr l} {
lappend map [string repeat 0 $w]
}
return $map
}
#####################################################################
#####################################################################
# affichage complet d'une map sur le canvas w
proc mapCreator::cvAfficheMapComplet {w} {
variable couleursPossibles
variable mapEnCours
variable tailleCarre
variable tailleIconeX
variable tailleIconeY
set map [lrange $mapEnCours 1 end]
catch {image delete fond}
image create photo fond -width [expr {$tailleIconeX*$tailleCarre}]\
-height [expr {$tailleIconeY*$tailleCarre}]
$w create image 0 0 -image fond -tags fond -anchor nw
set i 0
foreach line $map {
set j 0
set y0 [expr {$i * $tailleCarre}]
set y1 [expr {($i+1) * $tailleCarre}]
foreach pix [split $line {}] {
#
set x0 [expr {$j * $tailleCarre}]
set x1 [expr {($j+1) * $tailleCarre}]
fond put $couleursPossibles($pix) -to $x0 $y0 $x1 $y1
$w itemconfigure l${i}c${j} -text $pix
if {$pix <= 9 && $pix ne 0} {
$w itemconfigure l${i}c${j} -fill white
} else {
$w itemconfigure l${i}c${j} -fill black
}
#
incr j
}
incr i
}
$w raise grille
$w raise texte
}
# modifie l'élement (l,c) avec v sur le canvas w
proc mapCreator::cvModifieElementMap {w l c v} {
variable bgPlan
variable couleurBgPlan
variable mapEnCours
if {$v eq $bgPlan} {set couleur $couleurBgPlan}
$w configure l${l}c${c} -text $v
}
# affiche la grille d'affichage de la map sur le canvas w
proc mapCreator::cvGrille {w} {
variable tailleIconeX
variable tailleIconeY
variable tailleCarre
variable bgPlan
variable couleurBgPlan
set tailleTotaleX [expr {$tailleIconeX * $tailleCarre + 1}]
set tailleTotaleY [expr {$tailleIconeY * $tailleCarre + 1}]
$w configure -width $tailleTotaleX -height $tailleTotaleY
for {set i 0} {$i<$tailleIconeX} {incr i} {
set iprime [expr {$i*$tailleCarre}]
$w create line $iprime 0 $iprime $tailleTotaleY -width 1 -tags grille
for {set j 0} {$j<$tailleIconeY} {incr j} {
if {$i eq 0} {
set jprime [expr {$j*$tailleCarre}]
$w create line 0 $jprime $tailleTotaleX $jprime \
-width 1 -tags grille
}
$w create text [expr {($i+.5)*$tailleCarre}]\
[expr {($j+.5)*$tailleCarre}] \
-font policeValeurs -text $bgPlan\
-tags [list texte l${j}c${i}]
}
}
mapCreator::cvBind $w
mapCreator::cvBindSelection $w
}
proc mapCreator::cvBind {w} {
bind $w <Motion> [list mapCreator::cvBalade $w %X %Y %x %y]
bind $w <3> [list mapCreator::cvMenuSelection $w %X %Y]
bind $w <4> [list mapCreator::cvIncrSelection $w 1]
bind $w <5> [list mapCreator::cvIncrSelection $w -1]
}
proc mapCreator::cvBindSelection {w} {
bind $w <1> [list mapCreator::cvDebutSelection $w %x %y]
bind $w <B1-Motion> [list mapCreator::cvEnCoursDeSelection $w %x %y]
bind $w <B1-Motion> +[list mapCreator::cvBalade $w %X %Y %x %y]
bind $w <ButtonRelease-1> [list mapCreator::cvFinSelection $w %x %y]
}
proc mapCreator::cvBindSelectionMainLevee {w} {
bind $w <1> [list mapCreator::cvDebutSelectionMainLevee $w %x %y]
bind $w <B1-Motion> [list mapCreator::cvEnCoursDeSelectionMainLevee $w %x %y]
bind $w <B1-Motion> +[list mapCreator::cvBalade $w %X %Y %x %y]
bind $w <ButtonRelease-1> [list mapCreator::cvFinSelectionMainLevee $w %x %y]
}
proc mapCreator::cvBalade {w X Y x y} {
variable tailleCarre
set a .coords
if {![winfo exists $a]} {
toplevel $a
wm overrideredirect $a 1
label $a.l -width 8 -bg yellow -font policeCoords
pack $a.l
}
set x [expr {1 + $x/$tailleCarre}]
set y [expr {1 + $y/$tailleCarre}]
$a.l configure -text [format "%3d %3d" $x $y ]
set X [expr {$X+12}]
set Y [expr {$Y+12}]
wm geometry $a +${X}+${Y}
update
}
# w : le spinbox
# c : le canvas
proc mapCreator::cvDimCarreGrille {s c} {
variable tailleIconeX
variable tailleIconeY
variable tailleCarre
variable mapEnCours
$s configure -state disabled
set choix [$s get]
if {![string is integer $choix]} return
set tailleCarre $choix
$c delete all
mapCreator::cvGrille $c
mapCreator::cvAfficheMapComplet $c
$s configure -state normal
}
###############################################################################
###############################################################################
proc mapCreator::cvDebutSelection {w x y} {
variable tailleCarre
variable robertVar
variable debSelX
variable debSelY
variable xtemp
variable ytemp
variable listeSelection
variable optionSelection
$w delete selection
set listeSelection ""
set debSelX [expr {$x/$tailleCarre}]
set debSelY [expr {$y/$tailleCarre}]
set xtemp [expr {$debSelX*$tailleCarre}]
set ytemp [expr {$debSelY*$tailleCarre}]
$w create $robertVar(formeSel) $xtemp $ytemp $xtemp $ytemp \
$optionSelection($robertVar(formeSel)) green -width 2 -tags selection
$w raise selection
}
proc mapCreator::cvEnCoursDeSelection {w x y} {
variable tailleCarre
variable debSelX
variable debSelY
variable xtemp
variable ytemp
$w coords selection $xtemp $ytemp $x $y
##
set affSelX [expr {1 + $debSelX}]
set affSelY [expr {1 + $debSelY}]
set tmpSelX [expr {1 + $x/$tailleCarre}]
set tmpSelY [expr {1 + $y/$tailleCarre}]
set dx [expr {abs($debSelX-$tmpSelX)}]
set dy [expr {abs($debSelY-$tmpSelY)}]
.g.s configure \
-text "${dx}x${dy} ($affSelX,$affSelY) -> ($tmpSelX,$tmpSelY)"
}
proc mapCreator::cvFinSelection {w x y} {
variable robertVar
variable tailleCarre
variable debSelX
variable debSelY
variable xtemp
variable ytemp
variable finSelX
variable finSelY
variable listeSelection
variable tailleIconeX
variable tailleIconeY
set finSelX [expr {1 + $x/$tailleCarre}]
set finSelY [expr {1 + $y/$tailleCarre}]
if {$finSelX > $tailleIconeX } {
set finSelX $tailleIconeX
}
if {$finSelY > $tailleIconeY } {
set finSelY $tailleIconeY
}
if {$finSelX < 0 } {
set finSelX 0
}
if {$finSelY < 0 } {
set finSelY 0
}
set x [expr {$finSelX*$tailleCarre}]
set y [expr {$finSelY*$tailleCarre}]
$w coords selection $xtemp $ytemp $x $y
##
set affSelX [expr {1 + $debSelX}]
set affSelY [expr {1 + $debSelY}]
set dx [expr {abs($debSelX-$finSelX)}]
set dy [expr {abs($debSelY-$finSelY)}]
.g.s configure \
-text "${dx}x${dy} ($affSelX,$affSelY) -> ($finSelX,$finSelY)"
##
if {$debSelX > $finSelX} {
# si on a sélectionné de gauche à droite
# on inverse le point de début et de fin
# il n'en demeure pas moins que debSelY
# peut éventuellement > à finselY donc...
# attention aux boucles en Y !!!
set tmp $debSelX
set debSelX $finSelX
set finSelX $tmp
set tmp $debSelY
set debSelY $finSelY
set finSelY $tmp
}
if {$robertVar(formeSel) eq "rectangle"} {
### sélection rectangle
set listePix [list]
for {set i $debSelX} {$i<$finSelX} {incr i} {
for {set j [expr {min($debSelY,$finSelY)}]} \
{$j<max($debSelY,$finSelY)} {incr j} {
lappend listeSelection [list $i $j]
}
}
} elseif {$robertVar(formeSel) eq "oval"} {
### sélection ovale
set a [expr {($finSelX-$debSelX)/2.}]
set b [expr {($finSelY-$debSelY)/2.}]
set centreX [expr {$debSelX+$a}]
set centreY [expr {$debSelY+$b}]
for {set i $debSelX} {$i<=$finSelX} {incr i} {
for {set j [expr {min($debSelY,$finSelY)}]} \
{$j<=max($debSelY,$finSelY)} {incr j} {
# les $i+0.5 et $j+0.5 coorespondent aux centres
# des carrés plutôt qu'au point sup gauche
#(ça donne quelque chose de plus naturel)
if {pow(($centreX-($i+.5))/$a,2)+\
pow(($centreY-($j+.5))/$b,2) < 1} {
lappend listeSelection [list $i $j]
}
}
}
} elseif {$robertVar(formeSel) eq "line"} {
### sélection droite
if {($finSelX - $debSelX) <= 1} {
for {set i $debSelY} {$i<=$finSelY} {incr i} {
lappend listeSelection [list $debSelX $i]
}
} else {
set m [expr {($finSelY-$debSelY)*1./($finSelX-$debSelX)}]
set p [expr {$debSelY - $m * $debSelX}]
if {$m >= 0} {
# ici c'est subtil : et du coup il y a des trous...
for {set i $debSelX} {$i<$finSelX} {incr i} {
set j [expr {min($tailleIconeY-1,round($m * $i + $p))}]
if {$i eq $debSelX} {
set jOld $j
}
for {set y [expr {$jOld+1}]} {$y<$j} {incr y} {
# on bouche les trous
set x [expr {$m > 0.5?$i-1:$i}]
lappend listeSelection [list $x $y]
}
lappend listeSelection [list $i $j]
set jOld $j
}
} else {
# ici c'est subtil : et du coup il y a des trous...
for {set i $debSelX} {$i<$finSelX} {incr i} {
set j [expr {min($tailleIconeY-1,round($m * $i + $p))}]
## subtile ligne...qui permet de bien être au-dessus
## de la sélection dans ce cas.
incr j -1
if {$i eq $debSelX} {
set jOld $j
}
for {set y [expr {$j+1}]} {$y<$jOld} {incr y} {
# on bouche les trous
set x [expr {$m < -0.5?$i-1:$i}]
lappend listeSelection [list $x $y]
}
lappend listeSelection [list $i $j]
set jOld $j
}
}
}
}
}
proc mapCreator::cvDebutSelectionMainLevee {w x y} {
variable tailleIconeX
variable tailleIconeY
variable listeSelection
variable tailleCarre
$w delete selection
set listeSelection [list]
set selX [expr {$x/$tailleCarre}]
set selY [expr {$y/$tailleCarre}]
if {$selX >= $tailleIconeX } {
set selX [expr {$tailleIconeX-1}]
}
if {$selY >= $tailleIconeY } {
set selY [expr {$tailleIconeY-1}]
}
if {$selX < 0 } {
set selX 0
}
if {$selY < 0 } {
set selY 0
}
lappend listeSelection [list $selX $selY]
set xtemp [expr {$selX*$tailleCarre}]
set ytemp [expr {$selY*$tailleCarre}]
$w create rectangle $xtemp $ytemp \
[expr {$xtemp+$tailleCarre}] [expr {$ytemp+$tailleCarre}] \
-tags selection -outline green
}
proc mapCreator::cvEnCoursDeSelectionMainLevee {w x y} {
variable tailleIconeX
variable tailleIconeY
variable tailleCarre
variable listeSelection
set selX [expr {$x/$tailleCarre}]
set selY [expr {$y/$tailleCarre}]
if {$selX >= $tailleIconeX } {
set selX [expr {$tailleIconeX-1}]
}
if {$selY >= $tailleIconeY } {
set selY [expr {$tailleIconeY-1}]
}
if {$selX < 0 } {
set selX 0
}
if {$selY < 0 } {
set selY 0
}
if {[lsearch -exact $listeSelection [list $selX $selY]] ne -1} {
return
}
lappend listeSelection [list $selX $selY]
set xtemp [expr {$selX*$tailleCarre}]
set ytemp [expr {$selY*$tailleCarre}]
$w create rectangle $xtemp $ytemp \
[expr {$xtemp+$tailleCarre}] [expr {$ytemp+$tailleCarre}] \
-tags selection -outline green
}
proc mapCreator::cvFinSelectionMainLevee {w x y} {
}
###############################################################################
###############################################################################
proc mapCreator::cvEffaceSelection {w} {
variable listeSelection
#set listeSelection [list]
$w delete selection
unset listeSelection
}
proc mapCreator::cvMenuSelection {w x y} {
variable listeSelection
destroy .ms
if {![info exists listeSelection]} return
menu .ms -tearoff 0
.ms add command -label "Coller vers nouvelle map" \
-command [list mapCreator::cvVersNouvelleMap $w]
tk_popup .ms $x $y
}
# w le label à utiliser
proc mapCreator::cvAfficheTailleMap {w} {
variable tailleIconeX
variable tailleIconeY
$w configure -text "Largeur $tailleIconeX Hauteur $tailleIconeY"
update
}
proc mapCreator::cvVersNouvelleMap {w} {
variable tailleIconeX
variable tailleIconeY
variable debSelX
variable debSelY
variable finSelX
variable finSelY
variable mapEnCours
set mapEnCours [mapCreator::copiePartieMapVersMap \
$mapEnCours $debSelX $debSelY $finSelX $finSelY]
set tailleIconeX [expr {$finSelX-$debSelX}]
set tailleIconeY [expr {$finSelY-$debSelY}
]
mapCreator::cvGrille $w
mapCreator::cvAfficheMapComplet $w
mapCreator::cvAfficheTailleMap .g.l
}
proc mapCreator::cvIncrSelection {w increment} {
variable couleursPossibles
variable listeSelection
variable mapEnCours
variable enCours
variable tailleCarre
variable listeSelection
if {![info exists listeSelection]} return
if {$enCours eq 1} return
set enCours 1
foreach {mapEnCours lv} \
[mapCreator::incrSelectionMap $mapEnCours $listeSelection $increment]\
break
set i 0
foreach point $listeSelection {
lassign $point x y
set v [lindex $lv $i]
incr i
::fond put $couleursPossibles($v)\
-to [expr {$x * $tailleCarre}] [expr {$y * $tailleCarre}]\
[expr {($x+1) * $tailleCarre}] [expr {($y+1) * $tailleCarre}]
$w itemconfigure l${y}c${x} -text $v
if { $v<=9 && $v ne 0} {
$w itemconfigure l${y}c${x} -fill white
} else {
$w itemconfigure l${y}c${x} -fill black
}
}
update
set enCours 0
}
proc mapCreator::nouveau {w wl wh} {
variable tailleIconeX
variable tailleIconeY
variable mapEnCours
variable fichierCourant __creation__
set entreeL [$wl get]
if {$entreeL eq "" || $entreeL <= 0} return
set entreeH [$wh get]
if {$entreeH eq "" || $entreeH <= 0} return
destroy .new
set tailleIconeX $entreeL
set tailleIconeY $entreeH
.c delete selection
set mapEnCours [mapCreator::nouvelleMap $tailleIconeX $tailleIconeY]
.c delete all
mapCreator::cvGrille $w
wm title . "Éditeur de map"
mapCreator::cvAfficheMapComplet .c
mapCreator::cvAfficheTailleMap .g.l
}
proc mapCreator::dialogueNouveau {w} {
destroy .new
toplevel .new
wm title .new "Dimensions"
wm resizable .new 0 0
wm protocol .new WM_DELETE_WINDOW [list destroy .new]
set f .new.f
frame $f
label $f.l -text "Largeur du map" -width 16
entry $f.e -width 3 -bg white -validate key \
-vcmd {expr {[string is integer %P] && [string length %P] <= 3}}
set g .new.g
frame $g
label $g.l -text "Hauteur du map" -width 16
entry $g.e -width 3 -bg white -validate key \
-vcmd {expr {[string is integer %P] && [string length %P] <= 3}}
set h .new.h
frame $h
button $h.b -text "OK" -command [list mapCreator::nouveau $w $f.e $g.e]
button $h.c -text "Annuler" -command [list destroy .new]
pack $f.l $f.e -side left -expand 0
pack $g.l $g.e -side left -expand 0
pack $h.b $h.c -side left -expand 1 -fill x
pack $f $g
pack $h -expand 1 -fill x
}
proc mapCreator::ouvre {w} {
variable tailleIconeX
variable tailleIconeY
variable fichierCourant
variable mapEnCours
set f [tk_getOpenFile -filetypes {{"MAP file" .map} {"All files" .*}}]
if {$f eq ""} return
set fh [open $f r]
#
set i 0
while {![eof $fh]} {
gets $fh ligne
if {$ligne ne ""} {
incr i
lappend contenu [string trim $ligne]
}
}
close $fh
#
set fichierCourant [list $f]
wm title . [file tail $fichierCourant]
#
set tailleIconeX [string length [lindex $contenu end]]
set tailleIconeY [expr {$i-1}]
set mapEnCours $contenu
mapCreator::cvGrille $w
#puts [time {
mapCreator::cvAfficheMapComplet $w
#}]
#puts [time {
# mapCreator::cvAfficheMapComplet2 $w
#}]
mapCreator::cvAfficheTailleMap .g.l
}
proc mapCreator::enregistrer {w} {
variable tailleIconeX
variable tailleIconeY
variable fichierCourant
variable mapEnCours
if {$fichierCourant eq "__creation__"} {
mapCreator::enregistrerSous $w
return
}
if {[catch {set fh [open [list $fichierCourant] w+]}]} return
foreach l $mapEnCours {
puts $fh $l
}
close $fh
}
proc mapCreator::enregistrerSous {w} {
variable tailleIconeX
variable tailleIconeY
variable fichierCourant
variable mapEnCours
set types {
{{Map Files} {.map .MAP}}
{{All Files} *}
}
set f [tk_getSaveFile -filetypes $types]
if {$f eq "" || [catch {set fh [open [list $f] w+]}]} return
foreach l $mapEnCours {
puts $fh $l
}
close $fh
set fichierCourant [list $f]
wm title . [file tail $fichierCourant]
}
proc mapCreator::importPhoto {w data } {
variable tailleIconeX
variable tailleIconeY
variable mapEnCours
set mapEnCours [ulisMap::img2map $data]
.c delete selection
mapCreator::cvGrille $w
#puts [time {
mapCreator::cvAfficheMapComplet $w
#}]
#puts [time {
# mapCreator::cvAfficheMapComplet2 $w
#}]
mapCreator::cvAfficheTailleMap .g.l
wm title . "Import non sauvegardé"
}
proc mapCreator::dialogueImportPhoto {w} {
variable tailleIconeX
variable tailleIconeY
set f [tk_getOpenFile -filetypes {{"All files" .*}}]
if {$f eq ""} return
set img [pixane create]
if {[catch { pixane load $img -file $f }]} {
tk_messageBox -icon error -type ok \
-message "Problème d'ouverture pour ce fichier !"\
-detail "Vérifiez qu'il sagit bien d'un fichier
image ou que ce fichier soit accessible en lecture."
return
}
set tX [pixane width $img]
set tY [pixane height $img]
destroy .redim
toplevel .redim
wm title .redim "Redimensionner"
set r .redim
set l $r.l
set f $r.f
set g $r.g
set h $r.h
#
label $l -text "Voulez-vous redimensionner cette image ?
En laissant les dimensions ci-dessous, vous ne changez rien."
pack $l -expand 1 -fill x
#
frame $f
label $f.l -text "Largeur" -width 7
entry $f.e -width 3
pack $f.l $f.e -side left
#
frame $g
label $g.l -text "Hauteur" -width 7
entry $g.e -width 3
pack $g.l $g.e -side left
#
frame $h
button $h.b -text "OK"\
-command [list mapCreator::valideRedim $w $f.e $g.e $img]
pack $h.b
#
pack $f $g $h
#
$f.e insert end $tX
$g.e insert end $tY
}
proc mapCreator::dialogueRemplacer {w} {
variable valeursPossibles
variable listeSelection
variable robertVar
set r .remp
destroy $r
toplevel $r
wm title $r "Remplacer"
wm resizable $r 0 0
wm protocol $r WM_DELETE_WINDOW [list destroy $r]
set f $r.f
set h $r.h
set g $r.g
#
frame $f
label $f.l -text "Remplacer"
eval tk_optionMenu $f.om mapCreator::avt $valeursPossibles
label $f.m -text "par"
eval tk_optionMenu $f.on mapCreator::aps $valeursPossibles
pack $f.l $f.om $f.m $f.on -expand 0 -side left
pack $f
#
frame $h
checkbutton $h.cb1 -text "partout dans la map"\
-variable mapCreator::robertVar(sel) -onvalue 0
checkbutton $h.cb2 -text "dans la sélection" \
-variable mapCreator::robertVar(sel) -onvalue 1
pack $h.cb1 $h.cb2 -side left -expand 0
pack $h
if {![info exists listeSelection]} {
$h.cb2 configure -state disabled
}
update
#
frame $g
button $g.b -text "Appliquer" -command [list mapCreator::cvRemplacer .c]
button $g.c -text "Fini !" -command [list destroy $r]
pack $g.b $g.c -side left -expand 1 -fill x
pack $g
}
proc mapCreator::cvRemplacer {w} {
variable mapEnCours
variable listeSelection
variable tailleCarre
variable couleursPossibles
variable robertVar
# travail sur toute la map
# on réécrit sur la listeSelection -> on la sauvegarde
# pour la restaure à la fin
if {[info exists listeSelection]} {
set sauvegardeListeSelection $listeSelection
}
##
set lS [mapCreator::chercherElementMap $mapEnCours $mapCreator::avt]
if {$mapCreator::robertVar(sel) eq 0} {
set listeSelection $lS
} else {
# on extrait de cette liste ceux qui sont effectivement dans la
# sélection
set lSprime [list]
foreach point $lS {
if {[lsearch -exact $listeSelection $point] ne -1} {
lappend lSprime $point
}
}
set listeSelection $lSprime
}
if {[join $listeSelection] eq ""} {
tJL