perl

2d Term::Animation collision detection issues


I'm trying to make a perl animation, and the program is not detecting collisions properly with the use of 2-D objects/shapes. The desired behavior for the following code is that when it collides with the background line, it switches direction. As of now, it goes through the line without changing direction.

use strict;
use warnings;
use Term::Animation 2.0;
use Term::Animation::Entity;
use Time::HiRes qw(time);
use Data::Dumper;
use Curses;

main();

sub add_animal {
    my ($anim, $y) = @_;
    $y = $y - 5;

    my $shape = q{
                   __
                  / _)
         _.----._/ /
        /         /
     __/ (  | (  |
    /__.-'|_|--|_| };

    my $mask = q{
                   gg
                  g gg
         ggggggggg g
        g         g
     ggg g  g g  g
    gggggggggggggg };

    # Add the animal to the animation
    my $animal = $anim->new_entity(
        type => 'animal',
        position => [3, $y, 1],
        shape => $shape,
        color => $mask,
        callback_args => [1, 0, 0, 0],
        die_offscreen => 1,
        collision_handler => \&animal_collision,
        physical => 1,
    );
}

sub animal_collision {
  my ($animal, $anim) = @_;
  my $collisions = $animal->collisions();
  foreach my $col_obj (@{$collisions}) {
    # Check if the collision is with a background entity
    if ($col_obj->type eq 'background') {
      # Get the current x direction from the callback_args
      my $x_dir = $animal->callback_args->[0];

      # Reverse the direction
      $animal->callback_args->[0] = -$x_dir;
    }
  }
}

sub add_background {
    my ($anim, $screen_width, $screen_height) = @_;
    my $half_width = int($screen_width / 2);
    my $ground_level = int($screen_height * 0.7);

    for my $y (0..($screen_height)) {
      $anim->new_entity(
            type => 'background',
            shape => ['|'],
            position => [$half_width, $y, 1],
            color => ['w'],
            physical => 1,
        );
    }
}

sub main {

  my $anim = Term::Animation->new();
  $anim->color(1);

  halfdelay(1);

  my $screen_width = $anim->width();
  my $screen_height = $anim->height();
  my $half_width = int($screen_width / 2);
  my $ground_level = int($screen_height * 0.7);

  add_background($anim, $screen_width, $screen_height);
  my $animal = add_animal($anim, ($ground_level - 1));

  # animation loop
  while(1) {
      $anim->animate();

      # use getch to control the frame rate, and get input at the same time.
      my $input = getch();
      if($input eq 'q') { quit(); }
  }

  $anim->end();
}

When I substitute in a 1-D shape, the collision works as intended, but changing it breaks it somehow.


Solution

  • Your background line consists of one object per row. Therefore you get as many direction changes as there are rows in your shape (collision detection uses a bounding box). Unfortunately your shape has an even number of rows, so the direction changes cancel out. Make the Line a single object...

    Also note that there is a typo: it should be coll_handler instead of collision_handler

    
    sub add_background {
        my ($anim, $screen_width, $screen_height) = @_;
        my $half_width = int($screen_width / 2);
        my $ground_level = int($screen_height * 0.7);
    
          $anim->new_entity(
                type => 'background',
                shape => ["|\n"x $screen_height],
                position => [$half_width, 0, 1],
                color => ['w'],
                physical => 1,
            );
    }
    

    Another possibility is to return early from the collision callback:

    sub animal_collision {
      my ($animal, $anim) = @_;
      my $collisions = $animal->collisions();
      foreach my $col_obj (@{$collisions}) {
        # Check if the collision is with a background entity
        if ($col_obj->type eq 'background') {
          # Get the current x direction from the callback_args
          my $x_dir = $animal->callback_args->[0];
    
          # Reverse the direction
          $animal->callback_args->[0] = -$x_dir;
          # but reverse only once
          return;
        }
      }
    }