Experimenting with graphics algorithms

Marco Maggi This page is a collection of little scripts used to test graphics algorithms. I hope to find time to convert them to C code and release an extension.

I plan to add other algorithms: the next topics I would like to cover are transparency and clipping masks.

Before the C translation, it's important to move all the code to integer arithmetic: this is something that will take some time.

Marco Maggi (Sep 5, 2003) The following script draws aliased lines and circles. On the Net there are resources explaining aliasing algorithms, but they seem complex to me. This script just draws an additional element with lighter color under the real element; the additional element has width incremented by one pixel. I've tried it with the Analog widgets and it seems to work.

 # aliasing.tcl --

 package require Tcl 8.4
 package require Tk 8.4

 proc main { argc argv } {
    global      forever


    wm title . "Aliasing tests"
    wm geometry . +10+10
    bind . <Escape> "set forever 1"

    button .b -text Quit -command "set forever 1"
    grid .b
    bind .b <Return> "%W flash; %W invoke"

    aliased_lines   [frame .1]
    aliased_circles [frame .2]

    grid .1
    grid .2
    focus .b
    vwait forever
    exit 0
 }

 proc aliased_lines { master } {
    set pi 6.28
    set xc 100
    set yc 100
    set r  10
    set R  95

    set f [labelframe $master.1 -text "Aliased lines"]
    canvas $f.c -width 200 -height 200 -background white
    grid $f.c

    for {set i 0} {$i < 360} {incr i 15} {
        set a  [expr {$pi*$i/360.0}]
        set x1 [expr {$xc+$r*cos($a)}]
        set y1 [expr {$yc+$r*sin($a)}]
        set x2 [expr {$xc+$R*cos($a)}]
        set y2 [expr {$yc+$R*sin($a)}]
        $f.c create line $x1 $y1 $x2 $y2 -width 2 -fill darkgray
        $f.c create line $x1 $y1 $x2 $y2 -width 1 -fill black
    }

    set f [labelframe $master.2 -text "Normal lines"]
    canvas $f.c -width 200 -height 200 -background white
    grid $f.c

    for {set i 0} {$i < 360} {incr i 15} {
        set a  [expr {$pi*$i/360.0}]
        set x1 [expr {$xc+$R*cos($a)}]
        set y1 [expr {$yc+$R*sin($a)}]
        set x2 [expr {$xc+$r*cos($a)}]
        set y2 [expr {$yc+$r*sin($a)}]
        $f.c create line $x1 $y1 $x2 $y2 -width 1 -fill black
    }

    grid $master.1 $master.2
 }

 proc aliased_circles { master } {
    set xc 100
    set yc 100
    set r  10
    set R  95

    set f [labelframe $master.1 -text "Aliased circles"]
    canvas $f.c -width 200 -height 200 -background white
    grid $f.c

    for {set i $r} {$i < $R} {incr i 10} {
        set x1 [expr {$xc-$i}]
        set y1 [expr {$yc-$i}]
        set x2 [expr {$xc+$i}]
        set y2 [expr {$yc+$i}]
        $f.c create arc $x1 $y1 $x2 $y2 -width 2 \
                -start 0 -extent 359.999 -style arc -outline darkgray
        $f.c create arc $x1 $y1 $x2 $y2 -width 1 \
                -start 0 -extent 359.999 -style arc -outline black
    }

    set f [labelframe $master.2 -text "Normal circles"]
    canvas $f.c -width 200 -height 200 -background white
    grid $f.c

    for {set i $r} {$i < $R} {incr i 10} {
        set x1 [expr {$xc-$i}]
        set y1 [expr {$yc-$i}]
        set x2 [expr {$xc+$i}]
        set y2 [expr {$yc+$i}]
        $f.c create arc $x1 $y1 $x2 $y2 -width 1 \
                -start 0 -extent 359.999 -style arc -outline black
    }

    grid $master.1 $master.2
 }

 main $argc $argv

 ### end of file

___

uniquename 2014jan27

For those who do not have the facilities or time to implement the code above, here is a locally stored image of the Tk GUI produced by the code above.

Although this 'anti-aliasing' technique works somewhat, I still see quite a bit of aliasing on the lines at angles around 30 and 60 degrees to horizontal.

I have tried some anti-aliasing of straight lines in needles of meters using this same technique --- multiple 'create line' commands with slightly different colors (a blend of the needle color and the meter background color). But I also had difficulty in getting really good anti-aliasing at those angles.

Although I do not like to say this, it is probably the case that a more complex method, at the pixel level, may be required to get good results. In fact, if one captures screen images of black text on a white background and zooms-in on the images, one typically sees that pixels of colors other than gray (blues and beiges) can be seen to be used to perform the anti-aliasing on a color monitor.

Hopefully one could devise a method (that gives quite pleasing results) that uses grays --- no blues or other non-gray colored pixels.

___

Note that there is Tcl code at rosettacode.org [1] to implement Xiaolin Wu's line algorithm -- to draw an anti-aliased line.

The algorithm is described on Wikipedia [2].

Marco Maggi (Sep 5, 2003) The following script is a test for the superposition of transparent pixmaps. We simulate a pixmap buffer with an array and the grid of pixels with a canvas grid of squares. The algorithm is very simple: I've found it in the PNG reference.

 # transparency.tcl --

 package require Tcl 8.4
 package require Tk 8.4

 proc main { argc argv } {
    global      forever


    wm title . "Transparency tests"
    wm geometry . +10+10
    bind . <Escape> "set forever 1"

    button .b -text Quit -command "set forever 1"
    grid .b
    bind .b <Return> "%W flash; %W invoke"

    canvas .c -width 400 -height 400 -background white
    grid .c
    set w 100
    set h 100

    make_pixmap pixmap $w $h

    # The last  argument is the alpha  channel value, a  float between 0
    # and 1. 1 means opaque, 0 means transparent.

    make_square pixmap 10 10 70 red 0
    make_square pixmap 30 30 60 blue 0.6
    make_square pixmap 20 50 45 green 0.4
    
    draw_pixmap pixmap .c

    focus .b
    vwait forever
    exit 0
 }

 proc make_pixmap { varname width height } {
    upvar       $varname pixmap


    array set pixmap [list width $width height $height]
    for {set i 0} {$i < $width} {incr i} {
        for {set j 0} {$j < $height} {incr j} {
            set pixmap($i:$j) -1
        }
    }
 }

 proc draw_pixmap { varname canvas } {
    upvar       $varname pixmap


    set cw [$canvas cget -width]
    set ch [$canvas cget -height]
    set dx [expr {int($cw/$pixmap(width))}]
    set dy [expr {int($ch/$pixmap(height))}]
    
    for {set i 0} {$i < $pixmap(width)} {incr i} {
        for {set j 0} {$j < $pixmap(height)} {incr j} {
            if { $pixmap($i:$j) != -1 } {
                set x1 [expr {$dx*$i}]
                set x2 [expr {$x1+$dx}]
                set y1 [expr {$dy*$j}]
                set y2 [expr {$y1+$dy}]

                $canvas create rectangle $x1 $y1 $x2 $y2 \
                        -fill $pixmap($i:$j) -width 0
            }
        }
    }
 }

 proc make_square { varname X Y L color alpha } {
    upvar       $varname pixmap


    set mi [expr {$X+$L}]
    set mj [expr {$Y+$L}]
    foreach {red_fg green_fg blue_fg} [winfo rgb . $color] {}

    for {set i $X} {$i < $mi} {incr i} {
        for {set j $Y} {$j < $mj} {incr j} {
            if { $pixmap($i:$j) == -1 } {
                set pixmap($i:$j) $color
            } else {
                if { $alpha == 0 } {
                    set pixmap($i:$j) $color
                } elseif { $alpha == 1 } {
                    continue
                } else {
                    foreach {red_bg green_bg blue_bg} \
                            [winfo rgb . $pixmap($i:$j)] {}

                    set red   [alpha $red_fg   $red_bg   $alpha]
                    set green [alpha $green_fg $green_bg $alpha]
                    set blue  [alpha $blue_fg  $blue_bg  $alpha]
                
                    set pixmap($i:$j) [format "#%04x%04x%04x" \
                            $red $green $blue]
                }
            }
        }
    }
 }

 proc alpha { foreground background alpha } {
    return [expr {int($alpha*$foreground+(1-$alpha)*$background)}]
 }

 main $argc $argv

 ### end of file

___

uniquename 2014jan27

For those who do not have the facilities or time to implement the code above (and because the images at 'imageshack.us' at the bottom of this page will probably go dead, as many other such images of gold have done), here is a locally stored image of the Tk GUI produced by the code above.

Note that Maggi creates simple solid colored 'simulated' pixmaps within this code --- and he blends them pixel-by-pixel.

It would probably be much more useful to provide a demo of reading a couple (or three) GIF or PNG image files and making a 'merged' image from those images.

I have found one example like this at the wiki page Merging images with transparency by 'ulis' --- but the two image file names are hard-coded and this demo does not provide the user the capability of positioning the images relative to each other. (I have an interrupted-work-in-process --- with file-selection and image-anchoring features --- that I hope to finish and post here someday.)

If anyone finds (or creates) such a 'production-like' example on this wiki, a link to the page could be put here.

Marco Maggi (Sep 5, 2003) Once I've seen screenshots of the Mac and I liked the shape of the buttons on the window's title bar. Later I've found that there is a Fvwm theme that comes with pixmap of such sunken-surface buttons: I like it.

I have seen screenshots of the new Mac OS windows and I love the button shapes; the new Win will also have lovely button surfaces.

I would like to be able draw such surfaces with TK: it's just a matter of color gradients. The following script is just a first attempt and it's incorrect: the bottom-right corner is exposed to the light and so should have a lighter color; the top-right and bottom-left corners should have a color with middle intensity. To select the color of a macro-pixel I use a parabolic equation involving the X and Y coordinates: it needs to be corrected with a modulating function. Which one?

 # sunkensurface.tcl --

 package require Tcl 8.4
 package require Tk 8.4

 proc main { argc argv } {
    global      forever


    wm title . "Sunken surface tests"
    wm geometry . +10+10
    bind . <Escape> "set forever 1"

    button .b -text Quit -command "set forever 1"
    grid .b
    bind .b <Return> "%W flash; %W invoke"

    canvas .c1 -width 100 -height 100 -relief raised -borderwidth 1
    canvas .c2 -width 60 -height 30 -relief raised -borderwidth 1
    canvas .c3 -width 30 -height 30 -relief raised -borderwidth 1
    grid .c1 .c2 .c3

    make_gradient .c1 50 50
    make_gradient .c2 30 15
    make_gradient .c3 15 15


    focus .b
    vwait forever
    exit 0
 }

 proc make_gradient { canvas N M } {
    set width [$canvas cget -width]
    set height [$canvas cget -height]

    set dx [expr {double($width)/double($N)}]
    set dy [expr {double($height)/double($M)}]
    set a [expr {pow(double($N)/2.0,2)+pow(double($M)/2.0,2)}]

    for {set i 0} {$i <= $N} {incr i} {
        for {set j 0} {$j <= $M} {incr j} {
            set x1 [expr {$dx*double($i)}]
            set x2 [expr {$x1+$dx}]
            set y1 [expr {$dy*double($j)}]
            set y2 [expr {$y1+$dy}]

            set k [expr {int(30000+25000*(1.0 - \
                    0.8*(pow(double($i-$N/2.0),2) + \
                    pow(double($j-$M/2.0),2))/$a))}]

            $canvas create rectangle $x1 $y1 $x2 $y2 \
                    -fill [format "#%04x%04x%04x" $k $k $k] \
                    -width 0
        }
    }
 }

 main $argc $argv

 ### end of file

___

uniquename 2014jan27

Note that Maggi's code makes the images with a sequence of 'create rectangle' commands on a 'canvas'. However, Maggi indicates that he would like to make buttons like this --- and he would like to have different shadings (lightings) at the corners of these 'buttons'.

Note that it would probably be more efficient and far more flexible to use the '-compound' option of the 'button' widget to put quite general images on a Tk button --- and use 'create image' (and GIF or PNG image files) to create the background image for the button(s).

One advantage of using the 'create rectangle' technique of Maggi is that a wide variety of sizes (especially widths) can be made within any Tk GUI. However, one could no doubt do this with great efficiency (and with great image-type-flexibity) by using an image 'copy' (horizontal tile) technique with a given base image, like one of the gradient images above. Namely, break the image into 3 pieces --- left-end, middle-strip, and right-end --- and use the image 'copy' command to lay down the left-end, then 'tile' the middle strip horizontally, and then lay down the right-end.

I have not been able to find an image 'copy' example quite like that on this wiki. The closest I have found so far is on the Vanishing Child page of Keith Vetter.

If anyone finds (or creates) such an example on this wiki, a link to the page could be put here.

Marco Maggi (Sep 5, 2003) Have you seen the brushed metal interface on the Mac? I find it great! Those of you that have access to Dr. Dobb's Journal, September 2003, can find a picture on page 52.

I think that it's a vertically-modulated gray gradient with lighter color in the middle, and superimposed there are randomly-distributed random-width random-gray-level horizontal lines. Wadda ya think?

The gray-gradient buttons with rounded corners are also beautiful: the glyphs on them appears to be black shapes with sunken 3D border. TK comes with Tk_Draw3DPolygon() and Tk_Fill3DPolygon...

The following is a first attempt for the brushed-metal background; I've tried some modulating functions for the vertical gradient but with no satisfying success. Let's say that the function is y=f(x), with y in the range is 0-1, and x in the range 0-($col/($width-1)). The function should be f(0.5)~=1.0 and f(0)=f(1)~=0; the von Hann's window: -0.5*cos(2*pi*x)+0.5 is fine from the math point of view but the graphics result is not; it's also heavy to compute. Some sort of "configurable" poly?

 # brushedmetal --
 # $Id: 9776,v 1.6 2006-10-10 06:00:13 jcw Exp $

 package require Tcl 8.4
 package require Tk 8.4

 proc main { argc argv } {
    global      forever

    set 2_pi 6.28318530718


    wm title . "Transparency tests"
    wm geometry . +10+10
    bind . <Escape> "set forever 1"

    button .b -text Quit -command "set forever 1" -background white
    grid .b
    bind .b <Return> "%W flash; %W invoke"

    set width   400
    set height  200

    set c [canvas .c -width $width -height $height]
    grid $c

    for {set row 0} {$row < $height} {incr row 1} {
        set line_color [expr {45000+int(1000000*rand())%3000}]
        $c create line 0 $row $width $row -width 1 \
                -fill [format "#%04x%04x%04x" \
                $line_color $line_color $line_color]
    }

    focus .b
    vwait forever
    exit 0
 }

 main $argc $argv

 ### end of file

gold added pix

goldshell7, 9 Oct 2006 - The weave button in Refrigerator_Pinyin_Poetry implements a colorized or doctored version of the etched metal background from Marco Maggi.

The French Tcler's Wiki has a page on drawing buttons with nice gradients