1package SDLx::Controller; 2use strict; 3use warnings; 4use Carp; 5use Time::HiRes; 6use SDL; 7use SDL::Event; 8use SDL::Events; 9use SDL::Video; 10use SDLx::Controller::Interface; 11use SDLx::Controller::State; 12use Scalar::Util 'refaddr'; 13 14our $VERSION = 2.548; 15 16# inside out, so this can work as the superclass of another 17# SDL::Surface subclass 18my %_dt; 19my %_min_t; 20my %_current_time; 21my %_stop; 22my %_event; 23my %_event_handlers; 24my %_move_handlers; 25my %_show_handlers; 26my %_sleep_cycle; 27my %_eoq; 28my %_paused; 29 30sub new { 31 my ($self, %args) = @_; 32 if(ref $self) { 33 bless $self, ref $self; 34 } 35 else { 36 my $a; 37 $self = bless \$a, $self; 38 } 39 40 my $ref = refaddr $self; 41 42 $_dt{ $ref } = defined $args{dt} ? $args{dt} : 0.1; 43 $_min_t{ $ref } = defined $args{min_t} ? $args{min_t} : 1 / 60; 44# $_current_time{ $ref } = $args{current_time} || 0; #no point 45 $_stop{ $ref } = $args{stop}; 46 $_event{ $ref } = $args{event} || SDL::Event->new(); 47 $_event_handlers{ $ref } = $args{event_handlers} || []; 48 $_move_handlers{ $ref } = $args{move_handlers} || []; 49 $_show_handlers{ $ref } = $args{show_handlers} || []; 50 $_sleep_cycle{ $ref } = $args{delay}; 51 $_eoq{$ref} = $args{exit_on_quit} || $args{eoq} || 0; 52# $_paused{ $ref } = $args{paused}; #read only 53 54 return $self; 55} 56 57 58sub delay { 59 my $self = shift; 60 my $delay = shift; 61 my $ref = refaddr $self; 62 63 $_sleep_cycle{ $ref } = $delay if $delay; 64 return $self; 65} 66 67sub DESTROY { 68 my $self = shift; 69 my $ref = refaddr $self; 70 71 delete $_dt{ $ref}; 72 delete $_min_t{ $ref}; 73 delete $_current_time{ $ref}; 74 delete $_stop{ $ref}; 75 delete $_event{ $ref}; 76 delete $_event_handlers{ $ref}; 77 delete $_move_handlers{ $ref}; 78 delete $_show_handlers{ $ref}; 79 delete $_sleep_cycle { $ref }; 80 delete $_eoq{$ref}; 81 delete $_paused{$ref}; 82} 83 84sub run { 85 my ($self) = @_; 86 my $ref = refaddr $self; 87 my $dt = $_dt{ $ref }; 88 my $min_t = $_min_t{ $ref }; 89 my $t = 0.0; 90 91 #Allows us to do stop and run 92 $_stop{ $ref } = 0; 93 94 $_current_time{ $ref } = Time::HiRes::time; 95 while ( !$_stop{ $ref } ) { 96 $self->_event($ref); 97 98 my $new_time = Time::HiRes::time; 99 my $delta_time = $new_time - $_current_time{ $ref }; 100 next if $delta_time < $min_t; 101 $_current_time{ $ref} = $new_time; 102 my $delta_copy = $delta_time; 103 104 while ( $delta_copy > $dt ) { 105 $self->_move( $ref, 1, $t ); #a full move 106 $delta_copy -= $dt; 107 $t += $dt; 108 } 109 my $step = $delta_copy / $dt; 110 $self->_move( $ref, $step, $t ); #a partial move 111 $t += $dt * $step; 112 113 $self->_show( $ref, $delta_time ); 114 115 $dt = $_dt{ $ref}; #these can change 116 $min_t = $_min_t{ $ref}; #during the cycle 117 SDL::delay( $_sleep_cycle{ $ref } ) if $_sleep_cycle{ $ref }; 118 } 119 120} 121 122sub exit_on_quit { 123 my ($self, $value) = @_; 124 125 my $ref = refaddr $self; 126 if (defined $value) { 127 $_eoq{$ref} = $value; 128 } 129 130 return $_eoq{$ref}; 131} 132*eoq = \&exit_on_quit; # alias 133 134sub pause { 135 my ($self, $callback) = @_; 136 my $ref = refaddr $self; 137 $callback ||= sub {1}; 138 my $event = SDL::Event->new(); 139 $_paused{ $ref} = 1; 140 while(1) { 141 SDL::Events::wait_event($event) or Carp::confess("pause failed waiting for an event"); 142 if($callback->($event, $self)) { 143 $_current_time{ $ref} = Time::HiRes::time; #so run doesn't catch up with the time paused 144 last; 145 } 146 } 147 delete $_paused{ $ref}; 148} 149 150sub _event { 151 my ($self, $ref) = @_; 152 while ( SDL::Events::poll_event( $_event{ $ref} ) ) { 153 $self->_exit_on_quit( $_event{ $ref} ) if $_eoq{$ref}; 154 foreach my $event_handler ( @{ $_event_handlers{ $ref} } ) { 155 next unless $event_handler; 156 $event_handler->( $_event{ $ref}, $self ); 157 } 158 } 159} 160 161sub _move { 162 my ($self, $ref, $move_portion, $t) = @_; 163 foreach my $move_handler ( @{ $_move_handlers{ $ref} } ) { 164 next unless $move_handler; 165 $move_handler->( $move_portion, $self, $t ); 166 } 167} 168 169sub _show { 170 my ($self, $ref, $delta_ticks) = @_; 171 foreach my $show_handler ( @{ $_show_handlers{ $ref} } ) { 172 next unless $show_handler; 173 $show_handler->( $delta_ticks, $self ); 174 } 175} 176 177sub stop { $_stop{ refaddr $_[0] } = 1 } 178 179sub _add_handler { 180 my ( $arr_ref, $handler ) = @_; 181 push @{$arr_ref}, $handler; 182 return $#{$arr_ref}; 183} 184 185sub add_move_handler { 186 my $ref = refaddr $_[0]; 187 return _add_handler( $_move_handlers{ $ref}, $_[1] ); 188} 189 190sub add_event_handler { 191 my $ref = refaddr $_[0]; 192 Carp::confess 'SDLx::App or a Display (SDL::Video::get_video_mode) must be made' 193 unless SDL::Video::get_video_surface(); 194 return _add_handler( $_event_handlers{ $ref}, $_[1] ); 195} 196 197sub add_show_handler { 198 my $ref = refaddr $_[0]; 199 return _add_handler( $_show_handlers{ $ref}, $_[1] ); 200} 201 202sub _remove_handler { 203 my ( $arr_ref, $id ) = @_; 204 if ( ref $id ) { 205 ($id) = grep { 206 $id eq $arr_ref->[$_] 207 } 0..$#{$arr_ref}; 208 209 if ( !defined $id ) { 210 Carp::cluck("$id is not currently a handler of this type"); 211 return; 212 } 213 } 214 elsif(!defined $arr_ref->[$id]) { 215 Carp::cluck("$id is not currently a handler of this type"); 216 return; 217 } 218 return delete( $arr_ref->[$id] ); 219} 220 221sub remove_move_handler { 222 return _remove_handler( $_move_handlers{ refaddr $_[0] }, $_[1] ); 223} 224 225sub remove_event_handler { 226 return _remove_handler( $_event_handlers{ refaddr $_[0] }, $_[1] ); 227} 228 229sub remove_show_handler { 230 return _remove_handler( $_show_handlers{ refaddr $_[0] }, $_[1] ); 231} 232 233sub remove_all_handlers { 234 $_[0]->remove_all_move_handlers; 235 $_[0]->remove_all_event_handlers; 236 $_[0]->remove_all_show_handlers; 237} 238 239sub remove_all_move_handlers { 240 $_move_handlers{ refaddr $_[0] } = []; 241} 242 243sub remove_all_event_handlers { 244 $_event_handlers{ refaddr $_[0] } = []; 245} 246 247sub remove_all_show_handlers { 248 $_show_handlers{ refaddr $_[0] } = []; 249} 250 251sub move_handlers { $_move_handlers{ refaddr $_[0] } } 252sub event_handlers { $_event_handlers{ refaddr $_[0] } } 253sub show_handlers { $_show_handlers{ refaddr $_[0] } } 254 255sub dt { 256 my ($self, $arg) = @_; 257 my $ref = refaddr $self; 258 $_dt{ $ref} = $arg if defined $arg; 259 260 $_dt{ $ref}; 261} 262 263sub min_t { 264 my ($self, $arg) = @_; 265 my $ref = refaddr $self; 266 $_min_t{ $ref} = $arg if defined $arg; 267 268 $_min_t{ $ref}; 269} 270 271sub current_time { 272 my ($self, $arg) = @_; 273 my $ref = refaddr $self; 274 $_current_time{ $ref} = $arg if defined $arg; 275 276 $_current_time{ $ref}; 277} 278 279sub paused { 280 $_paused{ refaddr $_[0]}; 281} 282 283sub _exit_on_quit { 284 my ($self, $event) = @_; 285 286 $self->stop() if $event->type == SDL_QUIT; 287} 288 2891; 290 291__END__ 292 293 294