[fpc-devel] OpenGL patch

[Florian Klaempfl]

Ales Katona wrote:

> Ok so here's the patch. If you feel some things should change, tell me
> about it.
> This patch adds "TryLoadGL[u[t]]" and "GL[u[t]]IsLoaded" methods and
> also "fixes" the crash on win32 if opengl is not present. (but it will
> still crash later, if the user doesn't check)
> 
> Ales

I don't like this patch. Some years ago we didn't abort when no e.g. no
glut.dll was found and we get a lot of bug reports like 2969 and 3100
where people complained that they get runtime errors when using opengl code.

> 
> 
> ------------------------------------------------------------------------
> 
> Index: packages/extra/opengl/gl.pp
> ===================================================================
> --- packages/extra/opengl/gl.pp	(revision 446)
> +++ packages/extra/opengl/gl.pp	(working copy)
> @@ -1534,15 +1534,26 @@
>    PFNGLGETCOLORTABLEPARAMETERIVEXTPROC = procedure(target, pname: GLenum; params: PGLint); extdecl;
>    PFNGLGETCOLORTABLEPARAMETERFVEXTPROC = procedure(target, pname: GLenum; params: PGLfloat); extdecl;
>  
> +function GLIsLoaded: Boolean;
>  procedure LoadOpenGL(const dll: String);
> +procedure TryLoadGL;
>  procedure FreeOpenGL;
>  
> +
>  implementation
>  
> +var
> +  GLLoaded: Boolean;
> +
>  {$ifdef win32}
>  function WinChoosePixelFormat(DC: HDC; p2: PPixelFormatDescriptor): Integer; extdecl; external 'gdi32' name 'ChoosePixelFormat';
>  {$endif}
>  
> +function GLIsLoaded: Boolean;
> +begin
> +  Result:=GLLoaded;
> +end;
> +
>  procedure FreeOpenGL;
>  begin
>  
> @@ -1887,7 +1898,7 @@
>    {$ENDIF}
>  
>    FreeLibrary(LibGL);
> -
> +  GLLoaded:=False;
>  end;
>  
>  procedure LoadOpenGL(const dll: String);
> @@ -2240,15 +2251,11 @@
>    if not Assigned(ChoosePixelFormat) then
>      @ChoosePixelFormat := @WinChoosePixelFormat;
>    {$ENDIF}
> -
> +  GLLoaded:=True;
>  end;
>  
> -initialization
> -
> -  {$IFDEF WIN32}
> -  Set8087CW($133F);
> -  {$ENDIF WIN32}
> -
> +procedure TryLoadGL;
> +begin
>    try
>      {$IFDEF Win32}
>      LoadOpenGL('opengl32.dll');
> @@ -2260,10 +2267,19 @@
>      {$endif}
>      {$ENDIF}
>    except
> -    writeln('Error opening OpenGL library');
> -    halt(1);
> +    GLLoaded:=False;
>    end;
> +end;
>  
> +initialization
> +
> +  {$IFDEF WIN32}
> +  Set8087CW($133F);
> +  {$ENDIF WIN32}
> +
> +  GLLoaded:=False;
> +  TryLoadGL;
> +
>  finalization
>  
>    FreeOpenGL;
> Index: packages/extra/opengl/glu.pp
> ===================================================================
> --- packages/extra/opengl/glu.pp	(revision 446)
> +++ packages/extra/opengl/glu.pp	(working copy)
> @@ -363,14 +363,22 @@
>    GLU_ERROR       = GLU_TESS_ERROR;
>    GLU_EDGE_FLAG   = GLU_TESS_EDGE_FLAG;
>  
> +function GLuIsLoaded: Boolean;
>  procedure LoadGLu(const dll: String);
> +procedure TryLoadGLu;
>  procedure FreeGLu;
>  
>  implementation
>  
>  var
>    hDLL: THandle;
> +  GLuLoaded: Boolean;
>  
> +function GLuIsLoaded: Boolean;
> +begin
> +  Result:=GLuLoaded;
> +end;
> +
>  procedure FreeGLu;
>  begin
>  
> @@ -428,7 +436,7 @@
>    @gluEndPolygon := nil;
>  
>    FreeLibrary(hDLL);
> -
> +  GLuLoaded:=False;
>  end;
>  
>  procedure LoadGLu(const dll: String);
> @@ -492,11 +500,11 @@
>    @gluBeginPolygon := GetProcAddress(hDLL, 'gluBeginPolygon');
>    @gluNextContour := GetProcAddress(hDLL, 'gluNextContour');
>    @gluEndPolygon := GetProcAddress(hDLL, 'gluEndPolygon');
> -
> +  GLuLoaded:=True;
>  end;
>  
> -initialization
> -
> +procedure TryLoadGLU;
> +begin
>    try
>      {$IFDEF Win32}
>      LoadGLu('glu32.dll');
> @@ -508,10 +516,14 @@
>      {$ENDIF}
>      {$endif}
>    except
> -    writeln('error opening libGLU');
> -    halt(1);
> +    GLuLoaded:=False;
>    end;
> +end;
>  
> +initialization
> +  GLuLoaded:=False;
> +  TryLoadGLu;
> +
>  finalization
>  
>    FreeGLu;
> Index: packages/extra/opengl/glut.pp
> ===================================================================
> --- packages/extra/opengl/glut.pp	(revision 446)
> +++ packages/extra/opengl/glut.pp	(working copy)
> @@ -390,14 +390,22 @@
>    glutLeaveGameMode : procedure; extdecl;
>    glutGameModeGet : function (mode : GLenum) : integer; extdecl;
>  
> +function GLutIsLoaded: Boolean;
>  procedure LoadGlut(const dll: String);
> +procedure TryLoadGLut;
>  procedure FreeGlut;
>  
>  implementation
>  
>  var
>    hDLL: THandle;
> +  GLutLoaded: Boolean;
>  
> +function GLutIsLoaded: Boolean;
> +begin
> +  Result:=GLutLoaded;
> +end;
> +
>  procedure FreeGlut;
>  begin
>  
> @@ -507,7 +515,7 @@
>    @glutVideoResize := nil;
>    @glutVideoPan := nil;
>    @glutReportErrors := nil;
> -
> +  GLutLoaded:=False;
>  end;
>  
>  procedure LoadGlut(const dll: String);
> @@ -626,11 +634,11 @@
>    @glutEnterGameMode  := GetProcAddress(hDLL, 'glutEnterGameMode');
>    @glutLeaveGameMode  := GetProcAddress(hDLL, 'glutLeaveGameMode');
>    @glutGameModeGet    := GetProcAddress(hDLL, 'glutGameModeGet');
> -
> +  GLutLoaded:=True;
>  end;
>  
> -initialization
> -
> +procedure TryLoadGLut;
> +begin
>    try
>      {$IFDEF Win32}
>      LoadGlut('glut32.dll');
> @@ -642,10 +650,14 @@
>      {$endif}
>      {$ENDIF}
>    except
> -    writeln('Can''t load glut library');
> -    halt(1);
> +    GLutLoaded:=False;
>    end;
> +end;
>  
> +initialization
> +  GLutLoaded:=False;
> +  TryLoadGLut;
> +
>  finalization
>  
>    FreeGlut;
> 
> 
> ------------------------------------------------------------------------
> 
> _______________________________________________
> fpc-devel maillist  -  fpc-devel at lists.freepascal.org
> http://lists.freepascal.org/mailman/listinfo/fpc-devel