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