PageRenderTime 32ms CodeModel.GetById 28ms RepoModel.GetById 1ms app.codeStats 0ms

/lib/SDLx/Controller/Interface.pm

http://github.com/PerlGameDev/SDL
Perl | 61 lines | 44 code | 17 blank | 0 comment | 9 complexity | 3eeb1a636b315e435b054f2470b90c6d MD5 | raw file
Possible License(s): AGPL-1.0, GPL-2.0
  1. package SDLx::Controller::Interface;
  2. use strict;
  3. use warnings;
  4. use Carp qw/confess/;
  5. use Scalar::Util 'refaddr';
  6. our @ISA = qw(Exporter DynaLoader);
  7. use SDL::Internal::Loader;
  8. our $VERSION = 2.548;
  9. my %_controller;
  10. sub new {
  11. shift;
  12. my %foo = @_;
  13. my @args;
  14. push @args, ( $foo{x} || 0 );
  15. push @args, ( $foo{y} || 0 );
  16. push @args, ( $foo{v_x} || 0 );
  17. push @args, ( $foo{v_y} || 0 );
  18. push @args, ( $foo{rot} || 0 );
  19. push @args, ( $foo{ang_v} || 0 );
  20. return SDLx::Controller::Interface->make(@args);
  21. }
  22. sub attach {
  23. my ( $self, $controller, $render, @params ) = @_;
  24. Carp::confess "An SDLx::Controller is needed" unless $controller && $controller->isa('SDLx::Controller');
  25. $_controller{ refaddr $self } = [ $controller ];
  26. my $move = sub { $self->update( $_[2], $_[1]->dt )};
  27. $_controller{ refaddr $self }->[1] = $controller->add_move_handler($move);
  28. if ($render) {
  29. my $show = sub { my $state = $self->interpolate( $_[0] ); $render->( $state, @params ); };
  30. $_controller{ refaddr $self }->[2] = $controller->add_show_handler($show);
  31. } else {
  32. Carp::confess "Render callback not provided";
  33. }
  34. }
  35. sub detach {
  36. my ( $self) = @_;
  37. my $controller = $_controller{ refaddr $self };
  38. return unless $controller;
  39. $controller->[0]->remove_move_handler($controller->[1]);
  40. $controller->[0]->remove_show_handler($controller->[2]);
  41. }
  42. internal_load_dlls(__PACKAGE__);
  43. bootstrap SDLx::Controller::Interface;
  44. 1;