Fling.pm

package Fling;
use strict;
use warnings;
 
sub new {
	my $class = shift;
	my $x = shift || 0;
	my $y = shift || 0;
	my $field = shift;
	my @colors = qw/green blue yellow magenta cyan/;
	$x = $field->width-1 if $field->width-1<$x;
	$y = $field->height-1 if $field->height-1<$y;
	my $self = {
		pos_x => $x,
		pos_y => $y,
		dir_u => 0,
		dir_d => 0,
		dir_l => 0,
		dir_r => 0,
		prev_pos => [],
		field => $field,
		color => $colors[rand(scalar(@colors))],
	};
	bless $self, $class;
	$self->{field}->put_fling($self);
	return $self;
} ## --- end sub new


sub pos_x {
	my $self = shift;
	return $self->{pos_x};
} ## --- end sub pos_x

sub pos_y {
	my $self = shift;
	return $self->{pos_y};
} ## --- end sub pos_x

sub is_move_possible {
	my $self = shift;
	my $move = shift;
	if($move eq 'up'){
		return 0 unless $self->pos_y && !$self->{field}{pos_buff}[$self->pos_y-1][$self->pos_x] &&  $self->find_next($move);
	}elsif($move eq 'down'){
		return 0 if ($self->pos_y+1)>$self->{field}{height} || !$self->find_next($move) || $self->{field}{pos_buff}[$self->pos_y+1][$self->pos_x];
	}elsif($move eq 'left'){
		return 0 unless $self->pos_x && !$self->{field}{pos_buff}[$self->pos_y][$self->pos_x-1] && $self->find_next($move);
	}elsif($move eq 'right'){
		return 0 if ($self->pos_x+1)>$self->{field}{width} || !$self->find_next($move) || $self->{field}{pos_buff}[$self->pos_y][$self->pos_x+1];
	}else{
		print "INCORRECT MOVE : $move";
		return 0;
	}
	return 1;
} ## --- end sub is_move_posible


sub find_next {
	my $self = shift;
	my $direction = shift;
	my @next;
	if($direction eq 'up'){
		@next = grep {$self->{field}{flings}{$_}->pos_y<$self->pos_y && $self->{field}{flings}{$_}->pos_x==$self->pos_x} sort {$self->{field}{flings}{$b}->pos_y<=>$self->{field}{flings}{$a}->pos_y} keys %{$self->{field}{flings}};
	}elsif($direction eq 'down'){
		@next = grep {$self->{field}{flings}{$_}->pos_y>$self->pos_y && $self->{field}{flings}{$_}->pos_x==$self->pos_x} sort {$self->{field}{flings}{$a}->pos_y<=>$self->{field}{flings}{$b}->pos_y} keys %{$self->{field}{flings}};
	}elsif($direction eq 'left'){
		@next = grep {$self->{field}{flings}{$_}->pos_x<$self->pos_x && $self->{field}{flings}{$_}->pos_y==$self->pos_y} sort {$self->{field}{flings}{$b}->pos_x<=>$self->{field}{flings}{$a}->pos_x} keys %{$self->{field}{flings}};
	}elsif($direction eq 'right'){
		@next = grep {$self->{field}{flings}{$_}->pos_x>$self->pos_x && $self->{field}{flings}{$_}->pos_y==$self->pos_y} sort {$self->{field}{flings}{$a}->pos_x<=>$self->{field}{flings}{$b}->pos_x} keys %{$self->{field}{flings}};
	}
	return wantarray ? @next : scalar(@next);
} ## --- end sub find_next

sub move {
	my $self = shift;
	my $direction = shift;
	my $moved_by_fling = shift || 0;
	if($moved_by_fling || $self->is_move_possible($direction)){
		my ($next_fling_id) = $self->find_next($direction);
		unless($next_fling_id){
			$self->remove();
			return undef;
		}
		push @{$self->{prev_pos}}, [$self->pos_x, $self->pos_y];
		if($direction eq 'up'){
			$self->{pos_y}=$self->{field}{flings}{$next_fling_id}->pos_y+1;
		}elsif($direction eq 'down'){
			$self->{pos_y}=$self->{field}{flings}{$next_fling_id}->pos_y-1;
		}elsif($direction eq 'left'){
			$self->{pos_x}=$self->{field}{flings}{$next_fling_id}->pos_x+1;
		}elsif($direction eq 'right'){
			$self->{pos_x}=$self->{field}{flings}{$next_fling_id}->pos_x-1;
		}
		$self->{field}->refresh_positions();
		my @moved;
		my @res = $self->{field}{flings}{$next_fling_id}->move($direction, 1);
		push @moved, @res if $res[0];
		return @moved, $self->{id};
	}
	return undef;
} ## --- end sub move

sub remove {
	my $self = shift;
	delete $self->{field}{pos_buff}[$self->pos_y][$self->pos_x];
	delete $self->{field}{flings}{$self->{id}};
	push @{$self->{field}{removed}}, $self;
#	$self = undef;
} ## --- end sub remove


sub restore {
	my $self = shift;
	$self->{field}{flings}{$self->{id}} = $self;
	$self->{field}{pos_buff}[$self->pos_y][$self->pos_x] = $self;
	return ;
} ## --- end sub restore


sub restore_position {
	my $self = shift;
	if(scalar(@{$self->{prev_pos}})){
		my $pos = pop @{$self->{prev_pos}};
		($self->{pos_x}, $self->{pos_y}) = @$pos;
	}
	return 1;
} ## --- end sub restore_position

sub DESTROY {
	return 0;
} ## --- end sub DESTROY
1;