"Rubics Cube" game

[tos]

Category:

GUI Programming

Description:

Dear Monks,

my way to gui-programming was heavily influenced by perl/Tk. It ever impressed me and I like the examples that come with „widget“. So i always wanted to create my own (bigger) Tk-application.

Someway the idea occured to me to tinker the „Rubics Cube“ with the instruments that perl/Tk offers. After first experiences with a graphical rather rudimentary approach the second attempt was an actual 3d-application.

This for me ambitious project led me to a broad variety of problems. Solving these improved (as i think) my way of programming and my comprehension. Additionally i had to recall some mathematical basics from linear algebra. Briefly said, my tinkering didn't make me more stupid :-).

Meanwhile qb3 („kjuBeeThree“), as the application is called, has grown up to 5000 lines of code and the result relatively satisfies me. Unfortunaly i didn't reach one of my aims. Qb3 isn't able to solve given twisted cubes on its own.

My ambition concerning qb3 has faded in the last time. There are a lot of other perlish things which now stronger attract my attention than this.

Nevertheless i would like to see qb3 getting better and more capable. Therefore i'll give my „Unfinished“ to the PM-community, hoping that perhaps one or two are in the mood to work along on qb3. It also might be that there are quite interesting techniques to be seen in the code. Especially the own „3d-engine“ could be of interest.

Qb3 has a lot of bugs and surely there are many things that could be done better. But if seen pragmatically and not with an academic claim i would like to say that the result so far is quite cute. I mostly like to see it shuffle while it's rotated.

Qb3 runs „out of the box“ on unix and windows if Tk.pm is installed. Regard the shape of the mousepointer. If it changes its appereance it's worth to click (and move). Try all mousebuttons.

For editing the source use vim with tabstop=3 and :set fdm=marker.

$Id: qb3,v 0.68 2008/03/04 14:30:10 tos Exp tos $

# md5sum qb3 81b7f0a98394acd86d51132094c20835 *qb3

You have to concatenate the four sourceparts in order. Then you'll have gotten the whole.

Download the parts as qb3-1,2,3,4. Then make a

cat qb3-? >qb3

the result should have the above shown md5sum

Happy playing and regards, tos

p.s.: as you surely already noticed this isn't my native language. So, please bear with me. Of course laughing is allowed. I can't hear it anyway. :-)

p.p.s.: there is a picture of qb3 on my homenode

#!/usr/bin/perl

#
#                                       _    _____ 
#            / / / /              __ _| |__|___ /             / / / / 
+   
#            [][][]/             / _` | '_ \ |_ \             [][][]/
#            [][][]/            | (_| | |_) |__) |            [][][]/
#            [][][]/             \__, |_.__/____/             [][][]/
#                                    |_|           
#
#            $Id: qb3,v 0.68 2008/03/04 14:30:10 tos Exp tos $
#
#
#             nomenclature
#
#             qb        : the whole rubics-cube-object
#             cube    : one cubic element of qb
#             slice    : cubes with a common x, y or z-axis-value

# uses {{{1
use warnings;
use strict;
use Data::Dumper;
use Tk;
use Tk::DialogBox;
use Tk qw/:eventtypes/;
use Getopt::Std;
use File::Basename;
use constant PI => (atan2(1,1) * 4);
#}}}1

# global vars {{{1
$|++;

our ($VERSION, $opt_h, $opt_v, $opt_V) 
                = ((qw($Revision: 0.68 $))[1], 0, 0, 0, 0);

getopts('hl:vV') && &opts;

our (
        $canvas, $mm, $qb, $qbCubes, $actCube, $zug, $saveIt, $tl, 
        $tlcs
);

$qbCubes = 3;    # 2 - 5 valid

our ($screenWidth, $screenHeight, $distance) = (250, 250, 50);
our $Z = 0;
our $highId = 0;
our $iColrFlag = 1;
our $rotSiSteps = 8;

our %rgb = (
                    "ora",    "#ff9933",
                    "pin",    "#ff66cc",
                    "red",    "#dd0000",
                    "gre",    "#00d000",
                    "blu",    "#3399ff",
                    "yel",    "#ffff33",
                    
                    # "oral",    "#ffce9e",
                    # "pinl",    "#ffbce8",
                    # "redl",    "#ec8282",
                    # "grel",    "#92cd92",
                    # "blul",    "#bcd9f8",
                    # "yell",    "#fffea1",

                    "oral",    "#ffefe0",
                    "pinl",    "#ffe8f7",
                    "redl",    "#f9d9d9",
                    "grel",    "#d9f7d9",
                    "blul",    "#e0efff",
                    "yell",    "#ffffe0",

                    "orad",    "#bf7326",
                    "pind",    "#bf4d99",
                    "redd",    "#a80000",
                    "gred",    "#008c00",
                    "blud",    "#2671bd",
                    "yeld",    "#bfbf26",

                    "orag",    "#70dc1e",
                    "ping",    "#70cf45",
                    "redg",    "#68b611",
                    "greg",    "#30ea11",
                    "blug",    "#3ddc51",
                    "yelg",    "#70f61e",

                    "oray",    "#fce00f",
                    "piny",    "#fcd13c",
                    "redy",    "#f2b300",
                    "grey",    "#b0f000",
                    "bluy",    "#c0e04c",
                    "yely",    "#fcff0f",

                    "orar",    "#59dbb7",
                    "pinr",    "#59c9ed",
                    "redr",    "#4da6a6",
                    "grer",    "#00eea6",
                    "blur",    "#11dbff",
                    "yelr",    "#59c9ed",

                    "DarkRed", "#8b0000",
                    "DarkGreen", "#006400",
                    "DarkBlue", "#00008b",
);

my $cRef = [
                    [$rgb{yel}, $rgb{yell}, $rgb{yeld},
                    $rgb{yelg}, $rgb{yely}, $rgb{yelr}], 

                    [$rgb{red}, $rgb{redl}, $rgb{redd},
                    $rgb{redg}, $rgb{redy}, $rgb{redr}], 

                    [$rgb{ora}, $rgb{oral}, $rgb{orad},
                    $rgb{orag}, $rgb{oray}, $rgb{orar}], 

                    [$rgb{gre}, $rgb{grel}, $rgb{gred},
                    $rgb{greg}, $rgb{grey}, $rgb{grer}], 

                    [$rgb{blu}, $rgb{blul}, $rgb{blud},
                    $rgb{blug}, $rgb{bluy}, $rgb{blur}], 

                    [$rgb{pin}, $rgb{pinl}, $rgb{pind},
                    $rgb{ping}, $rgb{piny}, $rgb{pinr}],
];

our %cD = our %cL = (
                        r1 => $cRef->[0], 
                        r2 => $cRef->[1], 
                        r3 => $cRef->[2], 
                        r4 => $cRef->[3], 
                        r5 => $cRef->[4], 
                        r6 => $cRef->[5],
); #}}}1

#---------------------------------------------------------------------
package matob;    # {{{1
#---------------------------------------------------------------------

    # 3D- and matrix-computing # - - - - - - - - - - - - - - - - - - -
+ 

    use constant EPSILON => 1e-09;
    
    sub new { # {{{2
    
        my ($pkg, $t) = @_;
    
        # $t = 0, nullmatrix
        # $t = 1, identity-matrix

        bless        [
                        [$t, 0, 0, 0],
                        [0, $t, 0, 0],
                        [0, 0, $t, 0],
                        [0, 0, 0, $t]
                    ], $pkg;
    
    }; # constructor }}}2


    sub freeRot { # {{{2
    
        # rotation around arbitrary axis which intersects the origin.
        # must have a norm of 1 to avoid changes of ojectsize

        shift;
        
        my ($ra, $phi) = @_;
        die if ref($ra) ne "vec3d";
    
        my $x = $ra->{p2}{lx};
        my $y = $ra->{p2}{ly};
        my $z = $ra->{p2}{lz};
        
        my $sphi = sin($phi);
        my $cphi = cos($phi);
        my $emcphi = 1 - cos($phi);
    
        my ($xmat, $mat1) = (new matob, new matob);
    
        $xmat->[0][0] = $x * $x * $emcphi + $cphi; 
        $xmat->[0][1] = $x * $y * $emcphi - $z * $sphi; 
        $xmat->[0][2] = $x * $z * $emcphi + $y * $sphi; 
        $xmat->[0][3] = 0;
    
        $xmat->[1][0] = $x * $y * $emcphi + $z * $sphi; 
        $xmat->[1][1] = $y * $y * $emcphi + $cphi; 
        $xmat->[1][2] = $y * $z * $emcphi - $x * $sphi; 
        $xmat->[1][3] = 0;
    
        $xmat->[2][0] = $x * $z * $emcphi - $y * $sphi; 
        $xmat->[2][1] = $y * $z * $emcphi + $x * $sphi; 
        $xmat->[2][2] = $z * $z * $emcphi + $cphi; 
        $xmat->[2][3] = 0;
    
        $xmat->[3][0] = 0; $xmat->[3][1] = 0;
        $xmat->[3][2] = 0; $xmat->[3][3] = 1;
    
        matMult($mat1,$xmat,$mm);
        matCopy($mm,$mat1);

    } # freeRot    }}}2
    
    sub invMat { # {{{2
    
        my $m = shift;
        
        # Inverses of 3x3-Matrices can be determined with 
        # determinants (hihi) and because the neutral element 
        # (line 3, row 3) at this point has no influence on the 
        # resulting determinant, we can simply reduce our matrix 
        # to 3x3 and then solve it by the rule of Sarrus
    
        my $det     = $m->[0][0] * $m->[1][1] * $m->[2][2]
                    + $m->[0][1] * $m->[1][2] * $m->[2][0]
                    + $m->[0][2] * $m->[1][0] * $m->[2][1]
                    - $m->[2][0] * $m->[1][1] * $m->[0][2]
                    - $m->[2][1] * $m->[1][2] * $m->[0][0]
                    - $m->[2][2] * $m->[1][0] * $m->[0][1];
    
        my $x =
        [
            [
                $m->[1][1] * $m->[2][2] - $m->[1][2] * $m->[2][1], 
                $m->[0][2] * $m->[2][1] - $m->[0][1] * $m->[2][2], 
                $m->[0][1] * $m->[1][2] - $m->[0][2] * $m->[1][1], 
            ],
            [
                $m->[1][2] * $m->[2][0] - $m->[1][0] * $m->[2][2], 
                $m->[0][0] * $m->[2][2] - $m->[0][2] * $m->[2][0], 
                $m->[0][2] * $m->[1][0] - $m->[0][0] * $m->[1][2], 
            ],
            [
                $m->[1][0] * $m->[2][1] - $m->[1][1] * $m->[2][0], 
                $m->[0][1] * $m->[2][0] - $m->[0][0] * $m->[2][1], 
                $m->[0][0] * $m->[1][1] - $m->[0][1] * $m->[1][0], 
            ],
        ];
        
        my $inv = new(1);
    
        for (my $z = 0; $z < 3; $z++) {
           for (my $s = 0; $s < 3; $s++) {
              $inv->[$z][$s] = $det * $x->[$z][$s];
            }
        }
    
        $inv;
    
    } # matInv }}}2

    sub matCopy { # {{{2

        # copy matrices
    
        my ($dest, $source) = @_;
    
        for (my $i=0; $i<4; $i++) {
           for (my $j=0; $j<4; $j++) {
                 $dest->[$i][$j] = $source->[$i][$j];
            }
        }
    } # matCopy }}}2
    
    sub matMult { # {{{2
    
        # multiply matrices

        my ($result, $mat1, $mat2) = @_;
    
        for (my $i=0; $i<4; $i++) {
           for (my $j=0; $j<4; $j++) {
              for (my $k=0; $k<4; $k++) {
                 $result->[$i][$j] += $mat1->[$i][$k] * $mat2->[$k][$j
+];
                }
            }
        }
        $result; # sollte auch fuer $mat1 verwendet werden ...
    
    } # matMult }}}2
    
    sub rotate { # {{{2
    
        # rotation around local x, y, and z-axis

        shift;
        my ($ax, $ay, $az) = @_;

        # x-rotationmatrix
        unless ($ax == 0) {
           
           my ($xmat, $mat1) = (new matob, new matob);
    
           $xmat->[0][0] = 1; $xmat->[0][1] = 0; 
            $xmat->[0][2] = 0; $xmat->[0][3] = 0;
    
           $xmat->[1][0] = 0; $xmat->[1][1] = cos($ax);
           $xmat->[1][2] = sin($ax); $xmat->[1][3] = 0;
            
           $xmat->[2][0] = 0; $xmat->[2][1] = -1 * sin($ax);
           $xmat->[2][2] = cos($ax); $xmat->[2][3] = 0;
    
           $xmat->[3][0] = 0; $xmat->[3][1] = 0;
           $xmat->[3][2] = 0; $xmat->[3][3] = 1;
    
           matMult($mat1,$xmat,$mm);
           matCopy($mm,$mat1);
        }
        # y-rotationmatrix
        unless ($ay == 0) {
           
           my ($ymat, $mat1) = (new matob, new matob);
    
           $ymat->[0][0] = cos($ay); $ymat->[0][1] = 0; 
            $ymat->[0][2] = -1 * sin($ay); $ymat->[0][3] = 0;
    
           $ymat->[1][0] = 0; $ymat->[1][1] = 1;
           $ymat->[1][2] = 0; $ymat->[1][3] = 0;
            
           $ymat->[2][0] = sin($ay); $ymat->[2][1] = 0;
           $ymat->[2][2] = cos($ay); $ymat->[2][3] = 0;
    
           $ymat->[3][0] = 0; $ymat->[3][1] = 0;
           $ymat->[3][2] = 0; $ymat->[3][3] = 1;
    
           matMult($mat1,$ymat,$mm);
           matCopy($mm,$mat1);
        }
        # z-rotationmatrix
        unless ($az == 0) {
           
           my ($zmat, $mat1) = (new matob, new matob);
    
           $zmat->[0][0] = cos($az); $zmat->[0][1] = sin($az); 
            $zmat->[0][2] = 0; $zmat->[0][3] = 0;
    
           $zmat->[1][0] = -1 * sin($az); $zmat->[1][1] = cos($az);
           $zmat->[1][2] = 0; $zmat->[1][3] = 0;
            
           $zmat->[2][0] = 0; $zmat->[2][1] = 0;
           $zmat->[2][2] = 1; $zmat->[2][3] = 0;
    
           $zmat->[3][0] = 0; $zmat->[3][1] = 0;
           $zmat->[3][2] = 0; $zmat->[3][3] = 1;
    
           matMult($mat1,$zmat,$mm);
           matCopy($mm,$mat1);
        }
    }; # rotate }}}2
    
    sub vecsPhi { # {{{2
    
        # expects R3-unit vectors as references on 3-element-lists
        my ($v, $w) = @_;

        #dotProd($v, $w) / (vNorm(@$v) * vNorm(@$w));
        dotProd($v, $w);
    
    } # vecsPhi }}}2

    sub vNorm { # {{{2
    
        my ($x, $y, $z) = @_;
    
        # square root of scalar product
        sqrt ($x * $x + $y * $y + $z * $z);
    
    } # vNorm }}}2

    sub dotProd { # {{{2
        
        # expects R3-unit vectors as references on 3-element-lists
        my ($v, $w) = @_;

        $v->[0] * $w->[0] + $v->[1] * $w->[1] + $v->[2] * $w->[2];
        
    }; #dotProd }}}2
    
    sub notNull { #{{{2
    
        # retuns 0 if value "near" enough to 0
        my $n = shift;
    
        abs($n) > EPSILON ? $n : 0;
    
    }; #notNull }}}2

# package matob; }}}1

#---------------------------------------------------------------------
package point3d; # {{{1
#---------------------------------------------------------------------

    use Data::Dumper;

   # lx, ly, lz :    # local coordinates
   # wx, wy, wz :    # worldcoordinatesystem is 'leftsystem'
   # sx, sy :         # screenkoordinates

    sub new { # {{{2
    
        my ($pkg, $X, $Y, $Z) = @_;
    
        bless {
                    lx    => $X,
                    ly    => $Y,
                    lz    => $Z,
        }, $pkg;
    
    }; # constructor }}}2


    sub creaHVWC { # {{{2
    
        # find out the worldcoordinates for horizontal and vertical
        # axis to get "artificial horizon"
        
        my ($p, $eAxis) = @_;
        return 0 if ref($p) ne "point3d";

        # multiplication with inverse matrix to reverse rotation for 
        # horizontal and vertical vector

        my $i = $mm->invMat;
        my ($lx, $ly, $lz) = @$eAxis;
        
        $p->{lx} =         $lx * $i->[0][0]
                       +    $ly * $i->[1][0]
                       +    $lz * $i->[2][0]
                       +            $i->[3][0];
        
        $p->{ly} =         $lx * $i->[0][1]
                       +    $ly * $i->[1][1]
                       +    $lz * $i->[2][1]
                       +            $i->[3][1];
        
        $p->{lz} =         $lx * $i->[0][2]
                        +    $ly * $i->[1][2]
                        +    $lz * $i->[2][2]
                        +            $i->[3][2];
    
        # $corr is necessary to keep the "Einheits"-lenght
        # on the rotation-axis-vector. Without this correction
        # the norm of the rotation-axis-vector will shrink or grow
        # due to inexact(floatingpoint) computings. In this case
        # the cube will suddenly shrink or grow after a couple
        # of rotations are made. Though the shrinking is funny
        # to look at, it's not desired.
        
        my $corr = sqrt(1 /     
                                      (
                                             $p->{lx} * $p->{lx}
                                         +    $p->{ly} * $p->{ly}
                                         +    $p->{lz} * $p->{lz}
                                    )
                            );
    
        # uncomment the following three lines if you want to see
        # the shrink-/grow-effekt. Therefore you have to do several
        # Button3-Motions of the whole cube.

        $p->{lx} *= $corr;
        $p->{ly} *= $corr;
        $p->{lz} *= $corr;
                    
    }; # creaHVWC }}}2

    sub creaWC { # {{{2
    
        my $p = shift;
    
        return 0 if ref($p) ne "point3d";
    
        $p->{wx} =         $p->{lx} * $mm->[0][0]
                        +    $p->{ly} * $mm->[1][0]
                        +    $p->{lz} * $mm->[2][0]
                        +                  $mm->[3][0];
    
        $p->{wy} =         $p->{lx} * $mm->[0][1]
                        +    $p->{ly} * $mm->[1][1]
                        +    $p->{lz} * $mm->[2][1]
                        +                  $mm->[3][1];
    
        $p->{wz} =         $p->{lx} * $mm->[0][2]
                        +    $p->{ly} * $mm->[1][2]
                        +    $p->{lz} * $mm->[2][2]
                        +                  $mm->[3][2];
    
    }; # creaWC }}}2

    sub project3dTo2d { # {{{2
    
        my $p = shift;
        return 0 if ref($p) ne "point3d";
    
        my $xoffset = $screenWidth/2;
        my $yoffset = $screenHeight/2;
    
        $p->{sx} = 200 * $p->{wx} / ($p->{wz} + $distance) + $xoffset;
        $p->{sy} = -200 * $p->{wy} / ($p->{wz} + $distance) + $yoffset
+;
    
    }; # project3dTo2d }}}2

    sub rotate { # {{{2

        my ($p, $ax, $ay, $az) = @_;
        my ($lx, $ly, $lz);

        unless ($ax == 0) { # x-axis-rotation
           
            ($ly, $lz) = ($p->{ly}, $p->{lz});

            $p->{ly} = $ly * cos($ax) - $lz * sin($ax);
            $p->{lz} = $ly * sin($ax) + $lz * cos($ax);

        }
        unless ($ay == 0) { # y-axis-rotation
           
            ($lx, $lz) = ($p->{lx}, $p->{lz});

            $p->{lz} = $lz * cos($ay) - $lx * sin($ay);
            $p->{lx} = $lz * sin($ay) + $lx * cos($ay);

        }
        unless ($az == 0) { # z-axis-rotation
           
            ($lx, $ly) = ($p->{lx}, $p->{ly});

            $p->{lx} = $lx * cos($az) - $ly * sin($az);
            $p->{ly} = $lx * sin($az) + $ly * cos($az);

        }

    } # rotate }}}2

    sub showAttr { # {{{2
        
        print Dumper(shift);

    }; #showAttr }}}2

# package point3d; }}}1

#---------------------------------------------------------------------
package line3d; # {{{1
#---------------------------------------------------------------------

    use Data::Dumper;

    sub new { # {{{2

        my ($pkg, $P1, $P2, $visible, $color, $name) = @_;
        
        return 0 if (
                                ref($P1) ne "point3d" 
                            or ref($P2) ne "point3d"
                        ); 

        bless {
                    p1            => $P1,
                    p2            => $P2,
                   visible     => $visible,
                   color        => $color,   
                   name        => $name,           
        }, $pkg;
    
    }; # constructor }}}2


    sub clear {  # {{{2
    
        my $l = shift;
        #return 0 if ref($l) ne "line3d";

        $canvas->delete($l->{name});
        
    } # clear }}}2

    sub creaWC { # {{{2

        my $l = shift;
        #return 0 if ref($l) ne "line3d";
    
        $l->{$_}->creaWC for qw(p1 p2);
    
    }; # creaWC }}}2

    sub eVec { # {{{2

        my $l = shift;
        return undef unless isLine3d($l);

        my ($norm, $eVec) = (norm($l), []);

        @$eVec = map {
                            matob::notNull( 
                                                    ($l->{p2}{$_} - $l
+->{p1}{$_}) 
                                                    / $norm
                            )
                    } qw(lx ly lz);

        $eVec;

    }; # eVec }}}2

    sub isLine3d { # {{{2
        
        my $l = shift;
        ref($l) ne "line3d" && do {
                                            print "$l not type \"line3
+d\"\n";
                                            return 0;
                                        };
        1;

    }; #isLine3d }}}2

    sub norm { # {{{2
    
        my $l = shift;
        return undef unless isLine3d($l);
    
        matob::vNorm(
                            $l->{p2}{lx} - $l->{p1}{lx}, 
                            $l->{p2}{ly} - $l->{p1}{ly},
                            $l->{p2}{lz} - $l->{p1}{lz}
                        );

    } # norm }}}2

    sub plot { # {{{2
    
        my $l = shift;
        #return 0 if ref($l) ne "line3d";

        my $tag = $l->{name};
    
        return unless $l->{visible};
    
        $canvas->delete($tag);
        
        $l->creaWC;
        $l->project3dTo2d;
    
        if ($l->{visible}) {
            $canvas->createLine (
                $l->{p1}{sx}, $l->{p1}{sy},
                $l->{p2}{sx}, $l->{p2}{sy},
                -fill => $l->{color},
                -tags => [$tag, "line3d"],
                -arrow => "last",
                -activefill => "yellow",
            );
        }
    } # plot }}}2

    sub project3dTo2d { # {{{2
    
        my $l = shift;
        #return 0 if ref($l) ne "line3d";
    
        $l->{$_}->project3dTo2d for qw(p1 p2);
    
    }; # project3dTo2d }}}2

    sub showAttr { # {{{2
        
        print Dumper(shift);

    }; #showAttr }}}2

# package line3d; }}}1

#---------------------------------------------------------------------
package vec3d; # {{{1
#---------------------------------------------------------------------

    # dient v.a. der Selbstverdeutlichung der perl'schen Veerbungs-
    # lehre. 'vec3ds' sind 'line3ds' deren p1 der Ursprung ist.

    # i.Ü. muß eine Erbenklasse noch nicht einmal einen eigenen Kon-
    # struktor haben.

    # die Typprüfung in line3d müßte eigentlich um 'vec3d' erweitert
    # werden. ABER, ist das dann noch oo-sauber ?

    use Data::Dumper;

    our @ISA = qw(line3d);

    sub new { # {{{2

        my ($pkg, $p, $visible, $color, $name) = @_;
        
        $pkg->SUPER::new    (
                                    new point3d(0, 0, 0), 
                                    $p, $visible, $color, $name
                                );

    }; # constructor }}}2


    sub eVec { # {{{2

        my $v = shift;
        return undef unless isVec3d($v);

        my ($norm, $eVec) = (norm($v), []);
        @$eVec = map {
                            matob::notNull($v->{p2}{$_} / $norm)
                    } qw(lx ly lz);

        $eVec;

    }; # eVec }}}2

    sub isVec3d { # {{{2
        
        my $v = shift;
        ref($v) ne "vec3d" && do {
                                            print "$v not type \"vec3d
+\"\n";
                                            return 0;
                                        };
        1;

    }; #isVec3d }}}2

    sub norm { # {{{2
    
        my $v = shift;
        return undef unless isVec3d($v);
    
        matob::vNorm($v->{p2}{lx}, $v->{p2}{ly}, $v->{p2}{lz});

    } # norm }}}2

    sub plot { # {{{2
    
        my $l = shift;
        #return 0 if ref($l) ne "vec3d";

        my $tag = $l->{name};
    
        return unless $l->{visible};
    
        $canvas->delete($tag);
        
        $l->creaWC;
        $l->project3dTo2d;
    
        if ($l->{visible}) {
            $canvas->createLine (
                $l->{p1}{sx}, $l->{p1}{sy},
                $l->{p2}{sx}, $l->{p2}{sy},
                -fill => $l->{color},
                -tags => [$tag, "vec3d"],
                -arrow => "last",
                -activefill => "yellow",
            );
        }
    } # plot }}}2

    sub rotate { # {{{2

        my ($v, $ax, $ay, $az) = @_;

        $v->{p2}->rotate($ax, $ay, $az);

    }; # rotate }}}2

    sub showAttr { # {{{2
        
        print Dumper(shift);

    }; #showAttr }}}2

# package vec3d; }}}1

#---------------------------------------------------------------------
package rect3d; # {{{1
#---------------------------------------------------------------------

    use Data::Dumper;

    sub new { # {{{2

        my ($pkg, $P1, $P2, $P3, $P4, $visible, $color, $name) = @_;
        
        return 0 if (
                                ref($P1) ne "point3d" 
                            or ref($P2) ne "point3d"
                            or ref($P3) ne "point3d"
                            or ref($P4) ne "point3d"
                        ); 

        bless {
                    p1        => $P1,
                    p2        => $P2,
                    p3        => $P3,
                    p4        => $P4,
                   visible => $visible,     # for BackfaceCulling
                   color    => $color,           # side-color, @-refer
+enz
                                                    # palette-based

                   iColr    => "gray",            # individual Color !
                   name    => $name,           
        }, $pkg;
    
    }; # constructor

    sub creaWC {

        #  /**
        #   * Diese Methode multipliziert die 3DVektoren der LOKALEN-
        #   * Koordinaten des Objektes mit der Transformationsmatrix,
        #   * die die Daten für Rotation,Verschiebung,Skalierung
        #   * enthält, und speichert die Berechnungen als die WELT-
        #   * Koordinaten des Objektes ab.
        #   *
        #   * @param r Für dieses Rechteck wird die Transformation
        #   *          durchgeführt
        #   */
    
        my $r = shift;
        return 0 if ref($r) ne "rect3d";
    
        foreach my $p qw(p1 p2 p3 p4) {
            $r->{$p}->creaWC;
        }
    
    }; # creaWC }}}2


    sub backfaceCulling { # {{{2

        #  /**
        #   * Berechnet, in welche Richtung das Polygon zeigt.
        #   * Die Formel ist die letzte Zeile des Vektorproduktes
        #   * und gibt die z-Koordinate des Normalenvektors aus
        #   * den ersten drei Punkten des Polygons an (BILDSCHIRM-
        #   * Koordinaten). Ist z positiv, so zeigt die Fläche
        #   * mindestens 90 Grad vom Betrachter weg.
        #   */

        my $r = shift;
        return 0 if ref($r) ne "rect3d";
    
        my $z =         ($r->{p2}{sx} - $r->{p1}{sx}) 
                    *     ($r->{p3}{sy} - $r->{p1}{sy})
                    -     ($r->{p2}{sy} - $r->{p1}{sy})
                    *     ($r->{p3}{sx} - $r->{p1}{sx});
    
            $r->{visible} = ($z <= 0) ? 0 : 1;
    
    }; # backfaceCulling }}}2

    sub plot { # {{{2
            
        my $r = shift;
        return 0 if ref($r) ne "rect3d";

        my ($cTag, $palType, $side) = @_;
    
        $r->project3dTo2d;
        $r->backfaceCulling;
    
        my $color;
        if ($r->{visible}) {
            
            $color = $iColrFlag 
                        ? $cL{$side}[$palType] 
                        : $r->{iColr};

            unless ($r->{id}) {
                # object doesn't yet exist
                $r->{id} = $canvas->createPolygon
                (
                    $r->{p1}{sx}, $r->{p1}{sy},
                    $r->{p2}{sx}, $r->{p2}{sy},
                    $r->{p3}{sx}, $r->{p3}{sy},
                    $r->{p4}{sx}, $r->{p4}{sy},
                    -fill => $color,
                    -tags => [$cTag, $_, "cube"],
                    -outline => "black",
                    -activewidth => 5,
                    -activeoutline => "#c2ff51",
                    #-stipple => $main::stipple,
                );
                $highId = $r->{id};
                
            } else {

                my $x = $r->{id};
                $canvas->raise($x);
                $canvas->coords(
                    $r->{id},
                    $r->{p1}{sx}, $r->{p1}{sy},
                    $r->{p2}{sx}, $r->{p2}{sy},
                    $r->{p3}{sx}, $r->{p3}{sy},
                    $r->{p4}{sx}, $r->{p4}{sy},
                );
                $canvas->itemconfigure ($r->{id},
                    -fill => $color,
                );
            }
            
        } else {

                # keep object with size 0 at position 0
                $canvas->coords($r->{id}, 0, 0, 0, 0, 0, 0, 0, 0);
        }
    }; # plot }}}2

    sub project3dTo2d { # {{{2
    
        #  /**
        #   * Projiziert die 3DVektoren der WELT-Koordinaten des
        #   * Objektes auf 2DVektoren, die die BILDSCHIRM-Koordinaten
        #   * des Objektes angeben.
        #   *
        #   * @param r Für dieses Rechteck wird die Projektion
        #   *          durchgeführt
        #   */

        my $r = shift;
        return 0 if ref($r) ne "rect3d";
    
        $r->{$_}->project3dTo2d for qw(p1 p2 p3 p4);
    
    }; # project3dTo2d }}}2

    sub rotate { # {{{2

        my ($r, $ax, $ay, $az) = @_;
        return 0 if ref($r) ne "rect3d";

        $r->{$_}->rotate($ax, $ay, $az) for qw(p1 p2 p3 p4);

    } # rotate }}}2

    sub showAttr { # {{{2
        
        print Dumper(shift);

    }; # showAttr }}}2

# package rect3d; }}}1

#---------------------------------------------------------------------
package cube3d; # {{{1
#---------------------------------------------------------------------

    use Data::Dumper;

    our $hsl;
    
    sub new { # {{{2

        my $pkg = shift;
        my (    $origX, $origY, $origZ, 
                $sideLen, $name, $visible, $pal) = @_;

        $hsl = $sideLen / 2;
    
        my ($p1, $p2, $p3, $p4, $p5, $p6, $p7, $p8, $centr) =
            (
                new point3d($origX - $hsl, $origY - $hsl, $origZ + $hs
+l), 
                new point3d($origX + $hsl, $origY - $hsl, $origZ + $hs
+l), 
                new point3d($origX + $hsl, $origY + $hsl, $origZ + $hs
+l), 
                new point3d($origX - $hsl, $origY + $hsl, $origZ + $hs
+l), 
                new point3d($origX - $hsl, $origY + $hsl, $origZ - $hs
+l), 
                new point3d($origX + $hsl, $origY + $hsl, $origZ - $hs
+l), 
                new point3d($origX + $hsl, $origY - $hsl, $origZ - $hs
+l), 
                new point3d($origX - $hsl, $origY - $hsl, $origZ - $hs
+l), 
                new point3d($origX       , $origY       , $origZ      
+ ), 
            );
        
        # back
        my $r1 = new rect3d(    $p1, $p2, $p3, $p4, 1, 
                                    $cL{r1}, "yel");
        # front 
        my $r2 = new rect3d(    $p5, $p6, $p7, $p8, 1, 
                                    $cL{r2}, "red");
        # top  
        my $r3 = new rect3d( $p4, $p3, $p6, $p5, 1, 
                                    $cL{r3}, "ora");
        # bottom 
        my $r4 = new rect3d( $p1, $p8, $p7, $p2, 1, 
                                    $cL{r4}, "gre");
        # right 
        my $r5 = new rect3d( $p2, $p7, $p6, $p3, 1, 
                                    $cL{r5}, "blu");
        # left 
        my $r6 = new rect3d( $p8, $p1, $p4, $p5, 1, 
                                    $cL{r6}, "pin");
    
        my $obj = bless {
            r1            => $r1,
            r2            => $r2,
            r3            => $r3,
            r4            => $r4,
            r5            => $r5,
            r6            => $r6,
            name        => $name,
            centr        => $centr,
            visible    => $visible,
            palette    => $pal,
        }, $pkg;

        $obj->{centr}->creaWC; # Cube-Center
    
        $obj;
        
    }; # constructor }}}2


    sub check { # {{{2
        
        my $c = shift;
        my $stat = 0;

        unless ($c->{centr}{lx} == int($c->{centr}{lx})) {
            print $c->{name}, " lx: ", 
                    $c->{centr}{lx},"  ";
                    $stat++;
        };
        unless ($c->{centr}{ly} == int($c->{centr}{ly})) {
            print $c->{name}, " ly: ", 
                    $c->{centr}{ly},"  ";
                    $stat++;
        };
        unless ($c->{centr}{lz} == int($c->{centr}{lz})) {
            print $c->{name}, " lz: ", 
                    $c->{centr}{lz},"  ";
                    $stat++;
        };
        $stat;

    }; #showAttr }}}2

    sub creaWC { # {{{2
    
        my $c = shift;
        return 0 if ref($c) ne "cube3d";
    
        $c->{centr}->creaWC;
        $c->{$_}->creaWC for (qw|r1 r2 r3 r4 r5 r6|);
        
    }; # creaWC }}}2

    sub plot { # {{{2
    
        my $c = shift;
        return 0 if ref($c) ne "cube3d";

        my $palType = $c->{palette};

        my $cTag = "c" . $c->{name};
        return unless $c->{visible};
    
        foreach (qw|r1 r2 r3 r4 r5 r6|) {
    
            $c->{$_}->plot($cTag, $palType, $_);    
        
        }
    } # plot }}}2

    sub rotate { # {{{2

        my ($c, $ax, $ay, $az) = @_;
        return 0 if ref($c) ne "cube3d";

        $c->{$_}->rotate($ax, $ay, $az) for qw(r1 r2 r3 r4 r5 r6);

        # 040516.1030 :
        # durch Visualisierung ausgewählter Punktvektoren, finde ich 
        # heraus, daß der centr-Punkt erst nach drei Umläufen eines 
        # Einzelcubes (z.b. c20) wieder den korrekten Wert annimmt.
        # warum nun der Faktor 3, für ein sauberes 'Mitlaufen' des 
        # centr-Punkts eines Cubes sorgt, bleibt mir bislang schleier-
        # haft.

        $c->{centr}->rotate($ax * 3, $ay * 3, $az * 3);

    } # rotate }}}2

    sub showAttr { # {{{2
        
        my $c = shift;

        print Dumper($c);

    }; #showAttr }}}2

    sub visible { # {{{2
        
        my ($c, $visible) = @_;
        return 0 if ref($c) ne "cube3d";
        
        foreach my $r qw(r1 r2 r3 r4 r5 r6) {
            $c->{$r}{visible} = $visible;
        }
        1;

    }; # visible }}}2


# package cube3d; }}}1

#---------------------------------------------------------------------
package slice; # {{{1
#---------------------------------------------------------------------

    # 

    use Data::Dumper;
    use constant EPSILON => 1e-09;

    my $lastActAxis;

    sub new { # {{{2

        my ($pkg, $name) = @_;
        
        $name =~ /([xyz])(\d+)/;
        
        bless {
                   name        => $name,           
                    axis        => $1,
                    val        => undef,
                    propos    => 0,
                    #gripped    => 0,
                    members    => {},
        }, $pkg;
    
    }; # constructor }}}2


    sub examine { # {{{2

        my ($val, $axis) = @_;
        my %sm;

        #print "\$val: $val\n";
        #print "\$axis: $axis\n";
    
        foreach (@{$qb->{cube}}) {
    
                            ($axis eq "x") && 
                            do {
                                    abs($_->{centr}{lx} - $val) < EPSI
+LON 
                                    && do {$sm{$_->{name}} = 1};
                                    next;
                            };
                            ($axis eq "y") && 
                            do {
                                    abs($_->{centr}{ly} - $val) < EPSI
+LON
                                    && do {$sm{$_->{name}} = 1};
                                    next;
                            };
                            ($axis eq "z") && 
                            do {
                                    abs($_->{centr}{lz} - $val) < EPSI
+LON
                                    && do {$sm{$_->{name}} = 1};
                                    next;
                            };
                            print "*** HIER DARF ICH NICHT HIN ***\n";
        }

        keys %sm != $qbCubes * $qbCubes 
                && do {
                            print Dumper \%sm;
                            main::show_msg("error", 
                                                "slice-integrity corru
+pted");
                        }; 

        \%sm;

    }; # examine }}}2
                    
    sub changeColor { # {{{2
        
        my ($s, $num) = @_;

        foreach (keys %{$s->{members}}) {
                  
            $qb->{cube}[$_]->{palette} = $num;
            
        }

    } # changeColor }}}2

    sub members { # {{{2

        my $s = shift;
        
        $s->{members} = examine($s->{val}, $s->{axis});

    }; # members }}}2

    sub propose { # {{{2

    }; # propose }}}2

    sub showAttr { # {{{2
        
        print Dumper(shift);

    }; #showAttr }}}2

# package slice; }}}1

#---------------------------------------------------------------------
package qb; # {{{1
#---------------------------------------------------------------------

    use Data::Dumper;
    use Tk;
    use Tk qw/:eventtypes/;
    use constant PI => (atan2(1,1) * 4);
    use constant EPSILON => 1e-09;
    
    sub new { # qb-object {{{2
    
        my ($pkg, $k, $gap) = @_;
        my @c;
    
# bislang wurde die jeweilige Achsenpostion eines Slices (aus Bequem-
# lichkeitsgründen) direkt im Slicenamen wiedergespiegelt, z.b.
# 'sly-10'. Da nun verschieden große qbs möglich sind, muß die Slice-
# benamsung generalisiert werden. Slicenamen werden künfig, beginnend
# beim "negativsten" aufsteigend durchnumeriert. Bsp.: 3er_qb
# 'sly-10' wird 'sly1', 'sly  0' wird 'sly2' usw.

        # 3er-Cube

# perl -we '$sl=10;foreach $z (-$sl, 0, $sl) {foreach $y (-$sl, 0, $sl
+) {foreach $x (-$sl, 0, $sl) {printf "%3d %3d %3d %3d \n", $i++, $x, 
+$y, $z};print "\n"};print "\n"}'

        my (@seq, $sl, $spalt, $slap2n, $n2slap);

        CASE: { # welches Schweinderl hätten's denn gern ? {{{3
        
                    ($k == 2) && do {
                        ($sl, $spalt) = (12, $gap && 1.2);
                        my $slh = $sl/2;
                        @seq = ([$slh, -$slh], [-$slh, $slh]);

                        # SliceAxisPosition to ordNum
                        $slap2n = {-$slh,1,$slh,2};
                        # ordNum to slap. First Value is dummy.
                        $n2slap = [2, -$slh, $slh];
                    };

                    ($k == 3) && do {
                        ($sl, $spalt) = (10, $gap && 1);
                        @seq = ([$sl, 0, -$sl], [-$sl, 0, $sl]);

                        # SliceAxisPosition to ordNum
                        $slap2n = {-$sl,1,0,2,$sl,3};
                        # ordNum to slap. First Value is dummy.
                        $n2slap = [3, -$sl, 0, $sl];
                    };

                    ($k == 4) && do {
                        ($sl, $spalt) = (8, $gap && .8);
                        my $slh = $sl/2;
                        @seq = (    [$slh * 3, $slh, -$slh, -$slh * 3]
+,
                                    [-$slh * 3, -$slh, $slh, $slh * 3]
+);

                        # SliceAxisPosition to ordNum
                        $slap2n = {-$slh * 3, 1, -$slh, 
                                        2, $slh, 3, $slh * 3, 4};
                        # ordNum to slap. First Value is dummy.
                        $n2slap = [4, -$slh * 3, -$slh, $slh, $slh * 3
+];
                    };

                    ($k == 5) && do {
                        ($sl, $spalt) = (6, $gap && .6);
                        @seq = (    [$sl * 2, $sl, 0, -$sl, -$sl * 2],
+ 
                                    [-$sl * 2, -$sl, 0, $sl, $sl * 2])
+;

                        # SliceAxisPosition to ordNum
                        $slap2n = {-$sl * 2, 1, -$sl ,2, 0, 3,
                                        $sl, 4, $sl * 2, 5};
                        # ordNum to slap. First Value is dummy.
                        $n2slap = [5, -$sl * 2, -$sl, 0, $sl, $sl * 2]
+;
                    };

        } # }}}3

        my ($i, $sp) = (0, $sl - $spalt);

        foreach my $z (@{$seq[0]}) {
            
            foreach my $y (@{$seq[0]}) {

                foreach my $x (@{$seq[1]}) {

                    $c[$i] = new cube3d(    $x, $y, $z, $sp, 
                                                sprintf ("%02d", $i), 
+1, 0);
                    $i++;

                };
            };
        };
        
        my %s;
        foreach my $j (qw(x y z)) {
                  
            for (my $i = 1; $i <= $k; $i++) {

                $s{"$j$i"} = new slice("$j$i");

            };
        };

        my $steps = $rotSiSteps * 6;
        
        bless {
                            cube        => \@c,        # single-cubes
                            slice        => \%s,        # slices
                            sideLen    => $sl,
                            s2n        => $slap2n,    # slicenames
                            n2s        => $n2slap,
                            sMovFlag    => 0,
                            actAxis    => '',
                            rS            => PI / $steps,
        }, $pkg;

    }; # constructor }}}2


    sub autoRot { # {{{2
              
        my ($qb, $dSteps) = @_;
        my $steps = abs($dSteps);
        my $dir = $dSteps / $steps;
    
        while ($steps-- > 0) {

            my $tick = 0;
            while ($tick++ < $rotSiSteps) {
                      
                $qb->oneSliceRotStep(1, $dir); 
                #DoOneEvent(DONT_WAIT);
                DoOneEvent();
            }
        }
        $qb->updSlices();
        $qb->{slice}{marked}->changeColor(0);
        $qb->corr;
        $qb->plotAllCubes;

    }; # autoRot }}}2
    
    sub check { # {{{2
        
        my $c = shift;
        my $stat = 0;

        foreach (@{$qb->{cube}}) {
            $stat += $_->check;
        }
        $stat;

    }; #check }}}2

    sub corr { # {{{2

        # if the mousepointer leaves the gripped Slice while rotation
        # and enters another slice, this one will be the 'selCubes'-
        # slice. The next statement makes sure that the actually rotat
+ed
        # slice will be corrected.
        # Surely there is a cheaper solution concerning the performanc
+e-
        # aspect but for now this one will be good enough.

        #$qb->detSlViaNam($canvas, $qb->{slice}{gripped}) if $qb->{sli
+ce}{gripped};

        # correct inaccurancies in local-x/y/z-values

        my ($qb, $slice) = @_;

        $slice ||= $qb->{slice}{marked};
        print "correcting inaccuracies in slice ",
                $slice->{name}, "\n";
        my $x;

        foreach (keys %{$slice->{members}}) {

            print "$_ vor ";
            print "(lx, ly, lz): (",
                        $qb->{cube}[$_]{centr}{lx},", ",
                        $qb->{cube}[$_]{centr}{ly},", ",
                        $qb->{cube}[$_]{centr}{lz},")\n";

            $x = sprintf "%.0f",$qb->{cube}[$_]{centr}{lx};
            $qb->{cube}[$_]{centr}{lx} = ($x =~ /^-0$/) ? "0" : $x;

            $x = sprintf "%.0f",$qb->{cube}[$_]{centr}{ly};
            $qb->{cube}[$_]{centr}{ly} = ($x =~ /^-0$/) ? "0" : $x;
                                                
            $x = sprintf "%.0f",$qb->{cube}[$_]{centr}{lz};
            $qb->{cube}[$_]{centr}{lz} = ($x =~ /^-0$/) ? "0" : $x;
                                                
            print "$_ nach ";
            print "(lx, ly, lz): (",
                        $qb->{cube}[$_]{centr}{lx},", ",
                        $qb->{cube}[$_]{centr}{ly},", ",
                        $qb->{cube}[$_]{centr}{lz},")\n\n";
        }
    }; # corr }}}2
                    
    sub selSlice { # {{{2
        
        my ($qb, $slice) = @_;

        $qb->{slice}{marked} = $slice 
                                    ? (ref($slice) eq "slice")
                                        ? $slice
                                        : $qb->{slice}{$slice}
                                    : $qb->sliceOfCube($actCube);
        
        print "selektierte slice ", $qb->{slice}{marked}{name}, "\n";
        $qb->{slice}{marked}->changeColor(5);

    } # selSlice }}}2

    sub move { # {{{2

        my ($qb, $zug) = @_;

        $zug =~ /(([xyz])\d)(-?\d)/;
        $qb->{actAxis} = $2;
        my ($slice, $x) = ($1, $3);
        $qb->selSlice($slice);
        $qb->autoRot($x);
        
    }; # move }}}2

    sub oneSliceRotStep { # {{{2
    
        my ($qb, $steps, $dir) = @_;
        my $slice = $qb->{slice}{marked};
        
        while ($steps-- > 0) {
            # Achtung, identischer Baustein in 
            # $canvas->bind('cube', '<B1-Motion>' =>  #
            foreach (keys %{$slice->{members}}) {
    
                $qb->{cube}[$_]->rotate($qb->{rS} * $dir, 0.0, 0.0) 
                                                if ($qb->{actAxis} eq 
+"x");

                $qb->{cube}[$_]->rotate(0.0, $qb->{rS} * $dir, 0.0) 
                                                if ($qb->{actAxis} eq 
+"y");

                $qb->{cube}[$_]->rotate(0.0, 0.0, $qb->{rS} * $dir) 
                                                if ($qb->{actAxis} eq 
+"z");
    
            }
        
            main::plotAll();
    
        }
    } # oneSliceRotStep }}}2

    sub plotAllCubes { # {{{2
    
        # The drawing of the individual cubes is done from far to near
+ 
        # (relative to observers position) to avoid sumptuous object-
        # clipping-computings.
    
        # (gilt das noch ???)
        # bei einem 5er-cube werden eigentlich verdeckte Polygone ange
+-
        # zeigt. Eine Lösung könnte in der Distanzmessung zur Sicht-
        # ebene und nicht zum Beobachterpunkt liegen ...
        
        my $qb = shift;
        my ($i, @a, @b) = (0);
    
        foreach (@{$qb->{cube}}) {    # remember the particular 
                                # cubeCenter-observer-distance
    
            $_->creaWC;
    
            $a[$i] = matob::vNorm($_->{centr}{wx}, $_->{centr}{wy}, 
                                $_->{centr}{wz} + $distance) . "_$i";
    
            $b[$i++] = $_;
    
        }
    
        no warnings;                             # perl grumbles, 
        foreach (sort {$b <=> $a} @a) {    # but does the demanded
                                                    # numerical sort
            /._(\d+)$/;
    
            $b[$1]->plot;
        }
        use warnings;
    
    
    } # plotAllCubes }}}2

    sub randMove { # {{{2

        my $qb = shift;
        my ($x, $slice);

        $qb->{actAxis} = [qw/x y z/]->[int(rand(3))];
        my $n = int(rand($qbCubes))+1;
        $slice = sprintf("%1s%1d", $qb->{actAxis}, $n);
        #$qb->{slice}{gripped} = $slice;
        $qb->selSlice($slice);

        do {$x = int(rand(7)) - 3} until $x;
        $zug = $slice . sprintf("%2d *", $x);
        $zug =~ s/\s//;

        [$zug, $x];

    }; # randMove }}}2

    sub shuffle { # {{{2

        my ($qb, $shuffleSteps, $movLBox) = @_;

        my ($zn, $i, $zug, $x) = (1, 0);
        
        while ($i++ < $shuffleSteps) {
            
            my $rA = $qb->randMove;
            ($zug, $x) = @$rA;

            $qb->autoRot($x);

            my $zn = $movLBox->index('end') + 1;
            $zug = sprintf("%4d: %5s", $zn, $zug);
            $movLBox->insert('end', $zug);
            $movLBox->see('end');

            $qb->{shuffleBreak} && do {
                                                    $qb->{shuffleBreak
+} = 0;
                                                    last;
                                                };
            
            #sleep 1;
        };

    }; # shuffle }}}2

    sub showAttr { # {{{2
        
        my $qb = shift;

        print Dumper($qb);

    }; #showAttr }}}2

    sub save { # {{{2
        
        my ($qb, $fname, $movLBox) = @_;

        $canvas->configure(-cursor => 'watch');
        $fname =~ s/\.q(?:sn|po|mv)$//;
        $fname ||= "noname";
        #$fname = "noname";
        print "saving $fname ... ";

        # qsn    : SNap
        open (O, ">$fname.qsn");
        $Data::Dumper::Purity = 1;
        print O Data::Dumper->Dump([$qb], ['qb']);
        close O;

        # qmv : MoVes
        my @moves = $movLBox->get(0, 'end');
        open (O, ">$fname.qmv");
        print O "$_\n" for @moves;
        close O;

        # qpo : POsition
        open (O, ">$fname.qpo");
        $Data::Dumper::Purity = 1;
        print O Data::Dumper->Dump([$mm], ['mm']);
        close O;
        print "done\n";

        $saveIt = 0;

    }; #save }}}2
  
    sub updSlices { # {{{2

        return if keys %{$qb->{constraint}};
        print "updSlices start\n";
        foreach my $j (qw(x y z)) {
                  
            $j eq $qb->{actAxis} && next;
            for (my $i = 1; $i <= $qbCubes; $i++) {

                $qb->{slice}{$j . $i}{val} ||= $qb->{n2s}[$i];
                $qb->{slice}{$j . $i}->members();

            };
        };

        print "updSlices end\n";
        
    }; #updSlices }}}2

    sub sliceOfCube { # {{{2
        
        my ($qb, $cube) = @_;
        $cube ||= $actCube;
        
        #print "\$cube: $cube\n";
        my $val = $qb->{cube}[$cube]{centr}{"l" . $qb->{actAxis}};
        #print "\$val: $val\n";
        my $slice = $qb->{actAxis} . $qb->{s2n}{$val};

        #$qb->{slice}{$slice}->showAttr;

        $qb->{slice}{$slice};
        
    }; #sliceOfCube }}}2

    sub undoMove { # {{{2

        my ($qb, $rZug) = @_;

        $rZug =~ s/,-/, / || $rZug =~ s/, /,-/;
        $qb->move($rZug);

    }; # undoMove }}}2

# package qb; }}}1