File: OpenGL.pm

package info (click to toggle)
sdlperl 1.20.3dfsg-1
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 1,796 kB
  • ctags: 2,171
  • sloc: perl: 7,394; ansic: 232; makefile: 75; sh: 1
file content (215 lines) | stat: -rw-r--r-- 6,382 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
# SDL::OpenGL.pm
#
#	A simplified OpenGL wrapper
#

package SDL::OpenGL;

require Exporter;
use strict;
use SDL;
use vars qw/@ISA @EXPORT @EXPORT_OK/;
@ISA = qw/Exporter/;

use SDL::OpenGL::Constants;

BEGIN {
	my @glu = qw/
	LookAt Perspective Ortho2D ScaleImage Build1DMipmaps Build2DMipmaps  
	Build3DMipmaps Build1DMipmapLevels Build2DMipmapLevels
	Build3DMipmapLevels 
	ErrorString NewNurbsRenderer DeleteNurbsRenderer NurbsProperty	
	LoadSamplingMatrices GetNurbsProperty NurbsCallback BeginSurface
	EndSurface
	NurbsSurface BeginCurve EndCurve NurbsCurve NurbsCallbackData
	BeginTrim EndTrim PwlCurve
	/;	

	my @gl = qw/ StencilMask Light LightModel DrawElements EdgeFlagPointer
	NormalPointer Color 
	PopClientAttrib GetError TexImage1D IndexMask DeleteTess CopyTexImage1D 
	GetTessProperty IsList ClearStencil CallLists PushClientAttrib Scissor
	Clear DeleteTextures 
	TexImage2D ClearIndex ClipPlane PointSize LoadIdentity Fog
	ConvolutionParameter CopyTexImage2D ListBase Minmax FrontFace
	PolygonStipple 
	DepthFunc NewList BlendFunc ClearAccum TessEndPolygon TexImage3D
	DrawPixels ReadPixels ReadPixel 
	CopyPixels GenTextures Viewport UnProject SeparableFilter2D Begin
	EdgeFlag 
	LineWidth MapGrid1 TexEnv MatrixMode MapGrid2 EndList
	LoadMatrix RasterPos 
	AreTexturesResident ColorTableParameter PolygonOffset Project
	PushMatrix PixelTransfer 
	ColorMaterial PrioritizeTextures TessEndContour Scale PolygonMode Rect 
	TessBeginPolygon Index Flush ClearDepth MultMatrix ResetMinmax
	Map1 Map2 BlendEquation TessVertex EvalMesh1 Frustum EvalMesh2 Vertex 
	DisableClientState InterleavedArrays EnableClientState PopMatrix Enable 
	LineStipple ReadBuffer CopyColorSubTable Accum CallList DepthMask 
	DrawRangeElements ColorSubTable TessBeginContour StencilOp GetMinmax
	ShadeModel 
	VertexPointer Disable DrawBuffer PushAttrib GetHistogram StencilFunc
	End 
	EvalCoord1 CopyTexSubImage1D EvalCoord2 Translate TexSubImage1D
	GenLists DeleteLists 
	ConvolutionFilter1D CopyConvolutionFilter1D Ortho MultiTexCoord
	AlphaFunc 
	IsTexture LogicOp PixelStore ClearColor ColorTable Finish ColorPointer 
	TexParameter Rotate TessProperty CullFace TessNormal Normal
	ActiveTextureARB 
	UnProject4 CopyColorTable TessCallback ArrayElement Histogram Hint
	PixelZoom 
	PopAttrib IsEnabled CopyTexSubImage2D TexSubImage2D ConvolutionFilter2D 
	CopyConvolutionFilter2D NewTess TexCoordPointer DrawArrays
	ResetHistogram 
	Material PixelMap DepthRange BindTexture TexCoord TexGen Bitmap
	CopyTexSubImage3D 
	TexSubImage3D ColorMask
	/;

       my @routines = keys %SDL::OpenGL::;
       no strict 'refs';
       # for all routines in SDL::OpenGL, either export it or create an
       # alias and export this alias then
       for my $name ( @routines ) {
		next if $name =~ /^(BEGIN|CHECK|END|SaveBMP)$/;
		#if ($name =~ /^GL/) {
		#	push @EXPORT, "&$name";
		#} elsif ( in ( $name, @glu )) {
		if ( in ( $name, @glu )) {
			*{"glu".$name} = \&{$name};
			push @EXPORT, "glu$name";
		} else {
			*{"gl".$name} = \&{$name};
			push @EXPORT, "gl$name";
		}
	}
	@EXPORT_OK = qw/SaveBMP/;

};

sub SaveBMP
  {
  my ($file, $w, $h, $bpp, $data) = @_;

  my $datasize = int($w * $h * $bpp) / 8;
  my $headersize = 14;
  my $infoheadersize = 40;

  my $header = pack ("SLSSL", 0x4d42, 
    $headersize, 0, 0, 
    $headersize + $infoheadersize );
  my $infoheader = pack ("LLLSSLLLLLL", 
   $infoheadersize, $w, $h, 1, $bpp, 0, 	# 0 = uncompressed
	$datasize, 0, 0, 0, 0);

  my $FILE;
  open $FILE, ">$file" or die("Cannot write to $file: $!");
  binmode $FILE;
  print $FILE $header, $infoheader, $data;
  close $FILE;
  }

1;

__END__;

=pod

=head1 NAME

SDL::OpenGL - a perl extension

=head1 DESCRIPTION

L<SDL::OpenGL> is a perl module which when used by your application
exports the gl* and glu* functions into your application's primary namespace.
Most of the functions described in the OpenGL 1.3 specification are currently
supported in this fashion.  As the implementation of the OpenGL bindings that
comes with SDL_perl is largely type agnositic, there is no need to decline
the function names in the fashion that is done in the C API. For example,
glVertex3d is simply glVertex, and perl just does the right thing with regards
to types.

=head1 CAVEATS

The following methods work different in Perl than in C:

=over 2

=item glCallLists

	glCallLists(@array_of_numbers);

Unlike the C function, which get's passed a count, a type and a list of
numbers, the Perl equivalent only takes a list of numbers.

Note that this is slow, since it needs to allocate memory and construct a
list of numbers from the given scalars. For a faster version see
L<glCallListsString>.

=item glReadPixels

	$scalar = glReadPixels($x,$y,$width,$height,$format,$type);

Reads the pixels at $x,$y and returnes them packed into the scalar.

Here is a short example on how to make a screenshot of an OpenGL app and save
it to a BMP file:

	# get the data from the screen	
	$data = glReadPixels(0,0,$width,$height,GL_GBR,GL_UNSIGNED_BYTE);
	SaveBMP ($filename, $width, $height, 24, $data);

See also L<glSaveBMP()>, which implements this.
	
=back

The following methods exist in Perl in addition to the normal OpenGL
specification:

=over 2

=item glCallListsScalar

	glCallListsScalar($string);

Works like L<glCallLists()>, except that it needs only one parameter, a scalar
holding a string. The string is interpreted as a set of bytes, and each of
these will be passed to glCallLists as GL_BYTE. This is faster than
glCallLists, so you might want to pack your data like this:

	my $lists = pack("C", @array_of_numbers);

And later use it like this:

	glCallListsScalar($lists);

=item glReadPixel

	($r,$g,$b,$a) = glReadPixel($x,$y);

Reads one pixel and unpacks the returned data into RGBA. If you specified a
pixel type different than GL_BGRA or GL_RGBA, only partial information
is returned, e.g. GL_BLUE sets $b, and leaves $r,$g and $a as 0.

=item SDL::OpenGL::SaveBMP

	SDL::OpenGL::SaveBMP ($file, $width, $height, $bits_per_pixel, $data);

Save the data in $data to a BMP file. $data must contain 3-byte per pixel,
BGR packed data and $bits_per_pixel must (currently) be 24.

See L<glReadPixels()> for an example how to get the data.

=back

=head1 AUTHOR

David J. Goehrig, additional doc plus SaveBMP by Tels

=head1 SEE ALSO

L<perl>, L<SDL::App> and L<SDL::OpenGL::Constants>.

=cut