A simple 3D drawing

Arjen Markus (10 december 2023) The program below is nothing fancy, but I needed something like that for a pet project that involves all manner of mathematical tidbits (see https://github.com/arjenmarkus/wisconst ). To avoid complicated calculations it uses the so-called painter's algorithm to draw the cubes one by one. As part of that solution, the cubes must be drawn in the right order. But with the use of the move subcommand and tags to all the items, it is easy to manipulate the image further.

The cube consists of 27 smaller cubes in three colours:

coloured_cubes

By using the move commands, the colours are separated.

I intend to use this technique in a new note for the above project.

# cubes.tcl --
#     Draw cubes with a give tag, using the painter's algorithm
#
pack [canvas .c -width 900 -height 250]

# drawCube --
#     Draw a single cube in perspective
#
# Arguments:
#     code              Tag to use (actually: "C$code")
#     xstart            X-coordinate of lower left corner
#     ystart            Y-coordinate of lower left corner
#     side              Side of the cube
#
proc drawCube {code xstart ystart side} {

    .c create rectangle $xstart                    $ystart                    [expr {$xstart+$side}]     [expr {$ystart-$side}]        -tag C$code
    .c create polygon   [expr {$xstart+$side}]     $ystart                    [expr {$xstart+1.3*$side}] [expr {$ystart-0.3*$side}] \
                        [expr {$xstart+1.3*$side}] [expr {$ystart-1.3*$side}] [expr {$xstart+$side}]     [expr {$ystart-$side}]        -tag C$code -fill {} -outline black
    .c create polygon   $xstart                    [expr {$ystart-$side}]     [expr {$xstart+$side}]     [expr {$ystart-$side}] \
                        [expr {$xstart+1.3*$side}] [expr {$ystart-1.3*$side}] [expr {$xstart+0.3*$side}] [expr {$ystart-1.3*$side}]    -tag C$code -fill {} -outline black
}

# drawCubes --
#     Draw the cubes using a simple encoding
#
# Arguments:
#     encoding          Nested list encoding the cubes
#
# Note:
#     The argument defines the cubes to be drawn via planes.
#     Planes are given from front to back (and are drawn from
#     back to front. Each plane is a matrix with codes indicating
#     which cubes to draw, where a "0" means skip the cube at
#     that position.
#
proc drawCubes {encoding} {
    set side 50

    for {set i 0} {$i < [llength $encoding]} {incr i} {
        set plane [lindex $encoding end-$i]

        set xoffset [expr {0.3 * $side * ([llength $encoding] - $i)}]
        #set yoffset [expr {$side * ([llength $encoding] - $i)}]
        set yoffset [expr {-$xoffset}]

        for {set j 0} {$j < [llength $plane]} {incr j} {
            set row [lindex $plane end-$j]

            set ystart [expr {$yoffset + $side * ([llength $plane] - $j + 1)}]

            for {set k 0} {$k < [llength $row]} {incr k} {
                set code [lindex $row $k]

                set xstart [expr {$xoffset + $side * $k}]

                if { $code != "0" } {
                    puts "$code -- $xstart -- $ystart"
                    drawCube $code $xstart $ystart $side
                }
            }
        }
    }
}

# Three colours, irregular
drawCubes {
   { { 2 1 1 }
     { 3 3 1 }
     { 1 1 1 } }
   { { 2 3 1 }
     { 3 3 3 }
     { 2 3 1 } }
   { { 2 2 2 }
     { 2 3 3 }
     { 2 2 1 } }
}
drawCubes {
   { { 5 4 4 }
     { 6 6 4 }
     { 4 4 4 } }
   { { 5 6 4 }
     { 6 6 6 }
     { 5 6 4 } }
   { { 5 5 5 }
     { 5 6 6 }
     { 5 5 4 } }
}

.c itemconfigure C1 -fill red
.c itemconfigure C2 -fill green
.c itemconfigure C3 -fill blue
.c itemconfigure C4 -fill red
.c itemconfigure C5 -fill green
.c itemconfigure C6 -fill blue

.c move all  30  30
.c move C4  200   0
.c move C5  400   0
.c move C6  600   0