Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

version 0.004. Many various unfinished cleanups

  • Loading branch information...
commit 63b98b45e7d792c95dcc6b2c06c31d624a47dc70 1 parent 4439d99
@Blaizer authored
Showing with 945 additions and 544 deletions.
  1. +2 −1  .gitignore
  2. +4 −6 Build.PL
  3. +16 −5 CHANGELOG
  4. +2 −0  IMPROVEMENTS
  5. +1 −0  MANIFEST.skip
  6. +5 −3 README
  7. +3 −11 bin/nhc
  8. +75 −41 lib/Games/Neverhood.pm
  9. +0 −50 lib/Games/Neverhood/DualVar.pm
  10. +5 −2 lib/Games/Neverhood/Game.pm
  11. +1 −1  lib/Games/Neverhood/OrderedHash/TiedHash.pm
  12. +154 −185 lib/Games/Neverhood/Scene.pm
  13. +43 −39 lib/Games/Neverhood/Scene/Nursery/One.pm
  14. +17 −24 lib/Games/Neverhood/Sprite.pm
  15. +19 −24 lib/Games/Neverhood/Sprite/Cursor.pm
  16. +52 −91 lib/Games/Neverhood/Sprite/Klaymen.pm
  17. 0  lib/Games/Neverhood/Sprite/Single.pm
  18. +177 −0 lib/Games/Neverhood/Video.pm
  19. +85 −0 lib/Games/Neverhood/Video/BitStream.pm
  20. +94 −0 lib/Games/Neverhood/Video/Huffman/BigTree.pm
  21. +48 −0 lib/Games/Neverhood/Video/Huffman/Tree.pm
  22. BIN  share/cursor/click.png
  23. BIN  share/cursor/click/0.png
  24. BIN  share/cursor/click/1.png
  25. BIN  share/cursor/forward.png
  26. BIN  share/cursor/left.png
  27. BIN  share/cursor/right.png
  28. BIN  share/icon.bmp
  29. BIN  share/klaymen/idle.png
  30. BIN  share/klaymen/idle_push_button_back.png
  31. BIN  share/klaymen/idle_random_0.png
  32. BIN  share/klaymen/idle_random_1.png
  33. BIN  share/klaymen/idle_random_2.png
  34. BIN  share/klaymen/idle_random_3.png
  35. BIN  share/klaymen/idle_random_4.png
  36. BIN  share/klaymen/idle_shuffle.png
  37. BIN  share/klaymen/idle_shuffle_end.png
  38. BIN  share/klaymen/idle_slide.png
  39. BIN  share/klaymen/idle_slide_end.png
  40. BIN  share/klaymen/idle_think.png
  41. BIN  share/klaymen/idle_walk.png
  42. BIN  share/klaymen/idle_walk_end.png
  43. BIN  share/klaymen/idle_walk_start.png
  44. BIN  share/klaymen/pull_lever.png
  45. BIN  share/klaymen/snore.png
  46. BIN  share/klaymen/wake.png
  47. BIN  share/misc/nhc.ico
  48. BIN  share/misc/nhc.png
  49. BIN  share/nursery/one/background.png
  50. BIN  share/nursery/one/button.png
  51. BIN  share/nursery/one/door.png
  52. BIN  share/nursery/one/foreground.png
  53. BIN  share/nursery/one/hammer.png
  54. BIN  share/nursery/one/lever.png
  55. BIN  share/nursery/one/out_window.png
  56. BIN  share/nursery/one/window.png
  57. +21 −4 t/00-load.t
  58. +0 −52 t/dualvar.t
  59. +10 −5 t/orderedhash.t
  60. +74 −0 t/video_bitstream.t
  61. +36 −0 t/video_huffman_tree.t
  62. BIN  test/bitstream
  63. +1 −0  test/tree
View
3  .gitignore
@@ -6,6 +6,7 @@ _build*
MANIFEST
META.yml
MYMETA.yml
-img
+img*
+blb*
UNDATA*
*.txt
View
10 Build.PL
@@ -9,20 +9,18 @@ my $build = My::Module::Build->new(
license => 'perl',
share_dir => 'share',
requires => {
- 'perl' => 5.01,
- 'SDL' => 2.526,
+ 'perl' => 5.010,
+ 'SDL' => 2.560,
'File::ShareDir' => 0,
},
- recommends => {
- },
meta_merge => {
resources => {
license => 'http://dev.perl.org/licenses/',
repository => 'http://github.com/Blaizer/Neverhood',
},
},
- add_to_cleanup => [
- ],
+ # add_to_cleanup => [
+ # ],
);
$build->create_build_script;
View
21 CHANGELOG
@@ -1,11 +1,22 @@
Revision history for Games::Neverhood
-0.003 - xx Xxx 2011
-# Added storable hooks, they don't save many newly readonly params
-# Moved set method to game mode parent class, added music to it
+TODO
+ The game loads frames, mirrors them, and stores them only as it needs them
+ Graphics for entire game obtained
+ Added storable hooks, they don't save read-only params
+ Implemented music with SDLx::Music in Scene and set method
+ Implemented sound with SDLx::Sound
+ Video decoder working
+
+0.004 - xx Xxx 2011
+
+0.003 - 10 Jun 2011
+ Design for Scene and Sprite finalised back to the basics
+ Scene's sprites are now stored in an OrderedHash
+ bin/nhc is more final and nhc.pl is better
Primary modules now use Exporter
+ Moved set method to game mode parent class
Cleaned up module naming
- Implemented sound playing
Added proper command line options and usage information
event, move and show handlers now belong to $Game
@@ -20,6 +31,6 @@ Revision history for Games::Neverhood
Removed need for Holder class by turning it inside-out
Classes Scene, Holder and Sprite started
Image assets for first room obtained
-
+
0.000 - 27 Sep 2010
Project start
View
2  IMPROVEMENTS
@@ -24,5 +24,7 @@ The following is a list of ``improvements" that were made.
* Saves now save the exact positions and states of everything. Even the position of the music is now saved.
+- Keys now respect key modifiers (e.g. Alt and Ctrl)
+
Of course, there are many other slight differences but these are less `changes' and more `imperfections'. The idea is to lower the amount of this kind of change to zero.
View
1  MANIFEST.skip
@@ -8,6 +8,7 @@
^MANIFEST\.skip$
^MYMETA\.yml$
^img/
+^blb/
^(base|crop|dup|tile|zero)$
^UNDATA
\.txt$
View
8 README
@@ -1,16 +1,18 @@
Games::Neverhood
Blaise Roth
-The game works perfectly without installing as long as you have all the prereqs. These are simply:
+The game works without installing as long as you have the prerequisites. These are:
Perl 5.10.0
- SDL 2.5xx
+ SDL 2.540
+ File::ShareDir
Then just run:
perl nhc.pl
-To install, run the following commands:
+To get the prerequisites and install:
perl Build.PL
+ ./Build installdeps
./Build
./Build test
./Build install
View
14 bin/nhc
@@ -1,7 +1,8 @@
#!/usr/bin/perl
# bin/nhc
# Script that should be run to play Neverhood. Starts it up with all the
-# necessary command-line options, and their default values.
+# necessary command-line options, The respective module handles the default
+# values for these options.
use 5.01;
use strict;
@@ -18,18 +19,9 @@ BEGIN {
'help|?' => sub { require Pod::Usage; Pod::Usage::pod2usage(1) },
'normal-window' => sub { $Games::Neverhood::Fullscreen = 0; $Games::Neverhood::NoFrame = 0 },
'share-dir=s' => \$Games::Neverhood::ShareDir,
- 'start-set=s' => sub { @Games::Nevhood::StartSet = split /,/, $_[0], 2 },
+ 'start-set=s' => sub { ($Games::Nevhood::StartUnset, $Games::Neverhood::StartSet) = split /,/, $_[0] },
'window' => sub { $Games::Neverhood::Fullscreen = 0; $Games::Neverhood::NoFrame = 1 },
) or require Pod::Usage, Pod::Usage::pod2usage(2);
-
-# $Games::Neverhood::Debug
-# $Games::Neverhood::Scene::FastForward
- $Games::Neverhood::FPSLimit //= 60;
- $Games::Neverhood::Fullscreen //= 1;
- $Games::Neverhood::NoFrame //= 1;
- $Games::Neverhood::ShareDir //= do { require File::ShareDir; File::ShareDir::dist_dir('Games-Neverhood') };
- $Games::Neverhood::StartSet[0] //= 'Nursery::One';
- $Games::Neverhood::StartSet[1] //= $Games::Neverhood::StartSet[0];
}
use Games::Neverhood ();
View
116 lib/Games/Neverhood.pm
@@ -2,42 +2,65 @@ package Games::Neverhood;
use 5.01;
use strict;
use warnings;
-our $VERSION = 0.003;
+our $VERSION = 0.004;
+use SDL;
+use SDL::Video;
use SDLx::App;
+use SDL::Color;
use SDLx::Mixer;
use SDL::Events;
+use File::Spec;
use parent 'Exporter';
-our @EXPORT_OK = qw/$Game $App %GG $Debug $FPSLimit $Fullscreen $NoFrame $ShareDir $StartUnset $StartSet/;
+our @EXPORT_OK;
+BEGIN { @EXPORT_OK = qw/$Game $App %GG $Debug $FPSLimit $Fullscreen $NoFrame $ShareDir $StartUnset $StartSet/ }
use Data::Dumper;
+# the information for the current screen
our $Game;
+
+# the screen
our $App;
+
+# the information more global than the current screen that needs to be stored
our %GG;
-# Globals from bin/nhc
+# globals from bin/nhc
our ($Debug, $FPSLimit, $Fullscreen, $NoFrame, $ShareDir, $StartUnset, $StartSet);
+BEGIN {
+# $Debug;
+ $FPSLimit //= 60;
+ $Fullscreen //= 1;
+# $NoFrame;
+ $ShareDir //= do { require File::ShareDir; File::ShareDir::dist_dir('Games-Neverhood') };
+ $StartSet //= 'Scene::Nursery::One';
+ $StartUnset //= $Games::Neverhood::StartSet;
+}
-use Games::Neverhood::Sprite::Cursor;
-use Games::Neverhood::Sprite::Klaymen;
+# these make global sprites that persist throughout a game session
+# using them now so that every module that uses them doesn't have to
+# use Games::Neverhood::Sprite::Cursor;
+# use Games::Neverhood::Sprite::Klaymen;
-do {
+# use Games::Neverhood::Game;
+# do {
# quick way of giving the set method an unset object it can use
- no strict 'refs';
- my $unset = "Games::Neverhood::$StartUnset";
- @{"$unset::ISA"} = 'Games::Neverhood::Game';
+ # no strict 'refs';
+ # my $unset = "Games::Neverhood::$StartUnset";
+ # @{"$unset::ISA"} = 'Games::Neverhood::Game';
-$unset->new}->set($StartSet);
+# $unset->new}->set($StartSet);
+# $Game->set;
sub init {
$App = SDLx::App->new(
title => 'The Neverhood',
width => 640,
height => 480,
- depth => 32,
- min_t => $Vsync && 1 / $Vsync,
+ depth => 8,
+ min_t => $FPSLimit && 1 / $FPSLimit,
init => ['video', 'audio'],
no_cursor => 1,
centered => 1,
@@ -50,23 +73,30 @@ sub init {
# async_blit => 1,
# hw_palette => 1,
+ icon => do {
+ my $icon;
+ if($icon = SDL::Video::load_BMP(File::Spec->catfile($ShareDir, 'misc', 'nhc.bmp'))) {
+ SDL::Video::set_color_key($icon, SDL_SRCCOLORKEY, SDL::Color->new(255, 255, 255));
+ }
+ $icon;
+ },
event_handlers => [
\&event_quit,
\&event_window,
\&event_pause,
- sub{$Game->event(@_)},
+ # sub{$Game->event(@_)},
],
move_handlers => [
- sub{$Game->move(@_)}
+ # sub{$Game->move(@_)}
],
show_handlers => [
- sub{$Game->show(@_)},
+ # sub{$Game->show(@_)},
sub{$App->flip},
- sub{$Game->set},
+ # sub{$Game->set},
],
);
-
+
SDLx::Mixer::init(
frequency => 22050,
channels => 1,
@@ -78,7 +108,9 @@ sub init {
###############################################################################
-%GG = ( # Game Globals
+# Game Globals
+%GG = (
+ # 2, 1, 4, 5, 3, 11, 8, 6, 7, 9, 10, 17, 16, 18, 19, 20, 15, 14, 13, 12
# $nursery_1_window_open -- until jump down in nursery_2
# $flytrap_place -- only while in mail room, also remember if it has grabbed ring
# %mail_done -- from when the flytrap grabs the ring until willie dies
@@ -150,14 +182,14 @@ sub init {
###############################################################################
+# stop on quit event or alt-f4
sub event_quit {
my ($e) = @_;
- my $mod;
if(
$e->type == SDL_QUIT
or
- $e->type == SDL_KEYUP and $e->key_sym == SDLK_F4 and $mod = SDL::Events::get_mod_state,
- $mod & KMOD_ALT and not $mod & (KMOD_CTRL | KMOD_SHIFT)
+ $e->type == SDL_KEYDOWN and $e->key_sym == SDLK_F4
+ and $e->key_mod & KMOD_ALT and not $e->key_mod & (KMOD_CTRL | KMOD_SHIFT | KMOD_META)
) {
$App->stop;
return 1;
@@ -165,12 +197,10 @@ sub event_quit {
return;
}
+# pause when the app loses focus
sub event_window {
my ($e) = @_;
if($e->type == SDL_ACTIVEEVENT) {
- if($e->active_state & SDL_APPMOUSEFOCUS) {
- $Games::Neverhood::Sprite::Cursor->hide(!$e->active_gain);
- }
if($e->active_state & SDL_APPINPUTFOCUS) {
return 1 if $e->active_gain;
pause(\&event_window);
@@ -179,41 +209,45 @@ sub event_window {
$Fullscreen;
}
+# toggle pause when either alt is pressed
sub event_pause {
my ($e) = @_;
- state $alt;
- my $alt_sym = SDLK_LALT | SDLK_RALT;
- my $mod;
+ state $lalt;
+ state $ralt;
if($e->type == SDL_KEYDOWN) {
- if($e->key_sym & $alt_sym) {
- $alt = 1;
+ if($e->key_sym == SDLK_LALT) {
+ $lalt = 1;
+ }
+ elsif($e->key_sym == SDLK_RALT) {
+ $ralt = 1;
}
- elsif(not $e->keysym & (SDLK_LCTRL | SDLK_RCTRL | SDLK_LSHIFT | SDLK_RSHIFT)) {
- undef $alt;
+ else {
+ undef $lalt;
+ undef $ralt;
}
}
- elsif(
- $e->type == SDL_KEYUP and $e->key_sym & $alt_sym and $alt
- and $mod = SDL::Events::get_mod_state, not $mod & (KMOD_CTRL | KMOD_SHIFT)
- ) {
+ elsif($e->type == SDL_KEYUP and $e->key_sym == SDLK_LALT && $lalt || $e->key_sym == SDLK_RALT && $ralt) {
+ undef $lalt;
+ undef $ralt;
return 1 if $App->paused;
pause(\&event_pause);
-
}
return;
}
+# extra sub for pause to go through
+# for pre and post-pause and quitting while paused
sub pause {
my ($callback) = @_;
- SDL::Mixer::Music::pause_music;
- SDL::Mixer::Channels::pause(-1);
+ # SDL::Mixer::Music::pause_music;
+ # SDL::Mixer::Channels::pause(-1);
$App->pause(sub {
- return 1 if &$callback or &event_quit;
+ &$callback or &event_quit;
});
- SDL::Mixer::Music::resume_music;
- SDL::Mixer::Channels::resume(-1);
+ # SDL::Mixer::Music::resume_music;
+ # SDL::Mixer::Channels::resume(-1);
}
1;
View
50 lib/Games/Neverhood/DualVar.pm
@@ -1,50 +0,0 @@
-package Games::Neverhood::DualVar;
-use 5.01;
-use warnings;
-use strict;
-use Carp;
-use Scalar::Util;
-
-sub new {
- my $class = shift;
- my $self = bless [], ref $class || $class;
- $self->set(shift // 0, shift // '', @_);
-}
-
-sub set {
- if(@_ <= 3) {
- my ($self, $number, $string) = @_;
- if(
- !defined $number || Scalar::Util::looks_like_number($number)
- and !defined $string || !ref $string
- ) {
- $self->[0] = $number + 0 if defined $number;
- $self->[1] = $string . '' if defined $string;
- return $self;
- }
- }
- Carp::confess('arguments: [number, [string]]');
-}
-
-use overload
- '""' => sub { $_[0][1] },
- '0+' => sub { $_[0][0] },
-
- '+=' => sub { $_[0][0] += $_[1]; $_[0] },
- '-=' => sub { $_[0][0] -= $_[1]; $_[0] },
- '*=' => sub { $_[0][0] *= $_[1]; $_[0] },
- '/=' => sub { $_[0][0] /= $_[1]; $_[0] },
- '%=' => sub { $_[0][0] %= $_[1]; $_[0] },
- '**=' => sub { $_[0][0] **= $_[1]; $_[0] },
- 'x=' => sub { $_[0][1] x= $_[1]; $_[0] },
- '.=' => sub { $_[0][1] .= $_[1]; $_[0] },
- '<<=' => sub { $_[0][0] <<= $_[1]; $_[0] },
- '>>=' => sub { $_[0][0] >>= $_[1]; $_[0] },
- '&=' => sub { $_[0][0] &= $_[1]; $_[0] },
- '|=' => sub { $_[0][0] |= $_[1]; $_[0] },
- '^=' => sub { $_[0][0] ^= $_[1]; $_[0] },
-
- 'fallback' => 1,
-;
-
-1;
View
7 lib/Games/Neverhood/Game.pm
@@ -10,6 +10,8 @@ use File::Spec ();
use Data::Dumper;
+use Games::Neverhood qw/$Game $App/;
+
use overload
'""' => sub { ref($_[0]) =~ /^Games::Neverhood::(.*)/ and return $1; $_[0] },
'0+' => sub { $_[0] },
@@ -36,11 +38,12 @@ sub set {
$unset->setdown->($unset, $set);
$set->setup->($set, $unset);
- $Games::Neverhood::Scene = $set;
+ $Game = $set;
undef ${ref $unset};
undef $unset;
- $Games::Neverhood::App->dt(1 / $set->fps);
+ $App->dt(1 / $set->fps);
+ $Cursor->sprite($set->cursor_sprite);
$set;
}
View
2  lib/Games/Neverhood/OrderedHash/TiedHash.pm
@@ -11,7 +11,7 @@ sub FETCH {
}
sub STORE {
push @{$_[0][0]}, $_[1]
- unless exists $_[0][1]{$_[1]} or exists ${{ map {$_ => undef} @{$_[0][0]} }}{$_[1]};
+ unless exists $_[0][1]{$_[1]} or exists { map {$_ => undef} @{$_[0][0]} }->{$_[1]};
$_[0][1]{$_[1]} = $_[2];
}
sub DELETE {
View
339 lib/Games/Neverhood/Scene.pm
@@ -6,264 +6,232 @@ use warnings;
use SDL::Events;
use parent
- 'Games::Neverhood::GameMode',
+ 'Games::Neverhood::Game',
'Exporter',
;
-use Scalar::Util ();
-
use Data::Dumper;
+# The user entered text for the "cheat" system
our $Cheat = '';
# Globals from bin/nhc
our ($FastForward);
-our ($App, $Game, $Klaymen, $Cursor, $Remainder);
-use Games::Neverhood qw/$App $Game/;
+our ($Debug, $Klaymen, $Cursor, $Remainder);
+use Games::Neverhood qw/$Debug/;
use Games::Neverhood::Sprite qw/$Klaymen $Cursor $Remainder/;
-our @EXPORT = qw/$Game $Klaymen $Cursor/;
-our @EXPORT_OK = qw/$Cheat $FastForward $DrawDebug/;
+our @EXPORT_OK = qw/$Cheat $FastForward/;
+
+use Games::Neverhood::OrderedHash;
-#sprites all_folder fps move_bounds cursor on_set on_unset
+# sprites OrderedHash of sprites in scene
+# all_dir directory to be applied as a default to sprites
+# fps
+# cursor 'click' by default, or 'out'
+# music
+# on_set
+# on_unset run before on_set, when a scene is set
+# on_out
+# on_space
-our @ReadOnly = qw/all_folder fps cursor setup setdown/;
-sub read_only { \@ReadOnly }
+use constant no_store => qw/all_dir fps cursor music on_set on_unset on_out on_space/;
sub new {
my ($class, %arg) = @_;
my $self = bless \%arg, ref $class || $class;
- my @sprites;
+ # all_dir
+ my $sprites = Games::Neverhood::OrderedHash->new;
for(my $i = 0; $i < @{$self->sprites}; $i++) {
my $sprite = $self->sprites->[$i];
if(ref $sprite) {
- next if Scalar::Util::blessed($sprite);
-
- $sprite = Games::Neverhood::Sprite->new(
- defined $self->all_folder ? (all_folder => $self->all_folder) : (),
- %$sprite,
- );
+ unless(eval { $sprite->isa('Games::Neverhood::Sprite') }) {
+ $sprite = Games::Neverhood::Sprite->new(
+ defined $self->all_dir ? (all_dir => $self->all_dir) : (),
+ %$sprite,
+ );
+ }
}
else {
my $hash = $self->sprites->[++$i];
- my @all = map {
- defined $hash->{$_}
- ? ($_, delete $hash->{$_})
- : ()
- } @Games::Neverhood::Sprite::All;
$sprite = Games::Neverhood::Sprite->new(
$sprite => $hash,
- defined $self->all_folder ? (all_folder => $self->all_folder) : (),
- @all,
+ defined $self->all_dir ? (all_dir => $self->all_dir) : (),
+ map {
+ defined $hash->{$_}
+ ? ($_, delete $hash->{$_})
+ : ()
+ } Games::Neverhood::Sprite->all,
);
}
- $sprite->load;
} continue {
- push @sprites, $sprite;
+ $sprites->{$sprite->name} = $sprite;
}
- $self->sprites(\@sprites);
- $self->{fps} = 24 unless defined $self->fps;
- #bounds
- #cursors
- #setup
- #setdown
+ $self->{sprites} = $sprites;
+ $self->{fps} //= 24;
+ $self->{cursor} //= 'click';
+ # music
+ # on_set
+ # on_unset
+ # on_out
+ # on_space
$self;
}
-sub cursor_left_right {
- return 'left', 'left' if $_[0] < 320;
- return 'right', 'right';
-}
-sub cursor_left_forward_right {
- my $range = 100;
- return 'left', 'left' if $_[0] < $range;
- return 'right', 'right' if $_[0] >= 640 - $range;
- return 'forward', 'forward';
-}
-sub cursor_out {
- my $range = 20;
- return 'left', 'out' if $_[0] < $range;
- return 'right', 'out' if $_[0] >= 640 - $range;
- return;
-}
+###############################################################################
+### Accessors
-sub delete_clicked {
- $Cursor->clicked(undef);
-}
-
-sub klaymen {
- for(@{$_[0]->sprites}) {
- return $Klaymen if $_ == $Klaymen;
- }
-}
-# sub sprite {
- # $_[1] ~~ $_[0]->sprites;
-# }
-
-sub call {
- my (undef, $callback, @arg) = @_;
- $callback->(@arg);
-}
-
-###################################ACCESSORS###################################
-
-sub sprites {
- if(@_ > 1) { $_[0]->{sprites} = $_[1]; return $_[0]; }
- $_[0]->{sprites};
-}
-sub all_folder { $_[0]->{all_folder} }
-sub fps { $_[0]->{fps} }
-sub move_bounds {
- if(@_ > 1) { $_[0]->{move_bounds} = $_[1]; return $_[0]; }
- $_[0]->{move_bounds};
-}
-sub cursor {
- my $self = shift;
- $self->{cursor}->(@_) if $self->{cursor};
-}
-sub on_set {
- my $self = shift;
- $self->{on_set}->(@_) if $self->{on_set};
-}
-sub on_unset {
- my $self = shift;
- $self->{on_unset}->(@_) if $self->{on_unset};
-}
-
-###################################HANDLERS####################################
+sub sprites { $_[0]->{sprites} }
+sub all_dir { $_[0]->{all_dir} }
+sub fps { $_[0]->{fps} }
+sub cursor { $_[0]->{cursor} }
+sub music { $_[0]->{music} }
+sub on_set { $_[0]->{on_set}-> ($_[0]) if $_[0]->{on_set} }
+sub on_unset { $_[0]->{on_unset}->($_[0]) if $_[0]->{on_unset} }
+sub on_out { $_[0]->{on_out}-> ($_[0]) if $_[0]->{on_out} }
+sub on_space { $_[0]->{on_space}->($_[0]) if $_[0]->{on_space} }
+###############################################################################
+### Handlers
sub event {
- shift;
- my ($e) = @_;
- if($e->type == SDL_MOUSEBUTTONDOWN and $e->button_button & (SDL_BUTTON_LEFT | SDL_BUTTON_MIDDLE | SDL_BUTTON_RIGHT) and !$Cursor->hide) {
- my @pos = ($e->button_x, $e->button_y);
- my (undef, $event) = $Game->cursors->(@pos);
- $event = 'click' unless defined $event;
- $Cursor->clicked([@pos, $event]);
+ my ($self, $e) = @_;
+ if($e->type == SDL_MOUSEMOTION) {
+ $Cursor->pos([$e->motion_x, $e->motion_y]);
+ $Cursor->sprite($self->cursor_sprite);
}
- elsif($e->type == SDL_MOUSEMOTION) {
- my @pos = ($e->motion_x, $e->motion_y);
- my ($sprite) = $Game->cursors->(@pos);
- $sprite = 'click' unless defined $sprite;
- $Cursor->sprite($sprite);
+ elsif(
+ $e->type == SDL_MOUSEBUTTONDOWN and $e->button_button & (SDL_BUTTON_LEFT | SDL_BUTTON_MIDDLE | SDL_BUTTON_RIGHT)
+ and !$Cursor->hide
+ ) {
+ my @pos = ($e->button_x, $e->button_y);
$Cursor->pos(\@pos);
+ $Cursor->clicked([@pos, $self->cursor_sprite eq 'click' ? 'click' : 'out');
}
elsif($e->type == SDL_KEYDOWN) {
+ return if $e->key_mod & (KMOD_ALT | KMOD_CTRL | KMOD_SHIFT | KMOD_META);
my $name = SDL::Events::get_key_name($e->key_sym);
given($name) {
when('escape') {
-
+ # $self->set('Menu');
}
- when('space') {
-
+ when(/^[a-z]$/) {
+ $Cheat .= $name;
+ $Cheat = '-' if length $Cheat > length 'happybirthdayklaymen';
}
when('return') {
if($Cheat eq 'fastforward') {
$FastForward = !$FastForward;
- $App->dt($App->dt / 100);
+ # $App->dt( );
}
- elsif($Cheat eq 'happybirthdayklaymen') {
- if(
- $Game == $Games::Neverhood::Scene::Nursery1 or
- $Game == $Games::Neverhood::Scene::Nursery1OutWindow
- ) {
- $Game->set('Nursery::Two');
- }
+ elsif($Cheat eq 'happybirthdayklaymen' and $self eq 'Scene::Nursery::One') {
+ $self->set('Scene::Nursery::Two');
}
$Cheat = '';
}
- when(/^[a-z]$/) {
- $Cheat .= $name;
- $Cheat = '-' if length $Cheat > 19;
- }
- when(/ctrl$/) {
- $ARGV[1] = !$ARGV[1];
- $App->draw_rect([], 0) if $ARGV[1];
- }
+ }
+ }
+ elsif($e->type == SDL_ACTIVEEVENT) {
+ if($e->active_state & SDL_APPMOUSEFOCUS) {
+ $Cursor->hide(!$e->active_gain);
}
}
}
-sub move {
- shift;
- my ($step) = @_;
- return unless $step;
- $Remainder += $step;
- $Remainder -= int $Remainder;
- for my $sprite (@{$Game->sprites}, $Cursor) {
- next unless $sprite;
- my $frame = $sprite->frame + $step;
- if(int $frame eq $sprite->to_frame or $sprite->to_frame eq 'end') {
- $sprite->to_frame(-1, int $frame);
- }
- else {
- $sprite->to_frame((int $frame) x 2);
- }
- if($frame >= @{$sprite->this_sequence}) {
- $frame = $Remainder;
- $sprite->to_frame(0, 'end');
- }
- $sprite->frame = $frame;
- for(my $i = 0; $i < @{$sprite->events_sequence}; $i++) {
- my $condition = $sprite->events_sequence->[$i++];
- if(
- ref $condition eq 'CODE' and $Game->call($condition, $sprite)
- or !ref $condition and (
- $condition eq 'true'
- or $sprite->get(undef, $condition) )
- ) {
- $Game->call($sprite->events_sequence->[$i], $sprite, $step);
- }
- }
+sub cursor_sprite {
+ my ($self) = @_;
+ if($self->cursor eq 'click') {
+ 'click';
+ }
+ elsif($self->cursor eq 'out') {
+ $pos[0] < 10 ? 'left' :
+ $pos[0] >= 640 - 10 ? 'right' :
+ 'click';
}
+ else {
+ die 'DEBUG: Unknown cursor: ', $self->cursor;
+ '';
+ }
+}
+sub move {
+ my (undef, $step) = @_;
+ return unless $step;
&move_click;
+ &move_sprites;
+ &move_klaymen;
}
sub move_click {
- return unless my $click = $Cursor->clicked;
- my $event = $click->[2];
- die "click fail\n", Dumper $click unless defined $event;
- for my $sprite (grep ref $_->$event, @{$Game->sprites}) {
- for(my $i = 0; $i < @{$sprite->$event}; $i++) {
- my $condition = $sprite->$event->[$i++];
+ my ($self) = @_;
+ my ($
+ if($cursor_sprite eq 'click') {
+ for my $sprite (reverse @{$self->sprites}) {
+ my $return = $sprite->on_click // '';
+ unless($return eq 'no') {
+ $Cursor->clicked(undef) unless $return eq 'not_yet';
+ return;
+ }
+ }
+ if($self->sprites->{klaymen} and !$Klaymen->no_interrupt) {
+ my $bound;
if(
- ref $condition eq 'ARRAY' and $sprite->rect(@$condition)
- or ref $condition eq 'CODE' and $Game->call($condition, $sprite)
- or !ref $condition and $Klaymen->sprite =~ /$condition/
+ $bound = $self->bounds and
+ $bound->[0] <= $click->[0] and $bound->[1] <= $click->[1] and
+ $bound->[2] >= $click->[0] and $bound->[3] >= $click->[1] and
+
+ !$Klaymen->sprite eq 'idle' || ($click->[0] < $Klaymen->pos->[0] - 38 || $click->[0] > $Klaymen->pos->[0] + 38)
) {
- my $return = $Game->call($sprite->$event->[$i], $sprite);
- $return = '' unless defined $return;
- unless($return eq 'no') {
- $Game->delete_clicked unless $return eq 'not_yet';
- return;
- }
+ $Klaymen->move_to(to => $click->[0]);
}
+ $Cursor->clicked(undef);
+ return;
}
}
- if($Game->klaymen and $Klaymen->sprite =~ /^idle/) {
- my $bound;
- if(
- $bound = $Game->bounds and
- $bound->[0] <= $click->[0] and $bound->[1] <= $click->[1]
- and $bound->[2] >= $click->[0] and $bound->[3] >= $click->[1]
+ elsif($cursor_sprite eq 'left' or $cursor_sprite eq 'right') {
+ $self->on_out;
+ }
+}
- and !$Klaymen->sprite eq 'idle' || ($click->[0] < $Klaymen->pos->[0] - 38 || $click->[0] > $Klaymen->pos->[0] + 38)
- ) {
- $Klaymen->move_to(to => $click->[0]);
+sub move_sprites {
+ my ($self, $step) = @_;
+ $Remainder += $step;
+ if($Remainder >= 1) {
+ $Remainder--;
+ for my $sprite (@{$self->sprites}, $Cursor) {
+ next unless $sprite;
+ my $frame = $sprite->frame + $step;
+ if(int $frame eq $sprite->to_frame or $sprite->to_frame eq 'end') {
+ $sprite->to_frame(-1, int $frame);
+ }
+ else {
+ $sprite->to_frame((int $frame) x 2);
+ }
+ if($frame >= @{$sprite->this_sequence}) {
+ $frame = $Remainder;
+ $sprite->to_frame(0, 'end');
+ }
+ $sprite->frame = $frame;
+ for(my $i = 0; $i < @{$sprite->events_sequence}; $i++) {
+ my $condition = $sprite->events_sequence->[$i++];
+ if(
+ ref $condition eq 'CODE' and $self->call($condition, $sprite)
+ or !ref $condition and (
+ $condition eq 'true'
+ or $sprite->get(undef, $condition) )
+ ) {
+ $self->call($sprite->events_sequence->[$i], $sprite, $step);
+ }
+ }
}
- $Game->delete_clicked;
- return;
}
-
- &move_klaymen;
}
sub move_klaymen {
- return unless $Game->klaymen;
+ my ($self, $step, $app) = @_;
+ return unless $self->klaymen;
if($Klaymen->sprite eq 'idle') {
if(defined $Klaymen->blink_in) {
$Klaymen->blink_in($Klaymen->blink_in - $_[0]);
@@ -389,8 +357,9 @@ sub move_klaymen {
}
sub show {
- for(@{$Game->sprites}, $Cursor) {
- $_->show unless $DrawDebug and $_ != $Klaymen and $_ != $Cursor;
+ my ($self, $time) = @_;
+ for(@{$self->sprites}, $Cursor) {
+ $_->show;
}
}
View
82 lib/Games/Neverhood/Scene/Nursery/One.pm
@@ -1,55 +1,60 @@
package Games::Neverhood::Scene::Nursery::One;
use 5.01;
-use strict 'subs';
+use strict;
use warnings;
-use Games::Neverhood::Scene;
+use Games::Neverhood::Scene '$Klaymen';
+use Games::Neverhood '$Game', '%GG';
+our ($Klaymen, $Game, %GG);
our @ISA = 'Games::Neverhood::Scene';
use Data::Dumper;
sub import {
- ${+__PACKAGE__} = __PACKAGE__->SUPER::new(
+ $Game = __PACKAGE__->SUPER::new(
all_folder => ['nursery', 'one'],
- bounds => [ 151, 60, 500, 479 ],
+ move_bounds => [151, 60, 500, 479],
on_set => sub {
+ if($GG{nursery_1_window_open} == 1) { $Game->sprites->{window}->hide }
$Klaymen
->pos([200, 43])
->set('snore')
;
},
+ on_unset => sub {
+ $GG{nursery_1_window_open} = 1 if $Game->sprites->{window}->hide;
+ }
sprites => [
background => {
- click => [ '^snore$' => sub { $Klaymen->set('wake') } ]
+ on_click => sub {
+ if($Klaymen->get('snore')) { $Klaymen->set('wake') }
+ },
},
lever => {
pos => [65, 313],
- frames => 7,
sequences => [
[ 0 ],
- [ 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 4, 4, 3, 3, 2, 2, 1, 1 ],
- ],
- click => [
- [40, 300, 70, 100] => sub { $_[0]->move_to(right => 150, set => ['pull_lever']) }
+ [ 1,1,2,2,3,3,4,4,5,5,6,6,4,4,3,3,2,2,1,1 ],
],
- events => {
+ on_click => sub {
+ if($_[0]->rect(40, 300, 70, 100)) { $_[0]->move_to(right => 150, set => ['pull_lever']) }
+ },
+ actions => {
0 => [
- sub { $Klaymen->get('pull_lever', 26) } =>
- sub { $_[0]->sequence(1) }
+ sub { $Klaymen->get('pull_lever', 26) } => sub { $_[0]->set(undef, 0, 1) }
],
- 1 => [ end => sub { $_[0]->sequence(0) } ],
+ 1 => [ end => sub { $_[0]->set(undef, 0, 0) } ],
},
},
window => {
- pos => [ 317, 211 ],
- frames => 4,
+ pos => [317, 211],
sequences => [
[ 0 ],
- [ 1, 2, 3 ],
+ [ 1,2,3 ],
],
- events => {
+ actions => {
0 => [
sub { $_[0]->sequence == 0 and $Klaymen->get('push_button_back', 53) } =>
sub { $_[0]->sequence(1) }
@@ -60,19 +65,20 @@ sub import {
sub { $Game->set('Scene::Nursery::One::OutWindow'); }
],
},
- click => [
- [315, 200, 70, 140, undef, sub{ $_[0]->hide }] =>
- sub { $_[0]->move_to(left => 300, right => [391, 370], set => ['push_button_back', 0, 1]) }
- ],
+ on_click => sub {
+ if($_[0]->rect(315, 200, 70, 140) and $_[0]->hide) {
+ $_[0]->move_to(left => 300, right => [391, 370], set => ['push_button_back', 0, 1])
+ }
+ },
},
button => {
- pos => [ 466, 339 ],
+ pos => [466, 339],
hide => 1,
- click => [
- [455, 325, 40, 40] => sub { $_[0]->move_to(left => 370, set => ['push_button_back']) }
- ],
- events => {
+ on_click => sub {
+ if($_[0]->rect(455, 325, 40, 40)) { $_[0]->move_to(left => 370, set => ['push_button_back']) }
+ },
+ actions => {
0 => [
sub { $Klaymen->get('push_button_back', 51) } =>
sub { $_[0]->hide(0) },
@@ -84,18 +90,17 @@ sub import {
},
door => {
- pos => [ 493, 212 ],
- frames => 7,
+ pos => [493, 212],
sequences => [
[ 0 ],
- [ 1, 1, 2, 2, 3, 3 ],
+ [ 1,1,2,2,3,3 ],
[ 4 ],
- [ 1, 1, 2, 2, 3, 3 ],
+ [ 1,1,2,2,3,3 ],
[ 1 ],
- [ 5, 5, 6, 6 ],
+ [ 5,5,6,6 ],
],
- click => [
- [520, 200, 90, 250, '^idle(?!_think$)'] => sub {
+ on_click => sub {
+ if($_[0]->rect(520, 200, 90, 250) and $Klaymen->sprite ne 'think') {
if($_[0]->hide) {
$_[0]->move_to(to => 700);
}
@@ -104,7 +109,7 @@ sub import {
}
}
],
- events => {
+ actions => {
0 => [
sub { $Klaymen->get('pull_lever', 47) } =>
sub { $_[0]->sequence(1) }
@@ -126,13 +131,12 @@ sub import {
$Klaymen,
hammer => {
- pos => [ 375, 30 ],
- frames => 14,
+ pos => [375, 30],
sequences => [
[ 0 ],
- [ 1, 1, 2, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 13, 13 ],
+ [ 1,1,2,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10,11,11,12,12,13,13 ],
],
- events => {
+ actions => {
0 => [
sub { $Klaymen->get('pull_lever', 42) } =>
sub { $_[0]->sequence(1) }
View
41 lib/Games/Neverhood/Sprite.pm
@@ -27,18 +27,16 @@ our @EXPORT = qw/$Game $Klaymen $Cursor/;
our @EXPORT_OK = qw/$Klaymen $Cursor $Remainder @All/;
#ALL
-#to_frame
-#sprites sprite frame sequence pos hide flip all_on_ground all_folder all_name
-#sprites_sprite
+# to_frame
+# sprites sprite frame sequence pos hide flip all_on_ground all_folder all_name
+# sprites_sprite
#SPRITE
-#frames sequences offset flipable on_ground events surface surface_flip click left right out up down folder name
-#this_sequence this_sequence_frame events_sequence
+# sequences offset flipable on_ground events surface surface_flip click left right out up down folder
+# this_sequence this_sequence_frame events_sequence
-our @All = qw/sprite frame sequence pos hide mirror all_on_ground all_folder all_name/;
-
-our @ReadOnly = qw/sprites all_on_ground all_folder all_name /;
-sub read_only { \@ReadOnly }
+use constant all => qw/sprite frame sequence pos hide mirror all_on_ground all_folder all_name/;
+use constant no_store => qw/sprites all_on_ground all_folder all_name /;
sub new {
my ($class, %arg) = @_;
@@ -46,7 +44,7 @@ sub new {
my $sprite;
$self->{sprites} = {};
-
+
while(my ($key, $val) = keys %arg) {
if($key eq 'sprite') {
$sprite = $val;
@@ -64,7 +62,7 @@ sub new {
$self->{this_sprite}{offset}[1] //= 0;
#flipable
#on_ground
-
+
if(ref $self->events) {
if(ref $self->events eq 'CODE') {
$self->events({ 0 => [ true => $self->events ] });
@@ -94,7 +92,7 @@ sub new {
$self->name($_) unless defined $self->name;
}
}
-
+
$self->{to_frame} = Games::Neverhood::DualVar->new;
$self->frame($self->frame // 0);
$self->sequence(0) unless defined $self->sequence;
@@ -275,7 +273,7 @@ sub flip {
}
sub all_on_ground { $_[0]->{all_on_ground} }
sub all_folder { $_[0]->{all_folder} }
-# sub all_name { $_[0]->{all_name} }
+sub name { $_[0]->{name} }
sub to_frame {
my $self = shift;
if(@_ > 1) { $self->{to_frame}->set(@_); return $self; }
@@ -284,25 +282,20 @@ sub to_frame {
###############################################################################
-sub frames { $_[0]->{this_sprite}{frames} }
sub sequences { $_[0]->{this_sprite}{sequences} }
sub offset { $_[0]->{this_sprite}{offset} }
sub on_ground { $_[0]->{this_sprite}{on_ground} // $_[0]->all_on_ground }
sub events { $_[0]->{this_sprite}{events} }
-sub surface { $_[0]->{this_sprite}{surface} }
-sub surface_flip { $_[0]->{this_sprite}{surface_flip} }
-sub click { $_[0]->{this_sprite}{click} }
-sub left { $_[0]->{this_sprite}{left} }
-sub right { $_[0]->{this_sprite}{right} }
-sub out { $_[0]->{this_sprite}{out} }
-sub up { $_[0]->{this_sprite}{up} }
-sub down { $_[0]->{this_sprite}{down} }
+sub on_click {
+ $_[0]->{this_sprite}{on_click}[0]->($_[0]) and
+ $_[0]->{this_sprite}{on_click}[1]->($_[0])
+ if $_[0]->{this_sprite}{on_click};
+}
sub folder { $_[0]->{this_sprite}{folder} // $_[0]->all_folder }
-sub name { $_[0]->{this_sprite}{name} }
sub this_sequence { $_[0]->sequences($_[0]->sequence) }
sub this_sequence_frame { $_[0]->this_sequence($_[0]->frame) }
sub events_sequence { $_[0]->events($_[0]->sequence) }
-sub this_surface { $_[0]->flip ? $_[0]->surface_flip : $_[0]->surface }
1;
+
View
43 lib/Games/Neverhood/Sprite/Cursor.pm
@@ -1,35 +1,30 @@
package Games::Neverhood::Sprite::Cursor;
use 5.01;
use strict;
-no strict 'refs';
use warnings;
-use Games::Neverhood::Sprite;
-our @ISA = 'Games::Neverhood::Sprite';
+use parent 'Games::Neverhood::Sprite';
-${+__PACKAGE__} = __PACKAGE__->SUPER::new(
+${;no strict;__PACKAGE__} = __PACKAGE__->SUPER::new(
all_folder => 'cursor',
click => {
- frames => 3,
- sequences => [0, 0, 2, 2],
+ sequences => [[0, 0, 1, 1]],
},
- left => {
- frames => 3,
- sequences => [0, 0, 2, 2],
- },
- right => {
- frames => 3,
- sequences => [0, 0, 2, 2],
- },
- forward => {
- frames => 3,
- sequences => [0, 0, 2, 2],
- },
-)->load;
-
-sub clicked {
- if(@_ > 1) { $_[0]->{clicked} = $_[1]; return $_[0]; }
- $_[0]->{clicked};
-}
+ # left => {
+ # sequences => [[0, 0, 1, 1]],
+ # },
+ # right => {
+ # sequences => [[0, 0, 1, 1]],
+ # },
+ # forward => {
+ # sequences => [[0, 0, 1, 1]],
+ # },
+ # up => {
+ # sequences => [[0, 0, 1, 1]],
+ # },
+ # down => {
+ # sequences => [[0, 0, 1, 1]],
+ # },
+);
1;
View
143 lib/Games/Neverhood/Sprite/Klaymen.pm
@@ -1,181 +1,141 @@
package Games::Neverhood::Sprite::Klaymen;
use 5.01;
use strict;
-no strict 'refs';
use warnings;
-use Games::Neverhood::Sprite;
-our @ISA = 'Games::Neverhood::Sprite';
+use parent 'Games::Neverhood::Sprite';
-${+__PACKAGE__} = __PACKAGE__->SUPER::new(
+${;no strict;__PACKAGE__} = __PACKAGE__->SUPER::new(
all_folder => ['klaymen'],
all_on_ground => 1,
snore => {
- frames => 35,
offset => [-103, 3],
sequences => [[
- 0, 0, 0, 0, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 5, 5, 5, 5, 6, 6, 6, 7, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 13, 13, 14, 14, 15, 15, 16, 16, 17, 17, 18, 18, 19, 19, 20, 20, 21, 21, 22, 22, 23, 23, 24, 24, 25, 25, 26, 26, 27, 27, 28, 28, 29, 29, 30, 30, 31, 31, 32, 32, 33, 33, 34, 34, 34
+ 0,0,0,0,1,1,1,1,1,2,2,2,2,2,3,3,3,3,3,4,4,4,4,4,5,5,5,5,6,6,6,7,7,8,8,9,9,10,10,11,11,12,12,13,13,14,14,15,15,16,16,17,17,18,18,19,19,20,20,21,21,22,22,23,23,24,24,25,25,26,26,27,27,28,28,29,29,30,30,31,31,32,32,33,33,34,34,34
]],
- events => [ 15 => sub { $_->play_sound('ID_C0238244-03') } ],
+ actions => [ 15 => sub { $_[0]->play_sound('ID_C0238244-03') } ],
},
wake => {
- frames => 62,
offset => [-106, 8],
sequences => [[
- 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 13, 13, 14, 14, 14, 15, 15, 15, 15, 16, 16, 16, 16, 17, 17, 17, 17, 18, 18, 18, 19, 19, 19, 19, 20, 20, 20, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 22, 22, 23, 23, 24, 24, 25, 25, 26, 26, 27, 27, 28, 28, 29, 29, 30, 30, 31, 31, 32, 32, 33, 33, 34, 34, 35, 35, 36, 36, 36, 36, 36, 37, 37, 37, 37, 37, 37, 38, 38, 38, 38, 38, 38, 39, 39, 39, 40, 40, 40, 40, 39, 39, 39, 36, 36, 36, 36, 37, 37, 37, 37, 38, 38, 38, 38, 39, 39, 39, 40, 40, 40, 40, 41, 41, 42, 42, 43, 43, 44, 44, 45, 45, 46, 46, 47, 47, 48, 48, 49, 50, 50, 51, 51, 52, 52, 53, 53, 54, 54, 55, 55, 56, 56, 57, 57, 58, 58, 59, 59, 60, 60, 61, 61
+ 0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10,11,11,12,12,13,13,14,14,14,15,15,15,15,16,16,16,16,17,17,17,17,18,18,18,19,19,19,19,20,20,20,21,21,21,21,21,21,21,21,21,21,22,22,23,23,24,24,25,25,26,26,27,27,28,28,29,29,30,30,31,31,32,32,33,33,34,34,35,35,36,36,36,36,36,37,37,37,37,37,37,38,38,38,38,38,38,39,39,39,40,40,40,40,39,39,39,36,36,36,36,37,37,37,37,38,38,38,38,39,39,39,40,40,40,40,41,41,42,42,43,43,44,44,45,45,46,46,47,47,48,48,49,50,50,51,51,52,52,53,53,54,54,55,55,56,56,57,57,58,58,59,59,60,60,61,61
]],
- events => [ end => sub { $_->set('idle') } ],
+ actions => [ end => sub { $_[0]->set('idle') } ],
},
idle => {
- frames => 7,
offset => [-40, 0],
sequences => [
- [ 0, 0, 1, 1, 2, 2 ],
- [ 3, 3, 4, 5, 5, 6, 6 ],
+ [ 0,0,1,1,2,2 ],
+ [ 3,3,4,5,5,6,6 ],
],
- events => {
- 1 => [ end => sub { $_->sequence(0) } ],
+ actions => {
+ 1 => [ end => sub { $_[0]->sequence(0) } ],
},
},
idle_random_0 => {
- frames => 77,
offset => [-60, 1],
sequences => [[
- 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 13, 14, 15, 16, 16, 17, 18, 18, 19, 19, 19, 19, 19, 19, 20, 20, 21, 21, 22, 22, 23, 23, 24, 24, 25, 25, 26, 27, 27, 28, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 33, 34, 35, 36, 37, 38, 39, 40, 41, 43, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 54, 54, 54, 54, 54, 55, 55, 55, 55, 55, 55, 56, 56, 57, 57, 58, 58, 59, 59, 60, 60, 61, 61, 62, 62, 63, 63, 64, 64, 65, 65, 66, 66, 67, 67, 68, 68, 69, 69, 70, 71, 71, 72, 72, 73, 73, 74, 74, 75, 75, 76, 76
+ 0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10,11,11,12,13,14,15,16,16,17,18,18,19,19,19,19,19,19,20,20,21,21,22,22,23,23,24,24,25,25,26,27,27,28,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,33,34,35,36,37,38,39,40,41,42,43,33,34,35,36,37,38,39,40,41,43,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,54,54,54,54,54,55,55,55,55,55,55,56,56,57,57,58,58,59,59,60,60,61,61,62,62,63,63,64,64,65,65,66,66,67,67,68,68,69,69,70,71,71,72,72,73,73,74,74,75,75,76,76
]],
- events => [ end => sub { $_->set('idle') } ],
+ actions => [ end => sub { $_[0]->set('idle') } ],
},
idle_random_1 => {
- frames => 103,
offset => [-93, 0],
sequences => [[
- 0, 0, 1, 1, 2, 2, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 13, 13, 14, 14, 15, 15, 16, 16, 17, 17, 18, 18, 19, 19, 19, 20, 20, 21, 21, 22, 22, 23, 23, 24, 24, 25, 25, 25, 26, 26, 26, 27, 27, 28, 28, 29, 29, 30, 30, 31, 31, 32, 33, 33, 34, 34, 35, 35, 36, 36, 37, 37, 38, 38, 39, 39, 40, 40, 41, 41, 42, 42, 43, 43, 44, 44, 44, 45, 45, 46, 46, 47, 47, 48, 48, 49, 49, 50, 50, 51, 51, 52, 52, 53, 53, 54, 54, 55, 55, 56, 56, 57, 57, 58, 58, 59, 59, 60, 60, 61, 61, 61, 62, 62, 63, 64, 64, 65, 65, 66, 66, 67, 67, 68, 68, 69, 69, 70, 70, 71, 71, 72, 72, 73, 73, 74, 74, 75, 75, 76, 76, 77, 77, 78, 78, 79, 79, 80, 80, 81, 81, 82, 82, 83, 83, 84, 84, 85, 85, 86, 86, 87, 87, 88, 88, 89, 89, 90, 90, 91, 91, 86, 86, 92, 92, 93, 94, 94, 95, 95, 96, 96, 97, 97, 98, 98, 99, 99, 100, 100, 101, 101, 102, 102
+ 0,0,1,1,2,2,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10,11,11,12,12,13,13,14,14,15,15,16,16,17,17,18,18,19,19,19,20,20,21,21,22,22,23,23,24,24,25,25,25,26,26,26,27,27,28,28,29,29,30,30,31,31,32,33,33,34,34,35,35,36,36,37,37,38,38,39,39,40,40,41,41,42,42,43,43,44,44,44,45,45,46,46,47,47,48,48,49,49,50,50,51,51,52,52,53,53,54,54,55,55,56,56,57,57,58,58,59,59,60,60,61,61,61,62,62,63,64,64,65,65,66,66,67,67,68,68,69,69,70,70,71,71,72,72,73,73,74,74,75,75,76,76,77,77,78,78,79,79,80,80,81,81,82,82,83,83,84,84,85,85,86,86,87,87,88,88,89,89,90,90,91,91,86,86,92,92,93,94,94,95,95,96,96,97,97,98,98,99,99,100,100,101,101,102,102
]],
- events => [ end => sub { $_->set('idle') } ],
+ actions => [ end => sub { $_[0]->set('idle') } ],
},
idle_random_2 => {
- frames => 59,
offset => [-80, 1],
sequences => [[
- 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 13, 13, 14, 14, 15, 15, 16, 16, 17, 17, 18, 18, 10, 10, 11, 11, 12, 12, 13, 14, 14, 15, 15, 16, 16, 17, 17, 18, 18, 10, 10, 11, 11, 12, 12, 13, 13, 14, 14, 15, 15, 16, 16, 17, 17, 18, 18, 19, 19, 20, 20, 21, 21, 22, 22, 23, 23, 24, 24, 25, 25, 23, 23, 24, 24, 25, 25, 26, 26, 27, 27, 28, 28, 29, 29, 23, 23, 24, 24, 30, 31, 31, 32, 32, 33, 33, 34, 34, 35, 35, 36, 36, 34, 34, 35, 35, 36, 36, 34, 34, 35, 35, 36, 36, 34, 34, 35, 35, 36, 36, 37, 37, 38, 38, 39, 39, 40, 40, 41, 41, 42, 42, 43, 43, 44, 44, 45, 45, 46, 46, 47, 47, 45, 45, 46, 46, 48, 48, 49, 50, 50, 51, 51, 45, 45, 46, 46, 47, 47, 45, 45, 46, 46, 47, 47, 45, 45, 46, 46, 47, 47, 48, 48, 49, 49, 50, 50, 51, 51, 52, 52, 52, 52, 52, 53, 53, 54, 54, 55, 55, 56, 56, 57, 57, 58, 58
+ 0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10,11,11,12,12,13,13,14,14,15,15,16,16,17,17,18,18,10,10,11,11,12,12,13,14,14,15,15,16,16,17,17,18,18,10,10,11,11,12,12,13,13,14,14,15,15,16,16,17,17,18,18,19,19,20,20,21,21,22,22,23,23,24,24,25,25,23,23,24,24,25,25,26,26,27,27,28,28,29,29,23,23,24,24,30,31,31,32,32,33,33,34,34,35,35,36,36,34,34,35,35,36,36,34,34,35,35,36,36,34,34,35,35,36,36,37,37,38,38,39,39,40,40,41,41,42,42,43,43,44,44,45,45,46,46,47,47,45,45,46,46,48,48,49,50,50,51,51,45,45,46,46,47,47,45,45,46,46,47,47,45,45,46,46,47,47,48,48,49,49,50,50,51,51,52,52,52,52,52,53,53,54,54,55,55,56,56,57,57,58,58
]],
- events => [ end => sub { $_->set('idle') } ],
+ actions => [ end => sub { $_[0]->set('idle') } ],
},
idle_random_3 => {
- frames => 73,
offset => [-82, 0],
sequences => [[
- 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9, 10, 11, 11, 12, 12, 13, 13, 14, 14, 15, 15, 16, 16, 17, 17, 18, 18, 19, 19, 20, 20, 21, 21, 22, 22, 23, 23, 24, 24, 25, 25, 26, 26, 27, 27, 28, 28, 29, 29, 30, 30, 31, 31, 32, 32, 33, 33, 34, 34, 35, 35, 36, 36, 36, 36, 36, 36, 36, 36, 37, 37, 38, 38, 39, 39, 40, 40, 41, 41, 42, 42, 43, 43, 43, 44, 44, 44, 44, 45, 45, 45, 45, 46, 47, 48, 49, 50, 46, 47, 49, 50, 47, 49, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 51, 52, 53, 54, 54, 50, 51, 52, 53, 54, 54, 50, 51, 52, 53, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 46, 47, 48, 49, 50, 46, 46, 48, 48, 49, 49, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 51, 52, 53, 54, 54, 50, 51, 52, 53, 54, 54, 55, 55, 55, 55, 55, 55, 55, 55, 55, 55, 55, 55, 55, 55, 55, 55, 55, 55, 56, 56, 57, 57, 58, 58, 59, 59, 60, 60, 61, 61, 62, 62, 63, 63, 64, 64, 65, 65, 66, 66, 67, 67, 68, 68, 69, 69, 70, 71, 71, 72, 72
+ 0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,11,11,12,12,13,13,14,14,15,15,16,16,17,17,18,18,19,19,20,20,21,21,22,22,23,23,24,24,25,25,26,26,27,27,28,28,29,29,30,30,31,31,32,32,33,33,34,34,35,35,36,36,36,36,36,36,36,36,37,37,38,38,39,39,40,40,41,41,42,42,43,43,43,44,44,44,44,45,45,45,45,46,47,48,49,50,46,47,49,50,47,49,50,50,50,50,50,50,50,50,50,50,50,50,50,51,52,53,54,54,50,51,52,53,54,54,50,51,52,53,50,50,50,50,50,50,50,50,50,50,50,50,46,47,48,49,50,46,46,48,48,49,49,50,50,50,50,50,50,50,50,50,50,50,50,51,52,53,54,54,50,51,52,53,54,54,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,55,56,56,57,57,58,58,59,59,60,60,61,61,62,62,63,63,64,64,65,65,66,66,67,67,68,68,69,69,70,71,71,72,72
]],
- events => [ end => sub { $_->set('idle') } ],
+ actions => [ end => sub { $_[0]->set('idle') } ],
},
idle_random_4 => {
- frames => 138,
offset => [-90, 1],
sequences => [[
- 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 6, 7, 7, 7, 8, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 13, 13, 13, 14, 14, 15, 15, 16, 16, 17, 17, 18, 18, 19, 19, 20, 20, 21, 21, 22, 22, 23, 24, 24, 25, 25, 26, 26, 27, 27, 28, 28, 29, 29, 30, 30, 31, 31, 32, 32, 33, 33, 34, 34, 35, 35, 36, 36, 37, 37, 38, 38, 39, 39, 40, 40, 41, 41, 42, 42, 43, 43, 44, 44, 45, 45, 46, 46, 47, 47, 48, 48, 49, 49, 50, 50, 51, 51, 52, 52, 53, 53, 54, 55, 55, 56, 56, 57, 57, 58, 58, 59, 59, 60, 60, 61, 61, 62, 62, 63, 63, 64, 64, 65, 65, 66, 66, 67, 67, 68, 68, 69, 69, 70, 70, 71, 71, 72, 72, 73, 73, 74, 74, 75, 75, 76, 76, 77, 77, 78, 78, 79, 79, 80, 80, 81, 81, 82, 82, 83, 83, 84, 84, 85, 86, 86, 87, 87, 88, 88, 89, 89, 90, 90, 91, 91, 92, 92, 93, 93, 94, 94, 95, 95, 96, 96, 97, 97, 98, 98, 99, 99, 100, 100, 101, 101, 102, 102, 103, 103, 103, 103, 104, 104, 104, 104, 105, 105, 105, 105, 106, 106, 107, 107, 108, 108, 109, 109, 110, 110, 111, 111, 112, 112, 113, 113, 114, 115, 115, 116, 116, 117, 117, 118, 118, 119, 119, 120, 120, 121, 121, 122, 122, 123, 123, 124, 124, 125, 125, 126, 126, 127, 127, 128, 128, 129, 129, 130, 130, 131, 131, 132, 132, 119, 119, 120, 120, 121, 121, 122, 122, 123, 123, 124, 124, 125, 125, 126, 126, 127, 127, 128, 128, 129, 129, 130, 130, 131, 131, 132, 132, 132, 132, 132, 132, 132, 132, 133, 133, 134, 134, 135, 135, 136, 136, 137, 137
+ 0,0,1,1,2,2,3,3,4,4,5,5,6,6,6,7,7,7,8,8,8,9,9,10,10,11,11,12,12,13,13,13,14,14,15,15,16,16,17,17,18,18,19,19,20,20,21,21,22,22,23,24,24,25,25,26,26,27,27,28,28,29,29,30,30,31,31,32,32,33,33,34,34,35,35,36,36,37,37,38,38,39,39,40,40,41,41,42,42,43,43,44,44,45,45,46,46,47,47,48,48,49,49,50,50,51,51,52,52,53,53,54,55,55,56,56,57,57,58,58,59,59,60,60,61,61,62,62,63,63,64,64,65,65,66,66,67,67,68,68,69,69,70,70,71,71,72,72,73,73,74,74,75,75,76,76,77,77,78,78,79,79,80,80,81,81,82,82,83,83,84,84,85,86,86,87,87,88,88,89,89,90,90,91,91,92,92,93,93,94,94,95,95,96,96,97,97,98,98,99,99,100,100,101,101,102,102,103,103,103,103,104,104,104,104,105,105,105,105,106,106,107,107,108,108,109,109,110,110,111,111,112,112,113,113,114,115,115,116,116,117,117,118,118,119,119,120,120,121,121,122,122,123,123,124,124,125,125,126,126,127,127,128,128,129,129,130,130,131,131,132,132,119,119,120,120,121,121,122,122,123,123,124,124,125,125,126,126,127,127,128,128,129,129,130,130,131,131,132,132,132,132,132,132,132,132,133,133,134,134,135,135,136,136,137,137
]],
- events => [ end => sub { $_->set('idle') } ],
+ actions => [ end => sub { $_[0]->set('idle') } ],
},
- idle_think => {
- frames => 22,
+ think => {
offset => [-63, 1],
sequences => [[
- 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9, 10, 10, 8, 8, 9, 9, 10, 10, 8, 8, 9, 9, 10, 10, 8, 8, 9, 10, 10, 11, 11, 12, 12, 13, 13, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 13, 13, 8, 8, 9, 9, 10, 10, 14, 14, 15, 15, 16, 16, 17, 17, 18, 18, 19, 19, 20, 20, 21, 21
+ 0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10,8,8,9,9,10,10,8,8,9,9,10,10,8,8,9,10,10,11,11,12,12,13,13,8,8,9,9,10,10,11,11,12,12,13,13,8,8,9,9,10,10,14,14,15,15,16,16,17,17,18,18,19,19,20,20,21,21
]],
- events => [ end => sub { $_->set('idle') } ],
+ actions => [ end => sub { $_[0]->set('idle') } ],
},
pull_lever => {
- frames => 32,
offset => [-78, -1],
sequences => [[
- 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 13, 13, 14, 14, 15, 15, 16, 16, 17, 17, 18, 18, 16, 16, 15, 15, 14, 14, 13, 13, 19, 19, 20, 20, 21, 21, 22, 22, 23, 23, 24, 24, 25, 25, 26, 26, 27, 27, 28, 28, 29, 29, 30, 30, 31, 31
+ 0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10,11,11,12,12,13,13,14,14,15,15,16,16,17,17,18,18,16,16,15,15,14,14,13,13,19,19,20,20,21,21,22,22,23,23,24,24,25,25,26,26,27,27,28,28,29,29,30,30,31,31
]],
- events => [ end => sub { $_->set('idle') } ],
+ actions => [ end => sub { $_[0]->set('idle') } ],
},
- idle_push_button_back => {
- frames => 54,
+ push_button_back => {
offset => [-59, 0],
sequences => [
- [ 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 9, 9, 10, 10, 11, 12, 13, 13, 14, 14, 15, 16, 16, 17, 17, 18, 18, 19, 20, 21, 22, 23, 24, 25, 26, 26, 27, 28, 28, 29, 30, 30, 31, 31, 32, 32, 32, 33, 33, 33, 33, 34, 34, 34, 35, 35, 36, 36, 37, 37, 38, 38, 39, 39, 40, 40, 41, 41, 42, 42, 43, 43, 44, 44, 45, 45, 46, 46, 47, 47, 48, 48, 49, 49, 50, 51, 51, 52, 53, 53 ],
- [ 7, 7, 8, 9, 9, 10, 10, 11, 12, 13, 13, 14, 14 ],
- [ 44, 44, 45, 45, 46, 46, 47, 47 ],
+ [ 0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,9,9,10,10,11,12,13,13,14,14,15,16,16,17,17,18,18,19,20,21,22,23,24,25,26,26,27,28,28,29,30,30,31,31,32,32,32,33,33,33,33,34,34,34,35,35,36,36,37,37,38,38,39,39,40,40,41,41,42,42,43,43,44,44,45,45,46,46,47,47,48,48,49,49,50,51,51,52,53,53 ],
+ [ 7,7,8,9,9,10,10,11,12,13,13,14,14 ],
+ [ 44,44,45,45,46,46,47,47 ],
],
- events => {
- 0 => [ end => sub { $_->set('idle') } ],
- 2 => [ end => sub { $_->set('idle') } ],
+ actions => {
+ 0 => [ end => sub { $_[0]->set('idle') } ],
+ 2 => [ end => sub { $_[0]->set('idle') } ],
},
},
- idle_walk_start => {
- frames => 10,
+ walk => {
offset => [-86, 0],
- sequences => [[
- 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9
- ]],
- },
-
- idle_walk => {
- frames => 14,
offset => [-80, 0],
- sequences => [[
- 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 13, 13
- ]],
- },
-
- idle_walk_end => {
- frames => 23,
offset => [-98, 2],
- sequences => [[
- [ 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7 ],
- [ 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 8, 8, 9, 9, 10, 10, 11, 11 ],
- [ 12, 12, 13, 13, 14, 14, 15, 15, 16, 16, 17, 17, 18, 18, 19, 19, 20, 20, 11, 11, 21, 21, 6, 6, 22, 22, 7, 7 ]
- ]],
+ sequences => [
+ [ 0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9 ],
+ [ 0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10,11,11,12,12,13,13 ],
+ [ 0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7 ],
+ [ 0,0,1,1,2,2,3,3,4,4,5,5,8,8,9,9,10,10,11,11 ],
+ [ 12,12,13,13,14,14,15,15,16,16,17,17,18,18,19,19,20,20,11,11,21,21,6,6,22,22,7,7 ],
+ ],
},
- idle_shuffle => {
- frames => 8,
+ shuffle => {
offset => [-50, -1],
- sequences => [[
- 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7
- ]],
- },
-
- idle_shuffle_end => {
- frames => 3,
offset => [-48, -1],
- sequences => [[
- 0, 0, 1, 1, 2, 2
- ]],
+ sequences => [
+ [ 0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7 ],
+ [ 0,0,1,1,2,2 ],
+ ],
},
- idle_slide => {
- frames => 7,
+ slide => {
offset => [-99, 0],
- sequences => [[
- 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6
- ]],
- },
-
- idle_slide_end => {
- frames => 5,
offset => [-64, -1],
- sequences => [[
- 0, 0, 1, 1, 2, 2, 3, 3, 4, 4
- ]],
+ sequences => [
+ [ 0,0,1,1,2,2,3,3,4,4,5,5,6,6 ],
+ [ 0,0,1,1,2,2,3,3,4,4 ],
+ ],
},
-
+
);
sub blink_in {
@@ -190,5 +150,6 @@ sub moving_to {
if(@_ > 1) { $_[0]->{moving_to} = $_[1]; return $_[0]; }
$_[0]->{moving_to};
}
+sub no_interrupt { $_[0]->{this_sprite}{no_interrupt} }
1;
View
0  lib/Games/Neverhood/Sprite/Single.pm
No changes.
View
177 lib/Games/Neverhood/Video.pm
@@ -0,0 +1,177 @@
+package Games::Neverhood::Video;
+use strict;
+use warnings;
+use 5.01;
+use autodie;
+use File::Spec ();
+
+use Games::Neverhood::Video::BitStream;
+use Games::Neverhood::Video::Huffman::BigTree;
+
+use constant no_store => qw/file next no_skip pos on_set on_unset/;
+
+# file next no_skip pos on_set on_unset
+
+sub new {
+ my ($class, %arg) = @_;
+ my $self = bless \%arg, ref $class || $class;
+ # file
+ # next
+ # no_skip
+ $self->{pos}[0] //= 0;
+ $self->{pos}[1] //= 0;
+ # on_set
+ # on_unset
+
+ open my $fh, File::Spec->catfile('share', 'video', @{$self->file});
+ my $buf;
+
+ # Header
+ read $fh, $buf, 104;
+ (@{$self->{Header}}{
+ 'Signature', # all SMK2
+ 'Width',
+ 'Height',
+ 'Frames',
+ 'FrameRate', # all negative
+ 'Flags', # all 0
+ 'AudioSize', # all 0
+ 'TreesSize',
+ 'MMapSize',
+ 'MClrSize',
+ 'FullSize',
+ 'TypeSize',
+ 'AudioRate', # all 1 or 0 elements. have bit: 31=1, 30=1, 29=1 mostly but 0 for all m and one c, 28=0, 27-26=0, 25-24=0, 23-0=22050 but 11025 for all m
+ 'Dummy', # all undef
+ }) = unpack 'A4LLLlLA28LLLLLA28L', $buf;
+ $self->{Header}{AudioSize} = [ unpack 'LLLLLLL', $self->{Header}{AudioSize} ];
+ $self->{Header}{AudioRate} = [ unpack 'LLLLLLL', $self->{Header}{AudioRate} ];
+
+ # FrameSizes
+ read $fh, $buf, $self->{Header}{Frames} * 4;
+ $self->{FrameSizes} = [ unpack 'L' x $self->{Header}{Frames}, $buf ];
+ # no bit 0, no bit 1
+
+ # FrameTypes
+ read $fh, $buf, $self->{Header}{Frames};
+ $self->{FrameTypes} = [ unpack 'C' x $self->{Header}{Frames}, $buf ];
+ # all bit 0 on first FrameType some have bit 0 after, no bit 1 near the end..., no bits 2-7
+
+ my $bit = Games::Neverhood::Video::BitStream->new($fh);
+
+ $self->{HuffmanTrees}{MMap} = Games::Neverhood::Video::Huffman::BigTree->new($bit);
+ $self->{HuffmanTrees}{MClr} = Games::Neverhood::Video::Huffman::BigTree->new($bit);
+ $self->{HuffmanTrees}{Full} = Games::Neverhood::Video::Huffman::BigTree->new($bit);
+ $self->{HuffmanTrees}{Type} = Games::Neverhood::Video::Huffman::BigTree->new($bit);
+
+ $self->{bit} = $bit;
+
+ $self;
+}
+
+use constant palmap => [
+ 0x00, 0x04, 0x08, 0x0C, 0x10, 0x14, 0x18, 0x1C,
+ 0x20, 0x24, 0x28, 0x2C, 0x30, 0x34, 0x38, 0x3C,
+ 0x41, 0x45, 0x49, 0x4D, 0x51, 0x55, 0x59, 0x5D,
+ 0x61, 0x65, 0x69, 0x6D, 0x71, 0x75, 0x79, 0x7D,
+ 0x82, 0x86, 0x8A, 0x8E, 0x92, 0x96, 0x9A, 0x9E,
+ 0xA2, 0xA6, 0xAA, 0xAE, 0xB2, 0xB6, 0xBA, 0xBE,
+ 0xC3, 0xC7, 0xCB, 0xCF, 0xD3, 0xD7, 0xDB, 0xDF,
+ 0xE3, 0xE7, 0xEB, 0xEF, 0xF3, 0xF7, 0xFB, 0xFF
+];
+
+sub next_frame {
+ my ($self) = @_;
+ my $bit = $self->{bit};
+
+ my $frame_type = shift @{$self->{FrameTypes}};
+ my $frame_size = shift @{$self->{FrameSizes}};
+
+ if($frame_type & 1) { # palette
+ # // System.Console.WriteLine("Updating palette");
+ # var s = this.file.stream;
+ my $old_pal = $self->{pal};
+ $self->{pal} = [];
+ my $size = $bit->read_8;
+ $size = $size * 4 - 1;
+
+ $frame_size -= $size + 1;
+ my $sz = 0;
+ # var pos = s.position + size;
+ my $pal_index = 0;
+ while($sz < 256) {
+ my $t = $bit->read_8;
+ if($t & 0x80) {
+ # /* skip palette entries */
+ $sz += ($t & 0x7F) + 1;
+ for(my $i = 0; $i < ($t & 0x7F) + 1 && $sz < 256; $i++) {
+ $self->{pal}[$pal_index++] = [0, 0, 0];
+ }
+ }
+ elsif($t & 0x40 != 0) {
+ # /* copy with offset */
+ my $off = $bit->read_8;
+ my $j = ($t & 0x3F) + 1;
+ while($j-- != 0 && $sz < 256) {
+ $self->{pal}[$pal_index++] = oldPallette[off];
+ $sz++;
+ $off++;
+ }
+ }
+ else {
+ # /* new entries */
+ $self->{pal}[$pal_index++] = [palmap->[t], palmap->[$bit->read_8 & 0x3F], palmap->[$bit->read_8 & 0x3F]];
+ $sz++;
+ }
+ }
+ # s.seek(pos, "begin");
+ }
+
+ if($frame_type & 2 ) { # audio
+
+ }
+
+ # video
+}
+
+###############################################################################
+### Accessors
+
+sub file { $_[0]->{file} }
+sub next { $_[0]->{next} }
+sub no_skip { $_[0]->{no_skip} }
+sub pos { $_[0]->{pos} }
+# sub pos {
+ # if(@_ > 1) { $_[0]->{pos} = $_[1]; return $_[0]; }
+ # $_[0]->{pos};
+# }
+sub on_set {
+ my $self = shift;
+ $self->{on_set}->(@_) if $self->{on_set};
+}
+sub on_unset {
+ my $self = shift;
+ $self->{on_unset}->(@_) if $self->{on_unset};
+}
+
+for(<share/video/t>) {
+ for(<$_/ID_40494081-FF.smk>) {
+ s~share/video/~~;
+ my $n = $_;
+ my $game = Games::Neverhood::Video->new(
+ file => [$_],
+ );
+ # print join " ", @{$game->{Header}}{qw/TreesSize MMapSize MClrSize FullSize TypeSize/};
+ }
+}
+
+# my $game = Games::Neverhood::Video->new(
+ # path => ['c', 'ID_018C0407-FF.smk'],
+ # next => 'Scene::Shack';
+ # no_skip => 1,
+ # pos => [20, 40],
+ # on_set => sub { $Game->no_skip(0) if $GG{did_this} },
+ # on_unset => sub { $GG{did_this} = 1; },
+# );
+
+1;
View
85 lib/Games/Neverhood/Video/BitStream.pm
@@ -0,0 +1,85 @@
+package Games::Neverhood::Video::BitStream;
+use 5.01;
+use strict;
+use warnings;
+
+use constant CHUNK_SIZE => 512;
+
+sub new {
+ my ($class, $fh) = @_;
+ bless {
+ fh => $fh,
+ byte_off => CHUNK_SIZE,
+ bit_off => 8,
+ }, ref $class || $class;
+}
+
+sub read_1 {
+ my ($self) = @_;
+ if($self->{bit_off} >= 8) {
+ $self->{bit_off} = 0;
+ $self->{byte_off}++;
+ if($self->{byte_off} >= CHUNK_SIZE) {
+ read $self->{fh}, $self->{buf}, CHUNK_SIZE;
+ $self->{byte_off} = 0;
+ }
+ $self->{cur} = ord substr $self->{buf}, $self->{byte_off}, 1;
+ }
+ return $self->{cur} >> $self->{bit_off}++ & 1;
+}
+
+sub read_8 {
+ my ($self) = @_;
+ if($self->{bit_off} >= 8) {
+ if(++$self->{byte_off} >= CHUNK_SIZE) {
+ read $self->{fh}, $self->{buf}, CHUNK_SIZE;
+ $self->{byte_off} = 0;
+ }
+ return ord substr $self->{buf}, $self->{byte_off}, 1;
+ }
+ my $ret = $self->{cur} >> $self->{bit_off};
+ if(++$self->{byte_off} >= CHUNK_SIZE) {
+ read $self->{fh}, $self->{buf}, CHUNK_SIZE;
+ $self->{byte_off} = 0;
+ }
+ $self->{cur} = ord substr $self->{buf}, $self->{byte_off}, 1;
+ return $ret | $self->{cur} << 8 - $self->{bit_off} & 0xFF;
+}
+
+sub read_16 {
+ my ($self) = @_;
+ my $ret;
+ if($self->{bit_off} >= 8) {
+ if(++$self->{byte_off} >= CHUNK_SIZE) {
+ read $self->{fh}, $self->{buf}, CHUNK_SIZE;
+ $self->{byte_off} = 0;
+ }
+ $ret = ord substr $self->{buf}, $self->{byte_off}, 1;
+ if(++$self->{byte_off} >= CHUNK_SIZE) {
+ read $self->{fh}, $self->{buf}, CHUNK_SIZE;
+ $self->{byte_off} = 0;
+ }
+ return $ret | ord(substr $self->{buf}, $self->{byte_off}, 1) << 8;
+ }
+ $ret = $self->{cur} >> $self->{bit_off};
+ if(++$self->{byte_off} >= CHUNK_SIZE) {
+ read $self->{fh}, $self->{buf}, CHUNK_SIZE;
+ $self->{byte_off} = 0;
+ }
+ $ret |= ord(substr $self->{buf}, $self->{byte_off}) << 8 - $self->{bit_off};
+ if(++$self->{byte_off} >= CHUNK_SIZE) {
+ read $self->{fh}, $self->{buf}, CHUNK_SIZE;
+ $self->{byte_off} = 0;
+ }
+ $self->{cur} = ord substr $self->{buf}, $self->{byte_off}, 1;
+ $ret | $self->{cur} << 16 - $self->{bit_off} & 0xFFFF;
+}
+
+sub reset {
+ my ($self) = @_;
+ $self->{byte_off} = -1;
+ $self->{bit_off} = 8;
+
+}
+
+1;
View
94 lib/Games/Neverhood/Video/Huffman/BigTree.pm
@@ -0,0 +1,94 @@
+package Games::Neverhood::Video::Huffman::BigTree;
+use 5.01;
+use strict;
+use warnings;
+
+use Games::Neverhood::Video::BitStream;
+use Games::Neverhood::Video::Huffman::Tree;
+
+sub new {
+ my ($class, $bit) = @_;
+ my $self = bless {}, ref $class || $class;
+
+ # warn ('skipping bigtree'),
+ return $self unless $bit->read_1;
+
+ $self->{low_byte_tree} = Games::Neverhood::Video::Huffman::Tree->new($bit);
+ $self->{high_byte_tree} = Games::Neverhood::Video::Huffman::Tree->new($bit);
+
+ $self->{marker_1} = $bit->read_16;
+ $self->{marker_2} = $bit->read_16;
+ $self->{marker_3} = $bit->read_16;
+
+ $self->{marker_1_node} = [];
+ $self->{marker_2_node} = [];
+ $self->{marker_3_node} = [];
+
+ $self->build_tree_recurse($bit, $self->{tree} = []);
+
+ $bit->read_1;
+
+ $self;
+}
+
+sub build_tree_recurse {
+ my ($self, $bit, $node) = @_;
+ if($bit->read_1) {
+ $self->build_tree_recurse($bit, $node->[0] = []);
+ }
+ else {
+ warn 'what going on' if @$node;
+ my $leaf = $self->{low_byte_tree}->decode($bit) | $self->{high_byte_tree}->decode($bit) << 8;
+ if($leaf == $self->{marker_1}) {
+ $self->{marker_1_node} = $node;
+ $leaf = 0;
+ }
+ if($leaf == $self->{marker_2}) {
+ $self->{marker_2_node} = $node;
+ $leaf = 0;
+ }
+ if($leaf == $self->{marker_3}) {
+ $self->{marker_3_node} = $node;
+ $leaf = 0;
+ }
+ $node->[0] = $leaf;
+ return;
+ }
+ $self->build_tree_recurse($bit, $node->[1] = []);
+}
+
+sub decode {
+ my ($self, $bit) = @_;
+ my $node = $self->{tree};
+ unless($node) {
+ # warn 'trying to read from nonononono bigtree';
+ return 0;
+ }
+ while(@$node > 1) {
+ $node = $node->[$bit->read_1];
+ }
+ my $val = $node->[0];
+ if($val != $self->{marker_1}) {
+ $self->{marker_3} = $self->{marker_2};
+ $self->{marker_2} = $self->{marker_1};
+ $self->{marker_1} = $val;
+
+ $self->{marker_3_node}[0] = $self->{marker_2_node}->[0];
+ $self->{marker_2_node}[0] = $self->{marker_1_node}->[0];
+ $self->{marker_1_node}[0] = $val;
+ }
+ return $val;
+}
+
+sub reset {
+ my ($self) = @_;
+ $self->{marker_1} = 0;
+ $self->{marker_2} = 0;
+ $self->{marker_3} = 0;
+
+ $self->{marker_1_node}[0] = 0;
+ $self->{marker_1_node}[1] = 0;
+ $self->{marker_1_node}[2] = 0;
+}
+
+1;
View
48 lib/Games/Neverhood/Video/Huffman/Tree.pm
@@ -0,0 +1,48 @@
+package Games::Neverhood::Video::Huffman::Tree;
+use 5.01;
+use strict;
+use warnings;
+
+use Games::Neverhood::Video::BitStream;
+
+sub new {
+ my ($class, $bit) = @_;
+ my $self = bless {}, ref $class || $class;
+
+ # warn ('skipping tree'),
+ return $self unless $bit->read_1;
+
+ $self->build_tree_recurse($bit, $self->{tree} = []);
+
+ $bit->read_1;
+
+ $self;
+}
+
+sub build_tree_recurse {
+ my ($self, $bit, $node) = @_;
+ if($bit->read_1) {
+ $self->build_tree_recurse($bit, $node->[0] = []);
+ }
+ else {
+ warn 'what going on' if @$node;
+ $node->[0] = $bit->read_8;
+ return;
+ }
+ $self->build_tree_recurse($bit, $node->[1] = []);
+}
+
+sub decode {
+ my ($self, $bit) = @_;
+ my $node = $self->{tree};
+ unless($node) {
+ # warn 'trying to read from nonononono tree';
+ return 0;
+ }
+ while(@$node > 1) {
+ $node = $node->[$bit->read_1];
+ }
+ return $node->[0];
+}
+
+1;
View
BIN  share/cursor/click.png
Deleted file not rendered
View
BIN  share/cursor/click/0.png
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
View
BIN  share/cursor/click/1.png
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
View
BIN  share/cursor/forward.png
Deleted file not rendered
View
BIN  share/cursor/left.png
Deleted file not rendered
View
BIN  share/cursor/right.png
Deleted file not rendered
View
BIN  share/icon.bmp
Binary file not shown
View
BIN  share/klaymen/idle.png
Deleted file not rendered
View
BIN  share/klaymen/idle_push_button_back.png
Deleted file not rendered
View
BIN  share/klaymen/idle_random_0.png
Deleted file not rendered
View
BIN  share/klaymen/idle_random_1.png
Deleted file not rendered
View
BIN  share/klaymen/idle_random_2.png
Deleted file not rendered
View
BIN  share/klaymen/idle_random_3.png
Deleted file not rendered
View
BIN  share/klaymen/idle_random_4.png
Deleted file not rendered
View
BIN  share/klaymen/idle_shuffle.png
Deleted file not rendered
View
BIN  share/klaymen/idle_shuffle_end.png
Deleted file not rendered
View
BIN  share/klaymen/idle_slide.png
Deleted file not rendered
View
BIN  share/klaymen/idle_slide_end.png
Deleted file not rendered
View
BIN  share/klaymen/idle_think.png
Deleted file not rendered
View
BIN  share/klaymen/idle_walk.png
Deleted file not rendered
View
BIN  share/klaymen/idle_walk_end.png
Deleted file not rendered
View
BIN  share/klaymen/idle_walk_start.png
Deleted file not rendered
View
BIN  share/klaymen/pull_lever.png
Deleted file not rendered
View
BIN  share/klaymen/snore.png
Deleted file not rendered
View
BIN  share/klaymen/wake.png
Deleted file not rendered
View
BIN  share/misc/nhc.ico
Binary file not shown
View
BIN  share/misc/nhc.png
Deleted file not rendered
View
BIN  share/nursery/one/background.png
Diff not rendered
View
BIN  share/nursery/one/button.png
Diff not rendered
View
BIN  share/nursery/one/door.png
Diff not rendered
View
BIN  share/nursery/one/foreground.png
Diff not rendered
View
BIN  share/nursery/one/hammer.png
Diff not rendered
View
BIN  share/nursery/one/lever.png
Diff not rendered
View
BIN  share/nursery/one/out_window.png
Diff not rendered
View
BIN  share/nursery/one/window.png
Diff not rendered
View
25 t/00-load.t
@@ -1,16 +1,33 @@
+use 5.01;
use strict;
use warnings;
no warnings 'once';
use Test::More;
-use_ok('Games::Neverhood');
+use_ok(qw/
+ Games::Neverhood
+ Games::Neverhood::DualVar
+ Games::Neverhood::Game
+ Games::Neverhood::OrderedHash
+ Games::Neverhood::OrderedHash::TiedArray
+ Games::Neverhood::OrderedHash::TiedHash
+ Games::Neverhood::Scene
+ Games::Neverhood::Scene::Nursery::One
+ Games::Neverhood::Scene::Nursery::One::OutWindow
+ Games::Neverhood::Sprite
+ Games::Neverhood::Sprite::Cursor
+ Games::Neverhood::Sprite::Klaymen
+ Games::Neverhood::Video
+ Games::Neverhood::Video::BitStream
+ Games::Neverhood::Video::HuffmanTree
+/);
$Games::Neverhood::Fullscreen = 0;
-eval { Games::Neverhood::init(); };
-ok(!$@, 'Games::Neverhood::init();');
+eval { Games::Neverhood::init() };
+ok( !$@, 'Games::Neverhood::init()' );
-isnt($Games::Neverhood::Folder, undef, 'Have a sharedir');
+isnt( $Games::Neverhood::ShareDir, undef, 'Have a share dir' );
diag( "Testing Games::Neverhood $Games::Neverhood::VERSION, Perl $], $^X" );
View
52 t/dualvar.t
@@ -1,52 +0,0 @@
-use strict;
-use warnings;
-use Test::More;
-use Games::Neverhood::DualVar;
-
-my $var = Games::Neverhood::DualVar->new;
-ok($var == 0, 'default to 0');
-ok($var eq '', "default to ''");
-
-$var->set(1, 'foo');
-ok($var == 1, 'numeric works');
-ok($var eq 'foo', 'stringeric works');
-ok(!($var cmp 'foo'), 'cmp works');
-
-$var += 2;
-ok($var == 3, '+= works');
-ok(!($var - 3), '- and ! work');
-ok($var & 3 == 3, '& works');
-$var -= 3;
-ok(!(cos($var) <=> 1), 'cos and <=> work');
-$var -= 3;
-ok(abs($var) == 3, 'abs works');
-ok(-$var == 3, 'neg works');
-ok($var++ == -2, 'post-increment');
-ok($var == -2, 'post-increment works');
-ok(++$var == -1, 'pre-increment works');
-$var->set(3);
-ok($var == 3 && $var eq 'foo', 'set really works');
-$var &= 2;
-ok($var == 2, '&= works');
-
-$var .= 'bar';
-ok($var eq 'foobar', '.= works');
-ok($var . 'g' eq 'foobarg', '. works');
-ok($var x 2 eq 'foobar' x 2, 'x works');
-
-$var->set(1, '');
-if($var and !"$var") { pass 'bool and set work' }
-else { fail 'bool and set work' }
-
-ok(!eval {$var->set('e')}, 'illegal number');
-ok(!eval {$var->set(\1)}, 'illegal number');
-ok(!eval {$var->set(undef, \1)}, 'illegal string');
-ok(!eval {$var->set(0, '', 'dfg')}, 'illegal extra argument');
-
-$var->set(3, 'foo');
-$var->set;
-ok($var == 3 && $var eq 'foo', 'no change with not exists');
-$var->set(undef, undef);
-ok($var == 3 && $var eq 'foo', 'no change with undefs');
-
-done_testing;
View
15 t/orderedhash.t
@@ -7,8 +7,8 @@ use Games::Neverhood::OrderedHash;
ok(my $ref = Games::Neverhood::OrderedHash->new, 'new');
isa_ok($ref, 'Games::Neverhood::OrderedHash');
-isa_ok(tied %{;do{no overloading; $ref->[0]}}, 'Games::Neverhood::OrderedHash::TiedHash');
-isa_ok(tied @{;do{no overloading; $ref->[1]}}, 'Games::Neverhood::OrderedHash::TiedArray');
+isa_ok(tied %{;no overloading; $ref->[0]}, 'Games::Neverhood::OrderedHash::TiedHash');
+isa_ok(tied @{;no overloading; $ref->[1]}, 'Games::Neverhood::OrderedHash::TiedArray');
ok(!eval { untie %$ref }, '!untie %');
ok(!eval { untie @$ref }, '!untie @');
@@ -65,11 +65,13 @@ ok(!eval { $ref->[-4] = 0 }, "!index past start of array");
ok(