Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

"Rubics Cube" game - part 2

by tos (Deacon)
on Mar 04, 2008 at 15:29 UTC ( #671897=sourcecode: print w/replies, xml ) Need Help??
Category: GUI Programming
Author/Contact Info tos
Description: This source-part has to be concatenated after the first one first one

Sorry, but "on the fly" i don't see other quick possibilities

:-)

#---------------------------------------------------------------------
package main;
#---------------------------------------------------------------------

sub init { # {{{1
                
                $zug = "";

                undef $mm;
                $mm = new matob(1);

                undef $qb;
                $qb = new qb($qbCubes, 1);
                $qb->updSlices();
                $qb->{actAxis} = 'y';
    

                print $qb->{cube},"\n";

                my $font = 
                '-misc-fixed-medium-r-normal-*-*-150-*-*-c-*-iso8859-9
+';
                $font = '-misc-fixed-medium-r-*-*-13-*-*-*-m-*-*-*';
                my $font2 = '-*-console-medium-*-*-*-16-*-*-*-*-*-*-*'
+;
                $font2 = '-*-courier-medium-r-*-*-14-*-*-*-*-*-*-*';

                my $al = 26;
                my $xAxis = new line3d(    new point3d(-$al, 0, 0), 
                                                new point3d($al, 0, 0)
+, 
                                                1, "gray20", "xAxis");

                my $yAxis = new line3d(    new point3d(0, -$al, 0), 
                                                new point3d(0, $al, 0)
+, 
                                                1, $rgb{DarkRed}, "yAx
+is");
                
                my $zAxis = new line3d(    new point3d(0, 0, -$al), 
                                                new point3d(0, 0, $al)
+, 
                                                1, "blue", "zAxis");

                my $horiz = new vec3d(    new point3d(1, 0, 0), 
                                                1, "green", "vektor");

                my $vertik = new vec3d(new point3d(0, 1, 0), 
                                                1, "orange", "vektor")
+;

                my $cvac = new vec3d($qb->{cube}[$actCube]{centr}, 
                                            1, "white", "cvac");

                # all vars should be kept in a common ds

                {
                                cvac                => $cvac,
                                freezeCvac         => 0,
                                font                => [$font, $font2]
+,
                                horiz                => $horiz,
                                old_fill         => '',
                                PFLAG                => 1,
                                plotCS            => 0,
                                plotTri            => 0,
                                triX                => 0,
                                triY                => 0,
                                triZ                => 0,
                                showCvac         => 1,
                                shuffleSteps    => 1,
                                vertik            => $vertik,
                                xAxis                => $xAxis,
                                xb1down             => 0,
                                xb3down             => 0,
                                yAxis                => $yAxis,
                                yb1down             => 0,
                                yb3down             => 0,
                                zAxis                => $zAxis,
                }
} # init }}}1

my $V = init();

sub plotAllVectors { #{{{1

    $V->{showCvac} && $V->{cvac}->plot;
    $V->{horiz}->plot;
    $V->{vertik}->plot;
    #$c20_centr->plot;
                    
}; #}}}1

sub plotAll { #{{{1

    #print "plotte mal wieder all\n";;
    $qb->plotAllCubes;
    plotCS() if $V->{plotCS};
    plotTri() if $V->{plotTri};
    # plotAllVectors;

} # plotAll #}}}1

sub plotCS { #{{{1

    $V->{xAxis}->plot; $V->{yAxis}->plot; $V->{zAxis}->plot;

} # plotCS #}}}1

sub remCS { #{{{1

    $V->{xAxis}->clear; $V->{yAxis}->clear; $V->{zAxis}->clear;

} # remCS #}}}1

sub plotTri { #{{{1

    $V->{triX}->plot; $V->{triY}->plot; $V->{triZ}->plot;

} # plotCS #}}}1

sub remTri { #{{{1

    $V->{triX}->clear; $V->{triY}->clear; $V->{triZ}->clear;

} # remCS #}}}1

sub fileDialog { #{{{1

    my $w = shift;
    my $operation = shift;
    my $file;
    #   Type names        Extension(s)    Mac File Type(s)
    #
    #---------------------------------------------------------
    my @types = (    
                        ["qb3-Snapshot files",     '.qsn'],
                        ["qb3-Moves files",         '.qmv'],
                        ["qb3 files (deprecated)",    '.qb3'],
                        #["All files",        '*']
                    );
    if ($operation eq 'open') {
        $file = $w->getOpenFile(-filetypes => \@types);
    } else {
        $file = $w->getSaveFile(-filetypes => \@types,
                                        -initialfile => 'noname',
                                        #-defaultextension => '.qb3');
                                        );
    }

    $file;
    #if (defined $file and $file ne '') {
    #    $ent->delete(0, 'end');
    #    $ent->insert(0, $file);
    #    $ent->xview('end');
    #}
} # fileDialog }}}1

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Widgets and bindings
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

# Menus {{{1

my $top = MainWindow->new();
$top->resizable(1, 1);

# Menu Bar # {{{2
my $menu_bar = $top
                    ->Frame(
                                -relief => 'raise', 
                                -borderwidth  => 2)
                    ->pack(-side => 'top', -fill => 'x');
#}}}2

# Game Menu # {{{2
my $menuB1 = $menu_bar
                    ->Menubutton(-text => 'Game')
                    ->pack(-side => 'left', -padx => 2);

$menuB1->command(    -label       => 'New',
                        -accelerator => 'Ctrl-n',
                        -underline   => 0,
                        -command => \&newGame,
                    );
$top->bind('<Control-n>' => \&newGame);

$menuB1->separator();
$menuB1->command(    -label       => 'Load',
                        -accelerator => 'Ctrl-l',
                        -underline   => 0,
                        -command => \&load,
                    );

$menuB1->command(    -label       => 'Save as',
                        -accelerator => 'Ctrl+s',
                        -underline   => 0,
                        -command => \&save,
                    );
$menuB1->separator();
$menuB1->command(    -label       => 'Quit',
                        -accelerator => 'q',
                        -underline   => 0,
                        -command     => \&lebWohl,
                    ); #}}}2

# Dialogs Menu # {{{2
use subs qw/colMenu moveInp/;

# 040930: Menubutton's menuitems expects a list-of-list-
#             reference. It doesn't matter whether this reference
#             is delivered by list-reference or via sub.

my $diaMenu = 
    [
        ['cascade', "Colors", -menuitems => colMenu],
        ['command', 'MoveInput', -command => \&moveInp],
        ['command', 'checkSlices', -command => \&checkSlices],
    ];

#sub diaMenu {
#    [
#        ['cascade', "Colors", -menuitems => colMenu],
#    ],
#}

my $menuB4 = $menu_bar
                    ->Menubutton(    -text => 'Dialogs', 
                                        -menuitems => $diaMenu)
                    ->pack(-side => 'left', -padx => 2);

#my $menuB4 = $menu_bar
#                    ->Menubutton(    -text => 'Colors', 
#                                        -menuitems => colMenu)
#                    ->pack(-side => 'left', -padx => 2);
#
# the Slick, Sophisticated, New-Fashioned Way, 
#                                 -> 12.2.2. masteringPerlTk\ch12_02.h
+tm
#
# auf die folgende Art läßt sich sehr elegant das kaskadierende 
# Farbmenu erzeugen. 

sub colMenu { #{{{3

    [
      ['command', 'default', -command => 
        sub {
                 foreach (keys %cD) {
                    $menuB4->entryconfigure
                                    ($_, -background => $cD{$_}[0]);
                    %cL = %cD;
                    plotAll();
                }
             }
        ],

        map ['cascade', $_, 
                -background => $cL{$_}[0], -menuitems =>
          [
             map ['command', $_, -background => $rgb{$_}, 
                     -command => 
                    [    sub {    
                                print "\$_: $_\n";
                                print "\$menuB4: $menuB4\n";
                                # nachdem das colMenu ein Stufe tiefer
+ ge-
                                # rutscht ist, kann ich den index des 
+ersten
                                # col-Menus nicht mehr ermitteln. ?!
                                # bekomme nur 'none'. Lösung vermutlic
+h dann,
                                # wenn ich die folgende Zeile tatsächl
+ich ver-
                                # standen und anschließend modifiziert
+ habe.
                                # don't give up ...
                                # bis v0.52 funktioniert colMenu; alle
+rdings
                                # auf höherer Menustufe
                                my $i1 = $menuB4->menu()->index("activ
+e");
                                my $i2 = shift @_;
                                 print "$i1/$i2\n";

                                my $i3 = index ("yelredoragreblupin", 
+$i2)/3;
                                 print "\$i3: $i3\n";
                                my $i4 = $i1 - 1;
                                $cL{"r$i4"} = $cRef->[$i3];

                                $menuB4->entryconfigure($i1, 
                                                -background => $rgb{$i
+2});
                                plotAll();
                             }, $_
                     ],
                 ], qw/yel red ora gre blu pin/,
          ],
        ], qw/r1 r2 r3 r4 r5 r6/,
    ],

} # end colMenu  }}}3

sub moveInp { #{{{3
    
    if (! Exists($tl)) {
        $tl = $top->Toplevel( );
        $tl->title("MoveInput");
        my $text = $tl->Scrolled('Text', 
                            -width => 25, 
                            -height => 10, 
                            -scrollbars => 'w')->pack(qw/    -fill y 
                                                                    -e
+xpand 1/);
                            
        $tl->Button(-text => "Clear", -command => 
            sub { 
                    $text->delete("1.0", "end");
            }
        )->pack(-side => 'left');
        
        $tl->Button(-text => "Commit", -command => 
            sub { 
                    my @z =  split /\n/, $text->get("1.0", "end");

                    foreach (@z) {
                        /([xyz]\d)([+-]?\d)/
                            ? do     {
                                        my $z = "$1$2";
                                        print "tue $z\n";
                                        $qb->move($z);
                                    }
                            : print "invalid Move\n";
                    };
            }
        )->pack(-side => 'left');

        $tl->Button(-text => "HighLightCubes", -command => 
            sub { 
                    my @z =  split /\n/, $text->get("1.0", "end");

                    foreach (@z) {
                        /(\d\d)/ && print $1,"\n";
                        $qb->{cube}[$1]->{palette} = 4;
                    };
                    plotAll();
            }
        )->pack(-side => 'left');

        $tl->Button(-text => "Close", -command => 
            sub { 
                    $tl->withdraw 
            }
        )->pack(-side => 'left');

    } else {
        $tl->deiconify( );
        $tl->raise( );
    }

} # end moveInp #}}}3

sub checkSlices { #{{{3
    
    if (! Exists($tlcs)) {
        $tlcs = $top->Toplevel( );
        $tlcs->title("checkSlices");

        # setup the default value we would like
        my $rb_value = "gray";
        $tlcs->configure(-background => $rb_value);
        
        # create the Radiobuttons that will let us change it
        foreach (qw(x y z)) {
            my $fr = $tlcs->Frame(
                                            -borderwidth => 2, 
                                            #-relief => 'ridge',
                                            )->pack(qw/-side left/);

            for (my $i = 1; $i <= $qbCubes; $i++) {
              $fr->Radiobutton(
                              -text => $_ . $i,
                        -value => $_ . $i,
                        -variable => \$rb_value,
                        -command => \&set_bg)->pack(-side => 'top');
            }
        }
        
        sub set_bg {
            foreach (0 .. $qbCubes ** 3 - 1) {
                $qb->{cube}[$_]->{palette} = 0;
            };
            plotAll();
            #print "\$rb_value: $rb_value\n";
            foreach (keys %{$qb->{slice}{$rb_value}{members}}) {
                $qb->{cube}[$_]->{palette} = 1;
            };
            plotAll();
        }

        $tlcs->Button(-text => "Clear", -command => 
            sub { 
                    foreach (0 .. $qbCubes ** 3 - 1) {
                        $qb->{cube}[$_]->{palette} = 0;
                    };
                    plotAll();
            }
        )->pack(-fill => 'y', -expand => 1, -side => 'top');

        $tlcs->Button(-text => "Close", -command => 
            sub { 
                    $tlcs->withdraw 
            }
        )->pack(-side => 'bottom');

    } else {
        $tlcs->deiconify( );
        $tlcs->raise( );
    }

} # end moveInp #}}}3

# }}}2

# Options Menu  # {{{2
my $mOptions = $menu_bar
                    ->Menubutton(-text => 'Options')
                    ->pack(-side => 'left', -padx => 2);

$mOptions->separator;

my $cubeMenu = $mOptions->cget(-menu)->Menu();
$mOptions->cascade(-label => "cubes", 
                         -underline => 0,
                         -menu => $cubeMenu);

foreach (qw/2 3 4 5/) {
    $cubeMenu->radiobutton(
        -label    => $_,
        -variable => \$qbCubes,
    );
}

$mOptions->checkbutton(    -label    => 'show cvac',
                                -variable => \$V->{showCvac});
$mOptions->checkbutton(    -label    => 'freeze cvac',
                                -variable => \$V->{freezeCvac});
$mOptions->separator;

my $shufMenu = $mOptions->cget(-menu)->Menu();
$mOptions->cascade(-label => "shuffleSteps", 
                         -underline => 0,
                         -menu => $shufMenu);
$shufMenu->radiobutton(-label    => '3',
                        -variable => \$V->{shuffleSteps});
$shufMenu->radiobutton(-label    => '5',
                        -variable => \$V->{shuffleSteps});
$shufMenu->radiobutton(-label    => '9',
                        -variable => \$V->{shuffleSteps});
$shufMenu->radiobutton(-label    => '20',
                        -variable => \$V->{shuffleSteps});
$shufMenu->radiobutton(-label    => '50',
                        -variable => \$V->{shuffleSteps});
# }}}2

# "Questionmark"-menu {{{2
my $qmMenu = $menu_bar
                    ->Menubutton(-text => '?')
                    ->pack(-side => 'left', -padx => 2);

$qmMenu->command(    -label       => 'Help',
                        -accelerator => 'Meta+H',
                        -underline   => 0,
                        -command     => sub {print "hilf dir selbst da
+nn \
                                                                hilft 
+dir gott...\n"}
                    );

sub mbox {

    my $mbox = $top->DialogBox( 
                                            -title => "About qb3",
                                            -buttons => ["ok"],
                    );

    my $fr = $mbox->add('Frame',     -borderwidth => 2, 
                                            -relief => 'ridge')
                ->pack(qw/-side left/);

    $fr->Label(-image => $mbox->Pixmap(    -data => &greyCubeLogo))
                ->pack(qw/-side top/);

    $mbox->add('Label', 
                    -text => " Version: $VERSION\n\n" 
                                . "Perl: $]\n" 
                                . "Tk  : $Tk::VERSION", 
                    -relief => "groove", 
                    )->pack(-side => 'left');

    $mbox->add('Label', -image => $top->Pixmap(-data => &ptk))
                ->pack(qw/-side top/);
    $mbox->add('Label', -image => $top->Pixmap(-data => &cwVim))
                ->pack(qw/-side top/);
    $mbox->add('Label', -image => $top->Pixmap(-data => &wilbur))
                ->pack(qw/-side top/);
    $mbox->add('Label', -image => $top->Pixmap(-data => &tos),
                    -relief => "groove", 
                 )->pack(qw/-side top/);
    $mbox->add('Label', 
                    -text => " made by tos", 
                    -relief => "groove", 
                    )->pack(-side => 'top');


    $mbox->Show();

}; #}}}2

sub show_msg { #{{{1

    my($iconvar, $message, $movLBox) = @_;

    my $button = $top->messageBox(

        -icon => $iconvar, 
        -type => "OK",
        -title => 'Message',
        -message => $message

    );
    #$saveIt && $qb->save("errDump", $movLBox);
    exit;

} # show_msg }}}1

$qmMenu->command(
                -label       => 'About',
                -accelerator => 'Meta+A',
                -underline   => 0,
                -command => \&mbox,
                ); # }}}2

# menus }}}1

# dashboard {{{1

my $mainFrame = $top
                    ->Frame(-bd => "2")
                    ->pack(-side => 'top', -fill => 'x');

my $rf = $mainFrame
                    ->Frame(    -bd => "2",
                                #-cursor => 'rtl_logo',
                                #-cursor => 'question_arrow',
                                #-cursor => 'draped_box',
                                -cursor => 'plus',
                            )
                    ->pack(-side => 'right', -fill => 'y');

my $tf = $mainFrame
                    ->Frame()
                    ->pack(-side => 'top', -fill => 'both');

my $cubAnz1 = $tf
                    ->Label(    -text => "", 
                                #-relief => "groove", 
                                -width => 30, -foreground => $rgb{Dark
+Green}, 
                                -height => 4,
                                -font => $V->{font}[0])
                    ->pack(-fill => 'x', -expand => 1, -side => 'left'
+);

my $bf = $mainFrame
                    ->Frame()
                    ->pack(-side => 'bottom', -fill => 'x');

my $cubAnz2 = $bf
                    ->Label(    -text => "", 
                                #-relief => "groove", 
                                -foreground => $rgb{DarkGreen}, 
                                -height => 4,
                                -font => $V->{font}[0])
                    ->pack(-fill => 'x', -expand => 1, -side => 'left'
+);

my $lf = $mainFrame
                    ->Frame(
                                #-relief => "groove", 
                                -cursor => 'plus',
                                -bd => "2")
                    ->pack(-side => 'left', -fill => 'y');

my $tlf = $lf
                    ->Frame(
                                #-relief => "groove", 
                                -bd => "2")
                    ->pack(-side => 'top', -fill => 'x');

my $blf = $lf
                    ->Frame(
                                #-relief => "groove", 
                                -bd => "2")
                    ->pack(-side => 'bottom', -fill => 'x');


$top->Icon(-image => $top->Pixmap(-data => &icon));

my $hMovLBox = $tlf
                    ->Label(    -text => "Moves", -relief => "flat", 
                                -foreground => "gray20",
                                -cursor => 'pirate',
                                #-width => 10,
                                -font => $V->{font}[0])
                    ->pack(-side => 'top', -fill => 'x');

my $movLBox = $tlf
                    ->Scrolled(qw/Listbox -width 16 -height 7
                    -setgrid 1 -scrollbars w
                    -bd 2/,
                    -font => $V->{font}[1])
                    ->pack();
                    #-bg LemonChiffon2 /,

my $canvFram = $mainFrame
                    ->Frame(
                                #-relief => "groove", 
                                -width => 600,
                                -height => 270,
                                -bd => "2")
                    ->pack(-side => 'left');

$canvas = $canvFram
                    ->Canvas(-width     => $screenWidth, 
                                -height     => $screenHeight, 
                                #-relief     => "ridge", 
                                -cursor     => 'crosshair')
                    ->pack(-side => 'left', -fill => 'both');

my $detInf = $rf
                    ->Frame(
                            )
                    ->pack(-side => 'right', -fill => 'both');

my $statLine = $top
                    ->Frame(    -relief => "raise", -bd => "2", -heigh
+t => 8)
                    ->pack(-side => 'top', -fill => 'both');

my $statAnz = $top
                    ->Frame(    -relief => "sunken", -bd => "2",
                                -foreground => $rgb{DarkGreen})
                    ->pack(-side => 'top', -fill => 'x');


my $lvFrame = $detInf
                    ->Frame(    -relief => "flat", -bd => "2")
                    ->pack(-side => 'top', -fill => 'x');

my $wvFrame = $detInf
                    ->Frame(    -relief => "flat", -bd => "2")
                    ->pack(-side => 'top', -fill => 'x');

my $dFrame = $detInf
                    ->Frame(    -relief => "flat", -bd => "2")
                    ->pack(-side => 'top', -fill => 'x');

my $oFrame = $detInf
                    ->Frame(    -relief => "flat", -bd => "2")
                    ->pack(-side => 'top', -fill => 'x');

my $sVFrame = $detInf
                    ->Frame(    -relief => "flat", -bd => "2")
                    ->pack(-side => 'top', -fill => 'x');

my $rfDeckl = $detInf
                    ->Label(    -relief => "flat", 
                                -width => "50", 
                                -height => "40", 
                                -text => "")
                   ->place(-x => 0, -y => 0);

my $tlfDeckl = $tlf
                    ->Label(    -relief => "flat", 
                                -width => "50", 
                                -height => "20", 
                                -text => "")
                   ->place(-x => 0, -y => 0);

my $blfDeckl = $blf
                    ->Label(    -relief => "flat", 
                                -width => "50", 
                                -height => "20", 
                                -text => "")
                   ->place(-x => 0, -y => 0);

my $lvLab = $lvFrame
                    ->Label(    -text => "localCoords", 
                                -relief => "flat", 
                                -cursor => 'pirate',
                                -foreground => "gray20",
                                -width => 20,
                                -font => $V->{font}[0])
                    ->pack(-side => 'top');

my $lxAnz = $lvFrame
                    ->Label(    -text => "", -relief => "sunken", 
                                -foreground => "gray20",
                                -width => 10,
                                -font => $V->{font}[0])
                    ->pack(-side => 'top');

my $lyAnz = $lvFrame
                    ->Label(    -text => "", -relief => "sunken", 
                                -foreground => $rgb{DarkRed},
                                -width => 10,
                                -font => $V->{font}[0])
                    ->pack(-side => 'top');

my $lzAnz = $lvFrame
                    ->Label(    -text => "", -relief => "sunken", 
                                -foreground => $rgb{DarkBlue},
                                -width => 10,
                                -font => $V->{font}[0])
                    ->pack(-side => 'top');

my $cubAnz = $statLine
                    ->Label(    -text => "", -relief => "sunken", 
                                -width => 3, -foreground => $rgb{DarkG
+reen}, 
                                -font => $V->{font}[0])
                    ->pack(-side => 'left');

my $rectAnz = $statLine
                    ->Label(    -text => "", -relief => "sunken", 
                                -width => 2, -foreground => "blue", 
                                -font => $V->{font}[0])
                    ->pack(-side => 'left');

my $sliceAnz = $statLine
                    ->Label(    -text => "", -relief => "sunken", 
                                -width => 5, -foreground => "darkorchi
+d", 
                                -foreground => "purple", 
                                -font => $V->{font}[0])
                    ->pack(-side => 'left');

my $vecAnz = $statLine
                    ->Label(    -text => "", -relief => "sunken", 
                                -width => 4,
                                -foreground => "darkorchid", 
                                -font => $V->{font}[0])
                    ->pack(-side => 'left');

my $statFram = $statLine
                    ->Frame(    -relief => "groove", -bd => "1",
                                #-height => 3)
                                )
                    ->pack(-side => 'left', -fill => "x");

$statFram->bind('<1>' => 
            sub {
                    print "bye, bye Sir!\n";
                    exit;
            });

my $shuffle = $statFram
                    ->Button(-text => "shuffle",
                                -height => 0.3,
                                -command => 
                                sub {
                                        keys %{$qb->{constraint}} && r
+eturn;
                                        $qb->shuffle(
                                                            $V->{shuff
+leSteps}, 
                                                            $movLBox
                                                        );
                                },
                                -font => $V->{font}[0])
                    ->pack(-side => 'left');

my $leave = $statFram
                    ->Label(    -text => "",
                                -width => 40,
                                -cursor => 'pirate',
                                -font => $V->{font}[0])
                    ->pack(-side => 'left', -fill => 'x');

my $yKoor = $statLine
                    ->Label(    -text => "", -relief => "sunken", 
                                -width => 3, 
                                -font => $V->{font}[0])
                    ->pack(-side => 'right');

my $xKoor = $statLine
                    ->Label(    -text => "", -relief => "sunken", 
                                -width => 3, 
                                -font => $V->{font}[0])
                    ->pack(-side => 'right');

my $lwLab = $wvFrame
                    ->Label(    -text => "worldCoords", 
                                -relief => "flat", 
                                -foreground => "gray20",
                                -width => 12,
                                -font => $V->{font}[0])
                    ->pack(-side => 'top');

my $xKoor3d = $wvFrame
                    ->Label(    -text => "", -relief => "sunken", 
                                -width => 10, -foreground => "gray20",
+ 
                                -font => $V->{font}[0])
                    ->pack(-side => 'top');

my $yKoor3d = $wvFrame
                    ->Label(    -text => "", -relief => "sunken", 
                                -width => 10, -foreground => $rgb{Dark
+Red}, 
                                -font => $V->{font}[0])
                    ->pack(-side => 'top');

my $zKoor3d = $wvFrame
                    ->Label(    -text => "", -relief => "sunken", 
                                -width => 10, -foreground => $rgb{Dark
+Blue}, 
                                -font => $V->{font}[0])
                    ->pack(-side => 'top');

my $dLab = $dFrame
                    ->Label(    -text => "distance", 
                                -relief => "flat", 
                                -foreground => "gray20",
                                -width => 12,
                                -font => $V->{font}[0])
                    ->pack(-side => 'top');

my $distLab = $dFrame
                    ->Label(    -text => "", -foreground => "red", 
                                -relief => "sunken", -width => 10, 
                                -font => $V->{font}[0])
                    ->pack(-side => 'top');

my $oLab = $oFrame
                    ->Label(    -text => "query", 
                                -relief => "flat", 
                                -foreground => "gray20",
                                -width => 12,
                                -font => $V->{font}[0])
                    ->pack(-side => 'top');

my $rSentry = $oFrame
                    ->Entry(-relief => "sunken", -width => 10, 
                                 -textvariable => \$qb->{query},
                                 -validate => 'key',
                                -font => $V->{font}[0])
                    ->pack(-side => 'top');

my $sVLab = $sVFrame
                    ->Label(    -text => "selVect", 
                                -relief => "flat", 
                                -foreground => "gray20",
                                -width => 12,
                                -font => $V->{font}[0])
                    ->pack(-side => 'top');

my $sVxAnz = $sVFrame
                    ->Label(    -text => "", -relief => "sunken", 
                                -foreground => "gray20",
                                -width => 10,
                                -font => $V->{font}[0])
                    ->pack(-side => 'top');

my $sVyAnz = $sVFrame
                    ->Label(    -text => "", -relief => "sunken", 
                                -foreground => $rgb{DarkRed},
                                -width => 10,
                                -font => $V->{font}[0])
                    ->pack(-side => 'top');

my $sVzAnz = $sVFrame
                    ->Label(    -text => "", -relief => "sunken", 
                                -foreground => $rgb{DarkBlue},
                                -width => 10,
                                -font => $V->{font}[0])
                    ->pack(-side => 'top');

my $sVnAnz = $sVFrame
                    ->Label(    -text => "", -relief => "sunken", 
                                -foreground => "black",
                                -width => 10,
                                -font => $V->{font}[0])
                    ->pack(-side => 'top');

sub lebWohl {
                    $top->iconify();
                    #$saveIt && $qb->save("noname", $movLBox);
                    print "bye, bye Sir!\n";
                    exit;
}; # lebWohl

my $hiddenMB = $top->Menubutton(
    -text   => 'File',
    -relief => 'raised',
);
#$file->pack(qw/-side left/);

my $hiddenM = $hiddenMB->Menu(-tearoff => 0, -menuitems => [
    [qw/command ~color/],
    '',
    [qw/command ~position/],
    '',
    [qw/command ~properties/],
    '',
    [qw/command ~hide/],
    '',
    [qw/command ~Quit/, -command => \&exit],
]);
$hiddenMB->configure(-menu => $hiddenM);
#print "\$hiddenM: $hiddenM\n";


sub load { # {{{3

                $canvas->configure(-cursor => 'watch');
                my $file = shift || fileDialog($top, "open");
                $file || return;
                #print "\$file: $file\n";
                my ($name,$path,$ext) = fileparse($file, '\..*');
                
                #print "\$name: $name\n";
                #print "\$path: $path\n";
                #print "\$ext: $ext\n";

                print "loading ... ";
                $canvas->delete('all');

                #local $/ = "";

                CASE: {
                            ($ext eq ".qsn") && do 
                            {
                                my $ds;
                                open I, $file;
                                while (<I>) {
                                    m/\'id\'\s+\=\>\s+\d+/ && next;
                                    $ds .= $_;
                                };
                                close I;
                                eval $ds;
                            };

                            ($ext eq ".qmv") && do 
                            {
                                open I, $file;
                                while (<I>) {
                                                    #print;
                                                    chomp;
                                                       $movLBox->inser
+t('end', $_);
                                                    /([xyz]\d-?\d)/;
                                                    my $haltMal = $1;
                                                    #print "will $halt
+Mal\n";
                                                    $qb->move($haltMal
+);
                                }
                                close I;
                            };
                };

                open (I, $path . $name . ".qpo");
                my $ds = (<I>);
                print $ds;
                close I;
                eval $ds;
                
                print "done\n";
                plotAll();
                print "\$qb: $qb\n";
                $canvas->configure(-cursor => 'crosshair');

}; # load }}}3

sub save { # {{{3
                    my $f = fileDialog($top, "save");
                    $qb->save($f, $movLBox) if defined $f;
}; # save }}}3

sub newGame { # {{{3
                    $canvas->delete('all');
                    $movLBox->delete(0,'end');
                    $V = init();
                    $mm->rotate(PI/-6, PI/6, 0.0);
                    plotAll();
}; #}}}3

# dashboard }}}1

# bindings # {{{1

my $labDefColor = $statLine->cget('-background');
my $highLightBgColor = "wheat2";
#$lyAnz->configure(-background  => $highLightBgColor);

sub updDashBoard { # {{{2

    {
        ($qb->{actAxis} eq "x") && 
        do {
                $lyAnz->configure(-background  => $labDefColor);
                $lzAnz->configure(-background  => $labDefColor);
                $lxAnz->configure(-background  => $highLightBgColor);
        };
        ($qb->{actAxis} eq "y") && 
        do {
                $lxAnz->configure(-background  => $labDefColor);
                $lzAnz->configure(-background  => $labDefColor);
                $lyAnz->configure(-background  => $highLightBgColor);
        };
        ($qb->{actAxis} eq "z") && 
        do {
                $lxAnz->configure(-background  => $labDefColor);
                $lyAnz->configure(-background  => $labDefColor);
                $lzAnz->configure(-background  => $highLightBgColor);
        };
    }

} # updDashBoard # }}}2

#$top->bind('<A>' =>  # {{{2
#            # uneingerastete Slice-Stellung, deren Möglichkeit ich au
+s
#            # effekthascherischen Erwägungen beibehalten will, bringt
+ 
#            # leider Mehraufwand mit sich. (eigentlich logisch)
#            # Nun der Versuch das in, auch noch nach Monaten verständ
+-                 # liche Worte zu fassen. Also:
#
#            # Definition: "gerastet" meint, daß die Kanten aller Cube
+s
#            #                     eine Slices parallel zu den jeweils
+ korres-
#            #                    pondierenden Koordinatenachsen stehe
+n.
#            #                    Zu Spielbegin sind alle Slices geras
+tet.
#            #                    
#
#            # Definition: "engaged" [(ein)gerastet] means that all cu
+be-
#            #                  edges of a slice are parallel with the
+ parti-
#            #                   cular coordinate-axises. At the begin
+ning of
#            #                  a game all slices are engaged.
#            #                       
#            
#            # - Doppelklick auf gerasteten Slice führt zu Achsen-
#            #   wechsel. So solls auch sein. Ist der Slice nicht ge-
#            #   rastet, so findet kein Achsenwechsel statt. Es können
#            #   jetzt nur Slices gedreht werden, die senkrecht auf
#            #   der gleichen Achse stehen. (Schaschlikspieß).
#
#            # - Doubleclick on engaged slice leads to change of rota-
#            #   tionaxis. That's the way it has to be. If the slice i
+s
#            #   not engaged there will be no change of axis. Only sli
+ces
#            #   then can be rotated which are vertical to the same ax
+is.
#            #   Think of a skewer.
#
#            # - erst wenn alle Slices in der Flucht liegen UND gerast
+et
#            #   sind, kann wieder Achsenwechsel stattfinden.
#            
#            # - not until all slices lay in straight line AND are eng
+a-
#            #   ged change of axis can be done.
#
#            # - sind alle Slices gefluchtet aber nicht gerastet, steh
+en
#            #   sie gemeinsam schief im KS. Um wieder in alle Richtun
+gen
#            #   beweglich zu sein, muß jetzt erst wieder Orthogonalit
+ät
#            #   zwischen Slices und KS hergestellt werden.
#
#            # - if all slices are in straight line but not engaged th
+ey
#            #   have a common crooked position. To make them mavable 
+to
#            #   all directions there has to be at first an orthogonal
#            #   (relative) position between slices and coordinatesyst
+em.
#
#            # die folgende Subroutine soll ausgehend von einem repräs
+en-
#            # tativen Slice alle drei gemeinsam zurück in einen geras
+te-
#            # ten Zustand drehen.
#
#            # the following subroutine ...
#
#            sub {
#                print "<A>\n";
#                # adjust (make orthogonal) slices 
#                # relativ to coorSystem
#
#                my $slice = $qb->{slice}{gripped};
#                print "\$slice: $slice\n";
#                $slice =~ /^(sl[xyz])/;
#                my $slPrfx = $1;
#                
#                my $steps = $qb->{rot}{$slice};
#                my $dir = $steps / abs($steps);
#                $steps = abs($steps) % $rotSiSteps;
#                my $diff = $rotSiSteps - $steps;
#                if ($diff < $steps) {
#                                                $steps = $diff;
#                                                $dir = -$dir;
#                };
#
#                print "\$steps: $steps\n";
#                print "\$dir: $dir\n";
#
#                $qb->{slice}{gripped} = '';
#
#                for (my $i = 1; $i <= $qbCubes; $i++) {
#                #for ("-10", "  0", " 10") {
#                    my $slice = $slPrfx . $i;
#                    print "\$slice: $slice\n";
#                    $qb->detSlViaNam($canvas, $slice);
#                    $qb->oneSliceRotStep($steps, -$dir);
#                    $qb->corr;
#                    $qb->{rot}{$slice} = 0;
#                }
#
#            }); # }}}2

$top->bind('<b>' =>  # {{{2
            sub {
                    print "<b>\n";
                    $qb->{shuffleBreak}++;
            }); # }}}2

$top->bind('<Control-c>' => \&lebWohl);

$top->bind('<c>' =>  # {{{2
            sub {
                print "Cubes ", $qb->check ? "bad" : "OK", "\n";

                #print "\$qb->{constraint}\n";
                #print Dumper $qb->{constraint};

                foreach (qw(X Y Z)) {
                    my $tr = "tri$_";
                    my $ax = lc($_) . "Axis";
                    
                    print "\n$tr-eVec: \t(";
                    print "$_\t" for @{$V->{$tr}->eVec};
                    print ")\t";
                    print "\n$ax-eVec: \t(";
                    print "$_\t" for @{$V->{$ax}->eVec};
                    print ")\n";
                    print matob::vecsPhi(
                                                $V->{$tr}->eVec,
                                                $V->{$ax}->eVec
                                                ), "\n";
                }

            }); # }}}2

$top->bind('<C>' =>  # {{{2
            sub {
                    my $initialColor = "gray";
                    $top->chooseColor(-title => "Choose a color", -ini
+tialcolor => $initialColor);

            }); # }}}2

# <d> # {{{2
{my $x = 50;
$top->bind('<d>' =>
            sub {
                    $x = ($x == 50) ? 0 : 50;
                    $rfDeckl->configure(-width => $x);
                    $tlfDeckl->configure(-width => $x);
                    $blfDeckl->configure(-width => $x);
            
            });
}; # }}}2

$top->bind('<D>' => # {{{2
#$top->bind('<D>' => [\&autoRot, 2]);
            sub {
                    print "_"x25, "slice-Dump-Anf", "_"x25,"\n";
                    print "slices: ", Dumper ($qb->{slice}), "\n";
                    print "="x25, "slice-Dump-End", "="x25,"\n";
            }); # }}}2

$top->bind('<g>' =>  # {{{2
            sub {
                    print "\$qb->grippedS: ", 
                            $qb->{slice}{gripped}{name}, "\n";
            }); # }}}2

$top->bind('<h>' =>  # {{{2
            sub {
                    print "\$highId: $highId\n";
            }); # }}}2

$top->bind('<i>' =>  # {{{2
            sub {
                $iColrFlag = $iColrFlag ? 0 : 1;
                plotAll();
            }); # }}}2

$top->bind('<k>' =>  # {{{2
            sub {
                $V->{plotCS} = $V->{plotCS} ? do {remCS; 0} : plotCS;
            }); # }}}2

$top->bind('<l>' =>  # {{{2
        sub {
                
                print "\$mm: $mm\n";
                $mm->rotate( $qb->{rS}, 0.0, 0.0) 
                            if ($qb->{actAxis} eq "x");

                $mm->rotate( 0.0, $qb->{rS}, 0.0) 
                            if ($qb->{actAxis} eq "y");
                            
                $mm->rotate( 0.0, 0.0, $qb->{rS})
                            if ($qb->{actAxis} eq "z");

                plotAll;

            }); # }}}2

$top->bind('<Control-l>' =>  # {{{2
            sub {
                load();
            }); # }}}2

$top->bind('<m>' =>  # {{{2
        sub {
                #print Data::Dumper->Dump([$mm],['$mm']);
                
                print "\$mm:\n";
                for (my $z=0; $z<4; $z++) {
                   for (my $s=0; $s<4; $s++) {
                       printf "%+0.2f ", $mm->[$z][$s];
                    }
                    print "\n";
                }

                my $im = invMat($mm);

                print "\$inv:\n";
                for (my $z=0; $z<4; $z++) {
                   for (my $s=0; $s<4; $s++) {
                       printf "%+0.2f ", $im->[$z][$s];
                    }
                    print "\n";
                }

                my ($probe, $dummy) = ([]);
               $probe = matMult($dummy,$mm,$im);

                print "\$probe\n";
                for (my $z=0; $z<4; $z++) {
                   for (my $s=0; $s<4; $s++) {
                       printf "%+0.2f ", $probe->[$z][$s];
                    }
                    print "\n";
                }
        }); # }}}2

$top->bind('<M>' =>  # {{{2
        sub {
                {
                    $mm->freeRot($V->{horiz}, -$qb->{rS});
                }

                plotAll;

            }); # }}}2

$top->bind('<p>' =>  # {{{2
            sub {
                #print "<p> tut nix\n";
                print "\$actCube: $actCube\n";

            }); # }}}2

$top->bind('<P>' =>  # {{{2
        sub {
                {
                    $mm->freeRot($V->{horiz}, $qb->{rS});
                }

                plotAll;

            }); # }}}2

$top->bind('<Control-p>' =>  # {{{2
        sub {
                print "CTRL-p\n";
                foreach ($V->{xAxis}, $V->{yAxis}, $V->{zAxis}) {
                }

            }); # }}}2

$top->bind('<q>' => \&lebWohl);

$top->bind('<r>' =>  # {{{2
        sub {
                
                $mm->rotate(-$qb->{rS}, 0.0, 0.0) 
                  if ($qb->{actAxis} eq "x");

                $mm->rotate( 0.0,-$qb->{rS}, 0.0) 
                  if ($qb->{actAxis} eq "y");
                  
                $mm->rotate( 0.0, 0.0,-$qb->{rS}) 
                            if ($qb->{actAxis} eq "z");

                plotAll;

            }); # }}}2

$top->bind('<S>' =>  # {{{2
            sub {
                keys %{$qb->{constraint}} && return;
                $qb->shuffle($V->{shuffleSteps}, $movLBox);
            }); # }}}2

$top->bind('<s>' =>  # {{{2
            sub {
                $qb->{cube}[$actCube]->showAttr;
            }); # }}}2

$top->bind('<Control-s>' =>  # {{{2
            sub {
                save();
            }); # }}}2

$top->bind('<t>' =>  # {{{2
            sub {
                print "matob::dotProd(\$xAxis, \$yAxis): ",
                        matob::dotProd($V->{xAxis}, $V->{yAxis}), "\n"
+;
                #$V->{horiz}->showAttr;
            }); # }}}2

$top->bind('<T>' =>  # {{{2
            sub {
                print "$actCube\n";
                #rp4rp3
                $V->{triX} = new line3d($qb->{cube}[$actCube]{r2}{p4},
                                                $qb->{cube}[$actCube]{
+r2}{p3},
                                                1, "white", "triX");
                #rp4rp1
                $V->{triY} = new line3d($qb->{cube}[$actCube]{r2}{p4},
                                                $qb->{cube}[$actCube]{
+r2}{p1},
                                                1, "#42ff00", "triY");

                #rp4gp4
                $V->{triZ} = new line3d($qb->{cube}[$actCube]{r2}{p4},
                                                $qb->{cube}[$actCube]{
+r4}{p1},
                                                1, "cyan", "triZ");
                $V->{plotTri} = $V->{plotTri} ? do {remTri; 0} : plotT
+ri;

            }); # }}}2

$top->bind('<u>' =>  # {{{2
            sub {
                    return unless my $rZug = $movLBox->get('end');

                    $qb->undoMove($rZug);
                     $movLBox->delete('end');
                     $movLBox->see('end');
            }); # }}}2

$top->bind('<v>' =>  # {{{2
            sub {
                
            }); # }}}2

$top->bind('<V>' =>  # {{{2
            sub {
                print Data::Dumper->Dump([%$V]);
            }); # }}}2

$top->bind('<X>' =>  # {{{2
            sub {
                print Data::Dumper->Dump([%cL]);
            }); # }}}2

$top->bind('<w>' =>  # {{{2
            sub {
                $qb->showAttr;
            }); # }}}2

$top->bind('<x>' =>  # {{{2
        sub {
                $qb->{actAxis} = "x";
                updDashBoard;
        }); # }}}2

$top->bind('<y>' =>  # {{{2
        sub {
                $qb->{actAxis} = "y";
                updDashBoard;
        }); # }}}2

$top->bind('<z>' =>  # {{{2
        sub {
                $qb->{actAxis} = "z";
                updDashBoard;
        }); # }}}2

$top->bind('<Button-2>' =>  # {{{2
            sub {
                $V->{plotCS} = $V->{plotCS} ? do {remCS; 0} : plotCS;
                $V->{plotTri} = $V->{plotTri} ? do {remTri; 0} : plotT
+ri;
            }); # }}}2

$top->bind('<MouseWheel>' => sub {print "MouseWheel\n"});

$rSentry->bind('<Enter>' =>  # {{{2
            sub {
                $rSentry->focusNext;
            }); # }}}2

$leave->bind('<Button-1>' => \&lebWohl);

$rfDeckl->bind('<Button-1>' =>  # {{{2
            sub {

                      #print "<Button-1 / \$rfDeckl>\n";
                    $rfDeckl->configure(-width => 0);
            }); # }}}2

$lvLab->bind('<Button-1>' =>  # {{{2
            sub {
                      #print "<Button-1 / \$lvLab>\n";
                    $rfDeckl->configure(-width => 50);
            }); # }}}2

$tlfDeckl->bind('<Button-1>' =>  # {{{2
            sub {

                      #print "<Button-1 / \$tlfDeckl>\n";
                    $tlfDeckl->configure(-width => 0);
            }); # }}}2

$blfDeckl->bind('<Button-1>' =>  # {{{2
            sub {

                      #print "<Button-1 / \$blfDeckl>\n";
                    $blfDeckl->configure(-width => 0);
            }); # }}}2

$hMovLBox->bind('<Button-1>' =>  # {{{2
            sub {
                      #print "<Button-1 / \$hMovLBox>\n";
                    $tlfDeckl->configure(-width => 50);
            }); # }}}2

$canvas->bind('line3d', '<Button-1>' =>  # {{{2
            sub { 
                print "'line3d', <Button-1>\n";
                my $v = shift;
                my $id = $v->find(qw/withtag current/);
                my $name = ($v->gettags('current'))[0];
                print "line3d $name\n";
                
                $V->{$name}->showAttr;

                print "\neVec: (";
                print "$_\t" for @{$V->{$name}->eVec};
                print ")\n";


            }); # }}}2

$canvas->bind('vec3d', '<Any-Enter>' =>  # {{{2
            sub { 
                print "'vec3d', <Any-Enter>\n";
                my $v = shift;
                my $id = $v->find(qw/withtag current/);
                my $name = ($v->gettags('current'))[0];

                my $ref;
                eval "\$ref = \$$name";

                my ($x, $y, $z) 
                    = ($ref->{p2}{lx}, $ref->{p2}{ly}, $ref->{p2}{lz})
+;

                $vecAnz->configure(
                                -background => $highLightBgColor,
                                -text => $ref->{name}
                            );
                $sVxAnz->configure(
                                -background => $highLightBgColor,
                                -text => sprintf "%-0f", $x
                            );
                $sVyAnz->configure(
                                -background => $highLightBgColor,
                                -text => sprintf "%-0f", $y
                            );
                $sVzAnz->configure(
                                -background => $highLightBgColor,
                                -text => sprintf "%-0f", $z
                            );

                my $nrm = matob::vNorm($x, $y, $z);

                $sVnAnz->configure(
                                -background => $highLightBgColor,
                                -text => sprintf "%-0f", $nrm
                            );
                    
            }); # }}}2

$canvas->bind('vec3d', '<Any-Leave>' =>  # {{{2
            sub { 

                $vecAnz->configure(
                                -background => $labDefColor,
                            );
                $sVxAnz->configure(
                                -background => $labDefColor,
                            );
                $sVyAnz->configure(
                                -background => $labDefColor,
                            );
                $sVzAnz->configure(
                                -background => $labDefColor,
                            );
                $sVnAnz->configure(
                                -background => $labDefColor,
                            );
            }); # }}}2

$canvas->bind('cube', '<Button-1>' =>  # {{{2
    sub {
            print "cube-<Button-1>\n";

            my $e = $Tk::event;
            ($V->{xb1down}, $V->{yb1down}) = ($e->x, $e->y);
            $canvas->configure(-cursor => 'exchange');

            $qb->{slice}{gripped} 
                            = $qb->{slice}{$sliceAnz->cget('-text')};
    
    }); # }}}2

$canvas->bind('cube', '<Alt-Button-1>' => [ # {{{2
            sub {
                    my ($canv, $old_fill) = @_;
                    #print "<Alt-Button-1>\n";

                    my $id = $canv->find(qw/withtag current/);
                    #print "\$id: $id\n";
                    $canv->itemconfigure($id, 
                                                -outline => "#ffff64",
                                                -width => 5
                                                );

                    my $actRect = ($canv->gettags('current'))[1];
                    #print "\$actRect: $actRect\n";

                    
                    print "\$old_fill: $$old_fill\n";
                    #my $initialColor = $$old_fill;
                    my $newColor = $top->chooseColor(
                                            -title => "Choose a color"
+, 
                                            -initialcolor => $$old_fil
+l);

                    $newColor ||= $$old_fill;
                    print "\$newColor: $newColor\n";
                    
                    $qb->{cube}[$actCube]{$actRect}{iColr} = $newColor
+;
                    $canv->itemconfigure($id, 
                                                -outline => "black",
                                                -width => 1
                                                );

                    plotAll;

            }, \$V->{old_fill}]); # }}}2

$canvas->bind('cube', '<Double-Button-1>' =>  # {{{2
            sub {
                    print "<Double-Button-1>\n";
                    $qb->{slice}{marked}->changeColor(0);
                    $canvas->configure(-cursor => 'exchange');
                    #$canvas->configure(-cursor => 'target');
                    my $canv = shift;
                    
                    {
                        keys %{$qb->{constraint}} && last;
                                                    
                        $qb->{actAxis} eq "x" && do {
                                                          $qb->{actAxi
+s} = "y";
                                                          last;
                                                      };
                        $qb->{actAxis} eq "y" && do {
                                                          $qb->{actAxi
+s} = "z";
                                                          last;
                                                      };
                        $qb->{actAxis} eq "z" && do {
                                                            $qb->{actA
+xis} = "x";
                                                            last;
                                                        };
                    }
                    
                    $qb->selSlice;
                    plotAll;
                    $sliceAnz->configure(
                                    -text => $qb->{slice}{marked}{name
+}); 

                    $qb->{slice}{gripped} 
                                = $qb->{slice}{$sliceAnz->cget('-text'
+)};

            }); # }}}2

$canvas->bind('cube', '<Shift-Button-1>' => [ # {{{2
            sub {
                    my ($canv, $old_fill) = @_;
                    print "<Shift-Button-1>\n";
                    
                    my $id = $canv->find(qw/withtag current/);
                    $canv->itemconfigure($id, -fill => undef);

            }, \$V->{old_fill}]); # }}}2

#$canvas->bind('cube', '<Any-Enter>' => [\&cscroll_enter, \$old_fill])
+;
$canvas->bind('cube', '<Any-Enter>' => [ # {{{2
            sub {
                #$qb->{slice}{gripped} && return;
                print "'cube', <Any-Enter>\n";
            
                $V->{freezeCvac} || do {
                                            $V->{cvac}->{p2} 
                                                    = $qb->{cube}[$act
+Cube]{centr};
                                            plotAllVectors;
                                        };

                $V->{PFLAG} == 0 && return;    # OTHERWISE ENDLESS-LOO
+P !!!
            
                my ($canv, $old_fill) = @_;
                
                my $id = $canv->find(qw/withtag current/);
                $id-- if ($canv->gettags('current'))[0] eq 'text';
                $$old_fill = ($canv->itemconfigure($id, -fill))[4];
            
                ($actCube     = ($canv->gettags('current'))[0]) 
                                =~ s/c(\d+)/$1/;
                my $actRect = ($canv->gettags('current'))[1];

                updDashBoard;

                $qb->selSlice;
                $sliceAnz->configure(-text => $qb->{slice}{marked}{nam
+e}); 
                $V->{PFLAG} = 0;     # avoid renewed sub-run-through w
+hich 
                                        # will be caused (suspected) b
+y poly-
                                        # gon-redrawings
                plotAll;
            
                # cube/rect-names in statusline
                # selected cubes-names should be red (deprecated due t
+o 
                # slice-highlighting ?)
                my $fg = $qb->{slice}{marked}{members}{$actCube}     
                                                                ? "red
+" 
                                                                : $rgb
+{DarkGreen};
                $cubAnz->configure(    -text  => "c" . $actCube, 
                                            -foreground  => $fg);
                $rectAnz->configure(    -text  => $actRect);
                
                # update coordinate- and distance-display in dashboard
            
                my $dist = $mm->vNorm($qb->{cube}[$1]{centr}{wx},
                                        $qb->{cube}[$1]{centr}{wy},
                                        $qb->{cube}[$1]{centr}{wz} + $
+distance);
            
                $xKoor3d->configure(-text =>     sprintf "%0f", 
                                                        $qb->{cube}[$1
+]{centr}{wx});
                $yKoor3d->configure(-text =>     sprintf "%0f", 
                                                        $qb->{cube}[$1
+]{centr}{wy});
                $zKoor3d->configure(-text =>     sprintf "%0f", 
                                                        $qb->{cube}[$1
+]{centr}{wz});
            
                $distLab->configure(-text => sprintf "%0f", $dist);
            
                $lxAnz->configure(-text => sprintf "%0f", 
                                                    $qb->{cube}[$1]{ce
+ntr}{lx});
                $lyAnz->configure(-text => sprintf "%0f", 
                                                    $qb->{cube}[$1]{ce
+ntr}{ly});
                $lzAnz->configure(-text => sprintf "%0f", 
                                                    $qb->{cube}[$1]{ce
+ntr}{lz});
            
            }
            , \$V->{old_fill}]); # }}}2

$canvas->bind('cube', '<Any-Leave>' => [ # {{{2
            sub {
            
                my($canv, $old_fill) = @_;
                
                my $id = $canv->find(qw/withtag current/);
                $id-- if ($canv->gettags('current'))[0] eq 'text';
                $canv->itemconfigure($id, -fill => $$old_fill);
            
                $qb->{slice}{marked}->changeColor(0);
            
                $V->{PFLAG} = 1;
                plotAll;
                
            }
            , \$V->{old_fill}]); # }}}2

$canvas->bind('cube', '<B1-Motion>' =>  # {{{2
            sub {

                    ($Z++ <= 1) 
                                    ? return
                                    : do {$Z = 0};

                    foreach (keys %{$qb->{slice}{marked}{members}}) { 
                        $qb->{cube}[$_]{palette} = 0; 
                    }

                    my $e = $Tk::event;

                    my ($xnow, $ynow) = ($e->x, $e->y);
                    my $dir = ($V->{xb1down} > $xnow) ? 1 : -1;

                    $qb->{slice}{gripped}{rot} += $dir;
                    $qb->{sMovFlag} = 1;

                    foreach (keys %{$qb->{slice}{marked}{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");

                    }
                    
                    plotAll;
                    ($V->{xb1down}, $V->{yb1down}) = ($xnow, $ynow);
            }); # }}}2

$canvas->CanvasBind('<Motion>' =>  # {{{2
            sub {
                $xKoor->configure(-text => $Tk::event->x);
                $yKoor->configure(-text => $Tk::event->y);
            }); # }}}2

$canvas->CanvasBind('<Control-Button-1>' =>  # {{{2
            sub {
                      print "<Control-Button-1>\n";

                    print "\$actCube: $actCube\n";
                    # hol mir das sliceObjekt zu diesem cube
                    my $slice = $qb->sliceOfCube($actCube);
                    $slice->changeColor;

                    
            }); # }}}2

$canvas->CanvasBind('<Double-Button-3>' => # {{{2
            sub {
                $V->{plotCS} = $V->{plotCS} ? do {remCS; 0} : plotCS;
            }); # }}}2

$canvas->CanvasBind('<Button-1>' => # {{{2
#$canvas->CanvasBind('<Button-3>' => 
            sub {
                    $qb->{slice}{gripped}{name} && return;
                    $canvas->configure(-cursor => 'fleur');
                    plotAllVectors;

                    my $e = $Tk::event;
                    ($V->{xb3down}, $V->{yb3down}) = ($e->x, $e->y);
            }); # }}}2

$canvas->bind('cube', '<Button-3>' => [ # {{{2
            sub {
#$canvas->CanvasBind('<Button-3>' => [sub {
                    my($w, $x, $y) = @_;
                     print "\$hiddenM: $hiddenM\n";
                    $hiddenM->post($x, $y);
            }, Ev('X'), Ev('Y')]); #}}}2
                    
$canvas->CanvasBind('<B1-Motion>' =>  # {{{2
#$canvas->CanvasBind('<B3-Motion>' =>
            sub {

                    $qb->{slice}{gripped}{name} && return;
                    my $e = $Tk::event;

                    my ($xnow, $ynow) = ($e->x, $e->y);

                    my $xdir = ($V->{xb3down} - $xnow) / 10;
                    my $ydir = ($V->{yb3down} - $ynow) / 10;

                    $V->{horiz}->{p2}->creaHVWC([1, 0, 0]);
                    $V->{vertik}->{p2}->creaHVWC([0, 1, 0]);

                    $mm->freeRot($V->{horiz}, $qb->{rS} * -$ydir);
                    $mm->freeRot($V->{vertik}, $qb->{rS} * -$xdir);

                    plotAll;
                    ($V->{xb3down}, $V->{yb3down}) = ($xnow, $ynow);

            }); # }}}2

$canvas->CanvasBind('<ButtonRelease-3>' =>  # {{{2
            sub {
                    $canvas->configure(-cursor => 'crosshair');
            }); # }}}2

$canvas->CanvasBind('<ButtonRelease-1>' => sub         # {{{2
{
    print "ButtonRelease-1\n";
                    print "\$qb->{slice}{gripped}{name} ",
                            $qb->{slice}{gripped}{name},"\n";
    $canvas->configure(-cursor => 'crosshair');

    $V->{PFLAG} = 1;
    plotAll;
    
    my $slice = $qb->{slice}{gripped} || return;
    $qb->{slice}{gripped} = {};

    $qb->{sMovFlag} && do {
        print "moved slice was : ", $slice->{name}, "\n";
        my $rest = $slice->{rot} % $rotSiSteps;
        my $movs = int($slice->{rot} / $rotSiSteps);

        $rest 
            ? do {
                        #print "\$rest: $rest\n";
                        #print "incomplete move\n";
                        $qb->{constraint}{$slice->{name}} = $slice;
                    } 
            : do {

                        #print "\$movs: $movs\n";
                        $qb->corr($slice);
                        $movs && do 
                        {
                            $zug = sprintf("%4d: %2s%-2d", 
                                                $movLBox->index('end')
+ + 1,
                                                $slice->{name}, 
                                                $movs);
                            print "valid move: $zug\n";
                          
                              $movLBox->insert('end', $zug);
                            $movLBox->see('end');
                            $saveIt = 1;

                            $slice->{rot} = 0;
                        };

                        #print "delete ", $slice->{name}, "aus constra
+intHash\n";
                        delete ${$qb->{constraint}}{$slice->{name}};
                        $qb->updSlices;
                    };

    };
    $qb->{sMovFlag} = 0;
    print "Cubes ", $qb->check ? "bad" : "OK", "\n";
    #print "members: ", Dumper $slice->{members}, "\n";

}); # }}}2

# END bindings }}}1

$mm->rotate(PI/-6, PI/6, 0.0);
plotAll();
#$qb->detSlViaNam($canvas, "slx10");
#print ALL_EVENTS;

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://671897]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (8)
As of 2020-09-25 20:13 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    If at first I don’t succeed, I …










    Results (140 votes). Check out past polls.

    Notices?