Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

HollyGame gamekit (almost @ CPAN)

by holyghost (Sexton)
on Oct 15, 2017 at 08:22 UTC ( #1201388=CUFP: print w/replies, xml ) Need Help??

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); }

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; } } }

Replies are listed 'Best First'.
Re: HollyGame gamekit (almost @ CPAN)
by soonix (Monsignor) on Oct 15, 2017 at 09:11 UTC
    Obviously you didn't test before posting. There are syntax errors (missing curlies in your if-statements, see "Compound Statements" in perldoc perlsyn), and you are still using the nonsensical assigning-shift-to-a-list (see my previous comment about that). Please read perldoc shift again.

    I admit having posted untested code myself occasionally, but the section "cool uses" would imply to me, that you did use it, which would already be an (albeit very rudimentary) test.

    And finally, I want to join in the general chorus "use strict and warnings!!!1!"
Re: HollyGame gamekit (almost @ CPAN)
by kcott (Chancellor) on Oct 16, 2017 at 06:23 UTC

    G'day holyghost,

    In addition to what ++soonix has written, with which I wholeheartedly agree, I would recommend you put modules in separate files, i.e. HollyGame/Box.pm, HollyGame/Enemy.pm, and so on. Add these two lines to the top of each:

    use strict; use warnings;

    Then test each module individually with:

    perl -c Whatever.pm

    That will pick up many of your errors. For instance, in your first subroutine (&Box), you have:

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

    This has many problems. Apart from using four, uninitialised, package variables; $self actually ends up with this value:

    { "" => $_[4] }

    Here's a quick one-liner to give you an idea of what's happening:

    $ perl -e 'use Data::Dump; sub Box { my $self = { $x => shift, $y => s +hift }; dd $self } Box(qw{a b c})' { "" => "b" }

    In the second subroutine (&is_collision) you reference "$self->{x}", "$self->{y}", and so on: those keys don't exist! However, that issue is eclipsed by the syntax errors with the if statements (already pointed out by soonix).

    There's lots of other problems. For instance, you create blessed references which then appear to be silently discarded; there appears to be no encapsulation (no accessors or mutators; $self->{KEY} is used throughout); and a number of use MODULE statements appear at the end of a package but seem to be associated with the next package. I pretty much stopped looking at this point: do not consider this to be an exhaustive list.

    Perhaps you need to review "perlootut - Object-Oriented Programming in Perl Tutorial"; and consider using one of the "OO Sytems" discussed in that documentation.

    — Ken

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

      This has many problems. Apart from using four, uninitialised, package variables; $self actually ends up with this value:

      { "" => $_[4] }

      Well seen, kcott++. I really read

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

      instead.

      Another thing with this line - original or as misread by me - is order of evaluation. I don't know by heart if Perl guarantees left-to-right order in this case. I can't find a reason why it should not, and if I could get my brain out of stand-by mode, I would probably compare with %hash=( %oldhash, 'this' => 'overwrites', 'anything' => 'found', 'in' => '%oldhash' ); and consider this harmless.

      But the point is: I have to think about it. Maybe I have to RTFM. And apart from that, it is not elegant at all.

      In our code review system, I would mark this line as "bad style, probably wrong", and it would have to be changed (or explained by some comments). I would not spend more time considering if it is really wrong. It is sufficient that it is not clearly right.

      Our review system uses peer review, i.e. one developer reads the code of another developer, and the roles of coder and reviewer are swapped quite often. Understanding data flow and algorithms used is hard enough, and finding errors in there is even harder. Errors in our code can have the potential to hurt or - in the worst case - kill people, and so we want clean code.

      That does not mean that we can't use some tricks in our code. But if we do, those tricks are commented to explain what happens. Tricks are quite rare, because our target hardware usually has some spare CPU cycles and some spare memory. So instead of using tricks, we prefer code that wastes a little bit of memory and / or CPU, but is easier to read.

      Yes, I'm aware that games rarely kill real people, but code that is clean and easy to read makes it harder to accidentally hide bugs.

      Alexander

      --
      Today I will gladly share my knowledge and experience, for there are no sweeter words than "I told you so". ;-)

        G'day Alexander,

        "Another thing is order of evaluation. I don't know by heart if Perl guarantees left-to-right order in this case. I can't find a reason why it should not, ... I would probably compare with %hash=( %oldhash, ...) and consider this harmless."

        The thing with "%hash = (%default, %overwrite)" is that, given hashes have no inherent order, it could evaluated in various orders like these (additional parentheses added to highlight the contents of the two hashes).

        %hash = ( (a => 1, b => 2), (a => 101, b => 102) ); %hash = ( (a => 1, b => 2), (b => 102, a => 101) ); %hash = ( (b => 2, a => 1), (a => 101, b => 102) ); %hash = ( (b => 2, a => 1), (b => 102, a => 101) );

        However, regardless of whatever random order %default and %overwrite present themselves in, the key-value pairs of the two hashes won't become intermixed. For example, this evaluation won't occur:

        %hash = ( a => 102, b => 2, a => 1, b => 102 );

        Right at the end of "perldata: List value constructors" there's:

        "If a key appears more than once in the initializer list of a hash, the last occurrence wins: ..."

        So, $_[4] would have been the sole value in the %$self hash.

        Anyway, that's all rather academic. The sigils on the keys would have been picked up by strict. A na´ve fix to declare those variables beforehand would have ended up with "uninitialized value" warnings. And anyway, as you say, it's very bad style to start with: unpacking @_ with five separate shift operations mixed in with other code is pretty much asking for a hard-to-find bug in the future.

        I probably would not have written the code like this at all; however, working with what's there, I would have had &Box called more like "Box($class, $args)", where $args was a hashref with the "x y w h" keys. Alternatively, if stuck with a bad but published interface, I might have changed the implementation to, perhaps, something like:

        my $class = shift; my $self = {}; @$self{qw{x y w h}} = @_; bless $self, $class;

        — Ken

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://1201388]
Approved by beech
help
Chatterbox?
and the monks are chillaxin'...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (6)
As of 2017-11-19 13:10 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    In order to be able to say "I know Perl", you must have:













    Results (281 votes). Check out past polls.

    Notices?