I'm working on some code to generate random maps for games. However, seeing as this is somewhat specific, I've tried to at least encapsulate part of it and make it somewhat general--or at least easy to update. So far I've created a script that will populate a room with random objects. As of now, the objects are of specific categories, and you can select the percentage you wish for that category, i.e., %50 of the items should be category x. The categories are user specified. The most important(besides $room) variable is the $objs var. It is a ref. to a pretty complicated data structure.
$objs->{$category}->{obj} is a ref. to an array of objects to put into the room.
$objs->{$category}->{key} is a ref. to an array of keys to put into the actual room, which represent the objects.
At a higher level, you could scan the room and replace each key with an image, or whatever representation of the object you need. Well, I could explain this for a while, but the script speaks for itself. I'll only add that I plan to make a script to generate random maps, though that is a *lot* more complicated, so I started this, and am looking for some input to make it better. (p.s., the room is a ref. to a two dimensional array; "-" represents an empty space) The script is here:
sub populate {
my $hash = shift;
my $room = $hash->{room};
my $done = $hash->{done} || 5;
my $amnt = $hash->{amnt} || 100;
my $cats = $hash->{cats};
my $attr = $hash->{attr};
my $objs = $hash->{objs};
$attr = asign( {amnt => $amnt,hash => $attr,to_fill => $cats} );
for(1..$done) {
my $cat = get_cat($attr,$amnt);
my $ary = $objs->{cat}->{obj};
my $obj = $objs->{$cat}->{obj}->[int rand $#$ary];
my $key = get_key({objs=>$objs,cat=>$cat,obj=> $obj});
$room = place($key,$room);
}
$room;
}
sub asign {
my $attr = shift;
my $amnt = $attr->{amnt};
my $hash = $attr->{hash};
my $to_fill = $attr->{to_fill};
my $filled = scalar keys %$hash;
my ($sum,$each);
$sum = count_sum($hash);
$each = int(($amnt-$sum)/(scalar @$to_fill-scalar keys %$hash));
$hash->{$_} ||= $each for @$to_fill;
$sum = count_sum($hash);
while($sum = count_sum($hash) != $amnt) {
my $key = (keys %$hash)[int rand scalar keys %$hash];
$sum < $amnt ? $hash->{$key}++ : $hash->{$key}--;
}
$hash;
}
sub count_sum {
my $hash = shift;
my $sum = 0;
map { $sum += $_ } values %$hash;
$sum;
}
sub get_cat {
my($hash,$amnt) = @_;
weighted_rand(weight_to_dist($amnt,%$hash))
}
sub weight_to_dist {
my($amnt,%weights) = @_;
my($key, $weight,%dist);
$dist{$key} = $weight/$amnt while($key,$weight) = each %weights;
return %dist;
}
sub weighted_rand {
my %dist = @_;
my ($key, $weight);
while (1) {
my $rand = rand;
while (($key, $weight) = each %dist) {
return $key if ($rand -= $weight) < 0;
}
}
}
sub get_key {
my $hash = shift;
my $objs = $hash->{objs};
my $cat = $hash->{cat};
my $obj = $hash->{obj};
my $ary = $objs->{$cat}->{obj};
for(0..$#$ary) {
if($ary->[$_] eq $obj) {
return $objs->{$cat}->{key}->[$_];
}
}
}
sub place {
my $key = shift;
my $room = shift;
my $done;
do {
my $x = int rand @$room;
my $area = $room->[$x];
my $y = int rand @$area;
if($room->[$x]->[$y] eq "-") {
$room->[$x]->[$y] = $key;
$done = 1;
}
} until $done;
$room;
}
NOTE I've tested this only lightly; there may still be bugs in it.
Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
Read Where should I post X? if you're not absolutely sure you're posting in the right place.
Please read these before you post! —
Posts may use any of the Perl Monks Approved HTML tags:
- a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
| |
For: |
|
Use: |
| & | | & |
| < | | < |
| > | | > |
| [ | | [ |
| ] | | ] |
Link using PerlMonks shortcuts! What shortcuts can I use for linking?
See Writeup Formatting Tips and other pages linked from there for more info.