<?xml version="1.0" encoding="UTF-8"?>
<office:document-content
xmlns:text="urn:oasis:names:tc:opendocument:xmlns:text:1.0"
xmlns:table="urn:oasis:names:tc:opendocument:xmlns:table:1.0"
xmlns:office="urn:oasis:names:tc:opendocument:xmlns:office:1.0"
office:version="1.1">
<office:body>
<office:spreadsheet>
<table:table table:name="Minha Planilha">
<table:table-row>
<table:table-cell>
<text:p>a</text:p>
</table:table-cell>
<table:table-cell>
<text:p>1</text:p>
</table:table-cell>
</table:table-row>
<table:table-row>
<table:table-cell>
<text:p>b</text:p>
</table:table-cell>
<table:table-cell>
<text:p>2</text:p>
</table:table-cell>
</table:table-row>
</table:table>
</office:spreadsheet>
</office:body>
</office:document-content>
In a previous post I have showed how to implement a hack to have transactions and authorization around Catalyst model classes. I am now proud to say that after some uploads and a fix in MooseX::Method::Signatures (this post requires at least version 0.31 of that module), you can now write very elegant model classes.
The requirement is simple, you usually need your model methods to be enclosed in transactions and to be subject to some kind of authorization mechanism. Now the code looks like:
package MyApp::Model::MyModel;
use Moose;
use MooseX::Method::Signatures;
use aliased 'MooseX::Meta::Method::Transactional';
use aliased 'MooseX::Meta::Method::Authorized';
extends 'Catalyst::Model';
with 'Catalyst::Component::InstancePerContext';has user => (is => 'ro');
has schema => (is => 'ro');sub build_per_context_instance {
my ($self, $c) = @_;
return MyApp::Model::MyModel->new
({ user => $c->user, schema => $self->model('DBIC') });
}method get_product_price($product) does Transactional does Authorized(requires => ['customer']) {
return $product->prices->find({ 'me.listing' => "base" });
};method get_product_minprice($product) does Transactional does Authorized(requires => ['seller']) {
return $product->prices->find({ 'me.listing' => "minimum" });
};1;
Of course you also need MooseX::Meta::Method::Transactional, MooseX::Meta::Method::Authorized and Catalyst::Component::InstancePerContext for this code to work. But it certainly is very pretty.
]]>Following
posts 1,
2,
3,
4,
5 and
6 on
the subject of writing games in Perl, now we are going to add support
for maps.
At this moment, the initial ball position, as well as the walls are
being defined in Perl code, during the controller initialization. What
we are going to do now is creating a serialization format that
describes our simulated universe, then have a set of maps in a
directory navigating through them as the goals in each map are
achieved.
There are several options to serialize and deserialize data, some
are easier to use, others provide more introspection and others are
better performant. I've read once a good advice in game development,
which is: keep your map format accessible to art people.
A lot of people hate XML, I'm not of that club, I do like XML a
lot, specially because it allows introspection and validation via XML
Schema. And after the advent of XML::Compile::Schema, it's very simple
to handle XML in Perl. Basically, once you have a XML Schema, you can
think just in Perl data structures that will be
serialized/deserialized from/to XML with associated validation.
That being said, let's proceed to our map format, which is going to
be expressed as a XML Schema Definition:
<?xml version="1.0" encoding="UTF-8"?>
<xs:schema
xmlns:xs="http://www.w3.org/2001/XMLSchema"
targetNamespace="http://daniel.ruoso.com/categoria/perl/games-perl-7"
elementFormDefault="qualified">
<xs:element name="map">
<xs:complexType>
<xs:sequence>
<xs:element name="ball">
<xs:complexType>
<xs:attribute name="radius" type="xs:float" />
<xs:attribute name="x" type="xs:float" />
<xs:attribute name="y" type="xs:float" />
</xs:complexType>
</xs:element>
<xs:element name="goal">
<xs:complexType>
<xs:attribute name="x" type="xs:float" />
<xs:attribute name="y" type="xs:float" />
</xs:complexType>
</xs:element>
<xs:element name="wall" maxOccurs="unbounded">
<xs:complexType>
<xs:attribute name="x" type="xs:float" />
<xs:attribute name="y" type="xs:float" />
<xs:attribute name="w" type="xs:float" />
<xs:attribute name="h" type="xs:float" />
</xs:complexType>
</xs:element>
</xs:sequence>
</xs:complexType>
</xs:element>
</xs:schema>
What the above means is:
In Perl data structures that will mean the following:
The map currently implemented in Perl code would be the following
perl structure:
{ ball => { radius => 0.5,
x => 4,
y => 10 },
goal => { x => 10,
y => 12.5 },
wall => [{ x => 0, y => 0, w => 20, h => 1 },
{ x => 0, y => 0, h => 20, w => 1 },
{ x => 20, y => 0, h => 20, w => 1 },
{ x => 0, y => 20, w => 21, h => 1 },
{ x => 7, y => 0, h => 9, w => 1 },
{ x => 7, y => 11, h => 9, w => 1 },
{ x => 12, y => 0, h => 9, w => 1 },
{ x => 12, y => 11, h => 9, w => 1 },
{ x => 9.2, y => 11, h => 1, 1.6 } ] }
That same structure as XML looks like:
<?xml version="1.0"?>
<map xmlns="http://daniel.ruoso.com/categoria/perl/games-perl-7">
<ball radius="0.5" x="4" y="10"/>
<goal x="10" y="12.5"/>
<wall x="0" y="0" w="20" h="1"/>
<wall x="0" y="0" w="1" h="20"/>
<wall x="20" y="0" w="1" h="20"/>
<wall x="0" y="20" w="21" h="1"/>
<wall x="7" y="0" w="1" h="9"/>
<wall x="7" y="11" w="1" h="9"/>
<wall x="12" y="0" w="1" h="9"/>
<wall x="12" y="11" w="1" h="9"/>
<wall x="9.2" y="11" w="1.6" h="1"/>
</map>
With the advantage that non-Perl-Programmers can edit this map in a
very confortable way. They can even validate the XML outside our game
by using the XML Schema.
We're going to use a "maps" directory where we're going to load the
maps in alphabetical order, so I'm going to save it as
"zz_original_map.xml".
As the various objects were being created in the InGame controller
initialization, we're simply going to replace the hard-coded
initialization for the map-based loading.
The first step, which might happen at compile time, is building the
XML::Compile::Schema closure that will parse the map.
use XML::Compile::Schema;
use XML::Compile::Util qw(pack_type);
use constant MAP_NS => 'http://daniel.ruoso.com/categoria/perl/games-perl-7';
my $s = XML::Compile::Schema->new('schema/map.xsd');
my $r = $s->compile('READER', pack_type(MAP_NS, 'map'),
sloppy_floats => 1);
$r is a code-reference that you call sending the xml document.
We also want to add a new attribute to the controller which will
provide the map name:
has 'mapname' => ( is => 'ro',
isa => 'Str',
required => 1 );
For simplification sake, we're going to just send the name of the
first map in the controller ->new call:
my $controller = InGame->new({ main_surface => $surf,
mapname => 'maps/zz_original_map.xml' });
And the InGame initialization code now looks like:
sub BUILD {
my $self = shift;my $background = Plane->new({ main => $self->main_surface,
color => 0xFFFFFF });my $camera = Camera->new({ pixels_w => $self->main_surface->width,
pixels_h => $self->main_surface->height,
pointing_x => $self->ball->cen_h,
pointing_y => $self->ball->cen_v });my $map = $r->($self->mapname);
# first, let's set the ball position and radius.
$self->ball->cen_h($map->{ball}{x});
$self->ball->cen_v($map->{ball}{y});
$self->ball->radius($map->{ball}{radius});# attach the ball to the camera.
$self->ball->add_rect_moving_listener($camera);# create the ball view
my $ball_view = FilledRect->new({ color => 0x0000FF,
camera => $camera,
main => $self->main_surface,
x => $self->ball->pos_h,
y => $self->ball->pos_v,
w => $self->ball->width,
h => $self->ball->height });
$self->ball->add_rect_moving_listener($ball_view);# now create the goal
$self->goal(Point->new($map->{goal}));
my $goal_view = FilledRect->new({ color => 0xFFFF00,
camera => $camera,
main => $self->main_surface,
x => $self->goal->x - 0.1,
y => $self->goal->y - 0.1,
w => 0.2,
h => 0.2 });$self->views([]);
push @{$self->views}, $background, $ball_view, $goal_view;
$self->walls([]);# now we need to build four walls, to enclose our ball.
foreach my $rect (map { Rect->new($_) } @{$map->{wall}}) {my $wall_model = Wall->new({ pos_v => $rect->y,
pos_h => $rect->x,
width => $rect->w,
height => $rect->h });push @{$self->walls}, $wall_model;
my $wall_view = FilledRect->new({ color => 0xFF0000,
camera => $camera,
main => $self->main_surface,
x => $rect->x,
y => $rect->y,
w => $rect->w,
h => $rect->h });push @{$self->views}, $wall_view;
}
}
At this point, the game is fully functional with the original map,
now we can proceed to the next point.
We already have a goal in each map, so we need to react when the
goal is reached so the next map is loaded. As you might have noticed,
the InGame controller is completely tied to each map, so what we need
to do is replace the controller instance by one with the new map.
There's one important point in the way our ball.pl script handles
the main loop, it is not fully delegated to the controller, but it
tries to handle the global events before it sends it to the
controller.
What this means is that we can use an User SDL event to signal the
main application that the goal for this controller instance was
already achieved and that it should initialize the next
controller.
So, first we're going to fire the event in the InGame controller as
soon as the ball reaches the goal:
if (collide_goal($ball, $self->goal, $frame_elapsed_time)) {
my $event = SDL::Event->new();
$event->type( SDL_USEREVENT );
SDL::Events::push_event($event);
}
We're not doing putting any additional data in the event because
this is the only user event we have in the game, we could use the
event_code and the two pointers for data in the SDL::Event if we
wanted to have a better qualification of the event.
Now we just need to handle that event. First, we're going to get the list
of available maps in the beggining of ball.pl:
my @maps = sort <maps/*.xml>;
Then we're going to replace the hard-coded map selection with
the first map in that array.
my $controller = InGame->new({ main_surface => $surf,
mapname => shift @maps });
And, finally, handle the SDL_USEREVENT replacing the controller
with a new instance while there are still maps in @maps.
while (SDL::Events::poll_event($sevent)) {
my $type = $sevent->type;
if ($type == SDL_QUIT) {
exit;
my $nextmap = shift @maps;
if ($nextmap) {
$controller = InGame->new({ main_surface => $surf,
mapname => $nextmap });
} else {
print 'Finished course in '.(($now - $first_time)/1000)."\n";
exit;
}
} elsif ($controller->handle_sdl_event($sevent)) {
# handled.
} else {
# unknown event.
}
}
As usual, follows a small video of the game, where it starts in one
map and when the goal is achieved, the second map is loaded.
Deploying Perl in shared hosting environments used to be an unpleasant experience, since most hosting providers would refuse to install and keep up-to-date CPAN modules. Fortunally this is no longer the case, since the advent of local::lib, which allows the build and installing of modules in a private directory. But this still required the user to have shell access to the machine, in order to bootstrap the local::lib and install all the dependencies.
The most problematic is not just requiring shell access, but actually requiring the compiler toolkit as well as the development headers for libraries such as libpq-dev (for the DBD::Pg module) or libxml2-dev (for the XML::LibXML module). This would certainly be a problem for a lot of hosting providers.
The last time I started building a local::lib bootstrap I came to the following realization. The machine I'm using is a Debian Lenny, the machine in the hosting provider is a Debian Lenny, so all I need to do is bootstrap the local::lib in my own machine (actually doing it inside a fresh debootstrapped chroot, to actually installing every non-core module by cpan). Then I just created a tarball with it and sent to the server and voilà, it just worked.
Of course my chroot required all the development headers as well as the compiler toolchain, but when I move the local::lib dir to the server, everything is already compiled, so I just need to make sure the postgresql client library is installed (which was already the case) as well as the libxml2 package (which was also the case).
So I realized this image can be re-used in any hosting provider using Debian-Lenny- i386. As I wouldn't like to have my blog shutdown due to excess traffic, I've uploaded the file to rapidshare, feel free to take it to a more convenient place (please tell me the link so I can add it here) -- I have removed the manpages in order to reduce the file size (reduced about 50%). UPDATE: arcanez has kindly provided two other mirrors, and arw__ provided a third for that file so you don't need to suffer from rapidshare.
How to use it?
Simply unpack it into your user's account, it will create a "perl5" directory, if your hosting provider doesn't allow shell access, simply unpack it anywhere into your local machine and use the ftp client to send all the files (remember to set binary mode, since there will be binary files in there).
Then you need to include that path into your Perl's include directory, you can:
If more people think this is a good idea, we might eventually start having different prebuilt images, since that is completely OS-Version specific. The image I built is intended for use ONLY on Debian Lenny i386 machines, it will fail and segfault miserably if you try to use it in other OS and/or version.
]]>Following
posts 1,
2,
3,
4 and
5 on
the subject of writing games in Perl, now we are going to fix the math
in the game.
In the first post, I used a very naive simplification of the
movement calculation. I simply considered that the velocity was
constant during the time of the frame and recalculated the final
velocity after the frame so it would affect the next calculation.
I have to confess that I didn't do it just for the simplification
of the code. I did it because of my lack of good understanding of
math. Some people have noticed that I should've used
a Runge-Kutta
method to solve the problem, but, honestly, the math language is
something that really requires a level of practice I simply don't have
(I've been working on Information Systems for 12 years, now it's the
first time I really miss calculus knowledge).
The problem I was trying to solve is: Considering I have a ball
that is falling at a speed of 3 m/s with a gravity of 9.8 m/s², how
far would it fall after 25 miliseconds (about 40 FPS). I'm strongly
visually-oriented, so let me try to represent in some ascii-art what I
was trying to find out.
position | .
| I
| .
|
| .
|
|
| F
|
|
| .
0-------------------------
time
I was considering I had defined the position I (initial) and I
wanted to know which was the position F (final).
It was only after I shared the problem with Edilson (a colleague
that works in the same place as I do), and after he present me a sheet
full of math calculations which I simply ignored, since I couldn't
understand, and then he said me: "You're looking at the wrong graphic,
this graphic is derived from another graphic, which is velocity vs
time".
This was a very important realization for me, bear with me: Let's
simplify the problem a bit, let's consider we have a constant
velocity. The graphic of velocity vs time would be something like:
velocity |
|
|
|
|
|
|.......I..........F.....
|
|
|
|
0-------------------------
time
You probably remember that in order to find out how much an object
moved in a given time-frame, the formula would be:
ΔS = Δt * v
As I said before, I'm a very visually-oriented person, and at that
point I figured out the following:
velocity |
|
|
|
|
|
| I..........F
| | |
| | |
| | |
| | |
0-------------------------
time
Wait, that's a rectangle, its width is Δt and it's height is v,
so the distance travelled is the area of the rectangle.
WAIT! That's the definition of Integral I've been reading in math
books for a while and that never really meant anything to me because
of all the math blabbering that really require consistent math
practice to actually understand anything.
So now that I feel a lot less dumb, let's proceed to the problem at
hand. The velocity in our game is lineary-variable, which means that
its graphic over time will look like:
velocity | .
| .
| .
| F
| .
| .
| .
| I
| .
|.
|
0-------------------------
time
The intial grahic on the position over time at the beggining of
this post is derived from this graphic -- and this is actually the
meaning of derivative -- so the distance travelled in a given time
frame is the area of the trapezoid representing that time frame:
velocity |
|
|
| F
| . |
| . |
| . |
| I |
| | |
| | |
| | |
0-------------------------
time
So, the answer to my initial question is just a matter of
calculating that area:
Δs = ((vI + vF) * Δt)/2
It looks pretty easy now, and, in fact, I feel quite dumb for
taking so long to realize that. But anyway, that is probably all the
required math for a lot of games. I hope I wasn't the only one who had
a hard time understading all that, and, anyway, now I can start to
understand more complex integral and derivative calculations.
So, let's apply that to the code in our game, which happens to be
at the Ball.pm file.
sub time_lapse {
my ($self, $old_time, $new_time) = @_;
my $elapsed = ($new_time - $old_time)/1000; # convert to seconds...my $vf_h = $self->vel_h + $self->acc_h * $elapsed;
my $vf_v = $self->vel_v + ($self->acc_v - g) * $elapsed;my $ds_h = (($self->vel_h + $vf_h) * $elapsed) / 2;
my $ds_v = (($self->vel_v + $vf_v) * $elapsed) / 2;$self->vel_h($vf_h);
$self->vel_v($vf_v);
$self->cen_h($self->cen_h + $ds_h);
$self->cen_v($self->cen_v + $ds_v);
}
I also fixed the code in the main loop that was re-calculating that
instead of calling time_lapse.
foreach my $wall (@{$self->walls}) {
if (my $coll = collide($ball, $wall, $frame_elapsed_time)) {
# need to place the ball in the result after the bounce given
# the time elapsed after the collision.
$ball->time_lapse($oldtime, $oldtime + (($coll->time)*1000) - 1);if (defined $coll->axis &&
$coll->axis eq 'x') {
$ball->vel_h($ball->vel_h * -1);
} elsif (defined $coll->axis &&
$coll->axis eq 'y') {
$ball->vel_v($ball->vel_v * -1);
} elsif (defined $coll->axis &&
ref $coll->axis eq 'ARRAY') {
my ($xv, $yv) = @{$coll->bounce_vector};
$ball->vel_h($xv);
$ball->vel_v($yv);
} else {
warn 'BAD BALL!';
$ball->vel_h($ball->vel_h * -1);
$ball->vel_v($ball->vel_v * -1);
}
return $self->handle_frame($oldtime + ($coll->time*1000), $now);
}
}
I'm not going to post any video for this post, since there's no
visual difference. But I hope the ascii-art graphics are good enough.
Following
posts 1,
2,
3 and
4
on the subject of writing games in Perl, now we are going to add
a goal to our game.
Currently we have a bouncing ball with that collides in walls and
have a camera following it. Now we are about to add a goal to the
game. The idea is that you should get the ball to hit some specific
point, considering the gravity and the 100% efficient bounce, making
the ball go through some small places might be an interesting
challenge.
The first thing we're going to do is change the walls
configuration, so we make a more challenging setup, currently we have
a box with a wall of half the height in the middle, let's make it a
bit more interesting, let's change the walls initialization code to
the following.
foreach my $rect ( Rect->new({ x => 0,
y => 0,
w => 20,
h => 1 }), # left wall
Rect->new({ x => 0,
y => 0,
h => 20,
w => 1 }), # bottom wall
Rect->new({ x => 20,
y => 0,
h => 20,
w => 1 }), # right wall
Rect->new({ x => 0,
y => 20,
w => 21,
h => 1 }), # top wal
Rect->new({ x => 7,
y => 0,
h => 9,
w => 1 }), # middle-left bottom
Rect->new({ x => 7,
y => 11,
h => 9,
w => 1 }), # middle-left top
Rect->new({ x => 12,
y => 0,
h => 9,
w => 1 }), # middle-right bottom
Rect->new({ x => 12,
y => 11,
h => 9,
w => 1 }), # middle-right top
) {
# ...
}
This creates two small passages in the middle of two vertical
walls, not really hard, but kinda entertaining to get the ball to go
through those. But in order to make it actually hard, let's add
another wall:
Rect->new({ x => 9.2,
y => 11,
h => 1,
w => 1.6 }), # chamber
Now we have a small chamber created between the two vertical
lines. It's kinda tricky to get the ball in there, I personally took
some minutes.
But while I was testing this map, a bug appeared, and this is
actually an important bug. Since the collision was pretty simplified
to handle just one wall at the beginning, I was inadvertedly
positioning the ball at the target destination after it bounced. This
was ok when I had just one wall, but when I have more, and more
importantly, when they are really close to each other, I might
position the ball over another wall when detecting a collision, and
that just, well, you have a ball inside a wall, unless you're watching
the X Files, this can't be good.
The problem, as you might have noticed, happens when I calculate
the target position after the bounce, so what we're going to do is
simply stop trying to guess that. We're going to position the ball in
the exactly spot before the collision with the bouncing velocities and
recalculate the whole frame from that instant on.
This will actually mean a simplification of the code, that will
look like:
foreach my $wall (@{$self->walls}) {
if (my $coll = collide($ball, $wall, $frame_elapsed_time)) {
# need to place the ball in the result after the bounce given
# the time elapsed after the collision.
my $collision_remaining_time = $frame_elapsed_time - $coll->time;
my $movement_before_collision_h = $ball->vel_h * ($coll->time - 0.001);
my $movement_before_collision_v = $ball->vel_v * ($coll->time - 0.001);
$ball->cen_h($ball->cen_h + $movement_before_collision_h);
$ball->cen_v($ball->cen_v + $movement_before_collision_v);
if ($coll->axis eq 'x') {
$ball->vel_h($ball->vel_h * -1);
} elsif ($coll->axis eq 'y') {
$ball->vel_v($ball->vel_v * -1);
} elsif (ref $coll->axis eq 'ARRAY') {
my ($xv, $yv) = @{$coll->bounce_vector};
$ball->vel_h($xv);
$ball->vel_v($yv);
} else {
warn 'BAD BALL!';
$ball->vel_h($ball->vel_h * -1);
$ball->vel_v($ball->vel_v * -1);
}
return $self->handle_frame($oldtime + ($coll->time*1000), $now);
}
}
$ball->time_lapse($oldtime, $now);
Now, to add a goal, we're going to add another set of objects, the
goal itself, which is simply a point, and the view, which I'm also
going to reuse the filled rect view. First I'm going to create a Point
object akin to the Rect I have created earlier.
package BouncingBall::Event::Point;
use Moose;has x => ( is => 'ro',
isa => 'Num',
required => 1 );
has y => ( is => 'ro',
isa => 'Num',
required => 1 );
Now I'm going to add that point object to the controller as an
attribute:
use aliased 'BouncingBall::Event::Point';has 'goal' => ( isa => 'rw',
isa => Point );
And now initialize both the goal and the view for it.
$self->goal(Point->new({ x => 10, y => 12.5 }));
my $goal_view = FilledRect->new({ color => 0xFFFF00,
camera => $camera,
main => $self->main_surface,
x => $self->goal->x - 0.1,
y => $self->goal->y - 0.1,
w => 0.2,
h => 0.2 });$self->views([]);
push @{$self->views}, $background, $ball_view, $goal_view;
Ok, now that we can see our goal, we just need to detect when the
goal was achieved:
sub collide_goal {
my ($ball, $goal, $time) = @_;
my $rect = hash2point({ x => $goal->x, y => $goal->y });
my $circ = hash2circle({ x => $ball->cen_h, y => $ball->cen_v,
radius => $ball->radius,
xv => $ball->vel_h,
yv => $ball->vel_v });
return dynamic_collision($circ, $rect, interval => $time);
}
#...
sub reset_ball {
my ($self) = @_;
$self->ball(Ball->new());
}
#...
if (collide_goal($ball, $self->goal, $frame_elapsed_time)) {
$self->reset_ball();
}
Ok, not very exciting, but something does happen, and that's a
first step.
As usual, follows a small video of the game:
]]>Following
posts 1,
2 and
3
on the subject of writing games in Perl, now we are going to add
a camera.
Up to this point, we've been coupling the positional information in
our simulated universe with the screen position. This is very easy to
do, but very limiting as well, how can we represent off-screen
elements that way?
Our next step is to implement a camera. The idea is quite simple,
instead of asking for each model object to render itself, We're going
to:
At this point you might have noticed that I'm using the terms
"model" and "view" as a direct reference to the Model-View-Controller
architecture, and that's precisely my intention. The basic idea is:
The model is only responsible for managing the simulation of our
universe, while the view is only responsible for turning that
simulation visible to the user. The Controller here is the code that
implements the main loop, receiving the user events, and coordinating
the FPS management.
I could list several reasons on why having the model and the view
as separated objects is a good idea, but I'd like two point just two
of them, since these are going to be future topics in this
tutorial:
The first thing I'm going to do is reorganize our current module
layout. Up to this point our code had:
But now we're going to need a different layout, here is our target
organization:
A naive implementation of the connection between the models and the
views would be, at each step, to fetch the relevant information from
the model and set it into the view. Or possibly have the view itself
fetch the data from the model. But there's one important point to
consider, if the model and the view ends in a different thread,
accessing each other's data would become significantly complicated.
That being said, a different mechanism for view-model integration
is necessary. If we go to the way GUI toolkits work, we'll notice a
pattern called "The Observer Pattern", basically, one object registers
itself as "observing" the other. When that specific type of event
happens, a pre-defined method is called in the observing object.
So what we're going to do is to preserve a local cache of the
information that view needs from the model, use it directly and get it
updated using the observer pattern. That way we have the model and the
view decoupled in terms of threading.
The first thing we need to do is porting our Ball and Wall into
proper model objects, at first, simply removing the "get_rect" and
"draw" methods. I'm not going to put all its code again here, but
renaming the modules and removing that methods is the only thing I'm
doing right now. The time_lapse is also simplfied to remove the
automatic bounce, we're going to put extra walls to enclose the
ball.
Now we need to step-by-step get to the final code layout presented
earlier, let's start by the view classes, and in that case, let's get
the most important view class, the MainSurface.
package BouncingBall::View::MainSurface;
use Moose;
use SDL ':all';
use SDL::Video;# ':all';has 'surface' => (is => 'rw');
has 'width' => (is => 'ro', default => 800);
has 'height' => (is => 'ro', default => 600);
has 'depth' => (is => 'ro', default => 32);sub BUILD {
my ($self) = @_;die 'Cannot init ' . SDL::get_error()
if ( SDL::init( SDL_INIT_VIDEO ) == -1 );$self->surface
( SDL::Video::set_video_mode
( $self->width, $self->height, $self->depth,
SDL_HWSURFACE | SDL_DOUBLEBUF | SDL_HWACCEL ))
or die 'Error initializing video.';return 1;
}
Here we use Moose object initialization to initialize the SDL Video
subsystem and get a new surface for the required videomode. This is a
bit different then what we were doing in the original ball.pl, but not
much. The most important difference is that we're now using double
hardware buffering, which is more efficient then doing individual
updates.
Now we need the Plane view, which implements the background.
package BouncingBall::View::Plane;
use Moose;
use SDL::Video ':all';
use SDL::Surface;with 'BouncingBall::View';
has color => ( is => 'rw',
default => 0 );
has surface => ( is => 'rw' );
has rect_obj => ( is => 'rw' );
has color_obj => ( is => 'rw' );
has main => ( is => 'ro',
required => 1 );sub BUILD {
my ($self) = @_;
$self->_init_surface;
$self->_init_color_object;
$self->_init_rect;
$self->_fill_rect;
return 1;
}sub _init_surface {
my ($self) = @_;
$self->surface
( SDL::Surface->new
( SDL_SWSURFACE,
$self->main->width,
$self->main->height,
$self->main->depth,
0, 0, 0, 255 ) );
return 1;
}sub _init_color_object {
my ($self) = @_;
$self->color_obj
( SDL::Video::map_RGB
( $self->main->surface->format,
((0xFF0000 & $self->color)>>16),
((0x00FF00 & $self->color)>>8),
0x0000FF & $self->color ));
return 1;
}sub _init_rect {
my ($self) = @_;
$self->rect_obj
( SDL::Rect->new
( 0, 0,
$self->main->width,
$self->main->height ) );
return 1;
}sub _fill_rect {
my ($self) = @_;
SDL::Video::fill_rect
( $self->surface,
$self->rect_obj,
$self->color_obj );
return 1;
}after 'color' => sub {
my ($self, $color) = @_;
if ($color) {
$self->_init_color_object;
$self->_fill_rect;
}
return 1;
};sub draw {
my ($self) = @_;
SDL::Video::blit_surface
( $self->surface, $self->rect_obj,
$self->main->surface, $self->rect_obj );
return 1;
}
Now we need the Camera view, which is going to implement the logic
on translating the coordinates from each object to the current
visualization. This is a very important decoupling in our logic,
because it is here that we relativize the points from the simulated
universe to the screen. And this is going to be done by setting a
camera position which is going to serve as pivot in the coordinate
translation.
This is going to be implemented through three methods in our
camera, one that converts a distance in meters to pixels, other that
converts a coordinate to the screen and finally one that checks if a
coordinate is visible at that moment.
package BouncingBall::View::Camera;
use Moose;with 'BouncingBall::Event::RectMovingObserver';
has pointing_x => ( is => 'rw',
default => 0 );
has pointing_y => ( is => 'rw',
default => 0 );
has dpi => ( is => 'rw',
default => 0.96 );
has pixels_w => ( is => 'ro',
required => 1 );
has pixels_h => ( is => 'ro',
required => 1 );sub m2px {
my ($self, $input) = @_;
return int((($input) * ($self->dpi / 0.0254)) + 0.5);
}sub px2m {
my ($self, $input) = @_;
return ($input) / ($self->dpi / .0254);
}sub width {
my ($self) = @_;
return $self->px2m($self->pixels_w);
}sub height {
my ($self) = @_;
return $self->px2m($self->pixels_h);
}sub translate_point {
my ($self, $x, $y) = @_;
my $uplf_x = $self->pointing_x - ($self->width / 2);
my $uplf_y = $self->pointing_y - ($self->height / 2);
my $rel_x = $x - $uplf_x;
my $rel_y = $y - $uplf_y;
my $pix_x = $self->m2px($rel_x);
my $pix_y = $self->m2px($rel_y);
my $inv_y = $self->pixels_h - $pix_y;
return ($pix_x, $inv_y);
}sub translate_rect {
my ($self, $x, $y, $w, $h) = @_;
my ($pix_x, $inv_y) = $self->translate_point($x, $y);
my $pix_h = $self->m2px($h);
my $pix_w = $self->m2px($w);
return ($pix_x, $inv_y - $pix_h, $pix_w, $pix_h);
}sub is_visible {
my ($self, $x, $y) = @_;
my ($tx, $ty) = $self->translate($x, $y);
if ($tx > 0 && $ty > 0 &&
$tx < $self->pixels_w &&
$ty < $self->pixels_h) {
return 1;
} else {
return 0;
}
}
The Camera requires the information from the MainSurface on the
ammount of pixels it has to be able to do the translations.
Now we need to implement the FilledRect view class.
package BouncingBall::View::FilledRect;
use Moose;
use SDL::Video ':all';
use SDL::Surface;with 'BouncingBall::View';
with 'BouncingBall::Event::RectMovingObserver';has x => ( is => 'rw',
default => 0 );
has y => ( is => 'rw',
default => 0 );
has w => ( is => 'rw',
default => 0 );
has h => ( is => 'rw',
default => 0 );
has color => ( is => 'rw',
default => 0 );
has rect_obj => ( is => 'rw' );
has surface => ( is => 'rw' );
has color_obj => ( is => 'rw' );
has camera => ( is => 'rw',
required => 1 );
has main => ( is => 'rw',
required => 1 );sub BUILD {
my ($self) = @_;
$self->_init_surface;
$self->_init_color_object;
$self->_init_rect;
$self->_fill_rect;
return 1;
}sub _init_surface {
my ($self) = @_;
$self->surface
( SDL::Surface->new
( SDL_SWSURFACE,
$self->camera->m2px($self->w),
$self->camera->m2px($self->h),
$self->main->depth,
0, 0, 0, 255 ) );
return 1;
}sub _init_color_object {
my ($self) = @_;
$self->color_obj
( SDL::Video::map_RGB
( $self->main->surface->format,
((0xFF0000 & $self->color)>>16),
((0x00FF00 & $self->color)>>8),
0x0000FF & $self->color ));
return 1;
}sub _init_rect {
my ($self) = @_;
$self->rect_obj
( SDL::Rect->new
( 0, 0,
$self->camera->m2px($self->w),
$self->camera->m2px($self->h) ) );
return 1;
}sub _fill_rect {
my ($self) = @_;
SDL::Video::fill_rect
( $self->surface(),
$self->rect_obj(),
$self->color_obj() );
return 1;
}after 'color' => sub {
my ($self, $color) = @_;
if ($color) {
$self->_init_color_object;
$self->_fill_rect;
}
return 1;
};after qw(w h) => sub {
my ($self, $newval) = @_;
if ($newval) {
$self->_init_surface;
$self->_init_rect;
$self->_fill_rect;
}
return 1;
};sub draw {
my ($self) = @_;
my $rect = SDL::Rect->new
( $self->camera->translate_rect( $self->x, $self->y,
$self->w, $self->h ) );SDL::Video::blit_surface
( $self->surface, $self->rect_obj,
$self->main->surface, $rect );return 1;
}
Ok, now that we have the Model and the View classes, we can
implement the observer pattern, so the view can be updated as the
model changes.
One important aspect on how the MVC model works is that the
controller should have just a limited control on the interaction
between the model and the view, otherwise you'll get a very
complicated code in the controller. Ideally you should have the same
level of abstraction in the model as you have in the view, so you have
componentization of your application.
That being said, we need to plan the communication pattern between
the view and the model. It is important that they should be mostly
unaware of each other, in the sense that the view doesn't need to know
that it's a ball being modelled, but just that it has a point
describing its position and a rect describing its measures - We can
even keep only the rect for our current purposes.
That is our RectMoved event class and the Rect class which is used
by it:
package BouncingBall::Event::RectMoved;
use Moose;has old_rect => ( is => 'ro',
isa => 'BouncingBall::Event::Rect',
required => 0 );
has new_rect => ( is => 'ro',
isa => 'BouncingBall::Event::Rect',
required => 1 );
The rect class is implemented here because SDL::Rect expects
integers as its members, and we don't want to loose the precision.
package BouncingBall::Event::Rect;
use Moose;has x => ( is => 'ro',
isa => 'Num',
required => 1 );
has y => ( is => 'ro',
isa => 'Num',
required => 1 );
has w => ( is => 'ro',
isa => 'Num',
required => 1 );
has h => ( is => 'ro',
isa => 'Num',
required => 1 );
Now we need the role that implements the observable part, meaning
that any class that wants to fire events for moving rects just need to
compose that role and call the fire_rect_moved method.
package BouncingBall::Event::RectMovingObservable;
use Moose::Role;
use MooseX::Types::Moose qw(ArrayRef);use aliased 'BouncingBall::Event::RectMovingObserver';
use aliased 'BouncingBall::Event::RectMoved';has 'rect_moving_listeners' => ( traits => ['Array'],
is => 'ro',
isa => ArrayRef[RectMovingObserver],
default => sub { [] },
handles => { add_rect_moving_listener => 'push' } );sub remove_rect_moving_listener {
my ($self, $object) = @_;
my $count = $self->rect_moving_listeners->count;
my $found;
for my $i (0..($count-1)) {
if ($self->rect_moving_listeners->[$i] == $object) {
$found = $i;
last;
}
}
if ($found) {
splice @{$self->rect_moving_listeners}, $found, 1, ();
}
}sub fire_rect_moved {
my ($self, $old_rect, $new_rect) = @_;
my %args = ( new_rect => $new_rect );
$args{old_rect} = $old_rect if $old_rect;
my $ev = RectMoved->new(\%args);
$_->rect_moved($ev) for @{$self->rect_moving_listeners};
}
And the RectMovingObserver role:
package BouncingBall::Event::RectMovingObserver;
use Moose::Role;requires 'rect_moved';
Now we need to make our Ball model class fire that event whenever
its position or size attributes are changed. So we're goint to add the
following modifiers to the attributes. At first we're not going to
support the old_rect attribute of the event, so we're just sending the
new_rect.
with 'BouncingBall::Event::RectMovingObservable';after qw(cen_v cen_h) => sub {
my ($self, $newval) = @_;
if ($newval) {
$self->fire_rect_moved( undef,
Rect->new({ x => $self->pos_h,
y => $self->pos_v,
w => $self->width,
h => $self->height }) );
}
}
And finally adding the observer code in the view class.
with 'BouncingBall::Event::RectMovingObserver';sub rect_moved {
my ($self, $ev) = @_;
$self->$_($ev->$_()) for grep { $self->$_() != $ev->$_() } qw(x y w h);
}
Now we finally can have the controller code written. It should:
So, in the end our controller looks like the following:
package BouncingBall::Controller::InGame;
use Moose;
use MooseX::Types::Moose qw(ArrayRef);use SDL::Events ':all';
use aliased 'BouncingBall::Model::Ball';
use aliased 'BouncingBall::Model::Wall';
use aliased 'BouncingBall::View';
use aliased 'BouncingBall::View::Plane';
use aliased 'BouncingBall::View::FilledRect';
use aliased 'BouncingBall::View::Camera';
use aliased 'BouncingBall::View::MainSurface';
use aliased 'BouncingBall::Event::Rect';has 'ball' => ( is => 'rw',
isa => Ball,
default => sub { Ball->new() } );has 'main_surface' => ( is => 'ro',
isa => MainSurface,
required => 1 );has 'camera' => ( is => 'ro',
isa => Camera );has 'walls' => ( traits => ['Array'],
is => 'rw',
isa => ArrayRef[Wall] );
has 'views' => ( traits => ['Array'],
is => 'rw',
isa => ArrayRef[View] );
sub BUILD {
my $self = shift;my $background = Plane->new({ main => $self->main_surface,
color => 0xFFFFFF });my $camera = Camera->new({ pixels_w => $self->main_surface->width,
pixels_h => $self->main_surface->height,
pointing_x => $self->ball->cen_h,
pointing_y => $self->ball->cen_v });my $ball_view = FilledRect->new({ color => 0x0000FF,
camera => $camera,
main => $self->main_surface,
x => $self->ball->pos_h,
y => $self->ball->pos_v,
w => $self->ball->width,
h => $self->ball->height });
$self->ball->add_rect_moving_listener($ball_view);$self->views([]);
push @{$self->views}, $background, $ball_view;$self->walls([]);
# now we need to build four walls, to enclose our ball.
foreach my $rect ( Rect->new({ x => 0,
y => 0,
w => 20,
h => 1 }),
Rect->new({ x => 0,
y => 0,
h => 20,
w => 1 }),
Rect->new({ x => 20,
y => 0,
h => 20,
w => 1 }),
Rect->new({ x => 0,
y => 20,
w => 21,
h => 1 }),
Rect->new({ x => 10,
y => 0,
h => 10,
w => 1 })) {my $wall_model = Wall->new({ pos_v => $rect->y,
pos_h => $rect->x,
width => $rect->w,
height => $rect->h });push @{$self->walls}, $wall_model;
my $wall_view = FilledRect->new({ color => 0xFF0000,
camera => $camera,
main => $self->main_surface,
x => $rect->x,
y => $rect->y,
w => $rect->w,
h => $rect->h });push @{$self->views}, $wall_view;
}
}
sub handle_sdl_event {
my ($self, $sevent) = @_;my $ball = $self->ball;
my $type = $sevent->type;if ($type == SDL_KEYDOWN &&
$sevent->key_sym() == SDLK_LEFT) {
$ball->acc_h(-5);} elsif ($type == SDL_KEYUP &&
$sevent->key_sym() == SDLK_LEFT) {
$ball->acc_h(0);} elsif ($type == SDL_KEYDOWN &&
$sevent->key_sym() == SDLK_RIGHT) {
$ball->acc_h(5);} elsif ($type == SDL_KEYUP &&
$sevent->key_sym() == SDLK_RIGHT) {
$ball->acc_h(0);} elsif ($type == SDL_KEYDOWN &&
$sevent->key_sym() == SDLK_UP) {
$ball->acc_v(5);} elsif ($type == SDL_KEYUP &&
$sevent->key_sym() == SDLK_UP) {
$ball->acc_v(0);} elsif ($type == SDL_KEYDOWN &&
$sevent->key_sym() == SDLK_DOWN) {
$ball->acc_v(-5);} elsif ($type == SDL_KEYUP &&
$sevent->key_sym() == SDLK_DOWN) {
$ball->acc_v(0);} else {
return 0;
}
return 1;
}sub handle_frame {
my ($self, $oldtime, $now) = @_;my $frame_elapsed_time = ($now - $oldtime)/1000;
my $ball = $self->ball;
my $collided = 0;
foreach my $wall (@{$self->walls}) {
if (my $coll = collide($ball, $wall, $frame_elapsed_time)) {
# need to place the ball in the result after the bounce given
# the time elapsed after the collision.
my $collision_remaining_time = $frame_elapsed_time - $coll->time;
my $movement_before_collision_h = $ball->vel_h * $coll->time;
my $movement_before_collision_v = $ball->vel_v * $coll->time;
my $movement_after_collision_h = $ball->vel_h * $collision_remaining_time;
my $movement_after_collision_v = $ball->vel_v * $collision_remaining_time;
if ($coll->axis eq 'x') {
$ball->cen_h(($ball->cen_h + $movement_before_collision_h) +
($movement_after_collision_h * -1));
$ball->cen_v($ball->cen_v +
$movement_before_collision_v +
$movement_after_collision_v);
$ball->vel_h($ball->vel_h * -1);
} elsif ($coll->axis eq 'y') {
$ball->cen_v(($ball->cen_v + $movement_before_collision_v) +
($movement_after_collision_v * -1));
$ball->cen_h($ball->cen_h +
$movement_before_collision_h +
$movement_after_collision_h);
$ball->vel_v($ball->vel_v * -1);
} elsif (ref $coll->axis eq 'ARRAY') {
my ($xv, $yv) = @{$coll->bounce_vector};
$ball->cen_h(($ball->cen_h + $movement_before_collision_h) +
($xv * $collision_remaining_time));
$ball->vel_h($xv);
$ball->cen_v(($ball->cen_v + $movement_before_collision_v) +
($yv * $collision_remaining_time));
$ball->vel_v($yv);
} else {
warn 'BAD BALL!';
$ball->cen_h(($ball->cen_h + $movement_before_collision_h) +
($movement_after_collision_h * -1));
$ball->cen_v(($ball->cen_v + $movement_before_collision_v) +
($movement_after_collision_v * -1));
$ball->vel_h($ball->vel_h * -1);
$ball->vel_v($ball->vel_v * -1);
}
$collided = 1;
}
}if (!$collided) {
$ball->time_lapse($oldtime, $now);
}foreach my $view (@{$self->views}) {
my $ret = $view->draw();
}SDL::Video::flip($self->main_surface->surface);
}
use Collision::2D ':all';
sub collide {
my ($ball, $wall, $time) = @_;
my $rect = hash2rect({ x => $wall->pos_h, y => $wall->pos_v,
h => $wall->height, w => $wall->width });
my $circ = hash2circle({ x => $ball->cen_h, y => $ball->cen_v,
radius => $ball->radius,
xv => $ball->vel_h,
yv => $ball->vel_v });
return dynamic_collision($circ, $rect, interval => $time);
}
And with all the reorganization, the main ball.pl code is now
pretty simple:
#!/usr/bin/perluse 5.10.0;
use strict;
use warnings;use SDL;
use SDL::Event;
use SDL::Events;use lib 'lib';
use aliased 'BouncingBall::Controller::InGame';
use aliased 'BouncingBall::View::MainSurface';SDL::init( SDL_INIT_EVERYTHING );
my $fps = 60;
my $surf = MainSurface->new();
my $sevent = SDL::Event->new();
my $time = SDL::get_ticks;my $controller = InGame->new({ main_surface => $surf });
while (1) {
my $oldtime = $time;
my $now = SDL::get_ticks;while (SDL::Events::poll_event($sevent)) {
my $type = $sevent->type;
if ($type == SDL_QUIT) {
exit;
} elsif ($controller->handle_sdl_event($sevent)) {
# handled.
} else {
# unknown event.
}
}$controller->handle_frame($time, $now);
$time = SDL::get_ticks;
SDL::delay(1000/$fps);
}
We started this post around the idea of making a camera, but we
haven't done anything really interesting with it. So now I'm going to
implement the really usefull part of all this thing we've done.
Currently the camera is being set as looking at the point the ball
starts, but soon enough, the ball is going to get too close to the
bottom border of the screen.
The idea is pretty simple, try to keep the ball inside a threshold
margin by moving the camera when it gets too close of the border.
What makes this really simple is the fact that we just need to do
two things:
And that's all. Really. So here are all the code we need to make
the camera chase the ball:
# in the controller, we just need to add one line, after the camera
# initialization.
$self->ball->add_rect_moving_listener($camera);
And then we need to implement rect_moved on the camera:
sub rect_moved {
my ($self, $ev) = @_;
# implement a loose following of the ball. if the ball gets near
# the border of the screen, we follow it so it stays inside the
# desired area.my $lf_x = $self->pointing_x - ($self->width / 2);
my $br_lf_x = $lf_x + $self->width * 0.2;my $rt_x = $self->pointing_x + ($self->width / 2);
my $br_rt_x = $rt_x - $self->width * 0.2;my $up_y = $self->pointing_y + ($self->height / 2);
my $br_up_y = $up_y - $self->height * 0.2;my $dw_y = $self->pointing_y - ($self->height / 2);
my $br_dw_y = $dw_y + $self->height * 0.2;if ($ev->new_rect->x < $br_lf_x) {
$self->pointing_x( $self->pointing_x - ($br_lf_x - $ev->new_rect->x))
} elsif ($ev->new_rect->x > $br_rt_x) {
$self->pointing_x( $self->pointing_x + ($ev->new_rect->x - $br_rt_x));
}if ($ev->new_rect->y < $br_dw_y) {
$self->pointing_y( $self->pointing_y - ($br_dw_y - $ev->new_rect->y))
} elsif ($ev->new_rect->y > $br_up_y) {
$self->pointing_y( $self->pointing_y + ($ev->new_rect->y - $br_up_y));
}return 1;
}
And that's all. That's the joy of a properly designed MVC
architecture.
As usual, follows a small video of the game.
Following
posts 1
and 2
on the subject of writing games in Perl, now we are going to add
colision.
The idea is quite simple, we are going to add another square to the
game, and when the ball hits it, it will change direction. Following
the way we were working, I'm going to add another object, called
Wall.
The first thing is modelling our wall, which will be a rectangle,
so it has the following attributes.
package Wall;
use Moose;
use Util;
use SDL::Rect;# Position - vertical and horizontal
has pos_v => (is => 'rw', isa => 'Num', default => 0);
has pos_h => (is => 'rw', isa => 'Num', default => 0.12);# Width and height
has width => (is => 'rw', isa => 'Num', default => 0.005);
has height => (is => 'rw', isa => 'Num', default => 0.4);
Unlike the ball, a wall doesn't move, so we don't need a time_lapse
method, but we still have the get_rect and draw methods.
sub get_rect {
my ($self, $height, $width) = @_;my $inverted_v = ($height - ($self->pos_v + $self->height));
my $x = Util::m2px( $self->pos_h );
my $y = Util::m2px( $inverted_v );
my $h = Util::m2px( $self->height );
my $w = Util::m2px( $self->width );my $screen_w = Util::m2px( $width );
my $screen_h = Util::m2px( $height );if ($x $screen_w) {
$w -= ($x + $w) - $screen_w;
}if ($y $screen_h) {
$h -= ($y + $h) - $screen_h;
}return SDL::Rect->new( $x, $y, $w, $h );
}my $color;
sub draw {
my ($self, $surface, $height, $width) = @_;
unless ($color) {
$color = SDL::Video::map_RGB
( $surface->format(),
255, 0, 0 ); # red
}
SDL::Video::fill_rect
( $surface,
$self->get_rect($height, $width),
$color );
}
See
the first
post for more details on the get_rect and draw codes.
Now we need to add our wall to the game, that will mean a simple
change in our main code, first we need to load the Wall module, then
initialize the Wall just after initializing the ball, and finally
calling the draw method just after calling the same method on
ball.
use Wall;
my $wall = Wall->new;
$wall->draw($app, $height, $width);
If you tried to run the code at this point, you'll notice you won't
see any wall. That happens because the application is only updating
the screen where the ball is passing. The Wall needs to be drawn a
first time, and the screen needs to be updated at that position. This
prevents us from re-updating the wall rect everytime, which is
pointless, since the wall is static - that code goes right before the
main loop.
# let's draw the wall for the first time.
$wall->draw($app, $height, $width);
SDL::Video::update_rects
( $app,
$wall->get_rect($height, $width) );
Now we need to check for a collision. This should happen in the
place of the time_lapse call. Note that while I neglected math in the
movement part, here it's more complicated because I need to react in a
reasonable manner depending on how the collision happened. But as
we're working in Perl and we have CPAN, I can just use Collision::2D
(zpmorgan++ for working on this and pointing me in the correct
direction)
If you don't have the Collision::2D module installed, just call
# cpan Collision::2D
If you're not sure wether you have it or not, just try installing
it anyway, it will suceed if the module is already installed.
use Collision::2D ':all';
sub collide {
my ($ball, $wall, $time) = @_;
my $rect = hash2rect({ x => $wall->pos_h, y => $wall->pos_v,
h => $wall->height, w => $wall->width });
my $circ = hash2circle({ x => $ball->cen_h, y => $ball->cen_v,
radius => $ball->radius,
xv => $ball->vel_h,
yv => $ball->vel_v });
return dynamic_collision($circ, $rect, interval => $time);
}
I assumed an API that wasn't currently implemented in our Ball
object, so I changed the ball so that pos_v, pos_h, width and height
return the bounding dimensions for the ball I won't put the code in
the post, but you can check at
the github repo.
Okay, now it's time to check for collisions and act
accordingly. Again, we'll assume an 100% efficient collision, so the
code looks like:
my $frame_elapsed_time = ($now - $oldtime)/1000;
if (my $coll = Util::collide($ball, $wall, $frame_elapsed_time)) {
# need to place the ball in the result after the bounce given
# the time elapsed after the collision.
my $collision_remaining_time = $frame_elapsed_time - $coll->time;
my $movement_before_collision_h = $ball->vel_h * $coll->time;
my $movement_before_collision_v = $ball->vel_v * $coll->time;
my $movement_after_collision_h = $ball->vel_h * $collision_remaining_time;
my $movement_after_collision_v = $ball->vel_v * $collision_remaining_time;
if ($coll->axis eq 'x') {
$ball->cen_h(($ball->cen_h + $movement_before_collision_h) +
($movement_after_collision_h * -1));
$ball->cen_v($ball->cen_v +
$movement_before_collision_v +
$movement_after_collision_v);
$ball->vel_h($ball->vel_h * -1);
} elsif ($coll->axis eq 'y') {
$ball->cen_v(($ball->cen_v + $movement_before_collision_v) +
($movement_after_collision_v * -1));
$ball->cen_h($ball->cen_h +
$movement_before_collision_h +
$movement_after_collision_h);
$ball->vel_v($ball->vel_v * -1);
} elsif (ref $coll->axis eq 'ARRAY') {
my ($xv, $yv) = @{$coll->bounce_vector};
$ball->cen_h(($ball->cen_h + $movement_before_collision_h) +
($xv * $collision_remaining_time));
$ball->vel_h($xv);
$ball->cen_v(($ball->cen_v + $movement_before_collision_v) +
($yv * $collision_remaining_time));
$ball->vel_v($yv);
} else {
warn 'BAD BALL!';
$ball->cen_h(($ball->cen_h + $movement_before_collision_h) +
($movement_after_collision_h * -1));
$ball->cen_v(($ball->cen_v + $movement_before_collision_v) +
($movement_after_collision_v * -1));
$ball->vel_h($ball->vel_h * -1);
$ball->vel_v($ball->vel_v * -1);
}
} else {
$ball->time_lapse($oldtime, $now, $height, $width);
}
Okay, the above code was a bit complicated, let's brake it down...
my $frame_elapsed_time = ($now - $oldtime)/1000;
Collision::2D works with time in seconds, it calculates if the two
objects would have collided during the duration of this frame.
if (my $coll = Util::collide($ball, $wall, $frame_elapsed_time)) {
...
} else {
$ball->time_lapse($oldtime, $now, $height, $width);
}
Now we check if there was a collision. If not, we just proceed to
the regular code that calculates the new position for the ball.
my $collision_remaining_time = $frame_elapsed_time - $coll->time;
my $movement_before_collision_h = $ball->vel_h * $coll->time;
my $movement_before_collision_v = $ball->vel_v * $coll->time;
my $movement_after_collision_h = $ball->vel_h * $collision_remaining_time;
my $movement_after_collision_v = $ball->vel_v * $collision_remaining_time;
In the case we have a collision, Collision::2D tells us when and
how it happened. In order to implement the bouncing, I also calculate
how far they would have been proceeded before and after the collision.
if ($coll->axis eq 'x') {
...
} elsif ($coll->axis eq 'y') {
...
} elsif (ref $coll->axis eq 'ARRAY') {
...
} else {
...
}
The method that describes how the collision happened is "axis". If
it was a purely horizontal colision, it will return 'x', if it was
purely vertical, it will return 'y', if it was mixed, it will return a
vector that describes it. In the case of a bug, it will return undef.
$ball->cen_h(($ball->cen_h + $movement_before_collision_h) +
($movement_after_collision_h * -1));
$ball->cen_v($ball->cen_v +
$movement_before_collision_v +
$movement_after_collision_v);
$ball->vel_h($ball->vel_h * -1);
In the case of perfect horizontal or vertical collision (or bug),
we reposition the ball by first calculating where it would be at the
time of the collision and then bounce it away - depending on how the
collision occurred.
my ($xv, $yv) = @{$coll->bounce_vector};
$ball->cen_h(($ball->cen_h + $movement_before_collision_h) +
($xv * $collision_remaining_time));
$ball->vel_h($xv);
$ball->cen_v(($ball->cen_v + $movement_before_collision_v) +
($yv * $collision_remaining_time));
$ball->vel_v($yv);
This last part of the code uses a cool feature for Collision::2D,
which returns a bounce information for that collision, which we then
use to figure out the correct position after the bounce.
And now we can run our code. I have made some other changes not
explained here, because they are just settings that control the
behavior. Remember to access
the github repo for
more details.
Now a small video of the game running.
]]>I'm working for some time in a concept on what I've been calling Null CMS, which would be simply a content repository with metadata support and authorization. The interface would simply be a search and an edit screen. The data would be stored in Plain Old Semantic HTML (POSH), tags and categorization would be made with HTML META tags, microformats would also be used to allow structuring other types of data. Media files could be stored with an associated html file describing it.
In order to make it fast, I'd use KinoSearch to index all of that, including inexing known microformats and other patterns that could be defined in code. The other requisite for that is supporting UNIX-style permissions (ugo+rwx) so I could have three sets of indices - 1 for each user, 1 for each group and 1 for others.
In the end, this is going to be presented as a Catalyst Model, that will then be used to implement web sites in an easy and clean way - using a specialized cat front-end for sites is very straight forward, I had experience front-ending wordpress which, besides it's weird data modelling (and "weird" is putting it in a nice way), and it was pretty nice.
This could easily be solved with a XML database, such as Sedna, eXist or even bdbxml, but they require an extra level of control of the operating system that would make this project pointless (If I have this kind of control, I'd use Alfresco which already implements everything I need).
Conceptually, something as simple as storing everything in a tar file would solve it, but then we have concurrent access and it fails.
I was wondering about KiokuDB, but I'd still need a storage for kinosearch indexes, maybe it's possible to create a store class for kinosearch that stores it in a relational database.
In summary, I need a solution that could be used in a regular cheap shared hosting (which probably means only MySQL).
The other alternative is using Amazon services, but that would make me too depedant on them - although it would probably be a minor problem, since it's all encapsulated in a model class...
I'd like to hear ideas on this topic... what do you think?
]]>I'm usually not thrilled by competitions, but I must admit this one has taken me. I refer to the Google AI Challenge promoted by the University of Waterloo Computer Science Club. This is a simple bot competition where you play in a one-to-one tron game with another bot from the competition in one of a set of maps.
The deadline for bot submission is 26th february, but don't wait untill there. The example bots are nothing close to the competition bots... You can follow my status here.]]>
Following the
first post on the subject of writing games in Perl, where we
created a bouncing ball (I know, it is a rectangle, but I trust your
imagination), this post is going to add something very important when
dealing with games: input.
Silveira Neto suggested that
I should include more specific instructions on how to start the game
(and maybe a video), so I recalled that I didn't mention that all the
sources for this posts (including the text) is currently hosted at a
github repository (if
you plan to contribute, please just ask me for commit permissions
instead of forking the repo).
So if you want to run the codes posted here, you first need to:
$ git clone http://github.com/ruoso/games-perl.git
You can check for updates by calling
$ git pull origin master
from inside the games-perl directory. Each directory inside
games-perl starts with the number of the post. The first post is
inside the 1-bouncing-ball directory and the second is in
2-controlling. To run the the first code just get inside the
first directory and call:
$ perl ball.pl
The second example code is based on the first, so the script name
is the same, so just get into the other directory and run the same
line. If you get an error like:
Can't locate SDL/Video.pm in @INC (@INC contains: /etc/perl
/usr/local/lib/perl/5.10.0 /usr/local/share/perl/5.10.0 /usr/lib/perl5
/usr/share/perl5 /usr/lib/perl/5.10 /usr/share/perl/5.10
/usr/local/lib/site_perl .) at ball.pl line 8.
It means you probably don't have the newest SDL, take a look at
the first
post to see how to get the newest redesigned SDL.
Enough for the introduction, let's get to the actual code. The
first thing we need is understanding SDL Events. If you ever
programmed GUI applications or even if you wrote some javascript you
are aware of how an event framework looks like. SDL is no exception,
you need to wait (or poll) for the events, and each event will contain
the information you need to figure out what happened.
In our case, we want to apply additional acceleration to the ball
whenever the arrow keys are pressed. But if we have an event-based
system, the way to figure out which of those four keys is currently
pressed is keeping a state mask and update it when you receive keydown
and keyup events.
So what we're going to do is to manipulate the acc_h
and acc_v ball attributes depending on the keydown and keyup
events. It might look complicated, but the only change we need is
(this is inside ball.pl main loop):
while (SDL::Events::poll_event($event)) {
if ($event->type == SDL_QUIT) {
exit;} elsif ($type == SDL_KEYDOWN &&
$sevent->key_sym() == SDLK_LEFT) {
$ball->acc_h(-1);} elsif ($type == SDL_KEYUP &&
$sevent->key_sym() == SDLK_LEFT) {
$ball->acc_h(0);} elsif ($type == SDL_KEYDOWN &&
$sevent->key_sym() == SDLK_RIGHT) {
$ball->acc_h(1);} elsif ($type == SDL_KEYUP &&
$sevent->key_sym() == SDLK_RIGHT) {
$ball->acc_h(0);} elsif ($type == SDL_KEYDOWN &&
$sevent->key_sym() == SDLK_UP) {
$ball->acc_v(1);} elsif ($type == SDL_KEYUP &&
$sevent->key_sym() == SDLK_UP) {
$ball->acc_v(0);} elsif ($type == SDL_KEYDOWN &&
$sevent->key_sym() == SDLK_DOWN) {
$ball->acc_v(-1);} elsif ($type == SDL_KEYUP &&
$sevent->key_sym() == SDLK_DOWN) {
$ball->acc_v(0);}
}
So, this is it. Follows a small video of the game.
I've been saying I will write a lengthy description of my
experiments with SDL in Perl for a while, today
kthakore uploaded
a SDL experimental version with all the code involved in this
experiments. So I decided to start, but I decided to make it a serial
post. I'm still unsure about how the format will look like for the
rest of the posts, but I certainly would love any comment with ideas
of where I should go next.
So at the first post, I'll try to make a very simple application:
"bouncing ball". It is simply a ball bouncing in the screen, where the
left and right cursors will accelerate them to each side.
Well, at first you need version 2.3_5 or greater of the SDL module available here. Building the SDL perl binding will require the headers for most of the sdl related libraries. If you're in a Debian machine (or most debian-based distros) you can simply install the regular version of the SDL perl bindings. You can also do:
# apt-get build-dep libsdl-perl
This line requires you to have a deb-src line in your /etc/apt/sources.list. Mine looks like:
deb-src http://ftp.br.debian.org/debian lenny main
In the case you change your sources.list file, remember you need to call apt-get update for it to get the new info.
After that you can simply download SDL 2.3_5 from CPAN and follow
the README instructions, which basically means (note that this version
is experimental so you might notice some failing tests):
# perl Build.PL # ./Build # ./Build test # ./Build install
You might setup a local::lib if you still want to run other
applications that require the older and stable version of SDL (yes,
there are a lot of API changes). I'm not a Windows user, but it has
been reported that it works like charm when
using Strawberry Perl.
If everything is fine, you should be able to get "2.35" when you
do:
$ perl -MSDL -E 'say $SDL::VERSION'
You might always get into #sdl@irc.perl.org if you run into
trouble.
Alright, before getting into the technicalities of how to write a
game with SDL in Perl, let's think a bit on the mechanics of how a
game works.
The first thing to realize is that a game needs to simulate some universe, and that this universe needs to have some universal rules like the physics you apply. For instance, it is very important that you decide, from the beggining, if you're going to have gravity in your game.
The second thing to realize is that, even if we have the impression
that the time is a continuum, time is actually a sequence of events,
like the shutter of a camera in burst mode (okay, for the not
interested in photography, think in stop motion). That basically
means: in frame A the ball was at position 10,10 and in frame B it was
at 20,30. There's no in-between, you don't have to worry about it. You
might be wondering if a collision might be lost in that move, but the
point is, if the machine can't evaluate enough frames per second as to
avoid that, it probably wouldn't be able to evaluate a more
ellaborated calculation of the tragetories to see if they would have
collided.
This provides an important simplification on how to think your game
model. In this first example I'm going to overlook the modelling for
interaction with different objects, since we have just a bouncing
ball.
One last thing before we go on. You might be tempted to use pixels as your measuring unit, there's one important aspect to keep in mind. A Pixel is an integer value, which means that you'll need to do roundings for each frame. And if you need to store it as a integer value, you're going to accumulate imprecision, which might lead to weird effects, specially when the fps rate changes dramatically. My suggestion is to stick with the good old international measuring system and just use meters, a simple calculation can covert from/to pixels.
package Util;
use strict;
use warnings;
our $DPI = 96; # I think there's a sane way to fetch this value
sub m2px { int(((shift) * ($DPI / 0.0254)) + 0.5) }
sub px2m { (shift) / ($DPI / .0254) }
I think there probably isn't a better fit for Object Orientation
than games, since you're actually dealing with simulated objects, and
the most obvious choice is to use object orientation to work with
it. So that's the attributes I can think right now to our object.
package Ball; use Moose;use constant g => 1.5;
use Util;
use SDL::Rect;# how much space does it take
has radius => (is => 'rw', isa => 'Num', default => 0.005);# Position - vertical and horizontal
has pos_v => (is => 'rw', isa => 'Num', default => 0.1);
has pos_h => (is => 'rw', isa => 'Num', default => 0.04);# Velocty - vertical and horizontal
has vel_v => (is => 'rw', isa => 'Num', default => 0);
has vel_h => (is => 'rw', isa => 'Num', default => 0);# Current acceleration - vertical and horizontal
# gravity is added later
has acc_v => (is => 'rw', isa => 'Num', default => 0);
has acc_h => (is => 'rw', isa => 'Num', default => 0);
With our virtual ball defined, we need to implement the simulation of time. And again, we need to think that time is not a continuum, so what we do is providing a "time_lapse" method that will recalculate the attributes of our object according to the ammount of time past.
sub time_lapse {
my ($self, $old_time, $new_time, $height, $width) = @_;
my $elapsed = ($new_time - $old_time)/1000; # convert to seconds...
# now simple mechanics...
$self->vel_h( $self->vel_h + $self->acc_h * $elapsed );
# and add gravity for vertical velocity.
$self->vel_v( $self->vel_v + ($self->acc_v - g) * $elapsed );
# finally get the new position
$self->pos_v( $self->pos_v + $self->vel_v * $elapsed );
$self->pos_h( $self->pos_h + $self->vel_h * $elapsed );
# this ball is supposed to bounce, so let's check $width and $height
# if we're out of bounds, we assume a 100% efficient bounce.
if ($self->pos_v pos_v($self->pos_v * -1);
$self->vel_v($self->vel_v * -1);
} elsif ($self->pos_v > $height) {
$self->pos_v($height - ($self->pos_v - $height));
$self->vel_v($self->vel_v * -1);
}
if ($self->pos_h pos_h($self->pos_h * -1);
$self->vel_h($self->vel_h * -1);
} elsif ($self->pos_h > $width) {
$self->pos_h($width - ($self->pos_h - $width));
$self->vel_h($self->vel_h * -1);
}
}
You probably noticed that we haven't talked much about the game
development per se, so let's start thinking about it
The first difference from the simulated universe and the actual game is the coordinate system. In our universe the vertical position 0 is near the floor, but in the screen, the vertical position 0 is at the top of the screen.
The other difference, which I already mentioned, is that our measures are in meters, and the screen is measured in pixels. The SDL library provides an important class to interact with this issue, the SDL::Rect.
That way, we're going to have a method to return a rect - but we
need to remember to only return a rect that is inside the expected
bounds, otherwise SDL will throw an exception.
sub get_rect {
my ($self, $height, $width) = @_;
my $inverted_v = $height - $self->pos_v;
my $x = Util::m2px( $self->pos_h - $self->radius );
my $y = Util::m2px( $inverted_v - $self->radius );
my $h = Util::m2px( $self->radius * 2 );
my $w = Util::m2px( $self->radius * 2 );
my $screen_w = Util::m2px( $width );
my $screen_h = Util::m2px( $height );
if ($x $screen_w) {
$w -= ($x + $w) - $screen_w;
}
if ($y $screen_h) {
$h -= ($y + $h) - $screen_h;
}
return SDL::Rect->new( $x, $y, $w, $h );
}
The last part is actually drawing the ball, which involves painting the ball in the correct place. In our first version, our ball will be a square, since it's the most primitive drawing we have and I don't want to get into that specifics.
my $color;
sub draw {
my ($self, $surface, $height, $width) = @_;
unless ($color) {
$color = SDL::Video::map_RGB
( $surface->format(),
0, 0, 255 ); # blue
}
SDL::Video::fill_rect
( $surface,
$self->get_rect($height, $width),
$color );
}
Yeah, I know, it's an ugly ball, but it bounces... ;)
Now we just need the actual application to use our Ball. Note that
the cycle is basically:
Note that I could have asked for it to update the entire screen instead of only the parts that were changed, but that particular operation is actually the most expensive thing you can have in your app, so we try to update as few parts of the screen as possible.
#!/usr/bin/perl]]>use 5.10.0;
use strict;
use warnings;use SDL;
use SDL::Video;
use SDL::App;
use SDL::Events;
use SDL::Event;
use SDL::Time;use lib 'lib';
use Util;
use Ball;my $ball = Ball->new;
my $width = 0.2;
my $height = 0.15;
my $fps = 60;my $app = SDL::App->new
( -title => 'Bouncing Ball',
-width => Util::m2px($width),
-height => Util::m2px($height));my $black = SDL::Video::map_RGB
( $app->format(),
0, 0, 0 ); # blackmy $event = SDL::Event->new();
my $time = SDL::get_ticks;
my $app_rect = SDL::Rect->new(0, 0, $app->w, $app->h);
my $ball_rect = $ball->get_rect($height, $width);while (1) {
my $oldtime = $time;
my $now = SDL::get_ticks;while (SDL::Events::poll_event($event)) {
exit if $event->type == SDL_QUIT;
}my $old_ball_rect = $ball_rect;
$ball->time_lapse($oldtime, $now, $height, $width);
$ball_rect = $ball->get_rect($height, $width);
SDL::Video::fill_rect
( $app,
$app_rect,
$black );$ball->draw($app, $height, $width);
SDL::Video::update_rects
( $app,
$old_ball_rect, $ball_rect );$time = SDL::get_ticks;
if (($time - $oldtime) < (1000/$fps)) {
SDL::delay((1000/$fps) - ($time - $oldtime));
}
}
I think this thing started when Silveira Neto posted his code snippet on Pygame animating the tile set he has been creating for a long time. I knew for a long time that Perl supported SDL and that Frozen Bubble is written in Perl, but I have never tried it myself.
Working with graphics wasn't new to me, back in the days I played with BASIC, I wrote a blackjack program with animated cards, some time later - already in Linux, I played a bit with vgalib. I've been also thinking for a while on the concept of how to evaluate the progress of time in a game environment.
If you join this with the fact that I now have a 1yo kid, it kinda urged me to writing something in SDL for him. The idea was quite simple, as he doesn't coordinate mouse and keyboard movement yet, the game would simply present random images and sounds as there was any event at all.
So I started by using a simple event loop for the SDL events, and a timer to evaluate the time lapse and draw the game. To my surprise, using the timer caused segfaults, because the timer callback runs in a different thread in SDL, but the binding didn't provide any support for it and all I got was kaboom.
I worked around this issue by using Event, a simple event library I already used some other places, to implement the timer. It worked like charm, as there was events in SDL, it was creating rects of random sizes and colors that would last for a random amount of time, fading to black.
Then I thought: Ok, now let's proceed to audio. To my surprise, the callbacks for procedural audio generation were simply missing - Frozen Bubble only plays pre-produced audio files - and my idea was to produce random audio (not noise, but sounds in random frequencies). This was the push I needed to get to the redesign branch in github and start porting the app to it.
Lots of research later, with the help of kthakore++ and the tips from Nicholas++, we managed to have a working version of SDL based on threads and threads::shared. This was a very great moment. I must confess I always kept some envy from python people because of the - so I thought - better support for threads in Python. At some point in this path I found out that Python doesn't support threads at all, because they have a Global Interpreter Lock, which basically means that POE implements the same kind of scalability than Python (and it also explained why the people at ce.gov.br have so much trouble with zope scalability). So now not only we have a thread-enabled SDL binding, but it is *really* threaded, which means that the audio callback will really run at the same time as the timer callback , which will also run together with the event loop. And now I'm happy to know that Perl does have a better threading support than Python - yeah, I know envy is a bad thing, but... whatever...
After I finished Tecla, the app for my 1yo kid, I decided to play with Game::PerlInvaders, which I saw some time ago and I knew some things I could improve. The result is in the branch refact_ruoso at github.
I should make another post, with the details on how tecla and the rewrite of Game::PerlInvaders work, but that's it for now.
]]>Today I started the day looking at this post that inspired me to write an ascii analog clock in Perl.
Unlike the linked post, I didn't intend to golf, but rather writing a clean and readable code.
Follows the code:
]]>
#!/usr/bin/perl# besides DateTime, the standard pragmas
use 5.010;
use strict;
use warnings;
use utf8;
use DateTime;# initialize configuration variables
my $width = 32;
my $height = 32;
my $mark_at = 15;
my $length_m = 12;
my $length_h = 8;
my $length_s = 15;
my $pi = 3.14159265;
my $center_x = int(0.5 + ($width / 2));
my $center_y = int(0.5 + ($height / 2));
my $loop = 1;# clear the screen and position the cursor in the left top corner
print "\x1b[0;0H\x1b[2J";# loop the rendering of the clock
while ($loop && sleep 1) {# create a matrix of the configured height and width with blanks
# I use two spaces because most console fonts have the height with
# twice the width
my $data = [map {[ map { ' ' } 1..$width ]} 1..$height];# get the date and time in the local time zone
my $now = DateTime->now(time_zone => 'local');
my $hour = $now->hour_12;
my $min = $now->minute;
my $sec = $now->second;# convert that to degrees for the hands of that clock
my $degree_m = ($min * 6) + 270;
my $degree_h = ($hour * 30) + 270;
my $degree_s = ($sec * 6) + 270;# see the place sub down there
# place the numbers 1 to 12 around the clock
place($data,($_ * 30) + 270,$mark_at,sprintf("%02d",$_)) for 1..12;# now the seconds hand
place($data,$degree_m, $_ , '<>') for 0..$length_m;
# the hours hand
place($data,$degree_h, $_ , '::') for 0..$length_h;# the seconds hand
place($data,$degree_s, $_ , '..') for 0..$length_s;# mark the center o the clock
$data->[$center_y][$center_x] = 'OO';# position the cursor in the left top corner
print "\x1b[0;0H\n";
# covert the matrix into a single string and print it
say join "\n", map { join '', @$_ } @$data;
};# covert degrees and distance into X and Y coords using basic trigonometry
sub vec2xy {
my ($deg, $len) = @_;
return $center_x + int(0.5 + ($len * cos($deg * ($pi/180)))),
$center_y + int(0.5 + ($len * sin($deg * ($pi/180))));
}# place a string into some degree and distance
sub place {
my ($data, $deg, $len, $txt) = @_;
my ($x,$y) = vec2xy($deg,$len);
$data->[$y][$x] = $txt;
}