You are here

안티알리아싱 라인 그리기

admin의 아바타
package require Tcl 8.5
package require Tk
namespace path ::tcl::mathfunc ;# for [max] function

proc ::tcl::mathfunc::ipart x {expr {int($x)}}
proc ::tcl::mathfunc::fpart x {expr {$x - int($x)}}
proc ::tcl::mathfunc::rfpart x {expr {1.0 - fpart($x)}}
proc drawAntialiasedLine {image colour p1 p2} {
    lassign $p1 x1 y1
    lassign $p2 x2 y2
    set steep [expr {abs($y2 - $y1) > abs($x2 - $x1)}]
    if {$steep} {
        lassign [list $x1 $y1] y1 x1
        lassign [list $x2 $y2] y2 x2
    if {$x1 > $x2} {
        lassign [list $x1 $x2] x2 x1
        lassign [list $y1 $y2] y2 y1
    set deltax [expr {$x2 - $x1}]
    set deltay [expr {abs($y2 - $y1)}]
    set gradient [expr {1.0 * $deltay / $deltax}]

    # handle the first endpoint

    set xend [expr {round($x1)}]
    set yend [expr {$y1 + $gradient * ($xend - $x1)}]
    set xgap [expr {rfpart($x1 + 0.5)}]
    set xpxl1 $xend
    set ypxl1 [expr {ipart($yend)}]
    plot $image $colour $steep $xpxl1 $ypxl1 [expr {rfpart($yend)*$xgap}]
    plot $image $colour $steep $xpxl1 [expr {$ypxl1+1}] [expr {fpart($yend)*$xgap}]
    set itery [expr {$yend + $gradient}]

    # handle the second endpoint

    set xend [expr {round($x2)}]
    set yend [expr {$y2 + $gradient * ($xend - $x2)}]
    set xgap [expr {rfpart($x2 + 0.5)}]
    set xpxl2 $xend
    set ypxl2 [expr {ipart($yend)}]
    plot $image $colour $steep $xpxl2 $ypxl2 [expr {rfpart($yend)*$xgap}]
    plot $image $colour $steep $xpxl2 [expr {$ypxl2+1}] [expr {fpart($yend)*$xgap}]
    for {set x [expr {$xpxl1 + 1}]} {$x < $xpxl2} {incr x} {
        plot $image $colour $steep $x [expr {ipart($itery)}] [expr {rfpart($itery)}]
        plot $image $colour $steep $x [expr {ipart($itery) + 1}] [expr {fpart($itery)}]
        set itery [expr {$itery + $gradient}]
proc plot {image colour steep x y c} {
    set point [expr {$steep ? [list $y $x] : [list $x $y]}]
    set newColour [antialias $colour [getPixel $image $point] $c]
    setPixel $image $newColour $point
proc antialias {newColour oldColour c} {
    # get the new colour r,g,b

    if {[scan $newColour "#%2x%2x%2x%c" nr ng gb -] != 3} {
        scan [colour2rgb $newColour] "#%2x%2x%2x" nr ng nb

    # get the current colour r,g,b

    scan $oldColour "#%2x%2x%2x" cr cg cb

    # blend the colours in the ratio defined by "c"

    foreach new [list $nr $ng $nb] curr [list $cr $cg $cb] {
        append blend [format {%02x} [expr {round($new*$c + $curr*(1.0-$c))}]]
    return #$blend
proc colour2rgb {color_name} {
    foreach part [winfo rgb . $color_name] {
        append colour [format %02x [expr {$part >> 8}]]
    return #$colour
proc newImage {width height} {
    return [image create photo -width $width -height $height]
proc fill {image colour} {
    $image put $colour -to 0 0 [$image cget -width] [$image cget -height]
proc setPixel {image colour point} {
    lassign $point x y
    $image put $colour -to [max 0 $x] [max 0 $y]
proc getPixel {image point} {
    lassign $point x y
   # [$img get] returns a list: {r g b}; this proc should return a colour value
    format {#%02x%02x%02x} {*}[$image get $x $y]

set img [newImage 500 500]
fill $img blue
for {set a 10} {$a < 500} {incr a 60} {
    drawAntialiasedLine $img yellow {10 10} [list 490 $a]
    drawAntialiasedLine $img yellow {10 10} [list $a 490]
toplevel .wu
label .wu.l -image $img
pack .wu.l