描画順を計算

calcdraworder.pl

#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;

# 入力ファイルはこんなかんじで
# .......
# ...AA..
# ..BB...
# ..BBC..
# .DBBC..
# .D.....
# .......

{
    #
    # 読み込み
    #
    my %positions_of;
    my $y = 0;
    while (<>) {
        chomp;
        my $x = 0;
        for my $name (split //) {
            if ($name ne ".") {
                push @{ $positions_of{$name} }, [ $x, $y ];
            }
            ++$x;
        }
        ++$y;
    }

    #
    # @blocks にブロック情報を集める
    #
    my @blocks;
    for my $name (keys %positions_of) {
        push @blocks, {
            name      => $name,
            positions => $positions_of{$name},
        };
    }

    #
    # @order に描画順を入れる
    #
    my @order;
    while (@blocks) {
        # @blocksから「他のブロックを隠さないブロック」をとりだし
        # @orderにpush それを繰り返す
        SCAN:
        for my $i (0..$#blocks) {
            my $a = $blocks[$i];
            for my $b (@blocks) {
                if (hides($a, $b)) {
                    next SCAN;
                }
            }
            push @order, splice(@blocks, $i, 1);
            last;
        }
    }

    #
    # 表示
    #
    my %display;
    my $n = 0;
    for my $a (@order) {
        ++$n;
        for my $p (@{ $a->{positions} }) {
            my ($x, $y) = @$p;
            $display{$x, $y} = sprintf("%02d", $n);
        }
    }
    for my $y (0..6) {
        for my $x (0..6) {
            print $display{$x, $y} || ". ";
            print " ";
        }
        print "\n";
    }
}

sub hides {
    my ($a, $b) = @_;
    # この関数はキャッシュできるとイイネ

    return if $a->{name} eq $b->{name};

    for my $p (@{ $a->{positions} }) {
        for my $q (@{ $b->{positions} }) {
            if (_hides($p, $q)) {
                return 1;
            }
        }
    }
    return;
}

sub _hides {
    my ($p, $q) = @_;

    my ($px, $py) = @{ $p };
    my ($qx, $qy) = @{ $q };

    return if $px == $qx && $py == $qy;
    return if $px <  $qx || $py <  $qy;

    my $d = ($px - $qx) - ($py - $qy);
    return if $d < -1 || $d > 1;

    return 1;
}