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:
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