[原创代码] Perl 绘制3D模型文件 - 斯坦福兔子 (ply格式)

523066680

模型文件下载地址
http://www.cc.gatech.edu/projects/large_models/bunny.html

以及针对这只兔子的渲染代码，没有做成通用的，在加载不同模型的时候需要自己调整大小和位置以适应窗口

使用说明：需要 OpenGL 模块的支持，成功渲染后，按 w a s d, j k 可以旋转观察角度。

=Copy is not Right
    Author: 523066680@163.com
      Date: 2016-12
=cut

use v5.16;
use IO::Handle;
use OpenGL qw/ :all /;
use OpenGL::Config;
use Time::HiRes 'sleep';
use feature 'state';
STDOUT->autoflush(1);

our $WinID;
our $width  = 500;
our $height = 500;

our $rx = 0.0;
our $ry = 0.0;
our $rz = 0.0;

my @vtx;
my @faces;

open READ, "<:raw", "bunny.ply";
my $models = 0;

for  my $e ( <READ> )
{
    $e =~ s/\r?\n$//;
    if ($e =~ /v ([^\s]+) ([^\s]+) ([^\s]+)/i )
    {
        #考虑 科学表示法的情况 5.5e-05
        push @vtx, [ sprintf("%f", $1) * 1500.0, 
                     sprintf("%f", $2) * 1500.0, 
                     sprintf("%f", $3) * 1500.0 ] ;
    }
    elsif ($e =~ /f (\d+) (\d+) (\d+)/i ) 
    { 
        #某些模型文件的三角形索引从 1 开始
        push @faces, 
            [
                $1 - 1, 
                $2 - 1, 
                $3 - 1 
            ];
    }
    else 
    {
        printf("Other: $e\n"); 
    }

    if ($e =~ /feature/i )
    {
        $models++;
        if ($models > 1)
        {
            #last;
        }
    }
}
close READ;

printf("%d %d\n", $#vtx, $#faces);

printf("%f %f %f\n", $vtx[0]->[0], $vtx[0]->[1], $vtx[0]->[2] );
my @nums;
grep { push @nums, @{$_} } @faces;
@nums = (sort { $a <=> $b } @nums);
printf("\n %d\n", $nums[$#nums]);

&Main();

sub normalize
{
    my $v = shift;
    my $d = sqrt($v->[0]*$v->[0] + $v->[1]*$v->[1] + $v->[2]*$v->[2]);
    if ($d == 0.0)
    {
        printf("length zero!\n");
        return;
    }

    $v->[0] /= -$d;
    $v->[1] /= -$d;
    $v->[2] /= -$d;
}

sub normcrossprod
{
    my ( $v1, $v2, $out ) = @_;

    $out->[0] = $v1->[1] * $v2->[2] - $v1->[2] * $v2->[1];
    $out->[1] = $v1->[2] * $v2->[0] - $v1->[0] * $v2->[2];
    $out->[2] = $v1->[0] * $v2->[1] - $v1->[1] * $v2->[0];

    normalize( $out );
}

sub initlist
{
    my $idx;
    my $base = glGenLists(1);
    my ($a, $b, $c);

    my @tpa;
    my @tpb;
    my @norm = ();

    glNewList($base, GL_COMPILE);

    glBegin(GL_TRIANGLES);

    for my $i ( 0 ..  $#faces )
    {
        ($a, $b, $c) = @{ $faces[$i] } ;

        for ( 0 .. 2 )
        {
            $tpa[$_] = $vtx[$b]->[$_] - $vtx[$a]->[$_] ;
            $tpb[$_] = $vtx[$c]->[$_] - $vtx[$a]->[$_] ;
        }

        glColor3f( 0.9, 0.6, 0.2 );
        normcrossprod( \@tpa, \@tpb, \@norm );

        glNormal3f( @norm );
        glVertex3f( @{$vtx[$a]} );
        glVertex3f( @{$vtx[$b]} );
        glVertex3f( @{$vtx[$c]} );
    }
    glEnd();

    glEndList();
}

sub display 
{
    my $idx;
    glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT);

    glPushMatrix();
    glRotatef($rx, 1.0, 0.0, 0.0);
    glRotatef($ry, 0.0, 1.0, 0.0);
    glRotatef($rz, 0.0, 0.0, 1.0);
    glTranslatef(0.0, -150.0, 0.0);
    glColor4f(0.8, 0.8, 0.5, 0.5);

    glCallList(1);

    glPopMatrix();
    glutSwapBuffers();
}

sub init
{
    glClearColor(0.0, 0.0, 0.0, 0.5);
    glPointSize(1.0);
    glLineWidth(1.0);
    glEnable(GL_DEPTH_TEST);
    glEnable(GL_POINT_SMOOTH);
    glEnable(GL_LINE_SMOOTH);
    
    my @mat_ambient = ( 0.5, 0.5, 0.5, 1.0 );
    my @mat_specular = ( 1.0, 1.0, 1.0, 1.0 );
    my @mat_shininess = ( 10.0 );
    my @mat_diffuse = (0.5, 0.5, 0.5, 1.0);

    my @light_specular = ( 0.5, 0.5, 0.5, 1.0 );
    my @light_position = ( 200.0, 400.0, 0.0, 0.0 );

    my $ambient  = OpenGL::Array->new( 4, GL_FLOAT);
    my $specular = OpenGL::Array->new( 4, GL_FLOAT);
    my $diffuse  = OpenGL::Array->new( 4, GL_FLOAT);
    my $shininess = OpenGL::Array->new( 1, GL_FLOAT);

    my $light_position = OpenGL::Array->new( 4, GL_FLOAT);
    my $light_specular = OpenGL::Array->new( 4, GL_FLOAT);

    $ambient->assign(0,  ( 0.5, 0.5, 0.5, 1.0 ) );
    $specular->assign(0, ( 1.0, 1.0, 1.0, 1.0 ) );
    $diffuse->assign(0,  ( 0.5, 0.5, 0.5, 1.0 ) );
    $shininess->assign(0,  10.0 );

    $light_position->assign(0, ( 200.0, 200.0, 0.0, 0.0 ) );

    glMaterialfv_c(GL_FRONT_AND_BACK, GL_AMBIENT, $ambient->ptr );
    glMaterialfv_c(GL_FRONT_AND_BACK, GL_SPECULAR, $specular->ptr );
    glMaterialfv_c(GL_FRONT_AND_BACK, GL_DIFFUSE, $diffuse->ptr );
    glMaterialfv_c(GL_FRONT_AND_BACK, GL_SHININESS, $shininess->ptr );

    glLightfv_c(GL_LIGHT0, GL_POSITION, $light_position->ptr);

    glEnable(GL_LIGHTING);
    glEnable(GL_LIGHT0);

    glColorMaterial(GL_FRONT, GL_DIFFUSE);
    glEnable(GL_COLOR_MATERIAL);

    initlist();
}

sub idle 
{
    sleep 0.001;
    glutPostRedisplay();
}

sub Reshape 
{
    my ($w, $h) = (shift, shift);
    my $half = 200.0;
    my $fa = 250.0;

    glViewport(0, 0, $w, $h);
    glMatrixMode(GL_PROJECTION);
    glLoadIdentity();
    #glOrtho(-$half, $half, -$half, $half, 0.0, $fa*2.0); 
    gluPerspective( 90.0, 1.0, 1.0, $fa*2.0 );
    glMatrixMode(GL_MODELVIEW);
    glLoadIdentity();
    gluLookAt(0.0,0.0,$fa,0.0,0.0,0.0, 0.0,1.0, $fa);
}

sub hitkey 
{
    our $WinID;
    my $k = lc(chr(shift));

    given ($k)
    {
        when ('q') { glutDestroyWindow( $WinID ); }
        when ('a') { $ry-=3.0; }
        when ('d') { $ry+=3.0; }
        when ('w') { $rx+=3.0; }
        when ('s') { $rx-=3.0; }
        when ('j') { $rz+=3.0; }
        when ('k') { $rz-=3.0; }
    }

}

sub Main 
{
    glutInit();
    glutInitDisplayMode(GLUT_RGBA | GLUT_DOUBLE |GLUT_DEPTH |GLUT_MULTISAMPLE );
    glutInitWindowSize(500, 500);
    glutInitWindowPosition(1,1);
    our $WinID = glutCreateWindow("bunny");
    &init();
    glutDisplayFunc(\&display);
    glutReshapeFunc(\&Reshape);
    glutKeyboardFunc(\&hitkey);
    glutIdleFunc(\&idle);
    glutMainLoop();
}
复制代码

523066680

强行转 Perl 代码发帖。

转换过程中感到的明显缺点是，大量的敲打 $ 符号。
爽快的地方：

• given when 语句比 switch case 整洁多了。
  
• 从纯文本文件中读取数据、处理数据相对方便
  

523066680

回复 3# codegay


    另一种扫描没这么精细的三角形网格反而好看一些。
http://graphics.stanford.edu/pub/3Dscanrep/bunny.tar.gz

bun_zipper_res3.ply



代码稍作修改