mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-19 11:09:36 +02:00
* Finally, the new units are available: Match the C headers more closely;
support for OpenGL extensions, and much more. Based on the Delphi units by Tom Nuydens of delphi3d.net
This commit is contained in:
sg
parent
c905878b67
commit
1f2b762ce4
59
packages/extra/opengl/dllfuncs.pp
Normal file
59
packages/extra/opengl/dllfuncs.pp
Normal file
@ -0,0 +1,59 @@
|
||||
{
|
||||
$Id$
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{$MODE OBJFPC}
|
||||
|
||||
unit DLLFuncs;
|
||||
|
||||
interface
|
||||
|
||||
uses SysUtils;
|
||||
|
||||
function LoadLibrary(Name: PChar): THandle;
|
||||
function GetProcAddress(Lib: THandle; ProcName: PChar): Pointer;
|
||||
function FreeLibrary(Lib: THandle): Boolean;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
RTLD_LAZY = $001;
|
||||
RTLD_NOW = $002;
|
||||
RTLD_BINDING_MASK = $003;
|
||||
|
||||
function dlopen(Name: PChar; Flags: LongInt) : Pointer; cdecl; external 'dl';
|
||||
function dlsym(Lib: Pointer; Name: PChar) : Pointer; cdecl; external 'dl';
|
||||
function dlclose(Lib: Pointer): LongInt; cdecl; external 'dl';
|
||||
|
||||
|
||||
function LoadLibrary(Name: PChar): THandle;
|
||||
begin
|
||||
Result := THandle(dlopen(Name, RTLD_LAZY));
|
||||
end;
|
||||
|
||||
function GetProcAddress(Lib: THandle; ProcName: PChar): Pointer;
|
||||
begin
|
||||
Result := dlsym(Pointer(Lib), ProcName);
|
||||
end;
|
||||
|
||||
function FreeLibrary(Lib: THandle): Boolean;
|
||||
begin
|
||||
if Lib = 0 then
|
||||
Result := False
|
||||
else
|
||||
Result := dlClose(Pointer(Lib)) = 0;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2002-10-13 13:57:30 sg
|
||||
* Finally, the new units are available: Match the C headers more closely;
|
||||
support for OpenGL extensions, and much more. Based on the Delphi units
|
||||
by Tom Nuydens of delphi3d.net
|
||||
|
||||
}
|
||||
2265
packages/extra/opengl/gl.pp
Normal file
2265
packages/extra/opengl/gl.pp
Normal file
File diff suppressed because it is too large
Load Diff
3843
packages/extra/opengl/glext.pp
Normal file
3843
packages/extra/opengl/glext.pp
Normal file
File diff suppressed because it is too large
Load Diff
523
packages/extra/opengl/glu.pp
Normal file
523
packages/extra/opengl/glu.pp
Normal file
@ -0,0 +1,523 @@
|
||||
{
|
||||
$Id$
|
||||
|
||||
Adaption of the delphi3d.net OpenGL units to FreePascal
|
||||
Sebastian Guenther (sg@freepascal.org) in 2002
|
||||
These units are free to use
|
||||
}
|
||||
|
||||
(*++ BUILD Version: 0004 // Increment this if a change has global effects
|
||||
|
||||
Copyright (c) 1985-95, Microsoft Corporation
|
||||
|
||||
Module Name:
|
||||
|
||||
glu.h
|
||||
|
||||
Abstract:
|
||||
|
||||
Procedure declarations, constant definitions and macros for the OpenGL
|
||||
Utility Library.
|
||||
|
||||
--*)
|
||||
|
||||
(*
|
||||
** Copyright 1991-1993, Silicon Graphics, Inc.
|
||||
** All Rights Reserved.
|
||||
**
|
||||
** This is UNPUBLISHED PROPRIETARY SOURCE CODE of Silicon Graphics, Inc.;
|
||||
** the contents of this file may not be disclosed to third parties, copied or
|
||||
** duplicated in any form, in whole or in part, without the prior written
|
||||
** permission of Silicon Graphics, Inc.
|
||||
**
|
||||
** RESTRICTED RIGHTS LEGEND:
|
||||
** Use, duplication or disclosure by the Government is subject to restrictions
|
||||
** as set forth in subdivision (c)(1)(ii) of the Rights in Technical Data
|
||||
** and Computer Software clause at DFARS 252.227-7013, and/or in similar or
|
||||
** successor clauses in the FAR, DOD or NASA FAR Supplement. Unpublished -
|
||||
** rights reserved under the Copyright Laws of the United States.
|
||||
*)
|
||||
|
||||
(*
|
||||
** Return the error string associated with a particular error code.
|
||||
** This will return 0 for an invalid error code.
|
||||
**
|
||||
** The generic function prototype that can be compiled for ANSI or Unicode
|
||||
** is defined as follows:
|
||||
**
|
||||
** LPCTSTR APIENTRY gluErrorStringWIN (GLenum errCode);
|
||||
*)
|
||||
|
||||
{******************************************************************************}
|
||||
{ Converted to Delphi by Tom Nuydens (tom@delphi3d.net) }
|
||||
{ For the latest updates, visit Delphi3D: http://www.delphi3d.net }
|
||||
{******************************************************************************}
|
||||
|
||||
{$MACRO ON}
|
||||
{$MODE Delphi}
|
||||
{$IFDEF Windows}
|
||||
{$DEFINE extdecl := stdcall}
|
||||
{$ELSE}
|
||||
{$DEFINE extdecl := cdecl}
|
||||
{$ENDIF}
|
||||
|
||||
unit GLu;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
{$IFDEF Windows}
|
||||
Windows,
|
||||
{$ELSE}
|
||||
DLLFuncs,
|
||||
{$ENDIF}
|
||||
GL;
|
||||
|
||||
type
|
||||
TViewPortArray = array [0..3] of GLint;
|
||||
T16dArray = array [0..15] of GLdouble;
|
||||
TCallBack = procedure;
|
||||
T3dArray = array [0..2] of GLdouble;
|
||||
T4pArray = array [0..3] of Pointer;
|
||||
T4fArray = array [0..3] of GLfloat;
|
||||
PPointer = ^Pointer;
|
||||
|
||||
var
|
||||
gluErrorString: function(errCode: GLenum): PGLubyte; extdecl;
|
||||
gluErrorUnicodeStringEXT: function(errCode: GLenum): PWideChar; extdecl;
|
||||
gluGetString: function(name: GLenum): PGLubyte; extdecl;
|
||||
gluOrtho2D: procedure(left,right, bottom, top: GLdouble); extdecl;
|
||||
gluPerspective: procedure(fovy, aspect, zNear, zFar: GLdouble); extdecl;
|
||||
gluPickMatrix: procedure(x, y, width, height: GLdouble; viewport: TViewPortArray); extdecl;
|
||||
gluLookAt: procedure(eyex, eyey, eyez, centerx, centery, centerz, upx, upy, upz: GLdouble); extdecl;
|
||||
gluProject: function(objx, objy, objz: GLdouble; const modelMatrix, projMatrix: T16dArray; viewport: TViewPortArray; winx, winy, winz: PGLdouble): Integer; extdecl;
|
||||
gluUnProject: function(winx, winy, winz: GLdouble; const modelMatrix, projMatrix: T16dArray; viewport: TViewPortArray; objx, objy, objz: PGLdouble): Integer; extdecl;
|
||||
gluScaleImage: function(format: GLenum; widthin, heightin: GLint; typein: GLenum; const datain: Pointer; widthout, heightout: GLint; typeout: GLenum; dataout: Pointer): Integer; extdecl;
|
||||
gluBuild1DMipmaps: function(target: GLenum; components, width: GLint; format, atype: GLenum; const data: Pointer): Integer; extdecl;
|
||||
gluBuild2DMipmaps: function(target: GLenum; components, width, height: GLint; format, atype: GLenum; const data: Pointer): Integer; extdecl;
|
||||
|
||||
type
|
||||
GLUnurbs = record end; PGLUnurbs = ^GLUnurbs;
|
||||
GLUquadric = record end; PGLUquadric = ^GLUquadric;
|
||||
GLUtesselator = record end; PGLUtesselator = ^GLUtesselator;
|
||||
|
||||
// backwards compatibility:
|
||||
GLUnurbsObj = GLUnurbs; PGLUnurbsObj = PGLUnurbs;
|
||||
GLUquadricObj = GLUquadric; PGLUquadricObj = PGLUquadric;
|
||||
GLUtesselatorObj = GLUtesselator; PGLUtesselatorObj = PGLUtesselator;
|
||||
GLUtriangulatorObj = GLUtesselator; PGLUtriangulatorObj = PGLUtesselator;
|
||||
|
||||
var
|
||||
gluNewQuadric: function: PGLUquadric; extdecl;
|
||||
gluDeleteQuadric: procedure(state: PGLUquadric); extdecl;
|
||||
gluQuadricNormals: procedure(quadObject: PGLUquadric; normals: GLenum); extdecl;
|
||||
gluQuadricTexture: procedure(quadObject: PGLUquadric; textureCoords: GLboolean); extdecl;
|
||||
gluQuadricOrientation: procedure(quadObject: PGLUquadric; orientation: GLenum); extdecl;
|
||||
gluQuadricDrawStyle: procedure(quadObject: PGLUquadric; drawStyle: GLenum); extdecl;
|
||||
gluCylinder: procedure(qobj: PGLUquadric; baseRadius, topRadius, height: GLdouble; slices, stacks: GLint); extdecl;
|
||||
gluDisk: procedure(qobj: PGLUquadric; innerRadius, outerRadius: GLdouble; slices, loops: GLint); extdecl;
|
||||
gluPartialDisk: procedure(qobj: PGLUquadric; innerRadius, outerRadius: GLdouble; slices, loops: GLint; startAngle, sweepAngle: GLdouble); extdecl;
|
||||
gluSphere: procedure(qobj: PGLuquadric; radius: GLdouble; slices, stacks: GLint); extdecl;
|
||||
gluQuadricCallback: procedure(qobj: PGLUquadric; which: GLenum; fn: TCallBack); extdecl;
|
||||
gluNewTess: function: PGLUtesselator; extdecl;
|
||||
gluDeleteTess: procedure(tess: PGLUtesselator); extdecl;
|
||||
gluTessBeginPolygon: procedure(tess: PGLUtesselator; polygon_data: Pointer); extdecl;
|
||||
gluTessBeginContour: procedure(tess: PGLUtesselator); extdecl;
|
||||
gluTessVertex: procedure(tess: PGLUtesselator; coords: T3dArray; data: Pointer); extdecl;
|
||||
gluTessEndContour: procedure(tess: PGLUtesselator); extdecl;
|
||||
gluTessEndPolygon: procedure(tess: PGLUtesselator); extdecl;
|
||||
gluTessProperty: procedure(tess: PGLUtesselator; which: GLenum; value: GLdouble); extdecl;
|
||||
gluTessNormal: procedure(tess: PGLUtesselator; x, y, z: GLdouble); extdecl;
|
||||
gluTessCallback: procedure(tess: PGLUtesselator; which: GLenum;fn: TCallBack); extdecl;
|
||||
gluGetTessProperty: procedure(tess: PGLUtesselator; which: GLenum; value: PGLdouble); extdecl;
|
||||
gluNewNurbsRenderer: function: PGLUnurbs; extdecl;
|
||||
gluDeleteNurbsRenderer: procedure(nobj: PGLUnurbs); extdecl;
|
||||
gluBeginSurface: procedure(nobj: PGLUnurbs); extdecl;
|
||||
gluBeginCurve: procedure(nobj: PGLUnurbs); extdecl;
|
||||
gluEndCurve: procedure(nobj: PGLUnurbs); extdecl;
|
||||
gluEndSurface: procedure(nobj: PGLUnurbs); extdecl;
|
||||
gluBeginTrim: procedure(nobj: PGLUnurbs); extdecl;
|
||||
gluEndTrim: procedure(nobj: PGLUnurbs); extdecl;
|
||||
gluPwlCurve: procedure(nobj: PGLUnurbs; count: GLint; aarray: PGLfloat; stride: GLint; atype: GLenum); extdecl;
|
||||
gluNurbsCurve: procedure(nobj: PGLUnurbs; nknots: GLint; knot: PGLfloat; stride: GLint; ctlarray: PGLfloat; order: GLint; atype: GLenum); extdecl;
|
||||
gluNurbsSurface: procedure(nobj: PGLUnurbs; sknot_count: GLint; sknot: PGLfloat; tknot_count: GLint; tknot: PGLfloat; s_stride, t_stride: GLint; ctlarray: PGLfloat; sorder, torder: GLint; atype: GLenum); extdecl;
|
||||
gluLoadSamplingMatrices: procedure(nobj: PGLUnurbs; const modelMatrix, projMatrix: T16dArray; viewport: TViewPortArray); extdecl;
|
||||
gluNurbsProperty: procedure(nobj: PGLUnurbs; aproperty: GLenum; value: GLfloat); extdecl;
|
||||
gluGetNurbsProperty: procedure(nobj: PGLUnurbs; aproperty: GLenum; value: PGLfloat); extdecl;
|
||||
gluNurbsCallback: procedure(nobj: PGLUnurbs; which: GLenum; fn: TCallBack); extdecl;
|
||||
|
||||
(**** Callback function prototypes ****)
|
||||
|
||||
type
|
||||
// gluQuadricCallback
|
||||
GLUquadricErrorProc = procedure(p: GLenum); extdecl;
|
||||
|
||||
// gluTessCallback
|
||||
GLUtessBeginProc = procedure(p: GLenum); extdecl;
|
||||
GLUtessEdgeFlagProc = procedure(p: GLboolean); extdecl;
|
||||
GLUtessVertexProc = procedure(p: Pointer); extdecl;
|
||||
GLUtessEndProc = procedure; extdecl;
|
||||
GLUtessErrorProc = procedure(p: GLenum); extdecl;
|
||||
GLUtessCombineProc = procedure(p1: T3dArray; p2: T4pArray; p3: T4fArray; p4: PPointer); extdecl;
|
||||
GLUtessBeginDataProc = procedure(p1: GLenum; p2: Pointer); extdecl;
|
||||
GLUtessEdgeFlagDataProc = procedure(p1: GLboolean; p2: Pointer); extdecl;
|
||||
GLUtessVertexDataProc = procedure(p1, p2: Pointer); extdecl;
|
||||
GLUtessEndDataProc = procedure(p: Pointer); extdecl;
|
||||
GLUtessErrorDataProc = procedure(p1: GLenum; p2: Pointer); extdecl;
|
||||
GLUtessCombineDataProc = procedure(p1: T3dArray; p2: T4pArray; p3: T4fArray;
|
||||
p4: PPointer; p5: Pointer); extdecl;
|
||||
|
||||
// gluNurbsCallback
|
||||
GLUnurbsErrorProc = procedure(p: GLenum); extdecl;
|
||||
|
||||
|
||||
//*** Generic constants ****/
|
||||
|
||||
const
|
||||
// Version
|
||||
GLU_VERSION_1_1 = 1;
|
||||
GLU_VERSION_1_2 = 1;
|
||||
|
||||
// Errors: (return value 0 = no error)
|
||||
GLU_INVALID_ENUM = 100900;
|
||||
GLU_INVALID_VALUE = 100901;
|
||||
GLU_OUT_OF_MEMORY = 100902;
|
||||
GLU_INCOMPATIBLE_GL_VERSION = 100903;
|
||||
|
||||
// StringName
|
||||
GLU_VERSION = 100800;
|
||||
GLU_EXTENSIONS = 100801;
|
||||
|
||||
// Boolean
|
||||
GLU_TRUE = GL_TRUE;
|
||||
GLU_FALSE = GL_FALSE;
|
||||
|
||||
|
||||
//*** Quadric constants ****/
|
||||
|
||||
// QuadricNormal
|
||||
GLU_SMOOTH = 100000;
|
||||
GLU_FLAT = 100001;
|
||||
GLU_NONE = 100002;
|
||||
|
||||
// QuadricDrawStyle
|
||||
GLU_POINT = 100010;
|
||||
GLU_LINE = 100011;
|
||||
GLU_FILL = 100012;
|
||||
GLU_SILHOUETTE = 100013;
|
||||
|
||||
// QuadricOrientation
|
||||
GLU_OUTSIDE = 100020;
|
||||
GLU_INSIDE = 100021;
|
||||
|
||||
// Callback types:
|
||||
// GLU_ERROR = 100103;
|
||||
|
||||
|
||||
//*** Tesselation constants ****/
|
||||
|
||||
GLU_TESS_MAX_COORD = 1.0e150;
|
||||
|
||||
// TessProperty
|
||||
GLU_TESS_WINDING_RULE = 100140;
|
||||
GLU_TESS_BOUNDARY_ONLY = 100141;
|
||||
GLU_TESS_TOLERANCE = 100142;
|
||||
|
||||
// TessWinding
|
||||
GLU_TESS_WINDING_ODD = 100130;
|
||||
GLU_TESS_WINDING_NONZERO = 100131;
|
||||
GLU_TESS_WINDING_POSITIVE = 100132;
|
||||
GLU_TESS_WINDING_NEGATIVE = 100133;
|
||||
GLU_TESS_WINDING_ABS_GEQ_TWO = 100134;
|
||||
|
||||
// TessCallback
|
||||
GLU_TESS_BEGIN = 100100; // void (CALLBACK*)(GLenum type)
|
||||
GLU_TESS_VERTEX = 100101; // void (CALLBACK*)(void *data)
|
||||
GLU_TESS_END = 100102; // void (CALLBACK*)(void)
|
||||
GLU_TESS_ERROR = 100103; // void (CALLBACK*)(GLenum errno)
|
||||
GLU_TESS_EDGE_FLAG = 100104; // void (CALLBACK*)(GLboolean boundaryEdge)
|
||||
GLU_TESS_COMBINE = 100105; { void (CALLBACK*)(GLdouble coords[3],
|
||||
void *data[4],
|
||||
GLfloat weight[4],
|
||||
void **dataOut) }
|
||||
GLU_TESS_BEGIN_DATA = 100106; { void (CALLBACK*)(GLenum type,
|
||||
void *polygon_data) }
|
||||
GLU_TESS_VERTEX_DATA = 100107; { void (CALLBACK*)(void *data,
|
||||
void *polygon_data) }
|
||||
GLU_TESS_END_DATA = 100108; // void (CALLBACK*)(void *polygon_data)
|
||||
GLU_TESS_ERROR_DATA = 100109; { void (CALLBACK*)(GLenum errno,
|
||||
void *polygon_data) }
|
||||
GLU_TESS_EDGE_FLAG_DATA = 100110; { void (CALLBACK*)(GLboolean boundaryEdge,
|
||||
void *polygon_data) }
|
||||
GLU_TESS_COMBINE_DATA = 100111; { void (CALLBACK*)(GLdouble coords[3],
|
||||
void *data[4],
|
||||
GLfloat weight[4],
|
||||
void **dataOut,
|
||||
void *polygon_data) }
|
||||
|
||||
// TessError
|
||||
GLU_TESS_ERROR1 = 100151;
|
||||
GLU_TESS_ERROR2 = 100152;
|
||||
GLU_TESS_ERROR3 = 100153;
|
||||
GLU_TESS_ERROR4 = 100154;
|
||||
GLU_TESS_ERROR5 = 100155;
|
||||
GLU_TESS_ERROR6 = 100156;
|
||||
GLU_TESS_ERROR7 = 100157;
|
||||
GLU_TESS_ERROR8 = 100158;
|
||||
|
||||
GLU_TESS_MISSING_BEGIN_POLYGON = GLU_TESS_ERROR1;
|
||||
GLU_TESS_MISSING_BEGIN_CONTOUR = GLU_TESS_ERROR2;
|
||||
GLU_TESS_MISSING_END_POLYGON = GLU_TESS_ERROR3;
|
||||
GLU_TESS_MISSING_END_CONTOUR = GLU_TESS_ERROR4;
|
||||
GLU_TESS_COORD_TOO_LARGE = GLU_TESS_ERROR5;
|
||||
GLU_TESS_NEED_COMBINE_CALLBACK = GLU_TESS_ERROR6;
|
||||
|
||||
//*** NURBS constants ****/
|
||||
|
||||
// NurbsProperty
|
||||
GLU_AUTO_LOAD_MATRIX = 100200;
|
||||
GLU_CULLING = 100201;
|
||||
GLU_SAMPLING_TOLERANCE = 100203;
|
||||
GLU_DISPLAY_MODE = 100204;
|
||||
GLU_PARAMETRIC_TOLERANCE = 100202;
|
||||
GLU_SAMPLING_METHOD = 100205;
|
||||
GLU_U_STEP = 100206;
|
||||
GLU_V_STEP = 100207;
|
||||
|
||||
// NurbsSampling
|
||||
GLU_PATH_LENGTH = 100215;
|
||||
GLU_PARAMETRIC_ERROR = 100216;
|
||||
GLU_DOMAIN_DISTANCE = 100217;
|
||||
|
||||
|
||||
// NurbsTrim
|
||||
GLU_MAP1_TRIM_2 = 100210;
|
||||
GLU_MAP1_TRIM_3 = 100211;
|
||||
|
||||
// NurbsDisplay
|
||||
// GLU_FILL = 100012;
|
||||
GLU_OUTLINE_POLYGON = 100240;
|
||||
GLU_OUTLINE_PATCH = 100241;
|
||||
|
||||
// NurbsCallback
|
||||
// GLU_ERROR = 100103;
|
||||
|
||||
// NurbsErrors
|
||||
GLU_NURBS_ERROR1 = 100251;
|
||||
GLU_NURBS_ERROR2 = 100252;
|
||||
GLU_NURBS_ERROR3 = 100253;
|
||||
GLU_NURBS_ERROR4 = 100254;
|
||||
GLU_NURBS_ERROR5 = 100255;
|
||||
GLU_NURBS_ERROR6 = 100256;
|
||||
GLU_NURBS_ERROR7 = 100257;
|
||||
GLU_NURBS_ERROR8 = 100258;
|
||||
GLU_NURBS_ERROR9 = 100259;
|
||||
GLU_NURBS_ERROR10 = 100260;
|
||||
GLU_NURBS_ERROR11 = 100261;
|
||||
GLU_NURBS_ERROR12 = 100262;
|
||||
GLU_NURBS_ERROR13 = 100263;
|
||||
GLU_NURBS_ERROR14 = 100264;
|
||||
GLU_NURBS_ERROR15 = 100265;
|
||||
GLU_NURBS_ERROR16 = 100266;
|
||||
GLU_NURBS_ERROR17 = 100267;
|
||||
GLU_NURBS_ERROR18 = 100268;
|
||||
GLU_NURBS_ERROR19 = 100269;
|
||||
GLU_NURBS_ERROR20 = 100270;
|
||||
GLU_NURBS_ERROR21 = 100271;
|
||||
GLU_NURBS_ERROR22 = 100272;
|
||||
GLU_NURBS_ERROR23 = 100273;
|
||||
GLU_NURBS_ERROR24 = 100274;
|
||||
GLU_NURBS_ERROR25 = 100275;
|
||||
GLU_NURBS_ERROR26 = 100276;
|
||||
GLU_NURBS_ERROR27 = 100277;
|
||||
GLU_NURBS_ERROR28 = 100278;
|
||||
GLU_NURBS_ERROR29 = 100279;
|
||||
GLU_NURBS_ERROR30 = 100280;
|
||||
GLU_NURBS_ERROR31 = 100281;
|
||||
GLU_NURBS_ERROR32 = 100282;
|
||||
GLU_NURBS_ERROR33 = 100283;
|
||||
GLU_NURBS_ERROR34 = 100284;
|
||||
GLU_NURBS_ERROR35 = 100285;
|
||||
GLU_NURBS_ERROR36 = 100286;
|
||||
GLU_NURBS_ERROR37 = 100287;
|
||||
|
||||
//*** Backwards compatibility for old tesselator ****/
|
||||
|
||||
var
|
||||
gluBeginPolygon: procedure(tess: PGLUtesselator); extdecl;
|
||||
gluNextContour: procedure(tess: PGLUtesselator; atype: GLenum); extdecl;
|
||||
gluEndPolygon: procedure(tess: PGLUtesselator); extdecl;
|
||||
|
||||
const
|
||||
// Contours types -- obsolete!
|
||||
GLU_CW = 100120;
|
||||
GLU_CCW = 100121;
|
||||
GLU_INTERIOR = 100122;
|
||||
GLU_EXTERIOR = 100123;
|
||||
GLU_UNKNOWN = 100124;
|
||||
|
||||
// Names without "TESS_" prefix
|
||||
GLU_BEGIN = GLU_TESS_BEGIN;
|
||||
GLU_VERTEX = GLU_TESS_VERTEX;
|
||||
GLU_END = GLU_TESS_END;
|
||||
GLU_ERROR = GLU_TESS_ERROR;
|
||||
GLU_EDGE_FLAG = GLU_TESS_EDGE_FLAG;
|
||||
|
||||
procedure LoadGLu(const dll: String);
|
||||
procedure FreeGLu;
|
||||
|
||||
implementation
|
||||
|
||||
var
|
||||
hDLL: THandle;
|
||||
|
||||
procedure FreeGLu;
|
||||
begin
|
||||
|
||||
@gluErrorString := nil;
|
||||
@gluErrorUnicodeStringEXT := nil;
|
||||
@gluGetString := nil;
|
||||
@gluOrtho2D := nil;
|
||||
@gluPerspective := nil;
|
||||
@gluPickMatrix := nil;
|
||||
@gluLookAt := nil;
|
||||
@gluProject := nil;
|
||||
@gluUnProject := nil;
|
||||
@gluScaleImage := nil;
|
||||
@gluBuild1DMipmaps := nil;
|
||||
@gluBuild2DMipmaps := nil;
|
||||
@gluNewQuadric := nil;
|
||||
@gluDeleteQuadric := nil;
|
||||
@gluQuadricNormals := nil;
|
||||
@gluQuadricTexture := nil;
|
||||
@gluQuadricOrientation := nil;
|
||||
@gluQuadricDrawStyle := nil;
|
||||
@gluCylinder := nil;
|
||||
@gluDisk := nil;
|
||||
@gluPartialDisk := nil;
|
||||
@gluSphere := nil;
|
||||
@gluQuadricCallback := nil;
|
||||
@gluNewTess := nil;
|
||||
@gluDeleteTess := nil;
|
||||
@gluTessBeginPolygon := nil;
|
||||
@gluTessBeginContour := nil;
|
||||
@gluTessVertex := nil;
|
||||
@gluTessEndContour := nil;
|
||||
@gluTessEndPolygon := nil;
|
||||
@gluTessProperty := nil;
|
||||
@gluTessNormal := nil;
|
||||
@gluTessCallback := nil;
|
||||
@gluGetTessProperty := nil;
|
||||
@gluNewNurbsRenderer := nil;
|
||||
@gluDeleteNurbsRenderer := nil;
|
||||
@gluBeginSurface := nil;
|
||||
@gluBeginCurve := nil;
|
||||
@gluEndCurve := nil;
|
||||
@gluEndSurface := nil;
|
||||
@gluBeginTrim := nil;
|
||||
@gluEndTrim := nil;
|
||||
@gluPwlCurve := nil;
|
||||
@gluNurbsCurve := nil;
|
||||
@gluNurbsSurface := nil;
|
||||
@gluLoadSamplingMatrices := nil;
|
||||
@gluNurbsProperty := nil;
|
||||
@gluGetNurbsProperty := nil;
|
||||
@gluNurbsCallback := nil;
|
||||
@gluBeginPolygon := nil;
|
||||
@gluNextContour := nil;
|
||||
@gluEndPolygon := nil;
|
||||
|
||||
FreeLibrary(hDLL);
|
||||
|
||||
end;
|
||||
|
||||
procedure LoadGLu(const dll: String);
|
||||
begin
|
||||
|
||||
FreeGLu;
|
||||
|
||||
hDLL := LoadLibrary(PChar(dll));
|
||||
if hDLL = 0 then raise Exception.Create('Could not load GLu from ' + dll);
|
||||
|
||||
@gluErrorString := GetProcAddress(hDLL, 'gluErrorString');
|
||||
@gluErrorUnicodeStringEXT := GetProcAddress(hDLL, 'gluErrorUnicodeStringEXT');
|
||||
@gluGetString := GetProcAddress(hDLL, 'gluGetString');
|
||||
@gluOrtho2D := GetProcAddress(hDLL, 'gluOrtho2D');
|
||||
@gluPerspective := GetProcAddress(hDLL, 'gluPerspective');
|
||||
@gluPickMatrix := GetProcAddress(hDLL, 'gluPickMatrix');
|
||||
@gluLookAt := GetProcAddress(hDLL, 'gluLookAt');
|
||||
@gluProject := GetProcAddress(hDLL, 'gluProject');
|
||||
@gluUnProject := GetProcAddress(hDLL, 'gluUnProject');
|
||||
@gluScaleImage := GetProcAddress(hDLL, 'gluScaleImage');
|
||||
@gluBuild1DMipmaps := GetProcAddress(hDLL, 'gluBuild1DMipmaps');
|
||||
@gluBuild2DMipmaps := GetProcAddress(hDLL, 'gluBuild2DMipmaps');
|
||||
@gluNewQuadric := GetProcAddress(hDLL, 'gluNewQuadric');
|
||||
@gluDeleteQuadric := GetProcAddress(hDLL, 'gluDeleteQuadric');
|
||||
@gluQuadricNormals := GetProcAddress(hDLL, 'gluQuadricNormals');
|
||||
@gluQuadricTexture := GetProcAddress(hDLL, 'gluQuadricTexture');
|
||||
@gluQuadricOrientation := GetProcAddress(hDLL, 'gluQuadricOrientation');
|
||||
@gluQuadricDrawStyle := GetProcAddress(hDLL, 'gluQuadricDrawStyle');
|
||||
@gluCylinder := GetProcAddress(hDLL, 'gluCylinder');
|
||||
@gluDisk := GetProcAddress(hDLL, 'gluDisk');
|
||||
@gluPartialDisk := GetProcAddress(hDLL, 'gluPartialDisk');
|
||||
@gluSphere := GetProcAddress(hDLL, 'gluSphere');
|
||||
@gluQuadricCallback := GetProcAddress(hDLL, 'gluQuadricCallback');
|
||||
@gluNewTess := GetProcAddress(hDLL, 'gluNewTess');
|
||||
@gluDeleteTess := GetProcAddress(hDLL, 'gluDeleteTess');
|
||||
@gluTessBeginPolygon := GetProcAddress(hDLL, 'gluTessBeginPolygon');
|
||||
@gluTessBeginContour := GetProcAddress(hDLL, 'gluTessBeginContour');
|
||||
@gluTessVertex := GetProcAddress(hDLL, 'gluTessVertex');
|
||||
@gluTessEndContour := GetProcAddress(hDLL, 'gluTessEndContour');
|
||||
@gluTessEndPolygon := GetProcAddress(hDLL, 'gluTessEndPolygon');
|
||||
@gluTessProperty := GetProcAddress(hDLL, 'gluTessProperty');
|
||||
@gluTessNormal := GetProcAddress(hDLL, 'gluTessNormal');
|
||||
@gluTessCallback := GetProcAddress(hDLL, 'gluTessCallback');
|
||||
@gluGetTessProperty := GetProcAddress(hDLL, 'gluGetTessProperty');
|
||||
@gluNewNurbsRenderer := GetProcAddress(hDLL, 'gluNewNurbsRenderer');
|
||||
@gluDeleteNurbsRenderer := GetProcAddress(hDLL, 'gluDeleteNurbsRenderer');
|
||||
@gluBeginSurface := GetProcAddress(hDLL, 'gluBeginSurface');
|
||||
@gluBeginCurve := GetProcAddress(hDLL, 'gluBeginCurve');
|
||||
@gluEndCurve := GetProcAddress(hDLL, 'gluEndCurve');
|
||||
@gluEndSurface := GetProcAddress(hDLL, 'gluEndSurface');
|
||||
@gluBeginTrim := GetProcAddress(hDLL, 'gluBeginTrim');
|
||||
@gluEndTrim := GetProcAddress(hDLL, 'gluEndTrim');
|
||||
@gluPwlCurve := GetProcAddress(hDLL, 'gluPwlCurve');
|
||||
@gluNurbsCurve := GetProcAddress(hDLL, 'gluNurbsCurve');
|
||||
@gluNurbsSurface := GetProcAddress(hDLL, 'gluNurbsSurface');
|
||||
@gluLoadSamplingMatrices := GetProcAddress(hDLL, 'gluLoadSamplingMatrices');
|
||||
@gluNurbsProperty := GetProcAddress(hDLL, 'gluNurbsProperty');
|
||||
@gluGetNurbsProperty := GetProcAddress(hDLL, 'gluGetNurbsProperty');
|
||||
@gluNurbsCallback := GetProcAddress(hDLL, 'gluNurbsCallback');
|
||||
|
||||
@gluBeginPolygon := GetProcAddress(hDLL, 'gluBeginPolygon');
|
||||
@gluNextContour := GetProcAddress(hDLL, 'gluNextContour');
|
||||
@gluEndPolygon := GetProcAddress(hDLL, 'gluEndPolygon');
|
||||
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
try
|
||||
{$IFDEF Windows}
|
||||
LoadGLu('glu32.dll');
|
||||
{$ELSE}
|
||||
LoadGLu('libGLU.so.1');
|
||||
{$ENDIF}
|
||||
except end;
|
||||
|
||||
finalization
|
||||
|
||||
FreeGLu;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2002-10-13 13:57:31 sg
|
||||
* Finally, the new units are available: Match the C headers more closely;
|
||||
support for OpenGL extensions, and much more. Based on the Delphi units
|
||||
by Tom Nuydens of delphi3d.net
|
||||
|
||||
}
|
||||
652
packages/extra/opengl/glut.pp
Normal file
652
packages/extra/opengl/glut.pp
Normal file
@ -0,0 +1,652 @@
|
||||
{
|
||||
$Id$
|
||||
|
||||
Adaption of the delphi3d.net OpenGL units to FreePascal
|
||||
Sebastian Guenther (sg@freepascal.org) in 2002
|
||||
These units are free to use
|
||||
}
|
||||
|
||||
{$MACRO ON}
|
||||
{$MODE Delphi}
|
||||
{$IFDEF Windows}
|
||||
{$DEFINE extdecl := stdcall}
|
||||
{$ELSE}
|
||||
{$DEFINE extdecl := cdecl}
|
||||
{$ENDIF}
|
||||
|
||||
unit Glut;
|
||||
|
||||
// Copyright (c) Mark J. Kilgard, 1994, 1995, 1996. */
|
||||
|
||||
(* This program is freely distributable without licensing fees and is
|
||||
provided without guarantee or warrantee expressed or implied. This
|
||||
program is -not- in the public domain. *)
|
||||
|
||||
{******************************************************************************}
|
||||
{ Converted to Delphi by Tom Nuydens (tom@delphi3d.net) }
|
||||
{ Contributions by Igor Karpov (glygrik@hotbox.ru) }
|
||||
{ For the latest updates, visit Delphi3D: http://www.delphi3d.net }
|
||||
{******************************************************************************}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
{$IFDEF Windows}
|
||||
Windows,
|
||||
{$ELSE}
|
||||
DLLFuncs,
|
||||
{$ENDIF}
|
||||
GL;
|
||||
|
||||
type
|
||||
PInteger = ^Integer;
|
||||
PPChar = ^PChar;
|
||||
TGlutVoidCallback = procedure; cdecl;
|
||||
TGlut1IntCallback = procedure(value: Integer); cdecl;
|
||||
TGlut2IntCallback = procedure(v1, v2: Integer); cdecl;
|
||||
TGlut3IntCallback = procedure(v1, v2, v3: Integer); cdecl;
|
||||
TGlut4IntCallback = procedure(v1, v2, v3, v4: Integer); cdecl;
|
||||
TGlut1Char2IntCallback = procedure(c: Byte; v1, v2: Integer); cdecl;
|
||||
|
||||
const
|
||||
GLUT_API_VERSION = 3;
|
||||
GLUT_XLIB_IMPLEMENTATION = 12;
|
||||
// Display mode bit masks.
|
||||
GLUT_RGB = 0;
|
||||
GLUT_RGBA = GLUT_RGB;
|
||||
GLUT_INDEX = 1;
|
||||
GLUT_SINGLE = 0;
|
||||
GLUT_DOUBLE = 2;
|
||||
GLUT_ACCUM = 4;
|
||||
GLUT_ALPHA = 8;
|
||||
GLUT_DEPTH = 16;
|
||||
GLUT_STENCIL = 32;
|
||||
GLUT_MULTISAMPLE = 128;
|
||||
GLUT_STEREO = 256;
|
||||
GLUT_LUMINANCE = 512;
|
||||
|
||||
// Mouse buttons.
|
||||
GLUT_LEFT_BUTTON = 0;
|
||||
GLUT_MIDDLE_BUTTON = 1;
|
||||
GLUT_RIGHT_BUTTON = 2;
|
||||
|
||||
// Mouse button state.
|
||||
GLUT_DOWN = 0;
|
||||
GLUT_UP = 1;
|
||||
|
||||
// function keys
|
||||
GLUT_KEY_F1 = 1;
|
||||
GLUT_KEY_F2 = 2;
|
||||
GLUT_KEY_F3 = 3;
|
||||
GLUT_KEY_F4 = 4;
|
||||
GLUT_KEY_F5 = 5;
|
||||
GLUT_KEY_F6 = 6;
|
||||
GLUT_KEY_F7 = 7;
|
||||
GLUT_KEY_F8 = 8;
|
||||
GLUT_KEY_F9 = 9;
|
||||
GLUT_KEY_F10 = 10;
|
||||
GLUT_KEY_F11 = 11;
|
||||
GLUT_KEY_F12 = 12;
|
||||
// directional keys
|
||||
GLUT_KEY_LEFT = 100;
|
||||
GLUT_KEY_UP = 101;
|
||||
GLUT_KEY_RIGHT = 102;
|
||||
GLUT_KEY_DOWN = 103;
|
||||
GLUT_KEY_PAGE_UP = 104;
|
||||
GLUT_KEY_PAGE_DOWN = 105;
|
||||
GLUT_KEY_HOME = 106;
|
||||
GLUT_KEY_END = 107;
|
||||
GLUT_KEY_INSERT = 108;
|
||||
|
||||
// Entry/exit state.
|
||||
GLUT_LEFT = 0;
|
||||
GLUT_ENTERED = 1;
|
||||
|
||||
// Menu usage state.
|
||||
GLUT_MENU_NOT_IN_USE = 0;
|
||||
GLUT_MENU_IN_USE = 1;
|
||||
|
||||
// Visibility state.
|
||||
GLUT_NOT_VISIBLE = 0;
|
||||
GLUT_VISIBLE = 1;
|
||||
|
||||
// Window status state.
|
||||
GLUT_HIDDEN = 0;
|
||||
GLUT_FULLY_RETAINED = 1;
|
||||
GLUT_PARTIALLY_RETAINED = 2;
|
||||
GLUT_FULLY_COVERED = 3;
|
||||
|
||||
// Color index component selection values.
|
||||
GLUT_RED = 0;
|
||||
GLUT_GREEN = 1;
|
||||
GLUT_BLUE = 2;
|
||||
|
||||
// Layers for use.
|
||||
GLUT_NORMAL = 0;
|
||||
GLUT_OVERLAY = 1;
|
||||
|
||||
// Stroke font constants (use these in GLUT program).
|
||||
GLUT_STROKE_ROMAN = Pointer(0);
|
||||
GLUT_STROKE_MONO_ROMAN = Pointer(1);
|
||||
|
||||
// Bitmap font constants (use these in GLUT program).
|
||||
GLUT_BITMAP_9_BY_15 = Pointer(2);
|
||||
GLUT_BITMAP_8_BY_13 = Pointer(3);
|
||||
GLUT_BITMAP_TIMES_ROMAN_10 = Pointer(4);
|
||||
GLUT_BITMAP_TIMES_ROMAN_24 = Pointer(5);
|
||||
GLUT_BITMAP_HELVETICA_10 = Pointer(6);
|
||||
GLUT_BITMAP_HELVETICA_12 = Pointer(7);
|
||||
GLUT_BITMAP_HELVETICA_18 = Pointer(8);
|
||||
|
||||
// glutGet parameters.
|
||||
GLUT_WINDOW_X = 100;
|
||||
GLUT_WINDOW_Y = 101;
|
||||
GLUT_WINDOW_WIDTH = 102;
|
||||
GLUT_WINDOW_HEIGHT = 103;
|
||||
GLUT_WINDOW_BUFFER_SIZE = 104;
|
||||
GLUT_WINDOW_STENCIL_SIZE = 105;
|
||||
GLUT_WINDOW_DEPTH_SIZE = 106;
|
||||
GLUT_WINDOW_RED_SIZE = 107;
|
||||
GLUT_WINDOW_GREEN_SIZE = 108;
|
||||
GLUT_WINDOW_BLUE_SIZE = 109;
|
||||
GLUT_WINDOW_ALPHA_SIZE = 110;
|
||||
GLUT_WINDOW_ACCUM_RED_SIZE = 111;
|
||||
GLUT_WINDOW_ACCUM_GREEN_SIZE = 112;
|
||||
GLUT_WINDOW_ACCUM_BLUE_SIZE = 113;
|
||||
GLUT_WINDOW_ACCUM_ALPHA_SIZE = 114;
|
||||
GLUT_WINDOW_DOUBLEBUFFER = 115;
|
||||
GLUT_WINDOW_RGBA = 116;
|
||||
GLUT_WINDOW_PARENT = 117;
|
||||
GLUT_WINDOW_NUM_CHILDREN = 118;
|
||||
GLUT_WINDOW_COLORMAP_SIZE = 119;
|
||||
GLUT_WINDOW_NUM_SAMPLES = 120;
|
||||
GLUT_WINDOW_STEREO = 121;
|
||||
GLUT_WINDOW_CURSOR = 122;
|
||||
GLUT_SCREEN_WIDTH = 200;
|
||||
GLUT_SCREEN_HEIGHT = 201;
|
||||
GLUT_SCREEN_WIDTH_MM = 202;
|
||||
GLUT_SCREEN_HEIGHT_MM = 203;
|
||||
GLUT_MENU_NUM_ITEMS = 300;
|
||||
GLUT_DISPLAY_MODE_POSSIBLE = 400;
|
||||
GLUT_INIT_WINDOW_X = 500;
|
||||
GLUT_INIT_WINDOW_Y = 501;
|
||||
GLUT_INIT_WINDOW_WIDTH = 502;
|
||||
GLUT_INIT_WINDOW_HEIGHT = 503;
|
||||
GLUT_INIT_DISPLAY_MODE = 504;
|
||||
GLUT_ELAPSED_TIME = 700;
|
||||
|
||||
// glutDeviceGet parameters.
|
||||
GLUT_HAS_KEYBOARD = 600;
|
||||
GLUT_HAS_MOUSE = 601;
|
||||
GLUT_HAS_SPACEBALL = 602;
|
||||
GLUT_HAS_DIAL_AND_BUTTON_BOX = 603;
|
||||
GLUT_HAS_TABLET = 604;
|
||||
GLUT_NUM_MOUSE_BUTTONS = 605;
|
||||
GLUT_NUM_SPACEBALL_BUTTONS = 606;
|
||||
GLUT_NUM_BUTTON_BOX_BUTTONS = 607;
|
||||
GLUT_NUM_DIALS = 608;
|
||||
GLUT_NUM_TABLET_BUTTONS = 609;
|
||||
|
||||
// glutLayerGet parameters.
|
||||
GLUT_OVERLAY_POSSIBLE = 800;
|
||||
GLUT_LAYER_IN_USE = 801;
|
||||
GLUT_HAS_OVERLAY = 802;
|
||||
GLUT_TRANSPARENT_INDEX = 803;
|
||||
GLUT_NORMAL_DAMAGED = 804;
|
||||
GLUT_OVERLAY_DAMAGED = 805;
|
||||
|
||||
// glutVideoResizeGet parameters.
|
||||
GLUT_VIDEO_RESIZE_POSSIBLE = 900;
|
||||
GLUT_VIDEO_RESIZE_IN_USE = 901;
|
||||
GLUT_VIDEO_RESIZE_X_DELTA = 902;
|
||||
GLUT_VIDEO_RESIZE_Y_DELTA = 903;
|
||||
GLUT_VIDEO_RESIZE_WIDTH_DELTA = 904;
|
||||
GLUT_VIDEO_RESIZE_HEIGHT_DELTA = 905;
|
||||
GLUT_VIDEO_RESIZE_X = 906;
|
||||
GLUT_VIDEO_RESIZE_Y = 907;
|
||||
GLUT_VIDEO_RESIZE_WIDTH = 908;
|
||||
GLUT_VIDEO_RESIZE_HEIGHT = 909;
|
||||
|
||||
// glutGetModifiers return mask.
|
||||
GLUT_ACTIVE_SHIFT = 1;
|
||||
GLUT_ACTIVE_CTRL = 2;
|
||||
GLUT_ACTIVE_ALT = 4;
|
||||
|
||||
// glutSetCursor parameters.
|
||||
// Basic arrows.
|
||||
GLUT_CURSOR_RIGHT_ARROW = 0;
|
||||
GLUT_CURSOR_LEFT_ARROW = 1;
|
||||
// Symbolic cursor shapes.
|
||||
GLUT_CURSOR_INFO = 2;
|
||||
GLUT_CURSOR_DESTROY = 3;
|
||||
GLUT_CURSOR_HELP = 4;
|
||||
GLUT_CURSOR_CYCLE = 5;
|
||||
GLUT_CURSOR_SPRAY = 6;
|
||||
GLUT_CURSOR_WAIT = 7;
|
||||
GLUT_CURSOR_TEXT = 8;
|
||||
GLUT_CURSOR_CROSSHAIR = 9;
|
||||
// Directional cursors.
|
||||
GLUT_CURSOR_UP_DOWN = 10;
|
||||
GLUT_CURSOR_LEFT_RIGHT = 11;
|
||||
// Sizing cursors.
|
||||
GLUT_CURSOR_TOP_SIDE = 12;
|
||||
GLUT_CURSOR_BOTTOM_SIDE = 13;
|
||||
GLUT_CURSOR_LEFT_SIDE = 14;
|
||||
GLUT_CURSOR_RIGHT_SIDE = 15;
|
||||
GLUT_CURSOR_TOP_LEFT_CORNER = 16;
|
||||
GLUT_CURSOR_TOP_RIGHT_CORNER = 17;
|
||||
GLUT_CURSOR_BOTTOM_RIGHT_CORNER = 18;
|
||||
GLUT_CURSOR_BOTTOM_LEFT_CORNER = 19;
|
||||
// Inherit from parent window.
|
||||
GLUT_CURSOR_INHERIT = 100;
|
||||
// Blank cursor.
|
||||
GLUT_CURSOR_NONE = 101;
|
||||
// Fullscreen crosshair (if available).
|
||||
GLUT_CURSOR_FULL_CROSSHAIR = 102;
|
||||
|
||||
// GLUT game mode sub-API.
|
||||
// glutGameModeGet.
|
||||
GLUT_GAME_MODE_ACTIVE = 0;
|
||||
GLUT_GAME_MODE_POSSIBLE = 1;
|
||||
GLUT_GAME_MODE_WIDTH = 2;
|
||||
GLUT_GAME_MODE_HEIGHT = 3;
|
||||
GLUT_GAME_MODE_PIXEL_DEPTH = 4;
|
||||
GLUT_GAME_MODE_REFRESH_RATE = 5;
|
||||
GLUT_GAME_MODE_DISPLAY_CHANGED = 6;
|
||||
|
||||
var
|
||||
// GLUT initialization sub-API.
|
||||
glutInit: procedure(argcp: PInteger; argv: PPChar); extdecl;
|
||||
glutInitDisplayMode: procedure(mode: Word); extdecl;
|
||||
glutInitDisplayString: procedure(const str: PChar); extdecl;
|
||||
glutInitWindowPosition: procedure(x, y: Integer); extdecl;
|
||||
glutInitWindowSize: procedure(width, height: Integer); extdecl;
|
||||
glutMainLoop: procedure; extdecl;
|
||||
|
||||
// GLUT window sub-API.
|
||||
glutCreateWindow: function(const title: PChar): Integer; extdecl;
|
||||
glutCreateSubWindow: function(win, x, y, width, height: Integer): Integer; extdecl;
|
||||
glutDestroyWindow: procedure(win: Integer); extdecl;
|
||||
glutPostRedisplay: procedure; extdecl;
|
||||
glutPostWindowRedisplay: procedure(win: Integer); extdecl;
|
||||
glutSwapBuffers: procedure; extdecl;
|
||||
glutGetWindow: function: Integer; extdecl;
|
||||
glutSetWindow: procedure(win: Integer); extdecl;
|
||||
glutSetWindowTitle: procedure(const title: PChar); extdecl;
|
||||
glutSetIconTitle: procedure(const title: PChar); extdecl;
|
||||
glutPositionWindow: procedure(x, y: Integer); extdecl;
|
||||
glutReshapeWindow: procedure(width, height: Integer); extdecl;
|
||||
glutPopWindow: procedure; extdecl;
|
||||
glutPushWindow: procedure; extdecl;
|
||||
glutIconifyWindow: procedure; extdecl;
|
||||
glutShowWindow: procedure; extdecl;
|
||||
glutHideWindow: procedure; extdecl;
|
||||
glutFullScreen: procedure; extdecl;
|
||||
glutSetCursor: procedure(cursor: Integer); extdecl;
|
||||
glutWarpPointer: procedure(x, y: Integer); extdecl;
|
||||
|
||||
// GLUT overlay sub-API.
|
||||
glutEstablishOverlay: procedure; extdecl;
|
||||
glutRemoveOverlay: procedure; extdecl;
|
||||
glutUseLayer: procedure(layer: GLenum); extdecl;
|
||||
glutPostOverlayRedisplay: procedure; extdecl;
|
||||
glutPostWindowOverlayRedisplay: procedure(win: Integer); extdecl;
|
||||
glutShowOverlay: procedure; extdecl;
|
||||
glutHideOverlay: procedure; extdecl;
|
||||
|
||||
// GLUT menu sub-API.
|
||||
glutCreateMenu: function(callback: TGlut1IntCallback): Integer; extdecl;
|
||||
glutDestroyMenu: procedure(menu: Integer); extdecl;
|
||||
glutGetMenu: function: Integer; extdecl;
|
||||
glutSetMenu: procedure(menu: Integer); extdecl;
|
||||
glutAddMenuEntry: procedure(const caption: PChar; value: Integer); extdecl;
|
||||
glutAddSubMenu: procedure(const caption: PChar; submenu: Integer); extdecl;
|
||||
glutChangeToMenuEntry: procedure(item: Integer; const caption: PChar; value: Integer); extdecl;
|
||||
glutChangeToSubMenu: procedure(item: Integer; const caption: PChar; submenu: Integer); extdecl;
|
||||
glutRemoveMenuItem: procedure(item: Integer); extdecl;
|
||||
glutAttachMenu: procedure(button: Integer); extdecl;
|
||||
glutDetachMenu: procedure(button: Integer); extdecl;
|
||||
|
||||
// GLUTsub-API.
|
||||
glutDisplayFunc: procedure(f: TGlutVoidCallback); extdecl;
|
||||
glutReshapeFunc: procedure(f: TGlut2IntCallback); extdecl;
|
||||
glutKeyboardFunc: procedure(f: TGlut1Char2IntCallback); extdecl;
|
||||
glutMouseFunc: procedure(f: TGlut4IntCallback); extdecl;
|
||||
glutMotionFunc: procedure(f: TGlut2IntCallback); extdecl;
|
||||
glutPassiveMotionFunc: procedure(f: TGlut2IntCallback); extdecl;
|
||||
glutEntryFunc: procedure(f: TGlut1IntCallback); extdecl;
|
||||
glutVisibilityFunc: procedure(f: TGlut1IntCallback); extdecl;
|
||||
glutIdleFunc: procedure(f: TGlutVoidCallback); extdecl;
|
||||
glutTimerFunc: procedure(millis: Word; f: TGlut1IntCallback; value: Integer); extdecl;
|
||||
glutMenuStateFunc: procedure(f: TGlut1IntCallback); extdecl;
|
||||
glutSpecialFunc: procedure(f: TGlut3IntCallback); extdecl;
|
||||
glutSpaceballMotionFunc: procedure(f: TGlut3IntCallback); extdecl;
|
||||
glutSpaceballRotateFunc: procedure(f: TGlut3IntCallback); extdecl;
|
||||
glutSpaceballButtonFunc: procedure(f: TGlut2IntCallback); extdecl;
|
||||
glutButtonBoxFunc: procedure(f: TGlut2IntCallback); extdecl;
|
||||
glutDialsFunc: procedure(f: TGlut2IntCallback); extdecl;
|
||||
glutTabletMotionFunc: procedure(f: TGlut2IntCallback); extdecl;
|
||||
glutTabletButtonFunc: procedure(f: TGlut4IntCallback); extdecl;
|
||||
glutMenuStatusFunc: procedure(f: TGlut3IntCallback); extdecl;
|
||||
glutOverlayDisplayFunc: procedure(f:TGlutVoidCallback); extdecl;
|
||||
glutWindowStatusFunc: procedure(f: TGlut1IntCallback); extdecl;
|
||||
|
||||
// GLUT color index sub-API.
|
||||
glutSetColor: procedure(cell: Integer; red, green, blue: GLfloat); extdecl;
|
||||
glutGetColor: function(ndx, component: Integer): GLfloat; extdecl;
|
||||
glutCopyColormap: procedure(win: Integer); extdecl;
|
||||
|
||||
// GLUT state retrieval sub-API.
|
||||
glutGet: function(t: GLenum): Integer; extdecl;
|
||||
glutDeviceGet: function(t: GLenum): Integer; extdecl;
|
||||
|
||||
// GLUT extension support sub-API
|
||||
glutExtensionSupported: function(const name: PChar): Integer; extdecl;
|
||||
glutGetModifiers: function: Integer; extdecl;
|
||||
glutLayerGet: function(t: GLenum): Integer; extdecl;
|
||||
|
||||
// GLUT font sub-API
|
||||
glutBitmapCharacter: procedure(font : pointer; character: Integer); extdecl;
|
||||
glutBitmapWidth: function(font : pointer; character: Integer): Integer; extdecl;
|
||||
glutStrokeCharacter: procedure(font : pointer; character: Integer); extdecl;
|
||||
glutStrokeWidth: function(font : pointer; character: Integer): Integer; extdecl;
|
||||
glutBitmapLength: function(font: pointer; const str: PChar): Integer; extdecl;
|
||||
glutStrokeLength: function(font: pointer; const str: PChar): Integer; extdecl;
|
||||
|
||||
// GLUT pre-built models sub-API
|
||||
glutWireSphere: procedure(radius: GLdouble; slices, stacks: GLint); extdecl;
|
||||
glutSolidSphere: procedure(radius: GLdouble; slices, stacks: GLint); extdecl;
|
||||
glutWireCone: procedure(base, height: GLdouble; slices, stacks: GLint); extdecl;
|
||||
glutSolidCone: procedure(base, height: GLdouble; slices, stacks: GLint); extdecl;
|
||||
glutWireCube: procedure(size: GLdouble); extdecl;
|
||||
glutSolidCube: procedure(size: GLdouble); extdecl;
|
||||
glutWireTorus: procedure(innerRadius, outerRadius: GLdouble; sides, rings: GLint); extdecl;
|
||||
glutSolidTorus: procedure(innerRadius, outerRadius: GLdouble; sides, rings: GLint); extdecl;
|
||||
glutWireDodecahedron: procedure; extdecl;
|
||||
glutSolidDodecahedron: procedure; extdecl;
|
||||
glutWireTeapot: procedure(size: GLdouble); extdecl;
|
||||
glutSolidTeapot: procedure(size: GLdouble); extdecl;
|
||||
glutWireOctahedron: procedure; extdecl;
|
||||
glutSolidOctahedron: procedure; extdecl;
|
||||
glutWireTetrahedron: procedure; extdecl;
|
||||
glutSolidTetrahedron: procedure; extdecl;
|
||||
glutWireIcosahedron: procedure; extdecl;
|
||||
glutSolidIcosahedron: procedure; extdecl;
|
||||
|
||||
// GLUT video resize sub-API.
|
||||
glutVideoResizeGet: function(param: GLenum): Integer; extdecl;
|
||||
glutSetupVideoResizing: procedure; extdecl;
|
||||
glutStopVideoResizing: procedure; extdecl;
|
||||
glutVideoResize: procedure(x, y, width, height: Integer); extdecl;
|
||||
glutVideoPan: procedure(x, y, width, height: Integer); extdecl;
|
||||
|
||||
// GLUT debugging sub-API.
|
||||
glutReportErrors: procedure; extdecl;
|
||||
|
||||
var
|
||||
//example glutGameModeString('1280x1024:32@75');
|
||||
glutGameModeString : procedure (const AString : PChar); extdecl;
|
||||
glutEnterGameMode : function : integer; extdecl;
|
||||
glutLeaveGameMode : procedure; extdecl;
|
||||
glutGameModeGet : function (mode : GLenum) : integer; extdecl;
|
||||
|
||||
procedure LoadGlut(const dll: String);
|
||||
procedure FreeGlut;
|
||||
|
||||
implementation
|
||||
|
||||
var
|
||||
hDLL: THandle;
|
||||
|
||||
procedure FreeGlut;
|
||||
begin
|
||||
|
||||
FreeLibrary(hDLL);
|
||||
|
||||
@glutInit := nil;
|
||||
@glutInitDisplayMode := nil;
|
||||
@glutInitDisplayString := nil;
|
||||
@glutInitWindowPosition := nil;
|
||||
@glutInitWindowSize := nil;
|
||||
@glutMainLoop := nil;
|
||||
@glutCreateWindow := nil;
|
||||
@glutCreateSubWindow := nil;
|
||||
@glutDestroyWindow := nil;
|
||||
@glutPostRedisplay := nil;
|
||||
@glutPostWindowRedisplay := nil;
|
||||
@glutSwapBuffers := nil;
|
||||
@glutGetWindow := nil;
|
||||
@glutSetWindow := nil;
|
||||
@glutSetWindowTitle := nil;
|
||||
@glutSetIconTitle := nil;
|
||||
@glutPositionWindow := nil;
|
||||
@glutReshapeWindow := nil;
|
||||
@glutPopWindow := nil;
|
||||
@glutPushWindow := nil;
|
||||
@glutIconifyWindow := nil;
|
||||
@glutShowWindow := nil;
|
||||
@glutHideWindow := nil;
|
||||
@glutFullScreen := nil;
|
||||
@glutSetCursor := nil;
|
||||
@glutWarpPointer := nil;
|
||||
@glutEstablishOverlay := nil;
|
||||
@glutRemoveOverlay := nil;
|
||||
@glutUseLayer := nil;
|
||||
@glutPostOverlayRedisplay := nil;
|
||||
@glutPostWindowOverlayRedisplay := nil;
|
||||
@glutShowOverlay := nil;
|
||||
@glutHideOverlay := nil;
|
||||
@glutCreateMenu := nil;
|
||||
@glutDestroyMenu := nil;
|
||||
@glutGetMenu := nil;
|
||||
@glutSetMenu := nil;
|
||||
@glutAddMenuEntry := nil;
|
||||
@glutAddSubMenu := nil;
|
||||
@glutChangeToMenuEntry := nil;
|
||||
@glutChangeToSubMenu := nil;
|
||||
@glutRemoveMenuItem := nil;
|
||||
@glutAttachMenu := nil;
|
||||
@glutDetachMenu := nil;
|
||||
@glutDisplayFunc := nil;
|
||||
@glutReshapeFunc := nil;
|
||||
@glutKeyboardFunc := nil;
|
||||
@glutMouseFunc := nil;
|
||||
@glutMotionFunc := nil;
|
||||
@glutPassiveMotionFunc := nil;
|
||||
@glutEntryFunc := nil;
|
||||
@glutVisibilityFunc := nil;
|
||||
@glutIdleFunc := nil;
|
||||
@glutTimerFunc := nil;
|
||||
@glutMenuStateFunc := nil;
|
||||
@glutSpecialFunc := nil;
|
||||
@glutSpaceballMotionFunc := nil;
|
||||
@glutSpaceballRotateFunc := nil;
|
||||
@glutSpaceballButtonFunc := nil;
|
||||
@glutButtonBoxFunc := nil;
|
||||
@glutDialsFunc := nil;
|
||||
@glutTabletMotionFunc := nil;
|
||||
@glutTabletButtonFunc := nil;
|
||||
@glutMenuStatusFunc := nil;
|
||||
@glutOverlayDisplayFunc := nil;
|
||||
@glutWindowStatusFunc := nil;
|
||||
@glutSetColor := nil;
|
||||
@glutGetColor := nil;
|
||||
@glutCopyColormap := nil;
|
||||
@glutGet := nil;
|
||||
@glutDeviceGet := nil;
|
||||
@glutExtensionSupported := nil;
|
||||
@glutGetModifiers := nil;
|
||||
@glutLayerGet := nil;
|
||||
@glutBitmapCharacter := nil;
|
||||
@glutBitmapWidth := nil;
|
||||
@glutStrokeCharacter := nil;
|
||||
@glutStrokeWidth := nil;
|
||||
@glutBitmapLength := nil;
|
||||
@glutStrokeLength := nil;
|
||||
@glutWireSphere := nil;
|
||||
@glutSolidSphere := nil;
|
||||
@glutWireCone := nil;
|
||||
@glutSolidCone := nil;
|
||||
@glutWireCube := nil;
|
||||
@glutSolidCube := nil;
|
||||
@glutWireTorus := nil;
|
||||
@glutSolidTorus := nil;
|
||||
@glutWireDodecahedron := nil;
|
||||
@glutSolidDodecahedron := nil;
|
||||
@glutWireTeapot := nil;
|
||||
@glutSolidTeapot := nil;
|
||||
@glutWireOctahedron := nil;
|
||||
@glutSolidOctahedron := nil;
|
||||
@glutWireTetrahedron := nil;
|
||||
@glutSolidTetrahedron := nil;
|
||||
@glutWireIcosahedron := nil;
|
||||
@glutSolidIcosahedron := nil;
|
||||
@glutVideoResizeGet := nil;
|
||||
@glutSetupVideoResizing := nil;
|
||||
@glutStopVideoResizing := nil;
|
||||
@glutVideoResize := nil;
|
||||
@glutVideoPan := nil;
|
||||
@glutReportErrors := nil;
|
||||
|
||||
end;
|
||||
|
||||
procedure LoadGlut(const dll: String);
|
||||
begin
|
||||
|
||||
FreeGlut;
|
||||
|
||||
hDLL := LoadLibrary(PChar(dll));
|
||||
if hDLL = 0 then raise Exception.Create('Could not load Glut from ' + dll);
|
||||
|
||||
@glutInit := GetProcAddress(hDLL, 'glutInit');
|
||||
@glutInitDisplayMode := GetProcAddress(hDLL, 'glutInitDisplayMode');
|
||||
@glutInitDisplayString := GetProcAddress(hDLL, 'glutInitDisplayString');
|
||||
@glutInitWindowPosition := GetProcAddress(hDLL, 'glutInitWindowPosition');
|
||||
@glutInitWindowSize := GetProcAddress(hDLL, 'glutInitWindowSize');
|
||||
@glutMainLoop := GetProcAddress(hDLL, 'glutMainLoop');
|
||||
@glutCreateWindow := GetProcAddress(hDLL, 'glutCreateWindow');
|
||||
@glutCreateSubWindow := GetProcAddress(hDLL, 'glutCreateSubWindow');
|
||||
@glutDestroyWindow := GetProcAddress(hDLL, 'glutDestroyWindow');
|
||||
@glutPostRedisplay := GetProcAddress(hDLL, 'glutPostRedisplay');
|
||||
@glutPostWindowRedisplay := GetProcAddress(hDLL, 'glutPostWindowRedisplay');
|
||||
@glutSwapBuffers := GetProcAddress(hDLL, 'glutSwapBuffers');
|
||||
@glutGetWindow := GetProcAddress(hDLL, 'glutGetWindow');
|
||||
@glutSetWindow := GetProcAddress(hDLL, 'glutSetWindow');
|
||||
@glutSetWindowTitle := GetProcAddress(hDLL, 'glutSetWindowTitle');
|
||||
@glutSetIconTitle := GetProcAddress(hDLL, 'glutSetIconTitle');
|
||||
@glutPositionWindow := GetProcAddress(hDLL, 'glutPositionWindow');
|
||||
@glutReshapeWindow := GetProcAddress(hDLL, 'glutReshapeWindow');
|
||||
@glutPopWindow := GetProcAddress(hDLL, 'glutPopWindow');
|
||||
@glutPushWindow := GetProcAddress(hDLL, 'glutPushWindow');
|
||||
@glutIconifyWindow := GetProcAddress(hDLL, 'glutIconifyWindow');
|
||||
@glutShowWindow := GetProcAddress(hDLL, 'glutShowWindow');
|
||||
@glutHideWindow := GetProcAddress(hDLL, 'glutHideWindow');
|
||||
@glutFullScreen := GetProcAddress(hDLL, 'glutFullScreen');
|
||||
@glutSetCursor := GetProcAddress(hDLL, 'glutSetCursor');
|
||||
@glutWarpPointer := GetProcAddress(hDLL, 'glutWarpPointer');
|
||||
@glutEstablishOverlay := GetProcAddress(hDLL, 'glutEstablishOverlay');
|
||||
@glutRemoveOverlay := GetProcAddress(hDLL, 'glutRemoveOverlay');
|
||||
@glutUseLayer := GetProcAddress(hDLL, 'glutUseLayer');
|
||||
@glutPostOverlayRedisplay := GetProcAddress(hDLL, 'glutPostOverlayRedisplay');
|
||||
@glutPostWindowOverlayRedisplay := GetProcAddress(hDLL, 'glutPostWindowOverlayRedisplay');
|
||||
@glutShowOverlay := GetProcAddress(hDLL, 'glutShowOverlay');
|
||||
@glutHideOverlay := GetProcAddress(hDLL, 'glutHideOverlay');
|
||||
@glutCreateMenu := GetProcAddress(hDLL, 'glutCreateMenu');
|
||||
@glutDestroyMenu := GetProcAddress(hDLL, 'glutDestroyMenu');
|
||||
@glutGetMenu := GetProcAddress(hDLL, 'glutGetMenu');
|
||||
@glutSetMenu := GetProcAddress(hDLL, 'glutSetMenu');
|
||||
@glutAddMenuEntry := GetProcAddress(hDLL, 'glutAddMenuEntry');
|
||||
@glutAddSubMenu := GetProcAddress(hDLL, 'glutAddSubMenu');
|
||||
@glutChangeToMenuEntry := GetProcAddress(hDLL, 'glutChangeToMenuEntry');
|
||||
@glutChangeToSubMenu := GetProcAddress(hDLL, 'glutChangeToSubMenu');
|
||||
@glutRemoveMenuItem := GetProcAddress(hDLL, 'glutRemoveMenuItem');
|
||||
@glutAttachMenu := GetProcAddress(hDLL, 'glutAttachMenu');
|
||||
@glutDetachMenu := GetProcAddress(hDLL, 'glutDetachMenu');
|
||||
@glutDisplayFunc := GetProcAddress(hDLL, 'glutDisplayFunc');
|
||||
@glutReshapeFunc := GetProcAddress(hDLL, 'glutReshapeFunc');
|
||||
@glutKeyboardFunc := GetProcAddress(hDLL, 'glutKeyboardFunc');
|
||||
@glutMouseFunc := GetProcAddress(hDLL, 'glutMouseFunc');
|
||||
@glutMotionFunc := GetProcAddress(hDLL, 'glutMotionFunc');
|
||||
@glutPassiveMotionFunc := GetProcAddress(hDLL, 'glutPassiveMotionFunc');
|
||||
@glutEntryFunc := GetProcAddress(hDLL, 'glutEntryFunc');
|
||||
@glutVisibilityFunc := GetProcAddress(hDLL, 'glutVisibilityFunc');
|
||||
@glutIdleFunc := GetProcAddress(hDLL, 'glutIdleFunc');
|
||||
@glutTimerFunc := GetProcAddress(hDLL, 'glutTimerFunc');
|
||||
@glutMenuStateFunc := GetProcAddress(hDLL, 'glutMenuStateFunc');
|
||||
@glutSpecialFunc := GetProcAddress(hDLL, 'glutSpecialFunc');
|
||||
@glutSpaceballMotionFunc := GetProcAddress(hDLL, 'glutSpaceballMotionFunc');
|
||||
@glutSpaceballRotateFunc := GetProcAddress(hDLL, 'glutSpaceballRotateFunc');
|
||||
@glutSpaceballButtonFunc := GetProcAddress(hDLL, 'glutSpaceballButtonFunc');
|
||||
@glutButtonBoxFunc := GetProcAddress(hDLL, 'glutButtonBoxFunc');
|
||||
@glutDialsFunc := GetProcAddress(hDLL, 'glutDialsFunc');
|
||||
@glutTabletMotionFunc := GetProcAddress(hDLL, 'glutTabletMotionFunc');
|
||||
@glutTabletButtonFunc := GetProcAddress(hDLL, 'glutTabletButtonFunc');
|
||||
@glutMenuStatusFunc := GetProcAddress(hDLL, 'glutMenuStatusFunc');
|
||||
@glutOverlayDisplayFunc := GetProcAddress(hDLL, 'glutOverlayDisplayFunc');
|
||||
@glutWindowStatusFunc := GetProcAddress(hDLL, 'glutWindowStatusFunc');
|
||||
@glutSetColor := GetProcAddress(hDLL, 'glutSetColor');
|
||||
@glutGetColor := GetProcAddress(hDLL, 'glutGetColor');
|
||||
@glutCopyColormap := GetProcAddress(hDLL, 'glutCopyColormap');
|
||||
@glutGet := GetProcAddress(hDLL, 'glutGet');
|
||||
@glutDeviceGet := GetProcAddress(hDLL, 'glutDeviceGet');
|
||||
@glutExtensionSupported := GetProcAddress(hDLL, 'glutExtensionSupported');
|
||||
@glutGetModifiers := GetProcAddress(hDLL, 'glutGetModifiers');
|
||||
@glutLayerGet := GetProcAddress(hDLL, 'glutLayerGet');
|
||||
@glutBitmapCharacter := GetProcAddress(hDLL, 'glutBitmapCharacter');
|
||||
@glutBitmapWidth := GetProcAddress(hDLL, 'glutBitmapWidth');
|
||||
@glutStrokeCharacter := GetProcAddress(hDLL, 'glutStrokeCharacter');
|
||||
@glutStrokeWidth := GetProcAddress(hDLL, 'glutStrokeWidth');
|
||||
@glutBitmapLength := GetProcAddress(hDLL, 'glutBitmapLength');
|
||||
@glutStrokeLength := GetProcAddress(hDLL, 'glutStrokeLength');
|
||||
@glutWireSphere := GetProcAddress(hDLL, 'glutWireSphere');
|
||||
@glutSolidSphere := GetProcAddress(hDLL, 'glutSolidSphere');
|
||||
@glutWireCone := GetProcAddress(hDLL, 'glutWireCone');
|
||||
@glutSolidCone := GetProcAddress(hDLL, 'glutSolidCone');
|
||||
@glutWireCube := GetProcAddress(hDLL, 'glutWireCube');
|
||||
@glutSolidCube := GetProcAddress(hDLL, 'glutSolidCube');
|
||||
@glutWireTorus := GetProcAddress(hDLL, 'glutWireTorus');
|
||||
@glutSolidTorus := GetProcAddress(hDLL, 'glutSolidTorus');
|
||||
@glutWireDodecahedron := GetProcAddress(hDLL, 'glutWireDodecahedron');
|
||||
@glutSolidDodecahedron := GetProcAddress(hDLL, 'glutSolidDodecahedron');
|
||||
@glutWireTeapot := GetProcAddress(hDLL, 'glutWireTeapot');
|
||||
@glutSolidTeapot := GetProcAddress(hDLL, 'glutSolidTeapot');
|
||||
@glutWireOctahedron := GetProcAddress(hDLL, 'glutWireOctahedron');
|
||||
@glutSolidOctahedron := GetProcAddress(hDLL, 'glutSolidOctahedron');
|
||||
@glutWireTetrahedron := GetProcAddress(hDLL, 'glutWireTetrahedron');
|
||||
@glutSolidTetrahedron := GetProcAddress(hDLL, 'glutSolidTetrahedron');
|
||||
@glutWireIcosahedron := GetProcAddress(hDLL, 'glutWireIcosahedron');
|
||||
@glutSolidIcosahedron := GetProcAddress(hDLL, 'glutSolidIcosahedron');
|
||||
@glutVideoResizeGet := GetProcAddress(hDLL, 'glutVideoResizeGet');
|
||||
@glutSetupVideoResizing := GetProcAddress(hDLL, 'glutSetupVideoResizing');
|
||||
@glutStopVideoResizing := GetProcAddress(hDLL, 'glutStopVideoResizing');
|
||||
@glutVideoResize := GetProcAddress(hDLL, 'glutVideoResize');
|
||||
@glutVideoPan := GetProcAddress(hDLL, 'glutVideoPan');
|
||||
@glutReportErrors := GetProcAddress(hDLL, 'glutReportErrors');
|
||||
@glutGameModeString := GetProcAddress(hDLL, 'glutGameModeString');
|
||||
@glutEnterGameMode := GetProcAddress(hDLL, 'glutEnterGameMode');
|
||||
@glutLeaveGameMode := GetProcAddress(hDLL, 'glutLeaveGameMode');
|
||||
@glutGameModeGet := GetProcAddress(hDLL, 'glutGameModeGet');
|
||||
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
try
|
||||
{$IFDEF Windows}
|
||||
LoadGlut('glut32.dll');
|
||||
{$ELSE}
|
||||
LoadGlut('libglut.so.3');
|
||||
{$ENDIF}
|
||||
except end;
|
||||
|
||||
finalization
|
||||
|
||||
FreeGlut;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
{
|
||||
$Log:
|
||||
}
|
||||
254
packages/extra/opengl/glx.pp
Normal file
254
packages/extra/opengl/glx.pp
Normal file
@ -0,0 +1,254 @@
|
||||
{
|
||||
$Id$
|
||||
|
||||
Translation of the Mesa GLX headers for FreePascal
|
||||
Copyright (C) 1999 Sebastian Guenther
|
||||
|
||||
|
||||
Mesa 3-D graphics library
|
||||
Version: 3.0
|
||||
Copyright (C) 1995-1998 Brian Paul
|
||||
|
||||
This library is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU Library General Public
|
||||
License as published by the Free Software Foundation; either
|
||||
version 2 of the License, or (at your option) any later version.
|
||||
|
||||
This library is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
Library General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU Library General Public
|
||||
License along with this library; if not, write to the Free
|
||||
Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
}
|
||||
|
||||
{$MODE delphi} // objfpc would not work because of direct proc var assignments
|
||||
|
||||
{You have to enable Macros (compiler switch "-Sm") for compiling this unit!
|
||||
This is necessary for supporting different platforms with different calling
|
||||
conventions via a single unit.}
|
||||
|
||||
unit GLX;
|
||||
|
||||
interface
|
||||
|
||||
{$MACRO ON}
|
||||
|
||||
{$IFDEF Unix}
|
||||
uses
|
||||
X, XLib, XUtil;
|
||||
{$DEFINE HasGLX} // Activate GLX stuff
|
||||
{$ELSE}
|
||||
{$MESSAGE Unsupported platform.}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFNDEF HasGLX}
|
||||
{$MESSAGE GLX not present on this platform.}
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
// =======================================================
|
||||
// Unit specific extensions
|
||||
// =======================================================
|
||||
|
||||
// Note: Requires that the GL library has already been initialized
|
||||
function InitGLX: Boolean;
|
||||
|
||||
var
|
||||
GLXDumpUnresolvedFunctions,
|
||||
GLXInitialized: Boolean;
|
||||
|
||||
|
||||
// =======================================================
|
||||
// GLX consts, types and functions
|
||||
// =======================================================
|
||||
|
||||
// Tokens for glXChooseVisual and glXGetConfig:
|
||||
const
|
||||
GLX_USE_GL = 1;
|
||||
GLX_BUFFER_SIZE = 2;
|
||||
GLX_LEVEL = 3;
|
||||
GLX_RGBA = 4;
|
||||
GLX_DOUBLEBUFFER = 5;
|
||||
GLX_STEREO = 6;
|
||||
GLX_AUX_BUFFERS = 7;
|
||||
GLX_RED_SIZE = 8;
|
||||
GLX_GREEN_SIZE = 9;
|
||||
GLX_BLUE_SIZE = 10;
|
||||
GLX_ALPHA_SIZE = 11;
|
||||
GLX_DEPTH_SIZE = 12;
|
||||
GLX_STENCIL_SIZE = 13;
|
||||
GLX_ACCUM_RED_SIZE = 14;
|
||||
GLX_ACCUM_GREEN_SIZE = 15;
|
||||
GLX_ACCUM_BLUE_SIZE = 16;
|
||||
GLX_ACCUM_ALPHA_SIZE = 17;
|
||||
|
||||
// GLX_EXT_visual_info extension
|
||||
GLX_X_VISUAL_TYPE_EXT = $22;
|
||||
GLX_TRANSPARENT_TYPE_EXT = $23;
|
||||
GLX_TRANSPARENT_INDEX_VALUE_EXT = $24;
|
||||
GLX_TRANSPARENT_RED_VALUE_EXT = $25;
|
||||
GLX_TRANSPARENT_GREEN_VALUE_EXT = $26;
|
||||
GLX_TRANSPARENT_BLUE_VALUE_EXT = $27;
|
||||
GLX_TRANSPARENT_ALPHA_VALUE_EXT = $28;
|
||||
|
||||
|
||||
// Error codes returned by glXGetConfig:
|
||||
GLX_BAD_SCREEN = 1;
|
||||
GLX_BAD_ATTRIBUTE = 2;
|
||||
GLX_NO_EXTENSION = 3;
|
||||
GLX_BAD_VISUAL = 4;
|
||||
GLX_BAD_CONTEXT = 5;
|
||||
GLX_BAD_VALUE = 6;
|
||||
GLX_BAD_ENUM = 7;
|
||||
|
||||
// GLX 1.1 and later:
|
||||
GLX_VENDOR = 1;
|
||||
GLX_VERSION = 2;
|
||||
GLX_EXTENSIONS = 3;
|
||||
|
||||
// GLX_visual_info extension
|
||||
GLX_TRUE_COLOR_EXT = $8002;
|
||||
GLX_DIRECT_COLOR_EXT = $8003;
|
||||
GLX_PSEUDO_COLOR_EXT = $8004;
|
||||
GLX_STATIC_COLOR_EXT = $8005;
|
||||
GLX_GRAY_SCALE_EXT = $8006;
|
||||
GLX_STATIC_GRAY_EXT = $8007;
|
||||
GLX_NONE_EXT = $8000;
|
||||
GLX_TRANSPARENT_RGB_EXT = $8008;
|
||||
GLX_TRANSPARENT_INDEX_EXT = $8009;
|
||||
|
||||
type
|
||||
// From XLib:
|
||||
XPixmap = TXID;
|
||||
XFont = TXID;
|
||||
XColormap = TXID;
|
||||
|
||||
GLXContext = Pointer;
|
||||
GLXPixmap = TXID;
|
||||
GLXDrawable = TXID;
|
||||
GLXContextID = TXID;
|
||||
|
||||
var
|
||||
glXChooseVisual: function(dpy: PDisplay; screen: Integer; var attribList: Integer): PXVisualInfo; cdecl;
|
||||
glXCreateContext: function(dpy: PDisplay; vis: PXVisualInfo; shareList: GLXContext; direct: Boolean): GLXContext; cdecl;
|
||||
glXDestroyContext: procedure(dpy: PDisplay; ctx: GLXContext); cdecl;
|
||||
glXMakeCurrent: function(dpy: PDisplay; drawable: GLXDrawable; ctx: GLXContext): Boolean; cdecl;
|
||||
glXCopyContext: procedure(dpy: PDisplay; src, dst: GLXContext; mask: LongWord); cdecl;
|
||||
glXSwapBuffers: procedure(dpy: PDisplay; drawable: GLXDrawable); cdecl;
|
||||
glXCreateGLXPixmap: function(dpy: PDisplay; visual: PXVisualInfo; pixmap: XPixmap): GLXPixmap; cdecl;
|
||||
glXDestroyGLXPixmap: procedure(dpy: PDisplay; pixmap: GLXPixmap); cdecl;
|
||||
glXQueryExtension: function(dpy: PDisplay; var errorb, event: Integer): Boolean; cdecl;
|
||||
glXQueryVersion: function(dpy: PDisplay; var maj, min: Integer): Boolean; cdecl;
|
||||
glXIsDirect: function(dpy: PDisplay; ctx: GLXContext): Boolean; cdecl;
|
||||
glXGetConfig: function(dpy: PDisplay; visual: PXVisualInfo; attrib: Integer; var value: Integer): Integer; cdecl;
|
||||
glXGetCurrentContext: function: GLXContext; cdecl;
|
||||
glXGetCurrentDrawable: function: GLXDrawable; cdecl;
|
||||
glXWaitGL: procedure; cdecl;
|
||||
glXWaitX: procedure; cdecl;
|
||||
glXUseXFont: procedure(font: XFont; first, count, list: Integer); cdecl;
|
||||
|
||||
// GLX 1.1 and later
|
||||
glXQueryExtensionsString: function(dpy: PDisplay; screen: Integer): PChar; cdecl;
|
||||
glXQueryServerString: function(dpy: PDisplay; screen, name: Integer): PChar; cdecl;
|
||||
glXGetClientString: function(dpy: PDisplay; name: Integer): PChar; cdecl;
|
||||
|
||||
// Mesa GLX Extensions
|
||||
glXCreateGLXPixmapMESA: function(dpy: PDisplay; visual: PXVisualInfo; pixmap: XPixmap; cmap: XColormap): GLXPixmap; cdecl;
|
||||
glXReleaseBufferMESA: function(dpy: PDisplay; d: GLXDrawable): Boolean; cdecl;
|
||||
glXCopySubBufferMESA: procedure(dpy: PDisplay; drawbale: GLXDrawable; x, y, width, height: Integer); cdecl;
|
||||
glXGetVideoSyncSGI: function(var counter: LongWord): Integer; cdecl;
|
||||
glXWaitVideoSyncSGI: function(divisor, remainder: Integer; var count: LongWord): Integer; cdecl;
|
||||
|
||||
|
||||
// =======================================================
|
||||
//
|
||||
// =======================================================
|
||||
|
||||
implementation
|
||||
|
||||
{$LINKLIB m}
|
||||
|
||||
function dlopen(AFile: PChar; mode: LongInt): Pointer; external 'dl';
|
||||
function dlclose(handle: Pointer): LongInt; external 'dl';
|
||||
function dlsym(handle: Pointer; name: PChar): Pointer; external 'dl';
|
||||
|
||||
function LoadLibrary(name: PChar): Pointer;
|
||||
begin
|
||||
Result := dlopen(name, $101 {RTLD_GLOBAL or RTLD_LAZY});
|
||||
end;
|
||||
|
||||
function GetProc(handle: Pointer; name: PChar): Pointer;
|
||||
begin
|
||||
Result := dlsym(handle, name);
|
||||
if (Result = nil) and GLXDumpUnresolvedFunctions then
|
||||
WriteLn('Unresolved: ', name);
|
||||
end;
|
||||
|
||||
var
|
||||
libGLX: Pointer;
|
||||
|
||||
function InitGLXFromLibrary(libname:pchar): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
libGLX := LoadLibrary(libname);
|
||||
if not Assigned(libGLX) then exit;
|
||||
|
||||
glXChooseVisual := GetProc(libglx, 'glXChooseVisual');
|
||||
glXCreateContext := GetProc(libglx, 'glXCreateContext');
|
||||
glXDestroyContext := GetProc(libglx, 'glXDestroyContext');
|
||||
glXMakeCurrent := GetProc(libglx, 'glXMakeCurrent');
|
||||
glXCopyContext := GetProc(libglx, 'glXCopyContext');
|
||||
glXSwapBuffers := GetProc(libglx, 'glXSwapBuffers');
|
||||
glXCreateGLXPixmap := GetProc(libglx, 'glXCreateGLXPixmap');
|
||||
glXDestroyGLXPixmap := GetProc(libglx, 'glXDestroyGLXPixmap');
|
||||
glXQueryExtension := GetProc(libglx, 'glXQueryExtension');
|
||||
glXQueryVersion := GetProc(libglx, 'glXQueryVersion');
|
||||
glXIsDirect := GetProc(libglx, 'glXIsDirect');
|
||||
glXGetConfig := GetProc(libglx, 'glXGetConfig');
|
||||
glXGetCurrentContext := GetProc(libglx, 'glXGetCurrentContext');
|
||||
glXGetCurrentDrawable := GetProc(libglx, 'glXGetCurrentDrawable');
|
||||
glXWaitGL := GetProc(libglx, 'glXWaitGL');
|
||||
glXWaitX := GetProc(libglx, 'glXWaitX');
|
||||
glXUseXFont := GetProc(libglx, 'glXUseXFont');
|
||||
// GLX 1.1 and later
|
||||
glXQueryExtensionsString := GetProc(libglx, 'glXQueryExtensionsString');
|
||||
glXQueryServerString := GetProc(libglx, 'glXQueryServerString');
|
||||
glXGetClientString := GetProc(libglx, 'glXGetClientString');
|
||||
// Mesa GLX Extensions
|
||||
glXCreateGLXPixmapMESA := GetProc(libglx, 'glXCreateGLXPixmapMESA');
|
||||
glXReleaseBufferMESA := GetProc(libglx, 'glXReleaseBufferMESA');
|
||||
glXCopySubBufferMESA := GetProc(libglx, 'glXCopySubBufferMESA');
|
||||
glXGetVideoSyncSGI := GetProc(libglx, 'glXGetVideoSyncSGI');
|
||||
glXWaitVideoSyncSGI := GetProc(libglx, 'glXWaitVideoSyncSGI');
|
||||
|
||||
GLXInitialized := True;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function InitGLX: Boolean;
|
||||
begin
|
||||
Result := InitGLXFromLibrary('libGL.so') or
|
||||
InitGLXFromLibrary('libGL.so.1') or
|
||||
InitGLXFromLibrary('libMesaGL.so') or
|
||||
InitGLXFromLibrary('libMesaGL.so.3');
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
InitGLX;
|
||||
finalization
|
||||
if Assigned(libGLX) then dlclose(libGLX);
|
||||
end.
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2002-10-13 13:57:31 sg
|
||||
* Finally, the new units are available: Match the C headers more closely;
|
||||
support for OpenGL extensions, and much more. Based on the Delphi units
|
||||
by Tom Nuydens of delphi3d.net
|
||||
|
||||
}
|
||||
@ -1,58 +1,22 @@
|
||||
Free Pascal GL* (GL, GLU, GLUT, GLX) Units
|
||||
(c) 1999-2000 Sebastian Guenther, sg@freepascal.org
|
||||
New Free Pascal OpenGL (GL, GLU, GLUT, GLX) Units
|
||||
GLX unit (c) 1999-2002 Sebastian Guenther, sg@freepascal.org
|
||||
other units adapted to Free Pascal from the delphi3d.net units
|
||||
by Tom Nuydens (tom@delphi3d.net), see http://www.delphi3d.net/
|
||||
|
||||
You might have a look at the original readme, glunits.txt, as well
|
||||
|
||||
|
||||
subdirectory "build"
|
||||
--------------------
|
||||
This directory contains tools which create the sources of the real GL* units
|
||||
based on some template files. It contains its own README file, look there for
|
||||
further informations.
|
||||
|
||||
|
||||
subdirectory "linux"
|
||||
--------------------
|
||||
Contains the GL* units for Linux; currently you can use all GL, GLU and GLX
|
||||
functions as well as most GLUT functions. Automatic loading of GL extensions
|
||||
is not supported yet, but is planned for the future.
|
||||
Under Linux, the GL* units try to locate the underlying libraries at run-time;
|
||||
they search for the libraries in the following order:
|
||||
|
||||
GL: (includes GLX)
|
||||
1. libGL.so
|
||||
2. libGL.so.1
|
||||
3. libMesaGL.so.3
|
||||
|
||||
GLU:
|
||||
1. libGLU.so
|
||||
2. libGLU.so.1
|
||||
3. libMesaGLU.so.3
|
||||
|
||||
GLUT:
|
||||
1. libglut.so
|
||||
2. libglut.so.3
|
||||
|
||||
This should work on all more recent Linux installations.
|
||||
|
||||
|
||||
The GL unit has a variable called "GLDumpUnresolvedFunctions", and the GLUT
|
||||
unit one called "GLUTDumpUnresolvedFunctions". Set them to True in your
|
||||
applications if you want to get all function names dumped to the console
|
||||
which couldn't be resolved, i.e. which are not available in the loaded
|
||||
libraries.
|
||||
|
||||
|
||||
=== gtkglarea: ===
|
||||
|
||||
Additionally, there is an adaption for the gtkglarea (GTK GL area widget)
|
||||
available; as gtkglarea uses the XLib it is only available for Linux here.
|
||||
|
||||
|
||||
subdirectory "examples"
|
||||
-----------------------
|
||||
Only contains a test program called "glutdemo" at the moment, which
|
||||
demonstrates the use of the GL and GLUT units.
|
||||
|
||||
|
||||
|
||||
Have fun,
|
||||
Sebastian
|
||||
Some remarks:
|
||||
* The new OpenGL units are not 100% compatible to the old ones; the new units
|
||||
use exactly the same function declarations as their C counterpart.
|
||||
* Platform compatiblity: You can work on all targets exactly as on Win32;
|
||||
for example, you can use wglGetProcAddress for loading OpenGL extensions even
|
||||
on Unix based systems. A future release of the glext unit might have helper
|
||||
functions for loading specific extensions. (There is a small problem with
|
||||
Free Pascal: In FPC mode, you cannot assign a pointer, as returned by
|
||||
wglGetProcAddress, to a variable which holds a function pointer. Currently
|
||||
you have to compile your programs in Delphi mode, if they are using OpenGL
|
||||
extensions)
|
||||
* GLUT on Win32: Get the glut32.dll from here:
|
||||
http://www.xmission.com/~nate/glut.html
|
||||
* GTKGLArea: The GL Area widget for GTK is available in the GTK package
|
||||
|
||||
Loading…
Reference in New Issue
Block a user