[Perl]迷宫寻路

There's more than one way to do it!

[Perl]迷宫寻路

帖子523066680 » 2016-06-26 8:32

来自 http://迷路.jp 的图片
[url=http://迷路.jp/t007/]ありがとう「迷路.jp」2周年の迷路[/url]

以下图片,另存为 2.bmp
图片

Syntax: [ Download ] [ Hide ]
use v5.16;
use feature "state";
use IO::Handle;
use OpenGL qw/ :all /;
use OpenGL::Config;
use Time::HiRes 'sleep','time';

STDOUT->autoflush(1);

use utf8;
use Encode;
use IO::Handle;
STDOUT->autoflush(1);
binmode(STDOUT, ":encoding(gbk)");

our $WinID;
our $win_x = 500;
our $win_y = 500;
our $PI = 3.1415927;
our $PIx2 = $PI * 2;

my $file = "2.bmp";
my $READ;

open $READ, "<:raw", $file or die "$!";

my $v;
read($READ, $v, 14, 0);
our ($type, $bfSize, $res1, $res2, $offset) = (unpack 'SLSSL', $v);

read($READ, $v, 4+4+4+2+2, 0);
our ($headSize, $width, $height, $planes, $bitCount) = (unpack 'L3S2', $v);

our $Compoments_per_pixel = $bitCount / 8;
#有可能是RGBA,4个字节 => 32位情况下
#有可能是RGB, 3个字节 => 24位情况下

printf "文件字节数:%04x -> %d\n", $bfSize, $bfSize;
printf "位图偏移量:%04x -> %d\n", $offset, $offset;
printf "   宽 × 高:%d×%d\n", $width, $height;
printf "  位图色深:%d 位\n", $bitCount;

#实际宽度
#Windows的BMP规定一个扫描行所占的字节数必须是 4字节的倍数,不足的以0填充
my $rowLen = ($bfSize - $offset) / $height;
my $rowCut = ($width * $Compoments_per_pixel) % 4; #RGBA的情况下自然为0

#跳过文件头
seek($READ, $offset, 0);

my ($R, $G, $B);
my $col = 0;
my $lines = 0;
my $j = 0;
my @Colors;
our %Coord;
our @step;
our %badway;
our %way;

=way struct
    {
        "ox oy" =>
            {
                "ang" => $ang,   #当前ang
                "way" => [ratio1, ratio2, ratio3]
            }
    }
=cut

our $theVortex;
our $delay;
our $WRT;
open $WRT,">:raw", "log.txt";


while ( read( $READ, $v, $Compoments_per_pixel, 0) )
{
    $col++;
    ($B, $G, $R) = unpack("C$Compoments_per_pixel", $v);  #C4

    $Colors[$j++] =
    {
        'R'=>$R/255.0,
        'G'=>$G/255.0,
        'B'=>$B/255.0,
        'X'=>$col,
        'Y'=>$lines
    };

    #@{$Coord{$col}{$lines}{'R','G','B'}} = ($R, $G, $B);  #problem, keys => RGB

    $Coord{$col}{$lines} =
    {
        'R' => $R,
        'G' => $G,
        'B' => $B,
    };

    if ($col == $width)
    {
        seek($READ, $rowCut, 1);     #从当前去掉多余的填充字节
        $col = 0;
        $lines++;
    }
}

close $READ;

my @xrr;
my @yrr;
for my $info (@Colors)
{
    if ($info->{'R'} < 0.5 and $info->{'G'} < 0.5 and $info->{'B'} < 0.5 )
    {
        push @xrr, $info->{'X'};
        push @yrr, $info->{'Y'};
    }
}

#print join(", ", @xrr),"\n";
#print join(", ", @yrr);
#exit;

&Main();

sub display
{
    state $times = 0;
    our $WinID;
    our %coord;
    our @step;
    our %badway;
    our %way;

    our $PI;
    our $PIx2;

    my $radDelta = $PIx2 / 50.0 ;
    my $limit = 120.0/360.0*$PIx2 ;
    my $len = 8.0;
    my $testlen = 10.0;
    my $ratio;
    my $rad;
    my $angx;

    my $ref;

    state $ox = 137;
    state $oy = 500 - 451;
    state $ang = 70.0/360.0 * $PIx2;

    my ($tx, $ty);
    my ($n_x, $n_y);

    glPushMatrix();
        glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT);
       
        glCallList($theVortex);

        my $flag;

        my $ways = 0;
        if (not defined $way{"$ox $oy"} )
        {
LV1:        for ( $ratio = -$limit; $ratio <= $limit; $ratio += $radDelta )
            {
                $angx = $ang + $ratio;

                $flag = linetest( $ox, $oy, $len, $angx );
                if ($flag == 1)
                {
                    $ways++;

                    #走中间线
                    $rad = 0.0;
                    do
                    {
                        $rad += $radDelta;
                    }
                    while ( (linetest( $ox, $oy, $testlen, $angx+$rad ) == 1) and ($rad < $PI) );

                    $angx += $rad/2;  #中间位置
                    $ratio += $rad + (10.0/360.0*$PIx2);   #略过这个连续区域

                    $tx = $ox + around( $len * cos($angx) );
                    $ty = $oy + around( $len * sin($angx) );

                    glColor4f(1.0, 0.0, 1.0, 0.7);
                    draw_line($ox, $oy, $tx, $ty, 1.0);

                    push @{$way{"$ox $oy"}{'way'}},
                            {
                                'angx' => $angx,
                                'tx'   => $tx,
                                'ty'   => $ty,
                            };
                }
            }
        }

       
        glBlendFunc(GL_DST_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
        glBegin(GL_LINE_STRIP);
        glColor4f(0.0, 0.2, 0.2, 0.8);
        for my $i ( 0 .. $#step )
        {
            glVertex3f( $step[$i]->[0], $step[$i]->[1], 1.0 );
        }
        glEnd();
       

        $ref = $way{"$ox $oy"}{'way'};

        if ( $#{$ref} >= 0 )  #存在多条路径的时候,存储当前节点,回退的时候用
        {
            push @step, [$ox, $oy, $ang];
        }

        printf "%3d %3d %7.3f times :%d step: %d ways: %d \n",
            $ox, $oy, $ang ,$times, $#step+1, $ways;

        #print $ref->[0]{'ty'};
            #exit;

        if ( $#{$ref} >= 0 )
        {
            draw_line($ox, $oy, $ref->[0]{'tx'}, $ref->[0]{'ty'}, 1.0);

            $ox = $ref->[0]{'tx'};
            $oy = $ref->[0]{'ty'};
            $ang = $ref->[0]{'angx'};
            shift @{$ref};
        }  
        else
        {
            print "there is no way!\n";
            #pop @step;
            ($ox, $oy, $ang) = @{ $step[$#step] };
            pop @step;
        }
       
    glPopMatrix();
    glutSwapBuffers();
    $times++;
}

sub init
{
    glClearColor(0.0, 0.0, 0.0, 1.0);
    our $t=1.0;
    our $delay;

    $delay = 0.6;
    glPointSize(1.0);
    glLineWidth(2.0);
    glEnable(GL_DEPTH_TEST);
    glEnable(GL_BLEND);
    glEnable(GL_POINT_SMOOTH);
    glEnable(GL_LINE_SMOOTH);

    $theVortex=glGenLists(1);
    glNewList($theVortex, GL_COMPILE);
    drawbmp();
    glEndList();
}

sub drawbmp()
{
        glBegin(GL_POINTS);

        for my $c (@Colors)
        {
            glColor4f( @$c{'R','G','B'}, 1.0 );
            glVertex3f( $c->{'X'}, $c->{'Y'}, 0.0);
        }
        glEnd();
}

sub idle
{
    sleep $delay;
    glutPostRedisplay();
}

sub Reshape
{
    our $width;
    our $height;
    glViewport(0.0, 0.0, $win_x, $win_y);
    glMatrixMode(GL_PROJECTION);
    glLoadIdentity();
    glOrtho(0.0, 500.0, 0.0, 500.0, 0.0,200.0);
    glMatrixMode(GL_MODELVIEW);
    glLoadIdentity();
    gluLookAt(0.0,0.0,100.0,0.0,0.0,0.0, 0.0,1.0,100.0);
}

sub hitkey
{
    our $WinID;
    our %badway;

    my $keychar = lc(chr(shift));
    given ( $keychar )
    {
        when (/q/i) { glutDestroyWindow($WinID); dump_data( \%badway, "batway.txt" ); }
        when (/a/i) { $delay = 2.0; }
        when (/b/i) { $delay = 1.0; }
        when (/c/i) { $delay = 0.5; }
        when (/d/i) { $delay = 0.01; }
        when (/f/i) { glutPostRedisplay()  }
    }
}

sub mouse
{
    our %Coord;
    my (undef, undef, $x, $y) = @_;

    printf "Position %d %d, Color: %d %d %d\n",
        $x, $y,
        $Coord{$x}{500-$y}{'R'},
        $Coord{$x}{500-$y}{'G'},
        $Coord{$x}{500-$y}{'B'},
    ;
}

sub Main
{
    glutInit();
    glutInitDisplayMode( GLUT_DEPTH | GLUT_RGBA | GLUT_DOUBLE );
    glutInitWindowSize($win_x, $win_y);
    glutInitWindowPosition(1,1);
    our $WinID = glutCreateWindow("title");
    &init();
    glutDisplayFunc(\&display);
    glutReshapeFunc(\&Reshape);
    glutKeyboardFunc(\&hitkey);
    glutMouseFunc(\&mouse);
    glutIdleFunc(\&idle);
    glutMainLoop();
}

=Function
=cut

sub around
{
    my $num = shift;
    my $n = int($num);

    if ( $num - $n >= 0.5)
    {
        return $n + 1;
    }
    else
    {
        return $n;
    }
}

sub dump_data
{
    use Data::Dumper;
    my ($hashref, $file) = @_;

    open WRT, ">:raw:crlf", $file or warn "$!";
    print WRT Data::Dumper->Dump([$hashref], ['*badway']);
    close WRT;

    no YAML;
}

sub linetest
{
    our %coord;
    my ($ox, $oy, $len, $angx) = @_;
    my $ref;
    my $flag;
    my $tx;
    my $ty;

    $flag = 1;
    for my $test (1 .. $len+1)
    {
        for my $w ( -1..1 )
        {
            $tx = $ox + around( $test * cos( $angx ) -    $w * sin( $angx)  );
            $ty = $oy + around(    $w * cos( $angx ) + $test * sin ($angx)  );


            if ($ty < 0 or $tx < 0)
            {
                die "What?\n"
            }

            $ref = $Coord{ $tx }{ $ty };
           
            if ( $ref->{'R'} < 150 and $ref->{'G'} < 150 and $ref->{'B'} < 150 )
            {
                $flag = 0;
            }
            else
            {
                # glColor4f(0.5, 0.0, 0.5, 1.0);
                # glBegin(GL_LINES);
                # glVertex3f( $ox, $oy, 0.5);
                # glVertex3f( $tx, $ty, 0.5);
                # glEnd();
            }
        }
    }

    return $flag;
}

sub draw_line
{
    my ($ox, $oy, $tx, $ty, $z) = @_;
    glBegin(GL_LINES);
        glVertex3f( $ox, $oy, $z);
        glVertex3f( $tx, $ty, $z);
    glEnd();
}
 


论坛已转移 Code-By.Org 群号 322023604
头像
523066680
版主
 
帖子: 1680
注册: 2012-03-06 15:08

回到 Perl

在线用户

正在浏览此版面的用户:没有注册用户 和 1 位游客

cron
Not able to open ./cache/data_global.php