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.