[Perl]迷宫寻路 - 野生算法

There's more than one way to do it!
https://metacpan.org http://perlmonks.org
回复
头像
523066680
Administrator
Administrator
帖子: 573
注册时间: 2016年07月19日 12:14
联系:

[Perl]迷宫寻路 - 野生算法

帖子 523066680 »

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

左边的图片,另存为 2.bmp (右图为演示)
[image 400,400]http://imgout.ph.126.net/50992001/2.jpg[/image] [image 400,400]http://imgout.ph.126.net/50992002/3.jpg[/image]
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();
}
回复

在线用户

正浏览此版面之用户: 没有注册用户 和 6 访客