俺用メモ

モンスターの逆襲 (現代教養文庫―アドベンチャーゲームブック)と言うゲームブックがあってですね。
その中で面白いダンジョンの作り方があった訳です。以下略。
そのダンジョンを解析するプログラムを作ったんですが、細かい仕様が思い出せないので、中古で発注しているところです。
で、これをローカルに置いているとどこにおいたか忘れてしまうので（……）ブログに置いておこうと言うことです。

main

use strict;
use warnings;
use Monster;

my $tree = Monster->new(202);
my @temp = ( $tree );
my @line = ();
while ( @temp ) {
	my $node = shift @temp;
	$line[$node->{depth}] .= $node->make_html();
	push @temp, @{$node->{children}};
}

open ( OUT, '>res.htm' );
print OUT "<table border=1>\n";
print OUT map { "<tr>" . $_ . "</tr>\n" } @line;
print OUT "</table>\n";
close ( OUT );

Monstrer.pm

package Monster;
use strict;
use warnings;
our $depth = 0;
our $max = 40000;
our @menber = [];
sub new {
	my $invocant = shift;
	my $class = ref $invocant;
	$class ||= $invocant;
	my $num = shift;
	$menber[$num] and return ();
	my $self = bless {num=>$num}=>$class;
	$menber[$self->{num}] = $self;
	$self->{depth} = shift;
	$self->{depth} ||= 0;
	$self->{depth} > $depth and $depth = $self->{depth};
	$self->{children} = [];
	$self->init();
	return $self;
}

sub init {
	my $self = shift;
	my $num = $self->{num};
	$num > 300 and $num < 401 and return $self; # これ以上子供はいない。
	$self->make_left();
	$self->make_right();
}

sub make_left {
	my $self = shift;
	my $child = ( $self->{num} - 1 ) / 3;
	$child == int ( $child ) or return ();
	$child < 1 and return ();
	push @{$self->{children}}, __PACKAGE__->new($child, $self->{depth}+1);
}

sub make_right {
	my $self = shift;
	my $child = $self->{num} * 4;
	$child > $max and return ();
	push @{$self->{children}}, __PACKAGE__->new($child, $self->{depth}+1);
}

sub colspan {
	my $self = shift;
	my $colspan = 0;
	map { $colspan += $_->colspan() } @{$self->{children}};
	$colspan < 1 and $colspan = 1;
	return $colspan;
}

sub rowspan {
	my $self = shift;
	my $rowspan = 1;
	@{$self->{children}} or $rowspan = $depth - $self->{depth} + 1;
	return $rowspan;
}

sub make_html {
	my $self = shift;
	my $html = "<th colspan=" . $self->colspan() . " rowspan=" . $self->rowspan() . ( $self->{num} > 300 and $self->{num} < 401 ? " bgcolor=#ff0000" : "" ) . ">" . $self->{num} . "</th>";
	return $html;
}
1;

中古が届いたら、仕様を確認してもう一度実行する。