#!/usr/bin/perl

############################################################################
#
# tkballs.pl 1.1 - Object-oriented Animation of a bunch of Balls in Perl/Tk.
# transcoded to Object::Pad by haj, January 2022.
#
# Copyright (C) 2015, 2017, Hauke Lubenow, Germany.
#
# License: GNU GPL (version 3 or above):
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#
############################################################################

use warnings;
use strict;

use Tk;
use Object::Pad;

class BallWindow {

    has $screenx :param = 640;
    has $screeny :param = 480;
    has $speed   :param = 5;
    has $running        = 0;
    has @balls;
    has $mw;
    has $cv;
    has $fr1;
    has $btn_start;
    has $btn_stop;
    has $btn_exit;

    method runApplication {
        $self->initBalls();
        $self->showWindow();
    }

    method initBalls {
        @balls = (Ball->new(name => "Ball1",
                            x => $self->toX(40),
                            y => $self->toY(30),
                            color => "red",
                            direction => "11"),

                  Ball->new(name => "Ball2",
                            x => $self->toY(1.5),
                            y => $self->toY(1.5),
                            color => "blue"),

                  Ball->new(name => "Ball3",
                            x => $self->toX(2.5),
                            y => $self->toY(2.5),
                            color => "green"),

                  Ball->new(name => "Ball4",
                            x => $self->toX(2),
                            y => $self->toY(10),
                            color => "cyan"),

                  Ball->new(name => "Ball5",
                            x => $self->toX(5),
                            y => $self->toY(5),
                            color => "yellow"))
    }

    method toX {
        return $screenx / shift;
    }

    method toY {
        return $screeny / shift;
    }

    method showWindow {
        $mw = MainWindow->new();
        $mw->optionAdd("*font", "Arial 12 normal");
        $mw->title("TkBalls");
        my $geomstr = int($screenx * 1.25);
        $geomstr .= "x";
        $geomstr .= int($screeny * 1.25);
        $geomstr .= "+108+64";
        $mw->geometry($geomstr);
        $mw->bind('<Control-q>', sub { $mw->destroy() });
        $cv = $mw->Canvas(bg => "white",
                          width => $screenx,
                          height => $screeny);
        $cv->pack(-padx => 20, -pady => 20);
        $fr1 = $mw->Frame();
        $btn_start = $fr1->Button(-text => "Start",
                                          -command => sub { $self->startMoving() });
        $btn_start->focus();
        $btn_stop = $fr1->Button(-text => "Stop",
                                         -command => sub { $self->stopMoving() });
 
        $btn_exit = $mw->Button(-text => "Exit",
                                -command => sub { $mw->destroy() });
        $btn_start->pack(-side => "left", -padx => 50);
        $btn_stop->pack(-side => "left", -padx => 50);
        $fr1->pack();
        $btn_exit->pack(-side => "right", -padx => 5, -pady => 5);
        $self->moveBalls();
        $mw->MainLoop();
    }

    method moveBalls {
        my $i;
        foreach $i (@balls) {
            $i->clearDirChange();
            $self->checkCollisions();
            $i->moveBall($screenx, $screeny);
            $mw->after($speed, sub { $self->drawBall($i) });
        }
        if ($running == 1) {
            $mw->after($speed, sub { $self->moveBalls() });
        }
    }

    method startMoving {
        if ($running == 1) {
            return;
        }
        $running = 1;
        $self->moveBalls();
    }

    method stopMoving {
        $running = 0;
    }

    method checkCollisions {
        my $i;
        my $u;
        my @checkedballs = ();
        foreach $i (@balls) {
            foreach $u (@balls) {
                if ($i->getName() eq $u->getName()) {
                    next;
                }
                if ($self->alreadyChecked($u, @checkedballs) == 1) {
                    next;
                }
                $i->checkCollision($u, $screenx, $screeny);
            }
            push(@checkedballs, $i);
        }
    }

    method alreadyChecked {
        my $ball = shift;
        my @checkedballs = @_;
        my $i;
        foreach $i (@checkedballs) {
            if($ball->getName() eq $i->getName()) {
                return 1;
            }
        }
        return 0;
    }

    method drawBall {
        my $ball = shift;
        my $id = $ball->getId();
        if ($id != -1) {
            $cv->delete($id);
        }
        my $x = $ball->getX();
        my $y = $ball->getY();
        my $color = $ball->getColor();
        my $size = $ball->getSize();
        $id = $cv->createOval($x - $size,
                                      $y - $size,
                                      $x + $size,
                                      $y + $size, -fill => $color);
        $ball->setId($id);
    }
}

class Ball {
    has $name       :reader(getName)                  :param = "Ball1";
    has $x          :reader(getX)      :writer(setX)  :param = 0;
    has $y          :reader(getY)      :writer(setY)  :param = 0;
    has $color      :reader(getColor)                 :param = "black";
    has $size       :reader(getSize)                  :param = 15;
    has $id         :reader(getId)     :writer(setId) :param = -1;
    has $direction  :param = "xx";
    has $dirchanged        = 0;

    ADJUST {
        if ($direction eq "xx") {
            my @directions = ("00", "01", "10", "11");
            $direction = $directions[int(rand(4))];
        }
    }

    method moveBall ($screenx,$screeny) {
        my $xdir = substr($direction, 0, 1);
        my $newxdir = $xdir;
        my $ydir = substr($direction, 1, 1);
        my $newydir = $ydir;
        if ($xdir == 0) {
            if ($x <= $size) {
                $newxdir = 1;
            } else {
                $x--;
            }
        }
        if ($xdir == 1) {
            if ($x >= $screenx - $size) {
                $newxdir = 0;
            } else {
                $x++;
            }
        }
        if ($ydir == 0) {
            if ($y <= $size) {
                $newydir = 1;
            } else {
                $y--;
            }
        }
        if ($ydir == 1) {
            if ($y >= $screeny - $size) {
                $newydir = 0;
            } else {
                $y++;
            }
        }
        $direction = "$newxdir$newydir";
    }

    method checkCollision ($otherball,$screenx,$screeny) {
        if ($dirchanged == 1) {
            return;
        }
        my $otherx = $otherball->getX();
        my $othery = $otherball->getY();
        my $othersize = $otherball->getSize();

        if ($otherx - $othersize < $x + $size &&
            $otherx + $othersize > $x - $size &&
            $othery - $othersize < $y + $size &&
            $othery + $othersize > $y - $size) {
            $self->changeDirection();
            # If the balls are too close , they keep changing directions
            # and "stick" to each other. So at least on ball needs
            # to be moved away a bit:
            $self->moveBall($screenx, $screeny);
            $otherball->changeDirection();
        }
    }

    method changeDirection {
        my $newdir = "";
        if (substr($direction, 0, 1) eq "0") {
            $newdir .= "1";
        } else {
            $newdir .= "0";
        }
        if (substr($direction, 1, 1) eq "0") {
            $newdir .= "1";
        } else {
            $newdir .= "0";
        }
        $direction  = $newdir;
        $dirchanged = 1;
    }

    method clearDirChange {
        $dirchanged = 0;
    }
}

my $bw = BallWindow->new();
$bw->runApplication();