HollyGame gamekit (almost @ CPAN)

This is the first implmentation of HollyGame, it is a framework underneath e.g. SDL 1.2 in my code or or buildable with SDL 1.2 or cairo 1.2 or 2.x. If I debug it, it will try to host it on CPAN

### Copyright (C) The Holy Ghost 2017
###This program is released under the GPL 3.0 and artistic license 2.0
+.

package HollyGame::Box; 

sub Box {
    my ($class) = shift;

    my $self = { $x => shift, $y => shift, $w => shift, $h => shift };

    return bless $self, $class;
}

sub is_collision {
    my ($self, $box) = shift;

    if ($box->{x} < $self->{x})
        return 0;
    if ($box->{x} + $box->{w} > $self->{x} + $self->{w})
        return 0;
    
    if ($box->{y} < $self->{y})
        return 0;
    if ($box->{y} + $box->{h} > $self->{y} + $self->{h})
        return 0;

    return 1;
}
    
### Copyright (C) The Holy Ghost 2017
###This program is released under the GPL 3.0 and artistic license 2.0
+.

package HollyGame::Enemy;

our @ISA = "HollyGame::Sprite";

sub Enemy {
    my $class = shift;

    my $self = {};
    bless $self, class;  
    $self = $self->SUPER::Sprite(shift,shift,shift,shift);

    ### fill it with subclass
    my $self->{$box => Box->new{$x,$y,$w,$h}};
    my $self->{$imagelibrary => ImageLibrary->new};
    my $self->{$app} = shift;

    return $self;
}

sub draw {
    my $self = shift;
    ### subclass responsability
}    

sub update {
    my $self = shift;
    ### subclass responsability
}
### Copyright (C) The Holy Ghost 2017
###This program is released under the GPL 3.0 and artistic license 2.0
+.

package HollyGame::Exit; 

our @ISA = "HollyGame::Box";

sub Exit {
    my ($class) = shift;
    my $self = {};
    bless $self, $class;

    $self = $self->SUPER::Box{shift,shift,shift,shift};

    return bless $self, $class;
}


### Copyright (C) The Holy Ghost 2017
###This program is released under the GPL 3.0 and artistic license 2.0
+.

package HollyGame::Game;

sub Game {
    my $class = shift;

    my $self = { $room = shift; $app => shift };
    bless $self, $class;

    if (defined($app)) {
        $self->set_SDL_App($app);
    }

}

sub set_SDL_app {
    my ($self, $app) = shift;

    $self->{$app} = shift;
}

sub gameloop {
    my ($self) = shift;
    ### subclass responsability
}
### Copyright (C) The Holy Ghost 2017
###This program is released under the GPL 3.0 and artistic license 2.0
+.

use SDL;
###use SDL::TTFont;
use SDL::Surface;
use SDL::Rect;
use SDLx::App;

package HollyGame::GameExample;

our @ISA = "HollyGame::Game";

sub GameExample {
    my $class = shift;
    my $self = {};
    bless $self, $class;

    my $app = new SDLx::App(             -title => "Perl Game",
                        ###-icon => "",
                        -width => 800, 
                        -height => 600);
    $self = $self->SUPER::Game(shift,$app);
    $self->{screenrect} = new SDL::Rect -width => 800, -height => 600;
    $self->{font} = new SDL::TTFont ( -proto => $proto, 
                -name => "Times New Roman",
                -size => 12 ); 

    $self->{room} = MapRoomExample->MapRoomExample;    
    $self->{player} = PlayerExample->PlayerExample;    
}

sub gameloop {
    my ($self) = shift;
    ### subclass responsability

    my $gameover = 0;

    while (!$gameover) {
        $event = SDL::Event->new();

        $event->wait();
    
        if ($event->type() == SDL_KEYDOWN) {
            if ($event->key_sym == SDLK_ESCAPE) {
                $gameover = 1;
            }    
            if ($event->key_sym == SDLK_LEFT) {

            }    
            if ($event->key_sym == SDLK_RIGHT) {

            }    
            if ($event->key_sym == SDLK_UP) {

            }    
            if ($event->key_sym == SDLK_DOWN) {

            }
            $self->{room}->update();
            $self->{room}->draw();
            $self->{app}->flip;
            
        }
}
}
### Copyright (C) The Holy Ghost 2017
###This program is released under the GPL 3.0 and artistic license 2.0
+.

use SDL;
use SDL::Surface;

package HollyGame::Image;
our @ISA = "SDL::Surface";

sub new {
    my ($class) = @_;
    my $self = {-name => shift, @_ };

    bless ($self, $class);
    return $self;
}

1;    
### Copyright (C) The Holy Ghost 2017
###This program is released under the GPL 3.0 and artistic license 2.0
+.


package HollyGame::ImageHandle;

sub new {
    my ($class) = @_;
    my $self = { $image => shift, @_ };

    bless ($self, $class);
}

sub get {
    return $image;
}

sub set {
    my ($self, $image) = shift;

    $self->{$image} = $image;
}

1;    
### Copyright (C) The Holy Ghost 2017
###This program is released under the GPL 3.0 and artistic license 2.0
+.


package HollyGame::ImageLibrary;

sub ImageLibrary {
    my ($class) = @_;
    my $self = { stack => (), ptrh => 0, index => -1, @_ };

    bless ($self, $class);
}


sub push {
    my ($self, $element) = @_;
    push ($self->{stack}, $element);    
    $self->{ptrh}++;
    return 0;
}

sub pop {
    my ($self) = shift;
    return $self->{stack}[$self->{ptrh}--];    
}

sub index {
    my ($self, $idx) = shift;

    return $self->{stack}[$idx];    
}

sub get {
    my ($self) = shift;

    if ($index >= length($self->{stack})) {
        $index = 0;
    }
    
    return $self->{stack}[$index++];
}

1;    
### Copyright (C) The Holy Ghost 2017
###This program is released under the GPL 3.0 and artistic license 2.0
+.

package HollyGame::MapRoom;

our @ISA = "HollyGame::Room";

sub MapRoom {
    my $class = shift;
    my $self = {};
    bless $self, $class;

    $self = $self->SUPER::Room;
    $self->{@exits} = ();

    return bless $self, $class;
}

sub add_exit {
    my ($self, $exit) = shift;

    push (@exits, $exit);
}

sub collide_exit {
    my ($self, $box) = shift;

    return $box->is_collision($self);
}
    
}    
### Copyright (C) The Holy Ghost 2017
###This program is released under the GPL 3.0 and artistic license 2.0
+.

package HollyGame::MapRoomExample;

our @ISA = "HollyGame::MapRoom";

sub MapRoom {
    my $class = shift;
    my $self = {};
    bless $self, $class;

    $self = $self->SUPER::MapRoom;
    $self->{@exits} = ();

    return bless $self, $class;
}

### Copyright (C) The Holy Ghost 2017
###This program is released under the GPL 3.0 and artistic license 2.0
+.

package HollyGame::Player;

sub Player {
    my ($class,$x,$y,w,$h) = shift;

    ### fill it with subclass
    my $self = { $box => Box->Box{$x,$y,$w,$h}, 
            $dx => 0, $dy = 0, $dxy = 0,
            $leftimagelibrary = ImageLibrary->ImageLibrary; 
            $rightimagelibrary = ImageLibrary->ImageLibrary; 
            $upimagelibrary = ImageLibrary->ImageLibrary; 
            $downimagelibrary = ImageLibrary->ImageLibrary; 
    };
    
    bless $self, $class;
}

sub move {
    my ($class,$ddx,$ddy,$ddxy) = shift;

    $self->{$dx} = $ddx; 
    $self->{$dy} = $ddy; 
    $self->{$dxy} = $ddxy;

    $self->{x} += $self->{dx}; 
    $self->{y} += $self->{dy}; 
}

sub draw {
    my $self = shift;

    ### subclass responsability
}    

sub update {
    my $self = shift;

    ### subclass responsability
}
### Copyright (C) The Holy Ghost 2017
###This program is released under the GPL 3.0 and artistic license 2.0
+.

package HollyGame::PlayerExample;

our @ISA = "HollyGame::Player";

sub PlayerExample {
    my $class = shift;
    my $self = {};
    bless $self, $class;
    my $self = $self->SUPER::Player;
    $self->$app = shift;

    my $image1 = new SDL::Surface(-name=>"./images/player.jpg");
    $self->{imagelibrary}->push{$image1};
    my $image2 = new SDL::Surface(-name=>"./images/player2.jpg");
    $self->{imagelibrary}->push{$image1};
    my $image3 = new SDL::Surface(-name=>"./images/player3.jpg");
    $self->{imagelibrary}->push{$image1};

    return $self;    
}

sub update {
    my $self = shift;
    
}

sub draw {
    my $self = shift;
    my $image = $imagelibrary->get;
    $image->blit($screenrect, $self->{app}, $screenrect);    
}
### Copyright (C) The Holy Ghost 2017
###This program is released under the GPL 3.0 and artistic license 2.0
+.

package HollyGame::Room;

sub Room {
    my $class = shift;

    my $self = { @boxes => (), @sprites => (), @enemies => () };

    return bless $self, $class;
}

sub update {
    my $self = shift;

    foreach my $sprite (@sprites) {
        $sprite->update($self);
    }
    foreach my $enemy (@enemies) {
        $enemy->update($self);
    }
}    

sub draw {
    my $self = shift;

    foreach my $sprite (@sprites) {
        $sprite->draw($self);
    }
    foreach my $enemy (@enemies) {
        $enemy->draw($self);
    }
}


sub add_sprite {
    my ($self, $sprite) = shift;

    push (@sprites, $sprite);
}
    
sub add_enemy {
    my ($self, $enemy) = shift;

    push (@enemies, $enemy);
}
    
### Copyright (C) The Holy Ghost 2017
###This program is released under the GPL 3.0 and artistic license 2.0
+.

package HollyGame::Sprite;

sub Sprite {
    my ($class,$x,$y,w,$h) = shift;

    ### fill it with subclass
    my $self = { $box => Box->Box{$x,$y,$w,$h}, $imagelibrary = ImageL
+ibrary->new };

    bless $self, $class;
}

sub draw {
    my $self = shift;

    ### subclass responsability
}    

sub update {
    my $self = shift;

    ### subclass responsability
}
### Copyright (C) The Holy Ghost 2017
###This program is released under the GPL 3.0 and artistic license 2.0
+.

package HollyGame::SpriteExample;

our @ISA = "HollyGame::Sprite";

sub SpriteExample {
    my $class = shift;
    my $self = {};
    bless $self, $class;
    my $self = $self->SUPER::Sprite(shift,shift,shift,shift);
    $self->$app = shift;

    my $image1 = new SDL::Surface(-name=>"./images/larrysprite1.jpg");
    $self->{imagelibrary}->push{$image1};
    my $image2 = new SDL::Surface(-name=>"./images/larrysprite2.jpg");
    $self->{imagelibrary}->push{$image1};
    my $image3 = new SDL::Surface(-name=>"./images/larrysprite3.jpg");
    $self->{imagelibrary}->push{$image1};
    $self->{screenrect} = new SDL::Rect -width => $self->{box}->{w}, -
+height => $self->{box}->{h};

    return $self;    
}

sub update {
    my $self = shift;
    
    $self->{x}++;
}

sub draw {
    my ($self) = shift;
    my $image = $imagelibrary->get;
    $image->blit($screenrect, $self->{app}, $screenrect);    
}
[download]

Now follows an implementation of the game Wycadia based on the above code :

### Copyright (C) The Holy Ghost 2017
###This program is released under the GPL 3.0 and artistic license 2.0
+.

use lib "../../HollyGame";
use Sprite; 

package Wycadia::Aldhebrand;

our @ISA = "HollyGame::Player";

sub Aldhebrand {
    my $class = shift;
    my $self = {};
    bless $self, $class;
    my $self = $self->SUPER::Player;
    $self->$app = shift;

    my $image1 = new SDL::Surface(-name=>"./images/player.jpg");
    $self->{leftimagelibrary}->push{$image1};
    my $image2 = new SDL::Surface(-name=>"./images/player2.jpg");
    $self->{rightimagelibrary}->push{$image2};
    my $image3 = new SDL::Surface(-name=>"./images/player3.jpg");
    $self->{upimagelibrary}->push{$image3};
    my $image4 = new SDL::Surface(-name=>"./images/player3.jpg");
    $self->{downimagelibrary}->push{$image4};

    return $self;    
}

sub update {
    my $self = shift;
    
}

sub draw {
    my $self = shift;
    my $image = $imagelibrary->get;
    $image->blit($screenrect, $self->{app}, $screenrect);    
}
### Copyright (C) The Holy Ghost 2017
###This program is released under the GPL 3.0 and artistic license 2.0
+.

use lib "../../HollyGame";
use Sprite; 

package Wycadia::ButterflySprite;

our @ISA = "Sprite";

sub ButterflySprite {
    my $class = shift;
    my $self = {};
    bless $self, $class;
    my $self = $self->SUPER::Sprite(shift,shift,shift,shift);
    $self->$app = shift;

    my $image1 = new SDL::Surface(-name=>"./images/butterflysprite1.pn
+g");
    $self->{imagelibrary}->push{$image1};
    my $image2 = new SDL::Surface(-name=>"./images/butterflysprite2.pn
+g");
    $self->{imagelibrary}->push{$image1};
    $self->{screenrect} = new SDL::Rect -width => $self->{box}->{w}, -
+height => $self->{box}->{h};

    return $self;    
}

sub update {
    my $self = shift;
        
    $self->{x}++;
}

sub draw {
    my $self = shift;
    my $image = $imagelibrary->get;
    $image->blit($self->{screenrect}, $self->{app}, $self->{screenrect
+});    
}
### Copyright (C) The Holy Ghost 2017
###This program is released under the GPL 3.0 and artistic license 2.0
+.

use lib "../../HollyGame";
use Maproom; 

package Wycadia::MapRoom;

our @ISA = "MapRoom";

sub MapRoom {
    my $class = shift;
    my $self = {};
    bless $self, $class;

    $self = $self->SUPER::MapRoom;
    $self->{exits} = ();
    my $self->{app} = shift;
    $self->{background} = new SDL::Surface(-name=>"./images/morningglo
+ry-800x600-1.jpg");

    push ($self->{sprites}, ButterFlySprite($self->{app}));

    return bless $self, $class;
}

sub draw {
    my ($self, $app) = shift;
    $self->{background}->blit($screenrect, $app, $screenrect);    

    $self->SUPER::draw;
}

### Copyright (C) The Holy Ghost 2017
###This program is released under the GPL 3.0 and artistic license 2.0
+.

use SDL;
###use SDL::TTFont;
use SDL::Surface;
use SDL::Rect;
use SDLx::App;

use lib "../../HollyGame";
use Game; 

package Wycadia::WycadiaGame;

our @ISA = "Game";

sub Game {
    my $class = shift;
    my $self = {};
    bless $self, $class;

    my $app = new SDLx::App(             -title => "Perl Game",
                        ###-icon => "",
                        -width => 800, 
                        -height => 600);
    $self = $self->SUPER::Game(shift,$app);
    $self->{screenrect} = new SDL::Rect -width => 800, -height => 600;
    $self->{room} = MapRoomMorningGlory->MapRoomMorningGlory($app);   
+ 
    $self->{Aldhebrand} = Aldhebrand->Aldhebrand($app);    
    $self->{font} = new SDL::TTFont ( -proto => $proto, 
                -name => "Times New Roman",
                -size => 12 ); 
}

sub gameloop {
    my ($self) = shift;
    ### subclass responsability

    my $gameover = 0;

    while (!$gameover) {
        $event = SDL::Event->new();

        $event->wait();
    
        if ($event->type() == SDL_KEYDOWN) {
            if ($event->key_sym == SDLK_ESCAPE) {
                $gameover = 1;
            }    
            if ($event->key_sym == SDLK_LEFT) {
                $self->{Aldhebrand}->move(-1,0,0);
            }    
            if ($event->key_sym == SDLK_RIGHT) {
                $self->{Aldhebrand}->move(1,0,0);
            }    
            if ($event->key_sym == SDLK_UP) {
                $self->{Aldhebrand}->move(0,-1,0);
            }    
            if ($event->key_sym == SDLK_DOWN) {
                $self->{Aldhebrand}->move(0,1,0);
            }
            $self->{room}->update();
            $self->{room}->draw($self->{app}, $self->{screenrect});
            $self->{app}->flip;
            
        }
    }
}
[download]

Back to Cool Uses for Perl