test/OpenGL/tutorial/lesson06.pl

   1 #!/usr/bin/perl -w
   2 # This code was created by Jeff Molofee '99
   3 # (ported to SDL by Sam Lantinga '2000)
   4 # (ported to Perl/SDL by Wayne Keenan '2000)
   5 #
   6 # If you've found this code useful, please let me know.
   7 #
   8 # Visit me at www.demonews.com/hosted/nehe
   9
  10 use strict;
  11 use Getopt::Long;
  12 use Data::Dumper;
  13 use Benchmark;
  14
  15 use SDL;
  16 use SDL::App;
  17 use SDL::OpenGL;
  18 use SDL::Event;
  19
  20 my $arg_screen_width =640;
  21 my $arg_screen_height=512;
  22 my $arg_fullscreen=0;
  23 my $delay = 3;
  24
  25 GetOptions(
  26            "width:i"        => \$arg_screen_width,
  27            "height:i"       => \$arg_screen_height,
  28            "fullscreen!"    => \$arg_fullscreen,
  29            "delay:i"    => \$delay,
  30
  31           ) or die $!;
  32
  33 ############################################################
  34
  35 my ($xrot, $yrot, $zrot) = (0,0,0);
  36
  37 main();
  38 exit;
  39
  40
  41 sub main
  42   {
  43    my $done=0;
  44
  45    my $app = new SDL::App ( -title => "Jeff Molofee's GL Code Tutorial ... NeHe '99",
  46                             -icon => "Data/perl.png",
  47                             -width => $arg_screen_width,
  48                             -height =>$arg_screen_height,
  49                             -opengl => 1,
  50                           );
  51    $app->fullscreen() if $arg_fullscreen;
  52
  53    SDL::ShowCursor(0);
  54
  55    my $event = new SDL::Event;
  56    $event->set(SDL_SYSWMEVENT,SDL_IGNORE);
  57
  58    InitGL($arg_screen_width, $arg_screen_height);
  59
  60
  61    while ( not $done ) {
  62
  63     DrawGLScene();
  64
  65     $app->sync();
  66
  67     for (1 .. 10) {
  68         $event->pump;
  69         $event->poll;
  70         $app->delay($delay);
  71     }
  72
  73
  74     if ( $event->type == SDL_QUIT ) {
  75      $done = 1;
  76     }
  77
  78     if ( $event->type == SDL_KEYDOWN ) {
  79      if ( $event->key_sym == SDLK_ESCAPE ) {
  80       $done = 1;
  81      }
  82     }
  83    }
  84   }
  85
  86
  87
  88
  89
  90
  91 #########################################################################
  92 #Pretty much in original form, but 'Perlised'
  93
  94
  95
  96
  97 sub InitGL
  98   {
  99    my ($Width, $Height) = @_;
 100
 101    glViewport(0, 0, $Width, $Height);
 102
 103    LoadGLTextures();                            # Load The Texture(s)
 104
 105    glEnable(GL_TEXTURE_2D());                   # Enable Texture Mapping
 106
 107    glClearColor(0.0, 0.0, 1.0, 0.0);                            # This Will Clear The Background Color To Black
 108    glClearDepth(1.0);                                           # Enables Clearing Of The Depth Buffer
 109    glDepthFunc(GL_LESS);                                        # The Type Of Depth Test To Do
 110    glEnable(GL_DEPTH_TEST);                                     # Enables Depth Testing
 111    glShadeModel(GL_SMOOTH);                                     # Enables Smooth Color Shading
 112
 113    glMatrixMode(GL_PROJECTION);
 114    glLoadIdentity();                                            # Reset The Projection Matrix
 115
 116    gluPerspective(45.0, $Width/$Height, 0.1, 100.0);            # Calculate The Aspect Ratio Of The Window
 117
 118    glMatrixMode(GL_MODELVIEW);
 119   }
 120
 121
 122
 123 # The main drawing function.
 124 sub DrawGLScene
 125   {
 126    glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT);          # Clear The Screen And The Depth Buffer
 127    glLoadIdentity();                                            # Reset The View
 128
 129
 130    glTranslate(0.0,0.0,-5.0);                                  # move 5 units into the screen.
 131
 132    glRotate($xrot,1.0,0.0,0.0);                         # Rotate On The X Axis
 133    glRotate($yrot,0.0,1.0,0.0);                         # Rotate On The Y Axis
 134    glRotate($zrot,0.0,0.0,1.0);                         # Rotate On The Z Axis
 135
 136    glBindTexture(GL_TEXTURE_2D, 1);   # choose the texture to use.
 137
 138    glBegin(GL_QUADS);                                           # begin drawing a cube
 139
 140    # Front Face (note that the texture's corners have to match the quad's corners)
 141    glTexCoord(0.0, 0.0); glVertex(-1.0, -1.0,  1.0);    # Bottom Left Of The Texture and Quad
 142    glTexCoord(1.0, 0.0); glVertex( 1.0, -1.0,  1.0);    # Bottom Right Of The Texture and Quad
 143    glTexCoord(1.0, 1.0); glVertex( 1.0,  1.0,  1.0);    # Top Right Of The Texture and Quad
 144    glTexCoord(0.0, 1.0); glVertex(-1.0,  1.0,  1.0);    # Top Left Of The Texture and Quad
 145
 146    # Back Face
 147    glTexCoord(1.0, 0.0); glVertex(-1.0, -1.0, -1.0);    # Bottom Right Of The Texture and Quad
 148    glTexCoord(1.0, 1.0); glVertex(-1.0,  1.0, -1.0);    # Top Right Of The Texture and Quad
 149    glTexCoord(0.0, 1.0); glVertex( 1.0,  1.0, -1.0);    # Top Left Of The Texture and Quad
 150    glTexCoord(0.0, 0.0); glVertex( 1.0, -1.0, -1.0);    # Bottom Left Of The Texture and Quad
 151
 152    # Top Face
 153    glTexCoord(0.0, 1.0); glVertex(-1.0,  1.0, -1.0);    # Top Left Of The Texture and Quad
 154    glTexCoord(0.0, 0.0); glVertex(-1.0,  1.0,  1.0);    # Bottom Left Of The Texture and Quad
 155    glTexCoord(1.0, 0.0); glVertex( 1.0,  1.0,  1.0);    # Bottom Right Of The Texture and Quad
 156    glTexCoord(1.0, 1.0); glVertex( 1.0,  1.0, -1.0);    # Top Right Of The Texture and Quad
 157
 158    # Bottom Face
 159    glTexCoord(1.0, 1.0); glVertex(-1.0, -1.0, -1.0);    # Top Right Of The Texture and Quad
 160    glTexCoord(0.0, 1.0); glVertex( 1.0, -1.0, -1.0);    # Top Left Of The Texture and Quad
 161    glTexCoord(0.0, 0.0); glVertex( 1.0, -1.0,  1.0);    # Bottom Left Of The Texture and Quad
 162    glTexCoord(1.0, 0.0); glVertex(-1.0, -1.0,  1.0);    # Bottom Right Of The Texture and Quad
 163
 164    # Right face
 165    glTexCoord(1.0, 0.0); glVertex( 1.0, -1.0, -1.0);    # Bottom Right Of The Texture and Quad
 166    glTexCoord(1.0, 1.0); glVertex( 1.0,  1.0, -1.0);    # Top Right Of The Texture and Quad
 167    glTexCoord(0.0, 1.0); glVertex( 1.0,  1.0,  1.0);    # Top Left Of The Texture and Quad
 168    glTexCoord(0.0, 0.0); glVertex( 1.0, -1.0,  1.0);    # Bottom Left Of The Texture and Quad
 169
 170    # Left Face
 171    glTexCoord(0.0, 0.0); glVertex(-1.0, -1.0, -1.0);    # Bottom Left Of The Texture and Quad
 172    glTexCoord(1.0, 0.0); glVertex(-1.0, -1.0,  1.0);    # Bottom Right Of The Texture and Quad
 173    glTexCoord(1.0, 1.0); glVertex(-1.0,  1.0,  1.0);    # Top Right Of The Texture and Quad
 174    glTexCoord(0.0, 1.0); glVertex(-1.0,  1.0, -1.0);    # Top Left Of The Texture and Quad
 175
 176    glEnd();                                                     # done with the polygon.
 177
 178    $xrot+=15.0;                                                 # X Axis Rotation
 179    $yrot+=15.0;                                                 # Y Axis Rotation
 180    $zrot+=15.0;                                                 # Z Axis Rotation
 181
 182
 183   }
 184
 185 #my $image1,$a;  #this can cause a segfault in LoadGLTextures/glTexImage2D   !!!
 186
 187
 188 sub LoadGLTextures
 189   {
 190     # Load Texture
 191
 192    #uncomment this for a different method of loading:
 193    #my $img_data  = read_gfx_file(FILENAME=>"../../ScrollerDemos/backdrop2.h");
 194    #my $pixel_ptr = $img_data->{PIXEL_PTR};
 195    #my $pic_info  = $img_data->{INFO};
 196    #my $width     = $pic_info->{WIDTH};
 197    #my $height    = $pic_info->{HEIGHT};
 198
 199
 200    #if you uncomment the bit above, comment this out:
 201    #-snip-
 202    my $surface=create_SDL_surface_from_file("Data/crate.png");
 203    my $width=$surface->width();
 204    my $height=$surface->height();
 205    my $pitch = $surface->pitch();
 206    my $bytespp=  $surface->bytes_per_pixel();
 207    my $size=$pitch*$height;
 208    my $pixels = $surface->pixels();
 209
 210    # Create Texture
 211    my $textures = glGenTextures(1);                #name texture
 212         die "Could not genereate textures" unless $$textures[0];
 213
 214    glBindTexture(GL_TEXTURE_2D, $$textures[0]);   # 2d texture
 215
 216
 217    glTexParameter(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); # scale linearly when image bigger than texture
 218    glTexParameter(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); # scale linearly when image smalled than texture
 219
 220    glTexImage2D(GL_TEXTURE_2D(),
 221                    0,                      #level (0 normal, heighr is form mip-mapping)
 222                    GL_RGB(),                      #internal format (3=GL_RGB)
 223                    $width,$height,
 224                    0,                      # border
 225                    GL_RGB(),                 #format RGB color data
 226                   GL_UNSIGNED_BYTE(),       #unsigned bye data
 227                   $pixels);            #ptr to texture data
 228
 229     die "Problem setting up 2d Texture (dimensions not a power of 2?)):".glErrorString(glGetError())."\n" if glGetError();
 230
 231   }
 232
 233 sub create_SDL_surface_from_file
 234   {
 235    my $filename=shift;
 236
 237    my $surface = new SDL::Surface( -name  => $filename);
 238
 239    return $surface;
 240
 241   }
 242
 243
 244
 245
 246
 247 ###################
 248 #alternat loading support:
 249
 250 #keep ref counts up:
 251 my @sprite_c_heap =();
 252 my @sprite_area =();
 253
 254 sub read_gfx_file
 255   {
 256    my %args=(
 257              TYPE       => "GIMP_HEADER",
 258              FILENAME  => undef,
 259              @_,
 260             );
 261
 262    my $struct   = read_gimp_header_image($args{FILENAME});
 263    my $size     = length $struct->{DATA};
 264    my $c_array  = new OpenGL::Array  $size  , GL_UNSIGNED_BYTE;
 265
 266    # c_array is the main reason to do the following ref count trickster:
 267    # (otherwise the OpenGL:Array goes out of scope and the memory (image) is ZEROed out (and invalidated) by the DESTROY method
 268    push @sprite_c_heap,  $c_array;
 269    push @sprite_area,    $struct;
 270
 271    $c_array->assign_data(0, $struct->{DATA} );   #take a copy of the data
 272
 273    return {
 274            PIXEL_PTR   => $c_array->ptr(), #could return $c_array instead to kepe ref count alive
 275            INFO        => $struct,
 276           };
 277
 278    #that all needs modularising.....
 279
 280   }
 281
 282
 283 #nasty fixed to 3 byte RGB
 284 sub read_gimp_header_image
 285   {
 286    my $file=shift;
 287    my $cached_file="$file.cached-bin";
 288
 289    my ($width, $height,$pixel_format, $data)=(0,0,"RGB","");
 290
 291    #due to that fact that this aint the fastest code ever, we keep a cache.
 292    if (-e $cached_file and (-C $file >= -C $cached_file))
 293      {
 294
 295       print "Reading cached binary bitmap data :  $cached_file\n";
 296       open (FH, "<$file.cached-bin") or die "Open: $!";
 297       my $line="";
 298       $width=<FH>;
 299       $height=<FH>;
 300       $pixel_format=<FH>;
 301       chomp $width;
 302       chomp $height;
 303       chomp $pixel_format;  #but who cares? not here anyway!!!
 304
 305       #slurp in the rest of the file (its pixel data)
 306       {
 307        local $/;
 308        undef $/;
 309
 310        my @lines= <FH>;
 311        $data=join '', @lines;
 312       }
 313
 314       close (FH);
 315      }
 316    else                 # there is no cached file, or the cached file is out of date.
 317      {
 318
 319       open (FH, "<$file") or die "Open: $!";
 320
 321       my @data=();
 322       my @pixel=();
 323       while (defined (my $line=<FH>))
 324         {
 325          $width =$1 if ($line =~ /width\s*=\s*(\d+)/);
 326          $height=$1 if ($line =~ /height\s*=\s*(\d+)/);
 327          if ($line =~ /^\s+\"(.+)\"$/g)
 328            {
 329             my $c=$1;
 330             $c =~ s/\\(.)/$1/g;                                 #remove meta guard
 331             $c =~
 332               s/
 333                 \G
 334                   (.)(.)(.)(.)
 335                     /
 336                       @data=(ord($1),ord($2),ord($3),ord($4));
 337
 338             chr    (  (  (  ( $data[0] - 33) <<  2)       | (  ($data[1] - 33) >> 4) ) ).
 339               chr (  (  (  (  ( $data[1] - 33) & 0xF) << 4) | (  ($data[2] - 33) >> 2) ) ).
 340                 chr (  (  (  (  ( $data[2] - 33) & 0x3) << 6) | (  ($data[3] - 33)     ) ) );
 341             /gex;
 342
 343             $data.=$c ;
 344            }
 345         }
 346
 347
 348       close(FH);
 349
 350       print "Writing cached binary bitmap data for:  $file as $cached_file\n";
 351
 352       #create a binary cached copy
 353       open (FH, ">$cached_file") or die "Open: $!";
 354       binmode FH;  #we might have to put up with weak OSes.
 355       print FH  "$width\n$height\n$pixel_format\n$data";
 356
 357       close(FH);
 358      }
 359
 360
 361
 362
 363    return {
 364            WIDTH  => $width,
 365            HEIGHT => $height,
 366            FORMAT => $pixel_format,
 367            DATA   => $data
 368           };
 369   }
 370
 371