coloriage

 

dc 09/11/06

Je me suis intéressé au coloriage d'une zone fermée, j'ai trouvé cette page [1] qui m'a donné le bon algorithme, voici sa retranscription en tcl (enfin en tcl version dc...ça vaut ce que ça vaut !) :

x et y désignent la position où l'on a cliqué sur l'image. cr la couleur de remplissage genre #0000ff et cl la couleur qui limite les zones, habituellement le noir #000000.

 proc coloriage::remplissage {x y cr cl} {
    set gx(0) $x
    set gy(0) $y
    set i 1
    # xi et xf les positions min et max sur la ligne du germe
    # x et y deviennent variables
    while {$i!=0} {
	set i-1 [expr {$i-1}]
	set xi $gx(${i-1})
	set xf $gx(${i-1})
	set x $gx(${i-1})
	set y $gy(${i-1})
	incr x
	set cc [getCouleur $x $y]
	# on va à la limite à droite
	while {$cc!=$cl} {
	    set xf $x
	    incr x
	    set cc [getCouleur $x $y]
	}
	# on va à la limite à gauche
	set x $gx(${i-1})
	set cc [getCouleur $x $y]
	while {$cc!=$cl} {
	    set xi $x
	    incr x -1
	    set cc [getCouleur $x $y]
	}
	incr xf
	# on trace notre ligne pour finir
	coloriage::putCouleurLigne $xi $xf $y $cr
	# on décrémente notre nb de germes
	incr i -1
	# on passe à le recherche des germes sur
	# les lignes juste inf et sup
	# on commence au dessus
	set x $xf
	set y-1 [expr {$y-1}]
	set y+1 [expr {$y+1}]
	while {$x>=$xi} {
	    set cc [getCouleur $x ${y+1}]
	    # on parcourt en haut en partant de la droite
	    while {($x>=$xi) && ($cc==$cl || $cc==$cr)} {
		incr x -1
		set cc [getCouleur $x ${y+1}]
	    }
	    if {($x>=$xi) && ($cc!=$cl) && ($cc!=$cr)} {
		# on ajoute le germe trouvé
		set gx($i) $x
		set gy($i) ${y+1}
		incr i
	    }
	    # on continue à parcourir vers la gauche
	    # on attend donc de retrouver un poss. de germe
	    set cc [getCouleur $x ${y+1}]
	    while {$cc!=$cl && $x>=$xi} {
		incr x -1
		set cc [getCouleur $x ${y+1}]
	    }
	}
	# on poursuit en cherchant des germes en dessous
	set x $xf
	while {$x>=$xi} {
	    set cc [getCouleur $x ${y-1}]
	    # on parcourt en bas en partant de la droite
	    while {($x>=$xi) && ($cc==$cl || $cc==$cr)} {
		incr x -1
		set cc [getCouleur $x ${y-1}]
	    }
	    if {($x>=$xi) && ($cc!=$cl) && ($cc!=$cr)} {
		# on ajoute le germe trouvé
		set gx($i) $x
		set gy($i) ${y-1}
		incr i
	    }
	    # on continue à parcourir vers la gauche
	    # on attend donc de retrouver un poss. de germe
	    set cc [getCouleur $x ${y-1}]
	    while {$cc!=$cl && $x>=$xi} {
		incr x -1
		set cc [getCouleur $x ${y-1}]
	    }
	}
    }
 }

en ajoutant évidemment ces deux procédures où I est l'image

 proc coloriage::getCouleur {x y} {
    foreach {r g b} [I get $x $y] break
    return [format #%02x%02x%02x $r $g $b]
 }

 proc coloriage::putCouleurLigne {x0 x1 y c} {
    I put $c -to $x0 $y $x1 [expr {$y+1}]
 }

Pour tester une petite application basée dessus http://dcobac.free.fr/tcl/coloriage

À la fin du script coloriage_1.1.tcl, on doit donner le nom d'une image, celle-ci sera retaillée pour apparaître à l'écran [2] et réduite à deux couleurs (noir et blanc)[3], le script ajoute autour de l'image un cadre noir, couleur prise pour limiter les zones.

Cliquer le bouton gauche remplit la zone avec la couleur (bleu au départ).

Cliquer le bouton droit fait apparaître une toplevel pour choisir parmi 16 couleurs.

Sur un coloriage maison ou scanné, ça fait mon affaire ; par contre, un fichier chenonceau.jpg est fourni pour montrer les limites de la chose...vous comprendrez.