Anonymous user
Bitmap/Flood fill: Difference between revisions
add Tcl
No edit summary |
(add Tcl) |
||
Line 500:
This fills better than the Image::Imlib2 <tt>fill</tt> function the inner circle, since because of JPG compression and thanks to the <tt>$distparameter</tt>, it "sees" as black also pixel that are no more exactly black.
=={{header|Tcl}}==
Using code from [[Basic bitmap storage#Tcl]], [[Bresenham's line algorithm#Tcl]] and [[Midpoint circle algorithm#Tcl]]
<lang tcl>package require Tcl 8.5
package require Tk
package require struct::queue
proc floodFill {img colour point} {
set new [colour2rgb $colour]
set old [getPixel $img $point]
struct::queue Q
Q put $point
while {[Q size] > 0} {
set p [Q get]
if {[getPixel $img $p] eq $old} {
set w [findBorder $img $p $old west]
set e [findBorder $img $p $old east]
drawLine $img $new $w $e
set q $w
while {[x $q] <= [x $e]} {
set n [neighbour $q north]
if {[getPixel $img $n] eq $old} {Q put $n}
set s [neighbour $q south]
if {[getPixel $img $s] eq $old} {Q put $s}
set q [neighbour $q east]
}
}
}
Q destroy
}
proc findBorder {img p colour dir} {
set lookahead [neighbour $p $dir]
while {[getPixel $img $lookahead] eq $colour} {
set p $lookahead
set lookahead [neighbour $p $dir]
}
return $p
}
proc x p {lindex $p 0}
proc y p {lindex $p 1}
proc neighbour {p dir} {
lassign $p x y
switch -exact -- $dir {
west {return [list [incr x -1] $y]}
east {return [list [incr x] $y]}
north {return [list $x [incr y -1]]}
south {return [list $x [incr y]]}
}
}
proc colour2rgb {color_name} {
set colour "#"
foreach part [winfo rgb . $color_name] {
append colour [format %02x [expr {$part >> 8}]]
}
return $colour
}
set img [newImage 70 50]
fill $img white
drawLine $img blue {0 0} {0 4}
drawLine $img blue {0 4} {6 4}
drawLine $img blue {6 4} {6 0}
drawLine $img blue {6 0} {0 0}
floodFill $img green {3 3}
drawCircle $img black {35 25} 24
drawCircle $img black {35 25} 10
floodFill $img #7f7f7f {35 5}
toplevel .flood
label .flood.l -image $img
pack .flood.l </lang>
| |||