[sdlgit/SDL_perl.git] / test / OpenGL / tutorial / lesson06.pl

#!/usr/bin/perl -w
# This code was created by Jeff Molofee '99
# (ported to SDL by Sam Lantinga '2000)
# (ported to Perl/SDL by Wayne Keenan '2000)
#
# If you've found this code useful, please let me know.
#
# Visit me at www.demonews.com/hosted/nehe 

use strict;
use Getopt::Long;
use Data::Dumper;
use Benchmark;

use SDL;
use SDL::App;
use SDL::OpenGL;
use SDL::Event;

my $arg_screen_width =640;
my $arg_screen_height=512;
my $arg_fullscreen=0;
my $delay = 3;

GetOptions(
	   "width:i"        => \$arg_screen_width,
	   "height:i"       => \$arg_screen_height,
	   "fullscreen!"    => \$arg_fullscreen,
	   "delay:i"	=> \$delay,

	  ) or die $!;

############################################################

my ($xrot, $yrot, $zrot) = (0,0,0);

main();
exit;


sub main
  {  
   my $done=0;
   
   my $app = new SDL::App ( -title => "Jeff Molofee's GL Code Tutorial ... NeHe '99", 
			    -icon => "Data/perl.png",
			    -width => $arg_screen_width,
			    -height =>$arg_screen_height,
			    -opengl => 1,
			  );
   $app->fullscreen() if $arg_fullscreen;
   
   SDL::ShowCursor(0);   

   my $event = new SDL::Event;
   $event->set(SDL_SYSWMEVENT,SDL_IGNORE);
   
   InitGL($arg_screen_width, $arg_screen_height);


   while ( not $done ) {

    DrawGLScene();

    $app->sync();
   
    for (1 .. 10) {
    	$event->pump;
    	$event->poll;
    	$app->delay($delay);
    }
    
    
    if ( $event->type == SDL_QUIT ) {
     $done = 1;
    }

    if ( $event->type == SDL_KEYDOWN ) {
     if ( $event->key_sym == SDLK_ESCAPE ) {
      $done = 1;
     }
    }
   }
  }


#########################################################################
#Pretty much in original form, but 'Perlised' 


sub InitGL
  {
   my ($Width, $Height) = @_;

   glViewport(0, 0, $Width, $Height);

   LoadGLTextures();				# Load The Texture(s) 

   glEnable(GL_TEXTURE_2D());			# Enable Texture Mapping

   glClearColor(0.0, 0.0, 1.0, 0.0);				# This Will Clear The Background Color To Black
   glClearDepth(1.0);						# Enables Clearing Of The Depth Buffer
   glDepthFunc(GL_LESS);					# The Type Of Depth Test To Do
   glEnable(GL_DEPTH_TEST);					# Enables Depth Testing
   glShadeModel(GL_SMOOTH);					# Enables Smooth Color Shading
   
   glMatrixMode(GL_PROJECTION);
   glLoadIdentity();						# Reset The Projection Matrix
   
   gluPerspective(45.0, $Width/$Height, 0.1, 100.0);		# Calculate The Aspect Ratio Of The Window
   
   glMatrixMode(GL_MODELVIEW);
  }


# The main drawing function.
sub DrawGLScene
  {
   glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT);		# Clear The Screen And The Depth Buffer
   glLoadIdentity();						# Reset The View
   
 
   glTranslate(0.0,0.0,-5.0);                                  # move 5 units into the screen.
   
   glRotate($xrot,1.0,0.0,0.0);				# Rotate On The X Axis
   glRotate($yrot,0.0,1.0,0.0);				# Rotate On The Y Axis
   glRotate($zrot,0.0,0.0,1.0);				# Rotate On The Z Axis
   
   glBindTexture(GL_TEXTURE_2D, 1);   # choose the texture to use.
   
   glBegin(GL_QUADS);						# begin drawing a cube
   
   # Front Face (note that the texture's corners have to match the quad's corners)
   glTexCoord(0.0, 0.0); glVertex(-1.0, -1.0,  1.0);	# Bottom Left Of The Texture and Quad
   glTexCoord(1.0, 0.0); glVertex( 1.0, -1.0,  1.0);	# Bottom Right Of The Texture and Quad
   glTexCoord(1.0, 1.0); glVertex( 1.0,  1.0,  1.0);	# Top Right Of The Texture and Quad
   glTexCoord(0.0, 1.0); glVertex(-1.0,  1.0,  1.0);	# Top Left Of The Texture and Quad
   
   # Back Face
   glTexCoord(1.0, 0.0); glVertex(-1.0, -1.0, -1.0);	# Bottom Right Of The Texture and Quad
   glTexCoord(1.0, 1.0); glVertex(-1.0,  1.0, -1.0);	# Top Right Of The Texture and Quad
   glTexCoord(0.0, 1.0); glVertex( 1.0,  1.0, -1.0);	# Top Left Of The Texture and Quad
   glTexCoord(0.0, 0.0); glVertex( 1.0, -1.0, -1.0);	# Bottom Left Of The Texture and Quad
   
   # Top Face
   glTexCoord(0.0, 1.0); glVertex(-1.0,  1.0, -1.0);	# Top Left Of The Texture and Quad
   glTexCoord(0.0, 0.0); glVertex(-1.0,  1.0,  1.0);	# Bottom Left Of The Texture and Quad
   glTexCoord(1.0, 0.0); glVertex( 1.0,  1.0,  1.0);	# Bottom Right Of The Texture and Quad
   glTexCoord(1.0, 1.0); glVertex( 1.0,  1.0, -1.0);	# Top Right Of The Texture and Quad
   
   # Bottom Face       
   glTexCoord(1.0, 1.0); glVertex(-1.0, -1.0, -1.0);	# Top Right Of The Texture and Quad
   glTexCoord(0.0, 1.0); glVertex( 1.0, -1.0, -1.0);	# Top Left Of The Texture and Quad
   glTexCoord(0.0, 0.0); glVertex( 1.0, -1.0,  1.0);	# Bottom Left Of The Texture and Quad
   glTexCoord(1.0, 0.0); glVertex(-1.0, -1.0,  1.0);	# Bottom Right Of The Texture and Quad
   
   # Right face
   glTexCoord(1.0, 0.0); glVertex( 1.0, -1.0, -1.0);	# Bottom Right Of The Texture and Quad
   glTexCoord(1.0, 1.0); glVertex( 1.0,  1.0, -1.0);	# Top Right Of The Texture and Quad
   glTexCoord(0.0, 1.0); glVertex( 1.0,  1.0,  1.0);	# Top Left Of The Texture and Quad
   glTexCoord(0.0, 0.0); glVertex( 1.0, -1.0,  1.0);	# Bottom Left Of The Texture and Quad
   
   # Left Face
   glTexCoord(0.0, 0.0); glVertex(-1.0, -1.0, -1.0);	# Bottom Left Of The Texture and Quad
   glTexCoord(1.0, 0.0); glVertex(-1.0, -1.0,  1.0);	# Bottom Right Of The Texture and Quad
   glTexCoord(1.0, 1.0); glVertex(-1.0,  1.0,  1.0);	# Top Right Of The Texture and Quad
   glTexCoord(0.0, 1.0); glVertex(-1.0,  1.0, -1.0);	# Top Left Of The Texture and Quad
   
   glEnd();							# done with the polygon.
   
   $xrot+=15.0;							# X Axis Rotation	
   $yrot+=15.0;							# Y Axis Rotation
   $zrot+=15.0;							# Z Axis Rotation

   
  }

#my $image1,$a;  #this can cause a segfault in LoadGLTextures/glTexImage2D   !!!


sub LoadGLTextures
  {
    # Load Texture

   #uncomment this for a different method of loading:
   #my $img_data  = read_gfx_file(FILENAME=>"../../ScrollerDemos/backdrop2.h");
   #my $pixel_ptr = $img_data->{PIXEL_PTR};
   #my $pic_info  = $img_data->{INFO};
   #my $width     = $pic_info->{WIDTH};
   #my $height    = $pic_info->{HEIGHT};

    
   #if you uncomment the bit above, comment this out:
   #-snip-
   my $surface=create_SDL_surface_from_file("Data/crate.png");
   my $width=$surface->width();
   my $height=$surface->height();
   my $pitch = $surface->pitch();
   my $bytespp=  $surface->bytes_per_pixel();
   my $size=$pitch*$height;
   my $pixels = $surface->pixels();

   # Create Texture	
   my $textures = glGenTextures(1);                #name texture
	die "Could not genereate textures" unless $$textures[0];

   glBindTexture(GL_TEXTURE_2D, $$textures[0]);   # 2d texture 
   
   
   glTexParameter(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); # scale linearly when image bigger than texture
   glTexParameter(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); # scale linearly when image smalled than texture
  
   glTexImage2D(GL_TEXTURE_2D(), 
		   0,                      #level (0 normal, heighr is form mip-mapping)
		   GL_RGB(),                      #internal format (3=GL_RGB)
		   $width,$height,
		   0,                      # border 
		   GL_RGB(),                 #format RGB color data
		  GL_UNSIGNED_BYTE(),       #unsigned bye data
		  $pixels);            #ptr to texture data

    die "Problem setting up 2d Texture (dimensions not a power of 2?)):".glErrorString(glGetError())."\n" if glGetError();

  }

sub create_SDL_surface_from_file
  {
   my $filename=shift;
   
   my $surface = new SDL::Surface( -name  => $filename);
   
   return $surface;
			       
  }


###################
#alternat loading support:

#keep ref counts up:
my @sprite_c_heap =();
my @sprite_area =();

sub read_gfx_file
  {
   my %args=(
	     TYPE       => "GIMP_HEADER",
	     FILENAME  => undef,
	     @_,
	    );
   
   my $struct   = read_gimp_header_image($args{FILENAME}); 
   my $size     = length $struct->{DATA};
   my $c_array  = new OpenGL::Array  $size  , GL_UNSIGNED_BYTE;

   # c_array is the main reason to do the following ref count trickster:
   # (otherwise the OpenGL:Array goes out of scope and the memory (image) is ZEROed out (and invalidated) by the DESTROY method
   push @sprite_c_heap,  $c_array;             
   push @sprite_area,    $struct;

   $c_array->assign_data(0, $struct->{DATA} );   #take a copy of the data
   
   return {
	   PIXEL_PTR   => $c_array->ptr(), #could return $c_array instead to kepe ref count alive
	   INFO        => $struct,
	  };

   #that all needs modularising.....

  }


#nasty fixed to 3 byte RGB 
sub read_gimp_header_image
  {
   my $file=shift;
   my $cached_file="$file.cached-bin";

   my ($width, $height,$pixel_format, $data)=(0,0,"RGB","");

   #due to that fact that this aint the fastest code ever, we keep a cache.
   if (-e $cached_file and (-C $file >= -C $cached_file))
     {

      print "Reading cached binary bitmap data :  $cached_file\n";
      open (FH, "<$file.cached-bin") or die "Open: $!";
      my $line="";
      $width=<FH>;
      $height=<FH>;
      $pixel_format=<FH>;
      chomp $width;
      chomp $height;
      chomp $pixel_format;  #but who cares? not here anyway!!!

      #slurp in the rest of the file (its pixel data)
      {
       local $/;
       undef $/;
       
       my @lines= <FH>;
       $data=join '', @lines;
      }
      
      close (FH);
     }
   else                 # there is no cached file, or the cached file is out of date.
     {
      
      open (FH, "<$file") or die "Open: $!";

      my @data=();
      my @pixel=();
      while (defined (my $line=<FH>))
	{
	 $width =$1 if ($line =~ /width\s*=\s*(\d+)/);
	 $height=$1 if ($line =~ /height\s*=\s*(\d+)/);
	 if ($line =~ /^\s+\"(.+)\"$/g)
	   {
	    my $c=$1;
	    $c =~ s/\\(.)/$1/g;					#remove meta guard
	    $c =~ 
	      s/
		\G
		  (.)(.)(.)(.)
		    /
		      @data=(ord($1),ord($2),ord($3),ord($4));
	    
	    chr    (  (  (  ( $data[0] - 33) <<  2)       | (  ($data[1] - 33) >> 4) ) ). 
	      chr (  (  (  (  ( $data[1] - 33) & 0xF) << 4) | (  ($data[2] - 33) >> 2) ) ).
		chr (  (  (  (  ( $data[2] - 33) & 0x3) << 6) | (  ($data[3] - 33)     ) ) ); 
	    /gex;      
	    
	    $data.=$c ;
	   }
	}
      
      
      close(FH);
      
      print "Writing cached binary bitmap data for:  $file as $cached_file\n";
      
      #create a binary cached copy
      open (FH, ">$cached_file") or die "Open: $!";
      binmode FH;  #we might have to put up with weak OSes.
      print FH  "$width\n$height\n$pixel_format\n$data";

      close(FH);
     }
   

   return {
	   WIDTH  => $width,
	   HEIGHT => $height,
	   FORMAT => $pixel_format,
	   DATA   => $data
	  };
  }
Commit	Line	Data
8fde61e3	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