Clean up. This dir is still on experimental branch
[sdlgit/SDL_perl.git] / 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