#! /usr/bin/env perl
=head1  GDRAW Demonstration:  Bouncing Ball with User Controlled Paddle.

  Use command "perl bounce.pl", where this file is called bounce.pl .
  This code is a direct translation of the python code, which in turn was
  a direct translation of the original STK (scheme) code.

  Copyright 2005 Boley

=cut

use strict;
use warnings;
use gdraw;                ##### alternatively:   require "gdraw.pl";

my $ball = fill_oval(110,110,120,120,'red');
my $box = draw_rectangle(100,100,400,400);
my $paddle = fill_rectangle(90,100,100,150,'black');
my @velocity = (7,11);
my $move_p = 0;

sub center{ my @coords = @_;
    return (($coords[0]+$coords[2])/2,($coords[1]+$coords[3])/2);
}

sub get_new_pos{       ## compute next ball position, checking for wall bounce
    my @old_pos = get_coords($ball);
    my @pos_paddle = get_coords($paddle);
    my @pos_box = get_coords($box);
    my @new_pos = ($old_pos[0]+$velocity[0], $old_pos[1]+$velocity[1],
                   $old_pos[2]+$velocity[0], $old_pos[3]+$velocity[1]);
    if ($new_pos[0] < $pos_paddle[2]) { ## ball hits left wall (check paddle)
        my @c = center(@old_pos);
        if ($pos_paddle[1] <= $c[1] and $c[1] <= $pos_paddle[3]) {
            $velocity[0] = -$velocity[0]
	} else {
            $move_p = 0;
            $velocity[0] = abs($velocity[0]);
            print "lost ball: stop.  Click again to resume.\n";
	}
    } elsif ($pos_box[2] < $new_pos[2]) {   ## ball hits right wall
        $velocity[0] = -$velocity[0];
    } elsif ($new_pos[1] < $pos_box[1]) {   ## ball hits top wall
        $velocity[1] = -$velocity[1];
    } elsif ($pos_box[3] < $new_pos[3]) {   ## ball hits bottom wall
        $velocity[1] = -$velocity[1];
    };
    @new_pos = ($old_pos[0]+$velocity[0], $old_pos[1]+$velocity[1],
                $old_pos[2]+$velocity[0], $old_pos[3]+$velocity[1]);
    return @new_pos;
} 

sub update_pos{        ## move the ball to the next computed position.
    my @new_pos;
    if ($move_p) {
        @new_pos = get_new_pos();
        if ($move_p) {
            my $thunk = sub {
                set_coords($ball,@new_pos);
                update_pos();
		};
            after(50,$thunk)   ## after 50 msec, try moving the ball again.
        }
    } else { print "paused.  Click to resume.\n" }
}

sub move_paddle{  ## paddle simply follows the mouse (vertical only)
    my @pos_paddle = get_coords($paddle);
    my @pos_box = get_coords($box);
    my @mouse = get_mouse_coords();
    if ($move_p and $pos_box[1] < $mouse[1] and $mouse[1] < $pos_box[3]) {
        set_coords($paddle,$pos_paddle[0],$mouse[1]-25,
			   $pos_paddle[2],$mouse[1]+25);
    }
}

set_motion_binding(0,\&move_paddle);

sub go{ 
    $move_p = not $move_p;
    if ($move_p) {
        print "go ...\n";
        update_pos();
    } else { print "pause ...\n" }
}

set_binding(0,\&go);
print "======= Click on the canvas.  Control paddle with mouse. Click again to pause.\n";

MainLoop();                                ## Tell Tk to start processing.