Perl, C and Java Developer, initial author for the Perl Oak
Component Tree (http://perl-oak.sourceforge.net), SMOP
(http://www.perlfoundation.org/perl6/index.cgi?smop),
Colorblind (http://colorblind.alioth.debian.org) and
cvs-autoreleasedeb.
Transactional and Authorized Methods in yout Catalyst Model Class
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.
The Map Format
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:
The root element is "map", it is composed as a sequence.
The first element in the "map" sequence is "ball", it should appear once and only once, it has "radius", "x" and "y" as attributes.
The second element is "goal" it also should appear only once and has "x" and "y" as attributes.
Finally, the third element is "wall" which can happen more than once and has "x", "y", "w" and "h" as attributes.
In Perl data structures that will mean the following:
The main "map" structure is a hash, with "ball", "goal" and "wall" as keys.
The value for "ball" will be another hash, with "radius", "x" and "y" as keys and the floats as values
The value for "goal" will be another hash, with "x" and "y" as keys and the floats as values
The value for "wall" is going to be an arrayref containing one hash for each wall define, where those will have "x", "y", "w" and "h" as keys with the floats as values
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 } ] }
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".
Loading the map
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:
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.
Map cycling
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.
Simplifying the Deployment of Catalyst Perl Applications in Shared Hosting
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%).
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:
set the PERL5LIB environment directory with /home/youruser/perl5/lib/perl5:/home/youruser/perl5/lib/perl5/i486-linux-gnu-thread-multi
add -I/home/youruser/perl5/lib/perl5 -I/home/youruser/perl5/lib/perl5/i486-linux-gnu-thread-multi in the #!/usr/bin/perl line
use lib '/home/youruser/perl5/lib/perl5'; use lib '/home/youruser/perl5/lib/perl5/i486-linux-gnu-thread-multi'; # into your fastcgi script
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:
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.
[ Certification disabled because you're not logged in. ]
New Advogato Features
New HTML Parser: The long-awaited libxml2 based HTML parser
code is live. It needs further work but already handles most
markup better than the original parser.