diff options
Diffstat (limited to '')
65 files changed, 45190 insertions, 45190 deletions
diff --git a/Game/Code/lib/FreeImage/FreeBitmap.pas b/Game/Code/lib/FreeImage/FreeBitmap.pas index 4e5f50a4..4e5f50a4 100755..100644 --- a/Game/Code/lib/FreeImage/FreeBitmap.pas +++ b/Game/Code/lib/FreeImage/FreeBitmap.pas diff --git a/Game/Code/lib/FreeImage/FreeImage.pas b/Game/Code/lib/FreeImage/FreeImage.pas index b8e2c4a7..b8e2c4a7 100755..100644 --- a/Game/Code/lib/FreeImage/FreeImage.pas +++ b/Game/Code/lib/FreeImage/FreeImage.pas diff --git a/Game/Code/lib/JEDI-SDL/JEDI-SDL-README.txt b/Game/Code/lib/JEDI-SDL/JEDI-SDL-README.txt index a068e943..8e0d25f9 100644 --- a/Game/Code/lib/JEDI-SDL/JEDI-SDL-README.txt +++ b/Game/Code/lib/JEDI-SDL/JEDI-SDL-README.txt @@ -1,244 +1,244 @@ -This is the based on the SDL ( http://www.libsdl.org ) headers, and has been converted, comments and all, to the Pascal unit called sdl.pas.
-Other conversions that have also been done are SDL_Mixer.h, SDL_Net.h, SDL_Image.h, SDL_ttf, SMPEG.h, SDL_sound and the SFont library,
-which are all included in this distribution.
-
-It allows you to access all the functions within the SDL libraries under Windows, Linux and FreeBSD, so you can write cross-platform games or multimedia applications.
-
-Installation Instructions
--------------------------
-Windows - We now have a semi-automated setup under Windows ( thanks to David House and the Jedi JCL team ).
- Once you have extracted the zip file, simply double click on the "JEDISDLWin32Installer.exe" to have the correct paths added to your respective
- IDEs. All IDEs from Delphi 4 - 7 are supported and it also adds a link to the .CHM help file under the Tools menu.
-
-Linux - Alternatively if you use Linux or want to to manually install the paths, then make sure you read the "Getting Started.html" file ( ideal for those who are new to JEDI-SDL ) and is now included as a guide to help getting everything setup for smooth compilation.
-
-Also included is a guide of how to use Sourceforge using TortoiseCVS under Windows ( Linux guide is under development ).
-Both documents can be found in the "documentation" directory.
-
-
-Release History
----------------
-1.0 : Yeah!! The Official v1.0 Release of JEDI-SDL!!
- JEDI-SDL now updated to SDL v1.2.11, SDL_Image v1.2.5, SDL_Mixer v1.2.7, SDL_Net v1.2.6 & SDL_ttf v2.0.8
- Added Improved FreePascal, TMT Pascal and GnuPascal support as well as maintaining Delphi/Kylix support.
- Fixed Various bugs as pointed out on the JEDI-SDL mailing list.
- Added SDL_GL_STEREO, SDL_GL_MULTISAMPLEBUFFERS, SDL_GL_MULTISAMPLESAMPLES
-
-Now works on MacOS X and a MacOS X disk image is available for download.
-
-// DLL/Shared object functions
-function SDL_LoadObject( const sofile : PChar ) : Pointer;
-
-function SDL_LoadFunction( handle : Pointer; const name : PChar ) : Pointer;
-
-procedure SDL_UnloadObject( handle : Pointer );
-
-//Added function to create RWops from const memory: SDL_RWFromConstMem()
-function SDL_RWFromConstMem(const mem: Pointer; size: Integer) : PSDL_RWops;
-
-//Added support for environment variables SDL_VIDEO_WINDOW_POS and SDL_VIDEO_CENTERED on Windows
-
- New Units :
- -----------
- sdl_cpuinfo.pas - ported SDL_cpuinfo.h so Now you can test for Specific CPU types.
- sdlinput.pas - Input wrapper class
- sdlwindow.pas - Window wrapper class
- sdltruetypefont.pas - True Type Font wrapper class
- tcputils.pas - SDL_Net utility functions
- sdlweb.pas - SDL_Net Web class
- sdlwebhttp.pas - SDL_Net http protocol wrapper class
- sdlwebftp.pas - SDL_Net ftp protocol wrapper class
-
- New 2D Demos :
- --------------
-
-
- New 3D Demos :
- --------------
-
-
- Other New Stuff :
- -----------------
-
-
-
-0.5 : The JEDI-SDL project is now also set up on Sourceforge ( http://sf.net/projects/jedi-sdl/ ) so the latest code is available from there.
- Improved FreePascal support has been added.
- Various bug fixes as pointed out on the JEDI-SDL mailing list.
- SDL_Mixer has been updated to version 1.2.1 and includes an Effects API.
- Demo directories are now split into 2D and 3D related sub-directories.
- There are now both Kylix ( K prefix ) and Delphi ( D prefix ) project groups for all the demos.
- They can be found in Demos and the 2D and 3D directories.
-
- New Units
- ---------
- SDLStreams.pas - Chris Bruner has created a wrapper that uses Streams to load BMPs
- SDLUtils.pas - Pascal only version of some Utility functions
- SDLi386Utils.pas - Intel Assembler versions of the SDLUtils.pas functions.
- SDL_ttf.pas - Port of the SDL True Type font support unit.
- SDL_Sound.pas - Port of the SDL Sound library ( untested ).
-
- New 2D Demos :
- --------------
- Pan and Zoom Demo - How to Pan and Zoom an SDL surface.
- Isometric Demo - I ported my old DelphiX isometric demo over to SDL.
- TestTimer demo - Shows hows how to use AddTimer and RemoveTimer.
- MpegPlayer - I have updated and improved Anders Ohlsson's CLX MPegPlayer and component and it now works
- and installs into D4, D5, D6, D7, K1, K2 & K3.
- Showfont - Demo to show how to us SDL_ttf.dll
- SmpegPlayer - is a console MPEG player that use smpeg and SDL_Mixer
-
- New 3D Demos :
- --------------
- DeathTruckTion 1.1 - A slightly updated version of this fully functional 3D network game.
- TerrainDemo - Terrain demo ported from the book "OpenGL Game programming" by Hawkins and Astle.
- TestGL - the standard SDL/OpenGL Test demo. Shows how to mix 2D and 3D rendering using OpenGL.
- glfont - Demo to show how to us SDL_ttf with OpenGL.
- Particle Engine - Ariel's OpenGL Particle Engine.
- Picking - Phil Freeman's Picking Demo
- Motion Blur - Phil Freeman's Motion Blur Demo
- Dynamic Light - Phil Freeman's Dynamic Light Demo
- Environment Map - Phil Freeman's Environment Map Demo
- GLMovie - is an MPEG Player that uses OpenGL to render the movie.
- NeHe - Quite a few more NeHe demos are now included.
-
- New Network Demos :
- -------------------
- There are now 3 SDL_Net Server demos and 4 SDL_Client demos as submitted by Dean Ellis.
-
-
-Beta 4 : The JEDI-SDL home page is now located @ http://www.delphi-jedi.org/Jedi:TEAM_SDL_HOME
- All Demos ( including OpenGL Demos ) now compile under both Kylix and Delphi.
- I have added quite a few more OpenGL examples, we are now up to Nehe tutorial 12.
- All OpenGL demos also show how to handle Window resizing.
- Included an OpenGL demo called Puntos by Gustavo Maximo.
- Ported Jan Horn's OpenGL MetaBalls and also SkyBox demo to SDL.
- Ported Ilkka Tuomioja's OpenGL Quake 2 Model Viewer/Animator to SDL.
- NOTE : All OpenGL demos require OpenGL12.pas which can be found at...
- http://www.lischke-online.de/Graphics.html#OpenGL12
- I also fixed a conversion bug to do with SDL_MustLock and also a conversion omission to do with various events.
- Fixed a conversion bug with SDL_CDOpen ( as suggested on the mailing list ).
- Added the GetPixel and PuxPixel functions to the SDLUtils.pas file.
- Jason Farmer has donated SFont, a simple, yet effective Font library he converted for JEDI-SDL.
- It contains 4 Demos show how to best use it.
- Added TUInt8Array and PUIntArray to SDL.pas after suggestions from Matthias Thoma and Eric Grange.
- In the file area of the JEDI-SDL mailing list ( http://groups.yahoo.com/group/JEDI-SDL/files/DTTSrc/ there
- is a fully functional 3D network game called DeathTruckTion v1.0 written by the TNTeam that makes use of
- JEDI-SDL and is just too big to include with this distribution but is well worth looking at as it works under Windows and Linux!
- Gustavo Maxima is working on translating the JEDI-SDL Documentation to Spanish and Portugese.
- The Mouse Demo has now been speeded up considerably and it is very responsive now.
- Dean Ellis will provide steps on how to compile the demos using the Free Pascal compiler.
- Jason Farmer and I are working on a series of Tutorials that should hopefully be out soon.
- David Aclan has donated a SMpeg component that should work under Kylix.
- Róbert Kisnémeth, has been hard at work, and has donated some new demos he has created with a SpriteEngine ( which he also donated ).
- He has also donated a couple of games called BlitzBomber and Oxygene ( which uses the SpriteEngine ) and added a couple of useful
- functions to SDLUtils.pas.
- The Functions added are SDL_FlipV, SDL_FlipH, SDL_NewPutPixel ( assembler version ), SDL_AddPixel, SDL_SubPixel, SDL_DrawLine, SDL_AddLine,
- SDL_SubLine, SDL_AddSurface, SDL_SubSurface, SDL_MonoSurface & SDL_TexturedSurface.
- He has also donated a Font Blitting class and demo called SDL_MonoFonts which supports alignment like Left, Right and Center.
- He and Thomas are also working on a GUI library.
- Jason Farmer has donated a set of Image Filtering functions which add quite a few interesting effects. Check the SDL_Filter sub-directory for more
- info.
- Christian Hackbart also donated an OpenGL BlockOut clone.
-
-
-Beta 3 : I have added conversions for SDL_env.h, SDL_Mixer.h and SDL_Net.h while Matthias Thoma has added conversions for SDL_Image.h and SMPEG.h.
- This version is also SDL version 1.2.0 compliant.
- This release also adds demos for the SDL_Image, SDL_Mixer and SDL_Net libraries.
- There are now also some OpenGL demos that make some use of SDL as well as a demo on how to use the Mouse with Clickable regions.
- A conversion bug, that was pointed out by Clem Vasseur, has also been fixed.
- There is now a mailing list that has been set up at http://groups.yahoo.com/group/JEDI-SDL/join/ so we can all learn from each other how to use
- these libraries.
- Demos have not been unified into single .dpr files for each demo, thus showing how you would write a crossplatform game using only 1 .dpr file.
- There is also a documentation directory that is currently in HTML format. All code examples in the documentation have been converted to Object
- Pascal but are untested.
- I Also fixed a few conversion bugs which I came across while converting the documentation.
-
-Beta 2 : I have added conversions for SDL_active.h, SDL_thread.h, SDL_mutex.h and
- SDL_error.h, Matthias Thoma has added Linux Support and JEDI compliancy so these
- units and examples are now x-platform and x-compiler compilable.
- I also added Tom Jones' SDLUtils.pas file;
- Matthias also cleaned up the 2 new demos and made them work on both Linux and
- Windows.
-
-Beta 1 : Initial Release;
-
-
-There are now 5 examples included with this JEDI-SDL distribution.
-1. Is the TestWin application, which is based on the testwin application that comes with the SDL SDK, only my version has a gui front end to the options available and has been compiled under Delphi 4.03. It should be compatible with Delphi 3.0 onwards ( though Delphi 2 compatibility has not been tested ).
-
-2. A Plasma example which was converted from one found on the Demos page of the SDL site.
-
-3. A Voxel terrain following demo, which was converted from one found on the Demos page of the SDL site. This one should be of interest to others as it shows how to handle keyboard events when using SDL.
-
-4. A Mouse handling demo that shows how to use transparency and clickable regions.
-
-5. A Space Invaders style game called Aliens which shows the use of SDL, SDL_Image and SDL_Mixer. This game shows how to handle sound, keyboards and some basic collision detection. It is a conversion of one found on the SDL Demos page.
-
-There are also 14 OpenGL demos that are based on the NeHe tutorials <nehe.gamedev.net>. The other 3 OpenGL demos are Jan Horns' OpenGL demo, A Quake 2 Model viewer that I ported and a Demo by Gustavo Maxima called Puntos.
-
-If writing your own, just make sure that the SDL.pas file is in your projects path for compiling and that the SDL.dll file is in your path when running the compiled app.
-
-Please test these units and report problems to the JEDI-SDL mailing list @ http://groups.yahoo.com/group/JEDI-SDL/ outlining steps under which the error occurred. If you convert any more demos please send them to me so that I can
-include them in the ditribution for others to learn from.
-
-Also if you are using these Units to write any games
-please let me know about it so that I can post the information to the http://www.DelphiGamer.com site.
-
-The plan is to have this unit JEDI certified at some point so that it can be included on the Delphi and Kylix CDs, so all feedback is greatly welcomed.
-
-Compilers supported Tested
-------------------- ------
-Delphi Yes
-Kylix Yes
-FreePascal Yes
-TMT Pascal compiler Not Yet.
-Virtual Pascal No
-Gnu Pascal No
-
-
-
-Credits
--------
-Matthias Thoma <ma.thoma@gmx.de> for is endless help with my conversion bugs.
-Jason Farmer <jason@cerebral-bicycle.co.uk> for donating the SFont Font Library.
-Gustavo Maximo <gmaximo@secretariaplus.com> for the Puntos OpenGL Demo and work he is doing on the documentation
-Róbert Kisnémeth <mikrobi@freemail.hu> for his numerous contributions
-Chris Bruner <cryst@golden.net> for testing under Kylix
-August Logan Bear Jr.<augustjr@columbus.rr.com> for testing under Kylix
-Dean Ellis<dean_ellis@yahoo.com> for FreePascal Compiler compatability testing and SDL_Net demos and testing
-David House<david@dahsoftware.com> for Windows Insaller and testing.
-Romi Kuntsman<romik12345@lycos.co.uk> for helping out on some OpenGL issues.
-Everyone on the JEDI-SDL <http://groups.yahoo.com/group/JEDI-SDL/join/> mailing list for their feedback and support.
-Everyone on the Delphi-JEDI <http://groups.yahoo.com/group/Delphi-JEDI/join/> mailing for answering my conversion questions.
-Tom Jones for inspiring this conversion.
-
-The JEDI-SDL Home page can be found @ http://www.delphi-jedi.org/Jedi:TEAM_SDL_HOME
-
-The JEDI-SDL source code archive can be found @ http://www.sf.net/projects/jedi-sdl/
-
-The JEDI-SDL mailing list can be found @ http://groups.yahoo.com/group/JEDI-SDL/join/
-
-The Latest Stable Release version of the JEDI-SDL.zip file can always be found on the Delphi-JEDI site <http://www.delphi-jedi.org/Jedi:TEAM_SDL_HOME>
-
-The Latest Alpha/Unstable version can always be grabbed from the SourceForge CVS http://sourceforge.net/cvs/?group_id=43805
-
-
-Sincerely,
-
-
-
-Dominique Louis
-Delphi Game Developer.
-*********************************************************
-** To Do Nothing is to Collaborate with the oppressor **
-** -------------------------------------------------- **
-*********************************************************
-=========================================================
-From . . . . . . . : Dominique Louis
-Email. . . . . . . : Dominique@SavageSoftware.com.au
-Company. . . . . . : Savage Software Solutions
-Delphi Games Site. : http://www.DelphiGamer.com
-Delphi JEDI Site . : http://www.delphi-jedi.org
-=========================================================
-
+This is the based on the SDL ( http://www.libsdl.org ) headers, and has been converted, comments and all, to the Pascal unit called sdl.pas. +Other conversions that have also been done are SDL_Mixer.h, SDL_Net.h, SDL_Image.h, SDL_ttf, SMPEG.h, SDL_sound and the SFont library, +which are all included in this distribution. + +It allows you to access all the functions within the SDL libraries under Windows, Linux and FreeBSD, so you can write cross-platform games or multimedia applications. + +Installation Instructions +------------------------- +Windows - We now have a semi-automated setup under Windows ( thanks to David House and the Jedi JCL team ). + Once you have extracted the zip file, simply double click on the "JEDISDLWin32Installer.exe" to have the correct paths added to your respective + IDEs. All IDEs from Delphi 4 - 7 are supported and it also adds a link to the .CHM help file under the Tools menu. + +Linux - Alternatively if you use Linux or want to to manually install the paths, then make sure you read the "Getting Started.html" file ( ideal for those who are new to JEDI-SDL ) and is now included as a guide to help getting everything setup for smooth compilation. + +Also included is a guide of how to use Sourceforge using TortoiseCVS under Windows ( Linux guide is under development ). +Both documents can be found in the "documentation" directory. + + +Release History +--------------- +1.0 : Yeah!! The Official v1.0 Release of JEDI-SDL!! + JEDI-SDL now updated to SDL v1.2.11, SDL_Image v1.2.5, SDL_Mixer v1.2.7, SDL_Net v1.2.6 & SDL_ttf v2.0.8 + Added Improved FreePascal, TMT Pascal and GnuPascal support as well as maintaining Delphi/Kylix support. + Fixed Various bugs as pointed out on the JEDI-SDL mailing list. + Added SDL_GL_STEREO, SDL_GL_MULTISAMPLEBUFFERS, SDL_GL_MULTISAMPLESAMPLES + +Now works on MacOS X and a MacOS X disk image is available for download. + +// DLL/Shared object functions +function SDL_LoadObject( const sofile : PChar ) : Pointer; + +function SDL_LoadFunction( handle : Pointer; const name : PChar ) : Pointer; + +procedure SDL_UnloadObject( handle : Pointer ); + +//Added function to create RWops from const memory: SDL_RWFromConstMem() +function SDL_RWFromConstMem(const mem: Pointer; size: Integer) : PSDL_RWops; + +//Added support for environment variables SDL_VIDEO_WINDOW_POS and SDL_VIDEO_CENTERED on Windows + + New Units : + ----------- + sdl_cpuinfo.pas - ported SDL_cpuinfo.h so Now you can test for Specific CPU types. + sdlinput.pas - Input wrapper class + sdlwindow.pas - Window wrapper class + sdltruetypefont.pas - True Type Font wrapper class + tcputils.pas - SDL_Net utility functions + sdlweb.pas - SDL_Net Web class + sdlwebhttp.pas - SDL_Net http protocol wrapper class + sdlwebftp.pas - SDL_Net ftp protocol wrapper class + + New 2D Demos : + -------------- + + + New 3D Demos : + -------------- + + + Other New Stuff : + ----------------- + + + +0.5 : The JEDI-SDL project is now also set up on Sourceforge ( http://sf.net/projects/jedi-sdl/ ) so the latest code is available from there. + Improved FreePascal support has been added. + Various bug fixes as pointed out on the JEDI-SDL mailing list. + SDL_Mixer has been updated to version 1.2.1 and includes an Effects API. + Demo directories are now split into 2D and 3D related sub-directories. + There are now both Kylix ( K prefix ) and Delphi ( D prefix ) project groups for all the demos. + They can be found in Demos and the 2D and 3D directories. + + New Units + --------- + SDLStreams.pas - Chris Bruner has created a wrapper that uses Streams to load BMPs + SDLUtils.pas - Pascal only version of some Utility functions + SDLi386Utils.pas - Intel Assembler versions of the SDLUtils.pas functions. + SDL_ttf.pas - Port of the SDL True Type font support unit. + SDL_Sound.pas - Port of the SDL Sound library ( untested ). + + New 2D Demos : + -------------- + Pan and Zoom Demo - How to Pan and Zoom an SDL surface. + Isometric Demo - I ported my old DelphiX isometric demo over to SDL. + TestTimer demo - Shows hows how to use AddTimer and RemoveTimer. + MpegPlayer - I have updated and improved Anders Ohlsson's CLX MPegPlayer and component and it now works + and installs into D4, D5, D6, D7, K1, K2 & K3. + Showfont - Demo to show how to us SDL_ttf.dll + SmpegPlayer - is a console MPEG player that use smpeg and SDL_Mixer + + New 3D Demos : + -------------- + DeathTruckTion 1.1 - A slightly updated version of this fully functional 3D network game. + TerrainDemo - Terrain demo ported from the book "OpenGL Game programming" by Hawkins and Astle. + TestGL - the standard SDL/OpenGL Test demo. Shows how to mix 2D and 3D rendering using OpenGL. + glfont - Demo to show how to us SDL_ttf with OpenGL. + Particle Engine - Ariel's OpenGL Particle Engine. + Picking - Phil Freeman's Picking Demo + Motion Blur - Phil Freeman's Motion Blur Demo + Dynamic Light - Phil Freeman's Dynamic Light Demo + Environment Map - Phil Freeman's Environment Map Demo + GLMovie - is an MPEG Player that uses OpenGL to render the movie. + NeHe - Quite a few more NeHe demos are now included. + + New Network Demos : + ------------------- + There are now 3 SDL_Net Server demos and 4 SDL_Client demos as submitted by Dean Ellis. + + +Beta 4 : The JEDI-SDL home page is now located @ http://www.delphi-jedi.org/Jedi:TEAM_SDL_HOME + All Demos ( including OpenGL Demos ) now compile under both Kylix and Delphi. + I have added quite a few more OpenGL examples, we are now up to Nehe tutorial 12. + All OpenGL demos also show how to handle Window resizing. + Included an OpenGL demo called Puntos by Gustavo Maximo. + Ported Jan Horn's OpenGL MetaBalls and also SkyBox demo to SDL. + Ported Ilkka Tuomioja's OpenGL Quake 2 Model Viewer/Animator to SDL. + NOTE : All OpenGL demos require OpenGL12.pas which can be found at... + http://www.lischke-online.de/Graphics.html#OpenGL12 + I also fixed a conversion bug to do with SDL_MustLock and also a conversion omission to do with various events. + Fixed a conversion bug with SDL_CDOpen ( as suggested on the mailing list ). + Added the GetPixel and PuxPixel functions to the SDLUtils.pas file. + Jason Farmer has donated SFont, a simple, yet effective Font library he converted for JEDI-SDL. + It contains 4 Demos show how to best use it. + Added TUInt8Array and PUIntArray to SDL.pas after suggestions from Matthias Thoma and Eric Grange. + In the file area of the JEDI-SDL mailing list ( http://groups.yahoo.com/group/JEDI-SDL/files/DTTSrc/ there + is a fully functional 3D network game called DeathTruckTion v1.0 written by the TNTeam that makes use of + JEDI-SDL and is just too big to include with this distribution but is well worth looking at as it works under Windows and Linux! + Gustavo Maxima is working on translating the JEDI-SDL Documentation to Spanish and Portugese. + The Mouse Demo has now been speeded up considerably and it is very responsive now. + Dean Ellis will provide steps on how to compile the demos using the Free Pascal compiler. + Jason Farmer and I are working on a series of Tutorials that should hopefully be out soon. + David Aclan has donated a SMpeg component that should work under Kylix. + Róbert Kisnémeth, has been hard at work, and has donated some new demos he has created with a SpriteEngine ( which he also donated ). + He has also donated a couple of games called BlitzBomber and Oxygene ( which uses the SpriteEngine ) and added a couple of useful + functions to SDLUtils.pas. + The Functions added are SDL_FlipV, SDL_FlipH, SDL_NewPutPixel ( assembler version ), SDL_AddPixel, SDL_SubPixel, SDL_DrawLine, SDL_AddLine, + SDL_SubLine, SDL_AddSurface, SDL_SubSurface, SDL_MonoSurface & SDL_TexturedSurface. + He has also donated a Font Blitting class and demo called SDL_MonoFonts which supports alignment like Left, Right and Center. + He and Thomas are also working on a GUI library. + Jason Farmer has donated a set of Image Filtering functions which add quite a few interesting effects. Check the SDL_Filter sub-directory for more + info. + Christian Hackbart also donated an OpenGL BlockOut clone. + + +Beta 3 : I have added conversions for SDL_env.h, SDL_Mixer.h and SDL_Net.h while Matthias Thoma has added conversions for SDL_Image.h and SMPEG.h. + This version is also SDL version 1.2.0 compliant. + This release also adds demos for the SDL_Image, SDL_Mixer and SDL_Net libraries. + There are now also some OpenGL demos that make some use of SDL as well as a demo on how to use the Mouse with Clickable regions. + A conversion bug, that was pointed out by Clem Vasseur, has also been fixed. + There is now a mailing list that has been set up at http://groups.yahoo.com/group/JEDI-SDL/join/ so we can all learn from each other how to use + these libraries. + Demos have not been unified into single .dpr files for each demo, thus showing how you would write a crossplatform game using only 1 .dpr file. + There is also a documentation directory that is currently in HTML format. All code examples in the documentation have been converted to Object + Pascal but are untested. + I Also fixed a few conversion bugs which I came across while converting the documentation. + +Beta 2 : I have added conversions for SDL_active.h, SDL_thread.h, SDL_mutex.h and + SDL_error.h, Matthias Thoma has added Linux Support and JEDI compliancy so these + units and examples are now x-platform and x-compiler compilable. + I also added Tom Jones' SDLUtils.pas file; + Matthias also cleaned up the 2 new demos and made them work on both Linux and + Windows. + +Beta 1 : Initial Release; + + +There are now 5 examples included with this JEDI-SDL distribution. +1. Is the TestWin application, which is based on the testwin application that comes with the SDL SDK, only my version has a gui front end to the options available and has been compiled under Delphi 4.03. It should be compatible with Delphi 3.0 onwards ( though Delphi 2 compatibility has not been tested ). + +2. A Plasma example which was converted from one found on the Demos page of the SDL site. + +3. A Voxel terrain following demo, which was converted from one found on the Demos page of the SDL site. This one should be of interest to others as it shows how to handle keyboard events when using SDL. + +4. A Mouse handling demo that shows how to use transparency and clickable regions. + +5. A Space Invaders style game called Aliens which shows the use of SDL, SDL_Image and SDL_Mixer. This game shows how to handle sound, keyboards and some basic collision detection. It is a conversion of one found on the SDL Demos page. + +There are also 14 OpenGL demos that are based on the NeHe tutorials <nehe.gamedev.net>. The other 3 OpenGL demos are Jan Horns' OpenGL demo, A Quake 2 Model viewer that I ported and a Demo by Gustavo Maxima called Puntos. + +If writing your own, just make sure that the SDL.pas file is in your projects path for compiling and that the SDL.dll file is in your path when running the compiled app. + +Please test these units and report problems to the JEDI-SDL mailing list @ http://groups.yahoo.com/group/JEDI-SDL/ outlining steps under which the error occurred. If you convert any more demos please send them to me so that I can +include them in the ditribution for others to learn from. + +Also if you are using these Units to write any games +please let me know about it so that I can post the information to the http://www.DelphiGamer.com site. + +The plan is to have this unit JEDI certified at some point so that it can be included on the Delphi and Kylix CDs, so all feedback is greatly welcomed. + +Compilers supported Tested +------------------- ------ +Delphi Yes +Kylix Yes +FreePascal Yes +TMT Pascal compiler Not Yet. +Virtual Pascal No +Gnu Pascal No + + + +Credits +------- +Matthias Thoma <ma.thoma@gmx.de> for is endless help with my conversion bugs. +Jason Farmer <jason@cerebral-bicycle.co.uk> for donating the SFont Font Library. +Gustavo Maximo <gmaximo@secretariaplus.com> for the Puntos OpenGL Demo and work he is doing on the documentation +Róbert Kisnémeth <mikrobi@freemail.hu> for his numerous contributions +Chris Bruner <cryst@golden.net> for testing under Kylix +August Logan Bear Jr.<augustjr@columbus.rr.com> for testing under Kylix +Dean Ellis<dean_ellis@yahoo.com> for FreePascal Compiler compatability testing and SDL_Net demos and testing +David House<david@dahsoftware.com> for Windows Insaller and testing. +Romi Kuntsman<romik12345@lycos.co.uk> for helping out on some OpenGL issues. +Everyone on the JEDI-SDL <http://groups.yahoo.com/group/JEDI-SDL/join/> mailing list for their feedback and support. +Everyone on the Delphi-JEDI <http://groups.yahoo.com/group/Delphi-JEDI/join/> mailing for answering my conversion questions. +Tom Jones for inspiring this conversion. + +The JEDI-SDL Home page can be found @ http://www.delphi-jedi.org/Jedi:TEAM_SDL_HOME + +The JEDI-SDL source code archive can be found @ http://www.sf.net/projects/jedi-sdl/ + +The JEDI-SDL mailing list can be found @ http://groups.yahoo.com/group/JEDI-SDL/join/ + +The Latest Stable Release version of the JEDI-SDL.zip file can always be found on the Delphi-JEDI site <http://www.delphi-jedi.org/Jedi:TEAM_SDL_HOME> + +The Latest Alpha/Unstable version can always be grabbed from the SourceForge CVS http://sourceforge.net/cvs/?group_id=43805 + + +Sincerely, + + + +Dominique Louis +Delphi Game Developer. +********************************************************* +** To Do Nothing is to Collaborate with the oppressor ** +** -------------------------------------------------- ** +********************************************************* +========================================================= +From . . . . . . . : Dominique Louis +Email. . . . . . . : Dominique@SavageSoftware.com.au +Company. . . . . . : Savage Software Solutions +Delphi Games Site. : http://www.DelphiGamer.com +Delphi JEDI Site . : http://www.delphi-jedi.org +========================================================= + diff --git a/Game/Code/lib/JEDI-SDL/OpenGL/Pas/geometry.pas b/Game/Code/lib/JEDI-SDL/OpenGL/Pas/geometry.pas index 15783515..166ec811 100644 --- a/Game/Code/lib/JEDI-SDL/OpenGL/Pas/geometry.pas +++ b/Game/Code/lib/JEDI-SDL/OpenGL/Pas/geometry.pas @@ -1,1994 +1,1994 @@ -unit geometry;
-{
- $Id: geometry.pas,v 1.1 2004/03/30 21:53:54 savage Exp $
-
-}
-
-// This unit contains many needed types, functions and procedures for
-// quaternion, vector and matrix arithmetics. It is specifically designed
-// for geometric calculations within R3 (affine vector space)
-// and R4 (homogeneous vector space).
-//
-// Note: The terms 'affine' or 'affine coordinates' are not really correct here
-// because an 'affine transformation' describes generally a transformation which leads
-// to a uniquely solvable system of equations and has nothing to do with the dimensionality
-// of a vector. One could use 'projective coordinates' but this is also not really correct
-// and since I haven't found a better name (or even any correct one), 'affine' is as good
-// as any other one.
-//
-// Identifiers containing no dimensionality (like affine or homogeneous)
-// and no datatype (integer..extended) are supposed as R4 representation
-// with 'single' floating point type (examples are TVector, TMatrix,
-// and TQuaternion). The default data type is 'single' ('GLFloat' for OpenGL)
-// and used in all routines (except conversions and trigonometric functions).
-//
-// Routines with an open array as argument can either take Func([1,2,3,4,..]) or Func(Vect).
-// The latter is prefered, since no extra stack operations is required.
-// Note: Be careful while passing open array elements! If you pass more elements
-// than there's room in the result the behaviour will be unpredictable.
-//
-// If not otherwise stated, all angles are given in radians
-// (instead of degrees). Use RadToDeg or DegToRad to convert between them.
-//
-// Geometry.pas was assembled from different sources (like GraphicGems)
-// and relevant books or based on self written code, respectivly.
-//
-// Note: Some aspects need to be considered when using Delphi and pure
-// assembler code. Delphi ensures that the direction flag is always
-// cleared while entering a function and expects it cleared on return.
-// This is in particular important in routines with (CPU) string commands (MOVSD etc.)
-// The registers EDI, ESI and EBX (as well as the stack management
-// registers EBP and ESP) must not be changed! EAX, ECX and EDX are
-// freely available and mostly used for parameter.
-//
-// Version 2.5
-// last change : 04. January 2000
-//
-// (c) Copyright 1999, Dipl. Ing. Mike Lischke (public@lischke-online.de)
-{
- $Log: geometry.pas,v $
- Revision 1.1 2004/03/30 21:53:54 savage
- Moved to it's own folder.
-
- Revision 1.1 2004/02/05 00:08:19 savage
- Module 1.0 release
-
-
-}
-
-interface
-
-{$I jedi-sdl.inc}
-
-type
- // data types needed for 3D graphics calculation,
- // included are 'C like' aliases for each type (to be
- // conformal with OpenGL types)
-
- PByte = ^Byte;
- PWord = ^Word;
- PInteger = ^Integer;
- PFloat = ^Single;
- PDouble = ^Double;
- PExtended = ^Extended;
- PPointer = ^Pointer;
-
- // types to specify continous streams of a specific type
- // switch off range checking to access values beyond the limits
- PByteVector = ^TByteVector;
- PByteArray = PByteVector;
- TByteVector = array[0..0] of Byte;
-
- PWordVector = ^TWordVector;
- PWordArray = PWordVector; // note: there's a same named type in SysUtils
- TWordVector = array[0..0] of Word;
-
- PIntegerVector = ^TIntegerVector;
- PIntegerArray = PIntegerVector;
- TIntegerVector = array[0..0] of Integer;
-
- PFloatVector = ^TFloatVector;
- PFloatArray = PFloatVector;
- TFloatVector = array[0..0] of Single;
-
- PDoubleVector = ^TDoubleVector;
- PDoubleArray = PDoubleVector;
- TDoubleVector = array[0..0] of Double;
-
- PExtendedVector = ^TExtendedVector;
- PExtendedArray = PExtendedVector;
- TExtendedVector = array[0..0] of Extended;
-
- PPointerVector = ^TPointerVector;
- PPointerArray = PPointerVector;
- TPointerVector = array[0..0] of Pointer;
-
- PCardinalVector = ^TCardinalVector;
- PCardinalArray = PCardinalVector;
- TCardinalVector = array[0..0] of Cardinal;
-
- // common vector and matrix types with predefined limits
- // indices correspond like: x -> 0
- // y -> 1
- // z -> 2
- // w -> 3
-
- PHomogeneousByteVector = ^THomogeneousByteVector;
- THomogeneousByteVector = array[0..3] of Byte;
- TVector4b = THomogeneousByteVector;
-
- PHomogeneousWordVector = ^THomogeneousWordVector;
- THomogeneousWordVector = array[0..3] of Word;
- TVector4w = THomogeneousWordVector;
-
- PHomogeneousIntVector = ^THomogeneousIntVector;
- THomogeneousIntVector = array[0..3] of Integer;
- TVector4i = THomogeneousIntVector;
-
- PHomogeneousFltVector = ^THomogeneousFltVector;
- THomogeneousFltVector = array[0..3] of Single;
- TVector4f = THomogeneousFltVector;
-
- PHomogeneousDblVector = ^THomogeneousDblVector;
- THomogeneousDblVector = array[0..3] of Double;
- TVector4d = THomogeneousDblVector;
-
- PHomogeneousExtVector = ^THomogeneousExtVector;
- THomogeneousExtVector = array[0..3] of Extended;
- TVector4e = THomogeneousExtVector;
-
- PHomogeneousPtrVector = ^THomogeneousPtrVector;
- THomogeneousPtrVector = array[0..3] of Pointer;
- TVector4p = THomogeneousPtrVector;
-
- PAffineByteVector = ^TAffineByteVector;
- TAffineByteVector = array[0..2] of Byte;
- TVector3b = TAffineByteVector;
-
- PAffineWordVector = ^TAffineWordVector;
- TAffineWordVector = array[0..2] of Word;
- TVector3w = TAffineWordVector;
-
- PAffineIntVector = ^TAffineIntVector;
- TAffineIntVector = array[0..2] of Integer;
- TVector3i = TAffineIntVector;
-
- PAffineFltVector = ^TAffineFltVector;
- TAffineFltVector = array[0..2] of Single;
- TVector3f = TAffineFltVector;
-
- PAffineDblVector = ^TAffineDblVector;
- TAffineDblVector = array[0..2] of Double;
- TVector3d = TAffineDblVector;
-
- PAffineExtVector = ^TAffineExtVector;
- TAffineExtVector = array[0..2] of Extended;
- TVector3e = TAffineExtVector;
-
- PAffinePtrVector = ^TAffinePtrVector;
- TAffinePtrVector = array[0..2] of Pointer;
- TVector3p = TAffinePtrVector;
-
- // some simplified names
- PVector = ^TVector;
- TVector = THomogeneousFltVector;
-
- PHomogeneousVector = ^THomogeneousVector;
- THomogeneousVector = THomogeneousFltVector;
-
- PAffineVector = ^TAffineVector;
- TAffineVector = TAffineFltVector;
-
- // arrays of vectors
- PVectorArray = ^TVectorArray;
- TVectorArray = array[0..0] of TAffineVector;
-
- // matrices
- THomogeneousByteMatrix = array[0..3] of THomogeneousByteVector;
- TMatrix4b = THomogeneousByteMatrix;
-
- THomogeneousWordMatrix = array[0..3] of THomogeneousWordVector;
- TMatrix4w = THomogeneousWordMatrix;
-
- THomogeneousIntMatrix = array[0..3] of THomogeneousIntVector;
- TMatrix4i = THomogeneousIntMatrix;
-
- THomogeneousFltMatrix = array[0..3] of THomogeneousFltVector;
- TMatrix4f = THomogeneousFltMatrix;
-
- THomogeneousDblMatrix = array[0..3] of THomogeneousDblVector;
- TMatrix4d = THomogeneousDblMatrix;
-
- THomogeneousExtMatrix = array[0..3] of THomogeneousExtVector;
- TMatrix4e = THomogeneousExtMatrix;
-
- TAffineByteMatrix = array[0..2] of TAffineByteVector;
- TMatrix3b = TAffineByteMatrix;
-
- TAffineWordMatrix = array[0..2] of TAffineWordVector;
- TMatrix3w = TAffineWordMatrix;
-
- TAffineIntMatrix = array[0..2] of TAffineIntVector;
- TMatrix3i = TAffineIntMatrix;
-
- TAffineFltMatrix = array[0..2] of TAffineFltVector;
- TMatrix3f = TAffineFltMatrix;
-
- TAffineDblMatrix = array[0..2] of TAffineDblVector;
- TMatrix3d = TAffineDblMatrix;
-
- TAffineExtMatrix = array[0..2] of TAffineExtVector;
- TMatrix3e = TAffineExtMatrix;
-
- // some simplified names
- PMatrix = ^TMatrix;
- TMatrix = THomogeneousFltMatrix;
-
- PHomogeneousMatrix = ^THomogeneousMatrix;
- THomogeneousMatrix = THomogeneousFltMatrix;
-
- PAffineMatrix = ^TAffineMatrix;
- TAffineMatrix = TAffineFltMatrix;
-
- // q = ([x, y, z], w)
- TQuaternion = record
- case Integer of
- 0:
- (ImagPart: TAffineVector;
- RealPart: Single);
- 1:
- (Vector: TVector4f);
- end;
-
- TRectangle = record
- Left,
- Top,
- Width,
- Height: Integer;
- end;
-
- TTransType = (ttScaleX, ttScaleY, ttScaleZ,
- ttShearXY, ttShearXZ, ttShearYZ,
- ttRotateX, ttRotateY, ttRotateZ,
- ttTranslateX, ttTranslateY, ttTranslateZ,
- ttPerspectiveX, ttPerspectiveY, ttPerspectiveZ, ttPerspectiveW);
-
- // used to describe a sequence of transformations in following order:
- // [Sx][Sy][Sz][ShearXY][ShearXZ][ShearZY][Rx][Ry][Rz][Tx][Ty][Tz][P(x,y,z,w)]
- // constants are declared for easier access (see MatrixDecompose below)
- TTransformations = array[TTransType] of Single;
-
-
-const
- // useful constants
-
- // standard vectors
- XVector: TAffineVector = (1, 0, 0);
- YVector: TAffineVector = (0, 1, 0);
- ZVector: TAffineVector = (0, 0, 1);
- NullVector: TAffineVector = (0, 0, 0);
-
- IdentityMatrix: TMatrix = ((1, 0, 0, 0),
- (0, 1, 0, 0),
- (0, 0, 1, 0),
- (0, 0, 0, 1));
- EmptyMatrix: TMatrix = ((0, 0, 0, 0),
- (0, 0, 0, 0),
- (0, 0, 0, 0),
- (0, 0, 0, 0));
- // some very small numbers
- EPSILON = 1e-100;
- EPSILON2 = 1e-50;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-// vector functions
-function VectorAdd(V1, V2: TVector): TVector;
-function VectorAffineAdd(V1, V2: TAffineVector): TAffineVector;
-function VectorAffineCombine(V1, V2: TAffineVector; F1, F2: Single): TAffineVector;
-function VectorAffineDotProduct(V1, V2: TAffineVector): Single;
-function VectorAffineLerp(V1, V2: TAffineVector; t: Single): TAffineVector;
-function VectorAffineSubtract(V1, V2: TAffineVector): TAffineVector;
-function VectorAngle(V1, V2: TAffineVector): Single;
-function VectorCombine(V1, V2: TVector; F1, F2: Single): TVector;
-function VectorCrossProduct(V1, V2: TAffineVector): TAffineVector;
-function VectorDotProduct(V1, V2: TVector): Single;
-function VectorLength(V: array of Single): Single;
-function VectorLerp(V1, V2: TVector; t: Single): TVector;
-procedure VectorNegate(V: array of Single);
-function VectorNorm(V: array of Single): Single;
-function VectorNormalize(V: array of Single): Single;
-function VectorPerpendicular(V, N: TAffineVector): TAffineVector;
-function VectorReflect(V, N: TAffineVector): TAffineVector;
-procedure VectorRotate(var Vector: TVector4f; Axis: TVector3f; Angle: Single);
-procedure VectorScale(V: array of Single; Factor: Single);
-function VectorSubtract(V1, V2: TVector): TVector;
-
-// matrix functions
-function CreateRotationMatrixX(Sine, Cosine: Single): TMatrix;
-function CreateRotationMatrixY(Sine, Cosine: Single): TMatrix;
-function CreateRotationMatrixZ(Sine, Cosine: Single): TMatrix;
-function CreateScaleMatrix(V: TAffineVector): TMatrix;
-function CreateTranslationMatrix(V: TVector): TMatrix;
-procedure MatrixAdjoint(var M: TMatrix);
-function MatrixAffineDeterminant(M: TAffineMatrix): Single;
-procedure MatrixAffineTranspose(var M: TAffineMatrix);
-function MatrixDeterminant(M: TMatrix): Single;
-procedure MatrixInvert(var M: TMatrix);
-function MatrixMultiply(M1, M2: TMatrix): TMatrix;
-procedure MatrixScale(var M: TMatrix; Factor: Single);
-procedure MatrixTranspose(var M: TMatrix);
-
-// quaternion functions
-function QuaternionConjugate(Q: TQuaternion): TQuaternion;
-function QuaternionFromPoints(V1, V2: TAffineVector): TQuaternion;
-function QuaternionMultiply(qL, qR: TQuaternion): TQuaternion;
-function QuaternionSlerp(QStart, QEnd: TQuaternion; Spin: Integer; t: Single): TQuaternion;
-function QuaternionToMatrix(Q: TQuaternion): TMatrix;
-procedure QuaternionToPoints(Q: TQuaternion; var ArcFrom, ArcTo: TAffineVector);
-
-// mixed functions
-function ConvertRotation(Angles: TAffineVector): TVector;
-function CreateRotationMatrix(Axis: TVector3f; Angle: Single): TMatrix;
-function MatrixDecompose(M: TMatrix; var Tran: TTransformations): Boolean;
-function VectorAffineTransform(V: TAffineVector; M: TAffineMatrix): TAffineVector;
-function VectorTransform(V: TVector4f; M: TMatrix): TVector4f; overload;
-function VectorTransform(V: TVector3f; M: TMatrix): TVector3f; overload;
-
-// miscellaneous functions
-function MakeAffineDblVector(V: array of Double): TAffineDblVector;
-function MakeDblVector(V: array of Double): THomogeneousDblVector;
-function MakeAffineVector(V: array of Single): TAffineVector;
-function MakeQuaternion(Imag: array of Single; Real: Single): TQuaternion;
-function MakeVector(V: array of Single): TVector;
-function PointInPolygon(xp, yp : array of Single; x, y: Single): Boolean;
-function VectorAffineDblToFlt(V: TAffineDblVector): TAffineVector;
-function VectorDblToFlt(V: THomogeneousDblVector): THomogeneousVector;
-function VectorAffineFltToDbl(V: TAffineVector): TAffineDblVector;
-function VectorFltToDbl(V: TVector): THomogeneousDblVector;
-
-// trigonometric functions
-function ArcCos(X: Extended): Extended;
-function ArcSin(X: Extended): Extended;
-function ArcTan2(Y, X: Extended): Extended;
-function CoTan(X: Extended): Extended;
-function DegToRad(Degrees: Extended): Extended;
-function RadToDeg(Radians: Extended): Extended;
-procedure SinCos(Theta: Extended; var Sin, Cos: Extended);
-function Tan(X: Extended): Extended;
-
-// coordinate system manipulation functions
-function Turn(Matrix: TMatrix; Angle: Single): TMatrix; overload;
-function Turn(Matrix: TMatrix; MasterUp: TAffineVector; Angle: Single): TMatrix; overload;
-function Pitch(Matrix: TMatrix; Angle: Single): TMatrix; overload;
-function Pitch(Matrix: TMatrix; MasterRight: TAffineVector; Angle: Single): TMatrix; overload;
-function Roll(Matrix: TMatrix; Angle: Single): TMatrix; overload;
-function Roll(Matrix: TMatrix; MasterDirection: TAffineVector; Angle: Single): TMatrix; overload;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-implementation
-
-const
- // FPU status flags (high order byte)
- C0 = 1;
- C1 = 2;
- C2 = 4;
- C3 = $40;
-
- // to be used as descriptive indices
- X = 0;
- Y = 1;
- Z = 2;
- W = 3;
-
-//----------------- trigonometric helper functions ---------------------------------------------------------------------
-
-function DegToRad(Degrees: Extended): Extended;
-
-begin
- Result := Degrees * (PI / 180);
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function RadToDeg(Radians: Extended): Extended;
-
-begin
- Result := Radians * (180 / PI);
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-procedure SinCos(Theta: Extended; var Sin, Cos: Extended); assembler; register;
-
-// calculates sine and cosine from the given angle Theta
-// EAX contains address of Sin
-// EDX contains address of Cos
-// Theta is passed over the stack
-
-asm
- FLD Theta
- FSINCOS
- FSTP TBYTE PTR [EDX] // cosine
- FSTP TBYTE PTR [EAX] // sine
- FWAIT
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function ArcCos(X: Extended): Extended;
-
-begin
- Result := ArcTan2(Sqrt(1 - X * X), X);
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function ArcSin(X: Extended): Extended;
-
-begin
- Result := ArcTan2(X, Sqrt(1 - X * X))
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function ArcTan2(Y, X: Extended): Extended;
-
-asm
- FLD Y
- FLD X
- FPATAN
- FWAIT
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function Tan(X: Extended): Extended;
-
-asm
- FLD X
- FPTAN
- FSTP ST(0) // FPTAN pushes 1.0 after result
- FWAIT
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function CoTan(X: Extended): Extended;
-
-asm
- FLD X
- FPTAN
- FDIVRP
- FWAIT
-end;
-
-//----------------- miscellaneous vector functions ---------------------------------------------------------------------
-
-function MakeAffineDblVector(V: array of Double): TAffineDblVector; assembler;
-
-// creates a vector from given values
-// EAX contains address of V
-// ECX contains address to result vector
-// EDX contains highest index of V
-
-asm
- PUSH EDI
- PUSH ESI
- MOV EDI, ECX
- MOV ESI, EAX
- MOV ECX, EDX
- ADD ECX, 2
- REP MOVSD
- POP ESI
- POP EDI
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function MakeDblVector(V: array of Double): THomogeneousDblVector; assembler;
-
-// creates a vector from given values
-// EAX contains address of V
-// ECX contains address to result vector
-// EDX contains highest index of V
-
-asm
- PUSH EDI
- PUSH ESI
- MOV EDI, ECX
- MOV ESI, EAX
- MOV ECX, EDX
- ADD ECX, 2
- REP MOVSD
- POP ESI
- POP EDI
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function MakeAffineVector(V: array of Single): TAffineVector; assembler;
-
-// creates a vector from given values
-// EAX contains address of V
-// ECX contains address to result vector
-// EDX contains highest index of V
-
-asm
- PUSH EDI
- PUSH ESI
- MOV EDI, ECX
- MOV ESI, EAX
- MOV ECX, EDX
- INC ECX
- CMP ECX, 3
- JB @@1
- MOV ECX, 3
-@@1: REP MOVSD // copy given values
- MOV ECX, 2
- SUB ECX, EDX // determine missing entries
- JS @@Finish
- XOR EAX, EAX
- REP STOSD // set remaining fields to 0
-@@Finish: POP ESI
- POP EDI
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function MakeQuaternion(Imag: array of Single; Real: Single): TQuaternion; assembler;
-
-// creates a quaternion from the given values
-// EAX contains address of Imag
-// ECX contains address to result vector
-// EDX contains highest index of Imag
-// Real part is passed on the stack
-
-asm
- PUSH EDI
- PUSH ESI
- MOV EDI, ECX
- MOV ESI, EAX
- MOV ECX, EDX
- INC ECX
- REP MOVSD
- MOV EAX, [Real]
- MOV [EDI], EAX
- POP ESI
- POP EDI
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function MakeVector(V: array of Single): TVector; assembler;
-
-// creates a vector from given values
-// EAX contains address of V
-// ECX contains address to result vector
-// EDX contains highest index of V
-
-asm
- PUSH EDI
- PUSH ESI
- MOV EDI, ECX
- MOV ESI, EAX
- MOV ECX, EDX
- INC ECX
- CMP ECX, 4
- JB @@1
- MOV ECX, 4
-@@1: REP MOVSD // copy given values
- MOV ECX, 3
- SUB ECX, EDX // determine missing entries
- JS @@Finish
- XOR EAX, EAX
- REP STOSD // set remaining fields to 0
-@@Finish: POP ESI
- POP EDI
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function VectorLength(V: array of Single): Single; assembler;
-
-// calculates the length of a vector following the equation: sqrt(x * x + y * y + ...)
-// Note: The parameter of this function is declared as open array. Thus
-// there's no restriction about the number of the components of the vector.
-//
-// EAX contains address of V
-// EDX contains the highest index of V
-// the result is returned in ST(0)
-
-asm
- FLDZ // initialize sum
-@@Loop: FLD DWORD PTR [EAX + 4 * EDX] // load a component
- FMUL ST, ST
- FADDP
- SUB EDX, 1
- JNL @@Loop
- FSQRT
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function VectorAngle(V1, V2: TAffineVector): Single; assembler;
-
-// calculates the cosine of the angle between Vector1 and Vector2
-// Result = DotProduct(V1, V2) / (Length(V1) * Length(V2))
-//
-// EAX contains address of Vector1
-// EDX contains address of Vector2
-
-asm
- FLD DWORD PTR [EAX] // V1[0]
- FLD ST // double V1[0]
- FMUL ST, ST // V1[0]^2 (prep. for divisor)
- FLD DWORD PTR [EDX] // V2[0]
- FMUL ST(2), ST // ST(2) := V1[0] * V2[0]
- FMUL ST, ST // V2[0]^2 (prep. for divisor)
- FLD DWORD PTR [EAX + 4] // V1[1]
- FLD ST // double V1[1]
- FMUL ST, ST // ST(0) := V1[1]^2
- FADDP ST(3), ST // ST(2) := V1[0]^2 + V1[1] * * 2
- FLD DWORD PTR [EDX + 4] // V2[1]
- FMUL ST(1), ST // ST(1) := V1[1] * V2[1]
- FMUL ST, ST // ST(0) := V2[1]^2
- FADDP ST(2), ST // ST(1) := V2[0]^2 + V2[1]^2
- FADDP ST(3), ST // ST(2) := V1[0] * V2[0] + V1[1] * V2[1]
- FLD DWORD PTR [EAX + 8] // load V2[1]
- FLD ST // same calcs go here
- FMUL ST, ST // (compare above)
- FADDP ST(3), ST
- FLD DWORD PTR [EDX + 8]
- FMUL ST(1), ST
- FMUL ST, ST
- FADDP ST(2), ST
- FADDP ST(3), ST
- FMULP // ST(0) := (V1[0]^2 + V1[1]^2 + V1[2]) *
- // (V2[0]^2 + V2[1]^2 + V2[2])
- FSQRT // sqrt(ST(0))
- FDIVP // ST(0) := Result := ST(1) / ST(0)
- // the result is expected in ST(0), if it's invalid, an error is raised
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function VectorNorm(V: array of Single): Single; assembler; register;
-
-// calculates norm of a vector which is defined as norm = x * x + y * y + ...
-// EAX contains address of V
-// EDX contains highest index in V
-// result is passed in ST(0)
-
-asm
- FLDZ // initialize sum
-@@Loop: FLD DWORD PTR [EAX + 4 * EDX] // load a component
- FMUL ST, ST // make square
- FADDP // add previous calculated sum
- SUB EDX, 1
- JNL @@Loop
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function VectorNormalize(V: array of Single): Single; assembler; register;
-
-// transforms a vector to unit length and return length
-// EAX contains address of V
-// EDX contains the highest index in V
-// return former length of V in ST
-
-asm
- PUSH EBX
- MOV ECX, EDX // save size of V
- CALL VectorLength // calculate length of vector
- FTST // test if length = 0
- MOV EBX, EAX // save parameter address
- FSTSW AX // get test result
- TEST AH, C3 // check the test result
- JNZ @@Finish
- SUB EBX, 4 // simplyfied address calculation
- INC ECX
- FLD1 // calculate reciprocal of length
- FDIV ST, ST(1)
-@@1: FLD ST // double reciprocal
- FMUL DWORD PTR [EBX + 4 * ECX] // scale component
- WAIT
- FSTP DWORD PTR [EBX + 4 * ECX] // store result
- LOOP @@1
- FSTP ST // remove reciprocal from FPU stack
-@@Finish: POP EBX
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function VectorAffineSubtract(V1, V2: TAffineVector): TAffineVector; assembler; register;
-
-// returns v1 minus v2
-// EAX contains address of V1
-// EDX contains address of V2
-// ECX contains address of the result
-
-asm
- {Result[X] := V1[X]-V2[X];
- Result[Y] := V1[Y]-V2[Y];
- Result[Z] := V1[Z]-V2[Z];}
-
- FLD DWORD PTR [EAX]
- FSUB DWORD PTR [EDX]
- FSTP DWORD PTR [ECX]
- FLD DWORD PTR [EAX + 4]
- FSUB DWORD PTR [EDX + 4]
- FSTP DWORD PTR [ECX + 4]
- FLD DWORD PTR [EAX + 8]
- FSUB DWORD PTR [EDX + 8]
- FSTP DWORD PTR [ECX + 8]
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function VectorReflect(V, N: TAffineVector): TAffineVector; assembler; register;
-
-// reflects vector V against N (assumes N is normalized)
-// EAX contains address of V
-// EDX contains address of N
-// ECX contains address of the result
-
-//var Dot : Single;
-
-asm
- {Dot := VectorAffineDotProduct(V, N);
- Result[X] := V[X]-2 * Dot * N[X];
- Result[Y] := V[Y]-2 * Dot * N[Y];
- Result[Z] := V[Z]-2 * Dot * N[Z];}
-
- CALL VectorAffineDotProduct // dot is now in ST(0)
- FCHS // -dot
- FADD ST, ST // -dot * 2
- FLD DWORD PTR [EDX] // ST := N[X]
- FMUL ST, ST(1) // ST := -2 * dot * N[X]
- FADD DWORD PTR[EAX] // ST := V[X] - 2 * dot * N[X]
- FSTP DWORD PTR [ECX] // store result
- FLD DWORD PTR [EDX + 4] // etc.
- FMUL ST, ST(1)
- FADD DWORD PTR[EAX + 4]
- FSTP DWORD PTR [ECX + 4]
- FLD DWORD PTR [EDX + 8]
- FMUL ST, ST(1)
- FADD DWORD PTR[EAX + 8]
- FSTP DWORD PTR [ECX + 8]
- FSTP ST // clean FPU stack
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-procedure VectorRotate(var Vector: TVector4f; Axis: TVector3f; Angle: Single);
-
-// rotates Vector about Axis with Angle radiants
-
-var RotMatrix : TMatrix4f;
-
-begin
- RotMatrix := CreateRotationMatrix(Axis, Angle);
- Vector := VectorTransform(Vector, RotMatrix);
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-procedure VectorScale(V: array of Single; Factor: Single); assembler; register;
-
-// returns a vector scaled by a factor
-// EAX contains address of V
-// EDX contains highest index in V
-// Factor is located on the stack
-
-asm
- {for I := Low(V) to High(V) do V[I] := V[I] * Factor;}
-
- FLD DWORD PTR [Factor] // load factor
-@@Loop: FLD DWORD PTR [EAX + 4 * EDX] // load a component
- FMUL ST, ST(1) // multiply it with the factor
- WAIT
- FSTP DWORD PTR [EAX + 4 * EDX] // store the result
- DEC EDX // do the entire array
- JNS @@Loop
- FSTP ST(0) // clean the FPU stack
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-procedure VectorNegate(V: array of Single); assembler; register;
-
-// returns a negated vector
-// EAX contains address of V
-// EDX contains highest index in V
-
-asm
- {V[X] := -V[X];
- V[Y] := -V[Y];
- V[Z] := -V[Z];}
-
-@@Loop: FLD DWORD PTR [EAX + 4 * EDX]
- FCHS
- WAIT
- FSTP DWORD PTR [EAX + 4 * EDX]
- DEC EDX
- JNS @@Loop
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function VectorAdd(V1, V2: TVector): TVector; register;
-
-// returns the sum of two vectors
-
-begin
- Result[X] := V1[X] + V2[X];
- Result[Y] := V1[Y] + V2[Y];
- Result[Z] := V1[Z] + V2[Z];
- Result[W] := V1[W] + V2[W];
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function VectorAffineAdd(V1, V2: TAffineVector): TAffineVector; register;
-
-// returns the sum of two vectors
-
-begin
- Result[X] := V1[X] + V2[X];
- Result[Y] := V1[Y] + V2[Y];
- Result[Z] := V1[Z] + V2[Z];
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function VectorSubtract(V1, V2: TVector): TVector; register;
-
-// returns the difference of two vectors
-
-begin
- Result[X] := V1[X] - V2[X];
- Result[Y] := V1[Y] - V2[Y];
- Result[Z] := V1[Z] - V2[Z];
- Result[W] := V1[W] - V2[W];
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function VectorDotProduct(V1, V2: TVector): Single; register;
-
-begin
- Result := V1[X] * V2[X] + V1[Y] * V2[Y] + V1[Z] * V2[Z] + V1[W] * V2[W];
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function VectorAffineDotProduct(V1, V2: TAffineVector): Single; assembler; register;
-
-// calculates the dot product between V1 and V2
-// EAX contains address of V1
-// EDX contains address of V2
-// result is stored in ST(0)
-
-asm
- //Result := V1[X] * V2[X] + V1[Y] * V2[Y] + V1[Z] * V2[Z];
-
- FLD DWORD PTR [EAX]
- FMUL DWORD PTR [EDX]
- FLD DWORD PTR [EAX + 4]
- FMUL DWORD PTR [EDX + 4]
- FADDP
- FLD DWORD PTR [EAX + 8]
- FMUL DWORD PTR [EDX + 8]
- FADDP
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function VectorCrossProduct(V1, V2: TAffineVector): TAffineVector;
-
-// calculates the cross product between vector 1 and 2, Temp is necessary because
-// either V1 or V2 could also be the result vector
-//
-// EAX contains address of V1
-// EDX contains address of V2
-// ECX contains address of result
-
-var Temp: TAffineVector;
-
-asm
- {Temp[X] := V1[Y] * V2[Z]-V1[Z] * V2[Y];
- Temp[Y] := V1[Z] * V2[X]-V1[X] * V2[Z];
- Temp[Z] := V1[X] * V2[Y]-V1[Y] * V2[X];
- Result := Temp;}
-
- PUSH EBX // save EBX, must be restored to original value
- LEA EBX, [Temp]
- FLD DWORD PTR [EDX + 8] // first load both vectors onto FPU register stack
- FLD DWORD PTR [EDX + 4]
- FLD DWORD PTR [EDX + 0]
- FLD DWORD PTR [EAX + 8]
- FLD DWORD PTR [EAX + 4]
- FLD DWORD PTR [EAX + 0]
-
- FLD ST(1) // ST(0) := V1[Y]
- FMUL ST, ST(6) // ST(0) := V1[Y] * V2[Z]
- FLD ST(3) // ST(0) := V1[Z]
- FMUL ST, ST(6) // ST(0) := V1[Z] * V2[Y]
- FSUBP ST(1), ST // ST(0) := ST(1)-ST(0)
- FSTP DWORD [EBX] // Temp[X] := ST(0)
- FLD ST(2) // ST(0) := V1[Z]
- FMUL ST, ST(4) // ST(0) := V1[Z] * V2[X]
- FLD ST(1) // ST(0) := V1[X]
- FMUL ST, ST(7) // ST(0) := V1[X] * V2[Z]
- FSUBP ST(1), ST // ST(0) := ST(1)-ST(0)
- FSTP DWORD [EBX + 4] // Temp[Y] := ST(0)
- FLD ST // ST(0) := V1[X]
- FMUL ST, ST(5) // ST(0) := V1[X] * V2[Y]
- FLD ST(2) // ST(0) := V1[Y]
- FMUL ST, ST(5) // ST(0) := V1[Y] * V2[X]
- FSUBP ST(1), ST // ST(0) := ST(1)-ST(0)
- FSTP DWORD [EBX + 8] // Temp[Z] := ST(0)
- FSTP ST(0) // clear FPU register stack
- FSTP ST(0)
- FSTP ST(0)
- FSTP ST(0)
- FSTP ST(0)
- FSTP ST(0)
- MOV EAX, [EBX] // copy Temp to Result
- MOV [ECX], EAX
- MOV EAX, [EBX + 4]
- MOV [ECX + 4], EAX
- MOV EAX, [EBX + 8]
- MOV [ECX + 8], EAX
- POP EBX
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function VectorPerpendicular(V, N: TAffineVector): TAffineVector;
-
-// calculates a vector perpendicular to N (N is assumed to be of unit length)
-// subtract out any component parallel to N
-
-var Dot: Single;
-
-begin
- Dot := VectorAffineDotProduct(V, N);
- Result[X] := V[X]-Dot * N[X];
- Result[Y] := V[Y]-Dot * N[Y];
- Result[Z] := V[Z]-Dot * N[Z];
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function VectorTransform(V: TVector4f; M: TMatrix): TVector4f; register;
-
-// transforms a homogeneous vector by multiplying it with a matrix
-
-var TV: TVector4f;
-
-begin
- TV[X] := V[X] * M[X, X] + V[Y] * M[Y, X] + V[Z] * M[Z, X] + V[W] * M[W, X];
- TV[Y] := V[X] * M[X, Y] + V[Y] * M[Y, Y] + V[Z] * M[Z, Y] + V[W] * M[W, Y];
- TV[Z] := V[X] * M[X, Z] + V[Y] * M[Y, Z] + V[Z] * M[Z, Z] + V[W] * M[W, Z];
- TV[W] := V[X] * M[X, W] + V[Y] * M[Y, W] + V[Z] * M[Z, W] + V[W] * M[W, W];
- Result := TV
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function VectorTransform(V: TVector3f; M: TMatrix): TVector3f;
-
-// transforms an affine vector by multiplying it with a (homogeneous) matrix
-
-var TV: TVector3f;
-
-begin
- TV[X] := V[X] * M[X, X] + V[Y] * M[Y, X] + V[Z] * M[Z, X] + M[W, X];
- TV[Y] := V[X] * M[X, Y] + V[Y] * M[Y, Y] + V[Z] * M[Z, Y] + M[W, Y];
- TV[Z] := V[X] * M[X, Z] + V[Y] * M[Y, Z] + V[Z] * M[Z, Z] + M[W, Z];
- Result := TV;
-end;
-
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function VectorAffineTransform(V: TAffineVector; M: TAffineMatrix): TAffineVector; register;
-
-// transforms an affine vector by multiplying it with a matrix
-
-var TV: TAffineVector;
-
-begin
- TV[X] := V[X] * M[X, X] + V[Y] * M[Y, X] + V[Z] * M[Z, X];
- TV[Y] := V[X] * M[X, Y] + V[Y] * M[Y, Y] + V[Z] * M[Z, Y];
- TV[Z] := V[X] * M[X, Z] + V[Y] * M[Y, Z] + V[Z] * M[Z, Z];
- Result := TV;
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function PointInPolygon(xp, yp : array of Single; x, y: Single): Boolean;
-
-// The code below is from Wm. Randolph Franklin <wrf@ecse.rpi.edu>
-// with some minor modifications for speed. It returns 1 for strictly
-// interior points, 0 for strictly exterior, and 0 or 1 for points on
-// the boundary.
-// This code is not yet tested!
-
-var I, J: Integer;
-
-begin
- Result := False;
- if High(XP) <> High(YP) then Exit;
- J := High(XP);
- for I := 0 to High(XP) do
- begin
- if ((((yp[I] <= y) and (y < yp[J])) or ((yp[J] <= y) and (y < yp[I]))) and
- (x < (xp[J] - xp[I]) * (y - yp[I]) / (yp[J] - yp[I]) + xp[I]))
- then Result := not Result;
- J := I + 1;
- end;
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function QuaternionConjugate(Q: TQuaternion): TQuaternion; assembler;
-
-// returns the conjugate of a quaternion
-// EAX contains address of Q
-// EDX contains address of result
-
-asm
- FLD DWORD PTR [EAX]
- FCHS
- WAIT
- FSTP DWORD PTR [EDX]
- FLD DWORD PTR [EAX + 4]
- FCHS
- WAIT
- FSTP DWORD PTR [EDX + 4]
- FLD DWORD PTR [EAX + 8]
- FCHS
- WAIT
- FSTP DWORD PTR [EDX + 8]
- MOV EAX, [EAX + 12]
- MOV [EDX + 12], EAX
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function QuaternionFromPoints(V1, V2: TAffineVector): TQuaternion; assembler;
-
-// constructs a unit quaternion from two points on unit sphere
-// EAX contains address of V1
-// ECX contains address to result
-// EDX contains address of V2
-
-asm
- {Result.ImagPart := VectorCrossProduct(V1, V2);
- Result.RealPart := Sqrt((VectorAffineDotProduct(V1, V2) + 1)/2);}
-
- PUSH EAX
- CALL VectorCrossProduct // determine axis to rotate about
- POP EAX
- FLD1 // prepare next calculation
- Call VectorAffineDotProduct // calculate cos(angle between V1 and V2)
- FADD ST, ST(1) // transform angle to angle/2 by: cos(a/2)=sqrt((1 + cos(a))/2)
- FXCH ST(1)
- FADD ST, ST
- FDIVP ST(1), ST
- FSQRT
- FSTP DWORD PTR [ECX + 12] // Result.RealPart := ST(0)
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function QuaternionMultiply(qL, qR: TQuaternion): TQuaternion;
-
-// Returns quaternion product qL * qR. Note: order is important!
-// To combine rotations, use the product QuaternionMuliply(qSecond, qFirst),
-// which gives the effect of rotating by qFirst then qSecond.
-
-var Temp : TQuaternion;
-
-begin
- Temp.RealPart := qL.RealPart * qR.RealPart - qL.ImagPart[X] * qR.ImagPart[X] -
- qL.ImagPart[Y] * qR.ImagPart[Y] - qL.ImagPart[Z] * qR.ImagPart[Z];
- Temp.ImagPart[X] := qL.RealPart * qR.ImagPart[X] + qL.ImagPart[X] * qR.RealPart +
- qL.ImagPart[Y] * qR.ImagPart[Z] - qL.ImagPart[Z] * qR.ImagPart[Y];
- Temp.ImagPart[Y] := qL.RealPart * qR.ImagPart[Y] + qL.ImagPart[Y] * qR.RealPart +
- qL.ImagPart[Z] * qR.ImagPart[X] - qL.ImagPart[X] * qR.ImagPart[Z];
- Temp.ImagPart[Z] := qL.RealPart * qR.ImagPart[Z] + qL.ImagPart[Z] * qR.RealPart +
- qL.ImagPart[X] * qR.ImagPart[Y] - qL.ImagPart[Y] * qR.ImagPart[X];
- Result := Temp;
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function QuaternionToMatrix(Q: TQuaternion): TMatrix;
-
-// Constructs rotation matrix from (possibly non-unit) quaternion.
-// Assumes matrix is used to multiply column vector on the left:
-// vnew = mat vold. Works correctly for right-handed coordinate system
-// and right-handed rotations.
-
-// Essentially, this function is the same as CreateRotationMatrix and you can consider it as
-// being for reference here.
-
-{var Norm, S,
- XS, YS, ZS,
- WX, WY, WZ,
- XX, XY, XZ,
- YY, YZ, ZZ : Single;
-
-begin
- Norm := Q.Vector[X] * Q.Vector[X] + Q.Vector[Y] * Q.Vector[Y] + Q.Vector[Z] * Q.Vector[Z] + Q.RealPart * Q.RealPart;
- if Norm > 0 then S := 2 / Norm
- else S := 0;
-
- XS := Q.Vector[X] * S; YS := Q.Vector[Y] * S; ZS := Q.Vector[Z] * S;
- WX := Q.RealPart * XS; WY := Q.RealPart * YS; WZ := Q.RealPart * ZS;
- XX := Q.Vector[X] * XS; XY := Q.Vector[X] * YS; XZ := Q.Vector[X] * ZS;
- YY := Q.Vector[Y] * YS; YZ := Q.Vector[Y] * ZS; ZZ := Q.Vector[Z] * ZS;
-
- Result[X, X] := 1 - (YY + ZZ); Result[Y, X] := XY + WZ; Result[Z, X] := XZ - WY; Result[W, X] := 0;
- Result[X, Y] := XY - WZ; Result[Y, Y] := 1 - (XX + ZZ); Result[Z, Y] := YZ + WX; Result[W, Y] := 0;
- Result[X, Z] := XZ + WY; Result[Y, Z] := YZ - WX; Result[Z, Z] := 1 - (XX + YY); Result[W, Z] := 0;
- Result[X, W] := 0; Result[Y, W] := 0; Result[Z, W] := 0; Result[W, W] := 1;}
-
-var
- V: TAffineVector;
- SinA, CosA,
- A, B, C: Extended;
-
-begin
- V := Q.ImagPart;
- VectorNormalize(V);
- SinCos(Q.RealPart / 2, SinA, CosA);
- A := V[X] * SinA;
- B := V[Y] * SinA;
- C := V[Z] * SinA;
-
- Result := IdentityMatrix;
- Result[X, X] := 1 - 2 * B * B - 2 * C * C;
- Result[X, Y] := 2 * A * B - 2 * CosA * C;
- Result[X, Z] := 2 * A * C + 2 * CosA * B;
-
- Result[Y, X] := 2 * A * B + 2 * CosA * C;
- Result[Y, Y] := 1 - 2 * A * A - 2 * C * C;
- Result[Y, Z] := 2 * B * C - 2 * CosA * A;
-
- Result[Z, X] := 2 * A * C - 2 * CosA * B;
- Result[Z, Y] := 2 * B * C + 2 * CosA * A;
- Result[Z, Z] := 1 - 2 * A * A - 2 * B * B;
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-procedure QuaternionToPoints(Q: TQuaternion; var ArcFrom, ArcTo: TAffineVector); register;
-
-// converts a unit quaternion into two points on a unit sphere
-
-var S: Single;
-
-begin
- S := Sqrt(Q.ImagPart[X] * Q.ImagPart[X] + Q.ImagPart[Y] * Q.ImagPart[Y]);
- if S = 0 then ArcFrom := MakeAffineVector([0, 1, 0])
- else ArcFrom := MakeAffineVector([-Q.ImagPart[Y] / S, Q.ImagPart[X] / S, 0]);
- ArcTo[X] := Q.RealPart * ArcFrom[X] - Q.ImagPart[Z] * ArcFrom[Y];
- ArcTo[Y] := Q.RealPart * ArcFrom[Y] + Q.ImagPart[Z] * ArcFrom[X];
- ArcTo[Z] := Q.ImagPart[X] * ArcFrom[Y] - Q.ImagPart[Y] * ArcFrom[X];
- if Q.RealPart < 0 then ArcFrom := MakeAffineVector([-ArcFrom[X], -ArcFrom[Y], 0]);
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function MatrixAffineDeterminant(M: TAffineMatrix): Single; register;
-
-// determinant of a 3x3 matrix
-
-begin
- Result := M[X, X] * (M[Y, Y] * M[Z, Z] - M[Z, Y] * M[Y, Z]) -
- M[X, Y] * (M[Y, X] * M[Z, Z] - M[Z, X] * M[Y, Z]) +
- M[X, Z] * (M[Y, X] * M[Z, Y] - M[Z, X] * M[Y, Y]);
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function MatrixDetInternal(a1, a2, a3, b1, b2, b3, c1, c2, c3: Single): Single;
-
-// internal version for the determinant of a 3x3 matrix
-
-begin
- Result := a1 * (b2 * c3 - b3 * c2) -
- b1 * (a2 * c3 - a3 * c2) +
- c1 * (a2 * b3 - a3 * b2);
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-procedure MatrixAdjoint(var M: TMatrix); register;
-
-// Adjoint of a 4x4 matrix - used in the computation of the inverse
-// of a 4x4 matrix
-
-var a1, a2, a3, a4,
- b1, b2, b3, b4,
- c1, c2, c3, c4,
- d1, d2, d3, d4: Single;
-
-
-begin
- a1 := M[X, X]; b1 := M[X, Y];
- c1 := M[X, Z]; d1 := M[X, W];
- a2 := M[Y, X]; b2 := M[Y, Y];
- c2 := M[Y, Z]; d2 := M[Y, W];
- a3 := M[Z, X]; b3 := M[Z, Y];
- c3 := M[Z, Z]; d3 := M[Z, W];
- a4 := M[W, X]; b4 := M[W, Y];
- c4 := M[W, Z]; d4 := M[W, W];
-
- // row column labeling reversed since we transpose rows & columns
- M[X, X] := MatrixDetInternal(b2, b3, b4, c2, c3, c4, d2, d3, d4);
- M[Y, X] := -MatrixDetInternal(a2, a3, a4, c2, c3, c4, d2, d3, d4);
- M[Z, X] := MatrixDetInternal(a2, a3, a4, b2, b3, b4, d2, d3, d4);
- M[W, X] := -MatrixDetInternal(a2, a3, a4, b2, b3, b4, c2, c3, c4);
-
- M[X, Y] := -MatrixDetInternal(b1, b3, b4, c1, c3, c4, d1, d3, d4);
- M[Y, Y] := MatrixDetInternal(a1, a3, a4, c1, c3, c4, d1, d3, d4);
- M[Z, Y] := -MatrixDetInternal(a1, a3, a4, b1, b3, b4, d1, d3, d4);
- M[W, Y] := MatrixDetInternal(a1, a3, a4, b1, b3, b4, c1, c3, c4);
-
- M[X, Z] := MatrixDetInternal(b1, b2, b4, c1, c2, c4, d1, d2, d4);
- M[Y, Z] := -MatrixDetInternal(a1, a2, a4, c1, c2, c4, d1, d2, d4);
- M[Z, Z] := MatrixDetInternal(a1, a2, a4, b1, b2, b4, d1, d2, d4);
- M[W, Z] := -MatrixDetInternal(a1, a2, a4, b1, b2, b4, c1, c2, c4);
-
- M[X, W] := -MatrixDetInternal(b1, b2, b3, c1, c2, c3, d1, d2, d3);
- M[Y, W] := MatrixDetInternal(a1, a2, a3, c1, c2, c3, d1, d2, d3);
- M[Z, W] := -MatrixDetInternal(a1, a2, a3, b1, b2, b3, d1, d2, d3);
- M[W, W] := MatrixDetInternal(a1, a2, a3, b1, b2, b3, c1, c2, c3);
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function MatrixDeterminant(M: TMatrix): Single; register;
-
-// Determinant of a 4x4 matrix
-
-var a1, a2, a3, a4,
- b1, b2, b3, b4,
- c1, c2, c3, c4,
- d1, d2, d3, d4 : Single;
-
-begin
- a1 := M[X, X]; b1 := M[X, Y]; c1 := M[X, Z]; d1 := M[X, W];
- a2 := M[Y, X]; b2 := M[Y, Y]; c2 := M[Y, Z]; d2 := M[Y, W];
- a3 := M[Z, X]; b3 := M[Z, Y]; c3 := M[Z, Z]; d3 := M[Z, W];
- a4 := M[W, X]; b4 := M[W, Y]; c4 := M[W, Z]; d4 := M[W, W];
-
- Result := a1 * MatrixDetInternal(b2, b3, b4, c2, c3, c4, d2, d3, d4) -
- b1 * MatrixDetInternal(a2, a3, a4, c2, c3, c4, d2, d3, d4) +
- c1 * MatrixDetInternal(a2, a3, a4, b2, b3, b4, d2, d3, d4) -
- d1 * MatrixDetInternal(a2, a3, a4, b2, b3, b4, c2, c3, c4);
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-procedure MatrixScale(var M: TMatrix; Factor: Single); register;
-
-// multiplies all elements of a 4x4 matrix with a factor
-
-var I, J: Integer;
-
-begin
- for I := 0 to 3 do
- for J := 0 to 3 do M[I, J] := M[I, J] * Factor;
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-procedure MatrixInvert(var M: TMatrix); register;
-
-// finds the inverse of a 4x4 matrix
-
-var Det: Single;
-
-begin
- Det := MatrixDeterminant(M);
- if Abs(Det) < EPSILON then M := IdentityMatrix
- else
- begin
- MatrixAdjoint(M);
- MatrixScale(M, 1 / Det);
- end;
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-procedure MatrixTranspose(var M: TMatrix); register;
-
-// computes transpose of 4x4 matrix
-
-var I, J: Integer;
- TM: TMatrix;
-
-begin
- for I := 0 to 3 do
- for J := 0 to 3 do TM[J, I] := M[I, J];
- M := TM;
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-procedure MatrixAffineTranspose(var M: TAffineMatrix); register;
-
-// computes transpose of 3x3 matrix
-
-var I, J: Integer;
- TM: TAffineMatrix;
-
-begin
- for I := 0 to 2 do
- for J := 0 to 2 do TM[J, I] := M[I, J];
- M := TM;
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function MatrixMultiply(M1, M2: TMatrix): TMatrix; register;
-
-// multiplies two 4x4 matrices
-
-var I, J: Integer;
- TM: TMatrix;
-
-begin
- for I := 0 to 3 do
- for J := 0 to 3 do
- TM[I, J] := M1[I, X] * M2[X, J] +
- M1[I, Y] * M2[Y, J] +
- M1[I, Z] * M2[Z, J] +
- M1[I, W] * M2[W, J];
- Result := TM;
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function CreateRotationMatrix(Axis: TVector3f; Angle: Single): TMatrix; register;
-
-// Creates a rotation matrix along the given Axis by the given Angle in radians.
-
-var cosine,
- sine,
- Len,
- one_minus_cosine: Extended;
-
-begin
- SinCos(Angle, Sine, Cosine);
- one_minus_cosine := 1 - cosine;
- Len := VectorNormalize(Axis);
-
- if Len = 0 then Result := IdentityMatrix
- else
- begin
- Result[X, X] := (one_minus_cosine * Sqr(Axis[0])) + Cosine;
- Result[X, Y] := (one_minus_cosine * Axis[0] * Axis[1]) - (Axis[2] * Sine);
- Result[X, Z] := (one_minus_cosine * Axis[2] * Axis[0]) + (Axis[1] * Sine);
- Result[X, W] := 0;
-
- Result[Y, X] := (one_minus_cosine * Axis[0] * Axis[1]) + (Axis[2] * Sine);
- Result[Y, Y] := (one_minus_cosine * Sqr(Axis[1])) + Cosine;
- Result[Y, Z] := (one_minus_cosine * Axis[1] * Axis[2]) - (Axis[0] * Sine);
- Result[Y, W] := 0;
-
- Result[Z, X] := (one_minus_cosine * Axis[2] * Axis[0]) - (Axis[1] * Sine);
- Result[Z, Y] := (one_minus_cosine * Axis[1] * Axis[2]) + (Axis[0] * Sine);
- Result[Z, Z] := (one_minus_cosine * Sqr(Axis[2])) + Cosine;
- Result[Z, W] := 0;
-
- Result[W, X] := 0;
- Result[W, Y] := 0;
- Result[W, Z] := 0;
- Result[W, W] := 1;
- end;
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function ConvertRotation(Angles: TAffineVector): TVector; register;
-
-{ Turn a triplet of rotations about x, y, and z (in that order) into an
- equivalent rotation around a single axis (all in radians).
-
- Rotation of the Angle t about the axis (X, Y, Z) is given by:
-
- | X^2 + (1-X^2) Cos(t), XY(1-Cos(t)) + Z Sin(t), XZ(1-Cos(t))-Y Sin(t) |
- M = | XY(1-Cos(t))-Z Sin(t), Y^2 + (1-Y^2) Cos(t), YZ(1-Cos(t)) + X Sin(t) |
- | XZ(1-Cos(t)) + Y Sin(t), YZ(1-Cos(t))-X Sin(t), Z^2 + (1-Z^2) Cos(t) |
-
- Rotation about the three axes (Angles a1, a2, a3) can be represented as
- the product of the individual rotation matrices:
-
- | 1 0 0 | | Cos(a2) 0 -Sin(a2) | | Cos(a3) Sin(a3) 0 |
- | 0 Cos(a1) Sin(a1) | * | 0 1 0 | * | -Sin(a3) Cos(a3) 0 |
- | 0 -Sin(a1) Cos(a1) | | Sin(a2) 0 Cos(a2) | | 0 0 1 |
- Mx My Mz
-
- We now want to solve for X, Y, Z, and t given 9 equations in 4 unknowns.
- Using the diagonal elements of the two matrices, we get:
-
- X^2 + (1-X^2) Cos(t) = M[0][0]
- Y^2 + (1-Y^2) Cos(t) = M[1][1]
- Z^2 + (1-Z^2) Cos(t) = M[2][2]
-
- Adding the three equations, we get:
-
- X^2 + Y^2 + Z^2 - (M[0][0] + M[1][1] + M[2][2]) =
- - (3 - X^2 - Y^2 - Z^2) Cos(t)
-
- Since (X^2 + Y^2 + Z^2) = 1, we can rewrite as:
-
- Cos(t) = (1 - (M[0][0] + M[1][1] + M[2][2])) / 2
-
- Solving for t, we get:
-
- t = Acos(((M[0][0] + M[1][1] + M[2][2]) - 1) / 2)
-
- We can substitute t into the equations for X^2, Y^2, and Z^2 above
- to get the values for X, Y, and Z. To find the proper signs we note
- that:
-
- 2 X Sin(t) = M[1][2] - M[2][1]
- 2 Y Sin(t) = M[2][0] - M[0][2]
- 2 Z Sin(t) = M[0][1] - M[1][0]
-}
-
-var Axis1, Axis2: TVector3f;
- M, M1, M2: TMatrix;
- cost, cost1,
- sint,
- s1, s2, s3: Single;
- I: Integer;
-
-
-begin
- // see if we are only rotating about a single Axis
- if Abs(Angles[X]) < EPSILON then
- begin
- if Abs(Angles[Y]) < EPSILON then
- begin
- Result := MakeVector([0, 0, 1, Angles[Z]]);
- Exit;
- end
- else
- if Abs(Angles[Z]) < EPSILON then
- begin
- Result := MakeVector([0, 1, 0, Angles[Y]]);
- Exit;
- end
- end
- else
- if (Abs(Angles[Y]) < EPSILON) and
- (Abs(Angles[Z]) < EPSILON) then
- begin
- Result := MakeVector([1, 0, 0, Angles[X]]);
- Exit;
- end;
-
- // make the rotation matrix
- Axis1 := MakeAffineVector([1, 0, 0]);
- M := CreateRotationMatrix(Axis1, Angles[X]);
-
- Axis2 := MakeAffineVector([0, 1, 0]);
- M2 := CreateRotationMatrix(Axis2, Angles[Y]);
- M1 := MatrixMultiply(M, M2);
-
- Axis2 := MakeAffineVector([0, 0, 1]);
- M2 := CreateRotationMatrix(Axis2, Angles[Z]);
- M := MatrixMultiply(M1, M2);
-
- cost := ((M[X, X] + M[Y, Y] + M[Z, Z])-1) / 2;
- if cost < -1 then cost := -1
- else
- if cost > 1 - EPSILON then
- begin
- // Bad Angle - this would cause a crash
- Result := MakeVector([1, 0, 0, 0]);
- Exit;
- end;
-
- cost1 := 1 - cost;
- Result := Makevector([Sqrt((M[X, X]-cost) / cost1),
- Sqrt((M[Y, Y]-cost) / cost1),
- sqrt((M[Z, Z]-cost) / cost1),
- arccos(cost)]);
-
- sint := 2 * Sqrt(1 - cost * cost); // This is actually 2 Sin(t)
-
- // Determine the proper signs
- for I := 0 to 7 do
- begin
- if (I and 1) > 1 then s1 := -1 else s1 := 1;
- if (I and 2) > 1 then s2 := -1 else s2 := 1;
- if (I and 4) > 1 then s3 := -1 else s3 := 1;
- if (Abs(s1 * Result[X] * sint-M[Y, Z] + M[Z, Y]) < EPSILON2) and
- (Abs(s2 * Result[Y] * sint-M[Z, X] + M[X, Z]) < EPSILON2) and
- (Abs(s3 * Result[Z] * sint-M[X, Y] + M[Y, X]) < EPSILON2) then
- begin
- // We found the right combination of signs
- Result[X] := Result[X] * s1;
- Result[Y] := Result[Y] * s2;
- Result[Z] := Result[Z] * s3;
- Exit;
- end;
- end;
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function CreateRotationMatrixX(Sine, Cosine: Single): TMatrix; register;
-
-// creates matrix for rotation about x-axis
-
-begin
- Result := EmptyMatrix;
- Result[X, X] := 1;
- Result[Y, Y] := Cosine;
- Result[Y, Z] := Sine;
- Result[Z, Y] := -Sine;
- Result[Z, Z] := Cosine;
- Result[W, W] := 1;
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function CreateRotationMatrixY(Sine, Cosine: Single): TMatrix; register;
-
-// creates matrix for rotation about y-axis
-
-begin
- Result := EmptyMatrix;
- Result[X, X] := Cosine;
- Result[X, Z] := -Sine;
- Result[Y, Y] := 1;
- Result[Z, X] := Sine;
- Result[Z, Z] := Cosine;
- Result[W, W] := 1;
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function CreateRotationMatrixZ(Sine, Cosine: Single): TMatrix; register;
-
-// creates matrix for rotation about z-axis
-
-begin
- Result := EmptyMatrix;
- Result[X, X] := Cosine;
- Result[X, Y] := Sine;
- Result[Y, X] := -Sine;
- Result[Y, Y] := Cosine;
- Result[Z, Z] := 1;
- Result[W, W] := 1;
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function CreateScaleMatrix(V: TAffineVector): TMatrix; register;
-
-// creates scaling matrix
-
-begin
- Result := IdentityMatrix;
- Result[X, X] := V[X];
- Result[Y, Y] := V[Y];
- Result[Z, Z] := V[Z];
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function CreateTranslationMatrix(V: TVector): TMatrix; register;
-
-// creates translation matrix
-
-begin
- Result := IdentityMatrix;
- Result[W, X] := V[X];
- Result[W, Y] := V[Y];
- Result[W, Z] := V[Z];
- Result[W, W] := V[W];
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function Lerp(Start, Stop, t: Single): Single;
-
-// calculates linear interpolation between start and stop at point t
-
-begin
- Result := Start + (Stop - Start) * t;
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function VectorAffineLerp(V1, V2: TAffineVector; t: Single): TAffineVector;
-
-// calculates linear interpolation between vector1 and vector2 at point t
-
-begin
- Result[X] := Lerp(V1[X], V2[X], t);
- Result[Y] := Lerp(V1[Y], V2[Y], t);
- Result[Z] := Lerp(V1[Z], V2[Z], t);
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function VectorLerp(V1, V2: TVector; t: Single): TVector;
-
-// calculates linear interpolation between vector1 and vector2 at point t
-
-begin
- Result[X] := Lerp(V1[X], V2[X], t);
- Result[Y] := Lerp(V1[Y], V2[Y], t);
- Result[Z] := Lerp(V1[Z], V2[Z], t);
- Result[W] := Lerp(V1[W], V2[W], t);
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function QuaternionSlerp(QStart, QEnd: TQuaternion; Spin: Integer; t: Single): TQuaternion;
-
-// spherical linear interpolation of unit quaternions with spins
-// QStart, QEnd - start and end unit quaternions
-// t - interpolation parameter (0 to 1)
-// Spin - number of extra spin rotations to involve
-
-var beta, // complementary interp parameter
- theta, // Angle between A and B
- sint, cost, // sine, cosine of theta
- phi: Single; // theta plus spins
- bflip: Boolean; // use negativ t?
-
-
-begin
- // cosine theta
- cost := VectorAngle(QStart.ImagPart, QEnd.ImagPart);
-
- // if QEnd is on opposite hemisphere from QStart, use -QEnd instead
- if cost < 0 then
- begin
- cost := -cost;
- bflip := True;
- end
- else bflip := False;
-
- // if QEnd is (within precision limits) the same as QStart,
- // just linear interpolate between QStart and QEnd.
- // Can't do spins, since we don't know what direction to spin.
-
- if (1 - cost) < EPSILON then beta := 1 - t
- else
- begin
- // normal case
- theta := arccos(cost);
- phi := theta + Spin * Pi;
- sint := sin(theta);
- beta := sin(theta - t * phi) / sint;
- t := sin(t * phi) / sint;
- end;
-
- if bflip then t := -t;
-
- // interpolate
- Result.ImagPart[X] := beta * QStart.ImagPart[X] + t * QEnd.ImagPart[X];
- Result.ImagPart[Y] := beta * QStart.ImagPart[Y] + t * QEnd.ImagPart[Y];
- Result.ImagPart[Z] := beta * QStart.ImagPart[Z] + t * QEnd.ImagPart[Z];
- Result.RealPart := beta * QStart.RealPart + t * QEnd.RealPart;
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function VectorAffineCombine(V1, V2: TAffineVector; F1, F2: Single): TAffineVector;
-
-// makes a linear combination of two vectors and return the result
-
-begin
- Result[X] := (F1 * V1[X]) + (F2 * V2[X]);
- Result[Y] := (F1 * V1[Y]) + (F2 * V2[Y]);
- Result[Z] := (F1 * V1[Z]) + (F2 * V2[Z]);
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function VectorCombine(V1, V2: TVector; F1, F2: Single): TVector;
-
-// makes a linear combination of two vectors and return the result
-
-begin
- Result[X] := (F1 * V1[X]) + (F2 * V2[X]);
- Result[Y] := (F1 * V1[Y]) + (F2 * V2[Y]);
- Result[Z] := (F1 * V1[Z]) + (F2 * V2[Z]);
- Result[W] := (F1 * V1[W]) + (F2 * V2[W]);
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function MatrixDecompose(M: TMatrix; var Tran: TTransformations): Boolean; register;
-
-// Author: Spencer W. Thomas, University of Michigan
-//
-// MatrixDecompose - Decompose a non-degenerated 4x4 transformation matrix into
-// the sequence of transformations that produced it.
-//
-// The coefficient of each transformation is returned in the corresponding
-// element of the vector Tran.
-//
-// Returns true upon success, false if the matrix is singular.
-
-var I, J: Integer;
- LocMat,
- pmat,
- invpmat,
- tinvpmat: TMatrix;
- prhs,
- psol: TVector;
- Row: array[0..2] of TAffineVector;
-
-begin
- Result := False;
- locmat := M;
- // normalize the matrix
- if locmat[W, W] = 0 then Exit;
- for I := 0 to 3 do
- for J := 0 to 3 do
- locmat[I, J] := locmat[I, J] / locmat[W, W];
-
- // pmat is used to solve for perspective, but it also provides
- // an easy way to test for singularity of the upper 3x3 component.
-
- pmat := locmat;
- for I := 0 to 2 do pmat[I, W] := 0;
- pmat[W, W] := 1;
-
- if MatrixDeterminant(pmat) = 0 then Exit;
-
- // First, isolate perspective. This is the messiest.
- if (locmat[X, W] <> 0) or
- (locmat[Y, W] <> 0) or
- (locmat[Z, W] <> 0) then
- begin
- // prhs is the right hand side of the equation.
- prhs[X] := locmat[X, W];
- prhs[Y] := locmat[Y, W];
- prhs[Z] := locmat[Z, W];
- prhs[W] := locmat[W, W];
-
- // Solve the equation by inverting pmat and multiplying
- // prhs by the inverse. (This is the easiest way, not
- // necessarily the best.)
-
- invpmat := pmat;
- MatrixInvert(invpmat);
- MatrixTranspose(invpmat);
- psol := VectorTransform(prhs, tinvpmat);
-
- // stuff the answer away
- Tran[ttPerspectiveX] := psol[X];
- Tran[ttPerspectiveY] := psol[Y];
- Tran[ttPerspectiveZ] := psol[Z];
- Tran[ttPerspectiveW] := psol[W];
-
- // clear the perspective partition
- locmat[X, W] := 0;
- locmat[Y, W] := 0;
- locmat[Z, W] := 0;
- locmat[W, W] := 1;
- end
- else
- begin
- // no perspective
- Tran[ttPerspectiveX] := 0;
- Tran[ttPerspectiveY] := 0;
- Tran[ttPerspectiveZ] := 0;
- Tran[ttPerspectiveW] := 0;
- end;
-
- // next take care of translation (easy)
- for I := 0 to 2 do
- begin
- Tran[TTransType(Ord(ttTranslateX) + I)] := locmat[W, I];
- locmat[W, I] := 0;
- end;
-
- // now get scale and shear
- for I := 0 to 2 do
- begin
- row[I, X] := locmat[I, X];
- row[I, Y] := locmat[I, Y];
- row[I, Z] := locmat[I, Z];
- end;
-
- // compute X scale factor and normalize first row
- Tran[ttScaleX] := Sqr(VectorNormalize(row[0])); // ml: calculation optimized
-
- // compute XY shear factor and make 2nd row orthogonal to 1st
- Tran[ttShearXY] := VectorAffineDotProduct(row[0], row[1]);
- row[1] := VectorAffineCombine(row[1], row[0], 1, -Tran[ttShearXY]);
-
- // now, compute Y scale and normalize 2nd row
- Tran[ttScaleY] := Sqr(VectorNormalize(row[1])); // ml: calculation optimized
- Tran[ttShearXY] := Tran[ttShearXY]/Tran[ttScaleY];
-
- // compute XZ and YZ shears, orthogonalize 3rd row
- Tran[ttShearXZ] := VectorAffineDotProduct(row[0], row[2]);
- row[2] := VectorAffineCombine(row[2], row[0], 1, -Tran[ttShearXZ]);
- Tran[ttShearYZ] := VectorAffineDotProduct(row[1], row[2]);
- row[2] := VectorAffineCombine(row[2], row[1], 1, -Tran[ttShearYZ]);
-
- // next, get Z scale and normalize 3rd row
- Tran[ttScaleZ] := Sqr(VectorNormalize(row[1])); // (ML) calc. optimized
- Tran[ttShearXZ] := Tran[ttShearXZ] / tran[ttScaleZ];
- Tran[ttShearYZ] := Tran[ttShearYZ] / Tran[ttScaleZ];
-
- // At this point, the matrix (in rows[]) is orthonormal.
- // Check for a coordinate system flip. If the determinant
- // is -1, then negate the matrix and the scaling factors.
- if VectorAffineDotProduct(row[0], VectorCrossProduct(row[1], row[2])) < 0 then
- for I := 0 to 2 do
- begin
- Tran[TTransType(Ord(ttScaleX) + I)] := -Tran[TTransType(Ord(ttScaleX) + I)];
- row[I, X] := -row[I, X];
- row[I, Y] := -row[I, Y];
- row[I, Z] := -row[I, Z];
- end;
-
- // now, get the rotations out, as described in the gem
- Tran[ttRotateY] := arcsin(-row[0, Z]);
- if cos(Tran[ttRotateY]) <> 0 then
- begin
- Tran[ttRotateX] := arctan2(row[1, Z], row[2, Z]);
- Tran[ttRotateZ] := arctan2(row[0, Y], row[0, X]);
- end
- else
- begin
- tran[ttRotateX] := arctan2(row[1, X], row[1, Y]);
- tran[ttRotateZ] := 0;
- end;
- // All done!
- Result := True;
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function VectorDblToFlt(V: THomogeneousDblVector): THomogeneousVector; assembler;
-
-// converts a vector containing double sized values into a vector with single sized values
-
-asm
- FLD QWORD PTR [EAX]
- FSTP DWORD PTR [EDX]
- FLD QWORD PTR [EAX + 8]
- FSTP DWORD PTR [EDX + 4]
- FLD QWORD PTR [EAX + 16]
- FSTP DWORD PTR [EDX + 8]
- FLD QWORD PTR [EAX + 24]
- FSTP DWORD PTR [EDX + 12]
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function VectorAffineDblToFlt(V: TAffineDblVector): TAffineVector; assembler;
-
-// converts a vector containing double sized values into a vector with single sized values
-
-asm
- FLD QWORD PTR [EAX]
- FSTP DWORD PTR [EDX]
- FLD QWORD PTR [EAX + 8]
- FSTP DWORD PTR [EDX + 4]
- FLD QWORD PTR [EAX + 16]
- FSTP DWORD PTR [EDX + 8]
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function VectorAffineFltToDbl(V: TAffineVector): TAffineDblVector; assembler;
-
-// converts a vector containing single sized values into a vector with double sized values
-
-asm
- FLD DWORD PTR [EAX]
- FSTP QWORD PTR [EDX]
- FLD DWORD PTR [EAX + 8]
- FSTP QWORD PTR [EDX + 4]
- FLD DWORD PTR [EAX + 16]
- FSTP QWORD PTR [EDX + 8]
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function VectorFltToDbl(V: TVector): THomogeneousDblVector; assembler;
-
-// converts a vector containing single sized values into a vector with double sized values
-
-asm
- FLD DWORD PTR [EAX]
- FSTP QWORD PTR [EDX]
- FLD DWORD PTR [EAX + 8]
- FSTP QWORD PTR [EDX + 4]
- FLD DWORD PTR [EAX + 16]
- FSTP QWORD PTR [EDX + 8]
- FLD DWORD PTR [EAX + 24]
- FSTP QWORD PTR [EDX + 12]
-end;
-
-//----------------- coordinate system manipulation functions -----------------------------------------------------------
-
-function Turn(Matrix: TMatrix; Angle: Single): TMatrix;
-
-// rotates the given coordinate system (represented by the matrix) around its Y-axis
-
-begin
- Result := MatrixMultiply(Matrix, CreateRotationMatrix(MakeAffineVector(Matrix[1]), Angle));
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function Turn(Matrix: TMatrix; MasterUp: TAffineVector; Angle: Single): TMatrix;
-
-// rotates the given coordinate system (represented by the matrix) around MasterUp
-
-begin
- Result := MatrixMultiply(Matrix, CreateRotationMatrix(MasterUp, Angle));
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function Pitch(Matrix: TMatrix; Angle: Single): TMatrix;
-
-// rotates the given coordinate system (represented by the matrix) around its X-axis
-
-begin
- Result := MatrixMultiply(Matrix, CreateRotationMatrix(MakeAffineVector(Matrix[0]), Angle));
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function Pitch(Matrix: TMatrix; MasterRight: TAffineVector; Angle: Single): TMatrix; overload;
-
-// rotates the given coordinate system (represented by the matrix) around MasterRight
-
-begin
- Result := MatrixMultiply(Matrix, CreateRotationMatrix(MasterRight, Angle));
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function Roll(Matrix: TMatrix; Angle: Single): TMatrix;
-
-// rotates the given coordinate system (represented by the matrix) around its Z-axis
-
-begin
- Result := MatrixMultiply(Matrix, CreateRotationMatrix(MakeAffineVector(Matrix[2]), Angle));
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-function Roll(Matrix: TMatrix; MasterDirection: TAffineVector; Angle: Single): TMatrix; overload;
-
-// rotates the given coordinate system (represented by the matrix) around MasterDirection
-
-begin
- Result := MatrixMultiply(Matrix, CreateRotationMatrix(MasterDirection, Angle));
-end;
-
-//----------------------------------------------------------------------------------------------------------------------
-
-end.
-
-
+unit geometry; +{ + $Id: geometry.pas,v 1.1 2004/03/30 21:53:54 savage Exp $ + +} + +// This unit contains many needed types, functions and procedures for +// quaternion, vector and matrix arithmetics. It is specifically designed +// for geometric calculations within R3 (affine vector space) +// and R4 (homogeneous vector space). +// +// Note: The terms 'affine' or 'affine coordinates' are not really correct here +// because an 'affine transformation' describes generally a transformation which leads +// to a uniquely solvable system of equations and has nothing to do with the dimensionality +// of a vector. One could use 'projective coordinates' but this is also not really correct +// and since I haven't found a better name (or even any correct one), 'affine' is as good +// as any other one. +// +// Identifiers containing no dimensionality (like affine or homogeneous) +// and no datatype (integer..extended) are supposed as R4 representation +// with 'single' floating point type (examples are TVector, TMatrix, +// and TQuaternion). The default data type is 'single' ('GLFloat' for OpenGL) +// and used in all routines (except conversions and trigonometric functions). +// +// Routines with an open array as argument can either take Func([1,2,3,4,..]) or Func(Vect). +// The latter is prefered, since no extra stack operations is required. +// Note: Be careful while passing open array elements! If you pass more elements +// than there's room in the result the behaviour will be unpredictable. +// +// If not otherwise stated, all angles are given in radians +// (instead of degrees). Use RadToDeg or DegToRad to convert between them. +// +// Geometry.pas was assembled from different sources (like GraphicGems) +// and relevant books or based on self written code, respectivly. +// +// Note: Some aspects need to be considered when using Delphi and pure +// assembler code. Delphi ensures that the direction flag is always +// cleared while entering a function and expects it cleared on return. +// This is in particular important in routines with (CPU) string commands (MOVSD etc.) +// The registers EDI, ESI and EBX (as well as the stack management +// registers EBP and ESP) must not be changed! EAX, ECX and EDX are +// freely available and mostly used for parameter. +// +// Version 2.5 +// last change : 04. January 2000 +// +// (c) Copyright 1999, Dipl. Ing. Mike Lischke (public@lischke-online.de) +{ + $Log: geometry.pas,v $ + Revision 1.1 2004/03/30 21:53:54 savage + Moved to it's own folder. + + Revision 1.1 2004/02/05 00:08:19 savage + Module 1.0 release + + +} + +interface + +{$I jedi-sdl.inc} + +type + // data types needed for 3D graphics calculation, + // included are 'C like' aliases for each type (to be + // conformal with OpenGL types) + + PByte = ^Byte; + PWord = ^Word; + PInteger = ^Integer; + PFloat = ^Single; + PDouble = ^Double; + PExtended = ^Extended; + PPointer = ^Pointer; + + // types to specify continous streams of a specific type + // switch off range checking to access values beyond the limits + PByteVector = ^TByteVector; + PByteArray = PByteVector; + TByteVector = array[0..0] of Byte; + + PWordVector = ^TWordVector; + PWordArray = PWordVector; // note: there's a same named type in SysUtils + TWordVector = array[0..0] of Word; + + PIntegerVector = ^TIntegerVector; + PIntegerArray = PIntegerVector; + TIntegerVector = array[0..0] of Integer; + + PFloatVector = ^TFloatVector; + PFloatArray = PFloatVector; + TFloatVector = array[0..0] of Single; + + PDoubleVector = ^TDoubleVector; + PDoubleArray = PDoubleVector; + TDoubleVector = array[0..0] of Double; + + PExtendedVector = ^TExtendedVector; + PExtendedArray = PExtendedVector; + TExtendedVector = array[0..0] of Extended; + + PPointerVector = ^TPointerVector; + PPointerArray = PPointerVector; + TPointerVector = array[0..0] of Pointer; + + PCardinalVector = ^TCardinalVector; + PCardinalArray = PCardinalVector; + TCardinalVector = array[0..0] of Cardinal; + + // common vector and matrix types with predefined limits + // indices correspond like: x -> 0 + // y -> 1 + // z -> 2 + // w -> 3 + + PHomogeneousByteVector = ^THomogeneousByteVector; + THomogeneousByteVector = array[0..3] of Byte; + TVector4b = THomogeneousByteVector; + + PHomogeneousWordVector = ^THomogeneousWordVector; + THomogeneousWordVector = array[0..3] of Word; + TVector4w = THomogeneousWordVector; + + PHomogeneousIntVector = ^THomogeneousIntVector; + THomogeneousIntVector = array[0..3] of Integer; + TVector4i = THomogeneousIntVector; + + PHomogeneousFltVector = ^THomogeneousFltVector; + THomogeneousFltVector = array[0..3] of Single; + TVector4f = THomogeneousFltVector; + + PHomogeneousDblVector = ^THomogeneousDblVector; + THomogeneousDblVector = array[0..3] of Double; + TVector4d = THomogeneousDblVector; + + PHomogeneousExtVector = ^THomogeneousExtVector; + THomogeneousExtVector = array[0..3] of Extended; + TVector4e = THomogeneousExtVector; + + PHomogeneousPtrVector = ^THomogeneousPtrVector; + THomogeneousPtrVector = array[0..3] of Pointer; + TVector4p = THomogeneousPtrVector; + + PAffineByteVector = ^TAffineByteVector; + TAffineByteVector = array[0..2] of Byte; + TVector3b = TAffineByteVector; + + PAffineWordVector = ^TAffineWordVector; + TAffineWordVector = array[0..2] of Word; + TVector3w = TAffineWordVector; + + PAffineIntVector = ^TAffineIntVector; + TAffineIntVector = array[0..2] of Integer; + TVector3i = TAffineIntVector; + + PAffineFltVector = ^TAffineFltVector; + TAffineFltVector = array[0..2] of Single; + TVector3f = TAffineFltVector; + + PAffineDblVector = ^TAffineDblVector; + TAffineDblVector = array[0..2] of Double; + TVector3d = TAffineDblVector; + + PAffineExtVector = ^TAffineExtVector; + TAffineExtVector = array[0..2] of Extended; + TVector3e = TAffineExtVector; + + PAffinePtrVector = ^TAffinePtrVector; + TAffinePtrVector = array[0..2] of Pointer; + TVector3p = TAffinePtrVector; + + // some simplified names + PVector = ^TVector; + TVector = THomogeneousFltVector; + + PHomogeneousVector = ^THomogeneousVector; + THomogeneousVector = THomogeneousFltVector; + + PAffineVector = ^TAffineVector; + TAffineVector = TAffineFltVector; + + // arrays of vectors + PVectorArray = ^TVectorArray; + TVectorArray = array[0..0] of TAffineVector; + + // matrices + THomogeneousByteMatrix = array[0..3] of THomogeneousByteVector; + TMatrix4b = THomogeneousByteMatrix; + + THomogeneousWordMatrix = array[0..3] of THomogeneousWordVector; + TMatrix4w = THomogeneousWordMatrix; + + THomogeneousIntMatrix = array[0..3] of THomogeneousIntVector; + TMatrix4i = THomogeneousIntMatrix; + + THomogeneousFltMatrix = array[0..3] of THomogeneousFltVector; + TMatrix4f = THomogeneousFltMatrix; + + THomogeneousDblMatrix = array[0..3] of THomogeneousDblVector; + TMatrix4d = THomogeneousDblMatrix; + + THomogeneousExtMatrix = array[0..3] of THomogeneousExtVector; + TMatrix4e = THomogeneousExtMatrix; + + TAffineByteMatrix = array[0..2] of TAffineByteVector; + TMatrix3b = TAffineByteMatrix; + + TAffineWordMatrix = array[0..2] of TAffineWordVector; + TMatrix3w = TAffineWordMatrix; + + TAffineIntMatrix = array[0..2] of TAffineIntVector; + TMatrix3i = TAffineIntMatrix; + + TAffineFltMatrix = array[0..2] of TAffineFltVector; + TMatrix3f = TAffineFltMatrix; + + TAffineDblMatrix = array[0..2] of TAffineDblVector; + TMatrix3d = TAffineDblMatrix; + + TAffineExtMatrix = array[0..2] of TAffineExtVector; + TMatrix3e = TAffineExtMatrix; + + // some simplified names + PMatrix = ^TMatrix; + TMatrix = THomogeneousFltMatrix; + + PHomogeneousMatrix = ^THomogeneousMatrix; + THomogeneousMatrix = THomogeneousFltMatrix; + + PAffineMatrix = ^TAffineMatrix; + TAffineMatrix = TAffineFltMatrix; + + // q = ([x, y, z], w) + TQuaternion = record + case Integer of + 0: + (ImagPart: TAffineVector; + RealPart: Single); + 1: + (Vector: TVector4f); + end; + + TRectangle = record + Left, + Top, + Width, + Height: Integer; + end; + + TTransType = (ttScaleX, ttScaleY, ttScaleZ, + ttShearXY, ttShearXZ, ttShearYZ, + ttRotateX, ttRotateY, ttRotateZ, + ttTranslateX, ttTranslateY, ttTranslateZ, + ttPerspectiveX, ttPerspectiveY, ttPerspectiveZ, ttPerspectiveW); + + // used to describe a sequence of transformations in following order: + // [Sx][Sy][Sz][ShearXY][ShearXZ][ShearZY][Rx][Ry][Rz][Tx][Ty][Tz][P(x,y,z,w)] + // constants are declared for easier access (see MatrixDecompose below) + TTransformations = array[TTransType] of Single; + + +const + // useful constants + + // standard vectors + XVector: TAffineVector = (1, 0, 0); + YVector: TAffineVector = (0, 1, 0); + ZVector: TAffineVector = (0, 0, 1); + NullVector: TAffineVector = (0, 0, 0); + + IdentityMatrix: TMatrix = ((1, 0, 0, 0), + (0, 1, 0, 0), + (0, 0, 1, 0), + (0, 0, 0, 1)); + EmptyMatrix: TMatrix = ((0, 0, 0, 0), + (0, 0, 0, 0), + (0, 0, 0, 0), + (0, 0, 0, 0)); + // some very small numbers + EPSILON = 1e-100; + EPSILON2 = 1e-50; + +//---------------------------------------------------------------------------------------------------------------------- + +// vector functions +function VectorAdd(V1, V2: TVector): TVector; +function VectorAffineAdd(V1, V2: TAffineVector): TAffineVector; +function VectorAffineCombine(V1, V2: TAffineVector; F1, F2: Single): TAffineVector; +function VectorAffineDotProduct(V1, V2: TAffineVector): Single; +function VectorAffineLerp(V1, V2: TAffineVector; t: Single): TAffineVector; +function VectorAffineSubtract(V1, V2: TAffineVector): TAffineVector; +function VectorAngle(V1, V2: TAffineVector): Single; +function VectorCombine(V1, V2: TVector; F1, F2: Single): TVector; +function VectorCrossProduct(V1, V2: TAffineVector): TAffineVector; +function VectorDotProduct(V1, V2: TVector): Single; +function VectorLength(V: array of Single): Single; +function VectorLerp(V1, V2: TVector; t: Single): TVector; +procedure VectorNegate(V: array of Single); +function VectorNorm(V: array of Single): Single; +function VectorNormalize(V: array of Single): Single; +function VectorPerpendicular(V, N: TAffineVector): TAffineVector; +function VectorReflect(V, N: TAffineVector): TAffineVector; +procedure VectorRotate(var Vector: TVector4f; Axis: TVector3f; Angle: Single); +procedure VectorScale(V: array of Single; Factor: Single); +function VectorSubtract(V1, V2: TVector): TVector; + +// matrix functions +function CreateRotationMatrixX(Sine, Cosine: Single): TMatrix; +function CreateRotationMatrixY(Sine, Cosine: Single): TMatrix; +function CreateRotationMatrixZ(Sine, Cosine: Single): TMatrix; +function CreateScaleMatrix(V: TAffineVector): TMatrix; +function CreateTranslationMatrix(V: TVector): TMatrix; +procedure MatrixAdjoint(var M: TMatrix); +function MatrixAffineDeterminant(M: TAffineMatrix): Single; +procedure MatrixAffineTranspose(var M: TAffineMatrix); +function MatrixDeterminant(M: TMatrix): Single; +procedure MatrixInvert(var M: TMatrix); +function MatrixMultiply(M1, M2: TMatrix): TMatrix; +procedure MatrixScale(var M: TMatrix; Factor: Single); +procedure MatrixTranspose(var M: TMatrix); + +// quaternion functions +function QuaternionConjugate(Q: TQuaternion): TQuaternion; +function QuaternionFromPoints(V1, V2: TAffineVector): TQuaternion; +function QuaternionMultiply(qL, qR: TQuaternion): TQuaternion; +function QuaternionSlerp(QStart, QEnd: TQuaternion; Spin: Integer; t: Single): TQuaternion; +function QuaternionToMatrix(Q: TQuaternion): TMatrix; +procedure QuaternionToPoints(Q: TQuaternion; var ArcFrom, ArcTo: TAffineVector); + +// mixed functions +function ConvertRotation(Angles: TAffineVector): TVector; +function CreateRotationMatrix(Axis: TVector3f; Angle: Single): TMatrix; +function MatrixDecompose(M: TMatrix; var Tran: TTransformations): Boolean; +function VectorAffineTransform(V: TAffineVector; M: TAffineMatrix): TAffineVector; +function VectorTransform(V: TVector4f; M: TMatrix): TVector4f; overload; +function VectorTransform(V: TVector3f; M: TMatrix): TVector3f; overload; + +// miscellaneous functions +function MakeAffineDblVector(V: array of Double): TAffineDblVector; +function MakeDblVector(V: array of Double): THomogeneousDblVector; +function MakeAffineVector(V: array of Single): TAffineVector; +function MakeQuaternion(Imag: array of Single; Real: Single): TQuaternion; +function MakeVector(V: array of Single): TVector; +function PointInPolygon(xp, yp : array of Single; x, y: Single): Boolean; +function VectorAffineDblToFlt(V: TAffineDblVector): TAffineVector; +function VectorDblToFlt(V: THomogeneousDblVector): THomogeneousVector; +function VectorAffineFltToDbl(V: TAffineVector): TAffineDblVector; +function VectorFltToDbl(V: TVector): THomogeneousDblVector; + +// trigonometric functions +function ArcCos(X: Extended): Extended; +function ArcSin(X: Extended): Extended; +function ArcTan2(Y, X: Extended): Extended; +function CoTan(X: Extended): Extended; +function DegToRad(Degrees: Extended): Extended; +function RadToDeg(Radians: Extended): Extended; +procedure SinCos(Theta: Extended; var Sin, Cos: Extended); +function Tan(X: Extended): Extended; + +// coordinate system manipulation functions +function Turn(Matrix: TMatrix; Angle: Single): TMatrix; overload; +function Turn(Matrix: TMatrix; MasterUp: TAffineVector; Angle: Single): TMatrix; overload; +function Pitch(Matrix: TMatrix; Angle: Single): TMatrix; overload; +function Pitch(Matrix: TMatrix; MasterRight: TAffineVector; Angle: Single): TMatrix; overload; +function Roll(Matrix: TMatrix; Angle: Single): TMatrix; overload; +function Roll(Matrix: TMatrix; MasterDirection: TAffineVector; Angle: Single): TMatrix; overload; + +//---------------------------------------------------------------------------------------------------------------------- + +implementation + +const + // FPU status flags (high order byte) + C0 = 1; + C1 = 2; + C2 = 4; + C3 = $40; + + // to be used as descriptive indices + X = 0; + Y = 1; + Z = 2; + W = 3; + +//----------------- trigonometric helper functions --------------------------------------------------------------------- + +function DegToRad(Degrees: Extended): Extended; + +begin + Result := Degrees * (PI / 180); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function RadToDeg(Radians: Extended): Extended; + +begin + Result := Radians * (180 / PI); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure SinCos(Theta: Extended; var Sin, Cos: Extended); assembler; register; + +// calculates sine and cosine from the given angle Theta +// EAX contains address of Sin +// EDX contains address of Cos +// Theta is passed over the stack + +asm + FLD Theta + FSINCOS + FSTP TBYTE PTR [EDX] // cosine + FSTP TBYTE PTR [EAX] // sine + FWAIT +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function ArcCos(X: Extended): Extended; + +begin + Result := ArcTan2(Sqrt(1 - X * X), X); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function ArcSin(X: Extended): Extended; + +begin + Result := ArcTan2(X, Sqrt(1 - X * X)) +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function ArcTan2(Y, X: Extended): Extended; + +asm + FLD Y + FLD X + FPATAN + FWAIT +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function Tan(X: Extended): Extended; + +asm + FLD X + FPTAN + FSTP ST(0) // FPTAN pushes 1.0 after result + FWAIT +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function CoTan(X: Extended): Extended; + +asm + FLD X + FPTAN + FDIVRP + FWAIT +end; + +//----------------- miscellaneous vector functions --------------------------------------------------------------------- + +function MakeAffineDblVector(V: array of Double): TAffineDblVector; assembler; + +// creates a vector from given values +// EAX contains address of V +// ECX contains address to result vector +// EDX contains highest index of V + +asm + PUSH EDI + PUSH ESI + MOV EDI, ECX + MOV ESI, EAX + MOV ECX, EDX + ADD ECX, 2 + REP MOVSD + POP ESI + POP EDI +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function MakeDblVector(V: array of Double): THomogeneousDblVector; assembler; + +// creates a vector from given values +// EAX contains address of V +// ECX contains address to result vector +// EDX contains highest index of V + +asm + PUSH EDI + PUSH ESI + MOV EDI, ECX + MOV ESI, EAX + MOV ECX, EDX + ADD ECX, 2 + REP MOVSD + POP ESI + POP EDI +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function MakeAffineVector(V: array of Single): TAffineVector; assembler; + +// creates a vector from given values +// EAX contains address of V +// ECX contains address to result vector +// EDX contains highest index of V + +asm + PUSH EDI + PUSH ESI + MOV EDI, ECX + MOV ESI, EAX + MOV ECX, EDX + INC ECX + CMP ECX, 3 + JB @@1 + MOV ECX, 3 +@@1: REP MOVSD // copy given values + MOV ECX, 2 + SUB ECX, EDX // determine missing entries + JS @@Finish + XOR EAX, EAX + REP STOSD // set remaining fields to 0 +@@Finish: POP ESI + POP EDI +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function MakeQuaternion(Imag: array of Single; Real: Single): TQuaternion; assembler; + +// creates a quaternion from the given values +// EAX contains address of Imag +// ECX contains address to result vector +// EDX contains highest index of Imag +// Real part is passed on the stack + +asm + PUSH EDI + PUSH ESI + MOV EDI, ECX + MOV ESI, EAX + MOV ECX, EDX + INC ECX + REP MOVSD + MOV EAX, [Real] + MOV [EDI], EAX + POP ESI + POP EDI +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function MakeVector(V: array of Single): TVector; assembler; + +// creates a vector from given values +// EAX contains address of V +// ECX contains address to result vector +// EDX contains highest index of V + +asm + PUSH EDI + PUSH ESI + MOV EDI, ECX + MOV ESI, EAX + MOV ECX, EDX + INC ECX + CMP ECX, 4 + JB @@1 + MOV ECX, 4 +@@1: REP MOVSD // copy given values + MOV ECX, 3 + SUB ECX, EDX // determine missing entries + JS @@Finish + XOR EAX, EAX + REP STOSD // set remaining fields to 0 +@@Finish: POP ESI + POP EDI +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function VectorLength(V: array of Single): Single; assembler; + +// calculates the length of a vector following the equation: sqrt(x * x + y * y + ...) +// Note: The parameter of this function is declared as open array. Thus +// there's no restriction about the number of the components of the vector. +// +// EAX contains address of V +// EDX contains the highest index of V +// the result is returned in ST(0) + +asm + FLDZ // initialize sum +@@Loop: FLD DWORD PTR [EAX + 4 * EDX] // load a component + FMUL ST, ST + FADDP + SUB EDX, 1 + JNL @@Loop + FSQRT +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function VectorAngle(V1, V2: TAffineVector): Single; assembler; + +// calculates the cosine of the angle between Vector1 and Vector2 +// Result = DotProduct(V1, V2) / (Length(V1) * Length(V2)) +// +// EAX contains address of Vector1 +// EDX contains address of Vector2 + +asm + FLD DWORD PTR [EAX] // V1[0] + FLD ST // double V1[0] + FMUL ST, ST // V1[0]^2 (prep. for divisor) + FLD DWORD PTR [EDX] // V2[0] + FMUL ST(2), ST // ST(2) := V1[0] * V2[0] + FMUL ST, ST // V2[0]^2 (prep. for divisor) + FLD DWORD PTR [EAX + 4] // V1[1] + FLD ST // double V1[1] + FMUL ST, ST // ST(0) := V1[1]^2 + FADDP ST(3), ST // ST(2) := V1[0]^2 + V1[1] * * 2 + FLD DWORD PTR [EDX + 4] // V2[1] + FMUL ST(1), ST // ST(1) := V1[1] * V2[1] + FMUL ST, ST // ST(0) := V2[1]^2 + FADDP ST(2), ST // ST(1) := V2[0]^2 + V2[1]^2 + FADDP ST(3), ST // ST(2) := V1[0] * V2[0] + V1[1] * V2[1] + FLD DWORD PTR [EAX + 8] // load V2[1] + FLD ST // same calcs go here + FMUL ST, ST // (compare above) + FADDP ST(3), ST + FLD DWORD PTR [EDX + 8] + FMUL ST(1), ST + FMUL ST, ST + FADDP ST(2), ST + FADDP ST(3), ST + FMULP // ST(0) := (V1[0]^2 + V1[1]^2 + V1[2]) * + // (V2[0]^2 + V2[1]^2 + V2[2]) + FSQRT // sqrt(ST(0)) + FDIVP // ST(0) := Result := ST(1) / ST(0) + // the result is expected in ST(0), if it's invalid, an error is raised +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function VectorNorm(V: array of Single): Single; assembler; register; + +// calculates norm of a vector which is defined as norm = x * x + y * y + ... +// EAX contains address of V +// EDX contains highest index in V +// result is passed in ST(0) + +asm + FLDZ // initialize sum +@@Loop: FLD DWORD PTR [EAX + 4 * EDX] // load a component + FMUL ST, ST // make square + FADDP // add previous calculated sum + SUB EDX, 1 + JNL @@Loop +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function VectorNormalize(V: array of Single): Single; assembler; register; + +// transforms a vector to unit length and return length +// EAX contains address of V +// EDX contains the highest index in V +// return former length of V in ST + +asm + PUSH EBX + MOV ECX, EDX // save size of V + CALL VectorLength // calculate length of vector + FTST // test if length = 0 + MOV EBX, EAX // save parameter address + FSTSW AX // get test result + TEST AH, C3 // check the test result + JNZ @@Finish + SUB EBX, 4 // simplyfied address calculation + INC ECX + FLD1 // calculate reciprocal of length + FDIV ST, ST(1) +@@1: FLD ST // double reciprocal + FMUL DWORD PTR [EBX + 4 * ECX] // scale component + WAIT + FSTP DWORD PTR [EBX + 4 * ECX] // store result + LOOP @@1 + FSTP ST // remove reciprocal from FPU stack +@@Finish: POP EBX +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function VectorAffineSubtract(V1, V2: TAffineVector): TAffineVector; assembler; register; + +// returns v1 minus v2 +// EAX contains address of V1 +// EDX contains address of V2 +// ECX contains address of the result + +asm + {Result[X] := V1[X]-V2[X]; + Result[Y] := V1[Y]-V2[Y]; + Result[Z] := V1[Z]-V2[Z];} + + FLD DWORD PTR [EAX] + FSUB DWORD PTR [EDX] + FSTP DWORD PTR [ECX] + FLD DWORD PTR [EAX + 4] + FSUB DWORD PTR [EDX + 4] + FSTP DWORD PTR [ECX + 4] + FLD DWORD PTR [EAX + 8] + FSUB DWORD PTR [EDX + 8] + FSTP DWORD PTR [ECX + 8] +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function VectorReflect(V, N: TAffineVector): TAffineVector; assembler; register; + +// reflects vector V against N (assumes N is normalized) +// EAX contains address of V +// EDX contains address of N +// ECX contains address of the result + +//var Dot : Single; + +asm + {Dot := VectorAffineDotProduct(V, N); + Result[X] := V[X]-2 * Dot * N[X]; + Result[Y] := V[Y]-2 * Dot * N[Y]; + Result[Z] := V[Z]-2 * Dot * N[Z];} + + CALL VectorAffineDotProduct // dot is now in ST(0) + FCHS // -dot + FADD ST, ST // -dot * 2 + FLD DWORD PTR [EDX] // ST := N[X] + FMUL ST, ST(1) // ST := -2 * dot * N[X] + FADD DWORD PTR[EAX] // ST := V[X] - 2 * dot * N[X] + FSTP DWORD PTR [ECX] // store result + FLD DWORD PTR [EDX + 4] // etc. + FMUL ST, ST(1) + FADD DWORD PTR[EAX + 4] + FSTP DWORD PTR [ECX + 4] + FLD DWORD PTR [EDX + 8] + FMUL ST, ST(1) + FADD DWORD PTR[EAX + 8] + FSTP DWORD PTR [ECX + 8] + FSTP ST // clean FPU stack +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure VectorRotate(var Vector: TVector4f; Axis: TVector3f; Angle: Single); + +// rotates Vector about Axis with Angle radiants + +var RotMatrix : TMatrix4f; + +begin + RotMatrix := CreateRotationMatrix(Axis, Angle); + Vector := VectorTransform(Vector, RotMatrix); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure VectorScale(V: array of Single; Factor: Single); assembler; register; + +// returns a vector scaled by a factor +// EAX contains address of V +// EDX contains highest index in V +// Factor is located on the stack + +asm + {for I := Low(V) to High(V) do V[I] := V[I] * Factor;} + + FLD DWORD PTR [Factor] // load factor +@@Loop: FLD DWORD PTR [EAX + 4 * EDX] // load a component + FMUL ST, ST(1) // multiply it with the factor + WAIT + FSTP DWORD PTR [EAX + 4 * EDX] // store the result + DEC EDX // do the entire array + JNS @@Loop + FSTP ST(0) // clean the FPU stack +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure VectorNegate(V: array of Single); assembler; register; + +// returns a negated vector +// EAX contains address of V +// EDX contains highest index in V + +asm + {V[X] := -V[X]; + V[Y] := -V[Y]; + V[Z] := -V[Z];} + +@@Loop: FLD DWORD PTR [EAX + 4 * EDX] + FCHS + WAIT + FSTP DWORD PTR [EAX + 4 * EDX] + DEC EDX + JNS @@Loop +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function VectorAdd(V1, V2: TVector): TVector; register; + +// returns the sum of two vectors + +begin + Result[X] := V1[X] + V2[X]; + Result[Y] := V1[Y] + V2[Y]; + Result[Z] := V1[Z] + V2[Z]; + Result[W] := V1[W] + V2[W]; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function VectorAffineAdd(V1, V2: TAffineVector): TAffineVector; register; + +// returns the sum of two vectors + +begin + Result[X] := V1[X] + V2[X]; + Result[Y] := V1[Y] + V2[Y]; + Result[Z] := V1[Z] + V2[Z]; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function VectorSubtract(V1, V2: TVector): TVector; register; + +// returns the difference of two vectors + +begin + Result[X] := V1[X] - V2[X]; + Result[Y] := V1[Y] - V2[Y]; + Result[Z] := V1[Z] - V2[Z]; + Result[W] := V1[W] - V2[W]; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function VectorDotProduct(V1, V2: TVector): Single; register; + +begin + Result := V1[X] * V2[X] + V1[Y] * V2[Y] + V1[Z] * V2[Z] + V1[W] * V2[W]; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function VectorAffineDotProduct(V1, V2: TAffineVector): Single; assembler; register; + +// calculates the dot product between V1 and V2 +// EAX contains address of V1 +// EDX contains address of V2 +// result is stored in ST(0) + +asm + //Result := V1[X] * V2[X] + V1[Y] * V2[Y] + V1[Z] * V2[Z]; + + FLD DWORD PTR [EAX] + FMUL DWORD PTR [EDX] + FLD DWORD PTR [EAX + 4] + FMUL DWORD PTR [EDX + 4] + FADDP + FLD DWORD PTR [EAX + 8] + FMUL DWORD PTR [EDX + 8] + FADDP +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function VectorCrossProduct(V1, V2: TAffineVector): TAffineVector; + +// calculates the cross product between vector 1 and 2, Temp is necessary because +// either V1 or V2 could also be the result vector +// +// EAX contains address of V1 +// EDX contains address of V2 +// ECX contains address of result + +var Temp: TAffineVector; + +asm + {Temp[X] := V1[Y] * V2[Z]-V1[Z] * V2[Y]; + Temp[Y] := V1[Z] * V2[X]-V1[X] * V2[Z]; + Temp[Z] := V1[X] * V2[Y]-V1[Y] * V2[X]; + Result := Temp;} + + PUSH EBX // save EBX, must be restored to original value + LEA EBX, [Temp] + FLD DWORD PTR [EDX + 8] // first load both vectors onto FPU register stack + FLD DWORD PTR [EDX + 4] + FLD DWORD PTR [EDX + 0] + FLD DWORD PTR [EAX + 8] + FLD DWORD PTR [EAX + 4] + FLD DWORD PTR [EAX + 0] + + FLD ST(1) // ST(0) := V1[Y] + FMUL ST, ST(6) // ST(0) := V1[Y] * V2[Z] + FLD ST(3) // ST(0) := V1[Z] + FMUL ST, ST(6) // ST(0) := V1[Z] * V2[Y] + FSUBP ST(1), ST // ST(0) := ST(1)-ST(0) + FSTP DWORD [EBX] // Temp[X] := ST(0) + FLD ST(2) // ST(0) := V1[Z] + FMUL ST, ST(4) // ST(0) := V1[Z] * V2[X] + FLD ST(1) // ST(0) := V1[X] + FMUL ST, ST(7) // ST(0) := V1[X] * V2[Z] + FSUBP ST(1), ST // ST(0) := ST(1)-ST(0) + FSTP DWORD [EBX + 4] // Temp[Y] := ST(0) + FLD ST // ST(0) := V1[X] + FMUL ST, ST(5) // ST(0) := V1[X] * V2[Y] + FLD ST(2) // ST(0) := V1[Y] + FMUL ST, ST(5) // ST(0) := V1[Y] * V2[X] + FSUBP ST(1), ST // ST(0) := ST(1)-ST(0) + FSTP DWORD [EBX + 8] // Temp[Z] := ST(0) + FSTP ST(0) // clear FPU register stack + FSTP ST(0) + FSTP ST(0) + FSTP ST(0) + FSTP ST(0) + FSTP ST(0) + MOV EAX, [EBX] // copy Temp to Result + MOV [ECX], EAX + MOV EAX, [EBX + 4] + MOV [ECX + 4], EAX + MOV EAX, [EBX + 8] + MOV [ECX + 8], EAX + POP EBX +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function VectorPerpendicular(V, N: TAffineVector): TAffineVector; + +// calculates a vector perpendicular to N (N is assumed to be of unit length) +// subtract out any component parallel to N + +var Dot: Single; + +begin + Dot := VectorAffineDotProduct(V, N); + Result[X] := V[X]-Dot * N[X]; + Result[Y] := V[Y]-Dot * N[Y]; + Result[Z] := V[Z]-Dot * N[Z]; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function VectorTransform(V: TVector4f; M: TMatrix): TVector4f; register; + +// transforms a homogeneous vector by multiplying it with a matrix + +var TV: TVector4f; + +begin + TV[X] := V[X] * M[X, X] + V[Y] * M[Y, X] + V[Z] * M[Z, X] + V[W] * M[W, X]; + TV[Y] := V[X] * M[X, Y] + V[Y] * M[Y, Y] + V[Z] * M[Z, Y] + V[W] * M[W, Y]; + TV[Z] := V[X] * M[X, Z] + V[Y] * M[Y, Z] + V[Z] * M[Z, Z] + V[W] * M[W, Z]; + TV[W] := V[X] * M[X, W] + V[Y] * M[Y, W] + V[Z] * M[Z, W] + V[W] * M[W, W]; + Result := TV +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function VectorTransform(V: TVector3f; M: TMatrix): TVector3f; + +// transforms an affine vector by multiplying it with a (homogeneous) matrix + +var TV: TVector3f; + +begin + TV[X] := V[X] * M[X, X] + V[Y] * M[Y, X] + V[Z] * M[Z, X] + M[W, X]; + TV[Y] := V[X] * M[X, Y] + V[Y] * M[Y, Y] + V[Z] * M[Z, Y] + M[W, Y]; + TV[Z] := V[X] * M[X, Z] + V[Y] * M[Y, Z] + V[Z] * M[Z, Z] + M[W, Z]; + Result := TV; +end; + + +//---------------------------------------------------------------------------------------------------------------------- + +function VectorAffineTransform(V: TAffineVector; M: TAffineMatrix): TAffineVector; register; + +// transforms an affine vector by multiplying it with a matrix + +var TV: TAffineVector; + +begin + TV[X] := V[X] * M[X, X] + V[Y] * M[Y, X] + V[Z] * M[Z, X]; + TV[Y] := V[X] * M[X, Y] + V[Y] * M[Y, Y] + V[Z] * M[Z, Y]; + TV[Z] := V[X] * M[X, Z] + V[Y] * M[Y, Z] + V[Z] * M[Z, Z]; + Result := TV; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function PointInPolygon(xp, yp : array of Single; x, y: Single): Boolean; + +// The code below is from Wm. Randolph Franklin <wrf@ecse.rpi.edu> +// with some minor modifications for speed. It returns 1 for strictly +// interior points, 0 for strictly exterior, and 0 or 1 for points on +// the boundary. +// This code is not yet tested! + +var I, J: Integer; + +begin + Result := False; + if High(XP) <> High(YP) then Exit; + J := High(XP); + for I := 0 to High(XP) do + begin + if ((((yp[I] <= y) and (y < yp[J])) or ((yp[J] <= y) and (y < yp[I]))) and + (x < (xp[J] - xp[I]) * (y - yp[I]) / (yp[J] - yp[I]) + xp[I])) + then Result := not Result; + J := I + 1; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function QuaternionConjugate(Q: TQuaternion): TQuaternion; assembler; + +// returns the conjugate of a quaternion +// EAX contains address of Q +// EDX contains address of result + +asm + FLD DWORD PTR [EAX] + FCHS + WAIT + FSTP DWORD PTR [EDX] + FLD DWORD PTR [EAX + 4] + FCHS + WAIT + FSTP DWORD PTR [EDX + 4] + FLD DWORD PTR [EAX + 8] + FCHS + WAIT + FSTP DWORD PTR [EDX + 8] + MOV EAX, [EAX + 12] + MOV [EDX + 12], EAX +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function QuaternionFromPoints(V1, V2: TAffineVector): TQuaternion; assembler; + +// constructs a unit quaternion from two points on unit sphere +// EAX contains address of V1 +// ECX contains address to result +// EDX contains address of V2 + +asm + {Result.ImagPart := VectorCrossProduct(V1, V2); + Result.RealPart := Sqrt((VectorAffineDotProduct(V1, V2) + 1)/2);} + + PUSH EAX + CALL VectorCrossProduct // determine axis to rotate about + POP EAX + FLD1 // prepare next calculation + Call VectorAffineDotProduct // calculate cos(angle between V1 and V2) + FADD ST, ST(1) // transform angle to angle/2 by: cos(a/2)=sqrt((1 + cos(a))/2) + FXCH ST(1) + FADD ST, ST + FDIVP ST(1), ST + FSQRT + FSTP DWORD PTR [ECX + 12] // Result.RealPart := ST(0) +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function QuaternionMultiply(qL, qR: TQuaternion): TQuaternion; + +// Returns quaternion product qL * qR. Note: order is important! +// To combine rotations, use the product QuaternionMuliply(qSecond, qFirst), +// which gives the effect of rotating by qFirst then qSecond. + +var Temp : TQuaternion; + +begin + Temp.RealPart := qL.RealPart * qR.RealPart - qL.ImagPart[X] * qR.ImagPart[X] - + qL.ImagPart[Y] * qR.ImagPart[Y] - qL.ImagPart[Z] * qR.ImagPart[Z]; + Temp.ImagPart[X] := qL.RealPart * qR.ImagPart[X] + qL.ImagPart[X] * qR.RealPart + + qL.ImagPart[Y] * qR.ImagPart[Z] - qL.ImagPart[Z] * qR.ImagPart[Y]; + Temp.ImagPart[Y] := qL.RealPart * qR.ImagPart[Y] + qL.ImagPart[Y] * qR.RealPart + + qL.ImagPart[Z] * qR.ImagPart[X] - qL.ImagPart[X] * qR.ImagPart[Z]; + Temp.ImagPart[Z] := qL.RealPart * qR.ImagPart[Z] + qL.ImagPart[Z] * qR.RealPart + + qL.ImagPart[X] * qR.ImagPart[Y] - qL.ImagPart[Y] * qR.ImagPart[X]; + Result := Temp; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function QuaternionToMatrix(Q: TQuaternion): TMatrix; + +// Constructs rotation matrix from (possibly non-unit) quaternion. +// Assumes matrix is used to multiply column vector on the left: +// vnew = mat vold. Works correctly for right-handed coordinate system +// and right-handed rotations. + +// Essentially, this function is the same as CreateRotationMatrix and you can consider it as +// being for reference here. + +{var Norm, S, + XS, YS, ZS, + WX, WY, WZ, + XX, XY, XZ, + YY, YZ, ZZ : Single; + +begin + Norm := Q.Vector[X] * Q.Vector[X] + Q.Vector[Y] * Q.Vector[Y] + Q.Vector[Z] * Q.Vector[Z] + Q.RealPart * Q.RealPart; + if Norm > 0 then S := 2 / Norm + else S := 0; + + XS := Q.Vector[X] * S; YS := Q.Vector[Y] * S; ZS := Q.Vector[Z] * S; + WX := Q.RealPart * XS; WY := Q.RealPart * YS; WZ := Q.RealPart * ZS; + XX := Q.Vector[X] * XS; XY := Q.Vector[X] * YS; XZ := Q.Vector[X] * ZS; + YY := Q.Vector[Y] * YS; YZ := Q.Vector[Y] * ZS; ZZ := Q.Vector[Z] * ZS; + + Result[X, X] := 1 - (YY + ZZ); Result[Y, X] := XY + WZ; Result[Z, X] := XZ - WY; Result[W, X] := 0; + Result[X, Y] := XY - WZ; Result[Y, Y] := 1 - (XX + ZZ); Result[Z, Y] := YZ + WX; Result[W, Y] := 0; + Result[X, Z] := XZ + WY; Result[Y, Z] := YZ - WX; Result[Z, Z] := 1 - (XX + YY); Result[W, Z] := 0; + Result[X, W] := 0; Result[Y, W] := 0; Result[Z, W] := 0; Result[W, W] := 1;} + +var + V: TAffineVector; + SinA, CosA, + A, B, C: Extended; + +begin + V := Q.ImagPart; + VectorNormalize(V); + SinCos(Q.RealPart / 2, SinA, CosA); + A := V[X] * SinA; + B := V[Y] * SinA; + C := V[Z] * SinA; + + Result := IdentityMatrix; + Result[X, X] := 1 - 2 * B * B - 2 * C * C; + Result[X, Y] := 2 * A * B - 2 * CosA * C; + Result[X, Z] := 2 * A * C + 2 * CosA * B; + + Result[Y, X] := 2 * A * B + 2 * CosA * C; + Result[Y, Y] := 1 - 2 * A * A - 2 * C * C; + Result[Y, Z] := 2 * B * C - 2 * CosA * A; + + Result[Z, X] := 2 * A * C - 2 * CosA * B; + Result[Z, Y] := 2 * B * C + 2 * CosA * A; + Result[Z, Z] := 1 - 2 * A * A - 2 * B * B; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure QuaternionToPoints(Q: TQuaternion; var ArcFrom, ArcTo: TAffineVector); register; + +// converts a unit quaternion into two points on a unit sphere + +var S: Single; + +begin + S := Sqrt(Q.ImagPart[X] * Q.ImagPart[X] + Q.ImagPart[Y] * Q.ImagPart[Y]); + if S = 0 then ArcFrom := MakeAffineVector([0, 1, 0]) + else ArcFrom := MakeAffineVector([-Q.ImagPart[Y] / S, Q.ImagPart[X] / S, 0]); + ArcTo[X] := Q.RealPart * ArcFrom[X] - Q.ImagPart[Z] * ArcFrom[Y]; + ArcTo[Y] := Q.RealPart * ArcFrom[Y] + Q.ImagPart[Z] * ArcFrom[X]; + ArcTo[Z] := Q.ImagPart[X] * ArcFrom[Y] - Q.ImagPart[Y] * ArcFrom[X]; + if Q.RealPart < 0 then ArcFrom := MakeAffineVector([-ArcFrom[X], -ArcFrom[Y], 0]); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function MatrixAffineDeterminant(M: TAffineMatrix): Single; register; + +// determinant of a 3x3 matrix + +begin + Result := M[X, X] * (M[Y, Y] * M[Z, Z] - M[Z, Y] * M[Y, Z]) - + M[X, Y] * (M[Y, X] * M[Z, Z] - M[Z, X] * M[Y, Z]) + + M[X, Z] * (M[Y, X] * M[Z, Y] - M[Z, X] * M[Y, Y]); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function MatrixDetInternal(a1, a2, a3, b1, b2, b3, c1, c2, c3: Single): Single; + +// internal version for the determinant of a 3x3 matrix + +begin + Result := a1 * (b2 * c3 - b3 * c2) - + b1 * (a2 * c3 - a3 * c2) + + c1 * (a2 * b3 - a3 * b2); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure MatrixAdjoint(var M: TMatrix); register; + +// Adjoint of a 4x4 matrix - used in the computation of the inverse +// of a 4x4 matrix + +var a1, a2, a3, a4, + b1, b2, b3, b4, + c1, c2, c3, c4, + d1, d2, d3, d4: Single; + + +begin + a1 := M[X, X]; b1 := M[X, Y]; + c1 := M[X, Z]; d1 := M[X, W]; + a2 := M[Y, X]; b2 := M[Y, Y]; + c2 := M[Y, Z]; d2 := M[Y, W]; + a3 := M[Z, X]; b3 := M[Z, Y]; + c3 := M[Z, Z]; d3 := M[Z, W]; + a4 := M[W, X]; b4 := M[W, Y]; + c4 := M[W, Z]; d4 := M[W, W]; + + // row column labeling reversed since we transpose rows & columns + M[X, X] := MatrixDetInternal(b2, b3, b4, c2, c3, c4, d2, d3, d4); + M[Y, X] := -MatrixDetInternal(a2, a3, a4, c2, c3, c4, d2, d3, d4); + M[Z, X] := MatrixDetInternal(a2, a3, a4, b2, b3, b4, d2, d3, d4); + M[W, X] := -MatrixDetInternal(a2, a3, a4, b2, b3, b4, c2, c3, c4); + + M[X, Y] := -MatrixDetInternal(b1, b3, b4, c1, c3, c4, d1, d3, d4); + M[Y, Y] := MatrixDetInternal(a1, a3, a4, c1, c3, c4, d1, d3, d4); + M[Z, Y] := -MatrixDetInternal(a1, a3, a4, b1, b3, b4, d1, d3, d4); + M[W, Y] := MatrixDetInternal(a1, a3, a4, b1, b3, b4, c1, c3, c4); + + M[X, Z] := MatrixDetInternal(b1, b2, b4, c1, c2, c4, d1, d2, d4); + M[Y, Z] := -MatrixDetInternal(a1, a2, a4, c1, c2, c4, d1, d2, d4); + M[Z, Z] := MatrixDetInternal(a1, a2, a4, b1, b2, b4, d1, d2, d4); + M[W, Z] := -MatrixDetInternal(a1, a2, a4, b1, b2, b4, c1, c2, c4); + + M[X, W] := -MatrixDetInternal(b1, b2, b3, c1, c2, c3, d1, d2, d3); + M[Y, W] := MatrixDetInternal(a1, a2, a3, c1, c2, c3, d1, d2, d3); + M[Z, W] := -MatrixDetInternal(a1, a2, a3, b1, b2, b3, d1, d2, d3); + M[W, W] := MatrixDetInternal(a1, a2, a3, b1, b2, b3, c1, c2, c3); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function MatrixDeterminant(M: TMatrix): Single; register; + +// Determinant of a 4x4 matrix + +var a1, a2, a3, a4, + b1, b2, b3, b4, + c1, c2, c3, c4, + d1, d2, d3, d4 : Single; + +begin + a1 := M[X, X]; b1 := M[X, Y]; c1 := M[X, Z]; d1 := M[X, W]; + a2 := M[Y, X]; b2 := M[Y, Y]; c2 := M[Y, Z]; d2 := M[Y, W]; + a3 := M[Z, X]; b3 := M[Z, Y]; c3 := M[Z, Z]; d3 := M[Z, W]; + a4 := M[W, X]; b4 := M[W, Y]; c4 := M[W, Z]; d4 := M[W, W]; + + Result := a1 * MatrixDetInternal(b2, b3, b4, c2, c3, c4, d2, d3, d4) - + b1 * MatrixDetInternal(a2, a3, a4, c2, c3, c4, d2, d3, d4) + + c1 * MatrixDetInternal(a2, a3, a4, b2, b3, b4, d2, d3, d4) - + d1 * MatrixDetInternal(a2, a3, a4, b2, b3, b4, c2, c3, c4); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure MatrixScale(var M: TMatrix; Factor: Single); register; + +// multiplies all elements of a 4x4 matrix with a factor + +var I, J: Integer; + +begin + for I := 0 to 3 do + for J := 0 to 3 do M[I, J] := M[I, J] * Factor; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure MatrixInvert(var M: TMatrix); register; + +// finds the inverse of a 4x4 matrix + +var Det: Single; + +begin + Det := MatrixDeterminant(M); + if Abs(Det) < EPSILON then M := IdentityMatrix + else + begin + MatrixAdjoint(M); + MatrixScale(M, 1 / Det); + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure MatrixTranspose(var M: TMatrix); register; + +// computes transpose of 4x4 matrix + +var I, J: Integer; + TM: TMatrix; + +begin + for I := 0 to 3 do + for J := 0 to 3 do TM[J, I] := M[I, J]; + M := TM; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +procedure MatrixAffineTranspose(var M: TAffineMatrix); register; + +// computes transpose of 3x3 matrix + +var I, J: Integer; + TM: TAffineMatrix; + +begin + for I := 0 to 2 do + for J := 0 to 2 do TM[J, I] := M[I, J]; + M := TM; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function MatrixMultiply(M1, M2: TMatrix): TMatrix; register; + +// multiplies two 4x4 matrices + +var I, J: Integer; + TM: TMatrix; + +begin + for I := 0 to 3 do + for J := 0 to 3 do + TM[I, J] := M1[I, X] * M2[X, J] + + M1[I, Y] * M2[Y, J] + + M1[I, Z] * M2[Z, J] + + M1[I, W] * M2[W, J]; + Result := TM; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function CreateRotationMatrix(Axis: TVector3f; Angle: Single): TMatrix; register; + +// Creates a rotation matrix along the given Axis by the given Angle in radians. + +var cosine, + sine, + Len, + one_minus_cosine: Extended; + +begin + SinCos(Angle, Sine, Cosine); + one_minus_cosine := 1 - cosine; + Len := VectorNormalize(Axis); + + if Len = 0 then Result := IdentityMatrix + else + begin + Result[X, X] := (one_minus_cosine * Sqr(Axis[0])) + Cosine; + Result[X, Y] := (one_minus_cosine * Axis[0] * Axis[1]) - (Axis[2] * Sine); + Result[X, Z] := (one_minus_cosine * Axis[2] * Axis[0]) + (Axis[1] * Sine); + Result[X, W] := 0; + + Result[Y, X] := (one_minus_cosine * Axis[0] * Axis[1]) + (Axis[2] * Sine); + Result[Y, Y] := (one_minus_cosine * Sqr(Axis[1])) + Cosine; + Result[Y, Z] := (one_minus_cosine * Axis[1] * Axis[2]) - (Axis[0] * Sine); + Result[Y, W] := 0; + + Result[Z, X] := (one_minus_cosine * Axis[2] * Axis[0]) - (Axis[1] * Sine); + Result[Z, Y] := (one_minus_cosine * Axis[1] * Axis[2]) + (Axis[0] * Sine); + Result[Z, Z] := (one_minus_cosine * Sqr(Axis[2])) + Cosine; + Result[Z, W] := 0; + + Result[W, X] := 0; + Result[W, Y] := 0; + Result[W, Z] := 0; + Result[W, W] := 1; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function ConvertRotation(Angles: TAffineVector): TVector; register; + +{ Turn a triplet of rotations about x, y, and z (in that order) into an + equivalent rotation around a single axis (all in radians). + + Rotation of the Angle t about the axis (X, Y, Z) is given by: + + | X^2 + (1-X^2) Cos(t), XY(1-Cos(t)) + Z Sin(t), XZ(1-Cos(t))-Y Sin(t) | + M = | XY(1-Cos(t))-Z Sin(t), Y^2 + (1-Y^2) Cos(t), YZ(1-Cos(t)) + X Sin(t) | + | XZ(1-Cos(t)) + Y Sin(t), YZ(1-Cos(t))-X Sin(t), Z^2 + (1-Z^2) Cos(t) | + + Rotation about the three axes (Angles a1, a2, a3) can be represented as + the product of the individual rotation matrices: + + | 1 0 0 | | Cos(a2) 0 -Sin(a2) | | Cos(a3) Sin(a3) 0 | + | 0 Cos(a1) Sin(a1) | * | 0 1 0 | * | -Sin(a3) Cos(a3) 0 | + | 0 -Sin(a1) Cos(a1) | | Sin(a2) 0 Cos(a2) | | 0 0 1 | + Mx My Mz + + We now want to solve for X, Y, Z, and t given 9 equations in 4 unknowns. + Using the diagonal elements of the two matrices, we get: + + X^2 + (1-X^2) Cos(t) = M[0][0] + Y^2 + (1-Y^2) Cos(t) = M[1][1] + Z^2 + (1-Z^2) Cos(t) = M[2][2] + + Adding the three equations, we get: + + X^2 + Y^2 + Z^2 - (M[0][0] + M[1][1] + M[2][2]) = + - (3 - X^2 - Y^2 - Z^2) Cos(t) + + Since (X^2 + Y^2 + Z^2) = 1, we can rewrite as: + + Cos(t) = (1 - (M[0][0] + M[1][1] + M[2][2])) / 2 + + Solving for t, we get: + + t = Acos(((M[0][0] + M[1][1] + M[2][2]) - 1) / 2) + + We can substitute t into the equations for X^2, Y^2, and Z^2 above + to get the values for X, Y, and Z. To find the proper signs we note + that: + + 2 X Sin(t) = M[1][2] - M[2][1] + 2 Y Sin(t) = M[2][0] - M[0][2] + 2 Z Sin(t) = M[0][1] - M[1][0] +} + +var Axis1, Axis2: TVector3f; + M, M1, M2: TMatrix; + cost, cost1, + sint, + s1, s2, s3: Single; + I: Integer; + + +begin + // see if we are only rotating about a single Axis + if Abs(Angles[X]) < EPSILON then + begin + if Abs(Angles[Y]) < EPSILON then + begin + Result := MakeVector([0, 0, 1, Angles[Z]]); + Exit; + end + else + if Abs(Angles[Z]) < EPSILON then + begin + Result := MakeVector([0, 1, 0, Angles[Y]]); + Exit; + end + end + else + if (Abs(Angles[Y]) < EPSILON) and + (Abs(Angles[Z]) < EPSILON) then + begin + Result := MakeVector([1, 0, 0, Angles[X]]); + Exit; + end; + + // make the rotation matrix + Axis1 := MakeAffineVector([1, 0, 0]); + M := CreateRotationMatrix(Axis1, Angles[X]); + + Axis2 := MakeAffineVector([0, 1, 0]); + M2 := CreateRotationMatrix(Axis2, Angles[Y]); + M1 := MatrixMultiply(M, M2); + + Axis2 := MakeAffineVector([0, 0, 1]); + M2 := CreateRotationMatrix(Axis2, Angles[Z]); + M := MatrixMultiply(M1, M2); + + cost := ((M[X, X] + M[Y, Y] + M[Z, Z])-1) / 2; + if cost < -1 then cost := -1 + else + if cost > 1 - EPSILON then + begin + // Bad Angle - this would cause a crash + Result := MakeVector([1, 0, 0, 0]); + Exit; + end; + + cost1 := 1 - cost; + Result := Makevector([Sqrt((M[X, X]-cost) / cost1), + Sqrt((M[Y, Y]-cost) / cost1), + sqrt((M[Z, Z]-cost) / cost1), + arccos(cost)]); + + sint := 2 * Sqrt(1 - cost * cost); // This is actually 2 Sin(t) + + // Determine the proper signs + for I := 0 to 7 do + begin + if (I and 1) > 1 then s1 := -1 else s1 := 1; + if (I and 2) > 1 then s2 := -1 else s2 := 1; + if (I and 4) > 1 then s3 := -1 else s3 := 1; + if (Abs(s1 * Result[X] * sint-M[Y, Z] + M[Z, Y]) < EPSILON2) and + (Abs(s2 * Result[Y] * sint-M[Z, X] + M[X, Z]) < EPSILON2) and + (Abs(s3 * Result[Z] * sint-M[X, Y] + M[Y, X]) < EPSILON2) then + begin + // We found the right combination of signs + Result[X] := Result[X] * s1; + Result[Y] := Result[Y] * s2; + Result[Z] := Result[Z] * s3; + Exit; + end; + end; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function CreateRotationMatrixX(Sine, Cosine: Single): TMatrix; register; + +// creates matrix for rotation about x-axis + +begin + Result := EmptyMatrix; + Result[X, X] := 1; + Result[Y, Y] := Cosine; + Result[Y, Z] := Sine; + Result[Z, Y] := -Sine; + Result[Z, Z] := Cosine; + Result[W, W] := 1; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function CreateRotationMatrixY(Sine, Cosine: Single): TMatrix; register; + +// creates matrix for rotation about y-axis + +begin + Result := EmptyMatrix; + Result[X, X] := Cosine; + Result[X, Z] := -Sine; + Result[Y, Y] := 1; + Result[Z, X] := Sine; + Result[Z, Z] := Cosine; + Result[W, W] := 1; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function CreateRotationMatrixZ(Sine, Cosine: Single): TMatrix; register; + +// creates matrix for rotation about z-axis + +begin + Result := EmptyMatrix; + Result[X, X] := Cosine; + Result[X, Y] := Sine; + Result[Y, X] := -Sine; + Result[Y, Y] := Cosine; + Result[Z, Z] := 1; + Result[W, W] := 1; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function CreateScaleMatrix(V: TAffineVector): TMatrix; register; + +// creates scaling matrix + +begin + Result := IdentityMatrix; + Result[X, X] := V[X]; + Result[Y, Y] := V[Y]; + Result[Z, Z] := V[Z]; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function CreateTranslationMatrix(V: TVector): TMatrix; register; + +// creates translation matrix + +begin + Result := IdentityMatrix; + Result[W, X] := V[X]; + Result[W, Y] := V[Y]; + Result[W, Z] := V[Z]; + Result[W, W] := V[W]; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function Lerp(Start, Stop, t: Single): Single; + +// calculates linear interpolation between start and stop at point t + +begin + Result := Start + (Stop - Start) * t; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function VectorAffineLerp(V1, V2: TAffineVector; t: Single): TAffineVector; + +// calculates linear interpolation between vector1 and vector2 at point t + +begin + Result[X] := Lerp(V1[X], V2[X], t); + Result[Y] := Lerp(V1[Y], V2[Y], t); + Result[Z] := Lerp(V1[Z], V2[Z], t); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function VectorLerp(V1, V2: TVector; t: Single): TVector; + +// calculates linear interpolation between vector1 and vector2 at point t + +begin + Result[X] := Lerp(V1[X], V2[X], t); + Result[Y] := Lerp(V1[Y], V2[Y], t); + Result[Z] := Lerp(V1[Z], V2[Z], t); + Result[W] := Lerp(V1[W], V2[W], t); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function QuaternionSlerp(QStart, QEnd: TQuaternion; Spin: Integer; t: Single): TQuaternion; + +// spherical linear interpolation of unit quaternions with spins +// QStart, QEnd - start and end unit quaternions +// t - interpolation parameter (0 to 1) +// Spin - number of extra spin rotations to involve + +var beta, // complementary interp parameter + theta, // Angle between A and B + sint, cost, // sine, cosine of theta + phi: Single; // theta plus spins + bflip: Boolean; // use negativ t? + + +begin + // cosine theta + cost := VectorAngle(QStart.ImagPart, QEnd.ImagPart); + + // if QEnd is on opposite hemisphere from QStart, use -QEnd instead + if cost < 0 then + begin + cost := -cost; + bflip := True; + end + else bflip := False; + + // if QEnd is (within precision limits) the same as QStart, + // just linear interpolate between QStart and QEnd. + // Can't do spins, since we don't know what direction to spin. + + if (1 - cost) < EPSILON then beta := 1 - t + else + begin + // normal case + theta := arccos(cost); + phi := theta + Spin * Pi; + sint := sin(theta); + beta := sin(theta - t * phi) / sint; + t := sin(t * phi) / sint; + end; + + if bflip then t := -t; + + // interpolate + Result.ImagPart[X] := beta * QStart.ImagPart[X] + t * QEnd.ImagPart[X]; + Result.ImagPart[Y] := beta * QStart.ImagPart[Y] + t * QEnd.ImagPart[Y]; + Result.ImagPart[Z] := beta * QStart.ImagPart[Z] + t * QEnd.ImagPart[Z]; + Result.RealPart := beta * QStart.RealPart + t * QEnd.RealPart; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function VectorAffineCombine(V1, V2: TAffineVector; F1, F2: Single): TAffineVector; + +// makes a linear combination of two vectors and return the result + +begin + Result[X] := (F1 * V1[X]) + (F2 * V2[X]); + Result[Y] := (F1 * V1[Y]) + (F2 * V2[Y]); + Result[Z] := (F1 * V1[Z]) + (F2 * V2[Z]); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function VectorCombine(V1, V2: TVector; F1, F2: Single): TVector; + +// makes a linear combination of two vectors and return the result + +begin + Result[X] := (F1 * V1[X]) + (F2 * V2[X]); + Result[Y] := (F1 * V1[Y]) + (F2 * V2[Y]); + Result[Z] := (F1 * V1[Z]) + (F2 * V2[Z]); + Result[W] := (F1 * V1[W]) + (F2 * V2[W]); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function MatrixDecompose(M: TMatrix; var Tran: TTransformations): Boolean; register; + +// Author: Spencer W. Thomas, University of Michigan +// +// MatrixDecompose - Decompose a non-degenerated 4x4 transformation matrix into +// the sequence of transformations that produced it. +// +// The coefficient of each transformation is returned in the corresponding +// element of the vector Tran. +// +// Returns true upon success, false if the matrix is singular. + +var I, J: Integer; + LocMat, + pmat, + invpmat, + tinvpmat: TMatrix; + prhs, + psol: TVector; + Row: array[0..2] of TAffineVector; + +begin + Result := False; + locmat := M; + // normalize the matrix + if locmat[W, W] = 0 then Exit; + for I := 0 to 3 do + for J := 0 to 3 do + locmat[I, J] := locmat[I, J] / locmat[W, W]; + + // pmat is used to solve for perspective, but it also provides + // an easy way to test for singularity of the upper 3x3 component. + + pmat := locmat; + for I := 0 to 2 do pmat[I, W] := 0; + pmat[W, W] := 1; + + if MatrixDeterminant(pmat) = 0 then Exit; + + // First, isolate perspective. This is the messiest. + if (locmat[X, W] <> 0) or + (locmat[Y, W] <> 0) or + (locmat[Z, W] <> 0) then + begin + // prhs is the right hand side of the equation. + prhs[X] := locmat[X, W]; + prhs[Y] := locmat[Y, W]; + prhs[Z] := locmat[Z, W]; + prhs[W] := locmat[W, W]; + + // Solve the equation by inverting pmat and multiplying + // prhs by the inverse. (This is the easiest way, not + // necessarily the best.) + + invpmat := pmat; + MatrixInvert(invpmat); + MatrixTranspose(invpmat); + psol := VectorTransform(prhs, tinvpmat); + + // stuff the answer away + Tran[ttPerspectiveX] := psol[X]; + Tran[ttPerspectiveY] := psol[Y]; + Tran[ttPerspectiveZ] := psol[Z]; + Tran[ttPerspectiveW] := psol[W]; + + // clear the perspective partition + locmat[X, W] := 0; + locmat[Y, W] := 0; + locmat[Z, W] := 0; + locmat[W, W] := 1; + end + else + begin + // no perspective + Tran[ttPerspectiveX] := 0; + Tran[ttPerspectiveY] := 0; + Tran[ttPerspectiveZ] := 0; + Tran[ttPerspectiveW] := 0; + end; + + // next take care of translation (easy) + for I := 0 to 2 do + begin + Tran[TTransType(Ord(ttTranslateX) + I)] := locmat[W, I]; + locmat[W, I] := 0; + end; + + // now get scale and shear + for I := 0 to 2 do + begin + row[I, X] := locmat[I, X]; + row[I, Y] := locmat[I, Y]; + row[I, Z] := locmat[I, Z]; + end; + + // compute X scale factor and normalize first row + Tran[ttScaleX] := Sqr(VectorNormalize(row[0])); // ml: calculation optimized + + // compute XY shear factor and make 2nd row orthogonal to 1st + Tran[ttShearXY] := VectorAffineDotProduct(row[0], row[1]); + row[1] := VectorAffineCombine(row[1], row[0], 1, -Tran[ttShearXY]); + + // now, compute Y scale and normalize 2nd row + Tran[ttScaleY] := Sqr(VectorNormalize(row[1])); // ml: calculation optimized + Tran[ttShearXY] := Tran[ttShearXY]/Tran[ttScaleY]; + + // compute XZ and YZ shears, orthogonalize 3rd row + Tran[ttShearXZ] := VectorAffineDotProduct(row[0], row[2]); + row[2] := VectorAffineCombine(row[2], row[0], 1, -Tran[ttShearXZ]); + Tran[ttShearYZ] := VectorAffineDotProduct(row[1], row[2]); + row[2] := VectorAffineCombine(row[2], row[1], 1, -Tran[ttShearYZ]); + + // next, get Z scale and normalize 3rd row + Tran[ttScaleZ] := Sqr(VectorNormalize(row[1])); // (ML) calc. optimized + Tran[ttShearXZ] := Tran[ttShearXZ] / tran[ttScaleZ]; + Tran[ttShearYZ] := Tran[ttShearYZ] / Tran[ttScaleZ]; + + // At this point, the matrix (in rows[]) is orthonormal. + // Check for a coordinate system flip. If the determinant + // is -1, then negate the matrix and the scaling factors. + if VectorAffineDotProduct(row[0], VectorCrossProduct(row[1], row[2])) < 0 then + for I := 0 to 2 do + begin + Tran[TTransType(Ord(ttScaleX) + I)] := -Tran[TTransType(Ord(ttScaleX) + I)]; + row[I, X] := -row[I, X]; + row[I, Y] := -row[I, Y]; + row[I, Z] := -row[I, Z]; + end; + + // now, get the rotations out, as described in the gem + Tran[ttRotateY] := arcsin(-row[0, Z]); + if cos(Tran[ttRotateY]) <> 0 then + begin + Tran[ttRotateX] := arctan2(row[1, Z], row[2, Z]); + Tran[ttRotateZ] := arctan2(row[0, Y], row[0, X]); + end + else + begin + tran[ttRotateX] := arctan2(row[1, X], row[1, Y]); + tran[ttRotateZ] := 0; + end; + // All done! + Result := True; +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function VectorDblToFlt(V: THomogeneousDblVector): THomogeneousVector; assembler; + +// converts a vector containing double sized values into a vector with single sized values + +asm + FLD QWORD PTR [EAX] + FSTP DWORD PTR [EDX] + FLD QWORD PTR [EAX + 8] + FSTP DWORD PTR [EDX + 4] + FLD QWORD PTR [EAX + 16] + FSTP DWORD PTR [EDX + 8] + FLD QWORD PTR [EAX + 24] + FSTP DWORD PTR [EDX + 12] +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function VectorAffineDblToFlt(V: TAffineDblVector): TAffineVector; assembler; + +// converts a vector containing double sized values into a vector with single sized values + +asm + FLD QWORD PTR [EAX] + FSTP DWORD PTR [EDX] + FLD QWORD PTR [EAX + 8] + FSTP DWORD PTR [EDX + 4] + FLD QWORD PTR [EAX + 16] + FSTP DWORD PTR [EDX + 8] +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function VectorAffineFltToDbl(V: TAffineVector): TAffineDblVector; assembler; + +// converts a vector containing single sized values into a vector with double sized values + +asm + FLD DWORD PTR [EAX] + FSTP QWORD PTR [EDX] + FLD DWORD PTR [EAX + 8] + FSTP QWORD PTR [EDX + 4] + FLD DWORD PTR [EAX + 16] + FSTP QWORD PTR [EDX + 8] +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function VectorFltToDbl(V: TVector): THomogeneousDblVector; assembler; + +// converts a vector containing single sized values into a vector with double sized values + +asm + FLD DWORD PTR [EAX] + FSTP QWORD PTR [EDX] + FLD DWORD PTR [EAX + 8] + FSTP QWORD PTR [EDX + 4] + FLD DWORD PTR [EAX + 16] + FSTP QWORD PTR [EDX + 8] + FLD DWORD PTR [EAX + 24] + FSTP QWORD PTR [EDX + 12] +end; + +//----------------- coordinate system manipulation functions ----------------------------------------------------------- + +function Turn(Matrix: TMatrix; Angle: Single): TMatrix; + +// rotates the given coordinate system (represented by the matrix) around its Y-axis + +begin + Result := MatrixMultiply(Matrix, CreateRotationMatrix(MakeAffineVector(Matrix[1]), Angle)); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function Turn(Matrix: TMatrix; MasterUp: TAffineVector; Angle: Single): TMatrix; + +// rotates the given coordinate system (represented by the matrix) around MasterUp + +begin + Result := MatrixMultiply(Matrix, CreateRotationMatrix(MasterUp, Angle)); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function Pitch(Matrix: TMatrix; Angle: Single): TMatrix; + +// rotates the given coordinate system (represented by the matrix) around its X-axis + +begin + Result := MatrixMultiply(Matrix, CreateRotationMatrix(MakeAffineVector(Matrix[0]), Angle)); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function Pitch(Matrix: TMatrix; MasterRight: TAffineVector; Angle: Single): TMatrix; overload; + +// rotates the given coordinate system (represented by the matrix) around MasterRight + +begin + Result := MatrixMultiply(Matrix, CreateRotationMatrix(MasterRight, Angle)); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function Roll(Matrix: TMatrix; Angle: Single): TMatrix; + +// rotates the given coordinate system (represented by the matrix) around its Z-axis + +begin + Result := MatrixMultiply(Matrix, CreateRotationMatrix(MakeAffineVector(Matrix[2]), Angle)); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +function Roll(Matrix: TMatrix; MasterDirection: TAffineVector; Angle: Single): TMatrix; overload; + +// rotates the given coordinate system (represented by the matrix) around MasterDirection + +begin + Result := MatrixMultiply(Matrix, CreateRotationMatrix(MasterDirection, Angle)); +end; + +//---------------------------------------------------------------------------------------------------------------------- + +end. + + diff --git a/Game/Code/lib/JEDI-SDL/OpenGL/Pas/gl.pas b/Game/Code/lib/JEDI-SDL/OpenGL/Pas/gl.pas index 5c5ec0da..2dc99df5 100644 --- a/Game/Code/lib/JEDI-SDL/OpenGL/Pas/gl.pas +++ b/Game/Code/lib/JEDI-SDL/OpenGL/Pas/gl.pas @@ -1,2301 +1,2301 @@ -unit gl;
-{
- $Id: gl.pas,v 1.5 2007/05/20 20:28:31 savage Exp $
-
- 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-96, Microsoft Corporation
-
-Module Name:
-
- gl.h
-
-Abstract:
-
- Procedure declarations, constant definitions and macros for the OpenGL
- component.
-
---*)
-
-(*
-** Copyright 1996 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.
-*)
-
-{******************************************************************************}
-{ }
-{ Converted to Delphi by Tom Nuydens (tom@delphi3d.net) }
-{ For the latest updates, visit Delphi3D: http://www.delphi3d.net }
-{ }
-{ Modified for Delphi/Kylix and FreePascal }
-{ by Dominique Louis ( Dominique@Savagesoftware.com.au) }
-{ For the latest updates, visit JEDI-SDL : http://www.sf.net/projects/jedi-sdl }
-{ }
-{******************************************************************************}
-
-{
- $Log: gl.pas,v $
- Revision 1.5 2007/05/20 20:28:31 savage
- Initial Changes to Handle 64 Bits
-
- Revision 1.4 2006/11/20 21:20:59 savage
- Updated to work in MacOS X
-
- Revision 1.3 2005/05/22 18:52:09 savage
- Changes as suggested by Michalis Kamburelis. Thanks again.
-
- Revision 1.2 2004/08/14 22:54:30 savage
- Updated so that Library name defines are correctly defined for MacOS X.
-
- Revision 1.1 2004/03/30 21:53:54 savage
- Moved to it's own folder.
-
- Revision 1.4 2004/02/20 17:09:55 savage
- Code tidied up in gl, glu and glut, while extensions in glext.pas are now loaded using SDL_GL_GetProcAddress, thus making it more cross-platform compatible, but now more tied to SDL.
-
- Revision 1.3 2004/02/14 00:23:39 savage
- As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change.
-
- Revision 1.2 2004/02/14 00:09:18 savage
- Changed uses to now make use of moduleloader.pas rather than dllfuncs.pas
-
- Revision 1.1 2004/02/05 00:08:19 savage
- Module 1.0 release
-
- Revision 1.6 2003/06/02 12:32:12 savage
- Modified Sources to avoid warnings with Delphi by moving CVS Logging to the top of the header files. Hopefully CVS Logging still works.
-
-}
-
-interface
-
-{$I jedi-sdl.inc}
-
-uses
-{$IFDEF __GPC__}
- system,
- gpc,
-{$ENDIF}
-
-{$IFDEF WINDOWS}
- Windows,
-{$ENDIF}
- moduleloader;
-
-
-var
- LibGL: TModuleHandle;
-
-type
- GLenum = Cardinal; PGLenum = ^GLenum;
- GLboolean = Byte; PGLboolean = ^GLboolean;
- GLbitfield = Cardinal; PGLbitfield = ^GLbitfield;
- GLbyte = ShortInt; PGLbyte = ^GLbyte;
- GLshort = SmallInt; PGLshort = ^GLshort;
- GLint = Integer; PGLint = ^GLint;
- GLsizei = Integer; PGLsizei = ^GLsizei;
- GLubyte = Byte; PGLubyte = ^GLubyte;
- GLushort = Word; PGLushort = ^GLushort;
- GLuint = Cardinal; PGLuint = ^GLuint;
- GLfloat = Single; PGLfloat = ^GLfloat;
- GLclampf = Single; PGLclampf = ^GLclampf;
- GLdouble = Double; PGLdouble = ^GLdouble;
- GLclampd = Double; PGLclampd = ^GLclampd;
-{ GLvoid = void; } PGLvoid = Pointer;
-
-{******************************************************************************}
-
-const
-{$IFDEF WINDOWS}
- GLLibName = 'OpenGL32.dll';
-{$ENDIF}
-
-{$IFDEF UNIX}
-{$IFDEF DARWIN}
- GLLibName = '/System/Library/Frameworks/OpenGL.framework/Libraries/libGL.dylib';
-{$ELSE}
- GLLibName = 'libGL.so';
-{$ENDIF}
-{$ENDIF}
-
- // Version
- GL_VERSION_1_1 = 1;
-
- // AccumOp
- GL_ACCUM = $0100;
- GL_LOAD = $0101;
- GL_RETURN = $0102;
- GL_MULT = $0103;
- GL_ADD = $0104;
-
- // AlphaFunction
- GL_NEVER = $0200;
- GL_LESS = $0201;
- GL_EQUAL = $0202;
- GL_LEQUAL = $0203;
- GL_GREATER = $0204;
- GL_NOTEQUAL = $0205;
- GL_GEQUAL = $0206;
- GL_ALWAYS = $0207;
-
- // AttribMask
- GL_CURRENT_BIT = $00000001;
- GL_POINT_BIT = $00000002;
- GL_LINE_BIT = $00000004;
- GL_POLYGON_BIT = $00000008;
- GL_POLYGON_STIPPLE_BIT = $00000010;
- GL_PIXEL_MODE_BIT = $00000020;
- GL_LIGHTING_BIT = $00000040;
- GL_FOG_BIT = $00000080;
- GL_DEPTH_BUFFER_BIT = $00000100;
- GL_ACCUM_BUFFER_BIT = $00000200;
- GL_STENCIL_BUFFER_BIT = $00000400;
- GL_VIEWPORT_BIT = $00000800;
- GL_TRANSFORM_BIT = $00001000;
- GL_ENABLE_BIT = $00002000;
- GL_COLOR_BUFFER_BIT = $00004000;
- GL_HINT_BIT = $00008000;
- GL_EVAL_BIT = $00010000;
- GL_LIST_BIT = $00020000;
- GL_TEXTURE_BIT = $00040000;
- GL_SCISSOR_BIT = $00080000;
- GL_ALL_ATTRIB_BITS = $000FFFFF;
-
- // BeginMode
- GL_POINTS = $0000;
- GL_LINES = $0001;
- GL_LINE_LOOP = $0002;
- GL_LINE_STRIP = $0003;
- GL_TRIANGLES = $0004;
- GL_TRIANGLE_STRIP = $0005;
- GL_TRIANGLE_FAN = $0006;
- GL_QUADS = $0007;
- GL_QUAD_STRIP = $0008;
- GL_POLYGON = $0009;
-
- // BlendingFactorDest
- GL_ZERO = 0;
- GL_ONE = 1;
- GL_SRC_COLOR = $0300;
- GL_ONE_MINUS_SRC_COLOR = $0301;
- GL_SRC_ALPHA = $0302;
- GL_ONE_MINUS_SRC_ALPHA = $0303;
- GL_DST_ALPHA = $0304;
- GL_ONE_MINUS_DST_ALPHA = $0305;
-
- // BlendingFactorSrc
- // GL_ZERO
- // GL_ONE
- GL_DST_COLOR = $0306;
- GL_ONE_MINUS_DST_COLOR = $0307;
- GL_SRC_ALPHA_SATURATE = $0308;
- // GL_SRC_ALPHA
- // GL_ONE_MINUS_SRC_ALPHA
- // GL_DST_ALPHA
- // GL_ONE_MINUS_DST_ALPHA
-
- // Boolean
- GL_TRUE = 1;
- GL_FALSE = 0;
-
- // ClearBufferMask
- // GL_COLOR_BUFFER_BIT
- // GL_ACCUM_BUFFER_BIT
- // GL_STENCIL_BUFFER_BIT
- // GL_DEPTH_BUFFER_BIT
-
- // ClientArrayType
- // GL_VERTEX_ARRAY
- // GL_NORMAL_ARRAY
- // GL_COLOR_ARRAY
- // GL_INDEX_ARRAY
- // GL_TEXTURE_COORD_ARRAY
- // GL_EDGE_FLAG_ARRAY
-
- // ClipPlaneName
- GL_CLIP_PLANE0 = $3000;
- GL_CLIP_PLANE1 = $3001;
- GL_CLIP_PLANE2 = $3002;
- GL_CLIP_PLANE3 = $3003;
- GL_CLIP_PLANE4 = $3004;
- GL_CLIP_PLANE5 = $3005;
-
- // ColorMaterialFace
- // GL_FRONT
- // GL_BACK
- // GL_FRONT_AND_BACK
-
- // ColorMaterialParameter
- // GL_AMBIENT
- // GL_DIFFUSE
- // GL_SPECULAR
- // GL_EMISSION
- // GL_AMBIENT_AND_DIFFUSE
-
- // ColorPointerType
- // GL_BYTE
- // GL_UNSIGNED_BYTE
- // GL_SHORT
- // GL_UNSIGNED_SHORT
- // GL_INT
- // GL_UNSIGNED_INT
- // GL_FLOAT
- // GL_DOUBLE
-
- // CullFaceMode
- // GL_FRONT
- // GL_BACK
- // GL_FRONT_AND_BACK
-
- // DataType
- GL_BYTE = $1400;
- GL_UNSIGNED_BYTE = $1401;
- GL_SHORT = $1402;
- GL_UNSIGNED_SHORT = $1403;
- GL_INT = $1404;
- GL_UNSIGNED_INT = $1405;
- GL_FLOAT = $1406;
- GL_2_BYTES = $1407;
- GL_3_BYTES = $1408;
- GL_4_BYTES = $1409;
- GL_DOUBLE = $140A;
-
- // DepthFunction
- // GL_NEVER
- // GL_LESS
- // GL_EQUAL
- // GL_LEQUAL
- // GL_GREATER
- // GL_NOTEQUAL
- // GL_GEQUAL
- // GL_ALWAYS
-
- // DrawBufferMode
- GL_NONE = 0;
- GL_FRONT_LEFT = $0400;
- GL_FRONT_RIGHT = $0401;
- GL_BACK_LEFT = $0402;
- GL_BACK_RIGHT = $0403;
- GL_FRONT = $0404;
- GL_BACK = $0405;
- GL_LEFT = $0406;
- GL_RIGHT = $0407;
- GL_FRONT_AND_BACK = $0408;
- GL_AUX0 = $0409;
- GL_AUX1 = $040A;
- GL_AUX2 = $040B;
- GL_AUX3 = $040C;
-
- // Enable
- // GL_FOG
- // GL_LIGHTING
- // GL_TEXTURE_1D
- // GL_TEXTURE_2D
- // GL_LINE_STIPPLE
- // GL_POLYGON_STIPPLE
- // GL_CULL_FACE
- // GL_ALPHA_TEST
- // GL_BLEND
- // GL_INDEX_LOGIC_OP
- // GL_COLOR_LOGIC_OP
- // GL_DITHER
- // GL_STENCIL_TEST
- // GL_DEPTH_TEST
- // GL_CLIP_PLANE0
- // GL_CLIP_PLANE1
- // GL_CLIP_PLANE2
- // GL_CLIP_PLANE3
- // GL_CLIP_PLANE4
- // GL_CLIP_PLANE5
- // GL_LIGHT0
- // GL_LIGHT1
- // GL_LIGHT2
- // GL_LIGHT3
- // GL_LIGHT4
- // GL_LIGHT5
- // GL_LIGHT6
- // GL_LIGHT7
- // GL_TEXTURE_GEN_S
- // GL_TEXTURE_GEN_T
- // GL_TEXTURE_GEN_R
- // GL_TEXTURE_GEN_Q
- // GL_MAP1_VERTEX_3
- // GL_MAP1_VERTEX_4
- // GL_MAP1_COLOR_4
- // GL_MAP1_INDEX
- // GL_MAP1_NORMAL
- // GL_MAP1_TEXTURE_COORD_1
- // GL_MAP1_TEXTURE_COORD_2
- // GL_MAP1_TEXTURE_COORD_3
- // GL_MAP1_TEXTURE_COORD_4
- // GL_MAP2_VERTEX_3
- // GL_MAP2_VERTEX_4
- // GL_MAP2_COLOR_4
- // GL_MAP2_INDEX
- // GL_MAP2_NORMAL
- // GL_MAP2_TEXTURE_COORD_1
- // GL_MAP2_TEXTURE_COORD_2
- // GL_MAP2_TEXTURE_COORD_3
- // GL_MAP2_TEXTURE_COORD_4
- // GL_POINT_SMOOTH
- // GL_LINE_SMOOTH
- // GL_POLYGON_SMOOTH
- // GL_SCISSOR_TEST
- // GL_COLOR_MATERIAL
- // GL_NORMALIZE
- // GL_AUTO_NORMAL
- // GL_VERTEX_ARRAY
- // GL_NORMAL_ARRAY
- // GL_COLOR_ARRAY
- // GL_INDEX_ARRAY
- // GL_TEXTURE_COORD_ARRAY
- // GL_EDGE_FLAG_ARRAY
- // GL_POLYGON_OFFSET_POINT
- // GL_POLYGON_OFFSET_LINE
- // GL_POLYGON_OFFSET_FILL
-
- // ErrorCode
- GL_NO_ERROR = 0;
- GL_INVALID_ENUM = $0500;
- GL_INVALID_VALUE = $0501;
- GL_INVALID_OPERATION = $0502;
- GL_STACK_OVERFLOW = $0503;
- GL_STACK_UNDERFLOW = $0504;
- GL_OUT_OF_MEMORY = $0505;
-
- // FeedBackMode
- GL_2D = $0600;
- GL_3D = $0601;
- GL_3D_COLOR = $0602;
- GL_3D_COLOR_TEXTURE = $0603;
- GL_4D_COLOR_TEXTURE = $0604;
-
- // FeedBackToken
- GL_PASS_THROUGH_TOKEN = $0700;
- GL_POINT_TOKEN = $0701;
- GL_LINE_TOKEN = $0702;
- GL_POLYGON_TOKEN = $0703;
- GL_BITMAP_TOKEN = $0704;
- GL_DRAW_PIXEL_TOKEN = $0705;
- GL_COPY_PIXEL_TOKEN = $0706;
- GL_LINE_RESET_TOKEN = $0707;
-
- // FogMode
- // GL_LINEAR
- GL_EXP = $0800;
- GL_EXP2 = $0801;
-
- // FogParameter
- // GL_FOG_COLOR
- // GL_FOG_DENSITY
- // GL_FOG_END
- // GL_FOG_INDEX
- // GL_FOG_MODE
- // GL_FOG_START
-
- // FrontFaceDirection
- GL_CW = $0900;
- GL_CCW = $0901;
-
- // GetMapTarget
- GL_COEFF = $0A00;
- GL_ORDER = $0A01;
- GL_DOMAIN = $0A02;
-
- // GetPixelMap
- // GL_PIXEL_MAP_I_TO_I
- // GL_PIXEL_MAP_S_TO_S
- // GL_PIXEL_MAP_I_TO_R
- // GL_PIXEL_MAP_I_TO_G
- // GL_PIXEL_MAP_I_TO_B
- // GL_PIXEL_MAP_I_TO_A
- // GL_PIXEL_MAP_R_TO_R
- // GL_PIXEL_MAP_G_TO_G
- // GL_PIXEL_MAP_B_TO_B
- // GL_PIXEL_MAP_A_TO_A
-
- // GetPointerTarget
- // GL_VERTEX_ARRAY_POINTER
- // GL_NORMAL_ARRAY_POINTER
- // GL_COLOR_ARRAY_POINTER
- // GL_INDEX_ARRAY_POINTER
- // GL_TEXTURE_COORD_ARRAY_POINTER
- // GL_EDGE_FLAG_ARRAY_POINTER
-
- // GetTarget
- GL_CURRENT_COLOR = $0B00;
- GL_CURRENT_INDEX = $0B01;
- GL_CURRENT_NORMAL = $0B02;
- GL_CURRENT_TEXTURE_COORDS = $0B03;
- GL_CURRENT_RASTER_COLOR = $0B04;
- GL_CURRENT_RASTER_INDEX = $0B05;
- GL_CURRENT_RASTER_TEXTURE_COORDS = $0B06;
- GL_CURRENT_RASTER_POSITION = $0B07;
- GL_CURRENT_RASTER_POSITION_VALID = $0B08;
- GL_CURRENT_RASTER_DISTANCE = $0B09;
- GL_POINT_SMOOTH = $0B10;
- GL_POINT_SIZE = $0B11;
- GL_POINT_SIZE_RANGE = $0B12;
- GL_POINT_SIZE_GRANULARITY = $0B13;
- GL_LINE_SMOOTH = $0B20;
- GL_LINE_WIDTH = $0B21;
- GL_LINE_WIDTH_RANGE = $0B22;
- GL_LINE_WIDTH_GRANULARITY = $0B23;
- GL_LINE_STIPPLE = $0B24;
- GL_LINE_STIPPLE_PATTERN = $0B25;
- GL_LINE_STIPPLE_REPEAT = $0B26;
- GL_LIST_MODE = $0B30;
- GL_MAX_LIST_NESTING = $0B31;
- GL_LIST_BASE = $0B32;
- GL_LIST_INDEX = $0B33;
- GL_POLYGON_MODE = $0B40;
- GL_POLYGON_SMOOTH = $0B41;
- GL_POLYGON_STIPPLE = $0B42;
- GL_EDGE_FLAG = $0B43;
- GL_CULL_FACE = $0B44;
- GL_CULL_FACE_MODE = $0B45;
- GL_FRONT_FACE = $0B46;
- GL_LIGHTING = $0B50;
- GL_LIGHT_MODEL_LOCAL_VIEWER = $0B51;
- GL_LIGHT_MODEL_TWO_SIDE = $0B52;
- GL_LIGHT_MODEL_AMBIENT = $0B53;
- GL_SHADE_MODEL = $0B54;
- GL_COLOR_MATERIAL_FACE = $0B55;
- GL_COLOR_MATERIAL_PARAMETER = $0B56;
- GL_COLOR_MATERIAL = $0B57;
- GL_FOG = $0B60;
- GL_FOG_INDEX = $0B61;
- GL_FOG_DENSITY = $0B62;
- GL_FOG_START = $0B63;
- GL_FOG_END = $0B64;
- GL_FOG_MODE = $0B65;
- GL_FOG_COLOR = $0B66;
- GL_DEPTH_RANGE = $0B70;
- GL_DEPTH_TEST = $0B71;
- GL_DEPTH_WRITEMASK = $0B72;
- GL_DEPTH_CLEAR_VALUE = $0B73;
- GL_DEPTH_FUNC = $0B74;
- GL_ACCUM_CLEAR_VALUE = $0B80;
- GL_STENCIL_TEST = $0B90;
- GL_STENCIL_CLEAR_VALUE = $0B91;
- GL_STENCIL_FUNC = $0B92;
- GL_STENCIL_VALUE_MASK = $0B93;
- GL_STENCIL_FAIL = $0B94;
- GL_STENCIL_PASS_DEPTH_FAIL = $0B95;
- GL_STENCIL_PASS_DEPTH_PASS = $0B96;
- GL_STENCIL_REF = $0B97;
- GL_STENCIL_WRITEMASK = $0B98;
- GL_MATRIX_MODE = $0BA0;
- GL_NORMALIZE = $0BA1;
- GL_VIEWPORT = $0BA2;
- GL_MODELVIEW_STACK_DEPTH = $0BA3;
- GL_PROJECTION_STACK_DEPTH = $0BA4;
- GL_TEXTURE_STACK_DEPTH = $0BA5;
- GL_MODELVIEW_MATRIX = $0BA6;
- GL_PROJECTION_MATRIX = $0BA7;
- GL_TEXTURE_MATRIX = $0BA8;
- GL_ATTRIB_STACK_DEPTH = $0BB0;
- GL_CLIENT_ATTRIB_STACK_DEPTH = $0BB1;
- GL_ALPHA_TEST = $0BC0;
- GL_ALPHA_TEST_FUNC = $0BC1;
- GL_ALPHA_TEST_REF = $0BC2;
- GL_DITHER = $0BD0;
- GL_BLEND_DST = $0BE0;
- GL_BLEND_SRC = $0BE1;
- GL_BLEND = $0BE2;
- GL_LOGIC_OP_MODE = $0BF0;
- GL_INDEX_LOGIC_OP = $0BF1;
- GL_COLOR_LOGIC_OP = $0BF2;
- GL_AUX_BUFFERS = $0C00;
- GL_DRAW_BUFFER = $0C01;
- GL_READ_BUFFER = $0C02;
- GL_SCISSOR_BOX = $0C10;
- GL_SCISSOR_TEST = $0C11;
- GL_INDEX_CLEAR_VALUE = $0C20;
- GL_INDEX_WRITEMASK = $0C21;
- GL_COLOR_CLEAR_VALUE = $0C22;
- GL_COLOR_WRITEMASK = $0C23;
- GL_INDEX_MODE = $0C30;
- GL_RGBA_MODE = $0C31;
- GL_DOUBLEBUFFER = $0C32;
- GL_STEREO = $0C33;
- GL_RENDER_MODE = $0C40;
- GL_PERSPECTIVE_CORRECTION_HINT = $0C50;
- GL_POINT_SMOOTH_HINT = $0C51;
- GL_LINE_SMOOTH_HINT = $0C52;
- GL_POLYGON_SMOOTH_HINT = $0C53;
- GL_FOG_HINT = $0C54;
- GL_TEXTURE_GEN_S = $0C60;
- GL_TEXTURE_GEN_T = $0C61;
- GL_TEXTURE_GEN_R = $0C62;
- GL_TEXTURE_GEN_Q = $0C63;
- GL_PIXEL_MAP_I_TO_I = $0C70;
- GL_PIXEL_MAP_S_TO_S = $0C71;
- GL_PIXEL_MAP_I_TO_R = $0C72;
- GL_PIXEL_MAP_I_TO_G = $0C73;
- GL_PIXEL_MAP_I_TO_B = $0C74;
- GL_PIXEL_MAP_I_TO_A = $0C75;
- GL_PIXEL_MAP_R_TO_R = $0C76;
- GL_PIXEL_MAP_G_TO_G = $0C77;
- GL_PIXEL_MAP_B_TO_B = $0C78;
- GL_PIXEL_MAP_A_TO_A = $0C79;
- GL_PIXEL_MAP_I_TO_I_SIZE = $0CB0;
- GL_PIXEL_MAP_S_TO_S_SIZE = $0CB1;
- GL_PIXEL_MAP_I_TO_R_SIZE = $0CB2;
- GL_PIXEL_MAP_I_TO_G_SIZE = $0CB3;
- GL_PIXEL_MAP_I_TO_B_SIZE = $0CB4;
- GL_PIXEL_MAP_I_TO_A_SIZE = $0CB5;
- GL_PIXEL_MAP_R_TO_R_SIZE = $0CB6;
- GL_PIXEL_MAP_G_TO_G_SIZE = $0CB7;
- GL_PIXEL_MAP_B_TO_B_SIZE = $0CB8;
- GL_PIXEL_MAP_A_TO_A_SIZE = $0CB9;
- GL_UNPACK_SWAP_BYTES = $0CF0;
- GL_UNPACK_LSB_FIRST = $0CF1;
- GL_UNPACK_ROW_LENGTH = $0CF2;
- GL_UNPACK_SKIP_ROWS = $0CF3;
- GL_UNPACK_SKIP_PIXELS = $0CF4;
- GL_UNPACK_ALIGNMENT = $0CF5;
- GL_PACK_SWAP_BYTES = $0D00;
- GL_PACK_LSB_FIRST = $0D01;
- GL_PACK_ROW_LENGTH = $0D02;
- GL_PACK_SKIP_ROWS = $0D03;
- GL_PACK_SKIP_PIXELS = $0D04;
- GL_PACK_ALIGNMENT = $0D05;
- GL_MAP_COLOR = $0D10;
- GL_MAP_STENCIL = $0D11;
- GL_INDEX_SHIFT = $0D12;
- GL_INDEX_OFFSET = $0D13;
- GL_RED_SCALE = $0D14;
- GL_RED_BIAS = $0D15;
- GL_ZOOM_X = $0D16;
- GL_ZOOM_Y = $0D17;
- GL_GREEN_SCALE = $0D18;
- GL_GREEN_BIAS = $0D19;
- GL_BLUE_SCALE = $0D1A;
- GL_BLUE_BIAS = $0D1B;
- GL_ALPHA_SCALE = $0D1C;
- GL_ALPHA_BIAS = $0D1D;
- GL_DEPTH_SCALE = $0D1E;
- GL_DEPTH_BIAS = $0D1F;
- GL_MAX_EVAL_ORDER = $0D30;
- GL_MAX_LIGHTS = $0D31;
- GL_MAX_CLIP_PLANES = $0D32;
- GL_MAX_TEXTURE_SIZE = $0D33;
- GL_MAX_PIXEL_MAP_TABLE = $0D34;
- GL_MAX_ATTRIB_STACK_DEPTH = $0D35;
- GL_MAX_MODELVIEW_STACK_DEPTH = $0D36;
- GL_MAX_NAME_STACK_DEPTH = $0D37;
- GL_MAX_PROJECTION_STACK_DEPTH = $0D38;
- GL_MAX_TEXTURE_STACK_DEPTH = $0D39;
- GL_MAX_VIEWPORT_DIMS = $0D3A;
- GL_MAX_CLIENT_ATTRIB_STACK_DEPTH = $0D3B;
- GL_SUBPIXEL_BITS = $0D50;
- GL_INDEX_BITS = $0D51;
- GL_RED_BITS = $0D52;
- GL_GREEN_BITS = $0D53;
- GL_BLUE_BITS = $0D54;
- GL_ALPHA_BITS = $0D55;
- GL_DEPTH_BITS = $0D56;
- GL_STENCIL_BITS = $0D57;
- GL_ACCUM_RED_BITS = $0D58;
- GL_ACCUM_GREEN_BITS = $0D59;
- GL_ACCUM_BLUE_BITS = $0D5A;
- GL_ACCUM_ALPHA_BITS = $0D5B;
- GL_NAME_STACK_DEPTH = $0D70;
- GL_AUTO_NORMAL = $0D80;
- GL_MAP1_COLOR_4 = $0D90;
- GL_MAP1_INDEX = $0D91;
- GL_MAP1_NORMAL = $0D92;
- GL_MAP1_TEXTURE_COORD_1 = $0D93;
- GL_MAP1_TEXTURE_COORD_2 = $0D94;
- GL_MAP1_TEXTURE_COORD_3 = $0D95;
- GL_MAP1_TEXTURE_COORD_4 = $0D96;
- GL_MAP1_VERTEX_3 = $0D97;
- GL_MAP1_VERTEX_4 = $0D98;
- GL_MAP2_COLOR_4 = $0DB0;
- GL_MAP2_INDEX = $0DB1;
- GL_MAP2_NORMAL = $0DB2;
- GL_MAP2_TEXTURE_COORD_1 = $0DB3;
- GL_MAP2_TEXTURE_COORD_2 = $0DB4;
- GL_MAP2_TEXTURE_COORD_3 = $0DB5;
- GL_MAP2_TEXTURE_COORD_4 = $0DB6;
- GL_MAP2_VERTEX_3 = $0DB7;
- GL_MAP2_VERTEX_4 = $0DB8;
- GL_MAP1_GRID_DOMAIN = $0DD0;
- GL_MAP1_GRID_SEGMENTS = $0DD1;
- GL_MAP2_GRID_DOMAIN = $0DD2;
- GL_MAP2_GRID_SEGMENTS = $0DD3;
- GL_TEXTURE_1D = $0DE0;
- GL_TEXTURE_2D = $0DE1;
- GL_FEEDBACK_BUFFER_POINTER = $0DF0;
- GL_FEEDBACK_BUFFER_SIZE = $0DF1;
- GL_FEEDBACK_BUFFER_TYPE = $0DF2;
- GL_SELECTION_BUFFER_POINTER = $0DF3;
- GL_SELECTION_BUFFER_SIZE = $0DF4;
- // GL_TEXTURE_BINDING_1D
- // GL_TEXTURE_BINDING_2D
- // GL_VERTEX_ARRAY
- // GL_NORMAL_ARRAY
- // GL_COLOR_ARRAY
- // GL_INDEX_ARRAY
- // GL_TEXTURE_COORD_ARRAY
- // GL_EDGE_FLAG_ARRAY
- // GL_VERTEX_ARRAY_SIZE
- // GL_VERTEX_ARRAY_TYPE
- // GL_VERTEX_ARRAY_STRIDE
- // GL_NORMAL_ARRAY_TYPE
- // GL_NORMAL_ARRAY_STRIDE
- // GL_COLOR_ARRAY_SIZE
- // GL_COLOR_ARRAY_TYPE
- // GL_COLOR_ARRAY_STRIDE
- // GL_INDEX_ARRAY_TYPE
- // GL_INDEX_ARRAY_STRIDE
- // GL_TEXTURE_COORD_ARRAY_SIZE
- // GL_TEXTURE_COORD_ARRAY_TYPE
- // GL_TEXTURE_COORD_ARRAY_STRIDE
- // GL_EDGE_FLAG_ARRAY_STRIDE
- // GL_POLYGON_OFFSET_FACTOR
- // GL_POLYGON_OFFSET_UNITS
-
- // GetTextureParameter
- // GL_TEXTURE_MAG_FILTER
- // GL_TEXTURE_MIN_FILTER
- // GL_TEXTURE_WRAP_S
- // GL_TEXTURE_WRAP_T
- GL_TEXTURE_WIDTH = $1000;
- GL_TEXTURE_HEIGHT = $1001;
- GL_TEXTURE_INTERNAL_FORMAT = $1003;
- GL_TEXTURE_BORDER_COLOR = $1004;
- GL_TEXTURE_BORDER = $1005;
- // GL_TEXTURE_RED_SIZE
- // GL_TEXTURE_GREEN_SIZE
- // GL_TEXTURE_BLUE_SIZE
- // GL_TEXTURE_ALPHA_SIZE
- // GL_TEXTURE_LUMINANCE_SIZE
- // GL_TEXTURE_INTENSITY_SIZE
- // GL_TEXTURE_PRIORITY
- // GL_TEXTURE_RESIDENT
-
- // HintMode
- GL_DONT_CARE = $1100;
- GL_FASTEST = $1101;
- GL_NICEST = $1102;
-
- // HintTarget
- // GL_PERSPECTIVE_CORRECTION_HINT
- // GL_POINT_SMOOTH_HINT
- // GL_LINE_SMOOTH_HINT
- // GL_POLYGON_SMOOTH_HINT
- // GL_FOG_HINT
-
- // IndexPointerType
- // GL_SHORT
- // GL_INT
- // GL_FLOAT
- // GL_DOUBLE
-
- // LightModelParameter
- // GL_LIGHT_MODEL_AMBIENT
- // GL_LIGHT_MODEL_LOCAL_VIEWER
- // GL_LIGHT_MODEL_TWO_SIDE
-
- // LightName
- GL_LIGHT0 = $4000;
- GL_LIGHT1 = $4001;
- GL_LIGHT2 = $4002;
- GL_LIGHT3 = $4003;
- GL_LIGHT4 = $4004;
- GL_LIGHT5 = $4005;
- GL_LIGHT6 = $4006;
- GL_LIGHT7 = $4007;
-
- // LightParameter
- GL_AMBIENT = $1200;
- GL_DIFFUSE = $1201;
- GL_SPECULAR = $1202;
- GL_POSITION = $1203;
- GL_SPOT_DIRECTION = $1204;
- GL_SPOT_EXPONENT = $1205;
- GL_SPOT_CUTOFF = $1206;
- GL_CONSTANT_ATTENUATION = $1207;
- GL_LINEAR_ATTENUATION = $1208;
- GL_QUADRATIC_ATTENUATION = $1209;
-
- // InterleavedArrays
- // GL_V2F
- // GL_V3F
- // GL_C4UB_V2F
- // GL_C4UB_V3F
- // GL_C3F_V3F
- // GL_N3F_V3F
- // GL_C4F_N3F_V3F
- // GL_T2F_V3F
- // GL_T4F_V4F
- // GL_T2F_C4UB_V3F
- // GL_T2F_C3F_V3F
- // GL_T2F_N3F_V3F
- // GL_T2F_C4F_N3F_V3F
- // GL_T4F_C4F_N3F_V4F
-
- // ListMode
- GL_COMPILE = $1300;
- GL_COMPILE_AND_EXECUTE = $1301;
-
- // ListNameType
- // GL_BYTE
- // GL_UNSIGNED_BYTE
- // GL_SHORT
- // GL_UNSIGNED_SHORT
- // GL_INT
- // GL_UNSIGNED_INT
- // GL_FLOAT
- // GL_2_BYTES
- // GL_3_BYTES
- // GL_4_BYTES
-
- // LogicOp
- GL_CLEAR = $1500;
- GL_AND = $1501;
- GL_AND_REVERSE = $1502;
- GL_COPY = $1503;
- GL_AND_INVERTED = $1504;
- GL_NOOP = $1505;
- GL_XOR = $1506;
- GL_OR = $1507;
- GL_NOR = $1508;
- GL_EQUIV = $1509;
- GL_INVERT = $150A;
- GL_OR_REVERSE = $150B;
- GL_COPY_INVERTED = $150C;
- GL_OR_INVERTED = $150D;
- GL_NAND = $150E;
- GL_SET = $150F;
-
- // MapTarget
- // GL_MAP1_COLOR_4
- // GL_MAP1_INDEX
- // GL_MAP1_NORMAL
- // GL_MAP1_TEXTURE_COORD_1
- // GL_MAP1_TEXTURE_COORD_2
- // GL_MAP1_TEXTURE_COORD_3
- // GL_MAP1_TEXTURE_COORD_4
- // GL_MAP1_VERTEX_3
- // GL_MAP1_VERTEX_4
- // GL_MAP2_COLOR_4
- // GL_MAP2_INDEX
- // GL_MAP2_NORMAL
- // GL_MAP2_TEXTURE_COORD_1
- // GL_MAP2_TEXTURE_COORD_2
- // GL_MAP2_TEXTURE_COORD_3
- // GL_MAP2_TEXTURE_COORD_4
- // GL_MAP2_VERTEX_3
- // GL_MAP2_VERTEX_4
-
- // MaterialFace
- // GL_FRONT
- // GL_BACK
- // GL_FRONT_AND_BACK
-
- // MaterialParameter
- GL_EMISSION = $1600;
- GL_SHININESS = $1601;
- GL_AMBIENT_AND_DIFFUSE = $1602;
- GL_COLOR_INDEXES = $1603;
- // GL_AMBIENT
- // GL_DIFFUSE
- // GL_SPECULAR
-
- // MatrixMode
- GL_MODELVIEW = $1700;
- GL_PROJECTION = $1701;
- GL_TEXTURE = $1702;
-
- // MeshMode1
- // GL_POINT
- // GL_LINE
-
- // MeshMode2
- // GL_POINT
- // GL_LINE
- // GL_FILL
-
- // NormalPointerType
- // GL_BYTE
- // GL_SHORT
- // GL_INT
- // GL_FLOAT
- // GL_DOUBLE
-
- // PixelCopyType
- GL_COLOR = $1800;
- GL_DEPTH = $1801;
- GL_STENCIL = $1802;
-
- // PixelFormat
- GL_COLOR_INDEX = $1900;
- GL_STENCIL_INDEX = $1901;
- GL_DEPTH_COMPONENT = $1902;
- GL_RED = $1903;
- GL_GREEN = $1904;
- GL_BLUE = $1905;
- GL_ALPHA = $1906;
- GL_RGB = $1907;
- GL_RGBA = $1908;
- GL_LUMINANCE = $1909;
- GL_LUMINANCE_ALPHA = $190A;
-
- // PixelMap
- // GL_PIXEL_MAP_I_TO_I
- // GL_PIXEL_MAP_S_TO_S
- // GL_PIXEL_MAP_I_TO_R
- // GL_PIXEL_MAP_I_TO_G
- // GL_PIXEL_MAP_I_TO_B
- // GL_PIXEL_MAP_I_TO_A
- // GL_PIXEL_MAP_R_TO_R
- // GL_PIXEL_MAP_G_TO_G
- // GL_PIXEL_MAP_B_TO_B
- // GL_PIXEL_MAP_A_TO_A
-
- // PixelStore
- // GL_UNPACK_SWAP_BYTES
- // GL_UNPACK_LSB_FIRST
- // GL_UNPACK_ROW_LENGTH
- // GL_UNPACK_SKIP_ROWS
- // GL_UNPACK_SKIP_PIXELS
- // GL_UNPACK_ALIGNMENT
- // GL_PACK_SWAP_BYTES
- // GL_PACK_LSB_FIRST
- // GL_PACK_ROW_LENGTH
- // GL_PACK_SKIP_ROWS
- // GL_PACK_SKIP_PIXELS
- // GL_PACK_ALIGNMENT
-
- // PixelTransfer
- // GL_MAP_COLOR
- // GL_MAP_STENCIL
- // GL_INDEX_SHIFT
- // GL_INDEX_OFFSET
- // GL_RED_SCALE
- // GL_RED_BIAS
- // GL_GREEN_SCALE
- // GL_GREEN_BIAS
- // GL_BLUE_SCALE
- // GL_BLUE_BIAS
- // GL_ALPHA_SCALE
- // GL_ALPHA_BIAS
- // GL_DEPTH_SCALE
- // GL_DEPTH_BIAS
-
- // PixelType
- GL_BITMAP = $1A00;
- // GL_BYTE
- // GL_UNSIGNED_BYTE
- // GL_SHORT
- // GL_UNSIGNED_SHORT
- // GL_INT
- // GL_UNSIGNED_INT
- // GL_FLOAT
-
- // PolygonMode
- GL_POINT = $1B00;
- GL_LINE = $1B01;
- GL_FILL = $1B02;
-
- // ReadBufferMode
- // GL_FRONT_LEFT
- // GL_FRONT_RIGHT
- // GL_BACK_LEFT
- // GL_BACK_RIGHT
- // GL_FRONT
- // GL_BACK
- // GL_LEFT
- // GL_RIGHT
- // GL_AUX0
- // GL_AUX1
- // GL_AUX2
- // GL_AUX3
-
- // RenderingMode
- GL_RENDER = $1C00;
- GL_FEEDBACK = $1C01;
- GL_SELECT = $1C02;
-
- // ShadingModel
- GL_FLAT = $1D00;
- GL_SMOOTH = $1D01;
-
- // StencilFunction
- // GL_NEVER
- // GL_LESS
- // GL_EQUAL
- // GL_LEQUAL
- // GL_GREATER
- // GL_NOTEQUAL
- // GL_GEQUAL
- // GL_ALWAYS
-
- // StencilOp
- // GL_ZERO
- GL_KEEP = $1E00;
- GL_REPLACE = $1E01;
- GL_INCR = $1E02;
- GL_DECR = $1E03;
- // GL_INVERT
-
- // StringName
- GL_VENDOR = $1F00;
- GL_RENDERER = $1F01;
- GL_VERSION = $1F02;
- GL_EXTENSIONS = $1F03;
-
- // TextureCoordName
- GL_S = $2000;
- GL_T = $2001;
- GL_R = $2002;
- GL_Q = $2003;
-
- // TexCoordPointerType
- // GL_SHORT
- // GL_INT
- // GL_FLOAT
- // GL_DOUBLE
-
- // TextureEnvMode
- GL_MODULATE = $2100;
- GL_DECAL = $2101;
- // GL_BLEND
- // GL_REPLACE
-
- // TextureEnvParameter
- GL_TEXTURE_ENV_MODE = $2200;
- GL_TEXTURE_ENV_COLOR = $2201;
-
- // TextureEnvTarget
- GL_TEXTURE_ENV = $2300;
-
- // TextureGenMode
- GL_EYE_LINEAR = $2400;
- GL_OBJECT_LINEAR = $2401;
- GL_SPHERE_MAP = $2402;
-
- // TextureGenParameter
- GL_TEXTURE_GEN_MODE = $2500;
- GL_OBJECT_PLANE = $2501;
- GL_EYE_PLANE = $2502;
-
- // TextureMagFilter
- GL_NEAREST = $2600;
- GL_LINEAR = $2601;
-
- // TextureMinFilter
- // GL_NEAREST
- // GL_LINEAR
- GL_NEAREST_MIPMAP_NEAREST = $2700;
- GL_LINEAR_MIPMAP_NEAREST = $2701;
- GL_NEAREST_MIPMAP_LINEAR = $2702;
- GL_LINEAR_MIPMAP_LINEAR = $2703;
-
- // TextureParameterName
- GL_TEXTURE_MAG_FILTER = $2800;
- GL_TEXTURE_MIN_FILTER = $2801;
- GL_TEXTURE_WRAP_S = $2802;
- GL_TEXTURE_WRAP_T = $2803;
- // GL_TEXTURE_BORDER_COLOR
- // GL_TEXTURE_PRIORITY
-
- // TextureTarget
- // GL_TEXTURE_1D
- // GL_TEXTURE_2D
- // GL_PROXY_TEXTURE_1D
- // GL_PROXY_TEXTURE_2D
-
- // TextureWrapMode
- GL_CLAMP = $2900;
- GL_REPEAT = $2901;
-
- // VertexPointerType
- // GL_SHORT
- // GL_INT
- // GL_FLOAT
- // GL_DOUBLE
-
- // ClientAttribMask
- GL_CLIENT_PIXEL_STORE_BIT = $00000001;
- GL_CLIENT_VERTEX_ARRAY_BIT = $00000002;
- GL_CLIENT_ALL_ATTRIB_BITS = $FFFFFFFF;
-
- // polygon_offset
- GL_POLYGON_OFFSET_FACTOR = $8038;
- GL_POLYGON_OFFSET_UNITS = $2A00;
- GL_POLYGON_OFFSET_POINT = $2A01;
- GL_POLYGON_OFFSET_LINE = $2A02;
- GL_POLYGON_OFFSET_FILL = $8037;
-
- // texture
- GL_ALPHA4 = $803B;
- GL_ALPHA8 = $803C;
- GL_ALPHA12 = $803D;
- GL_ALPHA16 = $803E;
- GL_LUMINANCE4 = $803F;
- GL_LUMINANCE8 = $8040;
- GL_LUMINANCE12 = $8041;
- GL_LUMINANCE16 = $8042;
- GL_LUMINANCE4_ALPHA4 = $8043;
- GL_LUMINANCE6_ALPHA2 = $8044;
- GL_LUMINANCE8_ALPHA8 = $8045;
- GL_LUMINANCE12_ALPHA4 = $8046;
- GL_LUMINANCE12_ALPHA12 = $8047;
- GL_LUMINANCE16_ALPHA16 = $8048;
- GL_INTENSITY = $8049;
- GL_INTENSITY4 = $804A;
- GL_INTENSITY8 = $804B;
- GL_INTENSITY12 = $804C;
- GL_INTENSITY16 = $804D;
- GL_R3_G3_B2 = $2A10;
- GL_RGB4 = $804F;
- GL_RGB5 = $8050;
- GL_RGB8 = $8051;
- GL_RGB10 = $8052;
- GL_RGB12 = $8053;
- GL_RGB16 = $8054;
- GL_RGBA2 = $8055;
- GL_RGBA4 = $8056;
- GL_RGB5_A1 = $8057;
- GL_RGBA8 = $8058;
- GL_RGB10_A2 = $8059;
- GL_RGBA12 = $805A;
- GL_RGBA16 = $805B;
- GL_TEXTURE_RED_SIZE = $805C;
- GL_TEXTURE_GREEN_SIZE = $805D;
- GL_TEXTURE_BLUE_SIZE = $805E;
- GL_TEXTURE_ALPHA_SIZE = $805F;
- GL_TEXTURE_LUMINANCE_SIZE = $8060;
- GL_TEXTURE_INTENSITY_SIZE = $8061;
- GL_PROXY_TEXTURE_1D = $8063;
- GL_PROXY_TEXTURE_2D = $8064;
-
- // texture_object
- GL_TEXTURE_PRIORITY = $8066;
- GL_TEXTURE_RESIDENT = $8067;
- GL_TEXTURE_BINDING_1D = $8068;
- GL_TEXTURE_BINDING_2D = $8069;
-
- // vertex_array
- GL_VERTEX_ARRAY = $8074;
- GL_NORMAL_ARRAY = $8075;
- GL_COLOR_ARRAY = $8076;
- GL_INDEX_ARRAY = $8077;
- GL_TEXTURE_COORD_ARRAY = $8078;
- GL_EDGE_FLAG_ARRAY = $8079;
- GL_VERTEX_ARRAY_SIZE = $807A;
- GL_VERTEX_ARRAY_TYPE = $807B;
- GL_VERTEX_ARRAY_STRIDE = $807C;
- GL_NORMAL_ARRAY_TYPE = $807E;
- GL_NORMAL_ARRAY_STRIDE = $807F;
- GL_COLOR_ARRAY_SIZE = $8081;
- GL_COLOR_ARRAY_TYPE = $8082;
- GL_COLOR_ARRAY_STRIDE = $8083;
- GL_INDEX_ARRAY_TYPE = $8085;
- GL_INDEX_ARRAY_STRIDE = $8086;
- GL_TEXTURE_COORD_ARRAY_SIZE = $8088;
- GL_TEXTURE_COORD_ARRAY_TYPE = $8089;
- GL_TEXTURE_COORD_ARRAY_STRIDE = $808A;
- GL_EDGE_FLAG_ARRAY_STRIDE = $808C;
- GL_VERTEX_ARRAY_POINTER = $808E;
- GL_NORMAL_ARRAY_POINTER = $808F;
- GL_COLOR_ARRAY_POINTER = $8090;
- GL_INDEX_ARRAY_POINTER = $8091;
- GL_TEXTURE_COORD_ARRAY_POINTER = $8092;
- GL_EDGE_FLAG_ARRAY_POINTER = $8093;
- GL_V2F = $2A20;
- GL_V3F = $2A21;
- GL_C4UB_V2F = $2A22;
- GL_C4UB_V3F = $2A23;
- GL_C3F_V3F = $2A24;
- GL_N3F_V3F = $2A25;
- GL_C4F_N3F_V3F = $2A26;
- GL_T2F_V3F = $2A27;
- GL_T4F_V4F = $2A28;
- GL_T2F_C4UB_V3F = $2A29;
- GL_T2F_C3F_V3F = $2A2A;
- GL_T2F_N3F_V3F = $2A2B;
- GL_T2F_C4F_N3F_V3F = $2A2C;
- GL_T4F_C4F_N3F_V4F = $2A2D;
-
- // Extensions
- GL_EXT_vertex_array = 1;
- GL_WIN_swap_hint = 1;
- GL_EXT_bgra = 1;
- GL_EXT_paletted_texture = 1;
-
- // EXT_vertex_array
- GL_VERTEX_ARRAY_EXT = $8074;
- GL_NORMAL_ARRAY_EXT = $8075;
- GL_COLOR_ARRAY_EXT = $8076;
- GL_INDEX_ARRAY_EXT = $8077;
- GL_TEXTURE_COORD_ARRAY_EXT = $8078;
- GL_EDGE_FLAG_ARRAY_EXT = $8079;
- GL_VERTEX_ARRAY_SIZE_EXT = $807A;
- GL_VERTEX_ARRAY_TYPE_EXT = $807B;
- GL_VERTEX_ARRAY_STRIDE_EXT = $807C;
- GL_VERTEX_ARRAY_COUNT_EXT = $807D;
- GL_NORMAL_ARRAY_TYPE_EXT = $807E;
- GL_NORMAL_ARRAY_STRIDE_EXT = $807F;
- GL_NORMAL_ARRAY_COUNT_EXT = $8080;
- GL_COLOR_ARRAY_SIZE_EXT = $8081;
- GL_COLOR_ARRAY_TYPE_EXT = $8082;
- GL_COLOR_ARRAY_STRIDE_EXT = $8083;
- GL_COLOR_ARRAY_COUNT_EXT = $8084;
- GL_INDEX_ARRAY_TYPE_EXT = $8085;
- GL_INDEX_ARRAY_STRIDE_EXT = $8086;
- GL_INDEX_ARRAY_COUNT_EXT = $8087;
- GL_TEXTURE_COORD_ARRAY_SIZE_EXT = $8088;
- GL_TEXTURE_COORD_ARRAY_TYPE_EXT = $8089;
- GL_TEXTURE_COORD_ARRAY_STRIDE_EXT = $808A;
- GL_TEXTURE_COORD_ARRAY_COUNT_EXT = $808B;
- GL_EDGE_FLAG_ARRAY_STRIDE_EXT = $808C;
- GL_EDGE_FLAG_ARRAY_COUNT_EXT = $808D;
- GL_VERTEX_ARRAY_POINTER_EXT = $808E;
- GL_NORMAL_ARRAY_POINTER_EXT = $808F;
- GL_COLOR_ARRAY_POINTER_EXT = $8090;
- GL_INDEX_ARRAY_POINTER_EXT = $8091;
- GL_TEXTURE_COORD_ARRAY_POINTER_EXT = $8092;
- GL_EDGE_FLAG_ARRAY_POINTER_EXT = $8093;
- GL_DOUBLE_EXT = GL_DOUBLE;
-
- // EXT_bgra
- GL_BGR_EXT = $80E0;
- GL_BGRA_EXT = $80E1;
-
- // EXT_paletted_texture
-
- // These must match the GL_COLOR_TABLE_*_SGI enumerants
- GL_COLOR_TABLE_FORMAT_EXT = $80D8;
- GL_COLOR_TABLE_WIDTH_EXT = $80D9;
- GL_COLOR_TABLE_RED_SIZE_EXT = $80DA;
- GL_COLOR_TABLE_GREEN_SIZE_EXT = $80DB;
- GL_COLOR_TABLE_BLUE_SIZE_EXT = $80DC;
- GL_COLOR_TABLE_ALPHA_SIZE_EXT = $80DD;
- GL_COLOR_TABLE_LUMINANCE_SIZE_EXT = $80DE;
- GL_COLOR_TABLE_INTENSITY_SIZE_EXT = $80DF;
-
- GL_COLOR_INDEX1_EXT = $80E2;
- GL_COLOR_INDEX2_EXT = $80E3;
- GL_COLOR_INDEX4_EXT = $80E4;
- GL_COLOR_INDEX8_EXT = $80E5;
- GL_COLOR_INDEX12_EXT = $80E6;
- GL_COLOR_INDEX16_EXT = $80E7;
-
- // For compatibility with OpenGL v1.0
- GL_LOGIC_OP = GL_INDEX_LOGIC_OP;
- GL_TEXTURE_COMPONENTS = GL_TEXTURE_INTERNAL_FORMAT;
-
-{******************************************************************************}
-
-var
- glAccum: procedure(op: GLenum; value: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glAlphaFunc: procedure(func: GLenum; ref: GLclampf); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glAreTexturesResident: function (n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glArrayElement: procedure(i: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glBegin: procedure(mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glBindTexture: procedure(target: GLenum; texture: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glBitmap: procedure (width, height: GLsizei; xorig, yorig: GLfloat; xmove, ymove: GLfloat; const bitmap: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glBlendFunc: procedure(sfactor, dfactor: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCallList: procedure(list: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCallLists: procedure(n: GLsizei; atype: GLenum; const lists: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glClear: procedure(mask: GLbitfield); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glClearAccum: procedure(red, green, blue, alpha: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glClearColor: procedure(red, green, blue, alpha: GLclampf); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glClearDepth: procedure(depth: GLclampd); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glClearIndex: procedure(c: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glClearStencil: procedure(s: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glClipPlane: procedure(plane: GLenum; const equation: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor3b: procedure(red, green, blue: GLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor3bv: procedure(const v: PGLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor3d: procedure(red, green, blue: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor3dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor3f: procedure(red, green, blue: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor3fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor3i: procedure(red, green, blue: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor3iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor3s: procedure(red, green, blue: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor3sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor3ub: procedure(red, green, blue: GLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor3ubv: procedure(const v: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor3ui: procedure(red, green, blue: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor3uiv: procedure(const v: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor3us: procedure(red, green, blue: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor3usv: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor4b: procedure(red, green, blue, alpha: GLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor4bv: procedure(const v: PGLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor4d: procedure(red, green, blue, alpha: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor4dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor4f: procedure(red, green, blue, alpha: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor4fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor4i: procedure(red, green, blue, alpha: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor4iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor4s: procedure(red, green, blue, alpha: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor4sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor4ub: procedure(red, green, blue, alpha: GLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor4ubv: procedure(const v: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor4ui: procedure(red, green, blue, alpha: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor4uiv: procedure(const v: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor4us: procedure(red, green, blue, alpha: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor4usv: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColorMask: procedure(red, green, blue, alpha: GLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColorMaterial: procedure(face, mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColorPointer: procedure(size: GLint; atype: GLenum; stride: GLsizei; const pointer: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCopyPixels: procedure(x, y: GLint; width, height: GLsizei; atype: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCopyTexImage1D: procedure (target: GLenum; level: GLint; internalFormat: GLenum; x, y: GLint; width: GLsizei; border: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCopyTexImage2D: procedure(target: GLenum; level: GLint; internalFormat: GLenum; x, y: GLint; width, height: GLsizei; border: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCopyTexSubImage1D: procedure(target: GLenum; level, xoffset, x, y: GLint; width: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCopyTexSubImage2D: procedure(target: GLenum; level, xoffset, yoffset, x, y: GLint; width, height: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCullFace: procedure(mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDeleteLists: procedure(list: GLuint; range: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDeleteTextures: procedure(n: GLsizei; const textures: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDepthFunc: procedure(func: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDepthMask: procedure(flag: GLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDepthRange: procedure(zNear, zFar: GLclampd); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDisable: procedure(cap: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDisableClientState: procedure(aarray: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDrawArrays: procedure(mode: GLenum; first: GLint; count: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDrawBuffer: procedure(mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDrawElements: procedure(mode: GLenum; count: GLsizei; atype: GLenum; const indices: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDrawPixels: procedure(width, height: GLsizei; format, atype: GLenum; const pixels: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEdgeFlag: procedure(flag: GLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEdgeFlagPointer: procedure(stride: GLsizei; const pointer: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEdgeFlagv: procedure(const flag: PGLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEnable: procedure(cap: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEnableClientState: procedure(aarray: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEnd: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEndList: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEvalCoord1d: procedure(u: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEvalCoord1dv: procedure(const u: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEvalCoord1f: procedure(u: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEvalCoord1fv: procedure(const u: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEvalCoord2d: procedure(u, v: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEvalCoord2dv: procedure(const u: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEvalCoord2f: procedure(u, v: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEvalCoord2fv: procedure(const u: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEvalMesh1: procedure(mode: GLenum; i1, i2: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEvalMesh2: procedure(mode: GLenum; i1, i2, j1, j2: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEvalPoint1: procedure(i: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEvalPoint2: procedure(i, j: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFeedbackBuffer: procedure(size: GLsizei; atype: GLenum; buffer: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFinish: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFlush: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFogf: procedure(pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFogfv: procedure(pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFogi: procedure(pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFogiv: procedure(pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFrontFace: procedure(mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFrustum: procedure(left, right, bottom, top, zNear, zFar: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGenLists: function(range: GLsizei): GLuint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGenTextures: procedure(n: GLsizei; textures: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetBooleanv: procedure(pname: GLenum; params: PGLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetClipPlane: procedure(plane: GLenum; equation: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetDoublev: procedure(pname: GLenum; params: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetError: function: GLenum; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetFloatv: procedure(pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetIntegerv: procedure(pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetLightfv: procedure(light, pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetLightiv: procedure(light, pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetMapdv: procedure(target, query: GLenum; v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetMapfv: procedure(target, query: GLenum; v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetMapiv: procedure(target, query: GLenum; v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetMaterialfv: procedure(face, pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetMaterialiv: procedure(face, pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetPixelMapfv: procedure(map: GLenum; values: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetPixelMapuiv: procedure(map: GLenum; values: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetPixelMapusv: procedure(map: GLenum; values: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetPointerv: procedure(pname: GLenum; params: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetPolygonStipple: procedure(mask: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetString: function(name: GLenum): PChar; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetTexEnvfv: procedure(target, pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetTexEnviv: procedure(target, pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetTexGendv: procedure(coord, pname: GLenum; params: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetTexGenfv: procedure(coord, pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetTexGeniv: procedure(coord, pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetTexImage: procedure(target: GLenum; level: GLint; format: GLenum; atype: GLenum; pixels: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetTexLevelParameterfv: procedure(target: GLenum; level: GLint; pname: GLenum; params: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetTexLevelParameteriv: procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetTexParameterfv: procedure(target, pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetTexParameteriv: procedure(target, pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glHint: procedure(target, mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIndexMask: procedure(mask: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIndexPointer: procedure(atype: GLenum; stride: GLsizei; const pointer: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIndexd: procedure(c: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIndexdv: procedure(const c: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIndexf: procedure(c: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIndexfv: procedure(const c: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIndexi: procedure(c: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIndexiv: procedure(const c: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIndexs: procedure(c: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIndexsv: procedure(const c: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIndexub: procedure(c: GLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIndexubv: procedure(const c: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glInitNames: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glInterleavedArrays: procedure(format: GLenum; stride: GLsizei; const pointer: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIsEnabled: function(cap: GLenum): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIsList: function(list: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIsTexture: function(texture: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glLightModelf: procedure(pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glLightModelfv: procedure(pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glLightModeli: procedure(pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glLightModeliv: procedure(pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glLightf: procedure(light, pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glLightfv: procedure(light, pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glLighti: procedure(light, pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glLightiv: procedure(light, pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glLineStipple: procedure(factor: GLint; pattern: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glLineWidth: procedure(width: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glListBase: procedure(base: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glLoadIdentity: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glLoadMatrixd: procedure(const m: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glLoadMatrixf: procedure(const m: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glLoadName: procedure(name: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glLogicOp: procedure(opcode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMap1d: procedure(target: GLenum; u1, u2: GLdouble; stride, order: GLint; const points: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMap1f: procedure(target: GLenum; u1, u2: GLfloat; stride, order: GLint; const points: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMap2d: procedure(target: GLenum; u1, u2: GLdouble; ustride, uorder: GLint; v1, v2: GLdouble; vstride, vorder: GLint; const points: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMap2f: procedure(target: GLenum; u1, u2: GLfloat; ustride, uorder: GLint; v1, v2: GLfloat; vstride, vorder: GLint; const points: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMapGrid1d: procedure(un: GLint; u1, u2: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMapGrid1f: procedure(un: GLint; u1, u2: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMapGrid2d: procedure(un: GLint; u1, u2: GLdouble; vn: GLint; v1, v2: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMapGrid2f: procedure(un: GLint; u1, u2: GLfloat; vn: GLint; v1, v2: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMaterialf: procedure(face, pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMaterialfv: procedure(face, pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMateriali: procedure(face, pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMaterialiv: procedure(face, pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMatrixMode: procedure(mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultMatrixd: procedure(const m: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultMatrixf: procedure(const m: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNewList: procedure(list: GLuint; mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNormal3b: procedure(nx, ny, nz: GLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNormal3bv: procedure(const v: PGLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNormal3d: procedure(nx, ny, nz: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNormal3dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNormal3f: procedure(nx, ny, nz: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNormal3fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNormal3i: procedure(nx, ny, nz: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNormal3iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNormal3s: procedure(nx, ny, nz: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNormal3sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNormalPointer: procedure(atype: GLenum; stride: GLsizei; const pointer: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glOrtho: procedure(left, right, bottom, top, zNear, zFar: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPassThrough: procedure(token: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPixelMapfv: procedure(map: GLenum; mapsize: GLsizei; const values: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPixelMapuiv: procedure(map: GLenum; mapsize: GLsizei; const values: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPixelMapusv: procedure(map: GLenum; mapsize: GLsizei; const values: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPixelStoref: procedure(pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPixelStorei: procedure(pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPixelTransferf: procedure(pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPixelTransferi: procedure(pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPixelZoom: procedure(xfactor, yfactor: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPointSize: procedure(size: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPolygonMode: procedure(face, mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPolygonOffset: procedure(factor, units: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPolygonStipple: procedure(const mask: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPopAttrib: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPopClientAttrib: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPopMatrix: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPopName: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPrioritizeTextures: procedure(n: GLsizei; const textures: PGLuint; const priorities: PGLclampf); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPushAttrib: procedure(mask: GLbitfield); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPushClientAttrib: procedure(mask: GLbitfield); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPushMatrix: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPushName: procedure(name: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRasterPos2d: procedure(x, y: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRasterPos2dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRasterPos2f: procedure(x, y: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRasterPos2fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRasterPos2i: procedure(x, y: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRasterPos2iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRasterPos2s: procedure(x, y: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRasterPos2sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRasterPos3d: procedure(x, y, z: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRasterPos3dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRasterPos3f: procedure(x, y, z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRasterPos3fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRasterPos3i: procedure(x, y, z: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRasterPos3iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRasterPos3s: procedure(x, y, z: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRasterPos3sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRasterPos4d: procedure(x, y, z, w: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRasterPos4dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRasterPos4f: procedure(x, y, z, w: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRasterPos4fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRasterPos4i: procedure(x, y, z, w: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRasterPos4iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRasterPos4s: procedure(x, y, z, w: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRasterPos4sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glReadBuffer: procedure(mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glReadPixels: procedure(x, y: GLint; width, height: GLsizei; format, atype: GLenum; pixels: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRectd: procedure(x1, y1, x2, y2: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRectdv: procedure(const v1: PGLdouble; const v2: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRectf: procedure(x1, y1, x2, y2: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRectfv: procedure(const v1: PGLfloat; const v2: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRecti: procedure(x1, y1, x2, y2: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRectiv: procedure(const v1: PGLint; const v2: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRects: procedure(x1, y1, x2, y2: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRectsv: procedure(const v1: PGLshort; const v2: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRenderMode: function(mode: GLint): GLint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRotated: procedure(angle, x, y, z: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRotatef: procedure(angle, x, y, z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glScaled: procedure(x, y, z: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glScalef: procedure(x, y, z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glScissor: procedure(x, y: GLint; width, height: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSelectBuffer: procedure(size: GLsizei; buffer: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glShadeModel: procedure(mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glStencilFunc: procedure(func: GLenum; ref: GLint; mask: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glStencilMask: procedure(mask: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glStencilOp: procedure(fail, zfail, zpass: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord1d: procedure(s: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord1dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord1f: procedure(s: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord1fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord1i: procedure(s: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord1iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord1s: procedure(s: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord1sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord2d: procedure(s, t: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord2dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord2f: procedure(s, t: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord2fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord2i: procedure(s, t: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord2iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord2s: procedure(s, t: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord2sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord3d: procedure(s, t, r: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord3dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord3f: procedure(s, t, r: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord3fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord3i: procedure(s, t, r: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord3iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord3s: procedure(s, t, r: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord3sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord4d: procedure(s, t, r, q: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord4dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord4f: procedure(s, t, r, q: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord4fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord4i: procedure(s, t, r, q: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord4iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord4s: procedure(s, t, r, q: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord4sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoordPointer: procedure(size: GLint; atype: GLenum; stride: GLsizei; const pointer: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexEnvf: procedure(target: GLenum; pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexEnvfv: procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexEnvi: procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexEnviv: procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexGend: procedure(coord: GLenum; pname: GLenum; param: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexGendv: procedure(coord: GLenum; pname: GLenum; const params: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexGenf: procedure(coord: GLenum; pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexGenfv: procedure(coord: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexGeni: procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexGeniv: procedure(coord: GLenum; pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexImage1D: procedure(target: GLenum; level, internalformat: GLint; width: GLsizei; border: GLint; format, atype: GLenum; const pixels: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexImage2D: procedure(target: GLenum; level, internalformat: GLint; width, height: GLsizei; border: GLint; format, atype: GLenum; const pixels: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexParameterf: procedure(target: GLenum; pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexParameterfv: procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexParameteri: procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexParameteriv: procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexSubImage1D: procedure(target: GLenum; level, xoffset: GLint; width: GLsizei; format, atype: GLenum; const pixels: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexSubImage2D: procedure(target: GLenum; level, xoffset, yoffset: GLint; width, height: GLsizei; format, atype: GLenum; const pixels: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTranslated: procedure(x, y, z: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTranslatef: procedure(x, y, z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex2d: procedure(x, y: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex2dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex2f: procedure(x, y: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex2fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex2i: procedure(x, y: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex2iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex2s: procedure(x, y: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex2sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex3d: procedure(x, y, z: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex3dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex3f: procedure(x, y, z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex3fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex3i: procedure(x, y, z: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex3iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex3s: procedure(x, y, z: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex3sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex4d: procedure(x, y, z, w: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex4dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex4f: procedure(x, y, z, w: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex4fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex4i: procedure(x, y, z, w: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex4iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex4s: procedure(x, y, z, w: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex4sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexPointer: procedure(size: GLint; atype: GLenum; stride: GLsizei; const pointer: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glViewport: procedure(x, y: GLint; width, height: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- {$IFDEF WINDOWS}
- ChoosePixelFormat: function(DC: HDC; p2: PPixelFormatDescriptor): Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- {$ENDIF}
-
-type
- // EXT_vertex_array
- PFNGLARRAYELEMENTEXTPROC = procedure(i: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- PFNGLDRAWARRAYSEXTPROC = procedure(mode: GLenum; first: GLint; count: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- PFNGLVERTEXPOINTEREXTPROC = procedure(size: GLint; atype: GLenum;
- stride, count: GLsizei; const pointer: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- PFNGLNORMALPOINTEREXTPROC = procedure(atype: GLenum; stride, count: GLsizei;
- const pointer: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- PFNGLCOLORPOINTEREXTPROC = procedure(size: GLint; atype: GLenum; stride, count: GLsizei;
- const pointer: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- PFNGLINDEXPOINTEREXTPROC = procedure(atype: GLenum; stride, count: GLsizei;
- const pointer: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- PFNGLTEXCOORDPOINTEREXTPROC = procedure(size: GLint; atype: GLenum;
- stride, count: GLsizei; const pointer: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- PFNGLEDGEFLAGPOINTEREXTPROC = procedure(stride, count: GLsizei;
- const pointer: PGLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- PFNGLGETPOINTERVEXTPROC = procedure(pname: GLenum; params: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- PFNGLARRAYELEMENTARRAYEXTPROC = procedure(mode: GLenum; count: GLsizei;
- const pi: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
- // WIN_swap_hint
- PFNGLADDSWAPHINTRECTWINPROC = procedure(x, y: GLint; width, height: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
- // EXT_paletted_texture
- PFNGLCOLORTABLEEXTPROC = procedure(target, internalFormat: GLenum; width: GLsizei;
- format, atype: GLenum; const data: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- PFNGLCOLORSUBTABLEEXTPROC = procedure(target: GLenum; start, count: GLsizei;
- format, atype: GLenum; const data: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- PFNGLGETCOLORTABLEEXTPROC = procedure(target, format, atype: GLenum; data: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- PFNGLGETCOLORTABLEPARAMETERIVEXTPROC = procedure(target, pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- PFNGLGETCOLORTABLEPARAMETERFVEXTPROC = procedure(target, pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-procedure LoadOpenGL( const dll: PChar );
-procedure FreeOpenGL;
-
-implementation
-
-procedure FreeOpenGL;
-begin
-
- @glAccum := nil;
- @glAlphaFunc := nil;
- @glAreTexturesResident := nil;
- @glArrayElement := nil;
- @glBegin := nil;
- @glBindTexture := nil;
- @glBitmap := nil;
- @glBlendFunc := nil;
- @glCallList := nil;
- @glCallLists := nil;
- @glClear := nil;
- @glClearAccum := nil;
- @glClearColor := nil;
- @glClearDepth := nil;
- @glClearIndex := nil;
- @glClearStencil := nil;
- @glClipPlane := nil;
- @glColor3b := nil;
- @glColor3bv := nil;
- @glColor3d := nil;
- @glColor3dv := nil;
- @glColor3f := nil;
- @glColor3fv := nil;
- @glColor3i := nil;
- @glColor3iv := nil;
- @glColor3s := nil;
- @glColor3sv := nil;
- @glColor3ub := nil;
- @glColor3ubv := nil;
- @glColor3ui := nil;
- @glColor3uiv := nil;
- @glColor3us := nil;
- @glColor3usv := nil;
- @glColor4b := nil;
- @glColor4bv := nil;
- @glColor4d := nil;
- @glColor4dv := nil;
- @glColor4f := nil;
- @glColor4fv := nil;
- @glColor4i := nil;
- @glColor4iv := nil;
- @glColor4s := nil;
- @glColor4sv := nil;
- @glColor4ub := nil;
- @glColor4ubv := nil;
- @glColor4ui := nil;
- @glColor4uiv := nil;
- @glColor4us := nil;
- @glColor4usv := nil;
- @glColorMask := nil;
- @glColorMaterial := nil;
- @glColorPointer := nil;
- @glCopyPixels := nil;
- @glCopyTexImage1D := nil;
- @glCopyTexImage2D := nil;
- @glCopyTexSubImage1D := nil;
- @glCopyTexSubImage2D := nil;
- @glCullFace := nil;
- @glDeleteLists := nil;
- @glDeleteTextures := nil;
- @glDepthFunc := nil;
- @glDepthMask := nil;
- @glDepthRange := nil;
- @glDisable := nil;
- @glDisableClientState := nil;
- @glDrawArrays := nil;
- @glDrawBuffer := nil;
- @glDrawElements := nil;
- @glDrawPixels := nil;
- @glEdgeFlag := nil;
- @glEdgeFlagPointer := nil;
- @glEdgeFlagv := nil;
- @glEnable := nil;
- @glEnableClientState := nil;
- @glEnd := nil;
- @glEndList := nil;
- @glEvalCoord1d := nil;
- @glEvalCoord1dv := nil;
- @glEvalCoord1f := nil;
- @glEvalCoord1fv := nil;
- @glEvalCoord2d := nil;
- @glEvalCoord2dv := nil;
- @glEvalCoord2f := nil;
- @glEvalCoord2fv := nil;
- @glEvalMesh1 := nil;
- @glEvalMesh2 := nil;
- @glEvalPoint1 := nil;
- @glEvalPoint2 := nil;
- @glFeedbackBuffer := nil;
- @glFinish := nil;
- @glFlush := nil;
- @glFogf := nil;
- @glFogfv := nil;
- @glFogi := nil;
- @glFogiv := nil;
- @glFrontFace := nil;
- @glFrustum := nil;
- @glGenLists := nil;
- @glGenTextures := nil;
- @glGetBooleanv := nil;
- @glGetClipPlane := nil;
- @glGetDoublev := nil;
- @glGetError := nil;
- @glGetFloatv := nil;
- @glGetIntegerv := nil;
- @glGetLightfv := nil;
- @glGetLightiv := nil;
- @glGetMapdv := nil;
- @glGetMapfv := nil;
- @glGetMapiv := nil;
- @glGetMaterialfv := nil;
- @glGetMaterialiv := nil;
- @glGetPixelMapfv := nil;
- @glGetPixelMapuiv := nil;
- @glGetPixelMapusv := nil;
- @glGetPointerv := nil;
- @glGetPolygonStipple := nil;
- @glGetString := nil;
- @glGetTexEnvfv := nil;
- @glGetTexEnviv := nil;
- @glGetTexGendv := nil;
- @glGetTexGenfv := nil;
- @glGetTexGeniv := nil;
- @glGetTexImage := nil;
- @glGetTexLevelParameterfv := nil;
- @glGetTexLevelParameteriv := nil;
- @glGetTexParameterfv := nil;
- @glGetTexParameteriv := nil;
- @glHint := nil;
- @glIndexMask := nil;
- @glIndexPointer := nil;
- @glIndexd := nil;
- @glIndexdv := nil;
- @glIndexf := nil;
- @glIndexfv := nil;
- @glIndexi := nil;
- @glIndexiv := nil;
- @glIndexs := nil;
- @glIndexsv := nil;
- @glIndexub := nil;
- @glIndexubv := nil;
- @glInitNames := nil;
- @glInterleavedArrays := nil;
- @glIsEnabled := nil;
- @glIsList := nil;
- @glIsTexture := nil;
- @glLightModelf := nil;
- @glLightModelfv := nil;
- @glLightModeli := nil;
- @glLightModeliv := nil;
- @glLightf := nil;
- @glLightfv := nil;
- @glLighti := nil;
- @glLightiv := nil;
- @glLineStipple := nil;
- @glLineWidth := nil;
- @glListBase := nil;
- @glLoadIdentity := nil;
- @glLoadMatrixd := nil;
- @glLoadMatrixf := nil;
- @glLoadName := nil;
- @glLogicOp := nil;
- @glMap1d := nil;
- @glMap1f := nil;
- @glMap2d := nil;
- @glMap2f := nil;
- @glMapGrid1d := nil;
- @glMapGrid1f := nil;
- @glMapGrid2d := nil;
- @glMapGrid2f := nil;
- @glMaterialf := nil;
- @glMaterialfv := nil;
- @glMateriali := nil;
- @glMaterialiv := nil;
- @glMatrixMode := nil;
- @glMultMatrixd := nil;
- @glMultMatrixf := nil;
- @glNewList := nil;
- @glNormal3b := nil;
- @glNormal3bv := nil;
- @glNormal3d := nil;
- @glNormal3dv := nil;
- @glNormal3f := nil;
- @glNormal3fv := nil;
- @glNormal3i := nil;
- @glNormal3iv := nil;
- @glNormal3s := nil;
- @glNormal3sv := nil;
- @glNormalPointer := nil;
- @glOrtho := nil;
- @glPassThrough := nil;
- @glPixelMapfv := nil;
- @glPixelMapuiv := nil;
- @glPixelMapusv := nil;
- @glPixelStoref := nil;
- @glPixelStorei := nil;
- @glPixelTransferf := nil;
- @glPixelTransferi := nil;
- @glPixelZoom := nil;
- @glPointSize := nil;
- @glPolygonMode := nil;
- @glPolygonOffset := nil;
- @glPolygonStipple := nil;
- @glPopAttrib := nil;
- @glPopClientAttrib := nil;
- @glPopMatrix := nil;
- @glPopName := nil;
- @glPrioritizeTextures := nil;
- @glPushAttrib := nil;
- @glPushClientAttrib := nil;
- @glPushMatrix := nil;
- @glPushName := nil;
- @glRasterPos2d := nil;
- @glRasterPos2dv := nil;
- @glRasterPos2f := nil;
- @glRasterPos2fv := nil;
- @glRasterPos2i := nil;
- @glRasterPos2iv := nil;
- @glRasterPos2s := nil;
- @glRasterPos2sv := nil;
- @glRasterPos3d := nil;
- @glRasterPos3dv := nil;
- @glRasterPos3f := nil;
- @glRasterPos3fv := nil;
- @glRasterPos3i := nil;
- @glRasterPos3iv := nil;
- @glRasterPos3s := nil;
- @glRasterPos3sv := nil;
- @glRasterPos4d := nil;
- @glRasterPos4dv := nil;
- @glRasterPos4f := nil;
- @glRasterPos4fv := nil;
- @glRasterPos4i := nil;
- @glRasterPos4iv := nil;
- @glRasterPos4s := nil;
- @glRasterPos4sv := nil;
- @glReadBuffer := nil;
- @glReadPixels := nil;
- @glRectd := nil;
- @glRectdv := nil;
- @glRectf := nil;
- @glRectfv := nil;
- @glRecti := nil;
- @glRectiv := nil;
- @glRects := nil;
- @glRectsv := nil;
- @glRenderMode := nil;
- @glRotated := nil;
- @glRotatef := nil;
- @glScaled := nil;
- @glScalef := nil;
- @glScissor := nil;
- @glSelectBuffer := nil;
- @glShadeModel := nil;
- @glStencilFunc := nil;
- @glStencilMask := nil;
- @glStencilOp := nil;
- @glTexCoord1d := nil;
- @glTexCoord1dv := nil;
- @glTexCoord1f := nil;
- @glTexCoord1fv := nil;
- @glTexCoord1i := nil;
- @glTexCoord1iv := nil;
- @glTexCoord1s := nil;
- @glTexCoord1sv := nil;
- @glTexCoord2d := nil;
- @glTexCoord2dv := nil;
- @glTexCoord2f := nil;
- @glTexCoord2fv := nil;
- @glTexCoord2i := nil;
- @glTexCoord2iv := nil;
- @glTexCoord2s := nil;
- @glTexCoord2sv := nil;
- @glTexCoord3d := nil;
- @glTexCoord3dv := nil;
- @glTexCoord3f := nil;
- @glTexCoord3fv := nil;
- @glTexCoord3i := nil;
- @glTexCoord3iv := nil;
- @glTexCoord3s := nil;
- @glTexCoord3sv := nil;
- @glTexCoord4d := nil;
- @glTexCoord4dv := nil;
- @glTexCoord4f := nil;
- @glTexCoord4fv := nil;
- @glTexCoord4i := nil;
- @glTexCoord4iv := nil;
- @glTexCoord4s := nil;
- @glTexCoord4sv := nil;
- @glTexCoordPointer := nil;
- @glTexEnvf := nil;
- @glTexEnvfv := nil;
- @glTexEnvi := nil;
- @glTexEnviv := nil;
- @glTexGend := nil;
- @glTexGendv := nil;
- @glTexGenf := nil;
- @glTexGenfv := nil;
- @glTexGeni := nil;
- @glTexGeniv := nil;
- @glTexImage1D := nil;
- @glTexImage2D := nil;
- @glTexParameterf := nil;
- @glTexParameterfv := nil;
- @glTexParameteri := nil;
- @glTexParameteriv := nil;
- @glTexSubImage1D := nil;
- @glTexSubImage2D := nil;
- @glTranslated := nil;
- @glTranslatef := nil;
- @glVertex2d := nil;
- @glVertex2dv := nil;
- @glVertex2f := nil;
- @glVertex2fv := nil;
- @glVertex2i := nil;
- @glVertex2iv := nil;
- @glVertex2s := nil;
- @glVertex2sv := nil;
- @glVertex3d := nil;
- @glVertex3dv := nil;
- @glVertex3f := nil;
- @glVertex3fv := nil;
- @glVertex3i := nil;
- @glVertex3iv := nil;
- @glVertex3s := nil;
- @glVertex3sv := nil;
- @glVertex4d := nil;
- @glVertex4dv := nil;
- @glVertex4f := nil;
- @glVertex4fv := nil;
- @glVertex4i := nil;
- @glVertex4iv := nil;
- @glVertex4s := nil;
- @glVertex4sv := nil;
- @glVertexPointer := nil;
- @glViewport := nil;
- {$IFDEF WINDOWS}
- @ChoosePixelFormat := nil;
- {$ENDIF}
-
- UnLoadModule(LibGL);
-
-end;
-
-procedure LoadOpenGL(const dll: PChar);
-begin
-
- FreeOpenGL;
-
- if LoadModule( LibGL, dll ) then
- begin
- @glAccum := GetModuleSymbol(LibGL, 'glAccum');
- @glAlphaFunc := GetModuleSymbol(LibGL, 'glAlphaFunc');
- @glAreTexturesResident := GetModuleSymbol(LibGL, 'glAreTexturesResident');
- @glArrayElement := GetModuleSymbol(LibGL, 'glArrayElement');
- @glBegin := GetModuleSymbol(LibGL, 'glBegin');
- @glBindTexture := GetModuleSymbol(LibGL, 'glBindTexture');
- @glBitmap := GetModuleSymbol(LibGL, 'glBitmap');
- @glBlendFunc := GetModuleSymbol(LibGL, 'glBlendFunc');
- @glCallList := GetModuleSymbol(LibGL, 'glCallList');
- @glCallLists := GetModuleSymbol(LibGL, 'glCallLists');
- @glClear := GetModuleSymbol(LibGL, 'glClear');
- @glClearAccum := GetModuleSymbol(LibGL, 'glClearAccum');
- @glClearColor := GetModuleSymbol(LibGL, 'glClearColor');
- @glClearDepth := GetModuleSymbol(LibGL, 'glClearDepth');
- @glClearIndex := GetModuleSymbol(LibGL, 'glClearIndex');
- @glClearStencil := GetModuleSymbol(LibGL, 'glClearStencil');
- @glClipPlane := GetModuleSymbol(LibGL, 'glClipPlane');
- @glColor3b := GetModuleSymbol(LibGL, 'glColor3b');
- @glColor3bv := GetModuleSymbol(LibGL, 'glColor3bv');
- @glColor3d := GetModuleSymbol(LibGL, 'glColor3d');
- @glColor3dv := GetModuleSymbol(LibGL, 'glColor3dv');
- @glColor3f := GetModuleSymbol(LibGL, 'glColor3f');
- @glColor3fv := GetModuleSymbol(LibGL, 'glColor3fv');
- @glColor3i := GetModuleSymbol(LibGL, 'glColor3i');
- @glColor3iv := GetModuleSymbol(LibGL, 'glColor3iv');
- @glColor3s := GetModuleSymbol(LibGL, 'glColor3s');
- @glColor3sv := GetModuleSymbol(LibGL, 'glColor3sv');
- @glColor3ub := GetModuleSymbol(LibGL, 'glColor3ub');
- @glColor3ubv := GetModuleSymbol(LibGL, 'glColor3ubv');
- @glColor3ui := GetModuleSymbol(LibGL, 'glColor3ui');
- @glColor3uiv := GetModuleSymbol(LibGL, 'glColor3uiv');
- @glColor3us := GetModuleSymbol(LibGL, 'glColor3us');
- @glColor3usv := GetModuleSymbol(LibGL, 'glColor3usv');
- @glColor4b := GetModuleSymbol(LibGL, 'glColor4b');
- @glColor4bv := GetModuleSymbol(LibGL, 'glColor4bv');
- @glColor4d := GetModuleSymbol(LibGL, 'glColor4d');
- @glColor4dv := GetModuleSymbol(LibGL, 'glColor4dv');
- @glColor4f := GetModuleSymbol(LibGL, 'glColor4f');
- @glColor4fv := GetModuleSymbol(LibGL, 'glColor4fv');
- @glColor4i := GetModuleSymbol(LibGL, 'glColor4i');
- @glColor4iv := GetModuleSymbol(LibGL, 'glColor4iv');
- @glColor4s := GetModuleSymbol(LibGL, 'glColor4s');
- @glColor4sv := GetModuleSymbol(LibGL, 'glColor4sv');
- @glColor4ub := GetModuleSymbol(LibGL, 'glColor4ub');
- @glColor4ubv := GetModuleSymbol(LibGL, 'glColor4ubv');
- @glColor4ui := GetModuleSymbol(LibGL, 'glColor4ui');
- @glColor4uiv := GetModuleSymbol(LibGL, 'glColor4uiv');
- @glColor4us := GetModuleSymbol(LibGL, 'glColor4us');
- @glColor4usv := GetModuleSymbol(LibGL, 'glColor4usv');
- @glColorMask := GetModuleSymbol(LibGL, 'glColorMask');
- @glColorMaterial := GetModuleSymbol(LibGL, 'glColorMaterial');
- @glColorPointer := GetModuleSymbol(LibGL, 'glColorPointer');
- @glCopyPixels := GetModuleSymbol(LibGL, 'glCopyPixels');
- @glCopyTexImage1D := GetModuleSymbol(LibGL, 'glCopyTexImage1D');
- @glCopyTexImage2D := GetModuleSymbol(LibGL, 'glCopyTexImage2D');
- @glCopyTexSubImage1D := GetModuleSymbol(LibGL, 'glCopyTexSubImage1D');
- @glCopyTexSubImage2D := GetModuleSymbol(LibGL, 'glCopyTexSubImage2D');
- @glCullFace := GetModuleSymbol(LibGL, 'glCullFace');
- @glDeleteLists := GetModuleSymbol(LibGL, 'glDeleteLists');
- @glDeleteTextures := GetModuleSymbol(LibGL, 'glDeleteTextures');
- @glDepthFunc := GetModuleSymbol(LibGL, 'glDepthFunc');
- @glDepthMask := GetModuleSymbol(LibGL, 'glDepthMask');
- @glDepthRange := GetModuleSymbol(LibGL, 'glDepthRange');
- @glDisable := GetModuleSymbol(LibGL, 'glDisable');
- @glDisableClientState := GetModuleSymbol(LibGL, 'glDisableClientState');
- @glDrawArrays := GetModuleSymbol(LibGL, 'glDrawArrays');
- @glDrawBuffer := GetModuleSymbol(LibGL, 'glDrawBuffer');
- @glDrawElements := GetModuleSymbol(LibGL, 'glDrawElements');
- @glDrawPixels := GetModuleSymbol(LibGL, 'glDrawPixels');
- @glEdgeFlag := GetModuleSymbol(LibGL, 'glEdgeFlag');
- @glEdgeFlagPointer := GetModuleSymbol(LibGL, 'glEdgeFlagPointer');
- @glEdgeFlagv := GetModuleSymbol(LibGL, 'glEdgeFlagv');
- @glEnable := GetModuleSymbol(LibGL, 'glEnable');
- @glEnableClientState := GetModuleSymbol(LibGL, 'glEnableClientState');
- @glEnd := GetModuleSymbol(LibGL, 'glEnd');
- @glEndList := GetModuleSymbol(LibGL, 'glEndList');
- @glEvalCoord1d := GetModuleSymbol(LibGL, 'glEvalCoord1d');
- @glEvalCoord1dv := GetModuleSymbol(LibGL, 'glEvalCoord1dv');
- @glEvalCoord1f := GetModuleSymbol(LibGL, 'glEvalCoord1f');
- @glEvalCoord1fv := GetModuleSymbol(LibGL, 'glEvalCoord1fv');
- @glEvalCoord2d := GetModuleSymbol(LibGL, 'glEvalCoord2d');
- @glEvalCoord2dv := GetModuleSymbol(LibGL, 'glEvalCoord2dv');
- @glEvalCoord2f := GetModuleSymbol(LibGL, 'glEvalCoord2f');
- @glEvalCoord2fv := GetModuleSymbol(LibGL, 'glEvalCoord2fv');
- @glEvalMesh1 := GetModuleSymbol(LibGL, 'glEvalMesh1');
- @glEvalMesh2 := GetModuleSymbol(LibGL, 'glEvalMesh2');
- @glEvalPoint1 := GetModuleSymbol(LibGL, 'glEvalPoint1');
- @glEvalPoint2 := GetModuleSymbol(LibGL, 'glEvalPoint2');
- @glFeedbackBuffer := GetModuleSymbol(LibGL, 'glFeedbackBuffer');
- @glFinish := GetModuleSymbol(LibGL, 'glFinish');
- @glFlush := GetModuleSymbol(LibGL, 'glFlush');
- @glFogf := GetModuleSymbol(LibGL, 'glFogf');
- @glFogfv := GetModuleSymbol(LibGL, 'glFogfv');
- @glFogi := GetModuleSymbol(LibGL, 'glFogi');
- @glFogiv := GetModuleSymbol(LibGL, 'glFogiv');
- @glFrontFace := GetModuleSymbol(LibGL, 'glFrontFace');
- @glFrustum := GetModuleSymbol(LibGL, 'glFrustum');
- @glGenLists := GetModuleSymbol(LibGL, 'glGenLists');
- @glGenTextures := GetModuleSymbol(LibGL, 'glGenTextures');
- @glGetBooleanv := GetModuleSymbol(LibGL, 'glGetBooleanv');
- @glGetClipPlane := GetModuleSymbol(LibGL, 'glGetClipPlane');
- @glGetDoublev := GetModuleSymbol(LibGL, 'glGetDoublev');
- @glGetError := GetModuleSymbol(LibGL, 'glGetError');
- @glGetFloatv := GetModuleSymbol(LibGL, 'glGetFloatv');
- @glGetIntegerv := GetModuleSymbol(LibGL, 'glGetIntegerv');
- @glGetLightfv := GetModuleSymbol(LibGL, 'glGetLightfv');
- @glGetLightiv := GetModuleSymbol(LibGL, 'glGetLightiv');
- @glGetMapdv := GetModuleSymbol(LibGL, 'glGetMapdv');
- @glGetMapfv := GetModuleSymbol(LibGL, 'glGetMapfv');
- @glGetMapiv := GetModuleSymbol(LibGL, 'glGetMapiv');
- @glGetMaterialfv := GetModuleSymbol(LibGL, 'glGetMaterialfv');
- @glGetMaterialiv := GetModuleSymbol(LibGL, 'glGetMaterialiv');
- @glGetPixelMapfv := GetModuleSymbol(LibGL, 'glGetPixelMapfv');
- @glGetPixelMapuiv := GetModuleSymbol(LibGL, 'glGetPixelMapuiv');
- @glGetPixelMapusv := GetModuleSymbol(LibGL, 'glGetPixelMapusv');
- @glGetPointerv := GetModuleSymbol(LibGL, 'glGetPointerv');
- @glGetPolygonStipple := GetModuleSymbol(LibGL, 'glGetPolygonStipple');
- @glGetString := GetModuleSymbol(LibGL, 'glGetString');
- @glGetTexEnvfv := GetModuleSymbol(LibGL, 'glGetTexEnvfv');
- @glGetTexEnviv := GetModuleSymbol(LibGL, 'glGetTexEnviv');
- @glGetTexGendv := GetModuleSymbol(LibGL, 'glGetTexGendv');
- @glGetTexGenfv := GetModuleSymbol(LibGL, 'glGetTexGenfv');
- @glGetTexGeniv := GetModuleSymbol(LibGL, 'glGetTexGeniv');
- @glGetTexImage := GetModuleSymbol(LibGL, 'glGetTexImage');
- @glGetTexLevelParameterfv := GetModuleSymbol(LibGL, 'glGetTexLevelParameterfv');
- @glGetTexLevelParameteriv := GetModuleSymbol(LibGL, 'glGetTexLevelParameteriv');
- @glGetTexParameterfv := GetModuleSymbol(LibGL, 'glGetTexParameterfv');
- @glGetTexParameteriv := GetModuleSymbol(LibGL, 'glGetTexParameteriv');
- @glHint := GetModuleSymbol(LibGL, 'glHint');
- @glIndexMask := GetModuleSymbol(LibGL, 'glIndexMask');
- @glIndexPointer := GetModuleSymbol(LibGL, 'glIndexPointer');
- @glIndexd := GetModuleSymbol(LibGL, 'glIndexd');
- @glIndexdv := GetModuleSymbol(LibGL, 'glIndexdv');
- @glIndexf := GetModuleSymbol(LibGL, 'glIndexf');
- @glIndexfv := GetModuleSymbol(LibGL, 'glIndexfv');
- @glIndexi := GetModuleSymbol(LibGL, 'glIndexi');
- @glIndexiv := GetModuleSymbol(LibGL, 'glIndexiv');
- @glIndexs := GetModuleSymbol(LibGL, 'glIndexs');
- @glIndexsv := GetModuleSymbol(LibGL, 'glIndexsv');
- @glIndexub := GetModuleSymbol(LibGL, 'glIndexub');
- @glIndexubv := GetModuleSymbol(LibGL, 'glIndexubv');
- @glInitNames := GetModuleSymbol(LibGL, 'glInitNames');
- @glInterleavedArrays := GetModuleSymbol(LibGL, 'glInterleavedArrays');
- @glIsEnabled := GetModuleSymbol(LibGL, 'glIsEnabled');
- @glIsList := GetModuleSymbol(LibGL, 'glIsList');
- @glIsTexture := GetModuleSymbol(LibGL, 'glIsTexture');
- @glLightModelf := GetModuleSymbol(LibGL, 'glLightModelf');
- @glLightModelfv := GetModuleSymbol(LibGL, 'glLightModelfv');
- @glLightModeli := GetModuleSymbol(LibGL, 'glLightModeli');
- @glLightModeliv := GetModuleSymbol(LibGL, 'glLightModeliv');
- @glLightf := GetModuleSymbol(LibGL, 'glLightf');
- @glLightfv := GetModuleSymbol(LibGL, 'glLightfv');
- @glLighti := GetModuleSymbol(LibGL, 'glLighti');
- @glLightiv := GetModuleSymbol(LibGL, 'glLightiv');
- @glLineStipple := GetModuleSymbol(LibGL, 'glLineStipple');
- @glLineWidth := GetModuleSymbol(LibGL, 'glLineWidth');
- @glListBase := GetModuleSymbol(LibGL, 'glListBase');
- @glLoadIdentity := GetModuleSymbol(LibGL, 'glLoadIdentity');
- @glLoadMatrixd := GetModuleSymbol(LibGL, 'glLoadMatrixd');
- @glLoadMatrixf := GetModuleSymbol(LibGL, 'glLoadMatrixf');
- @glLoadName := GetModuleSymbol(LibGL, 'glLoadName');
- @glLogicOp := GetModuleSymbol(LibGL, 'glLogicOp');
- @glMap1d := GetModuleSymbol(LibGL, 'glMap1d');
- @glMap1f := GetModuleSymbol(LibGL, 'glMap1f');
- @glMap2d := GetModuleSymbol(LibGL, 'glMap2d');
- @glMap2f := GetModuleSymbol(LibGL, 'glMap2f');
- @glMapGrid1d := GetModuleSymbol(LibGL, 'glMapGrid1d');
- @glMapGrid1f := GetModuleSymbol(LibGL, 'glMapGrid1f');
- @glMapGrid2d := GetModuleSymbol(LibGL, 'glMapGrid2d');
- @glMapGrid2f := GetModuleSymbol(LibGL, 'glMapGrid2f');
- @glMaterialf := GetModuleSymbol(LibGL, 'glMaterialf');
- @glMaterialfv := GetModuleSymbol(LibGL, 'glMaterialfv');
- @glMateriali := GetModuleSymbol(LibGL, 'glMateriali');
- @glMaterialiv := GetModuleSymbol(LibGL, 'glMaterialiv');
- @glMatrixMode := GetModuleSymbol(LibGL, 'glMatrixMode');
- @glMultMatrixd := GetModuleSymbol(LibGL, 'glMultMatrixd');
- @glMultMatrixf := GetModuleSymbol(LibGL, 'glMultMatrixf');
- @glNewList := GetModuleSymbol(LibGL, 'glNewList');
- @glNormal3b := GetModuleSymbol(LibGL, 'glNormal3b');
- @glNormal3bv := GetModuleSymbol(LibGL, 'glNormal3bv');
- @glNormal3d := GetModuleSymbol(LibGL, 'glNormal3d');
- @glNormal3dv := GetModuleSymbol(LibGL, 'glNormal3dv');
- @glNormal3f := GetModuleSymbol(LibGL, 'glNormal3f');
- @glNormal3fv := GetModuleSymbol(LibGL, 'glNormal3fv');
- @glNormal3i := GetModuleSymbol(LibGL, 'glNormal3i');
- @glNormal3iv := GetModuleSymbol(LibGL, 'glNormal3iv');
- @glNormal3s := GetModuleSymbol(LibGL, 'glNormal3s');
- @glNormal3sv := GetModuleSymbol(LibGL, 'glNormal3sv');
- @glNormalPointer := GetModuleSymbol(LibGL, 'glNormalPointer');
- @glOrtho := GetModuleSymbol(LibGL, 'glOrtho');
- @glPassThrough := GetModuleSymbol(LibGL, 'glPassThrough');
- @glPixelMapfv := GetModuleSymbol(LibGL, 'glPixelMapfv');
- @glPixelMapuiv := GetModuleSymbol(LibGL, 'glPixelMapuiv');
- @glPixelMapusv := GetModuleSymbol(LibGL, 'glPixelMapusv');
- @glPixelStoref := GetModuleSymbol(LibGL, 'glPixelStoref');
- @glPixelStorei := GetModuleSymbol(LibGL, 'glPixelStorei');
- @glPixelTransferf := GetModuleSymbol(LibGL, 'glPixelTransferf');
- @glPixelTransferi := GetModuleSymbol(LibGL, 'glPixelTransferi');
- @glPixelZoom := GetModuleSymbol(LibGL, 'glPixelZoom');
- @glPointSize := GetModuleSymbol(LibGL, 'glPointSize');
- @glPolygonMode := GetModuleSymbol(LibGL, 'glPolygonMode');
- @glPolygonOffset := GetModuleSymbol(LibGL, 'glPolygonOffset');
- @glPolygonStipple := GetModuleSymbol(LibGL, 'glPolygonStipple');
- @glPopAttrib := GetModuleSymbol(LibGL, 'glPopAttrib');
- @glPopClientAttrib := GetModuleSymbol(LibGL, 'glPopClientAttrib');
- @glPopMatrix := GetModuleSymbol(LibGL, 'glPopMatrix');
- @glPopName := GetModuleSymbol(LibGL, 'glPopName');
- @glPrioritizeTextures := GetModuleSymbol(LibGL, 'glPrioritizeTextures');
- @glPushAttrib := GetModuleSymbol(LibGL, 'glPushAttrib');
- @glPushClientAttrib := GetModuleSymbol(LibGL, 'glPushClientAttrib');
- @glPushMatrix := GetModuleSymbol(LibGL, 'glPushMatrix');
- @glPushName := GetModuleSymbol(LibGL, 'glPushName');
- @glRasterPos2d := GetModuleSymbol(LibGL, 'glRasterPos2d');
- @glRasterPos2dv := GetModuleSymbol(LibGL, 'glRasterPos2dv');
- @glRasterPos2f := GetModuleSymbol(LibGL, 'glRasterPos2f');
- @glRasterPos2fv := GetModuleSymbol(LibGL, 'glRasterPos2fv');
- @glRasterPos2i := GetModuleSymbol(LibGL, 'glRasterPos2i');
- @glRasterPos2iv := GetModuleSymbol(LibGL, 'glRasterPos2iv');
- @glRasterPos2s := GetModuleSymbol(LibGL, 'glRasterPos2s');
- @glRasterPos2sv := GetModuleSymbol(LibGL, 'glRasterPos2sv');
- @glRasterPos3d := GetModuleSymbol(LibGL, 'glRasterPos3d');
- @glRasterPos3dv := GetModuleSymbol(LibGL, 'glRasterPos3dv');
- @glRasterPos3f := GetModuleSymbol(LibGL, 'glRasterPos3f');
- @glRasterPos3fv := GetModuleSymbol(LibGL, 'glRasterPos3fv');
- @glRasterPos3i := GetModuleSymbol(LibGL, 'glRasterPos3i');
- @glRasterPos3iv := GetModuleSymbol(LibGL, 'glRasterPos3iv');
- @glRasterPos3s := GetModuleSymbol(LibGL, 'glRasterPos3s');
- @glRasterPos3sv := GetModuleSymbol(LibGL, 'glRasterPos3sv');
- @glRasterPos4d := GetModuleSymbol(LibGL, 'glRasterPos4d');
- @glRasterPos4dv := GetModuleSymbol(LibGL, 'glRasterPos4dv');
- @glRasterPos4f := GetModuleSymbol(LibGL, 'glRasterPos4f');
- @glRasterPos4fv := GetModuleSymbol(LibGL, 'glRasterPos4fv');
- @glRasterPos4i := GetModuleSymbol(LibGL, 'glRasterPos4i');
- @glRasterPos4iv := GetModuleSymbol(LibGL, 'glRasterPos4iv');
- @glRasterPos4s := GetModuleSymbol(LibGL, 'glRasterPos4s');
- @glRasterPos4sv := GetModuleSymbol(LibGL, 'glRasterPos4sv');
- @glReadBuffer := GetModuleSymbol(LibGL, 'glReadBuffer');
- @glReadPixels := GetModuleSymbol(LibGL, 'glReadPixels');
- @glRectd := GetModuleSymbol(LibGL, 'glRectd');
- @glRectdv := GetModuleSymbol(LibGL, 'glRectdv');
- @glRectf := GetModuleSymbol(LibGL, 'glRectf');
- @glRectfv := GetModuleSymbol(LibGL, 'glRectfv');
- @glRecti := GetModuleSymbol(LibGL, 'glRecti');
- @glRectiv := GetModuleSymbol(LibGL, 'glRectiv');
- @glRects := GetModuleSymbol(LibGL, 'glRects');
- @glRectsv := GetModuleSymbol(LibGL, 'glRectsv');
- @glRenderMode := GetModuleSymbol(LibGL, 'glRenderMode');
- @glRotated := GetModuleSymbol(LibGL, 'glRotated');
- @glRotatef := GetModuleSymbol(LibGL, 'glRotatef');
- @glScaled := GetModuleSymbol(LibGL, 'glScaled');
- @glScalef := GetModuleSymbol(LibGL, 'glScalef');
- @glScissor := GetModuleSymbol(LibGL, 'glScissor');
- @glSelectBuffer := GetModuleSymbol(LibGL, 'glSelectBuffer');
- @glShadeModel := GetModuleSymbol(LibGL, 'glShadeModel');
- @glStencilFunc := GetModuleSymbol(LibGL, 'glStencilFunc');
- @glStencilMask := GetModuleSymbol(LibGL, 'glStencilMask');
- @glStencilOp := GetModuleSymbol(LibGL, 'glStencilOp');
- @glTexCoord1d := GetModuleSymbol(LibGL, 'glTexCoord1d');
- @glTexCoord1dv := GetModuleSymbol(LibGL, 'glTexCoord1dv');
- @glTexCoord1f := GetModuleSymbol(LibGL, 'glTexCoord1f');
- @glTexCoord1fv := GetModuleSymbol(LibGL, 'glTexCoord1fv');
- @glTexCoord1i := GetModuleSymbol(LibGL, 'glTexCoord1i');
- @glTexCoord1iv := GetModuleSymbol(LibGL, 'glTexCoord1iv');
- @glTexCoord1s := GetModuleSymbol(LibGL, 'glTexCoord1s');
- @glTexCoord1sv := GetModuleSymbol(LibGL, 'glTexCoord1sv');
- @glTexCoord2d := GetModuleSymbol(LibGL, 'glTexCoord2d');
- @glTexCoord2dv := GetModuleSymbol(LibGL, 'glTexCoord2dv');
- @glTexCoord2f := GetModuleSymbol(LibGL, 'glTexCoord2f');
- @glTexCoord2fv := GetModuleSymbol(LibGL, 'glTexCoord2fv');
- @glTexCoord2i := GetModuleSymbol(LibGL, 'glTexCoord2i');
- @glTexCoord2iv := GetModuleSymbol(LibGL, 'glTexCoord2iv');
- @glTexCoord2s := GetModuleSymbol(LibGL, 'glTexCoord2s');
- @glTexCoord2sv := GetModuleSymbol(LibGL, 'glTexCoord2sv');
- @glTexCoord3d := GetModuleSymbol(LibGL, 'glTexCoord3d');
- @glTexCoord3dv := GetModuleSymbol(LibGL, 'glTexCoord3dv');
- @glTexCoord3f := GetModuleSymbol(LibGL, 'glTexCoord3f');
- @glTexCoord3fv := GetModuleSymbol(LibGL, 'glTexCoord3fv');
- @glTexCoord3i := GetModuleSymbol(LibGL, 'glTexCoord3i');
- @glTexCoord3iv := GetModuleSymbol(LibGL, 'glTexCoord3iv');
- @glTexCoord3s := GetModuleSymbol(LibGL, 'glTexCoord3s');
- @glTexCoord3sv := GetModuleSymbol(LibGL, 'glTexCoord3sv');
- @glTexCoord4d := GetModuleSymbol(LibGL, 'glTexCoord4d');
- @glTexCoord4dv := GetModuleSymbol(LibGL, 'glTexCoord4dv');
- @glTexCoord4f := GetModuleSymbol(LibGL, 'glTexCoord4f');
- @glTexCoord4fv := GetModuleSymbol(LibGL, 'glTexCoord4fv');
- @glTexCoord4i := GetModuleSymbol(LibGL, 'glTexCoord4i');
- @glTexCoord4iv := GetModuleSymbol(LibGL, 'glTexCoord4iv');
- @glTexCoord4s := GetModuleSymbol(LibGL, 'glTexCoord4s');
- @glTexCoord4sv := GetModuleSymbol(LibGL, 'glTexCoord4sv');
- @glTexCoordPointer := GetModuleSymbol(LibGL, 'glTexCoordPointer');
- @glTexEnvf := GetModuleSymbol(LibGL, 'glTexEnvf');
- @glTexEnvfv := GetModuleSymbol(LibGL, 'glTexEnvfv');
- @glTexEnvi := GetModuleSymbol(LibGL, 'glTexEnvi');
- @glTexEnviv := GetModuleSymbol(LibGL, 'glTexEnviv');
- @glTexGend := GetModuleSymbol(LibGL, 'glTexGend');
- @glTexGendv := GetModuleSymbol(LibGL, 'glTexGendv');
- @glTexGenf := GetModuleSymbol(LibGL, 'glTexGenf');
- @glTexGenfv := GetModuleSymbol(LibGL, 'glTexGenfv');
- @glTexGeni := GetModuleSymbol(LibGL, 'glTexGeni');
- @glTexGeniv := GetModuleSymbol(LibGL, 'glTexGeniv');
- @glTexImage1D := GetModuleSymbol(LibGL, 'glTexImage1D');
- @glTexImage2D := GetModuleSymbol(LibGL, 'glTexImage2D');
- @glTexParameterf := GetModuleSymbol(LibGL, 'glTexParameterf');
- @glTexParameterfv := GetModuleSymbol(LibGL, 'glTexParameterfv');
- @glTexParameteri := GetModuleSymbol(LibGL, 'glTexParameteri');
- @glTexParameteriv := GetModuleSymbol(LibGL, 'glTexParameteriv');
- @glTexSubImage1D := GetModuleSymbol(LibGL, 'glTexSubImage1D');
- @glTexSubImage2D := GetModuleSymbol(LibGL, 'glTexSubImage2D');
- @glTranslated := GetModuleSymbol(LibGL, 'glTranslated');
- @glTranslatef := GetModuleSymbol(LibGL, 'glTranslatef');
- @glVertex2d := GetModuleSymbol(LibGL, 'glVertex2d');
- @glVertex2dv := GetModuleSymbol(LibGL, 'glVertex2dv');
- @glVertex2f := GetModuleSymbol(LibGL, 'glVertex2f');
- @glVertex2fv := GetModuleSymbol(LibGL, 'glVertex2fv');
- @glVertex2i := GetModuleSymbol(LibGL, 'glVertex2i');
- @glVertex2iv := GetModuleSymbol(LibGL, 'glVertex2iv');
- @glVertex2s := GetModuleSymbol(LibGL, 'glVertex2s');
- @glVertex2sv := GetModuleSymbol(LibGL, 'glVertex2sv');
- @glVertex3d := GetModuleSymbol(LibGL, 'glVertex3d');
- @glVertex3dv := GetModuleSymbol(LibGL, 'glVertex3dv');
- @glVertex3f := GetModuleSymbol(LibGL, 'glVertex3f');
- @glVertex3fv := GetModuleSymbol(LibGL, 'glVertex3fv');
- @glVertex3i := GetModuleSymbol(LibGL, 'glVertex3i');
- @glVertex3iv := GetModuleSymbol(LibGL, 'glVertex3iv');
- @glVertex3s := GetModuleSymbol(LibGL, 'glVertex3s');
- @glVertex3sv := GetModuleSymbol(LibGL, 'glVertex3sv');
- @glVertex4d := GetModuleSymbol(LibGL, 'glVertex4d');
- @glVertex4dv := GetModuleSymbol(LibGL, 'glVertex4dv');
- @glVertex4f := GetModuleSymbol(LibGL, 'glVertex4f');
- @glVertex4fv := GetModuleSymbol(LibGL, 'glVertex4fv');
- @glVertex4i := GetModuleSymbol(LibGL, 'glVertex4i');
- @glVertex4iv := GetModuleSymbol(LibGL, 'glVertex4iv');
- @glVertex4s := GetModuleSymbol(LibGL, 'glVertex4s');
- @glVertex4sv := GetModuleSymbol(LibGL, 'glVertex4sv');
- @glVertexPointer := GetModuleSymbol(LibGL, 'glVertexPointer');
- @glViewport := GetModuleSymbol(LibGL, 'glViewport');
-
- {$IFDEF WINDOWS}
- @ChoosePixelFormat := GetModuleSymbol(LibGL, 'ChoosePixelFormat');
- if not Assigned(ChoosePixelFormat) then
- {$IFNDEF FPC}@{$ENDIF}ChoosePixelFormat := @Windows.ChoosePixelFormat;
- {$ENDIF}
- end;
-end;
-
-initialization
- {$IF Defined(CPU386) or Defined(CPUI386) or Defined(CPUX86_64)}
- Set8087CW($133F);
- {$IFEND}
-
- LoadOpenGL( GLLibName );
-
-finalization
-
- FreeOpenGL;
-
-end.
-
+unit gl; +{ + $Id: gl.pas,v 1.5 2007/05/20 20:28:31 savage Exp $ + + 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-96, Microsoft Corporation + +Module Name: + + gl.h + +Abstract: + + Procedure declarations, constant definitions and macros for the OpenGL + component. + +--*) + +(* +** Copyright 1996 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. +*) + +{******************************************************************************} +{ } +{ Converted to Delphi by Tom Nuydens (tom@delphi3d.net) } +{ For the latest updates, visit Delphi3D: http://www.delphi3d.net } +{ } +{ Modified for Delphi/Kylix and FreePascal } +{ by Dominique Louis ( Dominique@Savagesoftware.com.au) } +{ For the latest updates, visit JEDI-SDL : http://www.sf.net/projects/jedi-sdl } +{ } +{******************************************************************************} + +{ + $Log: gl.pas,v $ + Revision 1.5 2007/05/20 20:28:31 savage + Initial Changes to Handle 64 Bits + + Revision 1.4 2006/11/20 21:20:59 savage + Updated to work in MacOS X + + Revision 1.3 2005/05/22 18:52:09 savage + Changes as suggested by Michalis Kamburelis. Thanks again. + + Revision 1.2 2004/08/14 22:54:30 savage + Updated so that Library name defines are correctly defined for MacOS X. + + Revision 1.1 2004/03/30 21:53:54 savage + Moved to it's own folder. + + Revision 1.4 2004/02/20 17:09:55 savage + Code tidied up in gl, glu and glut, while extensions in glext.pas are now loaded using SDL_GL_GetProcAddress, thus making it more cross-platform compatible, but now more tied to SDL. + + Revision 1.3 2004/02/14 00:23:39 savage + As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change. + + Revision 1.2 2004/02/14 00:09:18 savage + Changed uses to now make use of moduleloader.pas rather than dllfuncs.pas + + Revision 1.1 2004/02/05 00:08:19 savage + Module 1.0 release + + Revision 1.6 2003/06/02 12:32:12 savage + Modified Sources to avoid warnings with Delphi by moving CVS Logging to the top of the header files. Hopefully CVS Logging still works. + +} + +interface + +{$I jedi-sdl.inc} + +uses +{$IFDEF __GPC__} + system, + gpc, +{$ENDIF} + +{$IFDEF WINDOWS} + Windows, +{$ENDIF} + moduleloader; + + +var + LibGL: TModuleHandle; + +type + GLenum = Cardinal; PGLenum = ^GLenum; + GLboolean = Byte; PGLboolean = ^GLboolean; + GLbitfield = Cardinal; PGLbitfield = ^GLbitfield; + GLbyte = ShortInt; PGLbyte = ^GLbyte; + GLshort = SmallInt; PGLshort = ^GLshort; + GLint = Integer; PGLint = ^GLint; + GLsizei = Integer; PGLsizei = ^GLsizei; + GLubyte = Byte; PGLubyte = ^GLubyte; + GLushort = Word; PGLushort = ^GLushort; + GLuint = Cardinal; PGLuint = ^GLuint; + GLfloat = Single; PGLfloat = ^GLfloat; + GLclampf = Single; PGLclampf = ^GLclampf; + GLdouble = Double; PGLdouble = ^GLdouble; + GLclampd = Double; PGLclampd = ^GLclampd; +{ GLvoid = void; } PGLvoid = Pointer; + +{******************************************************************************} + +const +{$IFDEF WINDOWS} + GLLibName = 'OpenGL32.dll'; +{$ENDIF} + +{$IFDEF UNIX} +{$IFDEF DARWIN} + GLLibName = '/System/Library/Frameworks/OpenGL.framework/Libraries/libGL.dylib'; +{$ELSE} + GLLibName = 'libGL.so'; +{$ENDIF} +{$ENDIF} + + // Version + GL_VERSION_1_1 = 1; + + // AccumOp + GL_ACCUM = $0100; + GL_LOAD = $0101; + GL_RETURN = $0102; + GL_MULT = $0103; + GL_ADD = $0104; + + // AlphaFunction + GL_NEVER = $0200; + GL_LESS = $0201; + GL_EQUAL = $0202; + GL_LEQUAL = $0203; + GL_GREATER = $0204; + GL_NOTEQUAL = $0205; + GL_GEQUAL = $0206; + GL_ALWAYS = $0207; + + // AttribMask + GL_CURRENT_BIT = $00000001; + GL_POINT_BIT = $00000002; + GL_LINE_BIT = $00000004; + GL_POLYGON_BIT = $00000008; + GL_POLYGON_STIPPLE_BIT = $00000010; + GL_PIXEL_MODE_BIT = $00000020; + GL_LIGHTING_BIT = $00000040; + GL_FOG_BIT = $00000080; + GL_DEPTH_BUFFER_BIT = $00000100; + GL_ACCUM_BUFFER_BIT = $00000200; + GL_STENCIL_BUFFER_BIT = $00000400; + GL_VIEWPORT_BIT = $00000800; + GL_TRANSFORM_BIT = $00001000; + GL_ENABLE_BIT = $00002000; + GL_COLOR_BUFFER_BIT = $00004000; + GL_HINT_BIT = $00008000; + GL_EVAL_BIT = $00010000; + GL_LIST_BIT = $00020000; + GL_TEXTURE_BIT = $00040000; + GL_SCISSOR_BIT = $00080000; + GL_ALL_ATTRIB_BITS = $000FFFFF; + + // BeginMode + GL_POINTS = $0000; + GL_LINES = $0001; + GL_LINE_LOOP = $0002; + GL_LINE_STRIP = $0003; + GL_TRIANGLES = $0004; + GL_TRIANGLE_STRIP = $0005; + GL_TRIANGLE_FAN = $0006; + GL_QUADS = $0007; + GL_QUAD_STRIP = $0008; + GL_POLYGON = $0009; + + // BlendingFactorDest + GL_ZERO = 0; + GL_ONE = 1; + GL_SRC_COLOR = $0300; + GL_ONE_MINUS_SRC_COLOR = $0301; + GL_SRC_ALPHA = $0302; + GL_ONE_MINUS_SRC_ALPHA = $0303; + GL_DST_ALPHA = $0304; + GL_ONE_MINUS_DST_ALPHA = $0305; + + // BlendingFactorSrc + // GL_ZERO + // GL_ONE + GL_DST_COLOR = $0306; + GL_ONE_MINUS_DST_COLOR = $0307; + GL_SRC_ALPHA_SATURATE = $0308; + // GL_SRC_ALPHA + // GL_ONE_MINUS_SRC_ALPHA + // GL_DST_ALPHA + // GL_ONE_MINUS_DST_ALPHA + + // Boolean + GL_TRUE = 1; + GL_FALSE = 0; + + // ClearBufferMask + // GL_COLOR_BUFFER_BIT + // GL_ACCUM_BUFFER_BIT + // GL_STENCIL_BUFFER_BIT + // GL_DEPTH_BUFFER_BIT + + // ClientArrayType + // GL_VERTEX_ARRAY + // GL_NORMAL_ARRAY + // GL_COLOR_ARRAY + // GL_INDEX_ARRAY + // GL_TEXTURE_COORD_ARRAY + // GL_EDGE_FLAG_ARRAY + + // ClipPlaneName + GL_CLIP_PLANE0 = $3000; + GL_CLIP_PLANE1 = $3001; + GL_CLIP_PLANE2 = $3002; + GL_CLIP_PLANE3 = $3003; + GL_CLIP_PLANE4 = $3004; + GL_CLIP_PLANE5 = $3005; + + // ColorMaterialFace + // GL_FRONT + // GL_BACK + // GL_FRONT_AND_BACK + + // ColorMaterialParameter + // GL_AMBIENT + // GL_DIFFUSE + // GL_SPECULAR + // GL_EMISSION + // GL_AMBIENT_AND_DIFFUSE + + // ColorPointerType + // GL_BYTE + // GL_UNSIGNED_BYTE + // GL_SHORT + // GL_UNSIGNED_SHORT + // GL_INT + // GL_UNSIGNED_INT + // GL_FLOAT + // GL_DOUBLE + + // CullFaceMode + // GL_FRONT + // GL_BACK + // GL_FRONT_AND_BACK + + // DataType + GL_BYTE = $1400; + GL_UNSIGNED_BYTE = $1401; + GL_SHORT = $1402; + GL_UNSIGNED_SHORT = $1403; + GL_INT = $1404; + GL_UNSIGNED_INT = $1405; + GL_FLOAT = $1406; + GL_2_BYTES = $1407; + GL_3_BYTES = $1408; + GL_4_BYTES = $1409; + GL_DOUBLE = $140A; + + // DepthFunction + // GL_NEVER + // GL_LESS + // GL_EQUAL + // GL_LEQUAL + // GL_GREATER + // GL_NOTEQUAL + // GL_GEQUAL + // GL_ALWAYS + + // DrawBufferMode + GL_NONE = 0; + GL_FRONT_LEFT = $0400; + GL_FRONT_RIGHT = $0401; + GL_BACK_LEFT = $0402; + GL_BACK_RIGHT = $0403; + GL_FRONT = $0404; + GL_BACK = $0405; + GL_LEFT = $0406; + GL_RIGHT = $0407; + GL_FRONT_AND_BACK = $0408; + GL_AUX0 = $0409; + GL_AUX1 = $040A; + GL_AUX2 = $040B; + GL_AUX3 = $040C; + + // Enable + // GL_FOG + // GL_LIGHTING + // GL_TEXTURE_1D + // GL_TEXTURE_2D + // GL_LINE_STIPPLE + // GL_POLYGON_STIPPLE + // GL_CULL_FACE + // GL_ALPHA_TEST + // GL_BLEND + // GL_INDEX_LOGIC_OP + // GL_COLOR_LOGIC_OP + // GL_DITHER + // GL_STENCIL_TEST + // GL_DEPTH_TEST + // GL_CLIP_PLANE0 + // GL_CLIP_PLANE1 + // GL_CLIP_PLANE2 + // GL_CLIP_PLANE3 + // GL_CLIP_PLANE4 + // GL_CLIP_PLANE5 + // GL_LIGHT0 + // GL_LIGHT1 + // GL_LIGHT2 + // GL_LIGHT3 + // GL_LIGHT4 + // GL_LIGHT5 + // GL_LIGHT6 + // GL_LIGHT7 + // GL_TEXTURE_GEN_S + // GL_TEXTURE_GEN_T + // GL_TEXTURE_GEN_R + // GL_TEXTURE_GEN_Q + // GL_MAP1_VERTEX_3 + // GL_MAP1_VERTEX_4 + // GL_MAP1_COLOR_4 + // GL_MAP1_INDEX + // GL_MAP1_NORMAL + // GL_MAP1_TEXTURE_COORD_1 + // GL_MAP1_TEXTURE_COORD_2 + // GL_MAP1_TEXTURE_COORD_3 + // GL_MAP1_TEXTURE_COORD_4 + // GL_MAP2_VERTEX_3 + // GL_MAP2_VERTEX_4 + // GL_MAP2_COLOR_4 + // GL_MAP2_INDEX + // GL_MAP2_NORMAL + // GL_MAP2_TEXTURE_COORD_1 + // GL_MAP2_TEXTURE_COORD_2 + // GL_MAP2_TEXTURE_COORD_3 + // GL_MAP2_TEXTURE_COORD_4 + // GL_POINT_SMOOTH + // GL_LINE_SMOOTH + // GL_POLYGON_SMOOTH + // GL_SCISSOR_TEST + // GL_COLOR_MATERIAL + // GL_NORMALIZE + // GL_AUTO_NORMAL + // GL_VERTEX_ARRAY + // GL_NORMAL_ARRAY + // GL_COLOR_ARRAY + // GL_INDEX_ARRAY + // GL_TEXTURE_COORD_ARRAY + // GL_EDGE_FLAG_ARRAY + // GL_POLYGON_OFFSET_POINT + // GL_POLYGON_OFFSET_LINE + // GL_POLYGON_OFFSET_FILL + + // ErrorCode + GL_NO_ERROR = 0; + GL_INVALID_ENUM = $0500; + GL_INVALID_VALUE = $0501; + GL_INVALID_OPERATION = $0502; + GL_STACK_OVERFLOW = $0503; + GL_STACK_UNDERFLOW = $0504; + GL_OUT_OF_MEMORY = $0505; + + // FeedBackMode + GL_2D = $0600; + GL_3D = $0601; + GL_3D_COLOR = $0602; + GL_3D_COLOR_TEXTURE = $0603; + GL_4D_COLOR_TEXTURE = $0604; + + // FeedBackToken + GL_PASS_THROUGH_TOKEN = $0700; + GL_POINT_TOKEN = $0701; + GL_LINE_TOKEN = $0702; + GL_POLYGON_TOKEN = $0703; + GL_BITMAP_TOKEN = $0704; + GL_DRAW_PIXEL_TOKEN = $0705; + GL_COPY_PIXEL_TOKEN = $0706; + GL_LINE_RESET_TOKEN = $0707; + + // FogMode + // GL_LINEAR + GL_EXP = $0800; + GL_EXP2 = $0801; + + // FogParameter + // GL_FOG_COLOR + // GL_FOG_DENSITY + // GL_FOG_END + // GL_FOG_INDEX + // GL_FOG_MODE + // GL_FOG_START + + // FrontFaceDirection + GL_CW = $0900; + GL_CCW = $0901; + + // GetMapTarget + GL_COEFF = $0A00; + GL_ORDER = $0A01; + GL_DOMAIN = $0A02; + + // GetPixelMap + // GL_PIXEL_MAP_I_TO_I + // GL_PIXEL_MAP_S_TO_S + // GL_PIXEL_MAP_I_TO_R + // GL_PIXEL_MAP_I_TO_G + // GL_PIXEL_MAP_I_TO_B + // GL_PIXEL_MAP_I_TO_A + // GL_PIXEL_MAP_R_TO_R + // GL_PIXEL_MAP_G_TO_G + // GL_PIXEL_MAP_B_TO_B + // GL_PIXEL_MAP_A_TO_A + + // GetPointerTarget + // GL_VERTEX_ARRAY_POINTER + // GL_NORMAL_ARRAY_POINTER + // GL_COLOR_ARRAY_POINTER + // GL_INDEX_ARRAY_POINTER + // GL_TEXTURE_COORD_ARRAY_POINTER + // GL_EDGE_FLAG_ARRAY_POINTER + + // GetTarget + GL_CURRENT_COLOR = $0B00; + GL_CURRENT_INDEX = $0B01; + GL_CURRENT_NORMAL = $0B02; + GL_CURRENT_TEXTURE_COORDS = $0B03; + GL_CURRENT_RASTER_COLOR = $0B04; + GL_CURRENT_RASTER_INDEX = $0B05; + GL_CURRENT_RASTER_TEXTURE_COORDS = $0B06; + GL_CURRENT_RASTER_POSITION = $0B07; + GL_CURRENT_RASTER_POSITION_VALID = $0B08; + GL_CURRENT_RASTER_DISTANCE = $0B09; + GL_POINT_SMOOTH = $0B10; + GL_POINT_SIZE = $0B11; + GL_POINT_SIZE_RANGE = $0B12; + GL_POINT_SIZE_GRANULARITY = $0B13; + GL_LINE_SMOOTH = $0B20; + GL_LINE_WIDTH = $0B21; + GL_LINE_WIDTH_RANGE = $0B22; + GL_LINE_WIDTH_GRANULARITY = $0B23; + GL_LINE_STIPPLE = $0B24; + GL_LINE_STIPPLE_PATTERN = $0B25; + GL_LINE_STIPPLE_REPEAT = $0B26; + GL_LIST_MODE = $0B30; + GL_MAX_LIST_NESTING = $0B31; + GL_LIST_BASE = $0B32; + GL_LIST_INDEX = $0B33; + GL_POLYGON_MODE = $0B40; + GL_POLYGON_SMOOTH = $0B41; + GL_POLYGON_STIPPLE = $0B42; + GL_EDGE_FLAG = $0B43; + GL_CULL_FACE = $0B44; + GL_CULL_FACE_MODE = $0B45; + GL_FRONT_FACE = $0B46; + GL_LIGHTING = $0B50; + GL_LIGHT_MODEL_LOCAL_VIEWER = $0B51; + GL_LIGHT_MODEL_TWO_SIDE = $0B52; + GL_LIGHT_MODEL_AMBIENT = $0B53; + GL_SHADE_MODEL = $0B54; + GL_COLOR_MATERIAL_FACE = $0B55; + GL_COLOR_MATERIAL_PARAMETER = $0B56; + GL_COLOR_MATERIAL = $0B57; + GL_FOG = $0B60; + GL_FOG_INDEX = $0B61; + GL_FOG_DENSITY = $0B62; + GL_FOG_START = $0B63; + GL_FOG_END = $0B64; + GL_FOG_MODE = $0B65; + GL_FOG_COLOR = $0B66; + GL_DEPTH_RANGE = $0B70; + GL_DEPTH_TEST = $0B71; + GL_DEPTH_WRITEMASK = $0B72; + GL_DEPTH_CLEAR_VALUE = $0B73; + GL_DEPTH_FUNC = $0B74; + GL_ACCUM_CLEAR_VALUE = $0B80; + GL_STENCIL_TEST = $0B90; + GL_STENCIL_CLEAR_VALUE = $0B91; + GL_STENCIL_FUNC = $0B92; + GL_STENCIL_VALUE_MASK = $0B93; + GL_STENCIL_FAIL = $0B94; + GL_STENCIL_PASS_DEPTH_FAIL = $0B95; + GL_STENCIL_PASS_DEPTH_PASS = $0B96; + GL_STENCIL_REF = $0B97; + GL_STENCIL_WRITEMASK = $0B98; + GL_MATRIX_MODE = $0BA0; + GL_NORMALIZE = $0BA1; + GL_VIEWPORT = $0BA2; + GL_MODELVIEW_STACK_DEPTH = $0BA3; + GL_PROJECTION_STACK_DEPTH = $0BA4; + GL_TEXTURE_STACK_DEPTH = $0BA5; + GL_MODELVIEW_MATRIX = $0BA6; + GL_PROJECTION_MATRIX = $0BA7; + GL_TEXTURE_MATRIX = $0BA8; + GL_ATTRIB_STACK_DEPTH = $0BB0; + GL_CLIENT_ATTRIB_STACK_DEPTH = $0BB1; + GL_ALPHA_TEST = $0BC0; + GL_ALPHA_TEST_FUNC = $0BC1; + GL_ALPHA_TEST_REF = $0BC2; + GL_DITHER = $0BD0; + GL_BLEND_DST = $0BE0; + GL_BLEND_SRC = $0BE1; + GL_BLEND = $0BE2; + GL_LOGIC_OP_MODE = $0BF0; + GL_INDEX_LOGIC_OP = $0BF1; + GL_COLOR_LOGIC_OP = $0BF2; + GL_AUX_BUFFERS = $0C00; + GL_DRAW_BUFFER = $0C01; + GL_READ_BUFFER = $0C02; + GL_SCISSOR_BOX = $0C10; + GL_SCISSOR_TEST = $0C11; + GL_INDEX_CLEAR_VALUE = $0C20; + GL_INDEX_WRITEMASK = $0C21; + GL_COLOR_CLEAR_VALUE = $0C22; + GL_COLOR_WRITEMASK = $0C23; + GL_INDEX_MODE = $0C30; + GL_RGBA_MODE = $0C31; + GL_DOUBLEBUFFER = $0C32; + GL_STEREO = $0C33; + GL_RENDER_MODE = $0C40; + GL_PERSPECTIVE_CORRECTION_HINT = $0C50; + GL_POINT_SMOOTH_HINT = $0C51; + GL_LINE_SMOOTH_HINT = $0C52; + GL_POLYGON_SMOOTH_HINT = $0C53; + GL_FOG_HINT = $0C54; + GL_TEXTURE_GEN_S = $0C60; + GL_TEXTURE_GEN_T = $0C61; + GL_TEXTURE_GEN_R = $0C62; + GL_TEXTURE_GEN_Q = $0C63; + GL_PIXEL_MAP_I_TO_I = $0C70; + GL_PIXEL_MAP_S_TO_S = $0C71; + GL_PIXEL_MAP_I_TO_R = $0C72; + GL_PIXEL_MAP_I_TO_G = $0C73; + GL_PIXEL_MAP_I_TO_B = $0C74; + GL_PIXEL_MAP_I_TO_A = $0C75; + GL_PIXEL_MAP_R_TO_R = $0C76; + GL_PIXEL_MAP_G_TO_G = $0C77; + GL_PIXEL_MAP_B_TO_B = $0C78; + GL_PIXEL_MAP_A_TO_A = $0C79; + GL_PIXEL_MAP_I_TO_I_SIZE = $0CB0; + GL_PIXEL_MAP_S_TO_S_SIZE = $0CB1; + GL_PIXEL_MAP_I_TO_R_SIZE = $0CB2; + GL_PIXEL_MAP_I_TO_G_SIZE = $0CB3; + GL_PIXEL_MAP_I_TO_B_SIZE = $0CB4; + GL_PIXEL_MAP_I_TO_A_SIZE = $0CB5; + GL_PIXEL_MAP_R_TO_R_SIZE = $0CB6; + GL_PIXEL_MAP_G_TO_G_SIZE = $0CB7; + GL_PIXEL_MAP_B_TO_B_SIZE = $0CB8; + GL_PIXEL_MAP_A_TO_A_SIZE = $0CB9; + GL_UNPACK_SWAP_BYTES = $0CF0; + GL_UNPACK_LSB_FIRST = $0CF1; + GL_UNPACK_ROW_LENGTH = $0CF2; + GL_UNPACK_SKIP_ROWS = $0CF3; + GL_UNPACK_SKIP_PIXELS = $0CF4; + GL_UNPACK_ALIGNMENT = $0CF5; + GL_PACK_SWAP_BYTES = $0D00; + GL_PACK_LSB_FIRST = $0D01; + GL_PACK_ROW_LENGTH = $0D02; + GL_PACK_SKIP_ROWS = $0D03; + GL_PACK_SKIP_PIXELS = $0D04; + GL_PACK_ALIGNMENT = $0D05; + GL_MAP_COLOR = $0D10; + GL_MAP_STENCIL = $0D11; + GL_INDEX_SHIFT = $0D12; + GL_INDEX_OFFSET = $0D13; + GL_RED_SCALE = $0D14; + GL_RED_BIAS = $0D15; + GL_ZOOM_X = $0D16; + GL_ZOOM_Y = $0D17; + GL_GREEN_SCALE = $0D18; + GL_GREEN_BIAS = $0D19; + GL_BLUE_SCALE = $0D1A; + GL_BLUE_BIAS = $0D1B; + GL_ALPHA_SCALE = $0D1C; + GL_ALPHA_BIAS = $0D1D; + GL_DEPTH_SCALE = $0D1E; + GL_DEPTH_BIAS = $0D1F; + GL_MAX_EVAL_ORDER = $0D30; + GL_MAX_LIGHTS = $0D31; + GL_MAX_CLIP_PLANES = $0D32; + GL_MAX_TEXTURE_SIZE = $0D33; + GL_MAX_PIXEL_MAP_TABLE = $0D34; + GL_MAX_ATTRIB_STACK_DEPTH = $0D35; + GL_MAX_MODELVIEW_STACK_DEPTH = $0D36; + GL_MAX_NAME_STACK_DEPTH = $0D37; + GL_MAX_PROJECTION_STACK_DEPTH = $0D38; + GL_MAX_TEXTURE_STACK_DEPTH = $0D39; + GL_MAX_VIEWPORT_DIMS = $0D3A; + GL_MAX_CLIENT_ATTRIB_STACK_DEPTH = $0D3B; + GL_SUBPIXEL_BITS = $0D50; + GL_INDEX_BITS = $0D51; + GL_RED_BITS = $0D52; + GL_GREEN_BITS = $0D53; + GL_BLUE_BITS = $0D54; + GL_ALPHA_BITS = $0D55; + GL_DEPTH_BITS = $0D56; + GL_STENCIL_BITS = $0D57; + GL_ACCUM_RED_BITS = $0D58; + GL_ACCUM_GREEN_BITS = $0D59; + GL_ACCUM_BLUE_BITS = $0D5A; + GL_ACCUM_ALPHA_BITS = $0D5B; + GL_NAME_STACK_DEPTH = $0D70; + GL_AUTO_NORMAL = $0D80; + GL_MAP1_COLOR_4 = $0D90; + GL_MAP1_INDEX = $0D91; + GL_MAP1_NORMAL = $0D92; + GL_MAP1_TEXTURE_COORD_1 = $0D93; + GL_MAP1_TEXTURE_COORD_2 = $0D94; + GL_MAP1_TEXTURE_COORD_3 = $0D95; + GL_MAP1_TEXTURE_COORD_4 = $0D96; + GL_MAP1_VERTEX_3 = $0D97; + GL_MAP1_VERTEX_4 = $0D98; + GL_MAP2_COLOR_4 = $0DB0; + GL_MAP2_INDEX = $0DB1; + GL_MAP2_NORMAL = $0DB2; + GL_MAP2_TEXTURE_COORD_1 = $0DB3; + GL_MAP2_TEXTURE_COORD_2 = $0DB4; + GL_MAP2_TEXTURE_COORD_3 = $0DB5; + GL_MAP2_TEXTURE_COORD_4 = $0DB6; + GL_MAP2_VERTEX_3 = $0DB7; + GL_MAP2_VERTEX_4 = $0DB8; + GL_MAP1_GRID_DOMAIN = $0DD0; + GL_MAP1_GRID_SEGMENTS = $0DD1; + GL_MAP2_GRID_DOMAIN = $0DD2; + GL_MAP2_GRID_SEGMENTS = $0DD3; + GL_TEXTURE_1D = $0DE0; + GL_TEXTURE_2D = $0DE1; + GL_FEEDBACK_BUFFER_POINTER = $0DF0; + GL_FEEDBACK_BUFFER_SIZE = $0DF1; + GL_FEEDBACK_BUFFER_TYPE = $0DF2; + GL_SELECTION_BUFFER_POINTER = $0DF3; + GL_SELECTION_BUFFER_SIZE = $0DF4; + // GL_TEXTURE_BINDING_1D + // GL_TEXTURE_BINDING_2D + // GL_VERTEX_ARRAY + // GL_NORMAL_ARRAY + // GL_COLOR_ARRAY + // GL_INDEX_ARRAY + // GL_TEXTURE_COORD_ARRAY + // GL_EDGE_FLAG_ARRAY + // GL_VERTEX_ARRAY_SIZE + // GL_VERTEX_ARRAY_TYPE + // GL_VERTEX_ARRAY_STRIDE + // GL_NORMAL_ARRAY_TYPE + // GL_NORMAL_ARRAY_STRIDE + // GL_COLOR_ARRAY_SIZE + // GL_COLOR_ARRAY_TYPE + // GL_COLOR_ARRAY_STRIDE + // GL_INDEX_ARRAY_TYPE + // GL_INDEX_ARRAY_STRIDE + // GL_TEXTURE_COORD_ARRAY_SIZE + // GL_TEXTURE_COORD_ARRAY_TYPE + // GL_TEXTURE_COORD_ARRAY_STRIDE + // GL_EDGE_FLAG_ARRAY_STRIDE + // GL_POLYGON_OFFSET_FACTOR + // GL_POLYGON_OFFSET_UNITS + + // GetTextureParameter + // GL_TEXTURE_MAG_FILTER + // GL_TEXTURE_MIN_FILTER + // GL_TEXTURE_WRAP_S + // GL_TEXTURE_WRAP_T + GL_TEXTURE_WIDTH = $1000; + GL_TEXTURE_HEIGHT = $1001; + GL_TEXTURE_INTERNAL_FORMAT = $1003; + GL_TEXTURE_BORDER_COLOR = $1004; + GL_TEXTURE_BORDER = $1005; + // GL_TEXTURE_RED_SIZE + // GL_TEXTURE_GREEN_SIZE + // GL_TEXTURE_BLUE_SIZE + // GL_TEXTURE_ALPHA_SIZE + // GL_TEXTURE_LUMINANCE_SIZE + // GL_TEXTURE_INTENSITY_SIZE + // GL_TEXTURE_PRIORITY + // GL_TEXTURE_RESIDENT + + // HintMode + GL_DONT_CARE = $1100; + GL_FASTEST = $1101; + GL_NICEST = $1102; + + // HintTarget + // GL_PERSPECTIVE_CORRECTION_HINT + // GL_POINT_SMOOTH_HINT + // GL_LINE_SMOOTH_HINT + // GL_POLYGON_SMOOTH_HINT + // GL_FOG_HINT + + // IndexPointerType + // GL_SHORT + // GL_INT + // GL_FLOAT + // GL_DOUBLE + + // LightModelParameter + // GL_LIGHT_MODEL_AMBIENT + // GL_LIGHT_MODEL_LOCAL_VIEWER + // GL_LIGHT_MODEL_TWO_SIDE + + // LightName + GL_LIGHT0 = $4000; + GL_LIGHT1 = $4001; + GL_LIGHT2 = $4002; + GL_LIGHT3 = $4003; + GL_LIGHT4 = $4004; + GL_LIGHT5 = $4005; + GL_LIGHT6 = $4006; + GL_LIGHT7 = $4007; + + // LightParameter + GL_AMBIENT = $1200; + GL_DIFFUSE = $1201; + GL_SPECULAR = $1202; + GL_POSITION = $1203; + GL_SPOT_DIRECTION = $1204; + GL_SPOT_EXPONENT = $1205; + GL_SPOT_CUTOFF = $1206; + GL_CONSTANT_ATTENUATION = $1207; + GL_LINEAR_ATTENUATION = $1208; + GL_QUADRATIC_ATTENUATION = $1209; + + // InterleavedArrays + // GL_V2F + // GL_V3F + // GL_C4UB_V2F + // GL_C4UB_V3F + // GL_C3F_V3F + // GL_N3F_V3F + // GL_C4F_N3F_V3F + // GL_T2F_V3F + // GL_T4F_V4F + // GL_T2F_C4UB_V3F + // GL_T2F_C3F_V3F + // GL_T2F_N3F_V3F + // GL_T2F_C4F_N3F_V3F + // GL_T4F_C4F_N3F_V4F + + // ListMode + GL_COMPILE = $1300; + GL_COMPILE_AND_EXECUTE = $1301; + + // ListNameType + // GL_BYTE + // GL_UNSIGNED_BYTE + // GL_SHORT + // GL_UNSIGNED_SHORT + // GL_INT + // GL_UNSIGNED_INT + // GL_FLOAT + // GL_2_BYTES + // GL_3_BYTES + // GL_4_BYTES + + // LogicOp + GL_CLEAR = $1500; + GL_AND = $1501; + GL_AND_REVERSE = $1502; + GL_COPY = $1503; + GL_AND_INVERTED = $1504; + GL_NOOP = $1505; + GL_XOR = $1506; + GL_OR = $1507; + GL_NOR = $1508; + GL_EQUIV = $1509; + GL_INVERT = $150A; + GL_OR_REVERSE = $150B; + GL_COPY_INVERTED = $150C; + GL_OR_INVERTED = $150D; + GL_NAND = $150E; + GL_SET = $150F; + + // MapTarget + // GL_MAP1_COLOR_4 + // GL_MAP1_INDEX + // GL_MAP1_NORMAL + // GL_MAP1_TEXTURE_COORD_1 + // GL_MAP1_TEXTURE_COORD_2 + // GL_MAP1_TEXTURE_COORD_3 + // GL_MAP1_TEXTURE_COORD_4 + // GL_MAP1_VERTEX_3 + // GL_MAP1_VERTEX_4 + // GL_MAP2_COLOR_4 + // GL_MAP2_INDEX + // GL_MAP2_NORMAL + // GL_MAP2_TEXTURE_COORD_1 + // GL_MAP2_TEXTURE_COORD_2 + // GL_MAP2_TEXTURE_COORD_3 + // GL_MAP2_TEXTURE_COORD_4 + // GL_MAP2_VERTEX_3 + // GL_MAP2_VERTEX_4 + + // MaterialFace + // GL_FRONT + // GL_BACK + // GL_FRONT_AND_BACK + + // MaterialParameter + GL_EMISSION = $1600; + GL_SHININESS = $1601; + GL_AMBIENT_AND_DIFFUSE = $1602; + GL_COLOR_INDEXES = $1603; + // GL_AMBIENT + // GL_DIFFUSE + // GL_SPECULAR + + // MatrixMode + GL_MODELVIEW = $1700; + GL_PROJECTION = $1701; + GL_TEXTURE = $1702; + + // MeshMode1 + // GL_POINT + // GL_LINE + + // MeshMode2 + // GL_POINT + // GL_LINE + // GL_FILL + + // NormalPointerType + // GL_BYTE + // GL_SHORT + // GL_INT + // GL_FLOAT + // GL_DOUBLE + + // PixelCopyType + GL_COLOR = $1800; + GL_DEPTH = $1801; + GL_STENCIL = $1802; + + // PixelFormat + GL_COLOR_INDEX = $1900; + GL_STENCIL_INDEX = $1901; + GL_DEPTH_COMPONENT = $1902; + GL_RED = $1903; + GL_GREEN = $1904; + GL_BLUE = $1905; + GL_ALPHA = $1906; + GL_RGB = $1907; + GL_RGBA = $1908; + GL_LUMINANCE = $1909; + GL_LUMINANCE_ALPHA = $190A; + + // PixelMap + // GL_PIXEL_MAP_I_TO_I + // GL_PIXEL_MAP_S_TO_S + // GL_PIXEL_MAP_I_TO_R + // GL_PIXEL_MAP_I_TO_G + // GL_PIXEL_MAP_I_TO_B + // GL_PIXEL_MAP_I_TO_A + // GL_PIXEL_MAP_R_TO_R + // GL_PIXEL_MAP_G_TO_G + // GL_PIXEL_MAP_B_TO_B + // GL_PIXEL_MAP_A_TO_A + + // PixelStore + // GL_UNPACK_SWAP_BYTES + // GL_UNPACK_LSB_FIRST + // GL_UNPACK_ROW_LENGTH + // GL_UNPACK_SKIP_ROWS + // GL_UNPACK_SKIP_PIXELS + // GL_UNPACK_ALIGNMENT + // GL_PACK_SWAP_BYTES + // GL_PACK_LSB_FIRST + // GL_PACK_ROW_LENGTH + // GL_PACK_SKIP_ROWS + // GL_PACK_SKIP_PIXELS + // GL_PACK_ALIGNMENT + + // PixelTransfer + // GL_MAP_COLOR + // GL_MAP_STENCIL + // GL_INDEX_SHIFT + // GL_INDEX_OFFSET + // GL_RED_SCALE + // GL_RED_BIAS + // GL_GREEN_SCALE + // GL_GREEN_BIAS + // GL_BLUE_SCALE + // GL_BLUE_BIAS + // GL_ALPHA_SCALE + // GL_ALPHA_BIAS + // GL_DEPTH_SCALE + // GL_DEPTH_BIAS + + // PixelType + GL_BITMAP = $1A00; + // GL_BYTE + // GL_UNSIGNED_BYTE + // GL_SHORT + // GL_UNSIGNED_SHORT + // GL_INT + // GL_UNSIGNED_INT + // GL_FLOAT + + // PolygonMode + GL_POINT = $1B00; + GL_LINE = $1B01; + GL_FILL = $1B02; + + // ReadBufferMode + // GL_FRONT_LEFT + // GL_FRONT_RIGHT + // GL_BACK_LEFT + // GL_BACK_RIGHT + // GL_FRONT + // GL_BACK + // GL_LEFT + // GL_RIGHT + // GL_AUX0 + // GL_AUX1 + // GL_AUX2 + // GL_AUX3 + + // RenderingMode + GL_RENDER = $1C00; + GL_FEEDBACK = $1C01; + GL_SELECT = $1C02; + + // ShadingModel + GL_FLAT = $1D00; + GL_SMOOTH = $1D01; + + // StencilFunction + // GL_NEVER + // GL_LESS + // GL_EQUAL + // GL_LEQUAL + // GL_GREATER + // GL_NOTEQUAL + // GL_GEQUAL + // GL_ALWAYS + + // StencilOp + // GL_ZERO + GL_KEEP = $1E00; + GL_REPLACE = $1E01; + GL_INCR = $1E02; + GL_DECR = $1E03; + // GL_INVERT + + // StringName + GL_VENDOR = $1F00; + GL_RENDERER = $1F01; + GL_VERSION = $1F02; + GL_EXTENSIONS = $1F03; + + // TextureCoordName + GL_S = $2000; + GL_T = $2001; + GL_R = $2002; + GL_Q = $2003; + + // TexCoordPointerType + // GL_SHORT + // GL_INT + // GL_FLOAT + // GL_DOUBLE + + // TextureEnvMode + GL_MODULATE = $2100; + GL_DECAL = $2101; + // GL_BLEND + // GL_REPLACE + + // TextureEnvParameter + GL_TEXTURE_ENV_MODE = $2200; + GL_TEXTURE_ENV_COLOR = $2201; + + // TextureEnvTarget + GL_TEXTURE_ENV = $2300; + + // TextureGenMode + GL_EYE_LINEAR = $2400; + GL_OBJECT_LINEAR = $2401; + GL_SPHERE_MAP = $2402; + + // TextureGenParameter + GL_TEXTURE_GEN_MODE = $2500; + GL_OBJECT_PLANE = $2501; + GL_EYE_PLANE = $2502; + + // TextureMagFilter + GL_NEAREST = $2600; + GL_LINEAR = $2601; + + // TextureMinFilter + // GL_NEAREST + // GL_LINEAR + GL_NEAREST_MIPMAP_NEAREST = $2700; + GL_LINEAR_MIPMAP_NEAREST = $2701; + GL_NEAREST_MIPMAP_LINEAR = $2702; + GL_LINEAR_MIPMAP_LINEAR = $2703; + + // TextureParameterName + GL_TEXTURE_MAG_FILTER = $2800; + GL_TEXTURE_MIN_FILTER = $2801; + GL_TEXTURE_WRAP_S = $2802; + GL_TEXTURE_WRAP_T = $2803; + // GL_TEXTURE_BORDER_COLOR + // GL_TEXTURE_PRIORITY + + // TextureTarget + // GL_TEXTURE_1D + // GL_TEXTURE_2D + // GL_PROXY_TEXTURE_1D + // GL_PROXY_TEXTURE_2D + + // TextureWrapMode + GL_CLAMP = $2900; + GL_REPEAT = $2901; + + // VertexPointerType + // GL_SHORT + // GL_INT + // GL_FLOAT + // GL_DOUBLE + + // ClientAttribMask + GL_CLIENT_PIXEL_STORE_BIT = $00000001; + GL_CLIENT_VERTEX_ARRAY_BIT = $00000002; + GL_CLIENT_ALL_ATTRIB_BITS = $FFFFFFFF; + + // polygon_offset + GL_POLYGON_OFFSET_FACTOR = $8038; + GL_POLYGON_OFFSET_UNITS = $2A00; + GL_POLYGON_OFFSET_POINT = $2A01; + GL_POLYGON_OFFSET_LINE = $2A02; + GL_POLYGON_OFFSET_FILL = $8037; + + // texture + GL_ALPHA4 = $803B; + GL_ALPHA8 = $803C; + GL_ALPHA12 = $803D; + GL_ALPHA16 = $803E; + GL_LUMINANCE4 = $803F; + GL_LUMINANCE8 = $8040; + GL_LUMINANCE12 = $8041; + GL_LUMINANCE16 = $8042; + GL_LUMINANCE4_ALPHA4 = $8043; + GL_LUMINANCE6_ALPHA2 = $8044; + GL_LUMINANCE8_ALPHA8 = $8045; + GL_LUMINANCE12_ALPHA4 = $8046; + GL_LUMINANCE12_ALPHA12 = $8047; + GL_LUMINANCE16_ALPHA16 = $8048; + GL_INTENSITY = $8049; + GL_INTENSITY4 = $804A; + GL_INTENSITY8 = $804B; + GL_INTENSITY12 = $804C; + GL_INTENSITY16 = $804D; + GL_R3_G3_B2 = $2A10; + GL_RGB4 = $804F; + GL_RGB5 = $8050; + GL_RGB8 = $8051; + GL_RGB10 = $8052; + GL_RGB12 = $8053; + GL_RGB16 = $8054; + GL_RGBA2 = $8055; + GL_RGBA4 = $8056; + GL_RGB5_A1 = $8057; + GL_RGBA8 = $8058; + GL_RGB10_A2 = $8059; + GL_RGBA12 = $805A; + GL_RGBA16 = $805B; + GL_TEXTURE_RED_SIZE = $805C; + GL_TEXTURE_GREEN_SIZE = $805D; + GL_TEXTURE_BLUE_SIZE = $805E; + GL_TEXTURE_ALPHA_SIZE = $805F; + GL_TEXTURE_LUMINANCE_SIZE = $8060; + GL_TEXTURE_INTENSITY_SIZE = $8061; + GL_PROXY_TEXTURE_1D = $8063; + GL_PROXY_TEXTURE_2D = $8064; + + // texture_object + GL_TEXTURE_PRIORITY = $8066; + GL_TEXTURE_RESIDENT = $8067; + GL_TEXTURE_BINDING_1D = $8068; + GL_TEXTURE_BINDING_2D = $8069; + + // vertex_array + GL_VERTEX_ARRAY = $8074; + GL_NORMAL_ARRAY = $8075; + GL_COLOR_ARRAY = $8076; + GL_INDEX_ARRAY = $8077; + GL_TEXTURE_COORD_ARRAY = $8078; + GL_EDGE_FLAG_ARRAY = $8079; + GL_VERTEX_ARRAY_SIZE = $807A; + GL_VERTEX_ARRAY_TYPE = $807B; + GL_VERTEX_ARRAY_STRIDE = $807C; + GL_NORMAL_ARRAY_TYPE = $807E; + GL_NORMAL_ARRAY_STRIDE = $807F; + GL_COLOR_ARRAY_SIZE = $8081; + GL_COLOR_ARRAY_TYPE = $8082; + GL_COLOR_ARRAY_STRIDE = $8083; + GL_INDEX_ARRAY_TYPE = $8085; + GL_INDEX_ARRAY_STRIDE = $8086; + GL_TEXTURE_COORD_ARRAY_SIZE = $8088; + GL_TEXTURE_COORD_ARRAY_TYPE = $8089; + GL_TEXTURE_COORD_ARRAY_STRIDE = $808A; + GL_EDGE_FLAG_ARRAY_STRIDE = $808C; + GL_VERTEX_ARRAY_POINTER = $808E; + GL_NORMAL_ARRAY_POINTER = $808F; + GL_COLOR_ARRAY_POINTER = $8090; + GL_INDEX_ARRAY_POINTER = $8091; + GL_TEXTURE_COORD_ARRAY_POINTER = $8092; + GL_EDGE_FLAG_ARRAY_POINTER = $8093; + GL_V2F = $2A20; + GL_V3F = $2A21; + GL_C4UB_V2F = $2A22; + GL_C4UB_V3F = $2A23; + GL_C3F_V3F = $2A24; + GL_N3F_V3F = $2A25; + GL_C4F_N3F_V3F = $2A26; + GL_T2F_V3F = $2A27; + GL_T4F_V4F = $2A28; + GL_T2F_C4UB_V3F = $2A29; + GL_T2F_C3F_V3F = $2A2A; + GL_T2F_N3F_V3F = $2A2B; + GL_T2F_C4F_N3F_V3F = $2A2C; + GL_T4F_C4F_N3F_V4F = $2A2D; + + // Extensions + GL_EXT_vertex_array = 1; + GL_WIN_swap_hint = 1; + GL_EXT_bgra = 1; + GL_EXT_paletted_texture = 1; + + // EXT_vertex_array + GL_VERTEX_ARRAY_EXT = $8074; + GL_NORMAL_ARRAY_EXT = $8075; + GL_COLOR_ARRAY_EXT = $8076; + GL_INDEX_ARRAY_EXT = $8077; + GL_TEXTURE_COORD_ARRAY_EXT = $8078; + GL_EDGE_FLAG_ARRAY_EXT = $8079; + GL_VERTEX_ARRAY_SIZE_EXT = $807A; + GL_VERTEX_ARRAY_TYPE_EXT = $807B; + GL_VERTEX_ARRAY_STRIDE_EXT = $807C; + GL_VERTEX_ARRAY_COUNT_EXT = $807D; + GL_NORMAL_ARRAY_TYPE_EXT = $807E; + GL_NORMAL_ARRAY_STRIDE_EXT = $807F; + GL_NORMAL_ARRAY_COUNT_EXT = $8080; + GL_COLOR_ARRAY_SIZE_EXT = $8081; + GL_COLOR_ARRAY_TYPE_EXT = $8082; + GL_COLOR_ARRAY_STRIDE_EXT = $8083; + GL_COLOR_ARRAY_COUNT_EXT = $8084; + GL_INDEX_ARRAY_TYPE_EXT = $8085; + GL_INDEX_ARRAY_STRIDE_EXT = $8086; + GL_INDEX_ARRAY_COUNT_EXT = $8087; + GL_TEXTURE_COORD_ARRAY_SIZE_EXT = $8088; + GL_TEXTURE_COORD_ARRAY_TYPE_EXT = $8089; + GL_TEXTURE_COORD_ARRAY_STRIDE_EXT = $808A; + GL_TEXTURE_COORD_ARRAY_COUNT_EXT = $808B; + GL_EDGE_FLAG_ARRAY_STRIDE_EXT = $808C; + GL_EDGE_FLAG_ARRAY_COUNT_EXT = $808D; + GL_VERTEX_ARRAY_POINTER_EXT = $808E; + GL_NORMAL_ARRAY_POINTER_EXT = $808F; + GL_COLOR_ARRAY_POINTER_EXT = $8090; + GL_INDEX_ARRAY_POINTER_EXT = $8091; + GL_TEXTURE_COORD_ARRAY_POINTER_EXT = $8092; + GL_EDGE_FLAG_ARRAY_POINTER_EXT = $8093; + GL_DOUBLE_EXT = GL_DOUBLE; + + // EXT_bgra + GL_BGR_EXT = $80E0; + GL_BGRA_EXT = $80E1; + + // EXT_paletted_texture + + // These must match the GL_COLOR_TABLE_*_SGI enumerants + GL_COLOR_TABLE_FORMAT_EXT = $80D8; + GL_COLOR_TABLE_WIDTH_EXT = $80D9; + GL_COLOR_TABLE_RED_SIZE_EXT = $80DA; + GL_COLOR_TABLE_GREEN_SIZE_EXT = $80DB; + GL_COLOR_TABLE_BLUE_SIZE_EXT = $80DC; + GL_COLOR_TABLE_ALPHA_SIZE_EXT = $80DD; + GL_COLOR_TABLE_LUMINANCE_SIZE_EXT = $80DE; + GL_COLOR_TABLE_INTENSITY_SIZE_EXT = $80DF; + + GL_COLOR_INDEX1_EXT = $80E2; + GL_COLOR_INDEX2_EXT = $80E3; + GL_COLOR_INDEX4_EXT = $80E4; + GL_COLOR_INDEX8_EXT = $80E5; + GL_COLOR_INDEX12_EXT = $80E6; + GL_COLOR_INDEX16_EXT = $80E7; + + // For compatibility with OpenGL v1.0 + GL_LOGIC_OP = GL_INDEX_LOGIC_OP; + GL_TEXTURE_COMPONENTS = GL_TEXTURE_INTERNAL_FORMAT; + +{******************************************************************************} + +var + glAccum: procedure(op: GLenum; value: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glAlphaFunc: procedure(func: GLenum; ref: GLclampf); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glAreTexturesResident: function (n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glArrayElement: procedure(i: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glBegin: procedure(mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glBindTexture: procedure(target: GLenum; texture: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glBitmap: procedure (width, height: GLsizei; xorig, yorig: GLfloat; xmove, ymove: GLfloat; const bitmap: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glBlendFunc: procedure(sfactor, dfactor: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCallList: procedure(list: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCallLists: procedure(n: GLsizei; atype: GLenum; const lists: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glClear: procedure(mask: GLbitfield); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glClearAccum: procedure(red, green, blue, alpha: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glClearColor: procedure(red, green, blue, alpha: GLclampf); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glClearDepth: procedure(depth: GLclampd); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glClearIndex: procedure(c: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glClearStencil: procedure(s: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glClipPlane: procedure(plane: GLenum; const equation: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor3b: procedure(red, green, blue: GLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor3bv: procedure(const v: PGLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor3d: procedure(red, green, blue: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor3dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor3f: procedure(red, green, blue: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor3fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor3i: procedure(red, green, blue: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor3iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor3s: procedure(red, green, blue: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor3sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor3ub: procedure(red, green, blue: GLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor3ubv: procedure(const v: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor3ui: procedure(red, green, blue: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor3uiv: procedure(const v: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor3us: procedure(red, green, blue: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor3usv: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor4b: procedure(red, green, blue, alpha: GLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor4bv: procedure(const v: PGLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor4d: procedure(red, green, blue, alpha: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor4dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor4f: procedure(red, green, blue, alpha: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor4fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor4i: procedure(red, green, blue, alpha: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor4iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor4s: procedure(red, green, blue, alpha: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor4sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor4ub: procedure(red, green, blue, alpha: GLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor4ubv: procedure(const v: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor4ui: procedure(red, green, blue, alpha: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor4uiv: procedure(const v: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor4us: procedure(red, green, blue, alpha: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor4usv: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColorMask: procedure(red, green, blue, alpha: GLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColorMaterial: procedure(face, mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColorPointer: procedure(size: GLint; atype: GLenum; stride: GLsizei; const pointer: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCopyPixels: procedure(x, y: GLint; width, height: GLsizei; atype: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCopyTexImage1D: procedure (target: GLenum; level: GLint; internalFormat: GLenum; x, y: GLint; width: GLsizei; border: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCopyTexImage2D: procedure(target: GLenum; level: GLint; internalFormat: GLenum; x, y: GLint; width, height: GLsizei; border: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCopyTexSubImage1D: procedure(target: GLenum; level, xoffset, x, y: GLint; width: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCopyTexSubImage2D: procedure(target: GLenum; level, xoffset, yoffset, x, y: GLint; width, height: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCullFace: procedure(mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDeleteLists: procedure(list: GLuint; range: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDeleteTextures: procedure(n: GLsizei; const textures: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDepthFunc: procedure(func: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDepthMask: procedure(flag: GLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDepthRange: procedure(zNear, zFar: GLclampd); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDisable: procedure(cap: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDisableClientState: procedure(aarray: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDrawArrays: procedure(mode: GLenum; first: GLint; count: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDrawBuffer: procedure(mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDrawElements: procedure(mode: GLenum; count: GLsizei; atype: GLenum; const indices: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDrawPixels: procedure(width, height: GLsizei; format, atype: GLenum; const pixels: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEdgeFlag: procedure(flag: GLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEdgeFlagPointer: procedure(stride: GLsizei; const pointer: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEdgeFlagv: procedure(const flag: PGLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEnable: procedure(cap: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEnableClientState: procedure(aarray: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEnd: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEndList: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEvalCoord1d: procedure(u: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEvalCoord1dv: procedure(const u: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEvalCoord1f: procedure(u: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEvalCoord1fv: procedure(const u: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEvalCoord2d: procedure(u, v: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEvalCoord2dv: procedure(const u: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEvalCoord2f: procedure(u, v: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEvalCoord2fv: procedure(const u: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEvalMesh1: procedure(mode: GLenum; i1, i2: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEvalMesh2: procedure(mode: GLenum; i1, i2, j1, j2: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEvalPoint1: procedure(i: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEvalPoint2: procedure(i, j: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFeedbackBuffer: procedure(size: GLsizei; atype: GLenum; buffer: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFinish: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFlush: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFogf: procedure(pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFogfv: procedure(pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFogi: procedure(pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFogiv: procedure(pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFrontFace: procedure(mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFrustum: procedure(left, right, bottom, top, zNear, zFar: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGenLists: function(range: GLsizei): GLuint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGenTextures: procedure(n: GLsizei; textures: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetBooleanv: procedure(pname: GLenum; params: PGLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetClipPlane: procedure(plane: GLenum; equation: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetDoublev: procedure(pname: GLenum; params: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetError: function: GLenum; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetFloatv: procedure(pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetIntegerv: procedure(pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetLightfv: procedure(light, pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetLightiv: procedure(light, pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetMapdv: procedure(target, query: GLenum; v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetMapfv: procedure(target, query: GLenum; v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetMapiv: procedure(target, query: GLenum; v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetMaterialfv: procedure(face, pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetMaterialiv: procedure(face, pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetPixelMapfv: procedure(map: GLenum; values: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetPixelMapuiv: procedure(map: GLenum; values: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetPixelMapusv: procedure(map: GLenum; values: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetPointerv: procedure(pname: GLenum; params: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetPolygonStipple: procedure(mask: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetString: function(name: GLenum): PChar; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetTexEnvfv: procedure(target, pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetTexEnviv: procedure(target, pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetTexGendv: procedure(coord, pname: GLenum; params: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetTexGenfv: procedure(coord, pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetTexGeniv: procedure(coord, pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetTexImage: procedure(target: GLenum; level: GLint; format: GLenum; atype: GLenum; pixels: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetTexLevelParameterfv: procedure(target: GLenum; level: GLint; pname: GLenum; params: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetTexLevelParameteriv: procedure(target: GLenum; level: GLint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetTexParameterfv: procedure(target, pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetTexParameteriv: procedure(target, pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glHint: procedure(target, mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIndexMask: procedure(mask: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIndexPointer: procedure(atype: GLenum; stride: GLsizei; const pointer: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIndexd: procedure(c: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIndexdv: procedure(const c: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIndexf: procedure(c: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIndexfv: procedure(const c: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIndexi: procedure(c: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIndexiv: procedure(const c: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIndexs: procedure(c: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIndexsv: procedure(const c: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIndexub: procedure(c: GLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIndexubv: procedure(const c: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glInitNames: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glInterleavedArrays: procedure(format: GLenum; stride: GLsizei; const pointer: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIsEnabled: function(cap: GLenum): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIsList: function(list: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIsTexture: function(texture: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glLightModelf: procedure(pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glLightModelfv: procedure(pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glLightModeli: procedure(pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glLightModeliv: procedure(pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glLightf: procedure(light, pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glLightfv: procedure(light, pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glLighti: procedure(light, pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glLightiv: procedure(light, pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glLineStipple: procedure(factor: GLint; pattern: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glLineWidth: procedure(width: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glListBase: procedure(base: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glLoadIdentity: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glLoadMatrixd: procedure(const m: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glLoadMatrixf: procedure(const m: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glLoadName: procedure(name: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glLogicOp: procedure(opcode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMap1d: procedure(target: GLenum; u1, u2: GLdouble; stride, order: GLint; const points: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMap1f: procedure(target: GLenum; u1, u2: GLfloat; stride, order: GLint; const points: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMap2d: procedure(target: GLenum; u1, u2: GLdouble; ustride, uorder: GLint; v1, v2: GLdouble; vstride, vorder: GLint; const points: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMap2f: procedure(target: GLenum; u1, u2: GLfloat; ustride, uorder: GLint; v1, v2: GLfloat; vstride, vorder: GLint; const points: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMapGrid1d: procedure(un: GLint; u1, u2: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMapGrid1f: procedure(un: GLint; u1, u2: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMapGrid2d: procedure(un: GLint; u1, u2: GLdouble; vn: GLint; v1, v2: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMapGrid2f: procedure(un: GLint; u1, u2: GLfloat; vn: GLint; v1, v2: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMaterialf: procedure(face, pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMaterialfv: procedure(face, pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMateriali: procedure(face, pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMaterialiv: procedure(face, pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMatrixMode: procedure(mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultMatrixd: procedure(const m: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultMatrixf: procedure(const m: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNewList: procedure(list: GLuint; mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNormal3b: procedure(nx, ny, nz: GLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNormal3bv: procedure(const v: PGLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNormal3d: procedure(nx, ny, nz: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNormal3dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNormal3f: procedure(nx, ny, nz: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNormal3fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNormal3i: procedure(nx, ny, nz: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNormal3iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNormal3s: procedure(nx, ny, nz: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNormal3sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNormalPointer: procedure(atype: GLenum; stride: GLsizei; const pointer: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glOrtho: procedure(left, right, bottom, top, zNear, zFar: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPassThrough: procedure(token: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPixelMapfv: procedure(map: GLenum; mapsize: GLsizei; const values: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPixelMapuiv: procedure(map: GLenum; mapsize: GLsizei; const values: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPixelMapusv: procedure(map: GLenum; mapsize: GLsizei; const values: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPixelStoref: procedure(pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPixelStorei: procedure(pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPixelTransferf: procedure(pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPixelTransferi: procedure(pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPixelZoom: procedure(xfactor, yfactor: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPointSize: procedure(size: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPolygonMode: procedure(face, mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPolygonOffset: procedure(factor, units: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPolygonStipple: procedure(const mask: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPopAttrib: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPopClientAttrib: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPopMatrix: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPopName: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPrioritizeTextures: procedure(n: GLsizei; const textures: PGLuint; const priorities: PGLclampf); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPushAttrib: procedure(mask: GLbitfield); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPushClientAttrib: procedure(mask: GLbitfield); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPushMatrix: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPushName: procedure(name: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRasterPos2d: procedure(x, y: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRasterPos2dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRasterPos2f: procedure(x, y: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRasterPos2fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRasterPos2i: procedure(x, y: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRasterPos2iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRasterPos2s: procedure(x, y: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRasterPos2sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRasterPos3d: procedure(x, y, z: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRasterPos3dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRasterPos3f: procedure(x, y, z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRasterPos3fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRasterPos3i: procedure(x, y, z: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRasterPos3iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRasterPos3s: procedure(x, y, z: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRasterPos3sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRasterPos4d: procedure(x, y, z, w: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRasterPos4dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRasterPos4f: procedure(x, y, z, w: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRasterPos4fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRasterPos4i: procedure(x, y, z, w: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRasterPos4iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRasterPos4s: procedure(x, y, z, w: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRasterPos4sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glReadBuffer: procedure(mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glReadPixels: procedure(x, y: GLint; width, height: GLsizei; format, atype: GLenum; pixels: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRectd: procedure(x1, y1, x2, y2: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRectdv: procedure(const v1: PGLdouble; const v2: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRectf: procedure(x1, y1, x2, y2: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRectfv: procedure(const v1: PGLfloat; const v2: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRecti: procedure(x1, y1, x2, y2: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRectiv: procedure(const v1: PGLint; const v2: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRects: procedure(x1, y1, x2, y2: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRectsv: procedure(const v1: PGLshort; const v2: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRenderMode: function(mode: GLint): GLint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRotated: procedure(angle, x, y, z: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRotatef: procedure(angle, x, y, z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glScaled: procedure(x, y, z: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glScalef: procedure(x, y, z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glScissor: procedure(x, y: GLint; width, height: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSelectBuffer: procedure(size: GLsizei; buffer: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glShadeModel: procedure(mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glStencilFunc: procedure(func: GLenum; ref: GLint; mask: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glStencilMask: procedure(mask: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glStencilOp: procedure(fail, zfail, zpass: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord1d: procedure(s: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord1dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord1f: procedure(s: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord1fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord1i: procedure(s: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord1iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord1s: procedure(s: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord1sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord2d: procedure(s, t: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord2dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord2f: procedure(s, t: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord2fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord2i: procedure(s, t: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord2iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord2s: procedure(s, t: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord2sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord3d: procedure(s, t, r: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord3dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord3f: procedure(s, t, r: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord3fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord3i: procedure(s, t, r: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord3iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord3s: procedure(s, t, r: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord3sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord4d: procedure(s, t, r, q: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord4dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord4f: procedure(s, t, r, q: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord4fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord4i: procedure(s, t, r, q: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord4iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord4s: procedure(s, t, r, q: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord4sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoordPointer: procedure(size: GLint; atype: GLenum; stride: GLsizei; const pointer: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexEnvf: procedure(target: GLenum; pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexEnvfv: procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexEnvi: procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexEnviv: procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexGend: procedure(coord: GLenum; pname: GLenum; param: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexGendv: procedure(coord: GLenum; pname: GLenum; const params: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexGenf: procedure(coord: GLenum; pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexGenfv: procedure(coord: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexGeni: procedure(coord: GLenum; pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexGeniv: procedure(coord: GLenum; pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexImage1D: procedure(target: GLenum; level, internalformat: GLint; width: GLsizei; border: GLint; format, atype: GLenum; const pixels: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexImage2D: procedure(target: GLenum; level, internalformat: GLint; width, height: GLsizei; border: GLint; format, atype: GLenum; const pixels: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexParameterf: procedure(target: GLenum; pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexParameterfv: procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexParameteri: procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexParameteriv: procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexSubImage1D: procedure(target: GLenum; level, xoffset: GLint; width: GLsizei; format, atype: GLenum; const pixels: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexSubImage2D: procedure(target: GLenum; level, xoffset, yoffset: GLint; width, height: GLsizei; format, atype: GLenum; const pixels: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTranslated: procedure(x, y, z: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTranslatef: procedure(x, y, z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex2d: procedure(x, y: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex2dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex2f: procedure(x, y: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex2fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex2i: procedure(x, y: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex2iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex2s: procedure(x, y: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex2sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex3d: procedure(x, y, z: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex3dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex3f: procedure(x, y, z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex3fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex3i: procedure(x, y, z: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex3iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex3s: procedure(x, y, z: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex3sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex4d: procedure(x, y, z, w: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex4dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex4f: procedure(x, y, z, w: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex4fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex4i: procedure(x, y, z, w: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex4iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex4s: procedure(x, y, z, w: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex4sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexPointer: procedure(size: GLint; atype: GLenum; stride: GLsizei; const pointer: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glViewport: procedure(x, y: GLint; width, height: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + {$IFDEF WINDOWS} + ChoosePixelFormat: function(DC: HDC; p2: PPixelFormatDescriptor): Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + {$ENDIF} + +type + // EXT_vertex_array + PFNGLARRAYELEMENTEXTPROC = procedure(i: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + PFNGLDRAWARRAYSEXTPROC = procedure(mode: GLenum; first: GLint; count: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + PFNGLVERTEXPOINTEREXTPROC = procedure(size: GLint; atype: GLenum; + stride, count: GLsizei; const pointer: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + PFNGLNORMALPOINTEREXTPROC = procedure(atype: GLenum; stride, count: GLsizei; + const pointer: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + PFNGLCOLORPOINTEREXTPROC = procedure(size: GLint; atype: GLenum; stride, count: GLsizei; + const pointer: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + PFNGLINDEXPOINTEREXTPROC = procedure(atype: GLenum; stride, count: GLsizei; + const pointer: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + PFNGLTEXCOORDPOINTEREXTPROC = procedure(size: GLint; atype: GLenum; + stride, count: GLsizei; const pointer: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + PFNGLEDGEFLAGPOINTEREXTPROC = procedure(stride, count: GLsizei; + const pointer: PGLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + PFNGLGETPOINTERVEXTPROC = procedure(pname: GLenum; params: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + PFNGLARRAYELEMENTARRAYEXTPROC = procedure(mode: GLenum; count: GLsizei; + const pi: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + + // WIN_swap_hint + PFNGLADDSWAPHINTRECTWINPROC = procedure(x, y: GLint; width, height: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + + // EXT_paletted_texture + PFNGLCOLORTABLEEXTPROC = procedure(target, internalFormat: GLenum; width: GLsizei; + format, atype: GLenum; const data: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + PFNGLCOLORSUBTABLEEXTPROC = procedure(target: GLenum; start, count: GLsizei; + format, atype: GLenum; const data: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + PFNGLGETCOLORTABLEEXTPROC = procedure(target, format, atype: GLenum; data: Pointer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + PFNGLGETCOLORTABLEPARAMETERIVEXTPROC = procedure(target, pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + PFNGLGETCOLORTABLEPARAMETERFVEXTPROC = procedure(target, pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +procedure LoadOpenGL( const dll: PChar ); +procedure FreeOpenGL; + +implementation + +procedure FreeOpenGL; +begin + + @glAccum := nil; + @glAlphaFunc := nil; + @glAreTexturesResident := nil; + @glArrayElement := nil; + @glBegin := nil; + @glBindTexture := nil; + @glBitmap := nil; + @glBlendFunc := nil; + @glCallList := nil; + @glCallLists := nil; + @glClear := nil; + @glClearAccum := nil; + @glClearColor := nil; + @glClearDepth := nil; + @glClearIndex := nil; + @glClearStencil := nil; + @glClipPlane := nil; + @glColor3b := nil; + @glColor3bv := nil; + @glColor3d := nil; + @glColor3dv := nil; + @glColor3f := nil; + @glColor3fv := nil; + @glColor3i := nil; + @glColor3iv := nil; + @glColor3s := nil; + @glColor3sv := nil; + @glColor3ub := nil; + @glColor3ubv := nil; + @glColor3ui := nil; + @glColor3uiv := nil; + @glColor3us := nil; + @glColor3usv := nil; + @glColor4b := nil; + @glColor4bv := nil; + @glColor4d := nil; + @glColor4dv := nil; + @glColor4f := nil; + @glColor4fv := nil; + @glColor4i := nil; + @glColor4iv := nil; + @glColor4s := nil; + @glColor4sv := nil; + @glColor4ub := nil; + @glColor4ubv := nil; + @glColor4ui := nil; + @glColor4uiv := nil; + @glColor4us := nil; + @glColor4usv := nil; + @glColorMask := nil; + @glColorMaterial := nil; + @glColorPointer := nil; + @glCopyPixels := nil; + @glCopyTexImage1D := nil; + @glCopyTexImage2D := nil; + @glCopyTexSubImage1D := nil; + @glCopyTexSubImage2D := nil; + @glCullFace := nil; + @glDeleteLists := nil; + @glDeleteTextures := nil; + @glDepthFunc := nil; + @glDepthMask := nil; + @glDepthRange := nil; + @glDisable := nil; + @glDisableClientState := nil; + @glDrawArrays := nil; + @glDrawBuffer := nil; + @glDrawElements := nil; + @glDrawPixels := nil; + @glEdgeFlag := nil; + @glEdgeFlagPointer := nil; + @glEdgeFlagv := nil; + @glEnable := nil; + @glEnableClientState := nil; + @glEnd := nil; + @glEndList := nil; + @glEvalCoord1d := nil; + @glEvalCoord1dv := nil; + @glEvalCoord1f := nil; + @glEvalCoord1fv := nil; + @glEvalCoord2d := nil; + @glEvalCoord2dv := nil; + @glEvalCoord2f := nil; + @glEvalCoord2fv := nil; + @glEvalMesh1 := nil; + @glEvalMesh2 := nil; + @glEvalPoint1 := nil; + @glEvalPoint2 := nil; + @glFeedbackBuffer := nil; + @glFinish := nil; + @glFlush := nil; + @glFogf := nil; + @glFogfv := nil; + @glFogi := nil; + @glFogiv := nil; + @glFrontFace := nil; + @glFrustum := nil; + @glGenLists := nil; + @glGenTextures := nil; + @glGetBooleanv := nil; + @glGetClipPlane := nil; + @glGetDoublev := nil; + @glGetError := nil; + @glGetFloatv := nil; + @glGetIntegerv := nil; + @glGetLightfv := nil; + @glGetLightiv := nil; + @glGetMapdv := nil; + @glGetMapfv := nil; + @glGetMapiv := nil; + @glGetMaterialfv := nil; + @glGetMaterialiv := nil; + @glGetPixelMapfv := nil; + @glGetPixelMapuiv := nil; + @glGetPixelMapusv := nil; + @glGetPointerv := nil; + @glGetPolygonStipple := nil; + @glGetString := nil; + @glGetTexEnvfv := nil; + @glGetTexEnviv := nil; + @glGetTexGendv := nil; + @glGetTexGenfv := nil; + @glGetTexGeniv := nil; + @glGetTexImage := nil; + @glGetTexLevelParameterfv := nil; + @glGetTexLevelParameteriv := nil; + @glGetTexParameterfv := nil; + @glGetTexParameteriv := nil; + @glHint := nil; + @glIndexMask := nil; + @glIndexPointer := nil; + @glIndexd := nil; + @glIndexdv := nil; + @glIndexf := nil; + @glIndexfv := nil; + @glIndexi := nil; + @glIndexiv := nil; + @glIndexs := nil; + @glIndexsv := nil; + @glIndexub := nil; + @glIndexubv := nil; + @glInitNames := nil; + @glInterleavedArrays := nil; + @glIsEnabled := nil; + @glIsList := nil; + @glIsTexture := nil; + @glLightModelf := nil; + @glLightModelfv := nil; + @glLightModeli := nil; + @glLightModeliv := nil; + @glLightf := nil; + @glLightfv := nil; + @glLighti := nil; + @glLightiv := nil; + @glLineStipple := nil; + @glLineWidth := nil; + @glListBase := nil; + @glLoadIdentity := nil; + @glLoadMatrixd := nil; + @glLoadMatrixf := nil; + @glLoadName := nil; + @glLogicOp := nil; + @glMap1d := nil; + @glMap1f := nil; + @glMap2d := nil; + @glMap2f := nil; + @glMapGrid1d := nil; + @glMapGrid1f := nil; + @glMapGrid2d := nil; + @glMapGrid2f := nil; + @glMaterialf := nil; + @glMaterialfv := nil; + @glMateriali := nil; + @glMaterialiv := nil; + @glMatrixMode := nil; + @glMultMatrixd := nil; + @glMultMatrixf := nil; + @glNewList := nil; + @glNormal3b := nil; + @glNormal3bv := nil; + @glNormal3d := nil; + @glNormal3dv := nil; + @glNormal3f := nil; + @glNormal3fv := nil; + @glNormal3i := nil; + @glNormal3iv := nil; + @glNormal3s := nil; + @glNormal3sv := nil; + @glNormalPointer := nil; + @glOrtho := nil; + @glPassThrough := nil; + @glPixelMapfv := nil; + @glPixelMapuiv := nil; + @glPixelMapusv := nil; + @glPixelStoref := nil; + @glPixelStorei := nil; + @glPixelTransferf := nil; + @glPixelTransferi := nil; + @glPixelZoom := nil; + @glPointSize := nil; + @glPolygonMode := nil; + @glPolygonOffset := nil; + @glPolygonStipple := nil; + @glPopAttrib := nil; + @glPopClientAttrib := nil; + @glPopMatrix := nil; + @glPopName := nil; + @glPrioritizeTextures := nil; + @glPushAttrib := nil; + @glPushClientAttrib := nil; + @glPushMatrix := nil; + @glPushName := nil; + @glRasterPos2d := nil; + @glRasterPos2dv := nil; + @glRasterPos2f := nil; + @glRasterPos2fv := nil; + @glRasterPos2i := nil; + @glRasterPos2iv := nil; + @glRasterPos2s := nil; + @glRasterPos2sv := nil; + @glRasterPos3d := nil; + @glRasterPos3dv := nil; + @glRasterPos3f := nil; + @glRasterPos3fv := nil; + @glRasterPos3i := nil; + @glRasterPos3iv := nil; + @glRasterPos3s := nil; + @glRasterPos3sv := nil; + @glRasterPos4d := nil; + @glRasterPos4dv := nil; + @glRasterPos4f := nil; + @glRasterPos4fv := nil; + @glRasterPos4i := nil; + @glRasterPos4iv := nil; + @glRasterPos4s := nil; + @glRasterPos4sv := nil; + @glReadBuffer := nil; + @glReadPixels := nil; + @glRectd := nil; + @glRectdv := nil; + @glRectf := nil; + @glRectfv := nil; + @glRecti := nil; + @glRectiv := nil; + @glRects := nil; + @glRectsv := nil; + @glRenderMode := nil; + @glRotated := nil; + @glRotatef := nil; + @glScaled := nil; + @glScalef := nil; + @glScissor := nil; + @glSelectBuffer := nil; + @glShadeModel := nil; + @glStencilFunc := nil; + @glStencilMask := nil; + @glStencilOp := nil; + @glTexCoord1d := nil; + @glTexCoord1dv := nil; + @glTexCoord1f := nil; + @glTexCoord1fv := nil; + @glTexCoord1i := nil; + @glTexCoord1iv := nil; + @glTexCoord1s := nil; + @glTexCoord1sv := nil; + @glTexCoord2d := nil; + @glTexCoord2dv := nil; + @glTexCoord2f := nil; + @glTexCoord2fv := nil; + @glTexCoord2i := nil; + @glTexCoord2iv := nil; + @glTexCoord2s := nil; + @glTexCoord2sv := nil; + @glTexCoord3d := nil; + @glTexCoord3dv := nil; + @glTexCoord3f := nil; + @glTexCoord3fv := nil; + @glTexCoord3i := nil; + @glTexCoord3iv := nil; + @glTexCoord3s := nil; + @glTexCoord3sv := nil; + @glTexCoord4d := nil; + @glTexCoord4dv := nil; + @glTexCoord4f := nil; + @glTexCoord4fv := nil; + @glTexCoord4i := nil; + @glTexCoord4iv := nil; + @glTexCoord4s := nil; + @glTexCoord4sv := nil; + @glTexCoordPointer := nil; + @glTexEnvf := nil; + @glTexEnvfv := nil; + @glTexEnvi := nil; + @glTexEnviv := nil; + @glTexGend := nil; + @glTexGendv := nil; + @glTexGenf := nil; + @glTexGenfv := nil; + @glTexGeni := nil; + @glTexGeniv := nil; + @glTexImage1D := nil; + @glTexImage2D := nil; + @glTexParameterf := nil; + @glTexParameterfv := nil; + @glTexParameteri := nil; + @glTexParameteriv := nil; + @glTexSubImage1D := nil; + @glTexSubImage2D := nil; + @glTranslated := nil; + @glTranslatef := nil; + @glVertex2d := nil; + @glVertex2dv := nil; + @glVertex2f := nil; + @glVertex2fv := nil; + @glVertex2i := nil; + @glVertex2iv := nil; + @glVertex2s := nil; + @glVertex2sv := nil; + @glVertex3d := nil; + @glVertex3dv := nil; + @glVertex3f := nil; + @glVertex3fv := nil; + @glVertex3i := nil; + @glVertex3iv := nil; + @glVertex3s := nil; + @glVertex3sv := nil; + @glVertex4d := nil; + @glVertex4dv := nil; + @glVertex4f := nil; + @glVertex4fv := nil; + @glVertex4i := nil; + @glVertex4iv := nil; + @glVertex4s := nil; + @glVertex4sv := nil; + @glVertexPointer := nil; + @glViewport := nil; + {$IFDEF WINDOWS} + @ChoosePixelFormat := nil; + {$ENDIF} + + UnLoadModule(LibGL); + +end; + +procedure LoadOpenGL(const dll: PChar); +begin + + FreeOpenGL; + + if LoadModule( LibGL, dll ) then + begin + @glAccum := GetModuleSymbol(LibGL, 'glAccum'); + @glAlphaFunc := GetModuleSymbol(LibGL, 'glAlphaFunc'); + @glAreTexturesResident := GetModuleSymbol(LibGL, 'glAreTexturesResident'); + @glArrayElement := GetModuleSymbol(LibGL, 'glArrayElement'); + @glBegin := GetModuleSymbol(LibGL, 'glBegin'); + @glBindTexture := GetModuleSymbol(LibGL, 'glBindTexture'); + @glBitmap := GetModuleSymbol(LibGL, 'glBitmap'); + @glBlendFunc := GetModuleSymbol(LibGL, 'glBlendFunc'); + @glCallList := GetModuleSymbol(LibGL, 'glCallList'); + @glCallLists := GetModuleSymbol(LibGL, 'glCallLists'); + @glClear := GetModuleSymbol(LibGL, 'glClear'); + @glClearAccum := GetModuleSymbol(LibGL, 'glClearAccum'); + @glClearColor := GetModuleSymbol(LibGL, 'glClearColor'); + @glClearDepth := GetModuleSymbol(LibGL, 'glClearDepth'); + @glClearIndex := GetModuleSymbol(LibGL, 'glClearIndex'); + @glClearStencil := GetModuleSymbol(LibGL, 'glClearStencil'); + @glClipPlane := GetModuleSymbol(LibGL, 'glClipPlane'); + @glColor3b := GetModuleSymbol(LibGL, 'glColor3b'); + @glColor3bv := GetModuleSymbol(LibGL, 'glColor3bv'); + @glColor3d := GetModuleSymbol(LibGL, 'glColor3d'); + @glColor3dv := GetModuleSymbol(LibGL, 'glColor3dv'); + @glColor3f := GetModuleSymbol(LibGL, 'glColor3f'); + @glColor3fv := GetModuleSymbol(LibGL, 'glColor3fv'); + @glColor3i := GetModuleSymbol(LibGL, 'glColor3i'); + @glColor3iv := GetModuleSymbol(LibGL, 'glColor3iv'); + @glColor3s := GetModuleSymbol(LibGL, 'glColor3s'); + @glColor3sv := GetModuleSymbol(LibGL, 'glColor3sv'); + @glColor3ub := GetModuleSymbol(LibGL, 'glColor3ub'); + @glColor3ubv := GetModuleSymbol(LibGL, 'glColor3ubv'); + @glColor3ui := GetModuleSymbol(LibGL, 'glColor3ui'); + @glColor3uiv := GetModuleSymbol(LibGL, 'glColor3uiv'); + @glColor3us := GetModuleSymbol(LibGL, 'glColor3us'); + @glColor3usv := GetModuleSymbol(LibGL, 'glColor3usv'); + @glColor4b := GetModuleSymbol(LibGL, 'glColor4b'); + @glColor4bv := GetModuleSymbol(LibGL, 'glColor4bv'); + @glColor4d := GetModuleSymbol(LibGL, 'glColor4d'); + @glColor4dv := GetModuleSymbol(LibGL, 'glColor4dv'); + @glColor4f := GetModuleSymbol(LibGL, 'glColor4f'); + @glColor4fv := GetModuleSymbol(LibGL, 'glColor4fv'); + @glColor4i := GetModuleSymbol(LibGL, 'glColor4i'); + @glColor4iv := GetModuleSymbol(LibGL, 'glColor4iv'); + @glColor4s := GetModuleSymbol(LibGL, 'glColor4s'); + @glColor4sv := GetModuleSymbol(LibGL, 'glColor4sv'); + @glColor4ub := GetModuleSymbol(LibGL, 'glColor4ub'); + @glColor4ubv := GetModuleSymbol(LibGL, 'glColor4ubv'); + @glColor4ui := GetModuleSymbol(LibGL, 'glColor4ui'); + @glColor4uiv := GetModuleSymbol(LibGL, 'glColor4uiv'); + @glColor4us := GetModuleSymbol(LibGL, 'glColor4us'); + @glColor4usv := GetModuleSymbol(LibGL, 'glColor4usv'); + @glColorMask := GetModuleSymbol(LibGL, 'glColorMask'); + @glColorMaterial := GetModuleSymbol(LibGL, 'glColorMaterial'); + @glColorPointer := GetModuleSymbol(LibGL, 'glColorPointer'); + @glCopyPixels := GetModuleSymbol(LibGL, 'glCopyPixels'); + @glCopyTexImage1D := GetModuleSymbol(LibGL, 'glCopyTexImage1D'); + @glCopyTexImage2D := GetModuleSymbol(LibGL, 'glCopyTexImage2D'); + @glCopyTexSubImage1D := GetModuleSymbol(LibGL, 'glCopyTexSubImage1D'); + @glCopyTexSubImage2D := GetModuleSymbol(LibGL, 'glCopyTexSubImage2D'); + @glCullFace := GetModuleSymbol(LibGL, 'glCullFace'); + @glDeleteLists := GetModuleSymbol(LibGL, 'glDeleteLists'); + @glDeleteTextures := GetModuleSymbol(LibGL, 'glDeleteTextures'); + @glDepthFunc := GetModuleSymbol(LibGL, 'glDepthFunc'); + @glDepthMask := GetModuleSymbol(LibGL, 'glDepthMask'); + @glDepthRange := GetModuleSymbol(LibGL, 'glDepthRange'); + @glDisable := GetModuleSymbol(LibGL, 'glDisable'); + @glDisableClientState := GetModuleSymbol(LibGL, 'glDisableClientState'); + @glDrawArrays := GetModuleSymbol(LibGL, 'glDrawArrays'); + @glDrawBuffer := GetModuleSymbol(LibGL, 'glDrawBuffer'); + @glDrawElements := GetModuleSymbol(LibGL, 'glDrawElements'); + @glDrawPixels := GetModuleSymbol(LibGL, 'glDrawPixels'); + @glEdgeFlag := GetModuleSymbol(LibGL, 'glEdgeFlag'); + @glEdgeFlagPointer := GetModuleSymbol(LibGL, 'glEdgeFlagPointer'); + @glEdgeFlagv := GetModuleSymbol(LibGL, 'glEdgeFlagv'); + @glEnable := GetModuleSymbol(LibGL, 'glEnable'); + @glEnableClientState := GetModuleSymbol(LibGL, 'glEnableClientState'); + @glEnd := GetModuleSymbol(LibGL, 'glEnd'); + @glEndList := GetModuleSymbol(LibGL, 'glEndList'); + @glEvalCoord1d := GetModuleSymbol(LibGL, 'glEvalCoord1d'); + @glEvalCoord1dv := GetModuleSymbol(LibGL, 'glEvalCoord1dv'); + @glEvalCoord1f := GetModuleSymbol(LibGL, 'glEvalCoord1f'); + @glEvalCoord1fv := GetModuleSymbol(LibGL, 'glEvalCoord1fv'); + @glEvalCoord2d := GetModuleSymbol(LibGL, 'glEvalCoord2d'); + @glEvalCoord2dv := GetModuleSymbol(LibGL, 'glEvalCoord2dv'); + @glEvalCoord2f := GetModuleSymbol(LibGL, 'glEvalCoord2f'); + @glEvalCoord2fv := GetModuleSymbol(LibGL, 'glEvalCoord2fv'); + @glEvalMesh1 := GetModuleSymbol(LibGL, 'glEvalMesh1'); + @glEvalMesh2 := GetModuleSymbol(LibGL, 'glEvalMesh2'); + @glEvalPoint1 := GetModuleSymbol(LibGL, 'glEvalPoint1'); + @glEvalPoint2 := GetModuleSymbol(LibGL, 'glEvalPoint2'); + @glFeedbackBuffer := GetModuleSymbol(LibGL, 'glFeedbackBuffer'); + @glFinish := GetModuleSymbol(LibGL, 'glFinish'); + @glFlush := GetModuleSymbol(LibGL, 'glFlush'); + @glFogf := GetModuleSymbol(LibGL, 'glFogf'); + @glFogfv := GetModuleSymbol(LibGL, 'glFogfv'); + @glFogi := GetModuleSymbol(LibGL, 'glFogi'); + @glFogiv := GetModuleSymbol(LibGL, 'glFogiv'); + @glFrontFace := GetModuleSymbol(LibGL, 'glFrontFace'); + @glFrustum := GetModuleSymbol(LibGL, 'glFrustum'); + @glGenLists := GetModuleSymbol(LibGL, 'glGenLists'); + @glGenTextures := GetModuleSymbol(LibGL, 'glGenTextures'); + @glGetBooleanv := GetModuleSymbol(LibGL, 'glGetBooleanv'); + @glGetClipPlane := GetModuleSymbol(LibGL, 'glGetClipPlane'); + @glGetDoublev := GetModuleSymbol(LibGL, 'glGetDoublev'); + @glGetError := GetModuleSymbol(LibGL, 'glGetError'); + @glGetFloatv := GetModuleSymbol(LibGL, 'glGetFloatv'); + @glGetIntegerv := GetModuleSymbol(LibGL, 'glGetIntegerv'); + @glGetLightfv := GetModuleSymbol(LibGL, 'glGetLightfv'); + @glGetLightiv := GetModuleSymbol(LibGL, 'glGetLightiv'); + @glGetMapdv := GetModuleSymbol(LibGL, 'glGetMapdv'); + @glGetMapfv := GetModuleSymbol(LibGL, 'glGetMapfv'); + @glGetMapiv := GetModuleSymbol(LibGL, 'glGetMapiv'); + @glGetMaterialfv := GetModuleSymbol(LibGL, 'glGetMaterialfv'); + @glGetMaterialiv := GetModuleSymbol(LibGL, 'glGetMaterialiv'); + @glGetPixelMapfv := GetModuleSymbol(LibGL, 'glGetPixelMapfv'); + @glGetPixelMapuiv := GetModuleSymbol(LibGL, 'glGetPixelMapuiv'); + @glGetPixelMapusv := GetModuleSymbol(LibGL, 'glGetPixelMapusv'); + @glGetPointerv := GetModuleSymbol(LibGL, 'glGetPointerv'); + @glGetPolygonStipple := GetModuleSymbol(LibGL, 'glGetPolygonStipple'); + @glGetString := GetModuleSymbol(LibGL, 'glGetString'); + @glGetTexEnvfv := GetModuleSymbol(LibGL, 'glGetTexEnvfv'); + @glGetTexEnviv := GetModuleSymbol(LibGL, 'glGetTexEnviv'); + @glGetTexGendv := GetModuleSymbol(LibGL, 'glGetTexGendv'); + @glGetTexGenfv := GetModuleSymbol(LibGL, 'glGetTexGenfv'); + @glGetTexGeniv := GetModuleSymbol(LibGL, 'glGetTexGeniv'); + @glGetTexImage := GetModuleSymbol(LibGL, 'glGetTexImage'); + @glGetTexLevelParameterfv := GetModuleSymbol(LibGL, 'glGetTexLevelParameterfv'); + @glGetTexLevelParameteriv := GetModuleSymbol(LibGL, 'glGetTexLevelParameteriv'); + @glGetTexParameterfv := GetModuleSymbol(LibGL, 'glGetTexParameterfv'); + @glGetTexParameteriv := GetModuleSymbol(LibGL, 'glGetTexParameteriv'); + @glHint := GetModuleSymbol(LibGL, 'glHint'); + @glIndexMask := GetModuleSymbol(LibGL, 'glIndexMask'); + @glIndexPointer := GetModuleSymbol(LibGL, 'glIndexPointer'); + @glIndexd := GetModuleSymbol(LibGL, 'glIndexd'); + @glIndexdv := GetModuleSymbol(LibGL, 'glIndexdv'); + @glIndexf := GetModuleSymbol(LibGL, 'glIndexf'); + @glIndexfv := GetModuleSymbol(LibGL, 'glIndexfv'); + @glIndexi := GetModuleSymbol(LibGL, 'glIndexi'); + @glIndexiv := GetModuleSymbol(LibGL, 'glIndexiv'); + @glIndexs := GetModuleSymbol(LibGL, 'glIndexs'); + @glIndexsv := GetModuleSymbol(LibGL, 'glIndexsv'); + @glIndexub := GetModuleSymbol(LibGL, 'glIndexub'); + @glIndexubv := GetModuleSymbol(LibGL, 'glIndexubv'); + @glInitNames := GetModuleSymbol(LibGL, 'glInitNames'); + @glInterleavedArrays := GetModuleSymbol(LibGL, 'glInterleavedArrays'); + @glIsEnabled := GetModuleSymbol(LibGL, 'glIsEnabled'); + @glIsList := GetModuleSymbol(LibGL, 'glIsList'); + @glIsTexture := GetModuleSymbol(LibGL, 'glIsTexture'); + @glLightModelf := GetModuleSymbol(LibGL, 'glLightModelf'); + @glLightModelfv := GetModuleSymbol(LibGL, 'glLightModelfv'); + @glLightModeli := GetModuleSymbol(LibGL, 'glLightModeli'); + @glLightModeliv := GetModuleSymbol(LibGL, 'glLightModeliv'); + @glLightf := GetModuleSymbol(LibGL, 'glLightf'); + @glLightfv := GetModuleSymbol(LibGL, 'glLightfv'); + @glLighti := GetModuleSymbol(LibGL, 'glLighti'); + @glLightiv := GetModuleSymbol(LibGL, 'glLightiv'); + @glLineStipple := GetModuleSymbol(LibGL, 'glLineStipple'); + @glLineWidth := GetModuleSymbol(LibGL, 'glLineWidth'); + @glListBase := GetModuleSymbol(LibGL, 'glListBase'); + @glLoadIdentity := GetModuleSymbol(LibGL, 'glLoadIdentity'); + @glLoadMatrixd := GetModuleSymbol(LibGL, 'glLoadMatrixd'); + @glLoadMatrixf := GetModuleSymbol(LibGL, 'glLoadMatrixf'); + @glLoadName := GetModuleSymbol(LibGL, 'glLoadName'); + @glLogicOp := GetModuleSymbol(LibGL, 'glLogicOp'); + @glMap1d := GetModuleSymbol(LibGL, 'glMap1d'); + @glMap1f := GetModuleSymbol(LibGL, 'glMap1f'); + @glMap2d := GetModuleSymbol(LibGL, 'glMap2d'); + @glMap2f := GetModuleSymbol(LibGL, 'glMap2f'); + @glMapGrid1d := GetModuleSymbol(LibGL, 'glMapGrid1d'); + @glMapGrid1f := GetModuleSymbol(LibGL, 'glMapGrid1f'); + @glMapGrid2d := GetModuleSymbol(LibGL, 'glMapGrid2d'); + @glMapGrid2f := GetModuleSymbol(LibGL, 'glMapGrid2f'); + @glMaterialf := GetModuleSymbol(LibGL, 'glMaterialf'); + @glMaterialfv := GetModuleSymbol(LibGL, 'glMaterialfv'); + @glMateriali := GetModuleSymbol(LibGL, 'glMateriali'); + @glMaterialiv := GetModuleSymbol(LibGL, 'glMaterialiv'); + @glMatrixMode := GetModuleSymbol(LibGL, 'glMatrixMode'); + @glMultMatrixd := GetModuleSymbol(LibGL, 'glMultMatrixd'); + @glMultMatrixf := GetModuleSymbol(LibGL, 'glMultMatrixf'); + @glNewList := GetModuleSymbol(LibGL, 'glNewList'); + @glNormal3b := GetModuleSymbol(LibGL, 'glNormal3b'); + @glNormal3bv := GetModuleSymbol(LibGL, 'glNormal3bv'); + @glNormal3d := GetModuleSymbol(LibGL, 'glNormal3d'); + @glNormal3dv := GetModuleSymbol(LibGL, 'glNormal3dv'); + @glNormal3f := GetModuleSymbol(LibGL, 'glNormal3f'); + @glNormal3fv := GetModuleSymbol(LibGL, 'glNormal3fv'); + @glNormal3i := GetModuleSymbol(LibGL, 'glNormal3i'); + @glNormal3iv := GetModuleSymbol(LibGL, 'glNormal3iv'); + @glNormal3s := GetModuleSymbol(LibGL, 'glNormal3s'); + @glNormal3sv := GetModuleSymbol(LibGL, 'glNormal3sv'); + @glNormalPointer := GetModuleSymbol(LibGL, 'glNormalPointer'); + @glOrtho := GetModuleSymbol(LibGL, 'glOrtho'); + @glPassThrough := GetModuleSymbol(LibGL, 'glPassThrough'); + @glPixelMapfv := GetModuleSymbol(LibGL, 'glPixelMapfv'); + @glPixelMapuiv := GetModuleSymbol(LibGL, 'glPixelMapuiv'); + @glPixelMapusv := GetModuleSymbol(LibGL, 'glPixelMapusv'); + @glPixelStoref := GetModuleSymbol(LibGL, 'glPixelStoref'); + @glPixelStorei := GetModuleSymbol(LibGL, 'glPixelStorei'); + @glPixelTransferf := GetModuleSymbol(LibGL, 'glPixelTransferf'); + @glPixelTransferi := GetModuleSymbol(LibGL, 'glPixelTransferi'); + @glPixelZoom := GetModuleSymbol(LibGL, 'glPixelZoom'); + @glPointSize := GetModuleSymbol(LibGL, 'glPointSize'); + @glPolygonMode := GetModuleSymbol(LibGL, 'glPolygonMode'); + @glPolygonOffset := GetModuleSymbol(LibGL, 'glPolygonOffset'); + @glPolygonStipple := GetModuleSymbol(LibGL, 'glPolygonStipple'); + @glPopAttrib := GetModuleSymbol(LibGL, 'glPopAttrib'); + @glPopClientAttrib := GetModuleSymbol(LibGL, 'glPopClientAttrib'); + @glPopMatrix := GetModuleSymbol(LibGL, 'glPopMatrix'); + @glPopName := GetModuleSymbol(LibGL, 'glPopName'); + @glPrioritizeTextures := GetModuleSymbol(LibGL, 'glPrioritizeTextures'); + @glPushAttrib := GetModuleSymbol(LibGL, 'glPushAttrib'); + @glPushClientAttrib := GetModuleSymbol(LibGL, 'glPushClientAttrib'); + @glPushMatrix := GetModuleSymbol(LibGL, 'glPushMatrix'); + @glPushName := GetModuleSymbol(LibGL, 'glPushName'); + @glRasterPos2d := GetModuleSymbol(LibGL, 'glRasterPos2d'); + @glRasterPos2dv := GetModuleSymbol(LibGL, 'glRasterPos2dv'); + @glRasterPos2f := GetModuleSymbol(LibGL, 'glRasterPos2f'); + @glRasterPos2fv := GetModuleSymbol(LibGL, 'glRasterPos2fv'); + @glRasterPos2i := GetModuleSymbol(LibGL, 'glRasterPos2i'); + @glRasterPos2iv := GetModuleSymbol(LibGL, 'glRasterPos2iv'); + @glRasterPos2s := GetModuleSymbol(LibGL, 'glRasterPos2s'); + @glRasterPos2sv := GetModuleSymbol(LibGL, 'glRasterPos2sv'); + @glRasterPos3d := GetModuleSymbol(LibGL, 'glRasterPos3d'); + @glRasterPos3dv := GetModuleSymbol(LibGL, 'glRasterPos3dv'); + @glRasterPos3f := GetModuleSymbol(LibGL, 'glRasterPos3f'); + @glRasterPos3fv := GetModuleSymbol(LibGL, 'glRasterPos3fv'); + @glRasterPos3i := GetModuleSymbol(LibGL, 'glRasterPos3i'); + @glRasterPos3iv := GetModuleSymbol(LibGL, 'glRasterPos3iv'); + @glRasterPos3s := GetModuleSymbol(LibGL, 'glRasterPos3s'); + @glRasterPos3sv := GetModuleSymbol(LibGL, 'glRasterPos3sv'); + @glRasterPos4d := GetModuleSymbol(LibGL, 'glRasterPos4d'); + @glRasterPos4dv := GetModuleSymbol(LibGL, 'glRasterPos4dv'); + @glRasterPos4f := GetModuleSymbol(LibGL, 'glRasterPos4f'); + @glRasterPos4fv := GetModuleSymbol(LibGL, 'glRasterPos4fv'); + @glRasterPos4i := GetModuleSymbol(LibGL, 'glRasterPos4i'); + @glRasterPos4iv := GetModuleSymbol(LibGL, 'glRasterPos4iv'); + @glRasterPos4s := GetModuleSymbol(LibGL, 'glRasterPos4s'); + @glRasterPos4sv := GetModuleSymbol(LibGL, 'glRasterPos4sv'); + @glReadBuffer := GetModuleSymbol(LibGL, 'glReadBuffer'); + @glReadPixels := GetModuleSymbol(LibGL, 'glReadPixels'); + @glRectd := GetModuleSymbol(LibGL, 'glRectd'); + @glRectdv := GetModuleSymbol(LibGL, 'glRectdv'); + @glRectf := GetModuleSymbol(LibGL, 'glRectf'); + @glRectfv := GetModuleSymbol(LibGL, 'glRectfv'); + @glRecti := GetModuleSymbol(LibGL, 'glRecti'); + @glRectiv := GetModuleSymbol(LibGL, 'glRectiv'); + @glRects := GetModuleSymbol(LibGL, 'glRects'); + @glRectsv := GetModuleSymbol(LibGL, 'glRectsv'); + @glRenderMode := GetModuleSymbol(LibGL, 'glRenderMode'); + @glRotated := GetModuleSymbol(LibGL, 'glRotated'); + @glRotatef := GetModuleSymbol(LibGL, 'glRotatef'); + @glScaled := GetModuleSymbol(LibGL, 'glScaled'); + @glScalef := GetModuleSymbol(LibGL, 'glScalef'); + @glScissor := GetModuleSymbol(LibGL, 'glScissor'); + @glSelectBuffer := GetModuleSymbol(LibGL, 'glSelectBuffer'); + @glShadeModel := GetModuleSymbol(LibGL, 'glShadeModel'); + @glStencilFunc := GetModuleSymbol(LibGL, 'glStencilFunc'); + @glStencilMask := GetModuleSymbol(LibGL, 'glStencilMask'); + @glStencilOp := GetModuleSymbol(LibGL, 'glStencilOp'); + @glTexCoord1d := GetModuleSymbol(LibGL, 'glTexCoord1d'); + @glTexCoord1dv := GetModuleSymbol(LibGL, 'glTexCoord1dv'); + @glTexCoord1f := GetModuleSymbol(LibGL, 'glTexCoord1f'); + @glTexCoord1fv := GetModuleSymbol(LibGL, 'glTexCoord1fv'); + @glTexCoord1i := GetModuleSymbol(LibGL, 'glTexCoord1i'); + @glTexCoord1iv := GetModuleSymbol(LibGL, 'glTexCoord1iv'); + @glTexCoord1s := GetModuleSymbol(LibGL, 'glTexCoord1s'); + @glTexCoord1sv := GetModuleSymbol(LibGL, 'glTexCoord1sv'); + @glTexCoord2d := GetModuleSymbol(LibGL, 'glTexCoord2d'); + @glTexCoord2dv := GetModuleSymbol(LibGL, 'glTexCoord2dv'); + @glTexCoord2f := GetModuleSymbol(LibGL, 'glTexCoord2f'); + @glTexCoord2fv := GetModuleSymbol(LibGL, 'glTexCoord2fv'); + @glTexCoord2i := GetModuleSymbol(LibGL, 'glTexCoord2i'); + @glTexCoord2iv := GetModuleSymbol(LibGL, 'glTexCoord2iv'); + @glTexCoord2s := GetModuleSymbol(LibGL, 'glTexCoord2s'); + @glTexCoord2sv := GetModuleSymbol(LibGL, 'glTexCoord2sv'); + @glTexCoord3d := GetModuleSymbol(LibGL, 'glTexCoord3d'); + @glTexCoord3dv := GetModuleSymbol(LibGL, 'glTexCoord3dv'); + @glTexCoord3f := GetModuleSymbol(LibGL, 'glTexCoord3f'); + @glTexCoord3fv := GetModuleSymbol(LibGL, 'glTexCoord3fv'); + @glTexCoord3i := GetModuleSymbol(LibGL, 'glTexCoord3i'); + @glTexCoord3iv := GetModuleSymbol(LibGL, 'glTexCoord3iv'); + @glTexCoord3s := GetModuleSymbol(LibGL, 'glTexCoord3s'); + @glTexCoord3sv := GetModuleSymbol(LibGL, 'glTexCoord3sv'); + @glTexCoord4d := GetModuleSymbol(LibGL, 'glTexCoord4d'); + @glTexCoord4dv := GetModuleSymbol(LibGL, 'glTexCoord4dv'); + @glTexCoord4f := GetModuleSymbol(LibGL, 'glTexCoord4f'); + @glTexCoord4fv := GetModuleSymbol(LibGL, 'glTexCoord4fv'); + @glTexCoord4i := GetModuleSymbol(LibGL, 'glTexCoord4i'); + @glTexCoord4iv := GetModuleSymbol(LibGL, 'glTexCoord4iv'); + @glTexCoord4s := GetModuleSymbol(LibGL, 'glTexCoord4s'); + @glTexCoord4sv := GetModuleSymbol(LibGL, 'glTexCoord4sv'); + @glTexCoordPointer := GetModuleSymbol(LibGL, 'glTexCoordPointer'); + @glTexEnvf := GetModuleSymbol(LibGL, 'glTexEnvf'); + @glTexEnvfv := GetModuleSymbol(LibGL, 'glTexEnvfv'); + @glTexEnvi := GetModuleSymbol(LibGL, 'glTexEnvi'); + @glTexEnviv := GetModuleSymbol(LibGL, 'glTexEnviv'); + @glTexGend := GetModuleSymbol(LibGL, 'glTexGend'); + @glTexGendv := GetModuleSymbol(LibGL, 'glTexGendv'); + @glTexGenf := GetModuleSymbol(LibGL, 'glTexGenf'); + @glTexGenfv := GetModuleSymbol(LibGL, 'glTexGenfv'); + @glTexGeni := GetModuleSymbol(LibGL, 'glTexGeni'); + @glTexGeniv := GetModuleSymbol(LibGL, 'glTexGeniv'); + @glTexImage1D := GetModuleSymbol(LibGL, 'glTexImage1D'); + @glTexImage2D := GetModuleSymbol(LibGL, 'glTexImage2D'); + @glTexParameterf := GetModuleSymbol(LibGL, 'glTexParameterf'); + @glTexParameterfv := GetModuleSymbol(LibGL, 'glTexParameterfv'); + @glTexParameteri := GetModuleSymbol(LibGL, 'glTexParameteri'); + @glTexParameteriv := GetModuleSymbol(LibGL, 'glTexParameteriv'); + @glTexSubImage1D := GetModuleSymbol(LibGL, 'glTexSubImage1D'); + @glTexSubImage2D := GetModuleSymbol(LibGL, 'glTexSubImage2D'); + @glTranslated := GetModuleSymbol(LibGL, 'glTranslated'); + @glTranslatef := GetModuleSymbol(LibGL, 'glTranslatef'); + @glVertex2d := GetModuleSymbol(LibGL, 'glVertex2d'); + @glVertex2dv := GetModuleSymbol(LibGL, 'glVertex2dv'); + @glVertex2f := GetModuleSymbol(LibGL, 'glVertex2f'); + @glVertex2fv := GetModuleSymbol(LibGL, 'glVertex2fv'); + @glVertex2i := GetModuleSymbol(LibGL, 'glVertex2i'); + @glVertex2iv := GetModuleSymbol(LibGL, 'glVertex2iv'); + @glVertex2s := GetModuleSymbol(LibGL, 'glVertex2s'); + @glVertex2sv := GetModuleSymbol(LibGL, 'glVertex2sv'); + @glVertex3d := GetModuleSymbol(LibGL, 'glVertex3d'); + @glVertex3dv := GetModuleSymbol(LibGL, 'glVertex3dv'); + @glVertex3f := GetModuleSymbol(LibGL, 'glVertex3f'); + @glVertex3fv := GetModuleSymbol(LibGL, 'glVertex3fv'); + @glVertex3i := GetModuleSymbol(LibGL, 'glVertex3i'); + @glVertex3iv := GetModuleSymbol(LibGL, 'glVertex3iv'); + @glVertex3s := GetModuleSymbol(LibGL, 'glVertex3s'); + @glVertex3sv := GetModuleSymbol(LibGL, 'glVertex3sv'); + @glVertex4d := GetModuleSymbol(LibGL, 'glVertex4d'); + @glVertex4dv := GetModuleSymbol(LibGL, 'glVertex4dv'); + @glVertex4f := GetModuleSymbol(LibGL, 'glVertex4f'); + @glVertex4fv := GetModuleSymbol(LibGL, 'glVertex4fv'); + @glVertex4i := GetModuleSymbol(LibGL, 'glVertex4i'); + @glVertex4iv := GetModuleSymbol(LibGL, 'glVertex4iv'); + @glVertex4s := GetModuleSymbol(LibGL, 'glVertex4s'); + @glVertex4sv := GetModuleSymbol(LibGL, 'glVertex4sv'); + @glVertexPointer := GetModuleSymbol(LibGL, 'glVertexPointer'); + @glViewport := GetModuleSymbol(LibGL, 'glViewport'); + + {$IFDEF WINDOWS} + @ChoosePixelFormat := GetModuleSymbol(LibGL, 'ChoosePixelFormat'); + if not Assigned(ChoosePixelFormat) then + {$IFNDEF FPC}@{$ENDIF}ChoosePixelFormat := @Windows.ChoosePixelFormat; + {$ENDIF} + end; +end; + +initialization + {$IF Defined(CPU386) or Defined(CPUI386) or Defined(CPUX86_64)} + Set8087CW($133F); + {$IFEND} + + LoadOpenGL( GLLibName ); + +finalization + + FreeOpenGL; + +end. + diff --git a/Game/Code/lib/JEDI-SDL/OpenGL/Pas/glext.pas b/Game/Code/lib/JEDI-SDL/OpenGL/Pas/glext.pas index 835c1703..1fc70f8a 100644 --- a/Game/Code/lib/JEDI-SDL/OpenGL/Pas/glext.pas +++ b/Game/Code/lib/JEDI-SDL/OpenGL/Pas/glext.pas @@ -1,9578 +1,9578 @@ -unit glext;
-{
- $Id: glext.pas,v 1.6 2007/05/20 20:28:31 savage Exp $
-
-}
-(**************************************************
- * OpenGL extension loading library *
- * Generated by MetaGLext, written by Tom Nuydens *
- * (tom@delphi3d.net -- http://www.delphi3d.net *
- **************************************************)
-
-{
- $Log: glext.pas,v $
- Revision 1.6 2007/05/20 20:28:31 savage
- Initial Changes to Handle 64 Bits
-
- Revision 1.5 2006/01/11 22:39:02 drellis
- Updated to Support Up to OpenGL 2.0
-
- Revision 1.4 2005/01/05 00:28:40 savage
- Forgot to wrap a couple of Load_WGL function calls with an IFDEF WIN32. Fixed so now compiles under Linux as well.
-
- Revision 1.3 2004/08/24 19:33:06 savage
- Removed declarations of SDL_GL_GetProcAddress as the correct ones are in sdl.pas.
-
- Revision 1.2 2004/08/09 00:38:01 savage
- Updated to Tom's latest version. May contains bugs, but I hope not.
-
- Revision 1.1 2004/03/30 21:53:54 savage
- Moved to it's own folder.
-
- Revision 1.6 2004/03/28 00:28:43 savage
- Fixed some glSecondaryColor definitions...
-
- Revision 1.5 2004/02/20 17:18:16 savage
- Forgot to prefix function pointer with @ for FPC and other Pascal compilers.
-
- Revision 1.4 2004/02/20 17:09:55 savage
- Code tidied up in gl, glu and glut, while extensions in glext.pas are now loaded using SDL_GL_GetProcAddress, thus making it more cross-platform compatible, but now more tied to SDL.
-
- Revision 1.3 2004/02/14 22:36:29 savage
- Fixed inconsistencies of using LoadLibrary and LoadModule.
- Now all units make use of LoadModule rather than LoadLibrary and other dynamic proc procedures.
-
- Revision 1.2 2004/02/14 00:09:19 savage
- Changed uses to now make use of moduleloader.pas rather than dllfuncs.pas
-
- Revision 1.1 2004/02/05 00:08:19 savage
- Module 1.0 release
-
- Revision 1.7 2003/06/02 12:32:13 savage
- Modified Sources to avoid warnings with Delphi by moving CVS Logging to the top of the header files. Hopefully CVS Logging still works.
-
-}
-
-interface
-
-{$I jedi-sdl.inc}
-
-uses
- SysUtils,
-{$IFDEF __GPC__}
- gpc,
-{$ENDIF}
-
-{$IFDEF WINDOWS}
- Windows,
-{$ENDIF}
- moduleloader,
- gl;
-
-// Test if the given extension name is present in the given extension string.
-function glext_ExtensionSupported(const extension: PChar; const searchIn: PChar): Boolean;
-
-// Load a Specific Extension
-function glext_LoadExtension(ext: String): Boolean;
-// Some types that were introduced by extensions:
-type
- GLintptrARB = Integer;
- PGLintptrARB = ^GLintptrARB;
-
- GLsizeiptrARB = Integer;
- PGLsizeiptrARB = ^GLsizeiptrARB;
-
- GLcharARB = Char;
- PGLcharARB = ^GLcharARB;
-
- GLhandleARB = Cardinal;
- PGLhandleARB = ^GLhandleARB;
-
- GLintptr = Integer;
- PGLintptr = ^GLintptr;
-
- GLsizeiptr = Integer;
- PGLsizeiptr = ^GLsizeiptr;
-
- GLchar = Char;
- PGLchar = ^GLchar;
-
-//***** GL_version_1_2 *****//
-const
- GL_UNSIGNED_BYTE_3_3_2 = $8032;
- GL_UNSIGNED_SHORT_4_4_4_4 = $8033;
- GL_UNSIGNED_SHORT_5_5_5_1 = $8034;
- GL_UNSIGNED_INT_8_8_8_8 = $8035;
- GL_UNSIGNED_INT_10_10_10_2 = $8036;
- GL_RESCALE_NORMAL = $803A;
- GL_UNSIGNED_BYTE_2_3_3_REV = $8362;
- GL_UNSIGNED_SHORT_5_6_5 = $8363;
- GL_UNSIGNED_SHORT_5_6_5_REV = $8364;
- GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365;
- GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366;
- GL_UNSIGNED_INT_8_8_8_8_REV = $8367;
- GL_UNSIGNED_INT_2_10_10_10_REV = $8368;
- GL_BGR = $80E0;
- GL_BGRA = $80E1;
- GL_MAX_ELEMENTS_VERTICES = $80E8;
- GL_MAX_ELEMENTS_INDICES = $80E9;
- GL_CLAMP_TO_EDGE = $812F;
- GL_TEXTURE_MIN_LOD = $813A;
- GL_TEXTURE_MAX_LOD = $813B;
- GL_TEXTURE_BASE_LEVEL = $813C;
- GL_TEXTURE_MAX_LEVEL = $813D;
- GL_LIGHT_MODEL_COLOR_CONTROL = $81F8;
- GL_SINGLE_COLOR = $81F9;
- GL_SEPARATE_SPECULAR_COLOR = $81FA;
- GL_SMOOTH_POINT_SIZE_RANGE = $0B12;
- GL_SMOOTH_POINT_SIZE_GRANULARITY = $0B13;
- GL_SMOOTH_LINE_WIDTH_RANGE = $0B22;
- GL_SMOOTH_LINE_WIDTH_GRANULARITY = $0B23;
- GL_ALIASED_POINT_SIZE_RANGE = $846D;
- GL_ALIASED_LINE_WIDTH_RANGE = $846E;
- GL_PACK_SKIP_IMAGES = $806B;
- GL_PACK_IMAGE_HEIGHT = $806C;
- GL_UNPACK_SKIP_IMAGES = $806D;
- GL_UNPACK_IMAGE_HEIGHT = $806E;
- GL_TEXTURE_3D = $806F;
- GL_PROXY_TEXTURE_3D = $8070;
- GL_TEXTURE_DEPTH = $8071;
- GL_TEXTURE_WRAP_R = $8072;
- GL_MAX_3D_TEXTURE_SIZE = $8073;
-var
- glDrawRangeElements: procedure(mode: GLenum; start: GLuint; _end: GLuint; count: GLsizei; _type: GLenum; const indices: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexImage3D: procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; depth: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexSubImage3D: procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; zoffset: GLint; width: GLsizei; height: GLsizei; depth: GLsizei; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCopyTexSubImage3D: procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; zoffset: GLint; x: GLint; y: GLint; width: GLsizei; height: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_version_1_2: Boolean;
-
-//***** GL_ARB_imaging *****//
-const
- GL_CONSTANT_COLOR = $8001;
- GL_ONE_MINUS_CONSTANT_COLOR = $8002;
- GL_CONSTANT_ALPHA = $8003;
- GL_ONE_MINUS_CONSTANT_ALPHA = $8004;
- GL_BLEND_COLOR = $8005;
- GL_FUNC_ADD = $8006;
- GL_MIN = $8007;
- GL_MAX = $8008;
- GL_BLEND_EQUATION = $8009;
- GL_FUNC_SUBTRACT = $800A;
- GL_FUNC_REVERSE_SUBTRACT = $800B;
- GL_CONVOLUTION_1D = $8010;
- GL_CONVOLUTION_2D = $8011;
- GL_SEPARABLE_2D = $8012;
- GL_CONVOLUTION_BORDER_MODE = $8013;
- GL_CONVOLUTION_FILTER_SCALE = $8014;
- GL_CONVOLUTION_FILTER_BIAS = $8015;
- GL_REDUCE = $8016;
- GL_CONVOLUTION_FORMAT = $8017;
- GL_CONVOLUTION_WIDTH = $8018;
- GL_CONVOLUTION_HEIGHT = $8019;
- GL_MAX_CONVOLUTION_WIDTH = $801A;
- GL_MAX_CONVOLUTION_HEIGHT = $801B;
- GL_POST_CONVOLUTION_RED_SCALE = $801C;
- GL_POST_CONVOLUTION_GREEN_SCALE = $801D;
- GL_POST_CONVOLUTION_BLUE_SCALE = $801E;
- GL_POST_CONVOLUTION_ALPHA_SCALE = $801F;
- GL_POST_CONVOLUTION_RED_BIAS = $8020;
- GL_POST_CONVOLUTION_GREEN_BIAS = $8021;
- GL_POST_CONVOLUTION_BLUE_BIAS = $8022;
- GL_POST_CONVOLUTION_ALPHA_BIAS = $8023;
- GL_HISTOGRAM = $8024;
- GL_PROXY_HISTOGRAM = $8025;
- GL_HISTOGRAM_WIDTH = $8026;
- GL_HISTOGRAM_FORMAT = $8027;
- GL_HISTOGRAM_RED_SIZE = $8028;
- GL_HISTOGRAM_GREEN_SIZE = $8029;
- GL_HISTOGRAM_BLUE_SIZE = $802A;
- GL_HISTOGRAM_ALPHA_SIZE = $802B;
- GL_HISTOGRAM_LUMINANCE_SIZE = $802C;
- GL_HISTOGRAM_SINK = $802D;
- GL_MINMAX = $802E;
- GL_MINMAX_FORMAT = $802F;
- GL_MINMAX_SINK = $8030;
- GL_TABLE_TOO_LARGE = $8031;
- GL_COLOR_MATRIX = $80B1;
- GL_COLOR_MATRIX_STACK_DEPTH = $80B2;
- GL_MAX_COLOR_MATRIX_STACK_DEPTH = $80B3;
- GL_POST_COLOR_MATRIX_RED_SCALE = $80B4;
- GL_POST_COLOR_MATRIX_GREEN_SCALE = $80B5;
- GL_POST_COLOR_MATRIX_BLUE_SCALE = $80B6;
- GL_POST_COLOR_MATRIX_ALPHA_SCALE = $80B7;
- GL_POST_COLOR_MATRIX_RED_BIAS = $80B8;
- GL_POST_COLOR_MATRIX_GREEN_BIAS = $80B9;
- GL_POST_COLOR_MATRIX_BLUE_BIAS = $80BA;
- GL_POST_COLOR_MATIX_ALPHA_BIAS = $80BB;
- GL_COLOR_TABLE = $80D0;
- GL_POST_CONVOLUTION_COLOR_TABLE = $80D1;
- GL_POST_COLOR_MATRIX_COLOR_TABLE = $80D2;
- GL_PROXY_COLOR_TABLE = $80D3;
- GL_PROXY_POST_CONVOLUTION_COLOR_TABLE = $80D4;
- GL_PROXY_POST_COLOR_MATRIX_COLOR_TABLE = $80D5;
- GL_COLOR_TABLE_SCALE = $80D6;
- GL_COLOR_TABLE_BIAS = $80D7;
- GL_COLOR_TABLE_FORMAT = $80D8;
- GL_COLOR_TABLE_WIDTH = $80D9;
- GL_COLOR_TABLE_RED_SIZE = $80DA;
- GL_COLOR_TABLE_GREEN_SIZE = $80DB;
- GL_COLOR_TABLE_BLUE_SIZE = $80DC;
- GL_COLOR_TABLE_ALPHA_SIZE = $80DD;
- GL_COLOR_TABLE_LUMINANCE_SIZE = $80DE;
- GL_COLOR_TABLE_INTENSITY_SIZE = $80DF;
- GL_IGNORE_BORDER = $8150;
- GL_CONSTANT_BORDER = $8151;
- GL_WRAP_BORDER = $8152;
- GL_REPLICATE_BORDER = $8153;
- GL_CONVOLUTION_BORDER_COLOR = $8154;
-var
- glColorTable: procedure(target: GLenum; internalformat: GLenum; width: GLsizei; format: GLenum; _type: GLenum; const table: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColorTableParameterfv: procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColorTableParameteriv: procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCopyColorTable: procedure(target: GLenum; internalformat: GLenum; x: GLint; y: GLint; width: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetColorTable: procedure(target: GLenum; format: GLenum; _type: GLenum; table: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetColorTableParameterfv: procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetColorTableParameteriv: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColorSubTable: procedure(target: GLenum; start: GLsizei; count: GLsizei; format: GLenum; _type: GLenum; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCopyColorSubTable: procedure(target: GLenum; start: GLsizei; x: GLint; y: GLint; width: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glConvolutionFilter1D: procedure(target: GLenum; internalformat: GLenum; width: GLsizei; format: GLenum; _type: GLenum; const image: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glConvolutionFilter2D: procedure(target: GLenum; internalformat: GLenum; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; const image: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glConvolutionParameterf: procedure(target: GLenum; pname: GLenum; params: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glConvolutionParameterfv: procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glConvolutionParameteri: procedure(target: GLenum; pname: GLenum; params: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glConvolutionParameteriv: procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCopyConvolutionFilter1D: procedure(target: GLenum; internalformat: GLenum; x: GLint; y: GLint; width: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCopyConvolutionFilter2D: procedure(target: GLenum; internalformat: GLenum; x: GLint; y: GLint; width: GLsizei; height: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetConvolutionFilter: procedure(target: GLenum; format: GLenum; _type: GLenum; image: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetConvolutionParameterfv: procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetConvolutionParameteriv: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetSeparableFilter: procedure(target: GLenum; format: GLenum; _type: GLenum; row: PGLvoid; column: PGLvoid; span: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSeparableFilter2D: procedure(target: GLenum; internalformat: GLenum; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; const row: PGLvoid; const column: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetHistogram: procedure(target: GLenum; reset: GLboolean; format: GLenum; _type: GLenum; values: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetHistogramParameterfv: procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetHistogramParameteriv: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetMinmax: procedure(target: GLenum; reset: GLboolean; format: GLenum; _type: GLenum; values: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetMinmaxParameterfv: procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetMinmaxParameteriv: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glHistogram: procedure(target: GLenum; width: GLsizei; internalformat: GLenum; sink: GLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMinmax: procedure(target: GLenum; internalformat: GLenum; sink: GLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glResetHistogram: procedure(target: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glResetMinmax: procedure(target: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glBlendEquation: procedure(mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glBlendColor: procedure(red: GLclampf; green: GLclampf; blue: GLclampf; alpha: GLclampf); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_ARB_imaging: Boolean;
-
-//***** GL_version_1_3 *****//
-const
- GL_TEXTURE0 = $84C0;
- GL_TEXTURE1 = $84C1;
- GL_TEXTURE2 = $84C2;
- GL_TEXTURE3 = $84C3;
- GL_TEXTURE4 = $84C4;
- GL_TEXTURE5 = $84C5;
- GL_TEXTURE6 = $84C6;
- GL_TEXTURE7 = $84C7;
- GL_TEXTURE8 = $84C8;
- GL_TEXTURE9 = $84C9;
- GL_TEXTURE10 = $84CA;
- GL_TEXTURE11 = $84CB;
- GL_TEXTURE12 = $84CC;
- GL_TEXTURE13 = $84CD;
- GL_TEXTURE14 = $84CE;
- GL_TEXTURE15 = $84CF;
- GL_TEXTURE16 = $84D0;
- GL_TEXTURE17 = $84D1;
- GL_TEXTURE18 = $84D2;
- GL_TEXTURE19 = $84D3;
- GL_TEXTURE20 = $84D4;
- GL_TEXTURE21 = $84D5;
- GL_TEXTURE22 = $84D6;
- GL_TEXTURE23 = $84D7;
- GL_TEXTURE24 = $84D8;
- GL_TEXTURE25 = $84D9;
- GL_TEXTURE26 = $84DA;
- GL_TEXTURE27 = $84DB;
- GL_TEXTURE28 = $84DC;
- GL_TEXTURE29 = $84DD;
- GL_TEXTURE30 = $84DE;
- GL_TEXTURE31 = $84DF;
- GL_ACTIVE_TEXTURE = $84E0;
- GL_CLIENT_ACTIVE_TEXTURE = $84E1;
- GL_MAX_TEXTURE_UNITS = $84E2;
- GL_TRANSPOSE_MODELVIEW_MATRIX = $84E3;
- GL_TRANSPOSE_PROJECTION_MATRIX = $84E4;
- GL_TRANSPOSE_TEXTURE_MATRIX = $84E5;
- GL_TRANSPOSE_COLOR_MATRIX = $84E6;
- GL_MULTISAMPLE = $809D;
- GL_SAMPLE_ALPHA_TO_COVERAGE = $809E;
- GL_SAMPLE_ALPHA_TO_ONE = $809F;
- GL_SAMPLE_COVERAGE = $80A0;
- GL_SAMPLE_BUFFERS = $80A8;
- GL_SAMPLES = $80A9;
- GL_SAMPLE_COVERAGE_VALUE = $80AA;
- GL_SAMPLE_COVERAGE_INVERT = $80AB;
- GL_MULTISAMPLE_BIT = $20000000;
- GL_NORMAL_MAP = $8511;
- GL_REFLECTION_MAP = $8512;
- GL_TEXTURE_CUBE_MAP = $8513;
- GL_TEXTURE_BINDING_CUBE_MAP = $8514;
- GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515;
- GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516;
- GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517;
- GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518;
- GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519;
- GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A;
- GL_PROXY_TEXTURE_CUBE_MAP = $851B;
- GL_MAX_CUBE_MAP_TEXTURE_SIZE = $851C;
- GL_COMPRESSED_ALPHA = $84E9;
- GL_COMPRESSED_LUMINANCE = $84EA;
- GL_COMPRESSED_LUMINANCE_ALPHA = $84EB;
- GL_COMPRESSED_INTENSITY = $84EC;
- GL_COMPRESSED_RGB = $84ED;
- GL_COMPRESSED_RGBA = $84EE;
- GL_TEXTURE_COMPRESSION_HINT = $84EF;
- GL_TEXTURE_COMPRESSED_IMAGE_SIZE = $86A0;
- GL_TEXTURE_COMPRESSED = $86A1;
- GL_NUM_COMPRESSED_TEXTURE_FORMATS = $86A2;
- GL_COMPRESSED_TEXTURE_FORMATS = $86A3;
- GL_CLAMP_TO_BORDER = $812D;
- GL_CLAMP_TO_BORDER_SGIS = $812D;
- GL_COMBINE = $8570;
- GL_COMBINE_RGB = $8571;
- GL_COMBINE_ALPHA = $8572;
- GL_SOURCE0_RGB = $8580;
- GL_SOURCE1_RGB = $8581;
- GL_SOURCE2_RGB = $8582;
- GL_SOURCE0_ALPHA = $8588;
- GL_SOURCE1_ALPHA = $8589;
- GL_SOURCE2_ALPHA = $858A;
- GL_OPERAND0_RGB = $8590;
- GL_OPERAND1_RGB = $8591;
- GL_OPERAND2_RGB = $8592;
- GL_OPERAND0_ALPHA = $8598;
- GL_OPERAND1_ALPHA = $8599;
- GL_OPERAND2_ALPHA = $859A;
- GL_RGB_SCALE = $8573;
- GL_ADD_SIGNED = $8574;
- GL_INTERPOLATE = $8575;
- GL_SUBTRACT = $84E7;
- GL_CONSTANT = $8576;
- GL_PRIMARY_COLOR = $8577;
- GL_PREVIOUS = $8578;
- GL_DOT3_RGB = $86AE;
- GL_DOT3_RGBA = $86AF;
-var
- glActiveTexture: procedure(texture: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glClientActiveTexture: procedure(texture: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord1d: procedure(target: GLenum; s: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord1dv: procedure(target: GLenum; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord1f: procedure(target: GLenum; s: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord1fv: procedure(target: GLenum; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord1i: procedure(target: GLenum; s: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord1iv: procedure(target: GLenum; const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord1s: procedure(target: GLenum; s: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord1sv: procedure(target: GLenum; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord2d: procedure(target: GLenum; s: GLdouble; t: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord2dv: procedure(target: GLenum; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord2f: procedure(target: GLenum; s: GLfloat; t: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord2fv: procedure(target: GLenum; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord2i: procedure(target: GLenum; s: GLint; t: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord2iv: procedure(target: GLenum; const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord2s: procedure(target: GLenum; s: GLshort; t: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord2sv: procedure(target: GLenum; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord3d: procedure(target: GLenum; s: GLdouble; t: GLdouble; r: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord3dv: procedure(target: GLenum; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord3f: procedure(target: GLenum; s: GLfloat; t: GLfloat; r: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord3fv: procedure(target: GLenum; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord3i: procedure(target: GLenum; s: GLint; t: GLint; r: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord3iv: procedure(target: GLenum; const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord3s: procedure(target: GLenum; s: GLshort; t: GLshort; r: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord3sv: procedure(target: GLenum; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord4d: procedure(target: GLenum; s: GLdouble; t: GLdouble; r: GLdouble; q: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord4dv: procedure(target: GLenum; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord4f: procedure(target: GLenum; s: GLfloat; t: GLfloat; r: GLfloat; q: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord4fv: procedure(target: GLenum; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord4i: procedure(target: GLenum; s: GLint; t: GLint; r: GLint; q: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord4iv: procedure(target: GLenum; const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord4s: procedure(target: GLenum; s: GLshort; t: GLshort; r: GLshort; q: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord4sv: procedure(target: GLenum; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glLoadTransposeMatrixf: procedure(const m: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glLoadTransposeMatrixd: procedure(const m: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultTransposeMatrixf: procedure(const m: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultTransposeMatrixd: procedure(const m: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSampleCoverage: procedure(value: GLclampf; invert: GLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCompressedTexImage3D: procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; depth: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCompressedTexImage2D: procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCompressedTexImage1D: procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCompressedTexSubImage3D: procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; zoffset: GLint; width: GLsizei; height: GLsizei; depth: GLsizei; format: GLenum; imageSize: GLsizei; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCompressedTexSubImage2D: procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; width: GLsizei; height: GLsizei; format: GLenum; imageSize: GLsizei; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCompressedTexSubImage1D: procedure(target: GLenum; level: GLint; xoffset: GLint; width: GLsizei; format: GLenum; imageSize: GLsizei; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetCompressedTexImage: procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_version_1_3: Boolean;
-
-//***** GL_ARB_multitexture *****//
-const
- GL_TEXTURE0_ARB = $84C0;
- GL_TEXTURE1_ARB = $84C1;
- GL_TEXTURE2_ARB = $84C2;
- GL_TEXTURE3_ARB = $84C3;
- GL_TEXTURE4_ARB = $84C4;
- GL_TEXTURE5_ARB = $84C5;
- GL_TEXTURE6_ARB = $84C6;
- GL_TEXTURE7_ARB = $84C7;
- GL_TEXTURE8_ARB = $84C8;
- GL_TEXTURE9_ARB = $84C9;
- GL_TEXTURE10_ARB = $84CA;
- GL_TEXTURE11_ARB = $84CB;
- GL_TEXTURE12_ARB = $84CC;
- GL_TEXTURE13_ARB = $84CD;
- GL_TEXTURE14_ARB = $84CE;
- GL_TEXTURE15_ARB = $84CF;
- GL_TEXTURE16_ARB = $84D0;
- GL_TEXTURE17_ARB = $84D1;
- GL_TEXTURE18_ARB = $84D2;
- GL_TEXTURE19_ARB = $84D3;
- GL_TEXTURE20_ARB = $84D4;
- GL_TEXTURE21_ARB = $84D5;
- GL_TEXTURE22_ARB = $84D6;
- GL_TEXTURE23_ARB = $84D7;
- GL_TEXTURE24_ARB = $84D8;
- GL_TEXTURE25_ARB = $84D9;
- GL_TEXTURE26_ARB = $84DA;
- GL_TEXTURE27_ARB = $84DB;
- GL_TEXTURE28_ARB = $84DC;
- GL_TEXTURE29_ARB = $84DD;
- GL_TEXTURE30_ARB = $84DE;
- GL_TEXTURE31_ARB = $84DF;
- GL_ACTIVE_TEXTURE_ARB = $84E0;
- GL_CLIENT_ACTIVE_TEXTURE_ARB = $84E1;
- GL_MAX_TEXTURE_UNITS_ARB = $84E2;
-var
- glActiveTextureARB: procedure(texture: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glClientActiveTextureARB: procedure(texture: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord1dARB: procedure(target: GLenum; s: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord1dvARB: procedure(target: GLenum; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord1fARB: procedure(target: GLenum; s: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord1fvARB: procedure(target: GLenum; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord1iARB: procedure(target: GLenum; s: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord1ivARB: procedure(target: GLenum; const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord1sARB: procedure(target: GLenum; s: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord1svARB: procedure(target: GLenum; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord2dARB: procedure(target: GLenum; s: GLdouble; t: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord2dvARB: procedure(target: GLenum; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord2fARB: procedure(target: GLenum; s: GLfloat; t: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord2fvARB: procedure(target: GLenum; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord2iARB: procedure(target: GLenum; s: GLint; t: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord2ivARB: procedure(target: GLenum; const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord2sARB: procedure(target: GLenum; s: GLshort; t: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord2svARB: procedure(target: GLenum; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord3dARB: procedure(target: GLenum; s: GLdouble; t: GLdouble; r: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord3dvARB: procedure(target: GLenum; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord3fARB: procedure(target: GLenum; s: GLfloat; t: GLfloat; r: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord3fvARB: procedure(target: GLenum; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord3iARB: procedure(target: GLenum; s: GLint; t: GLint; r: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord3ivARB: procedure(target: GLenum; const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord3sARB: procedure(target: GLenum; s: GLshort; t: GLshort; r: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord3svARB: procedure(target: GLenum; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord4dARB: procedure(target: GLenum; s: GLdouble; t: GLdouble; r: GLdouble; q: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord4dvARB: procedure(target: GLenum; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord4fARB: procedure(target: GLenum; s: GLfloat; t: GLfloat; r: GLfloat; q: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord4fvARB: procedure(target: GLenum; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord4iARB: procedure(target: GLenum; s: GLint; t: GLint; r: GLint; q: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord4ivARB: procedure(target: GLenum; const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord4sARB: procedure(target: GLenum; s: GLshort; t: GLshort; r: GLshort; q: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord4svARB: procedure(target: GLenum; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_ARB_multitexture: Boolean;
-
-//***** GL_ARB_transpose_matrix *****//
-const
- GL_TRANSPOSE_MODELVIEW_MATRIX_ARB = $84E3;
- GL_TRANSPOSE_PROJECTION_MATRIX_ARB = $84E4;
- GL_TRANSPOSE_TEXTURE_MATRIX_ARB = $84E5;
- GL_TRANSPOSE_COLOR_MATRIX_ARB = $84E6;
-var
- glLoadTransposeMatrixfARB: procedure(m: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glLoadTransposeMatrixdARB: procedure(m: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultTransposeMatrixfARB: procedure(m: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultTransposeMatrixdARB: procedure(m: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_ARB_transpose_matrix: Boolean;
-
-//***** GL_ARB_multisample *****//
-const
- WGL_SAMPLE_BUFFERS_ARB = $2041;
- WGL_SAMPLES_ARB = $2042;
- GL_MULTISAMPLE_ARB = $809D;
- GL_SAMPLE_ALPHA_TO_COVERAGE_ARB = $809E;
- GL_SAMPLE_ALPHA_TO_ONE_ARB = $809F;
- GL_SAMPLE_COVERAGE_ARB = $80A0;
- GL_MULTISAMPLE_BIT_ARB = $20000000;
- GL_SAMPLE_BUFFERS_ARB = $80A8;
- GL_SAMPLES_ARB = $80A9;
- GL_SAMPLE_COVERAGE_VALUE_ARB = $80AA;
- GL_SAMPLE_COVERAGE_INVERT_ARB = $80AB;
-var
- glSampleCoverageARB: procedure(value: GLclampf; invert: GLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_ARB_multisample: Boolean;
-
-//***** GL_ARB_texture_env_add *****//
-
-function Load_GL_ARB_texture_env_add: Boolean;
-
-{$IFDEF WINDOWS}
-//***** WGL_ARB_extensions_string *****//
-var
- wglGetExtensionsStringARB: function(hdc: HDC): Pchar; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_WGL_ARB_extensions_string: Boolean;
-
-//***** WGL_ARB_buffer_region *****//
-const
- WGL_FRONT_COLOR_BUFFER_BIT_ARB = $0001;
- WGL_BACK_COLOR_BUFFER_BIT_ARB = $0002;
- WGL_DEPTH_BUFFER_BIT_ARB = $0004;
- WGL_STENCIL_BUFFER_BIT_ARB = $0008;
-var
- wglCreateBufferRegionARB: function(hDC: HDC; iLayerPlane: GLint; uType: GLuint): THandle; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglDeleteBufferRegionARB: procedure(hRegion: THandle); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglSaveBufferRegionARB: function(hRegion: THandle; x: GLint; y: GLint; width: GLint; height: GLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglRestoreBufferRegionARB: function(hRegion: THandle; x: GLint; y: GLint; width: GLint; height: GLint; xSrc: GLint; ySrc: GLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_WGL_ARB_buffer_region: Boolean;
-{$ENDIF}
-
-//***** GL_ARB_texture_cube_map *****//
-const
- GL_NORMAL_MAP_ARB = $8511;
- GL_REFLECTION_MAP_ARB = $8512;
- GL_TEXTURE_CUBE_MAP_ARB = $8513;
- GL_TEXTURE_BINDING_CUBE_MAP_ARB = $8514;
- GL_TEXTURE_CUBE_MAP_POSITIVE_X_ARB = $8515;
- GL_TEXTURE_CUBE_MAP_NEGATIVE_X_ARB = $8516;
- GL_TEXTURE_CUBE_MAP_POSITIVE_Y_ARB = $8517;
- GL_TEXTURE_CUBE_MAP_NEGATIVE_Y_ARB = $8518;
- GL_TEXTURE_CUBE_MAP_POSITIVE_Z_ARB = $8519;
- GL_TEXTURE_CUBE_MAP_NEGATIVE_Z_ARB = $851A;
- GL_PROXY_TEXTURE_CUBE_MAP_ARB = $851B;
- GL_MAX_CUBE_MAP_TEXTURE_SIZE_ARB = $851C;
-
-function Load_GL_ARB_texture_cube_map: Boolean;
-
-//***** GL_ARB_depth_texture *****//
-const
- GL_DEPTH_COMPONENT16_ARB = $81A5;
- GL_DEPTH_COMPONENT24_ARB = $81A6;
- GL_DEPTH_COMPONENT32_ARB = $81A7;
- GL_TEXTURE_DEPTH_SIZE_ARB = $884A;
- GL_DEPTH_TEXTURE_MODE_ARB = $884B;
-
-function Load_GL_ARB_depth_texture: Boolean;
-
-//***** GL_ARB_point_parameters *****//
-const
- GL_POINT_SIZE_MIN_ARB = $8126;
- GL_POINT_SIZE_MAX_ARB = $8127;
- GL_POINT_FADE_THRESHOLD_SIZE_ARB = $8128;
- GL_POINT_DISTANCE_ATTENUATION_ARB = $8129;
-var
- glPointParameterfARB: procedure(pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPointParameterfvARB: procedure(pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_ARB_point_parameters: Boolean;
-
-//***** GL_ARB_shadow *****//
-const
- GL_TEXTURE_COMPARE_MODE_ARB = $884C;
- GL_TEXTURE_COMPARE_FUNC_ARB = $884D;
- GL_COMPARE_R_TO_TEXTURE_ARB = $884E;
-
-function Load_GL_ARB_shadow: Boolean;
-
-//***** GL_ARB_shadow_ambient *****//
-const
- GL_TEXTURE_COMPARE_FAIL_VALUE_ARB = $80BF;
-
-function Load_GL_ARB_shadow_ambient: Boolean;
-
-//***** GL_ARB_texture_border_clamp *****//
-const
- GL_CLAMP_TO_BORDER_ARB = $812D;
-
-function Load_GL_ARB_texture_border_clamp: Boolean;
-
-//***** GL_ARB_texture_compression *****//
-const
- GL_COMPRESSED_ALPHA_ARB = $84E9;
- GL_COMPRESSED_LUMINANCE_ARB = $84EA;
- GL_COMPRESSED_LUMINANCE_ALPHA_ARB = $84EB;
- GL_COMPRESSED_INTENSITY_ARB = $84EC;
- GL_COMPRESSED_RGB_ARB = $84ED;
- GL_COMPRESSED_RGBA_ARB = $84EE;
- GL_TEXTURE_COMPRESSION_HINT_ARB = $84EF;
- GL_TEXTURE_COMPRESSED_IMAGE_SIZE_ARB = $86A0;
- GL_TEXTURE_COMPRESSED_ARB = $86A1;
- GL_NUM_COMPRESSED_TEXTURE_FORMATS_ARB = $86A2;
- GL_COMPRESSED_TEXTURE_FORMATS_ARB = $86A3;
-var
- glCompressedTexImage3DARB: procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; depth: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCompressedTexImage2DARB: procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCompressedTexImage1DARB: procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCompressedTexSubImage3DARB: procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; zoffset: GLint; width: GLsizei; height: GLsizei; depth: GLsizei; format: GLenum; imageSize: GLsizei; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCompressedTexSubImage2DARB: procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; width: GLsizei; height: GLsizei; format: GLenum; imageSize: GLsizei; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCompressedTexSubImage1DARB: procedure(target: GLenum; level: GLint; xoffset: GLint; width: GLsizei; format: GLenum; imageSize: GLsizei; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetCompressedTexImageARB: procedure(target: GLenum; lod: GLint; img: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_ARB_texture_compression: Boolean;
-
-//***** GL_ARB_texture_env_combine *****//
-const
- GL_COMBINE_ARB = $8570;
- GL_COMBINE_RGB_ARB = $8571;
- GL_COMBINE_ALPHA_ARB = $8572;
- GL_SOURCE0_RGB_ARB = $8580;
- GL_SOURCE1_RGB_ARB = $8581;
- GL_SOURCE2_RGB_ARB = $8582;
- GL_SOURCE0_ALPHA_ARB = $8588;
- GL_SOURCE1_ALPHA_ARB = $8589;
- GL_SOURCE2_ALPHA_ARB = $858A;
- GL_OPERAND0_RGB_ARB = $8590;
- GL_OPERAND1_RGB_ARB = $8591;
- GL_OPERAND2_RGB_ARB = $8592;
- GL_OPERAND0_ALPHA_ARB = $8598;
- GL_OPERAND1_ALPHA_ARB = $8599;
- GL_OPERAND2_ALPHA_ARB = $859A;
- GL_RGB_SCALE_ARB = $8573;
- GL_ADD_SIGNED_ARB = $8574;
- GL_INTERPOLATE_ARB = $8575;
- GL_SUBTRACT_ARB = $84E7;
- GL_CONSTANT_ARB = $8576;
- GL_PRIMARY_COLOR_ARB = $8577;
- GL_PREVIOUS_ARB = $8578;
-
-function Load_GL_ARB_texture_env_combine: Boolean;
-
-//***** GL_ARB_texture_env_crossbar *****//
-
-function Load_GL_ARB_texture_env_crossbar: Boolean;
-
-//***** GL_ARB_texture_env_dot3 *****//
-const
- GL_DOT3_RGB_ARB = $86AE;
- GL_DOT3_RGBA_ARB = $86AF;
-
-function Load_GL_ARB_texture_env_dot3: Boolean;
-
-//***** GL_ARB_texture_mirrored_repeat *****//
-const
- GL_MIRRORED_REPEAT_ARB = $8370;
-
-function Load_GL_ARB_texture_mirrored_repeat: Boolean;
-
-//***** GL_ARB_vertex_blend *****//
-const
- GL_MAX_VERTEX_UNITS_ARB = $86A4;
- GL_ACTIVE_VERTEX_UNITS_ARB = $86A5;
- GL_WEIGHT_SUM_UNITY_ARB = $86A6;
- GL_VERTEX_BLEND_ARB = $86A7;
- GL_MODELVIEW0_ARB = $1700;
- GL_MODELVIEW1_ARB = $850A;
- GL_MODELVIEW2_ARB = $8722;
- GL_MODELVIEW3_ARB = $8723;
- GL_MODELVIEW4_ARB = $8724;
- GL_MODELVIEW5_ARB = $8725;
- GL_MODELVIEW6_ARB = $8726;
- GL_MODELVIEW7_ARB = $8727;
- GL_MODELVIEW8_ARB = $8728;
- GL_MODELVIEW9_ARB = $8729;
- GL_MODELVIEW10_ARB = $872A;
- GL_MODELVIEW11_ARB = $872B;
- GL_MODELVIEW12_ARB = $872C;
- GL_MODELVIEW13_ARB = $872D;
- GL_MODELVIEW14_ARB = $872E;
- GL_MODELVIEW15_ARB = $872F;
- GL_MODELVIEW16_ARB = $8730;
- GL_MODELVIEW17_ARB = $8731;
- GL_MODELVIEW18_ARB = $8732;
- GL_MODELVIEW19_ARB = $8733;
- GL_MODELVIEW20_ARB = $8734;
- GL_MODELVIEW21_ARB = $8735;
- GL_MODELVIEW22_ARB = $8736;
- GL_MODELVIEW23_ARB = $8737;
- GL_MODELVIEW24_ARB = $8738;
- GL_MODELVIEW25_ARB = $8739;
- GL_MODELVIEW26_ARB = $873A;
- GL_MODELVIEW27_ARB = $873B;
- GL_MODELVIEW28_ARB = $873C;
- GL_MODELVIEW29_ARB = $873D;
- GL_MODELVIEW30_ARB = $873E;
- GL_MODELVIEW31_ARB = $873F;
- GL_CURRENT_WEIGHT_ARB = $86A8;
- GL_WEIGHT_ARRAY_TYPE_ARB = $86A9;
- GL_WEIGHT_ARRAY_STRIDE_ARB = $86AA;
- GL_WEIGHT_ARRAY_SIZE_ARB = $86AB;
- GL_WEIGHT_ARRAY_POINTER_ARB = $86AC;
- GL_WEIGHT_ARRAY_ARB = $86AD;
-var
- glWeightbvARB: procedure(size: GLint; weights: PGLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWeightsvARB: procedure(size: GLint; weights: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWeightivARB: procedure(size: GLint; weights: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWeightfvARB: procedure(size: GLint; weights: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWeightdvARB: procedure(size: GLint; weights: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWeightvARB: procedure(size: GLint; weights: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWeightubvARB: procedure(size: GLint; weights: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWeightusvARB: procedure(size: GLint; weights: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWeightuivARB: procedure(size: GLint; weights: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWeightPointerARB: procedure(size: GLint; _type: GLenum; stride: GLsizei; pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexBlendARB: procedure(count: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_ARB_vertex_blend: Boolean;
-
-//***** GL_ARB_vertex_program *****//
-const
- GL_VERTEX_PROGRAM_ARB = $8620;
- GL_VERTEX_PROGRAM_POINT_SIZE_ARB = $8642;
- GL_VERTEX_PROGRAM_TWO_SIDE_ARB = $8643;
- GL_COLOR_SUM_ARB = $8458;
- GL_PROGRAM_FORMAT_ASCII_ARB = $8875;
- GL_VERTEX_ATTRIB_ARRAY_ENABLED_ARB = $8622;
- GL_VERTEX_ATTRIB_ARRAY_SIZE_ARB = $8623;
- GL_VERTEX_ATTRIB_ARRAY_STRIDE_ARB = $8624;
- GL_VERTEX_ATTRIB_ARRAY_TYPE_ARB = $8625;
- GL_VERTEX_ATTRIB_ARRAY_NORMALIZED_ARB = $886A;
- GL_CURRENT_VERTEX_ATTRIB_ARB = $8626;
- GL_VERTEX_ATTRIB_ARRAY_POINTER_ARB = $8645;
- GL_PROGRAM_LENGTH_ARB = $8627;
- GL_PROGRAM_FORMAT_ARB = $8876;
- GL_PROGRAM_BINDING_ARB = $8677;
- GL_PROGRAM_INSTRUCTIONS_ARB = $88A0;
- GL_MAX_PROGRAM_INSTRUCTIONS_ARB = $88A1;
- GL_PROGRAM_NATIVE_INSTRUCTIONS_ARB = $88A2;
- GL_MAX_PROGRAM_NATIVE_INSTRUCTIONS_ARB = $88A3;
- GL_PROGRAM_TEMPORARIES_ARB = $88A4;
- GL_MAX_PROGRAM_TEMPORARIES_ARB = $88A5;
- GL_PROGRAM_NATIVE_TEMPORARIES_ARB = $88A6;
- GL_MAX_PROGRAM_NATIVE_TEMPORARIES_ARB = $88A7;
- GL_PROGRAM_PARAMETERS_ARB = $88A8;
- GL_MAX_PROGRAM_PARAMETERS_ARB = $88A9;
- GL_PROGRAM_NATIVE_PARAMETERS_ARB = $88AA;
- GL_MAX_PROGRAM_NATIVE_PARAMETERS_ARB = $88AB;
- GL_PROGRAM_ATTRIBS_ARB = $88AC;
- GL_MAX_PROGRAM_ATTRIBS_ARB = $88AD;
- GL_PROGRAM_NATIVE_ATTRIBS_ARB = $88AE;
- GL_MAX_PROGRAM_NATIVE_ATTRIBS_ARB = $88AF;
- GL_PROGRAM_ADDRESS_REGISTERS_ARB = $88B0;
- GL_MAX_PROGRAM_ADDRESS_REGISTERS_ARB = $88B1;
- GL_PROGRAM_NATIVE_ADDRESS_REGISTERS_ARB = $88B2;
- GL_MAX_PROGRAM_NATIVE_ADDRESS_REGISTERS_ARB = $88B3;
- GL_MAX_PROGRAM_LOCAL_PARAMETERS_ARB = $88B4;
- GL_MAX_PROGRAM_ENV_PARAMETERS_ARB = $88B5;
- GL_PROGRAM_UNDER_NATIVE_LIMITS_ARB = $88B6;
- GL_PROGRAM_STRING_ARB = $8628;
- GL_PROGRAM_ERROR_POSITION_ARB = $864B;
- GL_CURRENT_MATRIX_ARB = $8641;
- GL_TRANSPOSE_CURRENT_MATRIX_ARB = $88B7;
- GL_CURRENT_MATRIX_STACK_DEPTH_ARB = $8640;
- GL_MAX_VERTEX_ATTRIBS_ARB = $8869;
- GL_MAX_PROGRAM_MATRICES_ARB = $862F;
- GL_MAX_PROGRAM_MATRIX_STACK_DEPTH_ARB = $862E;
- GL_PROGRAM_ERROR_STRING_ARB = $8874;
- GL_MATRIX0_ARB = $88C0;
- GL_MATRIX1_ARB = $88C1;
- GL_MATRIX2_ARB = $88C2;
- GL_MATRIX3_ARB = $88C3;
- GL_MATRIX4_ARB = $88C4;
- GL_MATRIX5_ARB = $88C5;
- GL_MATRIX6_ARB = $88C6;
- GL_MATRIX7_ARB = $88C7;
- GL_MATRIX8_ARB = $88C8;
- GL_MATRIX9_ARB = $88C9;
- GL_MATRIX10_ARB = $88CA;
- GL_MATRIX11_ARB = $88CB;
- GL_MATRIX12_ARB = $88CC;
- GL_MATRIX13_ARB = $88CD;
- GL_MATRIX14_ARB = $88CE;
- GL_MATRIX15_ARB = $88CF;
- GL_MATRIX16_ARB = $88D0;
- GL_MATRIX17_ARB = $88D1;
- GL_MATRIX18_ARB = $88D2;
- GL_MATRIX19_ARB = $88D3;
- GL_MATRIX20_ARB = $88D4;
- GL_MATRIX21_ARB = $88D5;
- GL_MATRIX22_ARB = $88D6;
- GL_MATRIX23_ARB = $88D7;
- GL_MATRIX24_ARB = $88D8;
- GL_MATRIX25_ARB = $88D9;
- GL_MATRIX26_ARB = $88DA;
- GL_MATRIX27_ARB = $88DB;
- GL_MATRIX28_ARB = $88DC;
- GL_MATRIX29_ARB = $88DD;
- GL_MATRIX30_ARB = $88DE;
- GL_MATRIX31_ARB = $88DF;
-var
- glVertexAttrib1sARB: procedure(index: GLuint; x: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib1fARB: procedure(index: GLuint; x: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib1dARB: procedure(index: GLuint; x: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib2sARB: procedure(index: GLuint; x: GLshort; y: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib2fARB: procedure(index: GLuint; x: GLfloat; y: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib2dARB: procedure(index: GLuint; x: GLdouble; y: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib3sARB: procedure(index: GLuint; x: GLshort; y: GLshort; z: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib3fARB: procedure(index: GLuint; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib3dARB: procedure(index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4sARB: procedure(index: GLuint; x: GLshort; y: GLshort; z: GLshort; w: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4fARB: procedure(index: GLuint; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4dARB: procedure(index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4NubARB: procedure(index: GLuint; x: GLubyte; y: GLubyte; z: GLubyte; w: GLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib1svARB: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib1fvARB: procedure(index: GLuint; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib1dvARB: procedure(index: GLuint; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib2svARB: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib2fvARB: procedure(index: GLuint; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib2dvARB: procedure(index: GLuint; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib3svARB: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib3fvARB: procedure(index: GLuint; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib3dvARB: procedure(index: GLuint; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4bvARB: procedure(index: GLuint; const v: PGLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4svARB: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4ivARB: procedure(index: GLuint; const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4ubvARB: procedure(index: GLuint; const v: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4usvARB: procedure(index: GLuint; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4uivARB: procedure(index: GLuint; const v: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4fvARB: procedure(index: GLuint; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4dvARB: procedure(index: GLuint; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4NbvARB: procedure(index: GLuint; const v: PGLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4NsvARB: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4NivARB: procedure(index: GLuint; const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4NubvARB: procedure(index: GLuint; const v: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4NusvARB: procedure(index: GLuint; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4NuivARB: procedure(index: GLuint; const v: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttribPointerARB: procedure(index: GLuint; size: GLint; _type: GLenum; normalized: GLboolean; stride: GLsizei; const pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEnableVertexAttribArrayARB: procedure(index: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDisableVertexAttribArrayARB: procedure(index: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glProgramStringARB: procedure(target: GLenum; format: GLenum; len: GLsizei; const _string: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glBindProgramARB: procedure(target: GLenum; _program: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDeleteProgramsARB: procedure(n: GLsizei; const programs: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGenProgramsARB: procedure(n: GLsizei; programs: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glProgramEnvParameter4dARB: procedure(target: GLenum; index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glProgramEnvParameter4dvARB: procedure(target: GLenum; index: GLuint; const params: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glProgramEnvParameter4fARB: procedure(target: GLenum; index: GLuint; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glProgramEnvParameter4fvARB: procedure(target: GLenum; index: GLuint; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glProgramLocalParameter4dARB: procedure(target: GLenum; index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glProgramLocalParameter4dvARB: procedure(target: GLenum; index: GLuint; const params: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glProgramLocalParameter4fARB: procedure(target: GLenum; index: GLuint; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glProgramLocalParameter4fvARB: procedure(target: GLenum; index: GLuint; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetProgramEnvParameterdvARB: procedure(target: GLenum; index: GLuint; params: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetProgramEnvParameterfvARB: procedure(target: GLenum; index: GLuint; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetProgramLocalParameterdvARB: procedure(target: GLenum; index: GLuint; params: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetProgramLocalParameterfvARB: procedure(target: GLenum; index: GLuint; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetProgramivARB: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetProgramStringARB: procedure(target: GLenum; pname: GLenum; _string: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetVertexAttribdvARB: procedure(index: GLuint; pname: GLenum; params: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetVertexAttribfvARB: procedure(index: GLuint; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetVertexAttribivARB: procedure(index: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetVertexAttribPointervARB: procedure(index: GLuint; pname: GLenum; pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIsProgramARB: function(_program: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_ARB_vertex_program: Boolean;
-
-//***** GL_ARB_window_pos *****//
-var
- glWindowPos2dARB: procedure(x: GLdouble; y: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos2fARB: procedure(x: GLfloat; y: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos2iARB: procedure(x: GLint; y: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos2sARB: procedure(x: GLshort; y: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos2dvARB: procedure(const p: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos2fvARB: procedure(const p: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos2ivARB: procedure(const p: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos2svARB: procedure(const p: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos3dARB: procedure(x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos3fARB: procedure(x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos3iARB: procedure(x: GLint; y: GLint; z: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos3sARB: procedure(x: GLshort; y: GLshort; z: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos3dvARB: procedure(const p: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos3fvARB: procedure(const p: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos3ivARB: procedure(const p: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos3svARB: procedure(const p: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_ARB_window_pos: Boolean;
-
-//***** GL_EXT_422_pixels *****//
-const
- GL_422_EXT = $80CC;
- GL_422_REV_EXT = $80CD;
- GL_422_AVERAGE_EXT = $80CE;
- GL_422_REV_AVERAGE_EXT = $80CF;
-
-function Load_GL_EXT_422_pixels: Boolean;
-
-//***** GL_EXT_abgr *****//
-const
- GL_ABGR_EXT = $8000;
-
-function Load_GL_EXT_abgr: Boolean;
-
-//***** GL_EXT_bgra *****//
-const
- GL_BGR_EXT = $80E0;
- GL_BGRA_EXT = $80E1;
-
-function Load_GL_EXT_bgra: Boolean;
-
-//***** GL_EXT_blend_color *****//
-const
- GL_CONSTANT_COLOR_EXT = $8001;
- GL_ONE_MINUS_CONSTANT_COLOR_EXT = $8002;
- GL_CONSTANT_ALPHA_EXT = $8003;
- GL_ONE_MINUS_CONSTANT_ALPHA_EXT = $8004;
- GL_BLEND_COLOR_EXT = $8005;
-var
- glBlendColorEXT: procedure(red: GLclampf; green: GLclampf; blue: GLclampf; alpha: GLclampf); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_EXT_blend_color: Boolean;
-
-//***** GL_EXT_blend_func_separate *****//
-const
- GL_BLEND_DST_RGB_EXT = $80C8;
- GL_BLEND_SRC_RGB_EXT = $80C9;
- GL_BLEND_DST_ALPHA_EXT = $80CA;
- GL_BLEND_SRC_ALPHA_EXT = $80CB;
-var
- glBlendFuncSeparateEXT: procedure(sfactorRGB: GLenum; dfactorRGB: GLenum; sfactorAlpha: GLenum; dfactorAlpha: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_EXT_blend_func_separate: Boolean;
-
-//***** GL_EXT_blend_logic_op *****//
-
-function Load_GL_EXT_blend_logic_op: Boolean;
-
-//***** GL_EXT_blend_minmax *****//
-const
- GL_FUNC_ADD_EXT = $8006;
- GL_MIN_EXT = $8007;
- GL_MAX_EXT = $8008;
- GL_BLEND_EQUATION_EXT = $8009;
-var
- glBlendEquationEXT: procedure(mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_EXT_blend_minmax: Boolean;
-
-//***** GL_EXT_blend_subtract *****//
-const
- GL_FUNC_SUBTRACT_EXT = $800A;
- GL_FUNC_REVERSE_SUBTRACT_EXT = $800B;
-
-function Load_GL_EXT_blend_subtract: Boolean;
-
-//***** GL_EXT_clip_volume_hint *****//
-const
- GL_CLIP_VOLUME_CLIPPING_HINT_EXT = $80F0;
-
-function Load_GL_EXT_clip_volume_hint: Boolean;
-
-//***** GL_EXT_color_subtable *****//
-var
- glColorSubTableEXT: procedure(target: GLenum; start: GLsizei; count: GLsizei; format: GLenum; _type: GLenum; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCopyColorSubTableEXT: procedure(target: GLenum; start: GLsizei; x: GLint; y: GLint; width: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_EXT_color_subtable: Boolean;
-
-//***** GL_EXT_compiled_vertex_array *****//
-const
- GL_ARRAY_ELEMENT_LOCK_FIRST_EXT = $81A8;
- GL_ARRAY_ELEMENT_LOCK_COUNT_EXT = $81A9;
-var
- glLockArraysEXT: procedure(first: GLint; count: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUnlockArraysEXT: procedure(); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_EXT_compiled_vertex_array: Boolean;
-
-//***** GL_EXT_convolution *****//
-const
- GL_CONVOLUTION_1D_EXT = $8010;
- GL_CONVOLUTION_2D_EXT = $8011;
- GL_SEPARABLE_2D_EXT = $8012;
- GL_CONVOLUTION_BORDER_MODE_EXT = $8013;
- GL_CONVOLUTION_FILTER_SCALE_EXT = $8014;
- GL_CONVOLUTION_FILTER_BIAS_EXT = $8015;
- GL_REDUCE_EXT = $8016;
- GL_CONVOLUTION_FORMAT_EXT = $8017;
- GL_CONVOLUTION_WIDTH_EXT = $8018;
- GL_CONVOLUTION_HEIGHT_EXT = $8019;
- GL_MAX_CONVOLUTION_WIDTH_EXT = $801A;
- GL_MAX_CONVOLUTION_HEIGHT_EXT = $801B;
- GL_POST_CONVOLUTION_RED_SCALE_EXT = $801C;
- GL_POST_CONVOLUTION_GREEN_SCALE_EXT = $801D;
- GL_POST_CONVOLUTION_BLUE_SCALE_EXT = $801E;
- GL_POST_CONVOLUTION_ALPHA_SCALE_EXT = $801F;
- GL_POST_CONVOLUTION_RED_BIAS_EXT = $8020;
- GL_POST_CONVOLUTION_GREEN_BIAS_EXT = $8021;
- GL_POST_CONVOLUTION_BLUE_BIAS_EXT = $8022;
- GL_POST_CONVOLUTION_ALPHA_BIAS_EXT = $8023;
-var
- glConvolutionFilter1DEXT: procedure(target: GLenum; internalformat: GLenum; width: GLsizei; format: GLenum; _type: GLenum; const image: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glConvolutionFilter2DEXT: procedure(target: GLenum; internalformat: GLenum; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; const image: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCopyConvolutionFilter1DEXT: procedure(target: GLenum; internalformat: GLenum; x: GLint; y: GLint; width: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCopyConvolutionFilter2DEXT: procedure(target: GLenum; internalformat: GLenum; x: GLint; y: GLint; width: GLsizei; height: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetConvolutionFilterEXT: procedure(target: GLenum; format: GLenum; _type: GLenum; image: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSeparableFilter2DEXT: procedure(target: GLenum; internalformat: GLenum; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; const row: PGLvoid; const column: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetSeparableFilterEXT: procedure(target: GLenum; format: GLenum; _type: GLenum; row: PGLvoid; column: PGLvoid; span: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glConvolutionParameteriEXT: procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glConvolutionParameterivEXT: procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glConvolutionParameterfEXT: procedure(target: GLenum; pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glConvolutionParameterfvEXT: procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetConvolutionParameterivEXT: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetConvolutionParameterfvEXT: procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_EXT_convolution: Boolean;
-
-//***** GL_EXT_histogram *****//
-const
- GL_HISTOGRAM_EXT = $8024;
- GL_PROXY_HISTOGRAM_EXT = $8025;
- GL_HISTOGRAM_WIDTH_EXT = $8026;
- GL_HISTOGRAM_FORMAT_EXT = $8027;
- GL_HISTOGRAM_RED_SIZE_EXT = $8028;
- GL_HISTOGRAM_GREEN_SIZE_EXT = $8029;
- GL_HISTOGRAM_BLUE_SIZE_EXT = $802A;
- GL_HISTOGRAM_ALPHA_SIZE_EXT = $802B;
- GL_HISTOGRAM_LUMINANCE_SIZE_EXT = $802C;
- GL_HISTOGRAM_SINK_EXT = $802D;
- GL_MINMAX_EXT = $802E;
- GL_MINMAX_FORMAT_EXT = $802F;
- GL_MINMAX_SINK_EXT = $8030;
-var
- glHistogramEXT: procedure(target: GLenum; width: GLsizei; internalformat: GLenum; sink: GLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glResetHistogramEXT: procedure(target: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetHistogramEXT: procedure(target: GLenum; reset: GLboolean; format: GLenum; _type: GLenum; values: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetHistogramParameterivEXT: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetHistogramParameterfvEXT: procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMinmaxEXT: procedure(target: GLenum; internalformat: GLenum; sink: GLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glResetMinmaxEXT: procedure(target: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetMinmaxEXT: procedure(target: GLenum; reset: GLboolean; format: GLenum; _type: GLenum; values: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetMinmaxParameterivEXT: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetMinmaxParameterfvEXT: procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_EXT_histogram: Boolean;
-
-//***** GL_EXT_multi_draw_arrays *****//
-var
- glMultiDrawArraysEXT: procedure(mode: GLenum; first: PGLint; count: PGLsizei; primcount: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiDrawElementsEXT: procedure(mode: GLenum; count: PGLsizei; _type: GLenum; const indices: PGLvoid; primcount: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_EXT_multi_draw_arrays: Boolean;
-
-//***** GL_EXT_packed_pixels *****//
-const
- GL_UNSIGNED_BYTE_3_3_2_EXT = $8032;
- GL_UNSIGNED_SHORT_4_4_4_4_EXT = $8033;
- GL_UNSIGNED_SHORT_5_5_5_1_EXT = $8034;
- GL_UNSIGNED_INT_8_8_8_8_EXT = $8035;
- GL_UNSIGNED_INT_10_10_10_2_EXT = $8036;
-
-function Load_GL_EXT_packed_pixels: Boolean;
-
-//***** GL_EXT_paletted_texture *****//
-const
- GL_COLOR_INDEX1_EXT = $80E2;
- GL_COLOR_INDEX2_EXT = $80E3;
- GL_COLOR_INDEX4_EXT = $80E4;
- GL_COLOR_INDEX8_EXT = $80E5;
- GL_COLOR_INDEX12_EXT = $80E6;
- GL_COLOR_INDEX16_EXT = $80E7;
- GL_COLOR_TABLE_FORMAT_EXT = $80D8;
- GL_COLOR_TABLE_WIDTH_EXT = $80D9;
- GL_COLOR_TABLE_RED_SIZE_EXT = $80DA;
- GL_COLOR_TABLE_GREEN_SIZE_EXT = $80DB;
- GL_COLOR_TABLE_BLUE_SIZE_EXT = $80DC;
- GL_COLOR_TABLE_ALPHA_SIZE_EXT = $80DD;
- GL_COLOR_TABLE_LUMINANCE_SIZE_EXT = $80DE;
- GL_COLOR_TABLE_INTENSITY_SIZE_EXT = $80DF;
- GL_TEXTURE_INDEX_SIZE_EXT = $80ED;
- GL_TEXTURE_1D = $0DE0;
- GL_TEXTURE_2D = $0DE1;
- GL_TEXTURE_3D_EXT = $806F;
- // GL_TEXTURE_CUBE_MAP_ARB { already defined }
- GL_PROXY_TEXTURE_1D = $8063;
- GL_PROXY_TEXTURE_2D = $8064;
- GL_PROXY_TEXTURE_3D_EXT = $8070;
- // GL_PROXY_TEXTURE_CUBE_MAP_ARB { already defined }
- // GL_TEXTURE_1D { already defined }
- // GL_TEXTURE_2D { already defined }
- // GL_TEXTURE_3D_EXT { already defined }
- // GL_TEXTURE_CUBE_MAP_ARB { already defined }
-var
- glColorTableEXT: procedure(target: GLenum; internalFormat: GLenum; width: GLsizei; format: GLenum; _type: GLenum; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- // glColorSubTableEXT { already defined }
- glGetColorTableEXT: procedure(target: GLenum; format: GLenum; _type: GLenum; data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetColorTableParameterivEXT: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetColorTableParameterfvEXT: procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_EXT_paletted_texture: Boolean;
-
-//***** GL_EXT_point_parameters *****//
-const
- GL_POINT_SIZE_MIN_EXT = $8126;
- GL_POINT_SIZE_MAX_EXT = $8127;
- GL_POINT_FADE_THRESHOLD_SIZE_EXT = $8128;
- GL_DISTANCE_ATTENUATION_EXT = $8129;
-var
- glPointParameterfEXT: procedure(pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPointParameterfvEXT: procedure(pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_EXT_point_parameters: Boolean;
-
-//***** GL_EXT_polygon_offset *****//
-const
- GL_POLYGON_OFFSET_EXT = $8037;
- GL_POLYGON_OFFSET_FACTOR_EXT = $8038;
- GL_POLYGON_OFFSET_BIAS_EXT = $8039;
-var
- glPolygonOffsetEXT: procedure(factor: GLfloat; bias: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_EXT_polygon_offset: Boolean;
-
-//***** GL_EXT_separate_specular_color *****//
-const
- GL_LIGHT_MODEL_COLOR_CONTROL_EXT = $81F8;
- GL_SINGLE_COLOR_EXT = $81F9;
- GL_SEPARATE_SPECULAR_COLOR_EXT = $81FA;
-
-function Load_GL_EXT_separate_specular_color: Boolean;
-
-//***** GL_EXT_shadow_funcs *****//
-
-function Load_GL_EXT_shadow_funcs: Boolean;
-
-//***** GL_EXT_shared_texture_palette *****//
-const
- GL_SHARED_TEXTURE_PALETTE_EXT = $81FB;
-
-function Load_GL_EXT_shared_texture_palette: Boolean;
-
-//***** GL_EXT_stencil_two_side *****//
-const
- GL_STENCIL_TEST_TWO_SIDE_EXT = $8910;
- GL_ACTIVE_STENCIL_FACE_EXT = $8911;
-var
- glActiveStencilFaceEXT: procedure(face: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_EXT_stencil_two_side: Boolean;
-
-//***** GL_EXT_stencil_wrap *****//
-const
- GL_INCR_WRAP_EXT = $8507;
- GL_DECR_WRAP_EXT = $8508;
-
-function Load_GL_EXT_stencil_wrap: Boolean;
-
-//***** GL_EXT_subtexture *****//
-var
- glTexSubImage1DEXT: procedure(target: GLenum; level: GLint; xoffset: GLint; width: GLsizei; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexSubImage2DEXT: procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexSubImage3DEXT: procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; zoffset: GLint; width: GLsizei; height: GLsizei; depth: GLsizei; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_EXT_subtexture: Boolean;
-
-//***** GL_EXT_texture3D *****//
-const
- GL_PACK_SKIP_IMAGES_EXT = $806B;
- GL_PACK_IMAGE_HEIGHT_EXT = $806C;
- GL_UNPACK_SKIP_IMAGES_EXT = $806D;
- GL_UNPACK_IMAGE_HEIGHT_EXT = $806E;
- // GL_TEXTURE_3D_EXT { already defined }
- // GL_PROXY_TEXTURE_3D_EXT { already defined }
- GL_TEXTURE_DEPTH_EXT = $8071;
- GL_TEXTURE_WRAP_R_EXT = $8072;
- GL_MAX_3D_TEXTURE_SIZE_EXT = $8073;
-var
- glTexImage3DEXT: procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; depth: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_EXT_texture3D: Boolean;
-
-//***** GL_EXT_texture_compression_s3tc *****//
-const
- GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0;
- GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1;
- GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2;
- GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3;
-
-function Load_GL_EXT_texture_compression_s3tc: Boolean;
-
-//***** GL_EXT_texture_env_add *****//
-
-function Load_GL_EXT_texture_env_add: Boolean;
-
-//***** GL_EXT_texture_env_combine *****//
-const
- GL_COMBINE_EXT = $8570;
- GL_COMBINE_RGB_EXT = $8571;
- GL_COMBINE_ALPHA_EXT = $8572;
- GL_SOURCE0_RGB_EXT = $8580;
- GL_SOURCE1_RGB_EXT = $8581;
- GL_SOURCE2_RGB_EXT = $8582;
- GL_SOURCE0_ALPHA_EXT = $8588;
- GL_SOURCE1_ALPHA_EXT = $8589;
- GL_SOURCE2_ALPHA_EXT = $858A;
- GL_OPERAND0_RGB_EXT = $8590;
- GL_OPERAND1_RGB_EXT = $8591;
- GL_OPERAND2_RGB_EXT = $8592;
- GL_OPERAND0_ALPHA_EXT = $8598;
- GL_OPERAND1_ALPHA_EXT = $8599;
- GL_OPERAND2_ALPHA_EXT = $859A;
- GL_RGB_SCALE_EXT = $8573;
- GL_ADD_SIGNED_EXT = $8574;
- GL_INTERPOLATE_EXT = $8575;
- GL_CONSTANT_EXT = $8576;
- GL_PRIMARY_COLOR_EXT = $8577;
- GL_PREVIOUS_EXT = $8578;
-
-function Load_GL_EXT_texture_env_combine: Boolean;
-
-//***** GL_EXT_texture_env_dot3 *****//
-const
- GL_DOT3_RGB_EXT = $8740;
- GL_DOT3_RGBA_EXT = $8741;
-
-function Load_GL_EXT_texture_env_dot3: Boolean;
-
-//***** GL_EXT_texture_filter_anisotropic *****//
-const
- GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE;
- GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF;
-
-function Load_GL_EXT_texture_filter_anisotropic: Boolean;
-
-//***** GL_EXT_texture_lod_bias *****//
-const
- GL_TEXTURE_FILTER_CONTROL_EXT = $8500;
- GL_TEXTURE_LOD_BIAS_EXT = $8501;
- GL_MAX_TEXTURE_LOD_BIAS_EXT = $84FD;
-
-function Load_GL_EXT_texture_lod_bias: Boolean;
-
-//***** GL_EXT_texture_object *****//
-const
- GL_TEXTURE_PRIORITY_EXT = $8066;
- GL_TEXTURE_RESIDENT_EXT = $8067;
- GL_TEXTURE_1D_BINDING_EXT = $8068;
- GL_TEXTURE_2D_BINDING_EXT = $8069;
- GL_TEXTURE_3D_BINDING_EXT = $806A;
-var
- glGenTexturesEXT: procedure(n: GLsizei; textures: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDeleteTexturesEXT: procedure(n: GLsizei; const textures: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glBindTextureEXT: procedure(target: GLenum; texture: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPrioritizeTexturesEXT: procedure(n: GLsizei; const textures: PGLuint; const priorities: PGLclampf); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glAreTexturesResidentEXT: function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIsTextureEXT: function(texture: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_EXT_texture_object: Boolean;
-
-//***** GL_EXT_vertex_array *****//
-const
- GL_VERTEX_ARRAY_EXT = $8074;
- GL_NORMAL_ARRAY_EXT = $8075;
- GL_COLOR_ARRAY_EXT = $8076;
- GL_INDEX_ARRAY_EXT = $8077;
- GL_TEXTURE_COORD_ARRAY_EXT = $8078;
- GL_EDGE_FLAG_ARRAY_EXT = $8079;
- GL_DOUBLE_EXT = $140A;
- GL_VERTEX_ARRAY_SIZE_EXT = $807A;
- GL_VERTEX_ARRAY_TYPE_EXT = $807B;
- GL_VERTEX_ARRAY_STRIDE_EXT = $807C;
- GL_VERTEX_ARRAY_COUNT_EXT = $807D;
- GL_NORMAL_ARRAY_TYPE_EXT = $807E;
- GL_NORMAL_ARRAY_STRIDE_EXT = $807F;
- GL_NORMAL_ARRAY_COUNT_EXT = $8080;
- GL_COLOR_ARRAY_SIZE_EXT = $8081;
- GL_COLOR_ARRAY_TYPE_EXT = $8082;
- GL_COLOR_ARRAY_STRIDE_EXT = $8083;
- GL_COLOR_ARRAY_COUNT_EXT = $8084;
- GL_INDEX_ARRAY_TYPE_EXT = $8085;
- GL_INDEX_ARRAY_STRIDE_EXT = $8086;
- GL_INDEX_ARRAY_COUNT_EXT = $8087;
- GL_TEXTURE_COORD_ARRAY_SIZE_EXT = $8088;
- GL_TEXTURE_COORD_ARRAY_TYPE_EXT = $8089;
- GL_TEXTURE_COORD_ARRAY_STRIDE_EXT = $808A;
- GL_TEXTURE_COORD_ARRAY_COUNT_EXT = $808B;
- GL_EDGE_FLAG_ARRAY_STRIDE_EXT = $808C;
- GL_EDGE_FLAG_ARRAY_COUNT_EXT = $808D;
- GL_VERTEX_ARRAY_POINTER_EXT = $808E;
- GL_NORMAL_ARRAY_POINTER_EXT = $808F;
- GL_COLOR_ARRAY_POINTER_EXT = $8090;
- GL_INDEX_ARRAY_POINTER_EXT = $8091;
- GL_TEXTURE_COORD_ARRAY_POINTER_EXT = $8092;
- GL_EDGE_FLAG_ARRAY_POINTER_EXT = $8093;
-var
- glArrayElementEXT: procedure(i: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDrawArraysEXT: procedure(mode: GLenum; first: GLint; count: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexPointerEXT: procedure(size: GLint; _type: GLenum; stride: GLsizei; count: GLsizei; const pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNormalPointerEXT: procedure(_type: GLenum; stride: GLsizei; count: GLsizei; const pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColorPointerEXT: procedure(size: GLint; _type: GLenum; stride: GLsizei; count: GLsizei; const pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIndexPointerEXT: procedure(_type: GLenum; stride: GLsizei; count: GLsizei; const pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoordPointerEXT: procedure(size: GLint; _type: GLenum; stride: GLsizei; count: GLsizei; const pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEdgeFlagPointerEXT: procedure(stride: GLsizei; count: GLsizei; const pointer: PGLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetPointervEXT: procedure(pname: GLenum; params: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_EXT_vertex_array: Boolean;
-
-//***** GL_EXT_vertex_shader *****//
-const
- GL_VERTEX_SHADER_EXT = $8780;
- GL_VARIANT_VALUE_EXT = $87E4;
- GL_VARIANT_DATATYPE_EXT = $87E5;
- GL_VARIANT_ARRAY_STRIDE_EXT = $87E6;
- GL_VARIANT_ARRAY_TYPE_EXT = $87E7;
- GL_VARIANT_ARRAY_EXT = $87E8;
- GL_VARIANT_ARRAY_POINTER_EXT = $87E9;
- GL_INVARIANT_VALUE_EXT = $87EA;
- GL_INVARIANT_DATATYPE_EXT = $87EB;
- GL_LOCAL_CONSTANT_VALUE_EXT = $87EC;
- GL_LOCAL_CONSTANT_DATATYPE_EXT = $87ED;
- GL_OP_INDEX_EXT = $8782;
- GL_OP_NEGATE_EXT = $8783;
- GL_OP_DOT3_EXT = $8784;
- GL_OP_DOT4_EXT = $8785;
- GL_OP_MUL_EXT = $8786;
- GL_OP_ADD_EXT = $8787;
- GL_OP_MADD_EXT = $8788;
- GL_OP_FRAC_EXT = $8789;
- GL_OP_MAX_EXT = $878A;
- GL_OP_MIN_EXT = $878B;
- GL_OP_SET_GE_EXT = $878C;
- GL_OP_SET_LT_EXT = $878D;
- GL_OP_CLAMP_EXT = $878E;
- GL_OP_FLOOR_EXT = $878F;
- GL_OP_ROUND_EXT = $8790;
- GL_OP_EXP_BASE_2_EXT = $8791;
- GL_OP_LOG_BASE_2_EXT = $8792;
- GL_OP_POWER_EXT = $8793;
- GL_OP_RECIP_EXT = $8794;
- GL_OP_RECIP_SQRT_EXT = $8795;
- GL_OP_SUB_EXT = $8796;
- GL_OP_CROSS_PRODUCT_EXT = $8797;
- GL_OP_MULTIPLY_MATRIX_EXT = $8798;
- GL_OP_MOV_EXT = $8799;
- GL_OUTPUT_VERTEX_EXT = $879A;
- GL_OUTPUT_COLOR0_EXT = $879B;
- GL_OUTPUT_COLOR1_EXT = $879C;
- GL_OUTPUT_TEXTURE_COORD0_EXT = $879D;
- GL_OUTPUT_TEXTURE_COORD1_EXT = $879E;
- GL_OUTPUT_TEXTURE_COORD2_EXT = $879F;
- GL_OUTPUT_TEXTURE_COORD3_EXT = $87A0;
- GL_OUTPUT_TEXTURE_COORD4_EXT = $87A1;
- GL_OUTPUT_TEXTURE_COORD5_EXT = $87A2;
- GL_OUTPUT_TEXTURE_COORD6_EXT = $87A3;
- GL_OUTPUT_TEXTURE_COORD7_EXT = $87A4;
- GL_OUTPUT_TEXTURE_COORD8_EXT = $87A5;
- GL_OUTPUT_TEXTURE_COORD9_EXT = $87A6;
- GL_OUTPUT_TEXTURE_COORD10_EXT = $87A7;
- GL_OUTPUT_TEXTURE_COORD11_EXT = $87A8;
- GL_OUTPUT_TEXTURE_COORD12_EXT = $87A9;
- GL_OUTPUT_TEXTURE_COORD13_EXT = $87AA;
- GL_OUTPUT_TEXTURE_COORD14_EXT = $87AB;
- GL_OUTPUT_TEXTURE_COORD15_EXT = $87AC;
- GL_OUTPUT_TEXTURE_COORD16_EXT = $87AD;
- GL_OUTPUT_TEXTURE_COORD17_EXT = $87AE;
- GL_OUTPUT_TEXTURE_COORD18_EXT = $87AF;
- GL_OUTPUT_TEXTURE_COORD19_EXT = $87B0;
- GL_OUTPUT_TEXTURE_COORD20_EXT = $87B1;
- GL_OUTPUT_TEXTURE_COORD21_EXT = $87B2;
- GL_OUTPUT_TEXTURE_COORD22_EXT = $87B3;
- GL_OUTPUT_TEXTURE_COORD23_EXT = $87B4;
- GL_OUTPUT_TEXTURE_COORD24_EXT = $87B5;
- GL_OUTPUT_TEXTURE_COORD25_EXT = $87B6;
- GL_OUTPUT_TEXTURE_COORD26_EXT = $87B7;
- GL_OUTPUT_TEXTURE_COORD27_EXT = $87B8;
- GL_OUTPUT_TEXTURE_COORD28_EXT = $87B9;
- GL_OUTPUT_TEXTURE_COORD29_EXT = $87BA;
- GL_OUTPUT_TEXTURE_COORD30_EXT = $87BB;
- GL_OUTPUT_TEXTURE_COORD31_EXT = $87BC;
- GL_OUTPUT_FOG_EXT = $87BD;
- GL_SCALAR_EXT = $87BE;
- GL_VECTOR_EXT = $87BF;
- GL_MATRIX_EXT = $87C0;
- GL_VARIANT_EXT = $87C1;
- GL_INVARIANT_EXT = $87C2;
- GL_LOCAL_CONSTANT_EXT = $87C3;
- GL_LOCAL_EXT = $87C4;
- GL_MAX_VERTEX_SHADER_INSTRUCTIONS_EXT = $87C5;
- GL_MAX_VERTEX_SHADER_VARIANTS_EXT = $87C6;
- GL_MAX_VERTEX_SHADER_INVARIANTS_EXT = $87C7;
- GL_MAX_VERTEX_SHADER_LOCAL_CONSTANTS_EXT = $87C8;
- GL_MAX_VERTEX_SHADER_LOCALS_EXT = $87C9;
- GL_MAX_OPTIMIZED_VERTEX_SHADER_INSTRUCTIONS_EXT = $87CA;
- GL_MAX_OPTIMIZED_VERTEX_SHADER_VARIANTS_EXT = $87CB;
- GL_MAX_OPTIMIZED_VERTEX_SHADER_LOCAL_CONSTANTS_EXT = $87CC;
- GL_MAX_OPTIMIZED_VERTEX_SHADER_INVARIANTS_EXT = $87CD;
- GL_MAX_OPTIMIZED_VERTEX_SHADER_LOCALS_EXT = $87CE;
- GL_VERTEX_SHADER_INSTRUCTIONS_EXT = $87CF;
- GL_VERTEX_SHADER_VARIANTS_EXT = $87D0;
- GL_VERTEX_SHADER_INVARIANTS_EXT = $87D1;
- GL_VERTEX_SHADER_LOCAL_CONSTANTS_EXT = $87D2;
- GL_VERTEX_SHADER_LOCALS_EXT = $87D3;
- GL_VERTEX_SHADER_BINDING_EXT = $8781;
- GL_VERTEX_SHADER_OPTIMIZED_EXT = $87D4;
- GL_X_EXT = $87D5;
- GL_Y_EXT = $87D6;
- GL_Z_EXT = $87D7;
- GL_W_EXT = $87D8;
- GL_NEGATIVE_X_EXT = $87D9;
- GL_NEGATIVE_Y_EXT = $87DA;
- GL_NEGATIVE_Z_EXT = $87DB;
- GL_NEGATIVE_W_EXT = $87DC;
- GL_ZERO_EXT = $87DD;
- GL_ONE_EXT = $87DE;
- GL_NEGATIVE_ONE_EXT = $87DF;
- GL_NORMALIZED_RANGE_EXT = $87E0;
- GL_FULL_RANGE_EXT = $87E1;
- GL_CURRENT_VERTEX_EXT = $87E2;
- GL_MVP_MATRIX_EXT = $87E3;
-var
- glBeginVertexShaderEXT: procedure(); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEndVertexShaderEXT: procedure(); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glBindVertexShaderEXT: procedure(id: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGenVertexShadersEXT: function(range: GLuint): GLuint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDeleteVertexShaderEXT: procedure(id: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glShaderOp1EXT: procedure(op: GLenum; res: GLuint; arg1: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glShaderOp2EXT: procedure(op: GLenum; res: GLuint; arg1: GLuint; arg2: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glShaderOp3EXT: procedure(op: GLenum; res: GLuint; arg1: GLuint; arg2: GLuint; arg3: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSwizzleEXT: procedure(res: GLuint; _in: GLuint; outX: GLenum; outY: GLenum; outZ: GLenum; outW: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWriteMaskEXT: procedure(res: GLuint; _in: GLuint; outX: GLenum; outY: GLenum; outZ: GLenum; outW: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glInsertComponentEXT: procedure(res: GLuint; src: GLuint; num: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glExtractComponentEXT: procedure(res: GLuint; src: GLuint; num: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGenSymbolsEXT: function(datatype: GLenum; storagetype: GLenum; range: GLenum; components: GLuint): GLuint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSetInvariantEXT: procedure(id: GLuint; _type: GLenum; addr: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSetLocalConstantEXT: procedure(id: GLuint; _type: GLenum; addr: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVariantbvEXT: procedure(id: GLuint; addr: PGLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVariantsvEXT: procedure(id: GLuint; addr: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVariantivEXT: procedure(id: GLuint; addr: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVariantfvEXT: procedure(id: GLuint; addr: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVariantdvEXT: procedure(id: GLuint; addr: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVariantubvEXT: procedure(id: GLuint; addr: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVariantusvEXT: procedure(id: GLuint; addr: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVariantuivEXT: procedure(id: GLuint; addr: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVariantPointerEXT: procedure(id: GLuint; _type: GLenum; stride: GLuint; addr: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEnableVariantClientStateEXT: procedure(id: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDisableVariantClientStateEXT: procedure(id: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glBindLightParameterEXT: function(light: GLenum; value: GLenum): GLuint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glBindMaterialParameterEXT: function(face: GLenum; value: GLenum): GLuint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glBindTexGenParameterEXT: function(_unit: GLenum; coord: GLenum; value: GLenum): GLuint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glBindTextureUnitParameterEXT: function(_unit: GLenum; value: GLenum): GLuint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glBindParameterEXT: function(value: GLenum): GLuint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIsVariantEnabledEXT: function(id: GLuint; cap: GLenum): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetVariantBooleanvEXT: procedure(id: GLuint; value: GLenum; data: PGLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetVariantIntegervEXT: procedure(id: GLuint; value: GLenum; data: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetVariantFloatvEXT: procedure(id: GLuint; value: GLenum; data: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetVariantPointervEXT: procedure(id: GLuint; value: GLenum; data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetInvariantBooleanvEXT: procedure(id: GLuint; value: GLenum; data: PGLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetInvariantIntegervEXT: procedure(id: GLuint; value: GLenum; data: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetInvariantFloatvEXT: procedure(id: GLuint; value: GLenum; data: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetLocalConstantBooleanvEXT: procedure(id: GLuint; value: GLenum; data: PGLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetLocalConstantIntegervEXT: procedure(id: GLuint; value: GLenum; data: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetLocalConstantFloatvEXT: procedure(id: GLuint; value: GLenum; data: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_EXT_vertex_shader: Boolean;
-
-//***** GL_EXT_vertex_weighting *****//
-const
- GL_VERTEX_WEIGHTING_EXT = $8509;
- GL_MODELVIEW0_EXT = $1700;
- GL_MODELVIEW1_EXT = $850A;
- GL_MODELVIEW0_MATRIX_EXT = $0BA6;
- GL_MODELVIEW1_MATRIX_EXT = $8506;
- GL_CURRENT_VERTEX_WEIGHT_EXT = $850B;
- GL_VERTEX_WEIGHT_ARRAY_EXT = $850C;
- GL_VERTEX_WEIGHT_ARRAY_SIZE_EXT = $850D;
- GL_VERTEX_WEIGHT_ARRAY_TYPE_EXT = $850E;
- GL_VERTEX_WEIGHT_ARRAY_STRIDE_EXT = $850F;
- GL_MODELVIEW0_STACK_DEPTH_EXT = $0BA3;
- GL_MODELVIEW1_STACK_DEPTH_EXT = $8502;
- GL_VERTEX_WEIGHT_ARRAY_POINTER_EXT = $8510;
-var
- glVertexWeightfEXT: procedure(weight: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexWeightfvEXT: procedure(weight: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexWeightPointerEXT: procedure(size: GLint; _type: GLenum; stride: GLsizei; pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_EXT_vertex_weighting: Boolean;
-
-//***** GL_HP_occlusion_test *****//
-const
- GL_OCCLUSION_TEST_HP = $8165;
- GL_OCCLUSION_TEST_RESULT_HP = $8166;
-
-function Load_GL_HP_occlusion_test: Boolean;
-
-//***** GL_NV_blend_square *****//
-
-function Load_GL_NV_blend_square: Boolean;
-
-//***** GL_NV_copy_depth_to_color *****//
-const
- GL_DEPTH_STENCIL_TO_RGBA_NV = $886E;
- GL_DEPTH_STENCIL_TO_BGRA_NV = $886F;
-
-function Load_GL_NV_copy_depth_to_color: Boolean;
-
-//***** GL_NV_depth_clamp *****//
-const
- GL_DEPTH_CLAMP_NV = $864F;
-
-function Load_GL_NV_depth_clamp: Boolean;
-
-//***** GL_NV_evaluators *****//
-const
- GL_EVAL_2D_NV = $86C0;
- GL_EVAL_TRIANGULAR_2D_NV = $86C1;
- GL_MAP_TESSELLATION_NV = $86C2;
- GL_MAP_ATTRIB_U_ORDER_NV = $86C3;
- GL_MAP_ATTRIB_V_ORDER_NV = $86C4;
- GL_EVAL_FRACTIONAL_TESSELLATION_NV = $86C5;
- GL_EVAL_VERTEX_ATTRIB0_NV = $86C6;
- GL_EVAL_VERTEX_ATTRIB1_NV = $86C7;
- GL_EVAL_VERTEX_ATTRIB2_NV = $86C8;
- GL_EVAL_VERTEX_ATTRIB3_NV = $86C9;
- GL_EVAL_VERTEX_ATTRIB4_NV = $86CA;
- GL_EVAL_VERTEX_ATTRIB5_NV = $86CB;
- GL_EVAL_VERTEX_ATTRIB6_NV = $86CC;
- GL_EVAL_VERTEX_ATTRIB7_NV = $86CD;
- GL_EVAL_VERTEX_ATTRIB8_NV = $86CE;
- GL_EVAL_VERTEX_ATTRIB9_NV = $86CF;
- GL_EVAL_VERTEX_ATTRIB10_NV = $86D0;
- GL_EVAL_VERTEX_ATTRIB11_NV = $86D1;
- GL_EVAL_VERTEX_ATTRIB12_NV = $86D2;
- GL_EVAL_VERTEX_ATTRIB13_NV = $86D3;
- GL_EVAL_VERTEX_ATTRIB14_NV = $86D4;
- GL_EVAL_VERTEX_ATTRIB15_NV = $86D5;
- GL_MAX_MAP_TESSELLATION_NV = $86D6;
- GL_MAX_RATIONAL_EVAL_ORDER_NV = $86D7;
-var
- glMapControlPointsNV: procedure(target: GLenum; index: GLuint; _type: GLenum; ustride: GLsizei; vstride: GLsizei; uorder: GLint; vorder: GLint; _packed: GLboolean; const points: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMapParameterivNV: procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMapParameterfvNV: procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetMapControlPointsNV: procedure(target: GLenum; index: GLuint; _type: GLenum; ustride: GLsizei; vstride: GLsizei; _packed: GLboolean; points: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetMapParameterivNV: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetMapParameterfvNV: procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetMapAttribParameterivNV: procedure(target: GLenum; index: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetMapAttribParameterfvNV: procedure(target: GLenum; index: GLuint; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEvalMapsNV: procedure(target: GLenum; mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_NV_evaluators: Boolean;
-
-//***** GL_NV_fence *****//
-const
- GL_ALL_COMPLETED_NV = $84F2;
- GL_FENCE_STATUS_NV = $84F3;
- GL_FENCE_CONDITION_NV = $84F4;
-var
- glGenFencesNV: procedure(n: GLsizei; fences: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDeleteFencesNV: procedure(n: GLsizei; const fences: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSetFenceNV: procedure(fence: GLuint; condition: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTestFenceNV: function(fence: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFinishFenceNV: procedure(fence: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIsFenceNV: function(fence: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetFenceivNV: procedure(fence: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_NV_fence: Boolean;
-
-//***** GL_NV_fog_distance *****//
-const
- GL_FOG_DISTANCE_MODE_NV = $855A;
- GL_EYE_RADIAL_NV = $855B;
- GL_EYE_PLANE_ABSOLUTE_NV = $855C;
-
-function Load_GL_NV_fog_distance: Boolean;
-
-//***** GL_NV_light_max_exponent *****//
-const
- GL_MAX_SHININESS_NV = $8504;
- GL_MAX_SPOT_EXPONENT_NV = $8505;
-
-function Load_GL_NV_light_max_exponent: Boolean;
-
-//***** GL_NV_multisample_filter_hint *****//
-const
- GL_MULTISAMPLE_FILTER_HINT_NV = $8534;
-
-function Load_GL_NV_multisample_filter_hint: Boolean;
-
-//***** GL_NV_occlusion_query *****//
- // GL_OCCLUSION_TEST_HP { already defined }
- // GL_OCCLUSION_TEST_RESULT_HP { already defined }
-const
- GL_PIXEL_COUNTER_BITS_NV = $8864;
- GL_CURRENT_OCCLUSION_QUERY_ID_NV = $8865;
- GL_PIXEL_COUNT_NV = $8866;
- GL_PIXEL_COUNT_AVAILABLE_NV = $8867;
-var
- glGenOcclusionQueriesNV: procedure(n: GLsizei; ids: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDeleteOcclusionQueriesNV: procedure(n: GLsizei; const ids: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIsOcclusionQueryNV: function(id: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glBeginOcclusionQueryNV: procedure(id: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEndOcclusionQueryNV: procedure(); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetOcclusionQueryivNV: procedure(id: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetOcclusionQueryuivNV: procedure(id: GLuint; pname: GLenum; params: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_NV_occlusion_query: Boolean;
-
-//***** GL_NV_packed_depth_stencil *****//
-const
- GL_DEPTH_STENCIL_NV = $84F9;
- GL_UNSIGNED_INT_24_8_NV = $84FA;
-
-function Load_GL_NV_packed_depth_stencil: Boolean;
-
-//***** GL_NV_point_sprite *****//
-const
- GL_POINT_SPRITE_NV = $8861;
- GL_COORD_REPLACE_NV = $8862;
- GL_POINT_SPRITE_R_MODE_NV = $8863;
-var
- glPointParameteriNV: procedure(pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPointParameterivNV: procedure(pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_NV_point_sprite: Boolean;
-
-//***** GL_NV_register_combiners *****//
-const
- GL_REGISTER_COMBINERS_NV = $8522;
- GL_COMBINER0_NV = $8550;
- GL_COMBINER1_NV = $8551;
- GL_COMBINER2_NV = $8552;
- GL_COMBINER3_NV = $8553;
- GL_COMBINER4_NV = $8554;
- GL_COMBINER5_NV = $8555;
- GL_COMBINER6_NV = $8556;
- GL_COMBINER7_NV = $8557;
- GL_VARIABLE_A_NV = $8523;
- GL_VARIABLE_B_NV = $8524;
- GL_VARIABLE_C_NV = $8525;
- GL_VARIABLE_D_NV = $8526;
- GL_VARIABLE_E_NV = $8527;
- GL_VARIABLE_F_NV = $8528;
- GL_VARIABLE_G_NV = $8529;
- GL_CONSTANT_COLOR0_NV = $852A;
- GL_CONSTANT_COLOR1_NV = $852B;
- GL_PRIMARY_COLOR_NV = $852C;
- GL_SECONDARY_COLOR_NV = $852D;
- GL_SPARE0_NV = $852E;
- GL_SPARE1_NV = $852F;
- GL_UNSIGNED_IDENTITY_NV = $8536;
- GL_UNSIGNED_INVERT_NV = $8537;
- GL_EXPAND_NORMAL_NV = $8538;
- GL_EXPAND_NEGATE_NV = $8539;
- GL_HALF_BIAS_NORMAL_NV = $853A;
- GL_HALF_BIAS_NEGATE_NV = $853B;
- GL_SIGNED_IDENTITY_NV = $853C;
- GL_SIGNED_NEGATE_NV = $853D;
- GL_E_TIMES_F_NV = $8531;
- GL_SPARE0_PLUS_SECONDARY_COLOR_NV = $8532;
- GL_SCALE_BY_TWO_NV = $853E;
- GL_SCALE_BY_FOUR_NV = $853F;
- GL_SCALE_BY_ONE_HALF_NV = $8540;
- GL_BIAS_BY_NEGATIVE_ONE_HALF_NV = $8541;
- GL_DISCARD_NV = $8530;
- GL_COMBINER_INPUT_NV = $8542;
- GL_COMBINER_MAPPING_NV = $8543;
- GL_COMBINER_COMPONENT_USAGE_NV = $8544;
- GL_COMBINER_AB_DOT_PRODUCT_NV = $8545;
- GL_COMBINER_CD_DOT_PRODUCT_NV = $8546;
- GL_COMBINER_MUX_SUM_NV = $8547;
- GL_COMBINER_SCALE_NV = $8548;
- GL_COMBINER_BIAS_NV = $8549;
- GL_COMBINER_AB_OUTPUT_NV = $854A;
- GL_COMBINER_CD_OUTPUT_NV = $854B;
- GL_COMBINER_SUM_OUTPUT_NV = $854C;
- GL_NUM_GENERAL_COMBINERS_NV = $854E;
- GL_COLOR_SUM_CLAMP_NV = $854F;
- GL_MAX_GENERAL_COMBINERS_NV = $854D;
-var
- glCombinerParameterfvNV: procedure(pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCombinerParameterivNV: procedure(pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCombinerParameterfNV: procedure(pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCombinerParameteriNV: procedure(pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCombinerInputNV: procedure(stage: GLenum; portion: GLenum; variable: GLenum; input: GLenum; mapping: GLenum; componentUsage: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCombinerOutputNV: procedure(stage: GLenum; portion: GLenum; abOutput: GLenum; cdOutput: GLenum; sumOutput: GLenum; scale: GLenum; bias: GLenum; abDotProduct: GLboolean; cdDotProduct: GLboolean; muxSum: GLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFinalCombinerInputNV: procedure(variable: GLenum; input: GLenum; mapping: GLenum; componentUsage: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetCombinerInputParameterfvNV: procedure(stage: GLenum; portion: GLenum; variable: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetCombinerInputParameterivNV: procedure(stage: GLenum; portion: GLenum; variable: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetCombinerOutputParameterfvNV: procedure(stage: GLenum; portion: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetCombinerOutputParameterivNV: procedure(stage: GLenum; portion: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetFinalCombinerInputParameterfvNV: procedure(variable: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetFinalCombinerInputParameterivNV: procedure(variable: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_NV_register_combiners: Boolean;
-
-//***** GL_NV_register_combiners2 *****//
-const
- GL_PER_STAGE_CONSTANTS_NV = $8535;
-var
- glCombinerStageParameterfvNV: procedure(stage: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetCombinerStageParameterfvNV: procedure(stage: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_NV_register_combiners2: Boolean;
-
-//***** GL_NV_texgen_emboss *****//
-const
- GL_EMBOSS_MAP_NV = $855F;
- GL_EMBOSS_LIGHT_NV = $855D;
- GL_EMBOSS_CONSTANT_NV = $855E;
-
-function Load_GL_NV_texgen_emboss: Boolean;
-
-//***** GL_NV_texgen_reflection *****//
-const
- GL_NORMAL_MAP_NV = $8511;
- GL_REFLECTION_MAP_NV = $8512;
-
-function Load_GL_NV_texgen_reflection: Boolean;
-
-//***** GL_NV_texture_compression_vtc *****//
- // GL_COMPRESSED_RGB_S3TC_DXT1_EXT { already defined }
- // GL_COMPRESSED_RGBA_S3TC_DXT1_EXT { already defined }
- // GL_COMPRESSED_RGBA_S3TC_DXT3_EXT { already defined }
- // GL_COMPRESSED_RGBA_S3TC_DXT5_EXT { already defined }
-
-function Load_GL_NV_texture_compression_vtc: Boolean;
-
-//***** GL_NV_texture_env_combine4 *****//
-const
- GL_COMBINE4_NV = $8503;
- GL_SOURCE3_RGB_NV = $8583;
- GL_SOURCE3_ALPHA_NV = $858B;
- GL_OPERAND3_RGB_NV = $8593;
- GL_OPERAND3_ALPHA_NV = $859B;
-
-function Load_GL_NV_texture_env_combine4: Boolean;
-
-//***** GL_NV_texture_rectangle *****//
-const
- GL_TEXTURE_RECTANGLE_NV = $84F5;
- GL_TEXTURE_BINDING_RECTANGLE_NV = $84F6;
- GL_PROXY_TEXTURE_RECTANGLE_NV = $84F7;
- GL_MAX_RECTANGLE_TEXTURE_SIZE_NV = $84F8;
-
-function Load_GL_NV_texture_rectangle: Boolean;
-
-//***** GL_NV_texture_shader *****//
-const
- GL_TEXTURE_SHADER_NV = $86DE;
- GL_RGBA_UNSIGNED_DOT_PRODUCT_MAPPING_NV = $86D9;
- GL_SHADER_OPERATION_NV = $86DF;
- GL_CULL_MODES_NV = $86E0;
- GL_OFFSET_TEXTURE_MATRIX_NV = $86E1;
- GL_OFFSET_TEXTURE_SCALE_NV = $86E2;
- GL_OFFSET_TEXTURE_BIAS_NV = $86E3;
- GL_PREVIOUS_TEXTURE_INPUT_NV = $86E4;
- GL_CONST_EYE_NV = $86E5;
- GL_SHADER_CONSISTENT_NV = $86DD;
- GL_PASS_THROUGH_NV = $86E6;
- GL_CULL_FRAGMENT_NV = $86E7;
- GL_OFFSET_TEXTURE_2D_NV = $86E8;
- GL_OFFSET_TEXTURE_RECTANGLE_NV = $864C;
- GL_OFFSET_TEXTURE_RECTANGLE_SCALE_NV = $864D;
- GL_DEPENDENT_AR_TEXTURE_2D_NV = $86E9;
- GL_DEPENDENT_GB_TEXTURE_2D_NV = $86EA;
- GL_DOT_PRODUCT_NV = $86EC;
- GL_DOT_PRODUCT_DEPTH_REPLACE_NV = $86ED;
- GL_DOT_PRODUCT_TEXTURE_2D_NV = $86EE;
- GL_DOT_PRODUCT_TEXTURE_RECTANGLE_NV = $864E;
- GL_DOT_PRODUCT_TEXTURE_CUBE_MAP_NV = $86F0;
- GL_DOT_PRODUCT_DIFFUSE_CUBE_MAP_NV = $86F1;
- GL_DOT_PRODUCT_REFLECT_CUBE_MAP_NV = $86F2;
- GL_DOT_PRODUCT_CONST_EYE_REFLECT_CUBE_MAP_NV = $86F3;
- GL_HILO_NV = $86F4;
- GL_DSDT_NV = $86F5;
- GL_DSDT_MAG_NV = $86F6;
- GL_DSDT_MAG_VIB_NV = $86F7;
- GL_UNSIGNED_INT_S8_S8_8_8_NV = $86DA;
- GL_UNSIGNED_INT_8_8_S8_S8_REV_NV = $86DB;
- GL_SIGNED_RGBA_NV = $86FB;
- GL_SIGNED_RGBA8_NV = $86FC;
- GL_SIGNED_RGB_NV = $86FE;
- GL_SIGNED_RGB8_NV = $86FF;
- GL_SIGNED_LUMINANCE_NV = $8701;
- GL_SIGNED_LUMINANCE8_NV = $8702;
- GL_SIGNED_LUMINANCE_ALPHA_NV = $8703;
- GL_SIGNED_LUMINANCE8_ALPHA8_NV = $8704;
- GL_SIGNED_ALPHA_NV = $8705;
- GL_SIGNED_ALPHA8_NV = $8706;
- GL_SIGNED_INTENSITY_NV = $8707;
- GL_SIGNED_INTENSITY8_NV = $8708;
- GL_SIGNED_RGB_UNSIGNED_ALPHA_NV = $870C;
- GL_SIGNED_RGB8_UNSIGNED_ALPHA8_NV = $870D;
- GL_HILO16_NV = $86F8;
- GL_SIGNED_HILO_NV = $86F9;
- GL_SIGNED_HILO16_NV = $86FA;
- GL_DSDT8_NV = $8709;
- GL_DSDT8_MAG8_NV = $870A;
- GL_DSDT_MAG_INTENSITY_NV = $86DC;
- GL_DSDT8_MAG8_INTENSITY8_NV = $870B;
- GL_HI_SCALE_NV = $870E;
- GL_LO_SCALE_NV = $870F;
- GL_DS_SCALE_NV = $8710;
- GL_DT_SCALE_NV = $8711;
- GL_MAGNITUDE_SCALE_NV = $8712;
- GL_VIBRANCE_SCALE_NV = $8713;
- GL_HI_BIAS_NV = $8714;
- GL_LO_BIAS_NV = $8715;
- GL_DS_BIAS_NV = $8716;
- GL_DT_BIAS_NV = $8717;
- GL_MAGNITUDE_BIAS_NV = $8718;
- GL_VIBRANCE_BIAS_NV = $8719;
- GL_TEXTURE_BORDER_VALUES_NV = $871A;
- GL_TEXTURE_HI_SIZE_NV = $871B;
- GL_TEXTURE_LO_SIZE_NV = $871C;
- GL_TEXTURE_DS_SIZE_NV = $871D;
- GL_TEXTURE_DT_SIZE_NV = $871E;
- GL_TEXTURE_MAG_SIZE_NV = $871F;
-
-function Load_GL_NV_texture_shader: Boolean;
-
-//***** GL_NV_texture_shader2 *****//
-const
- GL_DOT_PRODUCT_TEXTURE_3D_NV = $86EF;
- // GL_HILO_NV { already defined }
- // GL_DSDT_NV { already defined }
- // GL_DSDT_MAG_NV { already defined }
- // GL_DSDT_MAG_VIB_NV { already defined }
- // GL_UNSIGNED_INT_S8_S8_8_8_NV { already defined }
- // GL_UNSIGNED_INT_8_8_S8_S8_REV_NV { already defined }
- // GL_SIGNED_RGBA_NV { already defined }
- // GL_SIGNED_RGBA8_NV { already defined }
- // GL_SIGNED_RGB_NV { already defined }
- // GL_SIGNED_RGB8_NV { already defined }
- // GL_SIGNED_LUMINANCE_NV { already defined }
- // GL_SIGNED_LUMINANCE8_NV { already defined }
- // GL_SIGNED_LUMINANCE_ALPHA_NV { already defined }
- // GL_SIGNED_LUMINANCE8_ALPHA8_NV { already defined }
- // GL_SIGNED_ALPHA_NV { already defined }
- // GL_SIGNED_ALPHA8_NV { already defined }
- // GL_SIGNED_INTENSITY_NV { already defined }
- // GL_SIGNED_INTENSITY8_NV { already defined }
- // GL_SIGNED_RGB_UNSIGNED_ALPHA_NV { already defined }
- // GL_SIGNED_RGB8_UNSIGNED_ALPHA8_NV { already defined }
- // GL_HILO16_NV { already defined }
- // GL_SIGNED_HILO_NV { already defined }
- // GL_SIGNED_HILO16_NV { already defined }
- // GL_DSDT8_NV { already defined }
- // GL_DSDT8_MAG8_NV { already defined }
- // GL_DSDT_MAG_INTENSITY_NV { already defined }
- // GL_DSDT8_MAG8_INTENSITY8_NV { already defined }
-
-function Load_GL_NV_texture_shader2: Boolean;
-
-//***** GL_NV_texture_shader3 *****//
-const
- GL_OFFSET_PROJECTIVE_TEXTURE_2D_NV = $8850;
- GL_OFFSET_PROJECTIVE_TEXTURE_2D_SCALE_NV = $8851;
- GL_OFFSET_PROJECTIVE_TEXTURE_RECTANGLE_NV = $8852;
- GL_OFFSET_PROJECTIVE_TEXTURE_RECTANGLE_SCALE_NV = $8853;
- GL_OFFSET_HILO_TEXTURE_2D_NV = $8854;
- GL_OFFSET_HILO_TEXTURE_RECTANGLE_NV = $8855;
- GL_OFFSET_HILO_PROJECTIVE_TEXTURE_2D_NV = $8856;
- GL_OFFSET_HILO_PROJECTIVE_TEXTURE_RECTANGLE_NV = $8857;
- GL_DEPENDENT_HILO_TEXTURE_2D_NV = $8858;
- GL_DEPENDENT_RGB_TEXTURE_3D_NV = $8859;
- GL_DEPENDENT_RGB_TEXTURE_CUBE_MAP_NV = $885A;
- GL_DOT_PRODUCT_PASS_THROUGH_NV = $885B;
- GL_DOT_PRODUCT_TEXTURE_1D_NV = $885C;
- GL_DOT_PRODUCT_AFFINE_DEPTH_REPLACE_NV = $885D;
- GL_HILO8_NV = $885E;
- GL_SIGNED_HILO8_NV = $885F;
- GL_FORCE_BLUE_TO_ONE_NV = $8860;
-
-function Load_GL_NV_texture_shader3: Boolean;
-
-//***** GL_NV_vertex_array_range *****//
-const
- GL_VERTEX_ARRAY_RANGE_NV = $851D;
- GL_VERTEX_ARRAY_RANGE_LENGTH_NV = $851E;
- GL_VERTEX_ARRAY_RANGE_VALID_NV = $851F;
- GL_MAX_VERTEX_ARRAY_RANGE_ELEMENT_NV = $8520;
- GL_VERTEX_ARRAY_RANGE_POINTER_NV = $8521;
-var
- glVertexArrayRangeNV: procedure(length: GLsizei; pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFlushVertexArrayRangeNV: procedure(); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-{$IFDEF WINDOWS}
- wglAllocateMemoryNV: function(size: GLsizei; readFrequency: GLfloat; writeFrequency: GLfloat; priority: GLfloat): PGLvoid; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglFreeMemoryNV: procedure(pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-{$ENDIF}
-
-function Load_GL_NV_vertex_array_range: Boolean;
-
-//***** GL_NV_vertex_array_range2 *****//
-const
- GL_VERTEX_ARRAY_RANGE_WITHOUT_FLUSH_NV = $8533;
-
-function Load_GL_NV_vertex_array_range2: Boolean;
-
-//***** GL_NV_vertex_program *****//
-const
- GL_VERTEX_PROGRAM_NV = $8620;
- GL_VERTEX_PROGRAM_POINT_SIZE_NV = $8642;
- GL_VERTEX_PROGRAM_TWO_SIDE_NV = $8643;
- GL_VERTEX_STATE_PROGRAM_NV = $8621;
- GL_ATTRIB_ARRAY_SIZE_NV = $8623;
- GL_ATTRIB_ARRAY_STRIDE_NV = $8624;
- GL_ATTRIB_ARRAY_TYPE_NV = $8625;
- GL_CURRENT_ATTRIB_NV = $8626;
- GL_PROGRAM_PARAMETER_NV = $8644;
- GL_ATTRIB_ARRAY_POINTER_NV = $8645;
- GL_PROGRAM_TARGET_NV = $8646;
- GL_PROGRAM_LENGTH_NV = $8627;
- GL_PROGRAM_RESIDENT_NV = $8647;
- GL_PROGRAM_STRING_NV = $8628;
- GL_TRACK_MATRIX_NV = $8648;
- GL_TRACK_MATRIX_TRANSFORM_NV = $8649;
- GL_MAX_TRACK_MATRIX_STACK_DEPTH_NV = $862E;
- GL_MAX_TRACK_MATRICES_NV = $862F;
- GL_CURRENT_MATRIX_STACK_DEPTH_NV = $8640;
- GL_CURRENT_MATRIX_NV = $8641;
- GL_VERTEX_PROGRAM_BINDING_NV = $864A;
- GL_PROGRAM_ERROR_POSITION_NV = $864B;
- GL_MODELVIEW_PROJECTION_NV = $8629;
- GL_MATRIX0_NV = $8630;
- GL_MATRIX1_NV = $8631;
- GL_MATRIX2_NV = $8632;
- GL_MATRIX3_NV = $8633;
- GL_MATRIX4_NV = $8634;
- GL_MATRIX5_NV = $8635;
- GL_MATRIX6_NV = $8636;
- GL_MATRIX7_NV = $8637;
- GL_IDENTITY_NV = $862A;
- GL_INVERSE_NV = $862B;
- GL_TRANSPOSE_NV = $862C;
- GL_INVERSE_TRANSPOSE_NV = $862D;
- GL_VERTEX_ATTRIB_ARRAY0_NV = $8650;
- GL_VERTEX_ATTRIB_ARRAY1_NV = $8651;
- GL_VERTEX_ATTRIB_ARRAY2_NV = $8652;
- GL_VERTEX_ATTRIB_ARRAY3_NV = $8653;
- GL_VERTEX_ATTRIB_ARRAY4_NV = $8654;
- GL_VERTEX_ATTRIB_ARRAY5_NV = $8655;
- GL_VERTEX_ATTRIB_ARRAY6_NV = $8656;
- GL_VERTEX_ATTRIB_ARRAY7_NV = $8657;
- GL_VERTEX_ATTRIB_ARRAY8_NV = $8658;
- GL_VERTEX_ATTRIB_ARRAY9_NV = $8659;
- GL_VERTEX_ATTRIB_ARRAY10_NV = $865A;
- GL_VERTEX_ATTRIB_ARRAY11_NV = $865B;
- GL_VERTEX_ATTRIB_ARRAY12_NV = $865C;
- GL_VERTEX_ATTRIB_ARRAY13_NV = $865D;
- GL_VERTEX_ATTRIB_ARRAY14_NV = $865E;
- GL_VERTEX_ATTRIB_ARRAY15_NV = $865F;
- GL_MAP1_VERTEX_ATTRIB0_4_NV = $8660;
- GL_MAP1_VERTEX_ATTRIB1_4_NV = $8661;
- GL_MAP1_VERTEX_ATTRIB2_4_NV = $8662;
- GL_MAP1_VERTEX_ATTRIB3_4_NV = $8663;
- GL_MAP1_VERTEX_ATTRIB4_4_NV = $8664;
- GL_MAP1_VERTEX_ATTRIB5_4_NV = $8665;
- GL_MAP1_VERTEX_ATTRIB6_4_NV = $8666;
- GL_MAP1_VERTEX_ATTRIB7_4_NV = $8667;
- GL_MAP1_VERTEX_ATTRIB8_4_NV = $8668;
- GL_MAP1_VERTEX_ATTRIB9_4_NV = $8669;
- GL_MAP1_VERTEX_ATTRIB10_4_NV = $866A;
- GL_MAP1_VERTEX_ATTRIB11_4_NV = $866B;
- GL_MAP1_VERTEX_ATTRIB12_4_NV = $866C;
- GL_MAP1_VERTEX_ATTRIB13_4_NV = $866D;
- GL_MAP1_VERTEX_ATTRIB14_4_NV = $866E;
- GL_MAP1_VERTEX_ATTRIB15_4_NV = $866F;
- GL_MAP2_VERTEX_ATTRIB0_4_NV = $8670;
- GL_MAP2_VERTEX_ATTRIB1_4_NV = $8671;
- GL_MAP2_VERTEX_ATTRIB2_4_NV = $8672;
- GL_MAP2_VERTEX_ATTRIB3_4_NV = $8673;
- GL_MAP2_VERTEX_ATTRIB4_4_NV = $8674;
- GL_MAP2_VERTEX_ATTRIB5_4_NV = $8675;
- GL_MAP2_VERTEX_ATTRIB6_4_NV = $8676;
- GL_MAP2_VERTEX_ATTRIB7_4_NV = $8677;
- GL_MAP2_VERTEX_ATTRIB8_4_NV = $8678;
- GL_MAP2_VERTEX_ATTRIB9_4_NV = $8679;
- GL_MAP2_VERTEX_ATTRIB10_4_NV = $867A;
- GL_MAP2_VERTEX_ATTRIB11_4_NV = $867B;
- GL_MAP2_VERTEX_ATTRIB12_4_NV = $867C;
- GL_MAP2_VERTEX_ATTRIB13_4_NV = $867D;
- GL_MAP2_VERTEX_ATTRIB14_4_NV = $867E;
- GL_MAP2_VERTEX_ATTRIB15_4_NV = $867F;
-var
- glBindProgramNV: procedure(target: GLenum; id: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDeleteProgramsNV: procedure(n: GLsizei; const ids: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glExecuteProgramNV: procedure(target: GLenum; id: GLuint; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGenProgramsNV: procedure(n: GLsizei; ids: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glAreProgramsResidentNV: function(n: GLsizei; const ids: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRequestResidentProgramsNV: procedure(n: GLsizei; ids: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetProgramParameterfvNV: procedure(target: GLenum; index: GLuint; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetProgramParameterdvNV: procedure(target: GLenum; index: GLuint; pname: GLenum; params: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetProgramivNV: procedure(id: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetProgramStringNV: procedure(id: GLuint; pname: GLenum; _program: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetTrackMatrixivNV: procedure(target: GLenum; address: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetVertexAttribdvNV: procedure(index: GLuint; pname: GLenum; params: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetVertexAttribfvNV: procedure(index: GLuint; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetVertexAttribivNV: procedure(index: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetVertexAttribPointervNV: procedure(index: GLuint; pname: GLenum; pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIsProgramNV: function(id: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glLoadProgramNV: procedure(target: GLenum; id: GLuint; len: GLsizei; const _program: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glProgramParameter4fNV: procedure(target: GLenum; index: GLuint; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glProgramParameter4fvNV: procedure(target: GLenum; index: GLuint; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glProgramParameters4dvNV: procedure(target: GLenum; index: GLuint; num: GLuint; const params: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glProgramParameters4fvNV: procedure(target: GLenum; index: GLuint; num: GLuint; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTrackMatrixNV: procedure(target: GLenum; address: GLuint; matrix: GLenum; transform: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttribPointerNV: procedure(index: GLuint; size: GLint; _type: GLenum; stride: GLsizei; const pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib1sNV: procedure(index: GLuint; x: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib1fNV: procedure(index: GLuint; x: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib1dNV: procedure(index: GLuint; x: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib2sNV: procedure(index: GLuint; x: GLshort; y: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib2fNV: procedure(index: GLuint; x: GLfloat; y: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib2dNV: procedure(index: GLuint; x: GLdouble; y: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib3sNV: procedure(index: GLuint; x: GLshort; y: GLshort; z: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib3fNV: procedure(index: GLuint; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib3dNV: procedure(index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4sNV: procedure(index: GLuint; x: GLshort; y: GLshort; z: GLshort; w: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4fNV: procedure(index: GLuint; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4dNV: procedure(index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4ubNV: procedure(index: GLuint; x: GLubyte; y: GLubyte; z: GLubyte; w: GLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib1svNV: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib1fvNV: procedure(index: GLuint; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib1dvNV: procedure(index: GLuint; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib2svNV: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib2fvNV: procedure(index: GLuint; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib2dvNV: procedure(index: GLuint; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib3svNV: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib3fvNV: procedure(index: GLuint; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib3dvNV: procedure(index: GLuint; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4svNV: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4fvNV: procedure(index: GLuint; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4dvNV: procedure(index: GLuint; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4ubvNV: procedure(index: GLuint; const v: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttribs1svNV: procedure(index: GLuint; n: GLsizei; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttribs1fvNV: procedure(index: GLuint; n: GLsizei; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttribs1dvNV: procedure(index: GLuint; n: GLsizei; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttribs2svNV: procedure(index: GLuint; n: GLsizei; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttribs2fvNV: procedure(index: GLuint; n: GLsizei; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttribs2dvNV: procedure(index: GLuint; n: GLsizei; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttribs3svNV: procedure(index: GLuint; n: GLsizei; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttribs3fvNV: procedure(index: GLuint; n: GLsizei; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttribs3dvNV: procedure(index: GLuint; n: GLsizei; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttribs4svNV: procedure(index: GLuint; n: GLsizei; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttribs4fvNV: procedure(index: GLuint; n: GLsizei; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttribs4dvNV: procedure(index: GLuint; n: GLsizei; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttribs4ubvNV: procedure(index: GLuint; n: GLsizei; const v: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_NV_vertex_program: Boolean;
-
-//***** GL_NV_vertex_program1_1 *****//
-
-function Load_GL_NV_vertex_program1_1: Boolean;
-
-//***** GL_ATI_element_array *****//
-const
- GL_ELEMENT_ARRAY_ATI = $8768;
- GL_ELEMENT_ARRAY_TYPE_ATI = $8769;
- GL_ELEMENT_ARRAY_POINTER_ATI = $876A;
-var
- glElementPointerATI: procedure(_type: GLenum; const pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDrawElementArrayATI: procedure(mode: GLenum; count: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDrawRangeElementArrayATI: procedure(mode: GLenum; start: GLuint; _end: GLuint; count: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_ATI_element_array: Boolean;
-
-//***** GL_ATI_envmap_bumpmap *****//
-const
- GL_BUMP_ROT_MATRIX_ATI = $8775;
- GL_BUMP_ROT_MATRIX_SIZE_ATI = $8776;
- GL_BUMP_NUM_TEX_UNITS_ATI = $8777;
- GL_BUMP_TEX_UNITS_ATI = $8778;
- GL_DUDV_ATI = $8779;
- GL_DU8DV8_ATI = $877A;
- GL_BUMP_ENVMAP_ATI = $877B;
- GL_BUMP_TARGET_ATI = $877C;
-var
- glTexBumpParameterivATI: procedure(pname: GLenum; param: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexBumpParameterfvATI: procedure(pname: GLenum; param: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetTexBumpParameterivATI: procedure(pname: GLenum; param: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetTexBumpParameterfvATI: procedure(pname: GLenum; param: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_ATI_envmap_bumpmap: Boolean;
-
-//***** GL_ATI_fragment_shader *****//
-const
- GL_FRAGMENT_SHADER_ATI = $8920;
- GL_REG_0_ATI = $8921;
- GL_REG_1_ATI = $8922;
- GL_REG_2_ATI = $8923;
- GL_REG_3_ATI = $8924;
- GL_REG_4_ATI = $8925;
- GL_REG_5_ATI = $8926;
- GL_CON_0_ATI = $8941;
- GL_CON_1_ATI = $8942;
- GL_CON_2_ATI = $8943;
- GL_CON_3_ATI = $8944;
- GL_CON_4_ATI = $8945;
- GL_CON_5_ATI = $8946;
- GL_CON_6_ATI = $8947;
- GL_CON_7_ATI = $8948;
- GL_MOV_ATI = $8961;
- GL_ADD_ATI = $8963;
- GL_MUL_ATI = $8964;
- GL_SUB_ATI = $8965;
- GL_DOT3_ATI = $8966;
- GL_DOT4_ATI = $8967;
- GL_MAD_ATI = $8968;
- GL_LERP_ATI = $8969;
- GL_CND_ATI = $896A;
- GL_CND0_ATI = $896B;
- GL_DOT2_ADD_ATI = $896C;
- GL_SECONDARY_INTERPOLATOR_ATI = $896D;
- GL_SWIZZLE_STR_ATI = $8976;
- GL_SWIZZLE_STQ_ATI = $8977;
- GL_SWIZZLE_STR_DR_ATI = $8978;
- GL_SWIZZLE_STQ_DQ_ATI = $8979;
- GL_RED_BIT_ATI = $0001;
- GL_GREEN_BIT_ATI = $0002;
- GL_BLUE_BIT_ATI = $0004;
- GL_2X_BIT_ATI = $0001;
- GL_4X_BIT_ATI = $0002;
- GL_8X_BIT_ATI = $0004;
- GL_HALF_BIT_ATI = $0008;
- GL_QUARTER_BIT_ATI = $0010;
- GL_EIGHTH_BIT_ATI = $0020;
- GL_SATURATE_BIT_ATI = $0040;
- // GL_2X_BIT_ATI { already defined }
- GL_COMP_BIT_ATI = $0002;
- GL_NEGATE_BIT_ATI = $0004;
- GL_BIAS_BIT_ATI = $0008;
-var
- glGenFragmentShadersATI: function(range: GLuint): GLuint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glBindFragmentShaderATI: procedure(id: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDeleteFragmentShaderATI: procedure(id: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glBeginFragmentShaderATI: procedure(); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEndFragmentShaderATI: procedure(); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPassTexCoordATI: procedure(dst: GLuint; coord: GLuint; swizzle: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSampleMapATI: procedure(dst: GLuint; interp: GLuint; swizzle: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColorFragmentOp1ATI: procedure(op: GLenum; dst: GLuint; dstMask: GLuint; dstMod: GLuint; arg1: GLuint; arg1Rep: GLuint; arg1Mod: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColorFragmentOp2ATI: procedure(op: GLenum; dst: GLuint; dstMask: GLuint; dstMod: GLuint; arg1: GLuint; arg1Rep: GLuint; arg1Mod: GLuint; arg2: GLuint; arg2Rep: GLuint; arg2Mod: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColorFragmentOp3ATI: procedure(op: GLenum; dst: GLuint; dstMask: GLuint; dstMod: GLuint; arg1: GLuint; arg1Rep: GLuint; arg1Mod: GLuint; arg2: GLuint; arg2Rep: GLuint; arg2Mod: GLuint; arg3: GLuint; arg3Rep: GLuint; arg3Mod: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glAlphaFragmentOp1ATI: procedure(op: GLenum; dst: GLuint; dstMod: GLuint; arg1: GLuint; arg1Rep: GLuint; arg1Mod: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glAlphaFragmentOp2ATI: procedure(op: GLenum; dst: GLuint; dstMod: GLuint; arg1: GLuint; arg1Rep: GLuint; arg1Mod: GLuint; arg2: GLuint; arg2Rep: GLuint; arg2Mod: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glAlphaFragmentOp3ATI: procedure(op: GLenum; dst: GLuint; dstMod: GLuint; arg1: GLuint; arg1Rep: GLuint; arg1Mod: GLuint; arg2: GLuint; arg2Rep: GLuint; arg2Mod: GLuint; arg3: GLuint; arg3Rep: GLuint; arg3Mod: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSetFragmentShaderConstantATI: procedure(dst: GLuint; const value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_ATI_fragment_shader: Boolean;
-
-//***** GL_ATI_pn_triangles *****//
-const
- GL_PN_TRIANGLES_ATI = $87F0;
- GL_MAX_PN_TRIANGLES_TESSELATION_LEVEL_ATI = $87F1;
- GL_PN_TRIANGLES_POINT_MODE_ATI = $87F2;
- GL_PN_TRIANGLES_NORMAL_MODE_ATI = $87F3;
- GL_PN_TRIANGLES_TESSELATION_LEVEL_ATI = $87F4;
- GL_PN_TRIANGLES_POINT_MODE_LINEAR_ATI = $87F5;
- GL_PN_TRIANGLES_POINT_MODE_CUBIC_ATI = $87F6;
- GL_PN_TRIANGLES_NORMAL_MODE_LINEAR_ATI = $87F7;
- GL_PN_TRIANGLES_NORMAL_MODE_QUADRATIC_ATI = $87F8;
-var
- glPNTrianglesiATI: procedure(pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPNTrianglesfATI: procedure(pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_ATI_pn_triangles: Boolean;
-
-//***** GL_ATI_texture_mirror_once *****//
-const
- GL_MIRROR_CLAMP_ATI = $8742;
- GL_MIRROR_CLAMP_TO_EDGE_ATI = $8743;
-
-function Load_GL_ATI_texture_mirror_once: Boolean;
-
-//***** GL_ATI_vertex_array_object *****//
-const
- GL_STATIC_ATI = $8760;
- GL_DYNAMIC_ATI = $8761;
- GL_PRESERVE_ATI = $8762;
- GL_DISCARD_ATI = $8763;
- GL_OBJECT_BUFFER_SIZE_ATI = $8764;
- GL_OBJECT_BUFFER_USAGE_ATI = $8765;
- GL_ARRAY_OBJECT_BUFFER_ATI = $8766;
- GL_ARRAY_OBJECT_OFFSET_ATI = $8767;
-var
- glNewObjectBufferATI: function(size: GLsizei; const pointer: PGLvoid; usage: GLenum): GLuint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIsObjectBufferATI: function(buffer: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUpdateObjectBufferATI: procedure(buffer: GLuint; offset: GLuint; size: GLsizei; const pointer: PGLvoid; preserve: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetObjectBufferfvATI: procedure(buffer: GLuint; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetObjectBufferivATI: procedure(buffer: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDeleteObjectBufferATI: procedure(buffer: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glArrayObjectATI: procedure(_array: GLenum; size: GLint; _type: GLenum; stride: GLsizei; buffer: GLuint; offset: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetArrayObjectfvATI: procedure(_array: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetArrayObjectivATI: procedure(_array: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVariantArrayObjectATI: procedure(id: GLuint; _type: GLenum; stride: GLsizei; buffer: GLuint; offset: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetVariantArrayObjectfvATI: procedure(id: GLuint; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetVariantArrayObjectivATI: procedure(id: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_ATI_vertex_array_object: Boolean;
-
-//***** GL_ATI_vertex_streams *****//
-const
- GL_MAX_VERTEX_STREAMS_ATI = $876B;
- GL_VERTEX_STREAM0_ATI = $876C;
- GL_VERTEX_STREAM1_ATI = $876D;
- GL_VERTEX_STREAM2_ATI = $876E;
- GL_VERTEX_STREAM3_ATI = $876F;
- GL_VERTEX_STREAM4_ATI = $8770;
- GL_VERTEX_STREAM5_ATI = $8771;
- GL_VERTEX_STREAM6_ATI = $8772;
- GL_VERTEX_STREAM7_ATI = $8773;
- GL_VERTEX_SOURCE_ATI = $8774;
-var
- glVertexStream1s: procedure(stream: GLenum; coords: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream1i: procedure(stream: GLenum; coords: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream1f: procedure(stream: GLenum; coords: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream1d: procedure(stream: GLenum; coords: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream1sv: procedure(stream: GLenum; coords: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream1iv: procedure(stream: GLenum; coords: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream1fv: procedure(stream: GLenum; coords: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream1dv: procedure(stream: GLenum; coords: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream2s: procedure(stream: GLenum; coords: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream2i: procedure(stream: GLenum; coords: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream2f: procedure(stream: GLenum; coords: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream2d: procedure(stream: GLenum; coords: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream2sv: procedure(stream: GLenum; coords: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream2iv: procedure(stream: GLenum; coords: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream2fv: procedure(stream: GLenum; coords: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream2dv: procedure(stream: GLenum; coords: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream3s: procedure(stream: GLenum; coords: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream3i: procedure(stream: GLenum; coords: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream3f: procedure(stream: GLenum; coords: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream3d: procedure(stream: GLenum; coords: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream3sv: procedure(stream: GLenum; coords: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream3iv: procedure(stream: GLenum; coords: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream3fv: procedure(stream: GLenum; coords: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream3dv: procedure(stream: GLenum; coords: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream4s: procedure(stream: GLenum; coords: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream4i: procedure(stream: GLenum; coords: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream4f: procedure(stream: GLenum; coords: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream4d: procedure(stream: GLenum; coords: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream4sv: procedure(stream: GLenum; coords: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream4iv: procedure(stream: GLenum; coords: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream4fv: procedure(stream: GLenum; coords: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexStream4dv: procedure(stream: GLenum; coords: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNormalStream3b: procedure(stream: GLenum; coords: GLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNormalStream3s: procedure(stream: GLenum; coords: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNormalStream3i: procedure(stream: GLenum; coords: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNormalStream3f: procedure(stream: GLenum; coords: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNormalStream3d: procedure(stream: GLenum; coords: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNormalStream3bv: procedure(stream: GLenum; coords: GLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNormalStream3sv: procedure(stream: GLenum; coords: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNormalStream3iv: procedure(stream: GLenum; coords: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNormalStream3fv: procedure(stream: GLenum; coords: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNormalStream3dv: procedure(stream: GLenum; coords: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glClientActiveVertexStream: procedure(stream: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexBlendEnvi: procedure(pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexBlendEnvf: procedure(pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_ATI_vertex_streams: Boolean;
-
-{$IFDEF WINDOWS}
-//***** WGL_I3D_image_buffer *****//
-const
- WGL_IMAGE_BUFFER_MIN_ACCESS_I3D = $0001;
- WGL_IMAGE_BUFFER_LOCK_I3D = $0002;
-var
- wglCreateImageBufferI3D: function(hDC: HDC; dwSize: DWORD; uFlags: UINT): PGLvoid; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglDestroyImageBufferI3D: function(hDC: HDC; pAddress: PGLvoid): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglAssociateImageBufferEventsI3D: function(hdc: HDC; pEvent: PHandle; pAddress: PGLvoid; pSize: PDWORD; count: UINT): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglReleaseImageBufferEventsI3D: function(hdc: HDC; pAddress: PGLvoid; count: UINT): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_WGL_I3D_image_buffer: Boolean;
-
-//***** WGL_I3D_swap_frame_lock *****//
-var
- wglEnableFrameLockI3D: function(): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglDisableFrameLockI3D: function(): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglIsEnabledFrameLockI3D: function(pFlag: PBOOL): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglQueryFrameLockMasterI3D: function(pFlag: PBOOL): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_WGL_I3D_swap_frame_lock: Boolean;
-
-//***** WGL_I3D_swap_frame_usage *****//
-var
- wglGetFrameUsageI3D: function(pUsage: PGLfloat): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglBeginFrameTrackingI3D: function(): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglEndFrameTrackingI3D: function(): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglQueryFrameTrackingI3D: function(pFrameCount: PDWORD; pMissedFrames: PDWORD; pLastMissedUsage: PGLfloat): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_WGL_I3D_swap_frame_usage: Boolean;
-{$ENDIF}
-
-//***** GL_3DFX_texture_compression_FXT1 *****//
-const
- GL_COMPRESSED_RGB_FXT1_3DFX = $86B0;
- GL_COMPRESSED_RGBA_FXT1_3DFX = $86B1;
-
-function Load_GL_3DFX_texture_compression_FXT1: Boolean;
-
-//***** GL_IBM_cull_vertex *****//
-const
- GL_CULL_VERTEX_IBM = $1928A;
-
-function Load_GL_IBM_cull_vertex: Boolean;
-
-//***** GL_IBM_multimode_draw_arrays *****//
-var
- glMultiModeDrawArraysIBM: procedure(mode: PGLenum; first: PGLint; count: PGLsizei; primcount: GLsizei; modestride: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiModeDrawElementsIBM: procedure(mode: PGLenum; count: PGLsizei; _type: GLenum; const indices: PGLvoid; primcount: GLsizei; modestride: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_IBM_multimode_draw_arrays: Boolean;
-
-//***** GL_IBM_raster_pos_clip *****//
-const
- GL_RASTER_POSITION_UNCLIPPED_IBM = $19262;
-
-function Load_GL_IBM_raster_pos_clip: Boolean;
-
-//***** GL_IBM_texture_mirrored_repeat *****//
-const
- GL_MIRRORED_REPEAT_IBM = $8370;
-
-function Load_GL_IBM_texture_mirrored_repeat: Boolean;
-
-//***** GL_IBM_vertex_array_lists *****//
-const
- GL_VERTEX_ARRAY_LIST_IBM = $1929E;
- GL_NORMAL_ARRAY_LIST_IBM = $1929F;
- GL_COLOR_ARRAY_LIST_IBM = $192A0;
- GL_INDEX_ARRAY_LIST_IBM = $192A1;
- GL_TEXTURE_COORD_ARRAY_LIST_IBM = $192A2;
- GL_EDGE_FLAG_ARRAY_LIST_IBM = $192A3;
- GL_FOG_COORDINATE_ARRAY_LIST_IBM = $192A4;
- GL_SECONDARY_COLOR_ARRAY_LIST_IBM = $192A5;
- GL_VERTEX_ARRAY_LIST_STRIDE_IBM = $192A8;
- GL_NORMAL_ARRAY_LIST_STRIDE_IBM = $192A9;
- GL_COLOR_ARRAY_LIST_STRIDE_IBM = $192AA;
- GL_INDEX_ARRAY_LIST_STRIDE_IBM = $192AB;
- GL_TEXTURE_COORD_ARRAY_LIST_STRIDE_IBM = $192AC;
- GL_EDGE_FLAG_ARRAY_LIST_STRIDE_IBM = $192AD;
- GL_FOG_COORDINATE_ARRAY_LIST_STRIDE_IBM = $192AE;
- GL_SECONDARY_COLOR_ARRAY_LIST_STRIDE_IBM = $192AF;
-var
- glColorPointerListIBM: procedure(size: GLint; _type: GLenum; stride: GLint; const pointer: PGLvoid; ptrstride: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColorPointerListIBM: procedure(size: GLint; _type: GLenum; stride: GLint; const pointer: PGLvoid; ptrstride: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEdgeFlagPointerListIBM: procedure(stride: GLint; const pointer: PGLboolean; ptrstride: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFogCoordPointerListIBM: procedure(_type: GLenum; stride: GLint; const pointer: PGLvoid; ptrstride: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNormalPointerListIBM: procedure(_type: GLenum; stride: GLint; const pointer: PGLvoid; ptrstride: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoordPointerListIBM: procedure(size: GLint; _type: GLenum; stride: GLint; const pointer: PGLvoid; ptrstride: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexPointerListIBM: procedure(size: GLint; _type: GLenum; stride: GLint; const pointer: PGLvoid; ptrstride: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_IBM_vertex_array_lists: Boolean;
-
-//***** GL_MESA_resize_buffers *****//
-var
- glResizeBuffersMESA: procedure(); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_MESA_resize_buffers: Boolean;
-
-//***** GL_MESA_window_pos *****//
-var
- glWindowPos2dMESA: procedure(x: GLdouble; y: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos2fMESA: procedure(x: GLfloat; y: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos2iMESA: procedure(x: GLint; y: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos2sMESA: procedure(x: GLshort; y: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos2ivMESA: procedure(const p: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos2svMESA: procedure(const p: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos2fvMESA: procedure(const p: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos2dvMESA: procedure(const p: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos3iMESA: procedure(x: GLint; y: GLint; z: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos3sMESA: procedure(x: GLshort; y: GLshort; z: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos3fMESA: procedure(x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos3dMESA: procedure(x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos3ivMESA: procedure(const p: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos3svMESA: procedure(const p: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos3fvMESA: procedure(const p: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos3dvMESA: procedure(const p: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos4iMESA: procedure(x: GLint; y: GLint; z: GLint; w: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos4sMESA: procedure(x: GLshort; y: GLshort; z: GLshort; w: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos4fMESA: procedure(x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos4dMESA: procedure(x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos4ivMESA: procedure(const p: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos4svMESA: procedure(const p: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos4fvMESA: procedure(const p: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos4dvMESA: procedure(const p: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_MESA_window_pos: Boolean;
-
-//***** GL_OML_interlace *****//
-const
- GL_INTERLACE_OML = $8980;
- GL_INTERLACE_READ_OML = $8981;
-
-function Load_GL_OML_interlace: Boolean;
-
-//***** GL_OML_resample *****//
-const
- GL_PACK_RESAMPLE_OML = $8984;
- GL_UNPACK_RESAMPLE_OML = $8985;
- GL_RESAMPLE_REPLICATE_OML = $8986;
- GL_RESAMPLE_ZERO_FILL_OML = $8987;
- GL_RESAMPLE_AVERAGE_OML = $8988;
- GL_RESAMPLE_DECIMATE_OML = $8989;
- // GL_RESAMPLE_AVERAGE_OML { already defined }
-
-function Load_GL_OML_resample: Boolean;
-
-//***** GL_OML_subsample *****//
-const
- GL_FORMAT_SUBSAMPLE_24_24_OML = $8982;
- GL_FORMAT_SUBSAMPLE_244_244_OML = $8983;
-
-function Load_GL_OML_subsample: Boolean;
-
-//***** GL_SGIS_generate_mipmap *****//
-const
- GL_GENERATE_MIPMAP_SGIS = $8191;
- GL_GENERATE_MIPMAP_HINT_SGIS = $8192;
-
-function Load_GL_SGIS_generate_mipmap: Boolean;
-
-//***** GL_SGIS_multisample *****//
-const
- GLX_SAMPLE_BUFFERS_SGIS = $186A0;
- GLX_SAMPLES_SGIS = $186A1;
- GL_MULTISAMPLE_SGIS = $809D;
- GL_SAMPLE_ALPHA_TO_MASK_SGIS = $809E;
- GL_SAMPLE_ALPHA_TO_ONE_SGIS = $809F;
- GL_SAMPLE_MASK_SGIS = $80A0;
- GL_MULTISAMPLE_BIT_EXT = $20000000;
- GL_1PASS_SGIS = $80A1;
- GL_2PASS_0_SGIS = $80A2;
- GL_2PASS_1_SGIS = $80A3;
- GL_4PASS_0_SGIS = $80A4;
- GL_4PASS_1_SGIS = $80A5;
- GL_4PASS_2_SGIS = $80A6;
- GL_4PASS_3_SGIS = $80A7;
- GL_SAMPLE_BUFFERS_SGIS = $80A8;
- GL_SAMPLES_SGIS = $80A9;
- GL_SAMPLE_MASK_VALUE_SGIS = $80AA;
- GL_SAMPLE_MASK_INVERT_SGIS = $80AB;
- GL_SAMPLE_PATTERN_SGIS = $80AC;
-var
- glSampleMaskSGIS: procedure(value: GLclampf; invert: GLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSamplePatternSGIS: procedure(pattern: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_SGIS_multisample: Boolean;
-
-//***** GL_SGIS_pixel_texture *****//
-const
- GL_PIXEL_TEXTURE_SGIS = $8353;
- GL_PIXEL_FRAGMENT_RGB_SOURCE_SGIS = $8354;
- GL_PIXEL_FRAGMENT_ALPHA_SOURCE_SGIS = $8355;
- GL_PIXEL_GROUP_COLOR_SGIS = $8356;
-var
- glPixelTexGenParameteriSGIS: procedure(pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPixelTexGenParameterfSGIS: procedure(pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetPixelTexGenParameterivSGIS: procedure(pname: GLenum; params: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetPixelTexGenParameterfvSGIS: procedure(pname: GLenum; params: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_SGIS_pixel_texture: Boolean;
-
-//***** GL_SGIS_texture_border_clamp *****//
- // GL_CLAMP_TO_BORDER_SGIS { already defined }
-
-function Load_GL_SGIS_texture_border_clamp: Boolean;
-
-//***** GL_SGIS_texture_color_mask *****//
-const
- GL_TEXTURE_COLOR_WRITEMASK_SGIS = $81EF;
-var
- glTextureColorMaskSGIS: procedure(r: GLboolean; g: GLboolean; b: GLboolean; a: GLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_SGIS_texture_color_mask: Boolean;
-
-//***** GL_SGIS_texture_edge_clamp *****//
-const
- GL_CLAMP_TO_EDGE_SGIS = $812F;
-
-function Load_GL_SGIS_texture_edge_clamp: Boolean;
-
-//***** GL_SGIS_texture_lod *****//
-const
- GL_TEXTURE_MIN_LOD_SGIS = $813A;
- GL_TEXTURE_MAX_LOD_SGIS = $813B;
- GL_TEXTURE_BASE_LEVEL_SGIS = $813C;
- GL_TEXTURE_MAX_LEVEL_SGIS = $813D;
-
-function Load_GL_SGIS_texture_lod: Boolean;
-
-//***** GL_SGIS_depth_texture *****//
-const
- GL_DEPTH_COMPONENT16_SGIX = $81A5;
- GL_DEPTH_COMPONENT24_SGIX = $81A6;
- GL_DEPTH_COMPONENT32_SGIX = $81A7;
-
-function Load_GL_SGIS_depth_texture: Boolean;
-
-//***** GL_SGIX_fog_offset *****//
-const
- GL_FOG_OFFSET_SGIX = $8198;
- GL_FOG_OFFSET_VALUE_SGIX = $8199;
-
-function Load_GL_SGIX_fog_offset: Boolean;
-
-//***** GL_SGIX_interlace *****//
-const
- GL_INTERLACE_SGIX = $8094;
-
-function Load_GL_SGIX_interlace: Boolean;
-
-//***** GL_SGIX_shadow_ambient *****//
-const
- GL_SHADOW_AMBIENT_SGIX = $80BF;
-
-function Load_GL_SGIX_shadow_ambient: Boolean;
-
-//***** GL_SGI_color_matrix *****//
-const
- GL_COLOR_MATRIX_SGI = $80B1;
- GL_COLOR_MATRIX_STACK_DEPTH_SGI = $80B2;
- GL_MAX_COLOR_MATRIX_STACK_DEPTH_SGI = $80B3;
- GL_POST_COLOR_MATRIX_RED_SCALE_SGI = $80B4;
- GL_POST_COLOR_MATRIX_GREEN_SCALE_SGI = $80B5;
- GL_POST_COLOR_MATRIX_BLUE_SCALE_SGI = $80B6;
- GL_POST_COLOR_MATRIX_ALPHA_SCALE_SGI = $80B7;
- GL_POST_COLOR_MATRIX_RED_BIAS_SGI = $80B8;
- GL_POST_COLOR_MATRIX_GREEN_BIAS_SGI = $80B9;
- GL_POST_COLOR_MATRIX_BLUE_BIAS_SGI = $80BA;
- GL_POST_COLOR_MATRIX_ALPHA_BIAS_SGI = $80BB;
-
-function Load_GL_SGI_color_matrix: Boolean;
-
-//***** GL_SGI_color_table *****//
-const
- GL_COLOR_TABLE_SGI = $80D0;
- GL_POST_CONVOLUTION_COLOR_TABLE_SGI = $80D1;
- GL_POST_COLOR_MATRIX_COLOR_TABLE_SGI = $80D2;
- GL_PROXY_COLOR_TABLE_SGI = $80D3;
- GL_PROXY_POST_CONVOLUTION_COLOR_TABLE_SGI = $80D4;
- GL_PROXY_POST_COLOR_MATRIX_COLOR_TABLE_SGI = $80D5;
- GL_COLOR_TABLE_SCALE_SGI = $80D6;
- GL_COLOR_TABLE_BIAS_SGI = $80D7;
- GL_COLOR_TABLE_FORMAT_SGI = $80D8;
- GL_COLOR_TABLE_WIDTH_SGI = $80D9;
- GL_COLOR_TABLE_RED_SIZE_SGI = $80DA;
- GL_COLOR_TABLE_GREEN_SIZE_SGI = $80DB;
- GL_COLOR_TABLE_BLUE_SIZE_SGI = $80DC;
- GL_COLOR_TABLE_ALPHA_SIZE_SGI = $80DD;
- GL_COLOR_TABLE_LUMINANCE_SIZE_SGI = $80DE;
- GL_COLOR_TABLE_INTENSITY_SIZE_SGI = $80DF;
-var
- glColorTableSGI: procedure(target: GLenum; internalformat: GLenum; width: GLsizei; format: GLenum; _type: GLenum; const table: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCopyColorTableSGI: procedure(target: GLenum; internalformat: GLenum; x: GLint; y: GLint; width: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColorTableParameterivSGI: procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColorTableParameterfvSGI: procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetColorTableSGI: procedure(target: GLenum; format: GLenum; _type: GLenum; table: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetColorTableParameterivSGI: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetColorTableParameterfvSGI: procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_SGI_color_table: Boolean;
-
-//***** GL_SGI_texture_color_table *****//
-const
- GL_TEXTURE_COLOR_TABLE_SGI = $80BC;
- GL_PROXY_TEXTURE_COLOR_TABLE_SGI = $80BD;
-
-function Load_GL_SGI_texture_color_table: Boolean;
-
-//***** GL_SUN_vertex *****//
-var
- glColor4ubVertex2fSUN: procedure(r: GLubyte; g: GLubyte; b: GLubyte; a: GLubyte; x: GLfloat; y: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor4ubVertex2fvSUN: procedure(const c: PGLubyte; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor4ubVertex3fSUN: procedure(r: GLubyte; g: GLubyte; b: GLubyte; a: GLubyte; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor4ubVertex3fvSUN: procedure(const c: PGLubyte; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor3fVertex3fSUN: procedure(r: GLfloat; g: GLfloat; b: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor3fVertex3fvSUN: procedure(const c: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNormal3fVertex3fSUN: procedure(nx: GLfloat; ny: GLfloat; nz: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNormal3fVertex3fvSUN: procedure(const n: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor4fNormal3fVertex3fSUN: procedure(r: GLfloat; g: GLfloat; b: GLfloat; a: GLfloat; nx: GLfloat; ny: GLfloat; nz: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor4fNormal3fVertex3fvSUN: procedure(const c: PGLfloat; const n: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord2fVertex3fSUN: procedure(s: GLfloat; t: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord2fVertex3fvSUN: procedure(const tc: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord4fVertex4fSUN: procedure(s: GLfloat; t: GLfloat; p: GLfloat; q: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord4fVertex4fvSUN: procedure(const tc: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord2fColor4ubVertex3fSUN: procedure(s: GLfloat; t: GLfloat; r: GLubyte; g: GLubyte; b: GLubyte; a: GLubyte; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord2fColor4ubVertex3fvSUN: procedure(const tc: PGLfloat; const c: PGLubyte; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord2fColor3fVertex3fSUN: procedure(s: GLfloat; t: GLfloat; r: GLfloat; g: GLfloat; b: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord2fColor3fVertex3fvSUN: procedure(const tc: PGLfloat; const c: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord2fNormal3fVertex3fSUN: procedure(s: GLfloat; t: GLfloat; nx: GLfloat; ny: GLfloat; nz: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord2fNormal3fVertex3fvSUN: procedure(const tc: PGLfloat; const n: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord2fColor4fNormal3fVertex3fSUN: procedure(s: GLfloat; t: GLfloat; r: GLfloat; g: GLfloat; b: GLfloat; a: GLfloat; nx: GLfloat; ny: GLfloat; nz: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord2fColor4fNormal3fVertex3fvSUN: procedure(const tc: PGLfloat; const c: PGLfloat; const n: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord4fColor4fNormal3fVertex4fSUN: procedure(s: GLfloat; t: GLfloat; p: GLfloat; q: GLfloat; r: GLfloat; g: GLfloat; b: GLfloat; a: GLfloat; nx: GLfloat; ny: GLfloat; nz: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord4fColor4fNormal3fVertex4fvSUN: procedure(const tc: PGLfloat; const c: PGLfloat; const n: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glReplacementCodeuiVertex3fSUN: procedure(rc: GLuint; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glReplacementCodeuiVertex3fvSUN: procedure(const rc: PGLuint; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glReplacementCodeuiColor4ubVertex3fSUN: procedure(rc: GLuint; r: GLubyte; g: GLubyte; b: GLubyte; a: GLubyte; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glReplacementCodeuiColor4ubVertex3fvSUN: procedure(const rc: PGLuint; const c: PGLubyte; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glReplacementCodeuiColor3fVertex3fSUN: procedure(rc: GLuint; r: GLfloat; g: GLfloat; b: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glReplacementCodeuiColor3fVertex3fvSUN: procedure(const rc: PGLuint; const c: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glReplacementCodeuiNormal3fVertex3fSUN: procedure(rc: GLuint; nx: GLfloat; ny: GLfloat; nz: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glReplacementCodeuiNormal3fVertex3fvSUN: procedure(const rc: PGLuint; const n: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glReplacementCodeuiColor4fNormal3fVertex3fSUN: procedure(rc: GLuint; r: GLfloat; g: GLfloat; b: GLfloat; a: GLfloat; nx: GLfloat; ny: GLfloat; nz: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glReplacementCodeuiColor4fNormal3fVertex3fvSUN: procedure(const rc: PGLuint; const c: PGLfloat; const n: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glReplacementCodeuiTexCoord2fVertex3fSUN: procedure(rc: GLuint; s: GLfloat; t: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glReplacementCodeuiTexCoord2fVertex3fvSUN: procedure(const rc: PGLuint; const tc: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glReplacementCodeuiTexCoord2fNormal3fVertex3fSUN: procedure(rc: GLuint; s: GLfloat; t: GLfloat; nx: GLfloat; ny: GLfloat; nz: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glReplacementCodeuiTexCoord2fNormal3fVertex3fvSUN: procedure(const rc: PGLuint; const tc: PGLfloat; const n: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glReplacementCodeuiTexCoord2fColor4fNormal3fVertex3fSUN: procedure(rc: GLuint; s: GLfloat; t: GLfloat; r: GLfloat; g: GLfloat; b: GLfloat; a: GLfloat; nx: GLfloat; ny: GLfloat; nz: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glReplacementCodeuiTexCoord2fColor4fNormal3fVertex3fvSUN: procedure(const rc: PGLuint; const tc: PGLfloat; const c: PGLfloat; const n: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_SUN_vertex: Boolean;
-
-//***** GL_ARB_fragment_program *****//
-const
- GL_FRAGMENT_PROGRAM_ARB = $8804;
- // GL_PROGRAM_FORMAT_ASCII_ARB { already defined }
- // GL_PROGRAM_LENGTH_ARB { already defined }
- // GL_PROGRAM_FORMAT_ARB { already defined }
- // GL_PROGRAM_BINDING_ARB { already defined }
- // GL_PROGRAM_INSTRUCTIONS_ARB { already defined }
- // GL_MAX_PROGRAM_INSTRUCTIONS_ARB { already defined }
- // GL_PROGRAM_NATIVE_INSTRUCTIONS_ARB { already defined }
- // GL_MAX_PROGRAM_NATIVE_INSTRUCTIONS_ARB { already defined }
- // GL_PROGRAM_TEMPORARIES_ARB { already defined }
- // GL_MAX_PROGRAM_TEMPORARIES_ARB { already defined }
- // GL_PROGRAM_NATIVE_TEMPORARIES_ARB { already defined }
- // GL_MAX_PROGRAM_NATIVE_TEMPORARIES_ARB { already defined }
- // GL_PROGRAM_PARAMETERS_ARB { already defined }
- // GL_MAX_PROGRAM_PARAMETERS_ARB { already defined }
- // GL_PROGRAM_NATIVE_PARAMETERS_ARB { already defined }
- // GL_MAX_PROGRAM_NATIVE_PARAMETERS_ARB { already defined }
- // GL_PROGRAM_ATTRIBS_ARB { already defined }
- // GL_MAX_PROGRAM_ATTRIBS_ARB { already defined }
- // GL_PROGRAM_NATIVE_ATTRIBS_ARB { already defined }
- // GL_MAX_PROGRAM_NATIVE_ATTRIBS_ARB { already defined }
- // GL_MAX_PROGRAM_LOCAL_PARAMETERS_ARB { already defined }
- // GL_MAX_PROGRAM_ENV_PARAMETERS_ARB { already defined }
- // GL_PROGRAM_UNDER_NATIVE_LIMITS_ARB { already defined }
- GL_PROGRAM_ALU_INSTRUCTIONS_ARB = $8805;
- GL_PROGRAM_TEX_INSTRUCTIONS_ARB = $8806;
- GL_PROGRAM_TEX_INDIRECTIONS_ARB = $8807;
- GL_PROGRAM_NATIVE_ALU_INSTRUCTIONS_ARB = $8808;
- GL_PROGRAM_NATIVE_TEX_INSTRUCTIONS_ARB = $8809;
- GL_PROGRAM_NATIVE_TEX_INDIRECTIONS_ARB = $880A;
- GL_MAX_PROGRAM_ALU_INSTRUCTIONS_ARB = $880B;
- GL_MAX_PROGRAM_TEX_INSTRUCTIONS_ARB = $880C;
- GL_MAX_PROGRAM_TEX_INDIRECTIONS_ARB = $880D;
- GL_MAX_PROGRAM_NATIVE_ALU_INSTRUCTIONS_ARB = $880E;
- GL_MAX_PROGRAM_NATIVE_TEX_INSTRUCTIONS_ARB = $880F;
- GL_MAX_PROGRAM_NATIVE_TEX_INDIRECTIONS_ARB = $8810;
- // GL_PROGRAM_STRING_ARB { already defined }
- // GL_PROGRAM_ERROR_POSITION_ARB { already defined }
- // GL_CURRENT_MATRIX_ARB { already defined }
- // GL_TRANSPOSE_CURRENT_MATRIX_ARB { already defined }
- // GL_CURRENT_MATRIX_STACK_DEPTH_ARB { already defined }
- // GL_MAX_PROGRAM_MATRICES_ARB { already defined }
- // GL_MAX_PROGRAM_MATRIX_STACK_DEPTH_ARB { already defined }
- GL_MAX_TEXTURE_COORDS_ARB = $8871;
- GL_MAX_TEXTURE_IMAGE_UNITS_ARB = $8872;
- // GL_PROGRAM_ERROR_STRING_ARB { already defined }
- // GL_MATRIX0_ARB { already defined }
- // GL_MATRIX1_ARB { already defined }
- // GL_MATRIX2_ARB { already defined }
- // GL_MATRIX3_ARB { already defined }
- // GL_MATRIX4_ARB { already defined }
- // GL_MATRIX5_ARB { already defined }
- // GL_MATRIX6_ARB { already defined }
- // GL_MATRIX7_ARB { already defined }
- // GL_MATRIX8_ARB { already defined }
- // GL_MATRIX9_ARB { already defined }
- // GL_MATRIX10_ARB { already defined }
- // GL_MATRIX11_ARB { already defined }
- // GL_MATRIX12_ARB { already defined }
- // GL_MATRIX13_ARB { already defined }
- // GL_MATRIX14_ARB { already defined }
- // GL_MATRIX15_ARB { already defined }
- // GL_MATRIX16_ARB { already defined }
- // GL_MATRIX17_ARB { already defined }
- // GL_MATRIX18_ARB { already defined }
- // GL_MATRIX19_ARB { already defined }
- // GL_MATRIX20_ARB { already defined }
- // GL_MATRIX21_ARB { already defined }
- // GL_MATRIX22_ARB { already defined }
- // GL_MATRIX23_ARB { already defined }
- // GL_MATRIX24_ARB { already defined }
- // GL_MATRIX25_ARB { already defined }
- // GL_MATRIX26_ARB { already defined }
- // GL_MATRIX27_ARB { already defined }
- // GL_MATRIX28_ARB { already defined }
- // GL_MATRIX29_ARB { already defined }
- // GL_MATRIX30_ARB { already defined }
- // GL_MATRIX31_ARB { already defined }
- // glProgramStringARB { already defined }
- // glBindProgramARB { already defined }
- // glDeleteProgramsARB { already defined }
- // glGenProgramsARB { already defined }
- // glProgramEnvParameter4dARB { already defined }
- // glProgramEnvParameter4dvARB { already defined }
- // glProgramEnvParameter4fARB { already defined }
- // glProgramEnvParameter4fvARB { already defined }
- // glProgramLocalParameter4dARB { already defined }
- // glProgramLocalParameter4dvARB { already defined }
- // glProgramLocalParameter4fARB { already defined }
- // glProgramLocalParameter4fvARB { already defined }
- // glGetProgramEnvParameterdvARB { already defined }
- // glGetProgramEnvParameterfvARB { already defined }
- // glGetProgramLocalParameterdvARB { already defined }
- // glGetProgramLocalParameterfvARB { already defined }
- // glGetProgramivARB { already defined }
- // glGetProgramStringARB { already defined }
- // glIsProgramARB { already defined }
-
-function Load_GL_ARB_fragment_program: Boolean;
-
-//***** GL_ATI_text_fragment_shader *****//
-const
- GL_TEXT_FRAGMENT_SHADER_ATI = $8200;
-
-function Load_GL_ATI_text_fragment_shader: Boolean;
-
-//***** GL_APPLE_client_storage *****//
-const
- GL_UNPACK_CLIENT_STORAGE_APPLE = $85B2;
-
-function Load_GL_APPLE_client_storage: Boolean;
-
-//***** GL_APPLE_element_array *****//
-const
- GL_ELEMENT_ARRAY_APPLE = $8768;
- GL_ELEMENT_ARRAY_TYPE_APPLE = $8769;
- GL_ELEMENT_ARRAY_POINTER_APPLE = $876A;
-var
- glElementPointerAPPLE: procedure(_type: GLenum; const pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDrawElementArrayAPPLE: procedure(mode: GLenum; first: GLint; count: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDrawRangeElementArrayAPPLE: procedure(mode: GLenum; start: GLuint; _end: GLuint; first: GLint; count: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiDrawElementArrayAPPLE: procedure(mode: GLenum; const first: PGLint; const count: PGLsizei; primcount: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiDrawRangeElementArrayAPPLE: procedure(mode: GLenum; start: GLuint; _end: GLuint; const first: PGLint; const count: PGLsizei; primcount: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_APPLE_element_array: Boolean;
-
-//***** GL_APPLE_fence *****//
-const
- GL_DRAW_PIXELS_APPLE = $8A0A;
- GL_FENCE_APPLE = $8A0B;
-var
- glGenFencesAPPLE: procedure(n: GLsizei; fences: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDeleteFencesAPPLE: procedure(n: GLsizei; const fences: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSetFenceAPPLE: procedure(fence: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIsFenceAPPLE: function(fence: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTestFenceAPPLE: function(fence: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFinishFenceAPPLE: procedure(fence: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTestObjectAPPLE: function(_object: GLenum; name: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFinishObjectAPPLE: procedure(_object: GLenum; name: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_APPLE_fence: Boolean;
-
-//***** GL_APPLE_vertex_array_object *****//
-const
- GL_VERTEX_ARRAY_BINDING_APPLE = $85B5;
-var
- glBindVertexArrayAPPLE: procedure(_array: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDeleteVertexArraysAPPLE: procedure(n: GLsizei; const arrays: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGenVertexArraysAPPLE: procedure(n: GLsizei; const arrays: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIsVertexArrayAPPLE: function(_array: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_APPLE_vertex_array_object: Boolean;
-
-//***** GL_APPLE_vertex_array_range *****//
-const
- GL_VERTEX_ARRAY_RANGE_APPLE = $851D;
- GL_VERTEX_ARRAY_RANGE_LENGTH_APPLE = $851E;
- GL_MAX_VERTEX_ARRAY_RANGE_ELEMENT_APPLE = $8520;
- GL_VERTEX_ARRAY_RANGE_POINTER_APPLE = $8521;
- GL_VERTEX_ARRAY_STORAGE_HINT_APPLE = $851F;
- GL_STORAGE_CACHED_APPLE = $85BE;
- GL_STORAGE_SHARED_APPLE = $85BF;
-var
- glVertexArrayRangeAPPLE: procedure(length: GLsizei; pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFlushVertexArrayRangeAPPLE: procedure(length: GLsizei; pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexArrayParameteriAPPLE: procedure(pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_APPLE_vertex_array_range: Boolean;
-
-{$IFDEF WINDOWS}
-//***** WGL_ARB_pixel_format *****//
-const
- WGL_NUMBER_PIXEL_FORMATS_ARB = $2000;
- WGL_DRAW_TO_WINDOW_ARB = $2001;
- WGL_DRAW_TO_BITMAP_ARB = $2002;
- WGL_ACCELERATION_ARB = $2003;
- WGL_NEED_PALETTE_ARB = $2004;
- WGL_NEED_SYSTEM_PALETTE_ARB = $2005;
- WGL_SWAP_LAYER_BUFFERS_ARB = $2006;
- WGL_SWAP_METHOD_ARB = $2007;
- WGL_NUMBER_OVERLAYS_ARB = $2008;
- WGL_NUMBER_UNDERLAYS_ARB = $2009;
- WGL_TRANSPARENT_ARB = $200A;
- WGL_TRANSPARENT_RED_VALUE_ARB = $2037;
- WGL_TRANSPARENT_GREEN_VALUE_ARB = $2038;
- WGL_TRANSPARENT_BLUE_VALUE_ARB = $2039;
- WGL_TRANSPARENT_ALPHA_VALUE_ARB = $203A;
- WGL_TRANSPARENT_INDEX_VALUE_ARB = $203B;
- WGL_SHARE_DEPTH_ARB = $200C;
- WGL_SHARE_STENCIL_ARB = $200D;
- WGL_SHARE_ACCUM_ARB = $200E;
- WGL_SUPPORT_GDI_ARB = $200F;
- WGL_SUPPORT_OPENGL_ARB = $2010;
- WGL_DOUBLE_BUFFER_ARB = $2011;
- WGL_STEREO_ARB = $2012;
- WGL_PIXEL_TYPE_ARB = $2013;
- WGL_COLOR_BITS_ARB = $2014;
- WGL_RED_BITS_ARB = $2015;
- WGL_RED_SHIFT_ARB = $2016;
- WGL_GREEN_BITS_ARB = $2017;
- WGL_GREEN_SHIFT_ARB = $2018;
- WGL_BLUE_BITS_ARB = $2019;
- WGL_BLUE_SHIFT_ARB = $201A;
- WGL_ALPHA_BITS_ARB = $201B;
- WGL_ALPHA_SHIFT_ARB = $201C;
- WGL_ACCUM_BITS_ARB = $201D;
- WGL_ACCUM_RED_BITS_ARB = $201E;
- WGL_ACCUM_GREEN_BITS_ARB = $201F;
- WGL_ACCUM_BLUE_BITS_ARB = $2020;
- WGL_ACCUM_ALPHA_BITS_ARB = $2021;
- WGL_DEPTH_BITS_ARB = $2022;
- WGL_STENCIL_BITS_ARB = $2023;
- WGL_AUX_BUFFERS_ARB = $2024;
- WGL_NO_ACCELERATION_ARB = $2025;
- WGL_GENERIC_ACCELERATION_ARB = $2026;
- WGL_FULL_ACCELERATION_ARB = $2027;
- WGL_SWAP_EXCHANGE_ARB = $2028;
- WGL_SWAP_COPY_ARB = $2029;
- WGL_SWAP_UNDEFINED_ARB = $202A;
- WGL_TYPE_RGBA_ARB = $202B;
- WGL_TYPE_COLORINDEX_ARB = $202C;
-var
- wglGetPixelFormatAttribivARB: function(hdc: HDC; iPixelFormat: GLint; iLayerPlane: GLint; nAttributes: GLuint; const piAttributes: PGLint; piValues: PGLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglGetPixelFormatAttribfvARB: function(hdc: HDC; iPixelFormat: GLint; iLayerPlane: GLint; nAttributes: GLuint; const piAttributes: PGLint; pfValues: PGLfloat): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglChoosePixelFormatARB: function(hdc: HDC; const piAttribIList: PGLint; const pfAttribFList: PGLfloat; nMaxFormats: GLuint; piFormats: PGLint; nNumFormats: PGLuint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_WGL_ARB_pixel_format: Boolean;
-
-//***** WGL_ARB_make_current_read *****//
-const
- WGL_ERROR_INVALID_PIXEL_TYPE_ARB = $2043;
- WGL_ERROR_INCOMPATIBLE_DEVICE_CONTEXTS_ARB = $2054;
-var
- wglMakeContextCurrentARB: function(hDrawDC: HDC; hReadDC: HDC; hglrc: HGLRC): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglGetCurrentReadDCARB: function(): HDC; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_WGL_ARB_make_current_read: Boolean;
-
-//***** WGL_ARB_pbuffer *****//
-const
- WGL_DRAW_TO_PBUFFER_ARB = $202D;
- // WGL_DRAW_TO_PBUFFER_ARB { already defined }
- WGL_MAX_PBUFFER_PIXELS_ARB = $202E;
- WGL_MAX_PBUFFER_WIDTH_ARB = $202F;
- WGL_MAX_PBUFFER_HEIGHT_ARB = $2030;
- WGL_PBUFFER_LARGEST_ARB = $2033;
- WGL_PBUFFER_WIDTH_ARB = $2034;
- WGL_PBUFFER_HEIGHT_ARB = $2035;
- WGL_PBUFFER_LOST_ARB = $2036;
-var
- wglCreatePbufferARB: function(hDC: HDC; iPixelFormat: GLint; iWidth: GLint; iHeight: GLint; const piAttribList: PGLint): THandle; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglGetPbufferDCARB: function(hPbuffer: THandle): HDC; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglReleasePbufferDCARB: function(hPbuffer: THandle; hDC: HDC): GLint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglDestroyPbufferARB: function(hPbuffer: THandle): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglQueryPbufferARB: function(hPbuffer: THandle; iAttribute: GLint; piValue: PGLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_WGL_ARB_pbuffer: Boolean;
-
-//***** WGL_EXT_swap_control *****//
-var
- wglSwapIntervalEXT: function(interval: GLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglGetSwapIntervalEXT: function(): GLint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_WGL_EXT_swap_control: Boolean;
-
-//***** WGL_ARB_render_texture *****//
-const
- WGL_BIND_TO_TEXTURE_RGB_ARB = $2070;
- WGL_BIND_TO_TEXTURE_RGBA_ARB = $2071;
- WGL_TEXTURE_FORMAT_ARB = $2072;
- WGL_TEXTURE_TARGET_ARB = $2073;
- WGL_MIPMAP_TEXTURE_ARB = $2074;
- WGL_TEXTURE_RGB_ARB = $2075;
- WGL_TEXTURE_RGBA_ARB = $2076;
- WGL_NO_TEXTURE_ARB = $2077;
- WGL_TEXTURE_CUBE_MAP_ARB = $2078;
- WGL_TEXTURE_1D_ARB = $2079;
- WGL_TEXTURE_2D_ARB = $207A;
- // WGL_NO_TEXTURE_ARB { already defined }
- WGL_MIPMAP_LEVEL_ARB = $207B;
- WGL_CUBE_MAP_FACE_ARB = $207C;
- WGL_TEXTURE_CUBE_MAP_POSITIVE_X_ARB = $207D;
- WGL_TEXTURE_CUBE_MAP_NEGATIVE_X_ARB = $207E;
- WGL_TEXTURE_CUBE_MAP_POSITIVE_Y_ARB = $207F;
- WGL_TEXTURE_CUBE_MAP_NEGATIVE_Y_ARB = $2080;
- WGL_TEXTURE_CUBE_MAP_POSITIVE_Z_ARB = $2081;
- WGL_TEXTURE_CUBE_MAP_NEGATIVE_Z_ARB = $2082;
- WGL_FRONT_LEFT_ARB = $2083;
- WGL_FRONT_RIGHT_ARB = $2084;
- WGL_BACK_LEFT_ARB = $2085;
- WGL_BACK_RIGHT_ARB = $2086;
- WGL_AUX0_ARB = $2087;
- WGL_AUX1_ARB = $2088;
- WGL_AUX2_ARB = $2089;
- WGL_AUX3_ARB = $208A;
- WGL_AUX4_ARB = $208B;
- WGL_AUX5_ARB = $208C;
- WGL_AUX6_ARB = $208D;
- WGL_AUX7_ARB = $208E;
- WGL_AUX8_ARB = $208F;
- WGL_AUX9_ARB = $2090;
-var
- wglBindTexImageARB: function(hPbuffer: THandle; iBuffer: GLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglReleaseTexImageARB: function(hPbuffer: THandle; iBuffer: GLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglSetPbufferAttribARB: function(hPbuffer: THandle; const piAttribList: PGLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_WGL_ARB_render_texture: Boolean;
-
-//***** WGL_EXT_extensions_string *****//
-var
- wglGetExtensionsStringEXT: function(): Pchar; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_WGL_EXT_extensions_string: Boolean;
-
-//***** WGL_EXT_make_current_read *****//
-var
- wglMakeContextCurrentEXT: function(hDrawDC: HDC; hReadDC: HDC; hglrc: HGLRC): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglGetCurrentReadDCEXT: function(): HDC; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_WGL_EXT_make_current_read: Boolean;
-
-//***** WGL_EXT_pbuffer *****//
-const
- WGL_DRAW_TO_PBUFFER_EXT = $202D;
- WGL_MAX_PBUFFER_PIXELS_EXT = $202E;
- WGL_MAX_PBUFFER_WIDTH_EXT = $202F;
- WGL_MAX_PBUFFER_HEIGHT_EXT = $2030;
- WGL_OPTIMAL_PBUFFER_WIDTH_EXT = $2031;
- WGL_OPTIMAL_PBUFFER_HEIGHT_EXT = $2032;
- WGL_PBUFFER_LARGEST_EXT = $2033;
- WGL_PBUFFER_WIDTH_EXT = $2034;
- WGL_PBUFFER_HEIGHT_EXT = $2035;
-var
- wglCreatePbufferEXT: function(hDC: HDC; iPixelFormat: GLint; iWidth: GLint; iHeight: GLint; const piAttribList: PGLint): THandle; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglGetPbufferDCEXT: function(hPbuffer: THandle): HDC; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglReleasePbufferDCEXT: function(hPbuffer: THandle; hDC: HDC): GLint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglDestroyPbufferEXT: function(hPbuffer: THandle): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglQueryPbufferEXT: function(hPbuffer: THandle; iAttribute: GLint; piValue: PGLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_WGL_EXT_pbuffer: Boolean;
-
-//***** WGL_EXT_pixel_format *****//
-const
- WGL_NUMBER_PIXEL_FORMATS_EXT = $2000;
- WGL_DRAW_TO_WINDOW_EXT = $2001;
- WGL_DRAW_TO_BITMAP_EXT = $2002;
- WGL_ACCELERATION_EXT = $2003;
- WGL_NEED_PALETTE_EXT = $2004;
- WGL_NEED_SYSTEM_PALETTE_EXT = $2005;
- WGL_SWAP_LAYER_BUFFERS_EXT = $2006;
- WGL_SWAP_METHOD_EXT = $2007;
- WGL_NUMBER_OVERLAYS_EXT = $2008;
- WGL_NUMBER_UNDERLAYS_EXT = $2009;
- WGL_TRANSPARENT_EXT = $200A;
- WGL_TRANSPARENT_VALUE_EXT = $200B;
- WGL_SHARE_DEPTH_EXT = $200C;
- WGL_SHARE_STENCIL_EXT = $200D;
- WGL_SHARE_ACCUM_EXT = $200E;
- WGL_SUPPORT_GDI_EXT = $200F;
- WGL_SUPPORT_OPENGL_EXT = $2010;
- WGL_DOUBLE_BUFFER_EXT = $2011;
- WGL_STEREO_EXT = $2012;
- WGL_PIXEL_TYPE_EXT = $2013;
- WGL_COLOR_BITS_EXT = $2014;
- WGL_RED_BITS_EXT = $2015;
- WGL_RED_SHIFT_EXT = $2016;
- WGL_GREEN_BITS_EXT = $2017;
- WGL_GREEN_SHIFT_EXT = $2018;
- WGL_BLUE_BITS_EXT = $2019;
- WGL_BLUE_SHIFT_EXT = $201A;
- WGL_ALPHA_BITS_EXT = $201B;
- WGL_ALPHA_SHIFT_EXT = $201C;
- WGL_ACCUM_BITS_EXT = $201D;
- WGL_ACCUM_RED_BITS_EXT = $201E;
- WGL_ACCUM_GREEN_BITS_EXT = $201F;
- WGL_ACCUM_BLUE_BITS_EXT = $2020;
- WGL_ACCUM_ALPHA_BITS_EXT = $2021;
- WGL_DEPTH_BITS_EXT = $2022;
- WGL_STENCIL_BITS_EXT = $2023;
- WGL_AUX_BUFFERS_EXT = $2024;
- WGL_NO_ACCELERATION_EXT = $2025;
- WGL_GENERIC_ACCELERATION_EXT = $2026;
- WGL_FULL_ACCELERATION_EXT = $2027;
- WGL_SWAP_EXCHANGE_EXT = $2028;
- WGL_SWAP_COPY_EXT = $2029;
- WGL_SWAP_UNDEFINED_EXT = $202A;
- WGL_TYPE_RGBA_EXT = $202B;
- WGL_TYPE_COLORINDEX_EXT = $202C;
-var
- wglGetPixelFormatAttribivEXT: function(hdc: HDC; iPixelFormat: GLint; iLayerPlane: GLint; nAttributes: GLuint; piAttributes: PGLint; piValues: PGLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglGetPixelFormatAttribfvEXT: function(hdc: HDC; iPixelFormat: GLint; iLayerPlane: GLint; nAttributes: GLuint; piAttributes: PGLint; pfValues: PGLfloat): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglChoosePixelFormatEXT: function(hdc: HDC; const piAttribIList: PGLint; const pfAttribFList: PGLfloat; nMaxFormats: GLuint; piFormats: PGLint; nNumFormats: PGLuint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_WGL_EXT_pixel_format: Boolean;
-
-//***** WGL_I3D_digital_video_control *****//
-const
- WGL_DIGITAL_VIDEO_CURSOR_ALPHA_FRAMEBUFFER_I3D = $2050;
- WGL_DIGITAL_VIDEO_CURSOR_ALPHA_VALUE_I3D = $2051;
- WGL_DIGITAL_VIDEO_CURSOR_INCLUDED_I3D = $2052;
- WGL_DIGITAL_VIDEO_GAMMA_CORRECTED_I3D = $2053;
-var
- wglGetDigitalVideoParametersI3D: function(hDC: HDC; iAttribute: GLint; piValue: PGLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglSetDigitalVideoParametersI3D: function(hDC: HDC; iAttribute: GLint; const piValue: PGLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_WGL_I3D_digital_video_control: Boolean;
-
-//***** WGL_I3D_gamma *****//
-const
- WGL_GAMMA_TABLE_SIZE_I3D = $204E;
- WGL_GAMMA_EXCLUDE_DESKTOP_I3D = $204F;
- // WGL_GAMMA_EXCLUDE_DESKTOP_I3D { already defined }
-var
- wglGetGammaTableParametersI3D: function(hDC: HDC; iAttribute: GLint; piValue: PGLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglSetGammaTableParametersI3D: function(hDC: HDC; iAttribute: GLint; const piValue: PGLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglGetGammaTableI3D: function(hDC: HDC; iEntries: GLint; puRed: PGLUSHORT; puGreen: PGLUSHORT; puBlue: PGLUSHORT): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglSetGammaTableI3D: function(hDC: HDC; iEntries: GLint; const puRed: PGLUSHORT; const puGreen: PGLUSHORT; const puBlue: PGLUSHORT): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_WGL_I3D_gamma: Boolean;
-
-//***** WGL_I3D_genlock *****//
-const
- WGL_GENLOCK_SOURCE_MULTIVIEW_I3D = $2044;
- WGL_GENLOCK_SOURCE_EXTERNAL_SYNC_I3D = $2045;
- WGL_GENLOCK_SOURCE_EXTERNAL_FIELD_I3D = $2046;
- WGL_GENLOCK_SOURCE_EXTERNAL_TTL_I3D = $2047;
- WGL_GENLOCK_SOURCE_DIGITAL_SYNC_I3D = $2048;
- WGL_GENLOCK_SOURCE_DIGITAL_FIELD_I3D = $2049;
- WGL_GENLOCK_SOURCE_EDGE_FALLING_I3D = $204A;
- WGL_GENLOCK_SOURCE_EDGE_RISING_I3D = $204B;
- WGL_GENLOCK_SOURCE_EDGE_BOTH_I3D = $204C;
-var
- wglEnableGenlockI3D: function(hDC: HDC): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglDisableGenlockI3D: function(hDC: HDC): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglIsEnabledGenlockI3D: function(hDC: HDC; pFlag: PBOOL): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglGenlockSourceI3D: function(hDC: HDC; uSource: GLUINT): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglGetGenlockSourceI3D: function(hDC: HDC; uSource: PGLUINT): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglGenlockSourceEdgeI3D: function(hDC: HDC; uEdge: GLUINT): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglGetGenlockSourceEdgeI3D: function(hDC: HDC; uEdge: PGLUINT): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglGenlockSampleRateI3D: function(hDC: HDC; uRate: GLUINT): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglGetGenlockSampleRateI3D: function(hDC: HDC; uRate: PGLUINT): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglGenlockSourceDelayI3D: function(hDC: HDC; uDelay: GLUINT): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglGetGenlockSourceDelayI3D: function(hDC: HDC; uDelay: PGLUINT): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- wglQueryGenlockMaxSourceDelayI3D: function(hDC: HDC; uMaxLineDelay: PGLUINT; uMaxPixelDelay: PGLUINT): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_WGL_I3D_genlock: Boolean;
-{$ENDIF}
-
-//***** GL_ARB_matrix_palette *****//
-const
- GL_MATRIX_PALETTE_ARB = $8840;
- GL_MAX_MATRIX_PALETTE_STACK_DEPTH_ARB = $8841;
- GL_MAX_PALETTE_MATRICES_ARB = $8842;
- GL_CURRENT_PALETTE_MATRIX_ARB = $8843;
- GL_MATRIX_INDEX_ARRAY_ARB = $8844;
- GL_CURRENT_MATRIX_INDEX_ARB = $8845;
- GL_MATRIX_INDEX_ARRAY_SIZE_ARB = $8846;
- GL_MATRIX_INDEX_ARRAY_TYPE_ARB = $8847;
- GL_MATRIX_INDEX_ARRAY_STRIDE_ARB = $8848;
- GL_MATRIX_INDEX_ARRAY_POINTER_ARB = $8849;
-var
- glCurrentPaletteMatrixARB: procedure(index: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMatrixIndexubvARB: procedure(size: GLint; indices: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMatrixIndexusvARB: procedure(size: GLint; indices: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMatrixIndexuivARB: procedure(size: GLint; indices: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMatrixIndexPointerARB: procedure(size: GLint; _type: GLenum; stride: GLsizei; pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_ARB_matrix_palette: Boolean;
-
-//***** GL_NV_element_array *****//
-const
- GL_ELEMENT_ARRAY_TYPE_NV = $8769;
- GL_ELEMENT_ARRAY_POINTER_NV = $876A;
-var
- glElementPointerNV: procedure(_type: GLenum; const pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDrawElementArrayNV: procedure(mode: GLenum; first: GLint; count: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDrawRangeElementArrayNV: procedure(mode: GLenum; start: GLuint; _end: GLuint; first: GLint; count: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiDrawElementArrayNV: procedure(mode: GLenum; const first: PGLint; const count: PGLsizei; primcount: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiDrawRangeElementArrayNV: procedure(mode: GLenum; start: GLuint; _end: GLuint; const first: PGLint; const count: PGLsizei; primcount: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_NV_element_array: Boolean;
-
-//***** GL_NV_float_buffer *****//
-const
- GL_FLOAT_R_NV = $8880;
- GL_FLOAT_RG_NV = $8881;
- GL_FLOAT_RGB_NV = $8882;
- GL_FLOAT_RGBA_NV = $8883;
- GL_FLOAT_R16_NV = $8884;
- GL_FLOAT_R32_NV = $8885;
- GL_FLOAT_RG16_NV = $8886;
- GL_FLOAT_RG32_NV = $8887;
- GL_FLOAT_RGB16_NV = $8888;
- GL_FLOAT_RGB32_NV = $8889;
- GL_FLOAT_RGBA16_NV = $888A;
- GL_FLOAT_RGBA32_NV = $888B;
- GL_TEXTURE_FLOAT_COMPONENTS_NV = $888C;
- GL_FLOAT_CLEAR_COLOR_VALUE_NV = $888D;
- GL_FLOAT_RGBA_MODE_NV = $888E;
-{$IFDEF WINDOWS}
- WGL_FLOAT_COMPONENTS_NV = $20B0;
- WGL_BIND_TO_TEXTURE_RECTANGLE_FLOAT_R_NV = $20B1;
- WGL_BIND_TO_TEXTURE_RECTANGLE_FLOAT_RG_NV = $20B2;
- WGL_BIND_TO_TEXTURE_RECTANGLE_FLOAT_RGB_NV = $20B3;
- WGL_BIND_TO_TEXTURE_RECTANGLE_FLOAT_RGBA_NV = $20B4;
- WGL_TEXTURE_FLOAT_R_NV = $20B5;
- WGL_TEXTURE_FLOAT_RG_NV = $20B6;
- WGL_TEXTURE_FLOAT_RGB_NV = $20B7;
- WGL_TEXTURE_FLOAT_RGBA_NV = $20B8;
-{$ENDIF}
-
-function Load_GL_NV_float_buffer: Boolean;
-
-//***** GL_NV_fragment_program *****//
-const
- GL_FRAGMENT_PROGRAM_NV = $8870;
- GL_MAX_TEXTURE_COORDS_NV = $8871;
- GL_MAX_TEXTURE_IMAGE_UNITS_NV = $8872;
- GL_FRAGMENT_PROGRAM_BINDING_NV = $8873;
- GL_MAX_FRAGMENT_PROGRAM_LOCAL_PARAMETERS_NV = $8868;
- GL_PROGRAM_ERROR_STRING_NV = $8874;
-var
- glProgramNamedParameter4fNV: procedure(id: GLuint; len: GLsizei; const name: PGLubyte; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glProgramNamedParameter4dNV: procedure(id: GLuint; len: GLsizei; const name: PGLubyte; x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetProgramNamedParameterfvNV: procedure(id: GLuint; len: GLsizei; const name: PGLubyte; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetProgramNamedParameterdvNV: procedure(id: GLuint; len: GLsizei; const name: PGLubyte; params: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- // glProgramLocalParameter4dARB { already defined }
- // glProgramLocalParameter4dvARB { already defined }
- // glProgramLocalParameter4fARB { already defined }
- // glProgramLocalParameter4fvARB { already defined }
- // glGetProgramLocalParameterdvARB { already defined }
- // glGetProgramLocalParameterfvARB { already defined }
-
-function Load_GL_NV_fragment_program: Boolean;
-
-//***** GL_NV_primitive_restart *****//
-const
- GL_PRIMITIVE_RESTART_NV = $8558;
- GL_PRIMITIVE_RESTART_INDEX_NV = $8559;
-var
- glPrimitiveRestartNV: procedure(); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPrimitiveRestartIndexNV: procedure(index: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_NV_primitive_restart: Boolean;
-
-//***** GL_NV_vertex_program2 *****//
-
-function Load_GL_NV_vertex_program2: Boolean;
-
-{$IFDEF WINDOWS}
-//***** WGL_NV_render_texture_rectangle *****//
-const
- WGL_BIND_TO_TEXTURE_RECTANGLE_RGB_NV = $20A0;
- WGL_BIND_TO_TEXTURE_RECTANGLE_RGBA_NV = $20A1;
- WGL_TEXTURE_RECTANGLE_NV = $20A2;
-
-function Load_WGL_NV_render_texture_rectangle: Boolean;
-{$ENDIF}
-
-//***** GL_NV_pixel_data_range *****//
-const
- GL_WRITE_PIXEL_DATA_RANGE_NV = $8878;
- GL_READ_PIXEL_DATA_RANGE_NV = $8879;
- GL_WRITE_PIXEL_DATA_RANGE_LENGTH_NV = $887A;
- GL_READ_PIXEL_DATA_RANGE_LENGTH_NV = $887B;
- GL_WRITE_PIXEL_DATA_RANGE_POINTER_NV = $887C;
- GL_READ_PIXEL_DATA_RANGE_POINTER_NV = $887D;
-var
- glPixelDataRangeNV: procedure(target: GLenum; length: GLsizei; pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFlushPixelDataRangeNV: procedure(target: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- // wglAllocateMemoryNV { already defined }
- // wglFreeMemoryNV { already defined }
-
-function Load_GL_NV_pixel_data_range: Boolean;
-
-//***** GL_EXT_texture_rectangle *****//
-const
- GL_TEXTURE_RECTANGLE_EXT = $84F5;
- GL_TEXTURE_BINDING_RECTANGLE_EXT = $84F6;
- GL_PROXY_TEXTURE_RECTANGLE_EXT = $84F7;
- GL_MAX_RECTANGLE_TEXTURE_SIZE_EXT = $84F8;
-
-function Load_GL_EXT_texture_rectangle: Boolean;
-
-//***** GL_S3_s3tc *****//
-const
- GL_RGB_S3TC = $83A0;
- GL_RGB4_S3TC = $83A1;
- GL_RGBA_S3TC = $83A2;
- GL_RGBA4_S3TC = $83A3;
-
-function Load_GL_S3_s3tc: Boolean;
-
-//***** GL_ATI_draw_buffers *****//
-const
- GL_MAX_DRAW_BUFFERS_ATI = $8824;
- GL_DRAW_BUFFER0_ATI = $8825;
- GL_DRAW_BUFFER1_ATI = $8826;
- GL_DRAW_BUFFER2_ATI = $8827;
- GL_DRAW_BUFFER3_ATI = $8828;
- GL_DRAW_BUFFER4_ATI = $8829;
- GL_DRAW_BUFFER5_ATI = $882A;
- GL_DRAW_BUFFER6_ATI = $882B;
- GL_DRAW_BUFFER7_ATI = $882C;
- GL_DRAW_BUFFER8_ATI = $882D;
- GL_DRAW_BUFFER9_ATI = $882E;
- GL_DRAW_BUFFER10_ATI = $882F;
- GL_DRAW_BUFFER11_ATI = $8830;
- GL_DRAW_BUFFER12_ATI = $8831;
- GL_DRAW_BUFFER13_ATI = $8832;
- GL_DRAW_BUFFER14_ATI = $8833;
- GL_DRAW_BUFFER15_ATI = $8834;
-var
- glDrawBuffersATI: procedure(n: GLsizei; const bufs: PGLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_ATI_draw_buffers: Boolean;
-
-{$IFDEF WINDOWS}
-//***** WGL_ATI_pixel_format_float *****//
-const
- WGL_RGBA_FLOAT_MODE_ATI = $8820;
- WGL_COLOR_CLEAR_UNCLAMPED_VALUE_ATI = $8835;
- WGL_TYPE_RGBA_FLOAT_ATI = $21A0;
-
-function Load_WGL_ATI_pixel_format_float: Boolean;
-{$ENDIF}
-
-//***** GL_ATI_texture_env_combine3 *****//
-const
- GL_MODULATE_ADD_ATI = $8744;
- GL_MODULATE_SIGNED_ADD_ATI = $8745;
- GL_MODULATE_SUBTRACT_ATI = $8746;
-
-function Load_GL_ATI_texture_env_combine3: Boolean;
-
-//***** GL_ATI_texture_float *****//
-const
- GL_RGBA_FLOAT32_ATI = $8814;
- GL_RGB_FLOAT32_ATI = $8815;
- GL_ALPHA_FLOAT32_ATI = $8816;
- GL_INTENSITY_FLOAT32_ATI = $8817;
- GL_LUMINANCE_FLOAT32_ATI = $8818;
- GL_LUMINANCE_ALPHA_FLOAT32_ATI = $8819;
- GL_RGBA_FLOAT16_ATI = $881A;
- GL_RGB_FLOAT16_ATI = $881B;
- GL_ALPHA_FLOAT16_ATI = $881C;
- GL_INTENSITY_FLOAT16_ATI = $881D;
- GL_LUMINANCE_FLOAT16_ATI = $881E;
- GL_LUMINANCE_ALPHA_FLOAT16_ATI = $881F;
-
-function Load_GL_ATI_texture_float: Boolean;
-
-//***** GL_NV_texture_expand_normal *****//
-const
- GL_TEXTURE_UNSIGNED_REMAP_MODE_NV = $888F;
-
-function Load_GL_NV_texture_expand_normal: Boolean;
-
-//***** GL_NV_half_float *****//
-const
- GL_HALF_FLOAT_NV = $140B;
-var
- glVertex2hNV: procedure(x: GLushort; y: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex2hvNV: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex3hNV: procedure(x: GLushort; y: GLushort; z: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex3hvNV: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex4hNV: procedure(x: GLushort; y: GLushort; z: GLushort; w: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertex4hvNV: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNormal3hNV: procedure(nx: GLushort; ny: GLushort; nz: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glNormal3hvNV: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor3hNV: procedure(red: GLushort; green: GLushort; blue: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor3hvNV: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor4hNV: procedure(red: GLushort; green: GLushort; blue: GLushort; alpha: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glColor4hvNV: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord1hNV: procedure(s: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord1hvNV: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord2hNV: procedure(s: GLushort; t: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord2hvNV: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord3hNV: procedure(s: GLushort; t: GLushort; r: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord3hvNV: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord4hNV: procedure(s: GLushort; t: GLushort; r: GLushort; q: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glTexCoord4hvNV: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord1hNV: procedure(target: GLenum; s: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord1hvNV: procedure(target: GLenum; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord2hNV: procedure(target: GLenum; s: GLushort; t: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord2hvNV: procedure(target: GLenum; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord3hNV: procedure(target: GLenum; s: GLushort; t: GLushort; r: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord3hvNV: procedure(target: GLenum; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord4hNV: procedure(target: GLenum; s: GLushort; t: GLushort; r: GLushort; q: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiTexCoord4hvNV: procedure(target: GLenum; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFogCoordhNV: procedure(fog: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFogCoordhvNV: procedure(const fog: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3hNV: procedure(red: GLushort; green: GLushort; blue: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3hvNV: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexWeighthNV: procedure(weight: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexWeighthvNV: procedure(const weight: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib1hNV: procedure(index: GLuint; x: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib1hvNV: procedure(index: GLuint; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib2hNV: procedure(index: GLuint; x: GLushort; y: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib2hvNV: procedure(index: GLuint; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib3hNV: procedure(index: GLuint; x: GLushort; y: GLushort; z: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib3hvNV: procedure(index: GLuint; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4hNV: procedure(index: GLuint; x: GLushort; y: GLushort; z: GLushort; w: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4hvNV: procedure(index: GLuint; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttribs1hvNV: procedure(index: GLuint; n: GLsizei; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttribs2hvNV: procedure(index: GLuint; n: GLsizei; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttribs3hvNV: procedure(index: GLuint; n: GLsizei; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttribs4hvNV: procedure(index: GLuint; n: GLsizei; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_NV_half_float: Boolean;
-
-//***** GL_ATI_map_object_buffer *****//
-var
- glMapObjectBufferATI: function(buffer: GLuint): PGLvoid; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUnmapObjectBufferATI: procedure(buffer: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_ATI_map_object_buffer: Boolean;
-
-//***** GL_ATI_separate_stencil *****//
-const
- GL_KEEP = $1E00;
- GL_ZERO = $0000;
- GL_REPLACE = $1E01;
- GL_INCR = $1E02;
- GL_DECR = $1E03;
- GL_INVERT = $150A;
- GL_NEVER = $0200;
- GL_LESS = $0201;
- GL_LEQUAL = $0203;
- GL_GREATER = $0204;
- GL_GEQUAL = $0206;
- GL_EQUAL = $0202;
- GL_NOTEQUAL = $0205;
- GL_ALWAYS = $0207;
- GL_FRONT = $0404;
- GL_BACK = $0405;
- GL_FRONT_AND_BACK = $0408;
- GL_STENCIL_BACK_FUNC_ATI = $8800;
- GL_STENCIL_BACK_FAIL_ATI = $8801;
- GL_STENCIL_BACK_PASS_DEPTH_FAIL_ATI = $8802;
- GL_STENCIL_BACK_PASS_DEPTH_PASS_ATI = $8803;
-var
- glStencilOpSeparateATI: procedure(face: GLenum; sfail: GLenum; dpfail: GLenum; dppass: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glStencilFuncSeparateATI: procedure(frontfunc: GLenum; backfunc: GLenum; ref: GLint; mask: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_ATI_separate_stencil: Boolean;
-
-//***** GL_ATI_vertex_attrib_array_object *****//
-var
- glVertexAttribArrayObjectATI: procedure(index: GLuint; size: GLint; _type: GLenum; normalized: GLboolean; stride: GLsizei; buffer: GLuint; offset: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetVertexAttribArrayObjectfvATI: procedure(index: GLuint; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetVertexAttribArrayObjectivATI: procedure(index: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_ATI_vertex_attrib_array_object: Boolean;
-
-//***** GL_ARB_vertex_buffer_object *****//
-const
- GL_ARRAY_BUFFER_ARB = $8892;
- GL_ELEMENT_ARRAY_BUFFER_ARB = $8893;
- GL_ARRAY_BUFFER_BINDING_ARB = $8894;
- GL_ELEMENT_ARRAY_BUFFER_BINDING_ARB = $8895;
- GL_VERTEX_ARRAY_BUFFER_BINDING_ARB = $8896;
- GL_NORMAL_ARRAY_BUFFER_BINDING_ARB = $8897;
- GL_COLOR_ARRAY_BUFFER_BINDING_ARB = $8898;
- GL_INDEX_ARRAY_BUFFER_BINDING_ARB = $8899;
- GL_TEXTURE_COORD_ARRAY_BUFFER_BINDING_ARB = $889A;
- GL_EDGE_FLAG_ARRAY_BUFFER_BINDING_ARB = $889B;
- GL_SECONDARY_COLOR_ARRAY_BUFFER_BINDING_ARB = $889C;
- GL_FOG_COORDINATE_ARRAY_BUFFER_BINDING_ARB = $889D;
- GL_WEIGHT_ARRAY_BUFFER_BINDING_ARB = $889E;
- GL_VERTEX_ATTRIB_ARRAY_BUFFER_BINDING_ARB = $889F;
- GL_STREAM_DRAW_ARB = $88E0;
- GL_STREAM_READ_ARB = $88E1;
- GL_STREAM_COPY_ARB = $88E2;
- GL_STATIC_DRAW_ARB = $88E4;
- GL_STATIC_READ_ARB = $88E5;
- GL_STATIC_COPY_ARB = $88E6;
- GL_DYNAMIC_DRAW_ARB = $88E8;
- GL_DYNAMIC_READ_ARB = $88E9;
- GL_DYNAMIC_COPY_ARB = $88EA;
- GL_READ_ONLY_ARB = $88B8;
- GL_WRITE_ONLY_ARB = $88B9;
- GL_READ_WRITE_ARB = $88BA;
- GL_BUFFER_SIZE_ARB = $8764;
- GL_BUFFER_USAGE_ARB = $8765;
- GL_BUFFER_ACCESS_ARB = $88BB;
- GL_BUFFER_MAPPED_ARB = $88BC;
- GL_BUFFER_MAP_POINTER_ARB = $88BD;
-var
- glBindBufferARB: procedure(target: GLenum; buffer: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDeleteBuffersARB: procedure(n: GLsizei; const buffers: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGenBuffersARB: procedure(n: GLsizei; buffers: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIsBufferARB: function(buffer: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glBufferDataARB: procedure(target: GLenum; size: GLsizeiptrARB; const data: PGLvoid; usage: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glBufferSubDataARB: procedure(target: GLenum; offset: GLintptrARB; size: GLsizeiptrARB; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetBufferSubDataARB: procedure(target: GLenum; offset: GLintptrARB; size: GLsizeiptrARB; data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMapBufferARB: function(target: GLenum; access: GLenum): PGLvoid; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUnmapBufferARB: function(target: GLenum): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetBufferParameterivARB: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetBufferPointervARB: procedure(target: GLenum; pname: GLenum; params: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_ARB_vertex_buffer_object: Boolean;
-
-//***** GL_ARB_occlusion_query *****//
-const
- GL_SAMPLES_PASSED_ARB = $8914;
- GL_QUERY_COUNTER_BITS_ARB = $8864;
- GL_CURRENT_QUERY_ARB = $8865;
- GL_QUERY_RESULT_ARB = $8866;
- GL_QUERY_RESULT_AVAILABLE_ARB = $8867;
-var
- glGenQueriesARB: procedure(n: GLsizei; ids: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDeleteQueriesARB: procedure(n: GLsizei; const ids: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIsQueryARB: function(id: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glBeginQueryARB: procedure(target: GLenum; id: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEndQueryARB: procedure(target: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetQueryivARB: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetQueryObjectivARB: procedure(id: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetQueryObjectuivARB: procedure(id: GLuint; pname: GLenum; params: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_ARB_occlusion_query: Boolean;
-
-//***** GL_ARB_shader_objects *****//
-const
- GL_PROGRAM_OBJECT_ARB = $8B40;
- GL_OBJECT_TYPE_ARB = $8B4E;
- GL_OBJECT_SUBTYPE_ARB = $8B4F;
- GL_OBJECT_DELETE_STATUS_ARB = $8B80;
- GL_OBJECT_COMPILE_STATUS_ARB = $8B81;
- GL_OBJECT_LINK_STATUS_ARB = $8B82;
- GL_OBJECT_VALIDATE_STATUS_ARB = $8B83;
- GL_OBJECT_INFO_LOG_LENGTH_ARB = $8B84;
- GL_OBJECT_ATTACHED_OBJECTS_ARB = $8B85;
- GL_OBJECT_ACTIVE_UNIFORMS_ARB = $8B86;
- GL_OBJECT_ACTIVE_UNIFORM_MAX_LENGTH_ARB = $8B87;
- GL_OBJECT_SHADER_SOURCE_LENGTH_ARB = $8B88;
- GL_SHADER_OBJECT_ARB = $8B48;
- GL_FLOAT = $1406;
- GL_FLOAT_VEC2_ARB = $8B50;
- GL_FLOAT_VEC3_ARB = $8B51;
- GL_FLOAT_VEC4_ARB = $8B52;
- GL_INT = $1404;
- GL_INT_VEC2_ARB = $8B53;
- GL_INT_VEC3_ARB = $8B54;
- GL_INT_VEC4_ARB = $8B55;
- GL_BOOL_ARB = $8B56;
- GL_BOOL_VEC2_ARB = $8B57;
- GL_BOOL_VEC3_ARB = $8B58;
- GL_BOOL_VEC4_ARB = $8B59;
- GL_FLOAT_MAT2_ARB = $8B5A;
- GL_FLOAT_MAT3_ARB = $8B5B;
- GL_FLOAT_MAT4_ARB = $8B5C;
-var
- glDeleteObjectARB: procedure(obj: GLhandleARB); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetHandleARB: function(pname: GLenum): GLhandleARB; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDetachObjectARB: procedure(containerObj: GLhandleARB; attachedObj: GLhandleARB); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCreateShaderObjectARB: function(shaderType: GLenum): GLhandleARB; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glShaderSourceARB: procedure(shaderObj: GLhandleARB; count: GLsizei; const _string: PGLvoid; const length: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCompileShaderARB: procedure(shaderObj: GLhandleARB); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCreateProgramObjectARB: function(): GLhandleARB; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glAttachObjectARB: procedure(containerObj: GLhandleARB; obj: GLhandleARB); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glLinkProgramARB: procedure(programObj: GLhandleARB); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUseProgramObjectARB: procedure(programObj: GLhandleARB); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glValidateProgramARB: procedure(programObj: GLhandleARB); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform1fARB: procedure(location: GLint; v0: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform2fARB: procedure(location: GLint; v0: GLfloat; v1: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform3fARB: procedure(location: GLint; v0: GLfloat; v1: GLfloat; v2: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform4fARB: procedure(location: GLint; v0: GLfloat; v1: GLfloat; v2: GLfloat; v3: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform1iARB: procedure(location: GLint; v0: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform2iARB: procedure(location: GLint; v0: GLint; v1: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform3iARB: procedure(location: GLint; v0: GLint; v1: GLint; v2: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform4iARB: procedure(location: GLint; v0: GLint; v1: GLint; v2: GLint; v3: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform1fvARB: procedure(location: GLint; count: GLsizei; value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform2fvARB: procedure(location: GLint; count: GLsizei; value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform3fvARB: procedure(location: GLint; count: GLsizei; value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform4fvARB: procedure(location: GLint; count: GLsizei; value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform1ivARB: procedure(location: GLint; count: GLsizei; value: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform2ivARB: procedure(location: GLint; count: GLsizei; value: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform3ivARB: procedure(location: GLint; count: GLsizei; value: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform4ivARB: procedure(location: GLint; count: GLsizei; value: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniformMatrix2fvARB: procedure(location: GLint; count: GLsizei; transpose: GLboolean; value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniformMatrix3fvARB: procedure(location: GLint; count: GLsizei; transpose: GLboolean; value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniformMatrix4fvARB: procedure(location: GLint; count: GLsizei; transpose: GLboolean; value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetObjectParameterfvARB: procedure(obj: GLhandleARB; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetObjectParameterivARB: procedure(obj: GLhandleARB; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetInfoLogARB: procedure(obj: GLhandleARB; maxLength: GLsizei; length: PGLsizei; infoLog: PGLcharARB); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetAttachedObjectsARB: procedure(containerObj: GLhandleARB; maxCount: GLsizei; count: PGLsizei; obj: PGLhandleARB); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetUniformLocationARB: function(programObj: GLhandleARB; const name: PGLcharARB): GLint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetActiveUniformARB: procedure(programObj: GLhandleARB; index: GLuint; maxLength: GLsizei; length: PGLsizei; size: PGLint; _type: PGLenum; name: PGLcharARB); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetUniformfvARB: procedure(programObj: GLhandleARB; location: GLint; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetUniformivARB: procedure(programObj: GLhandleARB; location: GLint; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetShaderSourceARB: procedure(obj: GLhandleARB; maxLength: GLsizei; length: PGLsizei; source: PGLcharARB); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_ARB_shader_objects: Boolean;
-
-//***** GL_ARB_vertex_shader *****//
-const
- GL_VERTEX_SHADER_ARB = $8B31;
- GL_MAX_VERTEX_UNIFORM_COMPONENTS_ARB = $8B4A;
- GL_MAX_VARYING_FLOATS_ARB = $8B4B;
- // GL_MAX_VERTEX_ATTRIBS_ARB { already defined }
- // GL_MAX_TEXTURE_IMAGE_UNITS_ARB { already defined }
- GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS_ARB = $8B4C;
- GL_MAX_COMBINED_TEXTURE_IMAGE_UNITS_ARB = $8B4D;
- // GL_MAX_TEXTURE_COORDS_ARB { already defined }
- // GL_VERTEX_PROGRAM_POINT_SIZE_ARB { already defined }
- // GL_VERTEX_PROGRAM_TWO_SIDE_ARB { already defined }
- // GL_OBJECT_TYPE_ARB { already defined }
- // GL_OBJECT_SUBTYPE_ARB { already defined }
- GL_OBJECT_ACTIVE_ATTRIBUTES_ARB = $8B89;
- GL_OBJECT_ACTIVE_ATTRIBUTE_MAX_LENGTH_ARB = $8B8A;
- // GL_SHADER_OBJECT_ARB { already defined }
- // GL_VERTEX_ATTRIB_ARRAY_ENABLED_ARB { already defined }
- // GL_VERTEX_ATTRIB_ARRAY_SIZE_ARB { already defined }
- // GL_VERTEX_ATTRIB_ARRAY_STRIDE_ARB { already defined }
- // GL_VERTEX_ATTRIB_ARRAY_TYPE_ARB { already defined }
- // GL_VERTEX_ATTRIB_ARRAY_NORMALIZED_ARB { already defined }
- // GL_CURRENT_VERTEX_ATTRIB_ARB { already defined }
- // GL_VERTEX_ATTRIB_ARRAY_POINTER_ARB { already defined }
- // GL_FLOAT { already defined }
- // GL_FLOAT_VEC2_ARB { already defined }
- // GL_FLOAT_VEC3_ARB { already defined }
- // GL_FLOAT_VEC4_ARB { already defined }
- // GL_FLOAT_MAT2_ARB { already defined }
- // GL_FLOAT_MAT3_ARB { already defined }
- // GL_FLOAT_MAT4_ARB { already defined }
- // glVertexAttrib1fARB { already defined }
- // glVertexAttrib1sARB { already defined }
- // glVertexAttrib1dARB { already defined }
- // glVertexAttrib2fARB { already defined }
- // glVertexAttrib2sARB { already defined }
- // glVertexAttrib2dARB { already defined }
- // glVertexAttrib3fARB { already defined }
- // glVertexAttrib3sARB { already defined }
- // glVertexAttrib3dARB { already defined }
- // glVertexAttrib4fARB { already defined }
- // glVertexAttrib4sARB { already defined }
- // glVertexAttrib4dARB { already defined }
- // glVertexAttrib4NubARB { already defined }
- // glVertexAttrib1fvARB { already defined }
- // glVertexAttrib1svARB { already defined }
- // glVertexAttrib1dvARB { already defined }
- // glVertexAttrib2fvARB { already defined }
- // glVertexAttrib2svARB { already defined }
- // glVertexAttrib2dvARB { already defined }
- // glVertexAttrib3fvARB { already defined }
- // glVertexAttrib3svARB { already defined }
- // glVertexAttrib3dvARB { already defined }
- // glVertexAttrib4fvARB { already defined }
- // glVertexAttrib4svARB { already defined }
- // glVertexAttrib4dvARB { already defined }
- // glVertexAttrib4ivARB { already defined }
- // glVertexAttrib4bvARB { already defined }
- // glVertexAttrib4ubvARB { already defined }
- // glVertexAttrib4usvARB { already defined }
- // glVertexAttrib4uivARB { already defined }
- // glVertexAttrib4NbvARB { already defined }
- // glVertexAttrib4NsvARB { already defined }
- // glVertexAttrib4NivARB { already defined }
- // glVertexAttrib4NubvARB { already defined }
- // glVertexAttrib4NusvARB { already defined }
- // glVertexAttrib4NuivARB { already defined }
- // glVertexAttribPointerARB { already defined }
- // glEnableVertexAttribArrayARB { already defined }
- // glDisableVertexAttribArrayARB { already defined }
-var
- glBindAttribLocationARB: procedure(programObj: GLhandleARB; index: GLuint; const name: PGLcharARB); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetActiveAttribARB: procedure(programObj: GLhandleARB; index: GLuint; maxLength: GLsizei; length: PGLsizei; size: PGLint; _type: PGLenum; name: PGLcharARB); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetAttribLocationARB: function(programObj: GLhandleARB; const name: PGLcharARB): GLint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- // glGetVertexAttribdvARB { already defined }
- // glGetVertexAttribfvARB { already defined }
- // glGetVertexAttribivARB { already defined }
- // glGetVertexAttribPointervARB { already defined }
-
-function Load_GL_ARB_vertex_shader: Boolean;
-
-//***** GL_ARB_fragment_shader *****//
-const
- GL_FRAGMENT_SHADER_ARB = $8B30;
- GL_MAX_FRAGMENT_UNIFORM_COMPONENTS_ARB = $8B49;
- // GL_MAX_TEXTURE_COORDS_ARB { already defined }
- // GL_MAX_TEXTURE_IMAGE_UNITS_ARB { already defined }
- // GL_OBJECT_TYPE_ARB { already defined }
- // GL_OBJECT_SUBTYPE_ARB { already defined }
- // GL_SHADER_OBJECT_ARB { already defined }
-
-function Load_GL_ARB_fragment_shader: Boolean;
-
-//***** GL_ARB_shading_language_100 *****//
-
-function Load_GL_ARB_shading_language_100: Boolean;
-
-//***** GL_ARB_texture_non_power_of_two *****//
-
-function Load_GL_ARB_texture_non_power_of_two: Boolean;
-
-//***** GL_ARB_point_sprite *****//
-const
- GL_POINT_SPRITE_ARB = $8861;
- GL_COORD_REPLACE_ARB = $8862;
-
-function Load_GL_ARB_point_sprite: Boolean;
-
-//***** GL_EXT_depth_bounds_test *****//
-const
- GL_DEPTH_BOUNDS_TEST_EXT = $8890;
- GL_DEPTH_BOUNDS_EXT = $8891;
-var
- glDepthBoundsEXT: procedure(zmin: GLclampd; zmax: GLclampd); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_EXT_depth_bounds_test: Boolean;
-
-//***** GL_EXT_secondary_color *****//
-const
- GL_COLOR_SUM_EXT = $8458;
- GL_CURRENT_SECONDARY_COLOR_EXT = $8459;
- GL_SECONDARY_COLOR_ARRAY_SIZE_EXT = $845A;
- GL_SECONDARY_COLOR_ARRAY_TYPE_EXT = $845B;
- GL_SECONDARY_COLOR_ARRAY_STRIDE_EXT = $845C;
- GL_SECONDARY_COLOR_ARRAY_POINTER_EXT = $845D;
- GL_SECONDARY_COLOR_ARRAY_EXT = $845E;
-var
- glSecondaryColor3bEXT: procedure(r: GLbyte; g: GLbyte; b: GLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3sEXT: procedure(r: GLshort; g: GLshort; b: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3iEXT: procedure(r: GLint; g: GLint; b: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3fEXT: procedure(r: GLfloat; g: GLfloat; b: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3dEXT: procedure(r: GLdouble; g: GLdouble; b: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3ubEXT: procedure(r: GLubyte; g: GLubyte; b: GLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3usEXT: procedure(r: GLushort; g: GLushort; b: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3uiEXT: procedure(r: GLuint; g: GLuint; b: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3bvEXT: procedure(components: PGLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3svEXT: procedure(components: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3ivEXT: procedure(components: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3fvEXT: procedure(components: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3dvEXT: procedure(components: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3ubvEXT: procedure(components: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3usvEXT: procedure(components: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3uivEXT: procedure(components: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColorPointerEXT: procedure(size: GLint; _type: GLenum; stride: GLsizei; pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_EXT_secondary_color: Boolean;
-
-//***** GL_EXT_texture_mirror_clamp *****//
-const
- GL_MIRROR_CLAMP_EXT = $8742;
- GL_MIRROR_CLAMP_TO_EDGE_EXT = $8743;
- GL_MIRROR_CLAMP_TO_BORDER_EXT = $8912;
-
-function Load_GL_EXT_texture_mirror_clamp: Boolean;
-
-//***** GL_EXT_blend_equation_separate *****//
-const
- GL_BLEND_EQUATION_RGB_EXT = $8009;
- GL_BLEND_EQUATION_ALPHA_EXT = $883D;
-var
- glBlendEquationSeparateEXT: procedure(modeRGB: GLenum; modeAlpha: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_EXT_blend_equation_separate: Boolean;
-
-//***** GL_MESA_pack_invert *****//
-const
- GL_PACK_INVERT_MESA = $8758;
-
-function Load_GL_MESA_pack_invert: Boolean;
-
-//***** GL_MESA_ycbcr_texture *****//
-const
- GL_YCBCR_MESA = $8757;
- GL_UNSIGNED_SHORT_8_8_MESA = $85BA;
- GL_UNSIGNED_SHORT_8_8_REV_MESA = $85BB;
-
-function Load_GL_MESA_ycbcr_texture: Boolean;
-
-//***** GL_ARB_fragment_program_shadow *****//
-
-function Load_GL_ARB_fragment_program_shadow: Boolean;
-
-//***** GL_EXT_fog_coord *****//
-const
- GL_FOG_COORDINATE_SOURCE_EXT = $8450;
- GL_FOG_COORDINATE_EXT = $8451;
- GL_FRAGMENT_DEPTH_EXT = $8452;
- GL_CURRENT_FOG_COORDINATE_EXT = $8453;
- GL_FOG_COORDINATE_ARRAY_TYPE_EXT = $8454;
- GL_FOG_COORDINATE_ARRAY_STRIDE_EXT = $8455;
- GL_FOG_COORDINATE_ARRAY_POINTER_EXT = $8456;
- GL_FOG_COORDINATE_ARRAY_EXT = $8457;
-var
- glFogCoordfEXT: procedure(coord: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFogCoorddEXT: procedure(coord: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFogCoordfvEXT: procedure(coord: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFogCoorddvEXT: procedure(coord: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFogCoordPointerEXT: procedure(_type: GLenum; stride: GLsizei; pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_EXT_fog_coord: Boolean;
-
-//***** GL_NV_fragment_program_option *****//
-
-function Load_GL_NV_fragment_program_option: Boolean;
-
-//***** GL_EXT_pixel_buffer_object *****//
-const
- GL_PIXEL_PACK_BUFFER_EXT = $88EB;
- GL_PIXEL_UNPACK_BUFFER_EXT = $88EC;
- GL_PIXEL_PACK_BUFFER_BINDING_EXT = $88ED;
- GL_PIXEL_UNPACK_BUFFER_BINDING_EXT = $88EF;
-
-function Load_GL_EXT_pixel_buffer_object: Boolean;
-
-//***** GL_NV_fragment_program2 *****//
-const
- GL_MAX_PROGRAM_EXEC_INSTRUCTIONS_NV = $88F4;
- GL_MAX_PROGRAM_CALL_DEPTH_NV = $88F5;
- GL_MAX_PROGRAM_IF_DEPTH_NV = $88F6;
- GL_MAX_PROGRAM_LOOP_DEPTH_NV = $88F7;
- GL_MAX_PROGRAM_LOOP_COUNT_NV = $88F8;
-
-function Load_GL_NV_fragment_program2: Boolean;
-
-//***** GL_NV_vertex_program2_option *****//
- // GL_MAX_PROGRAM_EXEC_INSTRUCTIONS_NV { already defined }
- // GL_MAX_PROGRAM_CALL_DEPTH_NV { already defined }
-
-function Load_GL_NV_vertex_program2_option: Boolean;
-
-//***** GL_NV_vertex_program3 *****//
- // GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS_ARB { already defined }
-
-function Load_GL_NV_vertex_program3: Boolean;
-
-//***** GL_ARB_draw_buffers *****//
-const
- GL_MAX_DRAW_BUFFERS_ARB = $8824;
- GL_DRAW_BUFFER0_ARB = $8825;
- GL_DRAW_BUFFER1_ARB = $8826;
- GL_DRAW_BUFFER2_ARB = $8827;
- GL_DRAW_BUFFER3_ARB = $8828;
- GL_DRAW_BUFFER4_ARB = $8829;
- GL_DRAW_BUFFER5_ARB = $882A;
- GL_DRAW_BUFFER6_ARB = $882B;
- GL_DRAW_BUFFER7_ARB = $882C;
- GL_DRAW_BUFFER8_ARB = $882D;
- GL_DRAW_BUFFER9_ARB = $882E;
- GL_DRAW_BUFFER10_ARB = $882F;
- GL_DRAW_BUFFER11_ARB = $8830;
- GL_DRAW_BUFFER12_ARB = $8831;
- GL_DRAW_BUFFER13_ARB = $8832;
- GL_DRAW_BUFFER14_ARB = $8833;
- GL_DRAW_BUFFER15_ARB = $8834;
-var
- glDrawBuffersARB: procedure(n: GLsizei; const bufs: PGLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_ARB_draw_buffers: Boolean;
-
-//***** GL_ARB_texture_rectangle *****//
-const
- GL_TEXTURE_RECTANGLE_ARB = $84F5;
- GL_TEXTURE_BINDING_RECTANGLE_ARB = $84F6;
- GL_PROXY_TEXTURE_RECTANGLE_ARB = $84F7;
- GL_MAX_RECTANGLE_TEXTURE_SIZE_ARB = $84F8;
-
-function Load_GL_ARB_texture_rectangle: Boolean;
-
-//***** GL_ARB_color_buffer_float *****//
-const
- GL_RGBA_FLOAT_MODE_ARB = $8820;
- GL_CLAMP_VERTEX_COLOR_ARB = $891A;
- GL_CLAMP_FRAGMENT_COLOR_ARB = $891B;
- GL_CLAMP_READ_COLOR_ARB = $891C;
- GL_FIXED_ONLY_ARB = $891D;
- WGL_TYPE_RGBA_FLOAT_ARB = $21A0;
-var
- glClampColorARB: procedure(target: GLenum; clamp: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_ARB_color_buffer_float: Boolean;
-
-//***** GL_ARB_half_float_pixel *****//
-const
- GL_HALF_FLOAT_ARB = $140B;
-
-function Load_GL_ARB_half_float_pixel: Boolean;
-
-//***** GL_ARB_texture_float *****//
-const
- GL_TEXTURE_RED_TYPE_ARB = $8C10;
- GL_TEXTURE_GREEN_TYPE_ARB = $8C11;
- GL_TEXTURE_BLUE_TYPE_ARB = $8C12;
- GL_TEXTURE_ALPHA_TYPE_ARB = $8C13;
- GL_TEXTURE_LUMINANCE_TYPE_ARB = $8C14;
- GL_TEXTURE_INTENSITY_TYPE_ARB = $8C15;
- GL_TEXTURE_DEPTH_TYPE_ARB = $8C16;
- GL_UNSIGNED_NORMALIZED_ARB = $8C17;
- GL_RGBA32F_ARB = $8814;
- GL_RGB32F_ARB = $8815;
- GL_ALPHA32F_ARB = $8816;
- GL_INTENSITY32F_ARB = $8817;
- GL_LUMINANCE32F_ARB = $8818;
- GL_LUMINANCE_ALPHA32F_ARB = $8819;
- GL_RGBA16F_ARB = $881A;
- GL_RGB16F_ARB = $881B;
- GL_ALPHA16F_ARB = $881C;
- GL_INTENSITY16F_ARB = $881D;
- GL_LUMINANCE16F_ARB = $881E;
- GL_LUMINANCE_ALPHA16F_ARB = $881F;
-
-function Load_GL_ARB_texture_float: Boolean;
-
-//***** GL_EXT_texture_compression_dxt1 *****//
- // GL_COMPRESSED_RGB_S3TC_DXT1_EXT { already defined }
- // GL_COMPRESSED_RGBA_S3TC_DXT1_EXT { already defined }
-
-function Load_GL_EXT_texture_compression_dxt1: Boolean;
-
-//***** GL_ARB_pixel_buffer_object *****//
-const
- GL_PIXEL_PACK_BUFFER_ARB = $88EB;
- GL_PIXEL_UNPACK_BUFFER_ARB = $88EC;
- GL_PIXEL_PACK_BUFFER_BINDING_ARB = $88ED;
- GL_PIXEL_UNPACK_BUFFER_BINDING_ARB = $88EF;
-
-function Load_GL_ARB_pixel_buffer_object: Boolean;
-
-//***** GL_EXT_framebuffer_object *****//
-const
- GL_FRAMEBUFFER_EXT = $8D40;
- GL_RENDERBUFFER_EXT = $8D41;
- GL_STENCIL_INDEX_EXT = $8D45;
- GL_STENCIL_INDEX1_EXT = $8D46;
- GL_STENCIL_INDEX4_EXT = $8D47;
- GL_STENCIL_INDEX8_EXT = $8D48;
- GL_STENCIL_INDEX16_EXT = $8D49;
- GL_RENDERBUFFER_WIDTH_EXT = $8D42;
- GL_RENDERBUFFER_HEIGHT_EXT = $8D43;
- GL_RENDERBUFFER_INTERNAL_FORMAT_EXT = $8D44;
- GL_FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE_EXT = $8CD0;
- GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME_EXT = $8CD1;
- GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL_EXT = $8CD2;
- GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE_EXT = $8CD3;
- GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_3D_ZOFFSET_EXT = $8CD4;
- GL_COLOR_ATTACHMENT0_EXT = $8CE0;
- GL_COLOR_ATTACHMENT1_EXT = $8CE1;
- GL_COLOR_ATTACHMENT2_EXT = $8CE2;
- GL_COLOR_ATTACHMENT3_EXT = $8CE3;
- GL_COLOR_ATTACHMENT4_EXT = $8CE4;
- GL_COLOR_ATTACHMENT5_EXT = $8CE5;
- GL_COLOR_ATTACHMENT6_EXT = $8CE6;
- GL_COLOR_ATTACHMENT7_EXT = $8CE7;
- GL_COLOR_ATTACHMENT8_EXT = $8CE8;
- GL_COLOR_ATTACHMENT9_EXT = $8CE9;
- GL_COLOR_ATTACHMENT10_EXT = $8CEA;
- GL_COLOR_ATTACHMENT11_EXT = $8CEB;
- GL_COLOR_ATTACHMENT12_EXT = $8CEC;
- GL_COLOR_ATTACHMENT13_EXT = $8CED;
- GL_COLOR_ATTACHMENT14_EXT = $8CEE;
- GL_COLOR_ATTACHMENT15_EXT = $8CEF;
- GL_DEPTH_ATTACHMENT_EXT = $8D00;
- GL_STENCIL_ATTACHMENT_EXT = $8D20;
- GL_FRAMEBUFFER_COMPLETE_EXT = $8CD5;
- GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT_EXT = $8CD6;
- GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT_EXT = $8CD7;
- GL_FRAMEBUFFER_INCOMPLETE_DUPLICATE_ATTACHMENT_EXT = $8CD8;
- GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT = $8CD9;
- GL_FRAMEBUFFER_INCOMPLETE_FORMATS_EXT = $8CDA;
- GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER_EXT = $8CDB;
- GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER_EXT = $8CDC;
- GL_FRAMEBUFFER_UNSUPPORTED_EXT = $8CDD;
- GL_FRAMEBUFFER_STATUS_ERROR_EXT = $8CDE;
- GL_FRAMEBUFFER_BINDING_EXT = $8CA6;
- GL_RENDERBUFFER_BINDING_EXT = $8CA7;
- GL_MAX_COLOR_ATTACHMENTS_EXT = $8CDF;
- GL_MAX_RENDERBUFFER_SIZE_EXT = $84E8;
- GL_INVALID_FRAMEBUFFER_OPERATION_EXT = $0506;
-var
- glIsRenderbufferEXT: function(renderbuffer: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glBindRenderbufferEXT: procedure(target: GLenum; renderbuffer: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDeleteRenderbuffersEXT: procedure(n: GLsizei; const renderbuffers: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGenRenderbuffersEXT: procedure(n: GLsizei; renderbuffers: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glRenderbufferStorageEXT: procedure(target: GLenum; internalformat: GLenum; width: GLsizei; height: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetRenderbufferParameterivEXT: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIsFramebufferEXT: function(framebuffer: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glBindFramebufferEXT: procedure(target: GLenum; framebuffer: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDeleteFramebuffersEXT: procedure(n: GLsizei; const framebuffers: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGenFramebuffersEXT: procedure(n: GLsizei; framebuffers: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCheckFramebufferStatusEXT: function(target: GLenum): GLenum; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFramebufferTexture1DEXT: procedure(target: GLenum; attachment: GLenum; textarget: GLenum; texture: GLuint; level: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFramebufferTexture2DEXT: procedure(target: GLenum; attachment: GLenum; textarget: GLenum; texture: GLuint; level: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFramebufferTexture3DEXT: procedure(target: GLenum; attachment: GLenum; textarget: GLenum; texture: GLuint; level: GLint; zoffset: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFramebufferRenderbufferEXT: procedure(target: GLenum; attachment: GLenum; renderbuffertarget: GLenum; renderbuffer: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetFramebufferAttachmentParameterivEXT: procedure(target: GLenum; attachment: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGenerateMipmapEXT: procedure(target: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_EXT_framebuffer_object: Boolean;
-
-//***** GL_version_1_4 *****//
-const
- GL_BLEND_DST_RGB = $80C8;
- GL_BLEND_SRC_RGB = $80C9;
- GL_BLEND_DST_ALPHA = $80CA;
- GL_BLEND_SRC_ALPHA = $80CB;
- GL_POINT_SIZE_MIN = $8126;
- GL_POINT_SIZE_MAX = $8127;
- GL_POINT_FADE_THRESHOLD_SIZE = $8128;
- GL_POINT_DISTANCE_ATTENUATION = $8129;
- GL_GENERATE_MIPMAP = $8191;
- GL_GENERATE_MIPMAP_HINT = $8192;
- GL_DEPTH_COMPONENT16 = $81A5;
- GL_DEPTH_COMPONENT24 = $81A6;
- GL_DEPTH_COMPONENT32 = $81A7;
- GL_MIRRORED_REPEAT = $8370;
- GL_FOG_COORDINATE_SOURCE = $8450;
- GL_FOG_COORDINATE = $8451;
- GL_FRAGMENT_DEPTH = $8452;
- GL_CURRENT_FOG_COORDINATE = $8453;
- GL_FOG_COORDINATE_ARRAY_TYPE = $8454;
- GL_FOG_COORDINATE_ARRAY_STRIDE = $8455;
- GL_FOG_COORDINATE_ARRAY_POINTER = $8456;
- GL_FOG_COORDINATE_ARRAY = $8457;
- GL_COLOR_SUM = $8458;
- GL_CURRENT_SECONDARY_COLOR = $8459;
- GL_SECONDARY_COLOR_ARRAY_SIZE = $845A;
- GL_SECONDARY_COLOR_ARRAY_TYPE = $845B;
- GL_SECONDARY_COLOR_ARRAY_STRIDE = $845C;
- GL_SECONDARY_COLOR_ARRAY_POINTER = $845D;
- GL_SECONDARY_COLOR_ARRAY = $845E;
- GL_MAX_TEXTURE_LOD_BIAS = $84FD;
- GL_TEXTURE_FILTER_CONTROL = $8500;
- GL_TEXTURE_LOD_BIAS = $8501;
- GL_INCR_WRAP = $8507;
- GL_DECR_WRAP = $8508;
- GL_TEXTURE_DEPTH_SIZE = $884A;
- GL_DEPTH_TEXTURE_MODE = $884B;
- GL_TEXTURE_COMPARE_MODE = $884C;
- GL_TEXTURE_COMPARE_FUNC = $884D;
- GL_COMPARE_R_TO_TEXTURE = $884E;
-var
- glBlendFuncSeparate: procedure(sfactorRGB: GLenum; dfactorRGB: GLenum; sfactorAlpha: GLenum; dfactorAlpha: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFogCoordf: procedure(coord: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFogCoordfv: procedure(const coord: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFogCoordd: procedure(coord: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFogCoorddv: procedure(const coord: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glFogCoordPointer: procedure(_type: GLenum; stride: GLsizei; const pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiDrawArrays: procedure(mode: GLenum; first: PGLint; count: PGLsizei; primcount: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMultiDrawElements: procedure(mode: GLenum; const count: PGLsizei; _type: GLenum; const indices: PGLvoid; primcount: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPointParameterf: procedure(pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPointParameterfv: procedure(pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPointParameteri: procedure(pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glPointParameteriv: procedure(pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3b: procedure(red: GLbyte; green: GLbyte; blue: GLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3bv: procedure(const v: PGLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3d: procedure(red: GLdouble; green: GLdouble; blue: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3f: procedure(red: GLfloat; green: GLfloat; blue: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3i: procedure(red: GLint; green: GLint; blue: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3s: procedure(red: GLshort; green: GLshort; blue: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3ub: procedure(red: GLubyte; green: GLubyte; blue: GLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3ubv: procedure(const v: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3ui: procedure(red: GLuint; green: GLuint; blue: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3uiv: procedure(const v: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3us: procedure(red: GLushort; green: GLushort; blue: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColor3usv: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glSecondaryColorPointer: procedure(size: GLint; _type: GLenum; stride: GLsizei; const pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos2d: procedure(x: GLdouble; y: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos2dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos2f: procedure(x: GLfloat; y: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos2fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos2i: procedure(x: GLint; y: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos2iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos2s: procedure(x: GLshort; y: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos2sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos3d: procedure(x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos3dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos3f: procedure(x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos3fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos3i: procedure(x: GLint; y: GLint; z: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos3iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos3s: procedure(x: GLshort; y: GLshort; z: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glWindowPos3sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_version_1_4: Boolean;
-
-//***** GL_version_1_5 *****//
-const
- GL_BUFFER_SIZE = $8764;
- GL_BUFFER_USAGE = $8765;
- GL_QUERY_COUNTER_BITS = $8864;
- GL_CURRENT_QUERY = $8865;
- GL_QUERY_RESULT = $8866;
- GL_QUERY_RESULT_AVAILABLE = $8867;
- GL_ARRAY_BUFFER = $8892;
- GL_ELEMENT_ARRAY_BUFFER = $8893;
- GL_ARRAY_BUFFER_BINDING = $8894;
- GL_ELEMENT_ARRAY_BUFFER_BINDING = $8895;
- GL_VERTEX_ARRAY_BUFFER_BINDING = $8896;
- GL_NORMAL_ARRAY_BUFFER_BINDING = $8897;
- GL_COLOR_ARRAY_BUFFER_BINDING = $8898;
- GL_INDEX_ARRAY_BUFFER_BINDING = $8899;
- GL_TEXTURE_COORD_ARRAY_BUFFER_BINDING = $889A;
- GL_EDGE_FLAG_ARRAY_BUFFER_BINDING = $889B;
- GL_SECONDARY_COLOR_ARRAY_BUFFER_BINDING = $889C;
- GL_FOG_COORDINATE_ARRAY_BUFFER_BINDING = $889D;
- GL_WEIGHT_ARRAY_BUFFER_BINDING = $889E;
- GL_VERTEX_ATTRIB_ARRAY_BUFFER_BINDING = $889F;
- GL_READ_ONLY = $88B8;
- GL_WRITE_ONLY = $88B9;
- GL_READ_WRITE = $88BA;
- GL_BUFFER_ACCESS = $88BB;
- GL_BUFFER_MAPPED = $88BC;
- GL_BUFFER_MAP_POINTER = $88BD;
- GL_STREAM_DRAW = $88E0;
- GL_STREAM_READ = $88E1;
- GL_STREAM_COPY = $88E2;
- GL_STATIC_DRAW = $88E4;
- GL_STATIC_READ = $88E5;
- GL_STATIC_COPY = $88E6;
- GL_DYNAMIC_DRAW = $88E8;
- GL_DYNAMIC_READ = $88E9;
- GL_DYNAMIC_COPY = $88EA;
- GL_SAMPLES_PASSED = $8914;
- GL_FOG_COORD_SRC = $8450;
- GL_FOG_COORD = $8451;
- GL_CURRENT_FOG_COORD = $8453;
- GL_FOG_COORD_ARRAY_TYPE = $8454;
- GL_FOG_COORD_ARRAY_STRIDE = $8455;
- GL_FOG_COORD_ARRAY_POINTER = $8456;
- GL_FOG_COORD_ARRAY = $8457;
- GL_FOG_COORD_ARRAY_BUFFER_BINDING = $889D;
- GL_SRC0_RGB = $8580;
- GL_SRC1_RGB = $8581;
- GL_SRC2_RGB = $8582;
- GL_SRC0_ALPHA = $8588;
- GL_SRC1_ALPHA = $8589;
- GL_SRC2_ALPHA = $858A;
-var
- glGenQueries: procedure(n: GLsizei; ids: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDeleteQueries: procedure(n: GLsizei; const ids: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIsQuery: function(id: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glBeginQuery: procedure(target: GLenum; id: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEndQuery: procedure(target: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetQueryiv: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetQueryObjectiv: procedure(id: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetQueryObjectuiv: procedure(id: GLuint; pname: GLenum; params: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glBindBuffer: procedure(target: GLenum; buffer: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDeleteBuffers: procedure(n: GLsizei; const buffers: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGenBuffers: procedure(n: GLsizei; buffers: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIsBuffer: function(buffer: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glBufferData: procedure(target: GLenum; size: GLsizeiptr; const data: PGLvoid; usage: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glBufferSubData: procedure(target: GLenum; offset: GLintptr; size: GLsizeiptr; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetBufferSubData: procedure(target: GLenum; offset: GLintptr; size: GLsizeiptr; data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glMapBuffer: function(target: GLenum; access: GLenum): PGLvoid; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUnmapBuffer: function(target: GLenum): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetBufferParameteriv: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetBufferPointerv: procedure(target: GLenum; pname: GLenum; params: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_version_1_5: Boolean;
-
-//***** GL_version_2_0 *****//
-const
- GL_BLEND_EQUATION_RGB = $8009;
- GL_VERTEX_ATTRIB_ARRAY_ENABLED = $8622;
- GL_VERTEX_ATTRIB_ARRAY_SIZE = $8623;
- GL_VERTEX_ATTRIB_ARRAY_STRIDE = $8624;
- GL_VERTEX_ATTRIB_ARRAY_TYPE = $8625;
- GL_CURRENT_VERTEX_ATTRIB = $8626;
- GL_VERTEX_PROGRAM_POINT_SIZE = $8642;
- GL_VERTEX_PROGRAM_TWO_SIDE = $8643;
- GL_VERTEX_ATTRIB_ARRAY_POINTER = $8645;
- GL_STENCIL_BACK_FUNC = $8800;
- GL_STENCIL_BACK_FAIL = $8801;
- GL_STENCIL_BACK_PASS_DEPTH_FAIL = $8802;
- GL_STENCIL_BACK_PASS_DEPTH_PASS = $8803;
- GL_MAX_DRAW_BUFFERS = $8824;
- GL_DRAW_BUFFER0 = $8825;
- GL_DRAW_BUFFER1 = $8826;
- GL_DRAW_BUFFER2 = $8827;
- GL_DRAW_BUFFER3 = $8828;
- GL_DRAW_BUFFER4 = $8829;
- GL_DRAW_BUFFER5 = $882A;
- GL_DRAW_BUFFER6 = $882B;
- GL_DRAW_BUFFER7 = $882C;
- GL_DRAW_BUFFER8 = $882D;
- GL_DRAW_BUFFER9 = $882E;
- GL_DRAW_BUFFER10 = $882F;
- GL_DRAW_BUFFER11 = $8830;
- GL_DRAW_BUFFER12 = $8831;
- GL_DRAW_BUFFER13 = $8832;
- GL_DRAW_BUFFER14 = $8833;
- GL_DRAW_BUFFER15 = $8834;
- GL_BLEND_EQUATION_ALPHA = $883D;
- GL_POINT_SPRITE = $8861;
- GL_COORD_REPLACE = $8862;
- GL_MAX_VERTEX_ATTRIBS = $8869;
- GL_VERTEX_ATTRIB_ARRAY_NORMALIZED = $886A;
- GL_MAX_TEXTURE_COORDS = $8871;
- GL_MAX_TEXTURE_IMAGE_UNITS = $8872;
- GL_FRAGMENT_SHADER = $8B30;
- GL_VERTEX_SHADER = $8B31;
- GL_MAX_FRAGMENT_UNIFORM_COMPONENTS = $8B49;
- GL_MAX_VERTEX_UNIFORM_COMPONENTS = $8B4A;
- GL_MAX_VARYING_FLOATS = $8B4B;
- GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS = $8B4C;
- GL_MAX_COMBINED_TEXTURE_IMAGE_UNITS = $8B4D;
- GL_SHADER_TYPE = $8B4F;
- GL_FLOAT_VEC2 = $8B50;
- GL_FLOAT_VEC3 = $8B51;
- GL_FLOAT_VEC4 = $8B52;
- GL_INT_VEC2 = $8B53;
- GL_INT_VEC3 = $8B54;
- GL_INT_VEC4 = $8B55;
- GL_BOOL = $8B56;
- GL_BOOL_VEC2 = $8B57;
- GL_BOOL_VEC3 = $8B58;
- GL_BOOL_VEC4 = $8B59;
- GL_FLOAT_MAT2 = $8B5A;
- GL_FLOAT_MAT3 = $8B5B;
- GL_FLOAT_MAT4 = $8B5C;
- GL_SAMPLER_1D = $8B5D;
- GL_SAMPLER_2D = $8B5E;
- GL_SAMPLER_3D = $8B5F;
- GL_SAMPLER_CUBE = $8B60;
- GL_SAMPLER_1D_SHADOW = $8B61;
- GL_SAMPLER_2D_SHADOW = $8B62;
- GL_DELETE_STATUS = $8B80;
- GL_COMPILE_STATUS = $8B81;
- GL_LINK_STATUS = $8B82;
- GL_VALIDATE_STATUS = $8B83;
- GL_INFO_LOG_LENGTH = $8B84;
- GL_ATTACHED_SHADERS = $8B85;
- GL_ACTIVE_UNIFORMS = $8B86;
- GL_ACTIVE_UNIFORM_MAX_LENGTH = $8B87;
- GL_SHADER_SOURCE_LENGTH = $8B88;
- GL_ACTIVE_ATTRIBUTES = $8B89;
- GL_ACTIVE_ATTRIBUTE_MAX_LENGTH = $8B8A;
- GL_FRAGMENT_SHADER_DERIVATIVE_HINT = $8B8B;
- GL_SHADING_LANGUAGE_VERSION = $8B8C;
- GL_CURRENT_PROGRAM = $8B8D;
- GL_POINT_SPRITE_COORD_ORIGIN = $8CA0;
- GL_LOWER_LEFT = $8CA1;
- GL_UPPER_LEFT = $8CA2;
- GL_STENCIL_BACK_REF = $8CA3;
- GL_STENCIL_BACK_VALUE_MASK = $8CA4;
- GL_STENCIL_BACK_WRITEMASK = $8CA5;
-var
- glBlendEquationSeparate: procedure(modeRGB: GLenum; modeAlpha: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDrawBuffers: procedure(n: GLsizei; const bufs: PGLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glStencilOpSeparate: procedure(face: GLenum; sfail: GLenum; dpfail: GLenum; dppass: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glStencilFuncSeparate: procedure(frontfunc: GLenum; backfunc: GLenum; ref: GLint; mask: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glStencilMaskSeparate: procedure(face: GLenum; mask: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glAttachShader: procedure(_program: GLuint; shader: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glBindAttribLocation: procedure(_program: GLuint; index: GLuint; const name: PGLchar); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCompileShader: procedure(shader: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCreateProgram: function(): GLuint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glCreateShader: function(_type: GLenum): GLuint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDeleteProgram: procedure(_program: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDeleteShader: procedure(shader: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDetachShader: procedure(_program: GLuint; shader: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glDisableVertexAttribArray: procedure(index: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glEnableVertexAttribArray: procedure(index: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetActiveAttrib: procedure(_program: GLuint; index: GLuint; bufSize: GLsizei; length: PGLsizei; size: PGLint; _type: PGLenum; name: PGLchar); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetActiveUniform: procedure(_program: GLuint; index: GLuint; bufSize: GLsizei; length: PGLsizei; size: PGLint; _type: PGLenum; name: PGLchar); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetAttachedShaders: procedure(_program: GLuint; maxCount: GLsizei; count: PGLsizei; obj: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetAttribLocation: function(_program: GLuint; const name: PGLchar): GLint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetProgramiv: procedure(_program: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetProgramInfoLog: procedure(_program: GLuint; bufSize: GLsizei; length: PGLsizei; infoLog: PGLchar); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetShaderiv: procedure(shader: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetShaderInfoLog: procedure(shader: GLuint; bufSize: GLsizei; length: PGLsizei; infoLog: PGLchar); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetShaderSource: procedure(shader: GLuint; bufSize: GLsizei; length: PGLsizei; source: PGLchar); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetUniformLocation: function(_program: GLuint; const name: PGLchar): GLint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetUniformfv: procedure(_program: GLuint; location: GLint; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetUniformiv: procedure(_program: GLuint; location: GLint; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetVertexAttribdv: procedure(index: GLuint; pname: GLenum; params: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetVertexAttribfv: procedure(index: GLuint; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetVertexAttribiv: procedure(index: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glGetVertexAttribPointerv: procedure(index: GLuint; pname: GLenum; pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIsProgram: function(_program: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glIsShader: function(shader: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glLinkProgram: procedure(_program: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glShaderSource: procedure(shader: GLuint; count: GLsizei; const _string: PGLchar; const length: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUseProgram: procedure(_program: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform1f: procedure(location: GLint; v0: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform2f: procedure(location: GLint; v0: GLfloat; v1: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform3f: procedure(location: GLint; v0: GLfloat; v1: GLfloat; v2: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform4f: procedure(location: GLint; v0: GLfloat; v1: GLfloat; v2: GLfloat; v3: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform1i: procedure(location: GLint; v0: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform2i: procedure(location: GLint; v0: GLint; v1: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform3i: procedure(location: GLint; v0: GLint; v1: GLint; v2: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform4i: procedure(location: GLint; v0: GLint; v1: GLint; v2: GLint; v3: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform1fv: procedure(location: GLint; count: GLsizei; const value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform2fv: procedure(location: GLint; count: GLsizei; const value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform3fv: procedure(location: GLint; count: GLsizei; const value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform4fv: procedure(location: GLint; count: GLsizei; const value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform1iv: procedure(location: GLint; count: GLsizei; const value: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform2iv: procedure(location: GLint; count: GLsizei; const value: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform3iv: procedure(location: GLint; count: GLsizei; const value: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniform4iv: procedure(location: GLint; count: GLsizei; const value: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniformMatrix2fv: procedure(location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniformMatrix3fv: procedure(location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glUniformMatrix4fv: procedure(location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glValidateProgram: procedure(_program: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib1d: procedure(index: GLuint; x: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib1dv: procedure(index: GLuint; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib1f: procedure(index: GLuint; x: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib1fv: procedure(index: GLuint; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib1s: procedure(index: GLuint; x: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib1sv: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib2d: procedure(index: GLuint; x: GLdouble; y: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib2dv: procedure(index: GLuint; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib2f: procedure(index: GLuint; x: GLfloat; y: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib2fv: procedure(index: GLuint; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib2s: procedure(index: GLuint; x: GLshort; y: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib2sv: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib3d: procedure(index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib3dv: procedure(index: GLuint; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib3f: procedure(index: GLuint; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib3fv: procedure(index: GLuint; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib3s: procedure(index: GLuint; x: GLshort; y: GLshort; z: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib3sv: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4Nbv: procedure(index: GLuint; const v: PGLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4Niv: procedure(index: GLuint; const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4Nsv: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4Nub: procedure(index: GLuint; x: GLubyte; y: GLubyte; z: GLubyte; w: GLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4Nubv: procedure(index: GLuint; const v: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4Nuiv: procedure(index: GLuint; const v: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4Nusv: procedure(index: GLuint; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4bv: procedure(index: GLuint; const v: PGLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4d: procedure(index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4dv: procedure(index: GLuint; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4f: procedure(index: GLuint; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4fv: procedure(index: GLuint; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4iv: procedure(index: GLuint; const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4s: procedure(index: GLuint; x: GLshort; y: GLshort; z: GLshort; w: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4sv: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4ubv: procedure(index: GLuint; const v: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4uiv: procedure(index: GLuint; const v: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttrib4usv: procedure(index: GLuint; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glVertexAttribPointer: procedure(index: GLuint; size: GLint; _type: GLenum; normalized: GLboolean; stride: GLsizei; const pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-function Load_GL_version_2_0: Boolean;
-
-implementation
-
-uses
- sdl;
-
-function glext_ExtensionSupported(const extension: PChar; const searchIn: PChar): Boolean;
-var
- extensions: PChar;
- start: PChar;
- where, terminator: PChar;
-begin
-
- if (Pos(' ', extension) <> 0) or (extension = '') then
- begin
- Result := FALSE;
- Exit;
- end;
-
- if searchIn = '' then
- extensions := glGetString(GL_EXTENSIONS)
- else
- //StrLCopy( extensions, searchIn, StrLen(searchIn)+1 );
- extensions := searchIn;
- start := extensions;
- while TRUE do
- begin
- where := StrPos(start, extension );
- if where = nil then Break;
- terminator := Pointer(Integer(where) + Integer( strlen( extension ) ) );
- if (where = start) or (PChar(Integer(where) - 1)^ = ' ') then
- begin
- if (terminator^ = ' ') or (terminator^ = #0) then
- begin
- Result := TRUE;
- Exit;
- end;
- end;
- start := terminator;
- end;
- Result := FALSE;
-
-end;
-
-function Load_GL_version_1_2: Boolean;
-{var
- extstring : PChar;}
-begin
-
- Result := FALSE;
- //extstring := glGetString( GL_EXTENSIONS );
-
- @glCopyTexSubImage3D := SDL_GL_GetProcAddress('glCopyTexSubImage3D');
- if not Assigned(glCopyTexSubImage3D) then Exit;
- @glDrawRangeElements := SDL_GL_GetProcAddress('glDrawRangeElements');
- if not Assigned(glDrawRangeElements) then Exit;
- @glTexImage3D := SDL_GL_GetProcAddress('glTexImage3D');
- if not Assigned(glTexImage3D) then Exit;
- @glTexSubImage3D := SDL_GL_GetProcAddress('glTexSubImage3D');
- if not Assigned(glTexSubImage3D) then Exit;
-
- Result := TRUE;
-
-end;
-
-function Load_GL_ARB_imaging: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_imaging', extstring) then
- begin
- @glColorTable := SDL_GL_GetProcAddress('glColorTable');
- if not Assigned(glColorTable) then Exit;
- @glColorTableParameterfv := SDL_GL_GetProcAddress('glColorTableParameterfv');
- if not Assigned(glColorTableParameterfv) then Exit;
- @glColorTableParameteriv := SDL_GL_GetProcAddress('glColorTableParameteriv');
- if not Assigned(glColorTableParameteriv) then Exit;
- @glCopyColorTable := SDL_GL_GetProcAddress('glCopyColorTable');
- if not Assigned(glCopyColorTable) then Exit;
- @glGetColorTable := SDL_GL_GetProcAddress('glGetColorTable');
- if not Assigned(glGetColorTable) then Exit;
- @glGetColorTableParameterfv := SDL_GL_GetProcAddress('glGetColorTableParameterfv');
- if not Assigned(glGetColorTableParameterfv) then Exit;
- @glGetColorTableParameteriv := SDL_GL_GetProcAddress('glGetColorTableParameteriv');
- if not Assigned(glGetColorTableParameteriv) then Exit;
- @glColorSubTable := SDL_GL_GetProcAddress('glColorSubTable');
- if not Assigned(glColorSubTable) then Exit;
- @glCopyColorSubTable := SDL_GL_GetProcAddress('glCopyColorSubTable');
- if not Assigned(glCopyColorSubTable) then Exit;
- @glConvolutionFilter1D := SDL_GL_GetProcAddress('glConvolutionFilter1D');
- if not Assigned(glConvolutionFilter1D) then Exit;
- @glConvolutionFilter2D := SDL_GL_GetProcAddress('glConvolutionFilter2D');
- if not Assigned(glConvolutionFilter2D) then Exit;
- @glConvolutionParameterf := SDL_GL_GetProcAddress('glConvolutionParameterf');
- if not Assigned(glConvolutionParameterf) then Exit;
- @glConvolutionParameterfv := SDL_GL_GetProcAddress('glConvolutionParameterfv');
- if not Assigned(glConvolutionParameterfv) then Exit;
- @glConvolutionParameteri := SDL_GL_GetProcAddress('glConvolutionParameteri');
- if not Assigned(glConvolutionParameteri) then Exit;
- @glConvolutionParameteriv := SDL_GL_GetProcAddress('glConvolutionParameteriv');
- if not Assigned(glConvolutionParameteriv) then Exit;
- @glCopyConvolutionFilter1D := SDL_GL_GetProcAddress('glCopyConvolutionFilter1D');
- if not Assigned(glCopyConvolutionFilter1D) then Exit;
- @glCopyConvolutionFilter2D := SDL_GL_GetProcAddress('glCopyConvolutionFilter2D');
- if not Assigned(glCopyConvolutionFilter2D) then Exit;
- @glGetConvolutionFilter := SDL_GL_GetProcAddress('glGetConvolutionFilter');
- if not Assigned(glGetConvolutionFilter) then Exit;
- @glGetConvolutionParameterfv := SDL_GL_GetProcAddress('glGetConvolutionParameterfv');
- if not Assigned(glGetConvolutionParameterfv) then Exit;
- @glGetConvolutionParameteriv := SDL_GL_GetProcAddress('glGetConvolutionParameteriv');
- if not Assigned(glGetConvolutionParameteriv) then Exit;
- @glGetSeparableFilter := SDL_GL_GetProcAddress('glGetSeparableFilter');
- if not Assigned(glGetSeparableFilter) then Exit;
- @glSeparableFilter2D := SDL_GL_GetProcAddress('glSeparableFilter2D');
- if not Assigned(glSeparableFilter2D) then Exit;
- @glGetHistogram := SDL_GL_GetProcAddress('glGetHistogram');
- if not Assigned(glGetHistogram) then Exit;
- @glGetHistogramParameterfv := SDL_GL_GetProcAddress('glGetHistogramParameterfv');
- if not Assigned(glGetHistogramParameterfv) then Exit;
- @glGetHistogramParameteriv := SDL_GL_GetProcAddress('glGetHistogramParameteriv');
- if not Assigned(glGetHistogramParameteriv) then Exit;
- @glGetMinmax := SDL_GL_GetProcAddress('glGetMinmax');
- if not Assigned(glGetMinmax) then Exit;
- @glGetMinmaxParameterfv := SDL_GL_GetProcAddress('glGetMinmaxParameterfv');
- if not Assigned(glGetMinmaxParameterfv) then Exit;
- @glGetMinmaxParameteriv := SDL_GL_GetProcAddress('glGetMinmaxParameteriv');
- if not Assigned(glGetMinmaxParameteriv) then Exit;
- @glHistogram := SDL_GL_GetProcAddress('glHistogram');
- if not Assigned(glHistogram) then Exit;
- @glMinmax := SDL_GL_GetProcAddress('glMinmax');
- if not Assigned(glMinmax) then Exit;
- @glResetHistogram := SDL_GL_GetProcAddress('glResetHistogram');
- if not Assigned(glResetHistogram) then Exit;
- @glResetMinmax := SDL_GL_GetProcAddress('glResetMinmax');
- if not Assigned(glResetMinmax) then Exit;
- @glBlendEquation := SDL_GL_GetProcAddress('glBlendEquation');
- if not Assigned(glBlendEquation) then Exit;
- @glBlendColor := SDL_GL_GetProcAddress('glBlendColor');
- if not Assigned(glBlendColor) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_version_1_3: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- @glActiveTexture := SDL_GL_GetProcAddress('glActiveTexture');
- if not Assigned(glActiveTexture) then Exit;
- @glClientActiveTexture := SDL_GL_GetProcAddress('glClientActiveTexture');
- if not Assigned(glClientActiveTexture) then Exit;
- @glMultiTexCoord1d := SDL_GL_GetProcAddress('glMultiTexCoord1d');
- if not Assigned(glMultiTexCoord1d) then Exit;
- @glMultiTexCoord1dv := SDL_GL_GetProcAddress('glMultiTexCoord1dv');
- if not Assigned(glMultiTexCoord1dv) then Exit;
- @glMultiTexCoord1f := SDL_GL_GetProcAddress('glMultiTexCoord1f');
- if not Assigned(glMultiTexCoord1f) then Exit;
- @glMultiTexCoord1fv := SDL_GL_GetProcAddress('glMultiTexCoord1fv');
- if not Assigned(glMultiTexCoord1fv) then Exit;
- @glMultiTexCoord1i := SDL_GL_GetProcAddress('glMultiTexCoord1i');
- if not Assigned(glMultiTexCoord1i) then Exit;
- @glMultiTexCoord1iv := SDL_GL_GetProcAddress('glMultiTexCoord1iv');
- if not Assigned(glMultiTexCoord1iv) then Exit;
- @glMultiTexCoord1s := SDL_GL_GetProcAddress('glMultiTexCoord1s');
- if not Assigned(glMultiTexCoord1s) then Exit;
- @glMultiTexCoord1sv := SDL_GL_GetProcAddress('glMultiTexCoord1sv');
- if not Assigned(glMultiTexCoord1sv) then Exit;
- @glMultiTexCoord2d := SDL_GL_GetProcAddress('glMultiTexCoord2d');
- if not Assigned(glMultiTexCoord2d) then Exit;
- @glMultiTexCoord2dv := SDL_GL_GetProcAddress('glMultiTexCoord2dv');
- if not Assigned(glMultiTexCoord2dv) then Exit;
- @glMultiTexCoord2f := SDL_GL_GetProcAddress('glMultiTexCoord2f');
- if not Assigned(glMultiTexCoord2f) then Exit;
- @glMultiTexCoord2fv := SDL_GL_GetProcAddress('glMultiTexCoord2fv');
- if not Assigned(glMultiTexCoord2fv) then Exit;
- @glMultiTexCoord2i := SDL_GL_GetProcAddress('glMultiTexCoord2i');
- if not Assigned(glMultiTexCoord2i) then Exit;
- @glMultiTexCoord2iv := SDL_GL_GetProcAddress('glMultiTexCoord2iv');
- if not Assigned(glMultiTexCoord2iv) then Exit;
- @glMultiTexCoord2s := SDL_GL_GetProcAddress('glMultiTexCoord2s');
- if not Assigned(glMultiTexCoord2s) then Exit;
- @glMultiTexCoord2sv := SDL_GL_GetProcAddress('glMultiTexCoord2sv');
- if not Assigned(glMultiTexCoord2sv) then Exit;
- @glMultiTexCoord3d := SDL_GL_GetProcAddress('glMultiTexCoord3d');
- if not Assigned(glMultiTexCoord3d) then Exit;
- @glMultiTexCoord3dv := SDL_GL_GetProcAddress('glMultiTexCoord3dv');
- if not Assigned(glMultiTexCoord3dv) then Exit;
- @glMultiTexCoord3f := SDL_GL_GetProcAddress('glMultiTexCoord3f');
- if not Assigned(glMultiTexCoord3f) then Exit;
- @glMultiTexCoord3fv := SDL_GL_GetProcAddress('glMultiTexCoord3fv');
- if not Assigned(glMultiTexCoord3fv) then Exit;
- @glMultiTexCoord3i := SDL_GL_GetProcAddress('glMultiTexCoord3i');
- if not Assigned(glMultiTexCoord3i) then Exit;
- @glMultiTexCoord3iv := SDL_GL_GetProcAddress('glMultiTexCoord3iv');
- if not Assigned(glMultiTexCoord3iv) then Exit;
- @glMultiTexCoord3s := SDL_GL_GetProcAddress('glMultiTexCoord3s');
- if not Assigned(glMultiTexCoord3s) then Exit;
- @glMultiTexCoord3sv := SDL_GL_GetProcAddress('glMultiTexCoord3sv');
- if not Assigned(glMultiTexCoord3sv) then Exit;
- @glMultiTexCoord4d := SDL_GL_GetProcAddress('glMultiTexCoord4d');
- if not Assigned(glMultiTexCoord4d) then Exit;
- @glMultiTexCoord4dv := SDL_GL_GetProcAddress('glMultiTexCoord4dv');
- if not Assigned(glMultiTexCoord4dv) then Exit;
- @glMultiTexCoord4f := SDL_GL_GetProcAddress('glMultiTexCoord4f');
- if not Assigned(glMultiTexCoord4f) then Exit;
- @glMultiTexCoord4fv := SDL_GL_GetProcAddress('glMultiTexCoord4fv');
- if not Assigned(glMultiTexCoord4fv) then Exit;
- @glMultiTexCoord4i := SDL_GL_GetProcAddress('glMultiTexCoord4i');
- if not Assigned(glMultiTexCoord4i) then Exit;
- @glMultiTexCoord4iv := SDL_GL_GetProcAddress('glMultiTexCoord4iv');
- if not Assigned(glMultiTexCoord4iv) then Exit;
- @glMultiTexCoord4s := SDL_GL_GetProcAddress('glMultiTexCoord4s');
- if not Assigned(glMultiTexCoord4s) then Exit;
- @glMultiTexCoord4sv := SDL_GL_GetProcAddress('glMultiTexCoord4sv');
- if not Assigned(glMultiTexCoord4sv) then Exit;
- @glLoadTransposeMatrixf := SDL_GL_GetProcAddress('glLoadTransposeMatrixf');
- if not Assigned(glLoadTransposeMatrixf) then Exit;
- @glLoadTransposeMatrixd := SDL_GL_GetProcAddress('glLoadTransposeMatrixd');
- if not Assigned(glLoadTransposeMatrixd) then Exit;
- @glMultTransposeMatrixf := SDL_GL_GetProcAddress('glMultTransposeMatrixf');
- if not Assigned(glMultTransposeMatrixf) then Exit;
- @glMultTransposeMatrixd := SDL_GL_GetProcAddress('glMultTransposeMatrixd');
- if not Assigned(glMultTransposeMatrixd) then Exit;
- @glSampleCoverage := SDL_GL_GetProcAddress('glSampleCoverage');
- if not Assigned(glSampleCoverage) then Exit;
- @glCompressedTexImage3D := SDL_GL_GetProcAddress('glCompressedTexImage3D');
- if not Assigned(glCompressedTexImage3D) then Exit;
- @glCompressedTexImage2D := SDL_GL_GetProcAddress('glCompressedTexImage2D');
- if not Assigned(glCompressedTexImage2D) then Exit;
- @glCompressedTexImage1D := SDL_GL_GetProcAddress('glCompressedTexImage1D');
- if not Assigned(glCompressedTexImage1D) then Exit;
- @glCompressedTexSubImage3D := SDL_GL_GetProcAddress('glCompressedTexSubImage3D');
- if not Assigned(glCompressedTexSubImage3D) then Exit;
- @glCompressedTexSubImage2D := SDL_GL_GetProcAddress('glCompressedTexSubImage2D');
- if not Assigned(glCompressedTexSubImage2D) then Exit;
- @glCompressedTexSubImage1D := SDL_GL_GetProcAddress('glCompressedTexSubImage1D');
- if not Assigned(glCompressedTexSubImage1D) then Exit;
- @glGetCompressedTexImage := SDL_GL_GetProcAddress('glGetCompressedTexImage');
- if not Assigned(glGetCompressedTexImage) then Exit;
- Result := TRUE;
-
-end;
-
-function Load_GL_ARB_multitexture: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_multitexture', extstring) then
- begin
- @glActiveTextureARB := SDL_GL_GetProcAddress('glActiveTextureARB');
- if not Assigned(glActiveTextureARB) then Exit;
- @glClientActiveTextureARB := SDL_GL_GetProcAddress('glClientActiveTextureARB');
- if not Assigned(glClientActiveTextureARB) then Exit;
- @glMultiTexCoord1dARB := SDL_GL_GetProcAddress('glMultiTexCoord1dARB');
- if not Assigned(glMultiTexCoord1dARB) then Exit;
- @glMultiTexCoord1dvARB := SDL_GL_GetProcAddress('glMultiTexCoord1dvARB');
- if not Assigned(glMultiTexCoord1dvARB) then Exit;
- @glMultiTexCoord1fARB := SDL_GL_GetProcAddress('glMultiTexCoord1fARB');
- if not Assigned(glMultiTexCoord1fARB) then Exit;
- @glMultiTexCoord1fvARB := SDL_GL_GetProcAddress('glMultiTexCoord1fvARB');
- if not Assigned(glMultiTexCoord1fvARB) then Exit;
- @glMultiTexCoord1iARB := SDL_GL_GetProcAddress('glMultiTexCoord1iARB');
- if not Assigned(glMultiTexCoord1iARB) then Exit;
- @glMultiTexCoord1ivARB := SDL_GL_GetProcAddress('glMultiTexCoord1ivARB');
- if not Assigned(glMultiTexCoord1ivARB) then Exit;
- @glMultiTexCoord1sARB := SDL_GL_GetProcAddress('glMultiTexCoord1sARB');
- if not Assigned(glMultiTexCoord1sARB) then Exit;
- @glMultiTexCoord1svARB := SDL_GL_GetProcAddress('glMultiTexCoord1svARB');
- if not Assigned(glMultiTexCoord1svARB) then Exit;
- @glMultiTexCoord2dARB := SDL_GL_GetProcAddress('glMultiTexCoord2dARB');
- if not Assigned(glMultiTexCoord2dARB) then Exit;
- @glMultiTexCoord2dvARB := SDL_GL_GetProcAddress('glMultiTexCoord2dvARB');
- if not Assigned(glMultiTexCoord2dvARB) then Exit;
- @glMultiTexCoord2fARB := SDL_GL_GetProcAddress('glMultiTexCoord2fARB');
- if not Assigned(glMultiTexCoord2fARB) then Exit;
- @glMultiTexCoord2fvARB := SDL_GL_GetProcAddress('glMultiTexCoord2fvARB');
- if not Assigned(glMultiTexCoord2fvARB) then Exit;
- @glMultiTexCoord2iARB := SDL_GL_GetProcAddress('glMultiTexCoord2iARB');
- if not Assigned(glMultiTexCoord2iARB) then Exit;
- @glMultiTexCoord2ivARB := SDL_GL_GetProcAddress('glMultiTexCoord2ivARB');
- if not Assigned(glMultiTexCoord2ivARB) then Exit;
- @glMultiTexCoord2sARB := SDL_GL_GetProcAddress('glMultiTexCoord2sARB');
- if not Assigned(glMultiTexCoord2sARB) then Exit;
- @glMultiTexCoord2svARB := SDL_GL_GetProcAddress('glMultiTexCoord2svARB');
- if not Assigned(glMultiTexCoord2svARB) then Exit;
- @glMultiTexCoord3dARB := SDL_GL_GetProcAddress('glMultiTexCoord3dARB');
- if not Assigned(glMultiTexCoord3dARB) then Exit;
- @glMultiTexCoord3dvARB := SDL_GL_GetProcAddress('glMultiTexCoord3dvARB');
- if not Assigned(glMultiTexCoord3dvARB) then Exit;
- @glMultiTexCoord3fARB := SDL_GL_GetProcAddress('glMultiTexCoord3fARB');
- if not Assigned(glMultiTexCoord3fARB) then Exit;
- @glMultiTexCoord3fvARB := SDL_GL_GetProcAddress('glMultiTexCoord3fvARB');
- if not Assigned(glMultiTexCoord3fvARB) then Exit;
- @glMultiTexCoord3iARB := SDL_GL_GetProcAddress('glMultiTexCoord3iARB');
- if not Assigned(glMultiTexCoord3iARB) then Exit;
- @glMultiTexCoord3ivARB := SDL_GL_GetProcAddress('glMultiTexCoord3ivARB');
- if not Assigned(glMultiTexCoord3ivARB) then Exit;
- @glMultiTexCoord3sARB := SDL_GL_GetProcAddress('glMultiTexCoord3sARB');
- if not Assigned(glMultiTexCoord3sARB) then Exit;
- @glMultiTexCoord3svARB := SDL_GL_GetProcAddress('glMultiTexCoord3svARB');
- if not Assigned(glMultiTexCoord3svARB) then Exit;
- @glMultiTexCoord4dARB := SDL_GL_GetProcAddress('glMultiTexCoord4dARB');
- if not Assigned(glMultiTexCoord4dARB) then Exit;
- @glMultiTexCoord4dvARB := SDL_GL_GetProcAddress('glMultiTexCoord4dvARB');
- if not Assigned(glMultiTexCoord4dvARB) then Exit;
- @glMultiTexCoord4fARB := SDL_GL_GetProcAddress('glMultiTexCoord4fARB');
- if not Assigned(glMultiTexCoord4fARB) then Exit;
- @glMultiTexCoord4fvARB := SDL_GL_GetProcAddress('glMultiTexCoord4fvARB');
- if not Assigned(glMultiTexCoord4fvARB) then Exit;
- @glMultiTexCoord4iARB := SDL_GL_GetProcAddress('glMultiTexCoord4iARB');
- if not Assigned(glMultiTexCoord4iARB) then Exit;
- @glMultiTexCoord4ivARB := SDL_GL_GetProcAddress('glMultiTexCoord4ivARB');
- if not Assigned(glMultiTexCoord4ivARB) then Exit;
- @glMultiTexCoord4sARB := SDL_GL_GetProcAddress('glMultiTexCoord4sARB');
- if not Assigned(glMultiTexCoord4sARB) then Exit;
- @glMultiTexCoord4svARB := SDL_GL_GetProcAddress('glMultiTexCoord4svARB');
- if not Assigned(glMultiTexCoord4svARB) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_transpose_matrix: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_transpose_matrix', extstring) then
- begin
- @glLoadTransposeMatrixfARB := SDL_GL_GetProcAddress('glLoadTransposeMatrixfARB');
- if not Assigned(glLoadTransposeMatrixfARB) then Exit;
- @glLoadTransposeMatrixdARB := SDL_GL_GetProcAddress('glLoadTransposeMatrixdARB');
- if not Assigned(glLoadTransposeMatrixdARB) then Exit;
- @glMultTransposeMatrixfARB := SDL_GL_GetProcAddress('glMultTransposeMatrixfARB');
- if not Assigned(glMultTransposeMatrixfARB) then Exit;
- @glMultTransposeMatrixdARB := SDL_GL_GetProcAddress('glMultTransposeMatrixdARB');
- if not Assigned(glMultTransposeMatrixdARB) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_multisample: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_multisample', extstring) then
- begin
- @glSampleCoverageARB := SDL_GL_GetProcAddress('glSampleCoverageARB');
- if not Assigned(glSampleCoverageARB) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_texture_env_add: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_texture_env_add', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-{$IFDEF WINDOWS}
-function Load_WGL_ARB_extensions_string: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB');
- if not Assigned(wglGetExtensionsStringARB) then Exit;
- extstring := wglGetExtensionsStringARB(wglGetCurrentDC);
-
- if glext_ExtensionSupported('WGL_ARB_extensions_string', extstring) then
- begin
- @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB');
- if not Assigned(wglGetExtensionsStringARB) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_WGL_ARB_buffer_region: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB');
- if not Assigned(wglGetExtensionsStringARB) then Exit;
- extstring := wglGetExtensionsStringARB(wglGetCurrentDC);
-
- if glext_ExtensionSupported('WGL_ARB_buffer_region', extstring) then
- begin
- @wglCreateBufferRegionARB := SDL_GL_GetProcAddress('wglCreateBufferRegionARB');
- if not Assigned(wglCreateBufferRegionARB) then Exit;
- @wglDeleteBufferRegionARB := SDL_GL_GetProcAddress('wglDeleteBufferRegionARB');
- if not Assigned(wglDeleteBufferRegionARB) then Exit;
- @wglSaveBufferRegionARB := SDL_GL_GetProcAddress('wglSaveBufferRegionARB');
- if not Assigned(wglSaveBufferRegionARB) then Exit;
- @wglRestoreBufferRegionARB := SDL_GL_GetProcAddress('wglRestoreBufferRegionARB');
- if not Assigned(wglRestoreBufferRegionARB) then Exit;
- Result := TRUE;
- end;
-
-end;
-{$ENDIF}
-
-function Load_GL_ARB_texture_cube_map: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_texture_cube_map', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_depth_texture: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_depth_texture', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_point_parameters: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_point_parameters', extstring) then
- begin
- @glPointParameterfARB := SDL_GL_GetProcAddress('glPointParameterfARB');
- if not Assigned(glPointParameterfARB) then Exit;
- @glPointParameterfvARB := SDL_GL_GetProcAddress('glPointParameterfvARB');
- if not Assigned(glPointParameterfvARB) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_shadow: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_shadow', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_shadow_ambient: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_shadow_ambient', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_texture_border_clamp: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_texture_border_clamp', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_texture_compression: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_texture_compression', extstring) then
- begin
- @glCompressedTexImage3DARB := SDL_GL_GetProcAddress('glCompressedTexImage3DARB');
- if not Assigned(glCompressedTexImage3DARB) then Exit;
- @glCompressedTexImage2DARB := SDL_GL_GetProcAddress('glCompressedTexImage2DARB');
- if not Assigned(glCompressedTexImage2DARB) then Exit;
- @glCompressedTexImage1DARB := SDL_GL_GetProcAddress('glCompressedTexImage1DARB');
- if not Assigned(glCompressedTexImage1DARB) then Exit;
- @glCompressedTexSubImage3DARB := SDL_GL_GetProcAddress('glCompressedTexSubImage3DARB');
- if not Assigned(glCompressedTexSubImage3DARB) then Exit;
- @glCompressedTexSubImage2DARB := SDL_GL_GetProcAddress('glCompressedTexSubImage2DARB');
- if not Assigned(glCompressedTexSubImage2DARB) then Exit;
- @glCompressedTexSubImage1DARB := SDL_GL_GetProcAddress('glCompressedTexSubImage1DARB');
- if not Assigned(glCompressedTexSubImage1DARB) then Exit;
- @glGetCompressedTexImageARB := SDL_GL_GetProcAddress('glGetCompressedTexImageARB');
- if not Assigned(glGetCompressedTexImageARB) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_texture_env_combine: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_texture_env_combine', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_texture_env_crossbar: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_texture_env_crossbar', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_texture_env_dot3: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_texture_env_dot3', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_texture_mirrored_repeat: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_texture_mirrored_repeat', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_vertex_blend: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_vertex_blend', extstring) then
- begin
- @glWeightbvARB := SDL_GL_GetProcAddress('glWeightbvARB');
- if not Assigned(glWeightbvARB) then Exit;
- @glWeightsvARB := SDL_GL_GetProcAddress('glWeightsvARB');
- if not Assigned(glWeightsvARB) then Exit;
- @glWeightivARB := SDL_GL_GetProcAddress('glWeightivARB');
- if not Assigned(glWeightivARB) then Exit;
- @glWeightfvARB := SDL_GL_GetProcAddress('glWeightfvARB');
- if not Assigned(glWeightfvARB) then Exit;
- @glWeightdvARB := SDL_GL_GetProcAddress('glWeightdvARB');
- if not Assigned(glWeightdvARB) then Exit;
- @glWeightvARB := SDL_GL_GetProcAddress('glWeightvARB');
- if not Assigned(glWeightvARB) then Exit;
- @glWeightubvARB := SDL_GL_GetProcAddress('glWeightubvARB');
- if not Assigned(glWeightubvARB) then Exit;
- @glWeightusvARB := SDL_GL_GetProcAddress('glWeightusvARB');
- if not Assigned(glWeightusvARB) then Exit;
- @glWeightuivARB := SDL_GL_GetProcAddress('glWeightuivARB');
- if not Assigned(glWeightuivARB) then Exit;
- @glWeightPointerARB := SDL_GL_GetProcAddress('glWeightPointerARB');
- if not Assigned(glWeightPointerARB) then Exit;
- @glVertexBlendARB := SDL_GL_GetProcAddress('glVertexBlendARB');
- if not Assigned(glVertexBlendARB) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_vertex_program: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_vertex_program', extstring) then
- begin
- @glVertexAttrib1sARB := SDL_GL_GetProcAddress('glVertexAttrib1sARB');
- if not Assigned(glVertexAttrib1sARB) then Exit;
- @glVertexAttrib1fARB := SDL_GL_GetProcAddress('glVertexAttrib1fARB');
- if not Assigned(glVertexAttrib1fARB) then Exit;
- @glVertexAttrib1dARB := SDL_GL_GetProcAddress('glVertexAttrib1dARB');
- if not Assigned(glVertexAttrib1dARB) then Exit;
- @glVertexAttrib2sARB := SDL_GL_GetProcAddress('glVertexAttrib2sARB');
- if not Assigned(glVertexAttrib2sARB) then Exit;
- @glVertexAttrib2fARB := SDL_GL_GetProcAddress('glVertexAttrib2fARB');
- if not Assigned(glVertexAttrib2fARB) then Exit;
- @glVertexAttrib2dARB := SDL_GL_GetProcAddress('glVertexAttrib2dARB');
- if not Assigned(glVertexAttrib2dARB) then Exit;
- @glVertexAttrib3sARB := SDL_GL_GetProcAddress('glVertexAttrib3sARB');
- if not Assigned(glVertexAttrib3sARB) then Exit;
- @glVertexAttrib3fARB := SDL_GL_GetProcAddress('glVertexAttrib3fARB');
- if not Assigned(glVertexAttrib3fARB) then Exit;
- @glVertexAttrib3dARB := SDL_GL_GetProcAddress('glVertexAttrib3dARB');
- if not Assigned(glVertexAttrib3dARB) then Exit;
- @glVertexAttrib4sARB := SDL_GL_GetProcAddress('glVertexAttrib4sARB');
- if not Assigned(glVertexAttrib4sARB) then Exit;
- @glVertexAttrib4fARB := SDL_GL_GetProcAddress('glVertexAttrib4fARB');
- if not Assigned(glVertexAttrib4fARB) then Exit;
- @glVertexAttrib4dARB := SDL_GL_GetProcAddress('glVertexAttrib4dARB');
- if not Assigned(glVertexAttrib4dARB) then Exit;
- @glVertexAttrib4NubARB := SDL_GL_GetProcAddress('glVertexAttrib4NubARB');
- if not Assigned(glVertexAttrib4NubARB) then Exit;
- @glVertexAttrib1svARB := SDL_GL_GetProcAddress('glVertexAttrib1svARB');
- if not Assigned(glVertexAttrib1svARB) then Exit;
- @glVertexAttrib1fvARB := SDL_GL_GetProcAddress('glVertexAttrib1fvARB');
- if not Assigned(glVertexAttrib1fvARB) then Exit;
- @glVertexAttrib1dvARB := SDL_GL_GetProcAddress('glVertexAttrib1dvARB');
- if not Assigned(glVertexAttrib1dvARB) then Exit;
- @glVertexAttrib2svARB := SDL_GL_GetProcAddress('glVertexAttrib2svARB');
- if not Assigned(glVertexAttrib2svARB) then Exit;
- @glVertexAttrib2fvARB := SDL_GL_GetProcAddress('glVertexAttrib2fvARB');
- if not Assigned(glVertexAttrib2fvARB) then Exit;
- @glVertexAttrib2dvARB := SDL_GL_GetProcAddress('glVertexAttrib2dvARB');
- if not Assigned(glVertexAttrib2dvARB) then Exit;
- @glVertexAttrib3svARB := SDL_GL_GetProcAddress('glVertexAttrib3svARB');
- if not Assigned(glVertexAttrib3svARB) then Exit;
- @glVertexAttrib3fvARB := SDL_GL_GetProcAddress('glVertexAttrib3fvARB');
- if not Assigned(glVertexAttrib3fvARB) then Exit;
- @glVertexAttrib3dvARB := SDL_GL_GetProcAddress('glVertexAttrib3dvARB');
- if not Assigned(glVertexAttrib3dvARB) then Exit;
- @glVertexAttrib4bvARB := SDL_GL_GetProcAddress('glVertexAttrib4bvARB');
- if not Assigned(glVertexAttrib4bvARB) then Exit;
- @glVertexAttrib4svARB := SDL_GL_GetProcAddress('glVertexAttrib4svARB');
- if not Assigned(glVertexAttrib4svARB) then Exit;
- @glVertexAttrib4ivARB := SDL_GL_GetProcAddress('glVertexAttrib4ivARB');
- if not Assigned(glVertexAttrib4ivARB) then Exit;
- @glVertexAttrib4ubvARB := SDL_GL_GetProcAddress('glVertexAttrib4ubvARB');
- if not Assigned(glVertexAttrib4ubvARB) then Exit;
- @glVertexAttrib4usvARB := SDL_GL_GetProcAddress('glVertexAttrib4usvARB');
- if not Assigned(glVertexAttrib4usvARB) then Exit;
- @glVertexAttrib4uivARB := SDL_GL_GetProcAddress('glVertexAttrib4uivARB');
- if not Assigned(glVertexAttrib4uivARB) then Exit;
- @glVertexAttrib4fvARB := SDL_GL_GetProcAddress('glVertexAttrib4fvARB');
- if not Assigned(glVertexAttrib4fvARB) then Exit;
- @glVertexAttrib4dvARB := SDL_GL_GetProcAddress('glVertexAttrib4dvARB');
- if not Assigned(glVertexAttrib4dvARB) then Exit;
- @glVertexAttrib4NbvARB := SDL_GL_GetProcAddress('glVertexAttrib4NbvARB');
- if not Assigned(glVertexAttrib4NbvARB) then Exit;
- @glVertexAttrib4NsvARB := SDL_GL_GetProcAddress('glVertexAttrib4NsvARB');
- if not Assigned(glVertexAttrib4NsvARB) then Exit;
- @glVertexAttrib4NivARB := SDL_GL_GetProcAddress('glVertexAttrib4NivARB');
- if not Assigned(glVertexAttrib4NivARB) then Exit;
- @glVertexAttrib4NubvARB := SDL_GL_GetProcAddress('glVertexAttrib4NubvARB');
- if not Assigned(glVertexAttrib4NubvARB) then Exit;
- @glVertexAttrib4NusvARB := SDL_GL_GetProcAddress('glVertexAttrib4NusvARB');
- if not Assigned(glVertexAttrib4NusvARB) then Exit;
- @glVertexAttrib4NuivARB := SDL_GL_GetProcAddress('glVertexAttrib4NuivARB');
- if not Assigned(glVertexAttrib4NuivARB) then Exit;
- @glVertexAttribPointerARB := SDL_GL_GetProcAddress('glVertexAttribPointerARB');
- if not Assigned(glVertexAttribPointerARB) then Exit;
- @glEnableVertexAttribArrayARB := SDL_GL_GetProcAddress('glEnableVertexAttribArrayARB');
- if not Assigned(glEnableVertexAttribArrayARB) then Exit;
- @glDisableVertexAttribArrayARB := SDL_GL_GetProcAddress('glDisableVertexAttribArrayARB');
- if not Assigned(glDisableVertexAttribArrayARB) then Exit;
- @glProgramStringARB := SDL_GL_GetProcAddress('glProgramStringARB');
- if not Assigned(glProgramStringARB) then Exit;
- @glBindProgramARB := SDL_GL_GetProcAddress('glBindProgramARB');
- if not Assigned(glBindProgramARB) then Exit;
- @glDeleteProgramsARB := SDL_GL_GetProcAddress('glDeleteProgramsARB');
- if not Assigned(glDeleteProgramsARB) then Exit;
- @glGenProgramsARB := SDL_GL_GetProcAddress('glGenProgramsARB');
- if not Assigned(glGenProgramsARB) then Exit;
- @glProgramEnvParameter4dARB := SDL_GL_GetProcAddress('glProgramEnvParameter4dARB');
- if not Assigned(glProgramEnvParameter4dARB) then Exit;
- @glProgramEnvParameter4dvARB := SDL_GL_GetProcAddress('glProgramEnvParameter4dvARB');
- if not Assigned(glProgramEnvParameter4dvARB) then Exit;
- @glProgramEnvParameter4fARB := SDL_GL_GetProcAddress('glProgramEnvParameter4fARB');
- if not Assigned(glProgramEnvParameter4fARB) then Exit;
- @glProgramEnvParameter4fvARB := SDL_GL_GetProcAddress('glProgramEnvParameter4fvARB');
- if not Assigned(glProgramEnvParameter4fvARB) then Exit;
- @glProgramLocalParameter4dARB := SDL_GL_GetProcAddress('glProgramLocalParameter4dARB');
- if not Assigned(glProgramLocalParameter4dARB) then Exit;
- @glProgramLocalParameter4dvARB := SDL_GL_GetProcAddress('glProgramLocalParameter4dvARB');
- if not Assigned(glProgramLocalParameter4dvARB) then Exit;
- @glProgramLocalParameter4fARB := SDL_GL_GetProcAddress('glProgramLocalParameter4fARB');
- if not Assigned(glProgramLocalParameter4fARB) then Exit;
- @glProgramLocalParameter4fvARB := SDL_GL_GetProcAddress('glProgramLocalParameter4fvARB');
- if not Assigned(glProgramLocalParameter4fvARB) then Exit;
- @glGetProgramEnvParameterdvARB := SDL_GL_GetProcAddress('glGetProgramEnvParameterdvARB');
- if not Assigned(glGetProgramEnvParameterdvARB) then Exit;
- @glGetProgramEnvParameterfvARB := SDL_GL_GetProcAddress('glGetProgramEnvParameterfvARB');
- if not Assigned(glGetProgramEnvParameterfvARB) then Exit;
- @glGetProgramLocalParameterdvARB := SDL_GL_GetProcAddress('glGetProgramLocalParameterdvARB');
- if not Assigned(glGetProgramLocalParameterdvARB) then Exit;
- @glGetProgramLocalParameterfvARB := SDL_GL_GetProcAddress('glGetProgramLocalParameterfvARB');
- if not Assigned(glGetProgramLocalParameterfvARB) then Exit;
- @glGetProgramivARB := SDL_GL_GetProcAddress('glGetProgramivARB');
- if not Assigned(glGetProgramivARB) then Exit;
- @glGetProgramStringARB := SDL_GL_GetProcAddress('glGetProgramStringARB');
- if not Assigned(glGetProgramStringARB) then Exit;
- @glGetVertexAttribdvARB := SDL_GL_GetProcAddress('glGetVertexAttribdvARB');
- if not Assigned(glGetVertexAttribdvARB) then Exit;
- @glGetVertexAttribfvARB := SDL_GL_GetProcAddress('glGetVertexAttribfvARB');
- if not Assigned(glGetVertexAttribfvARB) then Exit;
- @glGetVertexAttribivARB := SDL_GL_GetProcAddress('glGetVertexAttribivARB');
- if not Assigned(glGetVertexAttribivARB) then Exit;
- @glGetVertexAttribPointervARB := SDL_GL_GetProcAddress('glGetVertexAttribPointervARB');
- if not Assigned(glGetVertexAttribPointervARB) then Exit;
- @glIsProgramARB := SDL_GL_GetProcAddress('glIsProgramARB');
- if not Assigned(glIsProgramARB) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_window_pos: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_window_pos', extstring) then
- begin
- @glWindowPos2dARB := SDL_GL_GetProcAddress('glWindowPos2dARB');
- if not Assigned(glWindowPos2dARB) then Exit;
- @glWindowPos2fARB := SDL_GL_GetProcAddress('glWindowPos2fARB');
- if not Assigned(glWindowPos2fARB) then Exit;
- @glWindowPos2iARB := SDL_GL_GetProcAddress('glWindowPos2iARB');
- if not Assigned(glWindowPos2iARB) then Exit;
- @glWindowPos2sARB := SDL_GL_GetProcAddress('glWindowPos2sARB');
- if not Assigned(glWindowPos2sARB) then Exit;
- @glWindowPos2dvARB := SDL_GL_GetProcAddress('glWindowPos2dvARB');
- if not Assigned(glWindowPos2dvARB) then Exit;
- @glWindowPos2fvARB := SDL_GL_GetProcAddress('glWindowPos2fvARB');
- if not Assigned(glWindowPos2fvARB) then Exit;
- @glWindowPos2ivARB := SDL_GL_GetProcAddress('glWindowPos2ivARB');
- if not Assigned(glWindowPos2ivARB) then Exit;
- @glWindowPos2svARB := SDL_GL_GetProcAddress('glWindowPos2svARB');
- if not Assigned(glWindowPos2svARB) then Exit;
- @glWindowPos3dARB := SDL_GL_GetProcAddress('glWindowPos3dARB');
- if not Assigned(glWindowPos3dARB) then Exit;
- @glWindowPos3fARB := SDL_GL_GetProcAddress('glWindowPos3fARB');
- if not Assigned(glWindowPos3fARB) then Exit;
- @glWindowPos3iARB := SDL_GL_GetProcAddress('glWindowPos3iARB');
- if not Assigned(glWindowPos3iARB) then Exit;
- @glWindowPos3sARB := SDL_GL_GetProcAddress('glWindowPos3sARB');
- if not Assigned(glWindowPos3sARB) then Exit;
- @glWindowPos3dvARB := SDL_GL_GetProcAddress('glWindowPos3dvARB');
- if not Assigned(glWindowPos3dvARB) then Exit;
- @glWindowPos3fvARB := SDL_GL_GetProcAddress('glWindowPos3fvARB');
- if not Assigned(glWindowPos3fvARB) then Exit;
- @glWindowPos3ivARB := SDL_GL_GetProcAddress('glWindowPos3ivARB');
- if not Assigned(glWindowPos3ivARB) then Exit;
- @glWindowPos3svARB := SDL_GL_GetProcAddress('glWindowPos3svARB');
- if not Assigned(glWindowPos3svARB) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_422_pixels: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_422_pixels', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_abgr: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_abgr', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_bgra: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_bgra', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_blend_color: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_blend_color', extstring) then
- begin
- @glBlendColorEXT := SDL_GL_GetProcAddress('glBlendColorEXT');
- if not Assigned(glBlendColorEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_blend_func_separate: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_blend_func_separate', extstring) then
- begin
- @glBlendFuncSeparateEXT := SDL_GL_GetProcAddress('glBlendFuncSeparateEXT');
- if not Assigned(glBlendFuncSeparateEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_blend_logic_op: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_blend_logic_op', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_blend_minmax: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_blend_minmax', extstring) then
- begin
- @glBlendEquationEXT := SDL_GL_GetProcAddress('glBlendEquationEXT');
- if not Assigned(glBlendEquationEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_blend_subtract: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_blend_subtract', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_clip_volume_hint: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_clip_volume_hint', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_color_subtable: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_color_subtable', extstring) then
- begin
- @glColorSubTableEXT := SDL_GL_GetProcAddress('glColorSubTableEXT');
- if not Assigned(glColorSubTableEXT) then Exit;
- @glCopyColorSubTableEXT := SDL_GL_GetProcAddress('glCopyColorSubTableEXT');
- if not Assigned(glCopyColorSubTableEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_compiled_vertex_array: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_compiled_vertex_array', extstring) then
- begin
- @glLockArraysEXT := SDL_GL_GetProcAddress('glLockArraysEXT');
- if not Assigned(glLockArraysEXT) then Exit;
- @glUnlockArraysEXT := SDL_GL_GetProcAddress('glUnlockArraysEXT');
- if not Assigned(glUnlockArraysEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_convolution: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_convolution', extstring) then
- begin
- @glConvolutionFilter1DEXT := SDL_GL_GetProcAddress('glConvolutionFilter1DEXT');
- if not Assigned(glConvolutionFilter1DEXT) then Exit;
- @glConvolutionFilter2DEXT := SDL_GL_GetProcAddress('glConvolutionFilter2DEXT');
- if not Assigned(glConvolutionFilter2DEXT) then Exit;
- @glCopyConvolutionFilter1DEXT := SDL_GL_GetProcAddress('glCopyConvolutionFilter1DEXT');
- if not Assigned(glCopyConvolutionFilter1DEXT) then Exit;
- @glCopyConvolutionFilter2DEXT := SDL_GL_GetProcAddress('glCopyConvolutionFilter2DEXT');
- if not Assigned(glCopyConvolutionFilter2DEXT) then Exit;
- @glGetConvolutionFilterEXT := SDL_GL_GetProcAddress('glGetConvolutionFilterEXT');
- if not Assigned(glGetConvolutionFilterEXT) then Exit;
- @glSeparableFilter2DEXT := SDL_GL_GetProcAddress('glSeparableFilter2DEXT');
- if not Assigned(glSeparableFilter2DEXT) then Exit;
- @glGetSeparableFilterEXT := SDL_GL_GetProcAddress('glGetSeparableFilterEXT');
- if not Assigned(glGetSeparableFilterEXT) then Exit;
- @glConvolutionParameteriEXT := SDL_GL_GetProcAddress('glConvolutionParameteriEXT');
- if not Assigned(glConvolutionParameteriEXT) then Exit;
- @glConvolutionParameterivEXT := SDL_GL_GetProcAddress('glConvolutionParameterivEXT');
- if not Assigned(glConvolutionParameterivEXT) then Exit;
- @glConvolutionParameterfEXT := SDL_GL_GetProcAddress('glConvolutionParameterfEXT');
- if not Assigned(glConvolutionParameterfEXT) then Exit;
- @glConvolutionParameterfvEXT := SDL_GL_GetProcAddress('glConvolutionParameterfvEXT');
- if not Assigned(glConvolutionParameterfvEXT) then Exit;
- @glGetConvolutionParameterivEXT := SDL_GL_GetProcAddress('glGetConvolutionParameterivEXT');
- if not Assigned(glGetConvolutionParameterivEXT) then Exit;
- @glGetConvolutionParameterfvEXT := SDL_GL_GetProcAddress('glGetConvolutionParameterfvEXT');
- if not Assigned(glGetConvolutionParameterfvEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_histogram: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_histogram', extstring) then
- begin
- @glHistogramEXT := SDL_GL_GetProcAddress('glHistogramEXT');
- if not Assigned(glHistogramEXT) then Exit;
- @glResetHistogramEXT := SDL_GL_GetProcAddress('glResetHistogramEXT');
- if not Assigned(glResetHistogramEXT) then Exit;
- @glGetHistogramEXT := SDL_GL_GetProcAddress('glGetHistogramEXT');
- if not Assigned(glGetHistogramEXT) then Exit;
- @glGetHistogramParameterivEXT := SDL_GL_GetProcAddress('glGetHistogramParameterivEXT');
- if not Assigned(glGetHistogramParameterivEXT) then Exit;
- @glGetHistogramParameterfvEXT := SDL_GL_GetProcAddress('glGetHistogramParameterfvEXT');
- if not Assigned(glGetHistogramParameterfvEXT) then Exit;
- @glMinmaxEXT := SDL_GL_GetProcAddress('glMinmaxEXT');
- if not Assigned(glMinmaxEXT) then Exit;
- @glResetMinmaxEXT := SDL_GL_GetProcAddress('glResetMinmaxEXT');
- if not Assigned(glResetMinmaxEXT) then Exit;
- @glGetMinmaxEXT := SDL_GL_GetProcAddress('glGetMinmaxEXT');
- if not Assigned(glGetMinmaxEXT) then Exit;
- @glGetMinmaxParameterivEXT := SDL_GL_GetProcAddress('glGetMinmaxParameterivEXT');
- if not Assigned(glGetMinmaxParameterivEXT) then Exit;
- @glGetMinmaxParameterfvEXT := SDL_GL_GetProcAddress('glGetMinmaxParameterfvEXT');
- if not Assigned(glGetMinmaxParameterfvEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_multi_draw_arrays: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_multi_draw_arrays', extstring) then
- begin
- @glMultiDrawArraysEXT := SDL_GL_GetProcAddress('glMultiDrawArraysEXT');
- if not Assigned(glMultiDrawArraysEXT) then Exit;
- @glMultiDrawElementsEXT := SDL_GL_GetProcAddress('glMultiDrawElementsEXT');
- if not Assigned(glMultiDrawElementsEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_packed_pixels: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_packed_pixels', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_paletted_texture: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_paletted_texture', extstring) then
- begin
- @glColorTableEXT := SDL_GL_GetProcAddress('glColorTableEXT');
- if not Assigned(glColorTableEXT) then Exit;
- @glColorSubTableEXT := SDL_GL_GetProcAddress('glColorSubTableEXT');
- if not Assigned(glColorSubTableEXT) then Exit;
- @glGetColorTableEXT := SDL_GL_GetProcAddress('glGetColorTableEXT');
- if not Assigned(glGetColorTableEXT) then Exit;
- @glGetColorTableParameterivEXT := SDL_GL_GetProcAddress('glGetColorTableParameterivEXT');
- if not Assigned(glGetColorTableParameterivEXT) then Exit;
- @glGetColorTableParameterfvEXT := SDL_GL_GetProcAddress('glGetColorTableParameterfvEXT');
- if not Assigned(glGetColorTableParameterfvEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_point_parameters: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_point_parameters', extstring) then
- begin
- @glPointParameterfEXT := SDL_GL_GetProcAddress('glPointParameterfEXT');
- if not Assigned(glPointParameterfEXT) then Exit;
- @glPointParameterfvEXT := SDL_GL_GetProcAddress('glPointParameterfvEXT');
- if not Assigned(glPointParameterfvEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_polygon_offset: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_polygon_offset', extstring) then
- begin
- @glPolygonOffsetEXT := SDL_GL_GetProcAddress('glPolygonOffsetEXT');
- if not Assigned(glPolygonOffsetEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_separate_specular_color: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_separate_specular_color', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_shadow_funcs: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_shadow_funcs', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_shared_texture_palette: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_shared_texture_palette', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_stencil_two_side: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_stencil_two_side', extstring) then
- begin
- @glActiveStencilFaceEXT := SDL_GL_GetProcAddress('glActiveStencilFaceEXT');
- if not Assigned(glActiveStencilFaceEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_stencil_wrap: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_stencil_wrap', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_subtexture: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_subtexture', extstring) then
- begin
- @glTexSubImage1DEXT := SDL_GL_GetProcAddress('glTexSubImage1DEXT');
- if not Assigned(glTexSubImage1DEXT) then Exit;
- @glTexSubImage2DEXT := SDL_GL_GetProcAddress('glTexSubImage2DEXT');
- if not Assigned(glTexSubImage2DEXT) then Exit;
- @glTexSubImage3DEXT := SDL_GL_GetProcAddress('glTexSubImage3DEXT');
- if not Assigned(glTexSubImage3DEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_texture3D: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_texture3D', extstring) then
- begin
- glTexImage3DEXT := SDL_GL_GetProcAddress('glTexImage3DEXT');
- if not Assigned(glTexImage3DEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_texture_compression_s3tc: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_texture_compression_s3tc', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_texture_env_add: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_texture_env_add', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_texture_env_combine: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_texture_env_combine', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_texture_env_dot3: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_texture_env_dot3', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_texture_filter_anisotropic: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_texture_filter_anisotropic', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_texture_lod_bias: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_texture_lod_bias', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_texture_object: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_texture_object', extstring) then
- begin
- @glGenTexturesEXT := SDL_GL_GetProcAddress('glGenTexturesEXT');
- if not Assigned(glGenTexturesEXT) then Exit;
- @glDeleteTexturesEXT := SDL_GL_GetProcAddress('glDeleteTexturesEXT');
- if not Assigned(glDeleteTexturesEXT) then Exit;
- @glBindTextureEXT := SDL_GL_GetProcAddress('glBindTextureEXT');
- if not Assigned(glBindTextureEXT) then Exit;
- @glPrioritizeTexturesEXT := SDL_GL_GetProcAddress('glPrioritizeTexturesEXT');
- if not Assigned(glPrioritizeTexturesEXT) then Exit;
- @glAreTexturesResidentEXT := SDL_GL_GetProcAddress('glAreTexturesResidentEXT');
- if not Assigned(glAreTexturesResidentEXT) then Exit;
- @glIsTextureEXT := SDL_GL_GetProcAddress('glIsTextureEXT');
- if not Assigned(glIsTextureEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_vertex_array: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_vertex_array', extstring) then
- begin
- @glArrayElementEXT := SDL_GL_GetProcAddress('glArrayElementEXT');
- if not Assigned(glArrayElementEXT) then Exit;
- @glDrawArraysEXT := SDL_GL_GetProcAddress('glDrawArraysEXT');
- if not Assigned(glDrawArraysEXT) then Exit;
- @glVertexPointerEXT := SDL_GL_GetProcAddress('glVertexPointerEXT');
- if not Assigned(glVertexPointerEXT) then Exit;
- @glNormalPointerEXT := SDL_GL_GetProcAddress('glNormalPointerEXT');
- if not Assigned(glNormalPointerEXT) then Exit;
- @glColorPointerEXT := SDL_GL_GetProcAddress('glColorPointerEXT');
- if not Assigned(glColorPointerEXT) then Exit;
- @glIndexPointerEXT := SDL_GL_GetProcAddress('glIndexPointerEXT');
- if not Assigned(glIndexPointerEXT) then Exit;
- @glTexCoordPointerEXT := SDL_GL_GetProcAddress('glTexCoordPointerEXT');
- if not Assigned(glTexCoordPointerEXT) then Exit;
- @glEdgeFlagPointerEXT := SDL_GL_GetProcAddress('glEdgeFlagPointerEXT');
- if not Assigned(glEdgeFlagPointerEXT) then Exit;
- @glGetPointervEXT := SDL_GL_GetProcAddress('glGetPointervEXT');
- if not Assigned(glGetPointervEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_vertex_shader: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_vertex_shader', extstring) then
- begin
- @glBeginVertexShaderEXT := SDL_GL_GetProcAddress('glBeginVertexShaderEXT');
- if not Assigned(glBeginVertexShaderEXT) then Exit;
- @glEndVertexShaderEXT := SDL_GL_GetProcAddress('glEndVertexShaderEXT');
- if not Assigned(glEndVertexShaderEXT) then Exit;
- @glBindVertexShaderEXT := SDL_GL_GetProcAddress('glBindVertexShaderEXT');
- if not Assigned(glBindVertexShaderEXT) then Exit;
- @glGenVertexShadersEXT := SDL_GL_GetProcAddress('glGenVertexShadersEXT');
- if not Assigned(glGenVertexShadersEXT) then Exit;
- @glDeleteVertexShaderEXT := SDL_GL_GetProcAddress('glDeleteVertexShaderEXT');
- if not Assigned(glDeleteVertexShaderEXT) then Exit;
- @glShaderOp1EXT := SDL_GL_GetProcAddress('glShaderOp1EXT');
- if not Assigned(glShaderOp1EXT) then Exit;
- @glShaderOp2EXT := SDL_GL_GetProcAddress('glShaderOp2EXT');
- if not Assigned(glShaderOp2EXT) then Exit;
- @glShaderOp3EXT := SDL_GL_GetProcAddress('glShaderOp3EXT');
- if not Assigned(glShaderOp3EXT) then Exit;
- @glSwizzleEXT := SDL_GL_GetProcAddress('glSwizzleEXT');
- if not Assigned(glSwizzleEXT) then Exit;
- @glWriteMaskEXT := SDL_GL_GetProcAddress('glWriteMaskEXT');
- if not Assigned(glWriteMaskEXT) then Exit;
- @glInsertComponentEXT := SDL_GL_GetProcAddress('glInsertComponentEXT');
- if not Assigned(glInsertComponentEXT) then Exit;
- @glExtractComponentEXT := SDL_GL_GetProcAddress('glExtractComponentEXT');
- if not Assigned(glExtractComponentEXT) then Exit;
- @glGenSymbolsEXT := SDL_GL_GetProcAddress('glGenSymbolsEXT');
- if not Assigned(glGenSymbolsEXT) then Exit;
- @glSetInvariantEXT := SDL_GL_GetProcAddress('glSetInvariantEXT');
- if not Assigned(glSetInvariantEXT) then Exit;
- @glSetLocalConstantEXT := SDL_GL_GetProcAddress('glSetLocalConstantEXT');
- if not Assigned(glSetLocalConstantEXT) then Exit;
- @glVariantbvEXT := SDL_GL_GetProcAddress('glVariantbvEXT');
- if not Assigned(glVariantbvEXT) then Exit;
- @glVariantsvEXT := SDL_GL_GetProcAddress('glVariantsvEXT');
- if not Assigned(glVariantsvEXT) then Exit;
- @glVariantivEXT := SDL_GL_GetProcAddress('glVariantivEXT');
- if not Assigned(glVariantivEXT) then Exit;
- @glVariantfvEXT := SDL_GL_GetProcAddress('glVariantfvEXT');
- if not Assigned(glVariantfvEXT) then Exit;
- @glVariantdvEXT := SDL_GL_GetProcAddress('glVariantdvEXT');
- if not Assigned(glVariantdvEXT) then Exit;
- @glVariantubvEXT := SDL_GL_GetProcAddress('glVariantubvEXT');
- if not Assigned(glVariantubvEXT) then Exit;
- @glVariantusvEXT := SDL_GL_GetProcAddress('glVariantusvEXT');
- if not Assigned(glVariantusvEXT) then Exit;
- @glVariantuivEXT := SDL_GL_GetProcAddress('glVariantuivEXT');
- if not Assigned(glVariantuivEXT) then Exit;
- @glVariantPointerEXT := SDL_GL_GetProcAddress('glVariantPointerEXT');
- if not Assigned(glVariantPointerEXT) then Exit;
- @glEnableVariantClientStateEXT := SDL_GL_GetProcAddress('glEnableVariantClientStateEXT');
- if not Assigned(glEnableVariantClientStateEXT) then Exit;
- @glDisableVariantClientStateEXT := SDL_GL_GetProcAddress('glDisableVariantClientStateEXT');
- if not Assigned(glDisableVariantClientStateEXT) then Exit;
- @glBindLightParameterEXT := SDL_GL_GetProcAddress('glBindLightParameterEXT');
- if not Assigned(glBindLightParameterEXT) then Exit;
- @glBindMaterialParameterEXT := SDL_GL_GetProcAddress('glBindMaterialParameterEXT');
- if not Assigned(glBindMaterialParameterEXT) then Exit;
- @glBindTexGenParameterEXT := SDL_GL_GetProcAddress('glBindTexGenParameterEXT');
- if not Assigned(glBindTexGenParameterEXT) then Exit;
- @glBindTextureUnitParameterEXT := SDL_GL_GetProcAddress('glBindTextureUnitParameterEXT');
- if not Assigned(glBindTextureUnitParameterEXT) then Exit;
- @glBindParameterEXT := SDL_GL_GetProcAddress('glBindParameterEXT');
- if not Assigned(glBindParameterEXT) then Exit;
- @glIsVariantEnabledEXT := SDL_GL_GetProcAddress('glIsVariantEnabledEXT');
- if not Assigned(glIsVariantEnabledEXT) then Exit;
- @glGetVariantBooleanvEXT := SDL_GL_GetProcAddress('glGetVariantBooleanvEXT');
- if not Assigned(glGetVariantBooleanvEXT) then Exit;
- @glGetVariantIntegervEXT := SDL_GL_GetProcAddress('glGetVariantIntegervEXT');
- if not Assigned(glGetVariantIntegervEXT) then Exit;
- @glGetVariantFloatvEXT := SDL_GL_GetProcAddress('glGetVariantFloatvEXT');
- if not Assigned(glGetVariantFloatvEXT) then Exit;
- @glGetVariantPointervEXT := SDL_GL_GetProcAddress('glGetVariantPointervEXT');
- if not Assigned(glGetVariantPointervEXT) then Exit;
- @glGetInvariantBooleanvEXT := SDL_GL_GetProcAddress('glGetInvariantBooleanvEXT');
- if not Assigned(glGetInvariantBooleanvEXT) then Exit;
- @glGetInvariantIntegervEXT := SDL_GL_GetProcAddress('glGetInvariantIntegervEXT');
- if not Assigned(glGetInvariantIntegervEXT) then Exit;
- @glGetInvariantFloatvEXT := SDL_GL_GetProcAddress('glGetInvariantFloatvEXT');
- if not Assigned(glGetInvariantFloatvEXT) then Exit;
- @glGetLocalConstantBooleanvEXT := SDL_GL_GetProcAddress('glGetLocalConstantBooleanvEXT');
- if not Assigned(glGetLocalConstantBooleanvEXT) then Exit;
- @glGetLocalConstantIntegervEXT := SDL_GL_GetProcAddress('glGetLocalConstantIntegervEXT');
- if not Assigned(glGetLocalConstantIntegervEXT) then Exit;
- @glGetLocalConstantFloatvEXT := SDL_GL_GetProcAddress('glGetLocalConstantFloatvEXT');
- if not Assigned(glGetLocalConstantFloatvEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_vertex_weighting: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_vertex_weighting', extstring) then
- begin
- @glVertexWeightfEXT := SDL_GL_GetProcAddress('glVertexWeightfEXT');
- if not Assigned(glVertexWeightfEXT) then Exit;
- @glVertexWeightfvEXT := SDL_GL_GetProcAddress('glVertexWeightfvEXT');
- if not Assigned(glVertexWeightfvEXT) then Exit;
- @glVertexWeightPointerEXT := SDL_GL_GetProcAddress('glVertexWeightPointerEXT');
- if not Assigned(glVertexWeightPointerEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_HP_occlusion_test: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_HP_occlusion_test', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_blend_square: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_blend_square', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_copy_depth_to_color: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_copy_depth_to_color', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_depth_clamp: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_depth_clamp', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_evaluators: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_evaluators', extstring) then
- begin
- @glMapControlPointsNV := SDL_GL_GetProcAddress('glMapControlPointsNV');
- if not Assigned(glMapControlPointsNV) then Exit;
- @glMapParameterivNV := SDL_GL_GetProcAddress('glMapParameterivNV');
- if not Assigned(glMapParameterivNV) then Exit;
- @glMapParameterfvNV := SDL_GL_GetProcAddress('glMapParameterfvNV');
- if not Assigned(glMapParameterfvNV) then Exit;
- @glGetMapControlPointsNV := SDL_GL_GetProcAddress('glGetMapControlPointsNV');
- if not Assigned(glGetMapControlPointsNV) then Exit;
- @glGetMapParameterivNV := SDL_GL_GetProcAddress('glGetMapParameterivNV');
- if not Assigned(glGetMapParameterivNV) then Exit;
- @glGetMapParameterfvNV := SDL_GL_GetProcAddress('glGetMapParameterfvNV');
- if not Assigned(glGetMapParameterfvNV) then Exit;
- @glGetMapAttribParameterivNV := SDL_GL_GetProcAddress('glGetMapAttribParameterivNV');
- if not Assigned(glGetMapAttribParameterivNV) then Exit;
- @glGetMapAttribParameterfvNV := SDL_GL_GetProcAddress('glGetMapAttribParameterfvNV');
- if not Assigned(glGetMapAttribParameterfvNV) then Exit;
- @glEvalMapsNV := SDL_GL_GetProcAddress('glEvalMapsNV');
- if not Assigned(glEvalMapsNV) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_fence: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_fence', extstring) then
- begin
- @glGenFencesNV := SDL_GL_GetProcAddress('glGenFencesNV');
- if not Assigned(glGenFencesNV) then Exit;
- @glDeleteFencesNV := SDL_GL_GetProcAddress('glDeleteFencesNV');
- if not Assigned(glDeleteFencesNV) then Exit;
- @glSetFenceNV := SDL_GL_GetProcAddress('glSetFenceNV');
- if not Assigned(glSetFenceNV) then Exit;
- @glTestFenceNV := SDL_GL_GetProcAddress('glTestFenceNV');
- if not Assigned(glTestFenceNV) then Exit;
- @glFinishFenceNV := SDL_GL_GetProcAddress('glFinishFenceNV');
- if not Assigned(glFinishFenceNV) then Exit;
- @glIsFenceNV := SDL_GL_GetProcAddress('glIsFenceNV');
- if not Assigned(glIsFenceNV) then Exit;
- @glGetFenceivNV := SDL_GL_GetProcAddress('glGetFenceivNV');
- if not Assigned(glGetFenceivNV) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_fog_distance: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_fog_distance', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_light_max_exponent: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_light_max_exponent', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_multisample_filter_hint: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_multisample_filter_hint', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_occlusion_query: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_occlusion_query', extstring) then
- begin
- @glGenOcclusionQueriesNV := SDL_GL_GetProcAddress('glGenOcclusionQueriesNV');
- if not Assigned(glGenOcclusionQueriesNV) then Exit;
- @glDeleteOcclusionQueriesNV := SDL_GL_GetProcAddress('glDeleteOcclusionQueriesNV');
- if not Assigned(glDeleteOcclusionQueriesNV) then Exit;
- @glIsOcclusionQueryNV := SDL_GL_GetProcAddress('glIsOcclusionQueryNV');
- if not Assigned(glIsOcclusionQueryNV) then Exit;
- @glBeginOcclusionQueryNV := SDL_GL_GetProcAddress('glBeginOcclusionQueryNV');
- if not Assigned(glBeginOcclusionQueryNV) then Exit;
- @glEndOcclusionQueryNV := SDL_GL_GetProcAddress('glEndOcclusionQueryNV');
- if not Assigned(glEndOcclusionQueryNV) then Exit;
- @glGetOcclusionQueryivNV := SDL_GL_GetProcAddress('glGetOcclusionQueryivNV');
- if not Assigned(glGetOcclusionQueryivNV) then Exit;
- @glGetOcclusionQueryuivNV := SDL_GL_GetProcAddress('glGetOcclusionQueryuivNV');
- if not Assigned(glGetOcclusionQueryuivNV) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_packed_depth_stencil: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_packed_depth_stencil', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_point_sprite: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_point_sprite', extstring) then
- begin
- @glPointParameteriNV := SDL_GL_GetProcAddress('glPointParameteriNV');
- if not Assigned(glPointParameteriNV) then Exit;
- @glPointParameterivNV := SDL_GL_GetProcAddress('glPointParameterivNV');
- if not Assigned(glPointParameterivNV) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_register_combiners: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_register_combiners', extstring) then
- begin
- @glCombinerParameterfvNV := SDL_GL_GetProcAddress('glCombinerParameterfvNV');
- if not Assigned(glCombinerParameterfvNV) then Exit;
- @glCombinerParameterivNV := SDL_GL_GetProcAddress('glCombinerParameterivNV');
- if not Assigned(glCombinerParameterivNV) then Exit;
- @glCombinerParameterfNV := SDL_GL_GetProcAddress('glCombinerParameterfNV');
- if not Assigned(glCombinerParameterfNV) then Exit;
- @glCombinerParameteriNV := SDL_GL_GetProcAddress('glCombinerParameteriNV');
- if not Assigned(glCombinerParameteriNV) then Exit;
- @glCombinerInputNV := SDL_GL_GetProcAddress('glCombinerInputNV');
- if not Assigned(glCombinerInputNV) then Exit;
- @glCombinerOutputNV := SDL_GL_GetProcAddress('glCombinerOutputNV');
- if not Assigned(glCombinerOutputNV) then Exit;
- @glFinalCombinerInputNV := SDL_GL_GetProcAddress('glFinalCombinerInputNV');
- if not Assigned(glFinalCombinerInputNV) then Exit;
- @glGetCombinerInputParameterfvNV := SDL_GL_GetProcAddress('glGetCombinerInputParameterfvNV');
- if not Assigned(glGetCombinerInputParameterfvNV) then Exit;
- @glGetCombinerInputParameterivNV := SDL_GL_GetProcAddress('glGetCombinerInputParameterivNV');
- if not Assigned(glGetCombinerInputParameterivNV) then Exit;
- @glGetCombinerOutputParameterfvNV := SDL_GL_GetProcAddress('glGetCombinerOutputParameterfvNV');
- if not Assigned(glGetCombinerOutputParameterfvNV) then Exit;
- @glGetCombinerOutputParameterivNV := SDL_GL_GetProcAddress('glGetCombinerOutputParameterivNV');
- if not Assigned(glGetCombinerOutputParameterivNV) then Exit;
- @glGetFinalCombinerInputParameterfvNV := SDL_GL_GetProcAddress('glGetFinalCombinerInputParameterfvNV');
- if not Assigned(glGetFinalCombinerInputParameterfvNV) then Exit;
- @glGetFinalCombinerInputParameterivNV := SDL_GL_GetProcAddress('glGetFinalCombinerInputParameterivNV');
- if not Assigned(glGetFinalCombinerInputParameterivNV) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_register_combiners2: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_register_combiners2', extstring) then
- begin
- @glCombinerStageParameterfvNV := SDL_GL_GetProcAddress('glCombinerStageParameterfvNV');
- if not Assigned(glCombinerStageParameterfvNV) then Exit;
- @glGetCombinerStageParameterfvNV := SDL_GL_GetProcAddress('glGetCombinerStageParameterfvNV');
- if not Assigned(glGetCombinerStageParameterfvNV) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_texgen_emboss: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_texgen_emboss', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_texgen_reflection: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_texgen_reflection', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_texture_compression_vtc: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_texture_compression_vtc', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_texture_env_combine4: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_texture_env_combine4', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_texture_rectangle: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_texture_rectangle', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_texture_shader: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_texture_shader', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_texture_shader2: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_texture_shader2', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_texture_shader3: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_texture_shader3', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_vertex_array_range: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_vertex_array_range', extstring) then
- begin
- @glVertexArrayRangeNV := SDL_GL_GetProcAddress('glVertexArrayRangeNV');
- if not Assigned(glVertexArrayRangeNV) then Exit;
- @glFlushVertexArrayRangeNV := SDL_GL_GetProcAddress('glFlushVertexArrayRangeNV');
- if not Assigned(glFlushVertexArrayRangeNV) then Exit;
- {$IFDEF WINDOWS}
- @wglAllocateMemoryNV := SDL_GL_GetProcAddress('wglAllocateMemoryNV');
- if not Assigned(wglAllocateMemoryNV) then Exit;
- @wglFreeMemoryNV := SDL_GL_GetProcAddress('wglFreeMemoryNV');
- if not Assigned(wglFreeMemoryNV) then Exit;
- {$ENDIF}
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_vertex_array_range2: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_vertex_array_range2', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_vertex_program: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_vertex_program', extstring) then
- begin
- @glBindProgramNV := SDL_GL_GetProcAddress('glBindProgramNV');
- if not Assigned(glBindProgramNV) then Exit;
- @glDeleteProgramsNV := SDL_GL_GetProcAddress('glDeleteProgramsNV');
- if not Assigned(glDeleteProgramsNV) then Exit;
- @glExecuteProgramNV := SDL_GL_GetProcAddress('glExecuteProgramNV');
- if not Assigned(glExecuteProgramNV) then Exit;
- @glGenProgramsNV := SDL_GL_GetProcAddress('glGenProgramsNV');
- if not Assigned(glGenProgramsNV) then Exit;
- @glAreProgramsResidentNV := SDL_GL_GetProcAddress('glAreProgramsResidentNV');
- if not Assigned(glAreProgramsResidentNV) then Exit;
- @glRequestResidentProgramsNV := SDL_GL_GetProcAddress('glRequestResidentProgramsNV');
- if not Assigned(glRequestResidentProgramsNV) then Exit;
- @glGetProgramParameterfvNV := SDL_GL_GetProcAddress('glGetProgramParameterfvNV');
- if not Assigned(glGetProgramParameterfvNV) then Exit;
- @glGetProgramParameterdvNV := SDL_GL_GetProcAddress('glGetProgramParameterdvNV');
- if not Assigned(glGetProgramParameterdvNV) then Exit;
- @glGetProgramivNV := SDL_GL_GetProcAddress('glGetProgramivNV');
- if not Assigned(glGetProgramivNV) then Exit;
- @glGetProgramStringNV := SDL_GL_GetProcAddress('glGetProgramStringNV');
- if not Assigned(glGetProgramStringNV) then Exit;
- @glGetTrackMatrixivNV := SDL_GL_GetProcAddress('glGetTrackMatrixivNV');
- if not Assigned(glGetTrackMatrixivNV) then Exit;
- @glGetVertexAttribdvNV := SDL_GL_GetProcAddress('glGetVertexAttribdvNV');
- if not Assigned(glGetVertexAttribdvNV) then Exit;
- @glGetVertexAttribfvNV := SDL_GL_GetProcAddress('glGetVertexAttribfvNV');
- if not Assigned(glGetVertexAttribfvNV) then Exit;
- @glGetVertexAttribivNV := SDL_GL_GetProcAddress('glGetVertexAttribivNV');
- if not Assigned(glGetVertexAttribivNV) then Exit;
- @glGetVertexAttribPointervNV := SDL_GL_GetProcAddress('glGetVertexAttribPointervNV');
- if not Assigned(glGetVertexAttribPointervNV) then Exit;
- @glIsProgramNV := SDL_GL_GetProcAddress('glIsProgramNV');
- if not Assigned(glIsProgramNV) then Exit;
- @glLoadProgramNV := SDL_GL_GetProcAddress('glLoadProgramNV');
- if not Assigned(glLoadProgramNV) then Exit;
- @glProgramParameter4fNV := SDL_GL_GetProcAddress('glProgramParameter4fNV');
- if not Assigned(glProgramParameter4fNV) then Exit;
- @glProgramParameter4fvNV := SDL_GL_GetProcAddress('glProgramParameter4fvNV');
- if not Assigned(glProgramParameter4fvNV) then Exit;
- @glProgramParameters4dvNV := SDL_GL_GetProcAddress('glProgramParameters4dvNV');
- if not Assigned(glProgramParameters4dvNV) then Exit;
- @glProgramParameters4fvNV := SDL_GL_GetProcAddress('glProgramParameters4fvNV');
- if not Assigned(glProgramParameters4fvNV) then Exit;
- @glTrackMatrixNV := SDL_GL_GetProcAddress('glTrackMatrixNV');
- if not Assigned(glTrackMatrixNV) then Exit;
- @glVertexAttribPointerNV := SDL_GL_GetProcAddress('glVertexAttribPointerNV');
- if not Assigned(glVertexAttribPointerNV) then Exit;
- @glVertexAttrib1sNV := SDL_GL_GetProcAddress('glVertexAttrib1sNV');
- if not Assigned(glVertexAttrib1sNV) then Exit;
- @glVertexAttrib1fNV := SDL_GL_GetProcAddress('glVertexAttrib1fNV');
- if not Assigned(glVertexAttrib1fNV) then Exit;
- @glVertexAttrib1dNV := SDL_GL_GetProcAddress('glVertexAttrib1dNV');
- if not Assigned(glVertexAttrib1dNV) then Exit;
- @glVertexAttrib2sNV := SDL_GL_GetProcAddress('glVertexAttrib2sNV');
- if not Assigned(glVertexAttrib2sNV) then Exit;
- @glVertexAttrib2fNV := SDL_GL_GetProcAddress('glVertexAttrib2fNV');
- if not Assigned(glVertexAttrib2fNV) then Exit;
- @glVertexAttrib2dNV := SDL_GL_GetProcAddress('glVertexAttrib2dNV');
- if not Assigned(glVertexAttrib2dNV) then Exit;
- @glVertexAttrib3sNV := SDL_GL_GetProcAddress('glVertexAttrib3sNV');
- if not Assigned(glVertexAttrib3sNV) then Exit;
- @glVertexAttrib3fNV := SDL_GL_GetProcAddress('glVertexAttrib3fNV');
- if not Assigned(glVertexAttrib3fNV) then Exit;
- @glVertexAttrib3dNV := SDL_GL_GetProcAddress('glVertexAttrib3dNV');
- if not Assigned(glVertexAttrib3dNV) then Exit;
- @glVertexAttrib4sNV := SDL_GL_GetProcAddress('glVertexAttrib4sNV');
- if not Assigned(glVertexAttrib4sNV) then Exit;
- @glVertexAttrib4fNV := SDL_GL_GetProcAddress('glVertexAttrib4fNV');
- if not Assigned(glVertexAttrib4fNV) then Exit;
- @glVertexAttrib4dNV := SDL_GL_GetProcAddress('glVertexAttrib4dNV');
- if not Assigned(glVertexAttrib4dNV) then Exit;
- @glVertexAttrib4ubNV := SDL_GL_GetProcAddress('glVertexAttrib4ubNV');
- if not Assigned(glVertexAttrib4ubNV) then Exit;
- @glVertexAttrib1svNV := SDL_GL_GetProcAddress('glVertexAttrib1svNV');
- if not Assigned(glVertexAttrib1svNV) then Exit;
- @glVertexAttrib1fvNV := SDL_GL_GetProcAddress('glVertexAttrib1fvNV');
- if not Assigned(glVertexAttrib1fvNV) then Exit;
- @glVertexAttrib1dvNV := SDL_GL_GetProcAddress('glVertexAttrib1dvNV');
- if not Assigned(glVertexAttrib1dvNV) then Exit;
- @glVertexAttrib2svNV := SDL_GL_GetProcAddress('glVertexAttrib2svNV');
- if not Assigned(glVertexAttrib2svNV) then Exit;
- @glVertexAttrib2fvNV := SDL_GL_GetProcAddress('glVertexAttrib2fvNV');
- if not Assigned(glVertexAttrib2fvNV) then Exit;
- @glVertexAttrib2dvNV := SDL_GL_GetProcAddress('glVertexAttrib2dvNV');
- if not Assigned(glVertexAttrib2dvNV) then Exit;
- @glVertexAttrib3svNV := SDL_GL_GetProcAddress('glVertexAttrib3svNV');
- if not Assigned(glVertexAttrib3svNV) then Exit;
- @glVertexAttrib3fvNV := SDL_GL_GetProcAddress('glVertexAttrib3fvNV');
- if not Assigned(glVertexAttrib3fvNV) then Exit;
- @glVertexAttrib3dvNV := SDL_GL_GetProcAddress('glVertexAttrib3dvNV');
- if not Assigned(glVertexAttrib3dvNV) then Exit;
- @glVertexAttrib4svNV := SDL_GL_GetProcAddress('glVertexAttrib4svNV');
- if not Assigned(glVertexAttrib4svNV) then Exit;
- @glVertexAttrib4fvNV := SDL_GL_GetProcAddress('glVertexAttrib4fvNV');
- if not Assigned(glVertexAttrib4fvNV) then Exit;
- @glVertexAttrib4dvNV := SDL_GL_GetProcAddress('glVertexAttrib4dvNV');
- if not Assigned(glVertexAttrib4dvNV) then Exit;
- @glVertexAttrib4ubvNV := SDL_GL_GetProcAddress('glVertexAttrib4ubvNV');
- if not Assigned(glVertexAttrib4ubvNV) then Exit;
- @glVertexAttribs1svNV := SDL_GL_GetProcAddress('glVertexAttribs1svNV');
- if not Assigned(glVertexAttribs1svNV) then Exit;
- @glVertexAttribs1fvNV := SDL_GL_GetProcAddress('glVertexAttribs1fvNV');
- if not Assigned(glVertexAttribs1fvNV) then Exit;
- @glVertexAttribs1dvNV := SDL_GL_GetProcAddress('glVertexAttribs1dvNV');
- if not Assigned(glVertexAttribs1dvNV) then Exit;
- @glVertexAttribs2svNV := SDL_GL_GetProcAddress('glVertexAttribs2svNV');
- if not Assigned(glVertexAttribs2svNV) then Exit;
- @glVertexAttribs2fvNV := SDL_GL_GetProcAddress('glVertexAttribs2fvNV');
- if not Assigned(glVertexAttribs2fvNV) then Exit;
- @glVertexAttribs2dvNV := SDL_GL_GetProcAddress('glVertexAttribs2dvNV');
- if not Assigned(glVertexAttribs2dvNV) then Exit;
- @glVertexAttribs3svNV := SDL_GL_GetProcAddress('glVertexAttribs3svNV');
- if not Assigned(glVertexAttribs3svNV) then Exit;
- @glVertexAttribs3fvNV := SDL_GL_GetProcAddress('glVertexAttribs3fvNV');
- if not Assigned(glVertexAttribs3fvNV) then Exit;
- @glVertexAttribs3dvNV := SDL_GL_GetProcAddress('glVertexAttribs3dvNV');
- if not Assigned(glVertexAttribs3dvNV) then Exit;
- @glVertexAttribs4svNV := SDL_GL_GetProcAddress('glVertexAttribs4svNV');
- if not Assigned(glVertexAttribs4svNV) then Exit;
- @glVertexAttribs4fvNV := SDL_GL_GetProcAddress('glVertexAttribs4fvNV');
- if not Assigned(glVertexAttribs4fvNV) then Exit;
- @glVertexAttribs4dvNV := SDL_GL_GetProcAddress('glVertexAttribs4dvNV');
- if not Assigned(glVertexAttribs4dvNV) then Exit;
- @glVertexAttribs4ubvNV := SDL_GL_GetProcAddress('glVertexAttribs4ubvNV');
- if not Assigned(glVertexAttribs4ubvNV) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_vertex_program1_1: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_vertex_program1_1', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ATI_element_array: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ATI_element_array', extstring) then
- begin
- @glElementPointerATI := SDL_GL_GetProcAddress('glElementPointerATI');
- if not Assigned(glElementPointerATI) then Exit;
- @glDrawElementArrayATI := SDL_GL_GetProcAddress('glDrawElementArrayATI');
- if not Assigned(glDrawElementArrayATI) then Exit;
- @glDrawRangeElementArrayATI := SDL_GL_GetProcAddress('glDrawRangeElementArrayATI');
- if not Assigned(glDrawRangeElementArrayATI) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ATI_envmap_bumpmap: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ATI_envmap_bumpmap', extstring) then
- begin
- @glTexBumpParameterivATI := SDL_GL_GetProcAddress('glTexBumpParameterivATI');
- if not Assigned(glTexBumpParameterivATI) then Exit;
- @glTexBumpParameterfvATI := SDL_GL_GetProcAddress('glTexBumpParameterfvATI');
- if not Assigned(glTexBumpParameterfvATI) then Exit;
- @glGetTexBumpParameterivATI := SDL_GL_GetProcAddress('glGetTexBumpParameterivATI');
- if not Assigned(glGetTexBumpParameterivATI) then Exit;
- @glGetTexBumpParameterfvATI := SDL_GL_GetProcAddress('glGetTexBumpParameterfvATI');
- if not Assigned(glGetTexBumpParameterfvATI) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ATI_fragment_shader: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ATI_fragment_shader', extstring) then
- begin
- @glGenFragmentShadersATI := SDL_GL_GetProcAddress('glGenFragmentShadersATI');
- if not Assigned(glGenFragmentShadersATI) then Exit;
- @glBindFragmentShaderATI := SDL_GL_GetProcAddress('glBindFragmentShaderATI');
- if not Assigned(glBindFragmentShaderATI) then Exit;
- @glDeleteFragmentShaderATI := SDL_GL_GetProcAddress('glDeleteFragmentShaderATI');
- if not Assigned(glDeleteFragmentShaderATI) then Exit;
- @glBeginFragmentShaderATI := SDL_GL_GetProcAddress('glBeginFragmentShaderATI');
- if not Assigned(glBeginFragmentShaderATI) then Exit;
- @glEndFragmentShaderATI := SDL_GL_GetProcAddress('glEndFragmentShaderATI');
- if not Assigned(glEndFragmentShaderATI) then Exit;
- @glPassTexCoordATI := SDL_GL_GetProcAddress('glPassTexCoordATI');
- if not Assigned(glPassTexCoordATI) then Exit;
- @glSampleMapATI := SDL_GL_GetProcAddress('glSampleMapATI');
- if not Assigned(glSampleMapATI) then Exit;
- @glColorFragmentOp1ATI := SDL_GL_GetProcAddress('glColorFragmentOp1ATI');
- if not Assigned(glColorFragmentOp1ATI) then Exit;
- @glColorFragmentOp2ATI := SDL_GL_GetProcAddress('glColorFragmentOp2ATI');
- if not Assigned(glColorFragmentOp2ATI) then Exit;
- @glColorFragmentOp3ATI := SDL_GL_GetProcAddress('glColorFragmentOp3ATI');
- if not Assigned(glColorFragmentOp3ATI) then Exit;
- @glAlphaFragmentOp1ATI := SDL_GL_GetProcAddress('glAlphaFragmentOp1ATI');
- if not Assigned(glAlphaFragmentOp1ATI) then Exit;
- @glAlphaFragmentOp2ATI := SDL_GL_GetProcAddress('glAlphaFragmentOp2ATI');
- if not Assigned(glAlphaFragmentOp2ATI) then Exit;
- @glAlphaFragmentOp3ATI := SDL_GL_GetProcAddress('glAlphaFragmentOp3ATI');
- if not Assigned(glAlphaFragmentOp3ATI) then Exit;
- @glSetFragmentShaderConstantATI := SDL_GL_GetProcAddress('glSetFragmentShaderConstantATI');
- if not Assigned(glSetFragmentShaderConstantATI) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ATI_pn_triangles: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ATI_pn_triangles', extstring) then
- begin
- @glPNTrianglesiATI := SDL_GL_GetProcAddress('glPNTrianglesiATI');
- if not Assigned(glPNTrianglesiATI) then Exit;
- @glPNTrianglesfATI := SDL_GL_GetProcAddress('glPNTrianglesfATI');
- if not Assigned(glPNTrianglesfATI) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ATI_texture_mirror_once: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ATI_texture_mirror_once', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ATI_vertex_array_object: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ATI_vertex_array_object', extstring) then
- begin
- @glNewObjectBufferATI := SDL_GL_GetProcAddress('glNewObjectBufferATI');
- if not Assigned(glNewObjectBufferATI) then Exit;
- @glIsObjectBufferATI := SDL_GL_GetProcAddress('glIsObjectBufferATI');
- if not Assigned(glIsObjectBufferATI) then Exit;
- @glUpdateObjectBufferATI := SDL_GL_GetProcAddress('glUpdateObjectBufferATI');
- if not Assigned(glUpdateObjectBufferATI) then Exit;
- @glGetObjectBufferfvATI := SDL_GL_GetProcAddress('glGetObjectBufferfvATI');
- if not Assigned(glGetObjectBufferfvATI) then Exit;
- @glGetObjectBufferivATI := SDL_GL_GetProcAddress('glGetObjectBufferivATI');
- if not Assigned(glGetObjectBufferivATI) then Exit;
- @glDeleteObjectBufferATI := SDL_GL_GetProcAddress('glDeleteObjectBufferATI');
- if not Assigned(glDeleteObjectBufferATI) then Exit;
- @glArrayObjectATI := SDL_GL_GetProcAddress('glArrayObjectATI');
- if not Assigned(glArrayObjectATI) then Exit;
- @glGetArrayObjectfvATI := SDL_GL_GetProcAddress('glGetArrayObjectfvATI');
- if not Assigned(glGetArrayObjectfvATI) then Exit;
- @glGetArrayObjectivATI := SDL_GL_GetProcAddress('glGetArrayObjectivATI');
- if not Assigned(glGetArrayObjectivATI) then Exit;
- @glVariantArrayObjectATI := SDL_GL_GetProcAddress('glVariantArrayObjectATI');
- if not Assigned(glVariantArrayObjectATI) then Exit;
- @glGetVariantArrayObjectfvATI := SDL_GL_GetProcAddress('glGetVariantArrayObjectfvATI');
- if not Assigned(glGetVariantArrayObjectfvATI) then Exit;
- @glGetVariantArrayObjectivATI := SDL_GL_GetProcAddress('glGetVariantArrayObjectivATI');
- if not Assigned(glGetVariantArrayObjectivATI) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ATI_vertex_streams: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ATI_vertex_streams', extstring) then
- begin
- @glVertexStream1s := SDL_GL_GetProcAddress('glVertexStream1s');
- if not Assigned(glVertexStream1s) then Exit;
- @glVertexStream1i := SDL_GL_GetProcAddress('glVertexStream1i');
- if not Assigned(glVertexStream1i) then Exit;
- @glVertexStream1f := SDL_GL_GetProcAddress('glVertexStream1f');
- if not Assigned(glVertexStream1f) then Exit;
- @glVertexStream1d := SDL_GL_GetProcAddress('glVertexStream1d');
- if not Assigned(glVertexStream1d) then Exit;
- @glVertexStream1sv := SDL_GL_GetProcAddress('glVertexStream1sv');
- if not Assigned(glVertexStream1sv) then Exit;
- @glVertexStream1iv := SDL_GL_GetProcAddress('glVertexStream1iv');
- if not Assigned(glVertexStream1iv) then Exit;
- @glVertexStream1fv := SDL_GL_GetProcAddress('glVertexStream1fv');
- if not Assigned(glVertexStream1fv) then Exit;
- @glVertexStream1dv := SDL_GL_GetProcAddress('glVertexStream1dv');
- if not Assigned(glVertexStream1dv) then Exit;
- @glVertexStream2s := SDL_GL_GetProcAddress('glVertexStream2s');
- if not Assigned(glVertexStream2s) then Exit;
- @glVertexStream2i := SDL_GL_GetProcAddress('glVertexStream2i');
- if not Assigned(glVertexStream2i) then Exit;
- @glVertexStream2f := SDL_GL_GetProcAddress('glVertexStream2f');
- if not Assigned(glVertexStream2f) then Exit;
- @glVertexStream2d := SDL_GL_GetProcAddress('glVertexStream2d');
- if not Assigned(glVertexStream2d) then Exit;
- @glVertexStream2sv := SDL_GL_GetProcAddress('glVertexStream2sv');
- if not Assigned(glVertexStream2sv) then Exit;
- @glVertexStream2iv := SDL_GL_GetProcAddress('glVertexStream2iv');
- if not Assigned(glVertexStream2iv) then Exit;
- @glVertexStream2fv := SDL_GL_GetProcAddress('glVertexStream2fv');
- if not Assigned(glVertexStream2fv) then Exit;
- @glVertexStream2dv := SDL_GL_GetProcAddress('glVertexStream2dv');
- if not Assigned(glVertexStream2dv) then Exit;
- @glVertexStream3s := SDL_GL_GetProcAddress('glVertexStream3s');
- if not Assigned(glVertexStream3s) then Exit;
- @glVertexStream3i := SDL_GL_GetProcAddress('glVertexStream3i');
- if not Assigned(glVertexStream3i) then Exit;
- @glVertexStream3f := SDL_GL_GetProcAddress('glVertexStream3f');
- if not Assigned(glVertexStream3f) then Exit;
- @glVertexStream3d := SDL_GL_GetProcAddress('glVertexStream3d');
- if not Assigned(glVertexStream3d) then Exit;
- @glVertexStream3sv := SDL_GL_GetProcAddress('glVertexStream3sv');
- if not Assigned(glVertexStream3sv) then Exit;
- @glVertexStream3iv := SDL_GL_GetProcAddress('glVertexStream3iv');
- if not Assigned(glVertexStream3iv) then Exit;
- @glVertexStream3fv := SDL_GL_GetProcAddress('glVertexStream3fv');
- if not Assigned(glVertexStream3fv) then Exit;
- @glVertexStream3dv := SDL_GL_GetProcAddress('glVertexStream3dv');
- if not Assigned(glVertexStream3dv) then Exit;
- @glVertexStream4s := SDL_GL_GetProcAddress('glVertexStream4s');
- if not Assigned(glVertexStream4s) then Exit;
- @glVertexStream4i := SDL_GL_GetProcAddress('glVertexStream4i');
- if not Assigned(glVertexStream4i) then Exit;
- @glVertexStream4f := SDL_GL_GetProcAddress('glVertexStream4f');
- if not Assigned(glVertexStream4f) then Exit;
- @glVertexStream4d := SDL_GL_GetProcAddress('glVertexStream4d');
- if not Assigned(glVertexStream4d) then Exit;
- @glVertexStream4sv := SDL_GL_GetProcAddress('glVertexStream4sv');
- if not Assigned(glVertexStream4sv) then Exit;
- @glVertexStream4iv := SDL_GL_GetProcAddress('glVertexStream4iv');
- if not Assigned(glVertexStream4iv) then Exit;
- @glVertexStream4fv := SDL_GL_GetProcAddress('glVertexStream4fv');
- if not Assigned(glVertexStream4fv) then Exit;
- @glVertexStream4dv := SDL_GL_GetProcAddress('glVertexStream4dv');
- if not Assigned(glVertexStream4dv) then Exit;
- @glNormalStream3b := SDL_GL_GetProcAddress('glNormalStream3b');
- if not Assigned(glNormalStream3b) then Exit;
- @glNormalStream3s := SDL_GL_GetProcAddress('glNormalStream3s');
- if not Assigned(glNormalStream3s) then Exit;
- @glNormalStream3i := SDL_GL_GetProcAddress('glNormalStream3i');
- if not Assigned(glNormalStream3i) then Exit;
- @glNormalStream3f := SDL_GL_GetProcAddress('glNormalStream3f');
- if not Assigned(glNormalStream3f) then Exit;
- @glNormalStream3d := SDL_GL_GetProcAddress('glNormalStream3d');
- if not Assigned(glNormalStream3d) then Exit;
- @glNormalStream3bv := SDL_GL_GetProcAddress('glNormalStream3bv');
- if not Assigned(glNormalStream3bv) then Exit;
- @glNormalStream3sv := SDL_GL_GetProcAddress('glNormalStream3sv');
- if not Assigned(glNormalStream3sv) then Exit;
- @glNormalStream3iv := SDL_GL_GetProcAddress('glNormalStream3iv');
- if not Assigned(glNormalStream3iv) then Exit;
- @glNormalStream3fv := SDL_GL_GetProcAddress('glNormalStream3fv');
- if not Assigned(glNormalStream3fv) then Exit;
- @glNormalStream3dv := SDL_GL_GetProcAddress('glNormalStream3dv');
- if not Assigned(glNormalStream3dv) then Exit;
- @glClientActiveVertexStream := SDL_GL_GetProcAddress('glClientActiveVertexStream');
- if not Assigned(glClientActiveVertexStream) then Exit;
- @glVertexBlendEnvi := SDL_GL_GetProcAddress('glVertexBlendEnvi');
- if not Assigned(glVertexBlendEnvi) then Exit;
- @glVertexBlendEnvf := SDL_GL_GetProcAddress('glVertexBlendEnvf');
- if not Assigned(glVertexBlendEnvf) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-{$IFDEF WINDOWS}
-function Load_WGL_I3D_image_buffer: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB');
- if not Assigned(wglGetExtensionsStringARB) then Exit;
- extstring := wglGetExtensionsStringARB(wglGetCurrentDC);
-
- if glext_ExtensionSupported('WGL_I3D_image_buffer', extstring) then
- begin
- @wglCreateImageBufferI3D := SDL_GL_GetProcAddress('wglCreateImageBufferI3D');
- if not Assigned(wglCreateImageBufferI3D) then Exit;
- @wglDestroyImageBufferI3D := SDL_GL_GetProcAddress('wglDestroyImageBufferI3D');
- if not Assigned(wglDestroyImageBufferI3D) then Exit;
- @wglAssociateImageBufferEventsI3D := SDL_GL_GetProcAddress('wglAssociateImageBufferEventsI3D');
- if not Assigned(wglAssociateImageBufferEventsI3D) then Exit;
- @wglReleaseImageBufferEventsI3D := SDL_GL_GetProcAddress('wglReleaseImageBufferEventsI3D');
- if not Assigned(wglReleaseImageBufferEventsI3D) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_WGL_I3D_swap_frame_lock: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB');
- if not Assigned(wglGetExtensionsStringARB) then Exit;
- extstring := wglGetExtensionsStringARB(wglGetCurrentDC);
-
- if glext_ExtensionSupported('WGL_I3D_swap_frame_lock', extstring) then
- begin
- @wglEnableFrameLockI3D := SDL_GL_GetProcAddress('wglEnableFrameLockI3D');
- if not Assigned(wglEnableFrameLockI3D) then Exit;
- @wglDisableFrameLockI3D := SDL_GL_GetProcAddress('wglDisableFrameLockI3D');
- if not Assigned(wglDisableFrameLockI3D) then Exit;
- @wglIsEnabledFrameLockI3D := SDL_GL_GetProcAddress('wglIsEnabledFrameLockI3D');
- if not Assigned(wglIsEnabledFrameLockI3D) then Exit;
- @wglQueryFrameLockMasterI3D := SDL_GL_GetProcAddress('wglQueryFrameLockMasterI3D');
- if not Assigned(wglQueryFrameLockMasterI3D) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_WGL_I3D_swap_frame_usage: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB');
- if not Assigned(wglGetExtensionsStringARB) then Exit;
- extstring := wglGetExtensionsStringARB(wglGetCurrentDC);
-
- if glext_ExtensionSupported('WGL_I3D_swap_frame_usage', extstring) then
- begin
- @wglGetFrameUsageI3D := SDL_GL_GetProcAddress('wglGetFrameUsageI3D');
- if not Assigned(wglGetFrameUsageI3D) then Exit;
- @wglBeginFrameTrackingI3D := SDL_GL_GetProcAddress('wglBeginFrameTrackingI3D');
- if not Assigned(wglBeginFrameTrackingI3D) then Exit;
- @wglEndFrameTrackingI3D := SDL_GL_GetProcAddress('wglEndFrameTrackingI3D');
- if not Assigned(wglEndFrameTrackingI3D) then Exit;
- @wglQueryFrameTrackingI3D := SDL_GL_GetProcAddress('wglQueryFrameTrackingI3D');
- if not Assigned(wglQueryFrameTrackingI3D) then Exit;
- Result := TRUE;
- end;
-
-end;
-{$ENDIF}
-
-function Load_GL_3DFX_texture_compression_FXT1: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_3DFX_texture_compression_FXT1', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_IBM_cull_vertex: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_IBM_cull_vertex', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_IBM_multimode_draw_arrays: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_IBM_multimode_draw_arrays', extstring) then
- begin
- @glMultiModeDrawArraysIBM := SDL_GL_GetProcAddress('glMultiModeDrawArraysIBM');
- if not Assigned(glMultiModeDrawArraysIBM) then Exit;
- @glMultiModeDrawElementsIBM := SDL_GL_GetProcAddress('glMultiModeDrawElementsIBM');
- if not Assigned(glMultiModeDrawElementsIBM) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_IBM_raster_pos_clip: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_IBM_raster_pos_clip', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_IBM_texture_mirrored_repeat: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_IBM_texture_mirrored_repeat', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_IBM_vertex_array_lists: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_IBM_vertex_array_lists', extstring) then
- begin
- @glColorPointerListIBM := SDL_GL_GetProcAddress('glColorPointerListIBM');
- if not Assigned(glColorPointerListIBM) then Exit;
- @glSecondaryColorPointerListIBM := SDL_GL_GetProcAddress('glSecondaryColorPointerListIBM');
- if not Assigned(glSecondaryColorPointerListIBM) then Exit;
- @glEdgeFlagPointerListIBM := SDL_GL_GetProcAddress('glEdgeFlagPointerListIBM');
- if not Assigned(glEdgeFlagPointerListIBM) then Exit;
- @glFogCoordPointerListIBM := SDL_GL_GetProcAddress('glFogCoordPointerListIBM');
- if not Assigned(glFogCoordPointerListIBM) then Exit;
- @glNormalPointerListIBM := SDL_GL_GetProcAddress('glNormalPointerListIBM');
- if not Assigned(glNormalPointerListIBM) then Exit;
- @glTexCoordPointerListIBM := SDL_GL_GetProcAddress('glTexCoordPointerListIBM');
- if not Assigned(glTexCoordPointerListIBM) then Exit;
- @glVertexPointerListIBM := SDL_GL_GetProcAddress('glVertexPointerListIBM');
- if not Assigned(glVertexPointerListIBM) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_MESA_resize_buffers: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_MESA_resize_buffers', extstring) then
- begin
- @glResizeBuffersMESA := SDL_GL_GetProcAddress('glResizeBuffersMESA');
- if not Assigned(glResizeBuffersMESA) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_MESA_window_pos: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_MESA_window_pos', extstring) then
- begin
- @glWindowPos2dMESA := SDL_GL_GetProcAddress('glWindowPos2dMESA');
- if not Assigned(glWindowPos2dMESA) then Exit;
- @glWindowPos2fMESA := SDL_GL_GetProcAddress('glWindowPos2fMESA');
- if not Assigned(glWindowPos2fMESA) then Exit;
- @glWindowPos2iMESA := SDL_GL_GetProcAddress('glWindowPos2iMESA');
- if not Assigned(glWindowPos2iMESA) then Exit;
- @glWindowPos2sMESA := SDL_GL_GetProcAddress('glWindowPos2sMESA');
- if not Assigned(glWindowPos2sMESA) then Exit;
- @glWindowPos2ivMESA := SDL_GL_GetProcAddress('glWindowPos2ivMESA');
- if not Assigned(glWindowPos2ivMESA) then Exit;
- @glWindowPos2svMESA := SDL_GL_GetProcAddress('glWindowPos2svMESA');
- if not Assigned(glWindowPos2svMESA) then Exit;
- @glWindowPos2fvMESA := SDL_GL_GetProcAddress('glWindowPos2fvMESA');
- if not Assigned(glWindowPos2fvMESA) then Exit;
- @glWindowPos2dvMESA := SDL_GL_GetProcAddress('glWindowPos2dvMESA');
- if not Assigned(glWindowPos2dvMESA) then Exit;
- @glWindowPos3iMESA := SDL_GL_GetProcAddress('glWindowPos3iMESA');
- if not Assigned(glWindowPos3iMESA) then Exit;
- @glWindowPos3sMESA := SDL_GL_GetProcAddress('glWindowPos3sMESA');
- if not Assigned(glWindowPos3sMESA) then Exit;
- @glWindowPos3fMESA := SDL_GL_GetProcAddress('glWindowPos3fMESA');
- if not Assigned(glWindowPos3fMESA) then Exit;
- @glWindowPos3dMESA := SDL_GL_GetProcAddress('glWindowPos3dMESA');
- if not Assigned(glWindowPos3dMESA) then Exit;
- @glWindowPos3ivMESA := SDL_GL_GetProcAddress('glWindowPos3ivMESA');
- if not Assigned(glWindowPos3ivMESA) then Exit;
- @glWindowPos3svMESA := SDL_GL_GetProcAddress('glWindowPos3svMESA');
- if not Assigned(glWindowPos3svMESA) then Exit;
- @glWindowPos3fvMESA := SDL_GL_GetProcAddress('glWindowPos3fvMESA');
- if not Assigned(glWindowPos3fvMESA) then Exit;
- @glWindowPos3dvMESA := SDL_GL_GetProcAddress('glWindowPos3dvMESA');
- if not Assigned(glWindowPos3dvMESA) then Exit;
- @glWindowPos4iMESA := SDL_GL_GetProcAddress('glWindowPos4iMESA');
- if not Assigned(glWindowPos4iMESA) then Exit;
- @glWindowPos4sMESA := SDL_GL_GetProcAddress('glWindowPos4sMESA');
- if not Assigned(glWindowPos4sMESA) then Exit;
- @glWindowPos4fMESA := SDL_GL_GetProcAddress('glWindowPos4fMESA');
- if not Assigned(glWindowPos4fMESA) then Exit;
- @glWindowPos4dMESA := SDL_GL_GetProcAddress('glWindowPos4dMESA');
- if not Assigned(glWindowPos4dMESA) then Exit;
- @glWindowPos4ivMESA := SDL_GL_GetProcAddress('glWindowPos4ivMESA');
- if not Assigned(glWindowPos4ivMESA) then Exit;
- @glWindowPos4svMESA := SDL_GL_GetProcAddress('glWindowPos4svMESA');
- if not Assigned(glWindowPos4svMESA) then Exit;
- @glWindowPos4fvMESA := SDL_GL_GetProcAddress('glWindowPos4fvMESA');
- if not Assigned(glWindowPos4fvMESA) then Exit;
- @glWindowPos4dvMESA := SDL_GL_GetProcAddress('glWindowPos4dvMESA');
- if not Assigned(glWindowPos4dvMESA) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_OML_interlace: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_OML_interlace', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_OML_resample: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_OML_resample', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_OML_subsample: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_OML_subsample', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_SGIS_generate_mipmap: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_SGIS_generate_mipmap', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_SGIS_multisample: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_SGIS_multisample', extstring) then
- begin
- @glSampleMaskSGIS := SDL_GL_GetProcAddress('glSampleMaskSGIS');
- if not Assigned(glSampleMaskSGIS) then Exit;
- @glSamplePatternSGIS := SDL_GL_GetProcAddress('glSamplePatternSGIS');
- if not Assigned(glSamplePatternSGIS) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_SGIS_pixel_texture: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_SGIS_pixel_texture', extstring) then
- begin
- @glPixelTexGenParameteriSGIS := SDL_GL_GetProcAddress('glPixelTexGenParameteriSGIS');
- if not Assigned(glPixelTexGenParameteriSGIS) then Exit;
- @glPixelTexGenParameterfSGIS := SDL_GL_GetProcAddress('glPixelTexGenParameterfSGIS');
- if not Assigned(glPixelTexGenParameterfSGIS) then Exit;
- @glGetPixelTexGenParameterivSGIS := SDL_GL_GetProcAddress('glGetPixelTexGenParameterivSGIS');
- if not Assigned(glGetPixelTexGenParameterivSGIS) then Exit;
- @glGetPixelTexGenParameterfvSGIS := SDL_GL_GetProcAddress('glGetPixelTexGenParameterfvSGIS');
- if not Assigned(glGetPixelTexGenParameterfvSGIS) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_SGIS_texture_border_clamp: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_SGIS_texture_border_clamp', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_SGIS_texture_color_mask: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_SGIS_texture_color_mask', extstring) then
- begin
- @glTextureColorMaskSGIS := SDL_GL_GetProcAddress('glTextureColorMaskSGIS');
- if not Assigned(glTextureColorMaskSGIS) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_SGIS_texture_edge_clamp: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_SGIS_texture_edge_clamp', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_SGIS_texture_lod: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_SGIS_texture_lod', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_SGIS_depth_texture: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_SGIS_depth_texture', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_SGIX_fog_offset: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_SGIX_fog_offset', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_SGIX_interlace: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_SGIX_interlace', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_SGIX_shadow_ambient: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_SGIX_shadow_ambient', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_SGI_color_matrix: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_SGI_color_matrix', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_SGI_color_table: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_SGI_color_table', extstring) then
- begin
- @glColorTableSGI := SDL_GL_GetProcAddress('glColorTableSGI');
- if not Assigned(glColorTableSGI) then Exit;
- @glCopyColorTableSGI := SDL_GL_GetProcAddress('glCopyColorTableSGI');
- if not Assigned(glCopyColorTableSGI) then Exit;
- @glColorTableParameterivSGI := SDL_GL_GetProcAddress('glColorTableParameterivSGI');
- if not Assigned(glColorTableParameterivSGI) then Exit;
- @glColorTableParameterfvSGI := SDL_GL_GetProcAddress('glColorTableParameterfvSGI');
- if not Assigned(glColorTableParameterfvSGI) then Exit;
- @glGetColorTableSGI := SDL_GL_GetProcAddress('glGetColorTableSGI');
- if not Assigned(glGetColorTableSGI) then Exit;
- @glGetColorTableParameterivSGI := SDL_GL_GetProcAddress('glGetColorTableParameterivSGI');
- if not Assigned(glGetColorTableParameterivSGI) then Exit;
- @glGetColorTableParameterfvSGI := SDL_GL_GetProcAddress('glGetColorTableParameterfvSGI');
- if not Assigned(glGetColorTableParameterfvSGI) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_SGI_texture_color_table: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_SGI_texture_color_table', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_SUN_vertex: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_SUN_vertex', extstring) then
- begin
- @glColor4ubVertex2fSUN := SDL_GL_GetProcAddress('glColor4ubVertex2fSUN');
- if not Assigned(glColor4ubVertex2fSUN) then Exit;
- @glColor4ubVertex2fvSUN := SDL_GL_GetProcAddress('glColor4ubVertex2fvSUN');
- if not Assigned(glColor4ubVertex2fvSUN) then Exit;
- @glColor4ubVertex3fSUN := SDL_GL_GetProcAddress('glColor4ubVertex3fSUN');
- if not Assigned(glColor4ubVertex3fSUN) then Exit;
- @glColor4ubVertex3fvSUN := SDL_GL_GetProcAddress('glColor4ubVertex3fvSUN');
- if not Assigned(glColor4ubVertex3fvSUN) then Exit;
- @glColor3fVertex3fSUN := SDL_GL_GetProcAddress('glColor3fVertex3fSUN');
- if not Assigned(glColor3fVertex3fSUN) then Exit;
- @glColor3fVertex3fvSUN := SDL_GL_GetProcAddress('glColor3fVertex3fvSUN');
- if not Assigned(glColor3fVertex3fvSUN) then Exit;
- @glNormal3fVertex3fSUN := SDL_GL_GetProcAddress('glNormal3fVertex3fSUN');
- if not Assigned(glNormal3fVertex3fSUN) then Exit;
- @glNormal3fVertex3fvSUN := SDL_GL_GetProcAddress('glNormal3fVertex3fvSUN');
- if not Assigned(glNormal3fVertex3fvSUN) then Exit;
- @glColor4fNormal3fVertex3fSUN := SDL_GL_GetProcAddress('glColor4fNormal3fVertex3fSUN');
- if not Assigned(glColor4fNormal3fVertex3fSUN) then Exit;
- @glColor4fNormal3fVertex3fvSUN := SDL_GL_GetProcAddress('glColor4fNormal3fVertex3fvSUN');
- if not Assigned(glColor4fNormal3fVertex3fvSUN) then Exit;
- @glTexCoord2fVertex3fSUN := SDL_GL_GetProcAddress('glTexCoord2fVertex3fSUN');
- if not Assigned(glTexCoord2fVertex3fSUN) then Exit;
- @glTexCoord2fVertex3fvSUN := SDL_GL_GetProcAddress('glTexCoord2fVertex3fvSUN');
- if not Assigned(glTexCoord2fVertex3fvSUN) then Exit;
- @glTexCoord4fVertex4fSUN := SDL_GL_GetProcAddress('glTexCoord4fVertex4fSUN');
- if not Assigned(glTexCoord4fVertex4fSUN) then Exit;
- @glTexCoord4fVertex4fvSUN := SDL_GL_GetProcAddress('glTexCoord4fVertex4fvSUN');
- if not Assigned(glTexCoord4fVertex4fvSUN) then Exit;
- @glTexCoord2fColor4ubVertex3fSUN := SDL_GL_GetProcAddress('glTexCoord2fColor4ubVertex3fSUN');
- if not Assigned(glTexCoord2fColor4ubVertex3fSUN) then Exit;
- @glTexCoord2fColor4ubVertex3fvSUN := SDL_GL_GetProcAddress('glTexCoord2fColor4ubVertex3fvSUN');
- if not Assigned(glTexCoord2fColor4ubVertex3fvSUN) then Exit;
- @glTexCoord2fColor3fVertex3fSUN := SDL_GL_GetProcAddress('glTexCoord2fColor3fVertex3fSUN');
- if not Assigned(glTexCoord2fColor3fVertex3fSUN) then Exit;
- @glTexCoord2fColor3fVertex3fvSUN := SDL_GL_GetProcAddress('glTexCoord2fColor3fVertex3fvSUN');
- if not Assigned(glTexCoord2fColor3fVertex3fvSUN) then Exit;
- @glTexCoord2fNormal3fVertex3fSUN := SDL_GL_GetProcAddress('glTexCoord2fNormal3fVertex3fSUN');
- if not Assigned(glTexCoord2fNormal3fVertex3fSUN) then Exit;
- @glTexCoord2fNormal3fVertex3fvSUN := SDL_GL_GetProcAddress('glTexCoord2fNormal3fVertex3fvSUN');
- if not Assigned(glTexCoord2fNormal3fVertex3fvSUN) then Exit;
- @glTexCoord2fColor4fNormal3fVertex3fSUN := SDL_GL_GetProcAddress('glTexCoord2fColor4fNormal3fVertex3fSUN');
- if not Assigned(glTexCoord2fColor4fNormal3fVertex3fSUN) then Exit;
- @glTexCoord2fColor4fNormal3fVertex3fvSUN := SDL_GL_GetProcAddress('glTexCoord2fColor4fNormal3fVertex3fvSUN');
- if not Assigned(glTexCoord2fColor4fNormal3fVertex3fvSUN) then Exit;
- @glTexCoord4fColor4fNormal3fVertex4fSUN := SDL_GL_GetProcAddress('glTexCoord4fColor4fNormal3fVertex4fSUN');
- if not Assigned(glTexCoord4fColor4fNormal3fVertex4fSUN) then Exit;
- @glTexCoord4fColor4fNormal3fVertex4fvSUN := SDL_GL_GetProcAddress('glTexCoord4fColor4fNormal3fVertex4fvSUN');
- if not Assigned(glTexCoord4fColor4fNormal3fVertex4fvSUN) then Exit;
- @glReplacementCodeuiVertex3fSUN := SDL_GL_GetProcAddress('glReplacementCodeuiVertex3fSUN');
- if not Assigned(glReplacementCodeuiVertex3fSUN) then Exit;
- @glReplacementCodeuiVertex3fvSUN := SDL_GL_GetProcAddress('glReplacementCodeuiVertex3fvSUN');
- if not Assigned(glReplacementCodeuiVertex3fvSUN) then Exit;
- @glReplacementCodeuiColor4ubVertex3fSUN := SDL_GL_GetProcAddress('glReplacementCodeuiColor4ubVertex3fSUN');
- if not Assigned(glReplacementCodeuiColor4ubVertex3fSUN) then Exit;
- @glReplacementCodeuiColor4ubVertex3fvSUN := SDL_GL_GetProcAddress('glReplacementCodeuiColor4ubVertex3fvSUN');
- if not Assigned(glReplacementCodeuiColor4ubVertex3fvSUN) then Exit;
- @glReplacementCodeuiColor3fVertex3fSUN := SDL_GL_GetProcAddress('glReplacementCodeuiColor3fVertex3fSUN');
- if not Assigned(glReplacementCodeuiColor3fVertex3fSUN) then Exit;
- @glReplacementCodeuiColor3fVertex3fvSUN := SDL_GL_GetProcAddress('glReplacementCodeuiColor3fVertex3fvSUN');
- if not Assigned(glReplacementCodeuiColor3fVertex3fvSUN) then Exit;
- @glReplacementCodeuiNormal3fVertex3fSUN := SDL_GL_GetProcAddress('glReplacementCodeuiNormal3fVertex3fSUN');
- if not Assigned(glReplacementCodeuiNormal3fVertex3fSUN) then Exit;
- @glReplacementCodeuiNormal3fVertex3fvSUN := SDL_GL_GetProcAddress('glReplacementCodeuiNormal3fVertex3fvSUN');
- if not Assigned(glReplacementCodeuiNormal3fVertex3fvSUN) then Exit;
- @glReplacementCodeuiColor4fNormal3fVertex3fSUN := SDL_GL_GetProcAddress('glReplacementCodeuiColor4fNormal3fVertex3fSUN');
- if not Assigned(glReplacementCodeuiColor4fNormal3fVertex3fSUN) then Exit;
- @glReplacementCodeuiColor4fNormal3fVertex3fvSUN := SDL_GL_GetProcAddress('glReplacementCodeuiColor4fNormal3fVertex3fvSUN');
- if not Assigned(glReplacementCodeuiColor4fNormal3fVertex3fvSUN) then Exit;
- @glReplacementCodeuiTexCoord2fVertex3fSUN := SDL_GL_GetProcAddress('glReplacementCodeuiTexCoord2fVertex3fSUN');
- if not Assigned(glReplacementCodeuiTexCoord2fVertex3fSUN) then Exit;
- @glReplacementCodeuiTexCoord2fVertex3fvSUN := SDL_GL_GetProcAddress('glReplacementCodeuiTexCoord2fVertex3fvSUN');
- if not Assigned(glReplacementCodeuiTexCoord2fVertex3fvSUN) then Exit;
- @glReplacementCodeuiTexCoord2fNormal3fVertex3fSUN := SDL_GL_GetProcAddress('glReplacementCodeuiTexCoord2fNormal3fVertex3fSUN');
- if not Assigned(glReplacementCodeuiTexCoord2fNormal3fVertex3fSUN) then Exit;
- @glReplacementCodeuiTexCoord2fNormal3fVertex3fvSUN := SDL_GL_GetProcAddress('glReplacementCodeuiTexCoord2fNormal3fVertex3fvSUN');
- if not Assigned(glReplacementCodeuiTexCoord2fNormal3fVertex3fvSUN) then Exit;
- @glReplacementCodeuiTexCoord2fColor4fNormal3fVertex3fSUN := SDL_GL_GetProcAddress('glReplacementCodeuiTexCoord2fColor4fNormal3fVertex3fSUN');
- if not Assigned(glReplacementCodeuiTexCoord2fColor4fNormal3fVertex3fSUN) then Exit;
- @glReplacementCodeuiTexCoord2fColor4fNormal3fVertex3fvSUN := SDL_GL_GetProcAddress('glReplacementCodeuiTexCoord2fColor4fNormal3fVertex3fvSUN');
- if not Assigned(glReplacementCodeuiTexCoord2fColor4fNormal3fVertex3fvSUN) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_fragment_program: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_fragment_program', extstring) then
- begin
- @glProgramStringARB := SDL_GL_GetProcAddress('glProgramStringARB');
- if not Assigned(glProgramStringARB) then Exit;
- @glBindProgramARB := SDL_GL_GetProcAddress('glBindProgramARB');
- if not Assigned(glBindProgramARB) then Exit;
- @glDeleteProgramsARB := SDL_GL_GetProcAddress('glDeleteProgramsARB');
- if not Assigned(glDeleteProgramsARB) then Exit;
- @glGenProgramsARB := SDL_GL_GetProcAddress('glGenProgramsARB');
- if not Assigned(glGenProgramsARB) then Exit;
- @glProgramEnvParameter4dARB := SDL_GL_GetProcAddress('glProgramEnvParameter4dARB');
- if not Assigned(glProgramEnvParameter4dARB) then Exit;
- @glProgramEnvParameter4dvARB := SDL_GL_GetProcAddress('glProgramEnvParameter4dvARB');
- if not Assigned(glProgramEnvParameter4dvARB) then Exit;
- @glProgramEnvParameter4fARB := SDL_GL_GetProcAddress('glProgramEnvParameter4fARB');
- if not Assigned(glProgramEnvParameter4fARB) then Exit;
- @glProgramEnvParameter4fvARB := SDL_GL_GetProcAddress('glProgramEnvParameter4fvARB');
- if not Assigned(glProgramEnvParameter4fvARB) then Exit;
- @glProgramLocalParameter4dARB := SDL_GL_GetProcAddress('glProgramLocalParameter4dARB');
- if not Assigned(glProgramLocalParameter4dARB) then Exit;
- @glProgramLocalParameter4dvARB := SDL_GL_GetProcAddress('glProgramLocalParameter4dvARB');
- if not Assigned(glProgramLocalParameter4dvARB) then Exit;
- @glProgramLocalParameter4fARB := SDL_GL_GetProcAddress('glProgramLocalParameter4fARB');
- if not Assigned(glProgramLocalParameter4fARB) then Exit;
- @glProgramLocalParameter4fvARB := SDL_GL_GetProcAddress('glProgramLocalParameter4fvARB');
- if not Assigned(glProgramLocalParameter4fvARB) then Exit;
- @glGetProgramEnvParameterdvARB := SDL_GL_GetProcAddress('glGetProgramEnvParameterdvARB');
- if not Assigned(glGetProgramEnvParameterdvARB) then Exit;
- @glGetProgramEnvParameterfvARB := SDL_GL_GetProcAddress('glGetProgramEnvParameterfvARB');
- if not Assigned(glGetProgramEnvParameterfvARB) then Exit;
- @glGetProgramLocalParameterdvARB := SDL_GL_GetProcAddress('glGetProgramLocalParameterdvARB');
- if not Assigned(glGetProgramLocalParameterdvARB) then Exit;
- @glGetProgramLocalParameterfvARB := SDL_GL_GetProcAddress('glGetProgramLocalParameterfvARB');
- if not Assigned(glGetProgramLocalParameterfvARB) then Exit;
- @glGetProgramivARB := SDL_GL_GetProcAddress('glGetProgramivARB');
- if not Assigned(glGetProgramivARB) then Exit;
- @glGetProgramStringARB := SDL_GL_GetProcAddress('glGetProgramStringARB');
- if not Assigned(glGetProgramStringARB) then Exit;
- @glIsProgramARB := SDL_GL_GetProcAddress('glIsProgramARB');
- if not Assigned(glIsProgramARB) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ATI_text_fragment_shader: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ATI_text_fragment_shader', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_APPLE_client_storage: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_APPLE_client_storage', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_APPLE_element_array: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_APPLE_element_array', extstring) then
- begin
- @glElementPointerAPPLE := SDL_GL_GetProcAddress('glElementPointerAPPLE');
- if not Assigned(glElementPointerAPPLE) then Exit;
- @glDrawElementArrayAPPLE := SDL_GL_GetProcAddress('glDrawElementArrayAPPLE');
- if not Assigned(glDrawElementArrayAPPLE) then Exit;
- @glDrawRangeElementArrayAPPLE := SDL_GL_GetProcAddress('glDrawRangeElementArrayAPPLE');
- if not Assigned(glDrawRangeElementArrayAPPLE) then Exit;
- @glMultiDrawElementArrayAPPLE := SDL_GL_GetProcAddress('glMultiDrawElementArrayAPPLE');
- if not Assigned(glMultiDrawElementArrayAPPLE) then Exit;
- @glMultiDrawRangeElementArrayAPPLE := SDL_GL_GetProcAddress('glMultiDrawRangeElementArrayAPPLE');
- if not Assigned(glMultiDrawRangeElementArrayAPPLE) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_APPLE_fence: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_APPLE_fence', extstring) then
- begin
- @glGenFencesAPPLE := SDL_GL_GetProcAddress('glGenFencesAPPLE');
- if not Assigned(glGenFencesAPPLE) then Exit;
- @glDeleteFencesAPPLE := SDL_GL_GetProcAddress('glDeleteFencesAPPLE');
- if not Assigned(glDeleteFencesAPPLE) then Exit;
- @glSetFenceAPPLE := SDL_GL_GetProcAddress('glSetFenceAPPLE');
- if not Assigned(glSetFenceAPPLE) then Exit;
- @glIsFenceAPPLE := SDL_GL_GetProcAddress('glIsFenceAPPLE');
- if not Assigned(glIsFenceAPPLE) then Exit;
- @glTestFenceAPPLE := SDL_GL_GetProcAddress('glTestFenceAPPLE');
- if not Assigned(glTestFenceAPPLE) then Exit;
- @glFinishFenceAPPLE := SDL_GL_GetProcAddress('glFinishFenceAPPLE');
- if not Assigned(glFinishFenceAPPLE) then Exit;
- @glTestObjectAPPLE := SDL_GL_GetProcAddress('glTestObjectAPPLE');
- if not Assigned(glTestObjectAPPLE) then Exit;
- @glFinishObjectAPPLE := SDL_GL_GetProcAddress('glFinishObjectAPPLE');
- if not Assigned(glFinishObjectAPPLE) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_APPLE_vertex_array_object: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_APPLE_vertex_array_object', extstring) then
- begin
- @glBindVertexArrayAPPLE := SDL_GL_GetProcAddress('glBindVertexArrayAPPLE');
- if not Assigned(glBindVertexArrayAPPLE) then Exit;
- @glDeleteVertexArraysAPPLE := SDL_GL_GetProcAddress('glDeleteVertexArraysAPPLE');
- if not Assigned(glDeleteVertexArraysAPPLE) then Exit;
- @glGenVertexArraysAPPLE := SDL_GL_GetProcAddress('glGenVertexArraysAPPLE');
- if not Assigned(glGenVertexArraysAPPLE) then Exit;
- @glIsVertexArrayAPPLE := SDL_GL_GetProcAddress('glIsVertexArrayAPPLE');
- if not Assigned(glIsVertexArrayAPPLE) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_APPLE_vertex_array_range: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_APPLE_vertex_array_range', extstring) then
- begin
- @glVertexArrayRangeAPPLE := SDL_GL_GetProcAddress('glVertexArrayRangeAPPLE');
- if not Assigned(glVertexArrayRangeAPPLE) then Exit;
- @glFlushVertexArrayRangeAPPLE := SDL_GL_GetProcAddress('glFlushVertexArrayRangeAPPLE');
- if not Assigned(glFlushVertexArrayRangeAPPLE) then Exit;
- @glVertexArrayParameteriAPPLE := SDL_GL_GetProcAddress('glVertexArrayParameteriAPPLE');
- if not Assigned(glVertexArrayParameteriAPPLE) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-{$IFDEF WINDOWS}
-function Load_WGL_ARB_pixel_format: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB');
- if not Assigned(wglGetExtensionsStringARB) then Exit;
- extstring := wglGetExtensionsStringARB(wglGetCurrentDC);
-
- if glext_ExtensionSupported('WGL_ARB_pixel_format', extstring) then
- begin
- @wglGetPixelFormatAttribivARB := SDL_GL_GetProcAddress('wglGetPixelFormatAttribivARB');
- if not Assigned(wglGetPixelFormatAttribivARB) then Exit;
- @wglGetPixelFormatAttribfvARB := SDL_GL_GetProcAddress('wglGetPixelFormatAttribfvARB');
- if not Assigned(wglGetPixelFormatAttribfvARB) then Exit;
- @wglChoosePixelFormatARB := SDL_GL_GetProcAddress('wglChoosePixelFormatARB');
- if not Assigned(wglChoosePixelFormatARB) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_WGL_ARB_make_current_read: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB');
- if not Assigned(wglGetExtensionsStringARB) then Exit;
- extstring := wglGetExtensionsStringARB(wglGetCurrentDC);
-
- if glext_ExtensionSupported('WGL_ARB_make_current_read', extstring) then
- begin
- @wglMakeContextCurrentARB := SDL_GL_GetProcAddress('wglMakeContextCurrentARB');
- if not Assigned(wglMakeContextCurrentARB) then Exit;
- @wglGetCurrentReadDCARB := SDL_GL_GetProcAddress('wglGetCurrentReadDCARB');
- if not Assigned(wglGetCurrentReadDCARB) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_WGL_ARB_pbuffer: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB');
- if not Assigned(wglGetExtensionsStringARB) then Exit;
- extstring := wglGetExtensionsStringARB(wglGetCurrentDC);
-
- if glext_ExtensionSupported('WGL_ARB_pbuffer', extstring) then
- begin
- @wglCreatePbufferARB := SDL_GL_GetProcAddress('wglCreatePbufferARB');
- if not Assigned(wglCreatePbufferARB) then Exit;
- @wglGetPbufferDCARB := SDL_GL_GetProcAddress('wglGetPbufferDCARB');
- if not Assigned(wglGetPbufferDCARB) then Exit;
- @wglReleasePbufferDCARB := SDL_GL_GetProcAddress('wglReleasePbufferDCARB');
- if not Assigned(wglReleasePbufferDCARB) then Exit;
- @wglDestroyPbufferARB := SDL_GL_GetProcAddress('wglDestroyPbufferARB');
- if not Assigned(wglDestroyPbufferARB) then Exit;
- @wglQueryPbufferARB := SDL_GL_GetProcAddress('wglQueryPbufferARB');
- if not Assigned(wglQueryPbufferARB) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_WGL_EXT_swap_control: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB');
- if not Assigned(wglGetExtensionsStringARB) then Exit;
- extstring := wglGetExtensionsStringARB(wglGetCurrentDC);
-
- if glext_ExtensionSupported('WGL_EXT_swap_control', extstring) then
- begin
- @wglSwapIntervalEXT := SDL_GL_GetProcAddress('wglSwapIntervalEXT');
- if not Assigned(wglSwapIntervalEXT) then Exit;
- @wglGetSwapIntervalEXT := SDL_GL_GetProcAddress('wglGetSwapIntervalEXT');
- if not Assigned(wglGetSwapIntervalEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_WGL_ARB_render_texture: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB');
- if not Assigned(wglGetExtensionsStringARB) then Exit;
- extstring := wglGetExtensionsStringARB(wglGetCurrentDC);
-
- if glext_ExtensionSupported('WGL_ARB_render_texture', extstring) then
- begin
- @wglBindTexImageARB := SDL_GL_GetProcAddress('wglBindTexImageARB');
- if not Assigned(wglBindTexImageARB) then Exit;
- @wglReleaseTexImageARB := SDL_GL_GetProcAddress('wglReleaseTexImageARB');
- if not Assigned(wglReleaseTexImageARB) then Exit;
- @wglSetPbufferAttribARB := SDL_GL_GetProcAddress('wglSetPbufferAttribARB');
- if not Assigned(wglSetPbufferAttribARB) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_WGL_EXT_extensions_string: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB');
- if not Assigned(wglGetExtensionsStringARB) then Exit;
- extstring := wglGetExtensionsStringARB(wglGetCurrentDC);
-
- if glext_ExtensionSupported('WGL_EXT_extensions_string', extstring) then
- begin
- @wglGetExtensionsStringEXT := SDL_GL_GetProcAddress('wglGetExtensionsStringEXT');
- if not Assigned(wglGetExtensionsStringEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_WGL_EXT_make_current_read: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB');
- if not Assigned(wglGetExtensionsStringARB) then Exit;
- extstring := wglGetExtensionsStringARB(wglGetCurrentDC);
-
- if glext_ExtensionSupported('WGL_EXT_make_current_read', extstring) then
- begin
- @wglMakeContextCurrentEXT := SDL_GL_GetProcAddress('wglMakeContextCurrentEXT');
- if not Assigned(wglMakeContextCurrentEXT) then Exit;
- @wglGetCurrentReadDCEXT := SDL_GL_GetProcAddress('wglGetCurrentReadDCEXT');
- if not Assigned(wglGetCurrentReadDCEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_WGL_EXT_pbuffer: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB');
- if not Assigned(wglGetExtensionsStringARB) then Exit;
- extstring := wglGetExtensionsStringARB(wglGetCurrentDC);
-
- if glext_ExtensionSupported('WGL_EXT_pbuffer', extstring) then
- begin
- @wglCreatePbufferEXT := SDL_GL_GetProcAddress('wglCreatePbufferEXT');
- if not Assigned(wglCreatePbufferEXT) then Exit;
- @wglGetPbufferDCEXT := SDL_GL_GetProcAddress('wglGetPbufferDCEXT');
- if not Assigned(wglGetPbufferDCEXT) then Exit;
- @wglReleasePbufferDCEXT := SDL_GL_GetProcAddress('wglReleasePbufferDCEXT');
- if not Assigned(wglReleasePbufferDCEXT) then Exit;
- @wglDestroyPbufferEXT := SDL_GL_GetProcAddress('wglDestroyPbufferEXT');
- if not Assigned(wglDestroyPbufferEXT) then Exit;
- @wglQueryPbufferEXT := SDL_GL_GetProcAddress('wglQueryPbufferEXT');
- if not Assigned(wglQueryPbufferEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_WGL_EXT_pixel_format: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB');
- if not Assigned(wglGetExtensionsStringARB) then Exit;
- extstring := wglGetExtensionsStringARB(wglGetCurrentDC);
-
- if glext_ExtensionSupported('WGL_EXT_pixel_format', extstring) then
- begin
- @wglGetPixelFormatAttribivEXT := SDL_GL_GetProcAddress('wglGetPixelFormatAttribivEXT');
- if not Assigned(wglGetPixelFormatAttribivEXT) then Exit;
- @wglGetPixelFormatAttribfvEXT := SDL_GL_GetProcAddress('wglGetPixelFormatAttribfvEXT');
- if not Assigned(wglGetPixelFormatAttribfvEXT) then Exit;
- @wglChoosePixelFormatEXT := SDL_GL_GetProcAddress('wglChoosePixelFormatEXT');
- if not Assigned(wglChoosePixelFormatEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_WGL_I3D_digital_video_control: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB');
- if not Assigned(wglGetExtensionsStringARB) then Exit;
- extstring := wglGetExtensionsStringARB(wglGetCurrentDC);
-
- if glext_ExtensionSupported('WGL_I3D_digital_video_control', extstring) then
- begin
- @wglGetDigitalVideoParametersI3D := SDL_GL_GetProcAddress('wglGetDigitalVideoParametersI3D');
- if not Assigned(wglGetDigitalVideoParametersI3D) then Exit;
- @wglSetDigitalVideoParametersI3D := SDL_GL_GetProcAddress('wglSetDigitalVideoParametersI3D');
- if not Assigned(wglSetDigitalVideoParametersI3D) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_WGL_I3D_gamma: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB');
- if not Assigned(wglGetExtensionsStringARB) then Exit;
- extstring := wglGetExtensionsStringARB(wglGetCurrentDC);
-
- if glext_ExtensionSupported('WGL_I3D_gamma', extstring) then
- begin
- @wglGetGammaTableParametersI3D := SDL_GL_GetProcAddress('wglGetGammaTableParametersI3D');
- if not Assigned(wglGetGammaTableParametersI3D) then Exit;
- @wglSetGammaTableParametersI3D := SDL_GL_GetProcAddress('wglSetGammaTableParametersI3D');
- if not Assigned(wglSetGammaTableParametersI3D) then Exit;
- @wglGetGammaTableI3D := SDL_GL_GetProcAddress('wglGetGammaTableI3D');
- if not Assigned(wglGetGammaTableI3D) then Exit;
- @wglSetGammaTableI3D := SDL_GL_GetProcAddress('wglSetGammaTableI3D');
- if not Assigned(wglSetGammaTableI3D) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_WGL_I3D_genlock: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB');
- if not Assigned(wglGetExtensionsStringARB) then Exit;
- extstring := wglGetExtensionsStringARB(wglGetCurrentDC);
-
- if glext_ExtensionSupported('WGL_I3D_genlock', extstring) then
- begin
- @wglEnableGenlockI3D := SDL_GL_GetProcAddress('wglEnableGenlockI3D');
- if not Assigned(wglEnableGenlockI3D) then Exit;
- @wglDisableGenlockI3D := SDL_GL_GetProcAddress('wglDisableGenlockI3D');
- if not Assigned(wglDisableGenlockI3D) then Exit;
- @wglIsEnabledGenlockI3D := SDL_GL_GetProcAddress('wglIsEnabledGenlockI3D');
- if not Assigned(wglIsEnabledGenlockI3D) then Exit;
- @wglGenlockSourceI3D := SDL_GL_GetProcAddress('wglGenlockSourceI3D');
- if not Assigned(wglGenlockSourceI3D) then Exit;
- @wglGetGenlockSourceI3D := SDL_GL_GetProcAddress('wglGetGenlockSourceI3D');
- if not Assigned(wglGetGenlockSourceI3D) then Exit;
- @wglGenlockSourceEdgeI3D := SDL_GL_GetProcAddress('wglGenlockSourceEdgeI3D');
- if not Assigned(wglGenlockSourceEdgeI3D) then Exit;
- @wglGetGenlockSourceEdgeI3D := SDL_GL_GetProcAddress('wglGetGenlockSourceEdgeI3D');
- if not Assigned(wglGetGenlockSourceEdgeI3D) then Exit;
- @wglGenlockSampleRateI3D := SDL_GL_GetProcAddress('wglGenlockSampleRateI3D');
- if not Assigned(wglGenlockSampleRateI3D) then Exit;
- @wglGetGenlockSampleRateI3D := SDL_GL_GetProcAddress('wglGetGenlockSampleRateI3D');
- if not Assigned(wglGetGenlockSampleRateI3D) then Exit;
- @wglGenlockSourceDelayI3D := SDL_GL_GetProcAddress('wglGenlockSourceDelayI3D');
- if not Assigned(wglGenlockSourceDelayI3D) then Exit;
- @wglGetGenlockSourceDelayI3D := SDL_GL_GetProcAddress('wglGetGenlockSourceDelayI3D');
- if not Assigned(wglGetGenlockSourceDelayI3D) then Exit;
- @wglQueryGenlockMaxSourceDelayI3D := SDL_GL_GetProcAddress('wglQueryGenlockMaxSourceDelayI3D');
- if not Assigned(wglQueryGenlockMaxSourceDelayI3D) then Exit;
- Result := TRUE;
- end;
-
-end;
-{$ENDIF}
-
-function Load_GL_ARB_matrix_palette: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_matrix_palette', extstring) then
- begin
- @glCurrentPaletteMatrixARB := SDL_GL_GetProcAddress('glCurrentPaletteMatrixARB');
- if not Assigned(glCurrentPaletteMatrixARB) then Exit;
- @glMatrixIndexubvARB := SDL_GL_GetProcAddress('glMatrixIndexubvARB');
- if not Assigned(glMatrixIndexubvARB) then Exit;
- @glMatrixIndexusvARB := SDL_GL_GetProcAddress('glMatrixIndexusvARB');
- if not Assigned(glMatrixIndexusvARB) then Exit;
- @glMatrixIndexuivARB := SDL_GL_GetProcAddress('glMatrixIndexuivARB');
- if not Assigned(glMatrixIndexuivARB) then Exit;
- @glMatrixIndexPointerARB := SDL_GL_GetProcAddress('glMatrixIndexPointerARB');
- if not Assigned(glMatrixIndexPointerARB) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_element_array: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_element_array', extstring) then
- begin
- @glElementPointerNV := SDL_GL_GetProcAddress('glElementPointerNV');
- if not Assigned(glElementPointerNV) then Exit;
- @glDrawElementArrayNV := SDL_GL_GetProcAddress('glDrawElementArrayNV');
- if not Assigned(glDrawElementArrayNV) then Exit;
- @glDrawRangeElementArrayNV := SDL_GL_GetProcAddress('glDrawRangeElementArrayNV');
- if not Assigned(glDrawRangeElementArrayNV) then Exit;
- @glMultiDrawElementArrayNV := SDL_GL_GetProcAddress('glMultiDrawElementArrayNV');
- if not Assigned(glMultiDrawElementArrayNV) then Exit;
- @glMultiDrawRangeElementArrayNV := SDL_GL_GetProcAddress('glMultiDrawRangeElementArrayNV');
- if not Assigned(glMultiDrawRangeElementArrayNV) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_float_buffer: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_float_buffer', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_fragment_program: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_fragment_program', extstring) then
- begin
- @glProgramNamedParameter4fNV := SDL_GL_GetProcAddress('glProgramNamedParameter4fNV');
- if not Assigned(glProgramNamedParameter4fNV) then Exit;
- @glProgramNamedParameter4dNV := SDL_GL_GetProcAddress('glProgramNamedParameter4dNV');
- if not Assigned(glProgramNamedParameter4dNV) then Exit;
- @glGetProgramNamedParameterfvNV := SDL_GL_GetProcAddress('glGetProgramNamedParameterfvNV');
- if not Assigned(glGetProgramNamedParameterfvNV) then Exit;
- @glGetProgramNamedParameterdvNV := SDL_GL_GetProcAddress('glGetProgramNamedParameterdvNV');
- if not Assigned(glGetProgramNamedParameterdvNV) then Exit;
- @glProgramLocalParameter4dARB := SDL_GL_GetProcAddress('glProgramLocalParameter4dARB');
- if not Assigned(glProgramLocalParameter4dARB) then Exit;
- @glProgramLocalParameter4dvARB := SDL_GL_GetProcAddress('glProgramLocalParameter4dvARB');
- if not Assigned(glProgramLocalParameter4dvARB) then Exit;
- @glProgramLocalParameter4fARB := SDL_GL_GetProcAddress('glProgramLocalParameter4fARB');
- if not Assigned(glProgramLocalParameter4fARB) then Exit;
- @glProgramLocalParameter4fvARB := SDL_GL_GetProcAddress('glProgramLocalParameter4fvARB');
- if not Assigned(glProgramLocalParameter4fvARB) then Exit;
- @glGetProgramLocalParameterdvARB := SDL_GL_GetProcAddress('glGetProgramLocalParameterdvARB');
- if not Assigned(glGetProgramLocalParameterdvARB) then Exit;
- @glGetProgramLocalParameterfvARB := SDL_GL_GetProcAddress('glGetProgramLocalParameterfvARB');
- if not Assigned(glGetProgramLocalParameterfvARB) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_primitive_restart: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_primitive_restart', extstring) then
- begin
- @glPrimitiveRestartNV := SDL_GL_GetProcAddress('glPrimitiveRestartNV');
- if not Assigned(glPrimitiveRestartNV) then Exit;
- @glPrimitiveRestartIndexNV := SDL_GL_GetProcAddress('glPrimitiveRestartIndexNV');
- if not Assigned(glPrimitiveRestartIndexNV) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_vertex_program2: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_vertex_program2', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-{$IFDEF WINDOWS}
-function Load_WGL_NV_render_texture_rectangle: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB');
- if not Assigned(wglGetExtensionsStringARB) then Exit;
- extstring := wglGetExtensionsStringARB(wglGetCurrentDC);
-
- if glext_ExtensionSupported('WGL_NV_render_texture_rectangle', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-{$ENDIF}
-
-function Load_GL_NV_pixel_data_range: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_pixel_data_range', extstring) then
- begin
- @glPixelDataRangeNV := SDL_GL_GetProcAddress('glPixelDataRangeNV');
- if not Assigned(glPixelDataRangeNV) then Exit;
- @glFlushPixelDataRangeNV := SDL_GL_GetProcAddress('glFlushPixelDataRangeNV');
- if not Assigned(glFlushPixelDataRangeNV) then Exit;
- {$IFDEF WINDOWS}
- @wglAllocateMemoryNV := SDL_GL_GetProcAddress('wglAllocateMemoryNV');
- if not Assigned(wglAllocateMemoryNV) then Exit;
- @wglFreeMemoryNV := SDL_GL_GetProcAddress('wglFreeMemoryNV');
- if not Assigned(wglFreeMemoryNV) then Exit;
- {$ENDIF}
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_texture_rectangle: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_texture_rectangle', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_S3_s3tc: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_S3_s3tc', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ATI_draw_buffers: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ATI_draw_buffers', extstring) then
- begin
- @glDrawBuffersATI := SDL_GL_GetProcAddress('glDrawBuffersATI');
- if not Assigned(glDrawBuffersATI) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-{$IFDEF WINDOWS}
-function Load_WGL_ATI_pixel_format_float: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB');
- if not Assigned(wglGetExtensionsStringARB) then Exit;
- extstring := wglGetExtensionsStringARB(wglGetCurrentDC);
-
- if glext_ExtensionSupported('WGL_ATI_pixel_format_float', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-{$ENDIF}
-
-function Load_GL_ATI_texture_env_combine3: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ATI_texture_env_combine3', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ATI_texture_float: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ATI_texture_float', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_texture_expand_normal: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_texture_expand_normal', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_half_float: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_half_float', extstring) then
- begin
- @glVertex2hNV := SDL_GL_GetProcAddress('glVertex2hNV');
- if not Assigned(glVertex2hNV) then Exit;
- @glVertex2hvNV := SDL_GL_GetProcAddress('glVertex2hvNV');
- if not Assigned(glVertex2hvNV) then Exit;
- @glVertex3hNV := SDL_GL_GetProcAddress('glVertex3hNV');
- if not Assigned(glVertex3hNV) then Exit;
- @glVertex3hvNV := SDL_GL_GetProcAddress('glVertex3hvNV');
- if not Assigned(glVertex3hvNV) then Exit;
- @glVertex4hNV := SDL_GL_GetProcAddress('glVertex4hNV');
- if not Assigned(glVertex4hNV) then Exit;
- @glVertex4hvNV := SDL_GL_GetProcAddress('glVertex4hvNV');
- if not Assigned(glVertex4hvNV) then Exit;
- @glNormal3hNV := SDL_GL_GetProcAddress('glNormal3hNV');
- if not Assigned(glNormal3hNV) then Exit;
- @glNormal3hvNV := SDL_GL_GetProcAddress('glNormal3hvNV');
- if not Assigned(glNormal3hvNV) then Exit;
- @glColor3hNV := SDL_GL_GetProcAddress('glColor3hNV');
- if not Assigned(glColor3hNV) then Exit;
- @glColor3hvNV := SDL_GL_GetProcAddress('glColor3hvNV');
- if not Assigned(glColor3hvNV) then Exit;
- @glColor4hNV := SDL_GL_GetProcAddress('glColor4hNV');
- if not Assigned(glColor4hNV) then Exit;
- @glColor4hvNV := SDL_GL_GetProcAddress('glColor4hvNV');
- if not Assigned(glColor4hvNV) then Exit;
- @glTexCoord1hNV := SDL_GL_GetProcAddress('glTexCoord1hNV');
- if not Assigned(glTexCoord1hNV) then Exit;
- @glTexCoord1hvNV := SDL_GL_GetProcAddress('glTexCoord1hvNV');
- if not Assigned(glTexCoord1hvNV) then Exit;
- @glTexCoord2hNV := SDL_GL_GetProcAddress('glTexCoord2hNV');
- if not Assigned(glTexCoord2hNV) then Exit;
- @glTexCoord2hvNV := SDL_GL_GetProcAddress('glTexCoord2hvNV');
- if not Assigned(glTexCoord2hvNV) then Exit;
- @glTexCoord3hNV := SDL_GL_GetProcAddress('glTexCoord3hNV');
- if not Assigned(glTexCoord3hNV) then Exit;
- @glTexCoord3hvNV := SDL_GL_GetProcAddress('glTexCoord3hvNV');
- if not Assigned(glTexCoord3hvNV) then Exit;
- @glTexCoord4hNV := SDL_GL_GetProcAddress('glTexCoord4hNV');
- if not Assigned(glTexCoord4hNV) then Exit;
- @glTexCoord4hvNV := SDL_GL_GetProcAddress('glTexCoord4hvNV');
- if not Assigned(glTexCoord4hvNV) then Exit;
- @glMultiTexCoord1hNV := SDL_GL_GetProcAddress('glMultiTexCoord1hNV');
- if not Assigned(glMultiTexCoord1hNV) then Exit;
- @glMultiTexCoord1hvNV := SDL_GL_GetProcAddress('glMultiTexCoord1hvNV');
- if not Assigned(glMultiTexCoord1hvNV) then Exit;
- @glMultiTexCoord2hNV := SDL_GL_GetProcAddress('glMultiTexCoord2hNV');
- if not Assigned(glMultiTexCoord2hNV) then Exit;
- @glMultiTexCoord2hvNV := SDL_GL_GetProcAddress('glMultiTexCoord2hvNV');
- if not Assigned(glMultiTexCoord2hvNV) then Exit;
- @glMultiTexCoord3hNV := SDL_GL_GetProcAddress('glMultiTexCoord3hNV');
- if not Assigned(glMultiTexCoord3hNV) then Exit;
- @glMultiTexCoord3hvNV := SDL_GL_GetProcAddress('glMultiTexCoord3hvNV');
- if not Assigned(glMultiTexCoord3hvNV) then Exit;
- @glMultiTexCoord4hNV := SDL_GL_GetProcAddress('glMultiTexCoord4hNV');
- if not Assigned(glMultiTexCoord4hNV) then Exit;
- @glMultiTexCoord4hvNV := SDL_GL_GetProcAddress('glMultiTexCoord4hvNV');
- if not Assigned(glMultiTexCoord4hvNV) then Exit;
- @glFogCoordhNV := SDL_GL_GetProcAddress('glFogCoordhNV');
- if not Assigned(glFogCoordhNV) then Exit;
- @glFogCoordhvNV := SDL_GL_GetProcAddress('glFogCoordhvNV');
- if not Assigned(glFogCoordhvNV) then Exit;
- @glSecondaryColor3hNV := SDL_GL_GetProcAddress('glSecondaryColor3hNV');
- if not Assigned(glSecondaryColor3hNV) then Exit;
- @glSecondaryColor3hvNV := SDL_GL_GetProcAddress('glSecondaryColor3hvNV');
- if not Assigned(glSecondaryColor3hvNV) then Exit;
- @glVertexWeighthNV := SDL_GL_GetProcAddress('glVertexWeighthNV');
- if not Assigned(glVertexWeighthNV) then Exit;
- @glVertexWeighthvNV := SDL_GL_GetProcAddress('glVertexWeighthvNV');
- if not Assigned(glVertexWeighthvNV) then Exit;
- @glVertexAttrib1hNV := SDL_GL_GetProcAddress('glVertexAttrib1hNV');
- if not Assigned(glVertexAttrib1hNV) then Exit;
- @glVertexAttrib1hvNV := SDL_GL_GetProcAddress('glVertexAttrib1hvNV');
- if not Assigned(glVertexAttrib1hvNV) then Exit;
- @glVertexAttrib2hNV := SDL_GL_GetProcAddress('glVertexAttrib2hNV');
- if not Assigned(glVertexAttrib2hNV) then Exit;
- @glVertexAttrib2hvNV := SDL_GL_GetProcAddress('glVertexAttrib2hvNV');
- if not Assigned(glVertexAttrib2hvNV) then Exit;
- @glVertexAttrib3hNV := SDL_GL_GetProcAddress('glVertexAttrib3hNV');
- if not Assigned(glVertexAttrib3hNV) then Exit;
- @glVertexAttrib3hvNV := SDL_GL_GetProcAddress('glVertexAttrib3hvNV');
- if not Assigned(glVertexAttrib3hvNV) then Exit;
- @glVertexAttrib4hNV := SDL_GL_GetProcAddress('glVertexAttrib4hNV');
- if not Assigned(glVertexAttrib4hNV) then Exit;
- @glVertexAttrib4hvNV := SDL_GL_GetProcAddress('glVertexAttrib4hvNV');
- if not Assigned(glVertexAttrib4hvNV) then Exit;
- @glVertexAttribs1hvNV := SDL_GL_GetProcAddress('glVertexAttribs1hvNV');
- if not Assigned(glVertexAttribs1hvNV) then Exit;
- @glVertexAttribs2hvNV := SDL_GL_GetProcAddress('glVertexAttribs2hvNV');
- if not Assigned(glVertexAttribs2hvNV) then Exit;
- @glVertexAttribs3hvNV := SDL_GL_GetProcAddress('glVertexAttribs3hvNV');
- if not Assigned(glVertexAttribs3hvNV) then Exit;
- @glVertexAttribs4hvNV := SDL_GL_GetProcAddress('glVertexAttribs4hvNV');
- if not Assigned(glVertexAttribs4hvNV) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ATI_map_object_buffer: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ATI_map_object_buffer', extstring) then
- begin
- @glMapObjectBufferATI := SDL_GL_GetProcAddress('glMapObjectBufferATI');
- if not Assigned(glMapObjectBufferATI) then Exit;
- @glUnmapObjectBufferATI := SDL_GL_GetProcAddress('glUnmapObjectBufferATI');
- if not Assigned(glUnmapObjectBufferATI) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ATI_separate_stencil: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ATI_separate_stencil', extstring) then
- begin
- @glStencilOpSeparateATI := SDL_GL_GetProcAddress('glStencilOpSeparateATI');
- if not Assigned(glStencilOpSeparateATI) then Exit;
- @glStencilFuncSeparateATI := SDL_GL_GetProcAddress('glStencilFuncSeparateATI');
- if not Assigned(glStencilFuncSeparateATI) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ATI_vertex_attrib_array_object: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ATI_vertex_attrib_array_object', extstring) then
- begin
- @glVertexAttribArrayObjectATI := SDL_GL_GetProcAddress('glVertexAttribArrayObjectATI');
- if not Assigned(glVertexAttribArrayObjectATI) then Exit;
- @glGetVertexAttribArrayObjectfvATI := SDL_GL_GetProcAddress('glGetVertexAttribArrayObjectfvATI');
- if not Assigned(glGetVertexAttribArrayObjectfvATI) then Exit;
- @glGetVertexAttribArrayObjectivATI := SDL_GL_GetProcAddress('glGetVertexAttribArrayObjectivATI');
- if not Assigned(glGetVertexAttribArrayObjectivATI) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_vertex_buffer_object: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_vertex_buffer_object', extstring) then
- begin
- @glBindBufferARB := SDL_GL_GetProcAddress('glBindBufferARB');
- if not Assigned(glBindBufferARB) then Exit;
- @glDeleteBuffersARB := SDL_GL_GetProcAddress('glDeleteBuffersARB');
- if not Assigned(glDeleteBuffersARB) then Exit;
- @glGenBuffersARB := SDL_GL_GetProcAddress('glGenBuffersARB');
- if not Assigned(glGenBuffersARB) then Exit;
- @glIsBufferARB := SDL_GL_GetProcAddress('glIsBufferARB');
- if not Assigned(glIsBufferARB) then Exit;
- @glBufferDataARB := SDL_GL_GetProcAddress('glBufferDataARB');
- if not Assigned(glBufferDataARB) then Exit;
- @glBufferSubDataARB := SDL_GL_GetProcAddress('glBufferSubDataARB');
- if not Assigned(glBufferSubDataARB) then Exit;
- @glGetBufferSubDataARB := SDL_GL_GetProcAddress('glGetBufferSubDataARB');
- if not Assigned(glGetBufferSubDataARB) then Exit;
- @glMapBufferARB := SDL_GL_GetProcAddress('glMapBufferARB');
- if not Assigned(glMapBufferARB) then Exit;
- @glUnmapBufferARB := SDL_GL_GetProcAddress('glUnmapBufferARB');
- if not Assigned(glUnmapBufferARB) then Exit;
- @glGetBufferParameterivARB := SDL_GL_GetProcAddress('glGetBufferParameterivARB');
- if not Assigned(glGetBufferParameterivARB) then Exit;
- @glGetBufferPointervARB := SDL_GL_GetProcAddress('glGetBufferPointervARB');
- if not Assigned(glGetBufferPointervARB) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_occlusion_query: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_occlusion_query', extstring) then
- begin
- @glGenQueriesARB := SDL_GL_GetProcAddress('glGenQueriesARB');
- if not Assigned(glGenQueriesARB) then Exit;
- @glDeleteQueriesARB := SDL_GL_GetProcAddress('glDeleteQueriesARB');
- if not Assigned(glDeleteQueriesARB) then Exit;
- @glIsQueryARB := SDL_GL_GetProcAddress('glIsQueryARB');
- if not Assigned(glIsQueryARB) then Exit;
- @glBeginQueryARB := SDL_GL_GetProcAddress('glBeginQueryARB');
- if not Assigned(glBeginQueryARB) then Exit;
- @glEndQueryARB := SDL_GL_GetProcAddress('glEndQueryARB');
- if not Assigned(glEndQueryARB) then Exit;
- @glGetQueryivARB := SDL_GL_GetProcAddress('glGetQueryivARB');
- if not Assigned(glGetQueryivARB) then Exit;
- @glGetQueryObjectivARB := SDL_GL_GetProcAddress('glGetQueryObjectivARB');
- if not Assigned(glGetQueryObjectivARB) then Exit;
- @glGetQueryObjectuivARB := SDL_GL_GetProcAddress('glGetQueryObjectuivARB');
- if not Assigned(glGetQueryObjectuivARB) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_shader_objects: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_shader_objects', extstring) then
- begin
- @glDeleteObjectARB := SDL_GL_GetProcAddress('glDeleteObjectARB');
- if not Assigned(glDeleteObjectARB) then Exit;
- @glGetHandleARB := SDL_GL_GetProcAddress('glGetHandleARB');
- if not Assigned(glGetHandleARB) then Exit;
- @glDetachObjectARB := SDL_GL_GetProcAddress('glDetachObjectARB');
- if not Assigned(glDetachObjectARB) then Exit;
- @glCreateShaderObjectARB := SDL_GL_GetProcAddress('glCreateShaderObjectARB');
- if not Assigned(glCreateShaderObjectARB) then Exit;
- @glShaderSourceARB := SDL_GL_GetProcAddress('glShaderSourceARB');
- if not Assigned(glShaderSourceARB) then Exit;
- @glCompileShaderARB := SDL_GL_GetProcAddress('glCompileShaderARB');
- if not Assigned(glCompileShaderARB) then Exit;
- @glCreateProgramObjectARB := SDL_GL_GetProcAddress('glCreateProgramObjectARB');
- if not Assigned(glCreateProgramObjectARB) then Exit;
- @glAttachObjectARB := SDL_GL_GetProcAddress('glAttachObjectARB');
- if not Assigned(glAttachObjectARB) then Exit;
- @glLinkProgramARB := SDL_GL_GetProcAddress('glLinkProgramARB');
- if not Assigned(glLinkProgramARB) then Exit;
- @glUseProgramObjectARB := SDL_GL_GetProcAddress('glUseProgramObjectARB');
- if not Assigned(glUseProgramObjectARB) then Exit;
- @glValidateProgramARB := SDL_GL_GetProcAddress('glValidateProgramARB');
- if not Assigned(glValidateProgramARB) then Exit;
- @glUniform1fARB := SDL_GL_GetProcAddress('glUniform1fARB');
- if not Assigned(glUniform1fARB) then Exit;
- @glUniform2fARB := SDL_GL_GetProcAddress('glUniform2fARB');
- if not Assigned(glUniform2fARB) then Exit;
- @glUniform3fARB := SDL_GL_GetProcAddress('glUniform3fARB');
- if not Assigned(glUniform3fARB) then Exit;
- @glUniform4fARB := SDL_GL_GetProcAddress('glUniform4fARB');
- if not Assigned(glUniform4fARB) then Exit;
- @glUniform1iARB := SDL_GL_GetProcAddress('glUniform1iARB');
- if not Assigned(glUniform1iARB) then Exit;
- @glUniform2iARB := SDL_GL_GetProcAddress('glUniform2iARB');
- if not Assigned(glUniform2iARB) then Exit;
- @glUniform3iARB := SDL_GL_GetProcAddress('glUniform3iARB');
- if not Assigned(glUniform3iARB) then Exit;
- @glUniform4iARB := SDL_GL_GetProcAddress('glUniform4iARB');
- if not Assigned(glUniform4iARB) then Exit;
- @glUniform1fvARB := SDL_GL_GetProcAddress('glUniform1fvARB');
- if not Assigned(glUniform1fvARB) then Exit;
- @glUniform2fvARB := SDL_GL_GetProcAddress('glUniform2fvARB');
- if not Assigned(glUniform2fvARB) then Exit;
- @glUniform3fvARB := SDL_GL_GetProcAddress('glUniform3fvARB');
- if not Assigned(glUniform3fvARB) then Exit;
- @glUniform4fvARB := SDL_GL_GetProcAddress('glUniform4fvARB');
- if not Assigned(glUniform4fvARB) then Exit;
- @glUniform1ivARB := SDL_GL_GetProcAddress('glUniform1ivARB');
- if not Assigned(glUniform1ivARB) then Exit;
- @glUniform2ivARB := SDL_GL_GetProcAddress('glUniform2ivARB');
- if not Assigned(glUniform2ivARB) then Exit;
- @glUniform3ivARB := SDL_GL_GetProcAddress('glUniform3ivARB');
- if not Assigned(glUniform3ivARB) then Exit;
- @glUniform4ivARB := SDL_GL_GetProcAddress('glUniform4ivARB');
- if not Assigned(glUniform4ivARB) then Exit;
- @glUniformMatrix2fvARB := SDL_GL_GetProcAddress('glUniformMatrix2fvARB');
- if not Assigned(glUniformMatrix2fvARB) then Exit;
- @glUniformMatrix3fvARB := SDL_GL_GetProcAddress('glUniformMatrix3fvARB');
- if not Assigned(glUniformMatrix3fvARB) then Exit;
- @glUniformMatrix4fvARB := SDL_GL_GetProcAddress('glUniformMatrix4fvARB');
- if not Assigned(glUniformMatrix4fvARB) then Exit;
- @glGetObjectParameterfvARB := SDL_GL_GetProcAddress('glGetObjectParameterfvARB');
- if not Assigned(glGetObjectParameterfvARB) then Exit;
- @glGetObjectParameterivARB := SDL_GL_GetProcAddress('glGetObjectParameterivARB');
- if not Assigned(glGetObjectParameterivARB) then Exit;
- @glGetInfoLogARB := SDL_GL_GetProcAddress('glGetInfoLogARB');
- if not Assigned(glGetInfoLogARB) then Exit;
- @glGetAttachedObjectsARB := SDL_GL_GetProcAddress('glGetAttachedObjectsARB');
- if not Assigned(glGetAttachedObjectsARB) then Exit;
- @glGetUniformLocationARB := SDL_GL_GetProcAddress('glGetUniformLocationARB');
- if not Assigned(glGetUniformLocationARB) then Exit;
- @glGetActiveUniformARB := SDL_GL_GetProcAddress('glGetActiveUniformARB');
- if not Assigned(glGetActiveUniformARB) then Exit;
- @glGetUniformfvARB := SDL_GL_GetProcAddress('glGetUniformfvARB');
- if not Assigned(glGetUniformfvARB) then Exit;
- @glGetUniformivARB := SDL_GL_GetProcAddress('glGetUniformivARB');
- if not Assigned(glGetUniformivARB) then Exit;
- @glGetShaderSourceARB := SDL_GL_GetProcAddress('glGetShaderSourceARB');
- if not Assigned(glGetShaderSourceARB) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_vertex_shader: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_vertex_shader', extstring) then
- begin
- @glVertexAttrib1fARB := SDL_GL_GetProcAddress('glVertexAttrib1fARB');
- if not Assigned(glVertexAttrib1fARB) then Exit;
- @glVertexAttrib1sARB := SDL_GL_GetProcAddress('glVertexAttrib1sARB');
- if not Assigned(glVertexAttrib1sARB) then Exit;
- @glVertexAttrib1dARB := SDL_GL_GetProcAddress('glVertexAttrib1dARB');
- if not Assigned(glVertexAttrib1dARB) then Exit;
- @glVertexAttrib2fARB := SDL_GL_GetProcAddress('glVertexAttrib2fARB');
- if not Assigned(glVertexAttrib2fARB) then Exit;
- @glVertexAttrib2sARB := SDL_GL_GetProcAddress('glVertexAttrib2sARB');
- if not Assigned(glVertexAttrib2sARB) then Exit;
- @glVertexAttrib2dARB := SDL_GL_GetProcAddress('glVertexAttrib2dARB');
- if not Assigned(glVertexAttrib2dARB) then Exit;
- @glVertexAttrib3fARB := SDL_GL_GetProcAddress('glVertexAttrib3fARB');
- if not Assigned(glVertexAttrib3fARB) then Exit;
- @glVertexAttrib3sARB := SDL_GL_GetProcAddress('glVertexAttrib3sARB');
- if not Assigned(glVertexAttrib3sARB) then Exit;
- @glVertexAttrib3dARB := SDL_GL_GetProcAddress('glVertexAttrib3dARB');
- if not Assigned(glVertexAttrib3dARB) then Exit;
- @glVertexAttrib4fARB := SDL_GL_GetProcAddress('glVertexAttrib4fARB');
- if not Assigned(glVertexAttrib4fARB) then Exit;
- @glVertexAttrib4sARB := SDL_GL_GetProcAddress('glVertexAttrib4sARB');
- if not Assigned(glVertexAttrib4sARB) then Exit;
- @glVertexAttrib4dARB := SDL_GL_GetProcAddress('glVertexAttrib4dARB');
- if not Assigned(glVertexAttrib4dARB) then Exit;
- @glVertexAttrib4NubARB := SDL_GL_GetProcAddress('glVertexAttrib4NubARB');
- if not Assigned(glVertexAttrib4NubARB) then Exit;
- @glVertexAttrib1fvARB := SDL_GL_GetProcAddress('glVertexAttrib1fvARB');
- if not Assigned(glVertexAttrib1fvARB) then Exit;
- @glVertexAttrib1svARB := SDL_GL_GetProcAddress('glVertexAttrib1svARB');
- if not Assigned(glVertexAttrib1svARB) then Exit;
- @glVertexAttrib1dvARB := SDL_GL_GetProcAddress('glVertexAttrib1dvARB');
- if not Assigned(glVertexAttrib1dvARB) then Exit;
- @glVertexAttrib2fvARB := SDL_GL_GetProcAddress('glVertexAttrib2fvARB');
- if not Assigned(glVertexAttrib2fvARB) then Exit;
- @glVertexAttrib2svARB := SDL_GL_GetProcAddress('glVertexAttrib2svARB');
- if not Assigned(glVertexAttrib2svARB) then Exit;
- @glVertexAttrib2dvARB := SDL_GL_GetProcAddress('glVertexAttrib2dvARB');
- if not Assigned(glVertexAttrib2dvARB) then Exit;
- @glVertexAttrib3fvARB := SDL_GL_GetProcAddress('glVertexAttrib3fvARB');
- if not Assigned(glVertexAttrib3fvARB) then Exit;
- @glVertexAttrib3svARB := SDL_GL_GetProcAddress('glVertexAttrib3svARB');
- if not Assigned(glVertexAttrib3svARB) then Exit;
- @glVertexAttrib3dvARB := SDL_GL_GetProcAddress('glVertexAttrib3dvARB');
- if not Assigned(glVertexAttrib3dvARB) then Exit;
- @glVertexAttrib4fvARB := SDL_GL_GetProcAddress('glVertexAttrib4fvARB');
- if not Assigned(glVertexAttrib4fvARB) then Exit;
- @glVertexAttrib4svARB := SDL_GL_GetProcAddress('glVertexAttrib4svARB');
- if not Assigned(glVertexAttrib4svARB) then Exit;
- @glVertexAttrib4dvARB := SDL_GL_GetProcAddress('glVertexAttrib4dvARB');
- if not Assigned(glVertexAttrib4dvARB) then Exit;
- @glVertexAttrib4ivARB := SDL_GL_GetProcAddress('glVertexAttrib4ivARB');
- if not Assigned(glVertexAttrib4ivARB) then Exit;
- @glVertexAttrib4bvARB := SDL_GL_GetProcAddress('glVertexAttrib4bvARB');
- if not Assigned(glVertexAttrib4bvARB) then Exit;
- @glVertexAttrib4ubvARB := SDL_GL_GetProcAddress('glVertexAttrib4ubvARB');
- if not Assigned(glVertexAttrib4ubvARB) then Exit;
- @glVertexAttrib4usvARB := SDL_GL_GetProcAddress('glVertexAttrib4usvARB');
- if not Assigned(glVertexAttrib4usvARB) then Exit;
- @glVertexAttrib4uivARB := SDL_GL_GetProcAddress('glVertexAttrib4uivARB');
- if not Assigned(glVertexAttrib4uivARB) then Exit;
- @glVertexAttrib4NbvARB := SDL_GL_GetProcAddress('glVertexAttrib4NbvARB');
- if not Assigned(glVertexAttrib4NbvARB) then Exit;
- @glVertexAttrib4NsvARB := SDL_GL_GetProcAddress('glVertexAttrib4NsvARB');
- if not Assigned(glVertexAttrib4NsvARB) then Exit;
- @glVertexAttrib4NivARB := SDL_GL_GetProcAddress('glVertexAttrib4NivARB');
- if not Assigned(glVertexAttrib4NivARB) then Exit;
- @glVertexAttrib4NubvARB := SDL_GL_GetProcAddress('glVertexAttrib4NubvARB');
- if not Assigned(glVertexAttrib4NubvARB) then Exit;
- @glVertexAttrib4NusvARB := SDL_GL_GetProcAddress('glVertexAttrib4NusvARB');
- if not Assigned(glVertexAttrib4NusvARB) then Exit;
- @glVertexAttrib4NuivARB := SDL_GL_GetProcAddress('glVertexAttrib4NuivARB');
- if not Assigned(glVertexAttrib4NuivARB) then Exit;
- @glVertexAttribPointerARB := SDL_GL_GetProcAddress('glVertexAttribPointerARB');
- if not Assigned(glVertexAttribPointerARB) then Exit;
- @glEnableVertexAttribArrayARB := SDL_GL_GetProcAddress('glEnableVertexAttribArrayARB');
- if not Assigned(glEnableVertexAttribArrayARB) then Exit;
- @glDisableVertexAttribArrayARB := SDL_GL_GetProcAddress('glDisableVertexAttribArrayARB');
- if not Assigned(glDisableVertexAttribArrayARB) then Exit;
- @glBindAttribLocationARB := SDL_GL_GetProcAddress('glBindAttribLocationARB');
- if not Assigned(glBindAttribLocationARB) then Exit;
- @glGetActiveAttribARB := SDL_GL_GetProcAddress('glGetActiveAttribARB');
- if not Assigned(glGetActiveAttribARB) then Exit;
- @glGetAttribLocationARB := SDL_GL_GetProcAddress('glGetAttribLocationARB');
- if not Assigned(glGetAttribLocationARB) then Exit;
- @glGetVertexAttribdvARB := SDL_GL_GetProcAddress('glGetVertexAttribdvARB');
- if not Assigned(glGetVertexAttribdvARB) then Exit;
- @glGetVertexAttribfvARB := SDL_GL_GetProcAddress('glGetVertexAttribfvARB');
- if not Assigned(glGetVertexAttribfvARB) then Exit;
- @glGetVertexAttribivARB := SDL_GL_GetProcAddress('glGetVertexAttribivARB');
- if not Assigned(glGetVertexAttribivARB) then Exit;
- @glGetVertexAttribPointervARB := SDL_GL_GetProcAddress('glGetVertexAttribPointervARB');
- if not Assigned(glGetVertexAttribPointervARB) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_fragment_shader: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_fragment_shader', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_shading_language_100: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_shading_language_100', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_texture_non_power_of_two: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_texture_non_power_of_two', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_point_sprite: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_point_sprite', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_depth_bounds_test: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_depth_bounds_test', extstring) then
- begin
- @glDepthBoundsEXT := SDL_GL_GetProcAddress('glDepthBoundsEXT');
- if not Assigned(glDepthBoundsEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_secondary_color: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_secondary_color', extstring) then
- begin
- @glSecondaryColor3bEXT := SDL_GL_GetProcAddress('glSecondaryColor3bEXT');
- if not Assigned(glSecondaryColor3bEXT) then Exit;
- @glSecondaryColor3sEXT := SDL_GL_GetProcAddress('glSecondaryColor3sEXT');
- if not Assigned(glSecondaryColor3sEXT) then Exit;
- @glSecondaryColor3iEXT := SDL_GL_GetProcAddress('glSecondaryColor3iEXT');
- if not Assigned(glSecondaryColor3iEXT) then Exit;
- @glSecondaryColor3fEXT := SDL_GL_GetProcAddress('glSecondaryColor3fEXT');
- if not Assigned(glSecondaryColor3fEXT) then Exit;
- @glSecondaryColor3dEXT := SDL_GL_GetProcAddress('glSecondaryColor3dEXT');
- if not Assigned(glSecondaryColor3dEXT) then Exit;
- @glSecondaryColor3ubEXT := SDL_GL_GetProcAddress('glSecondaryColor3ubEXT');
- if not Assigned(glSecondaryColor3ubEXT) then Exit;
- @glSecondaryColor3usEXT := SDL_GL_GetProcAddress('glSecondaryColor3usEXT');
- if not Assigned(glSecondaryColor3usEXT) then Exit;
- @glSecondaryColor3uiEXT := SDL_GL_GetProcAddress('glSecondaryColor3uiEXT');
- if not Assigned(glSecondaryColor3uiEXT) then Exit;
- @glSecondaryColor3bvEXT := SDL_GL_GetProcAddress('glSecondaryColor3bvEXT');
- if not Assigned(glSecondaryColor3bvEXT) then Exit;
- @glSecondaryColor3svEXT := SDL_GL_GetProcAddress('glSecondaryColor3svEXT');
- if not Assigned(glSecondaryColor3svEXT) then Exit;
- @glSecondaryColor3ivEXT := SDL_GL_GetProcAddress('glSecondaryColor3ivEXT');
- if not Assigned(glSecondaryColor3ivEXT) then Exit;
- @glSecondaryColor3fvEXT := SDL_GL_GetProcAddress('glSecondaryColor3fvEXT');
- if not Assigned(glSecondaryColor3fvEXT) then Exit;
- @glSecondaryColor3dvEXT := SDL_GL_GetProcAddress('glSecondaryColor3dvEXT');
- if not Assigned(glSecondaryColor3dvEXT) then Exit;
- @glSecondaryColor3ubvEXT := SDL_GL_GetProcAddress('glSecondaryColor3ubvEXT');
- if not Assigned(glSecondaryColor3ubvEXT) then Exit;
- @glSecondaryColor3usvEXT := SDL_GL_GetProcAddress('glSecondaryColor3usvEXT');
- if not Assigned(glSecondaryColor3usvEXT) then Exit;
- @glSecondaryColor3uivEXT := SDL_GL_GetProcAddress('glSecondaryColor3uivEXT');
- if not Assigned(glSecondaryColor3uivEXT) then Exit;
- @glSecondaryColorPointerEXT := SDL_GL_GetProcAddress('glSecondaryColorPointerEXT');
- if not Assigned(glSecondaryColorPointerEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_texture_mirror_clamp: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_texture_mirror_clamp', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_blend_equation_separate: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_blend_equation_separate', extstring) then
- begin
- @glBlendEquationSeparateEXT := SDL_GL_GetProcAddress('glBlendEquationSeparateEXT');
- if not Assigned(glBlendEquationSeparateEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_MESA_pack_invert: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_MESA_pack_invert', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_MESA_ycbcr_texture: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_MESA_ycbcr_texture', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_fragment_program_shadow: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_ARB_fragment_program_shadow', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_fog_coord: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_fog_coord', extstring) then
- begin
- @glFogCoordfEXT := SDL_GL_GetProcAddress('glFogCoordfEXT');
- if not Assigned(glFogCoordfEXT) then Exit;
- @glFogCoorddEXT := SDL_GL_GetProcAddress('glFogCoorddEXT');
- if not Assigned(glFogCoorddEXT) then Exit;
- @glFogCoordfvEXT := SDL_GL_GetProcAddress('glFogCoordfvEXT');
- if not Assigned(glFogCoordfvEXT) then Exit;
- @glFogCoorddvEXT := SDL_GL_GetProcAddress('glFogCoorddvEXT');
- if not Assigned(glFogCoorddvEXT) then Exit;
- @glFogCoordPointerEXT := SDL_GL_GetProcAddress('glFogCoordPointerEXT');
- if not Assigned(glFogCoordPointerEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_fragment_program_option: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_fragment_program_option', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_pixel_buffer_object: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_EXT_pixel_buffer_object', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_fragment_program2: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_fragment_program2', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_vertex_program2_option: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_vertex_program2_option', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_NV_vertex_program3: Boolean;
-var
- extstring : PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString( GL_EXTENSIONS );
-
- if glext_ExtensionSupported('GL_NV_vertex_program3', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_draw_buffers: Boolean;
-var
- extstring: PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString(GL_EXTENSIONS);
-
- if glext_ExtensionSupported('GL_ARB_draw_buffers', extstring) then
- begin
- glDrawBuffersARB := SDL_GL_GetProcAddress('glDrawBuffersARB');
- if not Assigned(glDrawBuffersARB) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_texture_rectangle: Boolean;
-var
- extstring: PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString(GL_EXTENSIONS);
-
- if glext_ExtensionSupported('GL_ARB_texture_rectangle', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_color_buffer_float: Boolean;
-var
- extstring: PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString(GL_EXTENSIONS);
-
- if glext_ExtensionSupported('GL_ARB_color_buffer_float', extstring) then
- begin
- glClampColorARB := SDL_GL_GetProcAddress('glClampColorARB');
- if not Assigned(glClampColorARB) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_half_float_pixel: Boolean;
-var
- extstring: PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString(GL_EXTENSIONS);
-
- if glext_ExtensionSupported('GL_ARB_half_float_pixel', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_texture_float: Boolean;
-var
- extstring: PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString(GL_EXTENSIONS);
-
- if glext_ExtensionSupported('GL_ARB_texture_float', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_texture_compression_dxt1: Boolean;
-var
- extstring: PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString(GL_EXTENSIONS);
-
- if glext_ExtensionSupported('GL_EXT_texture_compression_dxt1', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_ARB_pixel_buffer_object: Boolean;
-var
- extstring: PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString(GL_EXTENSIONS);
-
- if glext_ExtensionSupported('GL_ARB_pixel_buffer_object', extstring) then
- begin
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_EXT_framebuffer_object: Boolean;
-var
- extstring: PChar;
-begin
-
- Result := FALSE;
- extstring := glGetString(GL_EXTENSIONS);
-
- if glext_ExtensionSupported('GL_EXT_framebuffer_object', extstring) then
- begin
- glIsRenderbufferEXT := SDL_GL_GetProcAddress('glIsRenderbufferEXT');
- if not Assigned(glIsRenderbufferEXT) then Exit;
- glBindRenderbufferEXT := SDL_GL_GetProcAddress('glBindRenderbufferEXT');
- if not Assigned(glBindRenderbufferEXT) then Exit;
- glDeleteRenderbuffersEXT := SDL_GL_GetProcAddress('glDeleteRenderbuffersEXT');
- if not Assigned(glDeleteRenderbuffersEXT) then Exit;
- glGenRenderbuffersEXT := SDL_GL_GetProcAddress('glGenRenderbuffersEXT');
- if not Assigned(glGenRenderbuffersEXT) then Exit;
- glRenderbufferStorageEXT := SDL_GL_GetProcAddress('glRenderbufferStorageEXT');
- if not Assigned(glRenderbufferStorageEXT) then Exit;
- glGetRenderbufferParameterivEXT := SDL_GL_GetProcAddress('glGetRenderbufferParameterivEXT');
- if not Assigned(glGetRenderbufferParameterivEXT) then Exit;
- glIsFramebufferEXT := SDL_GL_GetProcAddress('glIsFramebufferEXT');
- if not Assigned(glIsFramebufferEXT) then Exit;
- glBindFramebufferEXT := SDL_GL_GetProcAddress('glBindFramebufferEXT');
- if not Assigned(glBindFramebufferEXT) then Exit;
- glDeleteFramebuffersEXT := SDL_GL_GetProcAddress('glDeleteFramebuffersEXT');
- if not Assigned(glDeleteFramebuffersEXT) then Exit;
- glGenFramebuffersEXT := SDL_GL_GetProcAddress('glGenFramebuffersEXT');
- if not Assigned(glGenFramebuffersEXT) then Exit;
- glCheckFramebufferStatusEXT := SDL_GL_GetProcAddress('glCheckFramebufferStatusEXT');
- if not Assigned(glCheckFramebufferStatusEXT) then Exit;
- glFramebufferTexture1DEXT := SDL_GL_GetProcAddress('glFramebufferTexture1DEXT');
- if not Assigned(glFramebufferTexture1DEXT) then Exit;
- glFramebufferTexture2DEXT := SDL_GL_GetProcAddress('glFramebufferTexture2DEXT');
- if not Assigned(glFramebufferTexture2DEXT) then Exit;
- glFramebufferTexture3DEXT := SDL_GL_GetProcAddress('glFramebufferTexture3DEXT');
- if not Assigned(glFramebufferTexture3DEXT) then Exit;
- glFramebufferRenderbufferEXT := SDL_GL_GetProcAddress('glFramebufferRenderbufferEXT');
- if not Assigned(glFramebufferRenderbufferEXT) then Exit;
- glGetFramebufferAttachmentParameterivEXT := SDL_GL_GetProcAddress('glGetFramebufferAttachmentParameterivEXT');
- if not Assigned(glGetFramebufferAttachmentParameterivEXT) then Exit;
- glGenerateMipmapEXT := SDL_GL_GetProcAddress('glGenerateMipmapEXT');
- if not Assigned(glGenerateMipmapEXT) then Exit;
- Result := TRUE;
- end;
-
-end;
-
-function Load_GL_version_1_4: Boolean;
-var
- extstring: String;
-begin
-
- Result := FALSE;
- extstring := String(PChar(glGetString(GL_EXTENSIONS)));
-
- glBlendFuncSeparate := SDL_GL_GetProcAddress('glBlendFuncSeparate');
- if not Assigned(glBlendFuncSeparate) then Exit;
- glFogCoordf := SDL_GL_GetProcAddress('glFogCoordf');
- if not Assigned(glFogCoordf) then Exit;
- glFogCoordfv := SDL_GL_GetProcAddress('glFogCoordfv');
- if not Assigned(glFogCoordfv) then Exit;
- glFogCoordd := SDL_GL_GetProcAddress('glFogCoordd');
- if not Assigned(glFogCoordd) then Exit;
- glFogCoorddv := SDL_GL_GetProcAddress('glFogCoorddv');
- if not Assigned(glFogCoorddv) then Exit;
- glFogCoordPointer := SDL_GL_GetProcAddress('glFogCoordPointer');
- if not Assigned(glFogCoordPointer) then Exit;
- glMultiDrawArrays := SDL_GL_GetProcAddress('glMultiDrawArrays');
- if not Assigned(glMultiDrawArrays) then Exit;
- glMultiDrawElements := SDL_GL_GetProcAddress('glMultiDrawElements');
- if not Assigned(glMultiDrawElements) then Exit;
- glPointParameterf := SDL_GL_GetProcAddress('glPointParameterf');
- if not Assigned(glPointParameterf) then Exit;
- glPointParameterfv := SDL_GL_GetProcAddress('glPointParameterfv');
- if not Assigned(glPointParameterfv) then Exit;
- glPointParameteri := SDL_GL_GetProcAddress('glPointParameteri');
- if not Assigned(glPointParameteri) then Exit;
- glPointParameteriv := SDL_GL_GetProcAddress('glPointParameteriv');
- if not Assigned(glPointParameteriv) then Exit;
- glSecondaryColor3b := SDL_GL_GetProcAddress('glSecondaryColor3b');
- if not Assigned(glSecondaryColor3b) then Exit;
- glSecondaryColor3bv := SDL_GL_GetProcAddress('glSecondaryColor3bv');
- if not Assigned(glSecondaryColor3bv) then Exit;
- glSecondaryColor3d := SDL_GL_GetProcAddress('glSecondaryColor3d');
- if not Assigned(glSecondaryColor3d) then Exit;
- glSecondaryColor3dv := SDL_GL_GetProcAddress('glSecondaryColor3dv');
- if not Assigned(glSecondaryColor3dv) then Exit;
- glSecondaryColor3f := SDL_GL_GetProcAddress('glSecondaryColor3f');
- if not Assigned(glSecondaryColor3f) then Exit;
- glSecondaryColor3fv := SDL_GL_GetProcAddress('glSecondaryColor3fv');
- if not Assigned(glSecondaryColor3fv) then Exit;
- glSecondaryColor3i := SDL_GL_GetProcAddress('glSecondaryColor3i');
- if not Assigned(glSecondaryColor3i) then Exit;
- glSecondaryColor3iv := SDL_GL_GetProcAddress('glSecondaryColor3iv');
- if not Assigned(glSecondaryColor3iv) then Exit;
- glSecondaryColor3s := SDL_GL_GetProcAddress('glSecondaryColor3s');
- if not Assigned(glSecondaryColor3s) then Exit;
- glSecondaryColor3sv := SDL_GL_GetProcAddress('glSecondaryColor3sv');
- if not Assigned(glSecondaryColor3sv) then Exit;
- glSecondaryColor3ub := SDL_GL_GetProcAddress('glSecondaryColor3ub');
- if not Assigned(glSecondaryColor3ub) then Exit;
- glSecondaryColor3ubv := SDL_GL_GetProcAddress('glSecondaryColor3ubv');
- if not Assigned(glSecondaryColor3ubv) then Exit;
- glSecondaryColor3ui := SDL_GL_GetProcAddress('glSecondaryColor3ui');
- if not Assigned(glSecondaryColor3ui) then Exit;
- glSecondaryColor3uiv := SDL_GL_GetProcAddress('glSecondaryColor3uiv');
- if not Assigned(glSecondaryColor3uiv) then Exit;
- glSecondaryColor3us := SDL_GL_GetProcAddress('glSecondaryColor3us');
- if not Assigned(glSecondaryColor3us) then Exit;
- glSecondaryColor3usv := SDL_GL_GetProcAddress('glSecondaryColor3usv');
- if not Assigned(glSecondaryColor3usv) then Exit;
- glSecondaryColorPointer := SDL_GL_GetProcAddress('glSecondaryColorPointer');
- if not Assigned(glSecondaryColorPointer) then Exit;
- glWindowPos2d := SDL_GL_GetProcAddress('glWindowPos2d');
- if not Assigned(glWindowPos2d) then Exit;
- glWindowPos2dv := SDL_GL_GetProcAddress('glWindowPos2dv');
- if not Assigned(glWindowPos2dv) then Exit;
- glWindowPos2f := SDL_GL_GetProcAddress('glWindowPos2f');
- if not Assigned(glWindowPos2f) then Exit;
- glWindowPos2fv := SDL_GL_GetProcAddress('glWindowPos2fv');
- if not Assigned(glWindowPos2fv) then Exit;
- glWindowPos2i := SDL_GL_GetProcAddress('glWindowPos2i');
- if not Assigned(glWindowPos2i) then Exit;
- glWindowPos2iv := SDL_GL_GetProcAddress('glWindowPos2iv');
- if not Assigned(glWindowPos2iv) then Exit;
- glWindowPos2s := SDL_GL_GetProcAddress('glWindowPos2s');
- if not Assigned(glWindowPos2s) then Exit;
- glWindowPos2sv := SDL_GL_GetProcAddress('glWindowPos2sv');
- if not Assigned(glWindowPos2sv) then Exit;
- glWindowPos3d := SDL_GL_GetProcAddress('glWindowPos3d');
- if not Assigned(glWindowPos3d) then Exit;
- glWindowPos3dv := SDL_GL_GetProcAddress('glWindowPos3dv');
- if not Assigned(glWindowPos3dv) then Exit;
- glWindowPos3f := SDL_GL_GetProcAddress('glWindowPos3f');
- if not Assigned(glWindowPos3f) then Exit;
- glWindowPos3fv := SDL_GL_GetProcAddress('glWindowPos3fv');
- if not Assigned(glWindowPos3fv) then Exit;
- glWindowPos3i := SDL_GL_GetProcAddress('glWindowPos3i');
- if not Assigned(glWindowPos3i) then Exit;
- glWindowPos3iv := SDL_GL_GetProcAddress('glWindowPos3iv');
- if not Assigned(glWindowPos3iv) then Exit;
- glWindowPos3s := SDL_GL_GetProcAddress('glWindowPos3s');
- if not Assigned(glWindowPos3s) then Exit;
- glWindowPos3sv := SDL_GL_GetProcAddress('glWindowPos3sv');
- if not Assigned(glWindowPos3sv) then Exit;
- Result := TRUE;
-
-end;
-
-function Load_GL_version_1_5: Boolean;
-var
- extstring: String;
-begin
-
- Result := FALSE;
- extstring := String(PChar(glGetString(GL_EXTENSIONS)));
-
- glGenQueries := SDL_GL_GetProcAddress('glGenQueries');
- if not Assigned(glGenQueries) then Exit;
- glDeleteQueries := SDL_GL_GetProcAddress('glDeleteQueries');
- if not Assigned(glDeleteQueries) then Exit;
- glIsQuery := SDL_GL_GetProcAddress('glIsQuery');
- if not Assigned(glIsQuery) then Exit;
- glBeginQuery := SDL_GL_GetProcAddress('glBeginQuery');
- if not Assigned(glBeginQuery) then Exit;
- glEndQuery := SDL_GL_GetProcAddress('glEndQuery');
- if not Assigned(glEndQuery) then Exit;
- glGetQueryiv := SDL_GL_GetProcAddress('glGetQueryiv');
- if not Assigned(glGetQueryiv) then Exit;
- glGetQueryObjectiv := SDL_GL_GetProcAddress('glGetQueryObjectiv');
- if not Assigned(glGetQueryObjectiv) then Exit;
- glGetQueryObjectuiv := SDL_GL_GetProcAddress('glGetQueryObjectuiv');
- if not Assigned(glGetQueryObjectuiv) then Exit;
- glBindBuffer := SDL_GL_GetProcAddress('glBindBuffer');
- if not Assigned(glBindBuffer) then Exit;
- glDeleteBuffers := SDL_GL_GetProcAddress('glDeleteBuffers');
- if not Assigned(glDeleteBuffers) then Exit;
- glGenBuffers := SDL_GL_GetProcAddress('glGenBuffers');
- if not Assigned(glGenBuffers) then Exit;
- glIsBuffer := SDL_GL_GetProcAddress('glIsBuffer');
- if not Assigned(glIsBuffer) then Exit;
- glBufferData := SDL_GL_GetProcAddress('glBufferData');
- if not Assigned(glBufferData) then Exit;
- glBufferSubData := SDL_GL_GetProcAddress('glBufferSubData');
- if not Assigned(glBufferSubData) then Exit;
- glGetBufferSubData := SDL_GL_GetProcAddress('glGetBufferSubData');
- if not Assigned(glGetBufferSubData) then Exit;
- glMapBuffer := SDL_GL_GetProcAddress('glMapBuffer');
- if not Assigned(glMapBuffer) then Exit;
- glUnmapBuffer := SDL_GL_GetProcAddress('glUnmapBuffer');
- if not Assigned(glUnmapBuffer) then Exit;
- glGetBufferParameteriv := SDL_GL_GetProcAddress('glGetBufferParameteriv');
- if not Assigned(glGetBufferParameteriv) then Exit;
- glGetBufferPointerv := SDL_GL_GetProcAddress('glGetBufferPointerv');
- if not Assigned(glGetBufferPointerv) then Exit;
- Result := TRUE;
-
-end;
-
-function Load_GL_version_2_0: Boolean;
-var
- extstring: String;
-begin
-
- Result := FALSE;
- extstring := String(PChar(glGetString(GL_EXTENSIONS)));
-
- glBlendEquationSeparate := SDL_GL_GetProcAddress('glBlendEquationSeparate');
- if not Assigned(glBlendEquationSeparate) then Exit;
- glDrawBuffers := SDL_GL_GetProcAddress('glDrawBuffers');
- if not Assigned(glDrawBuffers) then Exit;
- glStencilOpSeparate := SDL_GL_GetProcAddress('glStencilOpSeparate');
- if not Assigned(glStencilOpSeparate) then Exit;
- glStencilFuncSeparate := SDL_GL_GetProcAddress('glStencilFuncSeparate');
- if not Assigned(glStencilFuncSeparate) then Exit;
- glStencilMaskSeparate := SDL_GL_GetProcAddress('glStencilMaskSeparate');
- if not Assigned(glStencilMaskSeparate) then Exit;
- glAttachShader := SDL_GL_GetProcAddress('glAttachShader');
- if not Assigned(glAttachShader) then Exit;
- glBindAttribLocation := SDL_GL_GetProcAddress('glBindAttribLocation');
- if not Assigned(glBindAttribLocation) then Exit;
- glCompileShader := SDL_GL_GetProcAddress('glCompileShader');
- if not Assigned(glCompileShader) then Exit;
- glCreateProgram := SDL_GL_GetProcAddress('glCreateProgram');
- if not Assigned(glCreateProgram) then Exit;
- glCreateShader := SDL_GL_GetProcAddress('glCreateShader');
- if not Assigned(glCreateShader) then Exit;
- glDeleteProgram := SDL_GL_GetProcAddress('glDeleteProgram');
- if not Assigned(glDeleteProgram) then Exit;
- glDeleteShader := SDL_GL_GetProcAddress('glDeleteShader');
- if not Assigned(glDeleteShader) then Exit;
- glDetachShader := SDL_GL_GetProcAddress('glDetachShader');
- if not Assigned(glDetachShader) then Exit;
- glDisableVertexAttribArray := SDL_GL_GetProcAddress('glDisableVertexAttribArray');
- if not Assigned(glDisableVertexAttribArray) then Exit;
- glEnableVertexAttribArray := SDL_GL_GetProcAddress('glEnableVertexAttribArray');
- if not Assigned(glEnableVertexAttribArray) then Exit;
- glGetActiveAttrib := SDL_GL_GetProcAddress('glGetActiveAttrib');
- if not Assigned(glGetActiveAttrib) then Exit;
- glGetActiveUniform := SDL_GL_GetProcAddress('glGetActiveUniform');
- if not Assigned(glGetActiveUniform) then Exit;
- glGetAttachedShaders := SDL_GL_GetProcAddress('glGetAttachedShaders');
- if not Assigned(glGetAttachedShaders) then Exit;
- glGetAttribLocation := SDL_GL_GetProcAddress('glGetAttribLocation');
- if not Assigned(glGetAttribLocation) then Exit;
- glGetProgramiv := SDL_GL_GetProcAddress('glGetProgramiv');
- if not Assigned(glGetProgramiv) then Exit;
- glGetProgramInfoLog := SDL_GL_GetProcAddress('glGetProgramInfoLog');
- if not Assigned(glGetProgramInfoLog) then Exit;
- glGetShaderiv := SDL_GL_GetProcAddress('glGetShaderiv');
- if not Assigned(glGetShaderiv) then Exit;
- glGetShaderInfoLog := SDL_GL_GetProcAddress('glGetShaderInfoLog');
- if not Assigned(glGetShaderInfoLog) then Exit;
- glGetShaderSource := SDL_GL_GetProcAddress('glGetShaderSource');
- if not Assigned(glGetShaderSource) then Exit;
- glGetUniformLocation := SDL_GL_GetProcAddress('glGetUniformLocation');
- if not Assigned(glGetUniformLocation) then Exit;
- glGetUniformfv := SDL_GL_GetProcAddress('glGetUniformfv');
- if not Assigned(glGetUniformfv) then Exit;
- glGetUniformiv := SDL_GL_GetProcAddress('glGetUniformiv');
- if not Assigned(glGetUniformiv) then Exit;
- glGetVertexAttribdv := SDL_GL_GetProcAddress('glGetVertexAttribdv');
- if not Assigned(glGetVertexAttribdv) then Exit;
- glGetVertexAttribfv := SDL_GL_GetProcAddress('glGetVertexAttribfv');
- if not Assigned(glGetVertexAttribfv) then Exit;
- glGetVertexAttribiv := SDL_GL_GetProcAddress('glGetVertexAttribiv');
- if not Assigned(glGetVertexAttribiv) then Exit;
- glGetVertexAttribPointerv := SDL_GL_GetProcAddress('glGetVertexAttribPointerv');
- if not Assigned(glGetVertexAttribPointerv) then Exit;
- glIsProgram := SDL_GL_GetProcAddress('glIsProgram');
- if not Assigned(glIsProgram) then Exit;
- glIsShader := SDL_GL_GetProcAddress('glIsShader');
- if not Assigned(glIsShader) then Exit;
- glLinkProgram := SDL_GL_GetProcAddress('glLinkProgram');
- if not Assigned(glLinkProgram) then Exit;
- glShaderSource := SDL_GL_GetProcAddress('glShaderSource');
- if not Assigned(glShaderSource) then Exit;
- glUseProgram := SDL_GL_GetProcAddress('glUseProgram');
- if not Assigned(glUseProgram) then Exit;
- glUniform1f := SDL_GL_GetProcAddress('glUniform1f');
- if not Assigned(glUniform1f) then Exit;
- glUniform2f := SDL_GL_GetProcAddress('glUniform2f');
- if not Assigned(glUniform2f) then Exit;
- glUniform3f := SDL_GL_GetProcAddress('glUniform3f');
- if not Assigned(glUniform3f) then Exit;
- glUniform4f := SDL_GL_GetProcAddress('glUniform4f');
- if not Assigned(glUniform4f) then Exit;
- glUniform1i := SDL_GL_GetProcAddress('glUniform1i');
- if not Assigned(glUniform1i) then Exit;
- glUniform2i := SDL_GL_GetProcAddress('glUniform2i');
- if not Assigned(glUniform2i) then Exit;
- glUniform3i := SDL_GL_GetProcAddress('glUniform3i');
- if not Assigned(glUniform3i) then Exit;
- glUniform4i := SDL_GL_GetProcAddress('glUniform4i');
- if not Assigned(glUniform4i) then Exit;
- glUniform1fv := SDL_GL_GetProcAddress('glUniform1fv');
- if not Assigned(glUniform1fv) then Exit;
- glUniform2fv := SDL_GL_GetProcAddress('glUniform2fv');
- if not Assigned(glUniform2fv) then Exit;
- glUniform3fv := SDL_GL_GetProcAddress('glUniform3fv');
- if not Assigned(glUniform3fv) then Exit;
- glUniform4fv := SDL_GL_GetProcAddress('glUniform4fv');
- if not Assigned(glUniform4fv) then Exit;
- glUniform1iv := SDL_GL_GetProcAddress('glUniform1iv');
- if not Assigned(glUniform1iv) then Exit;
- glUniform2iv := SDL_GL_GetProcAddress('glUniform2iv');
- if not Assigned(glUniform2iv) then Exit;
- glUniform3iv := SDL_GL_GetProcAddress('glUniform3iv');
- if not Assigned(glUniform3iv) then Exit;
- glUniform4iv := SDL_GL_GetProcAddress('glUniform4iv');
- if not Assigned(glUniform4iv) then Exit;
- glUniformMatrix2fv := SDL_GL_GetProcAddress('glUniformMatrix2fv');
- if not Assigned(glUniformMatrix2fv) then Exit;
- glUniformMatrix3fv := SDL_GL_GetProcAddress('glUniformMatrix3fv');
- if not Assigned(glUniformMatrix3fv) then Exit;
- glUniformMatrix4fv := SDL_GL_GetProcAddress('glUniformMatrix4fv');
- if not Assigned(glUniformMatrix4fv) then Exit;
- glValidateProgram := SDL_GL_GetProcAddress('glValidateProgram');
- if not Assigned(glValidateProgram) then Exit;
- glVertexAttrib1d := SDL_GL_GetProcAddress('glVertexAttrib1d');
- if not Assigned(glVertexAttrib1d) then Exit;
- glVertexAttrib1dv := SDL_GL_GetProcAddress('glVertexAttrib1dv');
- if not Assigned(glVertexAttrib1dv) then Exit;
- glVertexAttrib1f := SDL_GL_GetProcAddress('glVertexAttrib1f');
- if not Assigned(glVertexAttrib1f) then Exit;
- glVertexAttrib1fv := SDL_GL_GetProcAddress('glVertexAttrib1fv');
- if not Assigned(glVertexAttrib1fv) then Exit;
- glVertexAttrib1s := SDL_GL_GetProcAddress('glVertexAttrib1s');
- if not Assigned(glVertexAttrib1s) then Exit;
- glVertexAttrib1sv := SDL_GL_GetProcAddress('glVertexAttrib1sv');
- if not Assigned(glVertexAttrib1sv) then Exit;
- glVertexAttrib2d := SDL_GL_GetProcAddress('glVertexAttrib2d');
- if not Assigned(glVertexAttrib2d) then Exit;
- glVertexAttrib2dv := SDL_GL_GetProcAddress('glVertexAttrib2dv');
- if not Assigned(glVertexAttrib2dv) then Exit;
- glVertexAttrib2f := SDL_GL_GetProcAddress('glVertexAttrib2f');
- if not Assigned(glVertexAttrib2f) then Exit;
- glVertexAttrib2fv := SDL_GL_GetProcAddress('glVertexAttrib2fv');
- if not Assigned(glVertexAttrib2fv) then Exit;
- glVertexAttrib2s := SDL_GL_GetProcAddress('glVertexAttrib2s');
- if not Assigned(glVertexAttrib2s) then Exit;
- glVertexAttrib2sv := SDL_GL_GetProcAddress('glVertexAttrib2sv');
- if not Assigned(glVertexAttrib2sv) then Exit;
- glVertexAttrib3d := SDL_GL_GetProcAddress('glVertexAttrib3d');
- if not Assigned(glVertexAttrib3d) then Exit;
- glVertexAttrib3dv := SDL_GL_GetProcAddress('glVertexAttrib3dv');
- if not Assigned(glVertexAttrib3dv) then Exit;
- glVertexAttrib3f := SDL_GL_GetProcAddress('glVertexAttrib3f');
- if not Assigned(glVertexAttrib3f) then Exit;
- glVertexAttrib3fv := SDL_GL_GetProcAddress('glVertexAttrib3fv');
- if not Assigned(glVertexAttrib3fv) then Exit;
- glVertexAttrib3s := SDL_GL_GetProcAddress('glVertexAttrib3s');
- if not Assigned(glVertexAttrib3s) then Exit;
- glVertexAttrib3sv := SDL_GL_GetProcAddress('glVertexAttrib3sv');
- if not Assigned(glVertexAttrib3sv) then Exit;
- glVertexAttrib4Nbv := SDL_GL_GetProcAddress('glVertexAttrib4Nbv');
- if not Assigned(glVertexAttrib4Nbv) then Exit;
- glVertexAttrib4Niv := SDL_GL_GetProcAddress('glVertexAttrib4Niv');
- if not Assigned(glVertexAttrib4Niv) then Exit;
- glVertexAttrib4Nsv := SDL_GL_GetProcAddress('glVertexAttrib4Nsv');
- if not Assigned(glVertexAttrib4Nsv) then Exit;
- glVertexAttrib4Nub := SDL_GL_GetProcAddress('glVertexAttrib4Nub');
- if not Assigned(glVertexAttrib4Nub) then Exit;
- glVertexAttrib4Nubv := SDL_GL_GetProcAddress('glVertexAttrib4Nubv');
- if not Assigned(glVertexAttrib4Nubv) then Exit;
- glVertexAttrib4Nuiv := SDL_GL_GetProcAddress('glVertexAttrib4Nuiv');
- if not Assigned(glVertexAttrib4Nuiv) then Exit;
- glVertexAttrib4Nusv := SDL_GL_GetProcAddress('glVertexAttrib4Nusv');
- if not Assigned(glVertexAttrib4Nusv) then Exit;
- glVertexAttrib4bv := SDL_GL_GetProcAddress('glVertexAttrib4bv');
- if not Assigned(glVertexAttrib4bv) then Exit;
- glVertexAttrib4d := SDL_GL_GetProcAddress('glVertexAttrib4d');
- if not Assigned(glVertexAttrib4d) then Exit;
- glVertexAttrib4dv := SDL_GL_GetProcAddress('glVertexAttrib4dv');
- if not Assigned(glVertexAttrib4dv) then Exit;
- glVertexAttrib4f := SDL_GL_GetProcAddress('glVertexAttrib4f');
- if not Assigned(glVertexAttrib4f) then Exit;
- glVertexAttrib4fv := SDL_GL_GetProcAddress('glVertexAttrib4fv');
- if not Assigned(glVertexAttrib4fv) then Exit;
- glVertexAttrib4iv := SDL_GL_GetProcAddress('glVertexAttrib4iv');
- if not Assigned(glVertexAttrib4iv) then Exit;
- glVertexAttrib4s := SDL_GL_GetProcAddress('glVertexAttrib4s');
- if not Assigned(glVertexAttrib4s) then Exit;
- glVertexAttrib4sv := SDL_GL_GetProcAddress('glVertexAttrib4sv');
- if not Assigned(glVertexAttrib4sv) then Exit;
- glVertexAttrib4ubv := SDL_GL_GetProcAddress('glVertexAttrib4ubv');
- if not Assigned(glVertexAttrib4ubv) then Exit;
- glVertexAttrib4uiv := SDL_GL_GetProcAddress('glVertexAttrib4uiv');
- if not Assigned(glVertexAttrib4uiv) then Exit;
- glVertexAttrib4usv := SDL_GL_GetProcAddress('glVertexAttrib4usv');
- if not Assigned(glVertexAttrib4usv) then Exit;
- glVertexAttribPointer := SDL_GL_GetProcAddress('glVertexAttribPointer');
- if not Assigned(glVertexAttribPointer) then Exit;
- Result := TRUE;
-
-end;
-
-function glext_LoadExtension(ext: String): Boolean;
-begin
-
- Result := FALSE;
-
- if ext = 'GL_version_1_2' then Result := Load_GL_version_1_2
- else if ext = 'GL_ARB_imaging' then Result := Load_GL_ARB_imaging
- else if ext = 'GL_version_1_3' then Result := Load_GL_version_1_3
- else if ext = 'GL_ARB_multitexture' then Result := Load_GL_ARB_multitexture
- else if ext = 'GL_ARB_transpose_matrix' then Result := Load_GL_ARB_transpose_matrix
- else if ext = 'GL_ARB_multisample' then Result := Load_GL_ARB_multisample
- else if ext = 'GL_ARB_texture_env_add' then Result := Load_GL_ARB_texture_env_add
- {$IFDEF WINDOWS}
- else if ext = 'WGL_ARB_extensions_string' then Result := Load_WGL_ARB_extensions_string
- else if ext = 'WGL_ARB_buffer_region' then Result := Load_WGL_ARB_buffer_region
- {$ENDIF}
- else if ext = 'GL_ARB_texture_cube_map' then Result := Load_GL_ARB_texture_cube_map
- else if ext = 'GL_ARB_depth_texture' then Result := Load_GL_ARB_depth_texture
- else if ext = 'GL_ARB_point_parameters' then Result := Load_GL_ARB_point_parameters
- else if ext = 'GL_ARB_shadow' then Result := Load_GL_ARB_shadow
- else if ext = 'GL_ARB_shadow_ambient' then Result := Load_GL_ARB_shadow_ambient
- else if ext = 'GL_ARB_texture_border_clamp' then Result := Load_GL_ARB_texture_border_clamp
- else if ext = 'GL_ARB_texture_compression' then Result := Load_GL_ARB_texture_compression
- else if ext = 'GL_ARB_texture_env_combine' then Result := Load_GL_ARB_texture_env_combine
- else if ext = 'GL_ARB_texture_env_crossbar' then Result := Load_GL_ARB_texture_env_crossbar
- else if ext = 'GL_ARB_texture_env_dot3' then Result := Load_GL_ARB_texture_env_dot3
- else if ext = 'GL_ARB_texture_mirrored_repeat' then Result := Load_GL_ARB_texture_mirrored_repeat
- else if ext = 'GL_ARB_vertex_blend' then Result := Load_GL_ARB_vertex_blend
- else if ext = 'GL_ARB_vertex_program' then Result := Load_GL_ARB_vertex_program
- else if ext = 'GL_ARB_window_pos' then Result := Load_GL_ARB_window_pos
- else if ext = 'GL_EXT_422_pixels' then Result := Load_GL_EXT_422_pixels
- else if ext = 'GL_EXT_abgr' then Result := Load_GL_EXT_abgr
- else if ext = 'GL_EXT_bgra' then Result := Load_GL_EXT_bgra
- else if ext = 'GL_EXT_blend_color' then Result := Load_GL_EXT_blend_color
- else if ext = 'GL_EXT_blend_func_separate' then Result := Load_GL_EXT_blend_func_separate
- else if ext = 'GL_EXT_blend_logic_op' then Result := Load_GL_EXT_blend_logic_op
- else if ext = 'GL_EXT_blend_minmax' then Result := Load_GL_EXT_blend_minmax
- else if ext = 'GL_EXT_blend_subtract' then Result := Load_GL_EXT_blend_subtract
- else if ext = 'GL_EXT_clip_volume_hint' then Result := Load_GL_EXT_clip_volume_hint
- else if ext = 'GL_EXT_color_subtable' then Result := Load_GL_EXT_color_subtable
- else if ext = 'GL_EXT_compiled_vertex_array' then Result := Load_GL_EXT_compiled_vertex_array
- else if ext = 'GL_EXT_convolution' then Result := Load_GL_EXT_convolution
- else if ext = 'GL_EXT_histogram' then Result := Load_GL_EXT_histogram
- else if ext = 'GL_EXT_multi_draw_arrays' then Result := Load_GL_EXT_multi_draw_arrays
- else if ext = 'GL_EXT_packed_pixels' then Result := Load_GL_EXT_packed_pixels
- else if ext = 'GL_EXT_paletted_texture' then Result := Load_GL_EXT_paletted_texture
- else if ext = 'GL_EXT_point_parameters' then Result := Load_GL_EXT_point_parameters
- else if ext = 'GL_EXT_polygon_offset' then Result := Load_GL_EXT_polygon_offset
- else if ext = 'GL_EXT_separate_specular_color' then Result := Load_GL_EXT_separate_specular_color
- else if ext = 'GL_EXT_shadow_funcs' then Result := Load_GL_EXT_shadow_funcs
- else if ext = 'GL_EXT_shared_texture_palette' then Result := Load_GL_EXT_shared_texture_palette
- else if ext = 'GL_EXT_stencil_two_side' then Result := Load_GL_EXT_stencil_two_side
- else if ext = 'GL_EXT_stencil_wrap' then Result := Load_GL_EXT_stencil_wrap
- else if ext = 'GL_EXT_subtexture' then Result := Load_GL_EXT_subtexture
- else if ext = 'GL_EXT_texture3D' then Result := Load_GL_EXT_texture3D
- else if ext = 'GL_EXT_texture_compression_s3tc' then Result := Load_GL_EXT_texture_compression_s3tc
- else if ext = 'GL_EXT_texture_env_add' then Result := Load_GL_EXT_texture_env_add
- else if ext = 'GL_EXT_texture_env_combine' then Result := Load_GL_EXT_texture_env_combine
- else if ext = 'GL_EXT_texture_env_dot3' then Result := Load_GL_EXT_texture_env_dot3
- else if ext = 'GL_EXT_texture_filter_anisotropic' then Result := Load_GL_EXT_texture_filter_anisotropic
- else if ext = 'GL_EXT_texture_lod_bias' then Result := Load_GL_EXT_texture_lod_bias
- else if ext = 'GL_EXT_texture_object' then Result := Load_GL_EXT_texture_object
- else if ext = 'GL_EXT_vertex_array' then Result := Load_GL_EXT_vertex_array
- else if ext = 'GL_EXT_vertex_shader' then Result := Load_GL_EXT_vertex_shader
- else if ext = 'GL_EXT_vertex_weighting' then Result := Load_GL_EXT_vertex_weighting
- else if ext = 'GL_HP_occlusion_test' then Result := Load_GL_HP_occlusion_test
- else if ext = 'GL_NV_blend_square' then Result := Load_GL_NV_blend_square
- else if ext = 'GL_NV_copy_depth_to_color' then Result := Load_GL_NV_copy_depth_to_color
- else if ext = 'GL_NV_depth_clamp' then Result := Load_GL_NV_depth_clamp
- else if ext = 'GL_NV_evaluators' then Result := Load_GL_NV_evaluators
- else if ext = 'GL_NV_fence' then Result := Load_GL_NV_fence
- else if ext = 'GL_NV_fog_distance' then Result := Load_GL_NV_fog_distance
- else if ext = 'GL_NV_light_max_exponent' then Result := Load_GL_NV_light_max_exponent
- else if ext = 'GL_NV_multisample_filter_hint' then Result := Load_GL_NV_multisample_filter_hint
- else if ext = 'GL_NV_occlusion_query' then Result := Load_GL_NV_occlusion_query
- else if ext = 'GL_NV_packed_depth_stencil' then Result := Load_GL_NV_packed_depth_stencil
- else if ext = 'GL_NV_point_sprite' then Result := Load_GL_NV_point_sprite
- else if ext = 'GL_NV_register_combiners' then Result := Load_GL_NV_register_combiners
- else if ext = 'GL_NV_register_combiners2' then Result := Load_GL_NV_register_combiners2
- else if ext = 'GL_NV_texgen_emboss' then Result := Load_GL_NV_texgen_emboss
- else if ext = 'GL_NV_texgen_reflection' then Result := Load_GL_NV_texgen_reflection
- else if ext = 'GL_NV_texture_compression_vtc' then Result := Load_GL_NV_texture_compression_vtc
- else if ext = 'GL_NV_texture_env_combine4' then Result := Load_GL_NV_texture_env_combine4
- else if ext = 'GL_NV_texture_rectangle' then Result := Load_GL_NV_texture_rectangle
- else if ext = 'GL_NV_texture_shader' then Result := Load_GL_NV_texture_shader
- else if ext = 'GL_NV_texture_shader2' then Result := Load_GL_NV_texture_shader2
- else if ext = 'GL_NV_texture_shader3' then Result := Load_GL_NV_texture_shader3
- else if ext = 'GL_NV_vertex_array_range' then Result := Load_GL_NV_vertex_array_range
- else if ext = 'GL_NV_vertex_array_range2' then Result := Load_GL_NV_vertex_array_range2
- else if ext = 'GL_NV_vertex_program' then Result := Load_GL_NV_vertex_program
- else if ext = 'GL_NV_vertex_program1_1' then Result := Load_GL_NV_vertex_program1_1
- else if ext = 'GL_ATI_element_array' then Result := Load_GL_ATI_element_array
- else if ext = 'GL_ATI_envmap_bumpmap' then Result := Load_GL_ATI_envmap_bumpmap
- else if ext = 'GL_ATI_fragment_shader' then Result := Load_GL_ATI_fragment_shader
- else if ext = 'GL_ATI_pn_triangles' then Result := Load_GL_ATI_pn_triangles
- else if ext = 'GL_ATI_texture_mirror_once' then Result := Load_GL_ATI_texture_mirror_once
- else if ext = 'GL_ATI_vertex_array_object' then Result := Load_GL_ATI_vertex_array_object
- else if ext = 'GL_ATI_vertex_streams' then Result := Load_GL_ATI_vertex_streams
- {$IFDEF WINDOWS}
- else if ext = 'WGL_I3D_image_buffer' then Result := Load_WGL_I3D_image_buffer
- else if ext = 'WGL_I3D_swap_frame_lock' then Result := Load_WGL_I3D_swap_frame_lock
- else if ext = 'WGL_I3D_swap_frame_usage' then Result := Load_WGL_I3D_swap_frame_usage
- {$ENDIF}
- else if ext = 'GL_3DFX_texture_compression_FXT1' then Result := Load_GL_3DFX_texture_compression_FXT1
- else if ext = 'GL_IBM_cull_vertex' then Result := Load_GL_IBM_cull_vertex
- else if ext = 'GL_IBM_multimode_draw_arrays' then Result := Load_GL_IBM_multimode_draw_arrays
- else if ext = 'GL_IBM_raster_pos_clip' then Result := Load_GL_IBM_raster_pos_clip
- else if ext = 'GL_IBM_texture_mirrored_repeat' then Result := Load_GL_IBM_texture_mirrored_repeat
- else if ext = 'GL_IBM_vertex_array_lists' then Result := Load_GL_IBM_vertex_array_lists
- else if ext = 'GL_MESA_resize_buffers' then Result := Load_GL_MESA_resize_buffers
- else if ext = 'GL_MESA_window_pos' then Result := Load_GL_MESA_window_pos
- else if ext = 'GL_OML_interlace' then Result := Load_GL_OML_interlace
- else if ext = 'GL_OML_resample' then Result := Load_GL_OML_resample
- else if ext = 'GL_OML_subsample' then Result := Load_GL_OML_subsample
- else if ext = 'GL_SGIS_generate_mipmap' then Result := Load_GL_SGIS_generate_mipmap
- else if ext = 'GL_SGIS_multisample' then Result := Load_GL_SGIS_multisample
- else if ext = 'GL_SGIS_pixel_texture' then Result := Load_GL_SGIS_pixel_texture
- else if ext = 'GL_SGIS_texture_border_clamp' then Result := Load_GL_SGIS_texture_border_clamp
- else if ext = 'GL_SGIS_texture_color_mask' then Result := Load_GL_SGIS_texture_color_mask
- else if ext = 'GL_SGIS_texture_edge_clamp' then Result := Load_GL_SGIS_texture_edge_clamp
- else if ext = 'GL_SGIS_texture_lod' then Result := Load_GL_SGIS_texture_lod
- else if ext = 'GL_SGIS_depth_texture' then Result := Load_GL_SGIS_depth_texture
- else if ext = 'GL_SGIX_fog_offset' then Result := Load_GL_SGIX_fog_offset
- else if ext = 'GL_SGIX_interlace' then Result := Load_GL_SGIX_interlace
- else if ext = 'GL_SGIX_shadow_ambient' then Result := Load_GL_SGIX_shadow_ambient
- else if ext = 'GL_SGI_color_matrix' then Result := Load_GL_SGI_color_matrix
- else if ext = 'GL_SGI_color_table' then Result := Load_GL_SGI_color_table
- else if ext = 'GL_SGI_texture_color_table' then Result := Load_GL_SGI_texture_color_table
- else if ext = 'GL_SUN_vertex' then Result := Load_GL_SUN_vertex
- else if ext = 'GL_ARB_fragment_program' then Result := Load_GL_ARB_fragment_program
- else if ext = 'GL_ATI_text_fragment_shader' then Result := Load_GL_ATI_text_fragment_shader
- else if ext = 'GL_APPLE_client_storage' then Result := Load_GL_APPLE_client_storage
- else if ext = 'GL_APPLE_element_array' then Result := Load_GL_APPLE_element_array
- else if ext = 'GL_APPLE_fence' then Result := Load_GL_APPLE_fence
- else if ext = 'GL_APPLE_vertex_array_object' then Result := Load_GL_APPLE_vertex_array_object
- else if ext = 'GL_APPLE_vertex_array_range' then Result := Load_GL_APPLE_vertex_array_range
- {$IFDEF WINDOWS}
- else if ext = 'WGL_ARB_pixel_format' then Result := Load_WGL_ARB_pixel_format
- else if ext = 'WGL_ARB_make_current_read' then Result := Load_WGL_ARB_make_current_read
- else if ext = 'WGL_ARB_pbuffer' then Result := Load_WGL_ARB_pbuffer
- else if ext = 'WGL_EXT_swap_control' then Result := Load_WGL_EXT_swap_control
- else if ext = 'WGL_ARB_render_texture' then Result := Load_WGL_ARB_render_texture
- else if ext = 'WGL_EXT_extensions_string' then Result := Load_WGL_EXT_extensions_string
- else if ext = 'WGL_EXT_make_current_read' then Result := Load_WGL_EXT_make_current_read
- else if ext = 'WGL_EXT_pbuffer' then Result := Load_WGL_EXT_pbuffer
- else if ext = 'WGL_EXT_pixel_format' then Result := Load_WGL_EXT_pixel_format
- else if ext = 'WGL_I3D_digital_video_control' then Result := Load_WGL_I3D_digital_video_control
- else if ext = 'WGL_I3D_gamma' then Result := Load_WGL_I3D_gamma
- else if ext = 'WGL_I3D_genlock' then Result := Load_WGL_I3D_genlock
- {$ENDIF}
- else if ext = 'GL_ARB_matrix_palette' then Result := Load_GL_ARB_matrix_palette
- else if ext = 'GL_NV_element_array' then Result := Load_GL_NV_element_array
- else if ext = 'GL_NV_float_buffer' then Result := Load_GL_NV_float_buffer
- else if ext = 'GL_NV_fragment_program' then Result := Load_GL_NV_fragment_program
- else if ext = 'GL_NV_primitive_restart' then Result := Load_GL_NV_primitive_restart
- else if ext = 'GL_NV_vertex_program2' then Result := Load_GL_NV_vertex_program2
- {$IFDEF WINDOWS}
- else if ext = 'WGL_NV_render_texture_rectangle' then Result := Load_WGL_NV_render_texture_rectangle
- {$ENDIF}
- else if ext = 'GL_NV_pixel_data_range' then Result := Load_GL_NV_pixel_data_range
- else if ext = 'GL_EXT_texture_rectangle' then Result := Load_GL_EXT_texture_rectangle
- else if ext = 'GL_S3_s3tc' then Result := Load_GL_S3_s3tc
- else if ext = 'GL_ATI_draw_buffers' then Result := Load_GL_ATI_draw_buffers
- {$IFDEF WINDOWS}
- else if ext = 'WGL_ATI_pixel_format_float' then Result := Load_WGL_ATI_pixel_format_float
- {$ENDIF}
- else if ext = 'GL_ATI_texture_env_combine3' then Result := Load_GL_ATI_texture_env_combine3
- else if ext = 'GL_ATI_texture_float' then Result := Load_GL_ATI_texture_float
- else if ext = 'GL_NV_texture_expand_normal' then Result := Load_GL_NV_texture_expand_normal
- else if ext = 'GL_NV_half_float' then Result := Load_GL_NV_half_float
- else if ext = 'GL_ATI_map_object_buffer' then Result := Load_GL_ATI_map_object_buffer
- else if ext = 'GL_ATI_separate_stencil' then Result := Load_GL_ATI_separate_stencil
- else if ext = 'GL_ATI_vertex_attrib_array_object' then Result := Load_GL_ATI_vertex_attrib_array_object
- else if ext = 'GL_ARB_vertex_buffer_object' then Result := Load_GL_ARB_vertex_buffer_object
- else if ext = 'GL_ARB_occlusion_query' then Result := Load_GL_ARB_occlusion_query
- else if ext = 'GL_ARB_shader_objects' then Result := Load_GL_ARB_shader_objects
- else if ext = 'GL_ARB_vertex_shader' then Result := Load_GL_ARB_vertex_shader
- else if ext = 'GL_ARB_fragment_shader' then Result := Load_GL_ARB_fragment_shader
- else if ext = 'GL_ARB_shading_language_100' then Result := Load_GL_ARB_shading_language_100
- else if ext = 'GL_ARB_texture_non_power_of_two' then Result := Load_GL_ARB_texture_non_power_of_two
- else if ext = 'GL_ARB_point_sprite' then Result := Load_GL_ARB_point_sprite
- else if ext = 'GL_EXT_depth_bounds_test' then Result := Load_GL_EXT_depth_bounds_test
- else if ext = 'GL_EXT_secondary_color' then Result := Load_GL_EXT_secondary_color
- else if ext = 'GL_EXT_texture_mirror_clamp' then Result := Load_GL_EXT_texture_mirror_clamp
- else if ext = 'GL_EXT_blend_equation_separate' then Result := Load_GL_EXT_blend_equation_separate
- else if ext = 'GL_MESA_pack_invert' then Result := Load_GL_MESA_pack_invert
- else if ext = 'GL_MESA_ycbcr_texture' then Result := Load_GL_MESA_ycbcr_texture
- else if ext = 'GL_ARB_fragment_program_shadow' then Result := Load_GL_ARB_fragment_program_shadow
- else if ext = 'GL_EXT_fog_coord' then Result := Load_GL_EXT_fog_coord
- else if ext = 'GL_NV_fragment_program_option' then Result := Load_GL_NV_fragment_program_option
- else if ext = 'GL_EXT_pixel_buffer_object' then Result := Load_GL_EXT_pixel_buffer_object
- else if ext = 'GL_NV_fragment_program2' then Result := Load_GL_NV_fragment_program2
- else if ext = 'GL_NV_vertex_program2_option' then Result := Load_GL_NV_vertex_program2_option
- else if ext = 'GL_NV_vertex_program3' then Result := Load_GL_NV_vertex_program3
- else if ext = 'GL_ARB_draw_buffers' then Result := Load_GL_ARB_draw_buffers
- else if ext = 'GL_ARB_texture_rectangle' then Result := Load_GL_ARB_texture_rectangle
- else if ext = 'GL_ARB_color_buffer_float' then Result := Load_GL_ARB_color_buffer_float
- else if ext = 'GL_ARB_half_float_pixel' then Result := Load_GL_ARB_half_float_pixel
- else if ext = 'GL_ARB_texture_float' then Result := Load_GL_ARB_texture_float
- else if ext = 'GL_EXT_texture_compression_dxt1' then Result := Load_GL_EXT_texture_compression_dxt1
- else if ext = 'GL_ARB_pixel_buffer_object' then Result := Load_GL_ARB_pixel_buffer_object
- else if ext = 'GL_EXT_framebuffer_object' then Result := Load_GL_EXT_framebuffer_object
- else if ext = 'GL_version_1_4' then Result := Load_GL_version_1_4
- else if ext = 'GL_version_1_5' then Result := Load_GL_version_1_5
- else if ext = 'GL_version_2_0' then Result := Load_GL_version_2_0
-
-end;
-
-end.
+unit glext; +{ + $Id: glext.pas,v 1.6 2007/05/20 20:28:31 savage Exp $ + +} +(************************************************** + * OpenGL extension loading library * + * Generated by MetaGLext, written by Tom Nuydens * + * (tom@delphi3d.net -- http://www.delphi3d.net * + **************************************************) + +{ + $Log: glext.pas,v $ + Revision 1.6 2007/05/20 20:28:31 savage + Initial Changes to Handle 64 Bits + + Revision 1.5 2006/01/11 22:39:02 drellis + Updated to Support Up to OpenGL 2.0 + + Revision 1.4 2005/01/05 00:28:40 savage + Forgot to wrap a couple of Load_WGL function calls with an IFDEF WIN32. Fixed so now compiles under Linux as well. + + Revision 1.3 2004/08/24 19:33:06 savage + Removed declarations of SDL_GL_GetProcAddress as the correct ones are in sdl.pas. + + Revision 1.2 2004/08/09 00:38:01 savage + Updated to Tom's latest version. May contains bugs, but I hope not. + + Revision 1.1 2004/03/30 21:53:54 savage + Moved to it's own folder. + + Revision 1.6 2004/03/28 00:28:43 savage + Fixed some glSecondaryColor definitions... + + Revision 1.5 2004/02/20 17:18:16 savage + Forgot to prefix function pointer with @ for FPC and other Pascal compilers. + + Revision 1.4 2004/02/20 17:09:55 savage + Code tidied up in gl, glu and glut, while extensions in glext.pas are now loaded using SDL_GL_GetProcAddress, thus making it more cross-platform compatible, but now more tied to SDL. + + Revision 1.3 2004/02/14 22:36:29 savage + Fixed inconsistencies of using LoadLibrary and LoadModule. + Now all units make use of LoadModule rather than LoadLibrary and other dynamic proc procedures. + + Revision 1.2 2004/02/14 00:09:19 savage + Changed uses to now make use of moduleloader.pas rather than dllfuncs.pas + + Revision 1.1 2004/02/05 00:08:19 savage + Module 1.0 release + + Revision 1.7 2003/06/02 12:32:13 savage + Modified Sources to avoid warnings with Delphi by moving CVS Logging to the top of the header files. Hopefully CVS Logging still works. + +} + +interface + +{$I jedi-sdl.inc} + +uses + SysUtils, +{$IFDEF __GPC__} + gpc, +{$ENDIF} + +{$IFDEF WINDOWS} + Windows, +{$ENDIF} + moduleloader, + gl; + +// Test if the given extension name is present in the given extension string. +function glext_ExtensionSupported(const extension: PChar; const searchIn: PChar): Boolean; + +// Load a Specific Extension +function glext_LoadExtension(ext: String): Boolean; +// Some types that were introduced by extensions: +type + GLintptrARB = Integer; + PGLintptrARB = ^GLintptrARB; + + GLsizeiptrARB = Integer; + PGLsizeiptrARB = ^GLsizeiptrARB; + + GLcharARB = Char; + PGLcharARB = ^GLcharARB; + + GLhandleARB = Cardinal; + PGLhandleARB = ^GLhandleARB; + + GLintptr = Integer; + PGLintptr = ^GLintptr; + + GLsizeiptr = Integer; + PGLsizeiptr = ^GLsizeiptr; + + GLchar = Char; + PGLchar = ^GLchar; + +//***** GL_version_1_2 *****// +const + GL_UNSIGNED_BYTE_3_3_2 = $8032; + GL_UNSIGNED_SHORT_4_4_4_4 = $8033; + GL_UNSIGNED_SHORT_5_5_5_1 = $8034; + GL_UNSIGNED_INT_8_8_8_8 = $8035; + GL_UNSIGNED_INT_10_10_10_2 = $8036; + GL_RESCALE_NORMAL = $803A; + GL_UNSIGNED_BYTE_2_3_3_REV = $8362; + GL_UNSIGNED_SHORT_5_6_5 = $8363; + GL_UNSIGNED_SHORT_5_6_5_REV = $8364; + GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365; + GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366; + GL_UNSIGNED_INT_8_8_8_8_REV = $8367; + GL_UNSIGNED_INT_2_10_10_10_REV = $8368; + GL_BGR = $80E0; + GL_BGRA = $80E1; + GL_MAX_ELEMENTS_VERTICES = $80E8; + GL_MAX_ELEMENTS_INDICES = $80E9; + GL_CLAMP_TO_EDGE = $812F; + GL_TEXTURE_MIN_LOD = $813A; + GL_TEXTURE_MAX_LOD = $813B; + GL_TEXTURE_BASE_LEVEL = $813C; + GL_TEXTURE_MAX_LEVEL = $813D; + GL_LIGHT_MODEL_COLOR_CONTROL = $81F8; + GL_SINGLE_COLOR = $81F9; + GL_SEPARATE_SPECULAR_COLOR = $81FA; + GL_SMOOTH_POINT_SIZE_RANGE = $0B12; + GL_SMOOTH_POINT_SIZE_GRANULARITY = $0B13; + GL_SMOOTH_LINE_WIDTH_RANGE = $0B22; + GL_SMOOTH_LINE_WIDTH_GRANULARITY = $0B23; + GL_ALIASED_POINT_SIZE_RANGE = $846D; + GL_ALIASED_LINE_WIDTH_RANGE = $846E; + GL_PACK_SKIP_IMAGES = $806B; + GL_PACK_IMAGE_HEIGHT = $806C; + GL_UNPACK_SKIP_IMAGES = $806D; + GL_UNPACK_IMAGE_HEIGHT = $806E; + GL_TEXTURE_3D = $806F; + GL_PROXY_TEXTURE_3D = $8070; + GL_TEXTURE_DEPTH = $8071; + GL_TEXTURE_WRAP_R = $8072; + GL_MAX_3D_TEXTURE_SIZE = $8073; +var + glDrawRangeElements: procedure(mode: GLenum; start: GLuint; _end: GLuint; count: GLsizei; _type: GLenum; const indices: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexImage3D: procedure(target: GLenum; level: GLint; internalformat: GLint; width: GLsizei; height: GLsizei; depth: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexSubImage3D: procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; zoffset: GLint; width: GLsizei; height: GLsizei; depth: GLsizei; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCopyTexSubImage3D: procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; zoffset: GLint; x: GLint; y: GLint; width: GLsizei; height: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_version_1_2: Boolean; + +//***** GL_ARB_imaging *****// +const + GL_CONSTANT_COLOR = $8001; + GL_ONE_MINUS_CONSTANT_COLOR = $8002; + GL_CONSTANT_ALPHA = $8003; + GL_ONE_MINUS_CONSTANT_ALPHA = $8004; + GL_BLEND_COLOR = $8005; + GL_FUNC_ADD = $8006; + GL_MIN = $8007; + GL_MAX = $8008; + GL_BLEND_EQUATION = $8009; + GL_FUNC_SUBTRACT = $800A; + GL_FUNC_REVERSE_SUBTRACT = $800B; + GL_CONVOLUTION_1D = $8010; + GL_CONVOLUTION_2D = $8011; + GL_SEPARABLE_2D = $8012; + GL_CONVOLUTION_BORDER_MODE = $8013; + GL_CONVOLUTION_FILTER_SCALE = $8014; + GL_CONVOLUTION_FILTER_BIAS = $8015; + GL_REDUCE = $8016; + GL_CONVOLUTION_FORMAT = $8017; + GL_CONVOLUTION_WIDTH = $8018; + GL_CONVOLUTION_HEIGHT = $8019; + GL_MAX_CONVOLUTION_WIDTH = $801A; + GL_MAX_CONVOLUTION_HEIGHT = $801B; + GL_POST_CONVOLUTION_RED_SCALE = $801C; + GL_POST_CONVOLUTION_GREEN_SCALE = $801D; + GL_POST_CONVOLUTION_BLUE_SCALE = $801E; + GL_POST_CONVOLUTION_ALPHA_SCALE = $801F; + GL_POST_CONVOLUTION_RED_BIAS = $8020; + GL_POST_CONVOLUTION_GREEN_BIAS = $8021; + GL_POST_CONVOLUTION_BLUE_BIAS = $8022; + GL_POST_CONVOLUTION_ALPHA_BIAS = $8023; + GL_HISTOGRAM = $8024; + GL_PROXY_HISTOGRAM = $8025; + GL_HISTOGRAM_WIDTH = $8026; + GL_HISTOGRAM_FORMAT = $8027; + GL_HISTOGRAM_RED_SIZE = $8028; + GL_HISTOGRAM_GREEN_SIZE = $8029; + GL_HISTOGRAM_BLUE_SIZE = $802A; + GL_HISTOGRAM_ALPHA_SIZE = $802B; + GL_HISTOGRAM_LUMINANCE_SIZE = $802C; + GL_HISTOGRAM_SINK = $802D; + GL_MINMAX = $802E; + GL_MINMAX_FORMAT = $802F; + GL_MINMAX_SINK = $8030; + GL_TABLE_TOO_LARGE = $8031; + GL_COLOR_MATRIX = $80B1; + GL_COLOR_MATRIX_STACK_DEPTH = $80B2; + GL_MAX_COLOR_MATRIX_STACK_DEPTH = $80B3; + GL_POST_COLOR_MATRIX_RED_SCALE = $80B4; + GL_POST_COLOR_MATRIX_GREEN_SCALE = $80B5; + GL_POST_COLOR_MATRIX_BLUE_SCALE = $80B6; + GL_POST_COLOR_MATRIX_ALPHA_SCALE = $80B7; + GL_POST_COLOR_MATRIX_RED_BIAS = $80B8; + GL_POST_COLOR_MATRIX_GREEN_BIAS = $80B9; + GL_POST_COLOR_MATRIX_BLUE_BIAS = $80BA; + GL_POST_COLOR_MATIX_ALPHA_BIAS = $80BB; + GL_COLOR_TABLE = $80D0; + GL_POST_CONVOLUTION_COLOR_TABLE = $80D1; + GL_POST_COLOR_MATRIX_COLOR_TABLE = $80D2; + GL_PROXY_COLOR_TABLE = $80D3; + GL_PROXY_POST_CONVOLUTION_COLOR_TABLE = $80D4; + GL_PROXY_POST_COLOR_MATRIX_COLOR_TABLE = $80D5; + GL_COLOR_TABLE_SCALE = $80D6; + GL_COLOR_TABLE_BIAS = $80D7; + GL_COLOR_TABLE_FORMAT = $80D8; + GL_COLOR_TABLE_WIDTH = $80D9; + GL_COLOR_TABLE_RED_SIZE = $80DA; + GL_COLOR_TABLE_GREEN_SIZE = $80DB; + GL_COLOR_TABLE_BLUE_SIZE = $80DC; + GL_COLOR_TABLE_ALPHA_SIZE = $80DD; + GL_COLOR_TABLE_LUMINANCE_SIZE = $80DE; + GL_COLOR_TABLE_INTENSITY_SIZE = $80DF; + GL_IGNORE_BORDER = $8150; + GL_CONSTANT_BORDER = $8151; + GL_WRAP_BORDER = $8152; + GL_REPLICATE_BORDER = $8153; + GL_CONVOLUTION_BORDER_COLOR = $8154; +var + glColorTable: procedure(target: GLenum; internalformat: GLenum; width: GLsizei; format: GLenum; _type: GLenum; const table: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColorTableParameterfv: procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColorTableParameteriv: procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCopyColorTable: procedure(target: GLenum; internalformat: GLenum; x: GLint; y: GLint; width: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetColorTable: procedure(target: GLenum; format: GLenum; _type: GLenum; table: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetColorTableParameterfv: procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetColorTableParameteriv: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColorSubTable: procedure(target: GLenum; start: GLsizei; count: GLsizei; format: GLenum; _type: GLenum; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCopyColorSubTable: procedure(target: GLenum; start: GLsizei; x: GLint; y: GLint; width: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glConvolutionFilter1D: procedure(target: GLenum; internalformat: GLenum; width: GLsizei; format: GLenum; _type: GLenum; const image: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glConvolutionFilter2D: procedure(target: GLenum; internalformat: GLenum; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; const image: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glConvolutionParameterf: procedure(target: GLenum; pname: GLenum; params: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glConvolutionParameterfv: procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glConvolutionParameteri: procedure(target: GLenum; pname: GLenum; params: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glConvolutionParameteriv: procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCopyConvolutionFilter1D: procedure(target: GLenum; internalformat: GLenum; x: GLint; y: GLint; width: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCopyConvolutionFilter2D: procedure(target: GLenum; internalformat: GLenum; x: GLint; y: GLint; width: GLsizei; height: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetConvolutionFilter: procedure(target: GLenum; format: GLenum; _type: GLenum; image: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetConvolutionParameterfv: procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetConvolutionParameteriv: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetSeparableFilter: procedure(target: GLenum; format: GLenum; _type: GLenum; row: PGLvoid; column: PGLvoid; span: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSeparableFilter2D: procedure(target: GLenum; internalformat: GLenum; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; const row: PGLvoid; const column: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetHistogram: procedure(target: GLenum; reset: GLboolean; format: GLenum; _type: GLenum; values: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetHistogramParameterfv: procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetHistogramParameteriv: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetMinmax: procedure(target: GLenum; reset: GLboolean; format: GLenum; _type: GLenum; values: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetMinmaxParameterfv: procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetMinmaxParameteriv: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glHistogram: procedure(target: GLenum; width: GLsizei; internalformat: GLenum; sink: GLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMinmax: procedure(target: GLenum; internalformat: GLenum; sink: GLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glResetHistogram: procedure(target: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glResetMinmax: procedure(target: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glBlendEquation: procedure(mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glBlendColor: procedure(red: GLclampf; green: GLclampf; blue: GLclampf; alpha: GLclampf); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_ARB_imaging: Boolean; + +//***** GL_version_1_3 *****// +const + GL_TEXTURE0 = $84C0; + GL_TEXTURE1 = $84C1; + GL_TEXTURE2 = $84C2; + GL_TEXTURE3 = $84C3; + GL_TEXTURE4 = $84C4; + GL_TEXTURE5 = $84C5; + GL_TEXTURE6 = $84C6; + GL_TEXTURE7 = $84C7; + GL_TEXTURE8 = $84C8; + GL_TEXTURE9 = $84C9; + GL_TEXTURE10 = $84CA; + GL_TEXTURE11 = $84CB; + GL_TEXTURE12 = $84CC; + GL_TEXTURE13 = $84CD; + GL_TEXTURE14 = $84CE; + GL_TEXTURE15 = $84CF; + GL_TEXTURE16 = $84D0; + GL_TEXTURE17 = $84D1; + GL_TEXTURE18 = $84D2; + GL_TEXTURE19 = $84D3; + GL_TEXTURE20 = $84D4; + GL_TEXTURE21 = $84D5; + GL_TEXTURE22 = $84D6; + GL_TEXTURE23 = $84D7; + GL_TEXTURE24 = $84D8; + GL_TEXTURE25 = $84D9; + GL_TEXTURE26 = $84DA; + GL_TEXTURE27 = $84DB; + GL_TEXTURE28 = $84DC; + GL_TEXTURE29 = $84DD; + GL_TEXTURE30 = $84DE; + GL_TEXTURE31 = $84DF; + GL_ACTIVE_TEXTURE = $84E0; + GL_CLIENT_ACTIVE_TEXTURE = $84E1; + GL_MAX_TEXTURE_UNITS = $84E2; + GL_TRANSPOSE_MODELVIEW_MATRIX = $84E3; + GL_TRANSPOSE_PROJECTION_MATRIX = $84E4; + GL_TRANSPOSE_TEXTURE_MATRIX = $84E5; + GL_TRANSPOSE_COLOR_MATRIX = $84E6; + GL_MULTISAMPLE = $809D; + GL_SAMPLE_ALPHA_TO_COVERAGE = $809E; + GL_SAMPLE_ALPHA_TO_ONE = $809F; + GL_SAMPLE_COVERAGE = $80A0; + GL_SAMPLE_BUFFERS = $80A8; + GL_SAMPLES = $80A9; + GL_SAMPLE_COVERAGE_VALUE = $80AA; + GL_SAMPLE_COVERAGE_INVERT = $80AB; + GL_MULTISAMPLE_BIT = $20000000; + GL_NORMAL_MAP = $8511; + GL_REFLECTION_MAP = $8512; + GL_TEXTURE_CUBE_MAP = $8513; + GL_TEXTURE_BINDING_CUBE_MAP = $8514; + GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515; + GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516; + GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517; + GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518; + GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519; + GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A; + GL_PROXY_TEXTURE_CUBE_MAP = $851B; + GL_MAX_CUBE_MAP_TEXTURE_SIZE = $851C; + GL_COMPRESSED_ALPHA = $84E9; + GL_COMPRESSED_LUMINANCE = $84EA; + GL_COMPRESSED_LUMINANCE_ALPHA = $84EB; + GL_COMPRESSED_INTENSITY = $84EC; + GL_COMPRESSED_RGB = $84ED; + GL_COMPRESSED_RGBA = $84EE; + GL_TEXTURE_COMPRESSION_HINT = $84EF; + GL_TEXTURE_COMPRESSED_IMAGE_SIZE = $86A0; + GL_TEXTURE_COMPRESSED = $86A1; + GL_NUM_COMPRESSED_TEXTURE_FORMATS = $86A2; + GL_COMPRESSED_TEXTURE_FORMATS = $86A3; + GL_CLAMP_TO_BORDER = $812D; + GL_CLAMP_TO_BORDER_SGIS = $812D; + GL_COMBINE = $8570; + GL_COMBINE_RGB = $8571; + GL_COMBINE_ALPHA = $8572; + GL_SOURCE0_RGB = $8580; + GL_SOURCE1_RGB = $8581; + GL_SOURCE2_RGB = $8582; + GL_SOURCE0_ALPHA = $8588; + GL_SOURCE1_ALPHA = $8589; + GL_SOURCE2_ALPHA = $858A; + GL_OPERAND0_RGB = $8590; + GL_OPERAND1_RGB = $8591; + GL_OPERAND2_RGB = $8592; + GL_OPERAND0_ALPHA = $8598; + GL_OPERAND1_ALPHA = $8599; + GL_OPERAND2_ALPHA = $859A; + GL_RGB_SCALE = $8573; + GL_ADD_SIGNED = $8574; + GL_INTERPOLATE = $8575; + GL_SUBTRACT = $84E7; + GL_CONSTANT = $8576; + GL_PRIMARY_COLOR = $8577; + GL_PREVIOUS = $8578; + GL_DOT3_RGB = $86AE; + GL_DOT3_RGBA = $86AF; +var + glActiveTexture: procedure(texture: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glClientActiveTexture: procedure(texture: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord1d: procedure(target: GLenum; s: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord1dv: procedure(target: GLenum; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord1f: procedure(target: GLenum; s: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord1fv: procedure(target: GLenum; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord1i: procedure(target: GLenum; s: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord1iv: procedure(target: GLenum; const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord1s: procedure(target: GLenum; s: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord1sv: procedure(target: GLenum; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord2d: procedure(target: GLenum; s: GLdouble; t: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord2dv: procedure(target: GLenum; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord2f: procedure(target: GLenum; s: GLfloat; t: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord2fv: procedure(target: GLenum; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord2i: procedure(target: GLenum; s: GLint; t: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord2iv: procedure(target: GLenum; const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord2s: procedure(target: GLenum; s: GLshort; t: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord2sv: procedure(target: GLenum; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord3d: procedure(target: GLenum; s: GLdouble; t: GLdouble; r: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord3dv: procedure(target: GLenum; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord3f: procedure(target: GLenum; s: GLfloat; t: GLfloat; r: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord3fv: procedure(target: GLenum; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord3i: procedure(target: GLenum; s: GLint; t: GLint; r: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord3iv: procedure(target: GLenum; const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord3s: procedure(target: GLenum; s: GLshort; t: GLshort; r: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord3sv: procedure(target: GLenum; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord4d: procedure(target: GLenum; s: GLdouble; t: GLdouble; r: GLdouble; q: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord4dv: procedure(target: GLenum; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord4f: procedure(target: GLenum; s: GLfloat; t: GLfloat; r: GLfloat; q: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord4fv: procedure(target: GLenum; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord4i: procedure(target: GLenum; s: GLint; t: GLint; r: GLint; q: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord4iv: procedure(target: GLenum; const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord4s: procedure(target: GLenum; s: GLshort; t: GLshort; r: GLshort; q: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord4sv: procedure(target: GLenum; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glLoadTransposeMatrixf: procedure(const m: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glLoadTransposeMatrixd: procedure(const m: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultTransposeMatrixf: procedure(const m: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultTransposeMatrixd: procedure(const m: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSampleCoverage: procedure(value: GLclampf; invert: GLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCompressedTexImage3D: procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; depth: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCompressedTexImage2D: procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCompressedTexImage1D: procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCompressedTexSubImage3D: procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; zoffset: GLint; width: GLsizei; height: GLsizei; depth: GLsizei; format: GLenum; imageSize: GLsizei; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCompressedTexSubImage2D: procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; width: GLsizei; height: GLsizei; format: GLenum; imageSize: GLsizei; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCompressedTexSubImage1D: procedure(target: GLenum; level: GLint; xoffset: GLint; width: GLsizei; format: GLenum; imageSize: GLsizei; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetCompressedTexImage: procedure(target: GLenum; level: GLint; img: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_version_1_3: Boolean; + +//***** GL_ARB_multitexture *****// +const + GL_TEXTURE0_ARB = $84C0; + GL_TEXTURE1_ARB = $84C1; + GL_TEXTURE2_ARB = $84C2; + GL_TEXTURE3_ARB = $84C3; + GL_TEXTURE4_ARB = $84C4; + GL_TEXTURE5_ARB = $84C5; + GL_TEXTURE6_ARB = $84C6; + GL_TEXTURE7_ARB = $84C7; + GL_TEXTURE8_ARB = $84C8; + GL_TEXTURE9_ARB = $84C9; + GL_TEXTURE10_ARB = $84CA; + GL_TEXTURE11_ARB = $84CB; + GL_TEXTURE12_ARB = $84CC; + GL_TEXTURE13_ARB = $84CD; + GL_TEXTURE14_ARB = $84CE; + GL_TEXTURE15_ARB = $84CF; + GL_TEXTURE16_ARB = $84D0; + GL_TEXTURE17_ARB = $84D1; + GL_TEXTURE18_ARB = $84D2; + GL_TEXTURE19_ARB = $84D3; + GL_TEXTURE20_ARB = $84D4; + GL_TEXTURE21_ARB = $84D5; + GL_TEXTURE22_ARB = $84D6; + GL_TEXTURE23_ARB = $84D7; + GL_TEXTURE24_ARB = $84D8; + GL_TEXTURE25_ARB = $84D9; + GL_TEXTURE26_ARB = $84DA; + GL_TEXTURE27_ARB = $84DB; + GL_TEXTURE28_ARB = $84DC; + GL_TEXTURE29_ARB = $84DD; + GL_TEXTURE30_ARB = $84DE; + GL_TEXTURE31_ARB = $84DF; + GL_ACTIVE_TEXTURE_ARB = $84E0; + GL_CLIENT_ACTIVE_TEXTURE_ARB = $84E1; + GL_MAX_TEXTURE_UNITS_ARB = $84E2; +var + glActiveTextureARB: procedure(texture: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glClientActiveTextureARB: procedure(texture: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord1dARB: procedure(target: GLenum; s: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord1dvARB: procedure(target: GLenum; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord1fARB: procedure(target: GLenum; s: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord1fvARB: procedure(target: GLenum; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord1iARB: procedure(target: GLenum; s: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord1ivARB: procedure(target: GLenum; const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord1sARB: procedure(target: GLenum; s: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord1svARB: procedure(target: GLenum; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord2dARB: procedure(target: GLenum; s: GLdouble; t: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord2dvARB: procedure(target: GLenum; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord2fARB: procedure(target: GLenum; s: GLfloat; t: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord2fvARB: procedure(target: GLenum; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord2iARB: procedure(target: GLenum; s: GLint; t: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord2ivARB: procedure(target: GLenum; const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord2sARB: procedure(target: GLenum; s: GLshort; t: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord2svARB: procedure(target: GLenum; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord3dARB: procedure(target: GLenum; s: GLdouble; t: GLdouble; r: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord3dvARB: procedure(target: GLenum; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord3fARB: procedure(target: GLenum; s: GLfloat; t: GLfloat; r: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord3fvARB: procedure(target: GLenum; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord3iARB: procedure(target: GLenum; s: GLint; t: GLint; r: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord3ivARB: procedure(target: GLenum; const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord3sARB: procedure(target: GLenum; s: GLshort; t: GLshort; r: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord3svARB: procedure(target: GLenum; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord4dARB: procedure(target: GLenum; s: GLdouble; t: GLdouble; r: GLdouble; q: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord4dvARB: procedure(target: GLenum; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord4fARB: procedure(target: GLenum; s: GLfloat; t: GLfloat; r: GLfloat; q: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord4fvARB: procedure(target: GLenum; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord4iARB: procedure(target: GLenum; s: GLint; t: GLint; r: GLint; q: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord4ivARB: procedure(target: GLenum; const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord4sARB: procedure(target: GLenum; s: GLshort; t: GLshort; r: GLshort; q: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord4svARB: procedure(target: GLenum; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_ARB_multitexture: Boolean; + +//***** GL_ARB_transpose_matrix *****// +const + GL_TRANSPOSE_MODELVIEW_MATRIX_ARB = $84E3; + GL_TRANSPOSE_PROJECTION_MATRIX_ARB = $84E4; + GL_TRANSPOSE_TEXTURE_MATRIX_ARB = $84E5; + GL_TRANSPOSE_COLOR_MATRIX_ARB = $84E6; +var + glLoadTransposeMatrixfARB: procedure(m: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glLoadTransposeMatrixdARB: procedure(m: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultTransposeMatrixfARB: procedure(m: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultTransposeMatrixdARB: procedure(m: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_ARB_transpose_matrix: Boolean; + +//***** GL_ARB_multisample *****// +const + WGL_SAMPLE_BUFFERS_ARB = $2041; + WGL_SAMPLES_ARB = $2042; + GL_MULTISAMPLE_ARB = $809D; + GL_SAMPLE_ALPHA_TO_COVERAGE_ARB = $809E; + GL_SAMPLE_ALPHA_TO_ONE_ARB = $809F; + GL_SAMPLE_COVERAGE_ARB = $80A0; + GL_MULTISAMPLE_BIT_ARB = $20000000; + GL_SAMPLE_BUFFERS_ARB = $80A8; + GL_SAMPLES_ARB = $80A9; + GL_SAMPLE_COVERAGE_VALUE_ARB = $80AA; + GL_SAMPLE_COVERAGE_INVERT_ARB = $80AB; +var + glSampleCoverageARB: procedure(value: GLclampf; invert: GLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_ARB_multisample: Boolean; + +//***** GL_ARB_texture_env_add *****// + +function Load_GL_ARB_texture_env_add: Boolean; + +{$IFDEF WINDOWS} +//***** WGL_ARB_extensions_string *****// +var + wglGetExtensionsStringARB: function(hdc: HDC): Pchar; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_WGL_ARB_extensions_string: Boolean; + +//***** WGL_ARB_buffer_region *****// +const + WGL_FRONT_COLOR_BUFFER_BIT_ARB = $0001; + WGL_BACK_COLOR_BUFFER_BIT_ARB = $0002; + WGL_DEPTH_BUFFER_BIT_ARB = $0004; + WGL_STENCIL_BUFFER_BIT_ARB = $0008; +var + wglCreateBufferRegionARB: function(hDC: HDC; iLayerPlane: GLint; uType: GLuint): THandle; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglDeleteBufferRegionARB: procedure(hRegion: THandle); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglSaveBufferRegionARB: function(hRegion: THandle; x: GLint; y: GLint; width: GLint; height: GLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglRestoreBufferRegionARB: function(hRegion: THandle; x: GLint; y: GLint; width: GLint; height: GLint; xSrc: GLint; ySrc: GLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_WGL_ARB_buffer_region: Boolean; +{$ENDIF} + +//***** GL_ARB_texture_cube_map *****// +const + GL_NORMAL_MAP_ARB = $8511; + GL_REFLECTION_MAP_ARB = $8512; + GL_TEXTURE_CUBE_MAP_ARB = $8513; + GL_TEXTURE_BINDING_CUBE_MAP_ARB = $8514; + GL_TEXTURE_CUBE_MAP_POSITIVE_X_ARB = $8515; + GL_TEXTURE_CUBE_MAP_NEGATIVE_X_ARB = $8516; + GL_TEXTURE_CUBE_MAP_POSITIVE_Y_ARB = $8517; + GL_TEXTURE_CUBE_MAP_NEGATIVE_Y_ARB = $8518; + GL_TEXTURE_CUBE_MAP_POSITIVE_Z_ARB = $8519; + GL_TEXTURE_CUBE_MAP_NEGATIVE_Z_ARB = $851A; + GL_PROXY_TEXTURE_CUBE_MAP_ARB = $851B; + GL_MAX_CUBE_MAP_TEXTURE_SIZE_ARB = $851C; + +function Load_GL_ARB_texture_cube_map: Boolean; + +//***** GL_ARB_depth_texture *****// +const + GL_DEPTH_COMPONENT16_ARB = $81A5; + GL_DEPTH_COMPONENT24_ARB = $81A6; + GL_DEPTH_COMPONENT32_ARB = $81A7; + GL_TEXTURE_DEPTH_SIZE_ARB = $884A; + GL_DEPTH_TEXTURE_MODE_ARB = $884B; + +function Load_GL_ARB_depth_texture: Boolean; + +//***** GL_ARB_point_parameters *****// +const + GL_POINT_SIZE_MIN_ARB = $8126; + GL_POINT_SIZE_MAX_ARB = $8127; + GL_POINT_FADE_THRESHOLD_SIZE_ARB = $8128; + GL_POINT_DISTANCE_ATTENUATION_ARB = $8129; +var + glPointParameterfARB: procedure(pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPointParameterfvARB: procedure(pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_ARB_point_parameters: Boolean; + +//***** GL_ARB_shadow *****// +const + GL_TEXTURE_COMPARE_MODE_ARB = $884C; + GL_TEXTURE_COMPARE_FUNC_ARB = $884D; + GL_COMPARE_R_TO_TEXTURE_ARB = $884E; + +function Load_GL_ARB_shadow: Boolean; + +//***** GL_ARB_shadow_ambient *****// +const + GL_TEXTURE_COMPARE_FAIL_VALUE_ARB = $80BF; + +function Load_GL_ARB_shadow_ambient: Boolean; + +//***** GL_ARB_texture_border_clamp *****// +const + GL_CLAMP_TO_BORDER_ARB = $812D; + +function Load_GL_ARB_texture_border_clamp: Boolean; + +//***** GL_ARB_texture_compression *****// +const + GL_COMPRESSED_ALPHA_ARB = $84E9; + GL_COMPRESSED_LUMINANCE_ARB = $84EA; + GL_COMPRESSED_LUMINANCE_ALPHA_ARB = $84EB; + GL_COMPRESSED_INTENSITY_ARB = $84EC; + GL_COMPRESSED_RGB_ARB = $84ED; + GL_COMPRESSED_RGBA_ARB = $84EE; + GL_TEXTURE_COMPRESSION_HINT_ARB = $84EF; + GL_TEXTURE_COMPRESSED_IMAGE_SIZE_ARB = $86A0; + GL_TEXTURE_COMPRESSED_ARB = $86A1; + GL_NUM_COMPRESSED_TEXTURE_FORMATS_ARB = $86A2; + GL_COMPRESSED_TEXTURE_FORMATS_ARB = $86A3; +var + glCompressedTexImage3DARB: procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; depth: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCompressedTexImage2DARB: procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCompressedTexImage1DARB: procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; border: GLint; imageSize: GLsizei; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCompressedTexSubImage3DARB: procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; zoffset: GLint; width: GLsizei; height: GLsizei; depth: GLsizei; format: GLenum; imageSize: GLsizei; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCompressedTexSubImage2DARB: procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; width: GLsizei; height: GLsizei; format: GLenum; imageSize: GLsizei; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCompressedTexSubImage1DARB: procedure(target: GLenum; level: GLint; xoffset: GLint; width: GLsizei; format: GLenum; imageSize: GLsizei; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetCompressedTexImageARB: procedure(target: GLenum; lod: GLint; img: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_ARB_texture_compression: Boolean; + +//***** GL_ARB_texture_env_combine *****// +const + GL_COMBINE_ARB = $8570; + GL_COMBINE_RGB_ARB = $8571; + GL_COMBINE_ALPHA_ARB = $8572; + GL_SOURCE0_RGB_ARB = $8580; + GL_SOURCE1_RGB_ARB = $8581; + GL_SOURCE2_RGB_ARB = $8582; + GL_SOURCE0_ALPHA_ARB = $8588; + GL_SOURCE1_ALPHA_ARB = $8589; + GL_SOURCE2_ALPHA_ARB = $858A; + GL_OPERAND0_RGB_ARB = $8590; + GL_OPERAND1_RGB_ARB = $8591; + GL_OPERAND2_RGB_ARB = $8592; + GL_OPERAND0_ALPHA_ARB = $8598; + GL_OPERAND1_ALPHA_ARB = $8599; + GL_OPERAND2_ALPHA_ARB = $859A; + GL_RGB_SCALE_ARB = $8573; + GL_ADD_SIGNED_ARB = $8574; + GL_INTERPOLATE_ARB = $8575; + GL_SUBTRACT_ARB = $84E7; + GL_CONSTANT_ARB = $8576; + GL_PRIMARY_COLOR_ARB = $8577; + GL_PREVIOUS_ARB = $8578; + +function Load_GL_ARB_texture_env_combine: Boolean; + +//***** GL_ARB_texture_env_crossbar *****// + +function Load_GL_ARB_texture_env_crossbar: Boolean; + +//***** GL_ARB_texture_env_dot3 *****// +const + GL_DOT3_RGB_ARB = $86AE; + GL_DOT3_RGBA_ARB = $86AF; + +function Load_GL_ARB_texture_env_dot3: Boolean; + +//***** GL_ARB_texture_mirrored_repeat *****// +const + GL_MIRRORED_REPEAT_ARB = $8370; + +function Load_GL_ARB_texture_mirrored_repeat: Boolean; + +//***** GL_ARB_vertex_blend *****// +const + GL_MAX_VERTEX_UNITS_ARB = $86A4; + GL_ACTIVE_VERTEX_UNITS_ARB = $86A5; + GL_WEIGHT_SUM_UNITY_ARB = $86A6; + GL_VERTEX_BLEND_ARB = $86A7; + GL_MODELVIEW0_ARB = $1700; + GL_MODELVIEW1_ARB = $850A; + GL_MODELVIEW2_ARB = $8722; + GL_MODELVIEW3_ARB = $8723; + GL_MODELVIEW4_ARB = $8724; + GL_MODELVIEW5_ARB = $8725; + GL_MODELVIEW6_ARB = $8726; + GL_MODELVIEW7_ARB = $8727; + GL_MODELVIEW8_ARB = $8728; + GL_MODELVIEW9_ARB = $8729; + GL_MODELVIEW10_ARB = $872A; + GL_MODELVIEW11_ARB = $872B; + GL_MODELVIEW12_ARB = $872C; + GL_MODELVIEW13_ARB = $872D; + GL_MODELVIEW14_ARB = $872E; + GL_MODELVIEW15_ARB = $872F; + GL_MODELVIEW16_ARB = $8730; + GL_MODELVIEW17_ARB = $8731; + GL_MODELVIEW18_ARB = $8732; + GL_MODELVIEW19_ARB = $8733; + GL_MODELVIEW20_ARB = $8734; + GL_MODELVIEW21_ARB = $8735; + GL_MODELVIEW22_ARB = $8736; + GL_MODELVIEW23_ARB = $8737; + GL_MODELVIEW24_ARB = $8738; + GL_MODELVIEW25_ARB = $8739; + GL_MODELVIEW26_ARB = $873A; + GL_MODELVIEW27_ARB = $873B; + GL_MODELVIEW28_ARB = $873C; + GL_MODELVIEW29_ARB = $873D; + GL_MODELVIEW30_ARB = $873E; + GL_MODELVIEW31_ARB = $873F; + GL_CURRENT_WEIGHT_ARB = $86A8; + GL_WEIGHT_ARRAY_TYPE_ARB = $86A9; + GL_WEIGHT_ARRAY_STRIDE_ARB = $86AA; + GL_WEIGHT_ARRAY_SIZE_ARB = $86AB; + GL_WEIGHT_ARRAY_POINTER_ARB = $86AC; + GL_WEIGHT_ARRAY_ARB = $86AD; +var + glWeightbvARB: procedure(size: GLint; weights: PGLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWeightsvARB: procedure(size: GLint; weights: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWeightivARB: procedure(size: GLint; weights: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWeightfvARB: procedure(size: GLint; weights: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWeightdvARB: procedure(size: GLint; weights: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWeightvARB: procedure(size: GLint; weights: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWeightubvARB: procedure(size: GLint; weights: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWeightusvARB: procedure(size: GLint; weights: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWeightuivARB: procedure(size: GLint; weights: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWeightPointerARB: procedure(size: GLint; _type: GLenum; stride: GLsizei; pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexBlendARB: procedure(count: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_ARB_vertex_blend: Boolean; + +//***** GL_ARB_vertex_program *****// +const + GL_VERTEX_PROGRAM_ARB = $8620; + GL_VERTEX_PROGRAM_POINT_SIZE_ARB = $8642; + GL_VERTEX_PROGRAM_TWO_SIDE_ARB = $8643; + GL_COLOR_SUM_ARB = $8458; + GL_PROGRAM_FORMAT_ASCII_ARB = $8875; + GL_VERTEX_ATTRIB_ARRAY_ENABLED_ARB = $8622; + GL_VERTEX_ATTRIB_ARRAY_SIZE_ARB = $8623; + GL_VERTEX_ATTRIB_ARRAY_STRIDE_ARB = $8624; + GL_VERTEX_ATTRIB_ARRAY_TYPE_ARB = $8625; + GL_VERTEX_ATTRIB_ARRAY_NORMALIZED_ARB = $886A; + GL_CURRENT_VERTEX_ATTRIB_ARB = $8626; + GL_VERTEX_ATTRIB_ARRAY_POINTER_ARB = $8645; + GL_PROGRAM_LENGTH_ARB = $8627; + GL_PROGRAM_FORMAT_ARB = $8876; + GL_PROGRAM_BINDING_ARB = $8677; + GL_PROGRAM_INSTRUCTIONS_ARB = $88A0; + GL_MAX_PROGRAM_INSTRUCTIONS_ARB = $88A1; + GL_PROGRAM_NATIVE_INSTRUCTIONS_ARB = $88A2; + GL_MAX_PROGRAM_NATIVE_INSTRUCTIONS_ARB = $88A3; + GL_PROGRAM_TEMPORARIES_ARB = $88A4; + GL_MAX_PROGRAM_TEMPORARIES_ARB = $88A5; + GL_PROGRAM_NATIVE_TEMPORARIES_ARB = $88A6; + GL_MAX_PROGRAM_NATIVE_TEMPORARIES_ARB = $88A7; + GL_PROGRAM_PARAMETERS_ARB = $88A8; + GL_MAX_PROGRAM_PARAMETERS_ARB = $88A9; + GL_PROGRAM_NATIVE_PARAMETERS_ARB = $88AA; + GL_MAX_PROGRAM_NATIVE_PARAMETERS_ARB = $88AB; + GL_PROGRAM_ATTRIBS_ARB = $88AC; + GL_MAX_PROGRAM_ATTRIBS_ARB = $88AD; + GL_PROGRAM_NATIVE_ATTRIBS_ARB = $88AE; + GL_MAX_PROGRAM_NATIVE_ATTRIBS_ARB = $88AF; + GL_PROGRAM_ADDRESS_REGISTERS_ARB = $88B0; + GL_MAX_PROGRAM_ADDRESS_REGISTERS_ARB = $88B1; + GL_PROGRAM_NATIVE_ADDRESS_REGISTERS_ARB = $88B2; + GL_MAX_PROGRAM_NATIVE_ADDRESS_REGISTERS_ARB = $88B3; + GL_MAX_PROGRAM_LOCAL_PARAMETERS_ARB = $88B4; + GL_MAX_PROGRAM_ENV_PARAMETERS_ARB = $88B5; + GL_PROGRAM_UNDER_NATIVE_LIMITS_ARB = $88B6; + GL_PROGRAM_STRING_ARB = $8628; + GL_PROGRAM_ERROR_POSITION_ARB = $864B; + GL_CURRENT_MATRIX_ARB = $8641; + GL_TRANSPOSE_CURRENT_MATRIX_ARB = $88B7; + GL_CURRENT_MATRIX_STACK_DEPTH_ARB = $8640; + GL_MAX_VERTEX_ATTRIBS_ARB = $8869; + GL_MAX_PROGRAM_MATRICES_ARB = $862F; + GL_MAX_PROGRAM_MATRIX_STACK_DEPTH_ARB = $862E; + GL_PROGRAM_ERROR_STRING_ARB = $8874; + GL_MATRIX0_ARB = $88C0; + GL_MATRIX1_ARB = $88C1; + GL_MATRIX2_ARB = $88C2; + GL_MATRIX3_ARB = $88C3; + GL_MATRIX4_ARB = $88C4; + GL_MATRIX5_ARB = $88C5; + GL_MATRIX6_ARB = $88C6; + GL_MATRIX7_ARB = $88C7; + GL_MATRIX8_ARB = $88C8; + GL_MATRIX9_ARB = $88C9; + GL_MATRIX10_ARB = $88CA; + GL_MATRIX11_ARB = $88CB; + GL_MATRIX12_ARB = $88CC; + GL_MATRIX13_ARB = $88CD; + GL_MATRIX14_ARB = $88CE; + GL_MATRIX15_ARB = $88CF; + GL_MATRIX16_ARB = $88D0; + GL_MATRIX17_ARB = $88D1; + GL_MATRIX18_ARB = $88D2; + GL_MATRIX19_ARB = $88D3; + GL_MATRIX20_ARB = $88D4; + GL_MATRIX21_ARB = $88D5; + GL_MATRIX22_ARB = $88D6; + GL_MATRIX23_ARB = $88D7; + GL_MATRIX24_ARB = $88D8; + GL_MATRIX25_ARB = $88D9; + GL_MATRIX26_ARB = $88DA; + GL_MATRIX27_ARB = $88DB; + GL_MATRIX28_ARB = $88DC; + GL_MATRIX29_ARB = $88DD; + GL_MATRIX30_ARB = $88DE; + GL_MATRIX31_ARB = $88DF; +var + glVertexAttrib1sARB: procedure(index: GLuint; x: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib1fARB: procedure(index: GLuint; x: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib1dARB: procedure(index: GLuint; x: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib2sARB: procedure(index: GLuint; x: GLshort; y: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib2fARB: procedure(index: GLuint; x: GLfloat; y: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib2dARB: procedure(index: GLuint; x: GLdouble; y: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib3sARB: procedure(index: GLuint; x: GLshort; y: GLshort; z: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib3fARB: procedure(index: GLuint; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib3dARB: procedure(index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4sARB: procedure(index: GLuint; x: GLshort; y: GLshort; z: GLshort; w: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4fARB: procedure(index: GLuint; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4dARB: procedure(index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4NubARB: procedure(index: GLuint; x: GLubyte; y: GLubyte; z: GLubyte; w: GLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib1svARB: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib1fvARB: procedure(index: GLuint; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib1dvARB: procedure(index: GLuint; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib2svARB: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib2fvARB: procedure(index: GLuint; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib2dvARB: procedure(index: GLuint; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib3svARB: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib3fvARB: procedure(index: GLuint; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib3dvARB: procedure(index: GLuint; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4bvARB: procedure(index: GLuint; const v: PGLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4svARB: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4ivARB: procedure(index: GLuint; const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4ubvARB: procedure(index: GLuint; const v: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4usvARB: procedure(index: GLuint; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4uivARB: procedure(index: GLuint; const v: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4fvARB: procedure(index: GLuint; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4dvARB: procedure(index: GLuint; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4NbvARB: procedure(index: GLuint; const v: PGLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4NsvARB: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4NivARB: procedure(index: GLuint; const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4NubvARB: procedure(index: GLuint; const v: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4NusvARB: procedure(index: GLuint; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4NuivARB: procedure(index: GLuint; const v: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttribPointerARB: procedure(index: GLuint; size: GLint; _type: GLenum; normalized: GLboolean; stride: GLsizei; const pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEnableVertexAttribArrayARB: procedure(index: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDisableVertexAttribArrayARB: procedure(index: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glProgramStringARB: procedure(target: GLenum; format: GLenum; len: GLsizei; const _string: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glBindProgramARB: procedure(target: GLenum; _program: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDeleteProgramsARB: procedure(n: GLsizei; const programs: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGenProgramsARB: procedure(n: GLsizei; programs: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glProgramEnvParameter4dARB: procedure(target: GLenum; index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glProgramEnvParameter4dvARB: procedure(target: GLenum; index: GLuint; const params: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glProgramEnvParameter4fARB: procedure(target: GLenum; index: GLuint; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glProgramEnvParameter4fvARB: procedure(target: GLenum; index: GLuint; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glProgramLocalParameter4dARB: procedure(target: GLenum; index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glProgramLocalParameter4dvARB: procedure(target: GLenum; index: GLuint; const params: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glProgramLocalParameter4fARB: procedure(target: GLenum; index: GLuint; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glProgramLocalParameter4fvARB: procedure(target: GLenum; index: GLuint; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetProgramEnvParameterdvARB: procedure(target: GLenum; index: GLuint; params: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetProgramEnvParameterfvARB: procedure(target: GLenum; index: GLuint; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetProgramLocalParameterdvARB: procedure(target: GLenum; index: GLuint; params: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetProgramLocalParameterfvARB: procedure(target: GLenum; index: GLuint; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetProgramivARB: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetProgramStringARB: procedure(target: GLenum; pname: GLenum; _string: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetVertexAttribdvARB: procedure(index: GLuint; pname: GLenum; params: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetVertexAttribfvARB: procedure(index: GLuint; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetVertexAttribivARB: procedure(index: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetVertexAttribPointervARB: procedure(index: GLuint; pname: GLenum; pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIsProgramARB: function(_program: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_ARB_vertex_program: Boolean; + +//***** GL_ARB_window_pos *****// +var + glWindowPos2dARB: procedure(x: GLdouble; y: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos2fARB: procedure(x: GLfloat; y: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos2iARB: procedure(x: GLint; y: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos2sARB: procedure(x: GLshort; y: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos2dvARB: procedure(const p: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos2fvARB: procedure(const p: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos2ivARB: procedure(const p: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos2svARB: procedure(const p: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos3dARB: procedure(x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos3fARB: procedure(x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos3iARB: procedure(x: GLint; y: GLint; z: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos3sARB: procedure(x: GLshort; y: GLshort; z: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos3dvARB: procedure(const p: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos3fvARB: procedure(const p: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos3ivARB: procedure(const p: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos3svARB: procedure(const p: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_ARB_window_pos: Boolean; + +//***** GL_EXT_422_pixels *****// +const + GL_422_EXT = $80CC; + GL_422_REV_EXT = $80CD; + GL_422_AVERAGE_EXT = $80CE; + GL_422_REV_AVERAGE_EXT = $80CF; + +function Load_GL_EXT_422_pixels: Boolean; + +//***** GL_EXT_abgr *****// +const + GL_ABGR_EXT = $8000; + +function Load_GL_EXT_abgr: Boolean; + +//***** GL_EXT_bgra *****// +const + GL_BGR_EXT = $80E0; + GL_BGRA_EXT = $80E1; + +function Load_GL_EXT_bgra: Boolean; + +//***** GL_EXT_blend_color *****// +const + GL_CONSTANT_COLOR_EXT = $8001; + GL_ONE_MINUS_CONSTANT_COLOR_EXT = $8002; + GL_CONSTANT_ALPHA_EXT = $8003; + GL_ONE_MINUS_CONSTANT_ALPHA_EXT = $8004; + GL_BLEND_COLOR_EXT = $8005; +var + glBlendColorEXT: procedure(red: GLclampf; green: GLclampf; blue: GLclampf; alpha: GLclampf); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_EXT_blend_color: Boolean; + +//***** GL_EXT_blend_func_separate *****// +const + GL_BLEND_DST_RGB_EXT = $80C8; + GL_BLEND_SRC_RGB_EXT = $80C9; + GL_BLEND_DST_ALPHA_EXT = $80CA; + GL_BLEND_SRC_ALPHA_EXT = $80CB; +var + glBlendFuncSeparateEXT: procedure(sfactorRGB: GLenum; dfactorRGB: GLenum; sfactorAlpha: GLenum; dfactorAlpha: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_EXT_blend_func_separate: Boolean; + +//***** GL_EXT_blend_logic_op *****// + +function Load_GL_EXT_blend_logic_op: Boolean; + +//***** GL_EXT_blend_minmax *****// +const + GL_FUNC_ADD_EXT = $8006; + GL_MIN_EXT = $8007; + GL_MAX_EXT = $8008; + GL_BLEND_EQUATION_EXT = $8009; +var + glBlendEquationEXT: procedure(mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_EXT_blend_minmax: Boolean; + +//***** GL_EXT_blend_subtract *****// +const + GL_FUNC_SUBTRACT_EXT = $800A; + GL_FUNC_REVERSE_SUBTRACT_EXT = $800B; + +function Load_GL_EXT_blend_subtract: Boolean; + +//***** GL_EXT_clip_volume_hint *****// +const + GL_CLIP_VOLUME_CLIPPING_HINT_EXT = $80F0; + +function Load_GL_EXT_clip_volume_hint: Boolean; + +//***** GL_EXT_color_subtable *****// +var + glColorSubTableEXT: procedure(target: GLenum; start: GLsizei; count: GLsizei; format: GLenum; _type: GLenum; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCopyColorSubTableEXT: procedure(target: GLenum; start: GLsizei; x: GLint; y: GLint; width: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_EXT_color_subtable: Boolean; + +//***** GL_EXT_compiled_vertex_array *****// +const + GL_ARRAY_ELEMENT_LOCK_FIRST_EXT = $81A8; + GL_ARRAY_ELEMENT_LOCK_COUNT_EXT = $81A9; +var + glLockArraysEXT: procedure(first: GLint; count: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUnlockArraysEXT: procedure(); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_EXT_compiled_vertex_array: Boolean; + +//***** GL_EXT_convolution *****// +const + GL_CONVOLUTION_1D_EXT = $8010; + GL_CONVOLUTION_2D_EXT = $8011; + GL_SEPARABLE_2D_EXT = $8012; + GL_CONVOLUTION_BORDER_MODE_EXT = $8013; + GL_CONVOLUTION_FILTER_SCALE_EXT = $8014; + GL_CONVOLUTION_FILTER_BIAS_EXT = $8015; + GL_REDUCE_EXT = $8016; + GL_CONVOLUTION_FORMAT_EXT = $8017; + GL_CONVOLUTION_WIDTH_EXT = $8018; + GL_CONVOLUTION_HEIGHT_EXT = $8019; + GL_MAX_CONVOLUTION_WIDTH_EXT = $801A; + GL_MAX_CONVOLUTION_HEIGHT_EXT = $801B; + GL_POST_CONVOLUTION_RED_SCALE_EXT = $801C; + GL_POST_CONVOLUTION_GREEN_SCALE_EXT = $801D; + GL_POST_CONVOLUTION_BLUE_SCALE_EXT = $801E; + GL_POST_CONVOLUTION_ALPHA_SCALE_EXT = $801F; + GL_POST_CONVOLUTION_RED_BIAS_EXT = $8020; + GL_POST_CONVOLUTION_GREEN_BIAS_EXT = $8021; + GL_POST_CONVOLUTION_BLUE_BIAS_EXT = $8022; + GL_POST_CONVOLUTION_ALPHA_BIAS_EXT = $8023; +var + glConvolutionFilter1DEXT: procedure(target: GLenum; internalformat: GLenum; width: GLsizei; format: GLenum; _type: GLenum; const image: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glConvolutionFilter2DEXT: procedure(target: GLenum; internalformat: GLenum; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; const image: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCopyConvolutionFilter1DEXT: procedure(target: GLenum; internalformat: GLenum; x: GLint; y: GLint; width: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCopyConvolutionFilter2DEXT: procedure(target: GLenum; internalformat: GLenum; x: GLint; y: GLint; width: GLsizei; height: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetConvolutionFilterEXT: procedure(target: GLenum; format: GLenum; _type: GLenum; image: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSeparableFilter2DEXT: procedure(target: GLenum; internalformat: GLenum; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; const row: PGLvoid; const column: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetSeparableFilterEXT: procedure(target: GLenum; format: GLenum; _type: GLenum; row: PGLvoid; column: PGLvoid; span: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glConvolutionParameteriEXT: procedure(target: GLenum; pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glConvolutionParameterivEXT: procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glConvolutionParameterfEXT: procedure(target: GLenum; pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glConvolutionParameterfvEXT: procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetConvolutionParameterivEXT: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetConvolutionParameterfvEXT: procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_EXT_convolution: Boolean; + +//***** GL_EXT_histogram *****// +const + GL_HISTOGRAM_EXT = $8024; + GL_PROXY_HISTOGRAM_EXT = $8025; + GL_HISTOGRAM_WIDTH_EXT = $8026; + GL_HISTOGRAM_FORMAT_EXT = $8027; + GL_HISTOGRAM_RED_SIZE_EXT = $8028; + GL_HISTOGRAM_GREEN_SIZE_EXT = $8029; + GL_HISTOGRAM_BLUE_SIZE_EXT = $802A; + GL_HISTOGRAM_ALPHA_SIZE_EXT = $802B; + GL_HISTOGRAM_LUMINANCE_SIZE_EXT = $802C; + GL_HISTOGRAM_SINK_EXT = $802D; + GL_MINMAX_EXT = $802E; + GL_MINMAX_FORMAT_EXT = $802F; + GL_MINMAX_SINK_EXT = $8030; +var + glHistogramEXT: procedure(target: GLenum; width: GLsizei; internalformat: GLenum; sink: GLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glResetHistogramEXT: procedure(target: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetHistogramEXT: procedure(target: GLenum; reset: GLboolean; format: GLenum; _type: GLenum; values: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetHistogramParameterivEXT: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetHistogramParameterfvEXT: procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMinmaxEXT: procedure(target: GLenum; internalformat: GLenum; sink: GLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glResetMinmaxEXT: procedure(target: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetMinmaxEXT: procedure(target: GLenum; reset: GLboolean; format: GLenum; _type: GLenum; values: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetMinmaxParameterivEXT: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetMinmaxParameterfvEXT: procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_EXT_histogram: Boolean; + +//***** GL_EXT_multi_draw_arrays *****// +var + glMultiDrawArraysEXT: procedure(mode: GLenum; first: PGLint; count: PGLsizei; primcount: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiDrawElementsEXT: procedure(mode: GLenum; count: PGLsizei; _type: GLenum; const indices: PGLvoid; primcount: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_EXT_multi_draw_arrays: Boolean; + +//***** GL_EXT_packed_pixels *****// +const + GL_UNSIGNED_BYTE_3_3_2_EXT = $8032; + GL_UNSIGNED_SHORT_4_4_4_4_EXT = $8033; + GL_UNSIGNED_SHORT_5_5_5_1_EXT = $8034; + GL_UNSIGNED_INT_8_8_8_8_EXT = $8035; + GL_UNSIGNED_INT_10_10_10_2_EXT = $8036; + +function Load_GL_EXT_packed_pixels: Boolean; + +//***** GL_EXT_paletted_texture *****// +const + GL_COLOR_INDEX1_EXT = $80E2; + GL_COLOR_INDEX2_EXT = $80E3; + GL_COLOR_INDEX4_EXT = $80E4; + GL_COLOR_INDEX8_EXT = $80E5; + GL_COLOR_INDEX12_EXT = $80E6; + GL_COLOR_INDEX16_EXT = $80E7; + GL_COLOR_TABLE_FORMAT_EXT = $80D8; + GL_COLOR_TABLE_WIDTH_EXT = $80D9; + GL_COLOR_TABLE_RED_SIZE_EXT = $80DA; + GL_COLOR_TABLE_GREEN_SIZE_EXT = $80DB; + GL_COLOR_TABLE_BLUE_SIZE_EXT = $80DC; + GL_COLOR_TABLE_ALPHA_SIZE_EXT = $80DD; + GL_COLOR_TABLE_LUMINANCE_SIZE_EXT = $80DE; + GL_COLOR_TABLE_INTENSITY_SIZE_EXT = $80DF; + GL_TEXTURE_INDEX_SIZE_EXT = $80ED; + GL_TEXTURE_1D = $0DE0; + GL_TEXTURE_2D = $0DE1; + GL_TEXTURE_3D_EXT = $806F; + // GL_TEXTURE_CUBE_MAP_ARB { already defined } + GL_PROXY_TEXTURE_1D = $8063; + GL_PROXY_TEXTURE_2D = $8064; + GL_PROXY_TEXTURE_3D_EXT = $8070; + // GL_PROXY_TEXTURE_CUBE_MAP_ARB { already defined } + // GL_TEXTURE_1D { already defined } + // GL_TEXTURE_2D { already defined } + // GL_TEXTURE_3D_EXT { already defined } + // GL_TEXTURE_CUBE_MAP_ARB { already defined } +var + glColorTableEXT: procedure(target: GLenum; internalFormat: GLenum; width: GLsizei; format: GLenum; _type: GLenum; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + // glColorSubTableEXT { already defined } + glGetColorTableEXT: procedure(target: GLenum; format: GLenum; _type: GLenum; data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetColorTableParameterivEXT: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetColorTableParameterfvEXT: procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_EXT_paletted_texture: Boolean; + +//***** GL_EXT_point_parameters *****// +const + GL_POINT_SIZE_MIN_EXT = $8126; + GL_POINT_SIZE_MAX_EXT = $8127; + GL_POINT_FADE_THRESHOLD_SIZE_EXT = $8128; + GL_DISTANCE_ATTENUATION_EXT = $8129; +var + glPointParameterfEXT: procedure(pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPointParameterfvEXT: procedure(pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_EXT_point_parameters: Boolean; + +//***** GL_EXT_polygon_offset *****// +const + GL_POLYGON_OFFSET_EXT = $8037; + GL_POLYGON_OFFSET_FACTOR_EXT = $8038; + GL_POLYGON_OFFSET_BIAS_EXT = $8039; +var + glPolygonOffsetEXT: procedure(factor: GLfloat; bias: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_EXT_polygon_offset: Boolean; + +//***** GL_EXT_separate_specular_color *****// +const + GL_LIGHT_MODEL_COLOR_CONTROL_EXT = $81F8; + GL_SINGLE_COLOR_EXT = $81F9; + GL_SEPARATE_SPECULAR_COLOR_EXT = $81FA; + +function Load_GL_EXT_separate_specular_color: Boolean; + +//***** GL_EXT_shadow_funcs *****// + +function Load_GL_EXT_shadow_funcs: Boolean; + +//***** GL_EXT_shared_texture_palette *****// +const + GL_SHARED_TEXTURE_PALETTE_EXT = $81FB; + +function Load_GL_EXT_shared_texture_palette: Boolean; + +//***** GL_EXT_stencil_two_side *****// +const + GL_STENCIL_TEST_TWO_SIDE_EXT = $8910; + GL_ACTIVE_STENCIL_FACE_EXT = $8911; +var + glActiveStencilFaceEXT: procedure(face: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_EXT_stencil_two_side: Boolean; + +//***** GL_EXT_stencil_wrap *****// +const + GL_INCR_WRAP_EXT = $8507; + GL_DECR_WRAP_EXT = $8508; + +function Load_GL_EXT_stencil_wrap: Boolean; + +//***** GL_EXT_subtexture *****// +var + glTexSubImage1DEXT: procedure(target: GLenum; level: GLint; xoffset: GLint; width: GLsizei; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexSubImage2DEXT: procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; width: GLsizei; height: GLsizei; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexSubImage3DEXT: procedure(target: GLenum; level: GLint; xoffset: GLint; yoffset: GLint; zoffset: GLint; width: GLsizei; height: GLsizei; depth: GLsizei; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_EXT_subtexture: Boolean; + +//***** GL_EXT_texture3D *****// +const + GL_PACK_SKIP_IMAGES_EXT = $806B; + GL_PACK_IMAGE_HEIGHT_EXT = $806C; + GL_UNPACK_SKIP_IMAGES_EXT = $806D; + GL_UNPACK_IMAGE_HEIGHT_EXT = $806E; + // GL_TEXTURE_3D_EXT { already defined } + // GL_PROXY_TEXTURE_3D_EXT { already defined } + GL_TEXTURE_DEPTH_EXT = $8071; + GL_TEXTURE_WRAP_R_EXT = $8072; + GL_MAX_3D_TEXTURE_SIZE_EXT = $8073; +var + glTexImage3DEXT: procedure(target: GLenum; level: GLint; internalformat: GLenum; width: GLsizei; height: GLsizei; depth: GLsizei; border: GLint; format: GLenum; _type: GLenum; const pixels: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_EXT_texture3D: Boolean; + +//***** GL_EXT_texture_compression_s3tc *****// +const + GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0; + GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1; + GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2; + GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3; + +function Load_GL_EXT_texture_compression_s3tc: Boolean; + +//***** GL_EXT_texture_env_add *****// + +function Load_GL_EXT_texture_env_add: Boolean; + +//***** GL_EXT_texture_env_combine *****// +const + GL_COMBINE_EXT = $8570; + GL_COMBINE_RGB_EXT = $8571; + GL_COMBINE_ALPHA_EXT = $8572; + GL_SOURCE0_RGB_EXT = $8580; + GL_SOURCE1_RGB_EXT = $8581; + GL_SOURCE2_RGB_EXT = $8582; + GL_SOURCE0_ALPHA_EXT = $8588; + GL_SOURCE1_ALPHA_EXT = $8589; + GL_SOURCE2_ALPHA_EXT = $858A; + GL_OPERAND0_RGB_EXT = $8590; + GL_OPERAND1_RGB_EXT = $8591; + GL_OPERAND2_RGB_EXT = $8592; + GL_OPERAND0_ALPHA_EXT = $8598; + GL_OPERAND1_ALPHA_EXT = $8599; + GL_OPERAND2_ALPHA_EXT = $859A; + GL_RGB_SCALE_EXT = $8573; + GL_ADD_SIGNED_EXT = $8574; + GL_INTERPOLATE_EXT = $8575; + GL_CONSTANT_EXT = $8576; + GL_PRIMARY_COLOR_EXT = $8577; + GL_PREVIOUS_EXT = $8578; + +function Load_GL_EXT_texture_env_combine: Boolean; + +//***** GL_EXT_texture_env_dot3 *****// +const + GL_DOT3_RGB_EXT = $8740; + GL_DOT3_RGBA_EXT = $8741; + +function Load_GL_EXT_texture_env_dot3: Boolean; + +//***** GL_EXT_texture_filter_anisotropic *****// +const + GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE; + GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF; + +function Load_GL_EXT_texture_filter_anisotropic: Boolean; + +//***** GL_EXT_texture_lod_bias *****// +const + GL_TEXTURE_FILTER_CONTROL_EXT = $8500; + GL_TEXTURE_LOD_BIAS_EXT = $8501; + GL_MAX_TEXTURE_LOD_BIAS_EXT = $84FD; + +function Load_GL_EXT_texture_lod_bias: Boolean; + +//***** GL_EXT_texture_object *****// +const + GL_TEXTURE_PRIORITY_EXT = $8066; + GL_TEXTURE_RESIDENT_EXT = $8067; + GL_TEXTURE_1D_BINDING_EXT = $8068; + GL_TEXTURE_2D_BINDING_EXT = $8069; + GL_TEXTURE_3D_BINDING_EXT = $806A; +var + glGenTexturesEXT: procedure(n: GLsizei; textures: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDeleteTexturesEXT: procedure(n: GLsizei; const textures: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glBindTextureEXT: procedure(target: GLenum; texture: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPrioritizeTexturesEXT: procedure(n: GLsizei; const textures: PGLuint; const priorities: PGLclampf); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glAreTexturesResidentEXT: function(n: GLsizei; const textures: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIsTextureEXT: function(texture: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_EXT_texture_object: Boolean; + +//***** GL_EXT_vertex_array *****// +const + GL_VERTEX_ARRAY_EXT = $8074; + GL_NORMAL_ARRAY_EXT = $8075; + GL_COLOR_ARRAY_EXT = $8076; + GL_INDEX_ARRAY_EXT = $8077; + GL_TEXTURE_COORD_ARRAY_EXT = $8078; + GL_EDGE_FLAG_ARRAY_EXT = $8079; + GL_DOUBLE_EXT = $140A; + GL_VERTEX_ARRAY_SIZE_EXT = $807A; + GL_VERTEX_ARRAY_TYPE_EXT = $807B; + GL_VERTEX_ARRAY_STRIDE_EXT = $807C; + GL_VERTEX_ARRAY_COUNT_EXT = $807D; + GL_NORMAL_ARRAY_TYPE_EXT = $807E; + GL_NORMAL_ARRAY_STRIDE_EXT = $807F; + GL_NORMAL_ARRAY_COUNT_EXT = $8080; + GL_COLOR_ARRAY_SIZE_EXT = $8081; + GL_COLOR_ARRAY_TYPE_EXT = $8082; + GL_COLOR_ARRAY_STRIDE_EXT = $8083; + GL_COLOR_ARRAY_COUNT_EXT = $8084; + GL_INDEX_ARRAY_TYPE_EXT = $8085; + GL_INDEX_ARRAY_STRIDE_EXT = $8086; + GL_INDEX_ARRAY_COUNT_EXT = $8087; + GL_TEXTURE_COORD_ARRAY_SIZE_EXT = $8088; + GL_TEXTURE_COORD_ARRAY_TYPE_EXT = $8089; + GL_TEXTURE_COORD_ARRAY_STRIDE_EXT = $808A; + GL_TEXTURE_COORD_ARRAY_COUNT_EXT = $808B; + GL_EDGE_FLAG_ARRAY_STRIDE_EXT = $808C; + GL_EDGE_FLAG_ARRAY_COUNT_EXT = $808D; + GL_VERTEX_ARRAY_POINTER_EXT = $808E; + GL_NORMAL_ARRAY_POINTER_EXT = $808F; + GL_COLOR_ARRAY_POINTER_EXT = $8090; + GL_INDEX_ARRAY_POINTER_EXT = $8091; + GL_TEXTURE_COORD_ARRAY_POINTER_EXT = $8092; + GL_EDGE_FLAG_ARRAY_POINTER_EXT = $8093; +var + glArrayElementEXT: procedure(i: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDrawArraysEXT: procedure(mode: GLenum; first: GLint; count: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexPointerEXT: procedure(size: GLint; _type: GLenum; stride: GLsizei; count: GLsizei; const pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNormalPointerEXT: procedure(_type: GLenum; stride: GLsizei; count: GLsizei; const pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColorPointerEXT: procedure(size: GLint; _type: GLenum; stride: GLsizei; count: GLsizei; const pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIndexPointerEXT: procedure(_type: GLenum; stride: GLsizei; count: GLsizei; const pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoordPointerEXT: procedure(size: GLint; _type: GLenum; stride: GLsizei; count: GLsizei; const pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEdgeFlagPointerEXT: procedure(stride: GLsizei; count: GLsizei; const pointer: PGLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetPointervEXT: procedure(pname: GLenum; params: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_EXT_vertex_array: Boolean; + +//***** GL_EXT_vertex_shader *****// +const + GL_VERTEX_SHADER_EXT = $8780; + GL_VARIANT_VALUE_EXT = $87E4; + GL_VARIANT_DATATYPE_EXT = $87E5; + GL_VARIANT_ARRAY_STRIDE_EXT = $87E6; + GL_VARIANT_ARRAY_TYPE_EXT = $87E7; + GL_VARIANT_ARRAY_EXT = $87E8; + GL_VARIANT_ARRAY_POINTER_EXT = $87E9; + GL_INVARIANT_VALUE_EXT = $87EA; + GL_INVARIANT_DATATYPE_EXT = $87EB; + GL_LOCAL_CONSTANT_VALUE_EXT = $87EC; + GL_LOCAL_CONSTANT_DATATYPE_EXT = $87ED; + GL_OP_INDEX_EXT = $8782; + GL_OP_NEGATE_EXT = $8783; + GL_OP_DOT3_EXT = $8784; + GL_OP_DOT4_EXT = $8785; + GL_OP_MUL_EXT = $8786; + GL_OP_ADD_EXT = $8787; + GL_OP_MADD_EXT = $8788; + GL_OP_FRAC_EXT = $8789; + GL_OP_MAX_EXT = $878A; + GL_OP_MIN_EXT = $878B; + GL_OP_SET_GE_EXT = $878C; + GL_OP_SET_LT_EXT = $878D; + GL_OP_CLAMP_EXT = $878E; + GL_OP_FLOOR_EXT = $878F; + GL_OP_ROUND_EXT = $8790; + GL_OP_EXP_BASE_2_EXT = $8791; + GL_OP_LOG_BASE_2_EXT = $8792; + GL_OP_POWER_EXT = $8793; + GL_OP_RECIP_EXT = $8794; + GL_OP_RECIP_SQRT_EXT = $8795; + GL_OP_SUB_EXT = $8796; + GL_OP_CROSS_PRODUCT_EXT = $8797; + GL_OP_MULTIPLY_MATRIX_EXT = $8798; + GL_OP_MOV_EXT = $8799; + GL_OUTPUT_VERTEX_EXT = $879A; + GL_OUTPUT_COLOR0_EXT = $879B; + GL_OUTPUT_COLOR1_EXT = $879C; + GL_OUTPUT_TEXTURE_COORD0_EXT = $879D; + GL_OUTPUT_TEXTURE_COORD1_EXT = $879E; + GL_OUTPUT_TEXTURE_COORD2_EXT = $879F; + GL_OUTPUT_TEXTURE_COORD3_EXT = $87A0; + GL_OUTPUT_TEXTURE_COORD4_EXT = $87A1; + GL_OUTPUT_TEXTURE_COORD5_EXT = $87A2; + GL_OUTPUT_TEXTURE_COORD6_EXT = $87A3; + GL_OUTPUT_TEXTURE_COORD7_EXT = $87A4; + GL_OUTPUT_TEXTURE_COORD8_EXT = $87A5; + GL_OUTPUT_TEXTURE_COORD9_EXT = $87A6; + GL_OUTPUT_TEXTURE_COORD10_EXT = $87A7; + GL_OUTPUT_TEXTURE_COORD11_EXT = $87A8; + GL_OUTPUT_TEXTURE_COORD12_EXT = $87A9; + GL_OUTPUT_TEXTURE_COORD13_EXT = $87AA; + GL_OUTPUT_TEXTURE_COORD14_EXT = $87AB; + GL_OUTPUT_TEXTURE_COORD15_EXT = $87AC; + GL_OUTPUT_TEXTURE_COORD16_EXT = $87AD; + GL_OUTPUT_TEXTURE_COORD17_EXT = $87AE; + GL_OUTPUT_TEXTURE_COORD18_EXT = $87AF; + GL_OUTPUT_TEXTURE_COORD19_EXT = $87B0; + GL_OUTPUT_TEXTURE_COORD20_EXT = $87B1; + GL_OUTPUT_TEXTURE_COORD21_EXT = $87B2; + GL_OUTPUT_TEXTURE_COORD22_EXT = $87B3; + GL_OUTPUT_TEXTURE_COORD23_EXT = $87B4; + GL_OUTPUT_TEXTURE_COORD24_EXT = $87B5; + GL_OUTPUT_TEXTURE_COORD25_EXT = $87B6; + GL_OUTPUT_TEXTURE_COORD26_EXT = $87B7; + GL_OUTPUT_TEXTURE_COORD27_EXT = $87B8; + GL_OUTPUT_TEXTURE_COORD28_EXT = $87B9; + GL_OUTPUT_TEXTURE_COORD29_EXT = $87BA; + GL_OUTPUT_TEXTURE_COORD30_EXT = $87BB; + GL_OUTPUT_TEXTURE_COORD31_EXT = $87BC; + GL_OUTPUT_FOG_EXT = $87BD; + GL_SCALAR_EXT = $87BE; + GL_VECTOR_EXT = $87BF; + GL_MATRIX_EXT = $87C0; + GL_VARIANT_EXT = $87C1; + GL_INVARIANT_EXT = $87C2; + GL_LOCAL_CONSTANT_EXT = $87C3; + GL_LOCAL_EXT = $87C4; + GL_MAX_VERTEX_SHADER_INSTRUCTIONS_EXT = $87C5; + GL_MAX_VERTEX_SHADER_VARIANTS_EXT = $87C6; + GL_MAX_VERTEX_SHADER_INVARIANTS_EXT = $87C7; + GL_MAX_VERTEX_SHADER_LOCAL_CONSTANTS_EXT = $87C8; + GL_MAX_VERTEX_SHADER_LOCALS_EXT = $87C9; + GL_MAX_OPTIMIZED_VERTEX_SHADER_INSTRUCTIONS_EXT = $87CA; + GL_MAX_OPTIMIZED_VERTEX_SHADER_VARIANTS_EXT = $87CB; + GL_MAX_OPTIMIZED_VERTEX_SHADER_LOCAL_CONSTANTS_EXT = $87CC; + GL_MAX_OPTIMIZED_VERTEX_SHADER_INVARIANTS_EXT = $87CD; + GL_MAX_OPTIMIZED_VERTEX_SHADER_LOCALS_EXT = $87CE; + GL_VERTEX_SHADER_INSTRUCTIONS_EXT = $87CF; + GL_VERTEX_SHADER_VARIANTS_EXT = $87D0; + GL_VERTEX_SHADER_INVARIANTS_EXT = $87D1; + GL_VERTEX_SHADER_LOCAL_CONSTANTS_EXT = $87D2; + GL_VERTEX_SHADER_LOCALS_EXT = $87D3; + GL_VERTEX_SHADER_BINDING_EXT = $8781; + GL_VERTEX_SHADER_OPTIMIZED_EXT = $87D4; + GL_X_EXT = $87D5; + GL_Y_EXT = $87D6; + GL_Z_EXT = $87D7; + GL_W_EXT = $87D8; + GL_NEGATIVE_X_EXT = $87D9; + GL_NEGATIVE_Y_EXT = $87DA; + GL_NEGATIVE_Z_EXT = $87DB; + GL_NEGATIVE_W_EXT = $87DC; + GL_ZERO_EXT = $87DD; + GL_ONE_EXT = $87DE; + GL_NEGATIVE_ONE_EXT = $87DF; + GL_NORMALIZED_RANGE_EXT = $87E0; + GL_FULL_RANGE_EXT = $87E1; + GL_CURRENT_VERTEX_EXT = $87E2; + GL_MVP_MATRIX_EXT = $87E3; +var + glBeginVertexShaderEXT: procedure(); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEndVertexShaderEXT: procedure(); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glBindVertexShaderEXT: procedure(id: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGenVertexShadersEXT: function(range: GLuint): GLuint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDeleteVertexShaderEXT: procedure(id: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glShaderOp1EXT: procedure(op: GLenum; res: GLuint; arg1: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glShaderOp2EXT: procedure(op: GLenum; res: GLuint; arg1: GLuint; arg2: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glShaderOp3EXT: procedure(op: GLenum; res: GLuint; arg1: GLuint; arg2: GLuint; arg3: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSwizzleEXT: procedure(res: GLuint; _in: GLuint; outX: GLenum; outY: GLenum; outZ: GLenum; outW: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWriteMaskEXT: procedure(res: GLuint; _in: GLuint; outX: GLenum; outY: GLenum; outZ: GLenum; outW: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glInsertComponentEXT: procedure(res: GLuint; src: GLuint; num: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glExtractComponentEXT: procedure(res: GLuint; src: GLuint; num: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGenSymbolsEXT: function(datatype: GLenum; storagetype: GLenum; range: GLenum; components: GLuint): GLuint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSetInvariantEXT: procedure(id: GLuint; _type: GLenum; addr: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSetLocalConstantEXT: procedure(id: GLuint; _type: GLenum; addr: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVariantbvEXT: procedure(id: GLuint; addr: PGLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVariantsvEXT: procedure(id: GLuint; addr: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVariantivEXT: procedure(id: GLuint; addr: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVariantfvEXT: procedure(id: GLuint; addr: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVariantdvEXT: procedure(id: GLuint; addr: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVariantubvEXT: procedure(id: GLuint; addr: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVariantusvEXT: procedure(id: GLuint; addr: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVariantuivEXT: procedure(id: GLuint; addr: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVariantPointerEXT: procedure(id: GLuint; _type: GLenum; stride: GLuint; addr: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEnableVariantClientStateEXT: procedure(id: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDisableVariantClientStateEXT: procedure(id: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glBindLightParameterEXT: function(light: GLenum; value: GLenum): GLuint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glBindMaterialParameterEXT: function(face: GLenum; value: GLenum): GLuint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glBindTexGenParameterEXT: function(_unit: GLenum; coord: GLenum; value: GLenum): GLuint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glBindTextureUnitParameterEXT: function(_unit: GLenum; value: GLenum): GLuint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glBindParameterEXT: function(value: GLenum): GLuint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIsVariantEnabledEXT: function(id: GLuint; cap: GLenum): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetVariantBooleanvEXT: procedure(id: GLuint; value: GLenum; data: PGLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetVariantIntegervEXT: procedure(id: GLuint; value: GLenum; data: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetVariantFloatvEXT: procedure(id: GLuint; value: GLenum; data: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetVariantPointervEXT: procedure(id: GLuint; value: GLenum; data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetInvariantBooleanvEXT: procedure(id: GLuint; value: GLenum; data: PGLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetInvariantIntegervEXT: procedure(id: GLuint; value: GLenum; data: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetInvariantFloatvEXT: procedure(id: GLuint; value: GLenum; data: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetLocalConstantBooleanvEXT: procedure(id: GLuint; value: GLenum; data: PGLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetLocalConstantIntegervEXT: procedure(id: GLuint; value: GLenum; data: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetLocalConstantFloatvEXT: procedure(id: GLuint; value: GLenum; data: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_EXT_vertex_shader: Boolean; + +//***** GL_EXT_vertex_weighting *****// +const + GL_VERTEX_WEIGHTING_EXT = $8509; + GL_MODELVIEW0_EXT = $1700; + GL_MODELVIEW1_EXT = $850A; + GL_MODELVIEW0_MATRIX_EXT = $0BA6; + GL_MODELVIEW1_MATRIX_EXT = $8506; + GL_CURRENT_VERTEX_WEIGHT_EXT = $850B; + GL_VERTEX_WEIGHT_ARRAY_EXT = $850C; + GL_VERTEX_WEIGHT_ARRAY_SIZE_EXT = $850D; + GL_VERTEX_WEIGHT_ARRAY_TYPE_EXT = $850E; + GL_VERTEX_WEIGHT_ARRAY_STRIDE_EXT = $850F; + GL_MODELVIEW0_STACK_DEPTH_EXT = $0BA3; + GL_MODELVIEW1_STACK_DEPTH_EXT = $8502; + GL_VERTEX_WEIGHT_ARRAY_POINTER_EXT = $8510; +var + glVertexWeightfEXT: procedure(weight: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexWeightfvEXT: procedure(weight: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexWeightPointerEXT: procedure(size: GLint; _type: GLenum; stride: GLsizei; pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_EXT_vertex_weighting: Boolean; + +//***** GL_HP_occlusion_test *****// +const + GL_OCCLUSION_TEST_HP = $8165; + GL_OCCLUSION_TEST_RESULT_HP = $8166; + +function Load_GL_HP_occlusion_test: Boolean; + +//***** GL_NV_blend_square *****// + +function Load_GL_NV_blend_square: Boolean; + +//***** GL_NV_copy_depth_to_color *****// +const + GL_DEPTH_STENCIL_TO_RGBA_NV = $886E; + GL_DEPTH_STENCIL_TO_BGRA_NV = $886F; + +function Load_GL_NV_copy_depth_to_color: Boolean; + +//***** GL_NV_depth_clamp *****// +const + GL_DEPTH_CLAMP_NV = $864F; + +function Load_GL_NV_depth_clamp: Boolean; + +//***** GL_NV_evaluators *****// +const + GL_EVAL_2D_NV = $86C0; + GL_EVAL_TRIANGULAR_2D_NV = $86C1; + GL_MAP_TESSELLATION_NV = $86C2; + GL_MAP_ATTRIB_U_ORDER_NV = $86C3; + GL_MAP_ATTRIB_V_ORDER_NV = $86C4; + GL_EVAL_FRACTIONAL_TESSELLATION_NV = $86C5; + GL_EVAL_VERTEX_ATTRIB0_NV = $86C6; + GL_EVAL_VERTEX_ATTRIB1_NV = $86C7; + GL_EVAL_VERTEX_ATTRIB2_NV = $86C8; + GL_EVAL_VERTEX_ATTRIB3_NV = $86C9; + GL_EVAL_VERTEX_ATTRIB4_NV = $86CA; + GL_EVAL_VERTEX_ATTRIB5_NV = $86CB; + GL_EVAL_VERTEX_ATTRIB6_NV = $86CC; + GL_EVAL_VERTEX_ATTRIB7_NV = $86CD; + GL_EVAL_VERTEX_ATTRIB8_NV = $86CE; + GL_EVAL_VERTEX_ATTRIB9_NV = $86CF; + GL_EVAL_VERTEX_ATTRIB10_NV = $86D0; + GL_EVAL_VERTEX_ATTRIB11_NV = $86D1; + GL_EVAL_VERTEX_ATTRIB12_NV = $86D2; + GL_EVAL_VERTEX_ATTRIB13_NV = $86D3; + GL_EVAL_VERTEX_ATTRIB14_NV = $86D4; + GL_EVAL_VERTEX_ATTRIB15_NV = $86D5; + GL_MAX_MAP_TESSELLATION_NV = $86D6; + GL_MAX_RATIONAL_EVAL_ORDER_NV = $86D7; +var + glMapControlPointsNV: procedure(target: GLenum; index: GLuint; _type: GLenum; ustride: GLsizei; vstride: GLsizei; uorder: GLint; vorder: GLint; _packed: GLboolean; const points: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMapParameterivNV: procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMapParameterfvNV: procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetMapControlPointsNV: procedure(target: GLenum; index: GLuint; _type: GLenum; ustride: GLsizei; vstride: GLsizei; _packed: GLboolean; points: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetMapParameterivNV: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetMapParameterfvNV: procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetMapAttribParameterivNV: procedure(target: GLenum; index: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetMapAttribParameterfvNV: procedure(target: GLenum; index: GLuint; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEvalMapsNV: procedure(target: GLenum; mode: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_NV_evaluators: Boolean; + +//***** GL_NV_fence *****// +const + GL_ALL_COMPLETED_NV = $84F2; + GL_FENCE_STATUS_NV = $84F3; + GL_FENCE_CONDITION_NV = $84F4; +var + glGenFencesNV: procedure(n: GLsizei; fences: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDeleteFencesNV: procedure(n: GLsizei; const fences: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSetFenceNV: procedure(fence: GLuint; condition: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTestFenceNV: function(fence: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFinishFenceNV: procedure(fence: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIsFenceNV: function(fence: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetFenceivNV: procedure(fence: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_NV_fence: Boolean; + +//***** GL_NV_fog_distance *****// +const + GL_FOG_DISTANCE_MODE_NV = $855A; + GL_EYE_RADIAL_NV = $855B; + GL_EYE_PLANE_ABSOLUTE_NV = $855C; + +function Load_GL_NV_fog_distance: Boolean; + +//***** GL_NV_light_max_exponent *****// +const + GL_MAX_SHININESS_NV = $8504; + GL_MAX_SPOT_EXPONENT_NV = $8505; + +function Load_GL_NV_light_max_exponent: Boolean; + +//***** GL_NV_multisample_filter_hint *****// +const + GL_MULTISAMPLE_FILTER_HINT_NV = $8534; + +function Load_GL_NV_multisample_filter_hint: Boolean; + +//***** GL_NV_occlusion_query *****// + // GL_OCCLUSION_TEST_HP { already defined } + // GL_OCCLUSION_TEST_RESULT_HP { already defined } +const + GL_PIXEL_COUNTER_BITS_NV = $8864; + GL_CURRENT_OCCLUSION_QUERY_ID_NV = $8865; + GL_PIXEL_COUNT_NV = $8866; + GL_PIXEL_COUNT_AVAILABLE_NV = $8867; +var + glGenOcclusionQueriesNV: procedure(n: GLsizei; ids: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDeleteOcclusionQueriesNV: procedure(n: GLsizei; const ids: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIsOcclusionQueryNV: function(id: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glBeginOcclusionQueryNV: procedure(id: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEndOcclusionQueryNV: procedure(); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetOcclusionQueryivNV: procedure(id: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetOcclusionQueryuivNV: procedure(id: GLuint; pname: GLenum; params: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_NV_occlusion_query: Boolean; + +//***** GL_NV_packed_depth_stencil *****// +const + GL_DEPTH_STENCIL_NV = $84F9; + GL_UNSIGNED_INT_24_8_NV = $84FA; + +function Load_GL_NV_packed_depth_stencil: Boolean; + +//***** GL_NV_point_sprite *****// +const + GL_POINT_SPRITE_NV = $8861; + GL_COORD_REPLACE_NV = $8862; + GL_POINT_SPRITE_R_MODE_NV = $8863; +var + glPointParameteriNV: procedure(pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPointParameterivNV: procedure(pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_NV_point_sprite: Boolean; + +//***** GL_NV_register_combiners *****// +const + GL_REGISTER_COMBINERS_NV = $8522; + GL_COMBINER0_NV = $8550; + GL_COMBINER1_NV = $8551; + GL_COMBINER2_NV = $8552; + GL_COMBINER3_NV = $8553; + GL_COMBINER4_NV = $8554; + GL_COMBINER5_NV = $8555; + GL_COMBINER6_NV = $8556; + GL_COMBINER7_NV = $8557; + GL_VARIABLE_A_NV = $8523; + GL_VARIABLE_B_NV = $8524; + GL_VARIABLE_C_NV = $8525; + GL_VARIABLE_D_NV = $8526; + GL_VARIABLE_E_NV = $8527; + GL_VARIABLE_F_NV = $8528; + GL_VARIABLE_G_NV = $8529; + GL_CONSTANT_COLOR0_NV = $852A; + GL_CONSTANT_COLOR1_NV = $852B; + GL_PRIMARY_COLOR_NV = $852C; + GL_SECONDARY_COLOR_NV = $852D; + GL_SPARE0_NV = $852E; + GL_SPARE1_NV = $852F; + GL_UNSIGNED_IDENTITY_NV = $8536; + GL_UNSIGNED_INVERT_NV = $8537; + GL_EXPAND_NORMAL_NV = $8538; + GL_EXPAND_NEGATE_NV = $8539; + GL_HALF_BIAS_NORMAL_NV = $853A; + GL_HALF_BIAS_NEGATE_NV = $853B; + GL_SIGNED_IDENTITY_NV = $853C; + GL_SIGNED_NEGATE_NV = $853D; + GL_E_TIMES_F_NV = $8531; + GL_SPARE0_PLUS_SECONDARY_COLOR_NV = $8532; + GL_SCALE_BY_TWO_NV = $853E; + GL_SCALE_BY_FOUR_NV = $853F; + GL_SCALE_BY_ONE_HALF_NV = $8540; + GL_BIAS_BY_NEGATIVE_ONE_HALF_NV = $8541; + GL_DISCARD_NV = $8530; + GL_COMBINER_INPUT_NV = $8542; + GL_COMBINER_MAPPING_NV = $8543; + GL_COMBINER_COMPONENT_USAGE_NV = $8544; + GL_COMBINER_AB_DOT_PRODUCT_NV = $8545; + GL_COMBINER_CD_DOT_PRODUCT_NV = $8546; + GL_COMBINER_MUX_SUM_NV = $8547; + GL_COMBINER_SCALE_NV = $8548; + GL_COMBINER_BIAS_NV = $8549; + GL_COMBINER_AB_OUTPUT_NV = $854A; + GL_COMBINER_CD_OUTPUT_NV = $854B; + GL_COMBINER_SUM_OUTPUT_NV = $854C; + GL_NUM_GENERAL_COMBINERS_NV = $854E; + GL_COLOR_SUM_CLAMP_NV = $854F; + GL_MAX_GENERAL_COMBINERS_NV = $854D; +var + glCombinerParameterfvNV: procedure(pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCombinerParameterivNV: procedure(pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCombinerParameterfNV: procedure(pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCombinerParameteriNV: procedure(pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCombinerInputNV: procedure(stage: GLenum; portion: GLenum; variable: GLenum; input: GLenum; mapping: GLenum; componentUsage: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCombinerOutputNV: procedure(stage: GLenum; portion: GLenum; abOutput: GLenum; cdOutput: GLenum; sumOutput: GLenum; scale: GLenum; bias: GLenum; abDotProduct: GLboolean; cdDotProduct: GLboolean; muxSum: GLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFinalCombinerInputNV: procedure(variable: GLenum; input: GLenum; mapping: GLenum; componentUsage: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetCombinerInputParameterfvNV: procedure(stage: GLenum; portion: GLenum; variable: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetCombinerInputParameterivNV: procedure(stage: GLenum; portion: GLenum; variable: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetCombinerOutputParameterfvNV: procedure(stage: GLenum; portion: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetCombinerOutputParameterivNV: procedure(stage: GLenum; portion: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetFinalCombinerInputParameterfvNV: procedure(variable: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetFinalCombinerInputParameterivNV: procedure(variable: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_NV_register_combiners: Boolean; + +//***** GL_NV_register_combiners2 *****// +const + GL_PER_STAGE_CONSTANTS_NV = $8535; +var + glCombinerStageParameterfvNV: procedure(stage: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetCombinerStageParameterfvNV: procedure(stage: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_NV_register_combiners2: Boolean; + +//***** GL_NV_texgen_emboss *****// +const + GL_EMBOSS_MAP_NV = $855F; + GL_EMBOSS_LIGHT_NV = $855D; + GL_EMBOSS_CONSTANT_NV = $855E; + +function Load_GL_NV_texgen_emboss: Boolean; + +//***** GL_NV_texgen_reflection *****// +const + GL_NORMAL_MAP_NV = $8511; + GL_REFLECTION_MAP_NV = $8512; + +function Load_GL_NV_texgen_reflection: Boolean; + +//***** GL_NV_texture_compression_vtc *****// + // GL_COMPRESSED_RGB_S3TC_DXT1_EXT { already defined } + // GL_COMPRESSED_RGBA_S3TC_DXT1_EXT { already defined } + // GL_COMPRESSED_RGBA_S3TC_DXT3_EXT { already defined } + // GL_COMPRESSED_RGBA_S3TC_DXT5_EXT { already defined } + +function Load_GL_NV_texture_compression_vtc: Boolean; + +//***** GL_NV_texture_env_combine4 *****// +const + GL_COMBINE4_NV = $8503; + GL_SOURCE3_RGB_NV = $8583; + GL_SOURCE3_ALPHA_NV = $858B; + GL_OPERAND3_RGB_NV = $8593; + GL_OPERAND3_ALPHA_NV = $859B; + +function Load_GL_NV_texture_env_combine4: Boolean; + +//***** GL_NV_texture_rectangle *****// +const + GL_TEXTURE_RECTANGLE_NV = $84F5; + GL_TEXTURE_BINDING_RECTANGLE_NV = $84F6; + GL_PROXY_TEXTURE_RECTANGLE_NV = $84F7; + GL_MAX_RECTANGLE_TEXTURE_SIZE_NV = $84F8; + +function Load_GL_NV_texture_rectangle: Boolean; + +//***** GL_NV_texture_shader *****// +const + GL_TEXTURE_SHADER_NV = $86DE; + GL_RGBA_UNSIGNED_DOT_PRODUCT_MAPPING_NV = $86D9; + GL_SHADER_OPERATION_NV = $86DF; + GL_CULL_MODES_NV = $86E0; + GL_OFFSET_TEXTURE_MATRIX_NV = $86E1; + GL_OFFSET_TEXTURE_SCALE_NV = $86E2; + GL_OFFSET_TEXTURE_BIAS_NV = $86E3; + GL_PREVIOUS_TEXTURE_INPUT_NV = $86E4; + GL_CONST_EYE_NV = $86E5; + GL_SHADER_CONSISTENT_NV = $86DD; + GL_PASS_THROUGH_NV = $86E6; + GL_CULL_FRAGMENT_NV = $86E7; + GL_OFFSET_TEXTURE_2D_NV = $86E8; + GL_OFFSET_TEXTURE_RECTANGLE_NV = $864C; + GL_OFFSET_TEXTURE_RECTANGLE_SCALE_NV = $864D; + GL_DEPENDENT_AR_TEXTURE_2D_NV = $86E9; + GL_DEPENDENT_GB_TEXTURE_2D_NV = $86EA; + GL_DOT_PRODUCT_NV = $86EC; + GL_DOT_PRODUCT_DEPTH_REPLACE_NV = $86ED; + GL_DOT_PRODUCT_TEXTURE_2D_NV = $86EE; + GL_DOT_PRODUCT_TEXTURE_RECTANGLE_NV = $864E; + GL_DOT_PRODUCT_TEXTURE_CUBE_MAP_NV = $86F0; + GL_DOT_PRODUCT_DIFFUSE_CUBE_MAP_NV = $86F1; + GL_DOT_PRODUCT_REFLECT_CUBE_MAP_NV = $86F2; + GL_DOT_PRODUCT_CONST_EYE_REFLECT_CUBE_MAP_NV = $86F3; + GL_HILO_NV = $86F4; + GL_DSDT_NV = $86F5; + GL_DSDT_MAG_NV = $86F6; + GL_DSDT_MAG_VIB_NV = $86F7; + GL_UNSIGNED_INT_S8_S8_8_8_NV = $86DA; + GL_UNSIGNED_INT_8_8_S8_S8_REV_NV = $86DB; + GL_SIGNED_RGBA_NV = $86FB; + GL_SIGNED_RGBA8_NV = $86FC; + GL_SIGNED_RGB_NV = $86FE; + GL_SIGNED_RGB8_NV = $86FF; + GL_SIGNED_LUMINANCE_NV = $8701; + GL_SIGNED_LUMINANCE8_NV = $8702; + GL_SIGNED_LUMINANCE_ALPHA_NV = $8703; + GL_SIGNED_LUMINANCE8_ALPHA8_NV = $8704; + GL_SIGNED_ALPHA_NV = $8705; + GL_SIGNED_ALPHA8_NV = $8706; + GL_SIGNED_INTENSITY_NV = $8707; + GL_SIGNED_INTENSITY8_NV = $8708; + GL_SIGNED_RGB_UNSIGNED_ALPHA_NV = $870C; + GL_SIGNED_RGB8_UNSIGNED_ALPHA8_NV = $870D; + GL_HILO16_NV = $86F8; + GL_SIGNED_HILO_NV = $86F9; + GL_SIGNED_HILO16_NV = $86FA; + GL_DSDT8_NV = $8709; + GL_DSDT8_MAG8_NV = $870A; + GL_DSDT_MAG_INTENSITY_NV = $86DC; + GL_DSDT8_MAG8_INTENSITY8_NV = $870B; + GL_HI_SCALE_NV = $870E; + GL_LO_SCALE_NV = $870F; + GL_DS_SCALE_NV = $8710; + GL_DT_SCALE_NV = $8711; + GL_MAGNITUDE_SCALE_NV = $8712; + GL_VIBRANCE_SCALE_NV = $8713; + GL_HI_BIAS_NV = $8714; + GL_LO_BIAS_NV = $8715; + GL_DS_BIAS_NV = $8716; + GL_DT_BIAS_NV = $8717; + GL_MAGNITUDE_BIAS_NV = $8718; + GL_VIBRANCE_BIAS_NV = $8719; + GL_TEXTURE_BORDER_VALUES_NV = $871A; + GL_TEXTURE_HI_SIZE_NV = $871B; + GL_TEXTURE_LO_SIZE_NV = $871C; + GL_TEXTURE_DS_SIZE_NV = $871D; + GL_TEXTURE_DT_SIZE_NV = $871E; + GL_TEXTURE_MAG_SIZE_NV = $871F; + +function Load_GL_NV_texture_shader: Boolean; + +//***** GL_NV_texture_shader2 *****// +const + GL_DOT_PRODUCT_TEXTURE_3D_NV = $86EF; + // GL_HILO_NV { already defined } + // GL_DSDT_NV { already defined } + // GL_DSDT_MAG_NV { already defined } + // GL_DSDT_MAG_VIB_NV { already defined } + // GL_UNSIGNED_INT_S8_S8_8_8_NV { already defined } + // GL_UNSIGNED_INT_8_8_S8_S8_REV_NV { already defined } + // GL_SIGNED_RGBA_NV { already defined } + // GL_SIGNED_RGBA8_NV { already defined } + // GL_SIGNED_RGB_NV { already defined } + // GL_SIGNED_RGB8_NV { already defined } + // GL_SIGNED_LUMINANCE_NV { already defined } + // GL_SIGNED_LUMINANCE8_NV { already defined } + // GL_SIGNED_LUMINANCE_ALPHA_NV { already defined } + // GL_SIGNED_LUMINANCE8_ALPHA8_NV { already defined } + // GL_SIGNED_ALPHA_NV { already defined } + // GL_SIGNED_ALPHA8_NV { already defined } + // GL_SIGNED_INTENSITY_NV { already defined } + // GL_SIGNED_INTENSITY8_NV { already defined } + // GL_SIGNED_RGB_UNSIGNED_ALPHA_NV { already defined } + // GL_SIGNED_RGB8_UNSIGNED_ALPHA8_NV { already defined } + // GL_HILO16_NV { already defined } + // GL_SIGNED_HILO_NV { already defined } + // GL_SIGNED_HILO16_NV { already defined } + // GL_DSDT8_NV { already defined } + // GL_DSDT8_MAG8_NV { already defined } + // GL_DSDT_MAG_INTENSITY_NV { already defined } + // GL_DSDT8_MAG8_INTENSITY8_NV { already defined } + +function Load_GL_NV_texture_shader2: Boolean; + +//***** GL_NV_texture_shader3 *****// +const + GL_OFFSET_PROJECTIVE_TEXTURE_2D_NV = $8850; + GL_OFFSET_PROJECTIVE_TEXTURE_2D_SCALE_NV = $8851; + GL_OFFSET_PROJECTIVE_TEXTURE_RECTANGLE_NV = $8852; + GL_OFFSET_PROJECTIVE_TEXTURE_RECTANGLE_SCALE_NV = $8853; + GL_OFFSET_HILO_TEXTURE_2D_NV = $8854; + GL_OFFSET_HILO_TEXTURE_RECTANGLE_NV = $8855; + GL_OFFSET_HILO_PROJECTIVE_TEXTURE_2D_NV = $8856; + GL_OFFSET_HILO_PROJECTIVE_TEXTURE_RECTANGLE_NV = $8857; + GL_DEPENDENT_HILO_TEXTURE_2D_NV = $8858; + GL_DEPENDENT_RGB_TEXTURE_3D_NV = $8859; + GL_DEPENDENT_RGB_TEXTURE_CUBE_MAP_NV = $885A; + GL_DOT_PRODUCT_PASS_THROUGH_NV = $885B; + GL_DOT_PRODUCT_TEXTURE_1D_NV = $885C; + GL_DOT_PRODUCT_AFFINE_DEPTH_REPLACE_NV = $885D; + GL_HILO8_NV = $885E; + GL_SIGNED_HILO8_NV = $885F; + GL_FORCE_BLUE_TO_ONE_NV = $8860; + +function Load_GL_NV_texture_shader3: Boolean; + +//***** GL_NV_vertex_array_range *****// +const + GL_VERTEX_ARRAY_RANGE_NV = $851D; + GL_VERTEX_ARRAY_RANGE_LENGTH_NV = $851E; + GL_VERTEX_ARRAY_RANGE_VALID_NV = $851F; + GL_MAX_VERTEX_ARRAY_RANGE_ELEMENT_NV = $8520; + GL_VERTEX_ARRAY_RANGE_POINTER_NV = $8521; +var + glVertexArrayRangeNV: procedure(length: GLsizei; pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFlushVertexArrayRangeNV: procedure(); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} +{$IFDEF WINDOWS} + wglAllocateMemoryNV: function(size: GLsizei; readFrequency: GLfloat; writeFrequency: GLfloat; priority: GLfloat): PGLvoid; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglFreeMemoryNV: procedure(pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} +{$ENDIF} + +function Load_GL_NV_vertex_array_range: Boolean; + +//***** GL_NV_vertex_array_range2 *****// +const + GL_VERTEX_ARRAY_RANGE_WITHOUT_FLUSH_NV = $8533; + +function Load_GL_NV_vertex_array_range2: Boolean; + +//***** GL_NV_vertex_program *****// +const + GL_VERTEX_PROGRAM_NV = $8620; + GL_VERTEX_PROGRAM_POINT_SIZE_NV = $8642; + GL_VERTEX_PROGRAM_TWO_SIDE_NV = $8643; + GL_VERTEX_STATE_PROGRAM_NV = $8621; + GL_ATTRIB_ARRAY_SIZE_NV = $8623; + GL_ATTRIB_ARRAY_STRIDE_NV = $8624; + GL_ATTRIB_ARRAY_TYPE_NV = $8625; + GL_CURRENT_ATTRIB_NV = $8626; + GL_PROGRAM_PARAMETER_NV = $8644; + GL_ATTRIB_ARRAY_POINTER_NV = $8645; + GL_PROGRAM_TARGET_NV = $8646; + GL_PROGRAM_LENGTH_NV = $8627; + GL_PROGRAM_RESIDENT_NV = $8647; + GL_PROGRAM_STRING_NV = $8628; + GL_TRACK_MATRIX_NV = $8648; + GL_TRACK_MATRIX_TRANSFORM_NV = $8649; + GL_MAX_TRACK_MATRIX_STACK_DEPTH_NV = $862E; + GL_MAX_TRACK_MATRICES_NV = $862F; + GL_CURRENT_MATRIX_STACK_DEPTH_NV = $8640; + GL_CURRENT_MATRIX_NV = $8641; + GL_VERTEX_PROGRAM_BINDING_NV = $864A; + GL_PROGRAM_ERROR_POSITION_NV = $864B; + GL_MODELVIEW_PROJECTION_NV = $8629; + GL_MATRIX0_NV = $8630; + GL_MATRIX1_NV = $8631; + GL_MATRIX2_NV = $8632; + GL_MATRIX3_NV = $8633; + GL_MATRIX4_NV = $8634; + GL_MATRIX5_NV = $8635; + GL_MATRIX6_NV = $8636; + GL_MATRIX7_NV = $8637; + GL_IDENTITY_NV = $862A; + GL_INVERSE_NV = $862B; + GL_TRANSPOSE_NV = $862C; + GL_INVERSE_TRANSPOSE_NV = $862D; + GL_VERTEX_ATTRIB_ARRAY0_NV = $8650; + GL_VERTEX_ATTRIB_ARRAY1_NV = $8651; + GL_VERTEX_ATTRIB_ARRAY2_NV = $8652; + GL_VERTEX_ATTRIB_ARRAY3_NV = $8653; + GL_VERTEX_ATTRIB_ARRAY4_NV = $8654; + GL_VERTEX_ATTRIB_ARRAY5_NV = $8655; + GL_VERTEX_ATTRIB_ARRAY6_NV = $8656; + GL_VERTEX_ATTRIB_ARRAY7_NV = $8657; + GL_VERTEX_ATTRIB_ARRAY8_NV = $8658; + GL_VERTEX_ATTRIB_ARRAY9_NV = $8659; + GL_VERTEX_ATTRIB_ARRAY10_NV = $865A; + GL_VERTEX_ATTRIB_ARRAY11_NV = $865B; + GL_VERTEX_ATTRIB_ARRAY12_NV = $865C; + GL_VERTEX_ATTRIB_ARRAY13_NV = $865D; + GL_VERTEX_ATTRIB_ARRAY14_NV = $865E; + GL_VERTEX_ATTRIB_ARRAY15_NV = $865F; + GL_MAP1_VERTEX_ATTRIB0_4_NV = $8660; + GL_MAP1_VERTEX_ATTRIB1_4_NV = $8661; + GL_MAP1_VERTEX_ATTRIB2_4_NV = $8662; + GL_MAP1_VERTEX_ATTRIB3_4_NV = $8663; + GL_MAP1_VERTEX_ATTRIB4_4_NV = $8664; + GL_MAP1_VERTEX_ATTRIB5_4_NV = $8665; + GL_MAP1_VERTEX_ATTRIB6_4_NV = $8666; + GL_MAP1_VERTEX_ATTRIB7_4_NV = $8667; + GL_MAP1_VERTEX_ATTRIB8_4_NV = $8668; + GL_MAP1_VERTEX_ATTRIB9_4_NV = $8669; + GL_MAP1_VERTEX_ATTRIB10_4_NV = $866A; + GL_MAP1_VERTEX_ATTRIB11_4_NV = $866B; + GL_MAP1_VERTEX_ATTRIB12_4_NV = $866C; + GL_MAP1_VERTEX_ATTRIB13_4_NV = $866D; + GL_MAP1_VERTEX_ATTRIB14_4_NV = $866E; + GL_MAP1_VERTEX_ATTRIB15_4_NV = $866F; + GL_MAP2_VERTEX_ATTRIB0_4_NV = $8670; + GL_MAP2_VERTEX_ATTRIB1_4_NV = $8671; + GL_MAP2_VERTEX_ATTRIB2_4_NV = $8672; + GL_MAP2_VERTEX_ATTRIB3_4_NV = $8673; + GL_MAP2_VERTEX_ATTRIB4_4_NV = $8674; + GL_MAP2_VERTEX_ATTRIB5_4_NV = $8675; + GL_MAP2_VERTEX_ATTRIB6_4_NV = $8676; + GL_MAP2_VERTEX_ATTRIB7_4_NV = $8677; + GL_MAP2_VERTEX_ATTRIB8_4_NV = $8678; + GL_MAP2_VERTEX_ATTRIB9_4_NV = $8679; + GL_MAP2_VERTEX_ATTRIB10_4_NV = $867A; + GL_MAP2_VERTEX_ATTRIB11_4_NV = $867B; + GL_MAP2_VERTEX_ATTRIB12_4_NV = $867C; + GL_MAP2_VERTEX_ATTRIB13_4_NV = $867D; + GL_MAP2_VERTEX_ATTRIB14_4_NV = $867E; + GL_MAP2_VERTEX_ATTRIB15_4_NV = $867F; +var + glBindProgramNV: procedure(target: GLenum; id: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDeleteProgramsNV: procedure(n: GLsizei; const ids: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glExecuteProgramNV: procedure(target: GLenum; id: GLuint; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGenProgramsNV: procedure(n: GLsizei; ids: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glAreProgramsResidentNV: function(n: GLsizei; const ids: PGLuint; residences: PGLboolean): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRequestResidentProgramsNV: procedure(n: GLsizei; ids: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetProgramParameterfvNV: procedure(target: GLenum; index: GLuint; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetProgramParameterdvNV: procedure(target: GLenum; index: GLuint; pname: GLenum; params: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetProgramivNV: procedure(id: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetProgramStringNV: procedure(id: GLuint; pname: GLenum; _program: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetTrackMatrixivNV: procedure(target: GLenum; address: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetVertexAttribdvNV: procedure(index: GLuint; pname: GLenum; params: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetVertexAttribfvNV: procedure(index: GLuint; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetVertexAttribivNV: procedure(index: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetVertexAttribPointervNV: procedure(index: GLuint; pname: GLenum; pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIsProgramNV: function(id: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glLoadProgramNV: procedure(target: GLenum; id: GLuint; len: GLsizei; const _program: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glProgramParameter4fNV: procedure(target: GLenum; index: GLuint; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glProgramParameter4fvNV: procedure(target: GLenum; index: GLuint; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glProgramParameters4dvNV: procedure(target: GLenum; index: GLuint; num: GLuint; const params: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glProgramParameters4fvNV: procedure(target: GLenum; index: GLuint; num: GLuint; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTrackMatrixNV: procedure(target: GLenum; address: GLuint; matrix: GLenum; transform: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttribPointerNV: procedure(index: GLuint; size: GLint; _type: GLenum; stride: GLsizei; const pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib1sNV: procedure(index: GLuint; x: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib1fNV: procedure(index: GLuint; x: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib1dNV: procedure(index: GLuint; x: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib2sNV: procedure(index: GLuint; x: GLshort; y: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib2fNV: procedure(index: GLuint; x: GLfloat; y: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib2dNV: procedure(index: GLuint; x: GLdouble; y: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib3sNV: procedure(index: GLuint; x: GLshort; y: GLshort; z: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib3fNV: procedure(index: GLuint; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib3dNV: procedure(index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4sNV: procedure(index: GLuint; x: GLshort; y: GLshort; z: GLshort; w: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4fNV: procedure(index: GLuint; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4dNV: procedure(index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4ubNV: procedure(index: GLuint; x: GLubyte; y: GLubyte; z: GLubyte; w: GLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib1svNV: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib1fvNV: procedure(index: GLuint; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib1dvNV: procedure(index: GLuint; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib2svNV: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib2fvNV: procedure(index: GLuint; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib2dvNV: procedure(index: GLuint; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib3svNV: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib3fvNV: procedure(index: GLuint; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib3dvNV: procedure(index: GLuint; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4svNV: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4fvNV: procedure(index: GLuint; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4dvNV: procedure(index: GLuint; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4ubvNV: procedure(index: GLuint; const v: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttribs1svNV: procedure(index: GLuint; n: GLsizei; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttribs1fvNV: procedure(index: GLuint; n: GLsizei; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttribs1dvNV: procedure(index: GLuint; n: GLsizei; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttribs2svNV: procedure(index: GLuint; n: GLsizei; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttribs2fvNV: procedure(index: GLuint; n: GLsizei; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttribs2dvNV: procedure(index: GLuint; n: GLsizei; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttribs3svNV: procedure(index: GLuint; n: GLsizei; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttribs3fvNV: procedure(index: GLuint; n: GLsizei; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttribs3dvNV: procedure(index: GLuint; n: GLsizei; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttribs4svNV: procedure(index: GLuint; n: GLsizei; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttribs4fvNV: procedure(index: GLuint; n: GLsizei; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttribs4dvNV: procedure(index: GLuint; n: GLsizei; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttribs4ubvNV: procedure(index: GLuint; n: GLsizei; const v: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_NV_vertex_program: Boolean; + +//***** GL_NV_vertex_program1_1 *****// + +function Load_GL_NV_vertex_program1_1: Boolean; + +//***** GL_ATI_element_array *****// +const + GL_ELEMENT_ARRAY_ATI = $8768; + GL_ELEMENT_ARRAY_TYPE_ATI = $8769; + GL_ELEMENT_ARRAY_POINTER_ATI = $876A; +var + glElementPointerATI: procedure(_type: GLenum; const pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDrawElementArrayATI: procedure(mode: GLenum; count: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDrawRangeElementArrayATI: procedure(mode: GLenum; start: GLuint; _end: GLuint; count: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_ATI_element_array: Boolean; + +//***** GL_ATI_envmap_bumpmap *****// +const + GL_BUMP_ROT_MATRIX_ATI = $8775; + GL_BUMP_ROT_MATRIX_SIZE_ATI = $8776; + GL_BUMP_NUM_TEX_UNITS_ATI = $8777; + GL_BUMP_TEX_UNITS_ATI = $8778; + GL_DUDV_ATI = $8779; + GL_DU8DV8_ATI = $877A; + GL_BUMP_ENVMAP_ATI = $877B; + GL_BUMP_TARGET_ATI = $877C; +var + glTexBumpParameterivATI: procedure(pname: GLenum; param: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexBumpParameterfvATI: procedure(pname: GLenum; param: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetTexBumpParameterivATI: procedure(pname: GLenum; param: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetTexBumpParameterfvATI: procedure(pname: GLenum; param: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_ATI_envmap_bumpmap: Boolean; + +//***** GL_ATI_fragment_shader *****// +const + GL_FRAGMENT_SHADER_ATI = $8920; + GL_REG_0_ATI = $8921; + GL_REG_1_ATI = $8922; + GL_REG_2_ATI = $8923; + GL_REG_3_ATI = $8924; + GL_REG_4_ATI = $8925; + GL_REG_5_ATI = $8926; + GL_CON_0_ATI = $8941; + GL_CON_1_ATI = $8942; + GL_CON_2_ATI = $8943; + GL_CON_3_ATI = $8944; + GL_CON_4_ATI = $8945; + GL_CON_5_ATI = $8946; + GL_CON_6_ATI = $8947; + GL_CON_7_ATI = $8948; + GL_MOV_ATI = $8961; + GL_ADD_ATI = $8963; + GL_MUL_ATI = $8964; + GL_SUB_ATI = $8965; + GL_DOT3_ATI = $8966; + GL_DOT4_ATI = $8967; + GL_MAD_ATI = $8968; + GL_LERP_ATI = $8969; + GL_CND_ATI = $896A; + GL_CND0_ATI = $896B; + GL_DOT2_ADD_ATI = $896C; + GL_SECONDARY_INTERPOLATOR_ATI = $896D; + GL_SWIZZLE_STR_ATI = $8976; + GL_SWIZZLE_STQ_ATI = $8977; + GL_SWIZZLE_STR_DR_ATI = $8978; + GL_SWIZZLE_STQ_DQ_ATI = $8979; + GL_RED_BIT_ATI = $0001; + GL_GREEN_BIT_ATI = $0002; + GL_BLUE_BIT_ATI = $0004; + GL_2X_BIT_ATI = $0001; + GL_4X_BIT_ATI = $0002; + GL_8X_BIT_ATI = $0004; + GL_HALF_BIT_ATI = $0008; + GL_QUARTER_BIT_ATI = $0010; + GL_EIGHTH_BIT_ATI = $0020; + GL_SATURATE_BIT_ATI = $0040; + // GL_2X_BIT_ATI { already defined } + GL_COMP_BIT_ATI = $0002; + GL_NEGATE_BIT_ATI = $0004; + GL_BIAS_BIT_ATI = $0008; +var + glGenFragmentShadersATI: function(range: GLuint): GLuint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glBindFragmentShaderATI: procedure(id: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDeleteFragmentShaderATI: procedure(id: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glBeginFragmentShaderATI: procedure(); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEndFragmentShaderATI: procedure(); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPassTexCoordATI: procedure(dst: GLuint; coord: GLuint; swizzle: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSampleMapATI: procedure(dst: GLuint; interp: GLuint; swizzle: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColorFragmentOp1ATI: procedure(op: GLenum; dst: GLuint; dstMask: GLuint; dstMod: GLuint; arg1: GLuint; arg1Rep: GLuint; arg1Mod: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColorFragmentOp2ATI: procedure(op: GLenum; dst: GLuint; dstMask: GLuint; dstMod: GLuint; arg1: GLuint; arg1Rep: GLuint; arg1Mod: GLuint; arg2: GLuint; arg2Rep: GLuint; arg2Mod: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColorFragmentOp3ATI: procedure(op: GLenum; dst: GLuint; dstMask: GLuint; dstMod: GLuint; arg1: GLuint; arg1Rep: GLuint; arg1Mod: GLuint; arg2: GLuint; arg2Rep: GLuint; arg2Mod: GLuint; arg3: GLuint; arg3Rep: GLuint; arg3Mod: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glAlphaFragmentOp1ATI: procedure(op: GLenum; dst: GLuint; dstMod: GLuint; arg1: GLuint; arg1Rep: GLuint; arg1Mod: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glAlphaFragmentOp2ATI: procedure(op: GLenum; dst: GLuint; dstMod: GLuint; arg1: GLuint; arg1Rep: GLuint; arg1Mod: GLuint; arg2: GLuint; arg2Rep: GLuint; arg2Mod: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glAlphaFragmentOp3ATI: procedure(op: GLenum; dst: GLuint; dstMod: GLuint; arg1: GLuint; arg1Rep: GLuint; arg1Mod: GLuint; arg2: GLuint; arg2Rep: GLuint; arg2Mod: GLuint; arg3: GLuint; arg3Rep: GLuint; arg3Mod: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSetFragmentShaderConstantATI: procedure(dst: GLuint; const value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_ATI_fragment_shader: Boolean; + +//***** GL_ATI_pn_triangles *****// +const + GL_PN_TRIANGLES_ATI = $87F0; + GL_MAX_PN_TRIANGLES_TESSELATION_LEVEL_ATI = $87F1; + GL_PN_TRIANGLES_POINT_MODE_ATI = $87F2; + GL_PN_TRIANGLES_NORMAL_MODE_ATI = $87F3; + GL_PN_TRIANGLES_TESSELATION_LEVEL_ATI = $87F4; + GL_PN_TRIANGLES_POINT_MODE_LINEAR_ATI = $87F5; + GL_PN_TRIANGLES_POINT_MODE_CUBIC_ATI = $87F6; + GL_PN_TRIANGLES_NORMAL_MODE_LINEAR_ATI = $87F7; + GL_PN_TRIANGLES_NORMAL_MODE_QUADRATIC_ATI = $87F8; +var + glPNTrianglesiATI: procedure(pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPNTrianglesfATI: procedure(pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_ATI_pn_triangles: Boolean; + +//***** GL_ATI_texture_mirror_once *****// +const + GL_MIRROR_CLAMP_ATI = $8742; + GL_MIRROR_CLAMP_TO_EDGE_ATI = $8743; + +function Load_GL_ATI_texture_mirror_once: Boolean; + +//***** GL_ATI_vertex_array_object *****// +const + GL_STATIC_ATI = $8760; + GL_DYNAMIC_ATI = $8761; + GL_PRESERVE_ATI = $8762; + GL_DISCARD_ATI = $8763; + GL_OBJECT_BUFFER_SIZE_ATI = $8764; + GL_OBJECT_BUFFER_USAGE_ATI = $8765; + GL_ARRAY_OBJECT_BUFFER_ATI = $8766; + GL_ARRAY_OBJECT_OFFSET_ATI = $8767; +var + glNewObjectBufferATI: function(size: GLsizei; const pointer: PGLvoid; usage: GLenum): GLuint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIsObjectBufferATI: function(buffer: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUpdateObjectBufferATI: procedure(buffer: GLuint; offset: GLuint; size: GLsizei; const pointer: PGLvoid; preserve: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetObjectBufferfvATI: procedure(buffer: GLuint; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetObjectBufferivATI: procedure(buffer: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDeleteObjectBufferATI: procedure(buffer: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glArrayObjectATI: procedure(_array: GLenum; size: GLint; _type: GLenum; stride: GLsizei; buffer: GLuint; offset: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetArrayObjectfvATI: procedure(_array: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetArrayObjectivATI: procedure(_array: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVariantArrayObjectATI: procedure(id: GLuint; _type: GLenum; stride: GLsizei; buffer: GLuint; offset: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetVariantArrayObjectfvATI: procedure(id: GLuint; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetVariantArrayObjectivATI: procedure(id: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_ATI_vertex_array_object: Boolean; + +//***** GL_ATI_vertex_streams *****// +const + GL_MAX_VERTEX_STREAMS_ATI = $876B; + GL_VERTEX_STREAM0_ATI = $876C; + GL_VERTEX_STREAM1_ATI = $876D; + GL_VERTEX_STREAM2_ATI = $876E; + GL_VERTEX_STREAM3_ATI = $876F; + GL_VERTEX_STREAM4_ATI = $8770; + GL_VERTEX_STREAM5_ATI = $8771; + GL_VERTEX_STREAM6_ATI = $8772; + GL_VERTEX_STREAM7_ATI = $8773; + GL_VERTEX_SOURCE_ATI = $8774; +var + glVertexStream1s: procedure(stream: GLenum; coords: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream1i: procedure(stream: GLenum; coords: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream1f: procedure(stream: GLenum; coords: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream1d: procedure(stream: GLenum; coords: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream1sv: procedure(stream: GLenum; coords: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream1iv: procedure(stream: GLenum; coords: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream1fv: procedure(stream: GLenum; coords: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream1dv: procedure(stream: GLenum; coords: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream2s: procedure(stream: GLenum; coords: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream2i: procedure(stream: GLenum; coords: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream2f: procedure(stream: GLenum; coords: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream2d: procedure(stream: GLenum; coords: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream2sv: procedure(stream: GLenum; coords: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream2iv: procedure(stream: GLenum; coords: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream2fv: procedure(stream: GLenum; coords: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream2dv: procedure(stream: GLenum; coords: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream3s: procedure(stream: GLenum; coords: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream3i: procedure(stream: GLenum; coords: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream3f: procedure(stream: GLenum; coords: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream3d: procedure(stream: GLenum; coords: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream3sv: procedure(stream: GLenum; coords: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream3iv: procedure(stream: GLenum; coords: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream3fv: procedure(stream: GLenum; coords: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream3dv: procedure(stream: GLenum; coords: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream4s: procedure(stream: GLenum; coords: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream4i: procedure(stream: GLenum; coords: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream4f: procedure(stream: GLenum; coords: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream4d: procedure(stream: GLenum; coords: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream4sv: procedure(stream: GLenum; coords: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream4iv: procedure(stream: GLenum; coords: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream4fv: procedure(stream: GLenum; coords: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexStream4dv: procedure(stream: GLenum; coords: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNormalStream3b: procedure(stream: GLenum; coords: GLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNormalStream3s: procedure(stream: GLenum; coords: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNormalStream3i: procedure(stream: GLenum; coords: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNormalStream3f: procedure(stream: GLenum; coords: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNormalStream3d: procedure(stream: GLenum; coords: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNormalStream3bv: procedure(stream: GLenum; coords: GLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNormalStream3sv: procedure(stream: GLenum; coords: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNormalStream3iv: procedure(stream: GLenum; coords: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNormalStream3fv: procedure(stream: GLenum; coords: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNormalStream3dv: procedure(stream: GLenum; coords: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glClientActiveVertexStream: procedure(stream: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexBlendEnvi: procedure(pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexBlendEnvf: procedure(pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_ATI_vertex_streams: Boolean; + +{$IFDEF WINDOWS} +//***** WGL_I3D_image_buffer *****// +const + WGL_IMAGE_BUFFER_MIN_ACCESS_I3D = $0001; + WGL_IMAGE_BUFFER_LOCK_I3D = $0002; +var + wglCreateImageBufferI3D: function(hDC: HDC; dwSize: DWORD; uFlags: UINT): PGLvoid; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglDestroyImageBufferI3D: function(hDC: HDC; pAddress: PGLvoid): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglAssociateImageBufferEventsI3D: function(hdc: HDC; pEvent: PHandle; pAddress: PGLvoid; pSize: PDWORD; count: UINT): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglReleaseImageBufferEventsI3D: function(hdc: HDC; pAddress: PGLvoid; count: UINT): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_WGL_I3D_image_buffer: Boolean; + +//***** WGL_I3D_swap_frame_lock *****// +var + wglEnableFrameLockI3D: function(): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglDisableFrameLockI3D: function(): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglIsEnabledFrameLockI3D: function(pFlag: PBOOL): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglQueryFrameLockMasterI3D: function(pFlag: PBOOL): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_WGL_I3D_swap_frame_lock: Boolean; + +//***** WGL_I3D_swap_frame_usage *****// +var + wglGetFrameUsageI3D: function(pUsage: PGLfloat): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglBeginFrameTrackingI3D: function(): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglEndFrameTrackingI3D: function(): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglQueryFrameTrackingI3D: function(pFrameCount: PDWORD; pMissedFrames: PDWORD; pLastMissedUsage: PGLfloat): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_WGL_I3D_swap_frame_usage: Boolean; +{$ENDIF} + +//***** GL_3DFX_texture_compression_FXT1 *****// +const + GL_COMPRESSED_RGB_FXT1_3DFX = $86B0; + GL_COMPRESSED_RGBA_FXT1_3DFX = $86B1; + +function Load_GL_3DFX_texture_compression_FXT1: Boolean; + +//***** GL_IBM_cull_vertex *****// +const + GL_CULL_VERTEX_IBM = $1928A; + +function Load_GL_IBM_cull_vertex: Boolean; + +//***** GL_IBM_multimode_draw_arrays *****// +var + glMultiModeDrawArraysIBM: procedure(mode: PGLenum; first: PGLint; count: PGLsizei; primcount: GLsizei; modestride: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiModeDrawElementsIBM: procedure(mode: PGLenum; count: PGLsizei; _type: GLenum; const indices: PGLvoid; primcount: GLsizei; modestride: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_IBM_multimode_draw_arrays: Boolean; + +//***** GL_IBM_raster_pos_clip *****// +const + GL_RASTER_POSITION_UNCLIPPED_IBM = $19262; + +function Load_GL_IBM_raster_pos_clip: Boolean; + +//***** GL_IBM_texture_mirrored_repeat *****// +const + GL_MIRRORED_REPEAT_IBM = $8370; + +function Load_GL_IBM_texture_mirrored_repeat: Boolean; + +//***** GL_IBM_vertex_array_lists *****// +const + GL_VERTEX_ARRAY_LIST_IBM = $1929E; + GL_NORMAL_ARRAY_LIST_IBM = $1929F; + GL_COLOR_ARRAY_LIST_IBM = $192A0; + GL_INDEX_ARRAY_LIST_IBM = $192A1; + GL_TEXTURE_COORD_ARRAY_LIST_IBM = $192A2; + GL_EDGE_FLAG_ARRAY_LIST_IBM = $192A3; + GL_FOG_COORDINATE_ARRAY_LIST_IBM = $192A4; + GL_SECONDARY_COLOR_ARRAY_LIST_IBM = $192A5; + GL_VERTEX_ARRAY_LIST_STRIDE_IBM = $192A8; + GL_NORMAL_ARRAY_LIST_STRIDE_IBM = $192A9; + GL_COLOR_ARRAY_LIST_STRIDE_IBM = $192AA; + GL_INDEX_ARRAY_LIST_STRIDE_IBM = $192AB; + GL_TEXTURE_COORD_ARRAY_LIST_STRIDE_IBM = $192AC; + GL_EDGE_FLAG_ARRAY_LIST_STRIDE_IBM = $192AD; + GL_FOG_COORDINATE_ARRAY_LIST_STRIDE_IBM = $192AE; + GL_SECONDARY_COLOR_ARRAY_LIST_STRIDE_IBM = $192AF; +var + glColorPointerListIBM: procedure(size: GLint; _type: GLenum; stride: GLint; const pointer: PGLvoid; ptrstride: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColorPointerListIBM: procedure(size: GLint; _type: GLenum; stride: GLint; const pointer: PGLvoid; ptrstride: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEdgeFlagPointerListIBM: procedure(stride: GLint; const pointer: PGLboolean; ptrstride: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFogCoordPointerListIBM: procedure(_type: GLenum; stride: GLint; const pointer: PGLvoid; ptrstride: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNormalPointerListIBM: procedure(_type: GLenum; stride: GLint; const pointer: PGLvoid; ptrstride: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoordPointerListIBM: procedure(size: GLint; _type: GLenum; stride: GLint; const pointer: PGLvoid; ptrstride: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexPointerListIBM: procedure(size: GLint; _type: GLenum; stride: GLint; const pointer: PGLvoid; ptrstride: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_IBM_vertex_array_lists: Boolean; + +//***** GL_MESA_resize_buffers *****// +var + glResizeBuffersMESA: procedure(); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_MESA_resize_buffers: Boolean; + +//***** GL_MESA_window_pos *****// +var + glWindowPos2dMESA: procedure(x: GLdouble; y: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos2fMESA: procedure(x: GLfloat; y: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos2iMESA: procedure(x: GLint; y: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos2sMESA: procedure(x: GLshort; y: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos2ivMESA: procedure(const p: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos2svMESA: procedure(const p: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos2fvMESA: procedure(const p: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos2dvMESA: procedure(const p: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos3iMESA: procedure(x: GLint; y: GLint; z: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos3sMESA: procedure(x: GLshort; y: GLshort; z: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos3fMESA: procedure(x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos3dMESA: procedure(x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos3ivMESA: procedure(const p: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos3svMESA: procedure(const p: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos3fvMESA: procedure(const p: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos3dvMESA: procedure(const p: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos4iMESA: procedure(x: GLint; y: GLint; z: GLint; w: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos4sMESA: procedure(x: GLshort; y: GLshort; z: GLshort; w: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos4fMESA: procedure(x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos4dMESA: procedure(x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos4ivMESA: procedure(const p: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos4svMESA: procedure(const p: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos4fvMESA: procedure(const p: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos4dvMESA: procedure(const p: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_MESA_window_pos: Boolean; + +//***** GL_OML_interlace *****// +const + GL_INTERLACE_OML = $8980; + GL_INTERLACE_READ_OML = $8981; + +function Load_GL_OML_interlace: Boolean; + +//***** GL_OML_resample *****// +const + GL_PACK_RESAMPLE_OML = $8984; + GL_UNPACK_RESAMPLE_OML = $8985; + GL_RESAMPLE_REPLICATE_OML = $8986; + GL_RESAMPLE_ZERO_FILL_OML = $8987; + GL_RESAMPLE_AVERAGE_OML = $8988; + GL_RESAMPLE_DECIMATE_OML = $8989; + // GL_RESAMPLE_AVERAGE_OML { already defined } + +function Load_GL_OML_resample: Boolean; + +//***** GL_OML_subsample *****// +const + GL_FORMAT_SUBSAMPLE_24_24_OML = $8982; + GL_FORMAT_SUBSAMPLE_244_244_OML = $8983; + +function Load_GL_OML_subsample: Boolean; + +//***** GL_SGIS_generate_mipmap *****// +const + GL_GENERATE_MIPMAP_SGIS = $8191; + GL_GENERATE_MIPMAP_HINT_SGIS = $8192; + +function Load_GL_SGIS_generate_mipmap: Boolean; + +//***** GL_SGIS_multisample *****// +const + GLX_SAMPLE_BUFFERS_SGIS = $186A0; + GLX_SAMPLES_SGIS = $186A1; + GL_MULTISAMPLE_SGIS = $809D; + GL_SAMPLE_ALPHA_TO_MASK_SGIS = $809E; + GL_SAMPLE_ALPHA_TO_ONE_SGIS = $809F; + GL_SAMPLE_MASK_SGIS = $80A0; + GL_MULTISAMPLE_BIT_EXT = $20000000; + GL_1PASS_SGIS = $80A1; + GL_2PASS_0_SGIS = $80A2; + GL_2PASS_1_SGIS = $80A3; + GL_4PASS_0_SGIS = $80A4; + GL_4PASS_1_SGIS = $80A5; + GL_4PASS_2_SGIS = $80A6; + GL_4PASS_3_SGIS = $80A7; + GL_SAMPLE_BUFFERS_SGIS = $80A8; + GL_SAMPLES_SGIS = $80A9; + GL_SAMPLE_MASK_VALUE_SGIS = $80AA; + GL_SAMPLE_MASK_INVERT_SGIS = $80AB; + GL_SAMPLE_PATTERN_SGIS = $80AC; +var + glSampleMaskSGIS: procedure(value: GLclampf; invert: GLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSamplePatternSGIS: procedure(pattern: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_SGIS_multisample: Boolean; + +//***** GL_SGIS_pixel_texture *****// +const + GL_PIXEL_TEXTURE_SGIS = $8353; + GL_PIXEL_FRAGMENT_RGB_SOURCE_SGIS = $8354; + GL_PIXEL_FRAGMENT_ALPHA_SOURCE_SGIS = $8355; + GL_PIXEL_GROUP_COLOR_SGIS = $8356; +var + glPixelTexGenParameteriSGIS: procedure(pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPixelTexGenParameterfSGIS: procedure(pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetPixelTexGenParameterivSGIS: procedure(pname: GLenum; params: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetPixelTexGenParameterfvSGIS: procedure(pname: GLenum; params: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_SGIS_pixel_texture: Boolean; + +//***** GL_SGIS_texture_border_clamp *****// + // GL_CLAMP_TO_BORDER_SGIS { already defined } + +function Load_GL_SGIS_texture_border_clamp: Boolean; + +//***** GL_SGIS_texture_color_mask *****// +const + GL_TEXTURE_COLOR_WRITEMASK_SGIS = $81EF; +var + glTextureColorMaskSGIS: procedure(r: GLboolean; g: GLboolean; b: GLboolean; a: GLboolean); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_SGIS_texture_color_mask: Boolean; + +//***** GL_SGIS_texture_edge_clamp *****// +const + GL_CLAMP_TO_EDGE_SGIS = $812F; + +function Load_GL_SGIS_texture_edge_clamp: Boolean; + +//***** GL_SGIS_texture_lod *****// +const + GL_TEXTURE_MIN_LOD_SGIS = $813A; + GL_TEXTURE_MAX_LOD_SGIS = $813B; + GL_TEXTURE_BASE_LEVEL_SGIS = $813C; + GL_TEXTURE_MAX_LEVEL_SGIS = $813D; + +function Load_GL_SGIS_texture_lod: Boolean; + +//***** GL_SGIS_depth_texture *****// +const + GL_DEPTH_COMPONENT16_SGIX = $81A5; + GL_DEPTH_COMPONENT24_SGIX = $81A6; + GL_DEPTH_COMPONENT32_SGIX = $81A7; + +function Load_GL_SGIS_depth_texture: Boolean; + +//***** GL_SGIX_fog_offset *****// +const + GL_FOG_OFFSET_SGIX = $8198; + GL_FOG_OFFSET_VALUE_SGIX = $8199; + +function Load_GL_SGIX_fog_offset: Boolean; + +//***** GL_SGIX_interlace *****// +const + GL_INTERLACE_SGIX = $8094; + +function Load_GL_SGIX_interlace: Boolean; + +//***** GL_SGIX_shadow_ambient *****// +const + GL_SHADOW_AMBIENT_SGIX = $80BF; + +function Load_GL_SGIX_shadow_ambient: Boolean; + +//***** GL_SGI_color_matrix *****// +const + GL_COLOR_MATRIX_SGI = $80B1; + GL_COLOR_MATRIX_STACK_DEPTH_SGI = $80B2; + GL_MAX_COLOR_MATRIX_STACK_DEPTH_SGI = $80B3; + GL_POST_COLOR_MATRIX_RED_SCALE_SGI = $80B4; + GL_POST_COLOR_MATRIX_GREEN_SCALE_SGI = $80B5; + GL_POST_COLOR_MATRIX_BLUE_SCALE_SGI = $80B6; + GL_POST_COLOR_MATRIX_ALPHA_SCALE_SGI = $80B7; + GL_POST_COLOR_MATRIX_RED_BIAS_SGI = $80B8; + GL_POST_COLOR_MATRIX_GREEN_BIAS_SGI = $80B9; + GL_POST_COLOR_MATRIX_BLUE_BIAS_SGI = $80BA; + GL_POST_COLOR_MATRIX_ALPHA_BIAS_SGI = $80BB; + +function Load_GL_SGI_color_matrix: Boolean; + +//***** GL_SGI_color_table *****// +const + GL_COLOR_TABLE_SGI = $80D0; + GL_POST_CONVOLUTION_COLOR_TABLE_SGI = $80D1; + GL_POST_COLOR_MATRIX_COLOR_TABLE_SGI = $80D2; + GL_PROXY_COLOR_TABLE_SGI = $80D3; + GL_PROXY_POST_CONVOLUTION_COLOR_TABLE_SGI = $80D4; + GL_PROXY_POST_COLOR_MATRIX_COLOR_TABLE_SGI = $80D5; + GL_COLOR_TABLE_SCALE_SGI = $80D6; + GL_COLOR_TABLE_BIAS_SGI = $80D7; + GL_COLOR_TABLE_FORMAT_SGI = $80D8; + GL_COLOR_TABLE_WIDTH_SGI = $80D9; + GL_COLOR_TABLE_RED_SIZE_SGI = $80DA; + GL_COLOR_TABLE_GREEN_SIZE_SGI = $80DB; + GL_COLOR_TABLE_BLUE_SIZE_SGI = $80DC; + GL_COLOR_TABLE_ALPHA_SIZE_SGI = $80DD; + GL_COLOR_TABLE_LUMINANCE_SIZE_SGI = $80DE; + GL_COLOR_TABLE_INTENSITY_SIZE_SGI = $80DF; +var + glColorTableSGI: procedure(target: GLenum; internalformat: GLenum; width: GLsizei; format: GLenum; _type: GLenum; const table: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCopyColorTableSGI: procedure(target: GLenum; internalformat: GLenum; x: GLint; y: GLint; width: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColorTableParameterivSGI: procedure(target: GLenum; pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColorTableParameterfvSGI: procedure(target: GLenum; pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetColorTableSGI: procedure(target: GLenum; format: GLenum; _type: GLenum; table: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetColorTableParameterivSGI: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetColorTableParameterfvSGI: procedure(target: GLenum; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_SGI_color_table: Boolean; + +//***** GL_SGI_texture_color_table *****// +const + GL_TEXTURE_COLOR_TABLE_SGI = $80BC; + GL_PROXY_TEXTURE_COLOR_TABLE_SGI = $80BD; + +function Load_GL_SGI_texture_color_table: Boolean; + +//***** GL_SUN_vertex *****// +var + glColor4ubVertex2fSUN: procedure(r: GLubyte; g: GLubyte; b: GLubyte; a: GLubyte; x: GLfloat; y: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor4ubVertex2fvSUN: procedure(const c: PGLubyte; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor4ubVertex3fSUN: procedure(r: GLubyte; g: GLubyte; b: GLubyte; a: GLubyte; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor4ubVertex3fvSUN: procedure(const c: PGLubyte; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor3fVertex3fSUN: procedure(r: GLfloat; g: GLfloat; b: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor3fVertex3fvSUN: procedure(const c: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNormal3fVertex3fSUN: procedure(nx: GLfloat; ny: GLfloat; nz: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNormal3fVertex3fvSUN: procedure(const n: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor4fNormal3fVertex3fSUN: procedure(r: GLfloat; g: GLfloat; b: GLfloat; a: GLfloat; nx: GLfloat; ny: GLfloat; nz: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor4fNormal3fVertex3fvSUN: procedure(const c: PGLfloat; const n: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord2fVertex3fSUN: procedure(s: GLfloat; t: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord2fVertex3fvSUN: procedure(const tc: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord4fVertex4fSUN: procedure(s: GLfloat; t: GLfloat; p: GLfloat; q: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord4fVertex4fvSUN: procedure(const tc: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord2fColor4ubVertex3fSUN: procedure(s: GLfloat; t: GLfloat; r: GLubyte; g: GLubyte; b: GLubyte; a: GLubyte; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord2fColor4ubVertex3fvSUN: procedure(const tc: PGLfloat; const c: PGLubyte; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord2fColor3fVertex3fSUN: procedure(s: GLfloat; t: GLfloat; r: GLfloat; g: GLfloat; b: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord2fColor3fVertex3fvSUN: procedure(const tc: PGLfloat; const c: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord2fNormal3fVertex3fSUN: procedure(s: GLfloat; t: GLfloat; nx: GLfloat; ny: GLfloat; nz: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord2fNormal3fVertex3fvSUN: procedure(const tc: PGLfloat; const n: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord2fColor4fNormal3fVertex3fSUN: procedure(s: GLfloat; t: GLfloat; r: GLfloat; g: GLfloat; b: GLfloat; a: GLfloat; nx: GLfloat; ny: GLfloat; nz: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord2fColor4fNormal3fVertex3fvSUN: procedure(const tc: PGLfloat; const c: PGLfloat; const n: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord4fColor4fNormal3fVertex4fSUN: procedure(s: GLfloat; t: GLfloat; p: GLfloat; q: GLfloat; r: GLfloat; g: GLfloat; b: GLfloat; a: GLfloat; nx: GLfloat; ny: GLfloat; nz: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord4fColor4fNormal3fVertex4fvSUN: procedure(const tc: PGLfloat; const c: PGLfloat; const n: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glReplacementCodeuiVertex3fSUN: procedure(rc: GLuint; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glReplacementCodeuiVertex3fvSUN: procedure(const rc: PGLuint; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glReplacementCodeuiColor4ubVertex3fSUN: procedure(rc: GLuint; r: GLubyte; g: GLubyte; b: GLubyte; a: GLubyte; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glReplacementCodeuiColor4ubVertex3fvSUN: procedure(const rc: PGLuint; const c: PGLubyte; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glReplacementCodeuiColor3fVertex3fSUN: procedure(rc: GLuint; r: GLfloat; g: GLfloat; b: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glReplacementCodeuiColor3fVertex3fvSUN: procedure(const rc: PGLuint; const c: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glReplacementCodeuiNormal3fVertex3fSUN: procedure(rc: GLuint; nx: GLfloat; ny: GLfloat; nz: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glReplacementCodeuiNormal3fVertex3fvSUN: procedure(const rc: PGLuint; const n: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glReplacementCodeuiColor4fNormal3fVertex3fSUN: procedure(rc: GLuint; r: GLfloat; g: GLfloat; b: GLfloat; a: GLfloat; nx: GLfloat; ny: GLfloat; nz: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glReplacementCodeuiColor4fNormal3fVertex3fvSUN: procedure(const rc: PGLuint; const c: PGLfloat; const n: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glReplacementCodeuiTexCoord2fVertex3fSUN: procedure(rc: GLuint; s: GLfloat; t: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glReplacementCodeuiTexCoord2fVertex3fvSUN: procedure(const rc: PGLuint; const tc: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glReplacementCodeuiTexCoord2fNormal3fVertex3fSUN: procedure(rc: GLuint; s: GLfloat; t: GLfloat; nx: GLfloat; ny: GLfloat; nz: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glReplacementCodeuiTexCoord2fNormal3fVertex3fvSUN: procedure(const rc: PGLuint; const tc: PGLfloat; const n: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glReplacementCodeuiTexCoord2fColor4fNormal3fVertex3fSUN: procedure(rc: GLuint; s: GLfloat; t: GLfloat; r: GLfloat; g: GLfloat; b: GLfloat; a: GLfloat; nx: GLfloat; ny: GLfloat; nz: GLfloat; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glReplacementCodeuiTexCoord2fColor4fNormal3fVertex3fvSUN: procedure(const rc: PGLuint; const tc: PGLfloat; const c: PGLfloat; const n: PGLfloat; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_SUN_vertex: Boolean; + +//***** GL_ARB_fragment_program *****// +const + GL_FRAGMENT_PROGRAM_ARB = $8804; + // GL_PROGRAM_FORMAT_ASCII_ARB { already defined } + // GL_PROGRAM_LENGTH_ARB { already defined } + // GL_PROGRAM_FORMAT_ARB { already defined } + // GL_PROGRAM_BINDING_ARB { already defined } + // GL_PROGRAM_INSTRUCTIONS_ARB { already defined } + // GL_MAX_PROGRAM_INSTRUCTIONS_ARB { already defined } + // GL_PROGRAM_NATIVE_INSTRUCTIONS_ARB { already defined } + // GL_MAX_PROGRAM_NATIVE_INSTRUCTIONS_ARB { already defined } + // GL_PROGRAM_TEMPORARIES_ARB { already defined } + // GL_MAX_PROGRAM_TEMPORARIES_ARB { already defined } + // GL_PROGRAM_NATIVE_TEMPORARIES_ARB { already defined } + // GL_MAX_PROGRAM_NATIVE_TEMPORARIES_ARB { already defined } + // GL_PROGRAM_PARAMETERS_ARB { already defined } + // GL_MAX_PROGRAM_PARAMETERS_ARB { already defined } + // GL_PROGRAM_NATIVE_PARAMETERS_ARB { already defined } + // GL_MAX_PROGRAM_NATIVE_PARAMETERS_ARB { already defined } + // GL_PROGRAM_ATTRIBS_ARB { already defined } + // GL_MAX_PROGRAM_ATTRIBS_ARB { already defined } + // GL_PROGRAM_NATIVE_ATTRIBS_ARB { already defined } + // GL_MAX_PROGRAM_NATIVE_ATTRIBS_ARB { already defined } + // GL_MAX_PROGRAM_LOCAL_PARAMETERS_ARB { already defined } + // GL_MAX_PROGRAM_ENV_PARAMETERS_ARB { already defined } + // GL_PROGRAM_UNDER_NATIVE_LIMITS_ARB { already defined } + GL_PROGRAM_ALU_INSTRUCTIONS_ARB = $8805; + GL_PROGRAM_TEX_INSTRUCTIONS_ARB = $8806; + GL_PROGRAM_TEX_INDIRECTIONS_ARB = $8807; + GL_PROGRAM_NATIVE_ALU_INSTRUCTIONS_ARB = $8808; + GL_PROGRAM_NATIVE_TEX_INSTRUCTIONS_ARB = $8809; + GL_PROGRAM_NATIVE_TEX_INDIRECTIONS_ARB = $880A; + GL_MAX_PROGRAM_ALU_INSTRUCTIONS_ARB = $880B; + GL_MAX_PROGRAM_TEX_INSTRUCTIONS_ARB = $880C; + GL_MAX_PROGRAM_TEX_INDIRECTIONS_ARB = $880D; + GL_MAX_PROGRAM_NATIVE_ALU_INSTRUCTIONS_ARB = $880E; + GL_MAX_PROGRAM_NATIVE_TEX_INSTRUCTIONS_ARB = $880F; + GL_MAX_PROGRAM_NATIVE_TEX_INDIRECTIONS_ARB = $8810; + // GL_PROGRAM_STRING_ARB { already defined } + // GL_PROGRAM_ERROR_POSITION_ARB { already defined } + // GL_CURRENT_MATRIX_ARB { already defined } + // GL_TRANSPOSE_CURRENT_MATRIX_ARB { already defined } + // GL_CURRENT_MATRIX_STACK_DEPTH_ARB { already defined } + // GL_MAX_PROGRAM_MATRICES_ARB { already defined } + // GL_MAX_PROGRAM_MATRIX_STACK_DEPTH_ARB { already defined } + GL_MAX_TEXTURE_COORDS_ARB = $8871; + GL_MAX_TEXTURE_IMAGE_UNITS_ARB = $8872; + // GL_PROGRAM_ERROR_STRING_ARB { already defined } + // GL_MATRIX0_ARB { already defined } + // GL_MATRIX1_ARB { already defined } + // GL_MATRIX2_ARB { already defined } + // GL_MATRIX3_ARB { already defined } + // GL_MATRIX4_ARB { already defined } + // GL_MATRIX5_ARB { already defined } + // GL_MATRIX6_ARB { already defined } + // GL_MATRIX7_ARB { already defined } + // GL_MATRIX8_ARB { already defined } + // GL_MATRIX9_ARB { already defined } + // GL_MATRIX10_ARB { already defined } + // GL_MATRIX11_ARB { already defined } + // GL_MATRIX12_ARB { already defined } + // GL_MATRIX13_ARB { already defined } + // GL_MATRIX14_ARB { already defined } + // GL_MATRIX15_ARB { already defined } + // GL_MATRIX16_ARB { already defined } + // GL_MATRIX17_ARB { already defined } + // GL_MATRIX18_ARB { already defined } + // GL_MATRIX19_ARB { already defined } + // GL_MATRIX20_ARB { already defined } + // GL_MATRIX21_ARB { already defined } + // GL_MATRIX22_ARB { already defined } + // GL_MATRIX23_ARB { already defined } + // GL_MATRIX24_ARB { already defined } + // GL_MATRIX25_ARB { already defined } + // GL_MATRIX26_ARB { already defined } + // GL_MATRIX27_ARB { already defined } + // GL_MATRIX28_ARB { already defined } + // GL_MATRIX29_ARB { already defined } + // GL_MATRIX30_ARB { already defined } + // GL_MATRIX31_ARB { already defined } + // glProgramStringARB { already defined } + // glBindProgramARB { already defined } + // glDeleteProgramsARB { already defined } + // glGenProgramsARB { already defined } + // glProgramEnvParameter4dARB { already defined } + // glProgramEnvParameter4dvARB { already defined } + // glProgramEnvParameter4fARB { already defined } + // glProgramEnvParameter4fvARB { already defined } + // glProgramLocalParameter4dARB { already defined } + // glProgramLocalParameter4dvARB { already defined } + // glProgramLocalParameter4fARB { already defined } + // glProgramLocalParameter4fvARB { already defined } + // glGetProgramEnvParameterdvARB { already defined } + // glGetProgramEnvParameterfvARB { already defined } + // glGetProgramLocalParameterdvARB { already defined } + // glGetProgramLocalParameterfvARB { already defined } + // glGetProgramivARB { already defined } + // glGetProgramStringARB { already defined } + // glIsProgramARB { already defined } + +function Load_GL_ARB_fragment_program: Boolean; + +//***** GL_ATI_text_fragment_shader *****// +const + GL_TEXT_FRAGMENT_SHADER_ATI = $8200; + +function Load_GL_ATI_text_fragment_shader: Boolean; + +//***** GL_APPLE_client_storage *****// +const + GL_UNPACK_CLIENT_STORAGE_APPLE = $85B2; + +function Load_GL_APPLE_client_storage: Boolean; + +//***** GL_APPLE_element_array *****// +const + GL_ELEMENT_ARRAY_APPLE = $8768; + GL_ELEMENT_ARRAY_TYPE_APPLE = $8769; + GL_ELEMENT_ARRAY_POINTER_APPLE = $876A; +var + glElementPointerAPPLE: procedure(_type: GLenum; const pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDrawElementArrayAPPLE: procedure(mode: GLenum; first: GLint; count: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDrawRangeElementArrayAPPLE: procedure(mode: GLenum; start: GLuint; _end: GLuint; first: GLint; count: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiDrawElementArrayAPPLE: procedure(mode: GLenum; const first: PGLint; const count: PGLsizei; primcount: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiDrawRangeElementArrayAPPLE: procedure(mode: GLenum; start: GLuint; _end: GLuint; const first: PGLint; const count: PGLsizei; primcount: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_APPLE_element_array: Boolean; + +//***** GL_APPLE_fence *****// +const + GL_DRAW_PIXELS_APPLE = $8A0A; + GL_FENCE_APPLE = $8A0B; +var + glGenFencesAPPLE: procedure(n: GLsizei; fences: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDeleteFencesAPPLE: procedure(n: GLsizei; const fences: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSetFenceAPPLE: procedure(fence: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIsFenceAPPLE: function(fence: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTestFenceAPPLE: function(fence: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFinishFenceAPPLE: procedure(fence: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTestObjectAPPLE: function(_object: GLenum; name: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFinishObjectAPPLE: procedure(_object: GLenum; name: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_APPLE_fence: Boolean; + +//***** GL_APPLE_vertex_array_object *****// +const + GL_VERTEX_ARRAY_BINDING_APPLE = $85B5; +var + glBindVertexArrayAPPLE: procedure(_array: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDeleteVertexArraysAPPLE: procedure(n: GLsizei; const arrays: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGenVertexArraysAPPLE: procedure(n: GLsizei; const arrays: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIsVertexArrayAPPLE: function(_array: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_APPLE_vertex_array_object: Boolean; + +//***** GL_APPLE_vertex_array_range *****// +const + GL_VERTEX_ARRAY_RANGE_APPLE = $851D; + GL_VERTEX_ARRAY_RANGE_LENGTH_APPLE = $851E; + GL_MAX_VERTEX_ARRAY_RANGE_ELEMENT_APPLE = $8520; + GL_VERTEX_ARRAY_RANGE_POINTER_APPLE = $8521; + GL_VERTEX_ARRAY_STORAGE_HINT_APPLE = $851F; + GL_STORAGE_CACHED_APPLE = $85BE; + GL_STORAGE_SHARED_APPLE = $85BF; +var + glVertexArrayRangeAPPLE: procedure(length: GLsizei; pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFlushVertexArrayRangeAPPLE: procedure(length: GLsizei; pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexArrayParameteriAPPLE: procedure(pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_APPLE_vertex_array_range: Boolean; + +{$IFDEF WINDOWS} +//***** WGL_ARB_pixel_format *****// +const + WGL_NUMBER_PIXEL_FORMATS_ARB = $2000; + WGL_DRAW_TO_WINDOW_ARB = $2001; + WGL_DRAW_TO_BITMAP_ARB = $2002; + WGL_ACCELERATION_ARB = $2003; + WGL_NEED_PALETTE_ARB = $2004; + WGL_NEED_SYSTEM_PALETTE_ARB = $2005; + WGL_SWAP_LAYER_BUFFERS_ARB = $2006; + WGL_SWAP_METHOD_ARB = $2007; + WGL_NUMBER_OVERLAYS_ARB = $2008; + WGL_NUMBER_UNDERLAYS_ARB = $2009; + WGL_TRANSPARENT_ARB = $200A; + WGL_TRANSPARENT_RED_VALUE_ARB = $2037; + WGL_TRANSPARENT_GREEN_VALUE_ARB = $2038; + WGL_TRANSPARENT_BLUE_VALUE_ARB = $2039; + WGL_TRANSPARENT_ALPHA_VALUE_ARB = $203A; + WGL_TRANSPARENT_INDEX_VALUE_ARB = $203B; + WGL_SHARE_DEPTH_ARB = $200C; + WGL_SHARE_STENCIL_ARB = $200D; + WGL_SHARE_ACCUM_ARB = $200E; + WGL_SUPPORT_GDI_ARB = $200F; + WGL_SUPPORT_OPENGL_ARB = $2010; + WGL_DOUBLE_BUFFER_ARB = $2011; + WGL_STEREO_ARB = $2012; + WGL_PIXEL_TYPE_ARB = $2013; + WGL_COLOR_BITS_ARB = $2014; + WGL_RED_BITS_ARB = $2015; + WGL_RED_SHIFT_ARB = $2016; + WGL_GREEN_BITS_ARB = $2017; + WGL_GREEN_SHIFT_ARB = $2018; + WGL_BLUE_BITS_ARB = $2019; + WGL_BLUE_SHIFT_ARB = $201A; + WGL_ALPHA_BITS_ARB = $201B; + WGL_ALPHA_SHIFT_ARB = $201C; + WGL_ACCUM_BITS_ARB = $201D; + WGL_ACCUM_RED_BITS_ARB = $201E; + WGL_ACCUM_GREEN_BITS_ARB = $201F; + WGL_ACCUM_BLUE_BITS_ARB = $2020; + WGL_ACCUM_ALPHA_BITS_ARB = $2021; + WGL_DEPTH_BITS_ARB = $2022; + WGL_STENCIL_BITS_ARB = $2023; + WGL_AUX_BUFFERS_ARB = $2024; + WGL_NO_ACCELERATION_ARB = $2025; + WGL_GENERIC_ACCELERATION_ARB = $2026; + WGL_FULL_ACCELERATION_ARB = $2027; + WGL_SWAP_EXCHANGE_ARB = $2028; + WGL_SWAP_COPY_ARB = $2029; + WGL_SWAP_UNDEFINED_ARB = $202A; + WGL_TYPE_RGBA_ARB = $202B; + WGL_TYPE_COLORINDEX_ARB = $202C; +var + wglGetPixelFormatAttribivARB: function(hdc: HDC; iPixelFormat: GLint; iLayerPlane: GLint; nAttributes: GLuint; const piAttributes: PGLint; piValues: PGLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglGetPixelFormatAttribfvARB: function(hdc: HDC; iPixelFormat: GLint; iLayerPlane: GLint; nAttributes: GLuint; const piAttributes: PGLint; pfValues: PGLfloat): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglChoosePixelFormatARB: function(hdc: HDC; const piAttribIList: PGLint; const pfAttribFList: PGLfloat; nMaxFormats: GLuint; piFormats: PGLint; nNumFormats: PGLuint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_WGL_ARB_pixel_format: Boolean; + +//***** WGL_ARB_make_current_read *****// +const + WGL_ERROR_INVALID_PIXEL_TYPE_ARB = $2043; + WGL_ERROR_INCOMPATIBLE_DEVICE_CONTEXTS_ARB = $2054; +var + wglMakeContextCurrentARB: function(hDrawDC: HDC; hReadDC: HDC; hglrc: HGLRC): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglGetCurrentReadDCARB: function(): HDC; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_WGL_ARB_make_current_read: Boolean; + +//***** WGL_ARB_pbuffer *****// +const + WGL_DRAW_TO_PBUFFER_ARB = $202D; + // WGL_DRAW_TO_PBUFFER_ARB { already defined } + WGL_MAX_PBUFFER_PIXELS_ARB = $202E; + WGL_MAX_PBUFFER_WIDTH_ARB = $202F; + WGL_MAX_PBUFFER_HEIGHT_ARB = $2030; + WGL_PBUFFER_LARGEST_ARB = $2033; + WGL_PBUFFER_WIDTH_ARB = $2034; + WGL_PBUFFER_HEIGHT_ARB = $2035; + WGL_PBUFFER_LOST_ARB = $2036; +var + wglCreatePbufferARB: function(hDC: HDC; iPixelFormat: GLint; iWidth: GLint; iHeight: GLint; const piAttribList: PGLint): THandle; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglGetPbufferDCARB: function(hPbuffer: THandle): HDC; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglReleasePbufferDCARB: function(hPbuffer: THandle; hDC: HDC): GLint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglDestroyPbufferARB: function(hPbuffer: THandle): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglQueryPbufferARB: function(hPbuffer: THandle; iAttribute: GLint; piValue: PGLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_WGL_ARB_pbuffer: Boolean; + +//***** WGL_EXT_swap_control *****// +var + wglSwapIntervalEXT: function(interval: GLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglGetSwapIntervalEXT: function(): GLint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_WGL_EXT_swap_control: Boolean; + +//***** WGL_ARB_render_texture *****// +const + WGL_BIND_TO_TEXTURE_RGB_ARB = $2070; + WGL_BIND_TO_TEXTURE_RGBA_ARB = $2071; + WGL_TEXTURE_FORMAT_ARB = $2072; + WGL_TEXTURE_TARGET_ARB = $2073; + WGL_MIPMAP_TEXTURE_ARB = $2074; + WGL_TEXTURE_RGB_ARB = $2075; + WGL_TEXTURE_RGBA_ARB = $2076; + WGL_NO_TEXTURE_ARB = $2077; + WGL_TEXTURE_CUBE_MAP_ARB = $2078; + WGL_TEXTURE_1D_ARB = $2079; + WGL_TEXTURE_2D_ARB = $207A; + // WGL_NO_TEXTURE_ARB { already defined } + WGL_MIPMAP_LEVEL_ARB = $207B; + WGL_CUBE_MAP_FACE_ARB = $207C; + WGL_TEXTURE_CUBE_MAP_POSITIVE_X_ARB = $207D; + WGL_TEXTURE_CUBE_MAP_NEGATIVE_X_ARB = $207E; + WGL_TEXTURE_CUBE_MAP_POSITIVE_Y_ARB = $207F; + WGL_TEXTURE_CUBE_MAP_NEGATIVE_Y_ARB = $2080; + WGL_TEXTURE_CUBE_MAP_POSITIVE_Z_ARB = $2081; + WGL_TEXTURE_CUBE_MAP_NEGATIVE_Z_ARB = $2082; + WGL_FRONT_LEFT_ARB = $2083; + WGL_FRONT_RIGHT_ARB = $2084; + WGL_BACK_LEFT_ARB = $2085; + WGL_BACK_RIGHT_ARB = $2086; + WGL_AUX0_ARB = $2087; + WGL_AUX1_ARB = $2088; + WGL_AUX2_ARB = $2089; + WGL_AUX3_ARB = $208A; + WGL_AUX4_ARB = $208B; + WGL_AUX5_ARB = $208C; + WGL_AUX6_ARB = $208D; + WGL_AUX7_ARB = $208E; + WGL_AUX8_ARB = $208F; + WGL_AUX9_ARB = $2090; +var + wglBindTexImageARB: function(hPbuffer: THandle; iBuffer: GLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglReleaseTexImageARB: function(hPbuffer: THandle; iBuffer: GLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglSetPbufferAttribARB: function(hPbuffer: THandle; const piAttribList: PGLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_WGL_ARB_render_texture: Boolean; + +//***** WGL_EXT_extensions_string *****// +var + wglGetExtensionsStringEXT: function(): Pchar; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_WGL_EXT_extensions_string: Boolean; + +//***** WGL_EXT_make_current_read *****// +var + wglMakeContextCurrentEXT: function(hDrawDC: HDC; hReadDC: HDC; hglrc: HGLRC): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglGetCurrentReadDCEXT: function(): HDC; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_WGL_EXT_make_current_read: Boolean; + +//***** WGL_EXT_pbuffer *****// +const + WGL_DRAW_TO_PBUFFER_EXT = $202D; + WGL_MAX_PBUFFER_PIXELS_EXT = $202E; + WGL_MAX_PBUFFER_WIDTH_EXT = $202F; + WGL_MAX_PBUFFER_HEIGHT_EXT = $2030; + WGL_OPTIMAL_PBUFFER_WIDTH_EXT = $2031; + WGL_OPTIMAL_PBUFFER_HEIGHT_EXT = $2032; + WGL_PBUFFER_LARGEST_EXT = $2033; + WGL_PBUFFER_WIDTH_EXT = $2034; + WGL_PBUFFER_HEIGHT_EXT = $2035; +var + wglCreatePbufferEXT: function(hDC: HDC; iPixelFormat: GLint; iWidth: GLint; iHeight: GLint; const piAttribList: PGLint): THandle; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglGetPbufferDCEXT: function(hPbuffer: THandle): HDC; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglReleasePbufferDCEXT: function(hPbuffer: THandle; hDC: HDC): GLint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglDestroyPbufferEXT: function(hPbuffer: THandle): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglQueryPbufferEXT: function(hPbuffer: THandle; iAttribute: GLint; piValue: PGLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_WGL_EXT_pbuffer: Boolean; + +//***** WGL_EXT_pixel_format *****// +const + WGL_NUMBER_PIXEL_FORMATS_EXT = $2000; + WGL_DRAW_TO_WINDOW_EXT = $2001; + WGL_DRAW_TO_BITMAP_EXT = $2002; + WGL_ACCELERATION_EXT = $2003; + WGL_NEED_PALETTE_EXT = $2004; + WGL_NEED_SYSTEM_PALETTE_EXT = $2005; + WGL_SWAP_LAYER_BUFFERS_EXT = $2006; + WGL_SWAP_METHOD_EXT = $2007; + WGL_NUMBER_OVERLAYS_EXT = $2008; + WGL_NUMBER_UNDERLAYS_EXT = $2009; + WGL_TRANSPARENT_EXT = $200A; + WGL_TRANSPARENT_VALUE_EXT = $200B; + WGL_SHARE_DEPTH_EXT = $200C; + WGL_SHARE_STENCIL_EXT = $200D; + WGL_SHARE_ACCUM_EXT = $200E; + WGL_SUPPORT_GDI_EXT = $200F; + WGL_SUPPORT_OPENGL_EXT = $2010; + WGL_DOUBLE_BUFFER_EXT = $2011; + WGL_STEREO_EXT = $2012; + WGL_PIXEL_TYPE_EXT = $2013; + WGL_COLOR_BITS_EXT = $2014; + WGL_RED_BITS_EXT = $2015; + WGL_RED_SHIFT_EXT = $2016; + WGL_GREEN_BITS_EXT = $2017; + WGL_GREEN_SHIFT_EXT = $2018; + WGL_BLUE_BITS_EXT = $2019; + WGL_BLUE_SHIFT_EXT = $201A; + WGL_ALPHA_BITS_EXT = $201B; + WGL_ALPHA_SHIFT_EXT = $201C; + WGL_ACCUM_BITS_EXT = $201D; + WGL_ACCUM_RED_BITS_EXT = $201E; + WGL_ACCUM_GREEN_BITS_EXT = $201F; + WGL_ACCUM_BLUE_BITS_EXT = $2020; + WGL_ACCUM_ALPHA_BITS_EXT = $2021; + WGL_DEPTH_BITS_EXT = $2022; + WGL_STENCIL_BITS_EXT = $2023; + WGL_AUX_BUFFERS_EXT = $2024; + WGL_NO_ACCELERATION_EXT = $2025; + WGL_GENERIC_ACCELERATION_EXT = $2026; + WGL_FULL_ACCELERATION_EXT = $2027; + WGL_SWAP_EXCHANGE_EXT = $2028; + WGL_SWAP_COPY_EXT = $2029; + WGL_SWAP_UNDEFINED_EXT = $202A; + WGL_TYPE_RGBA_EXT = $202B; + WGL_TYPE_COLORINDEX_EXT = $202C; +var + wglGetPixelFormatAttribivEXT: function(hdc: HDC; iPixelFormat: GLint; iLayerPlane: GLint; nAttributes: GLuint; piAttributes: PGLint; piValues: PGLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglGetPixelFormatAttribfvEXT: function(hdc: HDC; iPixelFormat: GLint; iLayerPlane: GLint; nAttributes: GLuint; piAttributes: PGLint; pfValues: PGLfloat): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglChoosePixelFormatEXT: function(hdc: HDC; const piAttribIList: PGLint; const pfAttribFList: PGLfloat; nMaxFormats: GLuint; piFormats: PGLint; nNumFormats: PGLuint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_WGL_EXT_pixel_format: Boolean; + +//***** WGL_I3D_digital_video_control *****// +const + WGL_DIGITAL_VIDEO_CURSOR_ALPHA_FRAMEBUFFER_I3D = $2050; + WGL_DIGITAL_VIDEO_CURSOR_ALPHA_VALUE_I3D = $2051; + WGL_DIGITAL_VIDEO_CURSOR_INCLUDED_I3D = $2052; + WGL_DIGITAL_VIDEO_GAMMA_CORRECTED_I3D = $2053; +var + wglGetDigitalVideoParametersI3D: function(hDC: HDC; iAttribute: GLint; piValue: PGLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglSetDigitalVideoParametersI3D: function(hDC: HDC; iAttribute: GLint; const piValue: PGLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_WGL_I3D_digital_video_control: Boolean; + +//***** WGL_I3D_gamma *****// +const + WGL_GAMMA_TABLE_SIZE_I3D = $204E; + WGL_GAMMA_EXCLUDE_DESKTOP_I3D = $204F; + // WGL_GAMMA_EXCLUDE_DESKTOP_I3D { already defined } +var + wglGetGammaTableParametersI3D: function(hDC: HDC; iAttribute: GLint; piValue: PGLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglSetGammaTableParametersI3D: function(hDC: HDC; iAttribute: GLint; const piValue: PGLint): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglGetGammaTableI3D: function(hDC: HDC; iEntries: GLint; puRed: PGLUSHORT; puGreen: PGLUSHORT; puBlue: PGLUSHORT): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglSetGammaTableI3D: function(hDC: HDC; iEntries: GLint; const puRed: PGLUSHORT; const puGreen: PGLUSHORT; const puBlue: PGLUSHORT): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_WGL_I3D_gamma: Boolean; + +//***** WGL_I3D_genlock *****// +const + WGL_GENLOCK_SOURCE_MULTIVIEW_I3D = $2044; + WGL_GENLOCK_SOURCE_EXTERNAL_SYNC_I3D = $2045; + WGL_GENLOCK_SOURCE_EXTERNAL_FIELD_I3D = $2046; + WGL_GENLOCK_SOURCE_EXTERNAL_TTL_I3D = $2047; + WGL_GENLOCK_SOURCE_DIGITAL_SYNC_I3D = $2048; + WGL_GENLOCK_SOURCE_DIGITAL_FIELD_I3D = $2049; + WGL_GENLOCK_SOURCE_EDGE_FALLING_I3D = $204A; + WGL_GENLOCK_SOURCE_EDGE_RISING_I3D = $204B; + WGL_GENLOCK_SOURCE_EDGE_BOTH_I3D = $204C; +var + wglEnableGenlockI3D: function(hDC: HDC): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglDisableGenlockI3D: function(hDC: HDC): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglIsEnabledGenlockI3D: function(hDC: HDC; pFlag: PBOOL): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglGenlockSourceI3D: function(hDC: HDC; uSource: GLUINT): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglGetGenlockSourceI3D: function(hDC: HDC; uSource: PGLUINT): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglGenlockSourceEdgeI3D: function(hDC: HDC; uEdge: GLUINT): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglGetGenlockSourceEdgeI3D: function(hDC: HDC; uEdge: PGLUINT): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglGenlockSampleRateI3D: function(hDC: HDC; uRate: GLUINT): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglGetGenlockSampleRateI3D: function(hDC: HDC; uRate: PGLUINT): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglGenlockSourceDelayI3D: function(hDC: HDC; uDelay: GLUINT): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglGetGenlockSourceDelayI3D: function(hDC: HDC; uDelay: PGLUINT): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + wglQueryGenlockMaxSourceDelayI3D: function(hDC: HDC; uMaxLineDelay: PGLUINT; uMaxPixelDelay: PGLUINT): BOOL; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_WGL_I3D_genlock: Boolean; +{$ENDIF} + +//***** GL_ARB_matrix_palette *****// +const + GL_MATRIX_PALETTE_ARB = $8840; + GL_MAX_MATRIX_PALETTE_STACK_DEPTH_ARB = $8841; + GL_MAX_PALETTE_MATRICES_ARB = $8842; + GL_CURRENT_PALETTE_MATRIX_ARB = $8843; + GL_MATRIX_INDEX_ARRAY_ARB = $8844; + GL_CURRENT_MATRIX_INDEX_ARB = $8845; + GL_MATRIX_INDEX_ARRAY_SIZE_ARB = $8846; + GL_MATRIX_INDEX_ARRAY_TYPE_ARB = $8847; + GL_MATRIX_INDEX_ARRAY_STRIDE_ARB = $8848; + GL_MATRIX_INDEX_ARRAY_POINTER_ARB = $8849; +var + glCurrentPaletteMatrixARB: procedure(index: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMatrixIndexubvARB: procedure(size: GLint; indices: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMatrixIndexusvARB: procedure(size: GLint; indices: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMatrixIndexuivARB: procedure(size: GLint; indices: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMatrixIndexPointerARB: procedure(size: GLint; _type: GLenum; stride: GLsizei; pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_ARB_matrix_palette: Boolean; + +//***** GL_NV_element_array *****// +const + GL_ELEMENT_ARRAY_TYPE_NV = $8769; + GL_ELEMENT_ARRAY_POINTER_NV = $876A; +var + glElementPointerNV: procedure(_type: GLenum; const pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDrawElementArrayNV: procedure(mode: GLenum; first: GLint; count: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDrawRangeElementArrayNV: procedure(mode: GLenum; start: GLuint; _end: GLuint; first: GLint; count: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiDrawElementArrayNV: procedure(mode: GLenum; const first: PGLint; const count: PGLsizei; primcount: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiDrawRangeElementArrayNV: procedure(mode: GLenum; start: GLuint; _end: GLuint; const first: PGLint; const count: PGLsizei; primcount: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_NV_element_array: Boolean; + +//***** GL_NV_float_buffer *****// +const + GL_FLOAT_R_NV = $8880; + GL_FLOAT_RG_NV = $8881; + GL_FLOAT_RGB_NV = $8882; + GL_FLOAT_RGBA_NV = $8883; + GL_FLOAT_R16_NV = $8884; + GL_FLOAT_R32_NV = $8885; + GL_FLOAT_RG16_NV = $8886; + GL_FLOAT_RG32_NV = $8887; + GL_FLOAT_RGB16_NV = $8888; + GL_FLOAT_RGB32_NV = $8889; + GL_FLOAT_RGBA16_NV = $888A; + GL_FLOAT_RGBA32_NV = $888B; + GL_TEXTURE_FLOAT_COMPONENTS_NV = $888C; + GL_FLOAT_CLEAR_COLOR_VALUE_NV = $888D; + GL_FLOAT_RGBA_MODE_NV = $888E; +{$IFDEF WINDOWS} + WGL_FLOAT_COMPONENTS_NV = $20B0; + WGL_BIND_TO_TEXTURE_RECTANGLE_FLOAT_R_NV = $20B1; + WGL_BIND_TO_TEXTURE_RECTANGLE_FLOAT_RG_NV = $20B2; + WGL_BIND_TO_TEXTURE_RECTANGLE_FLOAT_RGB_NV = $20B3; + WGL_BIND_TO_TEXTURE_RECTANGLE_FLOAT_RGBA_NV = $20B4; + WGL_TEXTURE_FLOAT_R_NV = $20B5; + WGL_TEXTURE_FLOAT_RG_NV = $20B6; + WGL_TEXTURE_FLOAT_RGB_NV = $20B7; + WGL_TEXTURE_FLOAT_RGBA_NV = $20B8; +{$ENDIF} + +function Load_GL_NV_float_buffer: Boolean; + +//***** GL_NV_fragment_program *****// +const + GL_FRAGMENT_PROGRAM_NV = $8870; + GL_MAX_TEXTURE_COORDS_NV = $8871; + GL_MAX_TEXTURE_IMAGE_UNITS_NV = $8872; + GL_FRAGMENT_PROGRAM_BINDING_NV = $8873; + GL_MAX_FRAGMENT_PROGRAM_LOCAL_PARAMETERS_NV = $8868; + GL_PROGRAM_ERROR_STRING_NV = $8874; +var + glProgramNamedParameter4fNV: procedure(id: GLuint; len: GLsizei; const name: PGLubyte; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glProgramNamedParameter4dNV: procedure(id: GLuint; len: GLsizei; const name: PGLubyte; x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetProgramNamedParameterfvNV: procedure(id: GLuint; len: GLsizei; const name: PGLubyte; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetProgramNamedParameterdvNV: procedure(id: GLuint; len: GLsizei; const name: PGLubyte; params: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + // glProgramLocalParameter4dARB { already defined } + // glProgramLocalParameter4dvARB { already defined } + // glProgramLocalParameter4fARB { already defined } + // glProgramLocalParameter4fvARB { already defined } + // glGetProgramLocalParameterdvARB { already defined } + // glGetProgramLocalParameterfvARB { already defined } + +function Load_GL_NV_fragment_program: Boolean; + +//***** GL_NV_primitive_restart *****// +const + GL_PRIMITIVE_RESTART_NV = $8558; + GL_PRIMITIVE_RESTART_INDEX_NV = $8559; +var + glPrimitiveRestartNV: procedure(); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPrimitiveRestartIndexNV: procedure(index: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_NV_primitive_restart: Boolean; + +//***** GL_NV_vertex_program2 *****// + +function Load_GL_NV_vertex_program2: Boolean; + +{$IFDEF WINDOWS} +//***** WGL_NV_render_texture_rectangle *****// +const + WGL_BIND_TO_TEXTURE_RECTANGLE_RGB_NV = $20A0; + WGL_BIND_TO_TEXTURE_RECTANGLE_RGBA_NV = $20A1; + WGL_TEXTURE_RECTANGLE_NV = $20A2; + +function Load_WGL_NV_render_texture_rectangle: Boolean; +{$ENDIF} + +//***** GL_NV_pixel_data_range *****// +const + GL_WRITE_PIXEL_DATA_RANGE_NV = $8878; + GL_READ_PIXEL_DATA_RANGE_NV = $8879; + GL_WRITE_PIXEL_DATA_RANGE_LENGTH_NV = $887A; + GL_READ_PIXEL_DATA_RANGE_LENGTH_NV = $887B; + GL_WRITE_PIXEL_DATA_RANGE_POINTER_NV = $887C; + GL_READ_PIXEL_DATA_RANGE_POINTER_NV = $887D; +var + glPixelDataRangeNV: procedure(target: GLenum; length: GLsizei; pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFlushPixelDataRangeNV: procedure(target: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + // wglAllocateMemoryNV { already defined } + // wglFreeMemoryNV { already defined } + +function Load_GL_NV_pixel_data_range: Boolean; + +//***** GL_EXT_texture_rectangle *****// +const + GL_TEXTURE_RECTANGLE_EXT = $84F5; + GL_TEXTURE_BINDING_RECTANGLE_EXT = $84F6; + GL_PROXY_TEXTURE_RECTANGLE_EXT = $84F7; + GL_MAX_RECTANGLE_TEXTURE_SIZE_EXT = $84F8; + +function Load_GL_EXT_texture_rectangle: Boolean; + +//***** GL_S3_s3tc *****// +const + GL_RGB_S3TC = $83A0; + GL_RGB4_S3TC = $83A1; + GL_RGBA_S3TC = $83A2; + GL_RGBA4_S3TC = $83A3; + +function Load_GL_S3_s3tc: Boolean; + +//***** GL_ATI_draw_buffers *****// +const + GL_MAX_DRAW_BUFFERS_ATI = $8824; + GL_DRAW_BUFFER0_ATI = $8825; + GL_DRAW_BUFFER1_ATI = $8826; + GL_DRAW_BUFFER2_ATI = $8827; + GL_DRAW_BUFFER3_ATI = $8828; + GL_DRAW_BUFFER4_ATI = $8829; + GL_DRAW_BUFFER5_ATI = $882A; + GL_DRAW_BUFFER6_ATI = $882B; + GL_DRAW_BUFFER7_ATI = $882C; + GL_DRAW_BUFFER8_ATI = $882D; + GL_DRAW_BUFFER9_ATI = $882E; + GL_DRAW_BUFFER10_ATI = $882F; + GL_DRAW_BUFFER11_ATI = $8830; + GL_DRAW_BUFFER12_ATI = $8831; + GL_DRAW_BUFFER13_ATI = $8832; + GL_DRAW_BUFFER14_ATI = $8833; + GL_DRAW_BUFFER15_ATI = $8834; +var + glDrawBuffersATI: procedure(n: GLsizei; const bufs: PGLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_ATI_draw_buffers: Boolean; + +{$IFDEF WINDOWS} +//***** WGL_ATI_pixel_format_float *****// +const + WGL_RGBA_FLOAT_MODE_ATI = $8820; + WGL_COLOR_CLEAR_UNCLAMPED_VALUE_ATI = $8835; + WGL_TYPE_RGBA_FLOAT_ATI = $21A0; + +function Load_WGL_ATI_pixel_format_float: Boolean; +{$ENDIF} + +//***** GL_ATI_texture_env_combine3 *****// +const + GL_MODULATE_ADD_ATI = $8744; + GL_MODULATE_SIGNED_ADD_ATI = $8745; + GL_MODULATE_SUBTRACT_ATI = $8746; + +function Load_GL_ATI_texture_env_combine3: Boolean; + +//***** GL_ATI_texture_float *****// +const + GL_RGBA_FLOAT32_ATI = $8814; + GL_RGB_FLOAT32_ATI = $8815; + GL_ALPHA_FLOAT32_ATI = $8816; + GL_INTENSITY_FLOAT32_ATI = $8817; + GL_LUMINANCE_FLOAT32_ATI = $8818; + GL_LUMINANCE_ALPHA_FLOAT32_ATI = $8819; + GL_RGBA_FLOAT16_ATI = $881A; + GL_RGB_FLOAT16_ATI = $881B; + GL_ALPHA_FLOAT16_ATI = $881C; + GL_INTENSITY_FLOAT16_ATI = $881D; + GL_LUMINANCE_FLOAT16_ATI = $881E; + GL_LUMINANCE_ALPHA_FLOAT16_ATI = $881F; + +function Load_GL_ATI_texture_float: Boolean; + +//***** GL_NV_texture_expand_normal *****// +const + GL_TEXTURE_UNSIGNED_REMAP_MODE_NV = $888F; + +function Load_GL_NV_texture_expand_normal: Boolean; + +//***** GL_NV_half_float *****// +const + GL_HALF_FLOAT_NV = $140B; +var + glVertex2hNV: procedure(x: GLushort; y: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex2hvNV: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex3hNV: procedure(x: GLushort; y: GLushort; z: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex3hvNV: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex4hNV: procedure(x: GLushort; y: GLushort; z: GLushort; w: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertex4hvNV: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNormal3hNV: procedure(nx: GLushort; ny: GLushort; nz: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glNormal3hvNV: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor3hNV: procedure(red: GLushort; green: GLushort; blue: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor3hvNV: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor4hNV: procedure(red: GLushort; green: GLushort; blue: GLushort; alpha: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glColor4hvNV: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord1hNV: procedure(s: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord1hvNV: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord2hNV: procedure(s: GLushort; t: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord2hvNV: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord3hNV: procedure(s: GLushort; t: GLushort; r: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord3hvNV: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord4hNV: procedure(s: GLushort; t: GLushort; r: GLushort; q: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glTexCoord4hvNV: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord1hNV: procedure(target: GLenum; s: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord1hvNV: procedure(target: GLenum; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord2hNV: procedure(target: GLenum; s: GLushort; t: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord2hvNV: procedure(target: GLenum; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord3hNV: procedure(target: GLenum; s: GLushort; t: GLushort; r: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord3hvNV: procedure(target: GLenum; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord4hNV: procedure(target: GLenum; s: GLushort; t: GLushort; r: GLushort; q: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiTexCoord4hvNV: procedure(target: GLenum; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFogCoordhNV: procedure(fog: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFogCoordhvNV: procedure(const fog: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3hNV: procedure(red: GLushort; green: GLushort; blue: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3hvNV: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexWeighthNV: procedure(weight: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexWeighthvNV: procedure(const weight: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib1hNV: procedure(index: GLuint; x: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib1hvNV: procedure(index: GLuint; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib2hNV: procedure(index: GLuint; x: GLushort; y: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib2hvNV: procedure(index: GLuint; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib3hNV: procedure(index: GLuint; x: GLushort; y: GLushort; z: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib3hvNV: procedure(index: GLuint; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4hNV: procedure(index: GLuint; x: GLushort; y: GLushort; z: GLushort; w: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4hvNV: procedure(index: GLuint; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttribs1hvNV: procedure(index: GLuint; n: GLsizei; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttribs2hvNV: procedure(index: GLuint; n: GLsizei; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttribs3hvNV: procedure(index: GLuint; n: GLsizei; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttribs4hvNV: procedure(index: GLuint; n: GLsizei; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_NV_half_float: Boolean; + +//***** GL_ATI_map_object_buffer *****// +var + glMapObjectBufferATI: function(buffer: GLuint): PGLvoid; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUnmapObjectBufferATI: procedure(buffer: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_ATI_map_object_buffer: Boolean; + +//***** GL_ATI_separate_stencil *****// +const + GL_KEEP = $1E00; + GL_ZERO = $0000; + GL_REPLACE = $1E01; + GL_INCR = $1E02; + GL_DECR = $1E03; + GL_INVERT = $150A; + GL_NEVER = $0200; + GL_LESS = $0201; + GL_LEQUAL = $0203; + GL_GREATER = $0204; + GL_GEQUAL = $0206; + GL_EQUAL = $0202; + GL_NOTEQUAL = $0205; + GL_ALWAYS = $0207; + GL_FRONT = $0404; + GL_BACK = $0405; + GL_FRONT_AND_BACK = $0408; + GL_STENCIL_BACK_FUNC_ATI = $8800; + GL_STENCIL_BACK_FAIL_ATI = $8801; + GL_STENCIL_BACK_PASS_DEPTH_FAIL_ATI = $8802; + GL_STENCIL_BACK_PASS_DEPTH_PASS_ATI = $8803; +var + glStencilOpSeparateATI: procedure(face: GLenum; sfail: GLenum; dpfail: GLenum; dppass: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glStencilFuncSeparateATI: procedure(frontfunc: GLenum; backfunc: GLenum; ref: GLint; mask: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_ATI_separate_stencil: Boolean; + +//***** GL_ATI_vertex_attrib_array_object *****// +var + glVertexAttribArrayObjectATI: procedure(index: GLuint; size: GLint; _type: GLenum; normalized: GLboolean; stride: GLsizei; buffer: GLuint; offset: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetVertexAttribArrayObjectfvATI: procedure(index: GLuint; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetVertexAttribArrayObjectivATI: procedure(index: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_ATI_vertex_attrib_array_object: Boolean; + +//***** GL_ARB_vertex_buffer_object *****// +const + GL_ARRAY_BUFFER_ARB = $8892; + GL_ELEMENT_ARRAY_BUFFER_ARB = $8893; + GL_ARRAY_BUFFER_BINDING_ARB = $8894; + GL_ELEMENT_ARRAY_BUFFER_BINDING_ARB = $8895; + GL_VERTEX_ARRAY_BUFFER_BINDING_ARB = $8896; + GL_NORMAL_ARRAY_BUFFER_BINDING_ARB = $8897; + GL_COLOR_ARRAY_BUFFER_BINDING_ARB = $8898; + GL_INDEX_ARRAY_BUFFER_BINDING_ARB = $8899; + GL_TEXTURE_COORD_ARRAY_BUFFER_BINDING_ARB = $889A; + GL_EDGE_FLAG_ARRAY_BUFFER_BINDING_ARB = $889B; + GL_SECONDARY_COLOR_ARRAY_BUFFER_BINDING_ARB = $889C; + GL_FOG_COORDINATE_ARRAY_BUFFER_BINDING_ARB = $889D; + GL_WEIGHT_ARRAY_BUFFER_BINDING_ARB = $889E; + GL_VERTEX_ATTRIB_ARRAY_BUFFER_BINDING_ARB = $889F; + GL_STREAM_DRAW_ARB = $88E0; + GL_STREAM_READ_ARB = $88E1; + GL_STREAM_COPY_ARB = $88E2; + GL_STATIC_DRAW_ARB = $88E4; + GL_STATIC_READ_ARB = $88E5; + GL_STATIC_COPY_ARB = $88E6; + GL_DYNAMIC_DRAW_ARB = $88E8; + GL_DYNAMIC_READ_ARB = $88E9; + GL_DYNAMIC_COPY_ARB = $88EA; + GL_READ_ONLY_ARB = $88B8; + GL_WRITE_ONLY_ARB = $88B9; + GL_READ_WRITE_ARB = $88BA; + GL_BUFFER_SIZE_ARB = $8764; + GL_BUFFER_USAGE_ARB = $8765; + GL_BUFFER_ACCESS_ARB = $88BB; + GL_BUFFER_MAPPED_ARB = $88BC; + GL_BUFFER_MAP_POINTER_ARB = $88BD; +var + glBindBufferARB: procedure(target: GLenum; buffer: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDeleteBuffersARB: procedure(n: GLsizei; const buffers: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGenBuffersARB: procedure(n: GLsizei; buffers: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIsBufferARB: function(buffer: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glBufferDataARB: procedure(target: GLenum; size: GLsizeiptrARB; const data: PGLvoid; usage: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glBufferSubDataARB: procedure(target: GLenum; offset: GLintptrARB; size: GLsizeiptrARB; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetBufferSubDataARB: procedure(target: GLenum; offset: GLintptrARB; size: GLsizeiptrARB; data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMapBufferARB: function(target: GLenum; access: GLenum): PGLvoid; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUnmapBufferARB: function(target: GLenum): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetBufferParameterivARB: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetBufferPointervARB: procedure(target: GLenum; pname: GLenum; params: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_ARB_vertex_buffer_object: Boolean; + +//***** GL_ARB_occlusion_query *****// +const + GL_SAMPLES_PASSED_ARB = $8914; + GL_QUERY_COUNTER_BITS_ARB = $8864; + GL_CURRENT_QUERY_ARB = $8865; + GL_QUERY_RESULT_ARB = $8866; + GL_QUERY_RESULT_AVAILABLE_ARB = $8867; +var + glGenQueriesARB: procedure(n: GLsizei; ids: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDeleteQueriesARB: procedure(n: GLsizei; const ids: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIsQueryARB: function(id: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glBeginQueryARB: procedure(target: GLenum; id: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEndQueryARB: procedure(target: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetQueryivARB: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetQueryObjectivARB: procedure(id: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetQueryObjectuivARB: procedure(id: GLuint; pname: GLenum; params: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_ARB_occlusion_query: Boolean; + +//***** GL_ARB_shader_objects *****// +const + GL_PROGRAM_OBJECT_ARB = $8B40; + GL_OBJECT_TYPE_ARB = $8B4E; + GL_OBJECT_SUBTYPE_ARB = $8B4F; + GL_OBJECT_DELETE_STATUS_ARB = $8B80; + GL_OBJECT_COMPILE_STATUS_ARB = $8B81; + GL_OBJECT_LINK_STATUS_ARB = $8B82; + GL_OBJECT_VALIDATE_STATUS_ARB = $8B83; + GL_OBJECT_INFO_LOG_LENGTH_ARB = $8B84; + GL_OBJECT_ATTACHED_OBJECTS_ARB = $8B85; + GL_OBJECT_ACTIVE_UNIFORMS_ARB = $8B86; + GL_OBJECT_ACTIVE_UNIFORM_MAX_LENGTH_ARB = $8B87; + GL_OBJECT_SHADER_SOURCE_LENGTH_ARB = $8B88; + GL_SHADER_OBJECT_ARB = $8B48; + GL_FLOAT = $1406; + GL_FLOAT_VEC2_ARB = $8B50; + GL_FLOAT_VEC3_ARB = $8B51; + GL_FLOAT_VEC4_ARB = $8B52; + GL_INT = $1404; + GL_INT_VEC2_ARB = $8B53; + GL_INT_VEC3_ARB = $8B54; + GL_INT_VEC4_ARB = $8B55; + GL_BOOL_ARB = $8B56; + GL_BOOL_VEC2_ARB = $8B57; + GL_BOOL_VEC3_ARB = $8B58; + GL_BOOL_VEC4_ARB = $8B59; + GL_FLOAT_MAT2_ARB = $8B5A; + GL_FLOAT_MAT3_ARB = $8B5B; + GL_FLOAT_MAT4_ARB = $8B5C; +var + glDeleteObjectARB: procedure(obj: GLhandleARB); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetHandleARB: function(pname: GLenum): GLhandleARB; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDetachObjectARB: procedure(containerObj: GLhandleARB; attachedObj: GLhandleARB); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCreateShaderObjectARB: function(shaderType: GLenum): GLhandleARB; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glShaderSourceARB: procedure(shaderObj: GLhandleARB; count: GLsizei; const _string: PGLvoid; const length: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCompileShaderARB: procedure(shaderObj: GLhandleARB); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCreateProgramObjectARB: function(): GLhandleARB; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glAttachObjectARB: procedure(containerObj: GLhandleARB; obj: GLhandleARB); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glLinkProgramARB: procedure(programObj: GLhandleARB); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUseProgramObjectARB: procedure(programObj: GLhandleARB); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glValidateProgramARB: procedure(programObj: GLhandleARB); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform1fARB: procedure(location: GLint; v0: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform2fARB: procedure(location: GLint; v0: GLfloat; v1: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform3fARB: procedure(location: GLint; v0: GLfloat; v1: GLfloat; v2: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform4fARB: procedure(location: GLint; v0: GLfloat; v1: GLfloat; v2: GLfloat; v3: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform1iARB: procedure(location: GLint; v0: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform2iARB: procedure(location: GLint; v0: GLint; v1: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform3iARB: procedure(location: GLint; v0: GLint; v1: GLint; v2: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform4iARB: procedure(location: GLint; v0: GLint; v1: GLint; v2: GLint; v3: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform1fvARB: procedure(location: GLint; count: GLsizei; value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform2fvARB: procedure(location: GLint; count: GLsizei; value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform3fvARB: procedure(location: GLint; count: GLsizei; value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform4fvARB: procedure(location: GLint; count: GLsizei; value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform1ivARB: procedure(location: GLint; count: GLsizei; value: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform2ivARB: procedure(location: GLint; count: GLsizei; value: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform3ivARB: procedure(location: GLint; count: GLsizei; value: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform4ivARB: procedure(location: GLint; count: GLsizei; value: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniformMatrix2fvARB: procedure(location: GLint; count: GLsizei; transpose: GLboolean; value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniformMatrix3fvARB: procedure(location: GLint; count: GLsizei; transpose: GLboolean; value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniformMatrix4fvARB: procedure(location: GLint; count: GLsizei; transpose: GLboolean; value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetObjectParameterfvARB: procedure(obj: GLhandleARB; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetObjectParameterivARB: procedure(obj: GLhandleARB; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetInfoLogARB: procedure(obj: GLhandleARB; maxLength: GLsizei; length: PGLsizei; infoLog: PGLcharARB); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetAttachedObjectsARB: procedure(containerObj: GLhandleARB; maxCount: GLsizei; count: PGLsizei; obj: PGLhandleARB); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetUniformLocationARB: function(programObj: GLhandleARB; const name: PGLcharARB): GLint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetActiveUniformARB: procedure(programObj: GLhandleARB; index: GLuint; maxLength: GLsizei; length: PGLsizei; size: PGLint; _type: PGLenum; name: PGLcharARB); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetUniformfvARB: procedure(programObj: GLhandleARB; location: GLint; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetUniformivARB: procedure(programObj: GLhandleARB; location: GLint; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetShaderSourceARB: procedure(obj: GLhandleARB; maxLength: GLsizei; length: PGLsizei; source: PGLcharARB); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_ARB_shader_objects: Boolean; + +//***** GL_ARB_vertex_shader *****// +const + GL_VERTEX_SHADER_ARB = $8B31; + GL_MAX_VERTEX_UNIFORM_COMPONENTS_ARB = $8B4A; + GL_MAX_VARYING_FLOATS_ARB = $8B4B; + // GL_MAX_VERTEX_ATTRIBS_ARB { already defined } + // GL_MAX_TEXTURE_IMAGE_UNITS_ARB { already defined } + GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS_ARB = $8B4C; + GL_MAX_COMBINED_TEXTURE_IMAGE_UNITS_ARB = $8B4D; + // GL_MAX_TEXTURE_COORDS_ARB { already defined } + // GL_VERTEX_PROGRAM_POINT_SIZE_ARB { already defined } + // GL_VERTEX_PROGRAM_TWO_SIDE_ARB { already defined } + // GL_OBJECT_TYPE_ARB { already defined } + // GL_OBJECT_SUBTYPE_ARB { already defined } + GL_OBJECT_ACTIVE_ATTRIBUTES_ARB = $8B89; + GL_OBJECT_ACTIVE_ATTRIBUTE_MAX_LENGTH_ARB = $8B8A; + // GL_SHADER_OBJECT_ARB { already defined } + // GL_VERTEX_ATTRIB_ARRAY_ENABLED_ARB { already defined } + // GL_VERTEX_ATTRIB_ARRAY_SIZE_ARB { already defined } + // GL_VERTEX_ATTRIB_ARRAY_STRIDE_ARB { already defined } + // GL_VERTEX_ATTRIB_ARRAY_TYPE_ARB { already defined } + // GL_VERTEX_ATTRIB_ARRAY_NORMALIZED_ARB { already defined } + // GL_CURRENT_VERTEX_ATTRIB_ARB { already defined } + // GL_VERTEX_ATTRIB_ARRAY_POINTER_ARB { already defined } + // GL_FLOAT { already defined } + // GL_FLOAT_VEC2_ARB { already defined } + // GL_FLOAT_VEC3_ARB { already defined } + // GL_FLOAT_VEC4_ARB { already defined } + // GL_FLOAT_MAT2_ARB { already defined } + // GL_FLOAT_MAT3_ARB { already defined } + // GL_FLOAT_MAT4_ARB { already defined } + // glVertexAttrib1fARB { already defined } + // glVertexAttrib1sARB { already defined } + // glVertexAttrib1dARB { already defined } + // glVertexAttrib2fARB { already defined } + // glVertexAttrib2sARB { already defined } + // glVertexAttrib2dARB { already defined } + // glVertexAttrib3fARB { already defined } + // glVertexAttrib3sARB { already defined } + // glVertexAttrib3dARB { already defined } + // glVertexAttrib4fARB { already defined } + // glVertexAttrib4sARB { already defined } + // glVertexAttrib4dARB { already defined } + // glVertexAttrib4NubARB { already defined } + // glVertexAttrib1fvARB { already defined } + // glVertexAttrib1svARB { already defined } + // glVertexAttrib1dvARB { already defined } + // glVertexAttrib2fvARB { already defined } + // glVertexAttrib2svARB { already defined } + // glVertexAttrib2dvARB { already defined } + // glVertexAttrib3fvARB { already defined } + // glVertexAttrib3svARB { already defined } + // glVertexAttrib3dvARB { already defined } + // glVertexAttrib4fvARB { already defined } + // glVertexAttrib4svARB { already defined } + // glVertexAttrib4dvARB { already defined } + // glVertexAttrib4ivARB { already defined } + // glVertexAttrib4bvARB { already defined } + // glVertexAttrib4ubvARB { already defined } + // glVertexAttrib4usvARB { already defined } + // glVertexAttrib4uivARB { already defined } + // glVertexAttrib4NbvARB { already defined } + // glVertexAttrib4NsvARB { already defined } + // glVertexAttrib4NivARB { already defined } + // glVertexAttrib4NubvARB { already defined } + // glVertexAttrib4NusvARB { already defined } + // glVertexAttrib4NuivARB { already defined } + // glVertexAttribPointerARB { already defined } + // glEnableVertexAttribArrayARB { already defined } + // glDisableVertexAttribArrayARB { already defined } +var + glBindAttribLocationARB: procedure(programObj: GLhandleARB; index: GLuint; const name: PGLcharARB); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetActiveAttribARB: procedure(programObj: GLhandleARB; index: GLuint; maxLength: GLsizei; length: PGLsizei; size: PGLint; _type: PGLenum; name: PGLcharARB); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetAttribLocationARB: function(programObj: GLhandleARB; const name: PGLcharARB): GLint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + // glGetVertexAttribdvARB { already defined } + // glGetVertexAttribfvARB { already defined } + // glGetVertexAttribivARB { already defined } + // glGetVertexAttribPointervARB { already defined } + +function Load_GL_ARB_vertex_shader: Boolean; + +//***** GL_ARB_fragment_shader *****// +const + GL_FRAGMENT_SHADER_ARB = $8B30; + GL_MAX_FRAGMENT_UNIFORM_COMPONENTS_ARB = $8B49; + // GL_MAX_TEXTURE_COORDS_ARB { already defined } + // GL_MAX_TEXTURE_IMAGE_UNITS_ARB { already defined } + // GL_OBJECT_TYPE_ARB { already defined } + // GL_OBJECT_SUBTYPE_ARB { already defined } + // GL_SHADER_OBJECT_ARB { already defined } + +function Load_GL_ARB_fragment_shader: Boolean; + +//***** GL_ARB_shading_language_100 *****// + +function Load_GL_ARB_shading_language_100: Boolean; + +//***** GL_ARB_texture_non_power_of_two *****// + +function Load_GL_ARB_texture_non_power_of_two: Boolean; + +//***** GL_ARB_point_sprite *****// +const + GL_POINT_SPRITE_ARB = $8861; + GL_COORD_REPLACE_ARB = $8862; + +function Load_GL_ARB_point_sprite: Boolean; + +//***** GL_EXT_depth_bounds_test *****// +const + GL_DEPTH_BOUNDS_TEST_EXT = $8890; + GL_DEPTH_BOUNDS_EXT = $8891; +var + glDepthBoundsEXT: procedure(zmin: GLclampd; zmax: GLclampd); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_EXT_depth_bounds_test: Boolean; + +//***** GL_EXT_secondary_color *****// +const + GL_COLOR_SUM_EXT = $8458; + GL_CURRENT_SECONDARY_COLOR_EXT = $8459; + GL_SECONDARY_COLOR_ARRAY_SIZE_EXT = $845A; + GL_SECONDARY_COLOR_ARRAY_TYPE_EXT = $845B; + GL_SECONDARY_COLOR_ARRAY_STRIDE_EXT = $845C; + GL_SECONDARY_COLOR_ARRAY_POINTER_EXT = $845D; + GL_SECONDARY_COLOR_ARRAY_EXT = $845E; +var + glSecondaryColor3bEXT: procedure(r: GLbyte; g: GLbyte; b: GLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3sEXT: procedure(r: GLshort; g: GLshort; b: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3iEXT: procedure(r: GLint; g: GLint; b: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3fEXT: procedure(r: GLfloat; g: GLfloat; b: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3dEXT: procedure(r: GLdouble; g: GLdouble; b: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3ubEXT: procedure(r: GLubyte; g: GLubyte; b: GLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3usEXT: procedure(r: GLushort; g: GLushort; b: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3uiEXT: procedure(r: GLuint; g: GLuint; b: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3bvEXT: procedure(components: PGLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3svEXT: procedure(components: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3ivEXT: procedure(components: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3fvEXT: procedure(components: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3dvEXT: procedure(components: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3ubvEXT: procedure(components: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3usvEXT: procedure(components: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3uivEXT: procedure(components: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColorPointerEXT: procedure(size: GLint; _type: GLenum; stride: GLsizei; pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_EXT_secondary_color: Boolean; + +//***** GL_EXT_texture_mirror_clamp *****// +const + GL_MIRROR_CLAMP_EXT = $8742; + GL_MIRROR_CLAMP_TO_EDGE_EXT = $8743; + GL_MIRROR_CLAMP_TO_BORDER_EXT = $8912; + +function Load_GL_EXT_texture_mirror_clamp: Boolean; + +//***** GL_EXT_blend_equation_separate *****// +const + GL_BLEND_EQUATION_RGB_EXT = $8009; + GL_BLEND_EQUATION_ALPHA_EXT = $883D; +var + glBlendEquationSeparateEXT: procedure(modeRGB: GLenum; modeAlpha: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_EXT_blend_equation_separate: Boolean; + +//***** GL_MESA_pack_invert *****// +const + GL_PACK_INVERT_MESA = $8758; + +function Load_GL_MESA_pack_invert: Boolean; + +//***** GL_MESA_ycbcr_texture *****// +const + GL_YCBCR_MESA = $8757; + GL_UNSIGNED_SHORT_8_8_MESA = $85BA; + GL_UNSIGNED_SHORT_8_8_REV_MESA = $85BB; + +function Load_GL_MESA_ycbcr_texture: Boolean; + +//***** GL_ARB_fragment_program_shadow *****// + +function Load_GL_ARB_fragment_program_shadow: Boolean; + +//***** GL_EXT_fog_coord *****// +const + GL_FOG_COORDINATE_SOURCE_EXT = $8450; + GL_FOG_COORDINATE_EXT = $8451; + GL_FRAGMENT_DEPTH_EXT = $8452; + GL_CURRENT_FOG_COORDINATE_EXT = $8453; + GL_FOG_COORDINATE_ARRAY_TYPE_EXT = $8454; + GL_FOG_COORDINATE_ARRAY_STRIDE_EXT = $8455; + GL_FOG_COORDINATE_ARRAY_POINTER_EXT = $8456; + GL_FOG_COORDINATE_ARRAY_EXT = $8457; +var + glFogCoordfEXT: procedure(coord: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFogCoorddEXT: procedure(coord: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFogCoordfvEXT: procedure(coord: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFogCoorddvEXT: procedure(coord: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFogCoordPointerEXT: procedure(_type: GLenum; stride: GLsizei; pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_EXT_fog_coord: Boolean; + +//***** GL_NV_fragment_program_option *****// + +function Load_GL_NV_fragment_program_option: Boolean; + +//***** GL_EXT_pixel_buffer_object *****// +const + GL_PIXEL_PACK_BUFFER_EXT = $88EB; + GL_PIXEL_UNPACK_BUFFER_EXT = $88EC; + GL_PIXEL_PACK_BUFFER_BINDING_EXT = $88ED; + GL_PIXEL_UNPACK_BUFFER_BINDING_EXT = $88EF; + +function Load_GL_EXT_pixel_buffer_object: Boolean; + +//***** GL_NV_fragment_program2 *****// +const + GL_MAX_PROGRAM_EXEC_INSTRUCTIONS_NV = $88F4; + GL_MAX_PROGRAM_CALL_DEPTH_NV = $88F5; + GL_MAX_PROGRAM_IF_DEPTH_NV = $88F6; + GL_MAX_PROGRAM_LOOP_DEPTH_NV = $88F7; + GL_MAX_PROGRAM_LOOP_COUNT_NV = $88F8; + +function Load_GL_NV_fragment_program2: Boolean; + +//***** GL_NV_vertex_program2_option *****// + // GL_MAX_PROGRAM_EXEC_INSTRUCTIONS_NV { already defined } + // GL_MAX_PROGRAM_CALL_DEPTH_NV { already defined } + +function Load_GL_NV_vertex_program2_option: Boolean; + +//***** GL_NV_vertex_program3 *****// + // GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS_ARB { already defined } + +function Load_GL_NV_vertex_program3: Boolean; + +//***** GL_ARB_draw_buffers *****// +const + GL_MAX_DRAW_BUFFERS_ARB = $8824; + GL_DRAW_BUFFER0_ARB = $8825; + GL_DRAW_BUFFER1_ARB = $8826; + GL_DRAW_BUFFER2_ARB = $8827; + GL_DRAW_BUFFER3_ARB = $8828; + GL_DRAW_BUFFER4_ARB = $8829; + GL_DRAW_BUFFER5_ARB = $882A; + GL_DRAW_BUFFER6_ARB = $882B; + GL_DRAW_BUFFER7_ARB = $882C; + GL_DRAW_BUFFER8_ARB = $882D; + GL_DRAW_BUFFER9_ARB = $882E; + GL_DRAW_BUFFER10_ARB = $882F; + GL_DRAW_BUFFER11_ARB = $8830; + GL_DRAW_BUFFER12_ARB = $8831; + GL_DRAW_BUFFER13_ARB = $8832; + GL_DRAW_BUFFER14_ARB = $8833; + GL_DRAW_BUFFER15_ARB = $8834; +var + glDrawBuffersARB: procedure(n: GLsizei; const bufs: PGLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_ARB_draw_buffers: Boolean; + +//***** GL_ARB_texture_rectangle *****// +const + GL_TEXTURE_RECTANGLE_ARB = $84F5; + GL_TEXTURE_BINDING_RECTANGLE_ARB = $84F6; + GL_PROXY_TEXTURE_RECTANGLE_ARB = $84F7; + GL_MAX_RECTANGLE_TEXTURE_SIZE_ARB = $84F8; + +function Load_GL_ARB_texture_rectangle: Boolean; + +//***** GL_ARB_color_buffer_float *****// +const + GL_RGBA_FLOAT_MODE_ARB = $8820; + GL_CLAMP_VERTEX_COLOR_ARB = $891A; + GL_CLAMP_FRAGMENT_COLOR_ARB = $891B; + GL_CLAMP_READ_COLOR_ARB = $891C; + GL_FIXED_ONLY_ARB = $891D; + WGL_TYPE_RGBA_FLOAT_ARB = $21A0; +var + glClampColorARB: procedure(target: GLenum; clamp: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_ARB_color_buffer_float: Boolean; + +//***** GL_ARB_half_float_pixel *****// +const + GL_HALF_FLOAT_ARB = $140B; + +function Load_GL_ARB_half_float_pixel: Boolean; + +//***** GL_ARB_texture_float *****// +const + GL_TEXTURE_RED_TYPE_ARB = $8C10; + GL_TEXTURE_GREEN_TYPE_ARB = $8C11; + GL_TEXTURE_BLUE_TYPE_ARB = $8C12; + GL_TEXTURE_ALPHA_TYPE_ARB = $8C13; + GL_TEXTURE_LUMINANCE_TYPE_ARB = $8C14; + GL_TEXTURE_INTENSITY_TYPE_ARB = $8C15; + GL_TEXTURE_DEPTH_TYPE_ARB = $8C16; + GL_UNSIGNED_NORMALIZED_ARB = $8C17; + GL_RGBA32F_ARB = $8814; + GL_RGB32F_ARB = $8815; + GL_ALPHA32F_ARB = $8816; + GL_INTENSITY32F_ARB = $8817; + GL_LUMINANCE32F_ARB = $8818; + GL_LUMINANCE_ALPHA32F_ARB = $8819; + GL_RGBA16F_ARB = $881A; + GL_RGB16F_ARB = $881B; + GL_ALPHA16F_ARB = $881C; + GL_INTENSITY16F_ARB = $881D; + GL_LUMINANCE16F_ARB = $881E; + GL_LUMINANCE_ALPHA16F_ARB = $881F; + +function Load_GL_ARB_texture_float: Boolean; + +//***** GL_EXT_texture_compression_dxt1 *****// + // GL_COMPRESSED_RGB_S3TC_DXT1_EXT { already defined } + // GL_COMPRESSED_RGBA_S3TC_DXT1_EXT { already defined } + +function Load_GL_EXT_texture_compression_dxt1: Boolean; + +//***** GL_ARB_pixel_buffer_object *****// +const + GL_PIXEL_PACK_BUFFER_ARB = $88EB; + GL_PIXEL_UNPACK_BUFFER_ARB = $88EC; + GL_PIXEL_PACK_BUFFER_BINDING_ARB = $88ED; + GL_PIXEL_UNPACK_BUFFER_BINDING_ARB = $88EF; + +function Load_GL_ARB_pixel_buffer_object: Boolean; + +//***** GL_EXT_framebuffer_object *****// +const + GL_FRAMEBUFFER_EXT = $8D40; + GL_RENDERBUFFER_EXT = $8D41; + GL_STENCIL_INDEX_EXT = $8D45; + GL_STENCIL_INDEX1_EXT = $8D46; + GL_STENCIL_INDEX4_EXT = $8D47; + GL_STENCIL_INDEX8_EXT = $8D48; + GL_STENCIL_INDEX16_EXT = $8D49; + GL_RENDERBUFFER_WIDTH_EXT = $8D42; + GL_RENDERBUFFER_HEIGHT_EXT = $8D43; + GL_RENDERBUFFER_INTERNAL_FORMAT_EXT = $8D44; + GL_FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE_EXT = $8CD0; + GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME_EXT = $8CD1; + GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL_EXT = $8CD2; + GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE_EXT = $8CD3; + GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_3D_ZOFFSET_EXT = $8CD4; + GL_COLOR_ATTACHMENT0_EXT = $8CE0; + GL_COLOR_ATTACHMENT1_EXT = $8CE1; + GL_COLOR_ATTACHMENT2_EXT = $8CE2; + GL_COLOR_ATTACHMENT3_EXT = $8CE3; + GL_COLOR_ATTACHMENT4_EXT = $8CE4; + GL_COLOR_ATTACHMENT5_EXT = $8CE5; + GL_COLOR_ATTACHMENT6_EXT = $8CE6; + GL_COLOR_ATTACHMENT7_EXT = $8CE7; + GL_COLOR_ATTACHMENT8_EXT = $8CE8; + GL_COLOR_ATTACHMENT9_EXT = $8CE9; + GL_COLOR_ATTACHMENT10_EXT = $8CEA; + GL_COLOR_ATTACHMENT11_EXT = $8CEB; + GL_COLOR_ATTACHMENT12_EXT = $8CEC; + GL_COLOR_ATTACHMENT13_EXT = $8CED; + GL_COLOR_ATTACHMENT14_EXT = $8CEE; + GL_COLOR_ATTACHMENT15_EXT = $8CEF; + GL_DEPTH_ATTACHMENT_EXT = $8D00; + GL_STENCIL_ATTACHMENT_EXT = $8D20; + GL_FRAMEBUFFER_COMPLETE_EXT = $8CD5; + GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT_EXT = $8CD6; + GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT_EXT = $8CD7; + GL_FRAMEBUFFER_INCOMPLETE_DUPLICATE_ATTACHMENT_EXT = $8CD8; + GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT = $8CD9; + GL_FRAMEBUFFER_INCOMPLETE_FORMATS_EXT = $8CDA; + GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER_EXT = $8CDB; + GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER_EXT = $8CDC; + GL_FRAMEBUFFER_UNSUPPORTED_EXT = $8CDD; + GL_FRAMEBUFFER_STATUS_ERROR_EXT = $8CDE; + GL_FRAMEBUFFER_BINDING_EXT = $8CA6; + GL_RENDERBUFFER_BINDING_EXT = $8CA7; + GL_MAX_COLOR_ATTACHMENTS_EXT = $8CDF; + GL_MAX_RENDERBUFFER_SIZE_EXT = $84E8; + GL_INVALID_FRAMEBUFFER_OPERATION_EXT = $0506; +var + glIsRenderbufferEXT: function(renderbuffer: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glBindRenderbufferEXT: procedure(target: GLenum; renderbuffer: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDeleteRenderbuffersEXT: procedure(n: GLsizei; const renderbuffers: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGenRenderbuffersEXT: procedure(n: GLsizei; renderbuffers: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glRenderbufferStorageEXT: procedure(target: GLenum; internalformat: GLenum; width: GLsizei; height: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetRenderbufferParameterivEXT: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIsFramebufferEXT: function(framebuffer: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glBindFramebufferEXT: procedure(target: GLenum; framebuffer: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDeleteFramebuffersEXT: procedure(n: GLsizei; const framebuffers: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGenFramebuffersEXT: procedure(n: GLsizei; framebuffers: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCheckFramebufferStatusEXT: function(target: GLenum): GLenum; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFramebufferTexture1DEXT: procedure(target: GLenum; attachment: GLenum; textarget: GLenum; texture: GLuint; level: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFramebufferTexture2DEXT: procedure(target: GLenum; attachment: GLenum; textarget: GLenum; texture: GLuint; level: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFramebufferTexture3DEXT: procedure(target: GLenum; attachment: GLenum; textarget: GLenum; texture: GLuint; level: GLint; zoffset: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFramebufferRenderbufferEXT: procedure(target: GLenum; attachment: GLenum; renderbuffertarget: GLenum; renderbuffer: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetFramebufferAttachmentParameterivEXT: procedure(target: GLenum; attachment: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGenerateMipmapEXT: procedure(target: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_EXT_framebuffer_object: Boolean; + +//***** GL_version_1_4 *****// +const + GL_BLEND_DST_RGB = $80C8; + GL_BLEND_SRC_RGB = $80C9; + GL_BLEND_DST_ALPHA = $80CA; + GL_BLEND_SRC_ALPHA = $80CB; + GL_POINT_SIZE_MIN = $8126; + GL_POINT_SIZE_MAX = $8127; + GL_POINT_FADE_THRESHOLD_SIZE = $8128; + GL_POINT_DISTANCE_ATTENUATION = $8129; + GL_GENERATE_MIPMAP = $8191; + GL_GENERATE_MIPMAP_HINT = $8192; + GL_DEPTH_COMPONENT16 = $81A5; + GL_DEPTH_COMPONENT24 = $81A6; + GL_DEPTH_COMPONENT32 = $81A7; + GL_MIRRORED_REPEAT = $8370; + GL_FOG_COORDINATE_SOURCE = $8450; + GL_FOG_COORDINATE = $8451; + GL_FRAGMENT_DEPTH = $8452; + GL_CURRENT_FOG_COORDINATE = $8453; + GL_FOG_COORDINATE_ARRAY_TYPE = $8454; + GL_FOG_COORDINATE_ARRAY_STRIDE = $8455; + GL_FOG_COORDINATE_ARRAY_POINTER = $8456; + GL_FOG_COORDINATE_ARRAY = $8457; + GL_COLOR_SUM = $8458; + GL_CURRENT_SECONDARY_COLOR = $8459; + GL_SECONDARY_COLOR_ARRAY_SIZE = $845A; + GL_SECONDARY_COLOR_ARRAY_TYPE = $845B; + GL_SECONDARY_COLOR_ARRAY_STRIDE = $845C; + GL_SECONDARY_COLOR_ARRAY_POINTER = $845D; + GL_SECONDARY_COLOR_ARRAY = $845E; + GL_MAX_TEXTURE_LOD_BIAS = $84FD; + GL_TEXTURE_FILTER_CONTROL = $8500; + GL_TEXTURE_LOD_BIAS = $8501; + GL_INCR_WRAP = $8507; + GL_DECR_WRAP = $8508; + GL_TEXTURE_DEPTH_SIZE = $884A; + GL_DEPTH_TEXTURE_MODE = $884B; + GL_TEXTURE_COMPARE_MODE = $884C; + GL_TEXTURE_COMPARE_FUNC = $884D; + GL_COMPARE_R_TO_TEXTURE = $884E; +var + glBlendFuncSeparate: procedure(sfactorRGB: GLenum; dfactorRGB: GLenum; sfactorAlpha: GLenum; dfactorAlpha: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFogCoordf: procedure(coord: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFogCoordfv: procedure(const coord: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFogCoordd: procedure(coord: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFogCoorddv: procedure(const coord: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glFogCoordPointer: procedure(_type: GLenum; stride: GLsizei; const pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiDrawArrays: procedure(mode: GLenum; first: PGLint; count: PGLsizei; primcount: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMultiDrawElements: procedure(mode: GLenum; const count: PGLsizei; _type: GLenum; const indices: PGLvoid; primcount: GLsizei); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPointParameterf: procedure(pname: GLenum; param: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPointParameterfv: procedure(pname: GLenum; const params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPointParameteri: procedure(pname: GLenum; param: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glPointParameteriv: procedure(pname: GLenum; const params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3b: procedure(red: GLbyte; green: GLbyte; blue: GLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3bv: procedure(const v: PGLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3d: procedure(red: GLdouble; green: GLdouble; blue: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3f: procedure(red: GLfloat; green: GLfloat; blue: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3i: procedure(red: GLint; green: GLint; blue: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3s: procedure(red: GLshort; green: GLshort; blue: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3ub: procedure(red: GLubyte; green: GLubyte; blue: GLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3ubv: procedure(const v: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3ui: procedure(red: GLuint; green: GLuint; blue: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3uiv: procedure(const v: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3us: procedure(red: GLushort; green: GLushort; blue: GLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColor3usv: procedure(const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glSecondaryColorPointer: procedure(size: GLint; _type: GLenum; stride: GLsizei; const pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos2d: procedure(x: GLdouble; y: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos2dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos2f: procedure(x: GLfloat; y: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos2fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos2i: procedure(x: GLint; y: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos2iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos2s: procedure(x: GLshort; y: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos2sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos3d: procedure(x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos3dv: procedure(const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos3f: procedure(x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos3fv: procedure(const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos3i: procedure(x: GLint; y: GLint; z: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos3iv: procedure(const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos3s: procedure(x: GLshort; y: GLshort; z: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glWindowPos3sv: procedure(const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_version_1_4: Boolean; + +//***** GL_version_1_5 *****// +const + GL_BUFFER_SIZE = $8764; + GL_BUFFER_USAGE = $8765; + GL_QUERY_COUNTER_BITS = $8864; + GL_CURRENT_QUERY = $8865; + GL_QUERY_RESULT = $8866; + GL_QUERY_RESULT_AVAILABLE = $8867; + GL_ARRAY_BUFFER = $8892; + GL_ELEMENT_ARRAY_BUFFER = $8893; + GL_ARRAY_BUFFER_BINDING = $8894; + GL_ELEMENT_ARRAY_BUFFER_BINDING = $8895; + GL_VERTEX_ARRAY_BUFFER_BINDING = $8896; + GL_NORMAL_ARRAY_BUFFER_BINDING = $8897; + GL_COLOR_ARRAY_BUFFER_BINDING = $8898; + GL_INDEX_ARRAY_BUFFER_BINDING = $8899; + GL_TEXTURE_COORD_ARRAY_BUFFER_BINDING = $889A; + GL_EDGE_FLAG_ARRAY_BUFFER_BINDING = $889B; + GL_SECONDARY_COLOR_ARRAY_BUFFER_BINDING = $889C; + GL_FOG_COORDINATE_ARRAY_BUFFER_BINDING = $889D; + GL_WEIGHT_ARRAY_BUFFER_BINDING = $889E; + GL_VERTEX_ATTRIB_ARRAY_BUFFER_BINDING = $889F; + GL_READ_ONLY = $88B8; + GL_WRITE_ONLY = $88B9; + GL_READ_WRITE = $88BA; + GL_BUFFER_ACCESS = $88BB; + GL_BUFFER_MAPPED = $88BC; + GL_BUFFER_MAP_POINTER = $88BD; + GL_STREAM_DRAW = $88E0; + GL_STREAM_READ = $88E1; + GL_STREAM_COPY = $88E2; + GL_STATIC_DRAW = $88E4; + GL_STATIC_READ = $88E5; + GL_STATIC_COPY = $88E6; + GL_DYNAMIC_DRAW = $88E8; + GL_DYNAMIC_READ = $88E9; + GL_DYNAMIC_COPY = $88EA; + GL_SAMPLES_PASSED = $8914; + GL_FOG_COORD_SRC = $8450; + GL_FOG_COORD = $8451; + GL_CURRENT_FOG_COORD = $8453; + GL_FOG_COORD_ARRAY_TYPE = $8454; + GL_FOG_COORD_ARRAY_STRIDE = $8455; + GL_FOG_COORD_ARRAY_POINTER = $8456; + GL_FOG_COORD_ARRAY = $8457; + GL_FOG_COORD_ARRAY_BUFFER_BINDING = $889D; + GL_SRC0_RGB = $8580; + GL_SRC1_RGB = $8581; + GL_SRC2_RGB = $8582; + GL_SRC0_ALPHA = $8588; + GL_SRC1_ALPHA = $8589; + GL_SRC2_ALPHA = $858A; +var + glGenQueries: procedure(n: GLsizei; ids: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDeleteQueries: procedure(n: GLsizei; const ids: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIsQuery: function(id: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glBeginQuery: procedure(target: GLenum; id: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEndQuery: procedure(target: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetQueryiv: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetQueryObjectiv: procedure(id: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetQueryObjectuiv: procedure(id: GLuint; pname: GLenum; params: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glBindBuffer: procedure(target: GLenum; buffer: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDeleteBuffers: procedure(n: GLsizei; const buffers: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGenBuffers: procedure(n: GLsizei; buffers: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIsBuffer: function(buffer: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glBufferData: procedure(target: GLenum; size: GLsizeiptr; const data: PGLvoid; usage: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glBufferSubData: procedure(target: GLenum; offset: GLintptr; size: GLsizeiptr; const data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetBufferSubData: procedure(target: GLenum; offset: GLintptr; size: GLsizeiptr; data: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glMapBuffer: function(target: GLenum; access: GLenum): PGLvoid; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUnmapBuffer: function(target: GLenum): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetBufferParameteriv: procedure(target: GLenum; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetBufferPointerv: procedure(target: GLenum; pname: GLenum; params: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_version_1_5: Boolean; + +//***** GL_version_2_0 *****// +const + GL_BLEND_EQUATION_RGB = $8009; + GL_VERTEX_ATTRIB_ARRAY_ENABLED = $8622; + GL_VERTEX_ATTRIB_ARRAY_SIZE = $8623; + GL_VERTEX_ATTRIB_ARRAY_STRIDE = $8624; + GL_VERTEX_ATTRIB_ARRAY_TYPE = $8625; + GL_CURRENT_VERTEX_ATTRIB = $8626; + GL_VERTEX_PROGRAM_POINT_SIZE = $8642; + GL_VERTEX_PROGRAM_TWO_SIDE = $8643; + GL_VERTEX_ATTRIB_ARRAY_POINTER = $8645; + GL_STENCIL_BACK_FUNC = $8800; + GL_STENCIL_BACK_FAIL = $8801; + GL_STENCIL_BACK_PASS_DEPTH_FAIL = $8802; + GL_STENCIL_BACK_PASS_DEPTH_PASS = $8803; + GL_MAX_DRAW_BUFFERS = $8824; + GL_DRAW_BUFFER0 = $8825; + GL_DRAW_BUFFER1 = $8826; + GL_DRAW_BUFFER2 = $8827; + GL_DRAW_BUFFER3 = $8828; + GL_DRAW_BUFFER4 = $8829; + GL_DRAW_BUFFER5 = $882A; + GL_DRAW_BUFFER6 = $882B; + GL_DRAW_BUFFER7 = $882C; + GL_DRAW_BUFFER8 = $882D; + GL_DRAW_BUFFER9 = $882E; + GL_DRAW_BUFFER10 = $882F; + GL_DRAW_BUFFER11 = $8830; + GL_DRAW_BUFFER12 = $8831; + GL_DRAW_BUFFER13 = $8832; + GL_DRAW_BUFFER14 = $8833; + GL_DRAW_BUFFER15 = $8834; + GL_BLEND_EQUATION_ALPHA = $883D; + GL_POINT_SPRITE = $8861; + GL_COORD_REPLACE = $8862; + GL_MAX_VERTEX_ATTRIBS = $8869; + GL_VERTEX_ATTRIB_ARRAY_NORMALIZED = $886A; + GL_MAX_TEXTURE_COORDS = $8871; + GL_MAX_TEXTURE_IMAGE_UNITS = $8872; + GL_FRAGMENT_SHADER = $8B30; + GL_VERTEX_SHADER = $8B31; + GL_MAX_FRAGMENT_UNIFORM_COMPONENTS = $8B49; + GL_MAX_VERTEX_UNIFORM_COMPONENTS = $8B4A; + GL_MAX_VARYING_FLOATS = $8B4B; + GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS = $8B4C; + GL_MAX_COMBINED_TEXTURE_IMAGE_UNITS = $8B4D; + GL_SHADER_TYPE = $8B4F; + GL_FLOAT_VEC2 = $8B50; + GL_FLOAT_VEC3 = $8B51; + GL_FLOAT_VEC4 = $8B52; + GL_INT_VEC2 = $8B53; + GL_INT_VEC3 = $8B54; + GL_INT_VEC4 = $8B55; + GL_BOOL = $8B56; + GL_BOOL_VEC2 = $8B57; + GL_BOOL_VEC3 = $8B58; + GL_BOOL_VEC4 = $8B59; + GL_FLOAT_MAT2 = $8B5A; + GL_FLOAT_MAT3 = $8B5B; + GL_FLOAT_MAT4 = $8B5C; + GL_SAMPLER_1D = $8B5D; + GL_SAMPLER_2D = $8B5E; + GL_SAMPLER_3D = $8B5F; + GL_SAMPLER_CUBE = $8B60; + GL_SAMPLER_1D_SHADOW = $8B61; + GL_SAMPLER_2D_SHADOW = $8B62; + GL_DELETE_STATUS = $8B80; + GL_COMPILE_STATUS = $8B81; + GL_LINK_STATUS = $8B82; + GL_VALIDATE_STATUS = $8B83; + GL_INFO_LOG_LENGTH = $8B84; + GL_ATTACHED_SHADERS = $8B85; + GL_ACTIVE_UNIFORMS = $8B86; + GL_ACTIVE_UNIFORM_MAX_LENGTH = $8B87; + GL_SHADER_SOURCE_LENGTH = $8B88; + GL_ACTIVE_ATTRIBUTES = $8B89; + GL_ACTIVE_ATTRIBUTE_MAX_LENGTH = $8B8A; + GL_FRAGMENT_SHADER_DERIVATIVE_HINT = $8B8B; + GL_SHADING_LANGUAGE_VERSION = $8B8C; + GL_CURRENT_PROGRAM = $8B8D; + GL_POINT_SPRITE_COORD_ORIGIN = $8CA0; + GL_LOWER_LEFT = $8CA1; + GL_UPPER_LEFT = $8CA2; + GL_STENCIL_BACK_REF = $8CA3; + GL_STENCIL_BACK_VALUE_MASK = $8CA4; + GL_STENCIL_BACK_WRITEMASK = $8CA5; +var + glBlendEquationSeparate: procedure(modeRGB: GLenum; modeAlpha: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDrawBuffers: procedure(n: GLsizei; const bufs: PGLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glStencilOpSeparate: procedure(face: GLenum; sfail: GLenum; dpfail: GLenum; dppass: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glStencilFuncSeparate: procedure(frontfunc: GLenum; backfunc: GLenum; ref: GLint; mask: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glStencilMaskSeparate: procedure(face: GLenum; mask: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glAttachShader: procedure(_program: GLuint; shader: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glBindAttribLocation: procedure(_program: GLuint; index: GLuint; const name: PGLchar); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCompileShader: procedure(shader: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCreateProgram: function(): GLuint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glCreateShader: function(_type: GLenum): GLuint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDeleteProgram: procedure(_program: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDeleteShader: procedure(shader: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDetachShader: procedure(_program: GLuint; shader: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glDisableVertexAttribArray: procedure(index: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glEnableVertexAttribArray: procedure(index: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetActiveAttrib: procedure(_program: GLuint; index: GLuint; bufSize: GLsizei; length: PGLsizei; size: PGLint; _type: PGLenum; name: PGLchar); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetActiveUniform: procedure(_program: GLuint; index: GLuint; bufSize: GLsizei; length: PGLsizei; size: PGLint; _type: PGLenum; name: PGLchar); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetAttachedShaders: procedure(_program: GLuint; maxCount: GLsizei; count: PGLsizei; obj: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetAttribLocation: function(_program: GLuint; const name: PGLchar): GLint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetProgramiv: procedure(_program: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetProgramInfoLog: procedure(_program: GLuint; bufSize: GLsizei; length: PGLsizei; infoLog: PGLchar); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetShaderiv: procedure(shader: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetShaderInfoLog: procedure(shader: GLuint; bufSize: GLsizei; length: PGLsizei; infoLog: PGLchar); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetShaderSource: procedure(shader: GLuint; bufSize: GLsizei; length: PGLsizei; source: PGLchar); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetUniformLocation: function(_program: GLuint; const name: PGLchar): GLint; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetUniformfv: procedure(_program: GLuint; location: GLint; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetUniformiv: procedure(_program: GLuint; location: GLint; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetVertexAttribdv: procedure(index: GLuint; pname: GLenum; params: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetVertexAttribfv: procedure(index: GLuint; pname: GLenum; params: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetVertexAttribiv: procedure(index: GLuint; pname: GLenum; params: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glGetVertexAttribPointerv: procedure(index: GLuint; pname: GLenum; pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIsProgram: function(_program: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glIsShader: function(shader: GLuint): GLboolean; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glLinkProgram: procedure(_program: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glShaderSource: procedure(shader: GLuint; count: GLsizei; const _string: PGLchar; const length: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUseProgram: procedure(_program: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform1f: procedure(location: GLint; v0: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform2f: procedure(location: GLint; v0: GLfloat; v1: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform3f: procedure(location: GLint; v0: GLfloat; v1: GLfloat; v2: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform4f: procedure(location: GLint; v0: GLfloat; v1: GLfloat; v2: GLfloat; v3: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform1i: procedure(location: GLint; v0: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform2i: procedure(location: GLint; v0: GLint; v1: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform3i: procedure(location: GLint; v0: GLint; v1: GLint; v2: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform4i: procedure(location: GLint; v0: GLint; v1: GLint; v2: GLint; v3: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform1fv: procedure(location: GLint; count: GLsizei; const value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform2fv: procedure(location: GLint; count: GLsizei; const value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform3fv: procedure(location: GLint; count: GLsizei; const value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform4fv: procedure(location: GLint; count: GLsizei; const value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform1iv: procedure(location: GLint; count: GLsizei; const value: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform2iv: procedure(location: GLint; count: GLsizei; const value: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform3iv: procedure(location: GLint; count: GLsizei; const value: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniform4iv: procedure(location: GLint; count: GLsizei; const value: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniformMatrix2fv: procedure(location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniformMatrix3fv: procedure(location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glUniformMatrix4fv: procedure(location: GLint; count: GLsizei; transpose: GLboolean; const value: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glValidateProgram: procedure(_program: GLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib1d: procedure(index: GLuint; x: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib1dv: procedure(index: GLuint; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib1f: procedure(index: GLuint; x: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib1fv: procedure(index: GLuint; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib1s: procedure(index: GLuint; x: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib1sv: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib2d: procedure(index: GLuint; x: GLdouble; y: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib2dv: procedure(index: GLuint; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib2f: procedure(index: GLuint; x: GLfloat; y: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib2fv: procedure(index: GLuint; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib2s: procedure(index: GLuint; x: GLshort; y: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib2sv: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib3d: procedure(index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib3dv: procedure(index: GLuint; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib3f: procedure(index: GLuint; x: GLfloat; y: GLfloat; z: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib3fv: procedure(index: GLuint; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib3s: procedure(index: GLuint; x: GLshort; y: GLshort; z: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib3sv: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4Nbv: procedure(index: GLuint; const v: PGLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4Niv: procedure(index: GLuint; const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4Nsv: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4Nub: procedure(index: GLuint; x: GLubyte; y: GLubyte; z: GLubyte; w: GLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4Nubv: procedure(index: GLuint; const v: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4Nuiv: procedure(index: GLuint; const v: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4Nusv: procedure(index: GLuint; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4bv: procedure(index: GLuint; const v: PGLbyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4d: procedure(index: GLuint; x: GLdouble; y: GLdouble; z: GLdouble; w: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4dv: procedure(index: GLuint; const v: PGLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4f: procedure(index: GLuint; x: GLfloat; y: GLfloat; z: GLfloat; w: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4fv: procedure(index: GLuint; const v: PGLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4iv: procedure(index: GLuint; const v: PGLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4s: procedure(index: GLuint; x: GLshort; y: GLshort; z: GLshort; w: GLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4sv: procedure(index: GLuint; const v: PGLshort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4ubv: procedure(index: GLuint; const v: PGLubyte); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4uiv: procedure(index: GLuint; const v: PGLuint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttrib4usv: procedure(index: GLuint; const v: PGLushort); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glVertexAttribPointer: procedure(index: GLuint; size: GLint; _type: GLenum; normalized: GLboolean; stride: GLsizei; const pointer: PGLvoid); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +function Load_GL_version_2_0: Boolean; + +implementation + +uses + sdl; + +function glext_ExtensionSupported(const extension: PChar; const searchIn: PChar): Boolean; +var + extensions: PChar; + start: PChar; + where, terminator: PChar; +begin + + if (Pos(' ', extension) <> 0) or (extension = '') then + begin + Result := FALSE; + Exit; + end; + + if searchIn = '' then + extensions := glGetString(GL_EXTENSIONS) + else + //StrLCopy( extensions, searchIn, StrLen(searchIn)+1 ); + extensions := searchIn; + start := extensions; + while TRUE do + begin + where := StrPos(start, extension ); + if where = nil then Break; + terminator := Pointer(Integer(where) + Integer( strlen( extension ) ) ); + if (where = start) or (PChar(Integer(where) - 1)^ = ' ') then + begin + if (terminator^ = ' ') or (terminator^ = #0) then + begin + Result := TRUE; + Exit; + end; + end; + start := terminator; + end; + Result := FALSE; + +end; + +function Load_GL_version_1_2: Boolean; +{var + extstring : PChar;} +begin + + Result := FALSE; + //extstring := glGetString( GL_EXTENSIONS ); + + @glCopyTexSubImage3D := SDL_GL_GetProcAddress('glCopyTexSubImage3D'); + if not Assigned(glCopyTexSubImage3D) then Exit; + @glDrawRangeElements := SDL_GL_GetProcAddress('glDrawRangeElements'); + if not Assigned(glDrawRangeElements) then Exit; + @glTexImage3D := SDL_GL_GetProcAddress('glTexImage3D'); + if not Assigned(glTexImage3D) then Exit; + @glTexSubImage3D := SDL_GL_GetProcAddress('glTexSubImage3D'); + if not Assigned(glTexSubImage3D) then Exit; + + Result := TRUE; + +end; + +function Load_GL_ARB_imaging: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_imaging', extstring) then + begin + @glColorTable := SDL_GL_GetProcAddress('glColorTable'); + if not Assigned(glColorTable) then Exit; + @glColorTableParameterfv := SDL_GL_GetProcAddress('glColorTableParameterfv'); + if not Assigned(glColorTableParameterfv) then Exit; + @glColorTableParameteriv := SDL_GL_GetProcAddress('glColorTableParameteriv'); + if not Assigned(glColorTableParameteriv) then Exit; + @glCopyColorTable := SDL_GL_GetProcAddress('glCopyColorTable'); + if not Assigned(glCopyColorTable) then Exit; + @glGetColorTable := SDL_GL_GetProcAddress('glGetColorTable'); + if not Assigned(glGetColorTable) then Exit; + @glGetColorTableParameterfv := SDL_GL_GetProcAddress('glGetColorTableParameterfv'); + if not Assigned(glGetColorTableParameterfv) then Exit; + @glGetColorTableParameteriv := SDL_GL_GetProcAddress('glGetColorTableParameteriv'); + if not Assigned(glGetColorTableParameteriv) then Exit; + @glColorSubTable := SDL_GL_GetProcAddress('glColorSubTable'); + if not Assigned(glColorSubTable) then Exit; + @glCopyColorSubTable := SDL_GL_GetProcAddress('glCopyColorSubTable'); + if not Assigned(glCopyColorSubTable) then Exit; + @glConvolutionFilter1D := SDL_GL_GetProcAddress('glConvolutionFilter1D'); + if not Assigned(glConvolutionFilter1D) then Exit; + @glConvolutionFilter2D := SDL_GL_GetProcAddress('glConvolutionFilter2D'); + if not Assigned(glConvolutionFilter2D) then Exit; + @glConvolutionParameterf := SDL_GL_GetProcAddress('glConvolutionParameterf'); + if not Assigned(glConvolutionParameterf) then Exit; + @glConvolutionParameterfv := SDL_GL_GetProcAddress('glConvolutionParameterfv'); + if not Assigned(glConvolutionParameterfv) then Exit; + @glConvolutionParameteri := SDL_GL_GetProcAddress('glConvolutionParameteri'); + if not Assigned(glConvolutionParameteri) then Exit; + @glConvolutionParameteriv := SDL_GL_GetProcAddress('glConvolutionParameteriv'); + if not Assigned(glConvolutionParameteriv) then Exit; + @glCopyConvolutionFilter1D := SDL_GL_GetProcAddress('glCopyConvolutionFilter1D'); + if not Assigned(glCopyConvolutionFilter1D) then Exit; + @glCopyConvolutionFilter2D := SDL_GL_GetProcAddress('glCopyConvolutionFilter2D'); + if not Assigned(glCopyConvolutionFilter2D) then Exit; + @glGetConvolutionFilter := SDL_GL_GetProcAddress('glGetConvolutionFilter'); + if not Assigned(glGetConvolutionFilter) then Exit; + @glGetConvolutionParameterfv := SDL_GL_GetProcAddress('glGetConvolutionParameterfv'); + if not Assigned(glGetConvolutionParameterfv) then Exit; + @glGetConvolutionParameteriv := SDL_GL_GetProcAddress('glGetConvolutionParameteriv'); + if not Assigned(glGetConvolutionParameteriv) then Exit; + @glGetSeparableFilter := SDL_GL_GetProcAddress('glGetSeparableFilter'); + if not Assigned(glGetSeparableFilter) then Exit; + @glSeparableFilter2D := SDL_GL_GetProcAddress('glSeparableFilter2D'); + if not Assigned(glSeparableFilter2D) then Exit; + @glGetHistogram := SDL_GL_GetProcAddress('glGetHistogram'); + if not Assigned(glGetHistogram) then Exit; + @glGetHistogramParameterfv := SDL_GL_GetProcAddress('glGetHistogramParameterfv'); + if not Assigned(glGetHistogramParameterfv) then Exit; + @glGetHistogramParameteriv := SDL_GL_GetProcAddress('glGetHistogramParameteriv'); + if not Assigned(glGetHistogramParameteriv) then Exit; + @glGetMinmax := SDL_GL_GetProcAddress('glGetMinmax'); + if not Assigned(glGetMinmax) then Exit; + @glGetMinmaxParameterfv := SDL_GL_GetProcAddress('glGetMinmaxParameterfv'); + if not Assigned(glGetMinmaxParameterfv) then Exit; + @glGetMinmaxParameteriv := SDL_GL_GetProcAddress('glGetMinmaxParameteriv'); + if not Assigned(glGetMinmaxParameteriv) then Exit; + @glHistogram := SDL_GL_GetProcAddress('glHistogram'); + if not Assigned(glHistogram) then Exit; + @glMinmax := SDL_GL_GetProcAddress('glMinmax'); + if not Assigned(glMinmax) then Exit; + @glResetHistogram := SDL_GL_GetProcAddress('glResetHistogram'); + if not Assigned(glResetHistogram) then Exit; + @glResetMinmax := SDL_GL_GetProcAddress('glResetMinmax'); + if not Assigned(glResetMinmax) then Exit; + @glBlendEquation := SDL_GL_GetProcAddress('glBlendEquation'); + if not Assigned(glBlendEquation) then Exit; + @glBlendColor := SDL_GL_GetProcAddress('glBlendColor'); + if not Assigned(glBlendColor) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_version_1_3: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + @glActiveTexture := SDL_GL_GetProcAddress('glActiveTexture'); + if not Assigned(glActiveTexture) then Exit; + @glClientActiveTexture := SDL_GL_GetProcAddress('glClientActiveTexture'); + if not Assigned(glClientActiveTexture) then Exit; + @glMultiTexCoord1d := SDL_GL_GetProcAddress('glMultiTexCoord1d'); + if not Assigned(glMultiTexCoord1d) then Exit; + @glMultiTexCoord1dv := SDL_GL_GetProcAddress('glMultiTexCoord1dv'); + if not Assigned(glMultiTexCoord1dv) then Exit; + @glMultiTexCoord1f := SDL_GL_GetProcAddress('glMultiTexCoord1f'); + if not Assigned(glMultiTexCoord1f) then Exit; + @glMultiTexCoord1fv := SDL_GL_GetProcAddress('glMultiTexCoord1fv'); + if not Assigned(glMultiTexCoord1fv) then Exit; + @glMultiTexCoord1i := SDL_GL_GetProcAddress('glMultiTexCoord1i'); + if not Assigned(glMultiTexCoord1i) then Exit; + @glMultiTexCoord1iv := SDL_GL_GetProcAddress('glMultiTexCoord1iv'); + if not Assigned(glMultiTexCoord1iv) then Exit; + @glMultiTexCoord1s := SDL_GL_GetProcAddress('glMultiTexCoord1s'); + if not Assigned(glMultiTexCoord1s) then Exit; + @glMultiTexCoord1sv := SDL_GL_GetProcAddress('glMultiTexCoord1sv'); + if not Assigned(glMultiTexCoord1sv) then Exit; + @glMultiTexCoord2d := SDL_GL_GetProcAddress('glMultiTexCoord2d'); + if not Assigned(glMultiTexCoord2d) then Exit; + @glMultiTexCoord2dv := SDL_GL_GetProcAddress('glMultiTexCoord2dv'); + if not Assigned(glMultiTexCoord2dv) then Exit; + @glMultiTexCoord2f := SDL_GL_GetProcAddress('glMultiTexCoord2f'); + if not Assigned(glMultiTexCoord2f) then Exit; + @glMultiTexCoord2fv := SDL_GL_GetProcAddress('glMultiTexCoord2fv'); + if not Assigned(glMultiTexCoord2fv) then Exit; + @glMultiTexCoord2i := SDL_GL_GetProcAddress('glMultiTexCoord2i'); + if not Assigned(glMultiTexCoord2i) then Exit; + @glMultiTexCoord2iv := SDL_GL_GetProcAddress('glMultiTexCoord2iv'); + if not Assigned(glMultiTexCoord2iv) then Exit; + @glMultiTexCoord2s := SDL_GL_GetProcAddress('glMultiTexCoord2s'); + if not Assigned(glMultiTexCoord2s) then Exit; + @glMultiTexCoord2sv := SDL_GL_GetProcAddress('glMultiTexCoord2sv'); + if not Assigned(glMultiTexCoord2sv) then Exit; + @glMultiTexCoord3d := SDL_GL_GetProcAddress('glMultiTexCoord3d'); + if not Assigned(glMultiTexCoord3d) then Exit; + @glMultiTexCoord3dv := SDL_GL_GetProcAddress('glMultiTexCoord3dv'); + if not Assigned(glMultiTexCoord3dv) then Exit; + @glMultiTexCoord3f := SDL_GL_GetProcAddress('glMultiTexCoord3f'); + if not Assigned(glMultiTexCoord3f) then Exit; + @glMultiTexCoord3fv := SDL_GL_GetProcAddress('glMultiTexCoord3fv'); + if not Assigned(glMultiTexCoord3fv) then Exit; + @glMultiTexCoord3i := SDL_GL_GetProcAddress('glMultiTexCoord3i'); + if not Assigned(glMultiTexCoord3i) then Exit; + @glMultiTexCoord3iv := SDL_GL_GetProcAddress('glMultiTexCoord3iv'); + if not Assigned(glMultiTexCoord3iv) then Exit; + @glMultiTexCoord3s := SDL_GL_GetProcAddress('glMultiTexCoord3s'); + if not Assigned(glMultiTexCoord3s) then Exit; + @glMultiTexCoord3sv := SDL_GL_GetProcAddress('glMultiTexCoord3sv'); + if not Assigned(glMultiTexCoord3sv) then Exit; + @glMultiTexCoord4d := SDL_GL_GetProcAddress('glMultiTexCoord4d'); + if not Assigned(glMultiTexCoord4d) then Exit; + @glMultiTexCoord4dv := SDL_GL_GetProcAddress('glMultiTexCoord4dv'); + if not Assigned(glMultiTexCoord4dv) then Exit; + @glMultiTexCoord4f := SDL_GL_GetProcAddress('glMultiTexCoord4f'); + if not Assigned(glMultiTexCoord4f) then Exit; + @glMultiTexCoord4fv := SDL_GL_GetProcAddress('glMultiTexCoord4fv'); + if not Assigned(glMultiTexCoord4fv) then Exit; + @glMultiTexCoord4i := SDL_GL_GetProcAddress('glMultiTexCoord4i'); + if not Assigned(glMultiTexCoord4i) then Exit; + @glMultiTexCoord4iv := SDL_GL_GetProcAddress('glMultiTexCoord4iv'); + if not Assigned(glMultiTexCoord4iv) then Exit; + @glMultiTexCoord4s := SDL_GL_GetProcAddress('glMultiTexCoord4s'); + if not Assigned(glMultiTexCoord4s) then Exit; + @glMultiTexCoord4sv := SDL_GL_GetProcAddress('glMultiTexCoord4sv'); + if not Assigned(glMultiTexCoord4sv) then Exit; + @glLoadTransposeMatrixf := SDL_GL_GetProcAddress('glLoadTransposeMatrixf'); + if not Assigned(glLoadTransposeMatrixf) then Exit; + @glLoadTransposeMatrixd := SDL_GL_GetProcAddress('glLoadTransposeMatrixd'); + if not Assigned(glLoadTransposeMatrixd) then Exit; + @glMultTransposeMatrixf := SDL_GL_GetProcAddress('glMultTransposeMatrixf'); + if not Assigned(glMultTransposeMatrixf) then Exit; + @glMultTransposeMatrixd := SDL_GL_GetProcAddress('glMultTransposeMatrixd'); + if not Assigned(glMultTransposeMatrixd) then Exit; + @glSampleCoverage := SDL_GL_GetProcAddress('glSampleCoverage'); + if not Assigned(glSampleCoverage) then Exit; + @glCompressedTexImage3D := SDL_GL_GetProcAddress('glCompressedTexImage3D'); + if not Assigned(glCompressedTexImage3D) then Exit; + @glCompressedTexImage2D := SDL_GL_GetProcAddress('glCompressedTexImage2D'); + if not Assigned(glCompressedTexImage2D) then Exit; + @glCompressedTexImage1D := SDL_GL_GetProcAddress('glCompressedTexImage1D'); + if not Assigned(glCompressedTexImage1D) then Exit; + @glCompressedTexSubImage3D := SDL_GL_GetProcAddress('glCompressedTexSubImage3D'); + if not Assigned(glCompressedTexSubImage3D) then Exit; + @glCompressedTexSubImage2D := SDL_GL_GetProcAddress('glCompressedTexSubImage2D'); + if not Assigned(glCompressedTexSubImage2D) then Exit; + @glCompressedTexSubImage1D := SDL_GL_GetProcAddress('glCompressedTexSubImage1D'); + if not Assigned(glCompressedTexSubImage1D) then Exit; + @glGetCompressedTexImage := SDL_GL_GetProcAddress('glGetCompressedTexImage'); + if not Assigned(glGetCompressedTexImage) then Exit; + Result := TRUE; + +end; + +function Load_GL_ARB_multitexture: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_multitexture', extstring) then + begin + @glActiveTextureARB := SDL_GL_GetProcAddress('glActiveTextureARB'); + if not Assigned(glActiveTextureARB) then Exit; + @glClientActiveTextureARB := SDL_GL_GetProcAddress('glClientActiveTextureARB'); + if not Assigned(glClientActiveTextureARB) then Exit; + @glMultiTexCoord1dARB := SDL_GL_GetProcAddress('glMultiTexCoord1dARB'); + if not Assigned(glMultiTexCoord1dARB) then Exit; + @glMultiTexCoord1dvARB := SDL_GL_GetProcAddress('glMultiTexCoord1dvARB'); + if not Assigned(glMultiTexCoord1dvARB) then Exit; + @glMultiTexCoord1fARB := SDL_GL_GetProcAddress('glMultiTexCoord1fARB'); + if not Assigned(glMultiTexCoord1fARB) then Exit; + @glMultiTexCoord1fvARB := SDL_GL_GetProcAddress('glMultiTexCoord1fvARB'); + if not Assigned(glMultiTexCoord1fvARB) then Exit; + @glMultiTexCoord1iARB := SDL_GL_GetProcAddress('glMultiTexCoord1iARB'); + if not Assigned(glMultiTexCoord1iARB) then Exit; + @glMultiTexCoord1ivARB := SDL_GL_GetProcAddress('glMultiTexCoord1ivARB'); + if not Assigned(glMultiTexCoord1ivARB) then Exit; + @glMultiTexCoord1sARB := SDL_GL_GetProcAddress('glMultiTexCoord1sARB'); + if not Assigned(glMultiTexCoord1sARB) then Exit; + @glMultiTexCoord1svARB := SDL_GL_GetProcAddress('glMultiTexCoord1svARB'); + if not Assigned(glMultiTexCoord1svARB) then Exit; + @glMultiTexCoord2dARB := SDL_GL_GetProcAddress('glMultiTexCoord2dARB'); + if not Assigned(glMultiTexCoord2dARB) then Exit; + @glMultiTexCoord2dvARB := SDL_GL_GetProcAddress('glMultiTexCoord2dvARB'); + if not Assigned(glMultiTexCoord2dvARB) then Exit; + @glMultiTexCoord2fARB := SDL_GL_GetProcAddress('glMultiTexCoord2fARB'); + if not Assigned(glMultiTexCoord2fARB) then Exit; + @glMultiTexCoord2fvARB := SDL_GL_GetProcAddress('glMultiTexCoord2fvARB'); + if not Assigned(glMultiTexCoord2fvARB) then Exit; + @glMultiTexCoord2iARB := SDL_GL_GetProcAddress('glMultiTexCoord2iARB'); + if not Assigned(glMultiTexCoord2iARB) then Exit; + @glMultiTexCoord2ivARB := SDL_GL_GetProcAddress('glMultiTexCoord2ivARB'); + if not Assigned(glMultiTexCoord2ivARB) then Exit; + @glMultiTexCoord2sARB := SDL_GL_GetProcAddress('glMultiTexCoord2sARB'); + if not Assigned(glMultiTexCoord2sARB) then Exit; + @glMultiTexCoord2svARB := SDL_GL_GetProcAddress('glMultiTexCoord2svARB'); + if not Assigned(glMultiTexCoord2svARB) then Exit; + @glMultiTexCoord3dARB := SDL_GL_GetProcAddress('glMultiTexCoord3dARB'); + if not Assigned(glMultiTexCoord3dARB) then Exit; + @glMultiTexCoord3dvARB := SDL_GL_GetProcAddress('glMultiTexCoord3dvARB'); + if not Assigned(glMultiTexCoord3dvARB) then Exit; + @glMultiTexCoord3fARB := SDL_GL_GetProcAddress('glMultiTexCoord3fARB'); + if not Assigned(glMultiTexCoord3fARB) then Exit; + @glMultiTexCoord3fvARB := SDL_GL_GetProcAddress('glMultiTexCoord3fvARB'); + if not Assigned(glMultiTexCoord3fvARB) then Exit; + @glMultiTexCoord3iARB := SDL_GL_GetProcAddress('glMultiTexCoord3iARB'); + if not Assigned(glMultiTexCoord3iARB) then Exit; + @glMultiTexCoord3ivARB := SDL_GL_GetProcAddress('glMultiTexCoord3ivARB'); + if not Assigned(glMultiTexCoord3ivARB) then Exit; + @glMultiTexCoord3sARB := SDL_GL_GetProcAddress('glMultiTexCoord3sARB'); + if not Assigned(glMultiTexCoord3sARB) then Exit; + @glMultiTexCoord3svARB := SDL_GL_GetProcAddress('glMultiTexCoord3svARB'); + if not Assigned(glMultiTexCoord3svARB) then Exit; + @glMultiTexCoord4dARB := SDL_GL_GetProcAddress('glMultiTexCoord4dARB'); + if not Assigned(glMultiTexCoord4dARB) then Exit; + @glMultiTexCoord4dvARB := SDL_GL_GetProcAddress('glMultiTexCoord4dvARB'); + if not Assigned(glMultiTexCoord4dvARB) then Exit; + @glMultiTexCoord4fARB := SDL_GL_GetProcAddress('glMultiTexCoord4fARB'); + if not Assigned(glMultiTexCoord4fARB) then Exit; + @glMultiTexCoord4fvARB := SDL_GL_GetProcAddress('glMultiTexCoord4fvARB'); + if not Assigned(glMultiTexCoord4fvARB) then Exit; + @glMultiTexCoord4iARB := SDL_GL_GetProcAddress('glMultiTexCoord4iARB'); + if not Assigned(glMultiTexCoord4iARB) then Exit; + @glMultiTexCoord4ivARB := SDL_GL_GetProcAddress('glMultiTexCoord4ivARB'); + if not Assigned(glMultiTexCoord4ivARB) then Exit; + @glMultiTexCoord4sARB := SDL_GL_GetProcAddress('glMultiTexCoord4sARB'); + if not Assigned(glMultiTexCoord4sARB) then Exit; + @glMultiTexCoord4svARB := SDL_GL_GetProcAddress('glMultiTexCoord4svARB'); + if not Assigned(glMultiTexCoord4svARB) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_ARB_transpose_matrix: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_transpose_matrix', extstring) then + begin + @glLoadTransposeMatrixfARB := SDL_GL_GetProcAddress('glLoadTransposeMatrixfARB'); + if not Assigned(glLoadTransposeMatrixfARB) then Exit; + @glLoadTransposeMatrixdARB := SDL_GL_GetProcAddress('glLoadTransposeMatrixdARB'); + if not Assigned(glLoadTransposeMatrixdARB) then Exit; + @glMultTransposeMatrixfARB := SDL_GL_GetProcAddress('glMultTransposeMatrixfARB'); + if not Assigned(glMultTransposeMatrixfARB) then Exit; + @glMultTransposeMatrixdARB := SDL_GL_GetProcAddress('glMultTransposeMatrixdARB'); + if not Assigned(glMultTransposeMatrixdARB) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_ARB_multisample: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_multisample', extstring) then + begin + @glSampleCoverageARB := SDL_GL_GetProcAddress('glSampleCoverageARB'); + if not Assigned(glSampleCoverageARB) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_ARB_texture_env_add: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_texture_env_add', extstring) then + begin + Result := TRUE; + end; + +end; + +{$IFDEF WINDOWS} +function Load_WGL_ARB_extensions_string: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB'); + if not Assigned(wglGetExtensionsStringARB) then Exit; + extstring := wglGetExtensionsStringARB(wglGetCurrentDC); + + if glext_ExtensionSupported('WGL_ARB_extensions_string', extstring) then + begin + @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB'); + if not Assigned(wglGetExtensionsStringARB) then Exit; + Result := TRUE; + end; + +end; + +function Load_WGL_ARB_buffer_region: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB'); + if not Assigned(wglGetExtensionsStringARB) then Exit; + extstring := wglGetExtensionsStringARB(wglGetCurrentDC); + + if glext_ExtensionSupported('WGL_ARB_buffer_region', extstring) then + begin + @wglCreateBufferRegionARB := SDL_GL_GetProcAddress('wglCreateBufferRegionARB'); + if not Assigned(wglCreateBufferRegionARB) then Exit; + @wglDeleteBufferRegionARB := SDL_GL_GetProcAddress('wglDeleteBufferRegionARB'); + if not Assigned(wglDeleteBufferRegionARB) then Exit; + @wglSaveBufferRegionARB := SDL_GL_GetProcAddress('wglSaveBufferRegionARB'); + if not Assigned(wglSaveBufferRegionARB) then Exit; + @wglRestoreBufferRegionARB := SDL_GL_GetProcAddress('wglRestoreBufferRegionARB'); + if not Assigned(wglRestoreBufferRegionARB) then Exit; + Result := TRUE; + end; + +end; +{$ENDIF} + +function Load_GL_ARB_texture_cube_map: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_texture_cube_map', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_ARB_depth_texture: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_depth_texture', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_ARB_point_parameters: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_point_parameters', extstring) then + begin + @glPointParameterfARB := SDL_GL_GetProcAddress('glPointParameterfARB'); + if not Assigned(glPointParameterfARB) then Exit; + @glPointParameterfvARB := SDL_GL_GetProcAddress('glPointParameterfvARB'); + if not Assigned(glPointParameterfvARB) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_ARB_shadow: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_shadow', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_ARB_shadow_ambient: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_shadow_ambient', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_ARB_texture_border_clamp: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_texture_border_clamp', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_ARB_texture_compression: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_texture_compression', extstring) then + begin + @glCompressedTexImage3DARB := SDL_GL_GetProcAddress('glCompressedTexImage3DARB'); + if not Assigned(glCompressedTexImage3DARB) then Exit; + @glCompressedTexImage2DARB := SDL_GL_GetProcAddress('glCompressedTexImage2DARB'); + if not Assigned(glCompressedTexImage2DARB) then Exit; + @glCompressedTexImage1DARB := SDL_GL_GetProcAddress('glCompressedTexImage1DARB'); + if not Assigned(glCompressedTexImage1DARB) then Exit; + @glCompressedTexSubImage3DARB := SDL_GL_GetProcAddress('glCompressedTexSubImage3DARB'); + if not Assigned(glCompressedTexSubImage3DARB) then Exit; + @glCompressedTexSubImage2DARB := SDL_GL_GetProcAddress('glCompressedTexSubImage2DARB'); + if not Assigned(glCompressedTexSubImage2DARB) then Exit; + @glCompressedTexSubImage1DARB := SDL_GL_GetProcAddress('glCompressedTexSubImage1DARB'); + if not Assigned(glCompressedTexSubImage1DARB) then Exit; + @glGetCompressedTexImageARB := SDL_GL_GetProcAddress('glGetCompressedTexImageARB'); + if not Assigned(glGetCompressedTexImageARB) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_ARB_texture_env_combine: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_texture_env_combine', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_ARB_texture_env_crossbar: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_texture_env_crossbar', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_ARB_texture_env_dot3: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_texture_env_dot3', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_ARB_texture_mirrored_repeat: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_texture_mirrored_repeat', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_ARB_vertex_blend: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_vertex_blend', extstring) then + begin + @glWeightbvARB := SDL_GL_GetProcAddress('glWeightbvARB'); + if not Assigned(glWeightbvARB) then Exit; + @glWeightsvARB := SDL_GL_GetProcAddress('glWeightsvARB'); + if not Assigned(glWeightsvARB) then Exit; + @glWeightivARB := SDL_GL_GetProcAddress('glWeightivARB'); + if not Assigned(glWeightivARB) then Exit; + @glWeightfvARB := SDL_GL_GetProcAddress('glWeightfvARB'); + if not Assigned(glWeightfvARB) then Exit; + @glWeightdvARB := SDL_GL_GetProcAddress('glWeightdvARB'); + if not Assigned(glWeightdvARB) then Exit; + @glWeightvARB := SDL_GL_GetProcAddress('glWeightvARB'); + if not Assigned(glWeightvARB) then Exit; + @glWeightubvARB := SDL_GL_GetProcAddress('glWeightubvARB'); + if not Assigned(glWeightubvARB) then Exit; + @glWeightusvARB := SDL_GL_GetProcAddress('glWeightusvARB'); + if not Assigned(glWeightusvARB) then Exit; + @glWeightuivARB := SDL_GL_GetProcAddress('glWeightuivARB'); + if not Assigned(glWeightuivARB) then Exit; + @glWeightPointerARB := SDL_GL_GetProcAddress('glWeightPointerARB'); + if not Assigned(glWeightPointerARB) then Exit; + @glVertexBlendARB := SDL_GL_GetProcAddress('glVertexBlendARB'); + if not Assigned(glVertexBlendARB) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_ARB_vertex_program: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_vertex_program', extstring) then + begin + @glVertexAttrib1sARB := SDL_GL_GetProcAddress('glVertexAttrib1sARB'); + if not Assigned(glVertexAttrib1sARB) then Exit; + @glVertexAttrib1fARB := SDL_GL_GetProcAddress('glVertexAttrib1fARB'); + if not Assigned(glVertexAttrib1fARB) then Exit; + @glVertexAttrib1dARB := SDL_GL_GetProcAddress('glVertexAttrib1dARB'); + if not Assigned(glVertexAttrib1dARB) then Exit; + @glVertexAttrib2sARB := SDL_GL_GetProcAddress('glVertexAttrib2sARB'); + if not Assigned(glVertexAttrib2sARB) then Exit; + @glVertexAttrib2fARB := SDL_GL_GetProcAddress('glVertexAttrib2fARB'); + if not Assigned(glVertexAttrib2fARB) then Exit; + @glVertexAttrib2dARB := SDL_GL_GetProcAddress('glVertexAttrib2dARB'); + if not Assigned(glVertexAttrib2dARB) then Exit; + @glVertexAttrib3sARB := SDL_GL_GetProcAddress('glVertexAttrib3sARB'); + if not Assigned(glVertexAttrib3sARB) then Exit; + @glVertexAttrib3fARB := SDL_GL_GetProcAddress('glVertexAttrib3fARB'); + if not Assigned(glVertexAttrib3fARB) then Exit; + @glVertexAttrib3dARB := SDL_GL_GetProcAddress('glVertexAttrib3dARB'); + if not Assigned(glVertexAttrib3dARB) then Exit; + @glVertexAttrib4sARB := SDL_GL_GetProcAddress('glVertexAttrib4sARB'); + if not Assigned(glVertexAttrib4sARB) then Exit; + @glVertexAttrib4fARB := SDL_GL_GetProcAddress('glVertexAttrib4fARB'); + if not Assigned(glVertexAttrib4fARB) then Exit; + @glVertexAttrib4dARB := SDL_GL_GetProcAddress('glVertexAttrib4dARB'); + if not Assigned(glVertexAttrib4dARB) then Exit; + @glVertexAttrib4NubARB := SDL_GL_GetProcAddress('glVertexAttrib4NubARB'); + if not Assigned(glVertexAttrib4NubARB) then Exit; + @glVertexAttrib1svARB := SDL_GL_GetProcAddress('glVertexAttrib1svARB'); + if not Assigned(glVertexAttrib1svARB) then Exit; + @glVertexAttrib1fvARB := SDL_GL_GetProcAddress('glVertexAttrib1fvARB'); + if not Assigned(glVertexAttrib1fvARB) then Exit; + @glVertexAttrib1dvARB := SDL_GL_GetProcAddress('glVertexAttrib1dvARB'); + if not Assigned(glVertexAttrib1dvARB) then Exit; + @glVertexAttrib2svARB := SDL_GL_GetProcAddress('glVertexAttrib2svARB'); + if not Assigned(glVertexAttrib2svARB) then Exit; + @glVertexAttrib2fvARB := SDL_GL_GetProcAddress('glVertexAttrib2fvARB'); + if not Assigned(glVertexAttrib2fvARB) then Exit; + @glVertexAttrib2dvARB := SDL_GL_GetProcAddress('glVertexAttrib2dvARB'); + if not Assigned(glVertexAttrib2dvARB) then Exit; + @glVertexAttrib3svARB := SDL_GL_GetProcAddress('glVertexAttrib3svARB'); + if not Assigned(glVertexAttrib3svARB) then Exit; + @glVertexAttrib3fvARB := SDL_GL_GetProcAddress('glVertexAttrib3fvARB'); + if not Assigned(glVertexAttrib3fvARB) then Exit; + @glVertexAttrib3dvARB := SDL_GL_GetProcAddress('glVertexAttrib3dvARB'); + if not Assigned(glVertexAttrib3dvARB) then Exit; + @glVertexAttrib4bvARB := SDL_GL_GetProcAddress('glVertexAttrib4bvARB'); + if not Assigned(glVertexAttrib4bvARB) then Exit; + @glVertexAttrib4svARB := SDL_GL_GetProcAddress('glVertexAttrib4svARB'); + if not Assigned(glVertexAttrib4svARB) then Exit; + @glVertexAttrib4ivARB := SDL_GL_GetProcAddress('glVertexAttrib4ivARB'); + if not Assigned(glVertexAttrib4ivARB) then Exit; + @glVertexAttrib4ubvARB := SDL_GL_GetProcAddress('glVertexAttrib4ubvARB'); + if not Assigned(glVertexAttrib4ubvARB) then Exit; + @glVertexAttrib4usvARB := SDL_GL_GetProcAddress('glVertexAttrib4usvARB'); + if not Assigned(glVertexAttrib4usvARB) then Exit; + @glVertexAttrib4uivARB := SDL_GL_GetProcAddress('glVertexAttrib4uivARB'); + if not Assigned(glVertexAttrib4uivARB) then Exit; + @glVertexAttrib4fvARB := SDL_GL_GetProcAddress('glVertexAttrib4fvARB'); + if not Assigned(glVertexAttrib4fvARB) then Exit; + @glVertexAttrib4dvARB := SDL_GL_GetProcAddress('glVertexAttrib4dvARB'); + if not Assigned(glVertexAttrib4dvARB) then Exit; + @glVertexAttrib4NbvARB := SDL_GL_GetProcAddress('glVertexAttrib4NbvARB'); + if not Assigned(glVertexAttrib4NbvARB) then Exit; + @glVertexAttrib4NsvARB := SDL_GL_GetProcAddress('glVertexAttrib4NsvARB'); + if not Assigned(glVertexAttrib4NsvARB) then Exit; + @glVertexAttrib4NivARB := SDL_GL_GetProcAddress('glVertexAttrib4NivARB'); + if not Assigned(glVertexAttrib4NivARB) then Exit; + @glVertexAttrib4NubvARB := SDL_GL_GetProcAddress('glVertexAttrib4NubvARB'); + if not Assigned(glVertexAttrib4NubvARB) then Exit; + @glVertexAttrib4NusvARB := SDL_GL_GetProcAddress('glVertexAttrib4NusvARB'); + if not Assigned(glVertexAttrib4NusvARB) then Exit; + @glVertexAttrib4NuivARB := SDL_GL_GetProcAddress('glVertexAttrib4NuivARB'); + if not Assigned(glVertexAttrib4NuivARB) then Exit; + @glVertexAttribPointerARB := SDL_GL_GetProcAddress('glVertexAttribPointerARB'); + if not Assigned(glVertexAttribPointerARB) then Exit; + @glEnableVertexAttribArrayARB := SDL_GL_GetProcAddress('glEnableVertexAttribArrayARB'); + if not Assigned(glEnableVertexAttribArrayARB) then Exit; + @glDisableVertexAttribArrayARB := SDL_GL_GetProcAddress('glDisableVertexAttribArrayARB'); + if not Assigned(glDisableVertexAttribArrayARB) then Exit; + @glProgramStringARB := SDL_GL_GetProcAddress('glProgramStringARB'); + if not Assigned(glProgramStringARB) then Exit; + @glBindProgramARB := SDL_GL_GetProcAddress('glBindProgramARB'); + if not Assigned(glBindProgramARB) then Exit; + @glDeleteProgramsARB := SDL_GL_GetProcAddress('glDeleteProgramsARB'); + if not Assigned(glDeleteProgramsARB) then Exit; + @glGenProgramsARB := SDL_GL_GetProcAddress('glGenProgramsARB'); + if not Assigned(glGenProgramsARB) then Exit; + @glProgramEnvParameter4dARB := SDL_GL_GetProcAddress('glProgramEnvParameter4dARB'); + if not Assigned(glProgramEnvParameter4dARB) then Exit; + @glProgramEnvParameter4dvARB := SDL_GL_GetProcAddress('glProgramEnvParameter4dvARB'); + if not Assigned(glProgramEnvParameter4dvARB) then Exit; + @glProgramEnvParameter4fARB := SDL_GL_GetProcAddress('glProgramEnvParameter4fARB'); + if not Assigned(glProgramEnvParameter4fARB) then Exit; + @glProgramEnvParameter4fvARB := SDL_GL_GetProcAddress('glProgramEnvParameter4fvARB'); + if not Assigned(glProgramEnvParameter4fvARB) then Exit; + @glProgramLocalParameter4dARB := SDL_GL_GetProcAddress('glProgramLocalParameter4dARB'); + if not Assigned(glProgramLocalParameter4dARB) then Exit; + @glProgramLocalParameter4dvARB := SDL_GL_GetProcAddress('glProgramLocalParameter4dvARB'); + if not Assigned(glProgramLocalParameter4dvARB) then Exit; + @glProgramLocalParameter4fARB := SDL_GL_GetProcAddress('glProgramLocalParameter4fARB'); + if not Assigned(glProgramLocalParameter4fARB) then Exit; + @glProgramLocalParameter4fvARB := SDL_GL_GetProcAddress('glProgramLocalParameter4fvARB'); + if not Assigned(glProgramLocalParameter4fvARB) then Exit; + @glGetProgramEnvParameterdvARB := SDL_GL_GetProcAddress('glGetProgramEnvParameterdvARB'); + if not Assigned(glGetProgramEnvParameterdvARB) then Exit; + @glGetProgramEnvParameterfvARB := SDL_GL_GetProcAddress('glGetProgramEnvParameterfvARB'); + if not Assigned(glGetProgramEnvParameterfvARB) then Exit; + @glGetProgramLocalParameterdvARB := SDL_GL_GetProcAddress('glGetProgramLocalParameterdvARB'); + if not Assigned(glGetProgramLocalParameterdvARB) then Exit; + @glGetProgramLocalParameterfvARB := SDL_GL_GetProcAddress('glGetProgramLocalParameterfvARB'); + if not Assigned(glGetProgramLocalParameterfvARB) then Exit; + @glGetProgramivARB := SDL_GL_GetProcAddress('glGetProgramivARB'); + if not Assigned(glGetProgramivARB) then Exit; + @glGetProgramStringARB := SDL_GL_GetProcAddress('glGetProgramStringARB'); + if not Assigned(glGetProgramStringARB) then Exit; + @glGetVertexAttribdvARB := SDL_GL_GetProcAddress('glGetVertexAttribdvARB'); + if not Assigned(glGetVertexAttribdvARB) then Exit; + @glGetVertexAttribfvARB := SDL_GL_GetProcAddress('glGetVertexAttribfvARB'); + if not Assigned(glGetVertexAttribfvARB) then Exit; + @glGetVertexAttribivARB := SDL_GL_GetProcAddress('glGetVertexAttribivARB'); + if not Assigned(glGetVertexAttribivARB) then Exit; + @glGetVertexAttribPointervARB := SDL_GL_GetProcAddress('glGetVertexAttribPointervARB'); + if not Assigned(glGetVertexAttribPointervARB) then Exit; + @glIsProgramARB := SDL_GL_GetProcAddress('glIsProgramARB'); + if not Assigned(glIsProgramARB) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_ARB_window_pos: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_window_pos', extstring) then + begin + @glWindowPos2dARB := SDL_GL_GetProcAddress('glWindowPos2dARB'); + if not Assigned(glWindowPos2dARB) then Exit; + @glWindowPos2fARB := SDL_GL_GetProcAddress('glWindowPos2fARB'); + if not Assigned(glWindowPos2fARB) then Exit; + @glWindowPos2iARB := SDL_GL_GetProcAddress('glWindowPos2iARB'); + if not Assigned(glWindowPos2iARB) then Exit; + @glWindowPos2sARB := SDL_GL_GetProcAddress('glWindowPos2sARB'); + if not Assigned(glWindowPos2sARB) then Exit; + @glWindowPos2dvARB := SDL_GL_GetProcAddress('glWindowPos2dvARB'); + if not Assigned(glWindowPos2dvARB) then Exit; + @glWindowPos2fvARB := SDL_GL_GetProcAddress('glWindowPos2fvARB'); + if not Assigned(glWindowPos2fvARB) then Exit; + @glWindowPos2ivARB := SDL_GL_GetProcAddress('glWindowPos2ivARB'); + if not Assigned(glWindowPos2ivARB) then Exit; + @glWindowPos2svARB := SDL_GL_GetProcAddress('glWindowPos2svARB'); + if not Assigned(glWindowPos2svARB) then Exit; + @glWindowPos3dARB := SDL_GL_GetProcAddress('glWindowPos3dARB'); + if not Assigned(glWindowPos3dARB) then Exit; + @glWindowPos3fARB := SDL_GL_GetProcAddress('glWindowPos3fARB'); + if not Assigned(glWindowPos3fARB) then Exit; + @glWindowPos3iARB := SDL_GL_GetProcAddress('glWindowPos3iARB'); + if not Assigned(glWindowPos3iARB) then Exit; + @glWindowPos3sARB := SDL_GL_GetProcAddress('glWindowPos3sARB'); + if not Assigned(glWindowPos3sARB) then Exit; + @glWindowPos3dvARB := SDL_GL_GetProcAddress('glWindowPos3dvARB'); + if not Assigned(glWindowPos3dvARB) then Exit; + @glWindowPos3fvARB := SDL_GL_GetProcAddress('glWindowPos3fvARB'); + if not Assigned(glWindowPos3fvARB) then Exit; + @glWindowPos3ivARB := SDL_GL_GetProcAddress('glWindowPos3ivARB'); + if not Assigned(glWindowPos3ivARB) then Exit; + @glWindowPos3svARB := SDL_GL_GetProcAddress('glWindowPos3svARB'); + if not Assigned(glWindowPos3svARB) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_EXT_422_pixels: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_422_pixels', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_EXT_abgr: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_abgr', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_EXT_bgra: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_bgra', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_EXT_blend_color: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_blend_color', extstring) then + begin + @glBlendColorEXT := SDL_GL_GetProcAddress('glBlendColorEXT'); + if not Assigned(glBlendColorEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_EXT_blend_func_separate: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_blend_func_separate', extstring) then + begin + @glBlendFuncSeparateEXT := SDL_GL_GetProcAddress('glBlendFuncSeparateEXT'); + if not Assigned(glBlendFuncSeparateEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_EXT_blend_logic_op: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_blend_logic_op', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_EXT_blend_minmax: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_blend_minmax', extstring) then + begin + @glBlendEquationEXT := SDL_GL_GetProcAddress('glBlendEquationEXT'); + if not Assigned(glBlendEquationEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_EXT_blend_subtract: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_blend_subtract', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_EXT_clip_volume_hint: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_clip_volume_hint', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_EXT_color_subtable: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_color_subtable', extstring) then + begin + @glColorSubTableEXT := SDL_GL_GetProcAddress('glColorSubTableEXT'); + if not Assigned(glColorSubTableEXT) then Exit; + @glCopyColorSubTableEXT := SDL_GL_GetProcAddress('glCopyColorSubTableEXT'); + if not Assigned(glCopyColorSubTableEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_EXT_compiled_vertex_array: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_compiled_vertex_array', extstring) then + begin + @glLockArraysEXT := SDL_GL_GetProcAddress('glLockArraysEXT'); + if not Assigned(glLockArraysEXT) then Exit; + @glUnlockArraysEXT := SDL_GL_GetProcAddress('glUnlockArraysEXT'); + if not Assigned(glUnlockArraysEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_EXT_convolution: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_convolution', extstring) then + begin + @glConvolutionFilter1DEXT := SDL_GL_GetProcAddress('glConvolutionFilter1DEXT'); + if not Assigned(glConvolutionFilter1DEXT) then Exit; + @glConvolutionFilter2DEXT := SDL_GL_GetProcAddress('glConvolutionFilter2DEXT'); + if not Assigned(glConvolutionFilter2DEXT) then Exit; + @glCopyConvolutionFilter1DEXT := SDL_GL_GetProcAddress('glCopyConvolutionFilter1DEXT'); + if not Assigned(glCopyConvolutionFilter1DEXT) then Exit; + @glCopyConvolutionFilter2DEXT := SDL_GL_GetProcAddress('glCopyConvolutionFilter2DEXT'); + if not Assigned(glCopyConvolutionFilter2DEXT) then Exit; + @glGetConvolutionFilterEXT := SDL_GL_GetProcAddress('glGetConvolutionFilterEXT'); + if not Assigned(glGetConvolutionFilterEXT) then Exit; + @glSeparableFilter2DEXT := SDL_GL_GetProcAddress('glSeparableFilter2DEXT'); + if not Assigned(glSeparableFilter2DEXT) then Exit; + @glGetSeparableFilterEXT := SDL_GL_GetProcAddress('glGetSeparableFilterEXT'); + if not Assigned(glGetSeparableFilterEXT) then Exit; + @glConvolutionParameteriEXT := SDL_GL_GetProcAddress('glConvolutionParameteriEXT'); + if not Assigned(glConvolutionParameteriEXT) then Exit; + @glConvolutionParameterivEXT := SDL_GL_GetProcAddress('glConvolutionParameterivEXT'); + if not Assigned(glConvolutionParameterivEXT) then Exit; + @glConvolutionParameterfEXT := SDL_GL_GetProcAddress('glConvolutionParameterfEXT'); + if not Assigned(glConvolutionParameterfEXT) then Exit; + @glConvolutionParameterfvEXT := SDL_GL_GetProcAddress('glConvolutionParameterfvEXT'); + if not Assigned(glConvolutionParameterfvEXT) then Exit; + @glGetConvolutionParameterivEXT := SDL_GL_GetProcAddress('glGetConvolutionParameterivEXT'); + if not Assigned(glGetConvolutionParameterivEXT) then Exit; + @glGetConvolutionParameterfvEXT := SDL_GL_GetProcAddress('glGetConvolutionParameterfvEXT'); + if not Assigned(glGetConvolutionParameterfvEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_EXT_histogram: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_histogram', extstring) then + begin + @glHistogramEXT := SDL_GL_GetProcAddress('glHistogramEXT'); + if not Assigned(glHistogramEXT) then Exit; + @glResetHistogramEXT := SDL_GL_GetProcAddress('glResetHistogramEXT'); + if not Assigned(glResetHistogramEXT) then Exit; + @glGetHistogramEXT := SDL_GL_GetProcAddress('glGetHistogramEXT'); + if not Assigned(glGetHistogramEXT) then Exit; + @glGetHistogramParameterivEXT := SDL_GL_GetProcAddress('glGetHistogramParameterivEXT'); + if not Assigned(glGetHistogramParameterivEXT) then Exit; + @glGetHistogramParameterfvEXT := SDL_GL_GetProcAddress('glGetHistogramParameterfvEXT'); + if not Assigned(glGetHistogramParameterfvEXT) then Exit; + @glMinmaxEXT := SDL_GL_GetProcAddress('glMinmaxEXT'); + if not Assigned(glMinmaxEXT) then Exit; + @glResetMinmaxEXT := SDL_GL_GetProcAddress('glResetMinmaxEXT'); + if not Assigned(glResetMinmaxEXT) then Exit; + @glGetMinmaxEXT := SDL_GL_GetProcAddress('glGetMinmaxEXT'); + if not Assigned(glGetMinmaxEXT) then Exit; + @glGetMinmaxParameterivEXT := SDL_GL_GetProcAddress('glGetMinmaxParameterivEXT'); + if not Assigned(glGetMinmaxParameterivEXT) then Exit; + @glGetMinmaxParameterfvEXT := SDL_GL_GetProcAddress('glGetMinmaxParameterfvEXT'); + if not Assigned(glGetMinmaxParameterfvEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_EXT_multi_draw_arrays: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_multi_draw_arrays', extstring) then + begin + @glMultiDrawArraysEXT := SDL_GL_GetProcAddress('glMultiDrawArraysEXT'); + if not Assigned(glMultiDrawArraysEXT) then Exit; + @glMultiDrawElementsEXT := SDL_GL_GetProcAddress('glMultiDrawElementsEXT'); + if not Assigned(glMultiDrawElementsEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_EXT_packed_pixels: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_packed_pixels', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_EXT_paletted_texture: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_paletted_texture', extstring) then + begin + @glColorTableEXT := SDL_GL_GetProcAddress('glColorTableEXT'); + if not Assigned(glColorTableEXT) then Exit; + @glColorSubTableEXT := SDL_GL_GetProcAddress('glColorSubTableEXT'); + if not Assigned(glColorSubTableEXT) then Exit; + @glGetColorTableEXT := SDL_GL_GetProcAddress('glGetColorTableEXT'); + if not Assigned(glGetColorTableEXT) then Exit; + @glGetColorTableParameterivEXT := SDL_GL_GetProcAddress('glGetColorTableParameterivEXT'); + if not Assigned(glGetColorTableParameterivEXT) then Exit; + @glGetColorTableParameterfvEXT := SDL_GL_GetProcAddress('glGetColorTableParameterfvEXT'); + if not Assigned(glGetColorTableParameterfvEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_EXT_point_parameters: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_point_parameters', extstring) then + begin + @glPointParameterfEXT := SDL_GL_GetProcAddress('glPointParameterfEXT'); + if not Assigned(glPointParameterfEXT) then Exit; + @glPointParameterfvEXT := SDL_GL_GetProcAddress('glPointParameterfvEXT'); + if not Assigned(glPointParameterfvEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_EXT_polygon_offset: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_polygon_offset', extstring) then + begin + @glPolygonOffsetEXT := SDL_GL_GetProcAddress('glPolygonOffsetEXT'); + if not Assigned(glPolygonOffsetEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_EXT_separate_specular_color: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_separate_specular_color', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_EXT_shadow_funcs: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_shadow_funcs', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_EXT_shared_texture_palette: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_shared_texture_palette', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_EXT_stencil_two_side: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_stencil_two_side', extstring) then + begin + @glActiveStencilFaceEXT := SDL_GL_GetProcAddress('glActiveStencilFaceEXT'); + if not Assigned(glActiveStencilFaceEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_EXT_stencil_wrap: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_stencil_wrap', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_EXT_subtexture: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_subtexture', extstring) then + begin + @glTexSubImage1DEXT := SDL_GL_GetProcAddress('glTexSubImage1DEXT'); + if not Assigned(glTexSubImage1DEXT) then Exit; + @glTexSubImage2DEXT := SDL_GL_GetProcAddress('glTexSubImage2DEXT'); + if not Assigned(glTexSubImage2DEXT) then Exit; + @glTexSubImage3DEXT := SDL_GL_GetProcAddress('glTexSubImage3DEXT'); + if not Assigned(glTexSubImage3DEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_EXT_texture3D: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_texture3D', extstring) then + begin + glTexImage3DEXT := SDL_GL_GetProcAddress('glTexImage3DEXT'); + if not Assigned(glTexImage3DEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_EXT_texture_compression_s3tc: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_texture_compression_s3tc', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_EXT_texture_env_add: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_texture_env_add', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_EXT_texture_env_combine: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_texture_env_combine', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_EXT_texture_env_dot3: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_texture_env_dot3', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_EXT_texture_filter_anisotropic: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_texture_filter_anisotropic', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_EXT_texture_lod_bias: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_texture_lod_bias', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_EXT_texture_object: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_texture_object', extstring) then + begin + @glGenTexturesEXT := SDL_GL_GetProcAddress('glGenTexturesEXT'); + if not Assigned(glGenTexturesEXT) then Exit; + @glDeleteTexturesEXT := SDL_GL_GetProcAddress('glDeleteTexturesEXT'); + if not Assigned(glDeleteTexturesEXT) then Exit; + @glBindTextureEXT := SDL_GL_GetProcAddress('glBindTextureEXT'); + if not Assigned(glBindTextureEXT) then Exit; + @glPrioritizeTexturesEXT := SDL_GL_GetProcAddress('glPrioritizeTexturesEXT'); + if not Assigned(glPrioritizeTexturesEXT) then Exit; + @glAreTexturesResidentEXT := SDL_GL_GetProcAddress('glAreTexturesResidentEXT'); + if not Assigned(glAreTexturesResidentEXT) then Exit; + @glIsTextureEXT := SDL_GL_GetProcAddress('glIsTextureEXT'); + if not Assigned(glIsTextureEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_EXT_vertex_array: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_vertex_array', extstring) then + begin + @glArrayElementEXT := SDL_GL_GetProcAddress('glArrayElementEXT'); + if not Assigned(glArrayElementEXT) then Exit; + @glDrawArraysEXT := SDL_GL_GetProcAddress('glDrawArraysEXT'); + if not Assigned(glDrawArraysEXT) then Exit; + @glVertexPointerEXT := SDL_GL_GetProcAddress('glVertexPointerEXT'); + if not Assigned(glVertexPointerEXT) then Exit; + @glNormalPointerEXT := SDL_GL_GetProcAddress('glNormalPointerEXT'); + if not Assigned(glNormalPointerEXT) then Exit; + @glColorPointerEXT := SDL_GL_GetProcAddress('glColorPointerEXT'); + if not Assigned(glColorPointerEXT) then Exit; + @glIndexPointerEXT := SDL_GL_GetProcAddress('glIndexPointerEXT'); + if not Assigned(glIndexPointerEXT) then Exit; + @glTexCoordPointerEXT := SDL_GL_GetProcAddress('glTexCoordPointerEXT'); + if not Assigned(glTexCoordPointerEXT) then Exit; + @glEdgeFlagPointerEXT := SDL_GL_GetProcAddress('glEdgeFlagPointerEXT'); + if not Assigned(glEdgeFlagPointerEXT) then Exit; + @glGetPointervEXT := SDL_GL_GetProcAddress('glGetPointervEXT'); + if not Assigned(glGetPointervEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_EXT_vertex_shader: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_vertex_shader', extstring) then + begin + @glBeginVertexShaderEXT := SDL_GL_GetProcAddress('glBeginVertexShaderEXT'); + if not Assigned(glBeginVertexShaderEXT) then Exit; + @glEndVertexShaderEXT := SDL_GL_GetProcAddress('glEndVertexShaderEXT'); + if not Assigned(glEndVertexShaderEXT) then Exit; + @glBindVertexShaderEXT := SDL_GL_GetProcAddress('glBindVertexShaderEXT'); + if not Assigned(glBindVertexShaderEXT) then Exit; + @glGenVertexShadersEXT := SDL_GL_GetProcAddress('glGenVertexShadersEXT'); + if not Assigned(glGenVertexShadersEXT) then Exit; + @glDeleteVertexShaderEXT := SDL_GL_GetProcAddress('glDeleteVertexShaderEXT'); + if not Assigned(glDeleteVertexShaderEXT) then Exit; + @glShaderOp1EXT := SDL_GL_GetProcAddress('glShaderOp1EXT'); + if not Assigned(glShaderOp1EXT) then Exit; + @glShaderOp2EXT := SDL_GL_GetProcAddress('glShaderOp2EXT'); + if not Assigned(glShaderOp2EXT) then Exit; + @glShaderOp3EXT := SDL_GL_GetProcAddress('glShaderOp3EXT'); + if not Assigned(glShaderOp3EXT) then Exit; + @glSwizzleEXT := SDL_GL_GetProcAddress('glSwizzleEXT'); + if not Assigned(glSwizzleEXT) then Exit; + @glWriteMaskEXT := SDL_GL_GetProcAddress('glWriteMaskEXT'); + if not Assigned(glWriteMaskEXT) then Exit; + @glInsertComponentEXT := SDL_GL_GetProcAddress('glInsertComponentEXT'); + if not Assigned(glInsertComponentEXT) then Exit; + @glExtractComponentEXT := SDL_GL_GetProcAddress('glExtractComponentEXT'); + if not Assigned(glExtractComponentEXT) then Exit; + @glGenSymbolsEXT := SDL_GL_GetProcAddress('glGenSymbolsEXT'); + if not Assigned(glGenSymbolsEXT) then Exit; + @glSetInvariantEXT := SDL_GL_GetProcAddress('glSetInvariantEXT'); + if not Assigned(glSetInvariantEXT) then Exit; + @glSetLocalConstantEXT := SDL_GL_GetProcAddress('glSetLocalConstantEXT'); + if not Assigned(glSetLocalConstantEXT) then Exit; + @glVariantbvEXT := SDL_GL_GetProcAddress('glVariantbvEXT'); + if not Assigned(glVariantbvEXT) then Exit; + @glVariantsvEXT := SDL_GL_GetProcAddress('glVariantsvEXT'); + if not Assigned(glVariantsvEXT) then Exit; + @glVariantivEXT := SDL_GL_GetProcAddress('glVariantivEXT'); + if not Assigned(glVariantivEXT) then Exit; + @glVariantfvEXT := SDL_GL_GetProcAddress('glVariantfvEXT'); + if not Assigned(glVariantfvEXT) then Exit; + @glVariantdvEXT := SDL_GL_GetProcAddress('glVariantdvEXT'); + if not Assigned(glVariantdvEXT) then Exit; + @glVariantubvEXT := SDL_GL_GetProcAddress('glVariantubvEXT'); + if not Assigned(glVariantubvEXT) then Exit; + @glVariantusvEXT := SDL_GL_GetProcAddress('glVariantusvEXT'); + if not Assigned(glVariantusvEXT) then Exit; + @glVariantuivEXT := SDL_GL_GetProcAddress('glVariantuivEXT'); + if not Assigned(glVariantuivEXT) then Exit; + @glVariantPointerEXT := SDL_GL_GetProcAddress('glVariantPointerEXT'); + if not Assigned(glVariantPointerEXT) then Exit; + @glEnableVariantClientStateEXT := SDL_GL_GetProcAddress('glEnableVariantClientStateEXT'); + if not Assigned(glEnableVariantClientStateEXT) then Exit; + @glDisableVariantClientStateEXT := SDL_GL_GetProcAddress('glDisableVariantClientStateEXT'); + if not Assigned(glDisableVariantClientStateEXT) then Exit; + @glBindLightParameterEXT := SDL_GL_GetProcAddress('glBindLightParameterEXT'); + if not Assigned(glBindLightParameterEXT) then Exit; + @glBindMaterialParameterEXT := SDL_GL_GetProcAddress('glBindMaterialParameterEXT'); + if not Assigned(glBindMaterialParameterEXT) then Exit; + @glBindTexGenParameterEXT := SDL_GL_GetProcAddress('glBindTexGenParameterEXT'); + if not Assigned(glBindTexGenParameterEXT) then Exit; + @glBindTextureUnitParameterEXT := SDL_GL_GetProcAddress('glBindTextureUnitParameterEXT'); + if not Assigned(glBindTextureUnitParameterEXT) then Exit; + @glBindParameterEXT := SDL_GL_GetProcAddress('glBindParameterEXT'); + if not Assigned(glBindParameterEXT) then Exit; + @glIsVariantEnabledEXT := SDL_GL_GetProcAddress('glIsVariantEnabledEXT'); + if not Assigned(glIsVariantEnabledEXT) then Exit; + @glGetVariantBooleanvEXT := SDL_GL_GetProcAddress('glGetVariantBooleanvEXT'); + if not Assigned(glGetVariantBooleanvEXT) then Exit; + @glGetVariantIntegervEXT := SDL_GL_GetProcAddress('glGetVariantIntegervEXT'); + if not Assigned(glGetVariantIntegervEXT) then Exit; + @glGetVariantFloatvEXT := SDL_GL_GetProcAddress('glGetVariantFloatvEXT'); + if not Assigned(glGetVariantFloatvEXT) then Exit; + @glGetVariantPointervEXT := SDL_GL_GetProcAddress('glGetVariantPointervEXT'); + if not Assigned(glGetVariantPointervEXT) then Exit; + @glGetInvariantBooleanvEXT := SDL_GL_GetProcAddress('glGetInvariantBooleanvEXT'); + if not Assigned(glGetInvariantBooleanvEXT) then Exit; + @glGetInvariantIntegervEXT := SDL_GL_GetProcAddress('glGetInvariantIntegervEXT'); + if not Assigned(glGetInvariantIntegervEXT) then Exit; + @glGetInvariantFloatvEXT := SDL_GL_GetProcAddress('glGetInvariantFloatvEXT'); + if not Assigned(glGetInvariantFloatvEXT) then Exit; + @glGetLocalConstantBooleanvEXT := SDL_GL_GetProcAddress('glGetLocalConstantBooleanvEXT'); + if not Assigned(glGetLocalConstantBooleanvEXT) then Exit; + @glGetLocalConstantIntegervEXT := SDL_GL_GetProcAddress('glGetLocalConstantIntegervEXT'); + if not Assigned(glGetLocalConstantIntegervEXT) then Exit; + @glGetLocalConstantFloatvEXT := SDL_GL_GetProcAddress('glGetLocalConstantFloatvEXT'); + if not Assigned(glGetLocalConstantFloatvEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_EXT_vertex_weighting: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_vertex_weighting', extstring) then + begin + @glVertexWeightfEXT := SDL_GL_GetProcAddress('glVertexWeightfEXT'); + if not Assigned(glVertexWeightfEXT) then Exit; + @glVertexWeightfvEXT := SDL_GL_GetProcAddress('glVertexWeightfvEXT'); + if not Assigned(glVertexWeightfvEXT) then Exit; + @glVertexWeightPointerEXT := SDL_GL_GetProcAddress('glVertexWeightPointerEXT'); + if not Assigned(glVertexWeightPointerEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_HP_occlusion_test: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_HP_occlusion_test', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_NV_blend_square: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_blend_square', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_NV_copy_depth_to_color: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_copy_depth_to_color', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_NV_depth_clamp: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_depth_clamp', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_NV_evaluators: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_evaluators', extstring) then + begin + @glMapControlPointsNV := SDL_GL_GetProcAddress('glMapControlPointsNV'); + if not Assigned(glMapControlPointsNV) then Exit; + @glMapParameterivNV := SDL_GL_GetProcAddress('glMapParameterivNV'); + if not Assigned(glMapParameterivNV) then Exit; + @glMapParameterfvNV := SDL_GL_GetProcAddress('glMapParameterfvNV'); + if not Assigned(glMapParameterfvNV) then Exit; + @glGetMapControlPointsNV := SDL_GL_GetProcAddress('glGetMapControlPointsNV'); + if not Assigned(glGetMapControlPointsNV) then Exit; + @glGetMapParameterivNV := SDL_GL_GetProcAddress('glGetMapParameterivNV'); + if not Assigned(glGetMapParameterivNV) then Exit; + @glGetMapParameterfvNV := SDL_GL_GetProcAddress('glGetMapParameterfvNV'); + if not Assigned(glGetMapParameterfvNV) then Exit; + @glGetMapAttribParameterivNV := SDL_GL_GetProcAddress('glGetMapAttribParameterivNV'); + if not Assigned(glGetMapAttribParameterivNV) then Exit; + @glGetMapAttribParameterfvNV := SDL_GL_GetProcAddress('glGetMapAttribParameterfvNV'); + if not Assigned(glGetMapAttribParameterfvNV) then Exit; + @glEvalMapsNV := SDL_GL_GetProcAddress('glEvalMapsNV'); + if not Assigned(glEvalMapsNV) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_NV_fence: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_fence', extstring) then + begin + @glGenFencesNV := SDL_GL_GetProcAddress('glGenFencesNV'); + if not Assigned(glGenFencesNV) then Exit; + @glDeleteFencesNV := SDL_GL_GetProcAddress('glDeleteFencesNV'); + if not Assigned(glDeleteFencesNV) then Exit; + @glSetFenceNV := SDL_GL_GetProcAddress('glSetFenceNV'); + if not Assigned(glSetFenceNV) then Exit; + @glTestFenceNV := SDL_GL_GetProcAddress('glTestFenceNV'); + if not Assigned(glTestFenceNV) then Exit; + @glFinishFenceNV := SDL_GL_GetProcAddress('glFinishFenceNV'); + if not Assigned(glFinishFenceNV) then Exit; + @glIsFenceNV := SDL_GL_GetProcAddress('glIsFenceNV'); + if not Assigned(glIsFenceNV) then Exit; + @glGetFenceivNV := SDL_GL_GetProcAddress('glGetFenceivNV'); + if not Assigned(glGetFenceivNV) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_NV_fog_distance: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_fog_distance', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_NV_light_max_exponent: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_light_max_exponent', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_NV_multisample_filter_hint: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_multisample_filter_hint', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_NV_occlusion_query: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_occlusion_query', extstring) then + begin + @glGenOcclusionQueriesNV := SDL_GL_GetProcAddress('glGenOcclusionQueriesNV'); + if not Assigned(glGenOcclusionQueriesNV) then Exit; + @glDeleteOcclusionQueriesNV := SDL_GL_GetProcAddress('glDeleteOcclusionQueriesNV'); + if not Assigned(glDeleteOcclusionQueriesNV) then Exit; + @glIsOcclusionQueryNV := SDL_GL_GetProcAddress('glIsOcclusionQueryNV'); + if not Assigned(glIsOcclusionQueryNV) then Exit; + @glBeginOcclusionQueryNV := SDL_GL_GetProcAddress('glBeginOcclusionQueryNV'); + if not Assigned(glBeginOcclusionQueryNV) then Exit; + @glEndOcclusionQueryNV := SDL_GL_GetProcAddress('glEndOcclusionQueryNV'); + if not Assigned(glEndOcclusionQueryNV) then Exit; + @glGetOcclusionQueryivNV := SDL_GL_GetProcAddress('glGetOcclusionQueryivNV'); + if not Assigned(glGetOcclusionQueryivNV) then Exit; + @glGetOcclusionQueryuivNV := SDL_GL_GetProcAddress('glGetOcclusionQueryuivNV'); + if not Assigned(glGetOcclusionQueryuivNV) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_NV_packed_depth_stencil: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_packed_depth_stencil', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_NV_point_sprite: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_point_sprite', extstring) then + begin + @glPointParameteriNV := SDL_GL_GetProcAddress('glPointParameteriNV'); + if not Assigned(glPointParameteriNV) then Exit; + @glPointParameterivNV := SDL_GL_GetProcAddress('glPointParameterivNV'); + if not Assigned(glPointParameterivNV) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_NV_register_combiners: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_register_combiners', extstring) then + begin + @glCombinerParameterfvNV := SDL_GL_GetProcAddress('glCombinerParameterfvNV'); + if not Assigned(glCombinerParameterfvNV) then Exit; + @glCombinerParameterivNV := SDL_GL_GetProcAddress('glCombinerParameterivNV'); + if not Assigned(glCombinerParameterivNV) then Exit; + @glCombinerParameterfNV := SDL_GL_GetProcAddress('glCombinerParameterfNV'); + if not Assigned(glCombinerParameterfNV) then Exit; + @glCombinerParameteriNV := SDL_GL_GetProcAddress('glCombinerParameteriNV'); + if not Assigned(glCombinerParameteriNV) then Exit; + @glCombinerInputNV := SDL_GL_GetProcAddress('glCombinerInputNV'); + if not Assigned(glCombinerInputNV) then Exit; + @glCombinerOutputNV := SDL_GL_GetProcAddress('glCombinerOutputNV'); + if not Assigned(glCombinerOutputNV) then Exit; + @glFinalCombinerInputNV := SDL_GL_GetProcAddress('glFinalCombinerInputNV'); + if not Assigned(glFinalCombinerInputNV) then Exit; + @glGetCombinerInputParameterfvNV := SDL_GL_GetProcAddress('glGetCombinerInputParameterfvNV'); + if not Assigned(glGetCombinerInputParameterfvNV) then Exit; + @glGetCombinerInputParameterivNV := SDL_GL_GetProcAddress('glGetCombinerInputParameterivNV'); + if not Assigned(glGetCombinerInputParameterivNV) then Exit; + @glGetCombinerOutputParameterfvNV := SDL_GL_GetProcAddress('glGetCombinerOutputParameterfvNV'); + if not Assigned(glGetCombinerOutputParameterfvNV) then Exit; + @glGetCombinerOutputParameterivNV := SDL_GL_GetProcAddress('glGetCombinerOutputParameterivNV'); + if not Assigned(glGetCombinerOutputParameterivNV) then Exit; + @glGetFinalCombinerInputParameterfvNV := SDL_GL_GetProcAddress('glGetFinalCombinerInputParameterfvNV'); + if not Assigned(glGetFinalCombinerInputParameterfvNV) then Exit; + @glGetFinalCombinerInputParameterivNV := SDL_GL_GetProcAddress('glGetFinalCombinerInputParameterivNV'); + if not Assigned(glGetFinalCombinerInputParameterivNV) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_NV_register_combiners2: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_register_combiners2', extstring) then + begin + @glCombinerStageParameterfvNV := SDL_GL_GetProcAddress('glCombinerStageParameterfvNV'); + if not Assigned(glCombinerStageParameterfvNV) then Exit; + @glGetCombinerStageParameterfvNV := SDL_GL_GetProcAddress('glGetCombinerStageParameterfvNV'); + if not Assigned(glGetCombinerStageParameterfvNV) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_NV_texgen_emboss: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_texgen_emboss', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_NV_texgen_reflection: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_texgen_reflection', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_NV_texture_compression_vtc: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_texture_compression_vtc', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_NV_texture_env_combine4: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_texture_env_combine4', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_NV_texture_rectangle: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_texture_rectangle', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_NV_texture_shader: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_texture_shader', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_NV_texture_shader2: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_texture_shader2', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_NV_texture_shader3: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_texture_shader3', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_NV_vertex_array_range: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_vertex_array_range', extstring) then + begin + @glVertexArrayRangeNV := SDL_GL_GetProcAddress('glVertexArrayRangeNV'); + if not Assigned(glVertexArrayRangeNV) then Exit; + @glFlushVertexArrayRangeNV := SDL_GL_GetProcAddress('glFlushVertexArrayRangeNV'); + if not Assigned(glFlushVertexArrayRangeNV) then Exit; + {$IFDEF WINDOWS} + @wglAllocateMemoryNV := SDL_GL_GetProcAddress('wglAllocateMemoryNV'); + if not Assigned(wglAllocateMemoryNV) then Exit; + @wglFreeMemoryNV := SDL_GL_GetProcAddress('wglFreeMemoryNV'); + if not Assigned(wglFreeMemoryNV) then Exit; + {$ENDIF} + Result := TRUE; + end; + +end; + +function Load_GL_NV_vertex_array_range2: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_vertex_array_range2', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_NV_vertex_program: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_vertex_program', extstring) then + begin + @glBindProgramNV := SDL_GL_GetProcAddress('glBindProgramNV'); + if not Assigned(glBindProgramNV) then Exit; + @glDeleteProgramsNV := SDL_GL_GetProcAddress('glDeleteProgramsNV'); + if not Assigned(glDeleteProgramsNV) then Exit; + @glExecuteProgramNV := SDL_GL_GetProcAddress('glExecuteProgramNV'); + if not Assigned(glExecuteProgramNV) then Exit; + @glGenProgramsNV := SDL_GL_GetProcAddress('glGenProgramsNV'); + if not Assigned(glGenProgramsNV) then Exit; + @glAreProgramsResidentNV := SDL_GL_GetProcAddress('glAreProgramsResidentNV'); + if not Assigned(glAreProgramsResidentNV) then Exit; + @glRequestResidentProgramsNV := SDL_GL_GetProcAddress('glRequestResidentProgramsNV'); + if not Assigned(glRequestResidentProgramsNV) then Exit; + @glGetProgramParameterfvNV := SDL_GL_GetProcAddress('glGetProgramParameterfvNV'); + if not Assigned(glGetProgramParameterfvNV) then Exit; + @glGetProgramParameterdvNV := SDL_GL_GetProcAddress('glGetProgramParameterdvNV'); + if not Assigned(glGetProgramParameterdvNV) then Exit; + @glGetProgramivNV := SDL_GL_GetProcAddress('glGetProgramivNV'); + if not Assigned(glGetProgramivNV) then Exit; + @glGetProgramStringNV := SDL_GL_GetProcAddress('glGetProgramStringNV'); + if not Assigned(glGetProgramStringNV) then Exit; + @glGetTrackMatrixivNV := SDL_GL_GetProcAddress('glGetTrackMatrixivNV'); + if not Assigned(glGetTrackMatrixivNV) then Exit; + @glGetVertexAttribdvNV := SDL_GL_GetProcAddress('glGetVertexAttribdvNV'); + if not Assigned(glGetVertexAttribdvNV) then Exit; + @glGetVertexAttribfvNV := SDL_GL_GetProcAddress('glGetVertexAttribfvNV'); + if not Assigned(glGetVertexAttribfvNV) then Exit; + @glGetVertexAttribivNV := SDL_GL_GetProcAddress('glGetVertexAttribivNV'); + if not Assigned(glGetVertexAttribivNV) then Exit; + @glGetVertexAttribPointervNV := SDL_GL_GetProcAddress('glGetVertexAttribPointervNV'); + if not Assigned(glGetVertexAttribPointervNV) then Exit; + @glIsProgramNV := SDL_GL_GetProcAddress('glIsProgramNV'); + if not Assigned(glIsProgramNV) then Exit; + @glLoadProgramNV := SDL_GL_GetProcAddress('glLoadProgramNV'); + if not Assigned(glLoadProgramNV) then Exit; + @glProgramParameter4fNV := SDL_GL_GetProcAddress('glProgramParameter4fNV'); + if not Assigned(glProgramParameter4fNV) then Exit; + @glProgramParameter4fvNV := SDL_GL_GetProcAddress('glProgramParameter4fvNV'); + if not Assigned(glProgramParameter4fvNV) then Exit; + @glProgramParameters4dvNV := SDL_GL_GetProcAddress('glProgramParameters4dvNV'); + if not Assigned(glProgramParameters4dvNV) then Exit; + @glProgramParameters4fvNV := SDL_GL_GetProcAddress('glProgramParameters4fvNV'); + if not Assigned(glProgramParameters4fvNV) then Exit; + @glTrackMatrixNV := SDL_GL_GetProcAddress('glTrackMatrixNV'); + if not Assigned(glTrackMatrixNV) then Exit; + @glVertexAttribPointerNV := SDL_GL_GetProcAddress('glVertexAttribPointerNV'); + if not Assigned(glVertexAttribPointerNV) then Exit; + @glVertexAttrib1sNV := SDL_GL_GetProcAddress('glVertexAttrib1sNV'); + if not Assigned(glVertexAttrib1sNV) then Exit; + @glVertexAttrib1fNV := SDL_GL_GetProcAddress('glVertexAttrib1fNV'); + if not Assigned(glVertexAttrib1fNV) then Exit; + @glVertexAttrib1dNV := SDL_GL_GetProcAddress('glVertexAttrib1dNV'); + if not Assigned(glVertexAttrib1dNV) then Exit; + @glVertexAttrib2sNV := SDL_GL_GetProcAddress('glVertexAttrib2sNV'); + if not Assigned(glVertexAttrib2sNV) then Exit; + @glVertexAttrib2fNV := SDL_GL_GetProcAddress('glVertexAttrib2fNV'); + if not Assigned(glVertexAttrib2fNV) then Exit; + @glVertexAttrib2dNV := SDL_GL_GetProcAddress('glVertexAttrib2dNV'); + if not Assigned(glVertexAttrib2dNV) then Exit; + @glVertexAttrib3sNV := SDL_GL_GetProcAddress('glVertexAttrib3sNV'); + if not Assigned(glVertexAttrib3sNV) then Exit; + @glVertexAttrib3fNV := SDL_GL_GetProcAddress('glVertexAttrib3fNV'); + if not Assigned(glVertexAttrib3fNV) then Exit; + @glVertexAttrib3dNV := SDL_GL_GetProcAddress('glVertexAttrib3dNV'); + if not Assigned(glVertexAttrib3dNV) then Exit; + @glVertexAttrib4sNV := SDL_GL_GetProcAddress('glVertexAttrib4sNV'); + if not Assigned(glVertexAttrib4sNV) then Exit; + @glVertexAttrib4fNV := SDL_GL_GetProcAddress('glVertexAttrib4fNV'); + if not Assigned(glVertexAttrib4fNV) then Exit; + @glVertexAttrib4dNV := SDL_GL_GetProcAddress('glVertexAttrib4dNV'); + if not Assigned(glVertexAttrib4dNV) then Exit; + @glVertexAttrib4ubNV := SDL_GL_GetProcAddress('glVertexAttrib4ubNV'); + if not Assigned(glVertexAttrib4ubNV) then Exit; + @glVertexAttrib1svNV := SDL_GL_GetProcAddress('glVertexAttrib1svNV'); + if not Assigned(glVertexAttrib1svNV) then Exit; + @glVertexAttrib1fvNV := SDL_GL_GetProcAddress('glVertexAttrib1fvNV'); + if not Assigned(glVertexAttrib1fvNV) then Exit; + @glVertexAttrib1dvNV := SDL_GL_GetProcAddress('glVertexAttrib1dvNV'); + if not Assigned(glVertexAttrib1dvNV) then Exit; + @glVertexAttrib2svNV := SDL_GL_GetProcAddress('glVertexAttrib2svNV'); + if not Assigned(glVertexAttrib2svNV) then Exit; + @glVertexAttrib2fvNV := SDL_GL_GetProcAddress('glVertexAttrib2fvNV'); + if not Assigned(glVertexAttrib2fvNV) then Exit; + @glVertexAttrib2dvNV := SDL_GL_GetProcAddress('glVertexAttrib2dvNV'); + if not Assigned(glVertexAttrib2dvNV) then Exit; + @glVertexAttrib3svNV := SDL_GL_GetProcAddress('glVertexAttrib3svNV'); + if not Assigned(glVertexAttrib3svNV) then Exit; + @glVertexAttrib3fvNV := SDL_GL_GetProcAddress('glVertexAttrib3fvNV'); + if not Assigned(glVertexAttrib3fvNV) then Exit; + @glVertexAttrib3dvNV := SDL_GL_GetProcAddress('glVertexAttrib3dvNV'); + if not Assigned(glVertexAttrib3dvNV) then Exit; + @glVertexAttrib4svNV := SDL_GL_GetProcAddress('glVertexAttrib4svNV'); + if not Assigned(glVertexAttrib4svNV) then Exit; + @glVertexAttrib4fvNV := SDL_GL_GetProcAddress('glVertexAttrib4fvNV'); + if not Assigned(glVertexAttrib4fvNV) then Exit; + @glVertexAttrib4dvNV := SDL_GL_GetProcAddress('glVertexAttrib4dvNV'); + if not Assigned(glVertexAttrib4dvNV) then Exit; + @glVertexAttrib4ubvNV := SDL_GL_GetProcAddress('glVertexAttrib4ubvNV'); + if not Assigned(glVertexAttrib4ubvNV) then Exit; + @glVertexAttribs1svNV := SDL_GL_GetProcAddress('glVertexAttribs1svNV'); + if not Assigned(glVertexAttribs1svNV) then Exit; + @glVertexAttribs1fvNV := SDL_GL_GetProcAddress('glVertexAttribs1fvNV'); + if not Assigned(glVertexAttribs1fvNV) then Exit; + @glVertexAttribs1dvNV := SDL_GL_GetProcAddress('glVertexAttribs1dvNV'); + if not Assigned(glVertexAttribs1dvNV) then Exit; + @glVertexAttribs2svNV := SDL_GL_GetProcAddress('glVertexAttribs2svNV'); + if not Assigned(glVertexAttribs2svNV) then Exit; + @glVertexAttribs2fvNV := SDL_GL_GetProcAddress('glVertexAttribs2fvNV'); + if not Assigned(glVertexAttribs2fvNV) then Exit; + @glVertexAttribs2dvNV := SDL_GL_GetProcAddress('glVertexAttribs2dvNV'); + if not Assigned(glVertexAttribs2dvNV) then Exit; + @glVertexAttribs3svNV := SDL_GL_GetProcAddress('glVertexAttribs3svNV'); + if not Assigned(glVertexAttribs3svNV) then Exit; + @glVertexAttribs3fvNV := SDL_GL_GetProcAddress('glVertexAttribs3fvNV'); + if not Assigned(glVertexAttribs3fvNV) then Exit; + @glVertexAttribs3dvNV := SDL_GL_GetProcAddress('glVertexAttribs3dvNV'); + if not Assigned(glVertexAttribs3dvNV) then Exit; + @glVertexAttribs4svNV := SDL_GL_GetProcAddress('glVertexAttribs4svNV'); + if not Assigned(glVertexAttribs4svNV) then Exit; + @glVertexAttribs4fvNV := SDL_GL_GetProcAddress('glVertexAttribs4fvNV'); + if not Assigned(glVertexAttribs4fvNV) then Exit; + @glVertexAttribs4dvNV := SDL_GL_GetProcAddress('glVertexAttribs4dvNV'); + if not Assigned(glVertexAttribs4dvNV) then Exit; + @glVertexAttribs4ubvNV := SDL_GL_GetProcAddress('glVertexAttribs4ubvNV'); + if not Assigned(glVertexAttribs4ubvNV) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_NV_vertex_program1_1: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_vertex_program1_1', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_ATI_element_array: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ATI_element_array', extstring) then + begin + @glElementPointerATI := SDL_GL_GetProcAddress('glElementPointerATI'); + if not Assigned(glElementPointerATI) then Exit; + @glDrawElementArrayATI := SDL_GL_GetProcAddress('glDrawElementArrayATI'); + if not Assigned(glDrawElementArrayATI) then Exit; + @glDrawRangeElementArrayATI := SDL_GL_GetProcAddress('glDrawRangeElementArrayATI'); + if not Assigned(glDrawRangeElementArrayATI) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_ATI_envmap_bumpmap: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ATI_envmap_bumpmap', extstring) then + begin + @glTexBumpParameterivATI := SDL_GL_GetProcAddress('glTexBumpParameterivATI'); + if not Assigned(glTexBumpParameterivATI) then Exit; + @glTexBumpParameterfvATI := SDL_GL_GetProcAddress('glTexBumpParameterfvATI'); + if not Assigned(glTexBumpParameterfvATI) then Exit; + @glGetTexBumpParameterivATI := SDL_GL_GetProcAddress('glGetTexBumpParameterivATI'); + if not Assigned(glGetTexBumpParameterivATI) then Exit; + @glGetTexBumpParameterfvATI := SDL_GL_GetProcAddress('glGetTexBumpParameterfvATI'); + if not Assigned(glGetTexBumpParameterfvATI) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_ATI_fragment_shader: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ATI_fragment_shader', extstring) then + begin + @glGenFragmentShadersATI := SDL_GL_GetProcAddress('glGenFragmentShadersATI'); + if not Assigned(glGenFragmentShadersATI) then Exit; + @glBindFragmentShaderATI := SDL_GL_GetProcAddress('glBindFragmentShaderATI'); + if not Assigned(glBindFragmentShaderATI) then Exit; + @glDeleteFragmentShaderATI := SDL_GL_GetProcAddress('glDeleteFragmentShaderATI'); + if not Assigned(glDeleteFragmentShaderATI) then Exit; + @glBeginFragmentShaderATI := SDL_GL_GetProcAddress('glBeginFragmentShaderATI'); + if not Assigned(glBeginFragmentShaderATI) then Exit; + @glEndFragmentShaderATI := SDL_GL_GetProcAddress('glEndFragmentShaderATI'); + if not Assigned(glEndFragmentShaderATI) then Exit; + @glPassTexCoordATI := SDL_GL_GetProcAddress('glPassTexCoordATI'); + if not Assigned(glPassTexCoordATI) then Exit; + @glSampleMapATI := SDL_GL_GetProcAddress('glSampleMapATI'); + if not Assigned(glSampleMapATI) then Exit; + @glColorFragmentOp1ATI := SDL_GL_GetProcAddress('glColorFragmentOp1ATI'); + if not Assigned(glColorFragmentOp1ATI) then Exit; + @glColorFragmentOp2ATI := SDL_GL_GetProcAddress('glColorFragmentOp2ATI'); + if not Assigned(glColorFragmentOp2ATI) then Exit; + @glColorFragmentOp3ATI := SDL_GL_GetProcAddress('glColorFragmentOp3ATI'); + if not Assigned(glColorFragmentOp3ATI) then Exit; + @glAlphaFragmentOp1ATI := SDL_GL_GetProcAddress('glAlphaFragmentOp1ATI'); + if not Assigned(glAlphaFragmentOp1ATI) then Exit; + @glAlphaFragmentOp2ATI := SDL_GL_GetProcAddress('glAlphaFragmentOp2ATI'); + if not Assigned(glAlphaFragmentOp2ATI) then Exit; + @glAlphaFragmentOp3ATI := SDL_GL_GetProcAddress('glAlphaFragmentOp3ATI'); + if not Assigned(glAlphaFragmentOp3ATI) then Exit; + @glSetFragmentShaderConstantATI := SDL_GL_GetProcAddress('glSetFragmentShaderConstantATI'); + if not Assigned(glSetFragmentShaderConstantATI) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_ATI_pn_triangles: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ATI_pn_triangles', extstring) then + begin + @glPNTrianglesiATI := SDL_GL_GetProcAddress('glPNTrianglesiATI'); + if not Assigned(glPNTrianglesiATI) then Exit; + @glPNTrianglesfATI := SDL_GL_GetProcAddress('glPNTrianglesfATI'); + if not Assigned(glPNTrianglesfATI) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_ATI_texture_mirror_once: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ATI_texture_mirror_once', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_ATI_vertex_array_object: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ATI_vertex_array_object', extstring) then + begin + @glNewObjectBufferATI := SDL_GL_GetProcAddress('glNewObjectBufferATI'); + if not Assigned(glNewObjectBufferATI) then Exit; + @glIsObjectBufferATI := SDL_GL_GetProcAddress('glIsObjectBufferATI'); + if not Assigned(glIsObjectBufferATI) then Exit; + @glUpdateObjectBufferATI := SDL_GL_GetProcAddress('glUpdateObjectBufferATI'); + if not Assigned(glUpdateObjectBufferATI) then Exit; + @glGetObjectBufferfvATI := SDL_GL_GetProcAddress('glGetObjectBufferfvATI'); + if not Assigned(glGetObjectBufferfvATI) then Exit; + @glGetObjectBufferivATI := SDL_GL_GetProcAddress('glGetObjectBufferivATI'); + if not Assigned(glGetObjectBufferivATI) then Exit; + @glDeleteObjectBufferATI := SDL_GL_GetProcAddress('glDeleteObjectBufferATI'); + if not Assigned(glDeleteObjectBufferATI) then Exit; + @glArrayObjectATI := SDL_GL_GetProcAddress('glArrayObjectATI'); + if not Assigned(glArrayObjectATI) then Exit; + @glGetArrayObjectfvATI := SDL_GL_GetProcAddress('glGetArrayObjectfvATI'); + if not Assigned(glGetArrayObjectfvATI) then Exit; + @glGetArrayObjectivATI := SDL_GL_GetProcAddress('glGetArrayObjectivATI'); + if not Assigned(glGetArrayObjectivATI) then Exit; + @glVariantArrayObjectATI := SDL_GL_GetProcAddress('glVariantArrayObjectATI'); + if not Assigned(glVariantArrayObjectATI) then Exit; + @glGetVariantArrayObjectfvATI := SDL_GL_GetProcAddress('glGetVariantArrayObjectfvATI'); + if not Assigned(glGetVariantArrayObjectfvATI) then Exit; + @glGetVariantArrayObjectivATI := SDL_GL_GetProcAddress('glGetVariantArrayObjectivATI'); + if not Assigned(glGetVariantArrayObjectivATI) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_ATI_vertex_streams: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ATI_vertex_streams', extstring) then + begin + @glVertexStream1s := SDL_GL_GetProcAddress('glVertexStream1s'); + if not Assigned(glVertexStream1s) then Exit; + @glVertexStream1i := SDL_GL_GetProcAddress('glVertexStream1i'); + if not Assigned(glVertexStream1i) then Exit; + @glVertexStream1f := SDL_GL_GetProcAddress('glVertexStream1f'); + if not Assigned(glVertexStream1f) then Exit; + @glVertexStream1d := SDL_GL_GetProcAddress('glVertexStream1d'); + if not Assigned(glVertexStream1d) then Exit; + @glVertexStream1sv := SDL_GL_GetProcAddress('glVertexStream1sv'); + if not Assigned(glVertexStream1sv) then Exit; + @glVertexStream1iv := SDL_GL_GetProcAddress('glVertexStream1iv'); + if not Assigned(glVertexStream1iv) then Exit; + @glVertexStream1fv := SDL_GL_GetProcAddress('glVertexStream1fv'); + if not Assigned(glVertexStream1fv) then Exit; + @glVertexStream1dv := SDL_GL_GetProcAddress('glVertexStream1dv'); + if not Assigned(glVertexStream1dv) then Exit; + @glVertexStream2s := SDL_GL_GetProcAddress('glVertexStream2s'); + if not Assigned(glVertexStream2s) then Exit; + @glVertexStream2i := SDL_GL_GetProcAddress('glVertexStream2i'); + if not Assigned(glVertexStream2i) then Exit; + @glVertexStream2f := SDL_GL_GetProcAddress('glVertexStream2f'); + if not Assigned(glVertexStream2f) then Exit; + @glVertexStream2d := SDL_GL_GetProcAddress('glVertexStream2d'); + if not Assigned(glVertexStream2d) then Exit; + @glVertexStream2sv := SDL_GL_GetProcAddress('glVertexStream2sv'); + if not Assigned(glVertexStream2sv) then Exit; + @glVertexStream2iv := SDL_GL_GetProcAddress('glVertexStream2iv'); + if not Assigned(glVertexStream2iv) then Exit; + @glVertexStream2fv := SDL_GL_GetProcAddress('glVertexStream2fv'); + if not Assigned(glVertexStream2fv) then Exit; + @glVertexStream2dv := SDL_GL_GetProcAddress('glVertexStream2dv'); + if not Assigned(glVertexStream2dv) then Exit; + @glVertexStream3s := SDL_GL_GetProcAddress('glVertexStream3s'); + if not Assigned(glVertexStream3s) then Exit; + @glVertexStream3i := SDL_GL_GetProcAddress('glVertexStream3i'); + if not Assigned(glVertexStream3i) then Exit; + @glVertexStream3f := SDL_GL_GetProcAddress('glVertexStream3f'); + if not Assigned(glVertexStream3f) then Exit; + @glVertexStream3d := SDL_GL_GetProcAddress('glVertexStream3d'); + if not Assigned(glVertexStream3d) then Exit; + @glVertexStream3sv := SDL_GL_GetProcAddress('glVertexStream3sv'); + if not Assigned(glVertexStream3sv) then Exit; + @glVertexStream3iv := SDL_GL_GetProcAddress('glVertexStream3iv'); + if not Assigned(glVertexStream3iv) then Exit; + @glVertexStream3fv := SDL_GL_GetProcAddress('glVertexStream3fv'); + if not Assigned(glVertexStream3fv) then Exit; + @glVertexStream3dv := SDL_GL_GetProcAddress('glVertexStream3dv'); + if not Assigned(glVertexStream3dv) then Exit; + @glVertexStream4s := SDL_GL_GetProcAddress('glVertexStream4s'); + if not Assigned(glVertexStream4s) then Exit; + @glVertexStream4i := SDL_GL_GetProcAddress('glVertexStream4i'); + if not Assigned(glVertexStream4i) then Exit; + @glVertexStream4f := SDL_GL_GetProcAddress('glVertexStream4f'); + if not Assigned(glVertexStream4f) then Exit; + @glVertexStream4d := SDL_GL_GetProcAddress('glVertexStream4d'); + if not Assigned(glVertexStream4d) then Exit; + @glVertexStream4sv := SDL_GL_GetProcAddress('glVertexStream4sv'); + if not Assigned(glVertexStream4sv) then Exit; + @glVertexStream4iv := SDL_GL_GetProcAddress('glVertexStream4iv'); + if not Assigned(glVertexStream4iv) then Exit; + @glVertexStream4fv := SDL_GL_GetProcAddress('glVertexStream4fv'); + if not Assigned(glVertexStream4fv) then Exit; + @glVertexStream4dv := SDL_GL_GetProcAddress('glVertexStream4dv'); + if not Assigned(glVertexStream4dv) then Exit; + @glNormalStream3b := SDL_GL_GetProcAddress('glNormalStream3b'); + if not Assigned(glNormalStream3b) then Exit; + @glNormalStream3s := SDL_GL_GetProcAddress('glNormalStream3s'); + if not Assigned(glNormalStream3s) then Exit; + @glNormalStream3i := SDL_GL_GetProcAddress('glNormalStream3i'); + if not Assigned(glNormalStream3i) then Exit; + @glNormalStream3f := SDL_GL_GetProcAddress('glNormalStream3f'); + if not Assigned(glNormalStream3f) then Exit; + @glNormalStream3d := SDL_GL_GetProcAddress('glNormalStream3d'); + if not Assigned(glNormalStream3d) then Exit; + @glNormalStream3bv := SDL_GL_GetProcAddress('glNormalStream3bv'); + if not Assigned(glNormalStream3bv) then Exit; + @glNormalStream3sv := SDL_GL_GetProcAddress('glNormalStream3sv'); + if not Assigned(glNormalStream3sv) then Exit; + @glNormalStream3iv := SDL_GL_GetProcAddress('glNormalStream3iv'); + if not Assigned(glNormalStream3iv) then Exit; + @glNormalStream3fv := SDL_GL_GetProcAddress('glNormalStream3fv'); + if not Assigned(glNormalStream3fv) then Exit; + @glNormalStream3dv := SDL_GL_GetProcAddress('glNormalStream3dv'); + if not Assigned(glNormalStream3dv) then Exit; + @glClientActiveVertexStream := SDL_GL_GetProcAddress('glClientActiveVertexStream'); + if not Assigned(glClientActiveVertexStream) then Exit; + @glVertexBlendEnvi := SDL_GL_GetProcAddress('glVertexBlendEnvi'); + if not Assigned(glVertexBlendEnvi) then Exit; + @glVertexBlendEnvf := SDL_GL_GetProcAddress('glVertexBlendEnvf'); + if not Assigned(glVertexBlendEnvf) then Exit; + Result := TRUE; + end; + +end; + +{$IFDEF WINDOWS} +function Load_WGL_I3D_image_buffer: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB'); + if not Assigned(wglGetExtensionsStringARB) then Exit; + extstring := wglGetExtensionsStringARB(wglGetCurrentDC); + + if glext_ExtensionSupported('WGL_I3D_image_buffer', extstring) then + begin + @wglCreateImageBufferI3D := SDL_GL_GetProcAddress('wglCreateImageBufferI3D'); + if not Assigned(wglCreateImageBufferI3D) then Exit; + @wglDestroyImageBufferI3D := SDL_GL_GetProcAddress('wglDestroyImageBufferI3D'); + if not Assigned(wglDestroyImageBufferI3D) then Exit; + @wglAssociateImageBufferEventsI3D := SDL_GL_GetProcAddress('wglAssociateImageBufferEventsI3D'); + if not Assigned(wglAssociateImageBufferEventsI3D) then Exit; + @wglReleaseImageBufferEventsI3D := SDL_GL_GetProcAddress('wglReleaseImageBufferEventsI3D'); + if not Assigned(wglReleaseImageBufferEventsI3D) then Exit; + Result := TRUE; + end; + +end; + +function Load_WGL_I3D_swap_frame_lock: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB'); + if not Assigned(wglGetExtensionsStringARB) then Exit; + extstring := wglGetExtensionsStringARB(wglGetCurrentDC); + + if glext_ExtensionSupported('WGL_I3D_swap_frame_lock', extstring) then + begin + @wglEnableFrameLockI3D := SDL_GL_GetProcAddress('wglEnableFrameLockI3D'); + if not Assigned(wglEnableFrameLockI3D) then Exit; + @wglDisableFrameLockI3D := SDL_GL_GetProcAddress('wglDisableFrameLockI3D'); + if not Assigned(wglDisableFrameLockI3D) then Exit; + @wglIsEnabledFrameLockI3D := SDL_GL_GetProcAddress('wglIsEnabledFrameLockI3D'); + if not Assigned(wglIsEnabledFrameLockI3D) then Exit; + @wglQueryFrameLockMasterI3D := SDL_GL_GetProcAddress('wglQueryFrameLockMasterI3D'); + if not Assigned(wglQueryFrameLockMasterI3D) then Exit; + Result := TRUE; + end; + +end; + +function Load_WGL_I3D_swap_frame_usage: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB'); + if not Assigned(wglGetExtensionsStringARB) then Exit; + extstring := wglGetExtensionsStringARB(wglGetCurrentDC); + + if glext_ExtensionSupported('WGL_I3D_swap_frame_usage', extstring) then + begin + @wglGetFrameUsageI3D := SDL_GL_GetProcAddress('wglGetFrameUsageI3D'); + if not Assigned(wglGetFrameUsageI3D) then Exit; + @wglBeginFrameTrackingI3D := SDL_GL_GetProcAddress('wglBeginFrameTrackingI3D'); + if not Assigned(wglBeginFrameTrackingI3D) then Exit; + @wglEndFrameTrackingI3D := SDL_GL_GetProcAddress('wglEndFrameTrackingI3D'); + if not Assigned(wglEndFrameTrackingI3D) then Exit; + @wglQueryFrameTrackingI3D := SDL_GL_GetProcAddress('wglQueryFrameTrackingI3D'); + if not Assigned(wglQueryFrameTrackingI3D) then Exit; + Result := TRUE; + end; + +end; +{$ENDIF} + +function Load_GL_3DFX_texture_compression_FXT1: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_3DFX_texture_compression_FXT1', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_IBM_cull_vertex: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_IBM_cull_vertex', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_IBM_multimode_draw_arrays: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_IBM_multimode_draw_arrays', extstring) then + begin + @glMultiModeDrawArraysIBM := SDL_GL_GetProcAddress('glMultiModeDrawArraysIBM'); + if not Assigned(glMultiModeDrawArraysIBM) then Exit; + @glMultiModeDrawElementsIBM := SDL_GL_GetProcAddress('glMultiModeDrawElementsIBM'); + if not Assigned(glMultiModeDrawElementsIBM) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_IBM_raster_pos_clip: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_IBM_raster_pos_clip', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_IBM_texture_mirrored_repeat: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_IBM_texture_mirrored_repeat', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_IBM_vertex_array_lists: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_IBM_vertex_array_lists', extstring) then + begin + @glColorPointerListIBM := SDL_GL_GetProcAddress('glColorPointerListIBM'); + if not Assigned(glColorPointerListIBM) then Exit; + @glSecondaryColorPointerListIBM := SDL_GL_GetProcAddress('glSecondaryColorPointerListIBM'); + if not Assigned(glSecondaryColorPointerListIBM) then Exit; + @glEdgeFlagPointerListIBM := SDL_GL_GetProcAddress('glEdgeFlagPointerListIBM'); + if not Assigned(glEdgeFlagPointerListIBM) then Exit; + @glFogCoordPointerListIBM := SDL_GL_GetProcAddress('glFogCoordPointerListIBM'); + if not Assigned(glFogCoordPointerListIBM) then Exit; + @glNormalPointerListIBM := SDL_GL_GetProcAddress('glNormalPointerListIBM'); + if not Assigned(glNormalPointerListIBM) then Exit; + @glTexCoordPointerListIBM := SDL_GL_GetProcAddress('glTexCoordPointerListIBM'); + if not Assigned(glTexCoordPointerListIBM) then Exit; + @glVertexPointerListIBM := SDL_GL_GetProcAddress('glVertexPointerListIBM'); + if not Assigned(glVertexPointerListIBM) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_MESA_resize_buffers: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_MESA_resize_buffers', extstring) then + begin + @glResizeBuffersMESA := SDL_GL_GetProcAddress('glResizeBuffersMESA'); + if not Assigned(glResizeBuffersMESA) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_MESA_window_pos: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_MESA_window_pos', extstring) then + begin + @glWindowPos2dMESA := SDL_GL_GetProcAddress('glWindowPos2dMESA'); + if not Assigned(glWindowPos2dMESA) then Exit; + @glWindowPos2fMESA := SDL_GL_GetProcAddress('glWindowPos2fMESA'); + if not Assigned(glWindowPos2fMESA) then Exit; + @glWindowPos2iMESA := SDL_GL_GetProcAddress('glWindowPos2iMESA'); + if not Assigned(glWindowPos2iMESA) then Exit; + @glWindowPos2sMESA := SDL_GL_GetProcAddress('glWindowPos2sMESA'); + if not Assigned(glWindowPos2sMESA) then Exit; + @glWindowPos2ivMESA := SDL_GL_GetProcAddress('glWindowPos2ivMESA'); + if not Assigned(glWindowPos2ivMESA) then Exit; + @glWindowPos2svMESA := SDL_GL_GetProcAddress('glWindowPos2svMESA'); + if not Assigned(glWindowPos2svMESA) then Exit; + @glWindowPos2fvMESA := SDL_GL_GetProcAddress('glWindowPos2fvMESA'); + if not Assigned(glWindowPos2fvMESA) then Exit; + @glWindowPos2dvMESA := SDL_GL_GetProcAddress('glWindowPos2dvMESA'); + if not Assigned(glWindowPos2dvMESA) then Exit; + @glWindowPos3iMESA := SDL_GL_GetProcAddress('glWindowPos3iMESA'); + if not Assigned(glWindowPos3iMESA) then Exit; + @glWindowPos3sMESA := SDL_GL_GetProcAddress('glWindowPos3sMESA'); + if not Assigned(glWindowPos3sMESA) then Exit; + @glWindowPos3fMESA := SDL_GL_GetProcAddress('glWindowPos3fMESA'); + if not Assigned(glWindowPos3fMESA) then Exit; + @glWindowPos3dMESA := SDL_GL_GetProcAddress('glWindowPos3dMESA'); + if not Assigned(glWindowPos3dMESA) then Exit; + @glWindowPos3ivMESA := SDL_GL_GetProcAddress('glWindowPos3ivMESA'); + if not Assigned(glWindowPos3ivMESA) then Exit; + @glWindowPos3svMESA := SDL_GL_GetProcAddress('glWindowPos3svMESA'); + if not Assigned(glWindowPos3svMESA) then Exit; + @glWindowPos3fvMESA := SDL_GL_GetProcAddress('glWindowPos3fvMESA'); + if not Assigned(glWindowPos3fvMESA) then Exit; + @glWindowPos3dvMESA := SDL_GL_GetProcAddress('glWindowPos3dvMESA'); + if not Assigned(glWindowPos3dvMESA) then Exit; + @glWindowPos4iMESA := SDL_GL_GetProcAddress('glWindowPos4iMESA'); + if not Assigned(glWindowPos4iMESA) then Exit; + @glWindowPos4sMESA := SDL_GL_GetProcAddress('glWindowPos4sMESA'); + if not Assigned(glWindowPos4sMESA) then Exit; + @glWindowPos4fMESA := SDL_GL_GetProcAddress('glWindowPos4fMESA'); + if not Assigned(glWindowPos4fMESA) then Exit; + @glWindowPos4dMESA := SDL_GL_GetProcAddress('glWindowPos4dMESA'); + if not Assigned(glWindowPos4dMESA) then Exit; + @glWindowPos4ivMESA := SDL_GL_GetProcAddress('glWindowPos4ivMESA'); + if not Assigned(glWindowPos4ivMESA) then Exit; + @glWindowPos4svMESA := SDL_GL_GetProcAddress('glWindowPos4svMESA'); + if not Assigned(glWindowPos4svMESA) then Exit; + @glWindowPos4fvMESA := SDL_GL_GetProcAddress('glWindowPos4fvMESA'); + if not Assigned(glWindowPos4fvMESA) then Exit; + @glWindowPos4dvMESA := SDL_GL_GetProcAddress('glWindowPos4dvMESA'); + if not Assigned(glWindowPos4dvMESA) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_OML_interlace: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_OML_interlace', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_OML_resample: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_OML_resample', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_OML_subsample: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_OML_subsample', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_SGIS_generate_mipmap: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_SGIS_generate_mipmap', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_SGIS_multisample: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_SGIS_multisample', extstring) then + begin + @glSampleMaskSGIS := SDL_GL_GetProcAddress('glSampleMaskSGIS'); + if not Assigned(glSampleMaskSGIS) then Exit; + @glSamplePatternSGIS := SDL_GL_GetProcAddress('glSamplePatternSGIS'); + if not Assigned(glSamplePatternSGIS) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_SGIS_pixel_texture: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_SGIS_pixel_texture', extstring) then + begin + @glPixelTexGenParameteriSGIS := SDL_GL_GetProcAddress('glPixelTexGenParameteriSGIS'); + if not Assigned(glPixelTexGenParameteriSGIS) then Exit; + @glPixelTexGenParameterfSGIS := SDL_GL_GetProcAddress('glPixelTexGenParameterfSGIS'); + if not Assigned(glPixelTexGenParameterfSGIS) then Exit; + @glGetPixelTexGenParameterivSGIS := SDL_GL_GetProcAddress('glGetPixelTexGenParameterivSGIS'); + if not Assigned(glGetPixelTexGenParameterivSGIS) then Exit; + @glGetPixelTexGenParameterfvSGIS := SDL_GL_GetProcAddress('glGetPixelTexGenParameterfvSGIS'); + if not Assigned(glGetPixelTexGenParameterfvSGIS) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_SGIS_texture_border_clamp: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_SGIS_texture_border_clamp', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_SGIS_texture_color_mask: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_SGIS_texture_color_mask', extstring) then + begin + @glTextureColorMaskSGIS := SDL_GL_GetProcAddress('glTextureColorMaskSGIS'); + if not Assigned(glTextureColorMaskSGIS) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_SGIS_texture_edge_clamp: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_SGIS_texture_edge_clamp', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_SGIS_texture_lod: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_SGIS_texture_lod', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_SGIS_depth_texture: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_SGIS_depth_texture', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_SGIX_fog_offset: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_SGIX_fog_offset', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_SGIX_interlace: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_SGIX_interlace', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_SGIX_shadow_ambient: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_SGIX_shadow_ambient', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_SGI_color_matrix: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_SGI_color_matrix', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_SGI_color_table: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_SGI_color_table', extstring) then + begin + @glColorTableSGI := SDL_GL_GetProcAddress('glColorTableSGI'); + if not Assigned(glColorTableSGI) then Exit; + @glCopyColorTableSGI := SDL_GL_GetProcAddress('glCopyColorTableSGI'); + if not Assigned(glCopyColorTableSGI) then Exit; + @glColorTableParameterivSGI := SDL_GL_GetProcAddress('glColorTableParameterivSGI'); + if not Assigned(glColorTableParameterivSGI) then Exit; + @glColorTableParameterfvSGI := SDL_GL_GetProcAddress('glColorTableParameterfvSGI'); + if not Assigned(glColorTableParameterfvSGI) then Exit; + @glGetColorTableSGI := SDL_GL_GetProcAddress('glGetColorTableSGI'); + if not Assigned(glGetColorTableSGI) then Exit; + @glGetColorTableParameterivSGI := SDL_GL_GetProcAddress('glGetColorTableParameterivSGI'); + if not Assigned(glGetColorTableParameterivSGI) then Exit; + @glGetColorTableParameterfvSGI := SDL_GL_GetProcAddress('glGetColorTableParameterfvSGI'); + if not Assigned(glGetColorTableParameterfvSGI) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_SGI_texture_color_table: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_SGI_texture_color_table', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_SUN_vertex: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_SUN_vertex', extstring) then + begin + @glColor4ubVertex2fSUN := SDL_GL_GetProcAddress('glColor4ubVertex2fSUN'); + if not Assigned(glColor4ubVertex2fSUN) then Exit; + @glColor4ubVertex2fvSUN := SDL_GL_GetProcAddress('glColor4ubVertex2fvSUN'); + if not Assigned(glColor4ubVertex2fvSUN) then Exit; + @glColor4ubVertex3fSUN := SDL_GL_GetProcAddress('glColor4ubVertex3fSUN'); + if not Assigned(glColor4ubVertex3fSUN) then Exit; + @glColor4ubVertex3fvSUN := SDL_GL_GetProcAddress('glColor4ubVertex3fvSUN'); + if not Assigned(glColor4ubVertex3fvSUN) then Exit; + @glColor3fVertex3fSUN := SDL_GL_GetProcAddress('glColor3fVertex3fSUN'); + if not Assigned(glColor3fVertex3fSUN) then Exit; + @glColor3fVertex3fvSUN := SDL_GL_GetProcAddress('glColor3fVertex3fvSUN'); + if not Assigned(glColor3fVertex3fvSUN) then Exit; + @glNormal3fVertex3fSUN := SDL_GL_GetProcAddress('glNormal3fVertex3fSUN'); + if not Assigned(glNormal3fVertex3fSUN) then Exit; + @glNormal3fVertex3fvSUN := SDL_GL_GetProcAddress('glNormal3fVertex3fvSUN'); + if not Assigned(glNormal3fVertex3fvSUN) then Exit; + @glColor4fNormal3fVertex3fSUN := SDL_GL_GetProcAddress('glColor4fNormal3fVertex3fSUN'); + if not Assigned(glColor4fNormal3fVertex3fSUN) then Exit; + @glColor4fNormal3fVertex3fvSUN := SDL_GL_GetProcAddress('glColor4fNormal3fVertex3fvSUN'); + if not Assigned(glColor4fNormal3fVertex3fvSUN) then Exit; + @glTexCoord2fVertex3fSUN := SDL_GL_GetProcAddress('glTexCoord2fVertex3fSUN'); + if not Assigned(glTexCoord2fVertex3fSUN) then Exit; + @glTexCoord2fVertex3fvSUN := SDL_GL_GetProcAddress('glTexCoord2fVertex3fvSUN'); + if not Assigned(glTexCoord2fVertex3fvSUN) then Exit; + @glTexCoord4fVertex4fSUN := SDL_GL_GetProcAddress('glTexCoord4fVertex4fSUN'); + if not Assigned(glTexCoord4fVertex4fSUN) then Exit; + @glTexCoord4fVertex4fvSUN := SDL_GL_GetProcAddress('glTexCoord4fVertex4fvSUN'); + if not Assigned(glTexCoord4fVertex4fvSUN) then Exit; + @glTexCoord2fColor4ubVertex3fSUN := SDL_GL_GetProcAddress('glTexCoord2fColor4ubVertex3fSUN'); + if not Assigned(glTexCoord2fColor4ubVertex3fSUN) then Exit; + @glTexCoord2fColor4ubVertex3fvSUN := SDL_GL_GetProcAddress('glTexCoord2fColor4ubVertex3fvSUN'); + if not Assigned(glTexCoord2fColor4ubVertex3fvSUN) then Exit; + @glTexCoord2fColor3fVertex3fSUN := SDL_GL_GetProcAddress('glTexCoord2fColor3fVertex3fSUN'); + if not Assigned(glTexCoord2fColor3fVertex3fSUN) then Exit; + @glTexCoord2fColor3fVertex3fvSUN := SDL_GL_GetProcAddress('glTexCoord2fColor3fVertex3fvSUN'); + if not Assigned(glTexCoord2fColor3fVertex3fvSUN) then Exit; + @glTexCoord2fNormal3fVertex3fSUN := SDL_GL_GetProcAddress('glTexCoord2fNormal3fVertex3fSUN'); + if not Assigned(glTexCoord2fNormal3fVertex3fSUN) then Exit; + @glTexCoord2fNormal3fVertex3fvSUN := SDL_GL_GetProcAddress('glTexCoord2fNormal3fVertex3fvSUN'); + if not Assigned(glTexCoord2fNormal3fVertex3fvSUN) then Exit; + @glTexCoord2fColor4fNormal3fVertex3fSUN := SDL_GL_GetProcAddress('glTexCoord2fColor4fNormal3fVertex3fSUN'); + if not Assigned(glTexCoord2fColor4fNormal3fVertex3fSUN) then Exit; + @glTexCoord2fColor4fNormal3fVertex3fvSUN := SDL_GL_GetProcAddress('glTexCoord2fColor4fNormal3fVertex3fvSUN'); + if not Assigned(glTexCoord2fColor4fNormal3fVertex3fvSUN) then Exit; + @glTexCoord4fColor4fNormal3fVertex4fSUN := SDL_GL_GetProcAddress('glTexCoord4fColor4fNormal3fVertex4fSUN'); + if not Assigned(glTexCoord4fColor4fNormal3fVertex4fSUN) then Exit; + @glTexCoord4fColor4fNormal3fVertex4fvSUN := SDL_GL_GetProcAddress('glTexCoord4fColor4fNormal3fVertex4fvSUN'); + if not Assigned(glTexCoord4fColor4fNormal3fVertex4fvSUN) then Exit; + @glReplacementCodeuiVertex3fSUN := SDL_GL_GetProcAddress('glReplacementCodeuiVertex3fSUN'); + if not Assigned(glReplacementCodeuiVertex3fSUN) then Exit; + @glReplacementCodeuiVertex3fvSUN := SDL_GL_GetProcAddress('glReplacementCodeuiVertex3fvSUN'); + if not Assigned(glReplacementCodeuiVertex3fvSUN) then Exit; + @glReplacementCodeuiColor4ubVertex3fSUN := SDL_GL_GetProcAddress('glReplacementCodeuiColor4ubVertex3fSUN'); + if not Assigned(glReplacementCodeuiColor4ubVertex3fSUN) then Exit; + @glReplacementCodeuiColor4ubVertex3fvSUN := SDL_GL_GetProcAddress('glReplacementCodeuiColor4ubVertex3fvSUN'); + if not Assigned(glReplacementCodeuiColor4ubVertex3fvSUN) then Exit; + @glReplacementCodeuiColor3fVertex3fSUN := SDL_GL_GetProcAddress('glReplacementCodeuiColor3fVertex3fSUN'); + if not Assigned(glReplacementCodeuiColor3fVertex3fSUN) then Exit; + @glReplacementCodeuiColor3fVertex3fvSUN := SDL_GL_GetProcAddress('glReplacementCodeuiColor3fVertex3fvSUN'); + if not Assigned(glReplacementCodeuiColor3fVertex3fvSUN) then Exit; + @glReplacementCodeuiNormal3fVertex3fSUN := SDL_GL_GetProcAddress('glReplacementCodeuiNormal3fVertex3fSUN'); + if not Assigned(glReplacementCodeuiNormal3fVertex3fSUN) then Exit; + @glReplacementCodeuiNormal3fVertex3fvSUN := SDL_GL_GetProcAddress('glReplacementCodeuiNormal3fVertex3fvSUN'); + if not Assigned(glReplacementCodeuiNormal3fVertex3fvSUN) then Exit; + @glReplacementCodeuiColor4fNormal3fVertex3fSUN := SDL_GL_GetProcAddress('glReplacementCodeuiColor4fNormal3fVertex3fSUN'); + if not Assigned(glReplacementCodeuiColor4fNormal3fVertex3fSUN) then Exit; + @glReplacementCodeuiColor4fNormal3fVertex3fvSUN := SDL_GL_GetProcAddress('glReplacementCodeuiColor4fNormal3fVertex3fvSUN'); + if not Assigned(glReplacementCodeuiColor4fNormal3fVertex3fvSUN) then Exit; + @glReplacementCodeuiTexCoord2fVertex3fSUN := SDL_GL_GetProcAddress('glReplacementCodeuiTexCoord2fVertex3fSUN'); + if not Assigned(glReplacementCodeuiTexCoord2fVertex3fSUN) then Exit; + @glReplacementCodeuiTexCoord2fVertex3fvSUN := SDL_GL_GetProcAddress('glReplacementCodeuiTexCoord2fVertex3fvSUN'); + if not Assigned(glReplacementCodeuiTexCoord2fVertex3fvSUN) then Exit; + @glReplacementCodeuiTexCoord2fNormal3fVertex3fSUN := SDL_GL_GetProcAddress('glReplacementCodeuiTexCoord2fNormal3fVertex3fSUN'); + if not Assigned(glReplacementCodeuiTexCoord2fNormal3fVertex3fSUN) then Exit; + @glReplacementCodeuiTexCoord2fNormal3fVertex3fvSUN := SDL_GL_GetProcAddress('glReplacementCodeuiTexCoord2fNormal3fVertex3fvSUN'); + if not Assigned(glReplacementCodeuiTexCoord2fNormal3fVertex3fvSUN) then Exit; + @glReplacementCodeuiTexCoord2fColor4fNormal3fVertex3fSUN := SDL_GL_GetProcAddress('glReplacementCodeuiTexCoord2fColor4fNormal3fVertex3fSUN'); + if not Assigned(glReplacementCodeuiTexCoord2fColor4fNormal3fVertex3fSUN) then Exit; + @glReplacementCodeuiTexCoord2fColor4fNormal3fVertex3fvSUN := SDL_GL_GetProcAddress('glReplacementCodeuiTexCoord2fColor4fNormal3fVertex3fvSUN'); + if not Assigned(glReplacementCodeuiTexCoord2fColor4fNormal3fVertex3fvSUN) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_ARB_fragment_program: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_fragment_program', extstring) then + begin + @glProgramStringARB := SDL_GL_GetProcAddress('glProgramStringARB'); + if not Assigned(glProgramStringARB) then Exit; + @glBindProgramARB := SDL_GL_GetProcAddress('glBindProgramARB'); + if not Assigned(glBindProgramARB) then Exit; + @glDeleteProgramsARB := SDL_GL_GetProcAddress('glDeleteProgramsARB'); + if not Assigned(glDeleteProgramsARB) then Exit; + @glGenProgramsARB := SDL_GL_GetProcAddress('glGenProgramsARB'); + if not Assigned(glGenProgramsARB) then Exit; + @glProgramEnvParameter4dARB := SDL_GL_GetProcAddress('glProgramEnvParameter4dARB'); + if not Assigned(glProgramEnvParameter4dARB) then Exit; + @glProgramEnvParameter4dvARB := SDL_GL_GetProcAddress('glProgramEnvParameter4dvARB'); + if not Assigned(glProgramEnvParameter4dvARB) then Exit; + @glProgramEnvParameter4fARB := SDL_GL_GetProcAddress('glProgramEnvParameter4fARB'); + if not Assigned(glProgramEnvParameter4fARB) then Exit; + @glProgramEnvParameter4fvARB := SDL_GL_GetProcAddress('glProgramEnvParameter4fvARB'); + if not Assigned(glProgramEnvParameter4fvARB) then Exit; + @glProgramLocalParameter4dARB := SDL_GL_GetProcAddress('glProgramLocalParameter4dARB'); + if not Assigned(glProgramLocalParameter4dARB) then Exit; + @glProgramLocalParameter4dvARB := SDL_GL_GetProcAddress('glProgramLocalParameter4dvARB'); + if not Assigned(glProgramLocalParameter4dvARB) then Exit; + @glProgramLocalParameter4fARB := SDL_GL_GetProcAddress('glProgramLocalParameter4fARB'); + if not Assigned(glProgramLocalParameter4fARB) then Exit; + @glProgramLocalParameter4fvARB := SDL_GL_GetProcAddress('glProgramLocalParameter4fvARB'); + if not Assigned(glProgramLocalParameter4fvARB) then Exit; + @glGetProgramEnvParameterdvARB := SDL_GL_GetProcAddress('glGetProgramEnvParameterdvARB'); + if not Assigned(glGetProgramEnvParameterdvARB) then Exit; + @glGetProgramEnvParameterfvARB := SDL_GL_GetProcAddress('glGetProgramEnvParameterfvARB'); + if not Assigned(glGetProgramEnvParameterfvARB) then Exit; + @glGetProgramLocalParameterdvARB := SDL_GL_GetProcAddress('glGetProgramLocalParameterdvARB'); + if not Assigned(glGetProgramLocalParameterdvARB) then Exit; + @glGetProgramLocalParameterfvARB := SDL_GL_GetProcAddress('glGetProgramLocalParameterfvARB'); + if not Assigned(glGetProgramLocalParameterfvARB) then Exit; + @glGetProgramivARB := SDL_GL_GetProcAddress('glGetProgramivARB'); + if not Assigned(glGetProgramivARB) then Exit; + @glGetProgramStringARB := SDL_GL_GetProcAddress('glGetProgramStringARB'); + if not Assigned(glGetProgramStringARB) then Exit; + @glIsProgramARB := SDL_GL_GetProcAddress('glIsProgramARB'); + if not Assigned(glIsProgramARB) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_ATI_text_fragment_shader: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ATI_text_fragment_shader', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_APPLE_client_storage: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_APPLE_client_storage', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_APPLE_element_array: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_APPLE_element_array', extstring) then + begin + @glElementPointerAPPLE := SDL_GL_GetProcAddress('glElementPointerAPPLE'); + if not Assigned(glElementPointerAPPLE) then Exit; + @glDrawElementArrayAPPLE := SDL_GL_GetProcAddress('glDrawElementArrayAPPLE'); + if not Assigned(glDrawElementArrayAPPLE) then Exit; + @glDrawRangeElementArrayAPPLE := SDL_GL_GetProcAddress('glDrawRangeElementArrayAPPLE'); + if not Assigned(glDrawRangeElementArrayAPPLE) then Exit; + @glMultiDrawElementArrayAPPLE := SDL_GL_GetProcAddress('glMultiDrawElementArrayAPPLE'); + if not Assigned(glMultiDrawElementArrayAPPLE) then Exit; + @glMultiDrawRangeElementArrayAPPLE := SDL_GL_GetProcAddress('glMultiDrawRangeElementArrayAPPLE'); + if not Assigned(glMultiDrawRangeElementArrayAPPLE) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_APPLE_fence: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_APPLE_fence', extstring) then + begin + @glGenFencesAPPLE := SDL_GL_GetProcAddress('glGenFencesAPPLE'); + if not Assigned(glGenFencesAPPLE) then Exit; + @glDeleteFencesAPPLE := SDL_GL_GetProcAddress('glDeleteFencesAPPLE'); + if not Assigned(glDeleteFencesAPPLE) then Exit; + @glSetFenceAPPLE := SDL_GL_GetProcAddress('glSetFenceAPPLE'); + if not Assigned(glSetFenceAPPLE) then Exit; + @glIsFenceAPPLE := SDL_GL_GetProcAddress('glIsFenceAPPLE'); + if not Assigned(glIsFenceAPPLE) then Exit; + @glTestFenceAPPLE := SDL_GL_GetProcAddress('glTestFenceAPPLE'); + if not Assigned(glTestFenceAPPLE) then Exit; + @glFinishFenceAPPLE := SDL_GL_GetProcAddress('glFinishFenceAPPLE'); + if not Assigned(glFinishFenceAPPLE) then Exit; + @glTestObjectAPPLE := SDL_GL_GetProcAddress('glTestObjectAPPLE'); + if not Assigned(glTestObjectAPPLE) then Exit; + @glFinishObjectAPPLE := SDL_GL_GetProcAddress('glFinishObjectAPPLE'); + if not Assigned(glFinishObjectAPPLE) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_APPLE_vertex_array_object: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_APPLE_vertex_array_object', extstring) then + begin + @glBindVertexArrayAPPLE := SDL_GL_GetProcAddress('glBindVertexArrayAPPLE'); + if not Assigned(glBindVertexArrayAPPLE) then Exit; + @glDeleteVertexArraysAPPLE := SDL_GL_GetProcAddress('glDeleteVertexArraysAPPLE'); + if not Assigned(glDeleteVertexArraysAPPLE) then Exit; + @glGenVertexArraysAPPLE := SDL_GL_GetProcAddress('glGenVertexArraysAPPLE'); + if not Assigned(glGenVertexArraysAPPLE) then Exit; + @glIsVertexArrayAPPLE := SDL_GL_GetProcAddress('glIsVertexArrayAPPLE'); + if not Assigned(glIsVertexArrayAPPLE) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_APPLE_vertex_array_range: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_APPLE_vertex_array_range', extstring) then + begin + @glVertexArrayRangeAPPLE := SDL_GL_GetProcAddress('glVertexArrayRangeAPPLE'); + if not Assigned(glVertexArrayRangeAPPLE) then Exit; + @glFlushVertexArrayRangeAPPLE := SDL_GL_GetProcAddress('glFlushVertexArrayRangeAPPLE'); + if not Assigned(glFlushVertexArrayRangeAPPLE) then Exit; + @glVertexArrayParameteriAPPLE := SDL_GL_GetProcAddress('glVertexArrayParameteriAPPLE'); + if not Assigned(glVertexArrayParameteriAPPLE) then Exit; + Result := TRUE; + end; + +end; + +{$IFDEF WINDOWS} +function Load_WGL_ARB_pixel_format: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB'); + if not Assigned(wglGetExtensionsStringARB) then Exit; + extstring := wglGetExtensionsStringARB(wglGetCurrentDC); + + if glext_ExtensionSupported('WGL_ARB_pixel_format', extstring) then + begin + @wglGetPixelFormatAttribivARB := SDL_GL_GetProcAddress('wglGetPixelFormatAttribivARB'); + if not Assigned(wglGetPixelFormatAttribivARB) then Exit; + @wglGetPixelFormatAttribfvARB := SDL_GL_GetProcAddress('wglGetPixelFormatAttribfvARB'); + if not Assigned(wglGetPixelFormatAttribfvARB) then Exit; + @wglChoosePixelFormatARB := SDL_GL_GetProcAddress('wglChoosePixelFormatARB'); + if not Assigned(wglChoosePixelFormatARB) then Exit; + Result := TRUE; + end; + +end; + +function Load_WGL_ARB_make_current_read: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB'); + if not Assigned(wglGetExtensionsStringARB) then Exit; + extstring := wglGetExtensionsStringARB(wglGetCurrentDC); + + if glext_ExtensionSupported('WGL_ARB_make_current_read', extstring) then + begin + @wglMakeContextCurrentARB := SDL_GL_GetProcAddress('wglMakeContextCurrentARB'); + if not Assigned(wglMakeContextCurrentARB) then Exit; + @wglGetCurrentReadDCARB := SDL_GL_GetProcAddress('wglGetCurrentReadDCARB'); + if not Assigned(wglGetCurrentReadDCARB) then Exit; + Result := TRUE; + end; + +end; + +function Load_WGL_ARB_pbuffer: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB'); + if not Assigned(wglGetExtensionsStringARB) then Exit; + extstring := wglGetExtensionsStringARB(wglGetCurrentDC); + + if glext_ExtensionSupported('WGL_ARB_pbuffer', extstring) then + begin + @wglCreatePbufferARB := SDL_GL_GetProcAddress('wglCreatePbufferARB'); + if not Assigned(wglCreatePbufferARB) then Exit; + @wglGetPbufferDCARB := SDL_GL_GetProcAddress('wglGetPbufferDCARB'); + if not Assigned(wglGetPbufferDCARB) then Exit; + @wglReleasePbufferDCARB := SDL_GL_GetProcAddress('wglReleasePbufferDCARB'); + if not Assigned(wglReleasePbufferDCARB) then Exit; + @wglDestroyPbufferARB := SDL_GL_GetProcAddress('wglDestroyPbufferARB'); + if not Assigned(wglDestroyPbufferARB) then Exit; + @wglQueryPbufferARB := SDL_GL_GetProcAddress('wglQueryPbufferARB'); + if not Assigned(wglQueryPbufferARB) then Exit; + Result := TRUE; + end; + +end; + +function Load_WGL_EXT_swap_control: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB'); + if not Assigned(wglGetExtensionsStringARB) then Exit; + extstring := wglGetExtensionsStringARB(wglGetCurrentDC); + + if glext_ExtensionSupported('WGL_EXT_swap_control', extstring) then + begin + @wglSwapIntervalEXT := SDL_GL_GetProcAddress('wglSwapIntervalEXT'); + if not Assigned(wglSwapIntervalEXT) then Exit; + @wglGetSwapIntervalEXT := SDL_GL_GetProcAddress('wglGetSwapIntervalEXT'); + if not Assigned(wglGetSwapIntervalEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_WGL_ARB_render_texture: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB'); + if not Assigned(wglGetExtensionsStringARB) then Exit; + extstring := wglGetExtensionsStringARB(wglGetCurrentDC); + + if glext_ExtensionSupported('WGL_ARB_render_texture', extstring) then + begin + @wglBindTexImageARB := SDL_GL_GetProcAddress('wglBindTexImageARB'); + if not Assigned(wglBindTexImageARB) then Exit; + @wglReleaseTexImageARB := SDL_GL_GetProcAddress('wglReleaseTexImageARB'); + if not Assigned(wglReleaseTexImageARB) then Exit; + @wglSetPbufferAttribARB := SDL_GL_GetProcAddress('wglSetPbufferAttribARB'); + if not Assigned(wglSetPbufferAttribARB) then Exit; + Result := TRUE; + end; + +end; + +function Load_WGL_EXT_extensions_string: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB'); + if not Assigned(wglGetExtensionsStringARB) then Exit; + extstring := wglGetExtensionsStringARB(wglGetCurrentDC); + + if glext_ExtensionSupported('WGL_EXT_extensions_string', extstring) then + begin + @wglGetExtensionsStringEXT := SDL_GL_GetProcAddress('wglGetExtensionsStringEXT'); + if not Assigned(wglGetExtensionsStringEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_WGL_EXT_make_current_read: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB'); + if not Assigned(wglGetExtensionsStringARB) then Exit; + extstring := wglGetExtensionsStringARB(wglGetCurrentDC); + + if glext_ExtensionSupported('WGL_EXT_make_current_read', extstring) then + begin + @wglMakeContextCurrentEXT := SDL_GL_GetProcAddress('wglMakeContextCurrentEXT'); + if not Assigned(wglMakeContextCurrentEXT) then Exit; + @wglGetCurrentReadDCEXT := SDL_GL_GetProcAddress('wglGetCurrentReadDCEXT'); + if not Assigned(wglGetCurrentReadDCEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_WGL_EXT_pbuffer: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB'); + if not Assigned(wglGetExtensionsStringARB) then Exit; + extstring := wglGetExtensionsStringARB(wglGetCurrentDC); + + if glext_ExtensionSupported('WGL_EXT_pbuffer', extstring) then + begin + @wglCreatePbufferEXT := SDL_GL_GetProcAddress('wglCreatePbufferEXT'); + if not Assigned(wglCreatePbufferEXT) then Exit; + @wglGetPbufferDCEXT := SDL_GL_GetProcAddress('wglGetPbufferDCEXT'); + if not Assigned(wglGetPbufferDCEXT) then Exit; + @wglReleasePbufferDCEXT := SDL_GL_GetProcAddress('wglReleasePbufferDCEXT'); + if not Assigned(wglReleasePbufferDCEXT) then Exit; + @wglDestroyPbufferEXT := SDL_GL_GetProcAddress('wglDestroyPbufferEXT'); + if not Assigned(wglDestroyPbufferEXT) then Exit; + @wglQueryPbufferEXT := SDL_GL_GetProcAddress('wglQueryPbufferEXT'); + if not Assigned(wglQueryPbufferEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_WGL_EXT_pixel_format: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB'); + if not Assigned(wglGetExtensionsStringARB) then Exit; + extstring := wglGetExtensionsStringARB(wglGetCurrentDC); + + if glext_ExtensionSupported('WGL_EXT_pixel_format', extstring) then + begin + @wglGetPixelFormatAttribivEXT := SDL_GL_GetProcAddress('wglGetPixelFormatAttribivEXT'); + if not Assigned(wglGetPixelFormatAttribivEXT) then Exit; + @wglGetPixelFormatAttribfvEXT := SDL_GL_GetProcAddress('wglGetPixelFormatAttribfvEXT'); + if not Assigned(wglGetPixelFormatAttribfvEXT) then Exit; + @wglChoosePixelFormatEXT := SDL_GL_GetProcAddress('wglChoosePixelFormatEXT'); + if not Assigned(wglChoosePixelFormatEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_WGL_I3D_digital_video_control: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB'); + if not Assigned(wglGetExtensionsStringARB) then Exit; + extstring := wglGetExtensionsStringARB(wglGetCurrentDC); + + if glext_ExtensionSupported('WGL_I3D_digital_video_control', extstring) then + begin + @wglGetDigitalVideoParametersI3D := SDL_GL_GetProcAddress('wglGetDigitalVideoParametersI3D'); + if not Assigned(wglGetDigitalVideoParametersI3D) then Exit; + @wglSetDigitalVideoParametersI3D := SDL_GL_GetProcAddress('wglSetDigitalVideoParametersI3D'); + if not Assigned(wglSetDigitalVideoParametersI3D) then Exit; + Result := TRUE; + end; + +end; + +function Load_WGL_I3D_gamma: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB'); + if not Assigned(wglGetExtensionsStringARB) then Exit; + extstring := wglGetExtensionsStringARB(wglGetCurrentDC); + + if glext_ExtensionSupported('WGL_I3D_gamma', extstring) then + begin + @wglGetGammaTableParametersI3D := SDL_GL_GetProcAddress('wglGetGammaTableParametersI3D'); + if not Assigned(wglGetGammaTableParametersI3D) then Exit; + @wglSetGammaTableParametersI3D := SDL_GL_GetProcAddress('wglSetGammaTableParametersI3D'); + if not Assigned(wglSetGammaTableParametersI3D) then Exit; + @wglGetGammaTableI3D := SDL_GL_GetProcAddress('wglGetGammaTableI3D'); + if not Assigned(wglGetGammaTableI3D) then Exit; + @wglSetGammaTableI3D := SDL_GL_GetProcAddress('wglSetGammaTableI3D'); + if not Assigned(wglSetGammaTableI3D) then Exit; + Result := TRUE; + end; + +end; + +function Load_WGL_I3D_genlock: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB'); + if not Assigned(wglGetExtensionsStringARB) then Exit; + extstring := wglGetExtensionsStringARB(wglGetCurrentDC); + + if glext_ExtensionSupported('WGL_I3D_genlock', extstring) then + begin + @wglEnableGenlockI3D := SDL_GL_GetProcAddress('wglEnableGenlockI3D'); + if not Assigned(wglEnableGenlockI3D) then Exit; + @wglDisableGenlockI3D := SDL_GL_GetProcAddress('wglDisableGenlockI3D'); + if not Assigned(wglDisableGenlockI3D) then Exit; + @wglIsEnabledGenlockI3D := SDL_GL_GetProcAddress('wglIsEnabledGenlockI3D'); + if not Assigned(wglIsEnabledGenlockI3D) then Exit; + @wglGenlockSourceI3D := SDL_GL_GetProcAddress('wglGenlockSourceI3D'); + if not Assigned(wglGenlockSourceI3D) then Exit; + @wglGetGenlockSourceI3D := SDL_GL_GetProcAddress('wglGetGenlockSourceI3D'); + if not Assigned(wglGetGenlockSourceI3D) then Exit; + @wglGenlockSourceEdgeI3D := SDL_GL_GetProcAddress('wglGenlockSourceEdgeI3D'); + if not Assigned(wglGenlockSourceEdgeI3D) then Exit; + @wglGetGenlockSourceEdgeI3D := SDL_GL_GetProcAddress('wglGetGenlockSourceEdgeI3D'); + if not Assigned(wglGetGenlockSourceEdgeI3D) then Exit; + @wglGenlockSampleRateI3D := SDL_GL_GetProcAddress('wglGenlockSampleRateI3D'); + if not Assigned(wglGenlockSampleRateI3D) then Exit; + @wglGetGenlockSampleRateI3D := SDL_GL_GetProcAddress('wglGetGenlockSampleRateI3D'); + if not Assigned(wglGetGenlockSampleRateI3D) then Exit; + @wglGenlockSourceDelayI3D := SDL_GL_GetProcAddress('wglGenlockSourceDelayI3D'); + if not Assigned(wglGenlockSourceDelayI3D) then Exit; + @wglGetGenlockSourceDelayI3D := SDL_GL_GetProcAddress('wglGetGenlockSourceDelayI3D'); + if not Assigned(wglGetGenlockSourceDelayI3D) then Exit; + @wglQueryGenlockMaxSourceDelayI3D := SDL_GL_GetProcAddress('wglQueryGenlockMaxSourceDelayI3D'); + if not Assigned(wglQueryGenlockMaxSourceDelayI3D) then Exit; + Result := TRUE; + end; + +end; +{$ENDIF} + +function Load_GL_ARB_matrix_palette: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_matrix_palette', extstring) then + begin + @glCurrentPaletteMatrixARB := SDL_GL_GetProcAddress('glCurrentPaletteMatrixARB'); + if not Assigned(glCurrentPaletteMatrixARB) then Exit; + @glMatrixIndexubvARB := SDL_GL_GetProcAddress('glMatrixIndexubvARB'); + if not Assigned(glMatrixIndexubvARB) then Exit; + @glMatrixIndexusvARB := SDL_GL_GetProcAddress('glMatrixIndexusvARB'); + if not Assigned(glMatrixIndexusvARB) then Exit; + @glMatrixIndexuivARB := SDL_GL_GetProcAddress('glMatrixIndexuivARB'); + if not Assigned(glMatrixIndexuivARB) then Exit; + @glMatrixIndexPointerARB := SDL_GL_GetProcAddress('glMatrixIndexPointerARB'); + if not Assigned(glMatrixIndexPointerARB) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_NV_element_array: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_element_array', extstring) then + begin + @glElementPointerNV := SDL_GL_GetProcAddress('glElementPointerNV'); + if not Assigned(glElementPointerNV) then Exit; + @glDrawElementArrayNV := SDL_GL_GetProcAddress('glDrawElementArrayNV'); + if not Assigned(glDrawElementArrayNV) then Exit; + @glDrawRangeElementArrayNV := SDL_GL_GetProcAddress('glDrawRangeElementArrayNV'); + if not Assigned(glDrawRangeElementArrayNV) then Exit; + @glMultiDrawElementArrayNV := SDL_GL_GetProcAddress('glMultiDrawElementArrayNV'); + if not Assigned(glMultiDrawElementArrayNV) then Exit; + @glMultiDrawRangeElementArrayNV := SDL_GL_GetProcAddress('glMultiDrawRangeElementArrayNV'); + if not Assigned(glMultiDrawRangeElementArrayNV) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_NV_float_buffer: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_float_buffer', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_NV_fragment_program: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_fragment_program', extstring) then + begin + @glProgramNamedParameter4fNV := SDL_GL_GetProcAddress('glProgramNamedParameter4fNV'); + if not Assigned(glProgramNamedParameter4fNV) then Exit; + @glProgramNamedParameter4dNV := SDL_GL_GetProcAddress('glProgramNamedParameter4dNV'); + if not Assigned(glProgramNamedParameter4dNV) then Exit; + @glGetProgramNamedParameterfvNV := SDL_GL_GetProcAddress('glGetProgramNamedParameterfvNV'); + if not Assigned(glGetProgramNamedParameterfvNV) then Exit; + @glGetProgramNamedParameterdvNV := SDL_GL_GetProcAddress('glGetProgramNamedParameterdvNV'); + if not Assigned(glGetProgramNamedParameterdvNV) then Exit; + @glProgramLocalParameter4dARB := SDL_GL_GetProcAddress('glProgramLocalParameter4dARB'); + if not Assigned(glProgramLocalParameter4dARB) then Exit; + @glProgramLocalParameter4dvARB := SDL_GL_GetProcAddress('glProgramLocalParameter4dvARB'); + if not Assigned(glProgramLocalParameter4dvARB) then Exit; + @glProgramLocalParameter4fARB := SDL_GL_GetProcAddress('glProgramLocalParameter4fARB'); + if not Assigned(glProgramLocalParameter4fARB) then Exit; + @glProgramLocalParameter4fvARB := SDL_GL_GetProcAddress('glProgramLocalParameter4fvARB'); + if not Assigned(glProgramLocalParameter4fvARB) then Exit; + @glGetProgramLocalParameterdvARB := SDL_GL_GetProcAddress('glGetProgramLocalParameterdvARB'); + if not Assigned(glGetProgramLocalParameterdvARB) then Exit; + @glGetProgramLocalParameterfvARB := SDL_GL_GetProcAddress('glGetProgramLocalParameterfvARB'); + if not Assigned(glGetProgramLocalParameterfvARB) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_NV_primitive_restart: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_primitive_restart', extstring) then + begin + @glPrimitiveRestartNV := SDL_GL_GetProcAddress('glPrimitiveRestartNV'); + if not Assigned(glPrimitiveRestartNV) then Exit; + @glPrimitiveRestartIndexNV := SDL_GL_GetProcAddress('glPrimitiveRestartIndexNV'); + if not Assigned(glPrimitiveRestartIndexNV) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_NV_vertex_program2: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_vertex_program2', extstring) then + begin + Result := TRUE; + end; + +end; + +{$IFDEF WINDOWS} +function Load_WGL_NV_render_texture_rectangle: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB'); + if not Assigned(wglGetExtensionsStringARB) then Exit; + extstring := wglGetExtensionsStringARB(wglGetCurrentDC); + + if glext_ExtensionSupported('WGL_NV_render_texture_rectangle', extstring) then + begin + Result := TRUE; + end; + +end; +{$ENDIF} + +function Load_GL_NV_pixel_data_range: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_pixel_data_range', extstring) then + begin + @glPixelDataRangeNV := SDL_GL_GetProcAddress('glPixelDataRangeNV'); + if not Assigned(glPixelDataRangeNV) then Exit; + @glFlushPixelDataRangeNV := SDL_GL_GetProcAddress('glFlushPixelDataRangeNV'); + if not Assigned(glFlushPixelDataRangeNV) then Exit; + {$IFDEF WINDOWS} + @wglAllocateMemoryNV := SDL_GL_GetProcAddress('wglAllocateMemoryNV'); + if not Assigned(wglAllocateMemoryNV) then Exit; + @wglFreeMemoryNV := SDL_GL_GetProcAddress('wglFreeMemoryNV'); + if not Assigned(wglFreeMemoryNV) then Exit; + {$ENDIF} + Result := TRUE; + end; + +end; + +function Load_GL_EXT_texture_rectangle: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_texture_rectangle', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_S3_s3tc: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_S3_s3tc', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_ATI_draw_buffers: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ATI_draw_buffers', extstring) then + begin + @glDrawBuffersATI := SDL_GL_GetProcAddress('glDrawBuffersATI'); + if not Assigned(glDrawBuffersATI) then Exit; + Result := TRUE; + end; + +end; + +{$IFDEF WINDOWS} +function Load_WGL_ATI_pixel_format_float: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + @wglGetExtensionsStringARB := SDL_GL_GetProcAddress('wglGetExtensionsStringARB'); + if not Assigned(wglGetExtensionsStringARB) then Exit; + extstring := wglGetExtensionsStringARB(wglGetCurrentDC); + + if glext_ExtensionSupported('WGL_ATI_pixel_format_float', extstring) then + begin + Result := TRUE; + end; + +end; +{$ENDIF} + +function Load_GL_ATI_texture_env_combine3: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ATI_texture_env_combine3', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_ATI_texture_float: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ATI_texture_float', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_NV_texture_expand_normal: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_texture_expand_normal', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_NV_half_float: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_half_float', extstring) then + begin + @glVertex2hNV := SDL_GL_GetProcAddress('glVertex2hNV'); + if not Assigned(glVertex2hNV) then Exit; + @glVertex2hvNV := SDL_GL_GetProcAddress('glVertex2hvNV'); + if not Assigned(glVertex2hvNV) then Exit; + @glVertex3hNV := SDL_GL_GetProcAddress('glVertex3hNV'); + if not Assigned(glVertex3hNV) then Exit; + @glVertex3hvNV := SDL_GL_GetProcAddress('glVertex3hvNV'); + if not Assigned(glVertex3hvNV) then Exit; + @glVertex4hNV := SDL_GL_GetProcAddress('glVertex4hNV'); + if not Assigned(glVertex4hNV) then Exit; + @glVertex4hvNV := SDL_GL_GetProcAddress('glVertex4hvNV'); + if not Assigned(glVertex4hvNV) then Exit; + @glNormal3hNV := SDL_GL_GetProcAddress('glNormal3hNV'); + if not Assigned(glNormal3hNV) then Exit; + @glNormal3hvNV := SDL_GL_GetProcAddress('glNormal3hvNV'); + if not Assigned(glNormal3hvNV) then Exit; + @glColor3hNV := SDL_GL_GetProcAddress('glColor3hNV'); + if not Assigned(glColor3hNV) then Exit; + @glColor3hvNV := SDL_GL_GetProcAddress('glColor3hvNV'); + if not Assigned(glColor3hvNV) then Exit; + @glColor4hNV := SDL_GL_GetProcAddress('glColor4hNV'); + if not Assigned(glColor4hNV) then Exit; + @glColor4hvNV := SDL_GL_GetProcAddress('glColor4hvNV'); + if not Assigned(glColor4hvNV) then Exit; + @glTexCoord1hNV := SDL_GL_GetProcAddress('glTexCoord1hNV'); + if not Assigned(glTexCoord1hNV) then Exit; + @glTexCoord1hvNV := SDL_GL_GetProcAddress('glTexCoord1hvNV'); + if not Assigned(glTexCoord1hvNV) then Exit; + @glTexCoord2hNV := SDL_GL_GetProcAddress('glTexCoord2hNV'); + if not Assigned(glTexCoord2hNV) then Exit; + @glTexCoord2hvNV := SDL_GL_GetProcAddress('glTexCoord2hvNV'); + if not Assigned(glTexCoord2hvNV) then Exit; + @glTexCoord3hNV := SDL_GL_GetProcAddress('glTexCoord3hNV'); + if not Assigned(glTexCoord3hNV) then Exit; + @glTexCoord3hvNV := SDL_GL_GetProcAddress('glTexCoord3hvNV'); + if not Assigned(glTexCoord3hvNV) then Exit; + @glTexCoord4hNV := SDL_GL_GetProcAddress('glTexCoord4hNV'); + if not Assigned(glTexCoord4hNV) then Exit; + @glTexCoord4hvNV := SDL_GL_GetProcAddress('glTexCoord4hvNV'); + if not Assigned(glTexCoord4hvNV) then Exit; + @glMultiTexCoord1hNV := SDL_GL_GetProcAddress('glMultiTexCoord1hNV'); + if not Assigned(glMultiTexCoord1hNV) then Exit; + @glMultiTexCoord1hvNV := SDL_GL_GetProcAddress('glMultiTexCoord1hvNV'); + if not Assigned(glMultiTexCoord1hvNV) then Exit; + @glMultiTexCoord2hNV := SDL_GL_GetProcAddress('glMultiTexCoord2hNV'); + if not Assigned(glMultiTexCoord2hNV) then Exit; + @glMultiTexCoord2hvNV := SDL_GL_GetProcAddress('glMultiTexCoord2hvNV'); + if not Assigned(glMultiTexCoord2hvNV) then Exit; + @glMultiTexCoord3hNV := SDL_GL_GetProcAddress('glMultiTexCoord3hNV'); + if not Assigned(glMultiTexCoord3hNV) then Exit; + @glMultiTexCoord3hvNV := SDL_GL_GetProcAddress('glMultiTexCoord3hvNV'); + if not Assigned(glMultiTexCoord3hvNV) then Exit; + @glMultiTexCoord4hNV := SDL_GL_GetProcAddress('glMultiTexCoord4hNV'); + if not Assigned(glMultiTexCoord4hNV) then Exit; + @glMultiTexCoord4hvNV := SDL_GL_GetProcAddress('glMultiTexCoord4hvNV'); + if not Assigned(glMultiTexCoord4hvNV) then Exit; + @glFogCoordhNV := SDL_GL_GetProcAddress('glFogCoordhNV'); + if not Assigned(glFogCoordhNV) then Exit; + @glFogCoordhvNV := SDL_GL_GetProcAddress('glFogCoordhvNV'); + if not Assigned(glFogCoordhvNV) then Exit; + @glSecondaryColor3hNV := SDL_GL_GetProcAddress('glSecondaryColor3hNV'); + if not Assigned(glSecondaryColor3hNV) then Exit; + @glSecondaryColor3hvNV := SDL_GL_GetProcAddress('glSecondaryColor3hvNV'); + if not Assigned(glSecondaryColor3hvNV) then Exit; + @glVertexWeighthNV := SDL_GL_GetProcAddress('glVertexWeighthNV'); + if not Assigned(glVertexWeighthNV) then Exit; + @glVertexWeighthvNV := SDL_GL_GetProcAddress('glVertexWeighthvNV'); + if not Assigned(glVertexWeighthvNV) then Exit; + @glVertexAttrib1hNV := SDL_GL_GetProcAddress('glVertexAttrib1hNV'); + if not Assigned(glVertexAttrib1hNV) then Exit; + @glVertexAttrib1hvNV := SDL_GL_GetProcAddress('glVertexAttrib1hvNV'); + if not Assigned(glVertexAttrib1hvNV) then Exit; + @glVertexAttrib2hNV := SDL_GL_GetProcAddress('glVertexAttrib2hNV'); + if not Assigned(glVertexAttrib2hNV) then Exit; + @glVertexAttrib2hvNV := SDL_GL_GetProcAddress('glVertexAttrib2hvNV'); + if not Assigned(glVertexAttrib2hvNV) then Exit; + @glVertexAttrib3hNV := SDL_GL_GetProcAddress('glVertexAttrib3hNV'); + if not Assigned(glVertexAttrib3hNV) then Exit; + @glVertexAttrib3hvNV := SDL_GL_GetProcAddress('glVertexAttrib3hvNV'); + if not Assigned(glVertexAttrib3hvNV) then Exit; + @glVertexAttrib4hNV := SDL_GL_GetProcAddress('glVertexAttrib4hNV'); + if not Assigned(glVertexAttrib4hNV) then Exit; + @glVertexAttrib4hvNV := SDL_GL_GetProcAddress('glVertexAttrib4hvNV'); + if not Assigned(glVertexAttrib4hvNV) then Exit; + @glVertexAttribs1hvNV := SDL_GL_GetProcAddress('glVertexAttribs1hvNV'); + if not Assigned(glVertexAttribs1hvNV) then Exit; + @glVertexAttribs2hvNV := SDL_GL_GetProcAddress('glVertexAttribs2hvNV'); + if not Assigned(glVertexAttribs2hvNV) then Exit; + @glVertexAttribs3hvNV := SDL_GL_GetProcAddress('glVertexAttribs3hvNV'); + if not Assigned(glVertexAttribs3hvNV) then Exit; + @glVertexAttribs4hvNV := SDL_GL_GetProcAddress('glVertexAttribs4hvNV'); + if not Assigned(glVertexAttribs4hvNV) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_ATI_map_object_buffer: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ATI_map_object_buffer', extstring) then + begin + @glMapObjectBufferATI := SDL_GL_GetProcAddress('glMapObjectBufferATI'); + if not Assigned(glMapObjectBufferATI) then Exit; + @glUnmapObjectBufferATI := SDL_GL_GetProcAddress('glUnmapObjectBufferATI'); + if not Assigned(glUnmapObjectBufferATI) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_ATI_separate_stencil: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ATI_separate_stencil', extstring) then + begin + @glStencilOpSeparateATI := SDL_GL_GetProcAddress('glStencilOpSeparateATI'); + if not Assigned(glStencilOpSeparateATI) then Exit; + @glStencilFuncSeparateATI := SDL_GL_GetProcAddress('glStencilFuncSeparateATI'); + if not Assigned(glStencilFuncSeparateATI) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_ATI_vertex_attrib_array_object: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ATI_vertex_attrib_array_object', extstring) then + begin + @glVertexAttribArrayObjectATI := SDL_GL_GetProcAddress('glVertexAttribArrayObjectATI'); + if not Assigned(glVertexAttribArrayObjectATI) then Exit; + @glGetVertexAttribArrayObjectfvATI := SDL_GL_GetProcAddress('glGetVertexAttribArrayObjectfvATI'); + if not Assigned(glGetVertexAttribArrayObjectfvATI) then Exit; + @glGetVertexAttribArrayObjectivATI := SDL_GL_GetProcAddress('glGetVertexAttribArrayObjectivATI'); + if not Assigned(glGetVertexAttribArrayObjectivATI) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_ARB_vertex_buffer_object: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_vertex_buffer_object', extstring) then + begin + @glBindBufferARB := SDL_GL_GetProcAddress('glBindBufferARB'); + if not Assigned(glBindBufferARB) then Exit; + @glDeleteBuffersARB := SDL_GL_GetProcAddress('glDeleteBuffersARB'); + if not Assigned(glDeleteBuffersARB) then Exit; + @glGenBuffersARB := SDL_GL_GetProcAddress('glGenBuffersARB'); + if not Assigned(glGenBuffersARB) then Exit; + @glIsBufferARB := SDL_GL_GetProcAddress('glIsBufferARB'); + if not Assigned(glIsBufferARB) then Exit; + @glBufferDataARB := SDL_GL_GetProcAddress('glBufferDataARB'); + if not Assigned(glBufferDataARB) then Exit; + @glBufferSubDataARB := SDL_GL_GetProcAddress('glBufferSubDataARB'); + if not Assigned(glBufferSubDataARB) then Exit; + @glGetBufferSubDataARB := SDL_GL_GetProcAddress('glGetBufferSubDataARB'); + if not Assigned(glGetBufferSubDataARB) then Exit; + @glMapBufferARB := SDL_GL_GetProcAddress('glMapBufferARB'); + if not Assigned(glMapBufferARB) then Exit; + @glUnmapBufferARB := SDL_GL_GetProcAddress('glUnmapBufferARB'); + if not Assigned(glUnmapBufferARB) then Exit; + @glGetBufferParameterivARB := SDL_GL_GetProcAddress('glGetBufferParameterivARB'); + if not Assigned(glGetBufferParameterivARB) then Exit; + @glGetBufferPointervARB := SDL_GL_GetProcAddress('glGetBufferPointervARB'); + if not Assigned(glGetBufferPointervARB) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_ARB_occlusion_query: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_occlusion_query', extstring) then + begin + @glGenQueriesARB := SDL_GL_GetProcAddress('glGenQueriesARB'); + if not Assigned(glGenQueriesARB) then Exit; + @glDeleteQueriesARB := SDL_GL_GetProcAddress('glDeleteQueriesARB'); + if not Assigned(glDeleteQueriesARB) then Exit; + @glIsQueryARB := SDL_GL_GetProcAddress('glIsQueryARB'); + if not Assigned(glIsQueryARB) then Exit; + @glBeginQueryARB := SDL_GL_GetProcAddress('glBeginQueryARB'); + if not Assigned(glBeginQueryARB) then Exit; + @glEndQueryARB := SDL_GL_GetProcAddress('glEndQueryARB'); + if not Assigned(glEndQueryARB) then Exit; + @glGetQueryivARB := SDL_GL_GetProcAddress('glGetQueryivARB'); + if not Assigned(glGetQueryivARB) then Exit; + @glGetQueryObjectivARB := SDL_GL_GetProcAddress('glGetQueryObjectivARB'); + if not Assigned(glGetQueryObjectivARB) then Exit; + @glGetQueryObjectuivARB := SDL_GL_GetProcAddress('glGetQueryObjectuivARB'); + if not Assigned(glGetQueryObjectuivARB) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_ARB_shader_objects: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_shader_objects', extstring) then + begin + @glDeleteObjectARB := SDL_GL_GetProcAddress('glDeleteObjectARB'); + if not Assigned(glDeleteObjectARB) then Exit; + @glGetHandleARB := SDL_GL_GetProcAddress('glGetHandleARB'); + if not Assigned(glGetHandleARB) then Exit; + @glDetachObjectARB := SDL_GL_GetProcAddress('glDetachObjectARB'); + if not Assigned(glDetachObjectARB) then Exit; + @glCreateShaderObjectARB := SDL_GL_GetProcAddress('glCreateShaderObjectARB'); + if not Assigned(glCreateShaderObjectARB) then Exit; + @glShaderSourceARB := SDL_GL_GetProcAddress('glShaderSourceARB'); + if not Assigned(glShaderSourceARB) then Exit; + @glCompileShaderARB := SDL_GL_GetProcAddress('glCompileShaderARB'); + if not Assigned(glCompileShaderARB) then Exit; + @glCreateProgramObjectARB := SDL_GL_GetProcAddress('glCreateProgramObjectARB'); + if not Assigned(glCreateProgramObjectARB) then Exit; + @glAttachObjectARB := SDL_GL_GetProcAddress('glAttachObjectARB'); + if not Assigned(glAttachObjectARB) then Exit; + @glLinkProgramARB := SDL_GL_GetProcAddress('glLinkProgramARB'); + if not Assigned(glLinkProgramARB) then Exit; + @glUseProgramObjectARB := SDL_GL_GetProcAddress('glUseProgramObjectARB'); + if not Assigned(glUseProgramObjectARB) then Exit; + @glValidateProgramARB := SDL_GL_GetProcAddress('glValidateProgramARB'); + if not Assigned(glValidateProgramARB) then Exit; + @glUniform1fARB := SDL_GL_GetProcAddress('glUniform1fARB'); + if not Assigned(glUniform1fARB) then Exit; + @glUniform2fARB := SDL_GL_GetProcAddress('glUniform2fARB'); + if not Assigned(glUniform2fARB) then Exit; + @glUniform3fARB := SDL_GL_GetProcAddress('glUniform3fARB'); + if not Assigned(glUniform3fARB) then Exit; + @glUniform4fARB := SDL_GL_GetProcAddress('glUniform4fARB'); + if not Assigned(glUniform4fARB) then Exit; + @glUniform1iARB := SDL_GL_GetProcAddress('glUniform1iARB'); + if not Assigned(glUniform1iARB) then Exit; + @glUniform2iARB := SDL_GL_GetProcAddress('glUniform2iARB'); + if not Assigned(glUniform2iARB) then Exit; + @glUniform3iARB := SDL_GL_GetProcAddress('glUniform3iARB'); + if not Assigned(glUniform3iARB) then Exit; + @glUniform4iARB := SDL_GL_GetProcAddress('glUniform4iARB'); + if not Assigned(glUniform4iARB) then Exit; + @glUniform1fvARB := SDL_GL_GetProcAddress('glUniform1fvARB'); + if not Assigned(glUniform1fvARB) then Exit; + @glUniform2fvARB := SDL_GL_GetProcAddress('glUniform2fvARB'); + if not Assigned(glUniform2fvARB) then Exit; + @glUniform3fvARB := SDL_GL_GetProcAddress('glUniform3fvARB'); + if not Assigned(glUniform3fvARB) then Exit; + @glUniform4fvARB := SDL_GL_GetProcAddress('glUniform4fvARB'); + if not Assigned(glUniform4fvARB) then Exit; + @glUniform1ivARB := SDL_GL_GetProcAddress('glUniform1ivARB'); + if not Assigned(glUniform1ivARB) then Exit; + @glUniform2ivARB := SDL_GL_GetProcAddress('glUniform2ivARB'); + if not Assigned(glUniform2ivARB) then Exit; + @glUniform3ivARB := SDL_GL_GetProcAddress('glUniform3ivARB'); + if not Assigned(glUniform3ivARB) then Exit; + @glUniform4ivARB := SDL_GL_GetProcAddress('glUniform4ivARB'); + if not Assigned(glUniform4ivARB) then Exit; + @glUniformMatrix2fvARB := SDL_GL_GetProcAddress('glUniformMatrix2fvARB'); + if not Assigned(glUniformMatrix2fvARB) then Exit; + @glUniformMatrix3fvARB := SDL_GL_GetProcAddress('glUniformMatrix3fvARB'); + if not Assigned(glUniformMatrix3fvARB) then Exit; + @glUniformMatrix4fvARB := SDL_GL_GetProcAddress('glUniformMatrix4fvARB'); + if not Assigned(glUniformMatrix4fvARB) then Exit; + @glGetObjectParameterfvARB := SDL_GL_GetProcAddress('glGetObjectParameterfvARB'); + if not Assigned(glGetObjectParameterfvARB) then Exit; + @glGetObjectParameterivARB := SDL_GL_GetProcAddress('glGetObjectParameterivARB'); + if not Assigned(glGetObjectParameterivARB) then Exit; + @glGetInfoLogARB := SDL_GL_GetProcAddress('glGetInfoLogARB'); + if not Assigned(glGetInfoLogARB) then Exit; + @glGetAttachedObjectsARB := SDL_GL_GetProcAddress('glGetAttachedObjectsARB'); + if not Assigned(glGetAttachedObjectsARB) then Exit; + @glGetUniformLocationARB := SDL_GL_GetProcAddress('glGetUniformLocationARB'); + if not Assigned(glGetUniformLocationARB) then Exit; + @glGetActiveUniformARB := SDL_GL_GetProcAddress('glGetActiveUniformARB'); + if not Assigned(glGetActiveUniformARB) then Exit; + @glGetUniformfvARB := SDL_GL_GetProcAddress('glGetUniformfvARB'); + if not Assigned(glGetUniformfvARB) then Exit; + @glGetUniformivARB := SDL_GL_GetProcAddress('glGetUniformivARB'); + if not Assigned(glGetUniformivARB) then Exit; + @glGetShaderSourceARB := SDL_GL_GetProcAddress('glGetShaderSourceARB'); + if not Assigned(glGetShaderSourceARB) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_ARB_vertex_shader: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_vertex_shader', extstring) then + begin + @glVertexAttrib1fARB := SDL_GL_GetProcAddress('glVertexAttrib1fARB'); + if not Assigned(glVertexAttrib1fARB) then Exit; + @glVertexAttrib1sARB := SDL_GL_GetProcAddress('glVertexAttrib1sARB'); + if not Assigned(glVertexAttrib1sARB) then Exit; + @glVertexAttrib1dARB := SDL_GL_GetProcAddress('glVertexAttrib1dARB'); + if not Assigned(glVertexAttrib1dARB) then Exit; + @glVertexAttrib2fARB := SDL_GL_GetProcAddress('glVertexAttrib2fARB'); + if not Assigned(glVertexAttrib2fARB) then Exit; + @glVertexAttrib2sARB := SDL_GL_GetProcAddress('glVertexAttrib2sARB'); + if not Assigned(glVertexAttrib2sARB) then Exit; + @glVertexAttrib2dARB := SDL_GL_GetProcAddress('glVertexAttrib2dARB'); + if not Assigned(glVertexAttrib2dARB) then Exit; + @glVertexAttrib3fARB := SDL_GL_GetProcAddress('glVertexAttrib3fARB'); + if not Assigned(glVertexAttrib3fARB) then Exit; + @glVertexAttrib3sARB := SDL_GL_GetProcAddress('glVertexAttrib3sARB'); + if not Assigned(glVertexAttrib3sARB) then Exit; + @glVertexAttrib3dARB := SDL_GL_GetProcAddress('glVertexAttrib3dARB'); + if not Assigned(glVertexAttrib3dARB) then Exit; + @glVertexAttrib4fARB := SDL_GL_GetProcAddress('glVertexAttrib4fARB'); + if not Assigned(glVertexAttrib4fARB) then Exit; + @glVertexAttrib4sARB := SDL_GL_GetProcAddress('glVertexAttrib4sARB'); + if not Assigned(glVertexAttrib4sARB) then Exit; + @glVertexAttrib4dARB := SDL_GL_GetProcAddress('glVertexAttrib4dARB'); + if not Assigned(glVertexAttrib4dARB) then Exit; + @glVertexAttrib4NubARB := SDL_GL_GetProcAddress('glVertexAttrib4NubARB'); + if not Assigned(glVertexAttrib4NubARB) then Exit; + @glVertexAttrib1fvARB := SDL_GL_GetProcAddress('glVertexAttrib1fvARB'); + if not Assigned(glVertexAttrib1fvARB) then Exit; + @glVertexAttrib1svARB := SDL_GL_GetProcAddress('glVertexAttrib1svARB'); + if not Assigned(glVertexAttrib1svARB) then Exit; + @glVertexAttrib1dvARB := SDL_GL_GetProcAddress('glVertexAttrib1dvARB'); + if not Assigned(glVertexAttrib1dvARB) then Exit; + @glVertexAttrib2fvARB := SDL_GL_GetProcAddress('glVertexAttrib2fvARB'); + if not Assigned(glVertexAttrib2fvARB) then Exit; + @glVertexAttrib2svARB := SDL_GL_GetProcAddress('glVertexAttrib2svARB'); + if not Assigned(glVertexAttrib2svARB) then Exit; + @glVertexAttrib2dvARB := SDL_GL_GetProcAddress('glVertexAttrib2dvARB'); + if not Assigned(glVertexAttrib2dvARB) then Exit; + @glVertexAttrib3fvARB := SDL_GL_GetProcAddress('glVertexAttrib3fvARB'); + if not Assigned(glVertexAttrib3fvARB) then Exit; + @glVertexAttrib3svARB := SDL_GL_GetProcAddress('glVertexAttrib3svARB'); + if not Assigned(glVertexAttrib3svARB) then Exit; + @glVertexAttrib3dvARB := SDL_GL_GetProcAddress('glVertexAttrib3dvARB'); + if not Assigned(glVertexAttrib3dvARB) then Exit; + @glVertexAttrib4fvARB := SDL_GL_GetProcAddress('glVertexAttrib4fvARB'); + if not Assigned(glVertexAttrib4fvARB) then Exit; + @glVertexAttrib4svARB := SDL_GL_GetProcAddress('glVertexAttrib4svARB'); + if not Assigned(glVertexAttrib4svARB) then Exit; + @glVertexAttrib4dvARB := SDL_GL_GetProcAddress('glVertexAttrib4dvARB'); + if not Assigned(glVertexAttrib4dvARB) then Exit; + @glVertexAttrib4ivARB := SDL_GL_GetProcAddress('glVertexAttrib4ivARB'); + if not Assigned(glVertexAttrib4ivARB) then Exit; + @glVertexAttrib4bvARB := SDL_GL_GetProcAddress('glVertexAttrib4bvARB'); + if not Assigned(glVertexAttrib4bvARB) then Exit; + @glVertexAttrib4ubvARB := SDL_GL_GetProcAddress('glVertexAttrib4ubvARB'); + if not Assigned(glVertexAttrib4ubvARB) then Exit; + @glVertexAttrib4usvARB := SDL_GL_GetProcAddress('glVertexAttrib4usvARB'); + if not Assigned(glVertexAttrib4usvARB) then Exit; + @glVertexAttrib4uivARB := SDL_GL_GetProcAddress('glVertexAttrib4uivARB'); + if not Assigned(glVertexAttrib4uivARB) then Exit; + @glVertexAttrib4NbvARB := SDL_GL_GetProcAddress('glVertexAttrib4NbvARB'); + if not Assigned(glVertexAttrib4NbvARB) then Exit; + @glVertexAttrib4NsvARB := SDL_GL_GetProcAddress('glVertexAttrib4NsvARB'); + if not Assigned(glVertexAttrib4NsvARB) then Exit; + @glVertexAttrib4NivARB := SDL_GL_GetProcAddress('glVertexAttrib4NivARB'); + if not Assigned(glVertexAttrib4NivARB) then Exit; + @glVertexAttrib4NubvARB := SDL_GL_GetProcAddress('glVertexAttrib4NubvARB'); + if not Assigned(glVertexAttrib4NubvARB) then Exit; + @glVertexAttrib4NusvARB := SDL_GL_GetProcAddress('glVertexAttrib4NusvARB'); + if not Assigned(glVertexAttrib4NusvARB) then Exit; + @glVertexAttrib4NuivARB := SDL_GL_GetProcAddress('glVertexAttrib4NuivARB'); + if not Assigned(glVertexAttrib4NuivARB) then Exit; + @glVertexAttribPointerARB := SDL_GL_GetProcAddress('glVertexAttribPointerARB'); + if not Assigned(glVertexAttribPointerARB) then Exit; + @glEnableVertexAttribArrayARB := SDL_GL_GetProcAddress('glEnableVertexAttribArrayARB'); + if not Assigned(glEnableVertexAttribArrayARB) then Exit; + @glDisableVertexAttribArrayARB := SDL_GL_GetProcAddress('glDisableVertexAttribArrayARB'); + if not Assigned(glDisableVertexAttribArrayARB) then Exit; + @glBindAttribLocationARB := SDL_GL_GetProcAddress('glBindAttribLocationARB'); + if not Assigned(glBindAttribLocationARB) then Exit; + @glGetActiveAttribARB := SDL_GL_GetProcAddress('glGetActiveAttribARB'); + if not Assigned(glGetActiveAttribARB) then Exit; + @glGetAttribLocationARB := SDL_GL_GetProcAddress('glGetAttribLocationARB'); + if not Assigned(glGetAttribLocationARB) then Exit; + @glGetVertexAttribdvARB := SDL_GL_GetProcAddress('glGetVertexAttribdvARB'); + if not Assigned(glGetVertexAttribdvARB) then Exit; + @glGetVertexAttribfvARB := SDL_GL_GetProcAddress('glGetVertexAttribfvARB'); + if not Assigned(glGetVertexAttribfvARB) then Exit; + @glGetVertexAttribivARB := SDL_GL_GetProcAddress('glGetVertexAttribivARB'); + if not Assigned(glGetVertexAttribivARB) then Exit; + @glGetVertexAttribPointervARB := SDL_GL_GetProcAddress('glGetVertexAttribPointervARB'); + if not Assigned(glGetVertexAttribPointervARB) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_ARB_fragment_shader: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_fragment_shader', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_ARB_shading_language_100: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_shading_language_100', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_ARB_texture_non_power_of_two: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_texture_non_power_of_two', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_ARB_point_sprite: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_point_sprite', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_EXT_depth_bounds_test: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_depth_bounds_test', extstring) then + begin + @glDepthBoundsEXT := SDL_GL_GetProcAddress('glDepthBoundsEXT'); + if not Assigned(glDepthBoundsEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_EXT_secondary_color: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_secondary_color', extstring) then + begin + @glSecondaryColor3bEXT := SDL_GL_GetProcAddress('glSecondaryColor3bEXT'); + if not Assigned(glSecondaryColor3bEXT) then Exit; + @glSecondaryColor3sEXT := SDL_GL_GetProcAddress('glSecondaryColor3sEXT'); + if not Assigned(glSecondaryColor3sEXT) then Exit; + @glSecondaryColor3iEXT := SDL_GL_GetProcAddress('glSecondaryColor3iEXT'); + if not Assigned(glSecondaryColor3iEXT) then Exit; + @glSecondaryColor3fEXT := SDL_GL_GetProcAddress('glSecondaryColor3fEXT'); + if not Assigned(glSecondaryColor3fEXT) then Exit; + @glSecondaryColor3dEXT := SDL_GL_GetProcAddress('glSecondaryColor3dEXT'); + if not Assigned(glSecondaryColor3dEXT) then Exit; + @glSecondaryColor3ubEXT := SDL_GL_GetProcAddress('glSecondaryColor3ubEXT'); + if not Assigned(glSecondaryColor3ubEXT) then Exit; + @glSecondaryColor3usEXT := SDL_GL_GetProcAddress('glSecondaryColor3usEXT'); + if not Assigned(glSecondaryColor3usEXT) then Exit; + @glSecondaryColor3uiEXT := SDL_GL_GetProcAddress('glSecondaryColor3uiEXT'); + if not Assigned(glSecondaryColor3uiEXT) then Exit; + @glSecondaryColor3bvEXT := SDL_GL_GetProcAddress('glSecondaryColor3bvEXT'); + if not Assigned(glSecondaryColor3bvEXT) then Exit; + @glSecondaryColor3svEXT := SDL_GL_GetProcAddress('glSecondaryColor3svEXT'); + if not Assigned(glSecondaryColor3svEXT) then Exit; + @glSecondaryColor3ivEXT := SDL_GL_GetProcAddress('glSecondaryColor3ivEXT'); + if not Assigned(glSecondaryColor3ivEXT) then Exit; + @glSecondaryColor3fvEXT := SDL_GL_GetProcAddress('glSecondaryColor3fvEXT'); + if not Assigned(glSecondaryColor3fvEXT) then Exit; + @glSecondaryColor3dvEXT := SDL_GL_GetProcAddress('glSecondaryColor3dvEXT'); + if not Assigned(glSecondaryColor3dvEXT) then Exit; + @glSecondaryColor3ubvEXT := SDL_GL_GetProcAddress('glSecondaryColor3ubvEXT'); + if not Assigned(glSecondaryColor3ubvEXT) then Exit; + @glSecondaryColor3usvEXT := SDL_GL_GetProcAddress('glSecondaryColor3usvEXT'); + if not Assigned(glSecondaryColor3usvEXT) then Exit; + @glSecondaryColor3uivEXT := SDL_GL_GetProcAddress('glSecondaryColor3uivEXT'); + if not Assigned(glSecondaryColor3uivEXT) then Exit; + @glSecondaryColorPointerEXT := SDL_GL_GetProcAddress('glSecondaryColorPointerEXT'); + if not Assigned(glSecondaryColorPointerEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_EXT_texture_mirror_clamp: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_texture_mirror_clamp', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_EXT_blend_equation_separate: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_blend_equation_separate', extstring) then + begin + @glBlendEquationSeparateEXT := SDL_GL_GetProcAddress('glBlendEquationSeparateEXT'); + if not Assigned(glBlendEquationSeparateEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_MESA_pack_invert: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_MESA_pack_invert', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_MESA_ycbcr_texture: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_MESA_ycbcr_texture', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_ARB_fragment_program_shadow: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_ARB_fragment_program_shadow', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_EXT_fog_coord: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_fog_coord', extstring) then + begin + @glFogCoordfEXT := SDL_GL_GetProcAddress('glFogCoordfEXT'); + if not Assigned(glFogCoordfEXT) then Exit; + @glFogCoorddEXT := SDL_GL_GetProcAddress('glFogCoorddEXT'); + if not Assigned(glFogCoorddEXT) then Exit; + @glFogCoordfvEXT := SDL_GL_GetProcAddress('glFogCoordfvEXT'); + if not Assigned(glFogCoordfvEXT) then Exit; + @glFogCoorddvEXT := SDL_GL_GetProcAddress('glFogCoorddvEXT'); + if not Assigned(glFogCoorddvEXT) then Exit; + @glFogCoordPointerEXT := SDL_GL_GetProcAddress('glFogCoordPointerEXT'); + if not Assigned(glFogCoordPointerEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_NV_fragment_program_option: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_fragment_program_option', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_EXT_pixel_buffer_object: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_EXT_pixel_buffer_object', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_NV_fragment_program2: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_fragment_program2', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_NV_vertex_program2_option: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_vertex_program2_option', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_NV_vertex_program3: Boolean; +var + extstring : PChar; +begin + + Result := FALSE; + extstring := glGetString( GL_EXTENSIONS ); + + if glext_ExtensionSupported('GL_NV_vertex_program3', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_ARB_draw_buffers: Boolean; +var + extstring: PChar; +begin + + Result := FALSE; + extstring := glGetString(GL_EXTENSIONS); + + if glext_ExtensionSupported('GL_ARB_draw_buffers', extstring) then + begin + glDrawBuffersARB := SDL_GL_GetProcAddress('glDrawBuffersARB'); + if not Assigned(glDrawBuffersARB) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_ARB_texture_rectangle: Boolean; +var + extstring: PChar; +begin + + Result := FALSE; + extstring := glGetString(GL_EXTENSIONS); + + if glext_ExtensionSupported('GL_ARB_texture_rectangle', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_ARB_color_buffer_float: Boolean; +var + extstring: PChar; +begin + + Result := FALSE; + extstring := glGetString(GL_EXTENSIONS); + + if glext_ExtensionSupported('GL_ARB_color_buffer_float', extstring) then + begin + glClampColorARB := SDL_GL_GetProcAddress('glClampColorARB'); + if not Assigned(glClampColorARB) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_ARB_half_float_pixel: Boolean; +var + extstring: PChar; +begin + + Result := FALSE; + extstring := glGetString(GL_EXTENSIONS); + + if glext_ExtensionSupported('GL_ARB_half_float_pixel', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_ARB_texture_float: Boolean; +var + extstring: PChar; +begin + + Result := FALSE; + extstring := glGetString(GL_EXTENSIONS); + + if glext_ExtensionSupported('GL_ARB_texture_float', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_EXT_texture_compression_dxt1: Boolean; +var + extstring: PChar; +begin + + Result := FALSE; + extstring := glGetString(GL_EXTENSIONS); + + if glext_ExtensionSupported('GL_EXT_texture_compression_dxt1', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_ARB_pixel_buffer_object: Boolean; +var + extstring: PChar; +begin + + Result := FALSE; + extstring := glGetString(GL_EXTENSIONS); + + if glext_ExtensionSupported('GL_ARB_pixel_buffer_object', extstring) then + begin + Result := TRUE; + end; + +end; + +function Load_GL_EXT_framebuffer_object: Boolean; +var + extstring: PChar; +begin + + Result := FALSE; + extstring := glGetString(GL_EXTENSIONS); + + if glext_ExtensionSupported('GL_EXT_framebuffer_object', extstring) then + begin + glIsRenderbufferEXT := SDL_GL_GetProcAddress('glIsRenderbufferEXT'); + if not Assigned(glIsRenderbufferEXT) then Exit; + glBindRenderbufferEXT := SDL_GL_GetProcAddress('glBindRenderbufferEXT'); + if not Assigned(glBindRenderbufferEXT) then Exit; + glDeleteRenderbuffersEXT := SDL_GL_GetProcAddress('glDeleteRenderbuffersEXT'); + if not Assigned(glDeleteRenderbuffersEXT) then Exit; + glGenRenderbuffersEXT := SDL_GL_GetProcAddress('glGenRenderbuffersEXT'); + if not Assigned(glGenRenderbuffersEXT) then Exit; + glRenderbufferStorageEXT := SDL_GL_GetProcAddress('glRenderbufferStorageEXT'); + if not Assigned(glRenderbufferStorageEXT) then Exit; + glGetRenderbufferParameterivEXT := SDL_GL_GetProcAddress('glGetRenderbufferParameterivEXT'); + if not Assigned(glGetRenderbufferParameterivEXT) then Exit; + glIsFramebufferEXT := SDL_GL_GetProcAddress('glIsFramebufferEXT'); + if not Assigned(glIsFramebufferEXT) then Exit; + glBindFramebufferEXT := SDL_GL_GetProcAddress('glBindFramebufferEXT'); + if not Assigned(glBindFramebufferEXT) then Exit; + glDeleteFramebuffersEXT := SDL_GL_GetProcAddress('glDeleteFramebuffersEXT'); + if not Assigned(glDeleteFramebuffersEXT) then Exit; + glGenFramebuffersEXT := SDL_GL_GetProcAddress('glGenFramebuffersEXT'); + if not Assigned(glGenFramebuffersEXT) then Exit; + glCheckFramebufferStatusEXT := SDL_GL_GetProcAddress('glCheckFramebufferStatusEXT'); + if not Assigned(glCheckFramebufferStatusEXT) then Exit; + glFramebufferTexture1DEXT := SDL_GL_GetProcAddress('glFramebufferTexture1DEXT'); + if not Assigned(glFramebufferTexture1DEXT) then Exit; + glFramebufferTexture2DEXT := SDL_GL_GetProcAddress('glFramebufferTexture2DEXT'); + if not Assigned(glFramebufferTexture2DEXT) then Exit; + glFramebufferTexture3DEXT := SDL_GL_GetProcAddress('glFramebufferTexture3DEXT'); + if not Assigned(glFramebufferTexture3DEXT) then Exit; + glFramebufferRenderbufferEXT := SDL_GL_GetProcAddress('glFramebufferRenderbufferEXT'); + if not Assigned(glFramebufferRenderbufferEXT) then Exit; + glGetFramebufferAttachmentParameterivEXT := SDL_GL_GetProcAddress('glGetFramebufferAttachmentParameterivEXT'); + if not Assigned(glGetFramebufferAttachmentParameterivEXT) then Exit; + glGenerateMipmapEXT := SDL_GL_GetProcAddress('glGenerateMipmapEXT'); + if not Assigned(glGenerateMipmapEXT) then Exit; + Result := TRUE; + end; + +end; + +function Load_GL_version_1_4: Boolean; +var + extstring: String; +begin + + Result := FALSE; + extstring := String(PChar(glGetString(GL_EXTENSIONS))); + + glBlendFuncSeparate := SDL_GL_GetProcAddress('glBlendFuncSeparate'); + if not Assigned(glBlendFuncSeparate) then Exit; + glFogCoordf := SDL_GL_GetProcAddress('glFogCoordf'); + if not Assigned(glFogCoordf) then Exit; + glFogCoordfv := SDL_GL_GetProcAddress('glFogCoordfv'); + if not Assigned(glFogCoordfv) then Exit; + glFogCoordd := SDL_GL_GetProcAddress('glFogCoordd'); + if not Assigned(glFogCoordd) then Exit; + glFogCoorddv := SDL_GL_GetProcAddress('glFogCoorddv'); + if not Assigned(glFogCoorddv) then Exit; + glFogCoordPointer := SDL_GL_GetProcAddress('glFogCoordPointer'); + if not Assigned(glFogCoordPointer) then Exit; + glMultiDrawArrays := SDL_GL_GetProcAddress('glMultiDrawArrays'); + if not Assigned(glMultiDrawArrays) then Exit; + glMultiDrawElements := SDL_GL_GetProcAddress('glMultiDrawElements'); + if not Assigned(glMultiDrawElements) then Exit; + glPointParameterf := SDL_GL_GetProcAddress('glPointParameterf'); + if not Assigned(glPointParameterf) then Exit; + glPointParameterfv := SDL_GL_GetProcAddress('glPointParameterfv'); + if not Assigned(glPointParameterfv) then Exit; + glPointParameteri := SDL_GL_GetProcAddress('glPointParameteri'); + if not Assigned(glPointParameteri) then Exit; + glPointParameteriv := SDL_GL_GetProcAddress('glPointParameteriv'); + if not Assigned(glPointParameteriv) then Exit; + glSecondaryColor3b := SDL_GL_GetProcAddress('glSecondaryColor3b'); + if not Assigned(glSecondaryColor3b) then Exit; + glSecondaryColor3bv := SDL_GL_GetProcAddress('glSecondaryColor3bv'); + if not Assigned(glSecondaryColor3bv) then Exit; + glSecondaryColor3d := SDL_GL_GetProcAddress('glSecondaryColor3d'); + if not Assigned(glSecondaryColor3d) then Exit; + glSecondaryColor3dv := SDL_GL_GetProcAddress('glSecondaryColor3dv'); + if not Assigned(glSecondaryColor3dv) then Exit; + glSecondaryColor3f := SDL_GL_GetProcAddress('glSecondaryColor3f'); + if not Assigned(glSecondaryColor3f) then Exit; + glSecondaryColor3fv := SDL_GL_GetProcAddress('glSecondaryColor3fv'); + if not Assigned(glSecondaryColor3fv) then Exit; + glSecondaryColor3i := SDL_GL_GetProcAddress('glSecondaryColor3i'); + if not Assigned(glSecondaryColor3i) then Exit; + glSecondaryColor3iv := SDL_GL_GetProcAddress('glSecondaryColor3iv'); + if not Assigned(glSecondaryColor3iv) then Exit; + glSecondaryColor3s := SDL_GL_GetProcAddress('glSecondaryColor3s'); + if not Assigned(glSecondaryColor3s) then Exit; + glSecondaryColor3sv := SDL_GL_GetProcAddress('glSecondaryColor3sv'); + if not Assigned(glSecondaryColor3sv) then Exit; + glSecondaryColor3ub := SDL_GL_GetProcAddress('glSecondaryColor3ub'); + if not Assigned(glSecondaryColor3ub) then Exit; + glSecondaryColor3ubv := SDL_GL_GetProcAddress('glSecondaryColor3ubv'); + if not Assigned(glSecondaryColor3ubv) then Exit; + glSecondaryColor3ui := SDL_GL_GetProcAddress('glSecondaryColor3ui'); + if not Assigned(glSecondaryColor3ui) then Exit; + glSecondaryColor3uiv := SDL_GL_GetProcAddress('glSecondaryColor3uiv'); + if not Assigned(glSecondaryColor3uiv) then Exit; + glSecondaryColor3us := SDL_GL_GetProcAddress('glSecondaryColor3us'); + if not Assigned(glSecondaryColor3us) then Exit; + glSecondaryColor3usv := SDL_GL_GetProcAddress('glSecondaryColor3usv'); + if not Assigned(glSecondaryColor3usv) then Exit; + glSecondaryColorPointer := SDL_GL_GetProcAddress('glSecondaryColorPointer'); + if not Assigned(glSecondaryColorPointer) then Exit; + glWindowPos2d := SDL_GL_GetProcAddress('glWindowPos2d'); + if not Assigned(glWindowPos2d) then Exit; + glWindowPos2dv := SDL_GL_GetProcAddress('glWindowPos2dv'); + if not Assigned(glWindowPos2dv) then Exit; + glWindowPos2f := SDL_GL_GetProcAddress('glWindowPos2f'); + if not Assigned(glWindowPos2f) then Exit; + glWindowPos2fv := SDL_GL_GetProcAddress('glWindowPos2fv'); + if not Assigned(glWindowPos2fv) then Exit; + glWindowPos2i := SDL_GL_GetProcAddress('glWindowPos2i'); + if not Assigned(glWindowPos2i) then Exit; + glWindowPos2iv := SDL_GL_GetProcAddress('glWindowPos2iv'); + if not Assigned(glWindowPos2iv) then Exit; + glWindowPos2s := SDL_GL_GetProcAddress('glWindowPos2s'); + if not Assigned(glWindowPos2s) then Exit; + glWindowPos2sv := SDL_GL_GetProcAddress('glWindowPos2sv'); + if not Assigned(glWindowPos2sv) then Exit; + glWindowPos3d := SDL_GL_GetProcAddress('glWindowPos3d'); + if not Assigned(glWindowPos3d) then Exit; + glWindowPos3dv := SDL_GL_GetProcAddress('glWindowPos3dv'); + if not Assigned(glWindowPos3dv) then Exit; + glWindowPos3f := SDL_GL_GetProcAddress('glWindowPos3f'); + if not Assigned(glWindowPos3f) then Exit; + glWindowPos3fv := SDL_GL_GetProcAddress('glWindowPos3fv'); + if not Assigned(glWindowPos3fv) then Exit; + glWindowPos3i := SDL_GL_GetProcAddress('glWindowPos3i'); + if not Assigned(glWindowPos3i) then Exit; + glWindowPos3iv := SDL_GL_GetProcAddress('glWindowPos3iv'); + if not Assigned(glWindowPos3iv) then Exit; + glWindowPos3s := SDL_GL_GetProcAddress('glWindowPos3s'); + if not Assigned(glWindowPos3s) then Exit; + glWindowPos3sv := SDL_GL_GetProcAddress('glWindowPos3sv'); + if not Assigned(glWindowPos3sv) then Exit; + Result := TRUE; + +end; + +function Load_GL_version_1_5: Boolean; +var + extstring: String; +begin + + Result := FALSE; + extstring := String(PChar(glGetString(GL_EXTENSIONS))); + + glGenQueries := SDL_GL_GetProcAddress('glGenQueries'); + if not Assigned(glGenQueries) then Exit; + glDeleteQueries := SDL_GL_GetProcAddress('glDeleteQueries'); + if not Assigned(glDeleteQueries) then Exit; + glIsQuery := SDL_GL_GetProcAddress('glIsQuery'); + if not Assigned(glIsQuery) then Exit; + glBeginQuery := SDL_GL_GetProcAddress('glBeginQuery'); + if not Assigned(glBeginQuery) then Exit; + glEndQuery := SDL_GL_GetProcAddress('glEndQuery'); + if not Assigned(glEndQuery) then Exit; + glGetQueryiv := SDL_GL_GetProcAddress('glGetQueryiv'); + if not Assigned(glGetQueryiv) then Exit; + glGetQueryObjectiv := SDL_GL_GetProcAddress('glGetQueryObjectiv'); + if not Assigned(glGetQueryObjectiv) then Exit; + glGetQueryObjectuiv := SDL_GL_GetProcAddress('glGetQueryObjectuiv'); + if not Assigned(glGetQueryObjectuiv) then Exit; + glBindBuffer := SDL_GL_GetProcAddress('glBindBuffer'); + if not Assigned(glBindBuffer) then Exit; + glDeleteBuffers := SDL_GL_GetProcAddress('glDeleteBuffers'); + if not Assigned(glDeleteBuffers) then Exit; + glGenBuffers := SDL_GL_GetProcAddress('glGenBuffers'); + if not Assigned(glGenBuffers) then Exit; + glIsBuffer := SDL_GL_GetProcAddress('glIsBuffer'); + if not Assigned(glIsBuffer) then Exit; + glBufferData := SDL_GL_GetProcAddress('glBufferData'); + if not Assigned(glBufferData) then Exit; + glBufferSubData := SDL_GL_GetProcAddress('glBufferSubData'); + if not Assigned(glBufferSubData) then Exit; + glGetBufferSubData := SDL_GL_GetProcAddress('glGetBufferSubData'); + if not Assigned(glGetBufferSubData) then Exit; + glMapBuffer := SDL_GL_GetProcAddress('glMapBuffer'); + if not Assigned(glMapBuffer) then Exit; + glUnmapBuffer := SDL_GL_GetProcAddress('glUnmapBuffer'); + if not Assigned(glUnmapBuffer) then Exit; + glGetBufferParameteriv := SDL_GL_GetProcAddress('glGetBufferParameteriv'); + if not Assigned(glGetBufferParameteriv) then Exit; + glGetBufferPointerv := SDL_GL_GetProcAddress('glGetBufferPointerv'); + if not Assigned(glGetBufferPointerv) then Exit; + Result := TRUE; + +end; + +function Load_GL_version_2_0: Boolean; +var + extstring: String; +begin + + Result := FALSE; + extstring := String(PChar(glGetString(GL_EXTENSIONS))); + + glBlendEquationSeparate := SDL_GL_GetProcAddress('glBlendEquationSeparate'); + if not Assigned(glBlendEquationSeparate) then Exit; + glDrawBuffers := SDL_GL_GetProcAddress('glDrawBuffers'); + if not Assigned(glDrawBuffers) then Exit; + glStencilOpSeparate := SDL_GL_GetProcAddress('glStencilOpSeparate'); + if not Assigned(glStencilOpSeparate) then Exit; + glStencilFuncSeparate := SDL_GL_GetProcAddress('glStencilFuncSeparate'); + if not Assigned(glStencilFuncSeparate) then Exit; + glStencilMaskSeparate := SDL_GL_GetProcAddress('glStencilMaskSeparate'); + if not Assigned(glStencilMaskSeparate) then Exit; + glAttachShader := SDL_GL_GetProcAddress('glAttachShader'); + if not Assigned(glAttachShader) then Exit; + glBindAttribLocation := SDL_GL_GetProcAddress('glBindAttribLocation'); + if not Assigned(glBindAttribLocation) then Exit; + glCompileShader := SDL_GL_GetProcAddress('glCompileShader'); + if not Assigned(glCompileShader) then Exit; + glCreateProgram := SDL_GL_GetProcAddress('glCreateProgram'); + if not Assigned(glCreateProgram) then Exit; + glCreateShader := SDL_GL_GetProcAddress('glCreateShader'); + if not Assigned(glCreateShader) then Exit; + glDeleteProgram := SDL_GL_GetProcAddress('glDeleteProgram'); + if not Assigned(glDeleteProgram) then Exit; + glDeleteShader := SDL_GL_GetProcAddress('glDeleteShader'); + if not Assigned(glDeleteShader) then Exit; + glDetachShader := SDL_GL_GetProcAddress('glDetachShader'); + if not Assigned(glDetachShader) then Exit; + glDisableVertexAttribArray := SDL_GL_GetProcAddress('glDisableVertexAttribArray'); + if not Assigned(glDisableVertexAttribArray) then Exit; + glEnableVertexAttribArray := SDL_GL_GetProcAddress('glEnableVertexAttribArray'); + if not Assigned(glEnableVertexAttribArray) then Exit; + glGetActiveAttrib := SDL_GL_GetProcAddress('glGetActiveAttrib'); + if not Assigned(glGetActiveAttrib) then Exit; + glGetActiveUniform := SDL_GL_GetProcAddress('glGetActiveUniform'); + if not Assigned(glGetActiveUniform) then Exit; + glGetAttachedShaders := SDL_GL_GetProcAddress('glGetAttachedShaders'); + if not Assigned(glGetAttachedShaders) then Exit; + glGetAttribLocation := SDL_GL_GetProcAddress('glGetAttribLocation'); + if not Assigned(glGetAttribLocation) then Exit; + glGetProgramiv := SDL_GL_GetProcAddress('glGetProgramiv'); + if not Assigned(glGetProgramiv) then Exit; + glGetProgramInfoLog := SDL_GL_GetProcAddress('glGetProgramInfoLog'); + if not Assigned(glGetProgramInfoLog) then Exit; + glGetShaderiv := SDL_GL_GetProcAddress('glGetShaderiv'); + if not Assigned(glGetShaderiv) then Exit; + glGetShaderInfoLog := SDL_GL_GetProcAddress('glGetShaderInfoLog'); + if not Assigned(glGetShaderInfoLog) then Exit; + glGetShaderSource := SDL_GL_GetProcAddress('glGetShaderSource'); + if not Assigned(glGetShaderSource) then Exit; + glGetUniformLocation := SDL_GL_GetProcAddress('glGetUniformLocation'); + if not Assigned(glGetUniformLocation) then Exit; + glGetUniformfv := SDL_GL_GetProcAddress('glGetUniformfv'); + if not Assigned(glGetUniformfv) then Exit; + glGetUniformiv := SDL_GL_GetProcAddress('glGetUniformiv'); + if not Assigned(glGetUniformiv) then Exit; + glGetVertexAttribdv := SDL_GL_GetProcAddress('glGetVertexAttribdv'); + if not Assigned(glGetVertexAttribdv) then Exit; + glGetVertexAttribfv := SDL_GL_GetProcAddress('glGetVertexAttribfv'); + if not Assigned(glGetVertexAttribfv) then Exit; + glGetVertexAttribiv := SDL_GL_GetProcAddress('glGetVertexAttribiv'); + if not Assigned(glGetVertexAttribiv) then Exit; + glGetVertexAttribPointerv := SDL_GL_GetProcAddress('glGetVertexAttribPointerv'); + if not Assigned(glGetVertexAttribPointerv) then Exit; + glIsProgram := SDL_GL_GetProcAddress('glIsProgram'); + if not Assigned(glIsProgram) then Exit; + glIsShader := SDL_GL_GetProcAddress('glIsShader'); + if not Assigned(glIsShader) then Exit; + glLinkProgram := SDL_GL_GetProcAddress('glLinkProgram'); + if not Assigned(glLinkProgram) then Exit; + glShaderSource := SDL_GL_GetProcAddress('glShaderSource'); + if not Assigned(glShaderSource) then Exit; + glUseProgram := SDL_GL_GetProcAddress('glUseProgram'); + if not Assigned(glUseProgram) then Exit; + glUniform1f := SDL_GL_GetProcAddress('glUniform1f'); + if not Assigned(glUniform1f) then Exit; + glUniform2f := SDL_GL_GetProcAddress('glUniform2f'); + if not Assigned(glUniform2f) then Exit; + glUniform3f := SDL_GL_GetProcAddress('glUniform3f'); + if not Assigned(glUniform3f) then Exit; + glUniform4f := SDL_GL_GetProcAddress('glUniform4f'); + if not Assigned(glUniform4f) then Exit; + glUniform1i := SDL_GL_GetProcAddress('glUniform1i'); + if not Assigned(glUniform1i) then Exit; + glUniform2i := SDL_GL_GetProcAddress('glUniform2i'); + if not Assigned(glUniform2i) then Exit; + glUniform3i := SDL_GL_GetProcAddress('glUniform3i'); + if not Assigned(glUniform3i) then Exit; + glUniform4i := SDL_GL_GetProcAddress('glUniform4i'); + if not Assigned(glUniform4i) then Exit; + glUniform1fv := SDL_GL_GetProcAddress('glUniform1fv'); + if not Assigned(glUniform1fv) then Exit; + glUniform2fv := SDL_GL_GetProcAddress('glUniform2fv'); + if not Assigned(glUniform2fv) then Exit; + glUniform3fv := SDL_GL_GetProcAddress('glUniform3fv'); + if not Assigned(glUniform3fv) then Exit; + glUniform4fv := SDL_GL_GetProcAddress('glUniform4fv'); + if not Assigned(glUniform4fv) then Exit; + glUniform1iv := SDL_GL_GetProcAddress('glUniform1iv'); + if not Assigned(glUniform1iv) then Exit; + glUniform2iv := SDL_GL_GetProcAddress('glUniform2iv'); + if not Assigned(glUniform2iv) then Exit; + glUniform3iv := SDL_GL_GetProcAddress('glUniform3iv'); + if not Assigned(glUniform3iv) then Exit; + glUniform4iv := SDL_GL_GetProcAddress('glUniform4iv'); + if not Assigned(glUniform4iv) then Exit; + glUniformMatrix2fv := SDL_GL_GetProcAddress('glUniformMatrix2fv'); + if not Assigned(glUniformMatrix2fv) then Exit; + glUniformMatrix3fv := SDL_GL_GetProcAddress('glUniformMatrix3fv'); + if not Assigned(glUniformMatrix3fv) then Exit; + glUniformMatrix4fv := SDL_GL_GetProcAddress('glUniformMatrix4fv'); + if not Assigned(glUniformMatrix4fv) then Exit; + glValidateProgram := SDL_GL_GetProcAddress('glValidateProgram'); + if not Assigned(glValidateProgram) then Exit; + glVertexAttrib1d := SDL_GL_GetProcAddress('glVertexAttrib1d'); + if not Assigned(glVertexAttrib1d) then Exit; + glVertexAttrib1dv := SDL_GL_GetProcAddress('glVertexAttrib1dv'); + if not Assigned(glVertexAttrib1dv) then Exit; + glVertexAttrib1f := SDL_GL_GetProcAddress('glVertexAttrib1f'); + if not Assigned(glVertexAttrib1f) then Exit; + glVertexAttrib1fv := SDL_GL_GetProcAddress('glVertexAttrib1fv'); + if not Assigned(glVertexAttrib1fv) then Exit; + glVertexAttrib1s := SDL_GL_GetProcAddress('glVertexAttrib1s'); + if not Assigned(glVertexAttrib1s) then Exit; + glVertexAttrib1sv := SDL_GL_GetProcAddress('glVertexAttrib1sv'); + if not Assigned(glVertexAttrib1sv) then Exit; + glVertexAttrib2d := SDL_GL_GetProcAddress('glVertexAttrib2d'); + if not Assigned(glVertexAttrib2d) then Exit; + glVertexAttrib2dv := SDL_GL_GetProcAddress('glVertexAttrib2dv'); + if not Assigned(glVertexAttrib2dv) then Exit; + glVertexAttrib2f := SDL_GL_GetProcAddress('glVertexAttrib2f'); + if not Assigned(glVertexAttrib2f) then Exit; + glVertexAttrib2fv := SDL_GL_GetProcAddress('glVertexAttrib2fv'); + if not Assigned(glVertexAttrib2fv) then Exit; + glVertexAttrib2s := SDL_GL_GetProcAddress('glVertexAttrib2s'); + if not Assigned(glVertexAttrib2s) then Exit; + glVertexAttrib2sv := SDL_GL_GetProcAddress('glVertexAttrib2sv'); + if not Assigned(glVertexAttrib2sv) then Exit; + glVertexAttrib3d := SDL_GL_GetProcAddress('glVertexAttrib3d'); + if not Assigned(glVertexAttrib3d) then Exit; + glVertexAttrib3dv := SDL_GL_GetProcAddress('glVertexAttrib3dv'); + if not Assigned(glVertexAttrib3dv) then Exit; + glVertexAttrib3f := SDL_GL_GetProcAddress('glVertexAttrib3f'); + if not Assigned(glVertexAttrib3f) then Exit; + glVertexAttrib3fv := SDL_GL_GetProcAddress('glVertexAttrib3fv'); + if not Assigned(glVertexAttrib3fv) then Exit; + glVertexAttrib3s := SDL_GL_GetProcAddress('glVertexAttrib3s'); + if not Assigned(glVertexAttrib3s) then Exit; + glVertexAttrib3sv := SDL_GL_GetProcAddress('glVertexAttrib3sv'); + if not Assigned(glVertexAttrib3sv) then Exit; + glVertexAttrib4Nbv := SDL_GL_GetProcAddress('glVertexAttrib4Nbv'); + if not Assigned(glVertexAttrib4Nbv) then Exit; + glVertexAttrib4Niv := SDL_GL_GetProcAddress('glVertexAttrib4Niv'); + if not Assigned(glVertexAttrib4Niv) then Exit; + glVertexAttrib4Nsv := SDL_GL_GetProcAddress('glVertexAttrib4Nsv'); + if not Assigned(glVertexAttrib4Nsv) then Exit; + glVertexAttrib4Nub := SDL_GL_GetProcAddress('glVertexAttrib4Nub'); + if not Assigned(glVertexAttrib4Nub) then Exit; + glVertexAttrib4Nubv := SDL_GL_GetProcAddress('glVertexAttrib4Nubv'); + if not Assigned(glVertexAttrib4Nubv) then Exit; + glVertexAttrib4Nuiv := SDL_GL_GetProcAddress('glVertexAttrib4Nuiv'); + if not Assigned(glVertexAttrib4Nuiv) then Exit; + glVertexAttrib4Nusv := SDL_GL_GetProcAddress('glVertexAttrib4Nusv'); + if not Assigned(glVertexAttrib4Nusv) then Exit; + glVertexAttrib4bv := SDL_GL_GetProcAddress('glVertexAttrib4bv'); + if not Assigned(glVertexAttrib4bv) then Exit; + glVertexAttrib4d := SDL_GL_GetProcAddress('glVertexAttrib4d'); + if not Assigned(glVertexAttrib4d) then Exit; + glVertexAttrib4dv := SDL_GL_GetProcAddress('glVertexAttrib4dv'); + if not Assigned(glVertexAttrib4dv) then Exit; + glVertexAttrib4f := SDL_GL_GetProcAddress('glVertexAttrib4f'); + if not Assigned(glVertexAttrib4f) then Exit; + glVertexAttrib4fv := SDL_GL_GetProcAddress('glVertexAttrib4fv'); + if not Assigned(glVertexAttrib4fv) then Exit; + glVertexAttrib4iv := SDL_GL_GetProcAddress('glVertexAttrib4iv'); + if not Assigned(glVertexAttrib4iv) then Exit; + glVertexAttrib4s := SDL_GL_GetProcAddress('glVertexAttrib4s'); + if not Assigned(glVertexAttrib4s) then Exit; + glVertexAttrib4sv := SDL_GL_GetProcAddress('glVertexAttrib4sv'); + if not Assigned(glVertexAttrib4sv) then Exit; + glVertexAttrib4ubv := SDL_GL_GetProcAddress('glVertexAttrib4ubv'); + if not Assigned(glVertexAttrib4ubv) then Exit; + glVertexAttrib4uiv := SDL_GL_GetProcAddress('glVertexAttrib4uiv'); + if not Assigned(glVertexAttrib4uiv) then Exit; + glVertexAttrib4usv := SDL_GL_GetProcAddress('glVertexAttrib4usv'); + if not Assigned(glVertexAttrib4usv) then Exit; + glVertexAttribPointer := SDL_GL_GetProcAddress('glVertexAttribPointer'); + if not Assigned(glVertexAttribPointer) then Exit; + Result := TRUE; + +end; + +function glext_LoadExtension(ext: String): Boolean; +begin + + Result := FALSE; + + if ext = 'GL_version_1_2' then Result := Load_GL_version_1_2 + else if ext = 'GL_ARB_imaging' then Result := Load_GL_ARB_imaging + else if ext = 'GL_version_1_3' then Result := Load_GL_version_1_3 + else if ext = 'GL_ARB_multitexture' then Result := Load_GL_ARB_multitexture + else if ext = 'GL_ARB_transpose_matrix' then Result := Load_GL_ARB_transpose_matrix + else if ext = 'GL_ARB_multisample' then Result := Load_GL_ARB_multisample + else if ext = 'GL_ARB_texture_env_add' then Result := Load_GL_ARB_texture_env_add + {$IFDEF WINDOWS} + else if ext = 'WGL_ARB_extensions_string' then Result := Load_WGL_ARB_extensions_string + else if ext = 'WGL_ARB_buffer_region' then Result := Load_WGL_ARB_buffer_region + {$ENDIF} + else if ext = 'GL_ARB_texture_cube_map' then Result := Load_GL_ARB_texture_cube_map + else if ext = 'GL_ARB_depth_texture' then Result := Load_GL_ARB_depth_texture + else if ext = 'GL_ARB_point_parameters' then Result := Load_GL_ARB_point_parameters + else if ext = 'GL_ARB_shadow' then Result := Load_GL_ARB_shadow + else if ext = 'GL_ARB_shadow_ambient' then Result := Load_GL_ARB_shadow_ambient + else if ext = 'GL_ARB_texture_border_clamp' then Result := Load_GL_ARB_texture_border_clamp + else if ext = 'GL_ARB_texture_compression' then Result := Load_GL_ARB_texture_compression + else if ext = 'GL_ARB_texture_env_combine' then Result := Load_GL_ARB_texture_env_combine + else if ext = 'GL_ARB_texture_env_crossbar' then Result := Load_GL_ARB_texture_env_crossbar + else if ext = 'GL_ARB_texture_env_dot3' then Result := Load_GL_ARB_texture_env_dot3 + else if ext = 'GL_ARB_texture_mirrored_repeat' then Result := Load_GL_ARB_texture_mirrored_repeat + else if ext = 'GL_ARB_vertex_blend' then Result := Load_GL_ARB_vertex_blend + else if ext = 'GL_ARB_vertex_program' then Result := Load_GL_ARB_vertex_program + else if ext = 'GL_ARB_window_pos' then Result := Load_GL_ARB_window_pos + else if ext = 'GL_EXT_422_pixels' then Result := Load_GL_EXT_422_pixels + else if ext = 'GL_EXT_abgr' then Result := Load_GL_EXT_abgr + else if ext = 'GL_EXT_bgra' then Result := Load_GL_EXT_bgra + else if ext = 'GL_EXT_blend_color' then Result := Load_GL_EXT_blend_color + else if ext = 'GL_EXT_blend_func_separate' then Result := Load_GL_EXT_blend_func_separate + else if ext = 'GL_EXT_blend_logic_op' then Result := Load_GL_EXT_blend_logic_op + else if ext = 'GL_EXT_blend_minmax' then Result := Load_GL_EXT_blend_minmax + else if ext = 'GL_EXT_blend_subtract' then Result := Load_GL_EXT_blend_subtract + else if ext = 'GL_EXT_clip_volume_hint' then Result := Load_GL_EXT_clip_volume_hint + else if ext = 'GL_EXT_color_subtable' then Result := Load_GL_EXT_color_subtable + else if ext = 'GL_EXT_compiled_vertex_array' then Result := Load_GL_EXT_compiled_vertex_array + else if ext = 'GL_EXT_convolution' then Result := Load_GL_EXT_convolution + else if ext = 'GL_EXT_histogram' then Result := Load_GL_EXT_histogram + else if ext = 'GL_EXT_multi_draw_arrays' then Result := Load_GL_EXT_multi_draw_arrays + else if ext = 'GL_EXT_packed_pixels' then Result := Load_GL_EXT_packed_pixels + else if ext = 'GL_EXT_paletted_texture' then Result := Load_GL_EXT_paletted_texture + else if ext = 'GL_EXT_point_parameters' then Result := Load_GL_EXT_point_parameters + else if ext = 'GL_EXT_polygon_offset' then Result := Load_GL_EXT_polygon_offset + else if ext = 'GL_EXT_separate_specular_color' then Result := Load_GL_EXT_separate_specular_color + else if ext = 'GL_EXT_shadow_funcs' then Result := Load_GL_EXT_shadow_funcs + else if ext = 'GL_EXT_shared_texture_palette' then Result := Load_GL_EXT_shared_texture_palette + else if ext = 'GL_EXT_stencil_two_side' then Result := Load_GL_EXT_stencil_two_side + else if ext = 'GL_EXT_stencil_wrap' then Result := Load_GL_EXT_stencil_wrap + else if ext = 'GL_EXT_subtexture' then Result := Load_GL_EXT_subtexture + else if ext = 'GL_EXT_texture3D' then Result := Load_GL_EXT_texture3D + else if ext = 'GL_EXT_texture_compression_s3tc' then Result := Load_GL_EXT_texture_compression_s3tc + else if ext = 'GL_EXT_texture_env_add' then Result := Load_GL_EXT_texture_env_add + else if ext = 'GL_EXT_texture_env_combine' then Result := Load_GL_EXT_texture_env_combine + else if ext = 'GL_EXT_texture_env_dot3' then Result := Load_GL_EXT_texture_env_dot3 + else if ext = 'GL_EXT_texture_filter_anisotropic' then Result := Load_GL_EXT_texture_filter_anisotropic + else if ext = 'GL_EXT_texture_lod_bias' then Result := Load_GL_EXT_texture_lod_bias + else if ext = 'GL_EXT_texture_object' then Result := Load_GL_EXT_texture_object + else if ext = 'GL_EXT_vertex_array' then Result := Load_GL_EXT_vertex_array + else if ext = 'GL_EXT_vertex_shader' then Result := Load_GL_EXT_vertex_shader + else if ext = 'GL_EXT_vertex_weighting' then Result := Load_GL_EXT_vertex_weighting + else if ext = 'GL_HP_occlusion_test' then Result := Load_GL_HP_occlusion_test + else if ext = 'GL_NV_blend_square' then Result := Load_GL_NV_blend_square + else if ext = 'GL_NV_copy_depth_to_color' then Result := Load_GL_NV_copy_depth_to_color + else if ext = 'GL_NV_depth_clamp' then Result := Load_GL_NV_depth_clamp + else if ext = 'GL_NV_evaluators' then Result := Load_GL_NV_evaluators + else if ext = 'GL_NV_fence' then Result := Load_GL_NV_fence + else if ext = 'GL_NV_fog_distance' then Result := Load_GL_NV_fog_distance + else if ext = 'GL_NV_light_max_exponent' then Result := Load_GL_NV_light_max_exponent + else if ext = 'GL_NV_multisample_filter_hint' then Result := Load_GL_NV_multisample_filter_hint + else if ext = 'GL_NV_occlusion_query' then Result := Load_GL_NV_occlusion_query + else if ext = 'GL_NV_packed_depth_stencil' then Result := Load_GL_NV_packed_depth_stencil + else if ext = 'GL_NV_point_sprite' then Result := Load_GL_NV_point_sprite + else if ext = 'GL_NV_register_combiners' then Result := Load_GL_NV_register_combiners + else if ext = 'GL_NV_register_combiners2' then Result := Load_GL_NV_register_combiners2 + else if ext = 'GL_NV_texgen_emboss' then Result := Load_GL_NV_texgen_emboss + else if ext = 'GL_NV_texgen_reflection' then Result := Load_GL_NV_texgen_reflection + else if ext = 'GL_NV_texture_compression_vtc' then Result := Load_GL_NV_texture_compression_vtc + else if ext = 'GL_NV_texture_env_combine4' then Result := Load_GL_NV_texture_env_combine4 + else if ext = 'GL_NV_texture_rectangle' then Result := Load_GL_NV_texture_rectangle + else if ext = 'GL_NV_texture_shader' then Result := Load_GL_NV_texture_shader + else if ext = 'GL_NV_texture_shader2' then Result := Load_GL_NV_texture_shader2 + else if ext = 'GL_NV_texture_shader3' then Result := Load_GL_NV_texture_shader3 + else if ext = 'GL_NV_vertex_array_range' then Result := Load_GL_NV_vertex_array_range + else if ext = 'GL_NV_vertex_array_range2' then Result := Load_GL_NV_vertex_array_range2 + else if ext = 'GL_NV_vertex_program' then Result := Load_GL_NV_vertex_program + else if ext = 'GL_NV_vertex_program1_1' then Result := Load_GL_NV_vertex_program1_1 + else if ext = 'GL_ATI_element_array' then Result := Load_GL_ATI_element_array + else if ext = 'GL_ATI_envmap_bumpmap' then Result := Load_GL_ATI_envmap_bumpmap + else if ext = 'GL_ATI_fragment_shader' then Result := Load_GL_ATI_fragment_shader + else if ext = 'GL_ATI_pn_triangles' then Result := Load_GL_ATI_pn_triangles + else if ext = 'GL_ATI_texture_mirror_once' then Result := Load_GL_ATI_texture_mirror_once + else if ext = 'GL_ATI_vertex_array_object' then Result := Load_GL_ATI_vertex_array_object + else if ext = 'GL_ATI_vertex_streams' then Result := Load_GL_ATI_vertex_streams + {$IFDEF WINDOWS} + else if ext = 'WGL_I3D_image_buffer' then Result := Load_WGL_I3D_image_buffer + else if ext = 'WGL_I3D_swap_frame_lock' then Result := Load_WGL_I3D_swap_frame_lock + else if ext = 'WGL_I3D_swap_frame_usage' then Result := Load_WGL_I3D_swap_frame_usage + {$ENDIF} + else if ext = 'GL_3DFX_texture_compression_FXT1' then Result := Load_GL_3DFX_texture_compression_FXT1 + else if ext = 'GL_IBM_cull_vertex' then Result := Load_GL_IBM_cull_vertex + else if ext = 'GL_IBM_multimode_draw_arrays' then Result := Load_GL_IBM_multimode_draw_arrays + else if ext = 'GL_IBM_raster_pos_clip' then Result := Load_GL_IBM_raster_pos_clip + else if ext = 'GL_IBM_texture_mirrored_repeat' then Result := Load_GL_IBM_texture_mirrored_repeat + else if ext = 'GL_IBM_vertex_array_lists' then Result := Load_GL_IBM_vertex_array_lists + else if ext = 'GL_MESA_resize_buffers' then Result := Load_GL_MESA_resize_buffers + else if ext = 'GL_MESA_window_pos' then Result := Load_GL_MESA_window_pos + else if ext = 'GL_OML_interlace' then Result := Load_GL_OML_interlace + else if ext = 'GL_OML_resample' then Result := Load_GL_OML_resample + else if ext = 'GL_OML_subsample' then Result := Load_GL_OML_subsample + else if ext = 'GL_SGIS_generate_mipmap' then Result := Load_GL_SGIS_generate_mipmap + else if ext = 'GL_SGIS_multisample' then Result := Load_GL_SGIS_multisample + else if ext = 'GL_SGIS_pixel_texture' then Result := Load_GL_SGIS_pixel_texture + else if ext = 'GL_SGIS_texture_border_clamp' then Result := Load_GL_SGIS_texture_border_clamp + else if ext = 'GL_SGIS_texture_color_mask' then Result := Load_GL_SGIS_texture_color_mask + else if ext = 'GL_SGIS_texture_edge_clamp' then Result := Load_GL_SGIS_texture_edge_clamp + else if ext = 'GL_SGIS_texture_lod' then Result := Load_GL_SGIS_texture_lod + else if ext = 'GL_SGIS_depth_texture' then Result := Load_GL_SGIS_depth_texture + else if ext = 'GL_SGIX_fog_offset' then Result := Load_GL_SGIX_fog_offset + else if ext = 'GL_SGIX_interlace' then Result := Load_GL_SGIX_interlace + else if ext = 'GL_SGIX_shadow_ambient' then Result := Load_GL_SGIX_shadow_ambient + else if ext = 'GL_SGI_color_matrix' then Result := Load_GL_SGI_color_matrix + else if ext = 'GL_SGI_color_table' then Result := Load_GL_SGI_color_table + else if ext = 'GL_SGI_texture_color_table' then Result := Load_GL_SGI_texture_color_table + else if ext = 'GL_SUN_vertex' then Result := Load_GL_SUN_vertex + else if ext = 'GL_ARB_fragment_program' then Result := Load_GL_ARB_fragment_program + else if ext = 'GL_ATI_text_fragment_shader' then Result := Load_GL_ATI_text_fragment_shader + else if ext = 'GL_APPLE_client_storage' then Result := Load_GL_APPLE_client_storage + else if ext = 'GL_APPLE_element_array' then Result := Load_GL_APPLE_element_array + else if ext = 'GL_APPLE_fence' then Result := Load_GL_APPLE_fence + else if ext = 'GL_APPLE_vertex_array_object' then Result := Load_GL_APPLE_vertex_array_object + else if ext = 'GL_APPLE_vertex_array_range' then Result := Load_GL_APPLE_vertex_array_range + {$IFDEF WINDOWS} + else if ext = 'WGL_ARB_pixel_format' then Result := Load_WGL_ARB_pixel_format + else if ext = 'WGL_ARB_make_current_read' then Result := Load_WGL_ARB_make_current_read + else if ext = 'WGL_ARB_pbuffer' then Result := Load_WGL_ARB_pbuffer + else if ext = 'WGL_EXT_swap_control' then Result := Load_WGL_EXT_swap_control + else if ext = 'WGL_ARB_render_texture' then Result := Load_WGL_ARB_render_texture + else if ext = 'WGL_EXT_extensions_string' then Result := Load_WGL_EXT_extensions_string + else if ext = 'WGL_EXT_make_current_read' then Result := Load_WGL_EXT_make_current_read + else if ext = 'WGL_EXT_pbuffer' then Result := Load_WGL_EXT_pbuffer + else if ext = 'WGL_EXT_pixel_format' then Result := Load_WGL_EXT_pixel_format + else if ext = 'WGL_I3D_digital_video_control' then Result := Load_WGL_I3D_digital_video_control + else if ext = 'WGL_I3D_gamma' then Result := Load_WGL_I3D_gamma + else if ext = 'WGL_I3D_genlock' then Result := Load_WGL_I3D_genlock + {$ENDIF} + else if ext = 'GL_ARB_matrix_palette' then Result := Load_GL_ARB_matrix_palette + else if ext = 'GL_NV_element_array' then Result := Load_GL_NV_element_array + else if ext = 'GL_NV_float_buffer' then Result := Load_GL_NV_float_buffer + else if ext = 'GL_NV_fragment_program' then Result := Load_GL_NV_fragment_program + else if ext = 'GL_NV_primitive_restart' then Result := Load_GL_NV_primitive_restart + else if ext = 'GL_NV_vertex_program2' then Result := Load_GL_NV_vertex_program2 + {$IFDEF WINDOWS} + else if ext = 'WGL_NV_render_texture_rectangle' then Result := Load_WGL_NV_render_texture_rectangle + {$ENDIF} + else if ext = 'GL_NV_pixel_data_range' then Result := Load_GL_NV_pixel_data_range + else if ext = 'GL_EXT_texture_rectangle' then Result := Load_GL_EXT_texture_rectangle + else if ext = 'GL_S3_s3tc' then Result := Load_GL_S3_s3tc + else if ext = 'GL_ATI_draw_buffers' then Result := Load_GL_ATI_draw_buffers + {$IFDEF WINDOWS} + else if ext = 'WGL_ATI_pixel_format_float' then Result := Load_WGL_ATI_pixel_format_float + {$ENDIF} + else if ext = 'GL_ATI_texture_env_combine3' then Result := Load_GL_ATI_texture_env_combine3 + else if ext = 'GL_ATI_texture_float' then Result := Load_GL_ATI_texture_float + else if ext = 'GL_NV_texture_expand_normal' then Result := Load_GL_NV_texture_expand_normal + else if ext = 'GL_NV_half_float' then Result := Load_GL_NV_half_float + else if ext = 'GL_ATI_map_object_buffer' then Result := Load_GL_ATI_map_object_buffer + else if ext = 'GL_ATI_separate_stencil' then Result := Load_GL_ATI_separate_stencil + else if ext = 'GL_ATI_vertex_attrib_array_object' then Result := Load_GL_ATI_vertex_attrib_array_object + else if ext = 'GL_ARB_vertex_buffer_object' then Result := Load_GL_ARB_vertex_buffer_object + else if ext = 'GL_ARB_occlusion_query' then Result := Load_GL_ARB_occlusion_query + else if ext = 'GL_ARB_shader_objects' then Result := Load_GL_ARB_shader_objects + else if ext = 'GL_ARB_vertex_shader' then Result := Load_GL_ARB_vertex_shader + else if ext = 'GL_ARB_fragment_shader' then Result := Load_GL_ARB_fragment_shader + else if ext = 'GL_ARB_shading_language_100' then Result := Load_GL_ARB_shading_language_100 + else if ext = 'GL_ARB_texture_non_power_of_two' then Result := Load_GL_ARB_texture_non_power_of_two + else if ext = 'GL_ARB_point_sprite' then Result := Load_GL_ARB_point_sprite + else if ext = 'GL_EXT_depth_bounds_test' then Result := Load_GL_EXT_depth_bounds_test + else if ext = 'GL_EXT_secondary_color' then Result := Load_GL_EXT_secondary_color + else if ext = 'GL_EXT_texture_mirror_clamp' then Result := Load_GL_EXT_texture_mirror_clamp + else if ext = 'GL_EXT_blend_equation_separate' then Result := Load_GL_EXT_blend_equation_separate + else if ext = 'GL_MESA_pack_invert' then Result := Load_GL_MESA_pack_invert + else if ext = 'GL_MESA_ycbcr_texture' then Result := Load_GL_MESA_ycbcr_texture + else if ext = 'GL_ARB_fragment_program_shadow' then Result := Load_GL_ARB_fragment_program_shadow + else if ext = 'GL_EXT_fog_coord' then Result := Load_GL_EXT_fog_coord + else if ext = 'GL_NV_fragment_program_option' then Result := Load_GL_NV_fragment_program_option + else if ext = 'GL_EXT_pixel_buffer_object' then Result := Load_GL_EXT_pixel_buffer_object + else if ext = 'GL_NV_fragment_program2' then Result := Load_GL_NV_fragment_program2 + else if ext = 'GL_NV_vertex_program2_option' then Result := Load_GL_NV_vertex_program2_option + else if ext = 'GL_NV_vertex_program3' then Result := Load_GL_NV_vertex_program3 + else if ext = 'GL_ARB_draw_buffers' then Result := Load_GL_ARB_draw_buffers + else if ext = 'GL_ARB_texture_rectangle' then Result := Load_GL_ARB_texture_rectangle + else if ext = 'GL_ARB_color_buffer_float' then Result := Load_GL_ARB_color_buffer_float + else if ext = 'GL_ARB_half_float_pixel' then Result := Load_GL_ARB_half_float_pixel + else if ext = 'GL_ARB_texture_float' then Result := Load_GL_ARB_texture_float + else if ext = 'GL_EXT_texture_compression_dxt1' then Result := Load_GL_EXT_texture_compression_dxt1 + else if ext = 'GL_ARB_pixel_buffer_object' then Result := Load_GL_ARB_pixel_buffer_object + else if ext = 'GL_EXT_framebuffer_object' then Result := Load_GL_EXT_framebuffer_object + else if ext = 'GL_version_1_4' then Result := Load_GL_version_1_4 + else if ext = 'GL_version_1_5' then Result := Load_GL_version_1_5 + else if ext = 'GL_version_2_0' then Result := Load_GL_version_2_0 + +end; + +end. diff --git a/Game/Code/lib/JEDI-SDL/OpenGL/Pas/glu.pas b/Game/Code/lib/JEDI-SDL/OpenGL/Pas/glu.pas index 371ccdda..29647d12 100644 --- a/Game/Code/lib/JEDI-SDL/OpenGL/Pas/glu.pas +++ b/Game/Code/lib/JEDI-SDL/OpenGL/Pas/glu.pas @@ -1,582 +1,582 @@ -unit glu;
-{
- $Id: glu.pas,v 1.8 2007/05/20 20:28:31 savage Exp $
-
- 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 }
-{ }
-{ Modified for Delphi/Kylix and FreePascal }
-{ by Dominique Louis ( Dominique@Savagesoftware.com.au) }
-{ For the latest updates, visit JEDI-SDL : http://www.sf.net/projects/jedi-sdl }
-{ }
-{******************************************************************************}
-
-{
- $Log: glu.pas,v $
- Revision 1.8 2007/05/20 20:28:31 savage
- Initial Changes to Handle 64 Bits
-
- Revision 1.7 2006/11/26 16:35:49 savage
- Messed up the last change to GLUtessCombineDataProc, had to reapply it. Thanks Michalis.
-
- Revision 1.6 2006/11/25 23:38:02 savage
- Changes as proposed by Michalis Kamburelis for better FPC support
-
- Revision 1.5 2006/11/20 21:20:59 savage
- Updated to work in MacOS X
-
- Revision 1.4 2005/05/22 18:52:09 savage
- Changes as suggested by Michalis Kamburelis. Thanks again.
-
- Revision 1.3 2004/10/07 21:01:29 savage
- Fix for FPC
-
- Revision 1.2 2004/08/14 22:54:30 savage
- Updated so that Library name defines are correctly defined for MacOS X.
-
- Revision 1.1 2004/03/30 21:53:54 savage
- Moved to it's own folder.
-
- Revision 1.4 2004/02/20 17:09:55 savage
- Code tidied up in gl, glu and glut, while extensions in glext.pas are now loaded using SDL_GL_GetProcAddress, thus making it more cross-platform compatible, but now more tied to SDL.
-
- Revision 1.3 2004/02/14 00:23:39 savage
- As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change.
-
- Revision 1.2 2004/02/14 00:09:19 savage
- Changed uses to now make use of moduleloader.pas rather than dllfuncs.pas
-
- Revision 1.1 2004/02/05 00:08:19 savage
- Module 1.0 release
-
- Revision 1.4 2003/06/02 12:32:13 savage
- Modified Sources to avoid warnings with Delphi by moving CVS Logging to the top of the header files. Hopefully CVS Logging still works.
-
- Revision 1.3 2003/05/29 22:55:00 savage
- Make use of new DLLFunctions
-
- Revision 1.2 2003/05/27 09:39:53 savage
- Added better Gnu Pascal support.
-
- Revision 1.1 2003/05/11 13:18:03 savage
- Newest OpenGL Headers For Delphi, Kylix and FPC
-
- Revision 1.2 2002/10/13 14:36:47 sg
- * Win32 fix: The OS symbol is called "Win32", not "Windows"
-
- 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
-
-}
-
-interface
-
-{$I jedi-sdl.inc}
-
-uses
-{$IFDEF __GPC__}
- gpc,
-{$ENDIF}
- moduleloader,
- gl;
-
-const
-{$IFDEF WINDOWS}
- GLuLibName = 'glu32.dll';
-{$ENDIF}
-
-{$IFDEF UNIX}
-{$IFDEF DARWIN}
- GLuLibName = '/System/Library/Frameworks/OpenGL.framework/Libraries/libGLU.dylib';
-{$ELSE}
- GLuLibName = 'libGLU.so';
-{$ENDIF}
-{$ENDIF}
-
-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;
-{$IFNDEF __GPC__}
- PPointer = ^Pointer;
-{$ENDIF}
-
-var
- gluErrorString : function( errCode : GLenum ) : PChar; {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluErrorUnicodeStringEXT : function( errCode : GLenum ) : PWideChar; {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluGetString : function( name : GLenum ) : PChar; {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluOrtho2D : procedure( left, right, bottom, top : GLdouble ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluPerspective : procedure( fovy, aspect, zNear, zFar : GLdouble ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluPickMatrix : procedure( x, y, width, height : GLdouble; var viewport : TViewPortArray ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluLookAt : procedure( eyex, eyey, eyez, centerx, centery, centerz, upx, upy, upz : GLdouble ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluProject : function( objx, objy, objz : GLdouble; var modelMatrix, projMatrix : T16dArray; var viewport : TViewPortArray; winx, winy, winz : PGLdouble ) : Integer; {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluUnProject : function( winx, winy, winz : GLdouble; var modelMatrix, projMatrix : T16dArray; var viewport : TViewPortArray; objx, objy, objz : PGLdouble ) : Integer; {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluScaleImage : function( format : GLenum; widthin, heightin : GLint; typein : GLenum; const datain : Pointer; widthout, heightout : GLint; typeout : GLenum; dataout : Pointer ) : Integer; {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluBuild1DMipmaps : function( target : GLenum; components, width : GLint; format, atype : GLenum; const data : Pointer ) : Integer; {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluBuild2DMipmaps : function( target : GLenum; components, width, height : GLint; format, atype : GLenum; const data : Pointer ) : Integer; {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
-
-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; {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluDeleteQuadric : procedure( state : PGLUquadric ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluQuadricNormals : procedure( quadObject : PGLUquadric; normals : GLenum ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluQuadricTexture : procedure( quadObject : PGLUquadric; textureCoords : GLboolean ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluQuadricOrientation : procedure( quadObject : PGLUquadric; orientation : GLenum ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluQuadricDrawStyle : procedure( quadObject : PGLUquadric; drawStyle : GLenum ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluCylinder : procedure( qobj : PGLUquadric; baseRadius, topRadius, height : GLdouble; slices, stacks : GLint ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluDisk : procedure( qobj : PGLUquadric; innerRadius, outerRadius : GLdouble; slices, loops : GLint ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluPartialDisk : procedure( qobj : PGLUquadric; innerRadius, outerRadius : GLdouble; slices, loops : GLint; startAngle, sweepAngle : GLdouble ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluSphere : procedure( qobj : PGLuquadric; radius : GLdouble; slices, stacks : GLint ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluQuadricCallback : procedure( qobj : PGLUquadric; which : GLenum; fn : TCallBack ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluNewTess : function : PGLUtesselator; {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluDeleteTess : procedure( tess : PGLUtesselator ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluTessBeginPolygon : procedure( tess : PGLUtesselator; polygon_data : Pointer ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluTessBeginContour : procedure( tess : PGLUtesselator ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluTessVertex : procedure( tess : PGLUtesselator; var coords : T3dArray; data : Pointer ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluTessEndContour : procedure( tess : PGLUtesselator ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluTessEndPolygon : procedure( tess : PGLUtesselator ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluTessProperty : procedure( tess : PGLUtesselator; which : GLenum; value : GLdouble ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluTessNormal : procedure( tess : PGLUtesselator; x, y, z : GLdouble ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluTessCallback : procedure( tess : PGLUtesselator; which : GLenum; fn : TCallBack ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluGetTessProperty : procedure( tess : PGLUtesselator; which : GLenum; value : PGLdouble ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluNewNurbsRenderer : function : PGLUnurbs; {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluDeleteNurbsRenderer : procedure( nobj : PGLUnurbs ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluBeginSurface : procedure( nobj : PGLUnurbs ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluBeginCurve : procedure( nobj : PGLUnurbs ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluEndCurve : procedure( nobj : PGLUnurbs ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluEndSurface : procedure( nobj : PGLUnurbs ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluBeginTrim : procedure( nobj : PGLUnurbs ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluEndTrim : procedure( nobj : PGLUnurbs ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluPwlCurve : procedure( nobj : PGLUnurbs; count : GLint; aarray : PGLfloat; stride : GLint; atype : GLenum ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluNurbsCurve : procedure( nobj : PGLUnurbs; nknots : GLint; knot : PGLfloat; stride : GLint; ctlarray : PGLfloat; order : GLint; atype : GLenum ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- 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 ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluLoadSamplingMatrices : procedure( nobj : PGLUnurbs; var modelMatrix, projMatrix : T16dArray; var viewport : TViewPortArray ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluNurbsProperty : procedure( nobj : PGLUnurbs; aproperty : GLenum; value : GLfloat ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluGetNurbsProperty : procedure( nobj : PGLUnurbs; aproperty : GLenum; value : PGLfloat ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluNurbsCallback : procedure( nobj : PGLUnurbs; which : GLenum; fn : TCallBack ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
-
-(**** Callback function prototypes ****)
-
-type
- // gluQuadricCallback
- GLUquadricErrorProc = procedure( p : GLenum ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
-
- // gluTessCallback
- GLUtessBeginProc = procedure( p : GLenum ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- GLUtessEdgeFlagProc = procedure( p : GLboolean ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- GLUtessVertexProc = procedure( p : Pointer ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- GLUtessEndProc = procedure; {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- GLUtessErrorProc = procedure( p : GLenum ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- GLUtessCombineProc = procedure( var p1 : T3dArray; p2 : T4pArray; p3 : T4fArray; p4 : PPointer ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- GLUtessBeginDataProc = procedure( p1 : GLenum; p2 : Pointer ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- GLUtessEdgeFlagDataProc = procedure( p1 : GLboolean; p2 : Pointer ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- GLUtessVertexDataProc = procedure( p1, p2 : Pointer ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- GLUtessEndDataProc = procedure( p : Pointer ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- GLUtessErrorDataProc = procedure( p1 : GLenum; p2 : Pointer ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- GLUtessCombineDataProc = procedure( var p1 : T3dArray; var p2 : T4pArray; var p3 : T4fArray;
- p4 : PPointer; p5 : Pointer ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
-
- // gluNurbsCallback
- GLUnurbsErrorProc = procedure( p : GLenum ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
-
-
-//*** 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 ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluNextContour : procedure( tess : PGLUtesselator; atype : GLenum ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- gluEndPolygon : procedure( tess : PGLUtesselator ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
-
-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 : PChar );
-procedure FreeGLu;
-
-implementation
-
-var
- LibGlu : TModuleHandle;
-
-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;
-
- UnLoadModule( LibGlu );
-
-end;
-
-procedure LoadGLu( const dll : PChar );
-begin
-
- FreeGLu;
-
- if LoadModule( LibGlu, dll ) then
- begin
- @gluErrorString := GetModuleSymbol( LibGlu, 'gluErrorString' );
- @gluErrorUnicodeStringEXT := GetModuleSymbol( LibGlu, 'gluErrorUnicodeStringEXT' );
- @gluGetString := GetModuleSymbol( LibGlu, 'gluGetString' );
- @gluOrtho2D := GetModuleSymbol( LibGlu, 'gluOrtho2D' );
- @gluPerspective := GetModuleSymbol( LibGlu, 'gluPerspective' );
- @gluPickMatrix := GetModuleSymbol( LibGlu, 'gluPickMatrix' );
- @gluLookAt := GetModuleSymbol( LibGlu, 'gluLookAt' );
- @gluProject := GetModuleSymbol( LibGlu, 'gluProject' );
- @gluUnProject := GetModuleSymbol( LibGlu, 'gluUnProject' );
- @gluScaleImage := GetModuleSymbol( LibGlu, 'gluScaleImage' );
- @gluBuild1DMipmaps := GetModuleSymbol( LibGlu, 'gluBuild1DMipmaps' );
- @gluBuild2DMipmaps := GetModuleSymbol( LibGlu, 'gluBuild2DMipmaps' );
- @gluNewQuadric := GetModuleSymbol( LibGlu, 'gluNewQuadric' );
- @gluDeleteQuadric := GetModuleSymbol( LibGlu, 'gluDeleteQuadric' );
- @gluQuadricNormals := GetModuleSymbol( LibGlu, 'gluQuadricNormals' );
- @gluQuadricTexture := GetModuleSymbol( LibGlu, 'gluQuadricTexture' );
- @gluQuadricOrientation := GetModuleSymbol( LibGlu, 'gluQuadricOrientation' );
- @gluQuadricDrawStyle := GetModuleSymbol( LibGlu, 'gluQuadricDrawStyle' );
- @gluCylinder := GetModuleSymbol( LibGlu, 'gluCylinder' );
- @gluDisk := GetModuleSymbol( LibGlu, 'gluDisk' );
- @gluPartialDisk := GetModuleSymbol( LibGlu, 'gluPartialDisk' );
- @gluSphere := GetModuleSymbol( LibGlu, 'gluSphere' );
- @gluQuadricCallback := GetModuleSymbol( LibGlu, 'gluQuadricCallback' );
- @gluNewTess := GetModuleSymbol( LibGlu, 'gluNewTess' );
- @gluDeleteTess := GetModuleSymbol( LibGlu, 'gluDeleteTess' );
- @gluTessBeginPolygon := GetModuleSymbol( LibGlu, 'gluTessBeginPolygon' );
- @gluTessBeginContour := GetModuleSymbol( LibGlu, 'gluTessBeginContour' );
- @gluTessVertex := GetModuleSymbol( LibGlu, 'gluTessVertex' );
- @gluTessEndContour := GetModuleSymbol( LibGlu, 'gluTessEndContour' );
- @gluTessEndPolygon := GetModuleSymbol( LibGlu, 'gluTessEndPolygon' );
- @gluTessProperty := GetModuleSymbol( LibGlu, 'gluTessProperty' );
- @gluTessNormal := GetModuleSymbol( LibGlu, 'gluTessNormal' );
- @gluTessCallback := GetModuleSymbol( LibGlu, 'gluTessCallback' );
- @gluGetTessProperty := GetModuleSymbol( LibGlu, 'gluGetTessProperty' );
- @gluNewNurbsRenderer := GetModuleSymbol( LibGlu, 'gluNewNurbsRenderer' );
- @gluDeleteNurbsRenderer := GetModuleSymbol( LibGlu, 'gluDeleteNurbsRenderer' );
- @gluBeginSurface := GetModuleSymbol( LibGlu, 'gluBeginSurface' );
- @gluBeginCurve := GetModuleSymbol( LibGlu, 'gluBeginCurve' );
- @gluEndCurve := GetModuleSymbol( LibGlu, 'gluEndCurve' );
- @gluEndSurface := GetModuleSymbol( LibGlu, 'gluEndSurface' );
- @gluBeginTrim := GetModuleSymbol( LibGlu, 'gluBeginTrim' );
- @gluEndTrim := GetModuleSymbol( LibGlu, 'gluEndTrim' );
- @gluPwlCurve := GetModuleSymbol( LibGlu, 'gluPwlCurve' );
- @gluNurbsCurve := GetModuleSymbol( LibGlu, 'gluNurbsCurve' );
- @gluNurbsSurface := GetModuleSymbol( LibGlu, 'gluNurbsSurface' );
- @gluLoadSamplingMatrices := GetModuleSymbol( LibGlu, 'gluLoadSamplingMatrices' );
- @gluNurbsProperty := GetModuleSymbol( LibGlu, 'gluNurbsProperty' );
- @gluGetNurbsProperty := GetModuleSymbol( LibGlu, 'gluGetNurbsProperty' );
- @gluNurbsCallback := GetModuleSymbol( LibGlu, 'gluNurbsCallback' );
-
- @gluBeginPolygon := GetModuleSymbol( LibGlu, 'gluBeginPolygon' );
- @gluNextContour := GetModuleSymbol( LibGlu, 'gluNextContour' );
- @gluEndPolygon := GetModuleSymbol( LibGlu, 'gluEndPolygon' );
- end;
-end;
-
-initialization
-
- LoadGLu( GLuLibName );
-
-finalization
-
- FreeGLu;
-
-end.
-
+unit glu; +{ + $Id: glu.pas,v 1.8 2007/05/20 20:28:31 savage Exp $ + + 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 } +{ } +{ Modified for Delphi/Kylix and FreePascal } +{ by Dominique Louis ( Dominique@Savagesoftware.com.au) } +{ For the latest updates, visit JEDI-SDL : http://www.sf.net/projects/jedi-sdl } +{ } +{******************************************************************************} + +{ + $Log: glu.pas,v $ + Revision 1.8 2007/05/20 20:28:31 savage + Initial Changes to Handle 64 Bits + + Revision 1.7 2006/11/26 16:35:49 savage + Messed up the last change to GLUtessCombineDataProc, had to reapply it. Thanks Michalis. + + Revision 1.6 2006/11/25 23:38:02 savage + Changes as proposed by Michalis Kamburelis for better FPC support + + Revision 1.5 2006/11/20 21:20:59 savage + Updated to work in MacOS X + + Revision 1.4 2005/05/22 18:52:09 savage + Changes as suggested by Michalis Kamburelis. Thanks again. + + Revision 1.3 2004/10/07 21:01:29 savage + Fix for FPC + + Revision 1.2 2004/08/14 22:54:30 savage + Updated so that Library name defines are correctly defined for MacOS X. + + Revision 1.1 2004/03/30 21:53:54 savage + Moved to it's own folder. + + Revision 1.4 2004/02/20 17:09:55 savage + Code tidied up in gl, glu and glut, while extensions in glext.pas are now loaded using SDL_GL_GetProcAddress, thus making it more cross-platform compatible, but now more tied to SDL. + + Revision 1.3 2004/02/14 00:23:39 savage + As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change. + + Revision 1.2 2004/02/14 00:09:19 savage + Changed uses to now make use of moduleloader.pas rather than dllfuncs.pas + + Revision 1.1 2004/02/05 00:08:19 savage + Module 1.0 release + + Revision 1.4 2003/06/02 12:32:13 savage + Modified Sources to avoid warnings with Delphi by moving CVS Logging to the top of the header files. Hopefully CVS Logging still works. + + Revision 1.3 2003/05/29 22:55:00 savage + Make use of new DLLFunctions + + Revision 1.2 2003/05/27 09:39:53 savage + Added better Gnu Pascal support. + + Revision 1.1 2003/05/11 13:18:03 savage + Newest OpenGL Headers For Delphi, Kylix and FPC + + Revision 1.2 2002/10/13 14:36:47 sg + * Win32 fix: The OS symbol is called "Win32", not "Windows" + + 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 + +} + +interface + +{$I jedi-sdl.inc} + +uses +{$IFDEF __GPC__} + gpc, +{$ENDIF} + moduleloader, + gl; + +const +{$IFDEF WINDOWS} + GLuLibName = 'glu32.dll'; +{$ENDIF} + +{$IFDEF UNIX} +{$IFDEF DARWIN} + GLuLibName = '/System/Library/Frameworks/OpenGL.framework/Libraries/libGLU.dylib'; +{$ELSE} + GLuLibName = 'libGLU.so'; +{$ENDIF} +{$ENDIF} + +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; +{$IFNDEF __GPC__} + PPointer = ^Pointer; +{$ENDIF} + +var + gluErrorString : function( errCode : GLenum ) : PChar; {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluErrorUnicodeStringEXT : function( errCode : GLenum ) : PWideChar; {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluGetString : function( name : GLenum ) : PChar; {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluOrtho2D : procedure( left, right, bottom, top : GLdouble ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluPerspective : procedure( fovy, aspect, zNear, zFar : GLdouble ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluPickMatrix : procedure( x, y, width, height : GLdouble; var viewport : TViewPortArray ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluLookAt : procedure( eyex, eyey, eyez, centerx, centery, centerz, upx, upy, upz : GLdouble ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluProject : function( objx, objy, objz : GLdouble; var modelMatrix, projMatrix : T16dArray; var viewport : TViewPortArray; winx, winy, winz : PGLdouble ) : Integer; {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluUnProject : function( winx, winy, winz : GLdouble; var modelMatrix, projMatrix : T16dArray; var viewport : TViewPortArray; objx, objy, objz : PGLdouble ) : Integer; {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluScaleImage : function( format : GLenum; widthin, heightin : GLint; typein : GLenum; const datain : Pointer; widthout, heightout : GLint; typeout : GLenum; dataout : Pointer ) : Integer; {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluBuild1DMipmaps : function( target : GLenum; components, width : GLint; format, atype : GLenum; const data : Pointer ) : Integer; {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluBuild2DMipmaps : function( target : GLenum; components, width, height : GLint; format, atype : GLenum; const data : Pointer ) : Integer; {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + +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; {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluDeleteQuadric : procedure( state : PGLUquadric ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluQuadricNormals : procedure( quadObject : PGLUquadric; normals : GLenum ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluQuadricTexture : procedure( quadObject : PGLUquadric; textureCoords : GLboolean ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluQuadricOrientation : procedure( quadObject : PGLUquadric; orientation : GLenum ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluQuadricDrawStyle : procedure( quadObject : PGLUquadric; drawStyle : GLenum ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluCylinder : procedure( qobj : PGLUquadric; baseRadius, topRadius, height : GLdouble; slices, stacks : GLint ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluDisk : procedure( qobj : PGLUquadric; innerRadius, outerRadius : GLdouble; slices, loops : GLint ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluPartialDisk : procedure( qobj : PGLUquadric; innerRadius, outerRadius : GLdouble; slices, loops : GLint; startAngle, sweepAngle : GLdouble ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluSphere : procedure( qobj : PGLuquadric; radius : GLdouble; slices, stacks : GLint ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluQuadricCallback : procedure( qobj : PGLUquadric; which : GLenum; fn : TCallBack ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluNewTess : function : PGLUtesselator; {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluDeleteTess : procedure( tess : PGLUtesselator ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluTessBeginPolygon : procedure( tess : PGLUtesselator; polygon_data : Pointer ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluTessBeginContour : procedure( tess : PGLUtesselator ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluTessVertex : procedure( tess : PGLUtesselator; var coords : T3dArray; data : Pointer ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluTessEndContour : procedure( tess : PGLUtesselator ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluTessEndPolygon : procedure( tess : PGLUtesselator ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluTessProperty : procedure( tess : PGLUtesselator; which : GLenum; value : GLdouble ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluTessNormal : procedure( tess : PGLUtesselator; x, y, z : GLdouble ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluTessCallback : procedure( tess : PGLUtesselator; which : GLenum; fn : TCallBack ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluGetTessProperty : procedure( tess : PGLUtesselator; which : GLenum; value : PGLdouble ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluNewNurbsRenderer : function : PGLUnurbs; {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluDeleteNurbsRenderer : procedure( nobj : PGLUnurbs ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluBeginSurface : procedure( nobj : PGLUnurbs ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluBeginCurve : procedure( nobj : PGLUnurbs ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluEndCurve : procedure( nobj : PGLUnurbs ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluEndSurface : procedure( nobj : PGLUnurbs ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluBeginTrim : procedure( nobj : PGLUnurbs ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluEndTrim : procedure( nobj : PGLUnurbs ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluPwlCurve : procedure( nobj : PGLUnurbs; count : GLint; aarray : PGLfloat; stride : GLint; atype : GLenum ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluNurbsCurve : procedure( nobj : PGLUnurbs; nknots : GLint; knot : PGLfloat; stride : GLint; ctlarray : PGLfloat; order : GLint; atype : GLenum ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + 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 ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluLoadSamplingMatrices : procedure( nobj : PGLUnurbs; var modelMatrix, projMatrix : T16dArray; var viewport : TViewPortArray ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluNurbsProperty : procedure( nobj : PGLUnurbs; aproperty : GLenum; value : GLfloat ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluGetNurbsProperty : procedure( nobj : PGLUnurbs; aproperty : GLenum; value : PGLfloat ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluNurbsCallback : procedure( nobj : PGLUnurbs; which : GLenum; fn : TCallBack ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + +(**** Callback function prototypes ****) + +type + // gluQuadricCallback + GLUquadricErrorProc = procedure( p : GLenum ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + + // gluTessCallback + GLUtessBeginProc = procedure( p : GLenum ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + GLUtessEdgeFlagProc = procedure( p : GLboolean ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + GLUtessVertexProc = procedure( p : Pointer ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + GLUtessEndProc = procedure; {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + GLUtessErrorProc = procedure( p : GLenum ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + GLUtessCombineProc = procedure( var p1 : T3dArray; p2 : T4pArray; p3 : T4fArray; p4 : PPointer ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + GLUtessBeginDataProc = procedure( p1 : GLenum; p2 : Pointer ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + GLUtessEdgeFlagDataProc = procedure( p1 : GLboolean; p2 : Pointer ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + GLUtessVertexDataProc = procedure( p1, p2 : Pointer ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + GLUtessEndDataProc = procedure( p : Pointer ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + GLUtessErrorDataProc = procedure( p1 : GLenum; p2 : Pointer ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + GLUtessCombineDataProc = procedure( var p1 : T3dArray; var p2 : T4pArray; var p3 : T4fArray; + p4 : PPointer; p5 : Pointer ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + + // gluNurbsCallback + GLUnurbsErrorProc = procedure( p : GLenum ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + + +//*** 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 ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluNextContour : procedure( tess : PGLUtesselator; atype : GLenum ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + gluEndPolygon : procedure( tess : PGLUtesselator ); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF} + +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 : PChar ); +procedure FreeGLu; + +implementation + +var + LibGlu : TModuleHandle; + +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; + + UnLoadModule( LibGlu ); + +end; + +procedure LoadGLu( const dll : PChar ); +begin + + FreeGLu; + + if LoadModule( LibGlu, dll ) then + begin + @gluErrorString := GetModuleSymbol( LibGlu, 'gluErrorString' ); + @gluErrorUnicodeStringEXT := GetModuleSymbol( LibGlu, 'gluErrorUnicodeStringEXT' ); + @gluGetString := GetModuleSymbol( LibGlu, 'gluGetString' ); + @gluOrtho2D := GetModuleSymbol( LibGlu, 'gluOrtho2D' ); + @gluPerspective := GetModuleSymbol( LibGlu, 'gluPerspective' ); + @gluPickMatrix := GetModuleSymbol( LibGlu, 'gluPickMatrix' ); + @gluLookAt := GetModuleSymbol( LibGlu, 'gluLookAt' ); + @gluProject := GetModuleSymbol( LibGlu, 'gluProject' ); + @gluUnProject := GetModuleSymbol( LibGlu, 'gluUnProject' ); + @gluScaleImage := GetModuleSymbol( LibGlu, 'gluScaleImage' ); + @gluBuild1DMipmaps := GetModuleSymbol( LibGlu, 'gluBuild1DMipmaps' ); + @gluBuild2DMipmaps := GetModuleSymbol( LibGlu, 'gluBuild2DMipmaps' ); + @gluNewQuadric := GetModuleSymbol( LibGlu, 'gluNewQuadric' ); + @gluDeleteQuadric := GetModuleSymbol( LibGlu, 'gluDeleteQuadric' ); + @gluQuadricNormals := GetModuleSymbol( LibGlu, 'gluQuadricNormals' ); + @gluQuadricTexture := GetModuleSymbol( LibGlu, 'gluQuadricTexture' ); + @gluQuadricOrientation := GetModuleSymbol( LibGlu, 'gluQuadricOrientation' ); + @gluQuadricDrawStyle := GetModuleSymbol( LibGlu, 'gluQuadricDrawStyle' ); + @gluCylinder := GetModuleSymbol( LibGlu, 'gluCylinder' ); + @gluDisk := GetModuleSymbol( LibGlu, 'gluDisk' ); + @gluPartialDisk := GetModuleSymbol( LibGlu, 'gluPartialDisk' ); + @gluSphere := GetModuleSymbol( LibGlu, 'gluSphere' ); + @gluQuadricCallback := GetModuleSymbol( LibGlu, 'gluQuadricCallback' ); + @gluNewTess := GetModuleSymbol( LibGlu, 'gluNewTess' ); + @gluDeleteTess := GetModuleSymbol( LibGlu, 'gluDeleteTess' ); + @gluTessBeginPolygon := GetModuleSymbol( LibGlu, 'gluTessBeginPolygon' ); + @gluTessBeginContour := GetModuleSymbol( LibGlu, 'gluTessBeginContour' ); + @gluTessVertex := GetModuleSymbol( LibGlu, 'gluTessVertex' ); + @gluTessEndContour := GetModuleSymbol( LibGlu, 'gluTessEndContour' ); + @gluTessEndPolygon := GetModuleSymbol( LibGlu, 'gluTessEndPolygon' ); + @gluTessProperty := GetModuleSymbol( LibGlu, 'gluTessProperty' ); + @gluTessNormal := GetModuleSymbol( LibGlu, 'gluTessNormal' ); + @gluTessCallback := GetModuleSymbol( LibGlu, 'gluTessCallback' ); + @gluGetTessProperty := GetModuleSymbol( LibGlu, 'gluGetTessProperty' ); + @gluNewNurbsRenderer := GetModuleSymbol( LibGlu, 'gluNewNurbsRenderer' ); + @gluDeleteNurbsRenderer := GetModuleSymbol( LibGlu, 'gluDeleteNurbsRenderer' ); + @gluBeginSurface := GetModuleSymbol( LibGlu, 'gluBeginSurface' ); + @gluBeginCurve := GetModuleSymbol( LibGlu, 'gluBeginCurve' ); + @gluEndCurve := GetModuleSymbol( LibGlu, 'gluEndCurve' ); + @gluEndSurface := GetModuleSymbol( LibGlu, 'gluEndSurface' ); + @gluBeginTrim := GetModuleSymbol( LibGlu, 'gluBeginTrim' ); + @gluEndTrim := GetModuleSymbol( LibGlu, 'gluEndTrim' ); + @gluPwlCurve := GetModuleSymbol( LibGlu, 'gluPwlCurve' ); + @gluNurbsCurve := GetModuleSymbol( LibGlu, 'gluNurbsCurve' ); + @gluNurbsSurface := GetModuleSymbol( LibGlu, 'gluNurbsSurface' ); + @gluLoadSamplingMatrices := GetModuleSymbol( LibGlu, 'gluLoadSamplingMatrices' ); + @gluNurbsProperty := GetModuleSymbol( LibGlu, 'gluNurbsProperty' ); + @gluGetNurbsProperty := GetModuleSymbol( LibGlu, 'gluGetNurbsProperty' ); + @gluNurbsCallback := GetModuleSymbol( LibGlu, 'gluNurbsCallback' ); + + @gluBeginPolygon := GetModuleSymbol( LibGlu, 'gluBeginPolygon' ); + @gluNextContour := GetModuleSymbol( LibGlu, 'gluNextContour' ); + @gluEndPolygon := GetModuleSymbol( LibGlu, 'gluEndPolygon' ); + end; +end; + +initialization + + LoadGLu( GLuLibName ); + +finalization + + FreeGLu; + +end. + diff --git a/Game/Code/lib/JEDI-SDL/OpenGL/Pas/glut.pas b/Game/Code/lib/JEDI-SDL/OpenGL/Pas/glut.pas index 3bea3499..04f69267 100644 --- a/Game/Code/lib/JEDI-SDL/OpenGL/Pas/glut.pas +++ b/Game/Code/lib/JEDI-SDL/OpenGL/Pas/glut.pas @@ -1,688 +1,688 @@ -unit glut;
-{
- $Id: glut.pas,v 1.4 2007/05/20 20:28:31 savage Exp $
-
- Adaption of the delphi3d.net OpenGL units to FreePascal
- Sebastian Guenther (sg@freepascal.org) in 2002
- These units are free to use
-}
-
-// 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) }
-{ For the latest updates, visit Delphi3D: http://www.delphi3d.net }
-{ }
-{ Modified for Delphi/Kylix and FreePascal }
-{ by Dominique Louis ( Dominique@Savagesoftware.com.au) }
-{ For the latest updates, visit JEDI-SDL : http://www.sf.net/projects/jedi-sdl }
-{ }
-{******************************************************************************}
-
-{
- $Log: glut.pas,v $
- Revision 1.4 2007/05/20 20:28:31 savage
- Initial Changes to Handle 64 Bits
-
- Revision 1.3 2006/11/20 21:20:59 savage
- Updated to work in MacOS X
-
- Revision 1.2 2004/08/14 22:54:30 savage
- Updated so that Library name defines are correctly defined for MacOS X.
-
- Revision 1.1 2004/03/30 21:53:54 savage
- Moved to it's own folder.
-
- Revision 1.5 2004/02/20 17:09:55 savage
- Code tidied up in gl, glu and glut, while extensions in glext.pas are now loaded using SDL_GL_GetProcAddress, thus making it more cross-platform compatible, but now more tied to SDL.
-
- Revision 1.4 2004/02/14 22:36:29 savage
- Fixed inconsistencies of using LoadLibrary and LoadModule.
- Now all units make use of LoadModule rather than LoadLibrary and other dynamic proc procedures.
-
- Revision 1.3 2004/02/14 00:23:39 savage
- As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change.
-
- Revision 1.2 2004/02/14 00:09:19 savage
- Changed uses to now make use of moduleloader.pas rather than dllfuncs.pas
-
- Revision 1.1 2004/02/05 00:08:19 savage
- Module 1.0 release
-
- Revision 1.4 2003/06/02 12:32:13 savage
- Modified Sources to avoid warnings with Delphi by moving CVS Logging to the top of the header files. Hopefully CVS Logging still works.
-
-}
-
-interface
-
-{$I jedi-sdl.inc}
-
-uses
-{$IFDEF __GPC__}
- system,
- gpc,
-{$ENDIF}
-
-{$IFDEF WINDOWS}
- Windows,
-{$ENDIF}
- moduleloader,
- gl;
-
-type
- {$IFNDEF __GPC__}
- PInteger = ^Integer;
- PPChar = ^PChar;
- {$ENDIF}
- TGlutVoidCallback = procedure; {$IFNDEF __GPC__}{$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}{$ENDIF}
- TGlut1IntCallback = procedure(value: Integer); {$IFNDEF __GPC__}{$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}{$ENDIF}
- TGlut2IntCallback = procedure(v1, v2: Integer); {$IFNDEF __GPC__}{$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}{$ENDIF}
- TGlut3IntCallback = procedure(v1, v2, v3: Integer); {$IFNDEF __GPC__}{$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}{$ENDIF}
- TGlut4IntCallback = procedure(v1, v2, v3, v4: Integer); {$IFNDEF __GPC__}{$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}{$ENDIF}
- TGlut1Char2IntCallback = procedure(c: Byte; v1, v2: Integer); {$IFNDEF __GPC__}{$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}{$ENDIF}
-
-const
-{$IFDEF WINDOWS}
- GlutLibName = 'glut32.dll';
-{$ENDIF}
-
-{$IFDEF UNIX}
-{$IFDEF DARWIN}
- GlutLibName = '/System/Library/Frameworks/GLUT.framework/Libraries/libglut.dylib';
-{$ELSE}
- GlutLibName = 'libglut.so';
-{$ENDIF}
-{$ENDIF}
-
- 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); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutInitDisplayMode: procedure(mode: Word); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutInitDisplayString: procedure(const str: PChar); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutInitWindowPosition: procedure(x, y: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutInitWindowSize: procedure(width, height: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutMainLoop: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-// GLUT window sub-API.
- glutCreateWindow: function(const title: PChar): Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutCreateSubWindow: function(win, x, y, width, height: Integer): Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutDestroyWindow: procedure(win: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutPostRedisplay: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutPostWindowRedisplay: procedure(win: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutSwapBuffers: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutGetWindow: function: Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutSetWindow: procedure(win: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutSetWindowTitle: procedure(const title: PChar); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutSetIconTitle: procedure(const title: PChar); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutPositionWindow: procedure(x, y: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutReshapeWindow: procedure(width, height: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutPopWindow: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutPushWindow: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutIconifyWindow: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutShowWindow: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutHideWindow: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutFullScreen: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutSetCursor: procedure(cursor: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutWarpPointer: procedure(x, y: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-// GLUT overlay sub-API.
- glutEstablishOverlay: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutRemoveOverlay: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutUseLayer: procedure(layer: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutPostOverlayRedisplay: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutPostWindowOverlayRedisplay: procedure(win: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutShowOverlay: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutHideOverlay: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-// GLUT menu sub-API.
- glutCreateMenu: function(callback: TGlut1IntCallback): Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutDestroyMenu: procedure(menu: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutGetMenu: function: Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutSetMenu: procedure(menu: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutAddMenuEntry: procedure(const caption: PChar; value: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutAddSubMenu: procedure(const caption: PChar; submenu: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutChangeToMenuEntry: procedure(item: Integer; const caption: PChar; value: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutChangeToSubMenu: procedure(item: Integer; const caption: PChar; submenu: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutRemoveMenuItem: procedure(item: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutAttachMenu: procedure(button: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutDetachMenu: procedure(button: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-// GLUTsub-API.
- glutDisplayFunc: procedure(f: TGlutVoidCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutReshapeFunc: procedure(f: TGlut2IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutKeyboardFunc: procedure(f: TGlut1Char2IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutMouseFunc: procedure(f: TGlut4IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutMotionFunc: procedure(f: TGlut2IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutPassiveMotionFunc: procedure(f: TGlut2IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutEntryFunc: procedure(f: TGlut1IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutVisibilityFunc: procedure(f: TGlut1IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutIdleFunc: procedure(f: TGlutVoidCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutTimerFunc: procedure(millis: Word; f: TGlut1IntCallback; value: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutMenuStateFunc: procedure(f: TGlut1IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutSpecialFunc: procedure(f: TGlut3IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutSpaceballMotionFunc: procedure(f: TGlut3IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutSpaceballRotateFunc: procedure(f: TGlut3IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutSpaceballButtonFunc: procedure(f: TGlut2IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutButtonBoxFunc: procedure(f: TGlut2IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutDialsFunc: procedure(f: TGlut2IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutTabletMotionFunc: procedure(f: TGlut2IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutTabletButtonFunc: procedure(f: TGlut4IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutMenuStatusFunc: procedure(f: TGlut3IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutOverlayDisplayFunc: procedure(f:TGlutVoidCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutWindowStatusFunc: procedure(f: TGlut1IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-// GLUT color index sub-API.
- glutSetColor: procedure(cell: Integer; red, green, blue: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutGetColor: function(ndx, component: Integer): GLfloat; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutCopyColormap: procedure(win: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-// GLUT state retrieval sub-API.
- glutGet: function(t: GLenum): Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutDeviceGet: function(t: GLenum): Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-// GLUT extension support sub-API
- glutExtensionSupported: function(const name: PChar): Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutGetModifiers: function: Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutLayerGet: function(t: GLenum): Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-// GLUT font sub-API
- glutBitmapCharacter: procedure(font : pointer; character: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutBitmapWidth: function(font : pointer; character: Integer): Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutStrokeCharacter: procedure(font : pointer; character: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutStrokeWidth: function(font : pointer; character: Integer): Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutBitmapLength: function(font: pointer; const str: PChar): Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutStrokeLength: function(font: pointer; const str: PChar): Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-// GLUT pre-built models sub-API
- glutWireSphere: procedure(radius: GLdouble; slices, stacks: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutSolidSphere: procedure(radius: GLdouble; slices, stacks: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutWireCone: procedure(base, height: GLdouble; slices, stacks: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutSolidCone: procedure(base, height: GLdouble; slices, stacks: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutWireCube: procedure(size: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutSolidCube: procedure(size: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutWireTorus: procedure(innerRadius, outerRadius: GLdouble; sides, rings: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutSolidTorus: procedure(innerRadius, outerRadius: GLdouble; sides, rings: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutWireDodecahedron: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutSolidDodecahedron: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutWireTeapot: procedure(size: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutSolidTeapot: procedure(size: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutWireOctahedron: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutSolidOctahedron: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutWireTetrahedron: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutSolidTetrahedron: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutWireIcosahedron: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutSolidIcosahedron: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-// GLUT video resize sub-API.
- glutVideoResizeGet: function(param: GLenum): Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutSetupVideoResizing: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutStopVideoResizing: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutVideoResize: procedure(x, y, width, height: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutVideoPan: procedure(x, y, width, height: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-// GLUT debugging sub-API.
- glutReportErrors: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-var
- //example glutGameModeString('1280x1024:32@75');
- glutGameModeString : procedure (const AString : PChar); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutEnterGameMode : function : integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutLeaveGameMode : procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
- glutGameModeGet : function (mode : GLenum) : integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-
-procedure LoadGlut(const dll: PChar);
-procedure FreeGlut;
-
-implementation
-
-var
- LibGLUT : TModuleHandle;
-
-procedure FreeGlut;
-begin
-
- UnLoadModule( LibGLUT );
-
- @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: PChar);
-begin
-
- FreeGlut;
-
- if LoadModule( LibGLUT, dll ) then
- begin
- @glutInit := GetModuleSymbol(LibGLUT, 'glutInit');
- @glutInitDisplayMode := GetModuleSymbol(LibGLUT, 'glutInitDisplayMode');
- @glutInitDisplayString := GetModuleSymbol(LibGLUT, 'glutInitDisplayString');
- @glutInitWindowPosition := GetModuleSymbol(LibGLUT, 'glutInitWindowPosition');
- @glutInitWindowSize := GetModuleSymbol(LibGLUT, 'glutInitWindowSize');
- @glutMainLoop := GetModuleSymbol(LibGLUT, 'glutMainLoop');
- @glutCreateWindow := GetModuleSymbol(LibGLUT, 'glutCreateWindow');
- @glutCreateSubWindow := GetModuleSymbol(LibGLUT, 'glutCreateSubWindow');
- @glutDestroyWindow := GetModuleSymbol(LibGLUT, 'glutDestroyWindow');
- @glutPostRedisplay := GetModuleSymbol(LibGLUT, 'glutPostRedisplay');
- @glutPostWindowRedisplay := GetModuleSymbol(LibGLUT, 'glutPostWindowRedisplay');
- @glutSwapBuffers := GetModuleSymbol(LibGLUT, 'glutSwapBuffers');
- @glutGetWindow := GetModuleSymbol(LibGLUT, 'glutGetWindow');
- @glutSetWindow := GetModuleSymbol(LibGLUT, 'glutSetWindow');
- @glutSetWindowTitle := GetModuleSymbol(LibGLUT, 'glutSetWindowTitle');
- @glutSetIconTitle := GetModuleSymbol(LibGLUT, 'glutSetIconTitle');
- @glutPositionWindow := GetModuleSymbol(LibGLUT, 'glutPositionWindow');
- @glutReshapeWindow := GetModuleSymbol(LibGLUT, 'glutReshapeWindow');
- @glutPopWindow := GetModuleSymbol(LibGLUT, 'glutPopWindow');
- @glutPushWindow := GetModuleSymbol(LibGLUT, 'glutPushWindow');
- @glutIconifyWindow := GetModuleSymbol(LibGLUT, 'glutIconifyWindow');
- @glutShowWindow := GetModuleSymbol(LibGLUT, 'glutShowWindow');
- @glutHideWindow := GetModuleSymbol(LibGLUT, 'glutHideWindow');
- @glutFullScreen := GetModuleSymbol(LibGLUT, 'glutFullScreen');
- @glutSetCursor := GetModuleSymbol(LibGLUT, 'glutSetCursor');
- @glutWarpPointer := GetModuleSymbol(LibGLUT, 'glutWarpPointer');
- @glutEstablishOverlay := GetModuleSymbol(LibGLUT, 'glutEstablishOverlay');
- @glutRemoveOverlay := GetModuleSymbol(LibGLUT, 'glutRemoveOverlay');
- @glutUseLayer := GetModuleSymbol(LibGLUT, 'glutUseLayer');
- @glutPostOverlayRedisplay := GetModuleSymbol(LibGLUT, 'glutPostOverlayRedisplay');
- @glutPostWindowOverlayRedisplay := GetModuleSymbol(LibGLUT, 'glutPostWindowOverlayRedisplay');
- @glutShowOverlay := GetModuleSymbol(LibGLUT, 'glutShowOverlay');
- @glutHideOverlay := GetModuleSymbol(LibGLUT, 'glutHideOverlay');
- @glutCreateMenu := GetModuleSymbol(LibGLUT, 'glutCreateMenu');
- @glutDestroyMenu := GetModuleSymbol(LibGLUT, 'glutDestroyMenu');
- @glutGetMenu := GetModuleSymbol(LibGLUT, 'glutGetMenu');
- @glutSetMenu := GetModuleSymbol(LibGLUT, 'glutSetMenu');
- @glutAddMenuEntry := GetModuleSymbol(LibGLUT, 'glutAddMenuEntry');
- @glutAddSubMenu := GetModuleSymbol(LibGLUT, 'glutAddSubMenu');
- @glutChangeToMenuEntry := GetModuleSymbol(LibGLUT, 'glutChangeToMenuEntry');
- @glutChangeToSubMenu := GetModuleSymbol(LibGLUT, 'glutChangeToSubMenu');
- @glutRemoveMenuItem := GetModuleSymbol(LibGLUT, 'glutRemoveMenuItem');
- @glutAttachMenu := GetModuleSymbol(LibGLUT, 'glutAttachMenu');
- @glutDetachMenu := GetModuleSymbol(LibGLUT, 'glutDetachMenu');
- @glutDisplayFunc := GetModuleSymbol(LibGLUT, 'glutDisplayFunc');
- @glutReshapeFunc := GetModuleSymbol(LibGLUT, 'glutReshapeFunc');
- @glutKeyboardFunc := GetModuleSymbol(LibGLUT, 'glutKeyboardFunc');
- @glutMouseFunc := GetModuleSymbol(LibGLUT, 'glutMouseFunc');
- @glutMotionFunc := GetModuleSymbol(LibGLUT, 'glutMotionFunc');
- @glutPassiveMotionFunc := GetModuleSymbol(LibGLUT, 'glutPassiveMotionFunc');
- @glutEntryFunc := GetModuleSymbol(LibGLUT, 'glutEntryFunc');
- @glutVisibilityFunc := GetModuleSymbol(LibGLUT, 'glutVisibilityFunc');
- @glutIdleFunc := GetModuleSymbol(LibGLUT, 'glutIdleFunc');
- @glutTimerFunc := GetModuleSymbol(LibGLUT, 'glutTimerFunc');
- @glutMenuStateFunc := GetModuleSymbol(LibGLUT, 'glutMenuStateFunc');
- @glutSpecialFunc := GetModuleSymbol(LibGLUT, 'glutSpecialFunc');
- @glutSpaceballMotionFunc := GetModuleSymbol(LibGLUT, 'glutSpaceballMotionFunc');
- @glutSpaceballRotateFunc := GetModuleSymbol(LibGLUT, 'glutSpaceballRotateFunc');
- @glutSpaceballButtonFunc := GetModuleSymbol(LibGLUT, 'glutSpaceballButtonFunc');
- @glutButtonBoxFunc := GetModuleSymbol(LibGLUT, 'glutButtonBoxFunc');
- @glutDialsFunc := GetModuleSymbol(LibGLUT, 'glutDialsFunc');
- @glutTabletMotionFunc := GetModuleSymbol(LibGLUT, 'glutTabletMotionFunc');
- @glutTabletButtonFunc := GetModuleSymbol(LibGLUT, 'glutTabletButtonFunc');
- @glutMenuStatusFunc := GetModuleSymbol(LibGLUT, 'glutMenuStatusFunc');
- @glutOverlayDisplayFunc := GetModuleSymbol(LibGLUT, 'glutOverlayDisplayFunc');
- @glutWindowStatusFunc := GetModuleSymbol(LibGLUT, 'glutWindowStatusFunc');
- @glutSetColor := GetModuleSymbol(LibGLUT, 'glutSetColor');
- @glutGetColor := GetModuleSymbol(LibGLUT, 'glutGetColor');
- @glutCopyColormap := GetModuleSymbol(LibGLUT, 'glutCopyColormap');
- @glutGet := GetModuleSymbol(LibGLUT, 'glutGet');
- @glutDeviceGet := GetModuleSymbol(LibGLUT, 'glutDeviceGet');
- @glutExtensionSupported := GetModuleSymbol(LibGLUT, 'glutExtensionSupported');
- @glutGetModifiers := GetModuleSymbol(LibGLUT, 'glutGetModifiers');
- @glutLayerGet := GetModuleSymbol(LibGLUT, 'glutLayerGet');
- @glutBitmapCharacter := GetModuleSymbol(LibGLUT, 'glutBitmapCharacter');
- @glutBitmapWidth := GetModuleSymbol(LibGLUT, 'glutBitmapWidth');
- @glutStrokeCharacter := GetModuleSymbol(LibGLUT, 'glutStrokeCharacter');
- @glutStrokeWidth := GetModuleSymbol(LibGLUT, 'glutStrokeWidth');
- @glutBitmapLength := GetModuleSymbol(LibGLUT, 'glutBitmapLength');
- @glutStrokeLength := GetModuleSymbol(LibGLUT, 'glutStrokeLength');
- @glutWireSphere := GetModuleSymbol(LibGLUT, 'glutWireSphere');
- @glutSolidSphere := GetModuleSymbol(LibGLUT, 'glutSolidSphere');
- @glutWireCone := GetModuleSymbol(LibGLUT, 'glutWireCone');
- @glutSolidCone := GetModuleSymbol(LibGLUT, 'glutSolidCone');
- @glutWireCube := GetModuleSymbol(LibGLUT, 'glutWireCube');
- @glutSolidCube := GetModuleSymbol(LibGLUT, 'glutSolidCube');
- @glutWireTorus := GetModuleSymbol(LibGLUT, 'glutWireTorus');
- @glutSolidTorus := GetModuleSymbol(LibGLUT, 'glutSolidTorus');
- @glutWireDodecahedron := GetModuleSymbol(LibGLUT, 'glutWireDodecahedron');
- @glutSolidDodecahedron := GetModuleSymbol(LibGLUT, 'glutSolidDodecahedron');
- @glutWireTeapot := GetModuleSymbol(LibGLUT, 'glutWireTeapot');
- @glutSolidTeapot := GetModuleSymbol(LibGLUT, 'glutSolidTeapot');
- @glutWireOctahedron := GetModuleSymbol(LibGLUT, 'glutWireOctahedron');
- @glutSolidOctahedron := GetModuleSymbol(LibGLUT, 'glutSolidOctahedron');
- @glutWireTetrahedron := GetModuleSymbol(LibGLUT, 'glutWireTetrahedron');
- @glutSolidTetrahedron := GetModuleSymbol(LibGLUT, 'glutSolidTetrahedron');
- @glutWireIcosahedron := GetModuleSymbol(LibGLUT, 'glutWireIcosahedron');
- @glutSolidIcosahedron := GetModuleSymbol(LibGLUT, 'glutSolidIcosahedron');
- @glutVideoResizeGet := GetModuleSymbol(LibGLUT, 'glutVideoResizeGet');
- @glutSetupVideoResizing := GetModuleSymbol(LibGLUT, 'glutSetupVideoResizing');
- @glutStopVideoResizing := GetModuleSymbol(LibGLUT, 'glutStopVideoResizing');
- @glutVideoResize := GetModuleSymbol(LibGLUT, 'glutVideoResize');
- @glutVideoPan := GetModuleSymbol(LibGLUT, 'glutVideoPan');
- @glutReportErrors := GetModuleSymbol(LibGLUT, 'glutReportErrors');
- @glutGameModeString := GetModuleSymbol(LibGLUT, 'glutGameModeString');
- @glutEnterGameMode := GetModuleSymbol(LibGLUT, 'glutEnterGameMode');
- @glutLeaveGameMode := GetModuleSymbol(LibGLUT, 'glutLeaveGameMode');
- @glutGameModeGet := GetModuleSymbol(LibGLUT, 'glutGameModeGet');
- end;
-end;
-
-initialization
- LoadGlut( GlutLibName );
-
-finalization
- FreeGlut;
-
-end.
+unit glut; +{ + $Id: glut.pas,v 1.4 2007/05/20 20:28:31 savage Exp $ + + Adaption of the delphi3d.net OpenGL units to FreePascal + Sebastian Guenther (sg@freepascal.org) in 2002 + These units are free to use +} + +// 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) } +{ For the latest updates, visit Delphi3D: http://www.delphi3d.net } +{ } +{ Modified for Delphi/Kylix and FreePascal } +{ by Dominique Louis ( Dominique@Savagesoftware.com.au) } +{ For the latest updates, visit JEDI-SDL : http://www.sf.net/projects/jedi-sdl } +{ } +{******************************************************************************} + +{ + $Log: glut.pas,v $ + Revision 1.4 2007/05/20 20:28:31 savage + Initial Changes to Handle 64 Bits + + Revision 1.3 2006/11/20 21:20:59 savage + Updated to work in MacOS X + + Revision 1.2 2004/08/14 22:54:30 savage + Updated so that Library name defines are correctly defined for MacOS X. + + Revision 1.1 2004/03/30 21:53:54 savage + Moved to it's own folder. + + Revision 1.5 2004/02/20 17:09:55 savage + Code tidied up in gl, glu and glut, while extensions in glext.pas are now loaded using SDL_GL_GetProcAddress, thus making it more cross-platform compatible, but now more tied to SDL. + + Revision 1.4 2004/02/14 22:36:29 savage + Fixed inconsistencies of using LoadLibrary and LoadModule. + Now all units make use of LoadModule rather than LoadLibrary and other dynamic proc procedures. + + Revision 1.3 2004/02/14 00:23:39 savage + As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change. + + Revision 1.2 2004/02/14 00:09:19 savage + Changed uses to now make use of moduleloader.pas rather than dllfuncs.pas + + Revision 1.1 2004/02/05 00:08:19 savage + Module 1.0 release + + Revision 1.4 2003/06/02 12:32:13 savage + Modified Sources to avoid warnings with Delphi by moving CVS Logging to the top of the header files. Hopefully CVS Logging still works. + +} + +interface + +{$I jedi-sdl.inc} + +uses +{$IFDEF __GPC__} + system, + gpc, +{$ENDIF} + +{$IFDEF WINDOWS} + Windows, +{$ENDIF} + moduleloader, + gl; + +type + {$IFNDEF __GPC__} + PInteger = ^Integer; + PPChar = ^PChar; + {$ENDIF} + TGlutVoidCallback = procedure; {$IFNDEF __GPC__}{$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}{$ENDIF} + TGlut1IntCallback = procedure(value: Integer); {$IFNDEF __GPC__}{$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}{$ENDIF} + TGlut2IntCallback = procedure(v1, v2: Integer); {$IFNDEF __GPC__}{$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}{$ENDIF} + TGlut3IntCallback = procedure(v1, v2, v3: Integer); {$IFNDEF __GPC__}{$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}{$ENDIF} + TGlut4IntCallback = procedure(v1, v2, v3, v4: Integer); {$IFNDEF __GPC__}{$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}{$ENDIF} + TGlut1Char2IntCallback = procedure(c: Byte; v1, v2: Integer); {$IFNDEF __GPC__}{$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}{$ENDIF} + +const +{$IFDEF WINDOWS} + GlutLibName = 'glut32.dll'; +{$ENDIF} + +{$IFDEF UNIX} +{$IFDEF DARWIN} + GlutLibName = '/System/Library/Frameworks/GLUT.framework/Libraries/libglut.dylib'; +{$ELSE} + GlutLibName = 'libglut.so'; +{$ENDIF} +{$ENDIF} + + 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); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutInitDisplayMode: procedure(mode: Word); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutInitDisplayString: procedure(const str: PChar); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutInitWindowPosition: procedure(x, y: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutInitWindowSize: procedure(width, height: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutMainLoop: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +// GLUT window sub-API. + glutCreateWindow: function(const title: PChar): Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutCreateSubWindow: function(win, x, y, width, height: Integer): Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutDestroyWindow: procedure(win: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutPostRedisplay: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutPostWindowRedisplay: procedure(win: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutSwapBuffers: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutGetWindow: function: Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutSetWindow: procedure(win: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutSetWindowTitle: procedure(const title: PChar); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutSetIconTitle: procedure(const title: PChar); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutPositionWindow: procedure(x, y: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutReshapeWindow: procedure(width, height: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutPopWindow: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutPushWindow: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutIconifyWindow: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutShowWindow: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutHideWindow: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutFullScreen: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutSetCursor: procedure(cursor: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutWarpPointer: procedure(x, y: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +// GLUT overlay sub-API. + glutEstablishOverlay: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutRemoveOverlay: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutUseLayer: procedure(layer: GLenum); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutPostOverlayRedisplay: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutPostWindowOverlayRedisplay: procedure(win: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutShowOverlay: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutHideOverlay: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +// GLUT menu sub-API. + glutCreateMenu: function(callback: TGlut1IntCallback): Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutDestroyMenu: procedure(menu: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutGetMenu: function: Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutSetMenu: procedure(menu: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutAddMenuEntry: procedure(const caption: PChar; value: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutAddSubMenu: procedure(const caption: PChar; submenu: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutChangeToMenuEntry: procedure(item: Integer; const caption: PChar; value: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutChangeToSubMenu: procedure(item: Integer; const caption: PChar; submenu: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutRemoveMenuItem: procedure(item: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutAttachMenu: procedure(button: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutDetachMenu: procedure(button: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +// GLUTsub-API. + glutDisplayFunc: procedure(f: TGlutVoidCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutReshapeFunc: procedure(f: TGlut2IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutKeyboardFunc: procedure(f: TGlut1Char2IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutMouseFunc: procedure(f: TGlut4IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutMotionFunc: procedure(f: TGlut2IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutPassiveMotionFunc: procedure(f: TGlut2IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutEntryFunc: procedure(f: TGlut1IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutVisibilityFunc: procedure(f: TGlut1IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutIdleFunc: procedure(f: TGlutVoidCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutTimerFunc: procedure(millis: Word; f: TGlut1IntCallback; value: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutMenuStateFunc: procedure(f: TGlut1IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutSpecialFunc: procedure(f: TGlut3IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutSpaceballMotionFunc: procedure(f: TGlut3IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutSpaceballRotateFunc: procedure(f: TGlut3IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutSpaceballButtonFunc: procedure(f: TGlut2IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutButtonBoxFunc: procedure(f: TGlut2IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutDialsFunc: procedure(f: TGlut2IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutTabletMotionFunc: procedure(f: TGlut2IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutTabletButtonFunc: procedure(f: TGlut4IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutMenuStatusFunc: procedure(f: TGlut3IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutOverlayDisplayFunc: procedure(f:TGlutVoidCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutWindowStatusFunc: procedure(f: TGlut1IntCallback); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +// GLUT color index sub-API. + glutSetColor: procedure(cell: Integer; red, green, blue: GLfloat); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutGetColor: function(ndx, component: Integer): GLfloat; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutCopyColormap: procedure(win: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +// GLUT state retrieval sub-API. + glutGet: function(t: GLenum): Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutDeviceGet: function(t: GLenum): Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +// GLUT extension support sub-API + glutExtensionSupported: function(const name: PChar): Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutGetModifiers: function: Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutLayerGet: function(t: GLenum): Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +// GLUT font sub-API + glutBitmapCharacter: procedure(font : pointer; character: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutBitmapWidth: function(font : pointer; character: Integer): Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutStrokeCharacter: procedure(font : pointer; character: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutStrokeWidth: function(font : pointer; character: Integer): Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutBitmapLength: function(font: pointer; const str: PChar): Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutStrokeLength: function(font: pointer; const str: PChar): Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +// GLUT pre-built models sub-API + glutWireSphere: procedure(radius: GLdouble; slices, stacks: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutSolidSphere: procedure(radius: GLdouble; slices, stacks: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutWireCone: procedure(base, height: GLdouble; slices, stacks: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutSolidCone: procedure(base, height: GLdouble; slices, stacks: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutWireCube: procedure(size: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutSolidCube: procedure(size: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutWireTorus: procedure(innerRadius, outerRadius: GLdouble; sides, rings: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutSolidTorus: procedure(innerRadius, outerRadius: GLdouble; sides, rings: GLint); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutWireDodecahedron: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutSolidDodecahedron: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutWireTeapot: procedure(size: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutSolidTeapot: procedure(size: GLdouble); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutWireOctahedron: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutSolidOctahedron: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutWireTetrahedron: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutSolidTetrahedron: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutWireIcosahedron: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutSolidIcosahedron: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +// GLUT video resize sub-API. + glutVideoResizeGet: function(param: GLenum): Integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutSetupVideoResizing: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutStopVideoResizing: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutVideoResize: procedure(x, y, width, height: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutVideoPan: procedure(x, y, width, height: Integer); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +// GLUT debugging sub-API. + glutReportErrors: procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +var + //example glutGameModeString('1280x1024:32@75'); + glutGameModeString : procedure (const AString : PChar); {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutEnterGameMode : function : integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutLeaveGameMode : procedure; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + glutGameModeGet : function (mode : GLenum) : integer; {$IFDEF WINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} + +procedure LoadGlut(const dll: PChar); +procedure FreeGlut; + +implementation + +var + LibGLUT : TModuleHandle; + +procedure FreeGlut; +begin + + UnLoadModule( LibGLUT ); + + @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: PChar); +begin + + FreeGlut; + + if LoadModule( LibGLUT, dll ) then + begin + @glutInit := GetModuleSymbol(LibGLUT, 'glutInit'); + @glutInitDisplayMode := GetModuleSymbol(LibGLUT, 'glutInitDisplayMode'); + @glutInitDisplayString := GetModuleSymbol(LibGLUT, 'glutInitDisplayString'); + @glutInitWindowPosition := GetModuleSymbol(LibGLUT, 'glutInitWindowPosition'); + @glutInitWindowSize := GetModuleSymbol(LibGLUT, 'glutInitWindowSize'); + @glutMainLoop := GetModuleSymbol(LibGLUT, 'glutMainLoop'); + @glutCreateWindow := GetModuleSymbol(LibGLUT, 'glutCreateWindow'); + @glutCreateSubWindow := GetModuleSymbol(LibGLUT, 'glutCreateSubWindow'); + @glutDestroyWindow := GetModuleSymbol(LibGLUT, 'glutDestroyWindow'); + @glutPostRedisplay := GetModuleSymbol(LibGLUT, 'glutPostRedisplay'); + @glutPostWindowRedisplay := GetModuleSymbol(LibGLUT, 'glutPostWindowRedisplay'); + @glutSwapBuffers := GetModuleSymbol(LibGLUT, 'glutSwapBuffers'); + @glutGetWindow := GetModuleSymbol(LibGLUT, 'glutGetWindow'); + @glutSetWindow := GetModuleSymbol(LibGLUT, 'glutSetWindow'); + @glutSetWindowTitle := GetModuleSymbol(LibGLUT, 'glutSetWindowTitle'); + @glutSetIconTitle := GetModuleSymbol(LibGLUT, 'glutSetIconTitle'); + @glutPositionWindow := GetModuleSymbol(LibGLUT, 'glutPositionWindow'); + @glutReshapeWindow := GetModuleSymbol(LibGLUT, 'glutReshapeWindow'); + @glutPopWindow := GetModuleSymbol(LibGLUT, 'glutPopWindow'); + @glutPushWindow := GetModuleSymbol(LibGLUT, 'glutPushWindow'); + @glutIconifyWindow := GetModuleSymbol(LibGLUT, 'glutIconifyWindow'); + @glutShowWindow := GetModuleSymbol(LibGLUT, 'glutShowWindow'); + @glutHideWindow := GetModuleSymbol(LibGLUT, 'glutHideWindow'); + @glutFullScreen := GetModuleSymbol(LibGLUT, 'glutFullScreen'); + @glutSetCursor := GetModuleSymbol(LibGLUT, 'glutSetCursor'); + @glutWarpPointer := GetModuleSymbol(LibGLUT, 'glutWarpPointer'); + @glutEstablishOverlay := GetModuleSymbol(LibGLUT, 'glutEstablishOverlay'); + @glutRemoveOverlay := GetModuleSymbol(LibGLUT, 'glutRemoveOverlay'); + @glutUseLayer := GetModuleSymbol(LibGLUT, 'glutUseLayer'); + @glutPostOverlayRedisplay := GetModuleSymbol(LibGLUT, 'glutPostOverlayRedisplay'); + @glutPostWindowOverlayRedisplay := GetModuleSymbol(LibGLUT, 'glutPostWindowOverlayRedisplay'); + @glutShowOverlay := GetModuleSymbol(LibGLUT, 'glutShowOverlay'); + @glutHideOverlay := GetModuleSymbol(LibGLUT, 'glutHideOverlay'); + @glutCreateMenu := GetModuleSymbol(LibGLUT, 'glutCreateMenu'); + @glutDestroyMenu := GetModuleSymbol(LibGLUT, 'glutDestroyMenu'); + @glutGetMenu := GetModuleSymbol(LibGLUT, 'glutGetMenu'); + @glutSetMenu := GetModuleSymbol(LibGLUT, 'glutSetMenu'); + @glutAddMenuEntry := GetModuleSymbol(LibGLUT, 'glutAddMenuEntry'); + @glutAddSubMenu := GetModuleSymbol(LibGLUT, 'glutAddSubMenu'); + @glutChangeToMenuEntry := GetModuleSymbol(LibGLUT, 'glutChangeToMenuEntry'); + @glutChangeToSubMenu := GetModuleSymbol(LibGLUT, 'glutChangeToSubMenu'); + @glutRemoveMenuItem := GetModuleSymbol(LibGLUT, 'glutRemoveMenuItem'); + @glutAttachMenu := GetModuleSymbol(LibGLUT, 'glutAttachMenu'); + @glutDetachMenu := GetModuleSymbol(LibGLUT, 'glutDetachMenu'); + @glutDisplayFunc := GetModuleSymbol(LibGLUT, 'glutDisplayFunc'); + @glutReshapeFunc := GetModuleSymbol(LibGLUT, 'glutReshapeFunc'); + @glutKeyboardFunc := GetModuleSymbol(LibGLUT, 'glutKeyboardFunc'); + @glutMouseFunc := GetModuleSymbol(LibGLUT, 'glutMouseFunc'); + @glutMotionFunc := GetModuleSymbol(LibGLUT, 'glutMotionFunc'); + @glutPassiveMotionFunc := GetModuleSymbol(LibGLUT, 'glutPassiveMotionFunc'); + @glutEntryFunc := GetModuleSymbol(LibGLUT, 'glutEntryFunc'); + @glutVisibilityFunc := GetModuleSymbol(LibGLUT, 'glutVisibilityFunc'); + @glutIdleFunc := GetModuleSymbol(LibGLUT, 'glutIdleFunc'); + @glutTimerFunc := GetModuleSymbol(LibGLUT, 'glutTimerFunc'); + @glutMenuStateFunc := GetModuleSymbol(LibGLUT, 'glutMenuStateFunc'); + @glutSpecialFunc := GetModuleSymbol(LibGLUT, 'glutSpecialFunc'); + @glutSpaceballMotionFunc := GetModuleSymbol(LibGLUT, 'glutSpaceballMotionFunc'); + @glutSpaceballRotateFunc := GetModuleSymbol(LibGLUT, 'glutSpaceballRotateFunc'); + @glutSpaceballButtonFunc := GetModuleSymbol(LibGLUT, 'glutSpaceballButtonFunc'); + @glutButtonBoxFunc := GetModuleSymbol(LibGLUT, 'glutButtonBoxFunc'); + @glutDialsFunc := GetModuleSymbol(LibGLUT, 'glutDialsFunc'); + @glutTabletMotionFunc := GetModuleSymbol(LibGLUT, 'glutTabletMotionFunc'); + @glutTabletButtonFunc := GetModuleSymbol(LibGLUT, 'glutTabletButtonFunc'); + @glutMenuStatusFunc := GetModuleSymbol(LibGLUT, 'glutMenuStatusFunc'); + @glutOverlayDisplayFunc := GetModuleSymbol(LibGLUT, 'glutOverlayDisplayFunc'); + @glutWindowStatusFunc := GetModuleSymbol(LibGLUT, 'glutWindowStatusFunc'); + @glutSetColor := GetModuleSymbol(LibGLUT, 'glutSetColor'); + @glutGetColor := GetModuleSymbol(LibGLUT, 'glutGetColor'); + @glutCopyColormap := GetModuleSymbol(LibGLUT, 'glutCopyColormap'); + @glutGet := GetModuleSymbol(LibGLUT, 'glutGet'); + @glutDeviceGet := GetModuleSymbol(LibGLUT, 'glutDeviceGet'); + @glutExtensionSupported := GetModuleSymbol(LibGLUT, 'glutExtensionSupported'); + @glutGetModifiers := GetModuleSymbol(LibGLUT, 'glutGetModifiers'); + @glutLayerGet := GetModuleSymbol(LibGLUT, 'glutLayerGet'); + @glutBitmapCharacter := GetModuleSymbol(LibGLUT, 'glutBitmapCharacter'); + @glutBitmapWidth := GetModuleSymbol(LibGLUT, 'glutBitmapWidth'); + @glutStrokeCharacter := GetModuleSymbol(LibGLUT, 'glutStrokeCharacter'); + @glutStrokeWidth := GetModuleSymbol(LibGLUT, 'glutStrokeWidth'); + @glutBitmapLength := GetModuleSymbol(LibGLUT, 'glutBitmapLength'); + @glutStrokeLength := GetModuleSymbol(LibGLUT, 'glutStrokeLength'); + @glutWireSphere := GetModuleSymbol(LibGLUT, 'glutWireSphere'); + @glutSolidSphere := GetModuleSymbol(LibGLUT, 'glutSolidSphere'); + @glutWireCone := GetModuleSymbol(LibGLUT, 'glutWireCone'); + @glutSolidCone := GetModuleSymbol(LibGLUT, 'glutSolidCone'); + @glutWireCube := GetModuleSymbol(LibGLUT, 'glutWireCube'); + @glutSolidCube := GetModuleSymbol(LibGLUT, 'glutSolidCube'); + @glutWireTorus := GetModuleSymbol(LibGLUT, 'glutWireTorus'); + @glutSolidTorus := GetModuleSymbol(LibGLUT, 'glutSolidTorus'); + @glutWireDodecahedron := GetModuleSymbol(LibGLUT, 'glutWireDodecahedron'); + @glutSolidDodecahedron := GetModuleSymbol(LibGLUT, 'glutSolidDodecahedron'); + @glutWireTeapot := GetModuleSymbol(LibGLUT, 'glutWireTeapot'); + @glutSolidTeapot := GetModuleSymbol(LibGLUT, 'glutSolidTeapot'); + @glutWireOctahedron := GetModuleSymbol(LibGLUT, 'glutWireOctahedron'); + @glutSolidOctahedron := GetModuleSymbol(LibGLUT, 'glutSolidOctahedron'); + @glutWireTetrahedron := GetModuleSymbol(LibGLUT, 'glutWireTetrahedron'); + @glutSolidTetrahedron := GetModuleSymbol(LibGLUT, 'glutSolidTetrahedron'); + @glutWireIcosahedron := GetModuleSymbol(LibGLUT, 'glutWireIcosahedron'); + @glutSolidIcosahedron := GetModuleSymbol(LibGLUT, 'glutSolidIcosahedron'); + @glutVideoResizeGet := GetModuleSymbol(LibGLUT, 'glutVideoResizeGet'); + @glutSetupVideoResizing := GetModuleSymbol(LibGLUT, 'glutSetupVideoResizing'); + @glutStopVideoResizing := GetModuleSymbol(LibGLUT, 'glutStopVideoResizing'); + @glutVideoResize := GetModuleSymbol(LibGLUT, 'glutVideoResize'); + @glutVideoPan := GetModuleSymbol(LibGLUT, 'glutVideoPan'); + @glutReportErrors := GetModuleSymbol(LibGLUT, 'glutReportErrors'); + @glutGameModeString := GetModuleSymbol(LibGLUT, 'glutGameModeString'); + @glutEnterGameMode := GetModuleSymbol(LibGLUT, 'glutEnterGameMode'); + @glutLeaveGameMode := GetModuleSymbol(LibGLUT, 'glutLeaveGameMode'); + @glutGameModeGet := GetModuleSymbol(LibGLUT, 'glutGameModeGet'); + end; +end; + +initialization + LoadGlut( GlutLibName ); + +finalization + FreeGlut; + +end. diff --git a/Game/Code/lib/JEDI-SDL/OpenGL/Pas/glx.pas b/Game/Code/lib/JEDI-SDL/OpenGL/Pas/glx.pas index 125e3e39..f43a4e4c 100644 --- a/Game/Code/lib/JEDI-SDL/OpenGL/Pas/glx.pas +++ b/Game/Code/lib/JEDI-SDL/OpenGL/Pas/glx.pas @@ -1,280 +1,280 @@ -unit glx;
-{
- $Id: glx.pas,v 1.3 2006/11/20 21:20:59 savage Exp $
-
- 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.}
-
-{
- $Log: glx.pas,v $
- Revision 1.3 2006/11/20 21:20:59 savage
- Updated to work in MacOS X
-
- Revision 1.2 2006/04/18 18:38:33 savage
- fixed boolean test - thanks grudzio
-
- Revision 1.1 2004/03/30 21:53:55 savage
- Moved to it's own folder.
-
- Revision 1.5 2004/02/15 22:48:35 savage
- More FPC and FreeBSD support changes.
-
- Revision 1.4 2004/02/14 22:36:29 savage
- Fixed inconsistencies of using LoadLibrary and LoadModule.
- Now all units make use of LoadModule rather than LoadLibrary and other dynamic proc procedures.
-
- Revision 1.3 2004/02/14 00:23:39 savage
- As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change.
-
- Revision 1.2 2004/02/14 00:09:19 savage
- Changed uses to now make use of moduleloader.pas rather than dllfuncs.pas
-
- Revision 1.1 2004/02/05 00:08:19 savage
- Module 1.0 release
-
- Revision 1.1 2003/05/11 13:18:03 savage
- Newest OpenGL Headers For Delphi, Kylix and FPC
-
- 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
-
-}
-
-interface
-
-{$I jedi-sdl.inc}
-
-{$IFDEF UNIX}
- uses
- {$IFDEF FPC}
- x,
- xlib,
- xutil;
- {$ELSE}
- xlib;
- {$ENDIF}
- {$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:
- {$IFNDEF FPC}
- TXID = XID;
- {$ENDIF}
- 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
-
-uses
- {$IFNDEF __GPC__}
- SysUtils,
- {$ENDIF}
- moduleloader;
-
-(* {$LINKLIB m} *)
-
-var
- libGLX: TModuleHandle;
-
-function InitGLXFromLibrary( dll : PChar ): Boolean;
-begin
- Result := False;
-
- if not LoadModule( libGLX, dll ) then
- exit;
-
- glXChooseVisual := GetModuleSymbol(libglx, 'glXChooseVisual');
- glXCreateContext := GetModuleSymbol(libglx, 'glXCreateContext');
- glXDestroyContext := GetModuleSymbol(libglx, 'glXDestroyContext');
- glXMakeCurrent := GetModuleSymbol(libglx, 'glXMakeCurrent');
- glXCopyContext := GetModuleSymbol(libglx, 'glXCopyContext');
- glXSwapBuffers := GetModuleSymbol(libglx, 'glXSwapBuffers');
- glXCreateGLXPixmap := GetModuleSymbol(libglx, 'glXCreateGLXPixmap');
- glXDestroyGLXPixmap := GetModuleSymbol(libglx, 'glXDestroyGLXPixmap');
- glXQueryExtension := GetModuleSymbol(libglx, 'glXQueryExtension');
- glXQueryVersion := GetModuleSymbol(libglx, 'glXQueryVersion');
- glXIsDirect := GetModuleSymbol(libglx, 'glXIsDirect');
- glXGetConfig := GetModuleSymbol(libglx, 'glXGetConfig');
- glXGetCurrentContext := GetModuleSymbol(libglx, 'glXGetCurrentContext');
- glXGetCurrentDrawable := GetModuleSymbol(libglx, 'glXGetCurrentDrawable');
- glXWaitGL := GetModuleSymbol(libglx, 'glXWaitGL');
- glXWaitX := GetModuleSymbol(libglx, 'glXWaitX');
- glXUseXFont := GetModuleSymbol(libglx, 'glXUseXFont');
- // GLX 1.1 and later
- glXQueryExtensionsString := GetModuleSymbol(libglx, 'glXQueryExtensionsString');
- glXQueryServerString := GetModuleSymbol(libglx, 'glXQueryServerString');
- glXGetClientString := GetModuleSymbol(libglx, 'glXGetClientString');
- // Mesa GLX Extensions
- glXCreateGLXPixmapMESA := GetModuleSymbol(libglx, 'glXCreateGLXPixmapMESA');
- glXReleaseBufferMESA := GetModuleSymbol(libglx, 'glXReleaseBufferMESA');
- glXCopySubBufferMESA := GetModuleSymbol(libglx, 'glXCopySubBufferMESA');
- glXGetVideoSyncSGI := GetModuleSymbol(libglx, 'glXGetVideoSyncSGI');
- glXWaitVideoSyncSGI := GetModuleSymbol(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
- UnloadModule(libGLX);
-end.
+unit glx; +{ + $Id: glx.pas,v 1.3 2006/11/20 21:20:59 savage Exp $ + + 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.} + +{ + $Log: glx.pas,v $ + Revision 1.3 2006/11/20 21:20:59 savage + Updated to work in MacOS X + + Revision 1.2 2006/04/18 18:38:33 savage + fixed boolean test - thanks grudzio + + Revision 1.1 2004/03/30 21:53:55 savage + Moved to it's own folder. + + Revision 1.5 2004/02/15 22:48:35 savage + More FPC and FreeBSD support changes. + + Revision 1.4 2004/02/14 22:36:29 savage + Fixed inconsistencies of using LoadLibrary and LoadModule. + Now all units make use of LoadModule rather than LoadLibrary and other dynamic proc procedures. + + Revision 1.3 2004/02/14 00:23:39 savage + As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change. + + Revision 1.2 2004/02/14 00:09:19 savage + Changed uses to now make use of moduleloader.pas rather than dllfuncs.pas + + Revision 1.1 2004/02/05 00:08:19 savage + Module 1.0 release + + Revision 1.1 2003/05/11 13:18:03 savage + Newest OpenGL Headers For Delphi, Kylix and FPC + + 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 + +} + +interface + +{$I jedi-sdl.inc} + +{$IFDEF UNIX} + uses + {$IFDEF FPC} + x, + xlib, + xutil; + {$ELSE} + xlib; + {$ENDIF} + {$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: + {$IFNDEF FPC} + TXID = XID; + {$ENDIF} + 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 + +uses + {$IFNDEF __GPC__} + SysUtils, + {$ENDIF} + moduleloader; + +(* {$LINKLIB m} *) + +var + libGLX: TModuleHandle; + +function InitGLXFromLibrary( dll : PChar ): Boolean; +begin + Result := False; + + if not LoadModule( libGLX, dll ) then + exit; + + glXChooseVisual := GetModuleSymbol(libglx, 'glXChooseVisual'); + glXCreateContext := GetModuleSymbol(libglx, 'glXCreateContext'); + glXDestroyContext := GetModuleSymbol(libglx, 'glXDestroyContext'); + glXMakeCurrent := GetModuleSymbol(libglx, 'glXMakeCurrent'); + glXCopyContext := GetModuleSymbol(libglx, 'glXCopyContext'); + glXSwapBuffers := GetModuleSymbol(libglx, 'glXSwapBuffers'); + glXCreateGLXPixmap := GetModuleSymbol(libglx, 'glXCreateGLXPixmap'); + glXDestroyGLXPixmap := GetModuleSymbol(libglx, 'glXDestroyGLXPixmap'); + glXQueryExtension := GetModuleSymbol(libglx, 'glXQueryExtension'); + glXQueryVersion := GetModuleSymbol(libglx, 'glXQueryVersion'); + glXIsDirect := GetModuleSymbol(libglx, 'glXIsDirect'); + glXGetConfig := GetModuleSymbol(libglx, 'glXGetConfig'); + glXGetCurrentContext := GetModuleSymbol(libglx, 'glXGetCurrentContext'); + glXGetCurrentDrawable := GetModuleSymbol(libglx, 'glXGetCurrentDrawable'); + glXWaitGL := GetModuleSymbol(libglx, 'glXWaitGL'); + glXWaitX := GetModuleSymbol(libglx, 'glXWaitX'); + glXUseXFont := GetModuleSymbol(libglx, 'glXUseXFont'); + // GLX 1.1 and later + glXQueryExtensionsString := GetModuleSymbol(libglx, 'glXQueryExtensionsString'); + glXQueryServerString := GetModuleSymbol(libglx, 'glXQueryServerString'); + glXGetClientString := GetModuleSymbol(libglx, 'glXGetClientString'); + // Mesa GLX Extensions + glXCreateGLXPixmapMESA := GetModuleSymbol(libglx, 'glXCreateGLXPixmapMESA'); + glXReleaseBufferMESA := GetModuleSymbol(libglx, 'glXReleaseBufferMESA'); + glXCopySubBufferMESA := GetModuleSymbol(libglx, 'glXCopySubBufferMESA'); + glXGetVideoSyncSGI := GetModuleSymbol(libglx, 'glXGetVideoSyncSGI'); + glXWaitVideoSyncSGI := GetModuleSymbol(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 + UnloadModule(libGLX); +end. diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/Readme.txt b/Game/Code/lib/JEDI-SDL/SDL/Pas/Readme.txt index 76d63a9d..f176d0c9 100644 --- a/Game/Code/lib/JEDI-SDL/SDL/Pas/Readme.txt +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/Readme.txt @@ -1,27 +1,27 @@ -Delphi interface unit for OpenGL version 1.2 compilable with Delphi 3-6 and Kylix.
-
-This unit is open source under the Mozilla Public License and
-the original author is Dipl. Ing. Mike Lischke (public@lischke-online.de).
-
-You can obtain this unit also from the JEDI (Joint Endeavor of Delphi Innovators)
-API page at www.delphi-jedi.org.
-
-Note for GLScene users: Eric Grange has provided a general vector types unit which
-resolves conflicts for types which are defined in OpenGL12.pas as well as Geometry.pas.
-This unit is located in the sub folder "GLScene AddOn".
-Please add this unit to the uses clause of OpenGL12.pas and remove the few types which
-are already declared in VectorTypes.pas.
-
-For tests and as starting point three demos are included into the package. Two of them (GLDiag and GLTest)
-need the (also provided) simple OpenGL control GLControl (see "GLControl\Package").
-
-- Basic is a very simple test program which only uses an empty form.
-- GLTest (in GLControl) uses GLControl to show four rendering contexts simultanously.
-- GLDiag is a diagnosis tool similar to DXDiag which shows some properties of the current
- OpenGL driver implementation.
-
-Have fun and
-
-Ciao, Mike
-www.lischke-online.de
+Delphi interface unit for OpenGL version 1.2 compilable with Delphi 3-6 and Kylix. + +This unit is open source under the Mozilla Public License and +the original author is Dipl. Ing. Mike Lischke (public@lischke-online.de). + +You can obtain this unit also from the JEDI (Joint Endeavor of Delphi Innovators) +API page at www.delphi-jedi.org. + +Note for GLScene users: Eric Grange has provided a general vector types unit which +resolves conflicts for types which are defined in OpenGL12.pas as well as Geometry.pas. +This unit is located in the sub folder "GLScene AddOn". +Please add this unit to the uses clause of OpenGL12.pas and remove the few types which +are already declared in VectorTypes.pas. + +For tests and as starting point three demos are included into the package. Two of them (GLDiag and GLTest) +need the (also provided) simple OpenGL control GLControl (see "GLControl\Package"). + +- Basic is a very simple test program which only uses an empty form. +- GLTest (in GLControl) uses GLControl to show four rendering contexts simultanously. +- GLDiag is a diagnosis tool similar to DXDiag which shows some properties of the current + OpenGL driver implementation. + +Have fun and + +Ciao, Mike +www.lischke-online.de www.delphi-unicode.net
\ No newline at end of file diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/jedi-sdl.inc b/Game/Code/lib/JEDI-SDL/SDL/Pas/jedi-sdl.inc index 31283d40..0130ad32 100644 --- a/Game/Code/lib/JEDI-SDL/SDL/Pas/jedi-sdl.inc +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/jedi-sdl.inc @@ -1,438 +1,438 @@ -{
- $Id: jedi-sdl.inc,v 1.15 2007/05/29 21:30:48 savage Exp $
-}
-{******************************************************************************}
-{ }
-{ Borland Delphi SDL - Simple DirectMedia Layer }
-{ Global Conditional Definitions for JEDI-SDL cross-compilation }
-{ }
-{ }
-{ The initial developer of this Pascal code was : }
-{ Prof. Abimbola Olowofoyeku <http://www.bigfoot.com/~African_Chief/> }
-{ }
-{ Portions created by Prof. Abimbola Olowofoyeku are }
-{ Copyright (C) 2000 - 2100 Prof. Abimbola Olowofoyeku. }
-{ }
-{ }
-{ Contributor(s) }
-{ -------------- }
-{ Prof. Abimbola Olowofoyeku <http://www.bigfoot.com/~African_Chief/> }
-{ Dominqiue Louis <Dominique@SavageSoftware.com.au> }
-{ }
-{ Obtained through: }
-{ Joint Endeavour of Delphi Innovators ( Project JEDI ) }
-{ }
-{ You may retrieve the latest version of this file at the Project }
-{ JEDI home page, located at http://delphi-jedi.org }
-{ }
-{ The contents of this file are used with permission, subject to }
-{ the Mozilla Public License Version 1.1 (the "License"); you may }
-{ not use this file except in compliance with the License. You may }
-{ obtain a copy of the License at }
-{ http://www.mozilla.org/MPL/MPL-1.1.html }
-{ }
-{ Software distributed under the License is distributed on an }
-{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or }
-{ implied. See the License for the specific language governing }
-{ rights and limitations under the License. }
-{ }
-{ Description }
-{ ----------- }
-{ This code has been copied from... }
-{ Global Conditional Definitions for Chief's UNZIP package }
-{ By Prof. Abimbola Olowofoyeku (The African Chief) }
-{ http://www.bigfoot.com/~African_Chief/ }
-{ }
-{ }
-{ Requires }
-{ -------- }
-{ The SDL Runtime libraris on Win32 : SDL.dll on Linux : libSDL.so }
-{ They are available from... }
-{ http://www.libsdl.org . }
-{ }
-{ Programming Notes }
-{ ----------------- }
-{ }
-{ }
-{ }
-{ }
-{ Revision History }
-{ ---------------- }
-{ 2003-04-03 DL - Initial addition }
-{ }
-{ 2003-04-07 DL - Added Macro ON derective for FPC and OpenGL and removed }
-{ WEAKPACKAGE derective. WEAKPACKAGE should be set when }
-{ appropriate. }
-{ }
-{ 2003-04-23 - DL : under instruction from Alexey Barkovoy I have added }
-{ better TMT Pascal support and under instruction }
-{ from Prof. Abimbola Olowofoyeku (The African Chief) }
-{ I have added better Gnu Pascal support }
-{ }
-{ 2004-01-19 - DL : Under instruction from Marco van de Voort, I have added }
-{ Better FPC support for FreeBSD. }
-{ }
-(*
- $Log: jedi-sdl.inc,v $
- Revision 1.15 2007/05/29 21:30:48 savage
- Changes as suggested by Almindor for 64bit compatibility.
-
- Revision 1.14 2007/05/20 20:29:11 savage
- Initial Changes to Handle 64 Bits
-
- Revision 1.13 2007/01/21 15:51:45 savage
- Added Delphi 2006 support
-
- Revision 1.12 2006/11/19 18:41:01 savage
- removed THREADING ON flag as it is no longer needed in latest versions of FPC.
-
- Revision 1.11 2006/01/04 00:52:41 drellis
- Updated to include defined for ENDIAN values, SDL_BYTEORDER should now be correctly defined depending onthe platform. Code taken from sdl_mixer
-
- Revision 1.10 2005/05/22 18:42:31 savage
- Changes as suggested by Michalis Kamburelis. Thanks again.
-
- Revision 1.9 2004/12/23 23:42:17 savage
- Applied Patches supplied by Michalis Kamburelis ( THANKS! ), for greater FreePascal compatability.
-
- Revision 1.8 2004/10/20 22:43:04 savage
- Ensure that UNSAFE type warning are off in D9 as well
-
- Revision 1.7 2004/04/05 09:59:51 savage
- Changes for FreePacal as suggested by Marco
-
- Revision 1.6 2004/03/31 22:18:15 savage
- Small comment for turning off warning under GnuPascal
-
- Revision 1.5 2004/03/30 22:41:02 savage
- Added extra commenting due to previous compiler directive
-
- Revision 1.4 2004/03/30 22:08:33 savage
- Added Kylix Define
-
- Revision 1.3 2004/03/30 21:34:40 savage
- {$H+} needed for FPC compatiblity
-
- Revision 1.2 2004/02/14 00:23:39 savage
- As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change.
-
-*)
-{******************************************************************************}
-
-{.$define Debug} { uncomment for debugging }
-
-{$IFNDEF FPC}
- {$IFDEF __GPC__}
- {$I-}
- {$W-} // turn off GPC warnings
- {$X+}
- {$ELSE} {__GPC__}
- {$IFDEF Debug}
- {$F+,D+,Q-,L+,R+,I-,S+,Y+,A+}
- {$ELSE}
- {$F+,Q-,R-,S-,I-,A+}
- {$ENDIF}
- {$ENDIF} {__GPC__}
-{$ELSE} {FPC}
- //{$M+}
-{$ENDIF} {FPC}
-
-{$IFDEF LINUX}
-{$DEFINE UNIX}
-{$ENDIF}
-
-{$IFDEF ver70}
- {$IFDEF Windows}
- {$DEFINE Win16}
- {$ENDIF Windows}
- {$IFDEF MSDOS}
- {$DEFINE NO_EXPORTS}
- {$ENDIF MSDOS}
- {$IFDEF DPMI}
- {$DEFINE BP_DPMI}
- {$ENDIF}
- {$DEFINE OS_16_BIT}
- {$DEFINE __OS_DOS__}
-{$ENDIF ver70}
-
-{$IFDEF ver80}
- {$DEFINE Delphi} {Delphi 1.x}
- {$DEFINE Delphi16}
- {$DEFINE Win16}
- {$DEFINE OS_16_BIT}
- {$DEFINE __OS_DOS__}
-{$ENDIF ver80}
-
-{$IFDEF ver90}
- {$DEFINE Delphi} {Delphi 2.x}
- {$DEFINE Delphi32}
- {$DEFINE WIN32}
- {$DEFINE WINDOWS}
-{$ENDIF ver90}
-
-{$IFDEF ver100}
- {$DEFINE Delphi} {Delphi 3.x}
- {$DEFINE Delphi32}
- {$DEFINE WIN32}
- {$DEFINE WINDOWS}
-{$ENDIF ver100}
-
-{$IFDEF ver93}
- {$DEFINE Delphi} {C++ Builder 1.x}
- {$DEFINE Delphi32}
- {$DEFINE WINDOWS}
-{$ENDIF ver93}
-
-{$IFDEF ver110}
- {$DEFINE Delphi} {C++ Builder 3.x}
- {$DEFINE Delphi32}
- {$DEFINE WINDOWS}
-{$ENDIF ver110}
-
-{$IFDEF ver120}
- {$DEFINE Delphi} {Delphi 4.x}
- {$DEFINE Delphi32}
- {$DEFINE Delphi4UP}
- {$DEFINE Has_Int64}
- {$DEFINE WINDOWS}
-{$ENDIF ver120}
-
-{$IFDEF ver130}
- {$DEFINE Delphi} {Delphi 5.x}
- {$DEFINE Delphi32}
- {$DEFINE Delphi4UP}
- {$DEFINE Delphi5UP}
- {$DEFINE Has_Int64}
- {$DEFINE WINDOWS}
-{$ENDIF ver130}
-
-{$IFDEF ver140}
- {$DEFINE Delphi} {Delphi 6.x}
- {$DEFINE Delphi32}
- {$DEFINE Delphi4UP}
- {$DEFINE Delphi5UP}
- {$DEFINE Delphi6UP}
- {$DEFINE Has_Int64}
- {$DEFINE HAS_TYPES}
-{$ENDIF ver140}
-
-{$IFDEF ver150}
- {$DEFINE Delphi} {Delphi 7.x}
- {$DEFINE Delphi32}
- {$DEFINE Delphi4UP}
- {$DEFINE Delphi5UP}
- {$DEFINE Delphi6UP}
- {$DEFINE Delphi7UP}
- {$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7}
- {$DEFINE Has_Int64}
- {$DEFINE HAS_TYPES}
-{$ENDIF ver150}
-
-{$IFDEF ver160}
- {$DEFINE Delphi} {Delphi 8}
- {$DEFINE Delphi32}
- {$DEFINE Delphi4UP}
- {$DEFINE Delphi5UP}
- {$DEFINE Delphi6UP}
- {$DEFINE Delphi7UP}
- {$DEFINE Delphi8UP}
- {$DEFINE Has_Int64}
- {$DEFINE HAS_TYPES}
-{$ENDIF ver160}
-
-{$IFDEF ver170}
- {$DEFINE Delphi} {Delphi 2005}
- {$DEFINE Delphi32}
- {$DEFINE Delphi4UP}
- {$DEFINE Delphi5UP}
- {$DEFINE Delphi6UP}
- {$DEFINE Delphi7UP}
- {$DEFINE Delphi8UP}
- {$DEFINE Delphi9UP}
- {$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7}
- {$DEFINE Has_Int64}
- {$DEFINE HAS_TYPES}
-{$ENDIF ver170}
-
-{$IFDEF ver180}
- {$DEFINE Delphi} {Delphi 2006}
- {$DEFINE Delphi32}
- {$DEFINE Delphi4UP}
- {$DEFINE Delphi5UP}
- {$DEFINE Delphi6UP}
- {$DEFINE Delphi7UP}
- {$DEFINE Delphi8UP}
- {$DEFINE Delphi9UP}
- {$DEFINE Delphi10UP}
- {$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7}
- {$DEFINE Has_Int64}
- {$DEFINE HAS_TYPES}
-{$ENDIF ver180}
-
-{$IFDEF ver185}
- {$DEFINE Delphi} {Delphi 2007}
- {$DEFINE Delphi32}
- {$DEFINE Delphi4UP}
- {$DEFINE Delphi5UP}
- {$DEFINE Delphi6UP}
- {$DEFINE Delphi7UP}
- {$DEFINE Delphi8UP}
- {$DEFINE Delphi9UP}
- {$DEFINE Delphi10UP}
- {$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7}
- {$DEFINE Has_Int64}
- {$DEFINE HAS_TYPES}
-{$ENDIF ver180}
-
-{$IFDEF UNIX}
- {$ifdef VER140} // Kylix 1 & 2
- {$DEFINE KYLIX}
- {$DEFINE KYLIX1UP}
- {$DEFINE KYLIX2UP}
- {$DEFINE HAS_TYPES}
- {$endif}
-
- {$ifdef VER150} // Kylix 3
- {$DEFINE KYLIX}
- {$DEFINE KYLIX1UP}
- {$DEFINE KYLIX2UP}
- {$DEFINE KYLIX3UP}
- {$DEFINE HAS_TYPES}
- {$endif}
-{$ENDIF UNIX}
-
-{$IFDEF VirtualPascal} { Virtual Pascal 2.x }
- {$DEFINE Delphi} { Use Delphi Syntax }
- {$DEFINE VP2}
- {&Delphi+}
-{$ENDIF VirtualPascal}
-
-{$IFDEF Delphi}
- {$DEFINE Windows}
- {$DEFINE USE_STDCALL}
- //{$ALIGN ON}
-{$ENDIF Delphi}
-
-{$IFDEF FPC}
- {$MODE Delphi} { use Delphi compatibility mode }
- {$H+}
- {$PACKRECORDS C} // Added for record
- {$MACRO ON} // Added For OpenGL
- {$DEFINE Delphi}
- {$DEFINE UseAT}
- {$UNDEF USE_STDCALL}
- {$DEFINE OS_BigMem}
- {$DEFINE NO_EXPORTS}
- {$DEFINE Has_Int64}
- {$DEFINE NOCRT}
- {$IFDEF UNIX}
- {$DEFINE fpc_unix}
- {$ELSE}
- {$DEFINE __OS_DOS__}
- {$ENDIF}
- {$IFDEF WIN32}
- {$DEFINE UseWin}
- {$ENDIF}
- {$DEFINE HAS_TYPES}
-{$ENDIF FPC}
-
-{$IFDEF Win16}
- {$K+} {smart callbacks}
-{$ENDIF Win16}
-
- {$IFDEF OS2}
- {$UNDEF Windows}
- {$DEFINE UseWin}
- {$DEFINE OS_BigMem}
- {$ENDIF OS2}
-
-{$IFDEF __GPC__}
- {$UNDEF UseWin}
- {$UNDEF USE_STDCALL}
- {$DEFINE OS_BigMem}
- {$DEFINE NO_EXPORTS}
- {$DEFINE NOCRT}
- {$DEFINE cdecl attribute(cdecl)}
-{$ENDIF}
-
-{$IFDEF __TMT__}
- {$DEFINE OS_BigMem}
- {$DEFINE NO_EXPORTS}
- {$DEFINE __OS_DOS__}
- {$DEFINE UseAT}
- {$IFNDEF MSDOS}
- {$DEFINE USE_STDCALL}
- {$ENDIF}
-
- {$IFDEF __WIN32__}
- {$DEFINE Win32}
- {$DEFINE UseWin}
- {$DEFINE NOCRT}
- {$DEFINE Win32}
- {$IFNDEF __CON__}
- {$DEFINE Windows}
- {$ENDIF}
- {$ENDIF}
-
- {$A+} // Word alignment data
- {$OA+} // Objects and structures align
-{$ENDIF}
-
-{$IFDEF Win32}
- {$DEFINE OS_BigMem}
-{$ELSE Win32}
- {$IFDEF ver70}
- {$DEFINE assembler}
- {$ENDIF} { use 16-bit assembler! }
-{$ENDIF Win32}
-
-{ ************************** dos/dos-like platforms **************}
-{$IFDEF Windows}
- {$DEFINE __OS_DOS__}
- {$DEFINE UseWin}
- {$DEFINE MSWINDOWS}
-{$ENDIF Delphi}
-
-{$IFDEF OS2}
- {$DEFINE __OS_DOS__}
- {$DEFINE Can_Use_DLL}
-{$ENDIF Delphi}
-
-{$IFDEF UseWin}
- {$DEFINE Can_Use_DLL}
-{$ENDIF}
-
-{$IFDEF Win16}
- {$DEFINE Can_Use_DLL}
-{$ENDIF}
-
-{$IFDEF BP_DPMI}
- {$DEFINE Can_Use_DLL}
-{$ENDIF}
-
-{$IFDEF USE_STDCALL}
- {$IFNDEF __TMT__}
- {$DEFINE BY_NAME}
- {$ENDIF}
-{$ENDIF}
-
-{$IFNDEF ver70}
- {$UNDEF assembler}
-{$ENDIF}
-
-{*************** define LITTLE ENDIAN platforms ********************}
-
-
-{$IFDEF Delphi}
-{$DEFINE IA32}
-{$ENDIF}
-
-{$IFDEF KYLIX}
-{$DEFINE IA32}
-{$ENDIF}
-
-{$IFDEF FPC}
-{$IFDEF FPC_LITTLE_ENDIAN}
-{$DEFINE IA32}
-{$ENDIF}
-{$ENDIF}
+{ + $Id: jedi-sdl.inc,v 1.15 2007/05/29 21:30:48 savage Exp $ +} +{******************************************************************************} +{ } +{ Borland Delphi SDL - Simple DirectMedia Layer } +{ Global Conditional Definitions for JEDI-SDL cross-compilation } +{ } +{ } +{ The initial developer of this Pascal code was : } +{ Prof. Abimbola Olowofoyeku <http://www.bigfoot.com/~African_Chief/> } +{ } +{ Portions created by Prof. Abimbola Olowofoyeku are } +{ Copyright (C) 2000 - 2100 Prof. Abimbola Olowofoyeku. } +{ } +{ } +{ Contributor(s) } +{ -------------- } +{ Prof. Abimbola Olowofoyeku <http://www.bigfoot.com/~African_Chief/> } +{ Dominqiue Louis <Dominique@SavageSoftware.com.au> } +{ } +{ Obtained through: } +{ Joint Endeavour of Delphi Innovators ( Project JEDI ) } +{ } +{ You may retrieve the latest version of this file at the Project } +{ JEDI home page, located at http://delphi-jedi.org } +{ } +{ The contents of this file are used with permission, subject to } +{ the Mozilla Public License Version 1.1 (the "License"); you may } +{ not use this file except in compliance with the License. You may } +{ obtain a copy of the License at } +{ http://www.mozilla.org/MPL/MPL-1.1.html } +{ } +{ Software distributed under the License is distributed on an } +{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or } +{ implied. See the License for the specific language governing } +{ rights and limitations under the License. } +{ } +{ Description } +{ ----------- } +{ This code has been copied from... } +{ Global Conditional Definitions for Chief's UNZIP package } +{ By Prof. Abimbola Olowofoyeku (The African Chief) } +{ http://www.bigfoot.com/~African_Chief/ } +{ } +{ } +{ Requires } +{ -------- } +{ The SDL Runtime libraris on Win32 : SDL.dll on Linux : libSDL.so } +{ They are available from... } +{ http://www.libsdl.org . } +{ } +{ Programming Notes } +{ ----------------- } +{ } +{ } +{ } +{ } +{ Revision History } +{ ---------------- } +{ 2003-04-03 DL - Initial addition } +{ } +{ 2003-04-07 DL - Added Macro ON derective for FPC and OpenGL and removed } +{ WEAKPACKAGE derective. WEAKPACKAGE should be set when } +{ appropriate. } +{ } +{ 2003-04-23 - DL : under instruction from Alexey Barkovoy I have added } +{ better TMT Pascal support and under instruction } +{ from Prof. Abimbola Olowofoyeku (The African Chief) } +{ I have added better Gnu Pascal support } +{ } +{ 2004-01-19 - DL : Under instruction from Marco van de Voort, I have added } +{ Better FPC support for FreeBSD. } +{ } +(* + $Log: jedi-sdl.inc,v $ + Revision 1.15 2007/05/29 21:30:48 savage + Changes as suggested by Almindor for 64bit compatibility. + + Revision 1.14 2007/05/20 20:29:11 savage + Initial Changes to Handle 64 Bits + + Revision 1.13 2007/01/21 15:51:45 savage + Added Delphi 2006 support + + Revision 1.12 2006/11/19 18:41:01 savage + removed THREADING ON flag as it is no longer needed in latest versions of FPC. + + Revision 1.11 2006/01/04 00:52:41 drellis + Updated to include defined for ENDIAN values, SDL_BYTEORDER should now be correctly defined depending onthe platform. Code taken from sdl_mixer + + Revision 1.10 2005/05/22 18:42:31 savage + Changes as suggested by Michalis Kamburelis. Thanks again. + + Revision 1.9 2004/12/23 23:42:17 savage + Applied Patches supplied by Michalis Kamburelis ( THANKS! ), for greater FreePascal compatability. + + Revision 1.8 2004/10/20 22:43:04 savage + Ensure that UNSAFE type warning are off in D9 as well + + Revision 1.7 2004/04/05 09:59:51 savage + Changes for FreePacal as suggested by Marco + + Revision 1.6 2004/03/31 22:18:15 savage + Small comment for turning off warning under GnuPascal + + Revision 1.5 2004/03/30 22:41:02 savage + Added extra commenting due to previous compiler directive + + Revision 1.4 2004/03/30 22:08:33 savage + Added Kylix Define + + Revision 1.3 2004/03/30 21:34:40 savage + {$H+} needed for FPC compatiblity + + Revision 1.2 2004/02/14 00:23:39 savage + As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change. + +*) +{******************************************************************************} + +{.$define Debug} { uncomment for debugging } + +{$IFNDEF FPC} + {$IFDEF __GPC__} + {$I-} + {$W-} // turn off GPC warnings + {$X+} + {$ELSE} {__GPC__} + {$IFDEF Debug} + {$F+,D+,Q-,L+,R+,I-,S+,Y+,A+} + {$ELSE} + {$F+,Q-,R-,S-,I-,A+} + {$ENDIF} + {$ENDIF} {__GPC__} +{$ELSE} {FPC} + //{$M+} +{$ENDIF} {FPC} + +{$IFDEF LINUX} +{$DEFINE UNIX} +{$ENDIF} + +{$IFDEF ver70} + {$IFDEF Windows} + {$DEFINE Win16} + {$ENDIF Windows} + {$IFDEF MSDOS} + {$DEFINE NO_EXPORTS} + {$ENDIF MSDOS} + {$IFDEF DPMI} + {$DEFINE BP_DPMI} + {$ENDIF} + {$DEFINE OS_16_BIT} + {$DEFINE __OS_DOS__} +{$ENDIF ver70} + +{$IFDEF ver80} + {$DEFINE Delphi} {Delphi 1.x} + {$DEFINE Delphi16} + {$DEFINE Win16} + {$DEFINE OS_16_BIT} + {$DEFINE __OS_DOS__} +{$ENDIF ver80} + +{$IFDEF ver90} + {$DEFINE Delphi} {Delphi 2.x} + {$DEFINE Delphi32} + {$DEFINE WIN32} + {$DEFINE WINDOWS} +{$ENDIF ver90} + +{$IFDEF ver100} + {$DEFINE Delphi} {Delphi 3.x} + {$DEFINE Delphi32} + {$DEFINE WIN32} + {$DEFINE WINDOWS} +{$ENDIF ver100} + +{$IFDEF ver93} + {$DEFINE Delphi} {C++ Builder 1.x} + {$DEFINE Delphi32} + {$DEFINE WINDOWS} +{$ENDIF ver93} + +{$IFDEF ver110} + {$DEFINE Delphi} {C++ Builder 3.x} + {$DEFINE Delphi32} + {$DEFINE WINDOWS} +{$ENDIF ver110} + +{$IFDEF ver120} + {$DEFINE Delphi} {Delphi 4.x} + {$DEFINE Delphi32} + {$DEFINE Delphi4UP} + {$DEFINE Has_Int64} + {$DEFINE WINDOWS} +{$ENDIF ver120} + +{$IFDEF ver130} + {$DEFINE Delphi} {Delphi 5.x} + {$DEFINE Delphi32} + {$DEFINE Delphi4UP} + {$DEFINE Delphi5UP} + {$DEFINE Has_Int64} + {$DEFINE WINDOWS} +{$ENDIF ver130} + +{$IFDEF ver140} + {$DEFINE Delphi} {Delphi 6.x} + {$DEFINE Delphi32} + {$DEFINE Delphi4UP} + {$DEFINE Delphi5UP} + {$DEFINE Delphi6UP} + {$DEFINE Has_Int64} + {$DEFINE HAS_TYPES} +{$ENDIF ver140} + +{$IFDEF ver150} + {$DEFINE Delphi} {Delphi 7.x} + {$DEFINE Delphi32} + {$DEFINE Delphi4UP} + {$DEFINE Delphi5UP} + {$DEFINE Delphi6UP} + {$DEFINE Delphi7UP} + {$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7} + {$DEFINE Has_Int64} + {$DEFINE HAS_TYPES} +{$ENDIF ver150} + +{$IFDEF ver160} + {$DEFINE Delphi} {Delphi 8} + {$DEFINE Delphi32} + {$DEFINE Delphi4UP} + {$DEFINE Delphi5UP} + {$DEFINE Delphi6UP} + {$DEFINE Delphi7UP} + {$DEFINE Delphi8UP} + {$DEFINE Has_Int64} + {$DEFINE HAS_TYPES} +{$ENDIF ver160} + +{$IFDEF ver170} + {$DEFINE Delphi} {Delphi 2005} + {$DEFINE Delphi32} + {$DEFINE Delphi4UP} + {$DEFINE Delphi5UP} + {$DEFINE Delphi6UP} + {$DEFINE Delphi7UP} + {$DEFINE Delphi8UP} + {$DEFINE Delphi9UP} + {$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7} + {$DEFINE Has_Int64} + {$DEFINE HAS_TYPES} +{$ENDIF ver170} + +{$IFDEF ver180} + {$DEFINE Delphi} {Delphi 2006} + {$DEFINE Delphi32} + {$DEFINE Delphi4UP} + {$DEFINE Delphi5UP} + {$DEFINE Delphi6UP} + {$DEFINE Delphi7UP} + {$DEFINE Delphi8UP} + {$DEFINE Delphi9UP} + {$DEFINE Delphi10UP} + {$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7} + {$DEFINE Has_Int64} + {$DEFINE HAS_TYPES} +{$ENDIF ver180} + +{$IFDEF ver185} + {$DEFINE Delphi} {Delphi 2007} + {$DEFINE Delphi32} + {$DEFINE Delphi4UP} + {$DEFINE Delphi5UP} + {$DEFINE Delphi6UP} + {$DEFINE Delphi7UP} + {$DEFINE Delphi8UP} + {$DEFINE Delphi9UP} + {$DEFINE Delphi10UP} + {$WARN UNSAFE_TYPE OFF} {Disable warning for unsafe types in Delphi 7} + {$DEFINE Has_Int64} + {$DEFINE HAS_TYPES} +{$ENDIF ver180} + +{$IFDEF UNIX} + {$ifdef VER140} // Kylix 1 & 2 + {$DEFINE KYLIX} + {$DEFINE KYLIX1UP} + {$DEFINE KYLIX2UP} + {$DEFINE HAS_TYPES} + {$endif} + + {$ifdef VER150} // Kylix 3 + {$DEFINE KYLIX} + {$DEFINE KYLIX1UP} + {$DEFINE KYLIX2UP} + {$DEFINE KYLIX3UP} + {$DEFINE HAS_TYPES} + {$endif} +{$ENDIF UNIX} + +{$IFDEF VirtualPascal} { Virtual Pascal 2.x } + {$DEFINE Delphi} { Use Delphi Syntax } + {$DEFINE VP2} + {&Delphi+} +{$ENDIF VirtualPascal} + +{$IFDEF Delphi} + {$DEFINE Windows} + {$DEFINE USE_STDCALL} + //{$ALIGN ON} +{$ENDIF Delphi} + +{$IFDEF FPC} + {$MODE Delphi} { use Delphi compatibility mode } + {$H+} + {$PACKRECORDS C} // Added for record + {$MACRO ON} // Added For OpenGL + {$DEFINE Delphi} + {$DEFINE UseAT} + {$UNDEF USE_STDCALL} + {$DEFINE OS_BigMem} + {$DEFINE NO_EXPORTS} + {$DEFINE Has_Int64} + {$DEFINE NOCRT} + {$IFDEF UNIX} + {$DEFINE fpc_unix} + {$ELSE} + {$DEFINE __OS_DOS__} + {$ENDIF} + {$IFDEF WIN32} + {$DEFINE UseWin} + {$ENDIF} + {$DEFINE HAS_TYPES} +{$ENDIF FPC} + +{$IFDEF Win16} + {$K+} {smart callbacks} +{$ENDIF Win16} + + {$IFDEF OS2} + {$UNDEF Windows} + {$DEFINE UseWin} + {$DEFINE OS_BigMem} + {$ENDIF OS2} + +{$IFDEF __GPC__} + {$UNDEF UseWin} + {$UNDEF USE_STDCALL} + {$DEFINE OS_BigMem} + {$DEFINE NO_EXPORTS} + {$DEFINE NOCRT} + {$DEFINE cdecl attribute(cdecl)} +{$ENDIF} + +{$IFDEF __TMT__} + {$DEFINE OS_BigMem} + {$DEFINE NO_EXPORTS} + {$DEFINE __OS_DOS__} + {$DEFINE UseAT} + {$IFNDEF MSDOS} + {$DEFINE USE_STDCALL} + {$ENDIF} + + {$IFDEF __WIN32__} + {$DEFINE Win32} + {$DEFINE UseWin} + {$DEFINE NOCRT} + {$DEFINE Win32} + {$IFNDEF __CON__} + {$DEFINE Windows} + {$ENDIF} + {$ENDIF} + + {$A+} // Word alignment data + {$OA+} // Objects and structures align +{$ENDIF} + +{$IFDEF Win32} + {$DEFINE OS_BigMem} +{$ELSE Win32} + {$IFDEF ver70} + {$DEFINE assembler} + {$ENDIF} { use 16-bit assembler! } +{$ENDIF Win32} + +{ ************************** dos/dos-like platforms **************} +{$IFDEF Windows} + {$DEFINE __OS_DOS__} + {$DEFINE UseWin} + {$DEFINE MSWINDOWS} +{$ENDIF Delphi} + +{$IFDEF OS2} + {$DEFINE __OS_DOS__} + {$DEFINE Can_Use_DLL} +{$ENDIF Delphi} + +{$IFDEF UseWin} + {$DEFINE Can_Use_DLL} +{$ENDIF} + +{$IFDEF Win16} + {$DEFINE Can_Use_DLL} +{$ENDIF} + +{$IFDEF BP_DPMI} + {$DEFINE Can_Use_DLL} +{$ENDIF} + +{$IFDEF USE_STDCALL} + {$IFNDEF __TMT__} + {$DEFINE BY_NAME} + {$ENDIF} +{$ENDIF} + +{$IFNDEF ver70} + {$UNDEF assembler} +{$ENDIF} + +{*************** define LITTLE ENDIAN platforms ********************} + + +{$IFDEF Delphi} +{$DEFINE IA32} +{$ENDIF} + +{$IFDEF KYLIX} +{$DEFINE IA32} +{$ENDIF} + +{$IFDEF FPC} +{$IFDEF FPC_LITTLE_ENDIAN} +{$DEFINE IA32} +{$ENDIF} +{$ENDIF} diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/libxmlparser.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/libxmlparser.pas index 0cdf44c7..63e7b7fb 100644 --- a/Game/Code/lib/JEDI-SDL/SDL/Pas/libxmlparser.pas +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/libxmlparser.pas @@ -1,2688 +1,2688 @@ -(**
-===============================================================================================
-Name : LibXmlParser
-===============================================================================================
-Project : All Projects
-===============================================================================================
-Subject : Progressive XML Parser for all types of XML Files
-===============================================================================================
-Author : Stefan Heymann
- Eschenweg 3
- 72076 Tübingen
- GERMANY
-
-E-Mail: stefan@destructor.de
-URL: www.destructor.de
-===============================================================================================
-Source, Legals ("Licence")
---------------------------
-The official site to get this parser is http://www.destructor.de/
-
-Usage and Distribution of this Source Code is ruled by the
-"Destructor.de Source code Licence" (DSL) which comes with this file or
-can be downloaded at http://www.destructor.de/
-
-IN SHORT: Usage and distribution of this source code is free.
- You use it completely on your own risk.
-
-Postcardware
-------------
-If you like this code, please send a postcard of your city to my above address.
-===============================================================================================
-!!! All parts of this code which are not finished or not conforming exactly to
- the XmlSpec are marked with three exclamation marks
-
--!- Parts where the parser may be able to detect errors in the document's syntax are
- marked with the dash-exlamation mark-dash sequence.
-===============================================================================================
-Terminology:
-------------
-- Start: Start of a buffer part
-- Final: End (last character) of a buffer part
-- DTD: Document Type Definition
-- DTDc: Document Type Declaration
-- XMLSpec: The current W3C XML Recommendation (version 1.0 as of 1998-02-10), Chapter No.
-- Cur*: Fields concerning the "Current" part passed back by the "Scan" method
-===============================================================================================
-Scanning the XML document
--------------------------
-- Create TXmlParser Instance MyXml := TXmlParser.Create;
-- Load XML Document MyXml.LoadFromFile (Filename);
-- Start Scanning MyXml.StartScan;
-- Scan Loop WHILE MyXml.Scan DO
-- Test for Part Type CASE MyXml.CurPartType OF
-- Handle Parts ... : ;;;
-- Handle Parts ... : ;;;
-- Handle Parts ... : ;;;
- END;
-- Destroy MyXml.Free;
-===============================================================================================
-Loading the XML document
-------------------------
-You can load the XML document from a file with the "LoadFromFile" method.
-It is beyond the scope of this parser to perform HTTP or FTP accesses. If you want your
-application to handle such requests (URLs), you can load the XML via HTTP or FTP or whatever
-protocol and hand over the data buffer using the "LoadFromBuffer" or "SetBuffer" method.
-"LoadFromBuffer" loads the internal buffer of TXmlParser with the given null-terminated
-string, thereby creating a copy of that buffer.
-"SetBuffer" just takes the pointer to another buffer, which means that the given
-buffer pointer must be valid while the document is accessed via TXmlParser.
-===============================================================================================
-Encodings:
-----------
-This XML parser kind of "understands" the following encodings:
-- UTF-8
-- ISO-8859-1
-- Windows-1252
-
-Any flavor of multi-byte characters (and this includes UTF-16) is not supported. Sorry.
-
-Every string which has to be passed to the application passes the virtual method
-"TranslateEncoding" which translates the string from the current encoding (stored in
-"CurEncoding") into the encoding the application wishes to receive.
-The "TranslateEncoding" method that is built into TXmlParser assumes that the application
-wants to receive Windows ANSI (Windows-1252, about the same as ISO-8859-1) and is able
-to convert UTF-8 and ISO-8859-1 encodings.
-For other source and target encodings, you will have to override "TranslateEncoding".
-===============================================================================================
-Buffer Handling
----------------
-- The document must be loaded completely into a piece of RAM
-- All character positions are referenced by PChar pointers
-- The TXmlParser instance can either "own" the buffer itself (then, FBufferSize is > 0)
- or reference the buffer of another instance or object (then, FBuffersize is 0 and
- FBuffer is not NIL)
-- The Property DocBuffer passes back a pointer to the first byte of the document. If there
- is no document stored (FBuffer is NIL), the DocBuffer returns a pointer to a NULL character.
-===============================================================================================
-Whitespace Handling
--------------------
-The TXmlParser property "PackSpaces" determines how Whitespace is returned in Text Content:
-While PackSpaces is true, all leading and trailing whitespace characters are trimmed of, all
-Whitespace is converted to Space #x20 characters and contiguous Whitespace characters are
-compressed to one.
-If the "Scan" method reports a ptContent part, the application can get the original text
-with all whitespace characters by extracting the characters from "CurStart" to "CurFinal".
-If the application detects an xml:space attribute, it can set "PackSpaces" accordingly or
-use CurStart/CurFinal.
-Please note that TXmlParser does _not_ normalize Line Breaks to single LineFeed characters
-as the XmlSpec requires (XmlSpec 2.11).
-The xml:space attribute is not handled by TXmlParser. This is on behalf of the application.
-===============================================================================================
-Non-XML-Conforming
-------------------
-TXmlParser does not conform 100 % exactly to the XmlSpec:
-- UTF-16 is not supported (XmlSpec 2.2)
- (Workaround: Convert UTF-16 to UTF-8 and hand the buffer over to TXmlParser)
-- As the parser only works with single byte strings, all Unicode characters > 255
- can currently not be handled correctly.
-- Line breaks are not normalized to single Linefeed #x0A characters (XmlSpec 2.11)
- (Workaround: The Application can access the text contents on its own [CurStart, CurFinal],
- thereby applying every normalization it wishes to)
-- The attribute value normalization does not work exactly as defined in the
- Second Edition of the XML 1.0 specification.
-- See also the code parts marked with three consecutive exclamation marks. These are
- parts which are not finished in the current code release.
-
-This list may be incomplete, so it may grow if I get to know any other points.
-As work on the parser proceeds, this list may also shrink.
-===============================================================================================
-Things Todo
------------
-- Introduce a new event/callback which is called when there is an unresolvable
- entity or character reference
-- Support Unicode
-- Use Streams instead of reading the whole XML into memory
-===============================================================================================
-Change History, Version numbers
--------------------------------
-The Date is given in ISO Year-Month-Day (YYYY-MM-DD) order.
-Versions are counted from 1.0.0 beginning with the version from 2000-03-16.
-Unreleased versions don't get a version number.
-
-Date Author Version Changes
------------------------------------------------------------------------------------------------
-2000-03-16 HeySt 1.0.0 Start
-2000-03-28 HeySt 1.0.1 Initial Publishing of TXmlParser on the destructor.de Web Site
-2000-03-30 HeySt 1.0.2 TXmlParser.AnalyzeCData: Call "TranslateEncoding" for CurContent
-2000-03-31 HeySt 1.0.3 Deleted the StrPosE function (was not needed anyway)
-2000-04-04 HeySt 1.0.4 TDtdElementRec modified: Start/Final for all Elements;
- Should be backwards compatible.
- AnalyzeDtdc: Set CurPartType to ptDtdc
-2000-04-23 HeySt 1.0.5 New class TObjectList. Eliminated reference to the Delphi 5
- "Contnrs" unit so LibXmlParser is Delphi 4 compatible.
-2000-07-03 HeySt 1.0.6 TNvpNode: Added Constructor
-2000-07-11 HeySt 1.0.7 Removed "Windows" from USES clause
- Added three-exclamation-mark comments for Utf8ToAnsi/AnsiToUtf8
- Added three-exclamation-mark comments for CHR function calls
-2000-07-23 HeySt 1.0.8 TXmlParser.Clear: CurAttr.Clear; EntityStack.Clear;
- (This was not a bug; just defensive programming)
-2000-07-29 HeySt 1.0.9 TNvpList: Added methods: Node(Index), Value(Index), Name(Index);
-2000-10-07 HeySt Introduced Conditional Defines
- Uses Contnrs unit and its TObjectList class again for
- Delphi 5 and newer versions
-2001-01-30 HeySt Introduced Version Numbering
- Made LoadFromFile and LoadFromBuffer BOOLEAN functions
- Introduced FileMode parameter for LoadFromFile
- BugFix: TAttrList.Analyze: Must add CWhitespace to ExtractName call
- Comments worked over
-2001-02-28 HeySt 1.0.10 Completely worked over and tested the UTF-8 functions
- Fixed a bug in TXmlParser.Scan which caused it to start over when it
- was called after the end of scanning, resulting in an endless loop
- TEntityStack is now a TObjectList instead of TList
-2001-07-03 HeySt 1.0.11 Updated Compiler Version IFDEFs for Kylix
-2001-07-11 HeySt 1.0.12 New TCustomXmlScanner component (taken over from LibXmlComps.pas)
-2001-07-14 HeySt 1.0.13 Bugfix TCustomXmlScanner.FOnTranslateEncoding
-2001-10-22 HeySt Don't clear CurName anymore when the parser finds a CDATA section.
-2001-12-03 HeySt 1.0.14 TObjectList.Clear: Make call to INHERITED method (fixes a memory leak)
-2001-12-05 HeySt 1.0.15 TObjectList.Clear: removed call to INHERITED method
- TObjectList.Destroy: Inserted SetCapacity call.
- Reduces need for frequent re-allocation of pointer buffer
- Dedicated to my father, Theodor Heymann
-2002-06-26 HeySt 1.0.16 TXmlParser.Scan: Fixed a bug with PIs whose name is beginning
- with 'xml'. Thanks to Uwe Kamm for submitting this bug.
- The CurEncoding property is now always in uppercase letters (the XML
- spec wants it to be treated case independently so when it's uppercase
- comparisons are faster)
-2002-03-04 HeySt 1.0.17 Included an IFDEF for Delphi 7 (VER150) and Kylix
- There is a new symbol HAS_CONTNRS_UNIT which is used now to
- distinguish between IDEs which come with the Contnrs unit and
- those that don't.
-*)
-
-UNIT libxmlparser;
-
-{$I jedi-sdl.inc}
-
-INTERFACE
-
-USES
- SysUtils, Classes,
- (*$IFDEF HAS_CONTNRS_UNIT *) // The Contnrs Unit was introduced in Delphi 5
- Contnrs,
- (*$ENDIF*)
- Math;
-
-CONST
- CVersion = '1.0.17'; // This variable will be updated for every release
- // (I hope, I won't forget to do it everytime ...)
-
-TYPE
- TPartType = // --- Document Part Types
- (ptNone, // Nothing
- ptXmlProlog, // XML Prolog XmlSpec 2.8 / 4.3.1
- ptComment, // Comment XmlSpec 2.5
- ptPI, // Processing Instruction XmlSpec 2.6
- ptDtdc, // Document Type Declaration XmlSpec 2.8
- ptStartTag, // Start Tag XmlSpec 3.1
- ptEmptyTag, // Empty-Element Tag XmlSpec 3.1
- ptEndTag, // End Tag XmlSpec 3.1
- ptContent, // Text Content between Tags
- ptCData); // CDATA Section XmlSpec 2.7
-
- TDtdElemType = // --- DTD Elements
- (deElement, // !ELEMENT declaration
- deAttList, // !ATTLIST declaration
- deEntity, // !ENTITY declaration
- deNotation, // !NOTATION declaration
- dePI, // PI in DTD
- deComment, // Comment in DTD
- deError); // Error found in the DTD
-
-TYPE
- TAttrList = CLASS;
- TEntityStack = CLASS;
- TNvpList = CLASS;
- TElemDef = CLASS;
- TElemList = CLASS;
- TEntityDef = CLASS;
- TNotationDef = CLASS;
-
- TDtdElementRec = RECORD // --- This Record is returned by the DTD parser callback function
- Start, Final : PChar; // Start/End of the Element's Declaration
- CASE ElementType : TDtdElemType OF // Type of the Element
- deElement, // <!ELEMENT>
- deAttList : (ElemDef : TElemDef); // <!ATTLIST>
- deEntity : (EntityDef : TEntityDef); // <!ENTITY>
- deNotation : (NotationDef : TNotationDef); // <!NOTATION>
- dePI : (Target : PChar; // <?PI ?>
- Content : PChar;
- AttrList : TAttrList);
- deError : (Pos : PChar); // Error
- // deComment : ((No additional fields here)); // <!-- Comment -->
- END;
-
- TXmlParser = CLASS // --- Internal Properties and Methods
- PROTECTED
- FBuffer : PChar; // NIL if there is no buffer available
- FBufferSize : INTEGER; // 0 if the buffer is not owned by the Document instance
- FSource : STRING; // Name of Source of document. Filename for Documents loaded with LoadFromFile
-
- FXmlVersion : STRING; // XML version from Document header. Default is '1.0'
- FEncoding : STRING; // Encoding from Document header. Default is 'UTF-8'
- FStandalone : BOOLEAN; // Standalone declaration from Document header. Default is 'yes'
- FRootName : STRING; // Name of the Root Element (= DTD name)
- FDtdcFinal : PChar; // Pointer to the '>' character terminating the DTD declaration
-
- FNormalize : BOOLEAN; // If true: Pack Whitespace and don't return empty contents
- EntityStack : TEntityStack; // Entity Stack for Parameter and General Entities
- FCurEncoding : STRING; // Current Encoding during parsing (always uppercase)
-
- PROCEDURE AnalyzeProlog; // Analyze XML Prolog or Text Declaration
- PROCEDURE AnalyzeComment (Start : PChar; VAR Final : PChar); // Analyze Comments
- PROCEDURE AnalyzePI (Start : PChar; VAR Final : PChar); // Analyze Processing Instructions (PI)
- PROCEDURE AnalyzeDtdc; // Analyze Document Type Declaration
- PROCEDURE AnalyzeDtdElements (Start : PChar; VAR Final : PChar); // Analyze DTD declarations
- PROCEDURE AnalyzeTag; // Analyze Start/End/Empty-Element Tags
- PROCEDURE AnalyzeCData; // Analyze CDATA Sections
- PROCEDURE AnalyzeText (VAR IsDone : BOOLEAN); // Analyze Text Content between Tags
- PROCEDURE AnalyzeElementDecl (Start : PChar; VAR Final : PChar);
- PROCEDURE AnalyzeAttListDecl (Start : PChar; VAR Final : PChar);
- PROCEDURE AnalyzeEntityDecl (Start : PChar; VAR Final : PChar);
- PROCEDURE AnalyzeNotationDecl (Start : PChar; VAR Final : PChar);
-
- PROCEDURE PushPE (VAR Start : PChar);
- PROCEDURE ReplaceCharacterEntities (VAR Str : STRING);
- PROCEDURE ReplaceParameterEntities (VAR Str : STRING);
- PROCEDURE ReplaceGeneralEntities (VAR Str : STRING);
-
- FUNCTION GetDocBuffer : PChar; // Returns FBuffer or a pointer to a NUL char if Buffer is empty
-
- PUBLIC // --- Document Properties
- PROPERTY XmlVersion : STRING READ FXmlVersion; // XML version from the Document Prolog
- PROPERTY Encoding : STRING READ FEncoding; // Document Encoding from Prolog
- PROPERTY Standalone : BOOLEAN READ FStandalone; // Standalone Declaration from Prolog
- PROPERTY RootName : STRING READ FRootName; // Name of the Root Element
- PROPERTY Normalize : BOOLEAN READ FNormalize WRITE FNormalize; // True if Content is to be normalized
- PROPERTY Source : STRING READ FSource; // Name of Document Source (Filename)
- PROPERTY DocBuffer : PChar READ GetDocBuffer; // Returns document buffer
- PUBLIC // --- DTD Objects
- Elements : TElemList; // Elements: List of TElemDef (contains Attribute Definitions)
- Entities : TNvpList; // General Entities: List of TEntityDef
- ParEntities : TNvpList; // Parameter Entities: List of TEntityDef
- Notations : TNvpList; // Notations: List of TNotationDef
- PUBLIC
- CONSTRUCTOR Create;
- DESTRUCTOR Destroy; OVERRIDE;
-
- // --- Document Handling
- FUNCTION LoadFromFile (Filename : STRING;
- FileMode : INTEGER = fmOpenRead OR fmShareDenyNone) : BOOLEAN;
- // Loads Document from given file
- FUNCTION LoadFromBuffer (Buffer : PChar) : BOOLEAN; // Loads Document from another buffer
- PROCEDURE SetBuffer (Buffer : PChar); // References another buffer
- PROCEDURE Clear; // Clear Document
-
- PUBLIC
- // --- Scanning through the document
- CurPartType : TPartType; // Current Type
- CurName : STRING; // Current Name
- CurContent : STRING; // Current Normalized Content
- CurStart : PChar; // Current First character
- CurFinal : PChar; // Current Last character
- CurAttr : TAttrList; // Current Attribute List
- PROPERTY CurEncoding : STRING READ FCurEncoding; // Current Encoding
- PROCEDURE StartScan;
- FUNCTION Scan : BOOLEAN;
-
- // --- Events / Callbacks
- FUNCTION LoadExternalEntity (SystemId, PublicId,
- Notation : STRING) : TXmlParser; VIRTUAL;
- FUNCTION TranslateEncoding (CONST Source : STRING) : STRING; VIRTUAL;
- PROCEDURE DtdElementFound (DtdElementRec : TDtdElementRec); VIRTUAL;
- END;
-
- TValueType = // --- Attribute Value Type
- (vtNormal, // Normal specified Attribute
- vtImplied, // #IMPLIED attribute value
- vtFixed, // #FIXED attribute value
- vtDefault); // Attribute value from default value in !ATTLIST declaration
-
- TAttrDefault = // --- Attribute Default Type
- (adDefault, // Normal default value
- adRequired, // #REQUIRED attribute
- adImplied, // #IMPLIED attribute
- adFixed); // #FIXED attribute
-
- TAttrType = // --- Type of attribute
- (atUnknown, // Unknown type
- atCData, // Character data only
- atID, // ID
- atIdRef, // ID Reference
- atIdRefs, // Several ID References, separated by Whitespace
- atEntity, // Name of an unparsed Entity
- atEntities, // Several unparsed Entity names, separated by Whitespace
- atNmToken, // Name Token
- atNmTokens, // Several Name Tokens, separated by Whitespace
- atNotation, // A selection of Notation names (Unparsed Entity)
- atEnumeration); // Enumeration
-
- TElemType = // --- Element content type
- (etEmpty, // Element is always empty
- etAny, // Element can have any mixture of PCDATA and any elements
- etChildren, // Element must contain only elements
- etMixed); // Mixed PCDATA and elements
-
- (*$IFDEF HAS_CONTNRS_UNIT *)
- TObjectList = Contnrs.TObjectList; // Re-Export this identifier
- (*$ELSE *)
- TObjectList = CLASS (TList)
- DESTRUCTOR Destroy; OVERRIDE;
- PROCEDURE Delete (Index : INTEGER);
- PROCEDURE Clear; OVERRIDE;
- END;
- (*$ENDIF *)
-
- TNvpNode = CLASS // Name-Value Pair Node
- Name : STRING;
- Value : STRING;
- CONSTRUCTOR Create (TheName : STRING = ''; TheValue : STRING = '');
- END;
-
- TNvpList = CLASS (TObjectList) // Name-Value Pair List
- PROCEDURE Add (Node : TNvpNode);
- FUNCTION Node (Name : STRING) : TNvpNode; OVERLOAD;
- FUNCTION Node (Index : INTEGER) : TNvpNode; OVERLOAD;
- FUNCTION Value (Name : STRING) : STRING; OVERLOAD;
- FUNCTION Value (Index : INTEGER) : STRING; OVERLOAD;
- FUNCTION Name (Index : INTEGER) : STRING;
- END;
-
- TAttr = CLASS (TNvpNode) // Attribute of a Start-Tag or Empty-Element-Tag
- ValueType : TValueType;
- AttrType : TAttrType;
- END;
-
- TAttrList = CLASS (TNvpList) // List of Attributes
- PROCEDURE Analyze (Start : PChar; VAR Final : PChar);
- END;
-
- TEntityStack = CLASS (TObjectList) // Stack where current position is stored before parsing entities
- PROTECTED
- Owner : TXmlParser;
- PUBLIC
- CONSTRUCTOR Create (TheOwner : TXmlParser);
- PROCEDURE Push (LastPos : PChar); OVERLOAD;
- PROCEDURE Push (Instance : TObject; LastPos : PChar); OVERLOAD;
- FUNCTION Pop : PChar; // Returns next char or NIL if EOF is reached. Frees Instance.
- END;
-
- TAttrDef = CLASS (TNvpNode) // Represents a <!ATTLIST Definition. "Value" is the default value
- TypeDef : STRING; // Type definition from the DTD
- Notations : STRING; // Notation List, separated by pipe symbols '|'
- AttrType : TAttrType; // Attribute Type
- DefaultType : TAttrDefault; // Default Type
- END;
-
- TElemDef = CLASS (TNvpList) // Represents a <!ELEMENT Definition. Is a list of TAttrDef-Nodes
- Name : STRING; // Element name
- ElemType : TElemType; // Element type
- Definition : STRING; // Element definition from DTD
- END;
-
- TElemList = CLASS (TObjectList) // List of TElemDef nodes
- FUNCTION Node (Name : STRING) : TElemDef;
- PROCEDURE Add (Node : TElemDef);
- END;
-
- TEntityDef = CLASS (TNvpNode) // Represents a <!ENTITY Definition.
- SystemId : STRING;
- PublicId : STRING;
- NotationName : STRING;
- END;
-
- TNotationDef = CLASS (TNvpNode) // Represents a <!NOTATION Definition. Value is the System ID
- PublicId : STRING;
- END;
-
- TCharset = SET OF CHAR;
-
-
-CONST
- CWhitespace = [#32, #9, #13, #10]; // Whitespace characters (XmlSpec 2.3)
- CLetter = [#$41..#$5A, #$61..#$7A, #$C0..#$D6, #$D8..#$F6, #$F8..#$FF];
- CDigit = [#$30..#$39];
- CNameChar = CLetter + CDigit + ['.', '-', '_', ':', #$B7];
- CNameStart = CLetter + ['_', ':'];
- CQuoteChar = ['"', ''''];
- CPubidChar = [#32, ^M, ^J, #9, 'a'..'z', 'A'..'Z', '0'..'9',
- '-', '''', '(', ')', '+', ',', '.', '/', ':',
- '=', '?', ';', '!', '*', '#', '@', '$', '_', '%'];
-
- CDStart = '<![CDATA[';
- CDEnd = ']]>';
-
- // --- Name Constants for the above enumeration types
- CPartType_Name : ARRAY [TPartType] OF STRING =
- ('', 'XML Prolog', 'Comment', 'PI',
- 'DTD Declaration', 'Start Tag', 'Empty Tag', 'End Tag',
- 'Text', 'CDATA');
- CValueType_Name : ARRAY [TValueType] OF STRING = ('Normal', 'Implied', 'Fixed', 'Default');
- CAttrDefault_Name : ARRAY [TAttrDefault] OF STRING = ('Default', 'Required', 'Implied', 'Fixed');
- CElemType_Name : ARRAY [TElemType] OF STRING = ('Empty', 'Any', 'Childs only', 'Mixed');
- CAttrType_Name : ARRAY [TAttrType] OF STRING = ('Unknown', 'CDATA',
- 'ID', 'IDREF', 'IDREFS',
- 'ENTITY', 'ENTITIES',
- 'NMTOKEN', 'NMTOKENS',
- 'Notation', 'Enumeration');
-
-FUNCTION ConvertWs (Source: STRING; PackWs: BOOLEAN) : STRING; // Convert WS to spaces #x20
-PROCEDURE SetStringSF (VAR S : STRING; BufferStart, BufferFinal : PChar); // SetString by Start/Final of buffer
-FUNCTION StrSFPas (Start, Finish : PChar) : STRING; // Convert buffer part to Pascal string
-FUNCTION TrimWs (Source : STRING) : STRING; // Trim Whitespace
-
-FUNCTION AnsiToUtf8 (Source : ANSISTRING) : STRING; // Convert Win-1252 to UTF-8
-FUNCTION Utf8ToAnsi (Source : STRING; UnknownChar : CHAR = '¿') : ANSISTRING; // Convert UTF-8 to Win-1252
-
-
-(*
-===============================================================================================
-TCustomXmlScanner event based component wrapper for TXmlParser
-===============================================================================================
-*)
-
-TYPE
- TCustomXmlScanner = CLASS;
- TXmlPrologEvent = PROCEDURE (Sender : TObject; XmlVersion, Encoding: STRING; Standalone : BOOLEAN) OF OBJECT;
- TCommentEvent = PROCEDURE (Sender : TObject; Comment : STRING) OF OBJECT;
- TPIEvent = PROCEDURE (Sender : TObject; Target, Content: STRING; Attributes : TAttrList) OF OBJECT;
- TDtdEvent = PROCEDURE (Sender : TObject; RootElementName : STRING) OF OBJECT;
- TStartTagEvent = PROCEDURE (Sender : TObject; TagName : STRING; Attributes : TAttrList) OF OBJECT;
- TEndTagEvent = PROCEDURE (Sender : TObject; TagName : STRING) OF OBJECT;
- TContentEvent = PROCEDURE (Sender : TObject; Content : STRING) OF OBJECT;
- TElementEvent = PROCEDURE (Sender : TObject; ElemDef : TElemDef) OF OBJECT;
- TEntityEvent = PROCEDURE (Sender : TObject; EntityDef : TEntityDef) OF OBJECT;
- TNotationEvent = PROCEDURE (Sender : TObject; NotationDef : TNotationDef) OF OBJECT;
- TErrorEvent = PROCEDURE (Sender : TObject; ErrorPos : PChar) OF OBJECT;
- TExternalEvent = PROCEDURE (Sender : TObject; SystemId, PublicId, NotationId : STRING;
- VAR Result : TXmlParser) OF OBJECT;
- TEncodingEvent = FUNCTION (Sender : TObject; CurrentEncoding, Source : STRING) : STRING OF OBJECT;
-
-
- TCustomXmlScanner = CLASS (TComponent)
- PROTECTED
- FXmlParser : TXmlParser;
- FOnXmlProlog : TXmlPrologEvent;
- FOnComment : TCommentEvent;
- FOnPI : TPIEvent;
- FOnDtdRead : TDtdEvent;
- FOnStartTag : TStartTagEvent;
- FOnEmptyTag : TStartTagEvent;
- FOnEndTag : TEndTagEvent;
- FOnContent : TContentEvent;
- FOnCData : TContentEvent;
- FOnElement : TElementEvent;
- FOnAttList : TElementEvent;
- FOnEntity : TEntityEvent;
- FOnNotation : TNotationEvent;
- FOnDtdError : TErrorEvent;
- FOnLoadExternal : TExternalEvent;
- FOnTranslateEncoding : TEncodingEvent;
- FStopParser : BOOLEAN;
- FUNCTION GetNormalize : BOOLEAN;
- PROCEDURE SetNormalize (Value : BOOLEAN);
-
- PROCEDURE WhenXmlProlog(XmlVersion, Encoding: STRING; Standalone : BOOLEAN); VIRTUAL;
- PROCEDURE WhenComment (Comment : STRING); VIRTUAL;
- PROCEDURE WhenPI (Target, Content: STRING; Attributes : TAttrList); VIRTUAL;
- PROCEDURE WhenDtdRead (RootElementName : STRING); VIRTUAL;
- PROCEDURE WhenStartTag (TagName : STRING; Attributes : TAttrList); VIRTUAL;
- PROCEDURE WhenEmptyTag (TagName : STRING; Attributes : TAttrList); VIRTUAL;
- PROCEDURE WhenEndTag (TagName : STRING); VIRTUAL;
- PROCEDURE WhenContent (Content : STRING); VIRTUAL;
- PROCEDURE WhenCData (Content : STRING); VIRTUAL;
- PROCEDURE WhenElement (ElemDef : TElemDef); VIRTUAL;
- PROCEDURE WhenAttList (ElemDef : TElemDef); VIRTUAL;
- PROCEDURE WhenEntity (EntityDef : TEntityDef); VIRTUAL;
- PROCEDURE WhenNotation (NotationDef : TNotationDef); VIRTUAL;
- PROCEDURE WhenDtdError (ErrorPos : PChar); VIRTUAL;
-
- PUBLIC
- CONSTRUCTOR Create (AOwner: TComponent); OVERRIDE;
- DESTRUCTOR Destroy; OVERRIDE;
-
- PROCEDURE LoadFromFile (Filename : TFilename); // Load XML Document from file
- PROCEDURE LoadFromBuffer (Buffer : PChar); // Load XML Document from buffer
- PROCEDURE SetBuffer (Buffer : PChar); // Refer to Buffer
- FUNCTION GetFilename : TFilename;
-
- PROCEDURE Execute; // Perform scanning
-
- PROTECTED
- PROPERTY XmlParser : TXmlParser READ FXmlParser;
- PROPERTY StopParser : BOOLEAN READ FStopParser WRITE FStopParser;
- PROPERTY Filename : TFilename READ GetFilename WRITE LoadFromFile;
- PROPERTY Normalize : BOOLEAN READ GetNormalize WRITE SetNormalize;
- PROPERTY OnXmlProlog : TXmlPrologEvent READ FOnXmlProlog WRITE FOnXmlProlog;
- PROPERTY OnComment : TCommentEvent READ FOnComment WRITE FOnComment;
- PROPERTY OnPI : TPIEvent READ FOnPI WRITE FOnPI;
- PROPERTY OnDtdRead : TDtdEvent READ FOnDtdRead WRITE FOnDtdRead;
- PROPERTY OnStartTag : TStartTagEvent READ FOnStartTag WRITE FOnStartTag;
- PROPERTY OnEmptyTag : TStartTagEvent READ FOnEmptyTag WRITE FOnEmptyTag;
- PROPERTY OnEndTag : TEndTagEvent READ FOnEndTag WRITE FOnEndTag;
- PROPERTY OnContent : TContentEvent READ FOnContent WRITE FOnContent;
- PROPERTY OnCData : TContentEvent READ FOnCData WRITE FOnCData;
- PROPERTY OnElement : TElementEvent READ FOnElement WRITE FOnElement;
- PROPERTY OnAttList : TElementEvent READ FOnAttList WRITE FOnAttList;
- PROPERTY OnEntity : TEntityEvent READ FOnEntity WRITE FOnEntity;
- PROPERTY OnNotation : TNotationEvent READ FOnNotation WRITE FOnNotation;
- PROPERTY OnDtdError : TErrorEvent READ FOnDtdError WRITE FOnDtdError;
- PROPERTY OnLoadExternal : TExternalEvent READ FOnLoadExternal WRITE FOnLoadExternal;
- PROPERTY OnTranslateEncoding : TEncodingEvent READ FOnTranslateEncoding WRITE FOnTranslateEncoding;
- END;
-
-(*
-===============================================================================================
-IMPLEMENTATION
-===============================================================================================
-*)
-
-IMPLEMENTATION
-
-
-(*
-===============================================================================================
-Unicode and UTF-8 stuff
-===============================================================================================
-*)
-
-CONST
- // --- Character Translation Table for Unicode <-> Win-1252
- WIN1252_UNICODE : ARRAY [$00..$FF] OF WORD = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009,
- $000A, $000B, $000C, $000D, $000E, $000F, $0010, $0011, $0012, $0013,
- $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D,
- $001E, $001F, $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027,
- $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F, $0030, $0031,
- $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B,
- $003C, $003D, $003E, $003F, $0040, $0041, $0042, $0043, $0044, $0045,
- $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059,
- $005A, $005B, $005C, $005D, $005E, $005F, $0060, $0061, $0062, $0063,
- $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D,
- $006E, $006F, $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077,
- $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
-
- $20AC, $0081, $201A, $0192, $201E, $2026, $2020, $2021, $02C6, $2030,
- $0160, $2039, $0152, $008D, $017D, $008F, $0090, $2018, $2019, $201C,
- $201D, $2022, $2013, $2014, $02DC, $2122, $0161, $203A, $0153, $009D,
- $017E, $0178, $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
- $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF, $00B0, $00B1,
- $00B2, $00B3, $00B4, $00B5, $00B6, $00B7, $00B8, $00B9, $00BA, $00BB,
- $00BC, $00BD, $00BE, $00BF, $00C0, $00C1, $00C2, $00C3, $00C4, $00C5,
- $00C6, $00C7, $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
- $00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7, $00D8, $00D9,
- $00DA, $00DB, $00DC, $00DD, $00DE, $00DF, $00E0, $00E1, $00E2, $00E3,
- $00E4, $00E5, $00E6, $00E7, $00E8, $00E9, $00EA, $00EB, $00EC, $00ED,
- $00EE, $00EF, $00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7,
- $00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF);
-
-(* UTF-8 (somewhat simplified)
- -----
- Character Range Byte sequence
- --------------- -------------------------- (x=Bits from original character)
- $0000..$007F 0xxxxxxx
- $0080..$07FF 110xxxxx 10xxxxxx
- $8000..$FFFF 1110xxxx 10xxxxxx 10xxxxxx
-
- Example
- --------
- Transforming the Unicode character U+00E4 LATIN SMALL LETTER A WITH DIAERESIS ("ä"):
-
- ISO-8859-1, Decimal 228
- Win1252, Hex $E4
- ANSI Bin 1110 0100
- abcd efgh
-
- UTF-8 Binary 1100xxab 10cdefgh
- Binary 11000011 10100100
- Hex $C3 $A4
- Decimal 195 164
- ANSI Ã ¤ *)
-
-
-FUNCTION AnsiToUtf8 (Source : ANSISTRING) : STRING;
- (* Converts the given Windows ANSI (Win1252) String to UTF-8. *)
-VAR
- I : INTEGER; // Loop counter
- U : WORD; // Current Unicode value
- Len : INTEGER; // Current real length of "Result" string
-BEGIN
- SetLength (Result, Length (Source) * 3); // Worst case
- Len := 0;
- FOR I := 1 TO Length (Source) DO BEGIN
- U := WIN1252_UNICODE [ORD (Source [I])];
- CASE U OF
- $0000..$007F : BEGIN
- INC (Len);
- Result [Len] := CHR (U);
- END;
- $0080..$07FF : BEGIN
- INC (Len);
- Result [Len] := CHR ($C0 OR (U SHR 6));
- INC (Len);
- Result [Len] := CHR ($80 OR (U AND $3F));
- END;
- $0800..$FFFF : BEGIN
- INC (Len);
- Result [Len] := CHR ($E0 OR (U SHR 12));
- INC (Len);
- Result [Len] := CHR ($80 OR ((U SHR 6) AND $3F));
- INC (Len);
- Result [Len] := CHR ($80 OR (U AND $3F));
- END;
- END;
- END;
- SetLength (Result, Len);
-END;
-
-
-FUNCTION Utf8ToAnsi (Source : STRING; UnknownChar : CHAR = '¿') : ANSISTRING;
- (* Converts the given UTF-8 String to Windows ANSI (Win-1252).
- If a character can not be converted, the "UnknownChar" is inserted. *)
-VAR
- SourceLen : INTEGER; // Length of Source string
- I, K : INTEGER;
- A : BYTE; // Current ANSI character value
- U : WORD;
- Ch : CHAR; // Dest char
- Len : INTEGER; // Current real length of "Result" string
-BEGIN
- SourceLen := Length (Source);
- SetLength (Result, SourceLen); // Enough room to live
- Len := 0;
- I := 1;
- WHILE I <= SourceLen DO BEGIN
- A := ORD (Source [I]);
- IF A < $80 THEN BEGIN // Range $0000..$007F
- INC (Len);
- Result [Len] := Source [I];
- INC (I);
- END
- ELSE BEGIN // Determine U, Inc I
- IF (A AND $E0 = $C0) AND (I < SourceLen) THEN BEGIN // Range $0080..$07FF
- U := (WORD (A AND $1F) SHL 6) OR (ORD (Source [I+1]) AND $3F);
- INC (I, 2);
- END
- ELSE IF (A AND $F0 = $E0) AND (I < SourceLen-1) THEN BEGIN // Range $0800..$FFFF
- U := (WORD (A AND $0F) SHL 12) OR
- (WORD (ORD (Source [I+1]) AND $3F) SHL 6) OR
- ( ORD (Source [I+2]) AND $3F);
- INC (I, 3);
- END
- ELSE BEGIN // Unknown/unsupported
- INC (I);
- FOR K := 7 DOWNTO 0 DO
- IF A AND (1 SHL K) = 0 THEN BEGIN
- INC (I, (A SHR (K+1))-1);
- BREAK;
- END;
- U := WIN1252_UNICODE [ORD (UnknownChar)];
- END;
- Ch := UnknownChar; // Retrieve ANSI char
- FOR A := $00 TO $FF DO
- IF WIN1252_UNICODE [A] = U THEN BEGIN
- Ch := CHR (A);
- BREAK;
- END;
- INC (Len);
- Result [Len] := Ch;
- END;
- END;
- SetLength (Result, Len);
-END;
-
-
-(*
-===============================================================================================
-"Special" Helper Functions
-
-Don't ask me why. But including these functions makes the parser *DRAMATICALLY* faster
-on my K6-233 machine. You can test it yourself just by commenting them out.
-They do exactly the same as the Assembler routines defined in SysUtils.
-(This is where you can see how great the Delphi compiler really is. The compiled code is
-faster than hand-coded assembler!)
-===============================================================================================
---> Just move this line below the StrScan function --> *)
-
-
-FUNCTION StrPos (CONST Str, SearchStr : PChar) : PChar;
- // Same functionality as SysUtils.StrPos
-VAR
- First : CHAR;
- Len : INTEGER;
-BEGIN
- First := SearchStr^;
- Len := StrLen (SearchStr);
- Result := Str;
- REPEAT
- IF Result^ = First THEN
- IF StrLComp (Result, SearchStr, Len) = 0 THEN BREAK;
- IF Result^ = #0 THEN BEGIN
- Result := NIL;
- BREAK;
- END;
- INC (Result);
- UNTIL FALSE;
-END;
-
-
-FUNCTION StrScan (CONST Start : PChar; CONST Ch : CHAR) : PChar;
- // Same functionality as SysUtils.StrScan
-BEGIN
- Result := Start;
- WHILE Result^ <> Ch DO BEGIN
- IF Result^ = #0 THEN BEGIN
- Result := NIL;
- EXIT;
- END;
- INC (Result);
- END;
-END;
-
-
-(*
-===============================================================================================
-Helper Functions
-===============================================================================================
-*)
-
-FUNCTION DelChars (Source : STRING; CharsToDelete : TCharset) : STRING;
- // Delete all "CharsToDelete" from the string
-VAR
- I : INTEGER;
-BEGIN
- Result := Source;
- FOR I := Length (Result) DOWNTO 1 DO
- IF Result [I] IN CharsToDelete THEN
- Delete (Result, I, 1);
-END;
-
-
-FUNCTION TrimWs (Source : STRING) : STRING;
- // Trimms off Whitespace characters from both ends of the string
-VAR
- I : INTEGER;
-BEGIN
- // --- Trim Left
- I := 1;
- WHILE (I <= Length (Source)) AND (Source [I] IN CWhitespace) DO
- INC (I);
- Result := Copy (Source, I, MaxInt);
-
- // --- Trim Right
- I := Length (Result);
- WHILE (I > 1) AND (Result [I] IN CWhitespace) DO
- DEC (I);
- Delete (Result, I+1, Length (Result)-I);
-END;
-
-
-FUNCTION ConvertWs (Source: STRING; PackWs: BOOLEAN) : STRING;
- // Converts all Whitespace characters to the Space #x20 character
- // If "PackWs" is true, contiguous Whitespace characters are packed to one
-VAR
- I : INTEGER;
-BEGIN
- Result := Source;
- FOR I := Length (Result) DOWNTO 1 DO
- IF (Result [I] IN CWhitespace) THEN
- IF PackWs AND (I > 1) AND (Result [I-1] IN CWhitespace)
- THEN Delete (Result, I, 1)
- ELSE Result [I] := #32;
-END;
-
-
-PROCEDURE SetStringSF (VAR S : STRING; BufferStart, BufferFinal : PChar);
-BEGIN
- SetString (S, BufferStart, BufferFinal-BufferStart+1);
-END;
-
-
-FUNCTION StrLPas (Start : PChar; Len : INTEGER) : STRING;
-BEGIN
- SetString (Result, Start, Len);
-END;
-
-
-FUNCTION StrSFPas (Start, Finish : PChar) : STRING;
-BEGIN
- SetString (Result, Start, Finish-Start+1);
-END;
-
-
-FUNCTION StrScanE (CONST Source : PChar; CONST CharToScanFor : CHAR) : PChar;
- // If "CharToScanFor" is not found, StrScanE returns the last char of the
- // buffer instead of NIL
-BEGIN
- Result := StrScan (Source, CharToScanFor);
- IF Result = NIL THEN
- Result := StrEnd (Source)-1;
-END;
-
-
-PROCEDURE ExtractName (Start : PChar; Terminators : TCharset; VAR Final : PChar);
- (* Extracts the complete Name beginning at "Start".
- It is assumed that the name is contained in Markup, so the '>' character is
- always a Termination.
- Start: IN Pointer to first char of name. Is always considered to be valid
- Terminators: IN Characters which terminate the name
- Final: OUT Pointer to last char of name *)
-BEGIN
- Final := Start+1;
- Include (Terminators, #0);
- Include (Terminators, '>');
- WHILE NOT (Final^ IN Terminators) DO
- INC (Final);
- DEC (Final);
-END;
-
-
-PROCEDURE ExtractQuote (Start : PChar; VAR Content : STRING; VAR Final : PChar);
- (* Extract a string which is contained in single or double Quotes.
- Start: IN Pointer to opening quote
- Content: OUT The quoted string
- Final: OUT Pointer to closing quote *)
-BEGIN
- Final := StrScan (Start+1, Start^);
- IF Final = NIL THEN BEGIN
- Final := StrEnd (Start+1)-1;
- SetString (Content, Start+1, Final-Start);
- END
- ELSE
- SetString (Content, Start+1, Final-1-Start);
-END;
-
-
-(*
-===============================================================================================
-TEntityStackNode
-This Node is pushed to the "Entity Stack" whenever the parser parses entity replacement text.
-The "Instance" field holds the Instance pointer of an External Entity buffer. When it is
-popped, the Instance is freed.
-The "Encoding" field holds the name of the Encoding. External Parsed Entities may have
-another encoding as the document entity (XmlSpec 4.3.3). So when there is an "<?xml" PI
-found in the stream (= Text Declaration at the beginning of external parsed entities), the
-Encoding found there is used for the External Entity (is assigned to TXmlParser.CurEncoding)
-Default Encoding is for the Document Entity is UTF-8. It is assumed that External Entities
-have the same Encoding as the Document Entity, unless they carry a Text Declaration.
-===============================================================================================
-*)
-
-TYPE
- TEntityStackNode = CLASS
- Instance : TObject;
- Encoding : STRING;
- LastPos : PChar;
- END;
-
-(*
-===============================================================================================
-TEntityStack
-For nesting of Entities.
-When there is an entity reference found in the data stream, the corresponding entity
-definition is searched and the current position is pushed to this stack.
-From then on, the program scans the entitiy replacement text as if it were normal content.
-When the parser reaches the end of an entity, the current position is popped off the
-stack again.
-===============================================================================================
-*)
-
-CONSTRUCTOR TEntityStack.Create (TheOwner : TXmlParser);
-BEGIN
- INHERITED Create;
- Owner := TheOwner;
-END;
-
-
-PROCEDURE TEntityStack.Push (LastPos : PChar);
-BEGIN
- Push (NIL, LastPos);
-END;
-
-
-PROCEDURE TEntityStack.Push (Instance : TObject; LastPos : PChar);
-VAR
- ESN : TEntityStackNode;
-BEGIN
- ESN := TEntityStackNode.Create;
- ESN.Instance := Instance;
- ESN.Encoding := Owner.FCurEncoding; // Save current Encoding
- ESN.LastPos := LastPos;
- Add (ESN);
-END;
-
-
-FUNCTION TEntityStack.Pop : PChar;
-VAR
- ESN : TEntityStackNode;
-BEGIN
- IF Count > 0 THEN BEGIN
- ESN := TEntityStackNode (Items [Count-1]);
- Result := ESN.LastPos;
- IF ESN.Instance <> NIL THEN
- ESN.Instance.Free;
- IF ESN.Encoding <> '' THEN
- Owner.FCurEncoding := ESN.Encoding; // Restore current Encoding
- Delete (Count-1);
- END
- ELSE
- Result := NIL;
-END;
-
-
-(*
-===============================================================================================
-TExternalID
------------
-XmlSpec 4.2.2: ExternalID ::= 'SYSTEM' S SystemLiteral |
- 'PUBLIC' S PubidLiteral S SystemLiteral
-XmlSpec 4.7: PublicID ::= 'PUBLIC' S PubidLiteral
-SystemLiteral and PubidLiteral are quoted
-===============================================================================================
-*)
-
-TYPE
- TExternalID = CLASS
- PublicId : STRING;
- SystemId : STRING;
- Final : PChar;
- CONSTRUCTOR Create (Start : PChar);
- END;
-
-CONSTRUCTOR TExternalID.Create (Start : PChar);
-BEGIN
- INHERITED Create;
- Final := Start;
- IF StrLComp (Start, 'SYSTEM', 6) = 0 THEN BEGIN
- WHILE NOT (Final^ IN (CQuoteChar + [#0, '>', '['])) DO INC (Final);
- IF NOT (Final^ IN CQuoteChar) THEN EXIT;
- ExtractQuote (Final, SystemID, Final);
- END
- ELSE IF StrLComp (Start, 'PUBLIC', 6) = 0 THEN BEGIN
- WHILE NOT (Final^ IN (CQuoteChar + [#0, '>', '['])) DO INC (Final);
- IF NOT (Final^ IN CQuoteChar) THEN EXIT;
- ExtractQuote (Final, PublicID, Final);
- INC (Final);
- WHILE NOT (Final^ IN (CQuoteChar + [#0, '>', '['])) DO INC (Final);
- IF NOT (Final^ IN CQuoteChar) THEN EXIT;
- ExtractQuote (Final, SystemID, Final);
- END;
-END;
-
-
-(*
-===============================================================================================
-TXmlParser
-===============================================================================================
-*)
-
-CONSTRUCTOR TXmlParser.Create;
-BEGIN
- INHERITED Create;
- FBuffer := NIL;
- FBufferSize := 0;
- Elements := TElemList.Create;
- Entities := TNvpList.Create;
- ParEntities := TNvpList.Create;
- Notations := TNvpList.Create;
- CurAttr := TAttrList.Create;
- EntityStack := TEntityStack.Create (Self);
- Clear;
-END;
-
-
-DESTRUCTOR TXmlParser.Destroy;
-BEGIN
- Clear;
- Elements.Free;
- Entities.Free;
- ParEntities.Free;
- Notations.Free;
- CurAttr.Free;
- EntityStack.Free;
- INHERITED Destroy;
-END;
-
-
-PROCEDURE TXmlParser.Clear;
- // Free Buffer and clear all object attributes
-BEGIN
- IF (FBufferSize > 0) AND (FBuffer <> NIL) THEN
- FreeMem (FBuffer);
- FBuffer := NIL;
- FBufferSize := 0;
- FSource := '';
- FXmlVersion := '';
- FEncoding := '';
- FStandalone := FALSE;
- FRootName := '';
- FDtdcFinal := NIL;
- FNormalize := TRUE;
- Elements.Clear;
- Entities.Clear;
- ParEntities.Clear;
- Notations.Clear;
- CurAttr.Clear;
- EntityStack.Clear;
-END;
-
-
-FUNCTION TXmlParser.LoadFromFile (Filename : STRING; FileMode : INTEGER = fmOpenRead OR fmShareDenyNone) : BOOLEAN;
- // Loads Document from given file
- // Returns TRUE if successful
-VAR
- f : FILE;
- ReadIn : INTEGER;
- OldFileMode : INTEGER;
-BEGIN
- Result := FALSE;
- Clear;
-
- // --- Open File
- OldFileMode := SYSTEM.FileMode;
- TRY
- SYSTEM.FileMode := FileMode;
- TRY
- AssignFile (f, Filename);
- Reset (f, 1);
- EXCEPT
- EXIT;
- END;
-
- TRY
- // --- Allocate Memory
- TRY
- FBufferSize := Filesize (f) + 1;
- GetMem (FBuffer, FBufferSize);
- EXCEPT
- Clear;
- EXIT;
- END;
-
- // --- Read File
- TRY
- BlockRead (f, FBuffer^, FBufferSize, ReadIn);
- (FBuffer+ReadIn)^ := #0; // NULL termination
- EXCEPT
- Clear;
- EXIT;
- END;
- FINALLY
- CloseFile (f);
- END;
-
- FSource := Filename;
- Result := TRUE;
-
- FINALLY
- SYSTEM.FileMode := OldFileMode;
- END;
-END;
-
-
-FUNCTION TXmlParser.LoadFromBuffer (Buffer : PChar) : BOOLEAN;
- // Loads Document from another buffer
- // Returns TRUE if successful
- // The "Source" property becomes '<MEM>' if successful
-BEGIN
- Result := FALSE;
- Clear;
- FBufferSize := StrLen (Buffer) + 1;
- TRY
- GetMem (FBuffer, FBufferSize);
- EXCEPT
- Clear;
- EXIT;
- END;
- StrCopy (FBuffer, Buffer);
- FSource := '<MEM>';
- Result := TRUE;
-END;
-
-
-PROCEDURE TXmlParser.SetBuffer (Buffer : PChar); // References another buffer
-BEGIN
- Clear;
- FBuffer := Buffer;
- FBufferSize := 0;
- FSource := '<REFERENCE>';
-END;
-
-
-//-----------------------------------------------------------------------------------------------
-// Scanning through the document
-//-----------------------------------------------------------------------------------------------
-
-PROCEDURE TXmlParser.StartScan;
-BEGIN
- CurPartType := ptNone;
- CurName := '';
- CurContent := '';
- CurStart := NIL;
- CurFinal := NIL;
- CurAttr.Clear;
- EntityStack.Clear;
-END;
-
-
-FUNCTION TXmlParser.Scan : BOOLEAN;
- // Scans the next Part
- // Returns TRUE if a part could be found, FALSE if there is no part any more
- //
- // "IsDone" can be set to FALSE by AnalyzeText in order to go to the next part
- // if there is no Content due to normalization
-VAR
- IsDone : BOOLEAN;
-BEGIN
- REPEAT
- IsDone := TRUE;
-
- // --- Start of next Part
- IF CurStart = NIL
- THEN CurStart := DocBuffer
- ELSE CurStart := CurFinal+1;
- CurFinal := CurStart;
-
- // --- End of Document of Pop off a new part from the Entity stack?
- IF CurStart^ = #0 THEN
- CurStart := EntityStack.Pop;
-
- // --- No Document or End Of Document: Terminate Scan
- IF (CurStart = NIL) OR (CurStart^ = #0) THEN BEGIN
- CurStart := StrEnd (DocBuffer);
- CurFinal := CurStart-1;
- EntityStack.Clear;
- Result := FALSE;
- EXIT;
- END;
-
- IF (StrLComp (CurStart, '<?xml', 5) = 0) AND
- ((CurStart+5)^ IN CWhitespace) THEN AnalyzeProlog // XML Declaration, Text Declaration
- ELSE IF StrLComp (CurStart, '<?', 2) = 0 THEN AnalyzePI (CurStart, CurFinal) // PI
- ELSE IF StrLComp (CurStart, '<!--', 4) = 0 THEN AnalyzeComment (CurStart, CurFinal) // Comment
- ELSE IF StrLComp (CurStart, '<!DOCTYPE', 9) = 0 THEN AnalyzeDtdc // DTDc
- ELSE IF StrLComp (CurStart, CDStart, Length (CDStart)) = 0 THEN AnalyzeCdata // CDATA Section
- ELSE IF StrLComp (CurStart, '<', 1) = 0 THEN AnalyzeTag // Start-Tag, End-Tag, Empty-Element-Tag
- ELSE AnalyzeText (IsDone); // Text Content
- UNTIL IsDone;
- Result := TRUE;
-END;
-
-
-PROCEDURE TXmlParser.AnalyzeProlog;
- // Analyze XML Prolog or Text Declaration
-VAR
- F : PChar;
-BEGIN
- CurAttr.Analyze (CurStart+5, F);
- IF EntityStack.Count = 0 THEN BEGIN
- FXmlVersion := CurAttr.Value ('version');
- FEncoding := CurAttr.Value ('encoding');
- FStandalone := CurAttr.Value ('standalone') = 'yes';
- END;
- CurFinal := StrPos (F, '?>');
- IF CurFinal <> NIL
- THEN INC (CurFinal)
- ELSE CurFinal := StrEnd (CurStart)-1;
- FCurEncoding := AnsiUpperCase (CurAttr.Value ('encoding'));
- IF FCurEncoding = '' THEN
- FCurEncoding := 'UTF-8'; // Default XML Encoding is UTF-8
- CurPartType := ptXmlProlog;
- CurName := '';
- CurContent := '';
-END;
-
-
-PROCEDURE TXmlParser.AnalyzeComment (Start : PChar; VAR Final : PChar);
- // Analyze Comments
-BEGIN
- Final := StrPos (Start+4, '-->');
- IF Final = NIL
- THEN Final := StrEnd (Start)-1
- ELSE INC (Final, 2);
- CurPartType := ptComment;
-END;
-
-
-PROCEDURE TXmlParser.AnalyzePI (Start : PChar; VAR Final : PChar);
- // Analyze Processing Instructions (PI)
- // This is also called for Character
-VAR
- F : PChar;
-BEGIN
- CurPartType := ptPI;
- Final := StrPos (Start+2, '?>');
- IF Final = NIL
- THEN Final := StrEnd (Start)-1
- ELSE INC (Final);
- ExtractName (Start+2, CWhitespace + ['?', '>'], F);
- SetStringSF (CurName, Start+2, F);
- SetStringSF (CurContent, F+1, Final-2);
- CurAttr.Analyze (F+1, F);
-END;
-
-
-PROCEDURE TXmlParser.AnalyzeDtdc;
- (* Analyze Document Type Declaration
- doctypedecl ::= '<!DOCTYPE' S Name (S ExternalID)? S? ('[' (markupdecl | PEReference | S)* ']' S?)? '>'
- markupdecl ::= elementdecl | AttlistDecl | EntityDecl | NotationDecl | PI | Comment
- PEReference ::= '%' Name ';'
-
- elementdecl ::= '<!ELEMENT' S Name S contentspec S? '>'
- AttlistDecl ::= '<!ATTLIST' S Name AttDef* S? '>'
- EntityDecl ::= '<!ENTITY' S Name S EntityDef S? '>' |
- '<!ENTITY' S '%' S Name S PEDef S? '>'
- NotationDecl ::= '<!NOTATION' S Name S (ExternalID | PublicID) S? '>'
- PI ::= '<?' PITarget (S (Char* - (Char* '?>' Char* )))? '?>'
- Comment ::= '<!--' ((Char - '-') | ('-' (Char - '-')))* '-->' *)
-TYPE
- TPhase = (phName, phDtd, phInternal, phFinishing);
-VAR
- Phase : TPhase;
- F : PChar;
- ExternalID : TExternalID;
- ExternalDTD : TXmlParser;
- DER : TDtdElementRec;
-BEGIN
- DER.Start := CurStart;
- EntityStack.Clear; // Clear stack for Parameter Entities
- CurPartType := ptDtdc;
-
- // --- Don't read DTDc twice
- IF FDtdcFinal <> NIL THEN BEGIN
- CurFinal := FDtdcFinal;
- EXIT;
- END;
-
- // --- Scan DTDc
- CurFinal := CurStart + 9; // First char after '<!DOCTYPE'
- Phase := phName;
- REPEAT
- CASE CurFinal^ OF
- '%' : BEGIN
- PushPE (CurFinal);
- CONTINUE;
- END;
- #0 : IF EntityStack.Count = 0 THEN
- BREAK
- ELSE BEGIN
- CurFinal := EntityStack.Pop;
- CONTINUE;
- END;
- '[' : BEGIN
- Phase := phInternal;
- AnalyzeDtdElements (CurFinal+1, CurFinal);
- CONTINUE;
- END;
- ']' : Phase := phFinishing;
- '>' : BREAK;
- ELSE IF NOT (CurFinal^ IN CWhitespace) THEN BEGIN
- CASE Phase OF
- phName : IF (CurFinal^ IN CNameStart) THEN BEGIN
- ExtractName (CurFinal, CWhitespace + ['[', '>'], F);
- SetStringSF (FRootName, CurFinal, F);
- CurFinal := F;
- Phase := phDtd;
- END;
- phDtd : IF (StrLComp (CurFinal, 'SYSTEM', 6) = 0) OR
- (StrLComp (CurFinal, 'PUBLIC', 6) = 0) THEN BEGIN
- ExternalID := TExternalID.Create (CurFinal);
- ExternalDTD := LoadExternalEntity (ExternalId.SystemId, ExternalID.PublicId, '');
- F := StrPos (ExternalDtd.DocBuffer, '<!');
- IF F <> NIL THEN
- AnalyzeDtdElements (F, F);
- ExternalDTD.Free;
- CurFinal := ExternalID.Final;
- ExternalID.Free;
- END;
- ELSE BEGIN
- DER.ElementType := deError;
- DER.Pos := CurFinal;
- DER.Final := CurFinal;
- DtdElementFound (DER);
- END;
- END;
-
- END;
- END;
- INC (CurFinal);
- UNTIL FALSE;
-
- CurPartType := ptDtdc;
- CurName := '';
- CurContent := '';
-
- // It is an error in the document if "EntityStack" is not empty now
- IF EntityStack.Count > 0 THEN BEGIN
- DER.ElementType := deError;
- DER.Final := CurFinal;
- DER.Pos := CurFinal;
- DtdElementFound (DER);
- END;
-
- EntityStack.Clear; // Clear stack for General Entities
- FDtdcFinal := CurFinal;
-END;
-
-
-PROCEDURE TXmlParser.AnalyzeDtdElements (Start : PChar; VAR Final : PChar);
- // Analyze the "Elements" of a DTD contained in the external or
- // internal DTD subset.
-VAR
- DER : TDtdElementRec;
-BEGIN
- Final := Start;
- REPEAT
- CASE Final^ OF
- '%' : BEGIN
- PushPE (Final);
- CONTINUE;
- END;
- #0 : IF EntityStack.Count = 0 THEN
- BREAK
- ELSE BEGIN
- CurFinal := EntityStack.Pop;
- CONTINUE;
- END;
- ']',
- '>' : BREAK;
- '<' : IF StrLComp (Final, '<!ELEMENT', 9) = 0 THEN AnalyzeElementDecl (Final, Final)
- ELSE IF StrLComp (Final, '<!ATTLIST', 9) = 0 THEN AnalyzeAttListDecl (Final, Final)
- ELSE IF StrLComp (Final, '<!ENTITY', 8) = 0 THEN AnalyzeEntityDecl (Final, Final)
- ELSE IF StrLComp (Final, '<!NOTATION', 10) = 0 THEN AnalyzeNotationDecl (Final, Final)
- ELSE IF StrLComp (Final, '<?', 2) = 0 THEN BEGIN // PI in DTD
- DER.ElementType := dePI;
- DER.Start := Final;
- AnalyzePI (Final, Final);
- DER.Target := PChar (CurName);
- DER.Content := PChar (CurContent);
- DER.AttrList := CurAttr;
- DER.Final := Final;
- DtdElementFound (DER);
- END
- ELSE IF StrLComp (Final, '<!--', 4) = 0 THEN BEGIN // Comment in DTD
- DER.ElementType := deComment;
- DER.Start := Final;
- AnalyzeComment (Final, Final);
- DER.Final := Final;
- DtdElementFound (DER);
- END
- ELSE BEGIN
- DER.ElementType := deError;
- DER.Start := Final;
- DER.Pos := Final;
- DER.Final := Final;
- DtdElementFound (DER);
- END;
-
- END;
- INC (Final);
- UNTIL FALSE;
-END;
-
-
-PROCEDURE TXmlParser.AnalyzeTag;
- // Analyze Tags
-VAR
- S, F : PChar;
- Attr : TAttr;
- ElemDef : TElemDef;
- AttrDef : TAttrDef;
- I : INTEGER;
-BEGIN
- CurPartType := ptStartTag;
- S := CurStart+1;
- IF S^ = '/' THEN BEGIN
- CurPartType := ptEndTag;
- INC (S);
- END;
- ExtractName (S, CWhitespace + ['/'], F);
- SetStringSF (CurName, S, F);
- CurAttr.Analyze (F+1, CurFinal);
- IF CurFinal^ = '/' THEN BEGIN
- CurPartType := ptEmptyTag;
- END;
- CurFinal := StrScanE (CurFinal, '>');
-
- // --- Set Default Attribute values for nonexistent attributes
- IF (CurPartType = ptStartTag) OR (CurPartType = ptEmptyTag) THEN BEGIN
- ElemDef := Elements.Node (CurName);
- IF ElemDef <> NIL THEN BEGIN
- FOR I := 0 TO ElemDef.Count-1 DO BEGIN
- AttrDef := TAttrDef (ElemDef [I]);
- Attr := TAttr (CurAttr.Node (AttrDef.Name));
- IF (Attr = NIL) AND (AttrDef.Value <> '') THEN BEGIN
- Attr := TAttr.Create (AttrDef.Name, AttrDef.Value);
- Attr.ValueType := vtDefault;
- CurAttr.Add (Attr);
- END;
- IF Attr <> NIL THEN BEGIN
- CASE AttrDef.DefaultType OF
- adDefault : ;
- adRequired : ; // -!- It is an error in the document if "Attr.Value" is an empty string
- adImplied : Attr.ValueType := vtImplied;
- adFixed : BEGIN
- Attr.ValueType := vtFixed;
- Attr.Value := AttrDef.Value;
- END;
- END;
- Attr.AttrType := AttrDef.AttrType;
- END;
- END;
- END;
-
- // --- Normalize Attribute Values. XmlSpec:
- // - a character reference is processed by appending the referenced character to the attribute value
- // - an entity reference is processed by recursively processing the replacement text of the entity
- // - a whitespace character (#x20, #xD, #xA, #x9) is processed by appending #x20 to the normalized value,
- // except that only a single #x20 is appended for a "#xD#xA" sequence that is part of an external
- // parsed entity or the literal entity value of an internal parsed entity
- // - other characters are processed by appending them to the normalized value
- // If the declared value is not CDATA, then the XML processor must further process the
- // normalized attribute value by discarding any leading and trailing space (#x20) characters,
- // and by replacing sequences of space (#x20) characters by a single space (#x20) character.
- // All attributes for which no declaration has been read should be treated by a
- // non-validating parser as if declared CDATA.
- // !!! The XML 1.0 SE specification is somewhat different here
- // This code does not conform exactly to this specification
- FOR I := 0 TO CurAttr.Count-1 DO
- WITH TAttr (CurAttr [I]) DO BEGIN
- ReplaceGeneralEntities (Value);
- ReplaceCharacterEntities (Value);
- IF (AttrType <> atCData) AND (AttrType <> atUnknown)
- THEN Value := TranslateEncoding (TrimWs (ConvertWs (Value, TRUE)))
- ELSE Value := TranslateEncoding (ConvertWs (Value, FALSE));
- END;
- END;
-END;
-
-
-PROCEDURE TXmlParser.AnalyzeCData;
- // Analyze CDATA Sections
-BEGIN
- CurPartType := ptCData;
- CurFinal := StrPos (CurStart, CDEnd);
- IF CurFinal = NIL THEN BEGIN
- CurFinal := StrEnd (CurStart)-1;
- CurContent := TranslateEncoding (StrPas (CurStart+Length (CDStart)));
- END
- ELSE BEGIN
- SetStringSF (CurContent, CurStart+Length (CDStart), CurFinal-1);
- INC (CurFinal, Length (CDEnd)-1);
- CurContent := TranslateEncoding (CurContent);
- END;
-END;
-
-
-PROCEDURE TXmlParser.AnalyzeText (VAR IsDone : BOOLEAN);
- (* Analyzes Text Content between Tags. CurFinal will point to the last content character.
- Content ends at a '<' character or at the end of the document.
- Entity References and Character Entity references are resolved.
- If PackSpaces is TRUE, contiguous Whitespace Characters will be compressed to
- one Space #x20 character, Whitespace at the beginning and end of content will
- be trimmed off and content which is or becomes empty is not returned to
- the application (in this case, "IsDone" is set to FALSE which causes the
- Scan method to proceed directly to the next part. *)
-
- PROCEDURE ProcessEntity;
- (* Is called if there is an ampsersand '&' character found in the document.
- IN "CurFinal" points to the ampersand
- OUT "CurFinal" points to the first character after the semi-colon ';' *)
- VAR
- P : PChar;
- Name : STRING;
- EntityDef : TEntityDef;
- ExternalEntity : TXmlParser;
- BEGIN
- P := StrScan (CurFinal , ';');
- IF P <> NIL THEN BEGIN
- SetStringSF (Name, CurFinal+1, P-1);
-
- // Is it a Character Entity?
- IF (CurFinal+1)^ = '#' THEN BEGIN
- IF UpCase ((CurFinal+2)^) = 'X' // !!! Can't use "CHR" for Unicode characters > 255:
- THEN CurContent := CurContent + CHR (StrToIntDef ('$'+Copy (Name, 3, MaxInt), 32))
- ELSE CurContent := CurContent + CHR (StrToIntDef (Copy (Name, 2, MaxInt), 32));
- CurFinal := P+1;
- EXIT;
- END
-
- // Is it a Predefined Entity?
- ELSE IF Name = 'lt' THEN BEGIN CurContent := CurContent + '<'; CurFinal := P+1; EXIT; END
- ELSE IF Name = 'gt' THEN BEGIN CurContent := CurContent + '>'; CurFinal := P+1; EXIT; END
- ELSE IF Name = 'amp' THEN BEGIN CurContent := CurContent + '&'; CurFinal := P+1; EXIT; END
- ELSE IF Name = 'apos' THEN BEGIN CurContent := CurContent + ''''; CurFinal := P+1; EXIT; END
- ELSE IF Name = 'quot' THEN BEGIN CurContent := CurContent + '"'; CurFinal := P+1; EXIT; END;
-
- // Replace with Entity from DTD
- EntityDef := TEntityDef (Entities.Node (Name));
- IF EntityDef <> NIL THEN BEGIN
- IF EntityDef.Value <> '' THEN BEGIN
- EntityStack.Push (P+1);
- CurFinal := PChar (EntityDef.Value);
- END
- ELSE BEGIN
- ExternalEntity := LoadExternalEntity (EntityDef.SystemId, EntityDef.PublicId, EntityDef.NotationName);
- EntityStack.Push (ExternalEntity, P+1);
- CurFinal := ExternalEntity.DocBuffer;
- END;
- END
- ELSE BEGIN
- CurContent := CurContent + Name;
- CurFinal := P+1;
- END;
- END
- ELSE BEGIN
- INC (CurFinal);
- END;
- END;
-
-VAR
- C : INTEGER;
-BEGIN
- CurFinal := CurStart;
- CurPartType := ptContent;
- CurContent := '';
- C := 0;
- REPEAT
- CASE CurFinal^ OF
- '&' : BEGIN
- CurContent := CurContent + TranslateEncoding (StrLPas (CurFinal-C, C));
- C := 0;
- ProcessEntity;
- CONTINUE;
- END;
- #0 : BEGIN
- IF EntityStack.Count = 0 THEN
- BREAK
- ELSE BEGIN
- CurContent := CurContent + TranslateEncoding (StrLPas (CurFinal-C, C));
- C := 0;
- CurFinal := EntityStack.Pop;
- CONTINUE;
- END;
- END;
- '<' : BREAK;
- ELSE INC (C);
- END;
- INC (CurFinal);
- UNTIL FALSE;
- CurContent := CurContent + TranslateEncoding (StrLPas (CurFinal-C, C));
- DEC (CurFinal);
-
- IF FNormalize THEN BEGIN
- CurContent := ConvertWs (TrimWs (CurContent), TRUE);
- IsDone := CurContent <> ''; // IsDone will only get FALSE if PackSpaces is TRUE
- END;
-END;
-
-
-PROCEDURE TXmlParser.AnalyzeElementDecl (Start : PChar; VAR Final : PChar);
- (* Parse <!ELEMENT declaration starting at "Start"
- Final must point to the terminating '>' character
- XmlSpec 3.2:
- elementdecl ::= '<!ELEMENT' S Name S contentspec S? '>'
- contentspec ::= 'EMPTY' | 'ANY' | Mixed | children
- Mixed ::= '(' S? '#PCDATA' (S? '|' S? Name)* S? ')*' |
- '(' S? '#PCDATA' S? ')'
- children ::= (choice | seq) ('?' | '*' | '+')?
- choice ::= '(' S? cp ( S? '|' S? cp )* S? ')'
- cp ::= (Name | choice | seq) ('?' | '*' | '+')?
- seq ::= '(' S? cp ( S? ',' S? cp )* S? ')'
-
- More simply:
- contentspec ::= EMPTY
- ANY
- '(#PCDATA)'
- '(#PCDATA | A | B)*'
- '(A, B, C)'
- '(A | B | C)'
- '(A?, B*, C+),
- '(A, (B | C | D)* )' *)
-VAR
- Element : TElemDef;
- Elem2 : TElemDef;
- F : PChar;
- DER : TDtdElementRec;
-BEGIN
- Element := TElemDef.Create;
- Final := Start + 9;
- DER.Start := Start;
- REPEAT
- IF Final^ = '>' THEN BREAK;
- IF (Final^ IN CNameStart) AND (Element.Name = '') THEN BEGIN
- ExtractName (Final, CWhitespace, F);
- SetStringSF (Element.Name, Final, F);
- Final := F;
- F := StrScan (Final+1, '>');
- IF F = NIL THEN BEGIN
- Element.Definition := STRING (Final);
- Final := StrEnd (Final);
- BREAK;
- END
- ELSE BEGIN
- SetStringSF (Element.Definition, Final+1, F-1);
- Final := F;
- BREAK;
- END;
- END;
- INC (Final);
- UNTIL FALSE;
- Element.Definition := DelChars (Element.Definition, CWhitespace);
- ReplaceParameterEntities (Element.Definition);
- IF Element.Definition = 'EMPTY' THEN Element.ElemType := etEmpty
- ELSE IF Element.Definition = 'ANY' THEN Element.ElemType := etAny
- ELSE IF Copy (Element.Definition, 1, 8) = '(#PCDATA' THEN Element.ElemType := etMixed
- ELSE IF Copy (Element.Definition, 1, 1) = '(' THEN Element.ElemType := etChildren
- ELSE Element.ElemType := etAny;
-
- Elem2 := Elements.Node (Element.Name);
- IF Elem2 <> NIL THEN
- Elements.Delete (Elements.IndexOf (Elem2));
- Elements.Add (Element);
- Final := StrScanE (Final, '>');
- DER.ElementType := deElement;
- DER.ElemDef := Element;
- DER.Final := Final;
- DtdElementFound (DER);
-END;
-
-
-PROCEDURE TXmlParser.AnalyzeAttListDecl (Start : PChar; VAR Final : PChar);
- (* Parse <!ATTLIST declaration starting at "Start"
- Final must point to the terminating '>' character
- XmlSpec 3.3:
- AttlistDecl ::= '<!ATTLIST' S Name AttDef* S? '>'
- AttDef ::= S Name S AttType S DefaultDecl
- AttType ::= StringType | TokenizedType | EnumeratedType
- StringType ::= 'CDATA'
- TokenizedType ::= 'ID' | 'IDREF' | 'IDREFS' | 'ENTITY' | 'ENTITIES' | 'NMTOKEN' | 'NMTOKENS'
- EnumeratedType ::= NotationType | Enumeration
- NotationType ::= 'NOTATION' S '(' S? Name (S? '|' S? Name)* S? ')'
- Enumeration ::= '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')'
- DefaultDecl ::= '#REQUIRED' | '#IMPLIED' | (('#FIXED' S)? AttValue)
- AttValue ::= '"' ([^<&"] | Reference)* '"' | "'" ([^<&'] | Reference)* "'"
- Examples:
- <!ATTLIST address
- A1 CDATA "Default"
- A2 ID #REQUIRED
- A3 IDREF #IMPLIED
- A4 IDREFS #IMPLIED
- A5 ENTITY #FIXED "&at;ü"
- A6 ENTITIES #REQUIRED
- A7 NOTATION (WMF | DXF) "WMF"
- A8 (A | B | C) #REQUIRED> *)
-TYPE
- TPhase = (phElementName, phName, phType, phNotationContent, phDefault);
-VAR
- Phase : TPhase;
- F : PChar;
- ElementName : STRING;
- ElemDef : TElemDef;
- AttrDef : TAttrDef;
- AttrDef2 : TAttrDef;
- Strg : STRING;
- DER : TDtdElementRec;
-BEGIN
- Final := Start + 9; // The character after <!ATTLIST
- Phase := phElementName;
- DER.Start := Start;
- AttrDef := NIL;
- ElemDef := NIL;
- REPEAT
- IF NOT (Final^ IN CWhitespace) THEN
- CASE Final^ OF
- '%' : BEGIN
- PushPE (Final);
- CONTINUE;
- END;
- #0 : IF EntityStack.Count = 0 THEN
- BREAK
- ELSE BEGIN
- Final := EntityStack.Pop;
- CONTINUE;
- END;
- '>' : BREAK;
- ELSE CASE Phase OF
- phElementName : BEGIN
- ExtractName (Final, CWhitespace + CQuoteChar + ['#'], F);
- SetStringSF (ElementName, Final, F);
- Final := F;
- ElemDef := Elements.Node (ElementName);
- IF ElemDef = NIL THEN BEGIN
- ElemDef := TElemDef.Create;
- ElemDef.Name := ElementName;
- ElemDef.Definition := 'ANY';
- ElemDef.ElemType := etAny;
- Elements.Add (ElemDef);
- END;
- Phase := phName;
- END;
- phName : BEGIN
- AttrDef := TAttrDef.Create;
- ExtractName (Final, CWhitespace + CQuoteChar + ['#'], F);
- SetStringSF (AttrDef.Name, Final, F);
- Final := F;
- AttrDef2 := TAttrDef (ElemDef.Node (AttrDef.Name));
- IF AttrDef2 <> NIL THEN
- ElemDef.Delete (ElemDef.IndexOf (AttrDef2));
- ElemDef.Add (AttrDef);
- Phase := phType;
- END;
- phType : BEGIN
- IF Final^ = '(' THEN BEGIN
- F := StrScan (Final+1, ')');
- IF F <> NIL
- THEN SetStringSF (AttrDef.TypeDef, Final+1, F-1)
- ELSE AttrDef.TypeDef := STRING (Final+1);
- AttrDef.TypeDef := DelChars (AttrDef.TypeDef, CWhitespace);
- AttrDef.AttrType := atEnumeration;
- ReplaceParameterEntities (AttrDef.TypeDef);
- ReplaceCharacterEntities (AttrDef.TypeDef);
- Phase := phDefault;
- END
- ELSE IF StrLComp (Final, 'NOTATION', 8) = 0 THEN BEGIN
- INC (Final, 8);
- AttrDef.AttrType := atNotation;
- Phase := phNotationContent;
- END
- ELSE BEGIN
- ExtractName (Final, CWhitespace+CQuoteChar+['#'], F);
- SetStringSF (AttrDef.TypeDef, Final, F);
- IF AttrDef.TypeDef = 'CDATA' THEN AttrDef.AttrType := atCData
- ELSE IF AttrDef.TypeDef = 'ID' THEN AttrDef.AttrType := atId
- ELSE IF AttrDef.TypeDef = 'IDREF' THEN AttrDef.AttrType := atIdRef
- ELSE IF AttrDef.TypeDef = 'IDREFS' THEN AttrDef.AttrType := atIdRefs
- ELSE IF AttrDef.TypeDef = 'ENTITY' THEN AttrDef.AttrType := atEntity
- ELSE IF AttrDef.TypeDef = 'ENTITIES' THEN AttrDef.AttrType := atEntities
- ELSE IF AttrDef.TypeDef = 'NMTOKEN' THEN AttrDef.AttrType := atNmToken
- ELSE IF AttrDef.TypeDef = 'NMTOKENS' THEN AttrDef.AttrType := atNmTokens;
- Phase := phDefault;
- END
- END;
- phNotationContent : BEGIN
- F := StrScan (Final, ')');
- IF F <> NIL THEN
- SetStringSF (AttrDef.Notations, Final+1, F-1)
- ELSE BEGIN
- AttrDef.Notations := STRING (Final+1);
- Final := StrEnd (Final);
- END;
- ReplaceParameterEntities (AttrDef.Notations);
- AttrDef.Notations := DelChars (AttrDef.Notations, CWhitespace);
- Phase := phDefault;
- END;
- phDefault : BEGIN
- IF Final^ = '#' THEN BEGIN
- ExtractName (Final, CWhiteSpace + CQuoteChar, F);
- SetStringSF (Strg, Final, F);
- Final := F;
- ReplaceParameterEntities (Strg);
- IF Strg = '#REQUIRED' THEN BEGIN AttrDef.DefaultType := adRequired; Phase := phName; END
- ELSE IF Strg = '#IMPLIED' THEN BEGIN AttrDef.DefaultType := adImplied; Phase := phName; END
- ELSE IF Strg = '#FIXED' THEN AttrDef.DefaultType := adFixed;
- END
- ELSE IF (Final^ IN CQuoteChar) THEN BEGIN
- ExtractQuote (Final, AttrDef.Value, Final);
- ReplaceParameterEntities (AttrDef.Value);
- ReplaceCharacterEntities (AttrDef.Value);
- Phase := phName;
- END;
- IF Phase = phName THEN BEGIN
- AttrDef := NIL;
- END;
- END;
-
- END;
- END;
- INC (Final);
- UNTIL FALSE;
-
- Final := StrScan (Final, '>');
-
- DER.ElementType := deAttList;
- DER.ElemDef := ElemDef;
- DER.Final := Final;
- DtdElementFound (DER);
-END;
-
-
-PROCEDURE TXmlParser.AnalyzeEntityDecl (Start : PChar; VAR Final : PChar);
- (* Parse <!ENTITY declaration starting at "Start"
- Final must point to the terminating '>' character
- XmlSpec 4.2:
- EntityDecl ::= '<!ENTITY' S Name S EntityDef S? '>' |
- '<!ENTITY' S '%' S Name S PEDef S? '>'
- EntityDef ::= EntityValue | (ExternalID NDataDecl?)
- PEDef ::= EntityValue | ExternalID
- NDataDecl ::= S 'NDATA' S Name
- EntityValue ::= '"' ([^%&"] | PEReference | EntityRef | CharRef)* '"' |
- "'" ([^%&'] | PEReference | EntityRef | CharRef)* "'"
- PEReference ::= '%' Name ';'
-
- Examples
- <!ENTITY test1 "Stefan Heymann"> <!-- Internal, general, parsed -->
- <!ENTITY test2 SYSTEM "ent2.xml"> <!-- External, general, parsed -->
- <!ENTITY test2 SYSTEM "ent3.gif" NDATA gif> <!-- External, general, unparsed -->
- <!ENTITY % test3 "<!ELEMENT q ANY>"> <!-- Internal, parameter -->
- <!ENTITY % test6 SYSTEM "ent6.xml"> <!-- External, parameter -->
- <!ENTITY test4 "&test1; ist lieb"> <!-- IGP, Replacement text <> literal value -->
- <!ENTITY test5 "<p>Dies ist ein Test-Absatz</p>"> <!-- IGP, See XmlSpec 2.4 -->
- *)
-TYPE
- TPhase = (phName, phContent, phNData, phNotationName, phFinalGT);
-VAR
- Phase : TPhase;
- IsParamEntity : BOOLEAN;
- F : PChar;
- ExternalID : TExternalID;
- EntityDef : TEntityDef;
- EntityDef2 : TEntityDef;
- DER : TDtdElementRec;
-BEGIN
- Final := Start + 8; // First char after <!ENTITY
- DER.Start := Start;
- Phase := phName;
- IsParamEntity := FALSE;
- EntityDef := TEntityDef.Create;
- REPEAT
- IF NOT (Final^ IN CWhitespace) THEN
- CASE Final^ OF
- '%' : IsParamEntity := TRUE;
- '>' : BREAK;
- ELSE CASE Phase OF
- phName : IF Final^ IN CNameStart THEN BEGIN
- ExtractName (Final, CWhitespace + CQuoteChar, F);
- SetStringSF (EntityDef.Name, Final, F);
- Final := F;
- Phase := phContent;
- END;
- phContent : IF Final^ IN CQuoteChar THEN BEGIN
- ExtractQuote (Final, EntityDef.Value, Final);
- Phase := phFinalGT;
- END
- ELSE IF (StrLComp (Final, 'SYSTEM', 6) = 0) OR
- (StrLComp (Final, 'PUBLIC', 6) = 0) THEN BEGIN
- ExternalID := TExternalID.Create (Final);
- EntityDef.SystemId := ExternalID.SystemId;
- EntityDef.PublicId := ExternalID.PublicId;
- Final := ExternalID.Final;
- Phase := phNData;
- ExternalID.Free;
- END;
- phNData : IF StrLComp (Final, 'NDATA', 5) = 0 THEN BEGIN
- INC (Final, 4);
- Phase := phNotationName;
- END;
- phNotationName : IF Final^ IN CNameStart THEN BEGIN
- ExtractName (Final, CWhitespace + ['>'], F);
- SetStringSF (EntityDef.NotationName, Final, F);
- Final := F;
- Phase := phFinalGT;
- END;
- phFinalGT : ; // -!- There is an error in the document if this branch is called
- END;
- END;
- INC (Final);
- UNTIL FALSE;
- IF IsParamEntity THEN BEGIN
- EntityDef2 := TEntityDef (ParEntities.Node (EntityDef.Name));
- IF EntityDef2 <> NIL THEN
- ParEntities.Delete (ParEntities.IndexOf (EntityDef2));
- ParEntities.Add (EntityDef);
- ReplaceCharacterEntities (EntityDef.Value);
- END
- ELSE BEGIN
- EntityDef2 := TEntityDef (Entities.Node (EntityDef.Name));
- IF EntityDef2 <> NIL THEN
- Entities.Delete (Entities.IndexOf (EntityDef2));
- Entities.Add (EntityDef);
- ReplaceParameterEntities (EntityDef.Value); // Create replacement texts (see XmlSpec 4.5)
- ReplaceCharacterEntities (EntityDef.Value);
- END;
- Final := StrScanE (Final, '>');
-
- DER.ElementType := deEntity;
- DER.EntityDef := EntityDef;
- DER.Final := Final;
- DtdElementFound (DER);
-END;
-
-
-PROCEDURE TXmlParser.AnalyzeNotationDecl (Start : PChar; VAR Final : PChar);
- // Parse <!NOTATION declaration starting at "Start"
- // Final must point to the terminating '>' character
- // XmlSpec 4.7: NotationDecl ::= '<!NOTATION' S Name S (ExternalID | PublicID) S? '>'
-TYPE
- TPhase = (phName, phExtId, phEnd);
-VAR
- ExternalID : TExternalID;
- Phase : TPhase;
- F : PChar;
- NotationDef : TNotationDef;
- DER : TDtdElementRec;
-BEGIN
- Final := Start + 10; // Character after <!NOTATION
- DER.Start := Start;
- Phase := phName;
- NotationDef := TNotationDef.Create;
- REPEAT
- IF NOT (Final^ IN CWhitespace) THEN
- CASE Final^ OF
- '>',
- #0 : BREAK;
- ELSE CASE Phase OF
- phName : BEGIN
- ExtractName (Final, CWhitespace + ['>'], F);
- SetStringSF (NotationDef.Name, Final, F);
- Final := F;
- Phase := phExtId;
- END;
- phExtId : BEGIN
- ExternalID := TExternalID.Create (Final);
- NotationDef.Value := ExternalID.SystemId;
- NotationDef.PublicId := ExternalID.PublicId;
- Final := ExternalId.Final;
- ExternalId.Free;
- Phase := phEnd;
- END;
- phEnd : ; // -!- There is an error in the document if this branch is called
- END;
- END;
- INC (Final);
- UNTIL FALSE;
- Notations.Add (NotationDef);
- Final := StrScanE (Final, '>');
-
- DER.ElementType := deNotation;
- DER.NotationDef := NotationDef;
- DER.Final := Final;
- DtdElementFound (DER);
-END;
-
-
-PROCEDURE TXmlParser.PushPE (VAR Start : PChar);
- (* If there is a parameter entity reference found in the data stream,
- the current position will be pushed to the entity stack.
- Start: IN Pointer to the '%' character starting the PE reference
- OUT Pointer to first character of PE replacement text *)
-VAR
- P : PChar;
- EntityDef : TEntityDef;
-BEGIN
- P := StrScan (Start, ';');
- IF P <> NIL THEN BEGIN
- EntityDef := TEntityDef (ParEntities.Node (StrSFPas (Start+1, P-1)));
- IF EntityDef <> NIL THEN BEGIN
- EntityStack.Push (P+1);
- Start := PChar (EntityDef.Value);
- END
- ELSE
- Start := P+1;
- END;
-END;
-
-
-PROCEDURE TXmlParser.ReplaceCharacterEntities (VAR Str : STRING);
- // Replaces all Character Entity References in the String
-VAR
- Start : INTEGER;
- PAmp : PChar;
- PSemi : PChar;
- PosAmp : INTEGER;
- Len : INTEGER; // Length of Entity Reference
-BEGIN
- IF Str = '' THEN EXIT;
- Start := 1;
- REPEAT
- PAmp := StrPos (PChar (Str) + Start-1, '&#');
- IF PAmp = NIL THEN BREAK;
- PSemi := StrScan (PAmp+2, ';');
- IF PSemi = NIL THEN BREAK;
- PosAmp := PAmp - PChar (Str) + 1;
- Len := PSemi-PAmp+1;
- IF CompareText (Str [PosAmp+2], 'x') = 0 // !!! Can't use "CHR" for Unicode characters > 255
- THEN Str [PosAmp] := CHR (StrToIntDef ('$'+Copy (Str, PosAmp+3, Len-4), 0))
- ELSE Str [PosAmp] := CHR (StrToIntDef (Copy (Str, PosAmp+2, Len-3), 32));
- Delete (Str, PosAmp+1, Len-1);
- Start := PosAmp + 1;
- UNTIL FALSE;
-END;
-
-
-PROCEDURE TXmlParser.ReplaceParameterEntities (VAR Str : STRING);
- // Recursively replaces all Parameter Entity References in the String
- PROCEDURE ReplaceEntities (VAR Str : STRING);
- VAR
- Start : INTEGER;
- PAmp : PChar;
- PSemi : PChar;
- PosAmp : INTEGER;
- Len : INTEGER;
- Entity : TEntityDef;
- Repl : STRING; // Replacement
- BEGIN
- IF Str = '' THEN EXIT;
- Start := 1;
- REPEAT
- PAmp := StrPos (PChar (Str)+Start-1, '%');
- IF PAmp = NIL THEN BREAK;
- PSemi := StrScan (PAmp+2, ';');
- IF PSemi = NIL THEN BREAK;
- PosAmp := PAmp - PChar (Str) + 1;
- Len := PSemi-PAmp+1;
- Entity := TEntityDef (ParEntities.Node (Copy (Str, PosAmp+1, Len-2)));
- IF Entity <> NIL THEN BEGIN
- Repl := Entity.Value;
- ReplaceEntities (Repl); // Recursion
- END
- ELSE
- Repl := Copy (Str, PosAmp, Len);
- Delete (Str, PosAmp, Len);
- Insert (Repl, Str, PosAmp);
- Start := PosAmp + Length (Repl);
- UNTIL FALSE;
- END;
-BEGIN
- ReplaceEntities (Str);
-END;
-
-
-PROCEDURE TXmlParser.ReplaceGeneralEntities (VAR Str : STRING);
- // Recursively replaces General Entity References in the String
- PROCEDURE ReplaceEntities (VAR Str : STRING);
- VAR
- Start : INTEGER;
- PAmp : PChar;
- PSemi : PChar;
- PosAmp : INTEGER;
- Len : INTEGER;
- EntityDef : TEntityDef;
- EntName : STRING;
- Repl : STRING; // Replacement
- ExternalEntity : TXmlParser;
- BEGIN
- IF Str = '' THEN EXIT;
- Start := 1;
- REPEAT
- PAmp := StrPos (PChar (Str)+Start-1, '&');
- IF PAmp = NIL THEN BREAK;
- PSemi := StrScan (PAmp+2, ';');
- IF PSemi = NIL THEN BREAK;
- PosAmp := PAmp - PChar (Str) + 1;
- Len := PSemi-PAmp+1;
- EntName := Copy (Str, PosAmp+1, Len-2);
- IF EntName = 'lt' THEN Repl := '<'
- ELSE IF EntName = 'gt' THEN Repl := '>'
- ELSE IF EntName = 'amp' THEN Repl := '&'
- ELSE IF EntName = 'apos' THEN Repl := ''''
- ELSE IF EntName = 'quot' THEN Repl := '"'
- ELSE BEGIN
- EntityDef := TEntityDef (Entities.Node (EntName));
- IF EntityDef <> NIL THEN BEGIN
- IF EntityDef.Value <> '' THEN // Internal Entity
- Repl := EntityDef.Value
- ELSE BEGIN // External Entity
- ExternalEntity := LoadExternalEntity (EntityDef.SystemId, EntityDef.PublicId, EntityDef.NotationName);
- Repl := StrPas (ExternalEntity.DocBuffer); // !!! What if it contains a Text Declaration?
- ExternalEntity.Free;
- END;
- ReplaceEntities (Repl); // Recursion
- END
- ELSE
- Repl := Copy (Str, PosAmp, Len);
- END;
- Delete (Str, PosAmp, Len);
- Insert (Repl, Str, PosAmp);
- Start := PosAmp + Length (Repl);
- UNTIL FALSE;
- END;
-BEGIN
- ReplaceEntities (Str);
-END;
-
-
-FUNCTION TXmlParser.LoadExternalEntity (SystemId, PublicId, Notation : STRING) : TXmlParser;
- // This will be called whenever there is a Parsed External Entity or
- // the DTD External Subset to be parsed.
- // It has to create a TXmlParser instance and load the desired Entity.
- // This instance of LoadExternalEntity assumes that "SystemId" is a valid
- // file name (relative to the Document source) and loads this file using
- // the LoadFromFile method.
-VAR
- Filename : STRING;
-BEGIN
- // --- Convert System ID to complete filename
- Filename := StringReplace (SystemId, '/', '\', [rfReplaceAll]);
- IF Copy (FSource, 1, 1) <> '<' THEN
- IF (Copy (Filename, 1, 2) = '\\') OR (Copy (Filename, 2, 1) = ':') THEN
- // Already has an absolute Path
- ELSE BEGIN
- Filename := ExtractFilePath (FSource) + Filename;
- END;
-
- // --- Load the File
- Result := TXmlParser.Create;
- Result.LoadFromFile (Filename);
-END;
-
-
-FUNCTION TXmlParser.TranslateEncoding (CONST Source : STRING) : STRING;
- // The member variable "CurEncoding" always holds the name of the current
- // encoding, e.g. 'UTF-8' or 'ISO-8859-1'.
- // This virtual method "TranslateEncoding" is responsible for translating
- // the content passed in the "Source" parameter to the Encoding which
- // is expected by the application.
- // This instance of "TranlateEncoding" assumes that the Application expects
- // Windows ANSI (Win1252) strings. It is able to transform UTF-8 or ISO-8859-1
- // encodings.
- // If you want your application to understand or create other encodings, you
- // override this function.
-BEGIN
- IF CurEncoding = 'UTF-8'
- THEN Result := Utf8ToAnsi (Source)
- ELSE Result := Source;
-END;
-
-
-PROCEDURE TXmlParser.DtdElementFound (DtdElementRec : TDtdElementRec);
- // This method is called for every element which is found in the DTD
- // declaration. The variant record TDtdElementRec is passed which
- // holds informations about the element.
- // You can override this function to handle DTD declarations.
- // Note that when you parse the same Document instance a second time,
- // the DTD will not get parsed again.
-BEGIN
-END;
-
-
-FUNCTION TXmlParser.GetDocBuffer: PChar;
- // Returns FBuffer or a pointer to a NUL char if Buffer is empty
-BEGIN
- IF FBuffer = NIL
- THEN Result := #0
- ELSE Result := FBuffer;
-END;
-
-
-(*$IFNDEF HAS_CONTNRS_UNIT
-===============================================================================================
-TObjectList
-===============================================================================================
-*)
-
-DESTRUCTOR TObjectList.Destroy;
-BEGIN
- Clear;
- SetCapacity(0);
- INHERITED Destroy;
-END;
-
-
-PROCEDURE TObjectList.Delete (Index : INTEGER);
-BEGIN
- IF (Index < 0) OR (Index >= Count) THEN EXIT;
- TObject (Items [Index]).Free;
- INHERITED Delete (Index);
-END;
-
-
-PROCEDURE TObjectList.Clear;
-BEGIN
- WHILE Count > 0 DO
- Delete (Count-1);
-END;
-
-(*$ENDIF *)
-
-(*
-===============================================================================================
-TNvpNode
---------
-Node base class for the TNvpList
-===============================================================================================
-*)
-
-CONSTRUCTOR TNvpNode.Create (TheName, TheValue : STRING);
-BEGIN
- INHERITED Create;
- Name := TheName;
- Value := TheValue;
-END;
-
-
-(*
-===============================================================================================
-TNvpList
---------
-A generic List of Name-Value Pairs, based on the TObjectList introduced in Delphi 5
-===============================================================================================
-*)
-
-PROCEDURE TNvpList.Add (Node : TNvpNode);
-VAR
- I : INTEGER;
-BEGIN
- FOR I := Count-1 DOWNTO 0 DO
- IF Node.Name > TNvpNode (Items [I]).Name THEN BEGIN
- Insert (I+1, Node);
- EXIT;
- END;
- Insert (0, Node);
-END;
-
-
-
-FUNCTION TNvpList.Node (Name : STRING) : TNvpNode;
- // Binary search for Node
-VAR
- L, H : INTEGER; // Low, High Limit
- T, C : INTEGER; // Test Index, Comparison result
- Last : INTEGER; // Last Test Index
-BEGIN
- IF Count=0 THEN BEGIN
- Result := NIL;
- EXIT;
- END;
-
- L := 0;
- H := Count;
- Last := -1;
- REPEAT
- T := (L+H) DIV 2;
- IF T=Last THEN BREAK;
- Result := TNvpNode (Items [T]);
- C := CompareStr (Result.Name, Name);
- IF C = 0 THEN EXIT
- ELSE IF C < 0 THEN L := T
- ELSE H := T;
- Last := T;
- UNTIL FALSE;
- Result := NIL;
-END;
-
-
-FUNCTION TNvpList.Node (Index : INTEGER) : TNvpNode;
-BEGIN
- IF (Index < 0) OR (Index >= Count)
- THEN Result := NIL
- ELSE Result := TNvpNode (Items [Index]);
-END;
-
-
-FUNCTION TNvpList.Value (Name : STRING) : STRING;
-VAR
- Nvp : TNvpNode;
-BEGIN
- Nvp := TNvpNode (Node (Name));
- IF Nvp <> NIL
- THEN Result := Nvp.Value
- ELSE Result := '';
-END;
-
-
-FUNCTION TNvpList.Value (Index : INTEGER) : STRING;
-BEGIN
- IF (Index < 0) OR (Index >= Count)
- THEN Result := ''
- ELSE Result := TNvpNode (Items [Index]).Value;
-END;
-
-
-FUNCTION TNvpList.Name (Index : INTEGER) : STRING;
-BEGIN
- IF (Index < 0) OR (Index >= Count)
- THEN Result := ''
- ELSE Result := TNvpNode (Items [Index]).Name;
-END;
-
-
-(*
-===============================================================================================
-TAttrList
-List of Attributes. The "Analyze" method extracts the Attributes from the given Buffer.
-Is used for extraction of Attributes in Start-Tags, Empty-Element Tags and the "pseudo"
-attributes in XML Prologs, Text Declarations and PIs.
-===============================================================================================
-*)
-
-PROCEDURE TAttrList.Analyze (Start : PChar; VAR Final : PChar);
- // Analyze the Buffer for Attribute=Name pairs.
- // Terminates when there is a character which is not IN CNameStart
- // (e.g. '?>' or '>' or '/>')
-TYPE
- TPhase = (phName, phEq, phValue);
-VAR
- Phase : TPhase;
- F : PChar;
- Name : STRING;
- Value : STRING;
- Attr : TAttr;
-BEGIN
- Clear;
- Phase := phName;
- Final := Start;
- REPEAT
- IF (Final^ = #0) OR (Final^ = '>') THEN BREAK;
- IF NOT (Final^ IN CWhitespace) THEN
- CASE Phase OF
- phName : BEGIN
- IF NOT (Final^ IN CNameStart) THEN EXIT;
- ExtractName (Final, CWhitespace + ['=', '/'], F);
- SetStringSF (Name, Final, F);
- Final := F;
- Phase := phEq;
- END;
- phEq : BEGIN
- IF Final^ = '=' THEN
- Phase := phValue
- END;
- phValue : BEGIN
- IF Final^ IN CQuoteChar THEN BEGIN
- ExtractQuote (Final, Value, F);
- Attr := TAttr.Create;
- Attr.Name := Name;
- Attr.Value := Value;
- Attr.ValueType := vtNormal;
- Add (Attr);
- Final := F;
- Phase := phName;
- END;
- END;
- END;
- INC (Final);
- UNTIL FALSE;
-END;
-
-
-(*
-===============================================================================================
-TElemList
-List of TElemDef nodes.
-===============================================================================================
-*)
-
-FUNCTION TElemList.Node (Name : STRING) : TElemDef;
- // Binary search for the Node with the given Name
-VAR
- L, H : INTEGER; // Low, High Limit
- T, C : INTEGER; // Test Index, Comparison result
- Last : INTEGER; // Last Test Index
-BEGIN
- IF Count=0 THEN BEGIN
- Result := NIL;
- EXIT;
- END;
-
- L := 0;
- H := Count;
- Last := -1;
- REPEAT
- T := (L+H) DIV 2;
- IF T=Last THEN BREAK;
- Result := TElemDef (Items [T]);
- C := CompareStr (Result.Name, Name);
- IF C = 0 THEN EXIT
- ELSE IF C < 0 THEN L := T
- ELSE H := T;
- Last := T;
- UNTIL FALSE;
- Result := NIL;
-END;
-
-
-PROCEDURE TElemList.Add (Node : TElemDef);
-VAR
- I : INTEGER;
-BEGIN
- FOR I := Count-1 DOWNTO 0 DO
- IF Node.Name > TElemDef (Items [I]).Name THEN BEGIN
- Insert (I+1, Node);
- EXIT;
- END;
- Insert (0, Node);
-END;
-
-
-(*
-===============================================================================================
-TScannerXmlParser
-A TXmlParser descendant for the TCustomXmlScanner component
-===============================================================================================
-*)
-
-TYPE
- TScannerXmlParser = CLASS (TXmlParser)
- Scanner : TCustomXmlScanner;
- CONSTRUCTOR Create (TheScanner : TCustomXmlScanner);
- FUNCTION LoadExternalEntity (SystemId, PublicId,
- Notation : STRING) : TXmlParser; OVERRIDE;
- FUNCTION TranslateEncoding (CONST Source : STRING) : STRING; OVERRIDE;
- PROCEDURE DtdElementFound (DtdElementRec : TDtdElementRec); OVERRIDE;
- END;
-
-CONSTRUCTOR TScannerXmlParser.Create (TheScanner : TCustomXmlScanner);
-BEGIN
- INHERITED Create;
- Scanner := TheScanner;
-END;
-
-
-FUNCTION TScannerXmlParser.LoadExternalEntity (SystemId, PublicId, Notation : STRING) : TXmlParser;
-BEGIN
- IF Assigned (Scanner.FOnLoadExternal)
- THEN Scanner.FOnLoadExternal (Scanner, SystemId, PublicId, Notation, Result)
- ELSE Result := INHERITED LoadExternalEntity (SystemId, PublicId, Notation);
-END;
-
-
-FUNCTION TScannerXmlParser.TranslateEncoding (CONST Source : STRING) : STRING;
-BEGIN
- IF Assigned (Scanner.FOnTranslateEncoding)
- THEN Result := Scanner.FOnTranslateEncoding (Scanner, CurEncoding, Source)
- ELSE Result := INHERITED TranslateEncoding (Source);
-END;
-
-
-PROCEDURE TScannerXmlParser.DtdElementFound (DtdElementRec : TDtdElementRec);
-BEGIN
- WITH DtdElementRec DO
- CASE ElementType OF
- deElement : Scanner.WhenElement (ElemDef);
- deAttList : Scanner.WhenAttList (ElemDef);
- deEntity : Scanner.WhenEntity (EntityDef);
- deNotation : Scanner.WhenNotation (NotationDef);
- dePI : Scanner.WhenPI (STRING (Target), STRING (Content), AttrList);
- deComment : Scanner.WhenComment (StrSFPas (Start, Final));
- deError : Scanner.WhenDtdError (Pos);
- END;
-END;
-
-
-(*
-===============================================================================================
-TCustomXmlScanner
-===============================================================================================
-*)
-
-CONSTRUCTOR TCustomXmlScanner.Create (AOwner: TComponent);
-BEGIN
- INHERITED;
- FXmlParser := TScannerXmlParser.Create (Self);
-END;
-
-
-DESTRUCTOR TCustomXmlScanner.Destroy;
-BEGIN
- FXmlParser.Free;
- INHERITED;
-END;
-
-
-PROCEDURE TCustomXmlScanner.LoadFromFile (Filename : TFilename);
- // Load XML Document from file
-BEGIN
- FXmlParser.LoadFromFile (Filename);
-END;
-
-
-PROCEDURE TCustomXmlScanner.LoadFromBuffer (Buffer : PChar);
- // Load XML Document from buffer
-BEGIN
- FXmlParser.LoadFromBuffer (Buffer);
-END;
-
-
-PROCEDURE TCustomXmlScanner.SetBuffer (Buffer : PChar);
- // Refer to Buffer
-BEGIN
- FXmlParser.SetBuffer (Buffer);
-END;
-
-
-FUNCTION TCustomXmlScanner.GetFilename : TFilename;
-BEGIN
- Result := FXmlParser.Source;
-END;
-
-
-FUNCTION TCustomXmlScanner.GetNormalize : BOOLEAN;
-BEGIN
- Result := FXmlParser.Normalize;
-END;
-
-
-PROCEDURE TCustomXmlScanner.SetNormalize (Value : BOOLEAN);
-BEGIN
- FXmlParser.Normalize := Value;
-END;
-
-
-PROCEDURE TCustomXmlScanner.WhenXmlProlog(XmlVersion, Encoding: STRING; Standalone : BOOLEAN);
- // Is called when the parser has parsed the <? xml ?> declaration of the prolog
-BEGIN
- IF Assigned (FOnXmlProlog) THEN FOnXmlProlog (Self, XmlVersion, Encoding, Standalone);
-END;
-
-
-PROCEDURE TCustomXmlScanner.WhenComment (Comment : STRING);
- // Is called when the parser has parsed a <!-- comment -->
-BEGIN
- IF Assigned (FOnComment) THEN FOnComment (Self, Comment);
-END;
-
-
-PROCEDURE TCustomXmlScanner.WhenPI (Target, Content: STRING; Attributes : TAttrList);
- // Is called when the parser has parsed a <?processing instruction ?>
-BEGIN
- IF Assigned (FOnPI) THEN FOnPI (Self, Target, Content, Attributes);
-END;
-
-
-PROCEDURE TCustomXmlScanner.WhenDtdRead (RootElementName : STRING);
- // Is called when the parser has completely parsed the DTD
-BEGIN
- IF Assigned (FOnDtdRead) THEN FOnDtdRead (Self, RootElementName);
-END;
-
-
-PROCEDURE TCustomXmlScanner.WhenStartTag (TagName : STRING; Attributes : TAttrList);
- // Is called when the parser has parsed a start tag like <p>
-BEGIN
- IF Assigned (FOnStartTag) THEN FOnStartTag (Self, TagName, Attributes);
-END;
-
-
-PROCEDURE TCustomXmlScanner.WhenEmptyTag (TagName : STRING; Attributes : TAttrList);
- // Is called when the parser has parsed an Empty Element Tag like <br/>
-BEGIN
- IF Assigned (FOnEmptyTag) THEN FOnEmptyTag (Self, TagName, Attributes);
-END;
-
-
-PROCEDURE TCustomXmlScanner.WhenEndTag (TagName : STRING);
- // Is called when the parser has parsed an End Tag like </p>
-BEGIN
- IF Assigned (FOnEndTag) THEN FOnEndTag (Self, TagName);
-END;
-
-
-PROCEDURE TCustomXmlScanner.WhenContent (Content : STRING);
- // Is called when the parser has parsed an element's text content
-BEGIN
- IF Assigned (FOnContent) THEN FOnContent (Self, Content);
-END;
-
-
-PROCEDURE TCustomXmlScanner.WhenCData (Content : STRING);
- // Is called when the parser has parsed a CDATA section
-BEGIN
- IF Assigned (FOnCData) THEN FOnCData (Self, Content);
-END;
-
-
-PROCEDURE TCustomXmlScanner.WhenElement (ElemDef : TElemDef);
- // Is called when the parser has parsed an <!ELEMENT> definition
- // inside the DTD
-BEGIN
- IF Assigned (FOnElement) THEN FOnElement (Self, ElemDef);
-END;
-
-
-PROCEDURE TCustomXmlScanner.WhenAttList (ElemDef : TElemDef);
- // Is called when the parser has parsed an <!ATTLIST> definition
- // inside the DTD
-BEGIN
- IF Assigned (FOnAttList) THEN FOnAttList (Self, ElemDef);
-END;
-
-
-PROCEDURE TCustomXmlScanner.WhenEntity (EntityDef : TEntityDef);
- // Is called when the parser has parsed an <!ENTITY> definition
- // inside the DTD
-BEGIN
- IF Assigned (FOnEntity) THEN FOnEntity (Self, EntityDef);
-END;
-
-
-PROCEDURE TCustomXmlScanner.WhenNotation (NotationDef : TNotationDef);
- // Is called when the parser has parsed a <!NOTATION> definition
- // inside the DTD
-BEGIN
- IF Assigned (FOnNotation) THEN FOnNotation (Self, NotationDef);
-END;
-
-
-PROCEDURE TCustomXmlScanner.WhenDtdError (ErrorPos : PChar);
- // Is called when the parser has found an Error in the DTD
-BEGIN
- IF Assigned (FOnDtdError) THEN FOnDtdError (Self, ErrorPos);
-END;
-
-
-PROCEDURE TCustomXmlScanner.Execute;
- // Perform scanning
- // Scanning is done synchronously, i.e. you can expect events to be triggered
- // in the order of the XML data stream. Execute will finish when the whole XML
- // document has been scanned or when the StopParser property has been set to TRUE.
-BEGIN
- FStopParser := FALSE;
- FXmlParser.StartScan;
- WHILE FXmlParser.Scan AND (NOT FStopParser) DO
- CASE FXmlParser.CurPartType OF
- ptNone : ;
- ptXmlProlog : WhenXmlProlog (FXmlParser.XmlVersion, FXmlParser.Encoding, FXmlParser.Standalone);
- ptComment : WhenComment (StrSFPas (FXmlParser.CurStart, FXmlParser.CurFinal));
- ptPI : WhenPI (FXmlParser.CurName, FXmlParser.CurContent, FXmlParser.CurAttr);
- ptDtdc : WhenDtdRead (FXmlParser.RootName);
- ptStartTag : WhenStartTag (FXmlParser.CurName, FXmlParser.CurAttr);
- ptEmptyTag : WhenEmptyTag (FXmlParser.CurName, FXmlParser.CurAttr);
- ptEndTag : WhenEndTag (FXmlParser.CurName);
- ptContent : WhenContent (FXmlParser.CurContent);
- ptCData : WhenCData (FXmlParser.CurContent);
- END;
-END;
-
-
-END.
+(** +=============================================================================================== +Name : LibXmlParser +=============================================================================================== +Project : All Projects +=============================================================================================== +Subject : Progressive XML Parser for all types of XML Files +=============================================================================================== +Author : Stefan Heymann + Eschenweg 3 + 72076 Tübingen + GERMANY + +E-Mail: stefan@destructor.de +URL: www.destructor.de +=============================================================================================== +Source, Legals ("Licence") +-------------------------- +The official site to get this parser is http://www.destructor.de/ + +Usage and Distribution of this Source Code is ruled by the +"Destructor.de Source code Licence" (DSL) which comes with this file or +can be downloaded at http://www.destructor.de/ + +IN SHORT: Usage and distribution of this source code is free. + You use it completely on your own risk. + +Postcardware +------------ +If you like this code, please send a postcard of your city to my above address. +=============================================================================================== +!!! All parts of this code which are not finished or not conforming exactly to + the XmlSpec are marked with three exclamation marks + +-!- Parts where the parser may be able to detect errors in the document's syntax are + marked with the dash-exlamation mark-dash sequence. +=============================================================================================== +Terminology: +------------ +- Start: Start of a buffer part +- Final: End (last character) of a buffer part +- DTD: Document Type Definition +- DTDc: Document Type Declaration +- XMLSpec: The current W3C XML Recommendation (version 1.0 as of 1998-02-10), Chapter No. +- Cur*: Fields concerning the "Current" part passed back by the "Scan" method +=============================================================================================== +Scanning the XML document +------------------------- +- Create TXmlParser Instance MyXml := TXmlParser.Create; +- Load XML Document MyXml.LoadFromFile (Filename); +- Start Scanning MyXml.StartScan; +- Scan Loop WHILE MyXml.Scan DO +- Test for Part Type CASE MyXml.CurPartType OF +- Handle Parts ... : ;;; +- Handle Parts ... : ;;; +- Handle Parts ... : ;;; + END; +- Destroy MyXml.Free; +=============================================================================================== +Loading the XML document +------------------------ +You can load the XML document from a file with the "LoadFromFile" method. +It is beyond the scope of this parser to perform HTTP or FTP accesses. If you want your +application to handle such requests (URLs), you can load the XML via HTTP or FTP or whatever +protocol and hand over the data buffer using the "LoadFromBuffer" or "SetBuffer" method. +"LoadFromBuffer" loads the internal buffer of TXmlParser with the given null-terminated +string, thereby creating a copy of that buffer. +"SetBuffer" just takes the pointer to another buffer, which means that the given +buffer pointer must be valid while the document is accessed via TXmlParser. +=============================================================================================== +Encodings: +---------- +This XML parser kind of "understands" the following encodings: +- UTF-8 +- ISO-8859-1 +- Windows-1252 + +Any flavor of multi-byte characters (and this includes UTF-16) is not supported. Sorry. + +Every string which has to be passed to the application passes the virtual method +"TranslateEncoding" which translates the string from the current encoding (stored in +"CurEncoding") into the encoding the application wishes to receive. +The "TranslateEncoding" method that is built into TXmlParser assumes that the application +wants to receive Windows ANSI (Windows-1252, about the same as ISO-8859-1) and is able +to convert UTF-8 and ISO-8859-1 encodings. +For other source and target encodings, you will have to override "TranslateEncoding". +=============================================================================================== +Buffer Handling +--------------- +- The document must be loaded completely into a piece of RAM +- All character positions are referenced by PChar pointers +- The TXmlParser instance can either "own" the buffer itself (then, FBufferSize is > 0) + or reference the buffer of another instance or object (then, FBuffersize is 0 and + FBuffer is not NIL) +- The Property DocBuffer passes back a pointer to the first byte of the document. If there + is no document stored (FBuffer is NIL), the DocBuffer returns a pointer to a NULL character. +=============================================================================================== +Whitespace Handling +------------------- +The TXmlParser property "PackSpaces" determines how Whitespace is returned in Text Content: +While PackSpaces is true, all leading and trailing whitespace characters are trimmed of, all +Whitespace is converted to Space #x20 characters and contiguous Whitespace characters are +compressed to one. +If the "Scan" method reports a ptContent part, the application can get the original text +with all whitespace characters by extracting the characters from "CurStart" to "CurFinal". +If the application detects an xml:space attribute, it can set "PackSpaces" accordingly or +use CurStart/CurFinal. +Please note that TXmlParser does _not_ normalize Line Breaks to single LineFeed characters +as the XmlSpec requires (XmlSpec 2.11). +The xml:space attribute is not handled by TXmlParser. This is on behalf of the application. +=============================================================================================== +Non-XML-Conforming +------------------ +TXmlParser does not conform 100 % exactly to the XmlSpec: +- UTF-16 is not supported (XmlSpec 2.2) + (Workaround: Convert UTF-16 to UTF-8 and hand the buffer over to TXmlParser) +- As the parser only works with single byte strings, all Unicode characters > 255 + can currently not be handled correctly. +- Line breaks are not normalized to single Linefeed #x0A characters (XmlSpec 2.11) + (Workaround: The Application can access the text contents on its own [CurStart, CurFinal], + thereby applying every normalization it wishes to) +- The attribute value normalization does not work exactly as defined in the + Second Edition of the XML 1.0 specification. +- See also the code parts marked with three consecutive exclamation marks. These are + parts which are not finished in the current code release. + +This list may be incomplete, so it may grow if I get to know any other points. +As work on the parser proceeds, this list may also shrink. +=============================================================================================== +Things Todo +----------- +- Introduce a new event/callback which is called when there is an unresolvable + entity or character reference +- Support Unicode +- Use Streams instead of reading the whole XML into memory +=============================================================================================== +Change History, Version numbers +------------------------------- +The Date is given in ISO Year-Month-Day (YYYY-MM-DD) order. +Versions are counted from 1.0.0 beginning with the version from 2000-03-16. +Unreleased versions don't get a version number. + +Date Author Version Changes +----------------------------------------------------------------------------------------------- +2000-03-16 HeySt 1.0.0 Start +2000-03-28 HeySt 1.0.1 Initial Publishing of TXmlParser on the destructor.de Web Site +2000-03-30 HeySt 1.0.2 TXmlParser.AnalyzeCData: Call "TranslateEncoding" for CurContent +2000-03-31 HeySt 1.0.3 Deleted the StrPosE function (was not needed anyway) +2000-04-04 HeySt 1.0.4 TDtdElementRec modified: Start/Final for all Elements; + Should be backwards compatible. + AnalyzeDtdc: Set CurPartType to ptDtdc +2000-04-23 HeySt 1.0.5 New class TObjectList. Eliminated reference to the Delphi 5 + "Contnrs" unit so LibXmlParser is Delphi 4 compatible. +2000-07-03 HeySt 1.0.6 TNvpNode: Added Constructor +2000-07-11 HeySt 1.0.7 Removed "Windows" from USES clause + Added three-exclamation-mark comments for Utf8ToAnsi/AnsiToUtf8 + Added three-exclamation-mark comments for CHR function calls +2000-07-23 HeySt 1.0.8 TXmlParser.Clear: CurAttr.Clear; EntityStack.Clear; + (This was not a bug; just defensive programming) +2000-07-29 HeySt 1.0.9 TNvpList: Added methods: Node(Index), Value(Index), Name(Index); +2000-10-07 HeySt Introduced Conditional Defines + Uses Contnrs unit and its TObjectList class again for + Delphi 5 and newer versions +2001-01-30 HeySt Introduced Version Numbering + Made LoadFromFile and LoadFromBuffer BOOLEAN functions + Introduced FileMode parameter for LoadFromFile + BugFix: TAttrList.Analyze: Must add CWhitespace to ExtractName call + Comments worked over +2001-02-28 HeySt 1.0.10 Completely worked over and tested the UTF-8 functions + Fixed a bug in TXmlParser.Scan which caused it to start over when it + was called after the end of scanning, resulting in an endless loop + TEntityStack is now a TObjectList instead of TList +2001-07-03 HeySt 1.0.11 Updated Compiler Version IFDEFs for Kylix +2001-07-11 HeySt 1.0.12 New TCustomXmlScanner component (taken over from LibXmlComps.pas) +2001-07-14 HeySt 1.0.13 Bugfix TCustomXmlScanner.FOnTranslateEncoding +2001-10-22 HeySt Don't clear CurName anymore when the parser finds a CDATA section. +2001-12-03 HeySt 1.0.14 TObjectList.Clear: Make call to INHERITED method (fixes a memory leak) +2001-12-05 HeySt 1.0.15 TObjectList.Clear: removed call to INHERITED method + TObjectList.Destroy: Inserted SetCapacity call. + Reduces need for frequent re-allocation of pointer buffer + Dedicated to my father, Theodor Heymann +2002-06-26 HeySt 1.0.16 TXmlParser.Scan: Fixed a bug with PIs whose name is beginning + with 'xml'. Thanks to Uwe Kamm for submitting this bug. + The CurEncoding property is now always in uppercase letters (the XML + spec wants it to be treated case independently so when it's uppercase + comparisons are faster) +2002-03-04 HeySt 1.0.17 Included an IFDEF for Delphi 7 (VER150) and Kylix + There is a new symbol HAS_CONTNRS_UNIT which is used now to + distinguish between IDEs which come with the Contnrs unit and + those that don't. +*) + +UNIT libxmlparser; + +{$I jedi-sdl.inc} + +INTERFACE + +USES + SysUtils, Classes, + (*$IFDEF HAS_CONTNRS_UNIT *) // The Contnrs Unit was introduced in Delphi 5 + Contnrs, + (*$ENDIF*) + Math; + +CONST + CVersion = '1.0.17'; // This variable will be updated for every release + // (I hope, I won't forget to do it everytime ...) + +TYPE + TPartType = // --- Document Part Types + (ptNone, // Nothing + ptXmlProlog, // XML Prolog XmlSpec 2.8 / 4.3.1 + ptComment, // Comment XmlSpec 2.5 + ptPI, // Processing Instruction XmlSpec 2.6 + ptDtdc, // Document Type Declaration XmlSpec 2.8 + ptStartTag, // Start Tag XmlSpec 3.1 + ptEmptyTag, // Empty-Element Tag XmlSpec 3.1 + ptEndTag, // End Tag XmlSpec 3.1 + ptContent, // Text Content between Tags + ptCData); // CDATA Section XmlSpec 2.7 + + TDtdElemType = // --- DTD Elements + (deElement, // !ELEMENT declaration + deAttList, // !ATTLIST declaration + deEntity, // !ENTITY declaration + deNotation, // !NOTATION declaration + dePI, // PI in DTD + deComment, // Comment in DTD + deError); // Error found in the DTD + +TYPE + TAttrList = CLASS; + TEntityStack = CLASS; + TNvpList = CLASS; + TElemDef = CLASS; + TElemList = CLASS; + TEntityDef = CLASS; + TNotationDef = CLASS; + + TDtdElementRec = RECORD // --- This Record is returned by the DTD parser callback function + Start, Final : PChar; // Start/End of the Element's Declaration + CASE ElementType : TDtdElemType OF // Type of the Element + deElement, // <!ELEMENT> + deAttList : (ElemDef : TElemDef); // <!ATTLIST> + deEntity : (EntityDef : TEntityDef); // <!ENTITY> + deNotation : (NotationDef : TNotationDef); // <!NOTATION> + dePI : (Target : PChar; // <?PI ?> + Content : PChar; + AttrList : TAttrList); + deError : (Pos : PChar); // Error + // deComment : ((No additional fields here)); // <!-- Comment --> + END; + + TXmlParser = CLASS // --- Internal Properties and Methods + PROTECTED + FBuffer : PChar; // NIL if there is no buffer available + FBufferSize : INTEGER; // 0 if the buffer is not owned by the Document instance + FSource : STRING; // Name of Source of document. Filename for Documents loaded with LoadFromFile + + FXmlVersion : STRING; // XML version from Document header. Default is '1.0' + FEncoding : STRING; // Encoding from Document header. Default is 'UTF-8' + FStandalone : BOOLEAN; // Standalone declaration from Document header. Default is 'yes' + FRootName : STRING; // Name of the Root Element (= DTD name) + FDtdcFinal : PChar; // Pointer to the '>' character terminating the DTD declaration + + FNormalize : BOOLEAN; // If true: Pack Whitespace and don't return empty contents + EntityStack : TEntityStack; // Entity Stack for Parameter and General Entities + FCurEncoding : STRING; // Current Encoding during parsing (always uppercase) + + PROCEDURE AnalyzeProlog; // Analyze XML Prolog or Text Declaration + PROCEDURE AnalyzeComment (Start : PChar; VAR Final : PChar); // Analyze Comments + PROCEDURE AnalyzePI (Start : PChar; VAR Final : PChar); // Analyze Processing Instructions (PI) + PROCEDURE AnalyzeDtdc; // Analyze Document Type Declaration + PROCEDURE AnalyzeDtdElements (Start : PChar; VAR Final : PChar); // Analyze DTD declarations + PROCEDURE AnalyzeTag; // Analyze Start/End/Empty-Element Tags + PROCEDURE AnalyzeCData; // Analyze CDATA Sections + PROCEDURE AnalyzeText (VAR IsDone : BOOLEAN); // Analyze Text Content between Tags + PROCEDURE AnalyzeElementDecl (Start : PChar; VAR Final : PChar); + PROCEDURE AnalyzeAttListDecl (Start : PChar; VAR Final : PChar); + PROCEDURE AnalyzeEntityDecl (Start : PChar; VAR Final : PChar); + PROCEDURE AnalyzeNotationDecl (Start : PChar; VAR Final : PChar); + + PROCEDURE PushPE (VAR Start : PChar); + PROCEDURE ReplaceCharacterEntities (VAR Str : STRING); + PROCEDURE ReplaceParameterEntities (VAR Str : STRING); + PROCEDURE ReplaceGeneralEntities (VAR Str : STRING); + + FUNCTION GetDocBuffer : PChar; // Returns FBuffer or a pointer to a NUL char if Buffer is empty + + PUBLIC // --- Document Properties + PROPERTY XmlVersion : STRING READ FXmlVersion; // XML version from the Document Prolog + PROPERTY Encoding : STRING READ FEncoding; // Document Encoding from Prolog + PROPERTY Standalone : BOOLEAN READ FStandalone; // Standalone Declaration from Prolog + PROPERTY RootName : STRING READ FRootName; // Name of the Root Element + PROPERTY Normalize : BOOLEAN READ FNormalize WRITE FNormalize; // True if Content is to be normalized + PROPERTY Source : STRING READ FSource; // Name of Document Source (Filename) + PROPERTY DocBuffer : PChar READ GetDocBuffer; // Returns document buffer + PUBLIC // --- DTD Objects + Elements : TElemList; // Elements: List of TElemDef (contains Attribute Definitions) + Entities : TNvpList; // General Entities: List of TEntityDef + ParEntities : TNvpList; // Parameter Entities: List of TEntityDef + Notations : TNvpList; // Notations: List of TNotationDef + PUBLIC + CONSTRUCTOR Create; + DESTRUCTOR Destroy; OVERRIDE; + + // --- Document Handling + FUNCTION LoadFromFile (Filename : STRING; + FileMode : INTEGER = fmOpenRead OR fmShareDenyNone) : BOOLEAN; + // Loads Document from given file + FUNCTION LoadFromBuffer (Buffer : PChar) : BOOLEAN; // Loads Document from another buffer + PROCEDURE SetBuffer (Buffer : PChar); // References another buffer + PROCEDURE Clear; // Clear Document + + PUBLIC + // --- Scanning through the document + CurPartType : TPartType; // Current Type + CurName : STRING; // Current Name + CurContent : STRING; // Current Normalized Content + CurStart : PChar; // Current First character + CurFinal : PChar; // Current Last character + CurAttr : TAttrList; // Current Attribute List + PROPERTY CurEncoding : STRING READ FCurEncoding; // Current Encoding + PROCEDURE StartScan; + FUNCTION Scan : BOOLEAN; + + // --- Events / Callbacks + FUNCTION LoadExternalEntity (SystemId, PublicId, + Notation : STRING) : TXmlParser; VIRTUAL; + FUNCTION TranslateEncoding (CONST Source : STRING) : STRING; VIRTUAL; + PROCEDURE DtdElementFound (DtdElementRec : TDtdElementRec); VIRTUAL; + END; + + TValueType = // --- Attribute Value Type + (vtNormal, // Normal specified Attribute + vtImplied, // #IMPLIED attribute value + vtFixed, // #FIXED attribute value + vtDefault); // Attribute value from default value in !ATTLIST declaration + + TAttrDefault = // --- Attribute Default Type + (adDefault, // Normal default value + adRequired, // #REQUIRED attribute + adImplied, // #IMPLIED attribute + adFixed); // #FIXED attribute + + TAttrType = // --- Type of attribute + (atUnknown, // Unknown type + atCData, // Character data only + atID, // ID + atIdRef, // ID Reference + atIdRefs, // Several ID References, separated by Whitespace + atEntity, // Name of an unparsed Entity + atEntities, // Several unparsed Entity names, separated by Whitespace + atNmToken, // Name Token + atNmTokens, // Several Name Tokens, separated by Whitespace + atNotation, // A selection of Notation names (Unparsed Entity) + atEnumeration); // Enumeration + + TElemType = // --- Element content type + (etEmpty, // Element is always empty + etAny, // Element can have any mixture of PCDATA and any elements + etChildren, // Element must contain only elements + etMixed); // Mixed PCDATA and elements + + (*$IFDEF HAS_CONTNRS_UNIT *) + TObjectList = Contnrs.TObjectList; // Re-Export this identifier + (*$ELSE *) + TObjectList = CLASS (TList) + DESTRUCTOR Destroy; OVERRIDE; + PROCEDURE Delete (Index : INTEGER); + PROCEDURE Clear; OVERRIDE; + END; + (*$ENDIF *) + + TNvpNode = CLASS // Name-Value Pair Node + Name : STRING; + Value : STRING; + CONSTRUCTOR Create (TheName : STRING = ''; TheValue : STRING = ''); + END; + + TNvpList = CLASS (TObjectList) // Name-Value Pair List + PROCEDURE Add (Node : TNvpNode); + FUNCTION Node (Name : STRING) : TNvpNode; OVERLOAD; + FUNCTION Node (Index : INTEGER) : TNvpNode; OVERLOAD; + FUNCTION Value (Name : STRING) : STRING; OVERLOAD; + FUNCTION Value (Index : INTEGER) : STRING; OVERLOAD; + FUNCTION Name (Index : INTEGER) : STRING; + END; + + TAttr = CLASS (TNvpNode) // Attribute of a Start-Tag or Empty-Element-Tag + ValueType : TValueType; + AttrType : TAttrType; + END; + + TAttrList = CLASS (TNvpList) // List of Attributes + PROCEDURE Analyze (Start : PChar; VAR Final : PChar); + END; + + TEntityStack = CLASS (TObjectList) // Stack where current position is stored before parsing entities + PROTECTED + Owner : TXmlParser; + PUBLIC + CONSTRUCTOR Create (TheOwner : TXmlParser); + PROCEDURE Push (LastPos : PChar); OVERLOAD; + PROCEDURE Push (Instance : TObject; LastPos : PChar); OVERLOAD; + FUNCTION Pop : PChar; // Returns next char or NIL if EOF is reached. Frees Instance. + END; + + TAttrDef = CLASS (TNvpNode) // Represents a <!ATTLIST Definition. "Value" is the default value + TypeDef : STRING; // Type definition from the DTD + Notations : STRING; // Notation List, separated by pipe symbols '|' + AttrType : TAttrType; // Attribute Type + DefaultType : TAttrDefault; // Default Type + END; + + TElemDef = CLASS (TNvpList) // Represents a <!ELEMENT Definition. Is a list of TAttrDef-Nodes + Name : STRING; // Element name + ElemType : TElemType; // Element type + Definition : STRING; // Element definition from DTD + END; + + TElemList = CLASS (TObjectList) // List of TElemDef nodes + FUNCTION Node (Name : STRING) : TElemDef; + PROCEDURE Add (Node : TElemDef); + END; + + TEntityDef = CLASS (TNvpNode) // Represents a <!ENTITY Definition. + SystemId : STRING; + PublicId : STRING; + NotationName : STRING; + END; + + TNotationDef = CLASS (TNvpNode) // Represents a <!NOTATION Definition. Value is the System ID + PublicId : STRING; + END; + + TCharset = SET OF CHAR; + + +CONST + CWhitespace = [#32, #9, #13, #10]; // Whitespace characters (XmlSpec 2.3) + CLetter = [#$41..#$5A, #$61..#$7A, #$C0..#$D6, #$D8..#$F6, #$F8..#$FF]; + CDigit = [#$30..#$39]; + CNameChar = CLetter + CDigit + ['.', '-', '_', ':', #$B7]; + CNameStart = CLetter + ['_', ':']; + CQuoteChar = ['"', '''']; + CPubidChar = [#32, ^M, ^J, #9, 'a'..'z', 'A'..'Z', '0'..'9', + '-', '''', '(', ')', '+', ',', '.', '/', ':', + '=', '?', ';', '!', '*', '#', '@', '$', '_', '%']; + + CDStart = '<![CDATA['; + CDEnd = ']]>'; + + // --- Name Constants for the above enumeration types + CPartType_Name : ARRAY [TPartType] OF STRING = + ('', 'XML Prolog', 'Comment', 'PI', + 'DTD Declaration', 'Start Tag', 'Empty Tag', 'End Tag', + 'Text', 'CDATA'); + CValueType_Name : ARRAY [TValueType] OF STRING = ('Normal', 'Implied', 'Fixed', 'Default'); + CAttrDefault_Name : ARRAY [TAttrDefault] OF STRING = ('Default', 'Required', 'Implied', 'Fixed'); + CElemType_Name : ARRAY [TElemType] OF STRING = ('Empty', 'Any', 'Childs only', 'Mixed'); + CAttrType_Name : ARRAY [TAttrType] OF STRING = ('Unknown', 'CDATA', + 'ID', 'IDREF', 'IDREFS', + 'ENTITY', 'ENTITIES', + 'NMTOKEN', 'NMTOKENS', + 'Notation', 'Enumeration'); + +FUNCTION ConvertWs (Source: STRING; PackWs: BOOLEAN) : STRING; // Convert WS to spaces #x20 +PROCEDURE SetStringSF (VAR S : STRING; BufferStart, BufferFinal : PChar); // SetString by Start/Final of buffer +FUNCTION StrSFPas (Start, Finish : PChar) : STRING; // Convert buffer part to Pascal string +FUNCTION TrimWs (Source : STRING) : STRING; // Trim Whitespace + +FUNCTION AnsiToUtf8 (Source : ANSISTRING) : STRING; // Convert Win-1252 to UTF-8 +FUNCTION Utf8ToAnsi (Source : STRING; UnknownChar : CHAR = '¿') : ANSISTRING; // Convert UTF-8 to Win-1252 + + +(* +=============================================================================================== +TCustomXmlScanner event based component wrapper for TXmlParser +=============================================================================================== +*) + +TYPE + TCustomXmlScanner = CLASS; + TXmlPrologEvent = PROCEDURE (Sender : TObject; XmlVersion, Encoding: STRING; Standalone : BOOLEAN) OF OBJECT; + TCommentEvent = PROCEDURE (Sender : TObject; Comment : STRING) OF OBJECT; + TPIEvent = PROCEDURE (Sender : TObject; Target, Content: STRING; Attributes : TAttrList) OF OBJECT; + TDtdEvent = PROCEDURE (Sender : TObject; RootElementName : STRING) OF OBJECT; + TStartTagEvent = PROCEDURE (Sender : TObject; TagName : STRING; Attributes : TAttrList) OF OBJECT; + TEndTagEvent = PROCEDURE (Sender : TObject; TagName : STRING) OF OBJECT; + TContentEvent = PROCEDURE (Sender : TObject; Content : STRING) OF OBJECT; + TElementEvent = PROCEDURE (Sender : TObject; ElemDef : TElemDef) OF OBJECT; + TEntityEvent = PROCEDURE (Sender : TObject; EntityDef : TEntityDef) OF OBJECT; + TNotationEvent = PROCEDURE (Sender : TObject; NotationDef : TNotationDef) OF OBJECT; + TErrorEvent = PROCEDURE (Sender : TObject; ErrorPos : PChar) OF OBJECT; + TExternalEvent = PROCEDURE (Sender : TObject; SystemId, PublicId, NotationId : STRING; + VAR Result : TXmlParser) OF OBJECT; + TEncodingEvent = FUNCTION (Sender : TObject; CurrentEncoding, Source : STRING) : STRING OF OBJECT; + + + TCustomXmlScanner = CLASS (TComponent) + PROTECTED + FXmlParser : TXmlParser; + FOnXmlProlog : TXmlPrologEvent; + FOnComment : TCommentEvent; + FOnPI : TPIEvent; + FOnDtdRead : TDtdEvent; + FOnStartTag : TStartTagEvent; + FOnEmptyTag : TStartTagEvent; + FOnEndTag : TEndTagEvent; + FOnContent : TContentEvent; + FOnCData : TContentEvent; + FOnElement : TElementEvent; + FOnAttList : TElementEvent; + FOnEntity : TEntityEvent; + FOnNotation : TNotationEvent; + FOnDtdError : TErrorEvent; + FOnLoadExternal : TExternalEvent; + FOnTranslateEncoding : TEncodingEvent; + FStopParser : BOOLEAN; + FUNCTION GetNormalize : BOOLEAN; + PROCEDURE SetNormalize (Value : BOOLEAN); + + PROCEDURE WhenXmlProlog(XmlVersion, Encoding: STRING; Standalone : BOOLEAN); VIRTUAL; + PROCEDURE WhenComment (Comment : STRING); VIRTUAL; + PROCEDURE WhenPI (Target, Content: STRING; Attributes : TAttrList); VIRTUAL; + PROCEDURE WhenDtdRead (RootElementName : STRING); VIRTUAL; + PROCEDURE WhenStartTag (TagName : STRING; Attributes : TAttrList); VIRTUAL; + PROCEDURE WhenEmptyTag (TagName : STRING; Attributes : TAttrList); VIRTUAL; + PROCEDURE WhenEndTag (TagName : STRING); VIRTUAL; + PROCEDURE WhenContent (Content : STRING); VIRTUAL; + PROCEDURE WhenCData (Content : STRING); VIRTUAL; + PROCEDURE WhenElement (ElemDef : TElemDef); VIRTUAL; + PROCEDURE WhenAttList (ElemDef : TElemDef); VIRTUAL; + PROCEDURE WhenEntity (EntityDef : TEntityDef); VIRTUAL; + PROCEDURE WhenNotation (NotationDef : TNotationDef); VIRTUAL; + PROCEDURE WhenDtdError (ErrorPos : PChar); VIRTUAL; + + PUBLIC + CONSTRUCTOR Create (AOwner: TComponent); OVERRIDE; + DESTRUCTOR Destroy; OVERRIDE; + + PROCEDURE LoadFromFile (Filename : TFilename); // Load XML Document from file + PROCEDURE LoadFromBuffer (Buffer : PChar); // Load XML Document from buffer + PROCEDURE SetBuffer (Buffer : PChar); // Refer to Buffer + FUNCTION GetFilename : TFilename; + + PROCEDURE Execute; // Perform scanning + + PROTECTED + PROPERTY XmlParser : TXmlParser READ FXmlParser; + PROPERTY StopParser : BOOLEAN READ FStopParser WRITE FStopParser; + PROPERTY Filename : TFilename READ GetFilename WRITE LoadFromFile; + PROPERTY Normalize : BOOLEAN READ GetNormalize WRITE SetNormalize; + PROPERTY OnXmlProlog : TXmlPrologEvent READ FOnXmlProlog WRITE FOnXmlProlog; + PROPERTY OnComment : TCommentEvent READ FOnComment WRITE FOnComment; + PROPERTY OnPI : TPIEvent READ FOnPI WRITE FOnPI; + PROPERTY OnDtdRead : TDtdEvent READ FOnDtdRead WRITE FOnDtdRead; + PROPERTY OnStartTag : TStartTagEvent READ FOnStartTag WRITE FOnStartTag; + PROPERTY OnEmptyTag : TStartTagEvent READ FOnEmptyTag WRITE FOnEmptyTag; + PROPERTY OnEndTag : TEndTagEvent READ FOnEndTag WRITE FOnEndTag; + PROPERTY OnContent : TContentEvent READ FOnContent WRITE FOnContent; + PROPERTY OnCData : TContentEvent READ FOnCData WRITE FOnCData; + PROPERTY OnElement : TElementEvent READ FOnElement WRITE FOnElement; + PROPERTY OnAttList : TElementEvent READ FOnAttList WRITE FOnAttList; + PROPERTY OnEntity : TEntityEvent READ FOnEntity WRITE FOnEntity; + PROPERTY OnNotation : TNotationEvent READ FOnNotation WRITE FOnNotation; + PROPERTY OnDtdError : TErrorEvent READ FOnDtdError WRITE FOnDtdError; + PROPERTY OnLoadExternal : TExternalEvent READ FOnLoadExternal WRITE FOnLoadExternal; + PROPERTY OnTranslateEncoding : TEncodingEvent READ FOnTranslateEncoding WRITE FOnTranslateEncoding; + END; + +(* +=============================================================================================== +IMPLEMENTATION +=============================================================================================== +*) + +IMPLEMENTATION + + +(* +=============================================================================================== +Unicode and UTF-8 stuff +=============================================================================================== +*) + +CONST + // --- Character Translation Table for Unicode <-> Win-1252 + WIN1252_UNICODE : ARRAY [$00..$FF] OF WORD = ( + $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, + $000A, $000B, $000C, $000D, $000E, $000F, $0010, $0011, $0012, $0013, + $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, + $001E, $001F, $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, + $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F, $0030, $0031, + $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, + $003C, $003D, $003E, $003F, $0040, $0041, $0042, $0043, $0044, $0045, + $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F, + $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, + $005A, $005B, $005C, $005D, $005E, $005F, $0060, $0061, $0062, $0063, + $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, + $006E, $006F, $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, + $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F, + + $20AC, $0081, $201A, $0192, $201E, $2026, $2020, $2021, $02C6, $2030, + $0160, $2039, $0152, $008D, $017D, $008F, $0090, $2018, $2019, $201C, + $201D, $2022, $2013, $2014, $02DC, $2122, $0161, $203A, $0153, $009D, + $017E, $0178, $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7, + $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF, $00B0, $00B1, + $00B2, $00B3, $00B4, $00B5, $00B6, $00B7, $00B8, $00B9, $00BA, $00BB, + $00BC, $00BD, $00BE, $00BF, $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, + $00C6, $00C7, $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF, + $00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7, $00D8, $00D9, + $00DA, $00DB, $00DC, $00DD, $00DE, $00DF, $00E0, $00E1, $00E2, $00E3, + $00E4, $00E5, $00E6, $00E7, $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, + $00EE, $00EF, $00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7, + $00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF); + +(* UTF-8 (somewhat simplified) + ----- + Character Range Byte sequence + --------------- -------------------------- (x=Bits from original character) + $0000..$007F 0xxxxxxx + $0080..$07FF 110xxxxx 10xxxxxx + $8000..$FFFF 1110xxxx 10xxxxxx 10xxxxxx + + Example + -------- + Transforming the Unicode character U+00E4 LATIN SMALL LETTER A WITH DIAERESIS ("ä"): + + ISO-8859-1, Decimal 228 + Win1252, Hex $E4 + ANSI Bin 1110 0100 + abcd efgh + + UTF-8 Binary 1100xxab 10cdefgh + Binary 11000011 10100100 + Hex $C3 $A4 + Decimal 195 164 + ANSI Ã ¤ *) + + +FUNCTION AnsiToUtf8 (Source : ANSISTRING) : STRING; + (* Converts the given Windows ANSI (Win1252) String to UTF-8. *) +VAR + I : INTEGER; // Loop counter + U : WORD; // Current Unicode value + Len : INTEGER; // Current real length of "Result" string +BEGIN + SetLength (Result, Length (Source) * 3); // Worst case + Len := 0; + FOR I := 1 TO Length (Source) DO BEGIN + U := WIN1252_UNICODE [ORD (Source [I])]; + CASE U OF + $0000..$007F : BEGIN + INC (Len); + Result [Len] := CHR (U); + END; + $0080..$07FF : BEGIN + INC (Len); + Result [Len] := CHR ($C0 OR (U SHR 6)); + INC (Len); + Result [Len] := CHR ($80 OR (U AND $3F)); + END; + $0800..$FFFF : BEGIN + INC (Len); + Result [Len] := CHR ($E0 OR (U SHR 12)); + INC (Len); + Result [Len] := CHR ($80 OR ((U SHR 6) AND $3F)); + INC (Len); + Result [Len] := CHR ($80 OR (U AND $3F)); + END; + END; + END; + SetLength (Result, Len); +END; + + +FUNCTION Utf8ToAnsi (Source : STRING; UnknownChar : CHAR = '¿') : ANSISTRING; + (* Converts the given UTF-8 String to Windows ANSI (Win-1252). + If a character can not be converted, the "UnknownChar" is inserted. *) +VAR + SourceLen : INTEGER; // Length of Source string + I, K : INTEGER; + A : BYTE; // Current ANSI character value + U : WORD; + Ch : CHAR; // Dest char + Len : INTEGER; // Current real length of "Result" string +BEGIN + SourceLen := Length (Source); + SetLength (Result, SourceLen); // Enough room to live + Len := 0; + I := 1; + WHILE I <= SourceLen DO BEGIN + A := ORD (Source [I]); + IF A < $80 THEN BEGIN // Range $0000..$007F + INC (Len); + Result [Len] := Source [I]; + INC (I); + END + ELSE BEGIN // Determine U, Inc I + IF (A AND $E0 = $C0) AND (I < SourceLen) THEN BEGIN // Range $0080..$07FF + U := (WORD (A AND $1F) SHL 6) OR (ORD (Source [I+1]) AND $3F); + INC (I, 2); + END + ELSE IF (A AND $F0 = $E0) AND (I < SourceLen-1) THEN BEGIN // Range $0800..$FFFF + U := (WORD (A AND $0F) SHL 12) OR + (WORD (ORD (Source [I+1]) AND $3F) SHL 6) OR + ( ORD (Source [I+2]) AND $3F); + INC (I, 3); + END + ELSE BEGIN // Unknown/unsupported + INC (I); + FOR K := 7 DOWNTO 0 DO + IF A AND (1 SHL K) = 0 THEN BEGIN + INC (I, (A SHR (K+1))-1); + BREAK; + END; + U := WIN1252_UNICODE [ORD (UnknownChar)]; + END; + Ch := UnknownChar; // Retrieve ANSI char + FOR A := $00 TO $FF DO + IF WIN1252_UNICODE [A] = U THEN BEGIN + Ch := CHR (A); + BREAK; + END; + INC (Len); + Result [Len] := Ch; + END; + END; + SetLength (Result, Len); +END; + + +(* +=============================================================================================== +"Special" Helper Functions + +Don't ask me why. But including these functions makes the parser *DRAMATICALLY* faster +on my K6-233 machine. You can test it yourself just by commenting them out. +They do exactly the same as the Assembler routines defined in SysUtils. +(This is where you can see how great the Delphi compiler really is. The compiled code is +faster than hand-coded assembler!) +=============================================================================================== +--> Just move this line below the StrScan function --> *) + + +FUNCTION StrPos (CONST Str, SearchStr : PChar) : PChar; + // Same functionality as SysUtils.StrPos +VAR + First : CHAR; + Len : INTEGER; +BEGIN + First := SearchStr^; + Len := StrLen (SearchStr); + Result := Str; + REPEAT + IF Result^ = First THEN + IF StrLComp (Result, SearchStr, Len) = 0 THEN BREAK; + IF Result^ = #0 THEN BEGIN + Result := NIL; + BREAK; + END; + INC (Result); + UNTIL FALSE; +END; + + +FUNCTION StrScan (CONST Start : PChar; CONST Ch : CHAR) : PChar; + // Same functionality as SysUtils.StrScan +BEGIN + Result := Start; + WHILE Result^ <> Ch DO BEGIN + IF Result^ = #0 THEN BEGIN + Result := NIL; + EXIT; + END; + INC (Result); + END; +END; + + +(* +=============================================================================================== +Helper Functions +=============================================================================================== +*) + +FUNCTION DelChars (Source : STRING; CharsToDelete : TCharset) : STRING; + // Delete all "CharsToDelete" from the string +VAR + I : INTEGER; +BEGIN + Result := Source; + FOR I := Length (Result) DOWNTO 1 DO + IF Result [I] IN CharsToDelete THEN + Delete (Result, I, 1); +END; + + +FUNCTION TrimWs (Source : STRING) : STRING; + // Trimms off Whitespace characters from both ends of the string +VAR + I : INTEGER; +BEGIN + // --- Trim Left + I := 1; + WHILE (I <= Length (Source)) AND (Source [I] IN CWhitespace) DO + INC (I); + Result := Copy (Source, I, MaxInt); + + // --- Trim Right + I := Length (Result); + WHILE (I > 1) AND (Result [I] IN CWhitespace) DO + DEC (I); + Delete (Result, I+1, Length (Result)-I); +END; + + +FUNCTION ConvertWs (Source: STRING; PackWs: BOOLEAN) : STRING; + // Converts all Whitespace characters to the Space #x20 character + // If "PackWs" is true, contiguous Whitespace characters are packed to one +VAR + I : INTEGER; +BEGIN + Result := Source; + FOR I := Length (Result) DOWNTO 1 DO + IF (Result [I] IN CWhitespace) THEN + IF PackWs AND (I > 1) AND (Result [I-1] IN CWhitespace) + THEN Delete (Result, I, 1) + ELSE Result [I] := #32; +END; + + +PROCEDURE SetStringSF (VAR S : STRING; BufferStart, BufferFinal : PChar); +BEGIN + SetString (S, BufferStart, BufferFinal-BufferStart+1); +END; + + +FUNCTION StrLPas (Start : PChar; Len : INTEGER) : STRING; +BEGIN + SetString (Result, Start, Len); +END; + + +FUNCTION StrSFPas (Start, Finish : PChar) : STRING; +BEGIN + SetString (Result, Start, Finish-Start+1); +END; + + +FUNCTION StrScanE (CONST Source : PChar; CONST CharToScanFor : CHAR) : PChar; + // If "CharToScanFor" is not found, StrScanE returns the last char of the + // buffer instead of NIL +BEGIN + Result := StrScan (Source, CharToScanFor); + IF Result = NIL THEN + Result := StrEnd (Source)-1; +END; + + +PROCEDURE ExtractName (Start : PChar; Terminators : TCharset; VAR Final : PChar); + (* Extracts the complete Name beginning at "Start". + It is assumed that the name is contained in Markup, so the '>' character is + always a Termination. + Start: IN Pointer to first char of name. Is always considered to be valid + Terminators: IN Characters which terminate the name + Final: OUT Pointer to last char of name *) +BEGIN + Final := Start+1; + Include (Terminators, #0); + Include (Terminators, '>'); + WHILE NOT (Final^ IN Terminators) DO + INC (Final); + DEC (Final); +END; + + +PROCEDURE ExtractQuote (Start : PChar; VAR Content : STRING; VAR Final : PChar); + (* Extract a string which is contained in single or double Quotes. + Start: IN Pointer to opening quote + Content: OUT The quoted string + Final: OUT Pointer to closing quote *) +BEGIN + Final := StrScan (Start+1, Start^); + IF Final = NIL THEN BEGIN + Final := StrEnd (Start+1)-1; + SetString (Content, Start+1, Final-Start); + END + ELSE + SetString (Content, Start+1, Final-1-Start); +END; + + +(* +=============================================================================================== +TEntityStackNode +This Node is pushed to the "Entity Stack" whenever the parser parses entity replacement text. +The "Instance" field holds the Instance pointer of an External Entity buffer. When it is +popped, the Instance is freed. +The "Encoding" field holds the name of the Encoding. External Parsed Entities may have +another encoding as the document entity (XmlSpec 4.3.3). So when there is an "<?xml" PI +found in the stream (= Text Declaration at the beginning of external parsed entities), the +Encoding found there is used for the External Entity (is assigned to TXmlParser.CurEncoding) +Default Encoding is for the Document Entity is UTF-8. It is assumed that External Entities +have the same Encoding as the Document Entity, unless they carry a Text Declaration. +=============================================================================================== +*) + +TYPE + TEntityStackNode = CLASS + Instance : TObject; + Encoding : STRING; + LastPos : PChar; + END; + +(* +=============================================================================================== +TEntityStack +For nesting of Entities. +When there is an entity reference found in the data stream, the corresponding entity +definition is searched and the current position is pushed to this stack. +From then on, the program scans the entitiy replacement text as if it were normal content. +When the parser reaches the end of an entity, the current position is popped off the +stack again. +=============================================================================================== +*) + +CONSTRUCTOR TEntityStack.Create (TheOwner : TXmlParser); +BEGIN + INHERITED Create; + Owner := TheOwner; +END; + + +PROCEDURE TEntityStack.Push (LastPos : PChar); +BEGIN + Push (NIL, LastPos); +END; + + +PROCEDURE TEntityStack.Push (Instance : TObject; LastPos : PChar); +VAR + ESN : TEntityStackNode; +BEGIN + ESN := TEntityStackNode.Create; + ESN.Instance := Instance; + ESN.Encoding := Owner.FCurEncoding; // Save current Encoding + ESN.LastPos := LastPos; + Add (ESN); +END; + + +FUNCTION TEntityStack.Pop : PChar; +VAR + ESN : TEntityStackNode; +BEGIN + IF Count > 0 THEN BEGIN + ESN := TEntityStackNode (Items [Count-1]); + Result := ESN.LastPos; + IF ESN.Instance <> NIL THEN + ESN.Instance.Free; + IF ESN.Encoding <> '' THEN + Owner.FCurEncoding := ESN.Encoding; // Restore current Encoding + Delete (Count-1); + END + ELSE + Result := NIL; +END; + + +(* +=============================================================================================== +TExternalID +----------- +XmlSpec 4.2.2: ExternalID ::= 'SYSTEM' S SystemLiteral | + 'PUBLIC' S PubidLiteral S SystemLiteral +XmlSpec 4.7: PublicID ::= 'PUBLIC' S PubidLiteral +SystemLiteral and PubidLiteral are quoted +=============================================================================================== +*) + +TYPE + TExternalID = CLASS + PublicId : STRING; + SystemId : STRING; + Final : PChar; + CONSTRUCTOR Create (Start : PChar); + END; + +CONSTRUCTOR TExternalID.Create (Start : PChar); +BEGIN + INHERITED Create; + Final := Start; + IF StrLComp (Start, 'SYSTEM', 6) = 0 THEN BEGIN + WHILE NOT (Final^ IN (CQuoteChar + [#0, '>', '['])) DO INC (Final); + IF NOT (Final^ IN CQuoteChar) THEN EXIT; + ExtractQuote (Final, SystemID, Final); + END + ELSE IF StrLComp (Start, 'PUBLIC', 6) = 0 THEN BEGIN + WHILE NOT (Final^ IN (CQuoteChar + [#0, '>', '['])) DO INC (Final); + IF NOT (Final^ IN CQuoteChar) THEN EXIT; + ExtractQuote (Final, PublicID, Final); + INC (Final); + WHILE NOT (Final^ IN (CQuoteChar + [#0, '>', '['])) DO INC (Final); + IF NOT (Final^ IN CQuoteChar) THEN EXIT; + ExtractQuote (Final, SystemID, Final); + END; +END; + + +(* +=============================================================================================== +TXmlParser +=============================================================================================== +*) + +CONSTRUCTOR TXmlParser.Create; +BEGIN + INHERITED Create; + FBuffer := NIL; + FBufferSize := 0; + Elements := TElemList.Create; + Entities := TNvpList.Create; + ParEntities := TNvpList.Create; + Notations := TNvpList.Create; + CurAttr := TAttrList.Create; + EntityStack := TEntityStack.Create (Self); + Clear; +END; + + +DESTRUCTOR TXmlParser.Destroy; +BEGIN + Clear; + Elements.Free; + Entities.Free; + ParEntities.Free; + Notations.Free; + CurAttr.Free; + EntityStack.Free; + INHERITED Destroy; +END; + + +PROCEDURE TXmlParser.Clear; + // Free Buffer and clear all object attributes +BEGIN + IF (FBufferSize > 0) AND (FBuffer <> NIL) THEN + FreeMem (FBuffer); + FBuffer := NIL; + FBufferSize := 0; + FSource := ''; + FXmlVersion := ''; + FEncoding := ''; + FStandalone := FALSE; + FRootName := ''; + FDtdcFinal := NIL; + FNormalize := TRUE; + Elements.Clear; + Entities.Clear; + ParEntities.Clear; + Notations.Clear; + CurAttr.Clear; + EntityStack.Clear; +END; + + +FUNCTION TXmlParser.LoadFromFile (Filename : STRING; FileMode : INTEGER = fmOpenRead OR fmShareDenyNone) : BOOLEAN; + // Loads Document from given file + // Returns TRUE if successful +VAR + f : FILE; + ReadIn : INTEGER; + OldFileMode : INTEGER; +BEGIN + Result := FALSE; + Clear; + + // --- Open File + OldFileMode := SYSTEM.FileMode; + TRY + SYSTEM.FileMode := FileMode; + TRY + AssignFile (f, Filename); + Reset (f, 1); + EXCEPT + EXIT; + END; + + TRY + // --- Allocate Memory + TRY + FBufferSize := Filesize (f) + 1; + GetMem (FBuffer, FBufferSize); + EXCEPT + Clear; + EXIT; + END; + + // --- Read File + TRY + BlockRead (f, FBuffer^, FBufferSize, ReadIn); + (FBuffer+ReadIn)^ := #0; // NULL termination + EXCEPT + Clear; + EXIT; + END; + FINALLY + CloseFile (f); + END; + + FSource := Filename; + Result := TRUE; + + FINALLY + SYSTEM.FileMode := OldFileMode; + END; +END; + + +FUNCTION TXmlParser.LoadFromBuffer (Buffer : PChar) : BOOLEAN; + // Loads Document from another buffer + // Returns TRUE if successful + // The "Source" property becomes '<MEM>' if successful +BEGIN + Result := FALSE; + Clear; + FBufferSize := StrLen (Buffer) + 1; + TRY + GetMem (FBuffer, FBufferSize); + EXCEPT + Clear; + EXIT; + END; + StrCopy (FBuffer, Buffer); + FSource := '<MEM>'; + Result := TRUE; +END; + + +PROCEDURE TXmlParser.SetBuffer (Buffer : PChar); // References another buffer +BEGIN + Clear; + FBuffer := Buffer; + FBufferSize := 0; + FSource := '<REFERENCE>'; +END; + + +//----------------------------------------------------------------------------------------------- +// Scanning through the document +//----------------------------------------------------------------------------------------------- + +PROCEDURE TXmlParser.StartScan; +BEGIN + CurPartType := ptNone; + CurName := ''; + CurContent := ''; + CurStart := NIL; + CurFinal := NIL; + CurAttr.Clear; + EntityStack.Clear; +END; + + +FUNCTION TXmlParser.Scan : BOOLEAN; + // Scans the next Part + // Returns TRUE if a part could be found, FALSE if there is no part any more + // + // "IsDone" can be set to FALSE by AnalyzeText in order to go to the next part + // if there is no Content due to normalization +VAR + IsDone : BOOLEAN; +BEGIN + REPEAT + IsDone := TRUE; + + // --- Start of next Part + IF CurStart = NIL + THEN CurStart := DocBuffer + ELSE CurStart := CurFinal+1; + CurFinal := CurStart; + + // --- End of Document of Pop off a new part from the Entity stack? + IF CurStart^ = #0 THEN + CurStart := EntityStack.Pop; + + // --- No Document or End Of Document: Terminate Scan + IF (CurStart = NIL) OR (CurStart^ = #0) THEN BEGIN + CurStart := StrEnd (DocBuffer); + CurFinal := CurStart-1; + EntityStack.Clear; + Result := FALSE; + EXIT; + END; + + IF (StrLComp (CurStart, '<?xml', 5) = 0) AND + ((CurStart+5)^ IN CWhitespace) THEN AnalyzeProlog // XML Declaration, Text Declaration + ELSE IF StrLComp (CurStart, '<?', 2) = 0 THEN AnalyzePI (CurStart, CurFinal) // PI + ELSE IF StrLComp (CurStart, '<!--', 4) = 0 THEN AnalyzeComment (CurStart, CurFinal) // Comment + ELSE IF StrLComp (CurStart, '<!DOCTYPE', 9) = 0 THEN AnalyzeDtdc // DTDc + ELSE IF StrLComp (CurStart, CDStart, Length (CDStart)) = 0 THEN AnalyzeCdata // CDATA Section + ELSE IF StrLComp (CurStart, '<', 1) = 0 THEN AnalyzeTag // Start-Tag, End-Tag, Empty-Element-Tag + ELSE AnalyzeText (IsDone); // Text Content + UNTIL IsDone; + Result := TRUE; +END; + + +PROCEDURE TXmlParser.AnalyzeProlog; + // Analyze XML Prolog or Text Declaration +VAR + F : PChar; +BEGIN + CurAttr.Analyze (CurStart+5, F); + IF EntityStack.Count = 0 THEN BEGIN + FXmlVersion := CurAttr.Value ('version'); + FEncoding := CurAttr.Value ('encoding'); + FStandalone := CurAttr.Value ('standalone') = 'yes'; + END; + CurFinal := StrPos (F, '?>'); + IF CurFinal <> NIL + THEN INC (CurFinal) + ELSE CurFinal := StrEnd (CurStart)-1; + FCurEncoding := AnsiUpperCase (CurAttr.Value ('encoding')); + IF FCurEncoding = '' THEN + FCurEncoding := 'UTF-8'; // Default XML Encoding is UTF-8 + CurPartType := ptXmlProlog; + CurName := ''; + CurContent := ''; +END; + + +PROCEDURE TXmlParser.AnalyzeComment (Start : PChar; VAR Final : PChar); + // Analyze Comments +BEGIN + Final := StrPos (Start+4, '-->'); + IF Final = NIL + THEN Final := StrEnd (Start)-1 + ELSE INC (Final, 2); + CurPartType := ptComment; +END; + + +PROCEDURE TXmlParser.AnalyzePI (Start : PChar; VAR Final : PChar); + // Analyze Processing Instructions (PI) + // This is also called for Character +VAR + F : PChar; +BEGIN + CurPartType := ptPI; + Final := StrPos (Start+2, '?>'); + IF Final = NIL + THEN Final := StrEnd (Start)-1 + ELSE INC (Final); + ExtractName (Start+2, CWhitespace + ['?', '>'], F); + SetStringSF (CurName, Start+2, F); + SetStringSF (CurContent, F+1, Final-2); + CurAttr.Analyze (F+1, F); +END; + + +PROCEDURE TXmlParser.AnalyzeDtdc; + (* Analyze Document Type Declaration + doctypedecl ::= '<!DOCTYPE' S Name (S ExternalID)? S? ('[' (markupdecl | PEReference | S)* ']' S?)? '>' + markupdecl ::= elementdecl | AttlistDecl | EntityDecl | NotationDecl | PI | Comment + PEReference ::= '%' Name ';' + + elementdecl ::= '<!ELEMENT' S Name S contentspec S? '>' + AttlistDecl ::= '<!ATTLIST' S Name AttDef* S? '>' + EntityDecl ::= '<!ENTITY' S Name S EntityDef S? '>' | + '<!ENTITY' S '%' S Name S PEDef S? '>' + NotationDecl ::= '<!NOTATION' S Name S (ExternalID | PublicID) S? '>' + PI ::= '<?' PITarget (S (Char* - (Char* '?>' Char* )))? '?>' + Comment ::= '<!--' ((Char - '-') | ('-' (Char - '-')))* '-->' *) +TYPE + TPhase = (phName, phDtd, phInternal, phFinishing); +VAR + Phase : TPhase; + F : PChar; + ExternalID : TExternalID; + ExternalDTD : TXmlParser; + DER : TDtdElementRec; +BEGIN + DER.Start := CurStart; + EntityStack.Clear; // Clear stack for Parameter Entities + CurPartType := ptDtdc; + + // --- Don't read DTDc twice + IF FDtdcFinal <> NIL THEN BEGIN + CurFinal := FDtdcFinal; + EXIT; + END; + + // --- Scan DTDc + CurFinal := CurStart + 9; // First char after '<!DOCTYPE' + Phase := phName; + REPEAT + CASE CurFinal^ OF + '%' : BEGIN + PushPE (CurFinal); + CONTINUE; + END; + #0 : IF EntityStack.Count = 0 THEN + BREAK + ELSE BEGIN + CurFinal := EntityStack.Pop; + CONTINUE; + END; + '[' : BEGIN + Phase := phInternal; + AnalyzeDtdElements (CurFinal+1, CurFinal); + CONTINUE; + END; + ']' : Phase := phFinishing; + '>' : BREAK; + ELSE IF NOT (CurFinal^ IN CWhitespace) THEN BEGIN + CASE Phase OF + phName : IF (CurFinal^ IN CNameStart) THEN BEGIN + ExtractName (CurFinal, CWhitespace + ['[', '>'], F); + SetStringSF (FRootName, CurFinal, F); + CurFinal := F; + Phase := phDtd; + END; + phDtd : IF (StrLComp (CurFinal, 'SYSTEM', 6) = 0) OR + (StrLComp (CurFinal, 'PUBLIC', 6) = 0) THEN BEGIN + ExternalID := TExternalID.Create (CurFinal); + ExternalDTD := LoadExternalEntity (ExternalId.SystemId, ExternalID.PublicId, ''); + F := StrPos (ExternalDtd.DocBuffer, '<!'); + IF F <> NIL THEN + AnalyzeDtdElements (F, F); + ExternalDTD.Free; + CurFinal := ExternalID.Final; + ExternalID.Free; + END; + ELSE BEGIN + DER.ElementType := deError; + DER.Pos := CurFinal; + DER.Final := CurFinal; + DtdElementFound (DER); + END; + END; + + END; + END; + INC (CurFinal); + UNTIL FALSE; + + CurPartType := ptDtdc; + CurName := ''; + CurContent := ''; + + // It is an error in the document if "EntityStack" is not empty now + IF EntityStack.Count > 0 THEN BEGIN + DER.ElementType := deError; + DER.Final := CurFinal; + DER.Pos := CurFinal; + DtdElementFound (DER); + END; + + EntityStack.Clear; // Clear stack for General Entities + FDtdcFinal := CurFinal; +END; + + +PROCEDURE TXmlParser.AnalyzeDtdElements (Start : PChar; VAR Final : PChar); + // Analyze the "Elements" of a DTD contained in the external or + // internal DTD subset. +VAR + DER : TDtdElementRec; +BEGIN + Final := Start; + REPEAT + CASE Final^ OF + '%' : BEGIN + PushPE (Final); + CONTINUE; + END; + #0 : IF EntityStack.Count = 0 THEN + BREAK + ELSE BEGIN + CurFinal := EntityStack.Pop; + CONTINUE; + END; + ']', + '>' : BREAK; + '<' : IF StrLComp (Final, '<!ELEMENT', 9) = 0 THEN AnalyzeElementDecl (Final, Final) + ELSE IF StrLComp (Final, '<!ATTLIST', 9) = 0 THEN AnalyzeAttListDecl (Final, Final) + ELSE IF StrLComp (Final, '<!ENTITY', 8) = 0 THEN AnalyzeEntityDecl (Final, Final) + ELSE IF StrLComp (Final, '<!NOTATION', 10) = 0 THEN AnalyzeNotationDecl (Final, Final) + ELSE IF StrLComp (Final, '<?', 2) = 0 THEN BEGIN // PI in DTD + DER.ElementType := dePI; + DER.Start := Final; + AnalyzePI (Final, Final); + DER.Target := PChar (CurName); + DER.Content := PChar (CurContent); + DER.AttrList := CurAttr; + DER.Final := Final; + DtdElementFound (DER); + END + ELSE IF StrLComp (Final, '<!--', 4) = 0 THEN BEGIN // Comment in DTD + DER.ElementType := deComment; + DER.Start := Final; + AnalyzeComment (Final, Final); + DER.Final := Final; + DtdElementFound (DER); + END + ELSE BEGIN + DER.ElementType := deError; + DER.Start := Final; + DER.Pos := Final; + DER.Final := Final; + DtdElementFound (DER); + END; + + END; + INC (Final); + UNTIL FALSE; +END; + + +PROCEDURE TXmlParser.AnalyzeTag; + // Analyze Tags +VAR + S, F : PChar; + Attr : TAttr; + ElemDef : TElemDef; + AttrDef : TAttrDef; + I : INTEGER; +BEGIN + CurPartType := ptStartTag; + S := CurStart+1; + IF S^ = '/' THEN BEGIN + CurPartType := ptEndTag; + INC (S); + END; + ExtractName (S, CWhitespace + ['/'], F); + SetStringSF (CurName, S, F); + CurAttr.Analyze (F+1, CurFinal); + IF CurFinal^ = '/' THEN BEGIN + CurPartType := ptEmptyTag; + END; + CurFinal := StrScanE (CurFinal, '>'); + + // --- Set Default Attribute values for nonexistent attributes + IF (CurPartType = ptStartTag) OR (CurPartType = ptEmptyTag) THEN BEGIN + ElemDef := Elements.Node (CurName); + IF ElemDef <> NIL THEN BEGIN + FOR I := 0 TO ElemDef.Count-1 DO BEGIN + AttrDef := TAttrDef (ElemDef [I]); + Attr := TAttr (CurAttr.Node (AttrDef.Name)); + IF (Attr = NIL) AND (AttrDef.Value <> '') THEN BEGIN + Attr := TAttr.Create (AttrDef.Name, AttrDef.Value); + Attr.ValueType := vtDefault; + CurAttr.Add (Attr); + END; + IF Attr <> NIL THEN BEGIN + CASE AttrDef.DefaultType OF + adDefault : ; + adRequired : ; // -!- It is an error in the document if "Attr.Value" is an empty string + adImplied : Attr.ValueType := vtImplied; + adFixed : BEGIN + Attr.ValueType := vtFixed; + Attr.Value := AttrDef.Value; + END; + END; + Attr.AttrType := AttrDef.AttrType; + END; + END; + END; + + // --- Normalize Attribute Values. XmlSpec: + // - a character reference is processed by appending the referenced character to the attribute value + // - an entity reference is processed by recursively processing the replacement text of the entity + // - a whitespace character (#x20, #xD, #xA, #x9) is processed by appending #x20 to the normalized value, + // except that only a single #x20 is appended for a "#xD#xA" sequence that is part of an external + // parsed entity or the literal entity value of an internal parsed entity + // - other characters are processed by appending them to the normalized value + // If the declared value is not CDATA, then the XML processor must further process the + // normalized attribute value by discarding any leading and trailing space (#x20) characters, + // and by replacing sequences of space (#x20) characters by a single space (#x20) character. + // All attributes for which no declaration has been read should be treated by a + // non-validating parser as if declared CDATA. + // !!! The XML 1.0 SE specification is somewhat different here + // This code does not conform exactly to this specification + FOR I := 0 TO CurAttr.Count-1 DO + WITH TAttr (CurAttr [I]) DO BEGIN + ReplaceGeneralEntities (Value); + ReplaceCharacterEntities (Value); + IF (AttrType <> atCData) AND (AttrType <> atUnknown) + THEN Value := TranslateEncoding (TrimWs (ConvertWs (Value, TRUE))) + ELSE Value := TranslateEncoding (ConvertWs (Value, FALSE)); + END; + END; +END; + + +PROCEDURE TXmlParser.AnalyzeCData; + // Analyze CDATA Sections +BEGIN + CurPartType := ptCData; + CurFinal := StrPos (CurStart, CDEnd); + IF CurFinal = NIL THEN BEGIN + CurFinal := StrEnd (CurStart)-1; + CurContent := TranslateEncoding (StrPas (CurStart+Length (CDStart))); + END + ELSE BEGIN + SetStringSF (CurContent, CurStart+Length (CDStart), CurFinal-1); + INC (CurFinal, Length (CDEnd)-1); + CurContent := TranslateEncoding (CurContent); + END; +END; + + +PROCEDURE TXmlParser.AnalyzeText (VAR IsDone : BOOLEAN); + (* Analyzes Text Content between Tags. CurFinal will point to the last content character. + Content ends at a '<' character or at the end of the document. + Entity References and Character Entity references are resolved. + If PackSpaces is TRUE, contiguous Whitespace Characters will be compressed to + one Space #x20 character, Whitespace at the beginning and end of content will + be trimmed off and content which is or becomes empty is not returned to + the application (in this case, "IsDone" is set to FALSE which causes the + Scan method to proceed directly to the next part. *) + + PROCEDURE ProcessEntity; + (* Is called if there is an ampsersand '&' character found in the document. + IN "CurFinal" points to the ampersand + OUT "CurFinal" points to the first character after the semi-colon ';' *) + VAR + P : PChar; + Name : STRING; + EntityDef : TEntityDef; + ExternalEntity : TXmlParser; + BEGIN + P := StrScan (CurFinal , ';'); + IF P <> NIL THEN BEGIN + SetStringSF (Name, CurFinal+1, P-1); + + // Is it a Character Entity? + IF (CurFinal+1)^ = '#' THEN BEGIN + IF UpCase ((CurFinal+2)^) = 'X' // !!! Can't use "CHR" for Unicode characters > 255: + THEN CurContent := CurContent + CHR (StrToIntDef ('$'+Copy (Name, 3, MaxInt), 32)) + ELSE CurContent := CurContent + CHR (StrToIntDef (Copy (Name, 2, MaxInt), 32)); + CurFinal := P+1; + EXIT; + END + + // Is it a Predefined Entity? + ELSE IF Name = 'lt' THEN BEGIN CurContent := CurContent + '<'; CurFinal := P+1; EXIT; END + ELSE IF Name = 'gt' THEN BEGIN CurContent := CurContent + '>'; CurFinal := P+1; EXIT; END + ELSE IF Name = 'amp' THEN BEGIN CurContent := CurContent + '&'; CurFinal := P+1; EXIT; END + ELSE IF Name = 'apos' THEN BEGIN CurContent := CurContent + ''''; CurFinal := P+1; EXIT; END + ELSE IF Name = 'quot' THEN BEGIN CurContent := CurContent + '"'; CurFinal := P+1; EXIT; END; + + // Replace with Entity from DTD + EntityDef := TEntityDef (Entities.Node (Name)); + IF EntityDef <> NIL THEN BEGIN + IF EntityDef.Value <> '' THEN BEGIN + EntityStack.Push (P+1); + CurFinal := PChar (EntityDef.Value); + END + ELSE BEGIN + ExternalEntity := LoadExternalEntity (EntityDef.SystemId, EntityDef.PublicId, EntityDef.NotationName); + EntityStack.Push (ExternalEntity, P+1); + CurFinal := ExternalEntity.DocBuffer; + END; + END + ELSE BEGIN + CurContent := CurContent + Name; + CurFinal := P+1; + END; + END + ELSE BEGIN + INC (CurFinal); + END; + END; + +VAR + C : INTEGER; +BEGIN + CurFinal := CurStart; + CurPartType := ptContent; + CurContent := ''; + C := 0; + REPEAT + CASE CurFinal^ OF + '&' : BEGIN + CurContent := CurContent + TranslateEncoding (StrLPas (CurFinal-C, C)); + C := 0; + ProcessEntity; + CONTINUE; + END; + #0 : BEGIN + IF EntityStack.Count = 0 THEN + BREAK + ELSE BEGIN + CurContent := CurContent + TranslateEncoding (StrLPas (CurFinal-C, C)); + C := 0; + CurFinal := EntityStack.Pop; + CONTINUE; + END; + END; + '<' : BREAK; + ELSE INC (C); + END; + INC (CurFinal); + UNTIL FALSE; + CurContent := CurContent + TranslateEncoding (StrLPas (CurFinal-C, C)); + DEC (CurFinal); + + IF FNormalize THEN BEGIN + CurContent := ConvertWs (TrimWs (CurContent), TRUE); + IsDone := CurContent <> ''; // IsDone will only get FALSE if PackSpaces is TRUE + END; +END; + + +PROCEDURE TXmlParser.AnalyzeElementDecl (Start : PChar; VAR Final : PChar); + (* Parse <!ELEMENT declaration starting at "Start" + Final must point to the terminating '>' character + XmlSpec 3.2: + elementdecl ::= '<!ELEMENT' S Name S contentspec S? '>' + contentspec ::= 'EMPTY' | 'ANY' | Mixed | children + Mixed ::= '(' S? '#PCDATA' (S? '|' S? Name)* S? ')*' | + '(' S? '#PCDATA' S? ')' + children ::= (choice | seq) ('?' | '*' | '+')? + choice ::= '(' S? cp ( S? '|' S? cp )* S? ')' + cp ::= (Name | choice | seq) ('?' | '*' | '+')? + seq ::= '(' S? cp ( S? ',' S? cp )* S? ')' + + More simply: + contentspec ::= EMPTY + ANY + '(#PCDATA)' + '(#PCDATA | A | B)*' + '(A, B, C)' + '(A | B | C)' + '(A?, B*, C+), + '(A, (B | C | D)* )' *) +VAR + Element : TElemDef; + Elem2 : TElemDef; + F : PChar; + DER : TDtdElementRec; +BEGIN + Element := TElemDef.Create; + Final := Start + 9; + DER.Start := Start; + REPEAT + IF Final^ = '>' THEN BREAK; + IF (Final^ IN CNameStart) AND (Element.Name = '') THEN BEGIN + ExtractName (Final, CWhitespace, F); + SetStringSF (Element.Name, Final, F); + Final := F; + F := StrScan (Final+1, '>'); + IF F = NIL THEN BEGIN + Element.Definition := STRING (Final); + Final := StrEnd (Final); + BREAK; + END + ELSE BEGIN + SetStringSF (Element.Definition, Final+1, F-1); + Final := F; + BREAK; + END; + END; + INC (Final); + UNTIL FALSE; + Element.Definition := DelChars (Element.Definition, CWhitespace); + ReplaceParameterEntities (Element.Definition); + IF Element.Definition = 'EMPTY' THEN Element.ElemType := etEmpty + ELSE IF Element.Definition = 'ANY' THEN Element.ElemType := etAny + ELSE IF Copy (Element.Definition, 1, 8) = '(#PCDATA' THEN Element.ElemType := etMixed + ELSE IF Copy (Element.Definition, 1, 1) = '(' THEN Element.ElemType := etChildren + ELSE Element.ElemType := etAny; + + Elem2 := Elements.Node (Element.Name); + IF Elem2 <> NIL THEN + Elements.Delete (Elements.IndexOf (Elem2)); + Elements.Add (Element); + Final := StrScanE (Final, '>'); + DER.ElementType := deElement; + DER.ElemDef := Element; + DER.Final := Final; + DtdElementFound (DER); +END; + + +PROCEDURE TXmlParser.AnalyzeAttListDecl (Start : PChar; VAR Final : PChar); + (* Parse <!ATTLIST declaration starting at "Start" + Final must point to the terminating '>' character + XmlSpec 3.3: + AttlistDecl ::= '<!ATTLIST' S Name AttDef* S? '>' + AttDef ::= S Name S AttType S DefaultDecl + AttType ::= StringType | TokenizedType | EnumeratedType + StringType ::= 'CDATA' + TokenizedType ::= 'ID' | 'IDREF' | 'IDREFS' | 'ENTITY' | 'ENTITIES' | 'NMTOKEN' | 'NMTOKENS' + EnumeratedType ::= NotationType | Enumeration + NotationType ::= 'NOTATION' S '(' S? Name (S? '|' S? Name)* S? ')' + Enumeration ::= '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')' + DefaultDecl ::= '#REQUIRED' | '#IMPLIED' | (('#FIXED' S)? AttValue) + AttValue ::= '"' ([^<&"] | Reference)* '"' | "'" ([^<&'] | Reference)* "'" + Examples: + <!ATTLIST address + A1 CDATA "Default" + A2 ID #REQUIRED + A3 IDREF #IMPLIED + A4 IDREFS #IMPLIED + A5 ENTITY #FIXED "&at;ü" + A6 ENTITIES #REQUIRED + A7 NOTATION (WMF | DXF) "WMF" + A8 (A | B | C) #REQUIRED> *) +TYPE + TPhase = (phElementName, phName, phType, phNotationContent, phDefault); +VAR + Phase : TPhase; + F : PChar; + ElementName : STRING; + ElemDef : TElemDef; + AttrDef : TAttrDef; + AttrDef2 : TAttrDef; + Strg : STRING; + DER : TDtdElementRec; +BEGIN + Final := Start + 9; // The character after <!ATTLIST + Phase := phElementName; + DER.Start := Start; + AttrDef := NIL; + ElemDef := NIL; + REPEAT + IF NOT (Final^ IN CWhitespace) THEN + CASE Final^ OF + '%' : BEGIN + PushPE (Final); + CONTINUE; + END; + #0 : IF EntityStack.Count = 0 THEN + BREAK + ELSE BEGIN + Final := EntityStack.Pop; + CONTINUE; + END; + '>' : BREAK; + ELSE CASE Phase OF + phElementName : BEGIN + ExtractName (Final, CWhitespace + CQuoteChar + ['#'], F); + SetStringSF (ElementName, Final, F); + Final := F; + ElemDef := Elements.Node (ElementName); + IF ElemDef = NIL THEN BEGIN + ElemDef := TElemDef.Create; + ElemDef.Name := ElementName; + ElemDef.Definition := 'ANY'; + ElemDef.ElemType := etAny; + Elements.Add (ElemDef); + END; + Phase := phName; + END; + phName : BEGIN + AttrDef := TAttrDef.Create; + ExtractName (Final, CWhitespace + CQuoteChar + ['#'], F); + SetStringSF (AttrDef.Name, Final, F); + Final := F; + AttrDef2 := TAttrDef (ElemDef.Node (AttrDef.Name)); + IF AttrDef2 <> NIL THEN + ElemDef.Delete (ElemDef.IndexOf (AttrDef2)); + ElemDef.Add (AttrDef); + Phase := phType; + END; + phType : BEGIN + IF Final^ = '(' THEN BEGIN + F := StrScan (Final+1, ')'); + IF F <> NIL + THEN SetStringSF (AttrDef.TypeDef, Final+1, F-1) + ELSE AttrDef.TypeDef := STRING (Final+1); + AttrDef.TypeDef := DelChars (AttrDef.TypeDef, CWhitespace); + AttrDef.AttrType := atEnumeration; + ReplaceParameterEntities (AttrDef.TypeDef); + ReplaceCharacterEntities (AttrDef.TypeDef); + Phase := phDefault; + END + ELSE IF StrLComp (Final, 'NOTATION', 8) = 0 THEN BEGIN + INC (Final, 8); + AttrDef.AttrType := atNotation; + Phase := phNotationContent; + END + ELSE BEGIN + ExtractName (Final, CWhitespace+CQuoteChar+['#'], F); + SetStringSF (AttrDef.TypeDef, Final, F); + IF AttrDef.TypeDef = 'CDATA' THEN AttrDef.AttrType := atCData + ELSE IF AttrDef.TypeDef = 'ID' THEN AttrDef.AttrType := atId + ELSE IF AttrDef.TypeDef = 'IDREF' THEN AttrDef.AttrType := atIdRef + ELSE IF AttrDef.TypeDef = 'IDREFS' THEN AttrDef.AttrType := atIdRefs + ELSE IF AttrDef.TypeDef = 'ENTITY' THEN AttrDef.AttrType := atEntity + ELSE IF AttrDef.TypeDef = 'ENTITIES' THEN AttrDef.AttrType := atEntities + ELSE IF AttrDef.TypeDef = 'NMTOKEN' THEN AttrDef.AttrType := atNmToken + ELSE IF AttrDef.TypeDef = 'NMTOKENS' THEN AttrDef.AttrType := atNmTokens; + Phase := phDefault; + END + END; + phNotationContent : BEGIN + F := StrScan (Final, ')'); + IF F <> NIL THEN + SetStringSF (AttrDef.Notations, Final+1, F-1) + ELSE BEGIN + AttrDef.Notations := STRING (Final+1); + Final := StrEnd (Final); + END; + ReplaceParameterEntities (AttrDef.Notations); + AttrDef.Notations := DelChars (AttrDef.Notations, CWhitespace); + Phase := phDefault; + END; + phDefault : BEGIN + IF Final^ = '#' THEN BEGIN + ExtractName (Final, CWhiteSpace + CQuoteChar, F); + SetStringSF (Strg, Final, F); + Final := F; + ReplaceParameterEntities (Strg); + IF Strg = '#REQUIRED' THEN BEGIN AttrDef.DefaultType := adRequired; Phase := phName; END + ELSE IF Strg = '#IMPLIED' THEN BEGIN AttrDef.DefaultType := adImplied; Phase := phName; END + ELSE IF Strg = '#FIXED' THEN AttrDef.DefaultType := adFixed; + END + ELSE IF (Final^ IN CQuoteChar) THEN BEGIN + ExtractQuote (Final, AttrDef.Value, Final); + ReplaceParameterEntities (AttrDef.Value); + ReplaceCharacterEntities (AttrDef.Value); + Phase := phName; + END; + IF Phase = phName THEN BEGIN + AttrDef := NIL; + END; + END; + + END; + END; + INC (Final); + UNTIL FALSE; + + Final := StrScan (Final, '>'); + + DER.ElementType := deAttList; + DER.ElemDef := ElemDef; + DER.Final := Final; + DtdElementFound (DER); +END; + + +PROCEDURE TXmlParser.AnalyzeEntityDecl (Start : PChar; VAR Final : PChar); + (* Parse <!ENTITY declaration starting at "Start" + Final must point to the terminating '>' character + XmlSpec 4.2: + EntityDecl ::= '<!ENTITY' S Name S EntityDef S? '>' | + '<!ENTITY' S '%' S Name S PEDef S? '>' + EntityDef ::= EntityValue | (ExternalID NDataDecl?) + PEDef ::= EntityValue | ExternalID + NDataDecl ::= S 'NDATA' S Name + EntityValue ::= '"' ([^%&"] | PEReference | EntityRef | CharRef)* '"' | + "'" ([^%&'] | PEReference | EntityRef | CharRef)* "'" + PEReference ::= '%' Name ';' + + Examples + <!ENTITY test1 "Stefan Heymann"> <!-- Internal, general, parsed --> + <!ENTITY test2 SYSTEM "ent2.xml"> <!-- External, general, parsed --> + <!ENTITY test2 SYSTEM "ent3.gif" NDATA gif> <!-- External, general, unparsed --> + <!ENTITY % test3 "<!ELEMENT q ANY>"> <!-- Internal, parameter --> + <!ENTITY % test6 SYSTEM "ent6.xml"> <!-- External, parameter --> + <!ENTITY test4 "&test1; ist lieb"> <!-- IGP, Replacement text <> literal value --> + <!ENTITY test5 "<p>Dies ist ein Test-Absatz</p>"> <!-- IGP, See XmlSpec 2.4 --> + *) +TYPE + TPhase = (phName, phContent, phNData, phNotationName, phFinalGT); +VAR + Phase : TPhase; + IsParamEntity : BOOLEAN; + F : PChar; + ExternalID : TExternalID; + EntityDef : TEntityDef; + EntityDef2 : TEntityDef; + DER : TDtdElementRec; +BEGIN + Final := Start + 8; // First char after <!ENTITY + DER.Start := Start; + Phase := phName; + IsParamEntity := FALSE; + EntityDef := TEntityDef.Create; + REPEAT + IF NOT (Final^ IN CWhitespace) THEN + CASE Final^ OF + '%' : IsParamEntity := TRUE; + '>' : BREAK; + ELSE CASE Phase OF + phName : IF Final^ IN CNameStart THEN BEGIN + ExtractName (Final, CWhitespace + CQuoteChar, F); + SetStringSF (EntityDef.Name, Final, F); + Final := F; + Phase := phContent; + END; + phContent : IF Final^ IN CQuoteChar THEN BEGIN + ExtractQuote (Final, EntityDef.Value, Final); + Phase := phFinalGT; + END + ELSE IF (StrLComp (Final, 'SYSTEM', 6) = 0) OR + (StrLComp (Final, 'PUBLIC', 6) = 0) THEN BEGIN + ExternalID := TExternalID.Create (Final); + EntityDef.SystemId := ExternalID.SystemId; + EntityDef.PublicId := ExternalID.PublicId; + Final := ExternalID.Final; + Phase := phNData; + ExternalID.Free; + END; + phNData : IF StrLComp (Final, 'NDATA', 5) = 0 THEN BEGIN + INC (Final, 4); + Phase := phNotationName; + END; + phNotationName : IF Final^ IN CNameStart THEN BEGIN + ExtractName (Final, CWhitespace + ['>'], F); + SetStringSF (EntityDef.NotationName, Final, F); + Final := F; + Phase := phFinalGT; + END; + phFinalGT : ; // -!- There is an error in the document if this branch is called + END; + END; + INC (Final); + UNTIL FALSE; + IF IsParamEntity THEN BEGIN + EntityDef2 := TEntityDef (ParEntities.Node (EntityDef.Name)); + IF EntityDef2 <> NIL THEN + ParEntities.Delete (ParEntities.IndexOf (EntityDef2)); + ParEntities.Add (EntityDef); + ReplaceCharacterEntities (EntityDef.Value); + END + ELSE BEGIN + EntityDef2 := TEntityDef (Entities.Node (EntityDef.Name)); + IF EntityDef2 <> NIL THEN + Entities.Delete (Entities.IndexOf (EntityDef2)); + Entities.Add (EntityDef); + ReplaceParameterEntities (EntityDef.Value); // Create replacement texts (see XmlSpec 4.5) + ReplaceCharacterEntities (EntityDef.Value); + END; + Final := StrScanE (Final, '>'); + + DER.ElementType := deEntity; + DER.EntityDef := EntityDef; + DER.Final := Final; + DtdElementFound (DER); +END; + + +PROCEDURE TXmlParser.AnalyzeNotationDecl (Start : PChar; VAR Final : PChar); + // Parse <!NOTATION declaration starting at "Start" + // Final must point to the terminating '>' character + // XmlSpec 4.7: NotationDecl ::= '<!NOTATION' S Name S (ExternalID | PublicID) S? '>' +TYPE + TPhase = (phName, phExtId, phEnd); +VAR + ExternalID : TExternalID; + Phase : TPhase; + F : PChar; + NotationDef : TNotationDef; + DER : TDtdElementRec; +BEGIN + Final := Start + 10; // Character after <!NOTATION + DER.Start := Start; + Phase := phName; + NotationDef := TNotationDef.Create; + REPEAT + IF NOT (Final^ IN CWhitespace) THEN + CASE Final^ OF + '>', + #0 : BREAK; + ELSE CASE Phase OF + phName : BEGIN + ExtractName (Final, CWhitespace + ['>'], F); + SetStringSF (NotationDef.Name, Final, F); + Final := F; + Phase := phExtId; + END; + phExtId : BEGIN + ExternalID := TExternalID.Create (Final); + NotationDef.Value := ExternalID.SystemId; + NotationDef.PublicId := ExternalID.PublicId; + Final := ExternalId.Final; + ExternalId.Free; + Phase := phEnd; + END; + phEnd : ; // -!- There is an error in the document if this branch is called + END; + END; + INC (Final); + UNTIL FALSE; + Notations.Add (NotationDef); + Final := StrScanE (Final, '>'); + + DER.ElementType := deNotation; + DER.NotationDef := NotationDef; + DER.Final := Final; + DtdElementFound (DER); +END; + + +PROCEDURE TXmlParser.PushPE (VAR Start : PChar); + (* If there is a parameter entity reference found in the data stream, + the current position will be pushed to the entity stack. + Start: IN Pointer to the '%' character starting the PE reference + OUT Pointer to first character of PE replacement text *) +VAR + P : PChar; + EntityDef : TEntityDef; +BEGIN + P := StrScan (Start, ';'); + IF P <> NIL THEN BEGIN + EntityDef := TEntityDef (ParEntities.Node (StrSFPas (Start+1, P-1))); + IF EntityDef <> NIL THEN BEGIN + EntityStack.Push (P+1); + Start := PChar (EntityDef.Value); + END + ELSE + Start := P+1; + END; +END; + + +PROCEDURE TXmlParser.ReplaceCharacterEntities (VAR Str : STRING); + // Replaces all Character Entity References in the String +VAR + Start : INTEGER; + PAmp : PChar; + PSemi : PChar; + PosAmp : INTEGER; + Len : INTEGER; // Length of Entity Reference +BEGIN + IF Str = '' THEN EXIT; + Start := 1; + REPEAT + PAmp := StrPos (PChar (Str) + Start-1, '&#'); + IF PAmp = NIL THEN BREAK; + PSemi := StrScan (PAmp+2, ';'); + IF PSemi = NIL THEN BREAK; + PosAmp := PAmp - PChar (Str) + 1; + Len := PSemi-PAmp+1; + IF CompareText (Str [PosAmp+2], 'x') = 0 // !!! Can't use "CHR" for Unicode characters > 255 + THEN Str [PosAmp] := CHR (StrToIntDef ('$'+Copy (Str, PosAmp+3, Len-4), 0)) + ELSE Str [PosAmp] := CHR (StrToIntDef (Copy (Str, PosAmp+2, Len-3), 32)); + Delete (Str, PosAmp+1, Len-1); + Start := PosAmp + 1; + UNTIL FALSE; +END; + + +PROCEDURE TXmlParser.ReplaceParameterEntities (VAR Str : STRING); + // Recursively replaces all Parameter Entity References in the String + PROCEDURE ReplaceEntities (VAR Str : STRING); + VAR + Start : INTEGER; + PAmp : PChar; + PSemi : PChar; + PosAmp : INTEGER; + Len : INTEGER; + Entity : TEntityDef; + Repl : STRING; // Replacement + BEGIN + IF Str = '' THEN EXIT; + Start := 1; + REPEAT + PAmp := StrPos (PChar (Str)+Start-1, '%'); + IF PAmp = NIL THEN BREAK; + PSemi := StrScan (PAmp+2, ';'); + IF PSemi = NIL THEN BREAK; + PosAmp := PAmp - PChar (Str) + 1; + Len := PSemi-PAmp+1; + Entity := TEntityDef (ParEntities.Node (Copy (Str, PosAmp+1, Len-2))); + IF Entity <> NIL THEN BEGIN + Repl := Entity.Value; + ReplaceEntities (Repl); // Recursion + END + ELSE + Repl := Copy (Str, PosAmp, Len); + Delete (Str, PosAmp, Len); + Insert (Repl, Str, PosAmp); + Start := PosAmp + Length (Repl); + UNTIL FALSE; + END; +BEGIN + ReplaceEntities (Str); +END; + + +PROCEDURE TXmlParser.ReplaceGeneralEntities (VAR Str : STRING); + // Recursively replaces General Entity References in the String + PROCEDURE ReplaceEntities (VAR Str : STRING); + VAR + Start : INTEGER; + PAmp : PChar; + PSemi : PChar; + PosAmp : INTEGER; + Len : INTEGER; + EntityDef : TEntityDef; + EntName : STRING; + Repl : STRING; // Replacement + ExternalEntity : TXmlParser; + BEGIN + IF Str = '' THEN EXIT; + Start := 1; + REPEAT + PAmp := StrPos (PChar (Str)+Start-1, '&'); + IF PAmp = NIL THEN BREAK; + PSemi := StrScan (PAmp+2, ';'); + IF PSemi = NIL THEN BREAK; + PosAmp := PAmp - PChar (Str) + 1; + Len := PSemi-PAmp+1; + EntName := Copy (Str, PosAmp+1, Len-2); + IF EntName = 'lt' THEN Repl := '<' + ELSE IF EntName = 'gt' THEN Repl := '>' + ELSE IF EntName = 'amp' THEN Repl := '&' + ELSE IF EntName = 'apos' THEN Repl := '''' + ELSE IF EntName = 'quot' THEN Repl := '"' + ELSE BEGIN + EntityDef := TEntityDef (Entities.Node (EntName)); + IF EntityDef <> NIL THEN BEGIN + IF EntityDef.Value <> '' THEN // Internal Entity + Repl := EntityDef.Value + ELSE BEGIN // External Entity + ExternalEntity := LoadExternalEntity (EntityDef.SystemId, EntityDef.PublicId, EntityDef.NotationName); + Repl := StrPas (ExternalEntity.DocBuffer); // !!! What if it contains a Text Declaration? + ExternalEntity.Free; + END; + ReplaceEntities (Repl); // Recursion + END + ELSE + Repl := Copy (Str, PosAmp, Len); + END; + Delete (Str, PosAmp, Len); + Insert (Repl, Str, PosAmp); + Start := PosAmp + Length (Repl); + UNTIL FALSE; + END; +BEGIN + ReplaceEntities (Str); +END; + + +FUNCTION TXmlParser.LoadExternalEntity (SystemId, PublicId, Notation : STRING) : TXmlParser; + // This will be called whenever there is a Parsed External Entity or + // the DTD External Subset to be parsed. + // It has to create a TXmlParser instance and load the desired Entity. + // This instance of LoadExternalEntity assumes that "SystemId" is a valid + // file name (relative to the Document source) and loads this file using + // the LoadFromFile method. +VAR + Filename : STRING; +BEGIN + // --- Convert System ID to complete filename + Filename := StringReplace (SystemId, '/', '\', [rfReplaceAll]); + IF Copy (FSource, 1, 1) <> '<' THEN + IF (Copy (Filename, 1, 2) = '\\') OR (Copy (Filename, 2, 1) = ':') THEN + // Already has an absolute Path + ELSE BEGIN + Filename := ExtractFilePath (FSource) + Filename; + END; + + // --- Load the File + Result := TXmlParser.Create; + Result.LoadFromFile (Filename); +END; + + +FUNCTION TXmlParser.TranslateEncoding (CONST Source : STRING) : STRING; + // The member variable "CurEncoding" always holds the name of the current + // encoding, e.g. 'UTF-8' or 'ISO-8859-1'. + // This virtual method "TranslateEncoding" is responsible for translating + // the content passed in the "Source" parameter to the Encoding which + // is expected by the application. + // This instance of "TranlateEncoding" assumes that the Application expects + // Windows ANSI (Win1252) strings. It is able to transform UTF-8 or ISO-8859-1 + // encodings. + // If you want your application to understand or create other encodings, you + // override this function. +BEGIN + IF CurEncoding = 'UTF-8' + THEN Result := Utf8ToAnsi (Source) + ELSE Result := Source; +END; + + +PROCEDURE TXmlParser.DtdElementFound (DtdElementRec : TDtdElementRec); + // This method is called for every element which is found in the DTD + // declaration. The variant record TDtdElementRec is passed which + // holds informations about the element. + // You can override this function to handle DTD declarations. + // Note that when you parse the same Document instance a second time, + // the DTD will not get parsed again. +BEGIN +END; + + +FUNCTION TXmlParser.GetDocBuffer: PChar; + // Returns FBuffer or a pointer to a NUL char if Buffer is empty +BEGIN + IF FBuffer = NIL + THEN Result := #0 + ELSE Result := FBuffer; +END; + + +(*$IFNDEF HAS_CONTNRS_UNIT +=============================================================================================== +TObjectList +=============================================================================================== +*) + +DESTRUCTOR TObjectList.Destroy; +BEGIN + Clear; + SetCapacity(0); + INHERITED Destroy; +END; + + +PROCEDURE TObjectList.Delete (Index : INTEGER); +BEGIN + IF (Index < 0) OR (Index >= Count) THEN EXIT; + TObject (Items [Index]).Free; + INHERITED Delete (Index); +END; + + +PROCEDURE TObjectList.Clear; +BEGIN + WHILE Count > 0 DO + Delete (Count-1); +END; + +(*$ENDIF *) + +(* +=============================================================================================== +TNvpNode +-------- +Node base class for the TNvpList +=============================================================================================== +*) + +CONSTRUCTOR TNvpNode.Create (TheName, TheValue : STRING); +BEGIN + INHERITED Create; + Name := TheName; + Value := TheValue; +END; + + +(* +=============================================================================================== +TNvpList +-------- +A generic List of Name-Value Pairs, based on the TObjectList introduced in Delphi 5 +=============================================================================================== +*) + +PROCEDURE TNvpList.Add (Node : TNvpNode); +VAR + I : INTEGER; +BEGIN + FOR I := Count-1 DOWNTO 0 DO + IF Node.Name > TNvpNode (Items [I]).Name THEN BEGIN + Insert (I+1, Node); + EXIT; + END; + Insert (0, Node); +END; + + + +FUNCTION TNvpList.Node (Name : STRING) : TNvpNode; + // Binary search for Node +VAR + L, H : INTEGER; // Low, High Limit + T, C : INTEGER; // Test Index, Comparison result + Last : INTEGER; // Last Test Index +BEGIN + IF Count=0 THEN BEGIN + Result := NIL; + EXIT; + END; + + L := 0; + H := Count; + Last := -1; + REPEAT + T := (L+H) DIV 2; + IF T=Last THEN BREAK; + Result := TNvpNode (Items [T]); + C := CompareStr (Result.Name, Name); + IF C = 0 THEN EXIT + ELSE IF C < 0 THEN L := T + ELSE H := T; + Last := T; + UNTIL FALSE; + Result := NIL; +END; + + +FUNCTION TNvpList.Node (Index : INTEGER) : TNvpNode; +BEGIN + IF (Index < 0) OR (Index >= Count) + THEN Result := NIL + ELSE Result := TNvpNode (Items [Index]); +END; + + +FUNCTION TNvpList.Value (Name : STRING) : STRING; +VAR + Nvp : TNvpNode; +BEGIN + Nvp := TNvpNode (Node (Name)); + IF Nvp <> NIL + THEN Result := Nvp.Value + ELSE Result := ''; +END; + + +FUNCTION TNvpList.Value (Index : INTEGER) : STRING; +BEGIN + IF (Index < 0) OR (Index >= Count) + THEN Result := '' + ELSE Result := TNvpNode (Items [Index]).Value; +END; + + +FUNCTION TNvpList.Name (Index : INTEGER) : STRING; +BEGIN + IF (Index < 0) OR (Index >= Count) + THEN Result := '' + ELSE Result := TNvpNode (Items [Index]).Name; +END; + + +(* +=============================================================================================== +TAttrList +List of Attributes. The "Analyze" method extracts the Attributes from the given Buffer. +Is used for extraction of Attributes in Start-Tags, Empty-Element Tags and the "pseudo" +attributes in XML Prologs, Text Declarations and PIs. +=============================================================================================== +*) + +PROCEDURE TAttrList.Analyze (Start : PChar; VAR Final : PChar); + // Analyze the Buffer for Attribute=Name pairs. + // Terminates when there is a character which is not IN CNameStart + // (e.g. '?>' or '>' or '/>') +TYPE + TPhase = (phName, phEq, phValue); +VAR + Phase : TPhase; + F : PChar; + Name : STRING; + Value : STRING; + Attr : TAttr; +BEGIN + Clear; + Phase := phName; + Final := Start; + REPEAT + IF (Final^ = #0) OR (Final^ = '>') THEN BREAK; + IF NOT (Final^ IN CWhitespace) THEN + CASE Phase OF + phName : BEGIN + IF NOT (Final^ IN CNameStart) THEN EXIT; + ExtractName (Final, CWhitespace + ['=', '/'], F); + SetStringSF (Name, Final, F); + Final := F; + Phase := phEq; + END; + phEq : BEGIN + IF Final^ = '=' THEN + Phase := phValue + END; + phValue : BEGIN + IF Final^ IN CQuoteChar THEN BEGIN + ExtractQuote (Final, Value, F); + Attr := TAttr.Create; + Attr.Name := Name; + Attr.Value := Value; + Attr.ValueType := vtNormal; + Add (Attr); + Final := F; + Phase := phName; + END; + END; + END; + INC (Final); + UNTIL FALSE; +END; + + +(* +=============================================================================================== +TElemList +List of TElemDef nodes. +=============================================================================================== +*) + +FUNCTION TElemList.Node (Name : STRING) : TElemDef; + // Binary search for the Node with the given Name +VAR + L, H : INTEGER; // Low, High Limit + T, C : INTEGER; // Test Index, Comparison result + Last : INTEGER; // Last Test Index +BEGIN + IF Count=0 THEN BEGIN + Result := NIL; + EXIT; + END; + + L := 0; + H := Count; + Last := -1; + REPEAT + T := (L+H) DIV 2; + IF T=Last THEN BREAK; + Result := TElemDef (Items [T]); + C := CompareStr (Result.Name, Name); + IF C = 0 THEN EXIT + ELSE IF C < 0 THEN L := T + ELSE H := T; + Last := T; + UNTIL FALSE; + Result := NIL; +END; + + +PROCEDURE TElemList.Add (Node : TElemDef); +VAR + I : INTEGER; +BEGIN + FOR I := Count-1 DOWNTO 0 DO + IF Node.Name > TElemDef (Items [I]).Name THEN BEGIN + Insert (I+1, Node); + EXIT; + END; + Insert (0, Node); +END; + + +(* +=============================================================================================== +TScannerXmlParser +A TXmlParser descendant for the TCustomXmlScanner component +=============================================================================================== +*) + +TYPE + TScannerXmlParser = CLASS (TXmlParser) + Scanner : TCustomXmlScanner; + CONSTRUCTOR Create (TheScanner : TCustomXmlScanner); + FUNCTION LoadExternalEntity (SystemId, PublicId, + Notation : STRING) : TXmlParser; OVERRIDE; + FUNCTION TranslateEncoding (CONST Source : STRING) : STRING; OVERRIDE; + PROCEDURE DtdElementFound (DtdElementRec : TDtdElementRec); OVERRIDE; + END; + +CONSTRUCTOR TScannerXmlParser.Create (TheScanner : TCustomXmlScanner); +BEGIN + INHERITED Create; + Scanner := TheScanner; +END; + + +FUNCTION TScannerXmlParser.LoadExternalEntity (SystemId, PublicId, Notation : STRING) : TXmlParser; +BEGIN + IF Assigned (Scanner.FOnLoadExternal) + THEN Scanner.FOnLoadExternal (Scanner, SystemId, PublicId, Notation, Result) + ELSE Result := INHERITED LoadExternalEntity (SystemId, PublicId, Notation); +END; + + +FUNCTION TScannerXmlParser.TranslateEncoding (CONST Source : STRING) : STRING; +BEGIN + IF Assigned (Scanner.FOnTranslateEncoding) + THEN Result := Scanner.FOnTranslateEncoding (Scanner, CurEncoding, Source) + ELSE Result := INHERITED TranslateEncoding (Source); +END; + + +PROCEDURE TScannerXmlParser.DtdElementFound (DtdElementRec : TDtdElementRec); +BEGIN + WITH DtdElementRec DO + CASE ElementType OF + deElement : Scanner.WhenElement (ElemDef); + deAttList : Scanner.WhenAttList (ElemDef); + deEntity : Scanner.WhenEntity (EntityDef); + deNotation : Scanner.WhenNotation (NotationDef); + dePI : Scanner.WhenPI (STRING (Target), STRING (Content), AttrList); + deComment : Scanner.WhenComment (StrSFPas (Start, Final)); + deError : Scanner.WhenDtdError (Pos); + END; +END; + + +(* +=============================================================================================== +TCustomXmlScanner +=============================================================================================== +*) + +CONSTRUCTOR TCustomXmlScanner.Create (AOwner: TComponent); +BEGIN + INHERITED; + FXmlParser := TScannerXmlParser.Create (Self); +END; + + +DESTRUCTOR TCustomXmlScanner.Destroy; +BEGIN + FXmlParser.Free; + INHERITED; +END; + + +PROCEDURE TCustomXmlScanner.LoadFromFile (Filename : TFilename); + // Load XML Document from file +BEGIN + FXmlParser.LoadFromFile (Filename); +END; + + +PROCEDURE TCustomXmlScanner.LoadFromBuffer (Buffer : PChar); + // Load XML Document from buffer +BEGIN + FXmlParser.LoadFromBuffer (Buffer); +END; + + +PROCEDURE TCustomXmlScanner.SetBuffer (Buffer : PChar); + // Refer to Buffer +BEGIN + FXmlParser.SetBuffer (Buffer); +END; + + +FUNCTION TCustomXmlScanner.GetFilename : TFilename; +BEGIN + Result := FXmlParser.Source; +END; + + +FUNCTION TCustomXmlScanner.GetNormalize : BOOLEAN; +BEGIN + Result := FXmlParser.Normalize; +END; + + +PROCEDURE TCustomXmlScanner.SetNormalize (Value : BOOLEAN); +BEGIN + FXmlParser.Normalize := Value; +END; + + +PROCEDURE TCustomXmlScanner.WhenXmlProlog(XmlVersion, Encoding: STRING; Standalone : BOOLEAN); + // Is called when the parser has parsed the <? xml ?> declaration of the prolog +BEGIN + IF Assigned (FOnXmlProlog) THEN FOnXmlProlog (Self, XmlVersion, Encoding, Standalone); +END; + + +PROCEDURE TCustomXmlScanner.WhenComment (Comment : STRING); + // Is called when the parser has parsed a <!-- comment --> +BEGIN + IF Assigned (FOnComment) THEN FOnComment (Self, Comment); +END; + + +PROCEDURE TCustomXmlScanner.WhenPI (Target, Content: STRING; Attributes : TAttrList); + // Is called when the parser has parsed a <?processing instruction ?> +BEGIN + IF Assigned (FOnPI) THEN FOnPI (Self, Target, Content, Attributes); +END; + + +PROCEDURE TCustomXmlScanner.WhenDtdRead (RootElementName : STRING); + // Is called when the parser has completely parsed the DTD +BEGIN + IF Assigned (FOnDtdRead) THEN FOnDtdRead (Self, RootElementName); +END; + + +PROCEDURE TCustomXmlScanner.WhenStartTag (TagName : STRING; Attributes : TAttrList); + // Is called when the parser has parsed a start tag like <p> +BEGIN + IF Assigned (FOnStartTag) THEN FOnStartTag (Self, TagName, Attributes); +END; + + +PROCEDURE TCustomXmlScanner.WhenEmptyTag (TagName : STRING; Attributes : TAttrList); + // Is called when the parser has parsed an Empty Element Tag like <br/> +BEGIN + IF Assigned (FOnEmptyTag) THEN FOnEmptyTag (Self, TagName, Attributes); +END; + + +PROCEDURE TCustomXmlScanner.WhenEndTag (TagName : STRING); + // Is called when the parser has parsed an End Tag like </p> +BEGIN + IF Assigned (FOnEndTag) THEN FOnEndTag (Self, TagName); +END; + + +PROCEDURE TCustomXmlScanner.WhenContent (Content : STRING); + // Is called when the parser has parsed an element's text content +BEGIN + IF Assigned (FOnContent) THEN FOnContent (Self, Content); +END; + + +PROCEDURE TCustomXmlScanner.WhenCData (Content : STRING); + // Is called when the parser has parsed a CDATA section +BEGIN + IF Assigned (FOnCData) THEN FOnCData (Self, Content); +END; + + +PROCEDURE TCustomXmlScanner.WhenElement (ElemDef : TElemDef); + // Is called when the parser has parsed an <!ELEMENT> definition + // inside the DTD +BEGIN + IF Assigned (FOnElement) THEN FOnElement (Self, ElemDef); +END; + + +PROCEDURE TCustomXmlScanner.WhenAttList (ElemDef : TElemDef); + // Is called when the parser has parsed an <!ATTLIST> definition + // inside the DTD +BEGIN + IF Assigned (FOnAttList) THEN FOnAttList (Self, ElemDef); +END; + + +PROCEDURE TCustomXmlScanner.WhenEntity (EntityDef : TEntityDef); + // Is called when the parser has parsed an <!ENTITY> definition + // inside the DTD +BEGIN + IF Assigned (FOnEntity) THEN FOnEntity (Self, EntityDef); +END; + + +PROCEDURE TCustomXmlScanner.WhenNotation (NotationDef : TNotationDef); + // Is called when the parser has parsed a <!NOTATION> definition + // inside the DTD +BEGIN + IF Assigned (FOnNotation) THEN FOnNotation (Self, NotationDef); +END; + + +PROCEDURE TCustomXmlScanner.WhenDtdError (ErrorPos : PChar); + // Is called when the parser has found an Error in the DTD +BEGIN + IF Assigned (FOnDtdError) THEN FOnDtdError (Self, ErrorPos); +END; + + +PROCEDURE TCustomXmlScanner.Execute; + // Perform scanning + // Scanning is done synchronously, i.e. you can expect events to be triggered + // in the order of the XML data stream. Execute will finish when the whole XML + // document has been scanned or when the StopParser property has been set to TRUE. +BEGIN + FStopParser := FALSE; + FXmlParser.StartScan; + WHILE FXmlParser.Scan AND (NOT FStopParser) DO + CASE FXmlParser.CurPartType OF + ptNone : ; + ptXmlProlog : WhenXmlProlog (FXmlParser.XmlVersion, FXmlParser.Encoding, FXmlParser.Standalone); + ptComment : WhenComment (StrSFPas (FXmlParser.CurStart, FXmlParser.CurFinal)); + ptPI : WhenPI (FXmlParser.CurName, FXmlParser.CurContent, FXmlParser.CurAttr); + ptDtdc : WhenDtdRead (FXmlParser.RootName); + ptStartTag : WhenStartTag (FXmlParser.CurName, FXmlParser.CurAttr); + ptEmptyTag : WhenEmptyTag (FXmlParser.CurName, FXmlParser.CurAttr); + ptEndTag : WhenEndTag (FXmlParser.CurName); + ptContent : WhenContent (FXmlParser.CurContent); + ptCData : WhenCData (FXmlParser.CurContent); + END; +END; + + +END. diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/logger.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/logger.pas index 461fa261..ad9b24e6 100644 --- a/Game/Code/lib/JEDI-SDL/SDL/Pas/logger.pas +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/logger.pas @@ -1,189 +1,189 @@ -unit logger;
-{
- $Id: logger.pas,v 1.2 2006/11/26 16:58:04 savage Exp $
-
-}
-{******************************************************************************}
-{ }
-{ Error Logging Unit }
-{ }
-{ The initial developer of this Pascal code was : }
-{ Dominique Louis <Dominique@SavageSoftware.com.au> }
-{ }
-{ Portions created by Dominique Louis are }
-{ Copyright (C) 2000 - 2001 Dominique Louis. }
-{ }
-{ }
-{ }
-{ Contributor(s) }
-{ -------------- }
-{ }
-{ }
-{ Obtained through: }
-{ Joint Endeavour of Delphi Innovators ( Project JEDI ) }
-{ }
-{ You may retrieve the latest version of this file at the Project }
-{ JEDI home page, located at http://delphi-jedi.org }
-{ }
-{ The contents of this file are used with permission, subject to }
-{ the Mozilla Public License Version 1.1 (the "License"); you may }
-{ not use this file except in compliance with the License. You may }
-{ obtain a copy of the License at }
-{ http://www.mozilla.org/MPL/MPL-1.1.html }
-{ }
-{ Software distributed under the License is distributed on an }
-{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or }
-{ implied. See the License for the specific language governing }
-{ rights and limitations under the License. }
-{ }
-{ Description }
-{ ----------- }
-{ Logging functions... }
-{ }
-{ }
-{ Requires }
-{ -------- }
-{ SDL.dll on Windows platforms }
-{ libSDL-1.1.so.0 on Linux platform }
-{ }
-{ Programming Notes }
-{ ----------------- }
-{ }
-{ }
-{ }
-{ }
-{ Revision History }
-{ ---------------- }
-{ 2001 - DL : Initial creation }
-{ 25/10/2001 - DRE : Added $M+ directive to allow published }
-{ in classes. Added a compile directive }
-{ around fmShareExclusive as this does not }
-{ exist in Free Pascal }
-{ }
-{******************************************************************************}
-{
- $Log: logger.pas,v $
- Revision 1.2 2006/11/26 16:58:04 savage
- Modifed to create separate log files. Therefore each instance running from the same directory will have their own individual log file, prepended with a number.
-
- Revision 1.1 2004/02/05 00:08:20 savage
- Module 1.0 release
-
-
-}
-
-{$I jedi-sdl.inc}
-
-{$WEAKPACKAGEUNIT OFF}
-
-interface
-
-uses
- Classes,
- SysUtils;
-
-type
- TLogger = class
- private
- FFileHandle : TextFile;
- FApplicationName : string;
- FApplicationPath : string;
- protected
-
- public
- constructor Create;
- destructor Destroy; override;
- function GetApplicationName: string;
- function GetApplicationPath: string;
- procedure LogError( ErrorMessage : string; Location : string );
- procedure LogWarning( WarningMessage : string; Location : string );
- procedure LogStatus( StatusMessage : string; Location : string );
- published
- property ApplicationName : string read GetApplicationName;
- property ApplicationPath : string read GetApplicationPath;
- end;
-
-var
- Log : TLogger;
-
-implementation
-
-{ TLogger }
-constructor TLogger.Create;
-var
- FileName : string;
- FileNo : integer;
-begin
- FApplicationName := ExtractFileName( ParamStr(0) );
- FApplicationPath := ExtractFilePath( ParamStr(0) );
- FileName := FApplicationPath + ChangeFileExt( FApplicationName, '.log' );
- FileNo := 0;
- while FileExists( FileName ) do
- begin
- inc( FileNo );
- FileName := FApplicationPath + IntToStr( FileNo ) + ChangeFileExt( FApplicationName, '.log' )
- end;
- AssignFile( FFileHandle, FileName );
- ReWrite( FFileHandle );
- (*inherited Create( FApplicationPath + ChangeFileExt( FApplicationName, '.log' ),
- fmCreate {$IFNDEF FPC}or fmShareExclusive{$ENDIF} );*)
-end;
-
-destructor TLogger.Destroy;
-begin
- CloseFile( FFileHandle );
- inherited;
-end;
-
-function TLogger.GetApplicationName: string;
-begin
- result := FApplicationName;
-end;
-
-function TLogger.GetApplicationPath: string;
-begin
- result := FApplicationPath;
-end;
-
-procedure TLogger.LogError(ErrorMessage, Location: string);
-var
- S : string;
-begin
- S := '*** ERROR *** : @ ' + TimeToStr(Time) + ' MSG : ' + ErrorMessage + ' IN : ' + Location + #13#10;
- WriteLn( FFileHandle, S );
- Flush( FFileHandle );
-end;
-
-procedure TLogger.LogStatus(StatusMessage, Location: string);
-var
- S : string;
-begin
- S := 'STATUS INFO : @ ' + TimeToStr(Time) + ' MSG : ' + StatusMessage + ' IN : ' + Location + #13#10;
- WriteLn( FFileHandle, S );
- Flush( FFileHandle );
-end;
-
-procedure TLogger.LogWarning(WarningMessage, Location: string);
-var
- S : string;
-begin
- S := '=== WARNING === : @ ' + TimeToStr(Time) + ' MSG : ' + WarningMessage + ' IN : ' + Location + #13#10;
- WriteLn( FFileHandle, S );
- Flush( FFileHandle );
-end;
-
-initialization
-begin
- Log := TLogger.Create;
- Log.LogStatus( 'Starting Application', 'Initialization' );
-end;
-
-finalization
-begin
- Log.LogStatus( 'Terminating Application', 'Finalization' );
- Log.Free;
- Log := nil;
-end;
-
-end.
+unit logger; +{ + $Id: logger.pas,v 1.2 2006/11/26 16:58:04 savage Exp $ + +} +{******************************************************************************} +{ } +{ Error Logging Unit } +{ } +{ The initial developer of this Pascal code was : } +{ Dominique Louis <Dominique@SavageSoftware.com.au> } +{ } +{ Portions created by Dominique Louis are } +{ Copyright (C) 2000 - 2001 Dominique Louis. } +{ } +{ } +{ } +{ Contributor(s) } +{ -------------- } +{ } +{ } +{ Obtained through: } +{ Joint Endeavour of Delphi Innovators ( Project JEDI ) } +{ } +{ You may retrieve the latest version of this file at the Project } +{ JEDI home page, located at http://delphi-jedi.org } +{ } +{ The contents of this file are used with permission, subject to } +{ the Mozilla Public License Version 1.1 (the "License"); you may } +{ not use this file except in compliance with the License. You may } +{ obtain a copy of the License at } +{ http://www.mozilla.org/MPL/MPL-1.1.html } +{ } +{ Software distributed under the License is distributed on an } +{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or } +{ implied. See the License for the specific language governing } +{ rights and limitations under the License. } +{ } +{ Description } +{ ----------- } +{ Logging functions... } +{ } +{ } +{ Requires } +{ -------- } +{ SDL.dll on Windows platforms } +{ libSDL-1.1.so.0 on Linux platform } +{ } +{ Programming Notes } +{ ----------------- } +{ } +{ } +{ } +{ } +{ Revision History } +{ ---------------- } +{ 2001 - DL : Initial creation } +{ 25/10/2001 - DRE : Added $M+ directive to allow published } +{ in classes. Added a compile directive } +{ around fmShareExclusive as this does not } +{ exist in Free Pascal } +{ } +{******************************************************************************} +{ + $Log: logger.pas,v $ + Revision 1.2 2006/11/26 16:58:04 savage + Modifed to create separate log files. Therefore each instance running from the same directory will have their own individual log file, prepended with a number. + + Revision 1.1 2004/02/05 00:08:20 savage + Module 1.0 release + + +} + +{$I jedi-sdl.inc} + +{$WEAKPACKAGEUNIT OFF} + +interface + +uses + Classes, + SysUtils; + +type + TLogger = class + private + FFileHandle : TextFile; + FApplicationName : string; + FApplicationPath : string; + protected + + public + constructor Create; + destructor Destroy; override; + function GetApplicationName: string; + function GetApplicationPath: string; + procedure LogError( ErrorMessage : string; Location : string ); + procedure LogWarning( WarningMessage : string; Location : string ); + procedure LogStatus( StatusMessage : string; Location : string ); + published + property ApplicationName : string read GetApplicationName; + property ApplicationPath : string read GetApplicationPath; + end; + +var + Log : TLogger; + +implementation + +{ TLogger } +constructor TLogger.Create; +var + FileName : string; + FileNo : integer; +begin + FApplicationName := ExtractFileName( ParamStr(0) ); + FApplicationPath := ExtractFilePath( ParamStr(0) ); + FileName := FApplicationPath + ChangeFileExt( FApplicationName, '.log' ); + FileNo := 0; + while FileExists( FileName ) do + begin + inc( FileNo ); + FileName := FApplicationPath + IntToStr( FileNo ) + ChangeFileExt( FApplicationName, '.log' ) + end; + AssignFile( FFileHandle, FileName ); + ReWrite( FFileHandle ); + (*inherited Create( FApplicationPath + ChangeFileExt( FApplicationName, '.log' ), + fmCreate {$IFNDEF FPC}or fmShareExclusive{$ENDIF} );*) +end; + +destructor TLogger.Destroy; +begin + CloseFile( FFileHandle ); + inherited; +end; + +function TLogger.GetApplicationName: string; +begin + result := FApplicationName; +end; + +function TLogger.GetApplicationPath: string; +begin + result := FApplicationPath; +end; + +procedure TLogger.LogError(ErrorMessage, Location: string); +var + S : string; +begin + S := '*** ERROR *** : @ ' + TimeToStr(Time) + ' MSG : ' + ErrorMessage + ' IN : ' + Location + #13#10; + WriteLn( FFileHandle, S ); + Flush( FFileHandle ); +end; + +procedure TLogger.LogStatus(StatusMessage, Location: string); +var + S : string; +begin + S := 'STATUS INFO : @ ' + TimeToStr(Time) + ' MSG : ' + StatusMessage + ' IN : ' + Location + #13#10; + WriteLn( FFileHandle, S ); + Flush( FFileHandle ); +end; + +procedure TLogger.LogWarning(WarningMessage, Location: string); +var + S : string; +begin + S := '=== WARNING === : @ ' + TimeToStr(Time) + ' MSG : ' + WarningMessage + ' IN : ' + Location + #13#10; + WriteLn( FFileHandle, S ); + Flush( FFileHandle ); +end; + +initialization +begin + Log := TLogger.Create; + Log.LogStatus( 'Starting Application', 'Initialization' ); +end; + +finalization +begin + Log.LogStatus( 'Terminating Application', 'Finalization' ); + Log.Free; + Log := nil; +end; + +end.
\ No newline at end of file diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/moduleloader.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/moduleloader.pas index 146e4b30..56863ea5 100644 --- a/Game/Code/lib/JEDI-SDL/SDL/Pas/moduleloader.pas +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/moduleloader.pas @@ -1,319 +1,319 @@ -unit moduleloader;
-{
- $Id: moduleloader.pas,v 1.4 2004/02/20 17:19:10 savage Exp $
-
-}
-{******************************************************************}
-{ }
-{ Project JEDI }
-{ OS independent Dynamic Loading Helpers }
-{ }
-{ The initial developer of the this code is }
-{ Robert Marquardt <robert_marquardt@gmx.de) }
-{ }
-{ Copyright (C) 2000, 2001 Robert Marquardt. }
-{ }
-{ Obtained through: }
-{ Joint Endeavour of Delphi Innovators (Project JEDI) }
-{ }
-{ You may retrieve the latest version of this file at the Project }
-{ JEDI home page, located at http://delphi-jedi.org }
-{ }
-{ The contents of this file are used with permission, subject to }
-{ the Mozilla Public License Version 1.1 (the "License"); you may }
-{ not use this file except in compliance with the License. You may }
-{ obtain a copy of the License at }
-{ http://www.mozilla.org/NPL/NPL-1_1Final.html }
-{ }
-{ Software distributed under the License is distributed on an }
-{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or }
-{ implied. See the License for the specific language governing }
-{ rights and limitations under the License. }
-{ }
-{******************************************************************}
-{
- $Log: moduleloader.pas,v $
- Revision 1.4 2004/02/20 17:19:10 savage
- Added Calling convention to Win32 functions just in case.
-
- Revision 1.3 2004/02/14 22:36:29 savage
- Fixed inconsistencies of using LoadLibrary and LoadModule.
- Now all units make use of LoadModule rather than LoadLibrary and other dynamic proc procedures.
-
- Revision 1.2 2004/02/14 00:23:39 savage
- As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change.
-
- Revision 1.1 2004/02/14 00:04:50 savage
- dllfuncs conflicts with FreePascal so it has been renamed back to the moduleloader.pas
-
- Revision 1.1 2004/02/05 00:08:19 savage
- Module 1.0 release
-
-
-}
-
-interface
-
-{$i jedi-sdl.inc}
-{$WEAKPACKAGEUNIT ON}
-
-// each OS gets its own IFDEFed complete code block to make reading easier
-
-{$IFDEF WIN32}
-uses
- Windows;
-
-type
- // Handle to a loaded DLL
- TModuleHandle = HINST;
-
-const
- // Value designating an unassigned TModuleHandle od a failed loading
- INVALID_MODULEHANDLE_VALUE = TModuleHandle(0);
-
-function LoadModule(var Module: TModuleHandle; FileName: PChar): Boolean; stdcall;
-function LoadModuleEx(var Module: TModuleHandle; FileName: PChar; Flags: Cardinal): Boolean; stdcall;
-procedure UnloadModule(var Module: TModuleHandle); stdcall;
-function GetModuleSymbol(Module: TModuleHandle; SymbolName: PChar): Pointer; stdcall;
-function GetModuleSymbolEx(Module: TModuleHandle; SymbolName: PChar; var Accu: Boolean): Pointer; stdcall;
-function ReadModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean; stdcall;
-function WriteModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean; stdcall;
-
-implementation
-
-// load the DLL file FileName
-// the rules for FileName are those of LoadLibrary
-// Returns: True = success, False = failure to load
-// Assigns: the handle of the loaded DLL to Module
-// Warning: if Module has any other value than INVALID_MODULEHANDLE_VALUE
-// on entry the function will do nothing but returning success.
-
-function LoadModule(var Module: TModuleHandle; FileName: PChar): Boolean;
-begin
- if Module = INVALID_MODULEHANDLE_VALUE then
- Module := LoadLibrary( FileName );
- Result := Module <> INVALID_MODULEHANDLE_VALUE;
-end;
-
-// load the DLL file FileName
-// LoadLibraryEx is used to get better control of the loading
-// for the allowed values for flags see LoadLibraryEx documentation.
-
-function LoadModuleEx(var Module: TModuleHandle; FileName: PChar; Flags: Cardinal): Boolean;
-begin
- if Module = INVALID_MODULEHANDLE_VALUE then
- Module := LoadLibraryEx( FileName, 0, Flags);
- Result := Module <> INVALID_MODULEHANDLE_VALUE;
-end;
-
-// unload a DLL loaded with LoadModule or LoadModuleEx
-// The procedure will not try to unload a handle with
-// value INVALID_MODULEHANDLE_VALUE and assigns this value
-// to Module after unload.
-
-procedure UnloadModule(var Module: TModuleHandle);
-begin
- if Module <> INVALID_MODULEHANDLE_VALUE then
- FreeLibrary(Module);
- Module := INVALID_MODULEHANDLE_VALUE;
-end;
-
-// returns the pointer to the symbol named SymbolName
-// if it is exported from the DLL Module
-// nil is returned if the symbol is not available
-
-function GetModuleSymbol(Module: TModuleHandle; SymbolName: PChar): Pointer;
-begin
- Result := nil;
- if Module <> INVALID_MODULEHANDLE_VALUE then
- Result := GetProcAddress(Module, SymbolName );
-end;
-
-// returns the pointer to the symbol named SymbolName
-// if it is exported from the DLL Module
-// nil is returned if the symbol is not available.
-// as an extra the boolean variable Accu is updated
-// by anding in the success of the function.
-// This is very handy for rendering a global result
-// when accessing a long list of symbols.
-
-function GetModuleSymbolEx(Module: TModuleHandle; SymbolName: PChar; var Accu: Boolean): Pointer;
-begin
- Result := nil;
- if Module <> INVALID_MODULEHANDLE_VALUE then
- Result := GetProcAddress(Module, SymbolName );
- Accu := Accu and (Result <> nil);
-end;
-
-// get the value of variables exported from a DLL Module
-// Delphi cannot access variables in a DLL directly, so
-// this function allows to copy the data from the DLL.
-// Beware! You are accessing the DLL memory image directly.
-// Be sure to access a variable not a function and be sure
-// to read the correct amount of data.
-
-function ReadModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean;
-var
- Sym: Pointer;
-begin
- Result := True;
- Sym := GetModuleSymbolEx(Module, SymbolName, Result);
- if Result then
- Move(Sym^, Buffer, Size);
-end;
-
-// set the value of variables exported from a DLL Module
-// Delphi cannot access variables in a DLL directly, so
-// this function allows to copy the data to the DLL!
-// BEWARE! You are accessing the DLL memory image directly.
-// Be sure to access a variable not a function and be sure
-// to write the correct amount of data.
-// The changes are not persistent. They get lost when the
-// DLL is unloaded.
-
-function WriteModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean;
-var
- Sym: Pointer;
-begin
- Result := True;
- Sym := GetModuleSymbolEx(Module, SymbolName, Result);
- if Result then
- Move(Buffer, Sym^, Size);
-end;
-
-{$ENDIF}
-
-{$IFDEF Unix}
-uses
-{$ifdef Linux}
- Types,
- Libc;
-{$else}
- dl,
- Types,
- Baseunix,
- Unix;
-{$endif}
-type
- // Handle to a loaded .so
- TModuleHandle = Pointer;
-
-const
- // Value designating an unassigned TModuleHandle od a failed loading
- INVALID_MODULEHANDLE_VALUE = TModuleHandle(nil);
-
-function LoadModule(var Module: TModuleHandle; FileName: PChar): Boolean;
-function LoadModuleEx(var Module: TModuleHandle; FileName: PChar; Flags: Cardinal): Boolean;
-procedure UnloadModule(var Module: TModuleHandle);
-function GetModuleSymbol(Module: TModuleHandle; SymbolName: PChar): Pointer;
-function GetModuleSymbolEx(Module: TModuleHandle; SymbolName: PChar; var Accu: Boolean): Pointer;
-function ReadModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean;
-function WriteModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean;
-
-implementation
-
-// load the .so file FileName
-// the rules for FileName are those of dlopen()
-// Returns: True = success, False = failure to load
-// Assigns: the handle of the loaded .so to Module
-// Warning: if Module has any other value than INVALID_MODULEHANDLE_VALUE
-// on entry the function will do nothing but returning success.
-
-function LoadModule(var Module: TModuleHandle; FileName: PChar): Boolean;
-begin
- if Module = INVALID_MODULEHANDLE_VALUE then
- Module := dlopen( FileName, RTLD_NOW);
- Result := Module <> INVALID_MODULEHANDLE_VALUE;
-end;
-
-// load the .so file FileName
-// dlopen() with flags is used to get better control of the loading
-// for the allowed values for flags see "man dlopen".
-
-function LoadModuleEx(var Module: TModuleHandle; FileName: PChar; Flags: Cardinal): Boolean;
-begin
- if Module = INVALID_MODULEHANDLE_VALUE then
- Module := dlopen( FileName, Flags);
- Result := Module <> INVALID_MODULEHANDLE_VALUE;
-end;
-
-// unload a .so loaded with LoadModule or LoadModuleEx
-// The procedure will not try to unload a handle with
-// value INVALID_MODULEHANDLE_VALUE and assigns this value
-// to Module after unload.
-
-procedure UnloadModule(var Module: TModuleHandle);
-begin
- if Module <> INVALID_MODULEHANDLE_VALUE then
- dlclose(Module);
- Module := INVALID_MODULEHANDLE_VALUE;
-end;
-
-// returns the pointer to the symbol named SymbolName
-// if it is exported from the .so Module
-// nil is returned if the symbol is not available
-
-function GetModuleSymbol(Module: TModuleHandle; SymbolName: PChar): Pointer;
-begin
- Result := nil;
- if Module <> INVALID_MODULEHANDLE_VALUE then
- Result := dlsym(Module, SymbolName );
-end;
-
-// returns the pointer to the symbol named SymbolName
-// if it is exported from the .so Module
-// nil is returned if the symbol is not available.
-// as an extra the boolean variable Accu is updated
-// by anding in the success of the function.
-// This is very handy for rendering a global result
-// when accessing a long list of symbols.
-
-function GetModuleSymbolEx(Module: TModuleHandle; SymbolName: PChar; var Accu: Boolean): Pointer;
-begin
- Result := nil;
- if Module <> INVALID_MODULEHANDLE_VALUE then
- Result := dlsym(Module, SymbolName );
- Accu := Accu and (Result <> nil);
-end;
-
-// get the value of variables exported from a .so Module
-// Delphi cannot access variables in a .so directly, so
-// this function allows to copy the data from the .so.
-// Beware! You are accessing the .so memory image directly.
-// Be sure to access a variable not a function and be sure
-// to read the correct amount of data.
-
-function ReadModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean;
-var
- Sym: Pointer;
-begin
- Result := True;
- Sym := GetModuleSymbolEx(Module, SymbolName, Result);
- if Result then
- Move(Sym^, Buffer, Size);
-end;
-
-// set the value of variables exported from a .so Module
-// Delphi cannot access variables in a .so directly, so
-// this function allows to copy the data to the .so!
-// BEWARE! You are accessing the .so memory image directly.
-// Be sure to access a variable not a function and be sure
-// to write the correct amount of data.
-// The changes are not persistent. They get lost when the
-// .so is unloaded.
-
-function WriteModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean;
-var
- Sym: Pointer;
-begin
- Result := True;
- Sym := GetModuleSymbolEx(Module, SymbolName, Result);
- if Result then
- Move(Buffer, Sym^, Size);
-end;
-{$ENDIF}
-
-{$IFDEF __MACH__} // Mach definitions go here
-{$ENDIF}
-
-end.
+unit moduleloader; +{ + $Id: moduleloader.pas,v 1.4 2004/02/20 17:19:10 savage Exp $ + +} +{******************************************************************} +{ } +{ Project JEDI } +{ OS independent Dynamic Loading Helpers } +{ } +{ The initial developer of the this code is } +{ Robert Marquardt <robert_marquardt@gmx.de) } +{ } +{ Copyright (C) 2000, 2001 Robert Marquardt. } +{ } +{ Obtained through: } +{ Joint Endeavour of Delphi Innovators (Project JEDI) } +{ } +{ You may retrieve the latest version of this file at the Project } +{ JEDI home page, located at http://delphi-jedi.org } +{ } +{ The contents of this file are used with permission, subject to } +{ the Mozilla Public License Version 1.1 (the "License"); you may } +{ not use this file except in compliance with the License. You may } +{ obtain a copy of the License at } +{ http://www.mozilla.org/NPL/NPL-1_1Final.html } +{ } +{ Software distributed under the License is distributed on an } +{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or } +{ implied. See the License for the specific language governing } +{ rights and limitations under the License. } +{ } +{******************************************************************} +{ + $Log: moduleloader.pas,v $ + Revision 1.4 2004/02/20 17:19:10 savage + Added Calling convention to Win32 functions just in case. + + Revision 1.3 2004/02/14 22:36:29 savage + Fixed inconsistencies of using LoadLibrary and LoadModule. + Now all units make use of LoadModule rather than LoadLibrary and other dynamic proc procedures. + + Revision 1.2 2004/02/14 00:23:39 savage + As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change. + + Revision 1.1 2004/02/14 00:04:50 savage + dllfuncs conflicts with FreePascal so it has been renamed back to the moduleloader.pas + + Revision 1.1 2004/02/05 00:08:19 savage + Module 1.0 release + + +} + +interface + +{$i jedi-sdl.inc} +{$WEAKPACKAGEUNIT ON} + +// each OS gets its own IFDEFed complete code block to make reading easier + +{$IFDEF WIN32} +uses + Windows; + +type + // Handle to a loaded DLL + TModuleHandle = HINST; + +const + // Value designating an unassigned TModuleHandle od a failed loading + INVALID_MODULEHANDLE_VALUE = TModuleHandle(0); + +function LoadModule(var Module: TModuleHandle; FileName: PChar): Boolean; stdcall; +function LoadModuleEx(var Module: TModuleHandle; FileName: PChar; Flags: Cardinal): Boolean; stdcall; +procedure UnloadModule(var Module: TModuleHandle); stdcall; +function GetModuleSymbol(Module: TModuleHandle; SymbolName: PChar): Pointer; stdcall; +function GetModuleSymbolEx(Module: TModuleHandle; SymbolName: PChar; var Accu: Boolean): Pointer; stdcall; +function ReadModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean; stdcall; +function WriteModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean; stdcall; + +implementation + +// load the DLL file FileName +// the rules for FileName are those of LoadLibrary +// Returns: True = success, False = failure to load +// Assigns: the handle of the loaded DLL to Module +// Warning: if Module has any other value than INVALID_MODULEHANDLE_VALUE +// on entry the function will do nothing but returning success. + +function LoadModule(var Module: TModuleHandle; FileName: PChar): Boolean; +begin + if Module = INVALID_MODULEHANDLE_VALUE then + Module := LoadLibrary( FileName ); + Result := Module <> INVALID_MODULEHANDLE_VALUE; +end; + +// load the DLL file FileName +// LoadLibraryEx is used to get better control of the loading +// for the allowed values for flags see LoadLibraryEx documentation. + +function LoadModuleEx(var Module: TModuleHandle; FileName: PChar; Flags: Cardinal): Boolean; +begin + if Module = INVALID_MODULEHANDLE_VALUE then + Module := LoadLibraryEx( FileName, 0, Flags); + Result := Module <> INVALID_MODULEHANDLE_VALUE; +end; + +// unload a DLL loaded with LoadModule or LoadModuleEx +// The procedure will not try to unload a handle with +// value INVALID_MODULEHANDLE_VALUE and assigns this value +// to Module after unload. + +procedure UnloadModule(var Module: TModuleHandle); +begin + if Module <> INVALID_MODULEHANDLE_VALUE then + FreeLibrary(Module); + Module := INVALID_MODULEHANDLE_VALUE; +end; + +// returns the pointer to the symbol named SymbolName +// if it is exported from the DLL Module +// nil is returned if the symbol is not available + +function GetModuleSymbol(Module: TModuleHandle; SymbolName: PChar): Pointer; +begin + Result := nil; + if Module <> INVALID_MODULEHANDLE_VALUE then + Result := GetProcAddress(Module, SymbolName ); +end; + +// returns the pointer to the symbol named SymbolName +// if it is exported from the DLL Module +// nil is returned if the symbol is not available. +// as an extra the boolean variable Accu is updated +// by anding in the success of the function. +// This is very handy for rendering a global result +// when accessing a long list of symbols. + +function GetModuleSymbolEx(Module: TModuleHandle; SymbolName: PChar; var Accu: Boolean): Pointer; +begin + Result := nil; + if Module <> INVALID_MODULEHANDLE_VALUE then + Result := GetProcAddress(Module, SymbolName ); + Accu := Accu and (Result <> nil); +end; + +// get the value of variables exported from a DLL Module +// Delphi cannot access variables in a DLL directly, so +// this function allows to copy the data from the DLL. +// Beware! You are accessing the DLL memory image directly. +// Be sure to access a variable not a function and be sure +// to read the correct amount of data. + +function ReadModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean; +var + Sym: Pointer; +begin + Result := True; + Sym := GetModuleSymbolEx(Module, SymbolName, Result); + if Result then + Move(Sym^, Buffer, Size); +end; + +// set the value of variables exported from a DLL Module +// Delphi cannot access variables in a DLL directly, so +// this function allows to copy the data to the DLL! +// BEWARE! You are accessing the DLL memory image directly. +// Be sure to access a variable not a function and be sure +// to write the correct amount of data. +// The changes are not persistent. They get lost when the +// DLL is unloaded. + +function WriteModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean; +var + Sym: Pointer; +begin + Result := True; + Sym := GetModuleSymbolEx(Module, SymbolName, Result); + if Result then + Move(Buffer, Sym^, Size); +end; + +{$ENDIF} + +{$IFDEF Unix} +uses +{$ifdef Linux} + Types, + Libc; +{$else} + dl, + Types, + Baseunix, + Unix; +{$endif} +type + // Handle to a loaded .so + TModuleHandle = Pointer; + +const + // Value designating an unassigned TModuleHandle od a failed loading + INVALID_MODULEHANDLE_VALUE = TModuleHandle(nil); + +function LoadModule(var Module: TModuleHandle; FileName: PChar): Boolean; +function LoadModuleEx(var Module: TModuleHandle; FileName: PChar; Flags: Cardinal): Boolean; +procedure UnloadModule(var Module: TModuleHandle); +function GetModuleSymbol(Module: TModuleHandle; SymbolName: PChar): Pointer; +function GetModuleSymbolEx(Module: TModuleHandle; SymbolName: PChar; var Accu: Boolean): Pointer; +function ReadModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean; +function WriteModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean; + +implementation + +// load the .so file FileName +// the rules for FileName are those of dlopen() +// Returns: True = success, False = failure to load +// Assigns: the handle of the loaded .so to Module +// Warning: if Module has any other value than INVALID_MODULEHANDLE_VALUE +// on entry the function will do nothing but returning success. + +function LoadModule(var Module: TModuleHandle; FileName: PChar): Boolean; +begin + if Module = INVALID_MODULEHANDLE_VALUE then + Module := dlopen( FileName, RTLD_NOW); + Result := Module <> INVALID_MODULEHANDLE_VALUE; +end; + +// load the .so file FileName +// dlopen() with flags is used to get better control of the loading +// for the allowed values for flags see "man dlopen". + +function LoadModuleEx(var Module: TModuleHandle; FileName: PChar; Flags: Cardinal): Boolean; +begin + if Module = INVALID_MODULEHANDLE_VALUE then + Module := dlopen( FileName, Flags); + Result := Module <> INVALID_MODULEHANDLE_VALUE; +end; + +// unload a .so loaded with LoadModule or LoadModuleEx +// The procedure will not try to unload a handle with +// value INVALID_MODULEHANDLE_VALUE and assigns this value +// to Module after unload. + +procedure UnloadModule(var Module: TModuleHandle); +begin + if Module <> INVALID_MODULEHANDLE_VALUE then + dlclose(Module); + Module := INVALID_MODULEHANDLE_VALUE; +end; + +// returns the pointer to the symbol named SymbolName +// if it is exported from the .so Module +// nil is returned if the symbol is not available + +function GetModuleSymbol(Module: TModuleHandle; SymbolName: PChar): Pointer; +begin + Result := nil; + if Module <> INVALID_MODULEHANDLE_VALUE then + Result := dlsym(Module, SymbolName ); +end; + +// returns the pointer to the symbol named SymbolName +// if it is exported from the .so Module +// nil is returned if the symbol is not available. +// as an extra the boolean variable Accu is updated +// by anding in the success of the function. +// This is very handy for rendering a global result +// when accessing a long list of symbols. + +function GetModuleSymbolEx(Module: TModuleHandle; SymbolName: PChar; var Accu: Boolean): Pointer; +begin + Result := nil; + if Module <> INVALID_MODULEHANDLE_VALUE then + Result := dlsym(Module, SymbolName ); + Accu := Accu and (Result <> nil); +end; + +// get the value of variables exported from a .so Module +// Delphi cannot access variables in a .so directly, so +// this function allows to copy the data from the .so. +// Beware! You are accessing the .so memory image directly. +// Be sure to access a variable not a function and be sure +// to read the correct amount of data. + +function ReadModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean; +var + Sym: Pointer; +begin + Result := True; + Sym := GetModuleSymbolEx(Module, SymbolName, Result); + if Result then + Move(Sym^, Buffer, Size); +end; + +// set the value of variables exported from a .so Module +// Delphi cannot access variables in a .so directly, so +// this function allows to copy the data to the .so! +// BEWARE! You are accessing the .so memory image directly. +// Be sure to access a variable not a function and be sure +// to write the correct amount of data. +// The changes are not persistent. They get lost when the +// .so is unloaded. + +function WriteModuleData(Module: TModuleHandle; SymbolName: PChar; var Buffer; Size: Cardinal): Boolean; +var + Sym: Pointer; +begin + Result := True; + Sym := GetModuleSymbolEx(Module, SymbolName, Result); + if Result then + Move(Buffer, Sym^, Size); +end; +{$ENDIF} + +{$IFDEF __MACH__} // Mach definitions go here +{$ENDIF} + +end. diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/registryuserpreferences.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/registryuserpreferences.pas index 2d28a222..4a5d55f0 100644 --- a/Game/Code/lib/JEDI-SDL/SDL/Pas/registryuserpreferences.pas +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/registryuserpreferences.pas @@ -1,229 +1,229 @@ -unit registryuserpreferences;
-{
- $Id: registryuserpreferences.pas,v 1.1 2004/09/30 22:35:47 savage Exp $
-
-}
-{******************************************************************************}
-{ }
-{ JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer }
-{ Wrapper class for Windows Register and INI Files }
-{ }
-{ The initial developer of this Pascal code was : }
-{ Dominqiue Louis <Dominique@SavageSoftware.com.au> }
-{ }
-{ Portions created by Dominqiue Louis are }
-{ Copyright (C) 2000 - 2001 Dominqiue Louis. }
-{ }
-{ }
-{ Contributor(s) }
-{ -------------- }
-{ }
-{ }
-{ Obtained through: }
-{ Joint Endeavour of Delphi Innovators ( Project JEDI ) }
-{ }
-{ You may retrieve the latest version of this file at the Project }
-{ JEDI home page, located at http://delphi-jedi.org }
-{ }
-{ The contents of this file are used with permission, subject to }
-{ the Mozilla Public License Version 1.1 (the "License"); you may }
-{ not use this file except in compliance with the License. You may }
-{ obtain a copy of the License at }
-{ http://www.mozilla.org/MPL/MPL-1.1.html }
-{ }
-{ Software distributed under the License is distributed on an }
-{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or }
-{ implied. See the License for the specific language governing }
-{ rights and limitations under the License. }
-{ }
-{ Description }
-{ ----------- }
-{ }
-{ }
-{ }
-{ }
-{ }
-{ }
-{ }
-{ Requires }
-{ -------- }
-{ The SDL Runtime libraris on Win32 : SDL.dll on Linux : libSDL.so }
-{ They are available from... }
-{ http://www.libsdl.org . }
-{ }
-{ Programming Notes }
-{ ----------------- }
-{ }
-{ }
-{ }
-{ }
-{ Revision History }
-{ ---------------- }
-{ September 23 2004 - DL : Initial Creation }
-{
- $Log: registryuserpreferences.pas,v $
- Revision 1.1 2004/09/30 22:35:47 savage
- Changes, enhancements and additions as required to get SoAoS working.
-
-
-}
-{******************************************************************************}
-
-interface
-
-uses
- {$IFDEF REG}
- Registry,
- {$ELSE}
- IniFiles,
- {$ENDIF}
- Classes,
- userpreferences;
-
-type
- TRegistryUserPreferences = class( TUserPreferences )
- private
-
- protected
- function GetSection( const Index : Integer ) : string; virtual; abstract;
- function GetIdentifier( const Index : Integer ) : string; virtual; abstract;
- function GetDefaultBoolean( const Index : Integer ) : Boolean; override;
- function GetBoolean( const Index : Integer ) : Boolean; override;
- procedure SetBoolean( const Index : Integer; const Value : Boolean ); override;
- function GetDefaultDateTime( const Index : Integer ) : TDateTime; override;
- function GetDateTime( const Index : Integer ) : TDateTime; override;
- procedure SetDateTime( const Index : Integer; const Value : TDateTime ); override;
- function GetDefaultInteger( const Index : Integer ) : Integer; override;
- function GetInteger( const Index : Integer ) : Integer; override;
- procedure SetInteger( const Index : Integer; const Value : Integer ); override;
- function GetDefaultFloat( const Index : Integer ) : single; override;
- function GetFloat( const Index : Integer ) : single; override;
- procedure SetFloat( const Index : Integer; const Value : single ); override;
- function GetDefaultString( const Index : Integer ) : string; override;
- function GetString( const Index : Integer ) : string; override;
- procedure SetString( const Index : Integer; const Value : string ); override;
- public
- Registry : {$IFDEF REG}TRegIniFile{$ELSE}TIniFile{$ENDIF};
- constructor Create( const FileName : string = '' ); reintroduce;
- destructor Destroy; override;
- procedure Update; override;
- end;
-
-implementation
-
-uses
- SysUtils;
-
-{ TRegistryUserPreferences }
-constructor TRegistryUserPreferences.Create( const FileName : string );
-var
- defFileName : string;
-begin
- inherited Create;
-
- if FileName <> '' then
- defFileName := FileName
- else
- defFileName := ChangeFileExt( ParamStr( 0 ), '.ini' );
-
- Registry := {$IFDEF REG}TRegIniFile{$ELSE}TIniFile{$ENDIF}.Create( defFileName );
-end;
-
-destructor TRegistryUserPreferences.Destroy;
-begin
- Update;
- Registry.Free;
- Registry := nil;
- inherited;
-end;
-
-function TRegistryUserPreferences.GetBoolean( const Index : Integer ) : Boolean;
-begin
- Result := Registry.ReadBool( GetSection( Index ), GetIdentifier( Index ), GetDefaultBoolean( Index ) );
-end;
-
-function TRegistryUserPreferences.GetDateTime( const Index : Integer ): TDateTime;
-begin
- Result := Registry.ReadDateTime( GetSection( Index ){$IFNDEF REG}, GetIdentifier( Index ), GetDefaultDateTime( Index ){$ENDIF} );
-end;
-
-function TRegistryUserPreferences.GetDefaultBoolean( const Index : Integer ) : Boolean;
-begin
- result := false;
-end;
-
-function TRegistryUserPreferences.GetDefaultDateTime( const Index: Integer ) : TDateTime;
-begin
- result := Now;
-end;
-
-function TRegistryUserPreferences.GetDefaultFloat( const Index: Integer ) : single;
-begin
- result := 0.0;
-end;
-
-function TRegistryUserPreferences.GetDefaultInteger(const Index : Integer ) : Integer;
-begin
- result := 0;
-end;
-
-function TRegistryUserPreferences.GetDefaultString( const Index : Integer ) : string;
-begin
- result := '';
-end;
-
-function TRegistryUserPreferences.GetFloat( const Index : Integer ): single;
-begin
- Result := Registry.ReadFloat( GetSection( Index ){$IFNDEF REG}, GetIdentifier( Index ), GetDefaultFloat( Index ){$ENDIF} );
-end;
-
-function TRegistryUserPreferences.GetInteger( const Index : Integer ) : Integer;
-begin
- Result := Registry.ReadInteger( GetSection( Index ), GetIdentifier( Index ), GetDefaultInteger( Index ) );
-end;
-
-function TRegistryUserPreferences.GetString( const Index : Integer ): string;
-begin
- Result := Registry.ReadString( GetSection( Index ), GetIdentifier( Index ), GetDefaultString( Index ) );
-end;
-
-procedure TRegistryUserPreferences.SetBoolean( const Index : Integer; const Value : Boolean );
-begin
- Registry.WriteBool( GetSection( Index ), GetIdentifier( Index ), Value );
- inherited;
-end;
-
-procedure TRegistryUserPreferences.SetDateTime( const Index: Integer; const Value: TDateTime );
-begin
- Registry.WriteDateTime( GetSection( Index ){$IFNDEF REG}, GetIdentifier( Index ){$ENDIF}, Value );
- inherited;
-end;
-
-procedure TRegistryUserPreferences.SetFloat(const Index: Integer; const Value: single);
-begin
- Registry.WriteFloat( GetSection( Index ){$IFNDEF REG}, GetIdentifier( Index ){$ENDIF}, Value );
- inherited;
-end;
-
-procedure TRegistryUserPreferences.SetInteger( const Index, Value : Integer );
-begin
- Registry.WriteInteger( GetSection( Index ), GetIdentifier( Index ), Value );
- inherited;
-end;
-
-procedure TRegistryUserPreferences.SetString( const Index : Integer; const Value : string );
-begin
- Registry.WriteString( GetSection( Index ), GetIdentifier( Index ), Value );
- inherited;
-end;
-
-procedure TRegistryUserPreferences.Update;
-begin
- {$IFDEF REG}
- Registry.CloseKey;
- {$ELSE}
- Registry.UpdateFile;
- {$ENDIF}
-end;
-
-end.
+unit registryuserpreferences; +{ + $Id: registryuserpreferences.pas,v 1.1 2004/09/30 22:35:47 savage Exp $ + +} +{******************************************************************************} +{ } +{ JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer } +{ Wrapper class for Windows Register and INI Files } +{ } +{ The initial developer of this Pascal code was : } +{ Dominqiue Louis <Dominique@SavageSoftware.com.au> } +{ } +{ Portions created by Dominqiue Louis are } +{ Copyright (C) 2000 - 2001 Dominqiue Louis. } +{ } +{ } +{ Contributor(s) } +{ -------------- } +{ } +{ } +{ Obtained through: } +{ Joint Endeavour of Delphi Innovators ( Project JEDI ) } +{ } +{ You may retrieve the latest version of this file at the Project } +{ JEDI home page, located at http://delphi-jedi.org } +{ } +{ The contents of this file are used with permission, subject to } +{ the Mozilla Public License Version 1.1 (the "License"); you may } +{ not use this file except in compliance with the License. You may } +{ obtain a copy of the License at } +{ http://www.mozilla.org/MPL/MPL-1.1.html } +{ } +{ Software distributed under the License is distributed on an } +{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or } +{ implied. See the License for the specific language governing } +{ rights and limitations under the License. } +{ } +{ Description } +{ ----------- } +{ } +{ } +{ } +{ } +{ } +{ } +{ } +{ Requires } +{ -------- } +{ The SDL Runtime libraris on Win32 : SDL.dll on Linux : libSDL.so } +{ They are available from... } +{ http://www.libsdl.org . } +{ } +{ Programming Notes } +{ ----------------- } +{ } +{ } +{ } +{ } +{ Revision History } +{ ---------------- } +{ September 23 2004 - DL : Initial Creation } +{ + $Log: registryuserpreferences.pas,v $ + Revision 1.1 2004/09/30 22:35:47 savage + Changes, enhancements and additions as required to get SoAoS working. + + +} +{******************************************************************************} + +interface + +uses + {$IFDEF REG} + Registry, + {$ELSE} + IniFiles, + {$ENDIF} + Classes, + userpreferences; + +type + TRegistryUserPreferences = class( TUserPreferences ) + private + + protected + function GetSection( const Index : Integer ) : string; virtual; abstract; + function GetIdentifier( const Index : Integer ) : string; virtual; abstract; + function GetDefaultBoolean( const Index : Integer ) : Boolean; override; + function GetBoolean( const Index : Integer ) : Boolean; override; + procedure SetBoolean( const Index : Integer; const Value : Boolean ); override; + function GetDefaultDateTime( const Index : Integer ) : TDateTime; override; + function GetDateTime( const Index : Integer ) : TDateTime; override; + procedure SetDateTime( const Index : Integer; const Value : TDateTime ); override; + function GetDefaultInteger( const Index : Integer ) : Integer; override; + function GetInteger( const Index : Integer ) : Integer; override; + procedure SetInteger( const Index : Integer; const Value : Integer ); override; + function GetDefaultFloat( const Index : Integer ) : single; override; + function GetFloat( const Index : Integer ) : single; override; + procedure SetFloat( const Index : Integer; const Value : single ); override; + function GetDefaultString( const Index : Integer ) : string; override; + function GetString( const Index : Integer ) : string; override; + procedure SetString( const Index : Integer; const Value : string ); override; + public + Registry : {$IFDEF REG}TRegIniFile{$ELSE}TIniFile{$ENDIF}; + constructor Create( const FileName : string = '' ); reintroduce; + destructor Destroy; override; + procedure Update; override; + end; + +implementation + +uses + SysUtils; + +{ TRegistryUserPreferences } +constructor TRegistryUserPreferences.Create( const FileName : string ); +var + defFileName : string; +begin + inherited Create; + + if FileName <> '' then + defFileName := FileName + else + defFileName := ChangeFileExt( ParamStr( 0 ), '.ini' ); + + Registry := {$IFDEF REG}TRegIniFile{$ELSE}TIniFile{$ENDIF}.Create( defFileName ); +end; + +destructor TRegistryUserPreferences.Destroy; +begin + Update; + Registry.Free; + Registry := nil; + inherited; +end; + +function TRegistryUserPreferences.GetBoolean( const Index : Integer ) : Boolean; +begin + Result := Registry.ReadBool( GetSection( Index ), GetIdentifier( Index ), GetDefaultBoolean( Index ) ); +end; + +function TRegistryUserPreferences.GetDateTime( const Index : Integer ): TDateTime; +begin + Result := Registry.ReadDateTime( GetSection( Index ){$IFNDEF REG}, GetIdentifier( Index ), GetDefaultDateTime( Index ){$ENDIF} ); +end; + +function TRegistryUserPreferences.GetDefaultBoolean( const Index : Integer ) : Boolean; +begin + result := false; +end; + +function TRegistryUserPreferences.GetDefaultDateTime( const Index: Integer ) : TDateTime; +begin + result := Now; +end; + +function TRegistryUserPreferences.GetDefaultFloat( const Index: Integer ) : single; +begin + result := 0.0; +end; + +function TRegistryUserPreferences.GetDefaultInteger(const Index : Integer ) : Integer; +begin + result := 0; +end; + +function TRegistryUserPreferences.GetDefaultString( const Index : Integer ) : string; +begin + result := ''; +end; + +function TRegistryUserPreferences.GetFloat( const Index : Integer ): single; +begin + Result := Registry.ReadFloat( GetSection( Index ){$IFNDEF REG}, GetIdentifier( Index ), GetDefaultFloat( Index ){$ENDIF} ); +end; + +function TRegistryUserPreferences.GetInteger( const Index : Integer ) : Integer; +begin + Result := Registry.ReadInteger( GetSection( Index ), GetIdentifier( Index ), GetDefaultInteger( Index ) ); +end; + +function TRegistryUserPreferences.GetString( const Index : Integer ): string; +begin + Result := Registry.ReadString( GetSection( Index ), GetIdentifier( Index ), GetDefaultString( Index ) ); +end; + +procedure TRegistryUserPreferences.SetBoolean( const Index : Integer; const Value : Boolean ); +begin + Registry.WriteBool( GetSection( Index ), GetIdentifier( Index ), Value ); + inherited; +end; + +procedure TRegistryUserPreferences.SetDateTime( const Index: Integer; const Value: TDateTime ); +begin + Registry.WriteDateTime( GetSection( Index ){$IFNDEF REG}, GetIdentifier( Index ){$ENDIF}, Value ); + inherited; +end; + +procedure TRegistryUserPreferences.SetFloat(const Index: Integer; const Value: single); +begin + Registry.WriteFloat( GetSection( Index ){$IFNDEF REG}, GetIdentifier( Index ){$ENDIF}, Value ); + inherited; +end; + +procedure TRegistryUserPreferences.SetInteger( const Index, Value : Integer ); +begin + Registry.WriteInteger( GetSection( Index ), GetIdentifier( Index ), Value ); + inherited; +end; + +procedure TRegistryUserPreferences.SetString( const Index : Integer; const Value : string ); +begin + Registry.WriteString( GetSection( Index ), GetIdentifier( Index ), Value ); + inherited; +end; + +procedure TRegistryUserPreferences.Update; +begin + {$IFDEF REG} + Registry.CloseKey; + {$ELSE} + Registry.UpdateFile; + {$ENDIF} +end; + +end. diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdl_cpuinfo.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdl_cpuinfo.pas index bd371c55..b09f19f9 100644 --- a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdl_cpuinfo.pas +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdl_cpuinfo.pas @@ -1,155 +1,155 @@ -unit sdl_cpuinfo;
-{
- $Id: sdl_cpuinfo.pas,v 1.2 2004/02/18 22:52:53 savage Exp $
-
-}
-{******************************************************************************}
-{ }
-{ Borland Delphi SDL - Simple DirectMedia Layer }
-{ Conversion of the Simple DirectMedia Layer Headers }
-{ }
-{ Portions created by Sam Lantinga <slouken@devolution.com> are }
-{ Copyright (C) 1997-2004 Sam Lantinga }
-{ 5635-34 Springhouse Dr. }
-{ Pleasanton, CA 94588 (USA) }
-{ }
-{ All Rights Reserved. }
-{ }
-{ The original files are : SDL_cpuinfo.h }
-{ }
-{ The initial developer of this Pascal code was : }
-{ Dominqiue Louis <Dominique@SavageSoftware.com.au> }
-{ }
-{ Portions created by Dominqiue Louis are }
-{ Copyright (C) 2000 - 2004 Dominqiue Louis. }
-{ }
-{ }
-{ Contributor(s) }
-{ -------------- }
-{ Obtained through: }
-{ Joint Endeavour of Delphi Innovators ( Project JEDI ) }
-{ }
-{ You may retrieve the latest version of this file at the Project }
-{ JEDI home page, located at http://delphi-jedi.org }
-{ }
-{ The contents of this file are used with permission, subject to }
-{ the Mozilla Public License Version 1.1 (the "License"); you may }
-{ not use this file except in compliance with the License. You may }
-{ obtain a copy of the License at }
-{ http://www.mozilla.org/MPL/MPL-1.1.html }
-{ }
-{ Software distributed under the License is distributed on an }
-{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or }
-{ implied. See the License for the specific language governing }
-{ rights and limitations under the License. }
-{ }
-{ Description }
-{ ----------- }
-{ }
-{ }
-{ }
-{ }
-{ }
-{ }
-{ }
-{ Requires }
-{ -------- }
-{ The SDL Runtime libraris on Win32 : SDL.dll on Linux : libSDL.so }
-{ They are available from... }
-{ http://www.libsdl.org . }
-{ }
-{ Programming Notes }
-{ ----------------- }
-{ }
-{ }
-{ }
-{ }
-{ Revision History }
-{ ---------------- }
-{
- $Log: sdl_cpuinfo.pas,v $
- Revision 1.2 2004/02/18 22:52:53 savage
- Forgot to add jedi-sdl.inc file. It's there now.
-
- Revision 1.1 2004/02/18 22:35:54 savage
- Brought sdl.pas up to 1.2.7 compatability
- Thus...
- Added SDL_GL_STEREO,
- SDL_GL_MULTISAMPLEBUFFERS,
- SDL_GL_MULTISAMPLESAMPLES
-
- Add DLL/Shared object functions
- function SDL_LoadObject( const sofile : PChar ) : Pointer;
-
- function SDL_LoadFunction( handle : Pointer; const name : PChar ) : Pointer;
-
- procedure SDL_UnloadObject( handle : Pointer );
-
- Added function to create RWops from const memory: SDL_RWFromConstMem()
- function SDL_RWFromConstMem(const mem: Pointer; size: Integer) : PSDL_RWops;
-
- Ported SDL_cpuinfo.h so Now you can test for Specific CPU types.
-
-
-}
-{******************************************************************************}
-
-interface
-
-{$I jedi-sdl.inc}
-
-uses
- sdl;
-
-{* This function returns true if the CPU has the RDTSC instruction
- *}
-function SDL_HasRDTSC : SDL_Bool;
-cdecl; external {$IFDEF __GPC__}name 'SDL_HasRDTSC'{$ELSE} SDLLibName{$ENDIF __GPC__};
-{$EXTERNALSYM SDL_HasRDTSC}
-
-{* This function returns true if the CPU has MMX features
- *}
-function SDL_HasMMX : SDL_Bool;
-cdecl; external {$IFDEF __GPC__}name 'SDL_HasMMX'{$ELSE} SDLLibName{$ENDIF __GPC__};
-{$EXTERNALSYM SDL_HasMMX}
-
-{* This function returns true if the CPU has MMX Ext. features
- *}
-function SDL_HasMMXExt : SDL_Bool;
-cdecl; external {$IFDEF __GPC__}name 'SDL_HasMMXExt'{$ELSE} SDLLibName{$ENDIF __GPC__};
-{$EXTERNALSYM SDL_HasMMXExt}
-
-{* This function returns true if the CPU has 3DNow features
- *}
-function SDL_Has3DNow : SDL_Bool;
-cdecl; external {$IFDEF __GPC__}name 'SDL_Has3DNow'{$ELSE} SDLLibName{$ENDIF __GPC__};
-{$EXTERNALSYM SDL_Has3DNow}
-
-{* This function returns true if the CPU has 3DNow! Ext. features
- *}
-function SDL_Has3DNowExt : SDL_Bool;
-cdecl; external {$IFDEF __GPC__}name 'SDL_Has3DNowExt'{$ELSE} SDLLibName{$ENDIF __GPC__};
-{$EXTERNALSYM SDL_Has3DNowExt}
-
-{* This function returns true if the CPU has SSE features
- *}
-function SDL_HasSSE : SDL_Bool;
-cdecl; external {$IFDEF __GPC__}name 'SDL_HasSSE'{$ELSE} SDLLibName{$ENDIF __GPC__};
-{$EXTERNALSYM SDL_HasSSE}
-
-{* This function returns true if the CPU has SSE2 features
- *}
-function SDL_HasSSE2 : SDL_Bool;
-cdecl; external {$IFDEF __GPC__}name 'SDL_HasSSE2'{$ELSE} SDLLibName{$ENDIF __GPC__};
-{$EXTERNALSYM SDL_HasSSE2}
-
-{* This function returns true if the CPU has AltiVec features
- *}
-function SDL_HasAltiVec : SDL_Bool;
-cdecl; external {$IFDEF __GPC__}name 'SDL_HasAltiVec'{$ELSE} SDLLibName{$ENDIF __GPC__};
-{$EXTERNALSYM SDL_HasAltiVec}
-
-implementation
-
-end.
+unit sdl_cpuinfo; +{ + $Id: sdl_cpuinfo.pas,v 1.2 2004/02/18 22:52:53 savage Exp $ + +} +{******************************************************************************} +{ } +{ Borland Delphi SDL - Simple DirectMedia Layer } +{ Conversion of the Simple DirectMedia Layer Headers } +{ } +{ Portions created by Sam Lantinga <slouken@devolution.com> are } +{ Copyright (C) 1997-2004 Sam Lantinga } +{ 5635-34 Springhouse Dr. } +{ Pleasanton, CA 94588 (USA) } +{ } +{ All Rights Reserved. } +{ } +{ The original files are : SDL_cpuinfo.h } +{ } +{ The initial developer of this Pascal code was : } +{ Dominqiue Louis <Dominique@SavageSoftware.com.au> } +{ } +{ Portions created by Dominqiue Louis are } +{ Copyright (C) 2000 - 2004 Dominqiue Louis. } +{ } +{ } +{ Contributor(s) } +{ -------------- } +{ Obtained through: } +{ Joint Endeavour of Delphi Innovators ( Project JEDI ) } +{ } +{ You may retrieve the latest version of this file at the Project } +{ JEDI home page, located at http://delphi-jedi.org } +{ } +{ The contents of this file are used with permission, subject to } +{ the Mozilla Public License Version 1.1 (the "License"); you may } +{ not use this file except in compliance with the License. You may } +{ obtain a copy of the License at } +{ http://www.mozilla.org/MPL/MPL-1.1.html } +{ } +{ Software distributed under the License is distributed on an } +{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or } +{ implied. See the License for the specific language governing } +{ rights and limitations under the License. } +{ } +{ Description } +{ ----------- } +{ } +{ } +{ } +{ } +{ } +{ } +{ } +{ Requires } +{ -------- } +{ The SDL Runtime libraris on Win32 : SDL.dll on Linux : libSDL.so } +{ They are available from... } +{ http://www.libsdl.org . } +{ } +{ Programming Notes } +{ ----------------- } +{ } +{ } +{ } +{ } +{ Revision History } +{ ---------------- } +{ + $Log: sdl_cpuinfo.pas,v $ + Revision 1.2 2004/02/18 22:52:53 savage + Forgot to add jedi-sdl.inc file. It's there now. + + Revision 1.1 2004/02/18 22:35:54 savage + Brought sdl.pas up to 1.2.7 compatability + Thus... + Added SDL_GL_STEREO, + SDL_GL_MULTISAMPLEBUFFERS, + SDL_GL_MULTISAMPLESAMPLES + + Add DLL/Shared object functions + function SDL_LoadObject( const sofile : PChar ) : Pointer; + + function SDL_LoadFunction( handle : Pointer; const name : PChar ) : Pointer; + + procedure SDL_UnloadObject( handle : Pointer ); + + Added function to create RWops from const memory: SDL_RWFromConstMem() + function SDL_RWFromConstMem(const mem: Pointer; size: Integer) : PSDL_RWops; + + Ported SDL_cpuinfo.h so Now you can test for Specific CPU types. + + +} +{******************************************************************************} + +interface + +{$I jedi-sdl.inc} + +uses + sdl; + +{* This function returns true if the CPU has the RDTSC instruction + *} +function SDL_HasRDTSC : SDL_Bool; +cdecl; external {$IFDEF __GPC__}name 'SDL_HasRDTSC'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_HasRDTSC} + +{* This function returns true if the CPU has MMX features + *} +function SDL_HasMMX : SDL_Bool; +cdecl; external {$IFDEF __GPC__}name 'SDL_HasMMX'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_HasMMX} + +{* This function returns true if the CPU has MMX Ext. features + *} +function SDL_HasMMXExt : SDL_Bool; +cdecl; external {$IFDEF __GPC__}name 'SDL_HasMMXExt'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_HasMMXExt} + +{* This function returns true if the CPU has 3DNow features + *} +function SDL_Has3DNow : SDL_Bool; +cdecl; external {$IFDEF __GPC__}name 'SDL_Has3DNow'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_Has3DNow} + +{* This function returns true if the CPU has 3DNow! Ext. features + *} +function SDL_Has3DNowExt : SDL_Bool; +cdecl; external {$IFDEF __GPC__}name 'SDL_Has3DNowExt'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_Has3DNowExt} + +{* This function returns true if the CPU has SSE features + *} +function SDL_HasSSE : SDL_Bool; +cdecl; external {$IFDEF __GPC__}name 'SDL_HasSSE'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_HasSSE} + +{* This function returns true if the CPU has SSE2 features + *} +function SDL_HasSSE2 : SDL_Bool; +cdecl; external {$IFDEF __GPC__}name 'SDL_HasSSE2'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_HasSSE2} + +{* This function returns true if the CPU has AltiVec features + *} +function SDL_HasAltiVec : SDL_Bool; +cdecl; external {$IFDEF __GPC__}name 'SDL_HasAltiVec'{$ELSE} SDLLibName{$ENDIF __GPC__}; +{$EXTERNALSYM SDL_HasAltiVec} + +implementation + +end.
\ No newline at end of file diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlgameinterface.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlgameinterface.pas index cc95751d..9a58ff40 100644 --- a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlgameinterface.pas +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlgameinterface.pas @@ -1,202 +1,202 @@ -unit sdlgameinterface;
-{
- $Id: sdlgameinterface.pas,v 1.4 2005/08/03 18:57:31 savage Exp $
-
-}
-{******************************************************************************}
-{ }
-{ JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer }
-{ Game Interface Base class }
-{ }
-{ The initial developer of this Pascal code was : }
-{ Dominqiue Louis <Dominique@SavageSoftware.com.au> }
-{ }
-{ Portions created by Dominqiue Louis are }
-{ Copyright (C) 2000 - 2001 Dominqiue Louis. }
-{ }
-{ }
-{ Contributor(s) }
-{ -------------- }
-{ }
-{ }
-{ Obtained through: }
-{ Joint Endeavour of Delphi Innovators ( Project JEDI ) }
-{ }
-{ You may retrieve the latest version of this file at the Project }
-{ JEDI home page, located at http://delphi-jedi.org }
-{ }
-{ The contents of this file are used with permission, subject to }
-{ the Mozilla Public License Version 1.1 (the "License"); you may }
-{ not use this file except in compliance with the License. You may }
-{ obtain a copy of the License at }
-{ http://www.mozilla.org/MPL/MPL-1.1.html }
-{ }
-{ Software distributed under the License is distributed on an }
-{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or }
-{ implied. See the License for the specific language governing }
-{ rights and limitations under the License. }
-{ }
-{ Description }
-{ ----------- }
-{ }
-{ }
-{ }
-{ }
-{ }
-{ }
-{ }
-{ Requires }
-{ -------- }
-{ The SDL Runtime libraris on Win32 : SDL.dll on Linux : libSDL.so }
-{ They are available from... }
-{ http://www.libsdl.org . }
-{ }
-{ Programming Notes }
-{ ----------------- }
-{ }
-{ }
-{ }
-{ }
-{ Revision History }
-{ ---------------- }
-{ September 23 2004 - DL : Initial Creation }
-{
- $Log: sdlgameinterface.pas,v $
- Revision 1.4 2005/08/03 18:57:31 savage
- Various updates and additions. Mainly to handle OpenGL 3D Window support and better cursor support for the mouse class
-
- Revision 1.3 2004/10/17 18:41:49 savage
- Slight Change to allow Reseting of Input Event handlers
-
- Revision 1.2 2004/09/30 22:35:47 savage
- Changes, enhancements and additions as required to get SoAoS working.
-
-
-}
-{******************************************************************************}
-
-interface
-
-uses
- sdl,
- sdlwindow;
-
-type
- TGameInterfaceClass = class of TGameInterface;
-
- TGameInterface = class( TObject )
- private
- FNextGameInterface : TGameInterfaceClass;
- protected
- Dragging : Boolean;
- Loaded : Boolean;
- procedure FreeSurfaces; virtual;
- procedure Render; virtual; abstract;
- procedure Close; virtual;
- procedure Update( aElapsedTime : single ); virtual;
- procedure MouseDown( Button : Integer; Shift: TSDLMod; MousePos : TPoint ); virtual;
- procedure MouseMove( Shift: TSDLMod; CurrentPos : TPoint; RelativePos : TPoint ); virtual;
- procedure MouseUp( Button : Integer; Shift: TSDLMod; MousePos : TPoint ); virtual;
- procedure MouseWheelScroll( WheelDelta : Integer; Shift: TSDLMod; MousePos : TPoint ); virtual;
- procedure KeyDown( var Key: TSDLKey; Shift: TSDLMod; unicode : UInt16 ); virtual;
- public
- MainWindow : TSDLCustomWindow;
- procedure ResetInputManager;
- procedure LoadSurfaces; virtual;
- function PointIsInRect( Point : TPoint; x, y, x1, y1 : integer ) : Boolean;
- constructor Create( const aMainWindow : TSDLCustomWindow );
- destructor Destroy; override;
- property NextGameInterface : TGameInterfaceClass read FNextGameInterface write FNextGameInterface;
- end;
-
-implementation
-
-{ TGameInterface }
-procedure TGameInterface.Close;
-begin
- FNextGameInterface := nil;
-end;
-
-constructor TGameInterface.Create( const aMainWindow : TSDLCustomWindow );
-begin
- inherited Create;
- MainWindow := aMainWindow;
- FNextGameInterface := TGameInterface;
- ResetInputManager;
-end;
-
-destructor TGameInterface.Destroy;
-begin
- if Loaded then
- FreeSurfaces;
- inherited;
-end;
-
-procedure TGameInterface.FreeSurfaces;
-begin
- Loaded := False;
-end;
-
-procedure TGameInterface.KeyDown(var Key: TSDLKey; Shift: TSDLMod; unicode: UInt16);
-begin
-
-end;
-
-procedure TGameInterface.LoadSurfaces;
-begin
- Loaded := True;
-end;
-
-procedure TGameInterface.MouseDown(Button: Integer; Shift: TSDLMod; MousePos: TPoint);
-begin
- Dragging := True;
-end;
-
-procedure TGameInterface.MouseMove(Shift: TSDLMod; CurrentPos, RelativePos: TPoint);
-begin
-
-end;
-
-procedure TGameInterface.MouseUp(Button: Integer; Shift: TSDLMod; MousePos: TPoint);
-begin
- Dragging := True;
-end;
-
-procedure TGameInterface.MouseWheelScroll(WheelDelta: Integer; Shift: TSDLMod; MousePos: TPoint);
-begin
-
-end;
-
-function TGameInterface.PointIsInRect( Point : TPoint; x, y, x1, y1: integer ): Boolean;
-begin
- if ( Point.x >= x )
- and ( Point.y >= y )
- and ( Point.x <= x1 )
- and ( Point.y <= y1 ) then
- result := true
- else
- result := false;
-end;
-
-procedure TGameInterface.ResetInputManager;
-var
- temp : TSDLNotifyEvent;
-begin
- MainWindow.InputManager.Mouse.OnMouseDown := MouseDown;
- MainWindow.InputManager.Mouse.OnMouseMove := MouseMove;
- MainWindow.InputManager.Mouse.OnMouseUp := MouseUp;
- MainWindow.InputManager.Mouse.OnMouseWheel := MouseWheelScroll;
- MainWindow.InputManager.KeyBoard.OnKeyDown := KeyDown;
- temp := Render;
- MainWindow.OnRender := temp;
- temp := Close;
- MainWindow.OnClose := temp;
- MainWindow.OnUpdate := Update;
-end;
-
-procedure TGameInterface.Update(aElapsedTime: single);
-begin
-
-end;
-
-end.
+unit sdlgameinterface; +{ + $Id: sdlgameinterface.pas,v 1.4 2005/08/03 18:57:31 savage Exp $ + +} +{******************************************************************************} +{ } +{ JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer } +{ Game Interface Base class } +{ } +{ The initial developer of this Pascal code was : } +{ Dominqiue Louis <Dominique@SavageSoftware.com.au> } +{ } +{ Portions created by Dominqiue Louis are } +{ Copyright (C) 2000 - 2001 Dominqiue Louis. } +{ } +{ } +{ Contributor(s) } +{ -------------- } +{ } +{ } +{ Obtained through: } +{ Joint Endeavour of Delphi Innovators ( Project JEDI ) } +{ } +{ You may retrieve the latest version of this file at the Project } +{ JEDI home page, located at http://delphi-jedi.org } +{ } +{ The contents of this file are used with permission, subject to } +{ the Mozilla Public License Version 1.1 (the "License"); you may } +{ not use this file except in compliance with the License. You may } +{ obtain a copy of the License at } +{ http://www.mozilla.org/MPL/MPL-1.1.html } +{ } +{ Software distributed under the License is distributed on an } +{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or } +{ implied. See the License for the specific language governing } +{ rights and limitations under the License. } +{ } +{ Description } +{ ----------- } +{ } +{ } +{ } +{ } +{ } +{ } +{ } +{ Requires } +{ -------- } +{ The SDL Runtime libraris on Win32 : SDL.dll on Linux : libSDL.so } +{ They are available from... } +{ http://www.libsdl.org . } +{ } +{ Programming Notes } +{ ----------------- } +{ } +{ } +{ } +{ } +{ Revision History } +{ ---------------- } +{ September 23 2004 - DL : Initial Creation } +{ + $Log: sdlgameinterface.pas,v $ + Revision 1.4 2005/08/03 18:57:31 savage + Various updates and additions. Mainly to handle OpenGL 3D Window support and better cursor support for the mouse class + + Revision 1.3 2004/10/17 18:41:49 savage + Slight Change to allow Reseting of Input Event handlers + + Revision 1.2 2004/09/30 22:35:47 savage + Changes, enhancements and additions as required to get SoAoS working. + + +} +{******************************************************************************} + +interface + +uses + sdl, + sdlwindow; + +type + TGameInterfaceClass = class of TGameInterface; + + TGameInterface = class( TObject ) + private + FNextGameInterface : TGameInterfaceClass; + protected + Dragging : Boolean; + Loaded : Boolean; + procedure FreeSurfaces; virtual; + procedure Render; virtual; abstract; + procedure Close; virtual; + procedure Update( aElapsedTime : single ); virtual; + procedure MouseDown( Button : Integer; Shift: TSDLMod; MousePos : TPoint ); virtual; + procedure MouseMove( Shift: TSDLMod; CurrentPos : TPoint; RelativePos : TPoint ); virtual; + procedure MouseUp( Button : Integer; Shift: TSDLMod; MousePos : TPoint ); virtual; + procedure MouseWheelScroll( WheelDelta : Integer; Shift: TSDLMod; MousePos : TPoint ); virtual; + procedure KeyDown( var Key: TSDLKey; Shift: TSDLMod; unicode : UInt16 ); virtual; + public + MainWindow : TSDLCustomWindow; + procedure ResetInputManager; + procedure LoadSurfaces; virtual; + function PointIsInRect( Point : TPoint; x, y, x1, y1 : integer ) : Boolean; + constructor Create( const aMainWindow : TSDLCustomWindow ); + destructor Destroy; override; + property NextGameInterface : TGameInterfaceClass read FNextGameInterface write FNextGameInterface; + end; + +implementation + +{ TGameInterface } +procedure TGameInterface.Close; +begin + FNextGameInterface := nil; +end; + +constructor TGameInterface.Create( const aMainWindow : TSDLCustomWindow ); +begin + inherited Create; + MainWindow := aMainWindow; + FNextGameInterface := TGameInterface; + ResetInputManager; +end; + +destructor TGameInterface.Destroy; +begin + if Loaded then + FreeSurfaces; + inherited; +end; + +procedure TGameInterface.FreeSurfaces; +begin + Loaded := False; +end; + +procedure TGameInterface.KeyDown(var Key: TSDLKey; Shift: TSDLMod; unicode: UInt16); +begin + +end; + +procedure TGameInterface.LoadSurfaces; +begin + Loaded := True; +end; + +procedure TGameInterface.MouseDown(Button: Integer; Shift: TSDLMod; MousePos: TPoint); +begin + Dragging := True; +end; + +procedure TGameInterface.MouseMove(Shift: TSDLMod; CurrentPos, RelativePos: TPoint); +begin + +end; + +procedure TGameInterface.MouseUp(Button: Integer; Shift: TSDLMod; MousePos: TPoint); +begin + Dragging := True; +end; + +procedure TGameInterface.MouseWheelScroll(WheelDelta: Integer; Shift: TSDLMod; MousePos: TPoint); +begin + +end; + +function TGameInterface.PointIsInRect( Point : TPoint; x, y, x1, y1: integer ): Boolean; +begin + if ( Point.x >= x ) + and ( Point.y >= y ) + and ( Point.x <= x1 ) + and ( Point.y <= y1 ) then + result := true + else + result := false; +end; + +procedure TGameInterface.ResetInputManager; +var + temp : TSDLNotifyEvent; +begin + MainWindow.InputManager.Mouse.OnMouseDown := MouseDown; + MainWindow.InputManager.Mouse.OnMouseMove := MouseMove; + MainWindow.InputManager.Mouse.OnMouseUp := MouseUp; + MainWindow.InputManager.Mouse.OnMouseWheel := MouseWheelScroll; + MainWindow.InputManager.KeyBoard.OnKeyDown := KeyDown; + temp := Render; + MainWindow.OnRender := temp; + temp := Close; + MainWindow.OnClose := temp; + MainWindow.OnUpdate := Update; +end; + +procedure TGameInterface.Update(aElapsedTime: single); +begin + +end; + +end. diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdli386utils.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdli386utils.pas index 9151168a..4de4ebee 100644 --- a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdli386utils.pas +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdli386utils.pas @@ -1,5236 +1,5236 @@ -unit sdli386utils;
-{
- $Id: sdli386utils.pas,v 1.5 2004/06/02 19:38:53 savage Exp $
-
-}
-{******************************************************************************}
-{ }
-{ Borland Delphi SDL - Simple DirectMedia Layer }
-{ SDL Utility functions }
-{ }
-{ }
-{ The initial developer of this Pascal code was : }
-{ Tom Jones <tigertomjones@gmx.de> }
-{ }
-{ Portions created by Tom Jones are }
-{ Copyright (C) 2000 - 2001 Tom Jones. }
-{ }
-{ }
-{ Contributor(s) }
-{ -------------- }
-{ Dominique Louis <Dominique@SavageSoftware.com.au> }
-{ Róbert Kisnémeth <mikrobi@freemail.hu> }
-{ }
-{ Obtained through: }
-{ Joint Endeavour of Delphi Innovators ( Project JEDI ) }
-{ }
-{ You may retrieve the latest version of this file at the Project }
-{ JEDI home page, located at http://delphi-jedi.org }
-{ }
-{ The contents of this file are used with permission, subject to }
-{ the Mozilla Public License Version 1.1 (the "License"); you may }
-{ not use this file except in compliance with the License. You may }
-{ obtain a copy of the License at }
-{ http://www.mozilla.org/MPL/MPL-1.1.html }
-{ }
-{ Software distributed under the License is distributed on an }
-{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or }
-{ implied. See the License for the specific language governing }
-{ rights and limitations under the License. }
-{ }
-{ Description }
-{ ----------- }
-{ Helper functions... }
-{ }
-{ }
-{ Requires }
-{ -------- }
-{ SDL.dll on Windows platforms }
-{ libSDL-1.1.so.0 on Linux platform }
-{ }
-{ Programming Notes }
-{ ----------------- }
-{ }
-{ }
-{ }
-{ }
-{ Revision History }
-{ ---------------- }
-{ 2000 - TJ : Initial creation }
-{ }
-{ July 13 2001 - DL : Added PutPixel and GetPixel routines. }
-{ }
-{ Sept 14 2001 - RK : Added flipping routines. }
-{ }
-{ Sept 19 2001 - RK : Added PutPixel & line drawing & blitting with ADD }
-{ effect. Fixed a bug in SDL_PutPixel & SDL_GetPixel }
-{ Added PSDLRect() }
-{ Sept 22 2001 - DL : Removed need for Windows.pas by defining types here}
-{ Also removed by poor attempt or a dialog box }
-{ }
-{ Sept 25 2001 - RK : Added PixelTest, NewPutPixel, SubPixel, SubLine, }
-{ SubSurface, MonoSurface & TexturedSurface }
-{ }
-{ Sept 26 2001 - DL : Made change so that it refers to native Pascal }
-{ types rather that Windows types. This makes it more}
-{ portable to Linix. }
-{ }
-{ Sept 27 2001 - RK : SDLUtils now can be compiled with FreePascal }
-{ }
-{ Oct 27 2001 - JF : Added ScrollY function }
-{ }
-{ Jan 21 2002 - RK : Added SDL_ZoomSurface and SDL_WarpSurface }
-{ }
-{ Mar 28 2002 - JF : Added SDL_RotateSurface }
-{ }
-{ May 13 2002 - RK : Improved SDL_FillRectAdd & SDL_FillRectSub }
-{ }
-{ May 27 2002 - YS : GradientFillRect function }
-{ }
-{ May 30 2002 - RK : Added SDL_2xBlit, SDL_Scanline2xBlit }
-{ & SDL_50Scanline2xBlit }
-{ }
-{ June 12 2002 - RK : Added SDL_PixelTestSurfaceVsRect }
-{ }
-{ June 12 2002 - JF : Updated SDL_PixelTestSurfaceVsRect }
-{ }
-{ November 9 2002 - JF : Added Jason's boolean Surface functions }
-{ }
-{ December 10 2002 - DE : Added Dean's SDL_ClipLine function }
-{ }
-{******************************************************************************}
-{
- $Log: sdli386utils.pas,v $
- Revision 1.5 2004/06/02 19:38:53 savage
- Changes to SDL_GradientFillRect as suggested by
- Ángel Eduardo García Hernández. Many thanks.
-
- Revision 1.4 2004/05/29 23:11:53 savage
- Changes to SDL_ScaleSurfaceRect as suggested by
- Ángel Eduardo García Hernández to fix a colour issue with the function. Many thanks.
-
- Revision 1.3 2004/02/20 22:04:11 savage
- Added Changes as mentioned by Rodrigo "Rui" R. (1/2 RRC2Soft) to facilitate FPC compilation and it also works in Delphi. Also syncronized the funcitons so that they are identical to sdlutils.pas, when no assembly version is available.
-
- Revision 1.2 2004/02/14 00:23:39 savage
- As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change.
-
- Revision 1.1 2004/02/05 00:08:20 savage
- Module 1.0 release
-
-
-}
-
-interface
-
-{$i jedi-sdl.inc}
-
-uses
-{$IFDEF UNIX}
- Types,
- Xlib,
-{$ENDIF}
- SysUtils,
- sdl;
-
-type
- TGradientStyle = ( gsHorizontal, gsVertical );
-
- // Pixel procedures
-function SDL_PixelTest( SrcSurface1 : PSDL_Surface; SrcRect1 : PSDL_Rect; SrcSurface2 :
- PSDL_Surface; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : Boolean;
-
-function SDL_GetPixel( SrcSurface : PSDL_Surface; x : cardinal; y : cardinal ) : Uint32;
-
-procedure SDL_PutPixel( SrcSurface : PSDL_Surface; x : integer; y : integer; Color :
- cardinal );
-
-procedure SDL_AddPixel( SrcSurface : PSDL_Surface; x : integer; y : integer; Color :
- cardinal );
-
-procedure SDL_SubPixel( SrcSurface : PSDL_Surface; x : integer; y : integer; Color :
- cardinal );
-
-// Line procedures
-procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
- cardinal );overload;
-
-procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
- cardinal ; DashLength, DashSpace : byte ); overload;
-
-procedure SDL_AddLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
- cardinal );
-
-procedure SDL_SubLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
- cardinal );
-
-// Surface procedures
-procedure SDL_AddSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DstSurface : PSDL_Surface; DestRect : PSDL_Rect );
-
-procedure SDL_SubSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DstSurface : PSDL_Surface; DestRect : PSDL_Rect );
-
-procedure SDL_MonoSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DstSurface : PSDL_Surface; DestRect : PSDL_Rect; Color : cardinal );
-
-procedure SDL_TexturedSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DstSurface : PSDL_Surface; DestRect : PSDL_Rect; Texture : PSDL_Surface;
- TextureRect : PSDL_Rect );
-
-procedure SDL_ZoomSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; DstRect : PSDL_Rect );
-
-procedure SDL_WarpSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; UL, UR, LR, LL : PPoint );
-
-// Flip procedures
-procedure SDL_FlipRectH( DstSurface : PSDL_Surface; Rect : PSDL_Rect );
-
-procedure SDL_FlipRectV( DstSurface : PSDL_Surface; Rect : PSDL_Rect );
-
-function PSDLRect( aLeft, aTop, aWidth, aHeight : integer ) : PSDL_Rect;
-
-function SDLRect( aLeft, aTop, aWidth, aHeight : integer ) : TSDL_Rect; overload;
-
-function SDLRect( aRect : TRect ) : TSDL_Rect; overload;
-
-function SDL_ScaleSurfaceRect( SrcSurface : PSDL_Surface; SrcX1, SrcY1, SrcW, SrcH,
- Width, Height : integer ) : PSDL_Surface;
-
-procedure SDL_ScrollY( DstSurface : PSDL_Surface; DifY : integer );
-
-procedure SDL_ScrollX( DstSurface : PSDL_Surface; DifX : integer );
-
-procedure SDL_RotateDeg( DstSurface, SrcSurface : PSDL_Surface; SrcRect :
- PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Integer );
-
-procedure SDL_RotateRad( DstSurface, SrcSurface : PSDL_Surface; SrcRect :
- PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Single );
-
-function ValidateSurfaceRect( DstSurface : PSDL_Surface; dstrect : PSDL_Rect ) : TSDL_Rect;
-
-// Fill Rect routine
-procedure SDL_FillRectAdd( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );
-
-procedure SDL_FillRectSub( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );
-
-procedure SDL_GradientFillRect( DstSurface : PSDL_Surface; const Rect : PSDL_Rect; const StartColor, EndColor : TSDL_Color; const Style : TGradientStyle );
-
-// NOTE for All SDL_2xblit... function : the dest surface must be 2x of the source surface!
-procedure SDL_2xBlit( Src, Dest : PSDL_Surface );
-
-procedure SDL_Scanline2xBlit( Src, Dest : PSDL_Surface );
-
-procedure SDL_50Scanline2xBlit( Src, Dest : PSDL_Surface );
-
-function SDL_PixelTestSurfaceVsRect( SrcSurface1 : PSDL_Surface; SrcRect1 :
-PSDL_Rect; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) :
-boolean;
-
-// Jason's boolean Surface functions
-procedure SDL_ORSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-
-procedure SDL_ANDSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-
-procedure SDL_GTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-
-procedure SDL_LTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-
-function SDL_ClipLine(var x1,y1,x2,y2: Integer; ClipRect: PSDL_Rect) : boolean;
-
-implementation
-
-uses
- Math;
-
-function SDL_PixelTest( SrcSurface1 : PSDL_Surface; SrcRect1 : PSDL_Rect; SrcSurface2 :
- PSDL_Surface; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : boolean;
-var
- Src_Rect1, Src_Rect2 : TSDL_Rect;
- right1, bottom1 : integer;
- right2, bottom2 : integer;
- Scan1Start, Scan2Start, ScanWidth, ScanHeight : cardinal;
- Mod1, Mod2 : cardinal;
- Addr1, Addr2 : cardinal;
- BPP : cardinal;
- Pitch1, Pitch2 : cardinal;
- TransparentColor1, TransparentColor2 : cardinal;
- tx, ty : cardinal;
- StartTick : cardinal;
- Color1, Color2 : cardinal;
-begin
- Result := false;
- if SrcRect1 = nil then
- begin
- with Src_Rect1 do
- begin
- x := 0;
- y := 0;
- w := SrcSurface1.w;
- h := SrcSurface1.h;
- end;
- end
- else
- Src_Rect1 := SrcRect1^;
- if SrcRect2 = nil then
- begin
- with Src_Rect2 do
- begin
- x := 0;
- y := 0;
- w := SrcSurface2.w;
- h := SrcSurface2.h;
- end;
- end
- else
- Src_Rect2 := SrcRect2^;
- with Src_Rect1 do
- begin
- Right1 := Left1 + w;
- Bottom1 := Top1 + h;
- end;
- with Src_Rect2 do
- begin
- Right2 := Left2 + w;
- Bottom2 := Top2 + h;
- end;
- if ( Left1 >= Right2 ) or ( Right1 <= Left2 ) or ( Top1 >= Bottom2 ) or ( Bottom1 <=
- Top2 ) then
- exit;
- if Left1 <= Left2 then
- begin
- // 1. left, 2. right
- Scan1Start := Src_Rect1.x + Left2 - Left1;
- Scan2Start := Src_Rect2.x;
- ScanWidth := Right1 - Left2;
- with Src_Rect2 do
- if ScanWidth > w then
- ScanWidth := w;
- end
- else
- begin
- // 1. right, 2. left
- Scan1Start := Src_Rect1.x;
- Scan2Start := Src_Rect2.x + Left1 - Left2;
- ScanWidth := Right2 - Left1;
- with Src_Rect1 do
- if ScanWidth > w then
- ScanWidth := w;
- end;
- with SrcSurface1^ do
- begin
- Pitch1 := Pitch;
- Addr1 := cardinal( Pixels );
- inc( Addr1, Pitch1 * UInt32( Src_Rect1.y ) );
- with format^ do
- begin
- BPP := BytesPerPixel;
- TransparentColor1 := colorkey;
- end;
- end;
- with SrcSurface2^ do
- begin
- TransparentColor2 := format.colorkey;
- Pitch2 := Pitch;
- Addr2 := cardinal( Pixels );
- inc( Addr2, Pitch2 * UInt32( Src_Rect2.y ) );
- end;
- Mod1 := Pitch1 - ( ScanWidth * BPP );
- Mod2 := Pitch2 - ( ScanWidth * BPP );
- inc( Addr1, BPP * Scan1Start );
- inc( Addr2, BPP * Scan2Start );
- if Top1 <= Top2 then
- begin
- // 1. up, 2. down
- ScanHeight := Bottom1 - Top2;
- if ScanHeight > Src_Rect2.h then
- ScanHeight := Src_Rect2.h;
- inc( Addr1, Pitch1 * UInt32( Top2 - Top1 ) );
- end
- else
- begin
- // 1. down, 2. up
- ScanHeight := Bottom2 - Top1;
- if ScanHeight > Src_Rect1.h then
- ScanHeight := Src_Rect1.h;
- inc( Addr2, Pitch2 * UInt32( Top1 - Top2 ) );
- end;
- case BPP of
- 1 :
- for ty := 1 to ScanHeight do
- begin
- for tx := 1 to ScanWidth do
- begin
- if ( PByte( Addr1 )^ <> TransparentColor1 ) and ( PByte( Addr2 )^ <>
- TransparentColor2 ) then
- begin
- Result := true;
- exit;
- end;
- inc( Addr1 );
- inc( Addr2 );
- end;
- inc( Addr1, Mod1 );
- inc( Addr2, Mod2 );
- end;
- 2 :
- for ty := 1 to ScanHeight do
- begin
- for tx := 1 to ScanWidth do
- begin
- if ( PWord( Addr1 )^ <> TransparentColor1 ) and ( PWord( Addr2 )^ <>
- TransparentColor2 ) then
- begin
- Result := true;
- exit;
- end;
- inc( Addr1, 2 );
- inc( Addr2, 2 );
- end;
- inc( Addr1, Mod1 );
- inc( Addr2, Mod2 );
- end;
- 3 :
- for ty := 1 to ScanHeight do
- begin
- for tx := 1 to ScanWidth do
- begin
- Color1 := PLongWord( Addr1 )^ and $00FFFFFF;
- Color2 := PLongWord( Addr2 )^ and $00FFFFFF;
- if ( Color1 <> TransparentColor1 ) and ( Color2 <> TransparentColor2 )
- then
- begin
- Result := true;
- exit;
- end;
- inc( Addr1, 3 );
- inc( Addr2, 3 );
- end;
- inc( Addr1, Mod1 );
- inc( Addr2, Mod2 );
- end;
- 4 :
- for ty := 1 to ScanHeight do
- begin
- for tx := 1 to ScanWidth do
- begin
- if ( PLongWord( Addr1 )^ <> TransparentColor1 ) and ( PLongWord( Addr2 )^ <>
- TransparentColor2 ) then
- begin
- Result := true;
- exit;
- end;
- inc( Addr1, 4 );
- inc( Addr2, 4 );
- end;
- inc( Addr1, Mod1 );
- inc( Addr2, Mod2 );
- end;
- end;
-end;
-
-function SDL_GetPixel( SrcSurface : PSDL_Surface; x : cardinal; y : cardinal ) : Uint32;
-var
- bpp : UInt32;
- p : PInteger;
-begin
- bpp := SrcSurface.format.BytesPerPixel;
- // Here p is the address to the pixel we want to retrieve
- p := Pointer( Uint32( SrcSurface.pixels ) + UInt32( y ) * SrcSurface.pitch + UInt32( x ) *
- bpp );
- case bpp of
- 1 : result := PUint8( p )^;
- 2 : result := PUint16( p )^;
- 3 :
- if ( SDL_BYTEORDER = SDL_BIG_ENDIAN ) then
- result := PUInt8Array( p )[ 0 ] shl 16 or PUInt8Array( p )[ 1 ] shl 8 or
- PUInt8Array( p )[ 2 ]
- else
- result := PUInt8Array( p )[ 0 ] or PUInt8Array( p )[ 1 ] shl 8 or
- PUInt8Array( p )[ 2 ] shl 16;
- 4 : result := PUint32( p )^;
- else
- result := 0; // shouldn't happen, but avoids warnings
- end;
-end;
-
-procedure SDL_PutPixel( SrcSurface : PSDL_Surface; x : integer; y : integer; Color :
- cardinal );
-var
- Addr, Pitch, BPP : cardinal;
-begin
- Addr := cardinal( SrcSurface.Pixels );
- Pitch := SrcSurface.Pitch;
- BPP := SrcSurface.format.BytesPerPixel;
- asm
- mov eax, y
- mul Pitch // EAX := y * Pitch
- add Addr, eax // Addr:= Addr + (y * Pitch)
- mov eax, x
- mov ecx, Color
- cmp BPP, 1
- jne @Not1BPP
- add eax, Addr // Now: EAX:= Addr + (y * Pitch) + x
- mov [eax], cl
- jmp @Quit
- @Not1BPP:
- cmp BPP, 2
- jne @Not2BPP
- mul BPP // EAX := x * BPP
- add eax, Addr // Now: EAX:= Addr + (y * Pitch) + x * BPP
- mov [eax], cx
- jmp @Quit
- @Not2BPP:
- cmp BPP, 3
- jne @Not3BPP
- mul BPP // EAX := x * BPP
- add eax, Addr // Now: EAX:= Addr + (y * Pitch) + x * BPP
- mov edx, [eax]
- and edx, $ff000000
- or edx, ecx
- mov [eax], edx
- jmp @Quit
- @Not3BPP:
- mul BPP // EAX := x * BPP
- add eax, Addr // Now: EAX:= Addr + (y * Pitch) + x * BPP
- mov [eax], ecx
- @Quit:
- end;
-end;
-
-procedure SDL_AddPixel( SrcSurface : PSDL_Surface; x : integer; y : integer; Color :
- cardinal );
-var
- SrcColor, FinalColor : cardinal;
- Addr, Pitch, Bits : cardinal;
-begin
- if Color = 0 then
- exit;
- Addr := cardinal( SrcSurface.Pixels );
- Pitch := SrcSurface.Pitch;
- Bits := SrcSurface.format.BitsPerPixel;
- asm
- mov eax, y
- mul Pitch // EAX := y * Pitch
- add Addr, eax // Addr:= Addr + (y * Pitch)
- mov eax, x
- cmp Bits, 8
- jne @Not8bit
- add eax, Addr // Now: EAX:= Addr + (y * Pitch) + x
- mov cl, [eax]
- movzx ecx, cl
- mov SrcColor, ecx
- mov edx, Color
- and ecx, 3
- and edx, 3
- add ecx, edx
- cmp ecx, 3
- jbe @Skip1_8bit
- mov ecx, 3
- @Skip1_8bit:
- mov FinalColor, ecx
- mov ecx, SrcColor
- mov edx, Color
- and ecx, $1c
- and edx, $1c
- add ecx, edx
- cmp ecx, $1c
- jbe @Skip2_8bit
- mov ecx, $1c
- @Skip2_8bit:
- or FinalColor, ecx
- mov ecx, SrcColor
- mov edx, Color
- and ecx, $e0
- and edx, $e0
- add ecx, edx
- cmp ecx, $e0
- jbe @Skip3_8bit
- mov ecx, $e0
- @Skip3_8bit:
- or ecx, FinalColor
- mov [eax], cl
- jmp @Quit
- @Not8bit:
- cmp Bits, 15
- jne @Not15bit
- shl eax, 1
- add eax, Addr // Now: EAX:= Addr + (y * Pitch) + x * 2
- mov ecx, [eax]
- and ecx, $00007fff
- mov SrcColor, ecx
- mov edx, Color
- and ecx, $1f
- and edx, $1f
- add ecx, edx
- cmp ecx, $1f
- jbe @Skip1_15bit
- mov ecx, $1f
- @Skip1_15bit:
- mov FinalColor, ecx
- mov ecx, SrcColor
- mov edx, Color
- and ecx, $03e0
- and edx, $03e0
- add ecx, edx
- cmp ecx, $03e0
- jbe @Skip2_15bit
- mov ecx, $03e0
- @Skip2_15bit:
- or FinalColor, ecx
- mov ecx, SrcColor
- mov edx, Color
- and ecx, $7c00
- and edx, $7c00
- add ecx, edx
- cmp ecx, $7c00
- jbe @Skip3_15bit
- mov ecx, $7c00
- @Skip3_15bit:
- or ecx, FinalColor
- mov [eax], cx
- jmp @Quit
- @Not15Bit:
- cmp Bits, 16
- jne @Not16bit
- shl eax, 1
- add eax, Addr // Now: EAX:= Addr + (y * Pitch) + x * 2
- mov ecx, [eax]
- and ecx, $0000ffff
- mov SrcColor, ecx
- mov edx, Color
- and ecx, $1f
- and edx, $1f
- add ecx, edx
- cmp ecx, $1f
- jbe @Skip1_16bit
- mov ecx, $1f
- @Skip1_16bit:
- mov FinalColor, ecx
- mov ecx, SrcColor
- mov edx, Color
- and ecx, $07e0
- and edx, $07e0
- add ecx, edx
- cmp ecx, $07e0
- jbe @Skip2_16bit
- mov ecx, $07e0
- @Skip2_16bit:
- or FinalColor, ecx
- mov ecx, SrcColor
- mov edx, Color
- and ecx, $f800
- and edx, $f800
- add ecx, edx
- cmp ecx, $f800
- jbe @Skip3_16bit
- mov ecx, $f800
- @Skip3_16bit:
- or ecx, FinalColor
- mov [eax], cx
- jmp @Quit
- @Not16Bit:
- cmp Bits, 24
- jne @Not24bit
- mov ecx, 0
- add ecx, eax
- shl ecx, 1
- add ecx, eax
- mov eax, ecx
- jmp @32bit
- @Not24bit:
- shl eax, 2
- @32bit:
- add eax, Addr // Now: EAX:= Addr + (y * Pitch) + x * 2
- mov ecx, [eax]
- mov FinalColor, ecx
- and FinalColor, $ff000000
- and ecx, $00ffffff
- mov SrcColor, ecx
- mov edx, Color
- and ecx, $000000ff
- and edx, $000000ff
- add ecx, edx
- cmp ecx, $000000ff
- jbe @Skip1_32bit
- mov ecx, $000000ff
- @Skip1_32bit:
- or FinalColor, ecx
- mov ecx, SrcColor
- mov edx, Color
- and ecx, $0000ff00
- and edx, $0000ff00
- add ecx, edx
- cmp ecx, $0000ff00
- jbe @Skip2_32bit
- mov ecx, $0000ff00
- @Skip2_32bit:
- or FinalColor, ecx
- mov ecx, SrcColor
- mov edx, Color
- and ecx, $00ff0000
- and edx, $00ff0000
- add ecx, edx
- cmp ecx, $00ff0000
- jbe @Skip3_32bit
- mov ecx, $00ff0000
- @Skip3_32bit:
- or ecx, FinalColor
- mov [eax], ecx
- @Quit:
- end;
-end;
-
-procedure SDL_SubPixel( SrcSurface : PSDL_Surface; x : integer; y : integer; Color :
- cardinal );
-var
- SrcColor, FinalColor : cardinal;
- Addr, Pitch, Bits : cardinal;
-begin
- if Color = 0 then
- exit;
- Addr := cardinal( SrcSurface.Pixels );
- Pitch := SrcSurface.Pitch;
- Bits := SrcSurface.format.BitsPerPixel;
- asm
- mov eax, y
- mul Pitch // EAX := y * Pitch
- add Addr, eax // Addr:= Addr + (y * Pitch)
- mov eax, x
- cmp Bits, 8
- jne @Not8bit
- add eax, Addr // Now: EAX:= Addr + (y * Pitch) + x
- mov cl, [eax]
- movzx ecx, cl
- mov SrcColor, ecx
- mov edx, Color
- and ecx, 3
- and edx, 3
- sub ecx, edx
- jns @Skip1_8bit
- mov ecx, 0
- @Skip1_8bit:
- mov FinalColor, ecx
- mov ecx, SrcColor
- mov edx, Color
- and ecx, $1c
- and edx, $1c
- sub ecx, edx
- jns @Skip2_8bit
- mov ecx, 0
- @Skip2_8bit:
- or FinalColor, ecx
- mov ecx, SrcColor
- mov edx, Color
- and ecx, $e0
- and edx, $e0
- sub ecx, edx
- jns @Skip3_8bit
- mov ecx, 0
- @Skip3_8bit:
- or ecx, FinalColor
- mov [eax], cl
- jmp @Quit
- @Not8bit:
- cmp Bits, 15
- jne @Not15bit
- shl eax, 1
- add eax, Addr
- mov ecx, [eax]
- and ecx, $00007fff
- mov SrcColor, ecx
- mov edx, Color
- and ecx, $1f
- and edx, $1f
- sub ecx, edx
- jns @Skip1_15bit
- mov ecx, 0
- @Skip1_15bit:
- mov FinalColor, ecx
- mov ecx, SrcColor
- mov edx, Color
- and ecx, $03e0
- and edx, $03e0
- sub ecx, edx
- jns @Skip2_15bit
- mov ecx, 0
- @Skip2_15bit:
- or FinalColor, ecx
- mov ecx, SrcColor
- mov edx, Color
- and ecx, $7c00
- and edx, $7c00
- sub ecx, edx
- jns @Skip3_15bit
- mov ecx, 0
- @Skip3_15bit:
- or ecx, FinalColor
- mov [eax], cx
- jmp @Quit
- @Not15Bit:
- cmp Bits, 16
- jne @Not16bit
- shl eax, 1
- add eax, Addr
- mov ecx, [eax]
- and ecx, $0000ffff
- mov SrcColor, ecx
- mov edx, Color
- and ecx, $1f
- and edx, $1f
- sub ecx, edx
- jns @Skip1_16bit
- mov ecx, 0
- @Skip1_16bit:
- mov FinalColor, ecx
- mov ecx, SrcColor
- mov edx, Color
- and ecx, $07e0
- and edx, $07e0
- sub ecx, edx
- jns @Skip2_16bit
- mov ecx, 0
- @Skip2_16bit:
- or FinalColor, ecx
- mov ecx, SrcColor
- mov edx, Color
- and ecx, $f800
- and edx, $f800
- sub ecx, edx
- jns @Skip3_16bit
- mov ecx, 0
- @Skip3_16bit:
- or ecx, FinalColor
- mov [eax], cx
- jmp @Quit
- @Not16Bit:
- cmp Bits, 24
- jne @Not24bit
- mov ecx, 0
- add ecx, eax
- shl ecx, 1
- add ecx, eax
- mov eax, ecx
- jmp @32bit
- @Not24bit:
- shl eax, 2
- @32bit:
- add eax, Addr
- mov ecx, [eax]
- mov FinalColor, ecx
- and FinalColor, $ff000000
- and ecx, $00ffffff
- mov SrcColor, ecx
- mov edx, Color
- and ecx, $000000ff
- and edx, $000000ff
- sub ecx, edx
- jns @Skip1_32bit
- mov ecx, 0
- @Skip1_32bit:
- or FinalColor, ecx
- mov ecx, SrcColor
- mov edx, Color
- and ecx, $0000ff00
- and edx, $0000ff00
- sub ecx, edx
- jns @Skip2_32bit
- mov ecx, 0
- @Skip2_32bit:
- or FinalColor, ecx
- mov ecx, SrcColor
- mov edx, Color
- and ecx, $00ff0000
- and edx, $00ff0000
- sub ecx, edx
- jns @Skip3_32bit
- mov ecx, 0
- @Skip3_32bit:
- or ecx, FinalColor
- mov [eax], ecx
- @Quit:
- end;
-end;
-
-// Draw a line between x1,y1 and x2,y2 to the given surface
-// NOTE: The surface must be locked before calling this!
-procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
- cardinal );
-var
- dx, dy, sdx, sdy, x, y, px, py : integer;
-begin
- dx := x2 - x1;
- dy := y2 - y1;
- if dx < 0 then
- sdx := -1
- else
- sdx := 1;
- if dy < 0 then
- sdy := -1
- else
- sdy := 1;
- dx := sdx * dx + 1;
- dy := sdy * dy + 1;
- x := 0;
- y := 0;
- px := x1;
- py := y1;
- if dx >= dy then
- begin
- for x := 0 to dx - 1 do
- begin
- SDL_PutPixel( DstSurface, px, py, Color );
- y := y + dy;
- if y >= dx then
- begin
- y := y - dx;
- py := py + sdy;
- end;
- px := px + sdx;
- end;
- end
- else
- begin
- for y := 0 to dy - 1 do
- begin
- SDL_PutPixel( DstSurface, px, py, Color );
- x := x + dx;
- if x >= dy then
- begin
- x := x - dy;
- px := px + sdx;
- end;
- py := py + sdy;
- end;
- end;
-end;
-
-// Draw a dashed line between x1,y1 and x2,y2 to the given surface
-// NOTE: The surface must be locked before calling this!
-procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
- cardinal ; DashLength, DashSpace : byte ); overload;
-var
- dx, dy, sdx, sdy, x, y, px, py, counter : integer; drawdash : boolean;
-begin
- counter := 0;
- drawdash := true; //begin line drawing with dash
-
- //Avoid invalid user-passed dash parameters
- if (DashLength < 1)
- then DashLength := 1;
- if (DashSpace < 1)
- then DashSpace := 0;
-
- dx := x2 - x1;
- dy := y2 - y1;
- if dx < 0 then
- sdx := -1
- else
- sdx := 1;
- if dy < 0 then
- sdy := -1
- else
- sdy := 1;
- dx := sdx * dx + 1;
- dy := sdy * dy + 1;
- x := 0;
- y := 0;
- px := x1;
- py := y1;
- if dx >= dy then
- begin
- for x := 0 to dx - 1 do
- begin
-
- //Alternate drawing dashes, or leaving spaces
- if drawdash then
- begin
- SDL_PutPixel( DstSurface, px, py, Color );
- inc(counter);
- if (counter > DashLength-1) and (DashSpace > 0) then
- begin
- drawdash := false;
- counter := 0;
- end;
- end
- else //space
- begin
- inc(counter);
- if counter > DashSpace-1 then
- begin
- drawdash := true;
- counter := 0;
- end;
- end;
-
- y := y + dy;
- if y >= dx then
- begin
- y := y - dx;
- py := py + sdy;
- end;
- px := px + sdx;
- end;
- end
- else
- begin
- for y := 0 to dy - 1 do
- begin
-
- //Alternate drawing dashes, or leaving spaces
- if drawdash then
- begin
- SDL_PutPixel( DstSurface, px, py, Color );
- inc(counter);
- if (counter > DashLength-1) and (DashSpace > 0) then
- begin
- drawdash := false;
- counter := 0;
- end;
- end
- else //space
- begin
- inc(counter);
- if counter > DashSpace-1 then
- begin
- drawdash := true;
- counter := 0;
- end;
- end;
-
- x := x + dx;
- if x >= dy then
- begin
- x := x - dy;
- px := px + sdx;
- end;
- py := py + sdy;
- end;
- end;
-end;
-
-procedure SDL_AddLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
- cardinal );
-var
- dx, dy, sdx, sdy, x, y, px, py : integer;
-begin
- dx := x2 - x1;
- dy := y2 - y1;
- if dx < 0 then
- sdx := -1
- else
- sdx := 1;
- if dy < 0 then
- sdy := -1
- else
- sdy := 1;
- dx := sdx * dx + 1;
- dy := sdy * dy + 1;
- x := 0;
- y := 0;
- px := x1;
- py := y1;
- if dx >= dy then
- begin
- for x := 0 to dx - 1 do
- begin
- SDL_AddPixel( DstSurface, px, py, Color );
- y := y + dy;
- if y >= dx then
- begin
- y := y - dx;
- py := py + sdy;
- end;
- px := px + sdx;
- end;
- end
- else
- begin
- for y := 0 to dy - 1 do
- begin
- SDL_AddPixel( DstSurface, px, py, Color );
- x := x + dx;
- if x >= dy then
- begin
- x := x - dy;
- px := px + sdx;
- end;
- py := py + sdy;
- end;
- end;
-end;
-
-procedure SDL_SubLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
- cardinal );
-var
- dx, dy, sdx, sdy, x, y, px, py : integer;
-begin
- dx := x2 - x1;
- dy := y2 - y1;
- if dx < 0 then
- sdx := -1
- else
- sdx := 1;
- if dy < 0 then
- sdy := -1
- else
- sdy := 1;
- dx := sdx * dx + 1;
- dy := sdy * dy + 1;
- x := 0;
- y := 0;
- px := x1;
- py := y1;
- if dx >= dy then
- begin
- for x := 0 to dx - 1 do
- begin
- SDL_SubPixel( DstSurface, px, py, Color );
- y := y + dy;
- if y >= dx then
- begin
- y := y - dx;
- py := py + sdy;
- end;
- px := px + sdx;
- end;
- end
- else
- begin
- for y := 0 to dy - 1 do
- begin
- SDL_SubPixel( DstSurface, px, py, Color );
- x := x + dx;
- if x >= dy then
- begin
- x := x - dy;
- px := px + sdx;
- end;
- py := py + sdy;
- end;
- end;
-end;
-
-// This procedure works on 8, 15, 16, 24 and 32 bits color depth surfaces.
-// In 8 bit color depth mode the procedure works with the default packed
-// palette (RRRGGGBB). It handles all clipping.
-procedure SDL_AddSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DstSurface : PSDL_Surface; DestRect : PSDL_Rect );
-var
- Src, Dest : TSDL_Rect;
- Diff : integer;
- SrcAddr, DestAddr : cardinal;
- // TransparentColor: cardinal;
- _ebx, _esi, _edi, _esp : cardinal;
- WorkX, WorkY : word;
- SrcMod, DestMod : cardinal;
- Bits : cardinal;
-begin
- if ( SrcSurface = nil ) or ( DstSurface = nil ) then
- exit; // Remove this to make it faster
- if ( SrcSurface.Format.BitsPerPixel <> DstSurface.Format.BitsPerPixel ) then
- exit; // Remove this to make it faster
- if SrcRect = nil then
- begin
- with Src do
- begin
- x := 0;
- y := 0;
- w := SrcSurface.w;
- h := SrcSurface.h;
- end;
- end
- else
- Src := SrcRect^;
- if DestRect = nil then
- begin
- Dest.x := 0;
- Dest.y := 0;
- end
- else
- Dest := DestRect^;
- Dest.w := Src.w;
- Dest.h := Src.h;
- with DstSurface.Clip_Rect do
- begin
- // Source's right side is greater than the dest.cliprect
- if Dest.x + Src.w > x + w then
- begin
- smallint( Src.w ) := x + w - Dest.x;
- smallint( Dest.w ) := x + w - Dest.x;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's bottom side is greater than the dest.clip
- if Dest.y + Src.h > y + h then
- begin
- smallint( Src.h ) := y + h - Dest.y;
- smallint( Dest.h ) := y + h - Dest.y;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- // Source's left side is less than the dest.clip
- if Dest.x < x then
- begin
- Diff := x - Dest.x;
- Src.x := Src.x + Diff;
- smallint( Src.w ) := smallint( Src.w ) - Diff;
- Dest.x := x;
- smallint( Dest.w ) := smallint( Dest.w ) - Diff;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's Top side is less than the dest.clip
- if Dest.y < y then
- begin
- Diff := y - Dest.y;
- Src.y := Src.y + Diff;
- smallint( Src.h ) := smallint( Src.h ) - Diff;
- Dest.y := y;
- smallint( Dest.h ) := smallint( Dest.h ) - Diff;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- end;
- with SrcSurface^ do
- begin
- SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
- Format.BytesPerPixel;
- SrcMod := Pitch - Src.w * Format.BytesPerPixel;
- // TransparentColor := format.ColorKey;
- end;
- with DstSurface^ do
- begin
- DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
- Format.BytesPerPixel;
- DestMod := Pitch - Dest.w * Format.BytesPerPixel;
- Bits := Format.BitsPerPixel;
- end;
- SDL_LockSurface( SrcSurface );
- SDL_LockSurface( DstSurface );
- case bits of
- 8 :
- asm
- mov _ebx, ebx
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- @LoopY:
- mov ax, Src.w
- mov WorkX, ax // WorkX := Src.w
- @Loopx:
- mov al, [esi] // AL := source color
- cmp al, 0
- je @SkipColor // if AL=0 or AL=transparent color then skip everything
- mov esp, eax // ESP - source color
- mov bl, [edi] // BL := destination color
- mov dl, bl // DL := destination color
- and ax, $03 // Adding BLUE
- and bl, $03
- add al, bl
- cmp al, $03
- jbe @Skip1
- mov al, $03
- @Skip1:
- mov cl, al
- mov eax, esp // Adding GREEN
- mov bl, dl
- and al, $1c
- and bl, $1c
- add al, bl
- cmp al, $1c
- jbe @Skip2
- mov al, $1c
- @Skip2:
- or cl, al
- mov eax, esp // Adding RED
- mov bl, dl
- and ax, $e0
- and bx, $e0
- add ax, bx
- cmp ax, $e0
- jbe @Skip3
- mov al, $e0
- @Skip3:
- or cl, al
- mov [edi], cl
- @SkipColor:
- inc esi
- inc edi
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- dec WorkY
- jnz @LoopY
- mov esp,_esp
- mov edi,_edi
- mov esi,_esi
- mov ebx,_ebx
- end;
- 15 :
- asm
- mov _ebx, ebx
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- @LoopY:
- mov ax, Src.w
- mov WorkX, ax // WorkX := Src.w
- @Loopx:
- mov ax, [esi] // AX := source color
- cmp ax, 0
- je @SkipColor // if AX=0 then skip everything
- mov esp, eax // ESP - source color
- mov bx, [edi] // BX := destination color
- mov dx, bx // DX := destination color
- and ax, $001F // Adding BLUE
- and bx, $001F
- add ax, bx
- cmp ax, $001F
- jbe @Skip1
- mov ax, $001F
- @Skip1:
- mov cx, ax
- mov eax, esp // Adding GREEN
- mov bx, dx
- and ax, $3E0
- and bx, $3E0
- add ax, bx
- cmp ax, $3E0
- jbe @Skip2
- mov ax, $3E0
- @Skip2:
- or cx, ax
- mov eax, esp // Adding RED
- mov bx, dx
- and ax, $7C00
- and bx, $7C00
- add ax, bx
- cmp ax, $7C00
- jbe @Skip3
- mov ax, $7C00
- @Skip3:
- or cx, ax
- mov [edi], cx
- @SkipColor:
- add esi, 2
- add edi, 2
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- dec WorkY
- jnz @LoopY
- mov esp,_esp
- mov edi,_edi
- mov esi,_esi
- mov ebx,_ebx
- end;
- 16 :
- asm
- mov _ebx, ebx
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- @LoopY:
- mov ax, Src.w
- mov WorkX, ax // WorkX := Src.w
- @Loopx:
- mov ax, [esi] // AX := source color
- cmp ax, 0
- je @SkipColor // if AX=0 then skip everything
- mov esp, eax // ESP - source color
- mov bx, [edi] // BX := destination color
- mov dx, bx // DX := destination color
- and ax, $1F // Adding BLUE
- and bx, $1F
- add ax, bx
- cmp ax, $1F
- jbe @Skip1
- mov ax, $1F
- @Skip1:
- mov cx, ax
- mov eax, esp // Adding GREEN
- mov bx, dx
- and ax, $7E0
- and bx, $7E0
- add ax, bx
- cmp ax, $7E0
- jbe @Skip2
- mov ax, $7E0
- @Skip2:
- or cx, ax
- mov eax, esp // Adding RED
- mov bx, dx
- and eax, $F800
- and ebx, $F800
- add eax, ebx
- cmp eax, $F800
- jbe @Skip3
- mov ax, $F800
- @Skip3:
- or cx, ax
- mov [edi], cx
- @SkipColor:
- add esi, 2
- add edi, 2
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- dec WorkY
- jnz @LoopY
- mov esp,_esp
- mov edi,_edi
- mov esi,_esi
- mov ebx,_ebx
- end;
- 24 :
- asm
- mov _ebx, ebx
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- @LoopY:
- mov ax, Src.w
- mov WorkX, ax // WorkX := Src.w
- add WorkX, ax // WorkX := Src.w * 2
- add WorkX, ax // WorkX := Src.w * 3
- @Loopx:
- mov bl, [edi] // BX := destination color
- mov al, [esi] // AX := source color
- cmp al, 0
- je @Skip // if AL=0 then skip COMPONENT
- mov ah, 0 // AX := COLOR COMPONENT
- mov bh, 0
- add bx, ax
- cmp bx, $00ff
- jb @Skip
- mov bl, $ff
- @Skip:
- mov [edi], bl
- inc esi
- inc edi
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- dec WorkY
- jnz @LoopY
- mov esp,_esp
- mov edi,_edi
- mov esi,_esi
- mov ebx,_ebx
- end;
- 32 :
- asm
- mov _ebx, ebx
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- @LoopY:
- mov ax, Src.w
- shl ax, 2
- mov WorkX, ax // WorkX := Src.w * 4
- @Loopx:
- mov bl, [edi] // BX := destination color
- mov al, [esi] // AX := source color
- cmp al, 0
- je @Skip // if AL=0 then skip COMPONENT
- mov ah, 0 // AX := COLOR COMPONENT
- mov bh, 0
- add bx, ax
- cmp bx, $00ff
- jb @Skip
- mov bl, $ff
- @Skip:
- mov [edi], bl
- inc esi
- inc edi
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- dec WorkY
- jnz @LoopY
- mov esp,_esp
- mov edi,_edi
- mov esi,_esi
- mov ebx,_ebx
- end;
- end;
- SDL_UnlockSurface( SrcSurface );
- SDL_UnlockSurface( DstSurface );
-end;
-
-procedure SDL_SubSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DstSurface : PSDL_Surface; DestRect : PSDL_Rect );
-var
- Src, Dest : TSDL_Rect;
- Diff : integer;
- SrcAddr, DestAddr : cardinal;
- _ebx, _esi, _edi, _esp : cardinal;
- WorkX, WorkY : word;
- SrcMod, DestMod : cardinal;
- Bits : cardinal;
-begin
- if ( SrcSurface = nil ) or ( DstSurface = nil ) then
- exit; // Remove this to make it faster
- if ( SrcSurface.Format.BitsPerPixel <> DstSurface.Format.BitsPerPixel ) then
- exit; // Remove this to make it faster
- if SrcRect = nil then
- begin
- with Src do
- begin
- x := 0;
- y := 0;
- w := SrcSurface.w;
- h := SrcSurface.h;
- end;
- end
- else
- Src := SrcRect^;
- if DestRect = nil then
- begin
- Dest.x := 0;
- Dest.y := 0;
- end
- else
- Dest := DestRect^;
- Dest.w := Src.w;
- Dest.h := Src.h;
- with DstSurface.Clip_Rect do
- begin
- // Source's right side is greater than the dest.cliprect
- if Dest.x + Src.w > x + w then
- begin
- smallint( Src.w ) := x + w - Dest.x;
- smallint( Dest.w ) := x + w - Dest.x;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's bottom side is greater than the dest.clip
- if Dest.y + Src.h > y + h then
- begin
- smallint( Src.h ) := y + h - Dest.y;
- smallint( Dest.h ) := y + h - Dest.y;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- // Source's left side is less than the dest.clip
- if Dest.x < x then
- begin
- Diff := x - Dest.x;
- Src.x := Src.x + Diff;
- smallint( Src.w ) := smallint( Src.w ) - Diff;
- Dest.x := x;
- smallint( Dest.w ) := smallint( Dest.w ) - Diff;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's Top side is less than the dest.clip
- if Dest.y < y then
- begin
- Diff := y - Dest.y;
- Src.y := Src.y + Diff;
- smallint( Src.h ) := smallint( Src.h ) - Diff;
- Dest.y := y;
- smallint( Dest.h ) := smallint( Dest.h ) - Diff;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- end;
- with SrcSurface^ do
- begin
- SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
- Format.BytesPerPixel;
- SrcMod := Pitch - Src.w * Format.BytesPerPixel;
- end;
- with DstSurface^ do
- begin
- DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
- Format.BytesPerPixel;
- DestMod := Pitch - Dest.w * Format.BytesPerPixel;
- Bits := DstSurface.Format.BitsPerPixel;
- end;
- SDL_LockSurface( SrcSurface );
- SDL_LockSurface( DstSurface );
- case bits of
- 8 :
- asm
- mov _ebx, ebx
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- @LoopY:
- mov ax, Src.w
- mov WorkX, ax // WorkX := Src.w
- @Loopx:
- mov al, [esi] // AL := source color
- cmp al, 0
- je @SkipColor // if AL=0 then skip everything
- mov esp, eax // ESP - source color
- mov bl, [edi] // BL := destination color
- mov dl, bl // DL := destination color
- and al, $03 // Subtract BLUE
- and bl, $03
- sub bl, al
- jns @Skip1
- mov bl, 0
- @Skip1:
- mov cl, bl
- mov eax, esp // Subtract GREEN
- mov bl, dl
- and al, $1c
- and bl, $1c
- sub bl, al
- jns @Skip2
- mov bl, 0
- @Skip2:
- or cl, bl
- mov eax, esp // Subtract RED
- mov bl, dl
- and ax, $e0
- and bx, $e0
- sub bx, ax
- jns @Skip3
- mov bl, 0
- @Skip3:
- or cl, bl
- mov [edi], cl
- @SkipColor:
- inc esi
- inc edi
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- dec WorkY
- jnz @LoopY
- mov esp,_esp
- mov edi,_edi
- mov esi,_esi
- mov ebx,_ebx
- end;
- 15 :
- asm
- mov _ebx, ebx
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- @LoopY:
- mov ax, Src.w
- mov WorkX, ax // WorkX := Src.w
- @Loopx:
- mov ax, [esi] // AX := source color
- cmp ax, 0
- je @SkipColor // if AX=0 then skip everything
- mov esp, eax // ESP - source color
- mov bx, [edi] // BX := destination color
- mov dx, bx // DX := destination color
- and ax, $001F // Subtract BLUE
- and bx, $001F
- sub bx, ax
- jns @Skip1
- mov bx, 0
- @Skip1:
- mov cx, bx
- mov eax, esp // Subtract GREEN
- mov bx, dx
- and ax, $3E0
- and bx, $3E0
- sub bx, ax
- jns @Skip2
- mov bx, 0
- @Skip2:
- or cx, bx
- mov eax, esp // Subtract RED
- mov bx, dx
- and ax, $7C00
- and bx, $7C00
- sub bx, ax
- jns @Skip3
- mov bx, 0
- @Skip3:
- or cx, bx
- mov [edi], cx
- @SkipColor:
- add esi, 2
- add edi, 2
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- dec WorkY
- jnz @LoopY
- mov esp,_esp
- mov edi,_edi
- mov esi,_esi
- mov ebx,_ebx
- end;
- 16 :
- asm
- mov _ebx, ebx
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- @LoopY:
- mov ax, Src.w
- mov WorkX, ax // WorkX := Src.w
- @Loopx:
- mov ax, [esi] // AX := source color
- cmp ax, 0
- je @SkipColor // if AX=0 then skip everything
- mov esp, eax // ESP - source color
- mov bx, [edi] // BX := destination color
- mov dx, bx // DX := destination color
- and ax, $1F // Subtracting BLUE
- and bx, $1F
- sub bx, ax
- jns @Skip1
- mov bx, 0
- @Skip1:
- mov cx, bx
- mov eax, esp // Adding GREEN
- mov bx, dx
- and ax, $7E0
- and bx, $7E0
- sub bx, ax
- jns @Skip2
- mov bx, 0
- @Skip2:
- or cx, bx
- mov eax, esp // Adding RED
- mov bx, dx
- and eax, $F800
- and ebx, $F800
- sub ebx, eax
- jns @Skip3
- mov bx, 0
- @Skip3:
- or cx, bx
- mov [edi], cx
- @SkipColor:
- add esi, 2
- add edi, 2
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- dec WorkY
- jnz @LoopY
- mov esp,_esp
- mov edi,_edi
- mov esi,_esi
- mov ebx,_ebx
- end;
- 24 :
- asm
- mov _ebx, ebx
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- @LoopY:
- mov ax, Src.w
- mov WorkX, ax // WorkX := Src.w
- add WorkX, ax // WorkX := Src.w * 2
- add WorkX, ax // WorkX := Src.w * 3
- @Loopx:
- mov bl, [edi] // BX := destination color
- mov al, [esi] // AX := source color
- cmp al, 0
- je @Skip // if AL=0 then skip COMPONENT
- mov ah, 0 // AX := COLOR COMPONENT
- mov bh, 0
- sub bx, ax
- jns @Skip
- mov bl, 0
- @Skip:
- mov [edi], bl
- inc esi
- inc edi
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- dec WorkY
- jnz @LoopY
- mov esp,_esp
- mov edi,_edi
- mov esi,_esi
- mov ebx,_ebx
- end;
- 32 :
- asm
- mov _ebx, ebx
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- @LoopY:
- mov ax, Src.w
- shl ax, 2
- mov WorkX, ax // WorkX := Src.w * 4
- @Loopx:
- mov bl, [edi] // BX := destination color
- mov al, [esi] // AX := source color
- cmp al, 0
- je @Skip // if AL=0 then skip COMPONENT
- mov ah, 0 // AX := COLOR COMPONENT
- mov bh, 0
- sub bx, ax
- jns @Skip
- mov bl, 0
- @Skip:
- mov [edi], bl
- inc esi
- inc edi
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- dec WorkY
- jnz @LoopY
- mov esp,_esp
- mov edi,_edi
- mov esi,_esi
- mov ebx,_ebx
- end;
- end;
- SDL_UnlockSurface( SrcSurface );
- SDL_UnlockSurface( DstSurface );
-end;
-
-procedure SDL_MonoSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DstSurface : PSDL_Surface; DestRect : PSDL_Rect; Color : cardinal );
-var
- Src, Dest : TSDL_Rect;
- Diff : integer;
- SrcAddr, DestAddr : cardinal;
- _ebx, _esi, _edi, _esp : cardinal;
- WorkX, WorkY : word;
- SrcMod, DestMod : cardinal;
- SrcTransparentColor : cardinal;
- Bits : cardinal;
-begin
- if ( SrcSurface = nil ) or ( DstSurface = nil ) then
- exit; // Remove this to make it faster
- if ( SrcSurface.Format.BitsPerPixel <> DstSurface.Format.BitsPerPixel ) then
- exit; // Remove this to make it faster
- if SrcRect = nil then
- begin
- with Src do
- begin
- x := 0;
- y := 0;
- w := SrcSurface.w;
- h := SrcSurface.h;
- end;
- end
- else
- Src := SrcRect^;
- if DestRect = nil then
- begin
- Dest.x := 0;
- Dest.y := 0;
- end
- else
- Dest := DestRect^;
- Dest.w := Src.w;
- Dest.h := Src.h;
- with DstSurface.Clip_Rect do
- begin
- // Source's right side is greater than the dest.cliprect
- if Dest.x + Src.w > x + w then
- begin
- smallint( Src.w ) := x + w - Dest.x;
- smallint( Dest.w ) := x + w - Dest.x;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's bottom side is greater than the dest.clip
- if Dest.y + Src.h > y + h then
- begin
- smallint( Src.h ) := y + h - Dest.y;
- smallint( Dest.h ) := y + h - Dest.y;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- // Source's left side is less than the dest.clip
- if Dest.x < x then
- begin
- Diff := x - Dest.x;
- Src.x := Src.x + Diff;
- smallint( Src.w ) := smallint( Src.w ) - Diff;
- Dest.x := x;
- smallint( Dest.w ) := smallint( Dest.w ) - Diff;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's Top side is less than the dest.clip
- if Dest.y < y then
- begin
- Diff := y - Dest.y;
- Src.y := Src.y + Diff;
- smallint( Src.h ) := smallint( Src.h ) - Diff;
- Dest.y := y;
- smallint( Dest.h ) := smallint( Dest.h ) - Diff;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- end;
- with SrcSurface^ do
- begin
- SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
- Format.BytesPerPixel;
- SrcMod := Pitch - Src.w * Format.BytesPerPixel;
- SrcTransparentColor := format.colorkey;
- end;
- with DstSurface^ do
- begin
- DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
- Format.BytesPerPixel;
- DestMod := Pitch - Dest.w * Format.BytesPerPixel;
- Bits := DstSurface.Format.BitsPerPixel;
- end;
- SDL_LockSurface( SrcSurface );
- SDL_LockSurface( DstSurface );
- case bits of
- 8 :
- asm
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- mov ecx, Color
- @LoopY:
- mov ax, Src.w
- mov WorkX, ax // WorkX := Src.w
- @Loopx:
- mov al, [esi] // AL := source color
- movzx eax, al
- cmp eax, SrcTransparentColor
- je @SkipColor // if AL=Transparent color then skip everything
- mov [edi], cl
- @SkipColor:
- inc esi
- inc edi
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- dec WorkY
- jnz @LoopY
- mov esp,_esp
- mov edi,_edi
- mov esi,_esi
- end;
- 15, 16 :
- asm
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- mov ecx, Color
- @LoopY:
- mov ax, Src.w
- mov WorkX, ax // WorkX := Src.w
- @Loopx:
- mov ax, [esi] // AX := source color
- movzx eax, ax
- cmp eax, SrcTransparentColor
- je @SkipColor // if AX=Transparent color then skip everything
- mov [edi], cx
- @SkipColor:
- inc esi
- inc esi
- inc edi
- inc edi
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- dec WorkY
- jnz @LoopY
- mov esp,_esp
- mov edi,_edi
- mov esi,_esi
- end;
- 24 :
- asm
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov _ebx, ebx
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- mov ecx, Color
- and ecx, $00ffffff
- @LoopY:
- mov ax, Src.w
- mov WorkX, ax // WorkX := Src.w
- @Loopx:
- mov eax, [esi] // EAX := source color
- and eax, $00ffffff
- cmp eax, SrcTransparentColor
- je @SkipColor // if EAX=Transparent color then skip everything
- mov ebx, [edi]
- and ebx, $ff000000
- or ebx, ecx
- mov [edi], ecx
- @SkipColor:
- add esi, 3
- add edi, 3
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- dec WorkY
- jnz @LoopY
- mov esp, _esp
- mov edi, _edi
- mov esi, _esi
- mov ebx, _ebx
- end;
- 32 :
- asm
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- mov ecx, Color
- @LoopY:
- mov ax, Src.w
- mov WorkX, ax // WorkX := Src.w
- @Loopx:
- mov eax, [esi] // EAX := source color
- cmp eax, SrcTransparentColor
- je @SkipColor // if EAX=Transparent color then skip everything
- mov [edi], ecx
- @SkipColor:
- add esi, 4
- add edi, 4
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- dec WorkY
- jnz @LoopY
- mov esp, _esp
- mov edi, _edi
- mov esi, _esi
- end;
- end;
- SDL_UnlockSurface( SrcSurface );
- SDL_UnlockSurface( DstSurface );
-end;
-// TextureRect.w and TextureRect.h are not used.
-// The TextureSurface's size MUST larger than the drawing rectangle!!!
-
-procedure SDL_TexturedSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DstSurface : PSDL_Surface; DestRect : PSDL_Rect; Texture : PSDL_Surface;
- TextureRect : PSDL_Rect );
-var
- Src, Dest : TSDL_Rect;
- Diff : integer;
- SrcAddr, DestAddr, TextAddr : cardinal;
- _ebx, _esi, _edi, _esp : cardinal;
- WorkX, WorkY : word;
- SrcMod, DestMod, TextMod : cardinal;
- SrcTransparentColor : cardinal;
- Bits : cardinal;
-begin
- if ( SrcSurface = nil ) or ( DstSurface = nil ) then
- exit; // Remove this to make it faster
- if ( SrcSurface.Format.BitsPerPixel <> DstSurface.Format.BitsPerPixel ) then
- exit; // Remove this to make it faster
- if SrcRect = nil then
- begin
- with Src do
- begin
- x := 0;
- y := 0;
- w := SrcSurface.w;
- h := SrcSurface.h;
- end;
- end
- else
- Src := SrcRect^;
- if DestRect = nil then
- begin
- Dest.x := 0;
- Dest.y := 0;
- end
- else
- Dest := DestRect^;
- Dest.w := Src.w;
- Dest.h := Src.h;
- with DstSurface.Clip_Rect do
- begin
- // Source's right side is greater than the dest.cliprect
- if Dest.x + Src.w > x + w then
- begin
- smallint( Src.w ) := x + w - Dest.x;
- smallint( Dest.w ) := x + w - Dest.x;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's bottom side is greater than the dest.clip
- if Dest.y + Src.h > y + h then
- begin
- smallint( Src.h ) := y + h - Dest.y;
- smallint( Dest.h ) := y + h - Dest.y;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- // Source's left side is less than the dest.clip
- if Dest.x < x then
- begin
- Diff := x - Dest.x;
- Src.x := Src.x + Diff;
- smallint( Src.w ) := smallint( Src.w ) - Diff;
- Dest.x := x;
- smallint( Dest.w ) := smallint( Dest.w ) - Diff;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's Top side is less than the dest.clip
- if Dest.y < y then
- begin
- Diff := y - Dest.y;
- Src.y := Src.y + Diff;
- smallint( Src.h ) := smallint( Src.h ) - Diff;
- Dest.y := y;
- smallint( Dest.h ) := smallint( Dest.h ) - Diff;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- end;
- with SrcSurface^ do
- begin
- SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
- Format.BytesPerPixel;
- SrcMod := Pitch - Src.w * Format.BytesPerPixel;
- SrcTransparentColor := format.colorkey;
- end;
- with DstSurface^ do
- begin
- DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
- Format.BytesPerPixel;
- DestMod := Pitch - Dest.w * Format.BytesPerPixel;
- Bits := DstSurface.Format.BitsPerPixel;
- end;
- with Texture^ do
- begin
- TextAddr := cardinal( Pixels ) + UInt32( TextureRect.y ) * Pitch +
- UInt32( TextureRect.x ) * Format.BytesPerPixel;
- TextMod := Pitch - Src.w * Format.BytesPerPixel;
- end;
- SDL_LockSurface( SrcSurface );
- SDL_LockSurface( DstSurface );
- SDL_LockSurface( Texture );
- case bits of
- 8 :
- asm
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov _ebx, ebx
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ebx, TextAddr
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- @LoopY:
- mov ax, Src.w
- mov WorkX, ax // WorkX := Src.w
- @Loopx:
- mov al, [esi] // AL := source color
- movzx eax, al
- cmp eax, SrcTransparentColor
- je @SkipColor // if AL=Transparent color then skip everything
- mov al, [ebx]
- mov [edi], al
- @SkipColor:
- inc esi
- inc edi
- inc ebx
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- add ebx, TextMod
- dec WorkY
- jnz @LoopY
- mov esp,_esp
- mov edi,_edi
- mov esi,_esi
- mov ebx, _ebx
- end;
- 15, 16 :
- asm
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ecx, TextAddr
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- @LoopY:
- mov ax, Src.w
- mov WorkX, ax // WorkX := Src.w
- @Loopx:
- mov ax, [esi] // AL := source color
- movzx eax, ax
- cmp eax, SrcTransparentColor
- je @SkipColor // if AL=Transparent color then skip everything
- mov ax, [ecx]
- mov [edi], ax
- @SkipColor:
- inc esi
- inc esi
- inc edi
- inc edi
- inc ecx
- inc ecx
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- add ecx, TextMod
- dec WorkY
- jnz @LoopY
- mov esp,_esp
- mov edi,_edi
- mov esi,_esi
- end;
- 24 :
- asm
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov _ebx, ebx
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ebx, TextAddr
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- @LoopY:
- mov ax, Src.w
- mov WorkX, ax // WorkX := Src.w
- @Loopx:
- mov eax, [esi] // AL := source color
- and eax, $00ffffff
- cmp eax, SrcTransparentColor
- je @SkipColor // if AL=Transparent color then skip everything
- mov eax, [ebx]
- and eax, $00ffffff
- mov ecx, [edi]
- and ecx, $ff000000
- or ecx, eax
- mov [edi], eax
- @SkipColor:
- add esi, 3
- add edi, 3
- add ebx, 3
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- add ebx, TextMod
- dec WorkY
- jnz @LoopY
- mov esp,_esp
- mov edi,_edi
- mov esi,_esi
- mov ebx, _ebx
- end;
- 32 :
- asm
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ecx, TextAddr
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- @LoopY:
- mov ax, Src.w
- mov WorkX, ax // WorkX := Src.w
- @Loopx:
- mov eax, [esi] // AL := source color
- cmp eax, SrcTransparentColor
- je @SkipColor // if AL=Transparent color then skip everything
- mov eax, [ecx]
- mov [edi], eax
- @SkipColor:
- add esi, 4
- add edi, 4
- add ecx, 4
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- add ecx, TextMod
- dec WorkY
- jnz @LoopY
- mov esp,_esp
- mov edi,_edi
- mov esi,_esi
- end;
- end;
- SDL_UnlockSurface( SrcSurface );
- SDL_UnlockSurface( DstSurface );
- SDL_UnlockSurface( Texture );
-end;
-
-procedure SDL_ZoomSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; DstRect : PSDL_Rect );
-var
- xc, yc : cardinal;
- rx, wx, ry, wy, ry16 : cardinal;
- color : cardinal;
- modx, mody : cardinal;
-begin
- // Warning! No checks for surface pointers!!!
- if srcrect = nil then
- srcrect := @SrcSurface.clip_rect;
- if dstrect = nil then
- dstrect := @DstSurface.clip_rect;
- if SDL_MustLock( SrcSurface ) then
- SDL_LockSurface( SrcSurface );
- if SDL_MustLock( DstSurface ) then
- SDL_LockSurface( DstSurface );
- modx := trunc( ( srcrect.w / dstrect.w ) * 65536 );
- mody := trunc( ( srcrect.h / dstrect.h ) * 65536 );
- //rx := srcrect.x * 65536;
- ry := srcrect.y * 65536;
- wy := dstrect.y;
- for yc := 0 to dstrect.h - 1 do
- begin
- rx := srcrect.x * 65536;
- wx := dstrect.x;
- ry16 := ry shr 16;
- for xc := 0 to dstrect.w - 1 do
- begin
- color := SDL_GetPixel( SrcSurface, rx shr 16, ry16 );
- SDL_PutPixel( DstSurface, wx, wy, color );
- rx := rx + modx;
- inc( wx );
- end;
- ry := ry + mody;
- inc( wy );
- end;
- if SDL_MustLock( SrcSurface ) then
- SDL_UnlockSurface( SrcSurface );
- if SDL_MustLock( DstSurface ) then
- SDL_UnlockSurface( DstSurface );
-end;
-// Re-map a rectangular area into an area defined by four vertices
-// Converted from C to Pascal by KiCHY
-
-procedure SDL_WarpSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; UL, UR, LR, LL : PPoint );
-const
- SHIFTS = 15; // Extend ints to limit round-off error (try 2 - 20)
- THRESH = 1 shl SHIFTS; // Threshold for pixel size value
- procedure CopySourceToDest( UL, UR, LR, LL : TPoint; x1, y1, x2, y2 : cardinal );
- var
- tm, lm, rm, bm, m : TPoint;
- mx, my : cardinal;
- cr : cardinal;
- begin
- // Does the destination area specify a single pixel?
- if ( ( abs( ul.x - ur.x ) < THRESH ) and
- ( abs( ul.x - lr.x ) < THRESH ) and
- ( abs( ul.x - ll.x ) < THRESH ) and
- ( abs( ul.y - ur.y ) < THRESH ) and
- ( abs( ul.y - lr.y ) < THRESH ) and
- ( abs( ul.y - ll.y ) < THRESH ) ) then
- begin // Yes
- cr := SDL_GetPixel( SrcSurface, ( x1 shr SHIFTS ), ( y1 shr SHIFTS ) );
- SDL_PutPixel( DstSurface, ( ul.x shr SHIFTS ), ( ul.y shr SHIFTS ), cr );
- end
- else
- begin // No
- // Quarter the source and the destination, and then recurse
- tm.x := ( ul.x + ur.x ) shr 1;
- tm.y := ( ul.y + ur.y ) shr 1;
- bm.x := ( ll.x + lr.x ) shr 1;
- bm.y := ( ll.y + lr.y ) shr 1;
- lm.x := ( ul.x + ll.x ) shr 1;
- lm.y := ( ul.y + ll.y ) shr 1;
- rm.x := ( ur.x + lr.x ) shr 1;
- rm.y := ( ur.y + lr.y ) shr 1;
- m.x := ( tm.x + bm.x ) shr 1;
- m.y := ( tm.y + bm.y ) shr 1;
- mx := ( x1 + x2 ) shr 1;
- my := ( y1 + y2 ) shr 1;
- CopySourceToDest( ul, tm, m, lm, x1, y1, mx, my );
- CopySourceToDest( tm, ur, rm, m, mx, y1, x2, my );
- CopySourceToDest( m, rm, lr, bm, mx, my, x2, y2 );
- CopySourceToDest( lm, m, bm, ll, x1, my, mx, y2 );
- end;
- end;
-var
- _UL, _UR, _LR, _LL : TPoint;
- Rect_x, Rect_y, Rect_w, Rect_h : integer;
-begin
- if SDL_MustLock( SrcSurface ) then
- SDL_LockSurface( SrcSurface );
- if SDL_MustLock( DstSurface ) then
- SDL_LockSurface( DstSurface );
- if SrcRect = nil then
- begin
- Rect_x := 0;
- Rect_y := 0;
- Rect_w := ( SrcSurface.w - 1 ) shl SHIFTS;
- Rect_h := ( SrcSurface.h - 1 ) shl SHIFTS;
- end
- else
- begin
- Rect_x := SrcRect.x;
- Rect_y := SrcRect.y;
- Rect_w := ( SrcRect.w - 1 ) shl SHIFTS;
- Rect_h := ( SrcRect.h - 1 ) shl SHIFTS;
- end;
- // Shift all values to help reduce round-off error.
- _ul.x := ul.x shl SHIFTS;
- _ul.y := ul.y shl SHIFTS;
- _ur.x := ur.x shl SHIFTS;
- _ur.y := ur.y shl SHIFTS;
- _lr.x := lr.x shl SHIFTS;
- _lr.y := lr.y shl SHIFTS;
- _ll.x := ll.x shl SHIFTS;
- _ll.y := ll.y shl SHIFTS;
- CopySourceToDest( _ul, _ur, _lr, _ll, Rect_x, Rect_y, Rect_w, Rect_h );
- if SDL_MustLock( SrcSurface ) then
- SDL_UnlockSurface( SrcSurface );
- if SDL_MustLock( DstSurface ) then
- SDL_UnlockSurface( DstSurface );
-end;
-
-// flips a rectangle vertically on given surface
-procedure SDL_FlipRectV( DstSurface : PSDL_Surface; Rect : PSDL_Rect );
-var
- TmpRect : TSDL_Rect;
- Locked : boolean;
- y, FlipLength, RowLength : integer;
- Row1, Row2 : Pointer;
- OneRow : TByteArray; // Optimize it if you wish
-begin
- if DstSurface <> nil then
- begin
- if Rect = nil then
- begin // if Rect=nil then we flip the whole surface
- TmpRect := SDLRect( 0, 0, DstSurface.w, DstSurface.h );
- Rect := @TmpRect;
- end;
- FlipLength := Rect^.h shr 1 - 1;
- RowLength := Rect^.w * DstSurface^.format.BytesPerPixel;
- if SDL_MustLock( DstSurface ) then
- begin
- Locked := true;
- SDL_LockSurface( DstSurface );
- end
- else
- Locked := false;
- Row1 := pointer( cardinal( DstSurface^.Pixels ) + UInt32( Rect^.y ) *
- DstSurface^.Pitch );
- Row2 := pointer( cardinal( DstSurface^.Pixels ) + ( UInt32( Rect^.y ) + Rect^.h - 1 )
- * DstSurface^.Pitch );
- for y := 0 to FlipLength do
- begin
- Move( Row1^, OneRow, RowLength );
- Move( Row2^, Row1^, RowLength );
- Move( OneRow, Row2^, RowLength );
- inc( cardinal( Row1 ), DstSurface^.Pitch );
- dec( cardinal( Row2 ), DstSurface^.Pitch );
- end;
- if Locked then
- SDL_UnlockSurface( DstSurface );
- end;
-end;
-
-// flips a rectangle horizontally on given surface
-procedure SDL_FlipRectH( DstSurface : PSDL_Surface; Rect : PSDL_Rect );
-type
- T24bit = packed array[ 0..2 ] of byte;
- T24bitArray = packed array[ 0..8191 ] of T24bit;
- P24bitArray = ^T24bitArray;
- TLongWordArray = array[ 0..8191 ] of LongWord;
- PLongWordArray = ^TLongWordArray;
-var
- TmpRect : TSDL_Rect;
- Row8bit : PByteArray;
- Row16bit : PWordArray;
- Row24bit : P24bitArray;
- Row32bit : PLongWordArray;
- y, x, RightSide, FlipLength : integer;
- Pixel : cardinal;
- Pixel24 : T24bit;
- Locked : boolean;
-begin
- if DstSurface <> nil then
- begin
- if Rect = nil then
- begin
- TmpRect := SDLRect( 0, 0, DstSurface.w, DstSurface.h );
- Rect := @TmpRect;
- end;
- FlipLength := Rect^.w shr 1 - 1;
- if SDL_MustLock( DstSurface ) then
- begin
- Locked := true;
- SDL_LockSurface( DstSurface );
- end
- else
- Locked := false;
- case DstSurface^.format.BytesPerPixel of
- 1 :
- begin
- Row8Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) *
- DstSurface^.pitch );
- for y := 1 to Rect^.h do
- begin
- RightSide := Rect^.w - 1;
- for x := 0 to FlipLength do
- begin
- Pixel := Row8Bit^[ x ];
- Row8Bit^[ x ] := Row8Bit^[ RightSide ];
- Row8Bit^[ RightSide ] := Pixel;
- dec( RightSide );
- end;
- inc( cardinal( Row8Bit ), DstSurface^.pitch );
- end;
- end;
- 2 :
- begin
- Row16Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) *
- DstSurface^.pitch );
- for y := 1 to Rect^.h do
- begin
- RightSide := Rect^.w - 1;
- for x := 0 to FlipLength do
- begin
- Pixel := Row16Bit^[ x ];
- Row16Bit^[ x ] := Row16Bit^[ RightSide ];
- Row16Bit^[ RightSide ] := Pixel;
- dec( RightSide );
- end;
- inc( cardinal( Row16Bit ), DstSurface^.pitch );
- end;
- end;
- 3 :
- begin
- Row24Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) *
- DstSurface^.pitch );
- for y := 1 to Rect^.h do
- begin
- RightSide := Rect^.w - 1;
- for x := 0 to FlipLength do
- begin
- Pixel24 := Row24Bit^[ x ];
- Row24Bit^[ x ] := Row24Bit^[ RightSide ];
- Row24Bit^[ RightSide ] := Pixel24;
- dec( RightSide );
- end;
- inc( cardinal( Row24Bit ), DstSurface^.pitch );
- end;
- end;
- 4 :
- begin
- Row32Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) *
- DstSurface^.pitch );
- for y := 1 to Rect^.h do
- begin
- RightSide := Rect^.w - 1;
- for x := 0 to FlipLength do
- begin
- Pixel := Row32Bit^[ x ];
- Row32Bit^[ x ] := Row32Bit^[ RightSide ];
- Row32Bit^[ RightSide ] := Pixel;
- dec( RightSide );
- end;
- inc( cardinal( Row32Bit ), DstSurface^.pitch );
- end;
- end;
- end;
- if Locked then
- SDL_UnlockSurface( DstSurface );
- end;
-end;
-
-// Use with caution! The procedure allocates memory for TSDL_Rect and return with its pointer.
-// But you MUST free it after you don't need it anymore!!!
-function PSDLRect( aLeft, aTop, aWidth, aHeight : integer ) : PSDL_Rect;
-var
- Rect : PSDL_Rect;
-begin
- New( Rect );
- with Rect^ do
- begin
- x := aLeft;
- y := aTop;
- w := aWidth;
- h := aHeight;
- end;
- Result := Rect;
-end;
-
-function SDLRect( aLeft, aTop, aWidth, aHeight : integer ) : TSDL_Rect;
-begin
- with result do
- begin
- x := aLeft;
- y := aTop;
- w := aWidth;
- h := aHeight;
- end;
-end;
-
-function SDLRect( aRect : TRect ) : TSDL_Rect;
-begin
- with aRect do
- result := SDLRect( Left, Top, Right - Left, Bottom - Top );
-end;
-
-procedure SDL_Stretch8( Surface, Dst_Surface : PSDL_Surface; x1, x2, y1, y2, yr, yw,
- depth : integer );
-var
- dx, dy, e, d, dx2 : integer;
- src_pitch, dst_pitch : uint16;
- src_pixels, dst_pixels : PUint8;
-begin
- if ( yw >= dst_surface^.h ) then
- exit;
- dx := ( x2 - x1 );
- dy := ( y2 - y1 );
- dy := dy shl 1;
- e := dy - dx;
- dx2 := dx shl 1;
- src_pitch := Surface^.pitch;
- dst_pitch := dst_surface^.pitch;
- src_pixels := PUint8( integer( Surface^.pixels ) + yr * src_pitch + y1 * depth );
- dst_pixels := PUint8( integer( dst_surface^.pixels ) + yw * dst_pitch + x1 *
- depth );
- for d := 0 to dx - 1 do
- begin
- move( src_pixels^, dst_pixels^, depth );
- while ( e >= 0 ) do
- begin
- inc( src_pixels, depth );
- e := e - dx2;
- end;
- inc( dst_pixels, depth );
- e := e + dy;
- end;
-end;
-
-function sign( x : integer ) : integer;
-begin
- if x > 0 then
- result := 1
- else
- result := -1;
-end;
-
-// Stretches a part of a surface
-function SDL_ScaleSurfaceRect( SrcSurface : PSDL_Surface; SrcX1, SrcY1, SrcW, SrcH,
- Width, Height : integer ) : PSDL_Surface;
-var
- dst_surface : PSDL_Surface;
- dx, dy, e, d, dx2, srcx2, srcy2 : integer;
- destx1, desty1 : integer;
-begin
- srcx2 := srcx1 + SrcW;
- srcy2 := srcy1 + SrcH;
- result := nil;
- destx1 := 0;
- desty1 := 0;
- dx := abs( integer( Height - desty1 ) );
- dy := abs( integer( SrcY2 - SrcY1 ) );
- e := ( dy shl 1 ) - dx;
- dx2 := dx shl 1;
- dy := dy shl 1;
- dst_surface := SDL_CreateRGBSurface( SDL_HWPALETTE, width - destx1, Height -
- desty1,
- SrcSurface^.Format^.BitsPerPixel,
- SrcSurface^.Format^.RMask,
- SrcSurface^.Format^.GMask,
- SrcSurface^.Format^.BMask,
- SrcSurface^.Format^.AMask );
- if ( dst_surface^.format^.BytesPerPixel = 1 ) then
- SDL_SetColors( dst_surface, @SrcSurface^.format^.palette^.colors^[ 0 ], 0, 256 );
- SDL_SetColorKey( dst_surface, sdl_srccolorkey, SrcSurface^.format^.colorkey );
- if ( SDL_MustLock( dst_surface ) ) then
- if ( SDL_LockSurface( dst_surface ) < 0 ) then
- exit;
- for d := 0 to dx - 1 do
- begin
- SDL_Stretch8( SrcSurface, dst_surface, destx1, Width, SrcX1, SrcX2, SrcY1, desty1,
- SrcSurface^.format^.BytesPerPixel );
- while e >= 0 do
- begin
- inc( SrcY1 );
- e := e - dx2;
- end;
- inc( desty1 );
- e := e + dy;
- end;
- if SDL_MUSTLOCK( dst_surface ) then
- SDL_UnlockSurface( dst_surface );
- result := dst_surface;
-end;
-
-procedure SDL_ScrollY( DstSurface : PSDL_Surface; DifY : integer );
-var
- r1, r2 : TSDL_Rect;
- //buffer: PSDL_Surface;
- YPos : Integer;
-begin
- if ( DstSurface <> nil ) and ( DifY <> 0 ) then
- begin
- //if DifY > 0 then // going up
- //begin
- ypos := 0;
- r1.x := 0;
- r2.x := 0;
- r1.w := DstSurface.w;
- r2.w := DstSurface.w;
- r1.h := DifY;
- r2.h := DifY;
- while ypos < DstSurface.h do
- begin
- r1.y := ypos;
- r2.y := ypos + DifY;
- SDL_BlitSurface( DstSurface, @r2, DstSurface, @r1 );
- ypos := ypos + DifY;
- end;
- //end
- //else
- //begin // Going Down
- //end;
- end;
-end;
-
-procedure SDL_ScrollX( DstSurface : PSDL_Surface; DifX : integer );
-var
- r1, r2 : TSDL_Rect;
- buffer : PSDL_Surface;
-begin
- if ( DstSurface <> nil ) and ( DifX <> 0 ) then
- begin
- buffer := SDL_CreateRGBSurface( SDL_HWSURFACE, ( DstSurface^.w - DifX ) * 2,
- DstSurface^.h * 2,
- DstSurface^.Format^.BitsPerPixel,
- DstSurface^.Format^.RMask,
- DstSurface^.Format^.GMask,
- DstSurface^.Format^.BMask,
- DstSurface^.Format^.AMask );
- if buffer <> nil then
- begin
- if ( buffer^.format^.BytesPerPixel = 1 ) then
- SDL_SetColors( buffer, @DstSurface^.format^.palette^.colors^[ 0 ], 0, 256 );
- r1 := SDLRect( DifX, 0, buffer^.w, buffer^.h );
- r2 := SDLRect( 0, 0, buffer^.w, buffer^.h );
- SDL_BlitSurface( DstSurface, @r1, buffer, @r2 );
- SDL_BlitSurface( buffer, @r2, DstSurface, @r2 );
- SDL_FreeSurface( buffer );
- end;
- end;
-end;
-
-procedure SDL_RotateRad( DstSurface, SrcSurface : PSDL_Surface; SrcRect :
- PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Single );
-var
- aSin, aCos : Single;
- MX, MY, DX, DY, NX, NY, SX, SY, OX, OY, Width, Height, TX, TY, RX, RY, ROX, ROY : Integer;
- Colour, TempTransparentColour : UInt32;
- MAXX, MAXY : Integer;
-begin
- // Rotate the surface to the target surface.
- TempTransparentColour := SrcSurface.format.colorkey;
- if srcRect.w > srcRect.h then
- begin
- Width := srcRect.w;
- Height := srcRect.w;
- end
- else
- begin
- Width := srcRect.h;
- Height := srcRect.h;
- end;
-
- maxx := DstSurface.w;
- maxy := DstSurface.h;
- aCos := cos( Angle );
- aSin := sin( Angle );
-
- Width := round( abs( srcrect.h * acos ) + abs( srcrect.w * asin ) );
- Height := round( abs( srcrect.h * asin ) + abs( srcrect.w * acos ) );
-
- OX := Width div 2;
- OY := Height div 2; ;
- MX := ( srcRect.x + ( srcRect.x + srcRect.w ) ) div 2;
- MY := ( srcRect.y + ( srcRect.y + srcRect.h ) ) div 2;
- ROX := ( -( srcRect.w div 2 ) ) + Offsetx;
- ROY := ( -( srcRect.h div 2 ) ) + OffsetY;
- Tx := ox + round( ROX * aSin - ROY * aCos );
- Ty := oy + round( ROY * aSin + ROX * aCos );
- SX := 0;
- for DX := DestX - TX to DestX - TX + ( width ) do
- begin
- Inc( SX );
- SY := 0;
- for DY := DestY - TY to DestY - TY + ( Height ) do
- begin
- RX := SX - OX;
- RY := SY - OY;
- NX := round( mx + RX * aSin + RY * aCos ); //
- NY := round( my + RY * aSin - RX * aCos ); //
- // Used for testing only
- //SDL_PutPixel(DstSurface.SDLSurfacePointer,DX,DY,0);
- if ( ( DX > 0 ) and ( DX < MAXX ) ) and ( ( DY > 0 ) and ( DY < MAXY ) ) then
- begin
- if ( NX >= srcRect.x ) and ( NX <= srcRect.x + srcRect.w ) then
- begin
- if ( NY >= srcRect.y ) and ( NY <= srcRect.y + srcRect.h ) then
- begin
- Colour := SDL_GetPixel( SrcSurface, NX, NY );
- if Colour <> TempTransparentColour then
- begin
- SDL_PutPixel( DstSurface, DX, DY, Colour );
- end;
- end;
- end;
- end;
- inc( SY );
- end;
- end;
-end;
-
-procedure SDL_RotateDeg( DstSurface, SrcSurface : PSDL_Surface; SrcRect :
- PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Integer );
-begin
- SDL_RotateRad( DstSurface, SrcSurface, SrcRect, DestX, DestY, OffsetX, OffsetY, DegToRad( Angle ) );
-end;
-
-function ValidateSurfaceRect( DstSurface : PSDL_Surface; dstrect : PSDL_Rect ) : TSDL_Rect;
-var
- RealRect : TSDL_Rect;
- OutOfRange : Boolean;
-begin
- OutOfRange := false;
- if dstrect = nil then
- begin
- RealRect.x := 0;
- RealRect.y := 0;
- RealRect.w := DstSurface.w;
- RealRect.h := DstSurface.h;
- end
- else
- begin
- if dstrect.x < DstSurface.w then
- begin
- RealRect.x := dstrect.x;
- end
- else if dstrect.x < 0 then
- begin
- realrect.x := 0;
- end
- else
- begin
- OutOfRange := True;
- end;
- if dstrect.y < DstSurface.h then
- begin
- RealRect.y := dstrect.y;
- end
- else if dstrect.y < 0 then
- begin
- realrect.y := 0;
- end
- else
- begin
- OutOfRange := True;
- end;
- if OutOfRange = False then
- begin
- if realrect.x + dstrect.w <= DstSurface.w then
- begin
- RealRect.w := dstrect.w;
- end
- else
- begin
- RealRect.w := dstrect.w - realrect.x;
- end;
- if realrect.y + dstrect.h <= DstSurface.h then
- begin
- RealRect.h := dstrect.h;
- end
- else
- begin
- RealRect.h := dstrect.h - realrect.y;
- end;
- end;
- end;
- if OutOfRange = False then
- begin
- result := realrect;
- end
- else
- begin
- realrect.w := 0;
- realrect.h := 0;
- realrect.x := 0;
- realrect.y := 0;
- result := realrect;
- end;
-end;
-
-procedure SDL_FillRectAdd( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );
-var
- RealRect : TSDL_Rect;
- Addr : pointer;
- ModX, BPP : cardinal;
- x, y, R, G, B, SrcColor : cardinal;
-begin
- RealRect := ValidateSurfaceRect( DstSurface, DstRect );
- if ( RealRect.w > 0 ) and ( RealRect.h > 0 ) then
- begin
- SDL_LockSurface( DstSurface );
- BPP := DstSurface.format.BytesPerPixel;
- with DstSurface^ do
- begin
- Addr := pointer( UInt32( pixels ) + UInt32( RealRect.y ) * pitch + UInt32( RealRect.x ) * BPP );
- ModX := Pitch - UInt32( RealRect.w ) * BPP;
- end;
- case DstSurface.format.BitsPerPixel of
- 8 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $E0 + Color and $E0;
- G := SrcColor and $1C + Color and $1C;
- B := SrcColor and $03 + Color and $03;
- if R > $E0 then
- R := $E0;
- if G > $1C then
- G := $1C;
- if B > $03 then
- B := $03;
- PUInt8( Addr )^ := R or G or B;
- inc( UInt32( Addr ), BPP );
- end;
- inc( UInt32( Addr ), ModX );
- end;
- end;
- 15 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $7C00 + Color and $7C00;
- G := SrcColor and $03E0 + Color and $03E0;
- B := SrcColor and $001F + Color and $001F;
- if R > $7C00 then
- R := $7C00;
- if G > $03E0 then
- G := $03E0;
- if B > $001F then
- B := $001F;
- PUInt16( Addr )^ := R or G or B;
- inc( UInt32( Addr ), BPP );
- end;
- inc( UInt32( Addr ), ModX );
- end;
- end;
- 16 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $F800 + Color and $F800;
- G := SrcColor and $07C0 + Color and $07C0;
- B := SrcColor and $001F + Color and $001F;
- if R > $F800 then
- R := $F800;
- if G > $07C0 then
- G := $07C0;
- if B > $001F then
- B := $001F;
- PUInt16( Addr )^ := R or G or B;
- inc( UInt32( Addr ), BPP );
- end;
- inc( UInt32( Addr ), ModX );
- end;
- end;
- 24 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $00FF0000 + Color and $00FF0000;
- G := SrcColor and $0000FF00 + Color and $0000FF00;
- B := SrcColor and $000000FF + Color and $000000FF;
- if R > $FF0000 then
- R := $FF0000;
- if G > $00FF00 then
- G := $00FF00;
- if B > $0000FF then
- B := $0000FF;
- PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B;
- inc( UInt32( Addr ), BPP );
- end;
- inc( UInt32( Addr ), ModX );
- end;
- end;
- 32 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $00FF0000 + Color and $00FF0000;
- G := SrcColor and $0000FF00 + Color and $0000FF00;
- B := SrcColor and $000000FF + Color and $000000FF;
- if R > $FF0000 then
- R := $FF0000;
- if G > $00FF00 then
- G := $00FF00;
- if B > $0000FF then
- B := $0000FF;
- PUInt32( Addr )^ := R or G or B;
- inc( UInt32( Addr ), BPP );
- end;
- inc( UInt32( Addr ), ModX );
- end;
- end;
- end;
- SDL_UnlockSurface( DstSurface );
- end;
-end;
-
-procedure SDL_FillRectSub( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );
-var
- RealRect : TSDL_Rect;
- Addr : pointer;
- ModX, BPP : cardinal;
- x, y, R, G, B, SrcColor : cardinal;
-begin
- RealRect := ValidateSurfaceRect( DstSurface, DstRect );
- if ( RealRect.w > 0 ) and ( RealRect.h > 0 ) then
- begin
- SDL_LockSurface( DstSurface );
- BPP := DstSurface.format.BytesPerPixel;
- with DstSurface^ do
- begin
- Addr := pointer( UInt32( pixels ) + UInt32( RealRect.y ) * pitch + UInt32( RealRect.x ) * BPP );
- ModX := Pitch - UInt32( RealRect.w ) * BPP;
- end;
- case DstSurface.format.BitsPerPixel of
- 8 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $E0 - Color and $E0;
- G := SrcColor and $1C - Color and $1C;
- B := SrcColor and $03 - Color and $03;
- if R > $E0 then
- R := 0;
- if G > $1C then
- G := 0;
- if B > $03 then
- B := 0;
- PUInt8( Addr )^ := R or G or B;
- inc( UInt32( Addr ), BPP );
- end;
- inc( UInt32( Addr ), ModX );
- end;
- end;
- 15 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $7C00 - Color and $7C00;
- G := SrcColor and $03E0 - Color and $03E0;
- B := SrcColor and $001F - Color and $001F;
- if R > $7C00 then
- R := 0;
- if G > $03E0 then
- G := 0;
- if B > $001F then
- B := 0;
- PUInt16( Addr )^ := R or G or B;
- inc( UInt32( Addr ), BPP );
- end;
- inc( UInt32( Addr ), ModX );
- end;
- end;
- 16 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $F800 - Color and $F800;
- G := SrcColor and $07C0 - Color and $07C0;
- B := SrcColor and $001F - Color and $001F;
- if R > $F800 then
- R := 0;
- if G > $07C0 then
- G := 0;
- if B > $001F then
- B := 0;
- PUInt16( Addr )^ := R or G or B;
- inc( UInt32( Addr ), BPP );
- end;
- inc( UInt32( Addr ), ModX );
- end;
- end;
- 24 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $00FF0000 - Color and $00FF0000;
- G := SrcColor and $0000FF00 - Color and $0000FF00;
- B := SrcColor and $000000FF - Color and $000000FF;
- if R > $FF0000 then
- R := 0;
- if G > $00FF00 then
- G := 0;
- if B > $0000FF then
- B := 0;
- PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B;
- inc( UInt32( Addr ), BPP );
- end;
- inc( UInt32( Addr ), ModX );
- end;
- end;
- 32 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $00FF0000 - Color and $00FF0000;
- G := SrcColor and $0000FF00 - Color and $0000FF00;
- B := SrcColor and $000000FF - Color and $000000FF;
- if R > $FF0000 then
- R := 0;
- if G > $00FF00 then
- G := 0;
- if B > $0000FF then
- B := 0;
- PUInt32( Addr )^ := R or G or B;
- inc( UInt32( Addr ), BPP );
- end;
- inc( UInt32( Addr ), ModX );
- end;
- end;
- end;
- SDL_UnlockSurface( DstSurface );
- end;
-end;
-
-procedure SDL_GradientFillRect( DstSurface : PSDL_Surface; const Rect : PSDL_Rect; const StartColor, EndColor : TSDL_Color; const Style : TGradientStyle );
-var
- FBC : array[ 0..255 ] of Cardinal;
- // temp vars
- i, YR, YG, YB, SR, SG, SB, DR, DG, DB : Integer;
-
- TempStepV, TempStepH : Single;
- TempLeft, TempTop, TempHeight, TempWidth : integer;
- TempRect : TSDL_Rect;
-
-begin
- // calc FBC
- YR := StartColor.r;
- YG := StartColor.g;
- YB := StartColor.b;
- SR := YR;
- SG := YG;
- SB := YB;
- DR := EndColor.r - SR;
- DG := EndColor.g - SG;
- DB := EndColor.b - SB;
-
- for i := 0 to 255 do
- begin
- FBC[ i ] := SDL_MapRGB( DstSurface.format, YR, YG, YB );
- YR := SR + round( DR / 255 * i );
- YG := SG + round( DG / 255 * i );
- YB := SB + round( DB / 255 * i );
- end;
-
- // if aStyle = 1 then begin
- TempStepH := Rect.w / 255;
- TempStepV := Rect.h / 255;
- TempHeight := Trunc( TempStepV + 1 );
- TempWidth := Trunc( TempStepH + 1 );
- TempTop := 0;
- TempLeft := 0;
- TempRect.x := Rect.x;
- TempRect.y := Rect.y;
- TempRect.h := Rect.h;
- TempRect.w := Rect.w;
-
- case Style of
- gsHorizontal :
- begin
- TempRect.h := TempHeight;
- for i := 0 to 255 do
- begin
- TempRect.y := Rect.y + TempTop;
- SDL_FillRect( DstSurface, @TempRect, FBC[ i ] );
- TempTop := Trunc( TempStepV * i );
- end;
- end;
- gsVertical :
- begin
- TempRect.w := TempWidth;
- for i := 0 to 255 do
- begin
- TempRect.x := Rect.x + TempLeft;
- SDL_FillRect( DstSurface, @TempRect, FBC[ i ] );
- TempLeft := Trunc( TempStepH * i );
- end;
- end;
- end;
-end;
-
-procedure SDL_2xBlit( Src, Dest : PSDL_Surface );
-var
- ReadAddr, WriteAddr, ReadRow, WriteRow : UInt32;
- SrcPitch, DestPitch, x, y, w, h : UInt32;
-begin
- if ( Src = nil ) or ( Dest = nil ) then
- exit;
- if ( Src.w shl 1 ) < Dest.w then
- exit;
- if ( Src.h shl 1 ) < Dest.h then
- exit;
-
- if SDL_MustLock( Src ) then
- SDL_LockSurface( Src );
- if SDL_MustLock( Dest ) then
- SDL_LockSurface( Dest );
-
- ReadRow := UInt32( Src.Pixels );
- WriteRow := UInt32( Dest.Pixels );
-
- SrcPitch := Src.pitch;
- DestPitch := Dest.pitch;
-
- w := Src.w;
- h := Src.h;
-
- case Src.format.BytesPerPixel of
- 1 :
- asm
- push ebx
- mov eax, h // for y := 1 to Src.h do
- mov y, eax
- @LoopY:
- mov eax, ReadRow // ReadAddr := ReadRow;
- mov ReadAddr, eax
-
- mov eax, WriteRow // WriteAddr := WriteRow;
- mov WriteAddr, eax
-
- mov eax, w // for x := 1 to Src.w do
- mov x, eax
-
- mov ecx, ReadAddr
- mov edx, WriteAddr
- mov ebx, DestPitch
-
- @LoopX:
- mov al, [ecx] // PUInt8(WriteAddr)^ := PUInt8(ReadAddr)^;
- mov [edx], al
- mov [edx + 1], al // PUInt8(WriteAddr + 1)^ := PUInt8(ReadAddr)^;
- mov [edx + ebx], al // PUInt8(WriteAddr + DestPitch)^ := PUInt8(ReadAddr)^;
- mov [edx + ebx + 1], al // PUInt8(WriteAddr + DestPitch + 1)^ := PUInt8(ReadAddr)^;
-
- inc ecx // inc(ReadAddr);
- add edx, 2 // inc(WriteAddr, 2);
-
- dec x
- jnz @LoopX
-
- mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);
- add ReadRow, eax
-
- mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);
- add WriteRow, eax
- add WriteRow, eax
-
- dec y
- jnz @LoopY
- pop ebx
- end;
- 2 :
- asm
- push ebx
- mov eax, h // for y := 1 to Src.h do
- mov y, eax
- @LoopY:
- mov eax, ReadRow // ReadAddr := ReadRow;
- mov ReadAddr, eax
-
- mov eax, WriteRow // WriteAddr := WriteRow;
- mov WriteAddr, eax
-
- mov eax, w // for x := 1 to Src.w do
- mov x, eax
-
- mov ecx, ReadAddr
- mov edx, WriteAddr
- mov ebx, DestPitch
-
- @LoopX:
- mov ax, [ecx] // PUInt16(WriteAddr)^ := PUInt16(ReadAddr)^;
- mov [edx], ax
- mov [edx + 2], ax // PUInt16(WriteAddr + 2)^ := PUInt16(ReadAddr)^;
- mov [edx + ebx], ax // PUInt16(WriteAddr + DestPitch)^ := PUInt16(ReadAddr)^;
- mov [edx + ebx + 2], ax // PUInt16(WriteAddr + DestPitch + 2)^ := PUInt16(ReadAddr)^;
-
- add ecx, 2 // inc(ReadAddr, 2);
- add edx, 4 // inc(WriteAddr, 4);
-
- dec x
- jnz @LoopX
-
- mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);
- add ReadRow, eax
-
- mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);
- add WriteRow, eax
- add WriteRow, eax
-
- dec y
- jnz @LoopY
- pop ebx
- end;
- 3 :
- asm
- push ebx
- mov eax, h // for y := 1 to Src.h do
- mov y, eax
- @LoopY:
- mov eax, ReadRow // ReadAddr := ReadRow;
- mov ReadAddr, eax
-
- mov eax, WriteRow // WriteAddr := WriteRow;
- mov WriteAddr, eax
-
- mov eax, w // for x := 1 to Src.w do
- mov x, eax
-
- mov ecx, ReadAddr
- mov edx, WriteAddr
- mov ebx, DestPitch
-
- @LoopX:
- mov eax, [ecx] // (PUInt32(WriteAddr)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);
- and eax, $00ffffff
- and dword ptr [edx], $ff000000
- or [edx], eax
- and dword ptr [edx + 3], $00ffffff // (PUInt32(WriteAddr + 3)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);
- or [edx + 3], eax
- and dword ptr [edx + ebx], $00ffffff // (PUInt32(WriteAddr + DestPitch)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);
- or [edx + ebx], eax
- and dword ptr [edx + ebx + 3], $00ffffff // (PUInt32(WriteAddr + DestPitch + 3)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);
- or [edx + ebx + 3], eax
-
- add ecx, 3 // inc(ReadAddr, 3);
- add edx, 6 // inc(WriteAddr, 6);
-
- dec x
- jnz @LoopX
-
- mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);
- add ReadRow, eax
-
- mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);
- add WriteRow, eax
- add WriteRow, eax
-
- dec y
- jnz @LoopY
- pop ebx
- end;
- 4 :
- asm
- push ebx
- mov eax, h // for y := 1 to Src.h do
- mov y, eax
- @LoopY:
- mov eax, ReadRow // ReadAddr := ReadRow;
- mov ReadAddr, eax
-
- mov eax, WriteRow // WriteAddr := WriteRow;
- mov WriteAddr, eax
-
- mov eax, w // for x := 1 to Src.w do
- mov x, eax
-
- mov ecx, ReadAddr
- mov edx, WriteAddr
- mov ebx, DestPitch
-
- @LoopX:
- mov eax, [ecx] // PUInt32(WriteAddr)^ := PUInt32(ReadAddr)^;
- mov [edx], eax
- mov [edx + 4], eax // PUInt32(WriteAddr + 4)^ := PUInt32(ReadAddr)^;
- mov [edx + ebx], eax // PUInt32(WriteAddr + DestPitch)^ := PUInt32(ReadAddr)^;
- mov [edx + ebx + 4], eax // PUInt32(WriteAddr + DestPitch + 4)^ := PUInt32(ReadAddr)^;
-
- add ecx, 4 // inc(ReadAddr, 4);
- add edx, 8 // inc(WriteAddr, 8);
-
- dec x
- jnz @LoopX
-
- mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);
- add ReadRow, eax
-
- mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);
- add WriteRow, eax
- add WriteRow, eax
-
- dec y
- jnz @LoopY
- pop ebx
- end;
- end;
-
- if SDL_MustLock( Src ) then
- SDL_UnlockSurface( Src );
- if SDL_MustLock( Dest ) then
- SDL_UnlockSurface( Dest );
-end;
-
-procedure SDL_Scanline2xBlit( Src, Dest : PSDL_Surface );
-var
- ReadAddr, WriteAddr, ReadRow, WriteRow : UInt32;
- SrcPitch, DestPitch, x, y, w, h : UInt32;
-begin
- if ( Src = nil ) or ( Dest = nil ) then
- exit;
- if ( Src.w shl 1 ) < Dest.w then
- exit;
- if ( Src.h shl 1 ) < Dest.h then
- exit;
-
- if SDL_MustLock( Src ) then
- SDL_LockSurface( Src );
- if SDL_MustLock( Dest ) then
- SDL_LockSurface( Dest );
-
- ReadRow := UInt32( Src.Pixels );
- WriteRow := UInt32( Dest.Pixels );
-
- SrcPitch := Src.pitch;
- DestPitch := Dest.pitch;
-
- w := Src.w;
- h := Src.h;
-
- case Src.format.BytesPerPixel of
- 1 :
- asm
- push ebx
- mov eax, h // for y := 1 to Src.h do
- mov y, eax
- @LoopY:
- mov eax, ReadRow // ReadAddr := ReadRow;
- mov ReadAddr, eax
-
- mov eax, WriteRow // WriteAddr := WriteRow;
- mov WriteAddr, eax
-
- mov eax, w // for x := 1 to Src.w do
- mov x, eax
-
- mov ecx, ReadAddr
- mov edx, WriteAddr
-
- @LoopX:
- mov al, [ecx] // PUInt8(WriteAddr)^ := PUInt8(ReadAddr)^;
- mov [edx], al
- mov [edx + 1], al // PUInt8(WriteAddr + 1)^ := PUInt8(ReadAddr)^;
-
- inc ecx // inc(ReadAddr);
- add edx, 2 // inc(WriteAddr, 2);
-
- dec x
- jnz @LoopX
-
- mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);
- add ReadRow, eax
-
- mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);
- add WriteRow, eax
- add WriteRow, eax
-
- dec y
- jnz @LoopY
- pop ebx
- end;
- 2 :
- asm
- push ebx
- mov eax, h // for y := 1 to Src.h do
- mov y, eax
- @LoopY:
- mov eax, ReadRow // ReadAddr := ReadRow;
- mov ReadAddr, eax
-
- mov eax, WriteRow // WriteAddr := WriteRow;
- mov WriteAddr, eax
-
- mov eax, w // for x := 1 to Src.w do
- mov x, eax
-
- mov ecx, ReadAddr
- mov edx, WriteAddr
-
- @LoopX:
- mov ax, [ecx] // PUInt16(WriteAddr)^ := PUInt16(ReadAddr)^;
- mov [edx], ax
- mov [edx + 2], eax // PUInt16(WriteAddr + 2)^ := PUInt16(ReadAddr)^;
-
- add ecx, 2 // inc(ReadAddr, 2);
- add edx, 4 // inc(WriteAddr, 4);
-
- dec x
- jnz @LoopX
-
- mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);
- add ReadRow, eax
-
- mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);
- add WriteRow, eax
- add WriteRow, eax
-
- dec y
- jnz @LoopY
- pop ebx
- end;
- 3 :
- asm
- push ebx
- mov eax, h // for y := 1 to Src.h do
- mov y, eax
- @LoopY:
- mov eax, ReadRow // ReadAddr := ReadRow;
- mov ReadAddr, eax
-
- mov eax, WriteRow // WriteAddr := WriteRow;
- mov WriteAddr, eax
-
- mov eax, w // for x := 1 to Src.w do
- mov x, eax
-
- mov ecx, ReadAddr
- mov edx, WriteAddr
-
- @LoopX:
- mov eax, [ecx] // (PUInt32(WriteAddr)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);
- and eax, $00ffffff
- and dword ptr [edx], $ff000000
- or [edx], eax
- and dword ptr [edx + 3], $00ffffff // (PUInt32(WriteAddr + 3)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);
- or [edx + 3], eax
-
- add ecx, 3 // inc(ReadAddr, 3);
- add edx, 6 // inc(WriteAddr, 6);
-
- dec x
- jnz @LoopX
-
- mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);
- add ReadRow, eax
-
- mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);
- add WriteRow, eax
- add WriteRow, eax
-
- dec y
- jnz @LoopY
- pop ebx
- end;
- 4 :
- asm
- push ebx
- mov eax, h // for y := 1 to Src.h do
- mov y, eax
- @LoopY:
- mov eax, ReadRow // ReadAddr := ReadRow;
- mov ReadAddr, eax
-
- mov eax, WriteRow // WriteAddr := WriteRow;
- mov WriteAddr, eax
-
- mov eax, w // for x := 1 to Src.w do
- mov x, eax
-
- mov ecx, ReadAddr
- mov edx, WriteAddr
-
- @LoopX:
- mov eax, [ecx] // PUInt32(WriteAddr)^ := PUInt32(ReadAddr)^;
- mov [edx], eax
- mov [edx + 4], eax // PUInt32(WriteAddr + 4)^ := PUInt32(ReadAddr)^;
-
- add ecx, 4 // inc(ReadAddr, 4);
- add edx, 8 // inc(WriteAddr, 8);
-
- dec x
- jnz @LoopX
-
- mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);
- add ReadRow, eax
-
- mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);
- add WriteRow, eax
- add WriteRow, eax
-
- dec y
- jnz @LoopY
- pop ebx
- end;
- end;
-
- if SDL_MustLock( Src ) then
- SDL_UnlockSurface( Src );
- if SDL_MustLock( Dest ) then
- SDL_UnlockSurface( Dest );
-end;
-
-procedure SDL_50Scanline2xBlit( Src, Dest : PSDL_Surface );
-var
- ReadAddr, WriteAddr, ReadRow, WriteRow : UInt32;
- SrcPitch, DestPitch, x, y, w, h : UInt32;
-begin
- if ( Src = nil ) or ( Dest = nil ) then
- exit;
- if ( Src.w shl 1 ) < Dest.w then
- exit;
- if ( Src.h shl 1 ) < Dest.h then
- exit;
-
- if SDL_MustLock( Src ) then
- SDL_LockSurface( Src );
- if SDL_MustLock( Dest ) then
- SDL_LockSurface( Dest );
-
- ReadRow := UInt32( Src.Pixels );
- WriteRow := UInt32( Dest.Pixels );
-
- SrcPitch := Src.pitch;
- DestPitch := Dest.pitch;
-
- w := Src.w;
- h := Src.h;
-
- case Src.format.BitsPerPixel of
- 8 :
- asm
- push ebx
- mov eax, h // for y := 1 to Src.h do
- mov y, eax
- @LoopY:
- mov eax, ReadRow // ReadAddr := ReadRow;
- mov ReadAddr, eax
-
- mov eax, WriteRow // WriteAddr := WriteRow;
- mov WriteAddr, eax
-
- mov eax, w // for x := 1 to Src.w do
- mov x, eax
-
- mov ecx, ReadAddr
- mov edx, WriteAddr
- mov ebx, DestPitch
-
- @LoopX:
- mov al, [ecx] // PUInt8(WriteAddr)^ := PUInt8(ReadAddr)^;
- mov [edx], al
- mov [edx + 1], al // PUInt8(WriteAddr + 1)^ := PUInt8(ReadAddr)^;
- shr al, 1
- and al, $6d
- mov [edx + ebx], al // PUInt8(WriteAddr + DestPitch)^ := PUInt8(ReadAddr)^;
- mov [edx + ebx + 1], al // PUInt8(WriteAddr + DestPitch + 1)^ := PUInt8(ReadAddr)^;
-
- inc ecx // inc(ReadAddr);
- add edx, 2 // inc(WriteAddr, 2);
-
- dec x
- jnz @LoopX
-
- mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);
- add ReadRow, eax
-
- mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);
- add WriteRow, eax
- add WriteRow, eax
-
- dec y
- jnz @LoopY
- pop ebx
- end;
- 15 :
- asm
- push ebx
- mov eax, h // for y := 1 to Src.h do
- mov y, eax
- @LoopY:
- mov eax, ReadRow // ReadAddr := ReadRow;
- mov ReadAddr, eax
-
- mov eax, WriteRow // WriteAddr := WriteRow;
- mov WriteAddr, eax
-
- mov eax, w // for x := 1 to Src.w do
- mov x, eax
-
- mov ecx, ReadAddr
- mov edx, WriteAddr
- mov ebx, DestPitch
-
- @LoopX:
- mov ax, [ecx] // PUInt16(WriteAddr)^ := PUInt16(ReadAddr)^;
- mov [edx], ax
- mov [edx + 2], ax // PUInt16(WriteAddr + 2)^ := PUInt16(ReadAddr)^;
- shr ax, 1
- and ax, $3def
- mov [edx + ebx], ax // PUInt16(WriteAddr + DestPitch)^ := PUInt16(ReadAddr)^;
- mov [edx + ebx + 2], ax // PUInt16(WriteAddr + DestPitch + 2)^ := PUInt16(ReadAddr)^;
-
- add ecx, 2 // inc(ReadAddr, 2);
- add edx, 4 // inc(WriteAddr, 4);
-
- dec x
- jnz @LoopX
-
- mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);
- add ReadRow, eax
-
- mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);
- add WriteRow, eax
- add WriteRow, eax
-
- dec y
- jnz @LoopY
- pop ebx
- end;
- 16 :
- asm
- push ebx
- mov eax, h // for y := 1 to Src.h do
- mov y, eax
- @LoopY:
- mov eax, ReadRow // ReadAddr := ReadRow;
- mov ReadAddr, eax
-
- mov eax, WriteRow // WriteAddr := WriteRow;
- mov WriteAddr, eax
-
- mov eax, w // for x := 1 to Src.w do
- mov x, eax
-
- mov ecx, ReadAddr
- mov edx, WriteAddr
- mov ebx, DestPitch
-
- @LoopX:
- mov ax, [ecx] // PUInt16(WriteAddr)^ := PUInt16(ReadAddr)^;
- mov [edx], ax
- mov [edx + 2], ax // PUInt16(WriteAddr + 2)^ := PUInt16(ReadAddr)^;
- shr ax, 1
- and ax, $7bef
- mov [edx + ebx], ax // PUInt16(WriteAddr + DestPitch)^ := PUInt16(ReadAddr)^;
- mov [edx + ebx + 2], ax // PUInt16(WriteAddr + DestPitch + 2)^ := PUInt16(ReadAddr)^;
-
- add ecx, 2 // inc(ReadAddr, 2);
- add edx, 4 // inc(WriteAddr, 4);
-
- dec x
- jnz @LoopX
-
- mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);
- add ReadRow, eax
-
- mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);
- add WriteRow, eax
- add WriteRow, eax
-
- dec y
- jnz @LoopY
- pop ebx
- end;
- 24 :
- asm
- push ebx
- mov eax, h // for y := 1 to Src.h do
- mov y, eax
- @LoopY:
- mov eax, ReadRow // ReadAddr := ReadRow;
- mov ReadAddr, eax
-
- mov eax, WriteRow // WriteAddr := WriteRow;
- mov WriteAddr, eax
-
- mov eax, w // for x := 1 to Src.w do
- mov x, eax
-
- mov ecx, ReadAddr
- mov edx, WriteAddr
- mov ebx, DestPitch
-
- @LoopX:
- mov eax, [ecx] // (PUInt32(WriteAddr)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);
- and eax, $00ffffff
- and dword ptr [edx], $ff000000
- or [edx], eax
- and dword ptr [edx + 3], $00ffffff // (PUInt32(WriteAddr + 3)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);
- or [edx + 3], eax
- shr eax, 1
- and eax, $007f7f7f
- and dword ptr [edx + ebx], $00ffffff // (PUInt32(WriteAddr + DestPitch)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);
- or [edx + ebx], eax
- and dword ptr [edx + ebx + 3], $00ffffff // (PUInt32(WriteAddr + DestPitch + 3)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff);
- or [edx + ebx + 3], eax
-
- add ecx, 3 // inc(ReadAddr, 3);
- add edx, 6 // inc(WriteAddr, 6);
-
- dec x
- jnz @LoopX
-
- mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);
- add ReadRow, eax
-
- mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);
- add WriteRow, eax
- add WriteRow, eax
-
- dec y
- jnz @LoopY
- pop ebx
- end;
- 32 :
- asm
- push ebx
- mov eax, h // for y := 1 to Src.h do
- mov y, eax
- @LoopY:
- mov eax, ReadRow // ReadAddr := ReadRow;
- mov ReadAddr, eax
-
- mov eax, WriteRow // WriteAddr := WriteRow;
- mov WriteAddr, eax
-
- mov eax, w // for x := 1 to Src.w do
- mov x, eax
-
- mov ecx, ReadAddr
- mov edx, WriteAddr
- mov ebx, DestPitch
-
- @LoopX:
- mov eax, [ecx] // PUInt32(WriteAddr)^ := PUInt32(ReadAddr)^;
- mov [edx], eax
- mov [edx + 4], eax // PUInt32(WriteAddr + 4)^ := PUInt32(ReadAddr)^;
- shr eax, 1
- and eax, $7f7f7f7f
- mov [edx + ebx], eax // PUInt32(WriteAddr + DestPitch)^ := PUInt32(ReadAddr)^;
- mov [edx + ebx + 4], eax // PUInt32(WriteAddr + DestPitch + 4)^ := PUInt32(ReadAddr)^;
-
- add ecx, 4 // inc(ReadAddr, 4);
- add edx, 8 // inc(WriteAddr, 8);
-
- dec x
- jnz @LoopX
-
- mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch);
- add ReadRow, eax
-
- mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2);
- add WriteRow, eax
- add WriteRow, eax
-
- dec y
- jnz @LoopY
- pop ebx
- end;
- end;
-
- if SDL_MustLock( Src ) then
- SDL_UnlockSurface( Src );
- if SDL_MustLock( Dest ) then
- SDL_UnlockSurface( Dest );
-end;
-
-function SDL_PixelTestSurfaceVsRect( SrcSurface1 : PSDL_Surface; SrcRect1 : PSDL_Rect; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) :
-boolean;
-var
- Src_Rect1, Src_Rect2 : TSDL_Rect;
- right1, bottom1 : integer;
- right2, bottom2 : integer;
- Scan1Start, Scan2Start, ScanWidth, ScanHeight : cardinal;
- Mod1: cardinal;
- Addr1 : cardinal;
- BPP : cardinal;
- Pitch1 : cardinal;
- TransparentColor1 : cardinal;
- tx, ty : cardinal;
- StartTick : cardinal;
- Color1 : cardinal;
-begin
- Result := false;
- if SrcRect1 = nil then
- begin
- with Src_Rect1 do
- begin
- x := 0;
- y := 0;
- w := SrcSurface1.w;
- h := SrcSurface1.h;
- end;
- end
- else
- Src_Rect1 := SrcRect1^;
-
- Src_Rect2 := SrcRect2^;
- with Src_Rect1 do
- begin
- Right1 := Left1 + w;
- Bottom1 := Top1 + h;
- end;
- with Src_Rect2 do
- begin
- Right2 := Left2 + w;
- Bottom2 := Top2 + h;
- end;
- if ( Left1 >= Right2 ) or ( Right1 <= Left2 ) or ( Top1 >= Bottom2 ) or (
-Bottom1 <=
- Top2 ) then
- exit;
- if Left1 <= Left2 then
- begin
- // 1. left, 2. right
- Scan1Start := Src_Rect1.x + Left2 - Left1;
- Scan2Start := Src_Rect2.x;
- ScanWidth := Right1 - Left2;
- with Src_Rect2 do
- if ScanWidth > w then
- ScanWidth := w;
- end
- else
- begin
- // 1. right, 2. left
- Scan1Start := Src_Rect1.x;
- Scan2Start := Src_Rect2.x + Left1 - Left2;
- ScanWidth := Right2 - Left1;
- with Src_Rect1 do
- if ScanWidth > w then
- ScanWidth := w;
- end;
- with SrcSurface1^ do
- begin
- Pitch1 := Pitch;
- Addr1 := cardinal( Pixels );
- inc( Addr1, Pitch1 * UInt32( Src_Rect1.y ) );
- with format^ do
- begin
- BPP := BytesPerPixel;
- TransparentColor1 := colorkey;
- end;
- end;
-
- Mod1 := Pitch1 - ( ScanWidth * BPP );
-
- inc( Addr1, BPP * Scan1Start );
-
- if Top1 <= Top2 then
- begin
- // 1. up, 2. down
- ScanHeight := Bottom1 - Top2;
- if ScanHeight > Src_Rect2.h then
- ScanHeight := Src_Rect2.h;
- inc( Addr1, Pitch1 * UInt32( Top2 - Top1 ) );
- end
- else
- begin
- // 1. down, 2. up
- ScanHeight := Bottom2 - Top1;
- if ScanHeight > Src_Rect1.h then
- ScanHeight := Src_Rect1.h;
-
- end;
- case BPP of
- 1 :
- for ty := 1 to ScanHeight do
- begin
- for tx := 1 to ScanWidth do
- begin
- if ( PByte( Addr1 )^ <> TransparentColor1 ) then
- begin
- Result := true;
- exit;
- end;
- inc( Addr1 );
-
- end;
- inc( Addr1, Mod1 );
-
- end;
- 2 :
- for ty := 1 to ScanHeight do
- begin
- for tx := 1 to ScanWidth do
- begin
- if ( PWord( Addr1 )^ <> TransparentColor1 ) then
- begin
- Result := true;
- exit;
- end;
- inc( Addr1, 2 );
-
- end;
- inc( Addr1, Mod1 );
-
- end;
- 3 :
- for ty := 1 to ScanHeight do
- begin
- for tx := 1 to ScanWidth do
- begin
- Color1 := PLongWord( Addr1 )^ and $00FFFFFF;
-
- if ( Color1 <> TransparentColor1 )
- then
- begin
- Result := true;
- exit;
- end;
- inc( Addr1, 3 );
-
- end;
- inc( Addr1, Mod1 );
-
- end;
- 4 :
- for ty := 1 to ScanHeight do
- begin
- for tx := 1 to ScanWidth do
- begin
- if ( PLongWord( Addr1 )^ <> TransparentColor1 ) then
- begin
- Result := true;
- exit;
- end;
- inc( Addr1, 4 );
-
- end;
- inc( Addr1, Mod1 );
-
- end;
- end;
-end;
-
-procedure SDL_ORSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-var
- Src, Dest : TSDL_Rect;
- Diff : integer;
- SrcAddr, DestAddr, TransparentColor : cardinal;
- // TransparentColor: cardinal;
- _ebx, _esi, _edi, _esp : cardinal;
- WorkX, WorkY : word;
- SrcMod, DestMod : cardinal;
- Bits : cardinal;
-begin
- if ( SrcSurface = nil ) or ( DestSurface = nil ) then
- exit; // Remove this to make it faster
- if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
- exit; // Remove this to make it faster
- if SrcRect = nil then
- begin
- with Src do
- begin
- x := 0;
- y := 0;
- w := SrcSurface.w;
- h := SrcSurface.h;
- end;
- end
- else
- Src := SrcRect^;
- if DestRect = nil then
- begin
- Dest.x := 0;
- Dest.y := 0;
- end
- else
- Dest := DestRect^;
- Dest.w := Src.w;
- Dest.h := Src.h;
- with DestSurface.Clip_Rect do
- begin
- // Source's right side is greater than the dest.cliprect
- if Dest.x + Src.w > x + w then
- begin
- smallint( Src.w ) := x + w - Dest.x;
- smallint( Dest.w ) := x + w - Dest.x;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's bottom side is greater than the dest.clip
- if Dest.y + Src.h > y + h then
- begin
- smallint( Src.h ) := y + h - Dest.y;
- smallint( Dest.h ) := y + h - Dest.y;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- // Source's left side is less than the dest.clip
- if Dest.x < x then
- begin
- Diff := x - Dest.x;
- Src.x := Src.x + Diff;
- smallint( Src.w ) := smallint( Src.w ) - Diff;
- Dest.x := x;
- smallint( Dest.w ) := smallint( Dest.w ) - Diff;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's Top side is less than the dest.clip
- if Dest.y < y then
- begin
- Diff := y - Dest.y;
- Src.y := Src.y + Diff;
- smallint( Src.h ) := smallint( Src.h ) - Diff;
- Dest.y := y;
- smallint( Dest.h ) := smallint( Dest.h ) - Diff;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- end;
- with SrcSurface^ do
- begin
- SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
- Format.BytesPerPixel;
- SrcMod := Pitch - Src.w * Format.BytesPerPixel;
- TransparentColor := Format.colorkey;
- end;
- with DestSurface^ do
- begin
- DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
- Format.BytesPerPixel;
- DestMod := Pitch - Dest.w * Format.BytesPerPixel;
- Bits := Format.BitsPerPixel;
- end;
- SDL_LockSurface( SrcSurface );
- SDL_LockSurface( DestSurface );
- WorkY := Src.h;
- case bits of
- 8 :
- asm
- mov _ebx, ebx
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- @LoopY:
- mov ax, Src.w
- mov WorkX, ax // WorkX := Src.w
- @Loopx:
- mov al, [esi] // AL := source color
- cmp al, 0
- je @SkipColor // if AL=0 or AL=transparent color then skip everything
- cmp al, byte ptr TransparentColor
- je @SkipColor
- or al, [edi]
- mov [edi], al
- @SkipColor:
- inc esi
- inc edi
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- dec WorkY
- jnz @LoopY
- mov esp,_esp
- mov edi,_edi
- mov esi,_esi
- mov ebx,_ebx
- end;
- 15 :
- asm
- mov _ebx, ebx
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- @LoopY:
- mov ax, Src.w
- mov WorkX, ax // WorkX := Src.w
- @Loopx:
- mov ax, [esi] // AX := source color
- cmp ax, 0
- je @SkipColor // if AX=0 then skip everything
- cmp ax, word ptr TransparentColor
- je @SkipColor
- or ax, [edi]
- mov [edi], ax
- @SkipColor:
- add esi, 2
- add edi, 2
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- dec WorkY
- jnz @LoopY
- mov esp,_esp
- mov edi,_edi
- mov esi,_esi
- mov ebx,_ebx
- end;
- 16 :
- asm
- mov _ebx, ebx
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- @LoopY:
- mov ax, Src.w
- mov WorkX, ax // WorkX := Src.w
- @Loopx:
- mov ax, [esi] // AX := source color
- cmp ax, 0
- je @SkipColor // if AX=0 then skip everything
- cmp ax, word ptr TransparentColor
- je @SkipColor
- or ax, [edi]
- mov [edi], ax
- @SkipColor:
- add esi, 2
- add edi, 2
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- dec WorkY
- jnz @LoopY
- mov esp,_esp
- mov edi,_edi
- mov esi,_esi
- mov ebx,_ebx
- end;
- 24 :
- asm
- mov _ebx, ebx
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- @LoopY:
- mov ax, Src.w
- mov WorkX, ax // WorkX := Src.w
- add WorkX, ax // WorkX := Src.w * 2
- add WorkX, ax // WorkX := Src.w * 3
- @Loopx:
- mov al, [esi] // AL := source color
- or al, [edi]
- mov [edi], al
- inc esi
- inc edi
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- dec WorkY
- jnz @LoopY
- mov esp,_esp
- mov edi,_edi
- mov esi,_esi
- mov ebx,_ebx
- end;
- 32 :
- asm
- mov _ebx, ebx
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- @LoopY:
- mov ax, Src.w
- shl ax, 2
- mov WorkX, ax // WorkX := Src.w * 4
- @Loopx:
- mov al, [esi] // AL := source color
- or al, [edi]
- mov [edi], al
- inc esi
- inc edi
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- dec WorkY
- jnz @LoopY
- mov esp,_esp
- mov edi,_edi
- mov esi,_esi
- mov ebx,_ebx
- end;
- end;
- SDL_UnlockSurface( SrcSurface );
- SDL_UnlockSurface( DestSurface );
-end;
-
-procedure SDL_ANDSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-var
- Src, Dest : TSDL_Rect;
- Diff : integer;
- SrcAddr, DestAddr, TransparentColor : cardinal;
- // TransparentColor: cardinal;
- _ebx, _esi, _edi, _esp : cardinal;
- WorkX, WorkY : word;
- SrcMod, DestMod : cardinal;
- Bits : cardinal;
-begin
- if ( SrcSurface = nil ) or ( DestSurface = nil ) then
- exit; // Remove this to make it faster
- if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
- exit; // Remove this to make it faster
- if SrcRect = nil then
- begin
- with Src do
- begin
- x := 0;
- y := 0;
- w := SrcSurface.w;
- h := SrcSurface.h;
- end;
- end
- else
- Src := SrcRect^;
- if DestRect = nil then
- begin
- Dest.x := 0;
- Dest.y := 0;
- end
- else
- Dest := DestRect^;
- Dest.w := Src.w;
- Dest.h := Src.h;
- with DestSurface.Clip_Rect do
- begin
- // Source's right side is greater than the dest.cliprect
- if Dest.x + Src.w > x + w then
- begin
- smallint( Src.w ) := x + w - Dest.x;
- smallint( Dest.w ) := x + w - Dest.x;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's bottom side is greater than the dest.clip
- if Dest.y + Src.h > y + h then
- begin
- smallint( Src.h ) := y + h - Dest.y;
- smallint( Dest.h ) := y + h - Dest.y;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- // Source's left side is less than the dest.clip
- if Dest.x < x then
- begin
- Diff := x - Dest.x;
- Src.x := Src.x + Diff;
- smallint( Src.w ) := smallint( Src.w ) - Diff;
- Dest.x := x;
- smallint( Dest.w ) := smallint( Dest.w ) - Diff;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's Top side is less than the dest.clip
- if Dest.y < y then
- begin
- Diff := y - Dest.y;
- Src.y := Src.y + Diff;
- smallint( Src.h ) := smallint( Src.h ) - Diff;
- Dest.y := y;
- smallint( Dest.h ) := smallint( Dest.h ) - Diff;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- end;
- with SrcSurface^ do
- begin
- SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
- Format.BytesPerPixel;
- SrcMod := Pitch - Src.w * Format.BytesPerPixel;
- TransparentColor := Format.colorkey;
- end;
- with DestSurface^ do
- begin
- DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
- Format.BytesPerPixel;
- DestMod := Pitch - Dest.w * Format.BytesPerPixel;
- Bits := Format.BitsPerPixel;
- end;
- SDL_LockSurface( SrcSurface );
- SDL_LockSurface( DestSurface );
- WorkY := Src.h;
- case bits of
- 8 :
- asm
- mov _ebx, ebx
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- @LoopY:
- mov ax, Src.w
- mov WorkX, ax // WorkX := Src.w
- @Loopx:
- mov al, [esi] // AL := source color
- cmp al, 0
- je @SkipColor // if AL=0 or AL=transparent color then skip everything
- cmp al, byte ptr TransparentColor
- je @SkipColor
- and al, [edi]
- mov [edi], al
- @SkipColor:
- inc esi
- inc edi
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- dec WorkY
- jnz @LoopY
- mov esp,_esp
- mov edi,_edi
- mov esi,_esi
- mov ebx,_ebx
- end;
- 15 :
- asm
- mov _ebx, ebx
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- @LoopY:
- mov ax, Src.w
- mov WorkX, ax // WorkX := Src.w
- @Loopx:
- mov ax, [esi] // AX := source color
- cmp ax, 0
- je @SkipColor // if AX=0 then skip everything
- cmp ax, word ptr TransparentColor
- je @SkipColor
- and ax, [edi]
- mov [edi], ax
- @SkipColor:
- add esi, 2
- add edi, 2
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- dec WorkY
- jnz @LoopY
- mov esp,_esp
- mov edi,_edi
- mov esi,_esi
- mov ebx,_ebx
- end;
- 16 :
- asm
- mov _ebx, ebx
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- @LoopY:
- mov ax, Src.w
- mov WorkX, ax // WorkX := Src.w
- @Loopx:
- mov ax, [esi] // AX := source color
- cmp ax, 0
- je @SkipColor // if AX=0 then skip everything
- cmp ax, word ptr TransparentColor
- je @SkipColor
- and ax, [edi]
- mov [edi], ax
- @SkipColor:
- add esi, 2
- add edi, 2
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- dec WorkY
- jnz @LoopY
- mov esp,_esp
- mov edi,_edi
- mov esi,_esi
- mov ebx,_ebx
- end;
- 24 :
- asm
- mov _ebx, ebx
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- @LoopY:
- mov ax, Src.w
- mov WorkX, ax // WorkX := Src.w
- add WorkX, ax // WorkX := Src.w * 2
- add WorkX, ax // WorkX := Src.w * 3
- @Loopx:
- mov al, [esi] // AL := source color
- and al, [edi]
- mov [edi], al
- inc esi
- inc edi
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- dec WorkY
- jnz @LoopY
- mov esp,_esp
- mov edi,_edi
- mov esi,_esi
- mov ebx,_ebx
- end;
- 32 :
- asm
- mov _ebx, ebx
- mov _esi, esi
- mov _edi, edi
- mov _esp, esp
- mov esi, SrcAddr // ESI - Source Offset
- mov edi, DestAddr // EDI - Destination Offset
- mov ax, Src.h // WorkY := Src.h
- mov WorkY, ax
- @LoopY:
- mov ax, Src.w
- shl ax, 2
- mov WorkX, ax // WorkX := Src.w * 4
- @Loopx:
- mov al, [esi] // AL := source color
- and al, [edi]
- mov [edi], al
- inc esi
- inc edi
- dec WorkX
- jnz @LoopX
- add esi, SrcMod
- add edi, DestMod
- dec WorkY
- jnz @LoopY
- mov esp,_esp
- mov edi,_edi
- mov esi,_esi
- mov ebx,_ebx
- end;
- end;
- SDL_UnlockSurface( SrcSurface );
- SDL_UnlockSurface( DestSurface );
-end;
-
-
-procedure SDL_GTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-var
- R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;
- Src, Dest : TSDL_Rect;
- Diff : integer;
- SrcAddr, DestAddr : cardinal;
- WorkX, WorkY : word;
- SrcMod, DestMod : cardinal;
- Bits : cardinal;
-begin
- if ( SrcSurface = nil ) or ( DestSurface = nil ) then
- exit; // Remove this to make it faster
- if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
- exit; // Remove this to make it faster
- if SrcRect = nil then
- begin
- with Src do
- begin
- x := 0;
- y := 0;
- w := SrcSurface.w;
- h := SrcSurface.h;
- end;
- end
- else
- Src := SrcRect^;
- if DestRect = nil then
- begin
- Dest.x := 0;
- Dest.y := 0;
- end
- else
- Dest := DestRect^;
- Dest.w := Src.w;
- Dest.h := Src.h;
- with DestSurface.Clip_Rect do
- begin
- // Source's right side is greater than the dest.cliprect
- if Dest.x + Src.w > x + w then
- begin
- smallint( Src.w ) := x + w - Dest.x;
- smallint( Dest.w ) := x + w - Dest.x;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's bottom side is greater than the dest.clip
- if Dest.y + Src.h > y + h then
- begin
- smallint( Src.h ) := y + h - Dest.y;
- smallint( Dest.h ) := y + h - Dest.y;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- // Source's left side is less than the dest.clip
- if Dest.x < x then
- begin
- Diff := x - Dest.x;
- Src.x := Src.x + Diff;
- smallint( Src.w ) := smallint( Src.w ) - Diff;
- Dest.x := x;
- smallint( Dest.w ) := smallint( Dest.w ) - Diff;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's Top side is less than the dest.clip
- if Dest.y < y then
- begin
- Diff := y - Dest.y;
- Src.y := Src.y + Diff;
- smallint( Src.h ) := smallint( Src.h ) - Diff;
- Dest.y := y;
- smallint( Dest.h ) := smallint( Dest.h ) - Diff;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- end;
- with SrcSurface^ do
- begin
- SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
- Format.BytesPerPixel;
- SrcMod := Pitch - Src.w * Format.BytesPerPixel;
- TransparentColor := Format.colorkey;
- end;
- with DestSurface^ do
- begin
- DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
- Format.BytesPerPixel;
- DestMod := Pitch - Dest.w * Format.BytesPerPixel;
- Bits := Format.BitsPerPixel;
- end;
- SDL_LockSurface( SrcSurface );
- SDL_LockSurface( DestSurface );
- WorkY := Src.h;
- case bits of
- 8 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt8( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt8( DestAddr )^;
- if Pixel2 > 0 then
- begin
- if Pixel2 and $E0 > Pixel1 and $E0 then R := Pixel2 and $E0 else R := Pixel1 and $E0;
- if Pixel2 and $1C > Pixel1 and $1C then G := Pixel2 and $1C else G := Pixel1 and $1C;
- if Pixel2 and $03 > Pixel1 and $03 then B := Pixel2 and $03 else B := Pixel1 and $03;
-
- if R > $E0 then
- R := $E0;
- if G > $1C then
- G := $1C;
- if B > $03 then
- B := $03;
- PUInt8( DestAddr )^ := R or G or B;
- end
- else
- PUInt8( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr );
- inc( DestAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 15 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
- if Pixel2 > 0 then
- begin
-
- if Pixel2 and $7C00 > Pixel1 and $7C00 then R := Pixel2 and $7C00 else R := Pixel1 and $7C00;
- if Pixel2 and $03E0 > Pixel1 and $03E0 then G := Pixel2 and $03E0 else G := Pixel1 and $03E0;
- if Pixel2 and $001F > Pixel1 and $001F then B := Pixel2 and $001F else B := Pixel1 and $001F;
-
- PUInt16( DestAddr )^ := R or G or B;
- end
- else
- PUInt16( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 16 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
- if Pixel2 > 0 then
- begin
-
- if Pixel2 and $F800 > Pixel1 and $F800 then R := Pixel2 and $F800 else R := Pixel1 and $F800;
- if Pixel2 and $07E0 > Pixel1 and $07E0 then G := Pixel2 and $07E0 else G := Pixel1 and $07E0;
- if Pixel2 and $001F > Pixel1 and $001F then B := Pixel2 and $001F else B := Pixel1 and $001F;
-
- PUInt16( DestAddr )^ := R or G or B;
- end
- else
- PUInt16( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 24 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
- if Pixel2 > 0 then
- begin
-
- if Pixel2 and $FF0000 > Pixel1 and $FF0000 then R := Pixel2 and $FF0000 else R := Pixel1 and $FF0000;
- if Pixel2 and $00FF00 > Pixel1 and $00FF00 then G := Pixel2 and $00FF00 else G := Pixel1 and $00FF00;
- if Pixel2 and $0000FF > Pixel1 and $0000FF then B := Pixel2 and $0000FF else B := Pixel1 and $0000FF;
-
- PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B );
- end
- else
- PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1;
- end;
- inc( SrcAddr, 3 );
- inc( DestAddr, 3 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 32 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^;
- if Pixel2 > 0 then
- begin
-
- if Pixel2 and $FF0000 > Pixel1 and $FF0000 then R := Pixel2 and $FF0000 else R := Pixel1 and $FF0000;
- if Pixel2 and $00FF00 > Pixel1 and $00FF00 then G := Pixel2 and $00FF00 else G := Pixel1 and $00FF00;
- if Pixel2 and $0000FF > Pixel1 and $0000FF then B := Pixel2 and $0000FF else B := Pixel1 and $0000FF;
-
- PUInt32( DestAddr )^ := R or G or B;
- end
- else
- PUInt32( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr, 4 );
- inc( DestAddr, 4 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- end;
- SDL_UnlockSurface( SrcSurface );
- SDL_UnlockSurface( DestSurface );
-end;
-
-
-procedure SDL_LTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-var
- R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;
- Src, Dest : TSDL_Rect;
- Diff : integer;
- SrcAddr, DestAddr : cardinal;
- WorkX, WorkY : word;
- SrcMod, DestMod : cardinal;
- Bits : cardinal;
-begin
- if ( SrcSurface = nil ) or ( DestSurface = nil ) then
- exit; // Remove this to make it faster
- if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
- exit; // Remove this to make it faster
- if SrcRect = nil then
- begin
- with Src do
- begin
- x := 0;
- y := 0;
- w := SrcSurface.w;
- h := SrcSurface.h;
- end;
- end
- else
- Src := SrcRect^;
- if DestRect = nil then
- begin
- Dest.x := 0;
- Dest.y := 0;
- end
- else
- Dest := DestRect^;
- Dest.w := Src.w;
- Dest.h := Src.h;
- with DestSurface.Clip_Rect do
- begin
- // Source's right side is greater than the dest.cliprect
- if Dest.x + Src.w > x + w then
- begin
- smallint( Src.w ) := x + w - Dest.x;
- smallint( Dest.w ) := x + w - Dest.x;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's bottom side is greater than the dest.clip
- if Dest.y + Src.h > y + h then
- begin
- smallint( Src.h ) := y + h - Dest.y;
- smallint( Dest.h ) := y + h - Dest.y;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- // Source's left side is less than the dest.clip
- if Dest.x < x then
- begin
- Diff := x - Dest.x;
- Src.x := Src.x + Diff;
- smallint( Src.w ) := smallint( Src.w ) - Diff;
- Dest.x := x;
- smallint( Dest.w ) := smallint( Dest.w ) - Diff;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's Top side is less than the dest.clip
- if Dest.y < y then
- begin
- Diff := y - Dest.y;
- Src.y := Src.y + Diff;
- smallint( Src.h ) := smallint( Src.h ) - Diff;
- Dest.y := y;
- smallint( Dest.h ) := smallint( Dest.h ) - Diff;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- end;
- with SrcSurface^ do
- begin
- SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
- Format.BytesPerPixel;
- SrcMod := Pitch - Src.w * Format.BytesPerPixel;
- TransparentColor := Format.colorkey;
- end;
- with DestSurface^ do
- begin
- DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
- Format.BytesPerPixel;
- DestMod := Pitch - Dest.w * Format.BytesPerPixel;
- Bits := Format.BitsPerPixel;
- end;
- SDL_LockSurface( SrcSurface );
- SDL_LockSurface( DestSurface );
- WorkY := Src.h;
- case bits of
- 8 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt8( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt8( DestAddr )^;
- if Pixel2 > 0 then
- begin
- if Pixel2 and $E0 < Pixel1 and $E0 then R := Pixel2 and $E0 else R := Pixel1 and $E0;
- if Pixel2 and $1C < Pixel1 and $1C then G := Pixel2 and $1C else G := Pixel1 and $1C;
- if Pixel2 and $03 < Pixel1 and $03 then B := Pixel2 and $03 else B := Pixel1 and $03;
-
- if R > $E0 then
- R := $E0;
- if G > $1C then
- G := $1C;
- if B > $03 then
- B := $03;
- PUInt8( DestAddr )^ := R or G or B;
- end
- else
- PUInt8( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr );
- inc( DestAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 15 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
- if Pixel2 > 0 then
- begin
-
- if Pixel2 and $7C00 < Pixel1 and $7C00 then R := Pixel2 and $7C00 else R := Pixel1 and $7C00;
- if Pixel2 and $03E0 < Pixel1 and $03E0 then G := Pixel2 and $03E0 else G := Pixel1 and $03E0;
- if Pixel2 and $001F < Pixel1 and $001F then B := Pixel2 and $001F else B := Pixel1 and $001F;
-
- PUInt16( DestAddr )^ := R or G or B;
- end
- else
- PUInt16( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 16 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
- if Pixel2 > 0 then
- begin
-
- if Pixel2 and $F800 < Pixel1 and $F800 then R := Pixel2 and $F800 else R := Pixel1 and $F800;
- if Pixel2 and $07E0 < Pixel1 and $07E0 then G := Pixel2 and $07E0 else G := Pixel1 and $07E0;
- if Pixel2 and $001F < Pixel1 and $001F then B := Pixel2 and $001F else B := Pixel1 and $001F;
-
- PUInt16( DestAddr )^ := R or G or B;
- end
- else
- PUInt16( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 24 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
- if Pixel2 > 0 then
- begin
-
- if Pixel2 and $FF0000 < Pixel1 and $FF0000 then R := Pixel2 and $FF0000 else R := Pixel1 and $FF0000;
- if Pixel2 and $00FF00 < Pixel1 and $00FF00 then G := Pixel2 and $00FF00 else G := Pixel1 and $00FF00;
- if Pixel2 and $0000FF < Pixel1 and $0000FF then B := Pixel2 and $0000FF else B := Pixel1 and $0000FF;
-
- PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B );
- end
- else
- PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1;
- end;
- inc( SrcAddr, 3 );
- inc( DestAddr, 3 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 32 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^;
- if Pixel2 > 0 then
- begin
-
- if Pixel2 and $FF0000 < Pixel1 and $FF0000 then R := Pixel2 and $FF0000 else R := Pixel1 and $FF0000;
- if Pixel2 and $00FF00 < Pixel1 and $00FF00 then G := Pixel2 and $00FF00 else G := Pixel1 and $00FF00;
- if Pixel2 and $0000FF < Pixel1 and $0000FF then B := Pixel2 and $0000FF else B := Pixel1 and $0000FF;
-
- PUInt32( DestAddr )^ := R or G or B;
- end
- else
- PUInt32( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr, 4 );
- inc( DestAddr, 4 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- end;
- SDL_UnlockSurface( SrcSurface );
- SDL_UnlockSurface( DestSurface );
-end;
-
-function SDL_ClipLine(var x1,y1,x2,y2: Integer; ClipRect: PSDL_Rect) : boolean;
-var tflag, flag1, flag2: word;
- txy, xedge, yedge: Integer;
- slope: single;
-
- function ClipCode(x,y: Integer): word;
- begin
- Result := 0;
- if x < ClipRect.x then Result := 1;
- if x >= ClipRect.w + ClipRect.x then Result := Result or 2;
- if y < ClipRect.y then Result := Result or 4;
- if y >= ClipRect.h + ClipRect.y then Result := Result or 8;
- end;
-
-begin
- flag1 := ClipCode(x1,y1);
- flag2 := ClipCode(x2,y2);
- result := true;
-
- while true do
- begin
- if (flag1 or flag2) = 0 then Exit; // all in
-
- if (flag1 and flag2) <> 0 then
- begin
- result := false;
- Exit; // all out
- end;
-
- if flag2 = 0 then
- begin
- txy := x1; x1 := x2; x2 := txy;
- txy := y1; y1 := y2; y2 := txy;
- tflag := flag1; flag1 := flag2; flag2 := tflag;
- end;
-
- if (flag2 and 3) <> 0 then
- begin
- if (flag2 and 1) <> 0 then
- xedge := ClipRect.x
- else
- xedge := ClipRect.w + ClipRect.x -1; // back 1 pixel otherwise we end up in a loop
-
- slope := (y2 - y1) / (x2 - x1);
- y2 := y1 + Round(slope * (xedge - x1));
- x2 := xedge;
- end
- else
- begin
- if (flag2 and 4) <> 0 then
- yedge := ClipRect.y
- else
- yedge := ClipRect.h + ClipRect.y -1; // up 1 pixel otherwise we end up in a loop
-
- slope := (x2 - x1) / (y2 - y1);
- x2 := x1 + Round(slope * (yedge - y1));
- y2 := yedge;
- end;
-
- flag2 := ClipCode(x2, y2);
- end;
-end;
-
-end.
-
-
+unit sdli386utils; +{ + $Id: sdli386utils.pas,v 1.5 2004/06/02 19:38:53 savage Exp $ + +} +{******************************************************************************} +{ } +{ Borland Delphi SDL - Simple DirectMedia Layer } +{ SDL Utility functions } +{ } +{ } +{ The initial developer of this Pascal code was : } +{ Tom Jones <tigertomjones@gmx.de> } +{ } +{ Portions created by Tom Jones are } +{ Copyright (C) 2000 - 2001 Tom Jones. } +{ } +{ } +{ Contributor(s) } +{ -------------- } +{ Dominique Louis <Dominique@SavageSoftware.com.au> } +{ Róbert Kisnémeth <mikrobi@freemail.hu> } +{ } +{ Obtained through: } +{ Joint Endeavour of Delphi Innovators ( Project JEDI ) } +{ } +{ You may retrieve the latest version of this file at the Project } +{ JEDI home page, located at http://delphi-jedi.org } +{ } +{ The contents of this file are used with permission, subject to } +{ the Mozilla Public License Version 1.1 (the "License"); you may } +{ not use this file except in compliance with the License. You may } +{ obtain a copy of the License at } +{ http://www.mozilla.org/MPL/MPL-1.1.html } +{ } +{ Software distributed under the License is distributed on an } +{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or } +{ implied. See the License for the specific language governing } +{ rights and limitations under the License. } +{ } +{ Description } +{ ----------- } +{ Helper functions... } +{ } +{ } +{ Requires } +{ -------- } +{ SDL.dll on Windows platforms } +{ libSDL-1.1.so.0 on Linux platform } +{ } +{ Programming Notes } +{ ----------------- } +{ } +{ } +{ } +{ } +{ Revision History } +{ ---------------- } +{ 2000 - TJ : Initial creation } +{ } +{ July 13 2001 - DL : Added PutPixel and GetPixel routines. } +{ } +{ Sept 14 2001 - RK : Added flipping routines. } +{ } +{ Sept 19 2001 - RK : Added PutPixel & line drawing & blitting with ADD } +{ effect. Fixed a bug in SDL_PutPixel & SDL_GetPixel } +{ Added PSDLRect() } +{ Sept 22 2001 - DL : Removed need for Windows.pas by defining types here} +{ Also removed by poor attempt or a dialog box } +{ } +{ Sept 25 2001 - RK : Added PixelTest, NewPutPixel, SubPixel, SubLine, } +{ SubSurface, MonoSurface & TexturedSurface } +{ } +{ Sept 26 2001 - DL : Made change so that it refers to native Pascal } +{ types rather that Windows types. This makes it more} +{ portable to Linix. } +{ } +{ Sept 27 2001 - RK : SDLUtils now can be compiled with FreePascal } +{ } +{ Oct 27 2001 - JF : Added ScrollY function } +{ } +{ Jan 21 2002 - RK : Added SDL_ZoomSurface and SDL_WarpSurface } +{ } +{ Mar 28 2002 - JF : Added SDL_RotateSurface } +{ } +{ May 13 2002 - RK : Improved SDL_FillRectAdd & SDL_FillRectSub } +{ } +{ May 27 2002 - YS : GradientFillRect function } +{ } +{ May 30 2002 - RK : Added SDL_2xBlit, SDL_Scanline2xBlit } +{ & SDL_50Scanline2xBlit } +{ } +{ June 12 2002 - RK : Added SDL_PixelTestSurfaceVsRect } +{ } +{ June 12 2002 - JF : Updated SDL_PixelTestSurfaceVsRect } +{ } +{ November 9 2002 - JF : Added Jason's boolean Surface functions } +{ } +{ December 10 2002 - DE : Added Dean's SDL_ClipLine function } +{ } +{******************************************************************************} +{ + $Log: sdli386utils.pas,v $ + Revision 1.5 2004/06/02 19:38:53 savage + Changes to SDL_GradientFillRect as suggested by + Ángel Eduardo García Hernández. Many thanks. + + Revision 1.4 2004/05/29 23:11:53 savage + Changes to SDL_ScaleSurfaceRect as suggested by + Ángel Eduardo García Hernández to fix a colour issue with the function. Many thanks. + + Revision 1.3 2004/02/20 22:04:11 savage + Added Changes as mentioned by Rodrigo "Rui" R. (1/2 RRC2Soft) to facilitate FPC compilation and it also works in Delphi. Also syncronized the funcitons so that they are identical to sdlutils.pas, when no assembly version is available. + + Revision 1.2 2004/02/14 00:23:39 savage + As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change. + + Revision 1.1 2004/02/05 00:08:20 savage + Module 1.0 release + + +} + +interface + +{$i jedi-sdl.inc} + +uses +{$IFDEF UNIX} + Types, + Xlib, +{$ENDIF} + SysUtils, + sdl; + +type + TGradientStyle = ( gsHorizontal, gsVertical ); + + // Pixel procedures +function SDL_PixelTest( SrcSurface1 : PSDL_Surface; SrcRect1 : PSDL_Rect; SrcSurface2 : + PSDL_Surface; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : Boolean; + +function SDL_GetPixel( SrcSurface : PSDL_Surface; x : cardinal; y : cardinal ) : Uint32; + +procedure SDL_PutPixel( SrcSurface : PSDL_Surface; x : integer; y : integer; Color : + cardinal ); + +procedure SDL_AddPixel( SrcSurface : PSDL_Surface; x : integer; y : integer; Color : + cardinal ); + +procedure SDL_SubPixel( SrcSurface : PSDL_Surface; x : integer; y : integer; Color : + cardinal ); + +// Line procedures +procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color : + cardinal );overload; + +procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color : + cardinal ; DashLength, DashSpace : byte ); overload; + +procedure SDL_AddLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color : + cardinal ); + +procedure SDL_SubLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color : + cardinal ); + +// Surface procedures +procedure SDL_AddSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DstSurface : PSDL_Surface; DestRect : PSDL_Rect ); + +procedure SDL_SubSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DstSurface : PSDL_Surface; DestRect : PSDL_Rect ); + +procedure SDL_MonoSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DstSurface : PSDL_Surface; DestRect : PSDL_Rect; Color : cardinal ); + +procedure SDL_TexturedSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DstSurface : PSDL_Surface; DestRect : PSDL_Rect; Texture : PSDL_Surface; + TextureRect : PSDL_Rect ); + +procedure SDL_ZoomSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; DstRect : PSDL_Rect ); + +procedure SDL_WarpSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; UL, UR, LR, LL : PPoint ); + +// Flip procedures +procedure SDL_FlipRectH( DstSurface : PSDL_Surface; Rect : PSDL_Rect ); + +procedure SDL_FlipRectV( DstSurface : PSDL_Surface; Rect : PSDL_Rect ); + +function PSDLRect( aLeft, aTop, aWidth, aHeight : integer ) : PSDL_Rect; + +function SDLRect( aLeft, aTop, aWidth, aHeight : integer ) : TSDL_Rect; overload; + +function SDLRect( aRect : TRect ) : TSDL_Rect; overload; + +function SDL_ScaleSurfaceRect( SrcSurface : PSDL_Surface; SrcX1, SrcY1, SrcW, SrcH, + Width, Height : integer ) : PSDL_Surface; + +procedure SDL_ScrollY( DstSurface : PSDL_Surface; DifY : integer ); + +procedure SDL_ScrollX( DstSurface : PSDL_Surface; DifX : integer ); + +procedure SDL_RotateDeg( DstSurface, SrcSurface : PSDL_Surface; SrcRect : + PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Integer ); + +procedure SDL_RotateRad( DstSurface, SrcSurface : PSDL_Surface; SrcRect : + PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Single ); + +function ValidateSurfaceRect( DstSurface : PSDL_Surface; dstrect : PSDL_Rect ) : TSDL_Rect; + +// Fill Rect routine +procedure SDL_FillRectAdd( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 ); + +procedure SDL_FillRectSub( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 ); + +procedure SDL_GradientFillRect( DstSurface : PSDL_Surface; const Rect : PSDL_Rect; const StartColor, EndColor : TSDL_Color; const Style : TGradientStyle ); + +// NOTE for All SDL_2xblit... function : the dest surface must be 2x of the source surface! +procedure SDL_2xBlit( Src, Dest : PSDL_Surface ); + +procedure SDL_Scanline2xBlit( Src, Dest : PSDL_Surface ); + +procedure SDL_50Scanline2xBlit( Src, Dest : PSDL_Surface ); + +function SDL_PixelTestSurfaceVsRect( SrcSurface1 : PSDL_Surface; SrcRect1 : +PSDL_Rect; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : +boolean; + +// Jason's boolean Surface functions +procedure SDL_ORSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); + +procedure SDL_ANDSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); + +procedure SDL_GTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); + +procedure SDL_LTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); + +function SDL_ClipLine(var x1,y1,x2,y2: Integer; ClipRect: PSDL_Rect) : boolean; + +implementation + +uses + Math; + +function SDL_PixelTest( SrcSurface1 : PSDL_Surface; SrcRect1 : PSDL_Rect; SrcSurface2 : + PSDL_Surface; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : boolean; +var + Src_Rect1, Src_Rect2 : TSDL_Rect; + right1, bottom1 : integer; + right2, bottom2 : integer; + Scan1Start, Scan2Start, ScanWidth, ScanHeight : cardinal; + Mod1, Mod2 : cardinal; + Addr1, Addr2 : cardinal; + BPP : cardinal; + Pitch1, Pitch2 : cardinal; + TransparentColor1, TransparentColor2 : cardinal; + tx, ty : cardinal; + StartTick : cardinal; + Color1, Color2 : cardinal; +begin + Result := false; + if SrcRect1 = nil then + begin + with Src_Rect1 do + begin + x := 0; + y := 0; + w := SrcSurface1.w; + h := SrcSurface1.h; + end; + end + else + Src_Rect1 := SrcRect1^; + if SrcRect2 = nil then + begin + with Src_Rect2 do + begin + x := 0; + y := 0; + w := SrcSurface2.w; + h := SrcSurface2.h; + end; + end + else + Src_Rect2 := SrcRect2^; + with Src_Rect1 do + begin + Right1 := Left1 + w; + Bottom1 := Top1 + h; + end; + with Src_Rect2 do + begin + Right2 := Left2 + w; + Bottom2 := Top2 + h; + end; + if ( Left1 >= Right2 ) or ( Right1 <= Left2 ) or ( Top1 >= Bottom2 ) or ( Bottom1 <= + Top2 ) then + exit; + if Left1 <= Left2 then + begin + // 1. left, 2. right + Scan1Start := Src_Rect1.x + Left2 - Left1; + Scan2Start := Src_Rect2.x; + ScanWidth := Right1 - Left2; + with Src_Rect2 do + if ScanWidth > w then + ScanWidth := w; + end + else + begin + // 1. right, 2. left + Scan1Start := Src_Rect1.x; + Scan2Start := Src_Rect2.x + Left1 - Left2; + ScanWidth := Right2 - Left1; + with Src_Rect1 do + if ScanWidth > w then + ScanWidth := w; + end; + with SrcSurface1^ do + begin + Pitch1 := Pitch; + Addr1 := cardinal( Pixels ); + inc( Addr1, Pitch1 * UInt32( Src_Rect1.y ) ); + with format^ do + begin + BPP := BytesPerPixel; + TransparentColor1 := colorkey; + end; + end; + with SrcSurface2^ do + begin + TransparentColor2 := format.colorkey; + Pitch2 := Pitch; + Addr2 := cardinal( Pixels ); + inc( Addr2, Pitch2 * UInt32( Src_Rect2.y ) ); + end; + Mod1 := Pitch1 - ( ScanWidth * BPP ); + Mod2 := Pitch2 - ( ScanWidth * BPP ); + inc( Addr1, BPP * Scan1Start ); + inc( Addr2, BPP * Scan2Start ); + if Top1 <= Top2 then + begin + // 1. up, 2. down + ScanHeight := Bottom1 - Top2; + if ScanHeight > Src_Rect2.h then + ScanHeight := Src_Rect2.h; + inc( Addr1, Pitch1 * UInt32( Top2 - Top1 ) ); + end + else + begin + // 1. down, 2. up + ScanHeight := Bottom2 - Top1; + if ScanHeight > Src_Rect1.h then + ScanHeight := Src_Rect1.h; + inc( Addr2, Pitch2 * UInt32( Top1 - Top2 ) ); + end; + case BPP of + 1 : + for ty := 1 to ScanHeight do + begin + for tx := 1 to ScanWidth do + begin + if ( PByte( Addr1 )^ <> TransparentColor1 ) and ( PByte( Addr2 )^ <> + TransparentColor2 ) then + begin + Result := true; + exit; + end; + inc( Addr1 ); + inc( Addr2 ); + end; + inc( Addr1, Mod1 ); + inc( Addr2, Mod2 ); + end; + 2 : + for ty := 1 to ScanHeight do + begin + for tx := 1 to ScanWidth do + begin + if ( PWord( Addr1 )^ <> TransparentColor1 ) and ( PWord( Addr2 )^ <> + TransparentColor2 ) then + begin + Result := true; + exit; + end; + inc( Addr1, 2 ); + inc( Addr2, 2 ); + end; + inc( Addr1, Mod1 ); + inc( Addr2, Mod2 ); + end; + 3 : + for ty := 1 to ScanHeight do + begin + for tx := 1 to ScanWidth do + begin + Color1 := PLongWord( Addr1 )^ and $00FFFFFF; + Color2 := PLongWord( Addr2 )^ and $00FFFFFF; + if ( Color1 <> TransparentColor1 ) and ( Color2 <> TransparentColor2 ) + then + begin + Result := true; + exit; + end; + inc( Addr1, 3 ); + inc( Addr2, 3 ); + end; + inc( Addr1, Mod1 ); + inc( Addr2, Mod2 ); + end; + 4 : + for ty := 1 to ScanHeight do + begin + for tx := 1 to ScanWidth do + begin + if ( PLongWord( Addr1 )^ <> TransparentColor1 ) and ( PLongWord( Addr2 )^ <> + TransparentColor2 ) then + begin + Result := true; + exit; + end; + inc( Addr1, 4 ); + inc( Addr2, 4 ); + end; + inc( Addr1, Mod1 ); + inc( Addr2, Mod2 ); + end; + end; +end; + +function SDL_GetPixel( SrcSurface : PSDL_Surface; x : cardinal; y : cardinal ) : Uint32; +var + bpp : UInt32; + p : PInteger; +begin + bpp := SrcSurface.format.BytesPerPixel; + // Here p is the address to the pixel we want to retrieve + p := Pointer( Uint32( SrcSurface.pixels ) + UInt32( y ) * SrcSurface.pitch + UInt32( x ) * + bpp ); + case bpp of + 1 : result := PUint8( p )^; + 2 : result := PUint16( p )^; + 3 : + if ( SDL_BYTEORDER = SDL_BIG_ENDIAN ) then + result := PUInt8Array( p )[ 0 ] shl 16 or PUInt8Array( p )[ 1 ] shl 8 or + PUInt8Array( p )[ 2 ] + else + result := PUInt8Array( p )[ 0 ] or PUInt8Array( p )[ 1 ] shl 8 or + PUInt8Array( p )[ 2 ] shl 16; + 4 : result := PUint32( p )^; + else + result := 0; // shouldn't happen, but avoids warnings + end; +end; + +procedure SDL_PutPixel( SrcSurface : PSDL_Surface; x : integer; y : integer; Color : + cardinal ); +var + Addr, Pitch, BPP : cardinal; +begin + Addr := cardinal( SrcSurface.Pixels ); + Pitch := SrcSurface.Pitch; + BPP := SrcSurface.format.BytesPerPixel; + asm + mov eax, y + mul Pitch // EAX := y * Pitch + add Addr, eax // Addr:= Addr + (y * Pitch) + mov eax, x + mov ecx, Color + cmp BPP, 1 + jne @Not1BPP + add eax, Addr // Now: EAX:= Addr + (y * Pitch) + x + mov [eax], cl + jmp @Quit + @Not1BPP: + cmp BPP, 2 + jne @Not2BPP + mul BPP // EAX := x * BPP + add eax, Addr // Now: EAX:= Addr + (y * Pitch) + x * BPP + mov [eax], cx + jmp @Quit + @Not2BPP: + cmp BPP, 3 + jne @Not3BPP + mul BPP // EAX := x * BPP + add eax, Addr // Now: EAX:= Addr + (y * Pitch) + x * BPP + mov edx, [eax] + and edx, $ff000000 + or edx, ecx + mov [eax], edx + jmp @Quit + @Not3BPP: + mul BPP // EAX := x * BPP + add eax, Addr // Now: EAX:= Addr + (y * Pitch) + x * BPP + mov [eax], ecx + @Quit: + end; +end; + +procedure SDL_AddPixel( SrcSurface : PSDL_Surface; x : integer; y : integer; Color : + cardinal ); +var + SrcColor, FinalColor : cardinal; + Addr, Pitch, Bits : cardinal; +begin + if Color = 0 then + exit; + Addr := cardinal( SrcSurface.Pixels ); + Pitch := SrcSurface.Pitch; + Bits := SrcSurface.format.BitsPerPixel; + asm + mov eax, y + mul Pitch // EAX := y * Pitch + add Addr, eax // Addr:= Addr + (y * Pitch) + mov eax, x + cmp Bits, 8 + jne @Not8bit + add eax, Addr // Now: EAX:= Addr + (y * Pitch) + x + mov cl, [eax] + movzx ecx, cl + mov SrcColor, ecx + mov edx, Color + and ecx, 3 + and edx, 3 + add ecx, edx + cmp ecx, 3 + jbe @Skip1_8bit + mov ecx, 3 + @Skip1_8bit: + mov FinalColor, ecx + mov ecx, SrcColor + mov edx, Color + and ecx, $1c + and edx, $1c + add ecx, edx + cmp ecx, $1c + jbe @Skip2_8bit + mov ecx, $1c + @Skip2_8bit: + or FinalColor, ecx + mov ecx, SrcColor + mov edx, Color + and ecx, $e0 + and edx, $e0 + add ecx, edx + cmp ecx, $e0 + jbe @Skip3_8bit + mov ecx, $e0 + @Skip3_8bit: + or ecx, FinalColor + mov [eax], cl + jmp @Quit + @Not8bit: + cmp Bits, 15 + jne @Not15bit + shl eax, 1 + add eax, Addr // Now: EAX:= Addr + (y * Pitch) + x * 2 + mov ecx, [eax] + and ecx, $00007fff + mov SrcColor, ecx + mov edx, Color + and ecx, $1f + and edx, $1f + add ecx, edx + cmp ecx, $1f + jbe @Skip1_15bit + mov ecx, $1f + @Skip1_15bit: + mov FinalColor, ecx + mov ecx, SrcColor + mov edx, Color + and ecx, $03e0 + and edx, $03e0 + add ecx, edx + cmp ecx, $03e0 + jbe @Skip2_15bit + mov ecx, $03e0 + @Skip2_15bit: + or FinalColor, ecx + mov ecx, SrcColor + mov edx, Color + and ecx, $7c00 + and edx, $7c00 + add ecx, edx + cmp ecx, $7c00 + jbe @Skip3_15bit + mov ecx, $7c00 + @Skip3_15bit: + or ecx, FinalColor + mov [eax], cx + jmp @Quit + @Not15Bit: + cmp Bits, 16 + jne @Not16bit + shl eax, 1 + add eax, Addr // Now: EAX:= Addr + (y * Pitch) + x * 2 + mov ecx, [eax] + and ecx, $0000ffff + mov SrcColor, ecx + mov edx, Color + and ecx, $1f + and edx, $1f + add ecx, edx + cmp ecx, $1f + jbe @Skip1_16bit + mov ecx, $1f + @Skip1_16bit: + mov FinalColor, ecx + mov ecx, SrcColor + mov edx, Color + and ecx, $07e0 + and edx, $07e0 + add ecx, edx + cmp ecx, $07e0 + jbe @Skip2_16bit + mov ecx, $07e0 + @Skip2_16bit: + or FinalColor, ecx + mov ecx, SrcColor + mov edx, Color + and ecx, $f800 + and edx, $f800 + add ecx, edx + cmp ecx, $f800 + jbe @Skip3_16bit + mov ecx, $f800 + @Skip3_16bit: + or ecx, FinalColor + mov [eax], cx + jmp @Quit + @Not16Bit: + cmp Bits, 24 + jne @Not24bit + mov ecx, 0 + add ecx, eax + shl ecx, 1 + add ecx, eax + mov eax, ecx + jmp @32bit + @Not24bit: + shl eax, 2 + @32bit: + add eax, Addr // Now: EAX:= Addr + (y * Pitch) + x * 2 + mov ecx, [eax] + mov FinalColor, ecx + and FinalColor, $ff000000 + and ecx, $00ffffff + mov SrcColor, ecx + mov edx, Color + and ecx, $000000ff + and edx, $000000ff + add ecx, edx + cmp ecx, $000000ff + jbe @Skip1_32bit + mov ecx, $000000ff + @Skip1_32bit: + or FinalColor, ecx + mov ecx, SrcColor + mov edx, Color + and ecx, $0000ff00 + and edx, $0000ff00 + add ecx, edx + cmp ecx, $0000ff00 + jbe @Skip2_32bit + mov ecx, $0000ff00 + @Skip2_32bit: + or FinalColor, ecx + mov ecx, SrcColor + mov edx, Color + and ecx, $00ff0000 + and edx, $00ff0000 + add ecx, edx + cmp ecx, $00ff0000 + jbe @Skip3_32bit + mov ecx, $00ff0000 + @Skip3_32bit: + or ecx, FinalColor + mov [eax], ecx + @Quit: + end; +end; + +procedure SDL_SubPixel( SrcSurface : PSDL_Surface; x : integer; y : integer; Color : + cardinal ); +var + SrcColor, FinalColor : cardinal; + Addr, Pitch, Bits : cardinal; +begin + if Color = 0 then + exit; + Addr := cardinal( SrcSurface.Pixels ); + Pitch := SrcSurface.Pitch; + Bits := SrcSurface.format.BitsPerPixel; + asm + mov eax, y + mul Pitch // EAX := y * Pitch + add Addr, eax // Addr:= Addr + (y * Pitch) + mov eax, x + cmp Bits, 8 + jne @Not8bit + add eax, Addr // Now: EAX:= Addr + (y * Pitch) + x + mov cl, [eax] + movzx ecx, cl + mov SrcColor, ecx + mov edx, Color + and ecx, 3 + and edx, 3 + sub ecx, edx + jns @Skip1_8bit + mov ecx, 0 + @Skip1_8bit: + mov FinalColor, ecx + mov ecx, SrcColor + mov edx, Color + and ecx, $1c + and edx, $1c + sub ecx, edx + jns @Skip2_8bit + mov ecx, 0 + @Skip2_8bit: + or FinalColor, ecx + mov ecx, SrcColor + mov edx, Color + and ecx, $e0 + and edx, $e0 + sub ecx, edx + jns @Skip3_8bit + mov ecx, 0 + @Skip3_8bit: + or ecx, FinalColor + mov [eax], cl + jmp @Quit + @Not8bit: + cmp Bits, 15 + jne @Not15bit + shl eax, 1 + add eax, Addr + mov ecx, [eax] + and ecx, $00007fff + mov SrcColor, ecx + mov edx, Color + and ecx, $1f + and edx, $1f + sub ecx, edx + jns @Skip1_15bit + mov ecx, 0 + @Skip1_15bit: + mov FinalColor, ecx + mov ecx, SrcColor + mov edx, Color + and ecx, $03e0 + and edx, $03e0 + sub ecx, edx + jns @Skip2_15bit + mov ecx, 0 + @Skip2_15bit: + or FinalColor, ecx + mov ecx, SrcColor + mov edx, Color + and ecx, $7c00 + and edx, $7c00 + sub ecx, edx + jns @Skip3_15bit + mov ecx, 0 + @Skip3_15bit: + or ecx, FinalColor + mov [eax], cx + jmp @Quit + @Not15Bit: + cmp Bits, 16 + jne @Not16bit + shl eax, 1 + add eax, Addr + mov ecx, [eax] + and ecx, $0000ffff + mov SrcColor, ecx + mov edx, Color + and ecx, $1f + and edx, $1f + sub ecx, edx + jns @Skip1_16bit + mov ecx, 0 + @Skip1_16bit: + mov FinalColor, ecx + mov ecx, SrcColor + mov edx, Color + and ecx, $07e0 + and edx, $07e0 + sub ecx, edx + jns @Skip2_16bit + mov ecx, 0 + @Skip2_16bit: + or FinalColor, ecx + mov ecx, SrcColor + mov edx, Color + and ecx, $f800 + and edx, $f800 + sub ecx, edx + jns @Skip3_16bit + mov ecx, 0 + @Skip3_16bit: + or ecx, FinalColor + mov [eax], cx + jmp @Quit + @Not16Bit: + cmp Bits, 24 + jne @Not24bit + mov ecx, 0 + add ecx, eax + shl ecx, 1 + add ecx, eax + mov eax, ecx + jmp @32bit + @Not24bit: + shl eax, 2 + @32bit: + add eax, Addr + mov ecx, [eax] + mov FinalColor, ecx + and FinalColor, $ff000000 + and ecx, $00ffffff + mov SrcColor, ecx + mov edx, Color + and ecx, $000000ff + and edx, $000000ff + sub ecx, edx + jns @Skip1_32bit + mov ecx, 0 + @Skip1_32bit: + or FinalColor, ecx + mov ecx, SrcColor + mov edx, Color + and ecx, $0000ff00 + and edx, $0000ff00 + sub ecx, edx + jns @Skip2_32bit + mov ecx, 0 + @Skip2_32bit: + or FinalColor, ecx + mov ecx, SrcColor + mov edx, Color + and ecx, $00ff0000 + and edx, $00ff0000 + sub ecx, edx + jns @Skip3_32bit + mov ecx, 0 + @Skip3_32bit: + or ecx, FinalColor + mov [eax], ecx + @Quit: + end; +end; + +// Draw a line between x1,y1 and x2,y2 to the given surface +// NOTE: The surface must be locked before calling this! +procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color : + cardinal ); +var + dx, dy, sdx, sdy, x, y, px, py : integer; +begin + dx := x2 - x1; + dy := y2 - y1; + if dx < 0 then + sdx := -1 + else + sdx := 1; + if dy < 0 then + sdy := -1 + else + sdy := 1; + dx := sdx * dx + 1; + dy := sdy * dy + 1; + x := 0; + y := 0; + px := x1; + py := y1; + if dx >= dy then + begin + for x := 0 to dx - 1 do + begin + SDL_PutPixel( DstSurface, px, py, Color ); + y := y + dy; + if y >= dx then + begin + y := y - dx; + py := py + sdy; + end; + px := px + sdx; + end; + end + else + begin + for y := 0 to dy - 1 do + begin + SDL_PutPixel( DstSurface, px, py, Color ); + x := x + dx; + if x >= dy then + begin + x := x - dy; + px := px + sdx; + end; + py := py + sdy; + end; + end; +end; + +// Draw a dashed line between x1,y1 and x2,y2 to the given surface +// NOTE: The surface must be locked before calling this! +procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color : + cardinal ; DashLength, DashSpace : byte ); overload; +var + dx, dy, sdx, sdy, x, y, px, py, counter : integer; drawdash : boolean; +begin + counter := 0; + drawdash := true; //begin line drawing with dash + + //Avoid invalid user-passed dash parameters + if (DashLength < 1) + then DashLength := 1; + if (DashSpace < 1) + then DashSpace := 0; + + dx := x2 - x1; + dy := y2 - y1; + if dx < 0 then + sdx := -1 + else + sdx := 1; + if dy < 0 then + sdy := -1 + else + sdy := 1; + dx := sdx * dx + 1; + dy := sdy * dy + 1; + x := 0; + y := 0; + px := x1; + py := y1; + if dx >= dy then + begin + for x := 0 to dx - 1 do + begin + + //Alternate drawing dashes, or leaving spaces + if drawdash then + begin + SDL_PutPixel( DstSurface, px, py, Color ); + inc(counter); + if (counter > DashLength-1) and (DashSpace > 0) then + begin + drawdash := false; + counter := 0; + end; + end + else //space + begin + inc(counter); + if counter > DashSpace-1 then + begin + drawdash := true; + counter := 0; + end; + end; + + y := y + dy; + if y >= dx then + begin + y := y - dx; + py := py + sdy; + end; + px := px + sdx; + end; + end + else + begin + for y := 0 to dy - 1 do + begin + + //Alternate drawing dashes, or leaving spaces + if drawdash then + begin + SDL_PutPixel( DstSurface, px, py, Color ); + inc(counter); + if (counter > DashLength-1) and (DashSpace > 0) then + begin + drawdash := false; + counter := 0; + end; + end + else //space + begin + inc(counter); + if counter > DashSpace-1 then + begin + drawdash := true; + counter := 0; + end; + end; + + x := x + dx; + if x >= dy then + begin + x := x - dy; + px := px + sdx; + end; + py := py + sdy; + end; + end; +end; + +procedure SDL_AddLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color : + cardinal ); +var + dx, dy, sdx, sdy, x, y, px, py : integer; +begin + dx := x2 - x1; + dy := y2 - y1; + if dx < 0 then + sdx := -1 + else + sdx := 1; + if dy < 0 then + sdy := -1 + else + sdy := 1; + dx := sdx * dx + 1; + dy := sdy * dy + 1; + x := 0; + y := 0; + px := x1; + py := y1; + if dx >= dy then + begin + for x := 0 to dx - 1 do + begin + SDL_AddPixel( DstSurface, px, py, Color ); + y := y + dy; + if y >= dx then + begin + y := y - dx; + py := py + sdy; + end; + px := px + sdx; + end; + end + else + begin + for y := 0 to dy - 1 do + begin + SDL_AddPixel( DstSurface, px, py, Color ); + x := x + dx; + if x >= dy then + begin + x := x - dy; + px := px + sdx; + end; + py := py + sdy; + end; + end; +end; + +procedure SDL_SubLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color : + cardinal ); +var + dx, dy, sdx, sdy, x, y, px, py : integer; +begin + dx := x2 - x1; + dy := y2 - y1; + if dx < 0 then + sdx := -1 + else + sdx := 1; + if dy < 0 then + sdy := -1 + else + sdy := 1; + dx := sdx * dx + 1; + dy := sdy * dy + 1; + x := 0; + y := 0; + px := x1; + py := y1; + if dx >= dy then + begin + for x := 0 to dx - 1 do + begin + SDL_SubPixel( DstSurface, px, py, Color ); + y := y + dy; + if y >= dx then + begin + y := y - dx; + py := py + sdy; + end; + px := px + sdx; + end; + end + else + begin + for y := 0 to dy - 1 do + begin + SDL_SubPixel( DstSurface, px, py, Color ); + x := x + dx; + if x >= dy then + begin + x := x - dy; + px := px + sdx; + end; + py := py + sdy; + end; + end; +end; + +// This procedure works on 8, 15, 16, 24 and 32 bits color depth surfaces. +// In 8 bit color depth mode the procedure works with the default packed +// palette (RRRGGGBB). It handles all clipping. +procedure SDL_AddSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DstSurface : PSDL_Surface; DestRect : PSDL_Rect ); +var + Src, Dest : TSDL_Rect; + Diff : integer; + SrcAddr, DestAddr : cardinal; + // TransparentColor: cardinal; + _ebx, _esi, _edi, _esp : cardinal; + WorkX, WorkY : word; + SrcMod, DestMod : cardinal; + Bits : cardinal; +begin + if ( SrcSurface = nil ) or ( DstSurface = nil ) then + exit; // Remove this to make it faster + if ( SrcSurface.Format.BitsPerPixel <> DstSurface.Format.BitsPerPixel ) then + exit; // Remove this to make it faster + if SrcRect = nil then + begin + with Src do + begin + x := 0; + y := 0; + w := SrcSurface.w; + h := SrcSurface.h; + end; + end + else + Src := SrcRect^; + if DestRect = nil then + begin + Dest.x := 0; + Dest.y := 0; + end + else + Dest := DestRect^; + Dest.w := Src.w; + Dest.h := Src.h; + with DstSurface.Clip_Rect do + begin + // Source's right side is greater than the dest.cliprect + if Dest.x + Src.w > x + w then + begin + smallint( Src.w ) := x + w - Dest.x; + smallint( Dest.w ) := x + w - Dest.x; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's bottom side is greater than the dest.clip + if Dest.y + Src.h > y + h then + begin + smallint( Src.h ) := y + h - Dest.y; + smallint( Dest.h ) := y + h - Dest.y; + if smallint( Dest.h ) < 1 then + exit; + end; + // Source's left side is less than the dest.clip + if Dest.x < x then + begin + Diff := x - Dest.x; + Src.x := Src.x + Diff; + smallint( Src.w ) := smallint( Src.w ) - Diff; + Dest.x := x; + smallint( Dest.w ) := smallint( Dest.w ) - Diff; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's Top side is less than the dest.clip + if Dest.y < y then + begin + Diff := y - Dest.y; + Src.y := Src.y + Diff; + smallint( Src.h ) := smallint( Src.h ) - Diff; + Dest.y := y; + smallint( Dest.h ) := smallint( Dest.h ) - Diff; + if smallint( Dest.h ) < 1 then + exit; + end; + end; + with SrcSurface^ do + begin + SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) * + Format.BytesPerPixel; + SrcMod := Pitch - Src.w * Format.BytesPerPixel; + // TransparentColor := format.ColorKey; + end; + with DstSurface^ do + begin + DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) * + Format.BytesPerPixel; + DestMod := Pitch - Dest.w * Format.BytesPerPixel; + Bits := Format.BitsPerPixel; + end; + SDL_LockSurface( SrcSurface ); + SDL_LockSurface( DstSurface ); + case bits of + 8 : + asm + mov _ebx, ebx + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + @LoopY: + mov ax, Src.w + mov WorkX, ax // WorkX := Src.w + @Loopx: + mov al, [esi] // AL := source color + cmp al, 0 + je @SkipColor // if AL=0 or AL=transparent color then skip everything + mov esp, eax // ESP - source color + mov bl, [edi] // BL := destination color + mov dl, bl // DL := destination color + and ax, $03 // Adding BLUE + and bl, $03 + add al, bl + cmp al, $03 + jbe @Skip1 + mov al, $03 + @Skip1: + mov cl, al + mov eax, esp // Adding GREEN + mov bl, dl + and al, $1c + and bl, $1c + add al, bl + cmp al, $1c + jbe @Skip2 + mov al, $1c + @Skip2: + or cl, al + mov eax, esp // Adding RED + mov bl, dl + and ax, $e0 + and bx, $e0 + add ax, bx + cmp ax, $e0 + jbe @Skip3 + mov al, $e0 + @Skip3: + or cl, al + mov [edi], cl + @SkipColor: + inc esi + inc edi + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + dec WorkY + jnz @LoopY + mov esp,_esp + mov edi,_edi + mov esi,_esi + mov ebx,_ebx + end; + 15 : + asm + mov _ebx, ebx + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + @LoopY: + mov ax, Src.w + mov WorkX, ax // WorkX := Src.w + @Loopx: + mov ax, [esi] // AX := source color + cmp ax, 0 + je @SkipColor // if AX=0 then skip everything + mov esp, eax // ESP - source color + mov bx, [edi] // BX := destination color + mov dx, bx // DX := destination color + and ax, $001F // Adding BLUE + and bx, $001F + add ax, bx + cmp ax, $001F + jbe @Skip1 + mov ax, $001F + @Skip1: + mov cx, ax + mov eax, esp // Adding GREEN + mov bx, dx + and ax, $3E0 + and bx, $3E0 + add ax, bx + cmp ax, $3E0 + jbe @Skip2 + mov ax, $3E0 + @Skip2: + or cx, ax + mov eax, esp // Adding RED + mov bx, dx + and ax, $7C00 + and bx, $7C00 + add ax, bx + cmp ax, $7C00 + jbe @Skip3 + mov ax, $7C00 + @Skip3: + or cx, ax + mov [edi], cx + @SkipColor: + add esi, 2 + add edi, 2 + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + dec WorkY + jnz @LoopY + mov esp,_esp + mov edi,_edi + mov esi,_esi + mov ebx,_ebx + end; + 16 : + asm + mov _ebx, ebx + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + @LoopY: + mov ax, Src.w + mov WorkX, ax // WorkX := Src.w + @Loopx: + mov ax, [esi] // AX := source color + cmp ax, 0 + je @SkipColor // if AX=0 then skip everything + mov esp, eax // ESP - source color + mov bx, [edi] // BX := destination color + mov dx, bx // DX := destination color + and ax, $1F // Adding BLUE + and bx, $1F + add ax, bx + cmp ax, $1F + jbe @Skip1 + mov ax, $1F + @Skip1: + mov cx, ax + mov eax, esp // Adding GREEN + mov bx, dx + and ax, $7E0 + and bx, $7E0 + add ax, bx + cmp ax, $7E0 + jbe @Skip2 + mov ax, $7E0 + @Skip2: + or cx, ax + mov eax, esp // Adding RED + mov bx, dx + and eax, $F800 + and ebx, $F800 + add eax, ebx + cmp eax, $F800 + jbe @Skip3 + mov ax, $F800 + @Skip3: + or cx, ax + mov [edi], cx + @SkipColor: + add esi, 2 + add edi, 2 + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + dec WorkY + jnz @LoopY + mov esp,_esp + mov edi,_edi + mov esi,_esi + mov ebx,_ebx + end; + 24 : + asm + mov _ebx, ebx + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + @LoopY: + mov ax, Src.w + mov WorkX, ax // WorkX := Src.w + add WorkX, ax // WorkX := Src.w * 2 + add WorkX, ax // WorkX := Src.w * 3 + @Loopx: + mov bl, [edi] // BX := destination color + mov al, [esi] // AX := source color + cmp al, 0 + je @Skip // if AL=0 then skip COMPONENT + mov ah, 0 // AX := COLOR COMPONENT + mov bh, 0 + add bx, ax + cmp bx, $00ff + jb @Skip + mov bl, $ff + @Skip: + mov [edi], bl + inc esi + inc edi + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + dec WorkY + jnz @LoopY + mov esp,_esp + mov edi,_edi + mov esi,_esi + mov ebx,_ebx + end; + 32 : + asm + mov _ebx, ebx + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + @LoopY: + mov ax, Src.w + shl ax, 2 + mov WorkX, ax // WorkX := Src.w * 4 + @Loopx: + mov bl, [edi] // BX := destination color + mov al, [esi] // AX := source color + cmp al, 0 + je @Skip // if AL=0 then skip COMPONENT + mov ah, 0 // AX := COLOR COMPONENT + mov bh, 0 + add bx, ax + cmp bx, $00ff + jb @Skip + mov bl, $ff + @Skip: + mov [edi], bl + inc esi + inc edi + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + dec WorkY + jnz @LoopY + mov esp,_esp + mov edi,_edi + mov esi,_esi + mov ebx,_ebx + end; + end; + SDL_UnlockSurface( SrcSurface ); + SDL_UnlockSurface( DstSurface ); +end; + +procedure SDL_SubSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DstSurface : PSDL_Surface; DestRect : PSDL_Rect ); +var + Src, Dest : TSDL_Rect; + Diff : integer; + SrcAddr, DestAddr : cardinal; + _ebx, _esi, _edi, _esp : cardinal; + WorkX, WorkY : word; + SrcMod, DestMod : cardinal; + Bits : cardinal; +begin + if ( SrcSurface = nil ) or ( DstSurface = nil ) then + exit; // Remove this to make it faster + if ( SrcSurface.Format.BitsPerPixel <> DstSurface.Format.BitsPerPixel ) then + exit; // Remove this to make it faster + if SrcRect = nil then + begin + with Src do + begin + x := 0; + y := 0; + w := SrcSurface.w; + h := SrcSurface.h; + end; + end + else + Src := SrcRect^; + if DestRect = nil then + begin + Dest.x := 0; + Dest.y := 0; + end + else + Dest := DestRect^; + Dest.w := Src.w; + Dest.h := Src.h; + with DstSurface.Clip_Rect do + begin + // Source's right side is greater than the dest.cliprect + if Dest.x + Src.w > x + w then + begin + smallint( Src.w ) := x + w - Dest.x; + smallint( Dest.w ) := x + w - Dest.x; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's bottom side is greater than the dest.clip + if Dest.y + Src.h > y + h then + begin + smallint( Src.h ) := y + h - Dest.y; + smallint( Dest.h ) := y + h - Dest.y; + if smallint( Dest.h ) < 1 then + exit; + end; + // Source's left side is less than the dest.clip + if Dest.x < x then + begin + Diff := x - Dest.x; + Src.x := Src.x + Diff; + smallint( Src.w ) := smallint( Src.w ) - Diff; + Dest.x := x; + smallint( Dest.w ) := smallint( Dest.w ) - Diff; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's Top side is less than the dest.clip + if Dest.y < y then + begin + Diff := y - Dest.y; + Src.y := Src.y + Diff; + smallint( Src.h ) := smallint( Src.h ) - Diff; + Dest.y := y; + smallint( Dest.h ) := smallint( Dest.h ) - Diff; + if smallint( Dest.h ) < 1 then + exit; + end; + end; + with SrcSurface^ do + begin + SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) * + Format.BytesPerPixel; + SrcMod := Pitch - Src.w * Format.BytesPerPixel; + end; + with DstSurface^ do + begin + DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) * + Format.BytesPerPixel; + DestMod := Pitch - Dest.w * Format.BytesPerPixel; + Bits := DstSurface.Format.BitsPerPixel; + end; + SDL_LockSurface( SrcSurface ); + SDL_LockSurface( DstSurface ); + case bits of + 8 : + asm + mov _ebx, ebx + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + @LoopY: + mov ax, Src.w + mov WorkX, ax // WorkX := Src.w + @Loopx: + mov al, [esi] // AL := source color + cmp al, 0 + je @SkipColor // if AL=0 then skip everything + mov esp, eax // ESP - source color + mov bl, [edi] // BL := destination color + mov dl, bl // DL := destination color + and al, $03 // Subtract BLUE + and bl, $03 + sub bl, al + jns @Skip1 + mov bl, 0 + @Skip1: + mov cl, bl + mov eax, esp // Subtract GREEN + mov bl, dl + and al, $1c + and bl, $1c + sub bl, al + jns @Skip2 + mov bl, 0 + @Skip2: + or cl, bl + mov eax, esp // Subtract RED + mov bl, dl + and ax, $e0 + and bx, $e0 + sub bx, ax + jns @Skip3 + mov bl, 0 + @Skip3: + or cl, bl + mov [edi], cl + @SkipColor: + inc esi + inc edi + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + dec WorkY + jnz @LoopY + mov esp,_esp + mov edi,_edi + mov esi,_esi + mov ebx,_ebx + end; + 15 : + asm + mov _ebx, ebx + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + @LoopY: + mov ax, Src.w + mov WorkX, ax // WorkX := Src.w + @Loopx: + mov ax, [esi] // AX := source color + cmp ax, 0 + je @SkipColor // if AX=0 then skip everything + mov esp, eax // ESP - source color + mov bx, [edi] // BX := destination color + mov dx, bx // DX := destination color + and ax, $001F // Subtract BLUE + and bx, $001F + sub bx, ax + jns @Skip1 + mov bx, 0 + @Skip1: + mov cx, bx + mov eax, esp // Subtract GREEN + mov bx, dx + and ax, $3E0 + and bx, $3E0 + sub bx, ax + jns @Skip2 + mov bx, 0 + @Skip2: + or cx, bx + mov eax, esp // Subtract RED + mov bx, dx + and ax, $7C00 + and bx, $7C00 + sub bx, ax + jns @Skip3 + mov bx, 0 + @Skip3: + or cx, bx + mov [edi], cx + @SkipColor: + add esi, 2 + add edi, 2 + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + dec WorkY + jnz @LoopY + mov esp,_esp + mov edi,_edi + mov esi,_esi + mov ebx,_ebx + end; + 16 : + asm + mov _ebx, ebx + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + @LoopY: + mov ax, Src.w + mov WorkX, ax // WorkX := Src.w + @Loopx: + mov ax, [esi] // AX := source color + cmp ax, 0 + je @SkipColor // if AX=0 then skip everything + mov esp, eax // ESP - source color + mov bx, [edi] // BX := destination color + mov dx, bx // DX := destination color + and ax, $1F // Subtracting BLUE + and bx, $1F + sub bx, ax + jns @Skip1 + mov bx, 0 + @Skip1: + mov cx, bx + mov eax, esp // Adding GREEN + mov bx, dx + and ax, $7E0 + and bx, $7E0 + sub bx, ax + jns @Skip2 + mov bx, 0 + @Skip2: + or cx, bx + mov eax, esp // Adding RED + mov bx, dx + and eax, $F800 + and ebx, $F800 + sub ebx, eax + jns @Skip3 + mov bx, 0 + @Skip3: + or cx, bx + mov [edi], cx + @SkipColor: + add esi, 2 + add edi, 2 + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + dec WorkY + jnz @LoopY + mov esp,_esp + mov edi,_edi + mov esi,_esi + mov ebx,_ebx + end; + 24 : + asm + mov _ebx, ebx + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + @LoopY: + mov ax, Src.w + mov WorkX, ax // WorkX := Src.w + add WorkX, ax // WorkX := Src.w * 2 + add WorkX, ax // WorkX := Src.w * 3 + @Loopx: + mov bl, [edi] // BX := destination color + mov al, [esi] // AX := source color + cmp al, 0 + je @Skip // if AL=0 then skip COMPONENT + mov ah, 0 // AX := COLOR COMPONENT + mov bh, 0 + sub bx, ax + jns @Skip + mov bl, 0 + @Skip: + mov [edi], bl + inc esi + inc edi + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + dec WorkY + jnz @LoopY + mov esp,_esp + mov edi,_edi + mov esi,_esi + mov ebx,_ebx + end; + 32 : + asm + mov _ebx, ebx + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + @LoopY: + mov ax, Src.w + shl ax, 2 + mov WorkX, ax // WorkX := Src.w * 4 + @Loopx: + mov bl, [edi] // BX := destination color + mov al, [esi] // AX := source color + cmp al, 0 + je @Skip // if AL=0 then skip COMPONENT + mov ah, 0 // AX := COLOR COMPONENT + mov bh, 0 + sub bx, ax + jns @Skip + mov bl, 0 + @Skip: + mov [edi], bl + inc esi + inc edi + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + dec WorkY + jnz @LoopY + mov esp,_esp + mov edi,_edi + mov esi,_esi + mov ebx,_ebx + end; + end; + SDL_UnlockSurface( SrcSurface ); + SDL_UnlockSurface( DstSurface ); +end; + +procedure SDL_MonoSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DstSurface : PSDL_Surface; DestRect : PSDL_Rect; Color : cardinal ); +var + Src, Dest : TSDL_Rect; + Diff : integer; + SrcAddr, DestAddr : cardinal; + _ebx, _esi, _edi, _esp : cardinal; + WorkX, WorkY : word; + SrcMod, DestMod : cardinal; + SrcTransparentColor : cardinal; + Bits : cardinal; +begin + if ( SrcSurface = nil ) or ( DstSurface = nil ) then + exit; // Remove this to make it faster + if ( SrcSurface.Format.BitsPerPixel <> DstSurface.Format.BitsPerPixel ) then + exit; // Remove this to make it faster + if SrcRect = nil then + begin + with Src do + begin + x := 0; + y := 0; + w := SrcSurface.w; + h := SrcSurface.h; + end; + end + else + Src := SrcRect^; + if DestRect = nil then + begin + Dest.x := 0; + Dest.y := 0; + end + else + Dest := DestRect^; + Dest.w := Src.w; + Dest.h := Src.h; + with DstSurface.Clip_Rect do + begin + // Source's right side is greater than the dest.cliprect + if Dest.x + Src.w > x + w then + begin + smallint( Src.w ) := x + w - Dest.x; + smallint( Dest.w ) := x + w - Dest.x; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's bottom side is greater than the dest.clip + if Dest.y + Src.h > y + h then + begin + smallint( Src.h ) := y + h - Dest.y; + smallint( Dest.h ) := y + h - Dest.y; + if smallint( Dest.h ) < 1 then + exit; + end; + // Source's left side is less than the dest.clip + if Dest.x < x then + begin + Diff := x - Dest.x; + Src.x := Src.x + Diff; + smallint( Src.w ) := smallint( Src.w ) - Diff; + Dest.x := x; + smallint( Dest.w ) := smallint( Dest.w ) - Diff; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's Top side is less than the dest.clip + if Dest.y < y then + begin + Diff := y - Dest.y; + Src.y := Src.y + Diff; + smallint( Src.h ) := smallint( Src.h ) - Diff; + Dest.y := y; + smallint( Dest.h ) := smallint( Dest.h ) - Diff; + if smallint( Dest.h ) < 1 then + exit; + end; + end; + with SrcSurface^ do + begin + SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) * + Format.BytesPerPixel; + SrcMod := Pitch - Src.w * Format.BytesPerPixel; + SrcTransparentColor := format.colorkey; + end; + with DstSurface^ do + begin + DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) * + Format.BytesPerPixel; + DestMod := Pitch - Dest.w * Format.BytesPerPixel; + Bits := DstSurface.Format.BitsPerPixel; + end; + SDL_LockSurface( SrcSurface ); + SDL_LockSurface( DstSurface ); + case bits of + 8 : + asm + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + mov ecx, Color + @LoopY: + mov ax, Src.w + mov WorkX, ax // WorkX := Src.w + @Loopx: + mov al, [esi] // AL := source color + movzx eax, al + cmp eax, SrcTransparentColor + je @SkipColor // if AL=Transparent color then skip everything + mov [edi], cl + @SkipColor: + inc esi + inc edi + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + dec WorkY + jnz @LoopY + mov esp,_esp + mov edi,_edi + mov esi,_esi + end; + 15, 16 : + asm + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + mov ecx, Color + @LoopY: + mov ax, Src.w + mov WorkX, ax // WorkX := Src.w + @Loopx: + mov ax, [esi] // AX := source color + movzx eax, ax + cmp eax, SrcTransparentColor + je @SkipColor // if AX=Transparent color then skip everything + mov [edi], cx + @SkipColor: + inc esi + inc esi + inc edi + inc edi + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + dec WorkY + jnz @LoopY + mov esp,_esp + mov edi,_edi + mov esi,_esi + end; + 24 : + asm + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov _ebx, ebx + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + mov ecx, Color + and ecx, $00ffffff + @LoopY: + mov ax, Src.w + mov WorkX, ax // WorkX := Src.w + @Loopx: + mov eax, [esi] // EAX := source color + and eax, $00ffffff + cmp eax, SrcTransparentColor + je @SkipColor // if EAX=Transparent color then skip everything + mov ebx, [edi] + and ebx, $ff000000 + or ebx, ecx + mov [edi], ecx + @SkipColor: + add esi, 3 + add edi, 3 + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + dec WorkY + jnz @LoopY + mov esp, _esp + mov edi, _edi + mov esi, _esi + mov ebx, _ebx + end; + 32 : + asm + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + mov ecx, Color + @LoopY: + mov ax, Src.w + mov WorkX, ax // WorkX := Src.w + @Loopx: + mov eax, [esi] // EAX := source color + cmp eax, SrcTransparentColor + je @SkipColor // if EAX=Transparent color then skip everything + mov [edi], ecx + @SkipColor: + add esi, 4 + add edi, 4 + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + dec WorkY + jnz @LoopY + mov esp, _esp + mov edi, _edi + mov esi, _esi + end; + end; + SDL_UnlockSurface( SrcSurface ); + SDL_UnlockSurface( DstSurface ); +end; +// TextureRect.w and TextureRect.h are not used. +// The TextureSurface's size MUST larger than the drawing rectangle!!! + +procedure SDL_TexturedSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DstSurface : PSDL_Surface; DestRect : PSDL_Rect; Texture : PSDL_Surface; + TextureRect : PSDL_Rect ); +var + Src, Dest : TSDL_Rect; + Diff : integer; + SrcAddr, DestAddr, TextAddr : cardinal; + _ebx, _esi, _edi, _esp : cardinal; + WorkX, WorkY : word; + SrcMod, DestMod, TextMod : cardinal; + SrcTransparentColor : cardinal; + Bits : cardinal; +begin + if ( SrcSurface = nil ) or ( DstSurface = nil ) then + exit; // Remove this to make it faster + if ( SrcSurface.Format.BitsPerPixel <> DstSurface.Format.BitsPerPixel ) then + exit; // Remove this to make it faster + if SrcRect = nil then + begin + with Src do + begin + x := 0; + y := 0; + w := SrcSurface.w; + h := SrcSurface.h; + end; + end + else + Src := SrcRect^; + if DestRect = nil then + begin + Dest.x := 0; + Dest.y := 0; + end + else + Dest := DestRect^; + Dest.w := Src.w; + Dest.h := Src.h; + with DstSurface.Clip_Rect do + begin + // Source's right side is greater than the dest.cliprect + if Dest.x + Src.w > x + w then + begin + smallint( Src.w ) := x + w - Dest.x; + smallint( Dest.w ) := x + w - Dest.x; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's bottom side is greater than the dest.clip + if Dest.y + Src.h > y + h then + begin + smallint( Src.h ) := y + h - Dest.y; + smallint( Dest.h ) := y + h - Dest.y; + if smallint( Dest.h ) < 1 then + exit; + end; + // Source's left side is less than the dest.clip + if Dest.x < x then + begin + Diff := x - Dest.x; + Src.x := Src.x + Diff; + smallint( Src.w ) := smallint( Src.w ) - Diff; + Dest.x := x; + smallint( Dest.w ) := smallint( Dest.w ) - Diff; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's Top side is less than the dest.clip + if Dest.y < y then + begin + Diff := y - Dest.y; + Src.y := Src.y + Diff; + smallint( Src.h ) := smallint( Src.h ) - Diff; + Dest.y := y; + smallint( Dest.h ) := smallint( Dest.h ) - Diff; + if smallint( Dest.h ) < 1 then + exit; + end; + end; + with SrcSurface^ do + begin + SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) * + Format.BytesPerPixel; + SrcMod := Pitch - Src.w * Format.BytesPerPixel; + SrcTransparentColor := format.colorkey; + end; + with DstSurface^ do + begin + DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) * + Format.BytesPerPixel; + DestMod := Pitch - Dest.w * Format.BytesPerPixel; + Bits := DstSurface.Format.BitsPerPixel; + end; + with Texture^ do + begin + TextAddr := cardinal( Pixels ) + UInt32( TextureRect.y ) * Pitch + + UInt32( TextureRect.x ) * Format.BytesPerPixel; + TextMod := Pitch - Src.w * Format.BytesPerPixel; + end; + SDL_LockSurface( SrcSurface ); + SDL_LockSurface( DstSurface ); + SDL_LockSurface( Texture ); + case bits of + 8 : + asm + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov _ebx, ebx + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ebx, TextAddr + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + @LoopY: + mov ax, Src.w + mov WorkX, ax // WorkX := Src.w + @Loopx: + mov al, [esi] // AL := source color + movzx eax, al + cmp eax, SrcTransparentColor + je @SkipColor // if AL=Transparent color then skip everything + mov al, [ebx] + mov [edi], al + @SkipColor: + inc esi + inc edi + inc ebx + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + add ebx, TextMod + dec WorkY + jnz @LoopY + mov esp,_esp + mov edi,_edi + mov esi,_esi + mov ebx, _ebx + end; + 15, 16 : + asm + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ecx, TextAddr + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + @LoopY: + mov ax, Src.w + mov WorkX, ax // WorkX := Src.w + @Loopx: + mov ax, [esi] // AL := source color + movzx eax, ax + cmp eax, SrcTransparentColor + je @SkipColor // if AL=Transparent color then skip everything + mov ax, [ecx] + mov [edi], ax + @SkipColor: + inc esi + inc esi + inc edi + inc edi + inc ecx + inc ecx + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + add ecx, TextMod + dec WorkY + jnz @LoopY + mov esp,_esp + mov edi,_edi + mov esi,_esi + end; + 24 : + asm + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov _ebx, ebx + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ebx, TextAddr + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + @LoopY: + mov ax, Src.w + mov WorkX, ax // WorkX := Src.w + @Loopx: + mov eax, [esi] // AL := source color + and eax, $00ffffff + cmp eax, SrcTransparentColor + je @SkipColor // if AL=Transparent color then skip everything + mov eax, [ebx] + and eax, $00ffffff + mov ecx, [edi] + and ecx, $ff000000 + or ecx, eax + mov [edi], eax + @SkipColor: + add esi, 3 + add edi, 3 + add ebx, 3 + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + add ebx, TextMod + dec WorkY + jnz @LoopY + mov esp,_esp + mov edi,_edi + mov esi,_esi + mov ebx, _ebx + end; + 32 : + asm + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ecx, TextAddr + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + @LoopY: + mov ax, Src.w + mov WorkX, ax // WorkX := Src.w + @Loopx: + mov eax, [esi] // AL := source color + cmp eax, SrcTransparentColor + je @SkipColor // if AL=Transparent color then skip everything + mov eax, [ecx] + mov [edi], eax + @SkipColor: + add esi, 4 + add edi, 4 + add ecx, 4 + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + add ecx, TextMod + dec WorkY + jnz @LoopY + mov esp,_esp + mov edi,_edi + mov esi,_esi + end; + end; + SDL_UnlockSurface( SrcSurface ); + SDL_UnlockSurface( DstSurface ); + SDL_UnlockSurface( Texture ); +end; + +procedure SDL_ZoomSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; DstRect : PSDL_Rect ); +var + xc, yc : cardinal; + rx, wx, ry, wy, ry16 : cardinal; + color : cardinal; + modx, mody : cardinal; +begin + // Warning! No checks for surface pointers!!! + if srcrect = nil then + srcrect := @SrcSurface.clip_rect; + if dstrect = nil then + dstrect := @DstSurface.clip_rect; + if SDL_MustLock( SrcSurface ) then + SDL_LockSurface( SrcSurface ); + if SDL_MustLock( DstSurface ) then + SDL_LockSurface( DstSurface ); + modx := trunc( ( srcrect.w / dstrect.w ) * 65536 ); + mody := trunc( ( srcrect.h / dstrect.h ) * 65536 ); + //rx := srcrect.x * 65536; + ry := srcrect.y * 65536; + wy := dstrect.y; + for yc := 0 to dstrect.h - 1 do + begin + rx := srcrect.x * 65536; + wx := dstrect.x; + ry16 := ry shr 16; + for xc := 0 to dstrect.w - 1 do + begin + color := SDL_GetPixel( SrcSurface, rx shr 16, ry16 ); + SDL_PutPixel( DstSurface, wx, wy, color ); + rx := rx + modx; + inc( wx ); + end; + ry := ry + mody; + inc( wy ); + end; + if SDL_MustLock( SrcSurface ) then + SDL_UnlockSurface( SrcSurface ); + if SDL_MustLock( DstSurface ) then + SDL_UnlockSurface( DstSurface ); +end; +// Re-map a rectangular area into an area defined by four vertices +// Converted from C to Pascal by KiCHY + +procedure SDL_WarpSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; UL, UR, LR, LL : PPoint ); +const + SHIFTS = 15; // Extend ints to limit round-off error (try 2 - 20) + THRESH = 1 shl SHIFTS; // Threshold for pixel size value + procedure CopySourceToDest( UL, UR, LR, LL : TPoint; x1, y1, x2, y2 : cardinal ); + var + tm, lm, rm, bm, m : TPoint; + mx, my : cardinal; + cr : cardinal; + begin + // Does the destination area specify a single pixel? + if ( ( abs( ul.x - ur.x ) < THRESH ) and + ( abs( ul.x - lr.x ) < THRESH ) and + ( abs( ul.x - ll.x ) < THRESH ) and + ( abs( ul.y - ur.y ) < THRESH ) and + ( abs( ul.y - lr.y ) < THRESH ) and + ( abs( ul.y - ll.y ) < THRESH ) ) then + begin // Yes + cr := SDL_GetPixel( SrcSurface, ( x1 shr SHIFTS ), ( y1 shr SHIFTS ) ); + SDL_PutPixel( DstSurface, ( ul.x shr SHIFTS ), ( ul.y shr SHIFTS ), cr ); + end + else + begin // No + // Quarter the source and the destination, and then recurse + tm.x := ( ul.x + ur.x ) shr 1; + tm.y := ( ul.y + ur.y ) shr 1; + bm.x := ( ll.x + lr.x ) shr 1; + bm.y := ( ll.y + lr.y ) shr 1; + lm.x := ( ul.x + ll.x ) shr 1; + lm.y := ( ul.y + ll.y ) shr 1; + rm.x := ( ur.x + lr.x ) shr 1; + rm.y := ( ur.y + lr.y ) shr 1; + m.x := ( tm.x + bm.x ) shr 1; + m.y := ( tm.y + bm.y ) shr 1; + mx := ( x1 + x2 ) shr 1; + my := ( y1 + y2 ) shr 1; + CopySourceToDest( ul, tm, m, lm, x1, y1, mx, my ); + CopySourceToDest( tm, ur, rm, m, mx, y1, x2, my ); + CopySourceToDest( m, rm, lr, bm, mx, my, x2, y2 ); + CopySourceToDest( lm, m, bm, ll, x1, my, mx, y2 ); + end; + end; +var + _UL, _UR, _LR, _LL : TPoint; + Rect_x, Rect_y, Rect_w, Rect_h : integer; +begin + if SDL_MustLock( SrcSurface ) then + SDL_LockSurface( SrcSurface ); + if SDL_MustLock( DstSurface ) then + SDL_LockSurface( DstSurface ); + if SrcRect = nil then + begin + Rect_x := 0; + Rect_y := 0; + Rect_w := ( SrcSurface.w - 1 ) shl SHIFTS; + Rect_h := ( SrcSurface.h - 1 ) shl SHIFTS; + end + else + begin + Rect_x := SrcRect.x; + Rect_y := SrcRect.y; + Rect_w := ( SrcRect.w - 1 ) shl SHIFTS; + Rect_h := ( SrcRect.h - 1 ) shl SHIFTS; + end; + // Shift all values to help reduce round-off error. + _ul.x := ul.x shl SHIFTS; + _ul.y := ul.y shl SHIFTS; + _ur.x := ur.x shl SHIFTS; + _ur.y := ur.y shl SHIFTS; + _lr.x := lr.x shl SHIFTS; + _lr.y := lr.y shl SHIFTS; + _ll.x := ll.x shl SHIFTS; + _ll.y := ll.y shl SHIFTS; + CopySourceToDest( _ul, _ur, _lr, _ll, Rect_x, Rect_y, Rect_w, Rect_h ); + if SDL_MustLock( SrcSurface ) then + SDL_UnlockSurface( SrcSurface ); + if SDL_MustLock( DstSurface ) then + SDL_UnlockSurface( DstSurface ); +end; + +// flips a rectangle vertically on given surface +procedure SDL_FlipRectV( DstSurface : PSDL_Surface; Rect : PSDL_Rect ); +var + TmpRect : TSDL_Rect; + Locked : boolean; + y, FlipLength, RowLength : integer; + Row1, Row2 : Pointer; + OneRow : TByteArray; // Optimize it if you wish +begin + if DstSurface <> nil then + begin + if Rect = nil then + begin // if Rect=nil then we flip the whole surface + TmpRect := SDLRect( 0, 0, DstSurface.w, DstSurface.h ); + Rect := @TmpRect; + end; + FlipLength := Rect^.h shr 1 - 1; + RowLength := Rect^.w * DstSurface^.format.BytesPerPixel; + if SDL_MustLock( DstSurface ) then + begin + Locked := true; + SDL_LockSurface( DstSurface ); + end + else + Locked := false; + Row1 := pointer( cardinal( DstSurface^.Pixels ) + UInt32( Rect^.y ) * + DstSurface^.Pitch ); + Row2 := pointer( cardinal( DstSurface^.Pixels ) + ( UInt32( Rect^.y ) + Rect^.h - 1 ) + * DstSurface^.Pitch ); + for y := 0 to FlipLength do + begin + Move( Row1^, OneRow, RowLength ); + Move( Row2^, Row1^, RowLength ); + Move( OneRow, Row2^, RowLength ); + inc( cardinal( Row1 ), DstSurface^.Pitch ); + dec( cardinal( Row2 ), DstSurface^.Pitch ); + end; + if Locked then + SDL_UnlockSurface( DstSurface ); + end; +end; + +// flips a rectangle horizontally on given surface +procedure SDL_FlipRectH( DstSurface : PSDL_Surface; Rect : PSDL_Rect ); +type + T24bit = packed array[ 0..2 ] of byte; + T24bitArray = packed array[ 0..8191 ] of T24bit; + P24bitArray = ^T24bitArray; + TLongWordArray = array[ 0..8191 ] of LongWord; + PLongWordArray = ^TLongWordArray; +var + TmpRect : TSDL_Rect; + Row8bit : PByteArray; + Row16bit : PWordArray; + Row24bit : P24bitArray; + Row32bit : PLongWordArray; + y, x, RightSide, FlipLength : integer; + Pixel : cardinal; + Pixel24 : T24bit; + Locked : boolean; +begin + if DstSurface <> nil then + begin + if Rect = nil then + begin + TmpRect := SDLRect( 0, 0, DstSurface.w, DstSurface.h ); + Rect := @TmpRect; + end; + FlipLength := Rect^.w shr 1 - 1; + if SDL_MustLock( DstSurface ) then + begin + Locked := true; + SDL_LockSurface( DstSurface ); + end + else + Locked := false; + case DstSurface^.format.BytesPerPixel of + 1 : + begin + Row8Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) * + DstSurface^.pitch ); + for y := 1 to Rect^.h do + begin + RightSide := Rect^.w - 1; + for x := 0 to FlipLength do + begin + Pixel := Row8Bit^[ x ]; + Row8Bit^[ x ] := Row8Bit^[ RightSide ]; + Row8Bit^[ RightSide ] := Pixel; + dec( RightSide ); + end; + inc( cardinal( Row8Bit ), DstSurface^.pitch ); + end; + end; + 2 : + begin + Row16Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) * + DstSurface^.pitch ); + for y := 1 to Rect^.h do + begin + RightSide := Rect^.w - 1; + for x := 0 to FlipLength do + begin + Pixel := Row16Bit^[ x ]; + Row16Bit^[ x ] := Row16Bit^[ RightSide ]; + Row16Bit^[ RightSide ] := Pixel; + dec( RightSide ); + end; + inc( cardinal( Row16Bit ), DstSurface^.pitch ); + end; + end; + 3 : + begin + Row24Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) * + DstSurface^.pitch ); + for y := 1 to Rect^.h do + begin + RightSide := Rect^.w - 1; + for x := 0 to FlipLength do + begin + Pixel24 := Row24Bit^[ x ]; + Row24Bit^[ x ] := Row24Bit^[ RightSide ]; + Row24Bit^[ RightSide ] := Pixel24; + dec( RightSide ); + end; + inc( cardinal( Row24Bit ), DstSurface^.pitch ); + end; + end; + 4 : + begin + Row32Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) * + DstSurface^.pitch ); + for y := 1 to Rect^.h do + begin + RightSide := Rect^.w - 1; + for x := 0 to FlipLength do + begin + Pixel := Row32Bit^[ x ]; + Row32Bit^[ x ] := Row32Bit^[ RightSide ]; + Row32Bit^[ RightSide ] := Pixel; + dec( RightSide ); + end; + inc( cardinal( Row32Bit ), DstSurface^.pitch ); + end; + end; + end; + if Locked then + SDL_UnlockSurface( DstSurface ); + end; +end; + +// Use with caution! The procedure allocates memory for TSDL_Rect and return with its pointer. +// But you MUST free it after you don't need it anymore!!! +function PSDLRect( aLeft, aTop, aWidth, aHeight : integer ) : PSDL_Rect; +var + Rect : PSDL_Rect; +begin + New( Rect ); + with Rect^ do + begin + x := aLeft; + y := aTop; + w := aWidth; + h := aHeight; + end; + Result := Rect; +end; + +function SDLRect( aLeft, aTop, aWidth, aHeight : integer ) : TSDL_Rect; +begin + with result do + begin + x := aLeft; + y := aTop; + w := aWidth; + h := aHeight; + end; +end; + +function SDLRect( aRect : TRect ) : TSDL_Rect; +begin + with aRect do + result := SDLRect( Left, Top, Right - Left, Bottom - Top ); +end; + +procedure SDL_Stretch8( Surface, Dst_Surface : PSDL_Surface; x1, x2, y1, y2, yr, yw, + depth : integer ); +var + dx, dy, e, d, dx2 : integer; + src_pitch, dst_pitch : uint16; + src_pixels, dst_pixels : PUint8; +begin + if ( yw >= dst_surface^.h ) then + exit; + dx := ( x2 - x1 ); + dy := ( y2 - y1 ); + dy := dy shl 1; + e := dy - dx; + dx2 := dx shl 1; + src_pitch := Surface^.pitch; + dst_pitch := dst_surface^.pitch; + src_pixels := PUint8( integer( Surface^.pixels ) + yr * src_pitch + y1 * depth ); + dst_pixels := PUint8( integer( dst_surface^.pixels ) + yw * dst_pitch + x1 * + depth ); + for d := 0 to dx - 1 do + begin + move( src_pixels^, dst_pixels^, depth ); + while ( e >= 0 ) do + begin + inc( src_pixels, depth ); + e := e - dx2; + end; + inc( dst_pixels, depth ); + e := e + dy; + end; +end; + +function sign( x : integer ) : integer; +begin + if x > 0 then + result := 1 + else + result := -1; +end; + +// Stretches a part of a surface +function SDL_ScaleSurfaceRect( SrcSurface : PSDL_Surface; SrcX1, SrcY1, SrcW, SrcH, + Width, Height : integer ) : PSDL_Surface; +var + dst_surface : PSDL_Surface; + dx, dy, e, d, dx2, srcx2, srcy2 : integer; + destx1, desty1 : integer; +begin + srcx2 := srcx1 + SrcW; + srcy2 := srcy1 + SrcH; + result := nil; + destx1 := 0; + desty1 := 0; + dx := abs( integer( Height - desty1 ) ); + dy := abs( integer( SrcY2 - SrcY1 ) ); + e := ( dy shl 1 ) - dx; + dx2 := dx shl 1; + dy := dy shl 1; + dst_surface := SDL_CreateRGBSurface( SDL_HWPALETTE, width - destx1, Height - + desty1, + SrcSurface^.Format^.BitsPerPixel, + SrcSurface^.Format^.RMask, + SrcSurface^.Format^.GMask, + SrcSurface^.Format^.BMask, + SrcSurface^.Format^.AMask ); + if ( dst_surface^.format^.BytesPerPixel = 1 ) then + SDL_SetColors( dst_surface, @SrcSurface^.format^.palette^.colors^[ 0 ], 0, 256 ); + SDL_SetColorKey( dst_surface, sdl_srccolorkey, SrcSurface^.format^.colorkey ); + if ( SDL_MustLock( dst_surface ) ) then + if ( SDL_LockSurface( dst_surface ) < 0 ) then + exit; + for d := 0 to dx - 1 do + begin + SDL_Stretch8( SrcSurface, dst_surface, destx1, Width, SrcX1, SrcX2, SrcY1, desty1, + SrcSurface^.format^.BytesPerPixel ); + while e >= 0 do + begin + inc( SrcY1 ); + e := e - dx2; + end; + inc( desty1 ); + e := e + dy; + end; + if SDL_MUSTLOCK( dst_surface ) then + SDL_UnlockSurface( dst_surface ); + result := dst_surface; +end; + +procedure SDL_ScrollY( DstSurface : PSDL_Surface; DifY : integer ); +var + r1, r2 : TSDL_Rect; + //buffer: PSDL_Surface; + YPos : Integer; +begin + if ( DstSurface <> nil ) and ( DifY <> 0 ) then + begin + //if DifY > 0 then // going up + //begin + ypos := 0; + r1.x := 0; + r2.x := 0; + r1.w := DstSurface.w; + r2.w := DstSurface.w; + r1.h := DifY; + r2.h := DifY; + while ypos < DstSurface.h do + begin + r1.y := ypos; + r2.y := ypos + DifY; + SDL_BlitSurface( DstSurface, @r2, DstSurface, @r1 ); + ypos := ypos + DifY; + end; + //end + //else + //begin // Going Down + //end; + end; +end; + +procedure SDL_ScrollX( DstSurface : PSDL_Surface; DifX : integer ); +var + r1, r2 : TSDL_Rect; + buffer : PSDL_Surface; +begin + if ( DstSurface <> nil ) and ( DifX <> 0 ) then + begin + buffer := SDL_CreateRGBSurface( SDL_HWSURFACE, ( DstSurface^.w - DifX ) * 2, + DstSurface^.h * 2, + DstSurface^.Format^.BitsPerPixel, + DstSurface^.Format^.RMask, + DstSurface^.Format^.GMask, + DstSurface^.Format^.BMask, + DstSurface^.Format^.AMask ); + if buffer <> nil then + begin + if ( buffer^.format^.BytesPerPixel = 1 ) then + SDL_SetColors( buffer, @DstSurface^.format^.palette^.colors^[ 0 ], 0, 256 ); + r1 := SDLRect( DifX, 0, buffer^.w, buffer^.h ); + r2 := SDLRect( 0, 0, buffer^.w, buffer^.h ); + SDL_BlitSurface( DstSurface, @r1, buffer, @r2 ); + SDL_BlitSurface( buffer, @r2, DstSurface, @r2 ); + SDL_FreeSurface( buffer ); + end; + end; +end; + +procedure SDL_RotateRad( DstSurface, SrcSurface : PSDL_Surface; SrcRect : + PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Single ); +var + aSin, aCos : Single; + MX, MY, DX, DY, NX, NY, SX, SY, OX, OY, Width, Height, TX, TY, RX, RY, ROX, ROY : Integer; + Colour, TempTransparentColour : UInt32; + MAXX, MAXY : Integer; +begin + // Rotate the surface to the target surface. + TempTransparentColour := SrcSurface.format.colorkey; + if srcRect.w > srcRect.h then + begin + Width := srcRect.w; + Height := srcRect.w; + end + else + begin + Width := srcRect.h; + Height := srcRect.h; + end; + + maxx := DstSurface.w; + maxy := DstSurface.h; + aCos := cos( Angle ); + aSin := sin( Angle ); + + Width := round( abs( srcrect.h * acos ) + abs( srcrect.w * asin ) ); + Height := round( abs( srcrect.h * asin ) + abs( srcrect.w * acos ) ); + + OX := Width div 2; + OY := Height div 2; ; + MX := ( srcRect.x + ( srcRect.x + srcRect.w ) ) div 2; + MY := ( srcRect.y + ( srcRect.y + srcRect.h ) ) div 2; + ROX := ( -( srcRect.w div 2 ) ) + Offsetx; + ROY := ( -( srcRect.h div 2 ) ) + OffsetY; + Tx := ox + round( ROX * aSin - ROY * aCos ); + Ty := oy + round( ROY * aSin + ROX * aCos ); + SX := 0; + for DX := DestX - TX to DestX - TX + ( width ) do + begin + Inc( SX ); + SY := 0; + for DY := DestY - TY to DestY - TY + ( Height ) do + begin + RX := SX - OX; + RY := SY - OY; + NX := round( mx + RX * aSin + RY * aCos ); // + NY := round( my + RY * aSin - RX * aCos ); // + // Used for testing only + //SDL_PutPixel(DstSurface.SDLSurfacePointer,DX,DY,0); + if ( ( DX > 0 ) and ( DX < MAXX ) ) and ( ( DY > 0 ) and ( DY < MAXY ) ) then + begin + if ( NX >= srcRect.x ) and ( NX <= srcRect.x + srcRect.w ) then + begin + if ( NY >= srcRect.y ) and ( NY <= srcRect.y + srcRect.h ) then + begin + Colour := SDL_GetPixel( SrcSurface, NX, NY ); + if Colour <> TempTransparentColour then + begin + SDL_PutPixel( DstSurface, DX, DY, Colour ); + end; + end; + end; + end; + inc( SY ); + end; + end; +end; + +procedure SDL_RotateDeg( DstSurface, SrcSurface : PSDL_Surface; SrcRect : + PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Integer ); +begin + SDL_RotateRad( DstSurface, SrcSurface, SrcRect, DestX, DestY, OffsetX, OffsetY, DegToRad( Angle ) ); +end; + +function ValidateSurfaceRect( DstSurface : PSDL_Surface; dstrect : PSDL_Rect ) : TSDL_Rect; +var + RealRect : TSDL_Rect; + OutOfRange : Boolean; +begin + OutOfRange := false; + if dstrect = nil then + begin + RealRect.x := 0; + RealRect.y := 0; + RealRect.w := DstSurface.w; + RealRect.h := DstSurface.h; + end + else + begin + if dstrect.x < DstSurface.w then + begin + RealRect.x := dstrect.x; + end + else if dstrect.x < 0 then + begin + realrect.x := 0; + end + else + begin + OutOfRange := True; + end; + if dstrect.y < DstSurface.h then + begin + RealRect.y := dstrect.y; + end + else if dstrect.y < 0 then + begin + realrect.y := 0; + end + else + begin + OutOfRange := True; + end; + if OutOfRange = False then + begin + if realrect.x + dstrect.w <= DstSurface.w then + begin + RealRect.w := dstrect.w; + end + else + begin + RealRect.w := dstrect.w - realrect.x; + end; + if realrect.y + dstrect.h <= DstSurface.h then + begin + RealRect.h := dstrect.h; + end + else + begin + RealRect.h := dstrect.h - realrect.y; + end; + end; + end; + if OutOfRange = False then + begin + result := realrect; + end + else + begin + realrect.w := 0; + realrect.h := 0; + realrect.x := 0; + realrect.y := 0; + result := realrect; + end; +end; + +procedure SDL_FillRectAdd( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 ); +var + RealRect : TSDL_Rect; + Addr : pointer; + ModX, BPP : cardinal; + x, y, R, G, B, SrcColor : cardinal; +begin + RealRect := ValidateSurfaceRect( DstSurface, DstRect ); + if ( RealRect.w > 0 ) and ( RealRect.h > 0 ) then + begin + SDL_LockSurface( DstSurface ); + BPP := DstSurface.format.BytesPerPixel; + with DstSurface^ do + begin + Addr := pointer( UInt32( pixels ) + UInt32( RealRect.y ) * pitch + UInt32( RealRect.x ) * BPP ); + ModX := Pitch - UInt32( RealRect.w ) * BPP; + end; + case DstSurface.format.BitsPerPixel of + 8 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $E0 + Color and $E0; + G := SrcColor and $1C + Color and $1C; + B := SrcColor and $03 + Color and $03; + if R > $E0 then + R := $E0; + if G > $1C then + G := $1C; + if B > $03 then + B := $03; + PUInt8( Addr )^ := R or G or B; + inc( UInt32( Addr ), BPP ); + end; + inc( UInt32( Addr ), ModX ); + end; + end; + 15 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $7C00 + Color and $7C00; + G := SrcColor and $03E0 + Color and $03E0; + B := SrcColor and $001F + Color and $001F; + if R > $7C00 then + R := $7C00; + if G > $03E0 then + G := $03E0; + if B > $001F then + B := $001F; + PUInt16( Addr )^ := R or G or B; + inc( UInt32( Addr ), BPP ); + end; + inc( UInt32( Addr ), ModX ); + end; + end; + 16 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $F800 + Color and $F800; + G := SrcColor and $07C0 + Color and $07C0; + B := SrcColor and $001F + Color and $001F; + if R > $F800 then + R := $F800; + if G > $07C0 then + G := $07C0; + if B > $001F then + B := $001F; + PUInt16( Addr )^ := R or G or B; + inc( UInt32( Addr ), BPP ); + end; + inc( UInt32( Addr ), ModX ); + end; + end; + 24 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $00FF0000 + Color and $00FF0000; + G := SrcColor and $0000FF00 + Color and $0000FF00; + B := SrcColor and $000000FF + Color and $000000FF; + if R > $FF0000 then + R := $FF0000; + if G > $00FF00 then + G := $00FF00; + if B > $0000FF then + B := $0000FF; + PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B; + inc( UInt32( Addr ), BPP ); + end; + inc( UInt32( Addr ), ModX ); + end; + end; + 32 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $00FF0000 + Color and $00FF0000; + G := SrcColor and $0000FF00 + Color and $0000FF00; + B := SrcColor and $000000FF + Color and $000000FF; + if R > $FF0000 then + R := $FF0000; + if G > $00FF00 then + G := $00FF00; + if B > $0000FF then + B := $0000FF; + PUInt32( Addr )^ := R or G or B; + inc( UInt32( Addr ), BPP ); + end; + inc( UInt32( Addr ), ModX ); + end; + end; + end; + SDL_UnlockSurface( DstSurface ); + end; +end; + +procedure SDL_FillRectSub( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 ); +var + RealRect : TSDL_Rect; + Addr : pointer; + ModX, BPP : cardinal; + x, y, R, G, B, SrcColor : cardinal; +begin + RealRect := ValidateSurfaceRect( DstSurface, DstRect ); + if ( RealRect.w > 0 ) and ( RealRect.h > 0 ) then + begin + SDL_LockSurface( DstSurface ); + BPP := DstSurface.format.BytesPerPixel; + with DstSurface^ do + begin + Addr := pointer( UInt32( pixels ) + UInt32( RealRect.y ) * pitch + UInt32( RealRect.x ) * BPP ); + ModX := Pitch - UInt32( RealRect.w ) * BPP; + end; + case DstSurface.format.BitsPerPixel of + 8 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $E0 - Color and $E0; + G := SrcColor and $1C - Color and $1C; + B := SrcColor and $03 - Color and $03; + if R > $E0 then + R := 0; + if G > $1C then + G := 0; + if B > $03 then + B := 0; + PUInt8( Addr )^ := R or G or B; + inc( UInt32( Addr ), BPP ); + end; + inc( UInt32( Addr ), ModX ); + end; + end; + 15 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $7C00 - Color and $7C00; + G := SrcColor and $03E0 - Color and $03E0; + B := SrcColor and $001F - Color and $001F; + if R > $7C00 then + R := 0; + if G > $03E0 then + G := 0; + if B > $001F then + B := 0; + PUInt16( Addr )^ := R or G or B; + inc( UInt32( Addr ), BPP ); + end; + inc( UInt32( Addr ), ModX ); + end; + end; + 16 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $F800 - Color and $F800; + G := SrcColor and $07C0 - Color and $07C0; + B := SrcColor and $001F - Color and $001F; + if R > $F800 then + R := 0; + if G > $07C0 then + G := 0; + if B > $001F then + B := 0; + PUInt16( Addr )^ := R or G or B; + inc( UInt32( Addr ), BPP ); + end; + inc( UInt32( Addr ), ModX ); + end; + end; + 24 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $00FF0000 - Color and $00FF0000; + G := SrcColor and $0000FF00 - Color and $0000FF00; + B := SrcColor and $000000FF - Color and $000000FF; + if R > $FF0000 then + R := 0; + if G > $00FF00 then + G := 0; + if B > $0000FF then + B := 0; + PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B; + inc( UInt32( Addr ), BPP ); + end; + inc( UInt32( Addr ), ModX ); + end; + end; + 32 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $00FF0000 - Color and $00FF0000; + G := SrcColor and $0000FF00 - Color and $0000FF00; + B := SrcColor and $000000FF - Color and $000000FF; + if R > $FF0000 then + R := 0; + if G > $00FF00 then + G := 0; + if B > $0000FF then + B := 0; + PUInt32( Addr )^ := R or G or B; + inc( UInt32( Addr ), BPP ); + end; + inc( UInt32( Addr ), ModX ); + end; + end; + end; + SDL_UnlockSurface( DstSurface ); + end; +end; + +procedure SDL_GradientFillRect( DstSurface : PSDL_Surface; const Rect : PSDL_Rect; const StartColor, EndColor : TSDL_Color; const Style : TGradientStyle ); +var + FBC : array[ 0..255 ] of Cardinal; + // temp vars + i, YR, YG, YB, SR, SG, SB, DR, DG, DB : Integer; + + TempStepV, TempStepH : Single; + TempLeft, TempTop, TempHeight, TempWidth : integer; + TempRect : TSDL_Rect; + +begin + // calc FBC + YR := StartColor.r; + YG := StartColor.g; + YB := StartColor.b; + SR := YR; + SG := YG; + SB := YB; + DR := EndColor.r - SR; + DG := EndColor.g - SG; + DB := EndColor.b - SB; + + for i := 0 to 255 do + begin + FBC[ i ] := SDL_MapRGB( DstSurface.format, YR, YG, YB ); + YR := SR + round( DR / 255 * i ); + YG := SG + round( DG / 255 * i ); + YB := SB + round( DB / 255 * i ); + end; + + // if aStyle = 1 then begin + TempStepH := Rect.w / 255; + TempStepV := Rect.h / 255; + TempHeight := Trunc( TempStepV + 1 ); + TempWidth := Trunc( TempStepH + 1 ); + TempTop := 0; + TempLeft := 0; + TempRect.x := Rect.x; + TempRect.y := Rect.y; + TempRect.h := Rect.h; + TempRect.w := Rect.w; + + case Style of + gsHorizontal : + begin + TempRect.h := TempHeight; + for i := 0 to 255 do + begin + TempRect.y := Rect.y + TempTop; + SDL_FillRect( DstSurface, @TempRect, FBC[ i ] ); + TempTop := Trunc( TempStepV * i ); + end; + end; + gsVertical : + begin + TempRect.w := TempWidth; + for i := 0 to 255 do + begin + TempRect.x := Rect.x + TempLeft; + SDL_FillRect( DstSurface, @TempRect, FBC[ i ] ); + TempLeft := Trunc( TempStepH * i ); + end; + end; + end; +end; + +procedure SDL_2xBlit( Src, Dest : PSDL_Surface ); +var + ReadAddr, WriteAddr, ReadRow, WriteRow : UInt32; + SrcPitch, DestPitch, x, y, w, h : UInt32; +begin + if ( Src = nil ) or ( Dest = nil ) then + exit; + if ( Src.w shl 1 ) < Dest.w then + exit; + if ( Src.h shl 1 ) < Dest.h then + exit; + + if SDL_MustLock( Src ) then + SDL_LockSurface( Src ); + if SDL_MustLock( Dest ) then + SDL_LockSurface( Dest ); + + ReadRow := UInt32( Src.Pixels ); + WriteRow := UInt32( Dest.Pixels ); + + SrcPitch := Src.pitch; + DestPitch := Dest.pitch; + + w := Src.w; + h := Src.h; + + case Src.format.BytesPerPixel of + 1 : + asm + push ebx + mov eax, h // for y := 1 to Src.h do + mov y, eax + @LoopY: + mov eax, ReadRow // ReadAddr := ReadRow; + mov ReadAddr, eax + + mov eax, WriteRow // WriteAddr := WriteRow; + mov WriteAddr, eax + + mov eax, w // for x := 1 to Src.w do + mov x, eax + + mov ecx, ReadAddr + mov edx, WriteAddr + mov ebx, DestPitch + + @LoopX: + mov al, [ecx] // PUInt8(WriteAddr)^ := PUInt8(ReadAddr)^; + mov [edx], al + mov [edx + 1], al // PUInt8(WriteAddr + 1)^ := PUInt8(ReadAddr)^; + mov [edx + ebx], al // PUInt8(WriteAddr + DestPitch)^ := PUInt8(ReadAddr)^; + mov [edx + ebx + 1], al // PUInt8(WriteAddr + DestPitch + 1)^ := PUInt8(ReadAddr)^; + + inc ecx // inc(ReadAddr); + add edx, 2 // inc(WriteAddr, 2); + + dec x + jnz @LoopX + + mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch); + add ReadRow, eax + + mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2); + add WriteRow, eax + add WriteRow, eax + + dec y + jnz @LoopY + pop ebx + end; + 2 : + asm + push ebx + mov eax, h // for y := 1 to Src.h do + mov y, eax + @LoopY: + mov eax, ReadRow // ReadAddr := ReadRow; + mov ReadAddr, eax + + mov eax, WriteRow // WriteAddr := WriteRow; + mov WriteAddr, eax + + mov eax, w // for x := 1 to Src.w do + mov x, eax + + mov ecx, ReadAddr + mov edx, WriteAddr + mov ebx, DestPitch + + @LoopX: + mov ax, [ecx] // PUInt16(WriteAddr)^ := PUInt16(ReadAddr)^; + mov [edx], ax + mov [edx + 2], ax // PUInt16(WriteAddr + 2)^ := PUInt16(ReadAddr)^; + mov [edx + ebx], ax // PUInt16(WriteAddr + DestPitch)^ := PUInt16(ReadAddr)^; + mov [edx + ebx + 2], ax // PUInt16(WriteAddr + DestPitch + 2)^ := PUInt16(ReadAddr)^; + + add ecx, 2 // inc(ReadAddr, 2); + add edx, 4 // inc(WriteAddr, 4); + + dec x + jnz @LoopX + + mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch); + add ReadRow, eax + + mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2); + add WriteRow, eax + add WriteRow, eax + + dec y + jnz @LoopY + pop ebx + end; + 3 : + asm + push ebx + mov eax, h // for y := 1 to Src.h do + mov y, eax + @LoopY: + mov eax, ReadRow // ReadAddr := ReadRow; + mov ReadAddr, eax + + mov eax, WriteRow // WriteAddr := WriteRow; + mov WriteAddr, eax + + mov eax, w // for x := 1 to Src.w do + mov x, eax + + mov ecx, ReadAddr + mov edx, WriteAddr + mov ebx, DestPitch + + @LoopX: + mov eax, [ecx] // (PUInt32(WriteAddr)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff); + and eax, $00ffffff + and dword ptr [edx], $ff000000 + or [edx], eax + and dword ptr [edx + 3], $00ffffff // (PUInt32(WriteAddr + 3)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff); + or [edx + 3], eax + and dword ptr [edx + ebx], $00ffffff // (PUInt32(WriteAddr + DestPitch)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff); + or [edx + ebx], eax + and dword ptr [edx + ebx + 3], $00ffffff // (PUInt32(WriteAddr + DestPitch + 3)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff); + or [edx + ebx + 3], eax + + add ecx, 3 // inc(ReadAddr, 3); + add edx, 6 // inc(WriteAddr, 6); + + dec x + jnz @LoopX + + mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch); + add ReadRow, eax + + mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2); + add WriteRow, eax + add WriteRow, eax + + dec y + jnz @LoopY + pop ebx + end; + 4 : + asm + push ebx + mov eax, h // for y := 1 to Src.h do + mov y, eax + @LoopY: + mov eax, ReadRow // ReadAddr := ReadRow; + mov ReadAddr, eax + + mov eax, WriteRow // WriteAddr := WriteRow; + mov WriteAddr, eax + + mov eax, w // for x := 1 to Src.w do + mov x, eax + + mov ecx, ReadAddr + mov edx, WriteAddr + mov ebx, DestPitch + + @LoopX: + mov eax, [ecx] // PUInt32(WriteAddr)^ := PUInt32(ReadAddr)^; + mov [edx], eax + mov [edx + 4], eax // PUInt32(WriteAddr + 4)^ := PUInt32(ReadAddr)^; + mov [edx + ebx], eax // PUInt32(WriteAddr + DestPitch)^ := PUInt32(ReadAddr)^; + mov [edx + ebx + 4], eax // PUInt32(WriteAddr + DestPitch + 4)^ := PUInt32(ReadAddr)^; + + add ecx, 4 // inc(ReadAddr, 4); + add edx, 8 // inc(WriteAddr, 8); + + dec x + jnz @LoopX + + mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch); + add ReadRow, eax + + mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2); + add WriteRow, eax + add WriteRow, eax + + dec y + jnz @LoopY + pop ebx + end; + end; + + if SDL_MustLock( Src ) then + SDL_UnlockSurface( Src ); + if SDL_MustLock( Dest ) then + SDL_UnlockSurface( Dest ); +end; + +procedure SDL_Scanline2xBlit( Src, Dest : PSDL_Surface ); +var + ReadAddr, WriteAddr, ReadRow, WriteRow : UInt32; + SrcPitch, DestPitch, x, y, w, h : UInt32; +begin + if ( Src = nil ) or ( Dest = nil ) then + exit; + if ( Src.w shl 1 ) < Dest.w then + exit; + if ( Src.h shl 1 ) < Dest.h then + exit; + + if SDL_MustLock( Src ) then + SDL_LockSurface( Src ); + if SDL_MustLock( Dest ) then + SDL_LockSurface( Dest ); + + ReadRow := UInt32( Src.Pixels ); + WriteRow := UInt32( Dest.Pixels ); + + SrcPitch := Src.pitch; + DestPitch := Dest.pitch; + + w := Src.w; + h := Src.h; + + case Src.format.BytesPerPixel of + 1 : + asm + push ebx + mov eax, h // for y := 1 to Src.h do + mov y, eax + @LoopY: + mov eax, ReadRow // ReadAddr := ReadRow; + mov ReadAddr, eax + + mov eax, WriteRow // WriteAddr := WriteRow; + mov WriteAddr, eax + + mov eax, w // for x := 1 to Src.w do + mov x, eax + + mov ecx, ReadAddr + mov edx, WriteAddr + + @LoopX: + mov al, [ecx] // PUInt8(WriteAddr)^ := PUInt8(ReadAddr)^; + mov [edx], al + mov [edx + 1], al // PUInt8(WriteAddr + 1)^ := PUInt8(ReadAddr)^; + + inc ecx // inc(ReadAddr); + add edx, 2 // inc(WriteAddr, 2); + + dec x + jnz @LoopX + + mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch); + add ReadRow, eax + + mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2); + add WriteRow, eax + add WriteRow, eax + + dec y + jnz @LoopY + pop ebx + end; + 2 : + asm + push ebx + mov eax, h // for y := 1 to Src.h do + mov y, eax + @LoopY: + mov eax, ReadRow // ReadAddr := ReadRow; + mov ReadAddr, eax + + mov eax, WriteRow // WriteAddr := WriteRow; + mov WriteAddr, eax + + mov eax, w // for x := 1 to Src.w do + mov x, eax + + mov ecx, ReadAddr + mov edx, WriteAddr + + @LoopX: + mov ax, [ecx] // PUInt16(WriteAddr)^ := PUInt16(ReadAddr)^; + mov [edx], ax + mov [edx + 2], eax // PUInt16(WriteAddr + 2)^ := PUInt16(ReadAddr)^; + + add ecx, 2 // inc(ReadAddr, 2); + add edx, 4 // inc(WriteAddr, 4); + + dec x + jnz @LoopX + + mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch); + add ReadRow, eax + + mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2); + add WriteRow, eax + add WriteRow, eax + + dec y + jnz @LoopY + pop ebx + end; + 3 : + asm + push ebx + mov eax, h // for y := 1 to Src.h do + mov y, eax + @LoopY: + mov eax, ReadRow // ReadAddr := ReadRow; + mov ReadAddr, eax + + mov eax, WriteRow // WriteAddr := WriteRow; + mov WriteAddr, eax + + mov eax, w // for x := 1 to Src.w do + mov x, eax + + mov ecx, ReadAddr + mov edx, WriteAddr + + @LoopX: + mov eax, [ecx] // (PUInt32(WriteAddr)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff); + and eax, $00ffffff + and dword ptr [edx], $ff000000 + or [edx], eax + and dword ptr [edx + 3], $00ffffff // (PUInt32(WriteAddr + 3)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff); + or [edx + 3], eax + + add ecx, 3 // inc(ReadAddr, 3); + add edx, 6 // inc(WriteAddr, 6); + + dec x + jnz @LoopX + + mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch); + add ReadRow, eax + + mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2); + add WriteRow, eax + add WriteRow, eax + + dec y + jnz @LoopY + pop ebx + end; + 4 : + asm + push ebx + mov eax, h // for y := 1 to Src.h do + mov y, eax + @LoopY: + mov eax, ReadRow // ReadAddr := ReadRow; + mov ReadAddr, eax + + mov eax, WriteRow // WriteAddr := WriteRow; + mov WriteAddr, eax + + mov eax, w // for x := 1 to Src.w do + mov x, eax + + mov ecx, ReadAddr + mov edx, WriteAddr + + @LoopX: + mov eax, [ecx] // PUInt32(WriteAddr)^ := PUInt32(ReadAddr)^; + mov [edx], eax + mov [edx + 4], eax // PUInt32(WriteAddr + 4)^ := PUInt32(ReadAddr)^; + + add ecx, 4 // inc(ReadAddr, 4); + add edx, 8 // inc(WriteAddr, 8); + + dec x + jnz @LoopX + + mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch); + add ReadRow, eax + + mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2); + add WriteRow, eax + add WriteRow, eax + + dec y + jnz @LoopY + pop ebx + end; + end; + + if SDL_MustLock( Src ) then + SDL_UnlockSurface( Src ); + if SDL_MustLock( Dest ) then + SDL_UnlockSurface( Dest ); +end; + +procedure SDL_50Scanline2xBlit( Src, Dest : PSDL_Surface ); +var + ReadAddr, WriteAddr, ReadRow, WriteRow : UInt32; + SrcPitch, DestPitch, x, y, w, h : UInt32; +begin + if ( Src = nil ) or ( Dest = nil ) then + exit; + if ( Src.w shl 1 ) < Dest.w then + exit; + if ( Src.h shl 1 ) < Dest.h then + exit; + + if SDL_MustLock( Src ) then + SDL_LockSurface( Src ); + if SDL_MustLock( Dest ) then + SDL_LockSurface( Dest ); + + ReadRow := UInt32( Src.Pixels ); + WriteRow := UInt32( Dest.Pixels ); + + SrcPitch := Src.pitch; + DestPitch := Dest.pitch; + + w := Src.w; + h := Src.h; + + case Src.format.BitsPerPixel of + 8 : + asm + push ebx + mov eax, h // for y := 1 to Src.h do + mov y, eax + @LoopY: + mov eax, ReadRow // ReadAddr := ReadRow; + mov ReadAddr, eax + + mov eax, WriteRow // WriteAddr := WriteRow; + mov WriteAddr, eax + + mov eax, w // for x := 1 to Src.w do + mov x, eax + + mov ecx, ReadAddr + mov edx, WriteAddr + mov ebx, DestPitch + + @LoopX: + mov al, [ecx] // PUInt8(WriteAddr)^ := PUInt8(ReadAddr)^; + mov [edx], al + mov [edx + 1], al // PUInt8(WriteAddr + 1)^ := PUInt8(ReadAddr)^; + shr al, 1 + and al, $6d + mov [edx + ebx], al // PUInt8(WriteAddr + DestPitch)^ := PUInt8(ReadAddr)^; + mov [edx + ebx + 1], al // PUInt8(WriteAddr + DestPitch + 1)^ := PUInt8(ReadAddr)^; + + inc ecx // inc(ReadAddr); + add edx, 2 // inc(WriteAddr, 2); + + dec x + jnz @LoopX + + mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch); + add ReadRow, eax + + mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2); + add WriteRow, eax + add WriteRow, eax + + dec y + jnz @LoopY + pop ebx + end; + 15 : + asm + push ebx + mov eax, h // for y := 1 to Src.h do + mov y, eax + @LoopY: + mov eax, ReadRow // ReadAddr := ReadRow; + mov ReadAddr, eax + + mov eax, WriteRow // WriteAddr := WriteRow; + mov WriteAddr, eax + + mov eax, w // for x := 1 to Src.w do + mov x, eax + + mov ecx, ReadAddr + mov edx, WriteAddr + mov ebx, DestPitch + + @LoopX: + mov ax, [ecx] // PUInt16(WriteAddr)^ := PUInt16(ReadAddr)^; + mov [edx], ax + mov [edx + 2], ax // PUInt16(WriteAddr + 2)^ := PUInt16(ReadAddr)^; + shr ax, 1 + and ax, $3def + mov [edx + ebx], ax // PUInt16(WriteAddr + DestPitch)^ := PUInt16(ReadAddr)^; + mov [edx + ebx + 2], ax // PUInt16(WriteAddr + DestPitch + 2)^ := PUInt16(ReadAddr)^; + + add ecx, 2 // inc(ReadAddr, 2); + add edx, 4 // inc(WriteAddr, 4); + + dec x + jnz @LoopX + + mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch); + add ReadRow, eax + + mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2); + add WriteRow, eax + add WriteRow, eax + + dec y + jnz @LoopY + pop ebx + end; + 16 : + asm + push ebx + mov eax, h // for y := 1 to Src.h do + mov y, eax + @LoopY: + mov eax, ReadRow // ReadAddr := ReadRow; + mov ReadAddr, eax + + mov eax, WriteRow // WriteAddr := WriteRow; + mov WriteAddr, eax + + mov eax, w // for x := 1 to Src.w do + mov x, eax + + mov ecx, ReadAddr + mov edx, WriteAddr + mov ebx, DestPitch + + @LoopX: + mov ax, [ecx] // PUInt16(WriteAddr)^ := PUInt16(ReadAddr)^; + mov [edx], ax + mov [edx + 2], ax // PUInt16(WriteAddr + 2)^ := PUInt16(ReadAddr)^; + shr ax, 1 + and ax, $7bef + mov [edx + ebx], ax // PUInt16(WriteAddr + DestPitch)^ := PUInt16(ReadAddr)^; + mov [edx + ebx + 2], ax // PUInt16(WriteAddr + DestPitch + 2)^ := PUInt16(ReadAddr)^; + + add ecx, 2 // inc(ReadAddr, 2); + add edx, 4 // inc(WriteAddr, 4); + + dec x + jnz @LoopX + + mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch); + add ReadRow, eax + + mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2); + add WriteRow, eax + add WriteRow, eax + + dec y + jnz @LoopY + pop ebx + end; + 24 : + asm + push ebx + mov eax, h // for y := 1 to Src.h do + mov y, eax + @LoopY: + mov eax, ReadRow // ReadAddr := ReadRow; + mov ReadAddr, eax + + mov eax, WriteRow // WriteAddr := WriteRow; + mov WriteAddr, eax + + mov eax, w // for x := 1 to Src.w do + mov x, eax + + mov ecx, ReadAddr + mov edx, WriteAddr + mov ebx, DestPitch + + @LoopX: + mov eax, [ecx] // (PUInt32(WriteAddr)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff); + and eax, $00ffffff + and dword ptr [edx], $ff000000 + or [edx], eax + and dword ptr [edx + 3], $00ffffff // (PUInt32(WriteAddr + 3)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff); + or [edx + 3], eax + shr eax, 1 + and eax, $007f7f7f + and dword ptr [edx + ebx], $00ffffff // (PUInt32(WriteAddr + DestPitch)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff); + or [edx + ebx], eax + and dword ptr [edx + ebx + 3], $00ffffff // (PUInt32(WriteAddr + DestPitch + 3)^ and $ff000000) or (PUInt32(ReadAddr)^ and $00ffffff); + or [edx + ebx + 3], eax + + add ecx, 3 // inc(ReadAddr, 3); + add edx, 6 // inc(WriteAddr, 6); + + dec x + jnz @LoopX + + mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch); + add ReadRow, eax + + mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2); + add WriteRow, eax + add WriteRow, eax + + dec y + jnz @LoopY + pop ebx + end; + 32 : + asm + push ebx + mov eax, h // for y := 1 to Src.h do + mov y, eax + @LoopY: + mov eax, ReadRow // ReadAddr := ReadRow; + mov ReadAddr, eax + + mov eax, WriteRow // WriteAddr := WriteRow; + mov WriteAddr, eax + + mov eax, w // for x := 1 to Src.w do + mov x, eax + + mov ecx, ReadAddr + mov edx, WriteAddr + mov ebx, DestPitch + + @LoopX: + mov eax, [ecx] // PUInt32(WriteAddr)^ := PUInt32(ReadAddr)^; + mov [edx], eax + mov [edx + 4], eax // PUInt32(WriteAddr + 4)^ := PUInt32(ReadAddr)^; + shr eax, 1 + and eax, $7f7f7f7f + mov [edx + ebx], eax // PUInt32(WriteAddr + DestPitch)^ := PUInt32(ReadAddr)^; + mov [edx + ebx + 4], eax // PUInt32(WriteAddr + DestPitch + 4)^ := PUInt32(ReadAddr)^; + + add ecx, 4 // inc(ReadAddr, 4); + add edx, 8 // inc(WriteAddr, 8); + + dec x + jnz @LoopX + + mov eax, SrcPitch // inc(UInt32(ReadRow), SrcPitch); + add ReadRow, eax + + mov eax, DestPitch // inc(UInt32(WriteRow), DestPitch * 2); + add WriteRow, eax + add WriteRow, eax + + dec y + jnz @LoopY + pop ebx + end; + end; + + if SDL_MustLock( Src ) then + SDL_UnlockSurface( Src ); + if SDL_MustLock( Dest ) then + SDL_UnlockSurface( Dest ); +end; + +function SDL_PixelTestSurfaceVsRect( SrcSurface1 : PSDL_Surface; SrcRect1 : PSDL_Rect; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : +boolean; +var + Src_Rect1, Src_Rect2 : TSDL_Rect; + right1, bottom1 : integer; + right2, bottom2 : integer; + Scan1Start, Scan2Start, ScanWidth, ScanHeight : cardinal; + Mod1: cardinal; + Addr1 : cardinal; + BPP : cardinal; + Pitch1 : cardinal; + TransparentColor1 : cardinal; + tx, ty : cardinal; + StartTick : cardinal; + Color1 : cardinal; +begin + Result := false; + if SrcRect1 = nil then + begin + with Src_Rect1 do + begin + x := 0; + y := 0; + w := SrcSurface1.w; + h := SrcSurface1.h; + end; + end + else + Src_Rect1 := SrcRect1^; + + Src_Rect2 := SrcRect2^; + with Src_Rect1 do + begin + Right1 := Left1 + w; + Bottom1 := Top1 + h; + end; + with Src_Rect2 do + begin + Right2 := Left2 + w; + Bottom2 := Top2 + h; + end; + if ( Left1 >= Right2 ) or ( Right1 <= Left2 ) or ( Top1 >= Bottom2 ) or ( +Bottom1 <= + Top2 ) then + exit; + if Left1 <= Left2 then + begin + // 1. left, 2. right + Scan1Start := Src_Rect1.x + Left2 - Left1; + Scan2Start := Src_Rect2.x; + ScanWidth := Right1 - Left2; + with Src_Rect2 do + if ScanWidth > w then + ScanWidth := w; + end + else + begin + // 1. right, 2. left + Scan1Start := Src_Rect1.x; + Scan2Start := Src_Rect2.x + Left1 - Left2; + ScanWidth := Right2 - Left1; + with Src_Rect1 do + if ScanWidth > w then + ScanWidth := w; + end; + with SrcSurface1^ do + begin + Pitch1 := Pitch; + Addr1 := cardinal( Pixels ); + inc( Addr1, Pitch1 * UInt32( Src_Rect1.y ) ); + with format^ do + begin + BPP := BytesPerPixel; + TransparentColor1 := colorkey; + end; + end; + + Mod1 := Pitch1 - ( ScanWidth * BPP ); + + inc( Addr1, BPP * Scan1Start ); + + if Top1 <= Top2 then + begin + // 1. up, 2. down + ScanHeight := Bottom1 - Top2; + if ScanHeight > Src_Rect2.h then + ScanHeight := Src_Rect2.h; + inc( Addr1, Pitch1 * UInt32( Top2 - Top1 ) ); + end + else + begin + // 1. down, 2. up + ScanHeight := Bottom2 - Top1; + if ScanHeight > Src_Rect1.h then + ScanHeight := Src_Rect1.h; + + end; + case BPP of + 1 : + for ty := 1 to ScanHeight do + begin + for tx := 1 to ScanWidth do + begin + if ( PByte( Addr1 )^ <> TransparentColor1 ) then + begin + Result := true; + exit; + end; + inc( Addr1 ); + + end; + inc( Addr1, Mod1 ); + + end; + 2 : + for ty := 1 to ScanHeight do + begin + for tx := 1 to ScanWidth do + begin + if ( PWord( Addr1 )^ <> TransparentColor1 ) then + begin + Result := true; + exit; + end; + inc( Addr1, 2 ); + + end; + inc( Addr1, Mod1 ); + + end; + 3 : + for ty := 1 to ScanHeight do + begin + for tx := 1 to ScanWidth do + begin + Color1 := PLongWord( Addr1 )^ and $00FFFFFF; + + if ( Color1 <> TransparentColor1 ) + then + begin + Result := true; + exit; + end; + inc( Addr1, 3 ); + + end; + inc( Addr1, Mod1 ); + + end; + 4 : + for ty := 1 to ScanHeight do + begin + for tx := 1 to ScanWidth do + begin + if ( PLongWord( Addr1 )^ <> TransparentColor1 ) then + begin + Result := true; + exit; + end; + inc( Addr1, 4 ); + + end; + inc( Addr1, Mod1 ); + + end; + end; +end; + +procedure SDL_ORSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); +var + Src, Dest : TSDL_Rect; + Diff : integer; + SrcAddr, DestAddr, TransparentColor : cardinal; + // TransparentColor: cardinal; + _ebx, _esi, _edi, _esp : cardinal; + WorkX, WorkY : word; + SrcMod, DestMod : cardinal; + Bits : cardinal; +begin + if ( SrcSurface = nil ) or ( DestSurface = nil ) then + exit; // Remove this to make it faster + if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then + exit; // Remove this to make it faster + if SrcRect = nil then + begin + with Src do + begin + x := 0; + y := 0; + w := SrcSurface.w; + h := SrcSurface.h; + end; + end + else + Src := SrcRect^; + if DestRect = nil then + begin + Dest.x := 0; + Dest.y := 0; + end + else + Dest := DestRect^; + Dest.w := Src.w; + Dest.h := Src.h; + with DestSurface.Clip_Rect do + begin + // Source's right side is greater than the dest.cliprect + if Dest.x + Src.w > x + w then + begin + smallint( Src.w ) := x + w - Dest.x; + smallint( Dest.w ) := x + w - Dest.x; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's bottom side is greater than the dest.clip + if Dest.y + Src.h > y + h then + begin + smallint( Src.h ) := y + h - Dest.y; + smallint( Dest.h ) := y + h - Dest.y; + if smallint( Dest.h ) < 1 then + exit; + end; + // Source's left side is less than the dest.clip + if Dest.x < x then + begin + Diff := x - Dest.x; + Src.x := Src.x + Diff; + smallint( Src.w ) := smallint( Src.w ) - Diff; + Dest.x := x; + smallint( Dest.w ) := smallint( Dest.w ) - Diff; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's Top side is less than the dest.clip + if Dest.y < y then + begin + Diff := y - Dest.y; + Src.y := Src.y + Diff; + smallint( Src.h ) := smallint( Src.h ) - Diff; + Dest.y := y; + smallint( Dest.h ) := smallint( Dest.h ) - Diff; + if smallint( Dest.h ) < 1 then + exit; + end; + end; + with SrcSurface^ do + begin + SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) * + Format.BytesPerPixel; + SrcMod := Pitch - Src.w * Format.BytesPerPixel; + TransparentColor := Format.colorkey; + end; + with DestSurface^ do + begin + DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) * + Format.BytesPerPixel; + DestMod := Pitch - Dest.w * Format.BytesPerPixel; + Bits := Format.BitsPerPixel; + end; + SDL_LockSurface( SrcSurface ); + SDL_LockSurface( DestSurface ); + WorkY := Src.h; + case bits of + 8 : + asm + mov _ebx, ebx + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + @LoopY: + mov ax, Src.w + mov WorkX, ax // WorkX := Src.w + @Loopx: + mov al, [esi] // AL := source color + cmp al, 0 + je @SkipColor // if AL=0 or AL=transparent color then skip everything + cmp al, byte ptr TransparentColor + je @SkipColor + or al, [edi] + mov [edi], al + @SkipColor: + inc esi + inc edi + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + dec WorkY + jnz @LoopY + mov esp,_esp + mov edi,_edi + mov esi,_esi + mov ebx,_ebx + end; + 15 : + asm + mov _ebx, ebx + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + @LoopY: + mov ax, Src.w + mov WorkX, ax // WorkX := Src.w + @Loopx: + mov ax, [esi] // AX := source color + cmp ax, 0 + je @SkipColor // if AX=0 then skip everything + cmp ax, word ptr TransparentColor + je @SkipColor + or ax, [edi] + mov [edi], ax + @SkipColor: + add esi, 2 + add edi, 2 + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + dec WorkY + jnz @LoopY + mov esp,_esp + mov edi,_edi + mov esi,_esi + mov ebx,_ebx + end; + 16 : + asm + mov _ebx, ebx + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + @LoopY: + mov ax, Src.w + mov WorkX, ax // WorkX := Src.w + @Loopx: + mov ax, [esi] // AX := source color + cmp ax, 0 + je @SkipColor // if AX=0 then skip everything + cmp ax, word ptr TransparentColor + je @SkipColor + or ax, [edi] + mov [edi], ax + @SkipColor: + add esi, 2 + add edi, 2 + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + dec WorkY + jnz @LoopY + mov esp,_esp + mov edi,_edi + mov esi,_esi + mov ebx,_ebx + end; + 24 : + asm + mov _ebx, ebx + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + @LoopY: + mov ax, Src.w + mov WorkX, ax // WorkX := Src.w + add WorkX, ax // WorkX := Src.w * 2 + add WorkX, ax // WorkX := Src.w * 3 + @Loopx: + mov al, [esi] // AL := source color + or al, [edi] + mov [edi], al + inc esi + inc edi + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + dec WorkY + jnz @LoopY + mov esp,_esp + mov edi,_edi + mov esi,_esi + mov ebx,_ebx + end; + 32 : + asm + mov _ebx, ebx + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + @LoopY: + mov ax, Src.w + shl ax, 2 + mov WorkX, ax // WorkX := Src.w * 4 + @Loopx: + mov al, [esi] // AL := source color + or al, [edi] + mov [edi], al + inc esi + inc edi + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + dec WorkY + jnz @LoopY + mov esp,_esp + mov edi,_edi + mov esi,_esi + mov ebx,_ebx + end; + end; + SDL_UnlockSurface( SrcSurface ); + SDL_UnlockSurface( DestSurface ); +end; + +procedure SDL_ANDSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); +var + Src, Dest : TSDL_Rect; + Diff : integer; + SrcAddr, DestAddr, TransparentColor : cardinal; + // TransparentColor: cardinal; + _ebx, _esi, _edi, _esp : cardinal; + WorkX, WorkY : word; + SrcMod, DestMod : cardinal; + Bits : cardinal; +begin + if ( SrcSurface = nil ) or ( DestSurface = nil ) then + exit; // Remove this to make it faster + if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then + exit; // Remove this to make it faster + if SrcRect = nil then + begin + with Src do + begin + x := 0; + y := 0; + w := SrcSurface.w; + h := SrcSurface.h; + end; + end + else + Src := SrcRect^; + if DestRect = nil then + begin + Dest.x := 0; + Dest.y := 0; + end + else + Dest := DestRect^; + Dest.w := Src.w; + Dest.h := Src.h; + with DestSurface.Clip_Rect do + begin + // Source's right side is greater than the dest.cliprect + if Dest.x + Src.w > x + w then + begin + smallint( Src.w ) := x + w - Dest.x; + smallint( Dest.w ) := x + w - Dest.x; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's bottom side is greater than the dest.clip + if Dest.y + Src.h > y + h then + begin + smallint( Src.h ) := y + h - Dest.y; + smallint( Dest.h ) := y + h - Dest.y; + if smallint( Dest.h ) < 1 then + exit; + end; + // Source's left side is less than the dest.clip + if Dest.x < x then + begin + Diff := x - Dest.x; + Src.x := Src.x + Diff; + smallint( Src.w ) := smallint( Src.w ) - Diff; + Dest.x := x; + smallint( Dest.w ) := smallint( Dest.w ) - Diff; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's Top side is less than the dest.clip + if Dest.y < y then + begin + Diff := y - Dest.y; + Src.y := Src.y + Diff; + smallint( Src.h ) := smallint( Src.h ) - Diff; + Dest.y := y; + smallint( Dest.h ) := smallint( Dest.h ) - Diff; + if smallint( Dest.h ) < 1 then + exit; + end; + end; + with SrcSurface^ do + begin + SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) * + Format.BytesPerPixel; + SrcMod := Pitch - Src.w * Format.BytesPerPixel; + TransparentColor := Format.colorkey; + end; + with DestSurface^ do + begin + DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) * + Format.BytesPerPixel; + DestMod := Pitch - Dest.w * Format.BytesPerPixel; + Bits := Format.BitsPerPixel; + end; + SDL_LockSurface( SrcSurface ); + SDL_LockSurface( DestSurface ); + WorkY := Src.h; + case bits of + 8 : + asm + mov _ebx, ebx + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + @LoopY: + mov ax, Src.w + mov WorkX, ax // WorkX := Src.w + @Loopx: + mov al, [esi] // AL := source color + cmp al, 0 + je @SkipColor // if AL=0 or AL=transparent color then skip everything + cmp al, byte ptr TransparentColor + je @SkipColor + and al, [edi] + mov [edi], al + @SkipColor: + inc esi + inc edi + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + dec WorkY + jnz @LoopY + mov esp,_esp + mov edi,_edi + mov esi,_esi + mov ebx,_ebx + end; + 15 : + asm + mov _ebx, ebx + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + @LoopY: + mov ax, Src.w + mov WorkX, ax // WorkX := Src.w + @Loopx: + mov ax, [esi] // AX := source color + cmp ax, 0 + je @SkipColor // if AX=0 then skip everything + cmp ax, word ptr TransparentColor + je @SkipColor + and ax, [edi] + mov [edi], ax + @SkipColor: + add esi, 2 + add edi, 2 + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + dec WorkY + jnz @LoopY + mov esp,_esp + mov edi,_edi + mov esi,_esi + mov ebx,_ebx + end; + 16 : + asm + mov _ebx, ebx + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + @LoopY: + mov ax, Src.w + mov WorkX, ax // WorkX := Src.w + @Loopx: + mov ax, [esi] // AX := source color + cmp ax, 0 + je @SkipColor // if AX=0 then skip everything + cmp ax, word ptr TransparentColor + je @SkipColor + and ax, [edi] + mov [edi], ax + @SkipColor: + add esi, 2 + add edi, 2 + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + dec WorkY + jnz @LoopY + mov esp,_esp + mov edi,_edi + mov esi,_esi + mov ebx,_ebx + end; + 24 : + asm + mov _ebx, ebx + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + @LoopY: + mov ax, Src.w + mov WorkX, ax // WorkX := Src.w + add WorkX, ax // WorkX := Src.w * 2 + add WorkX, ax // WorkX := Src.w * 3 + @Loopx: + mov al, [esi] // AL := source color + and al, [edi] + mov [edi], al + inc esi + inc edi + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + dec WorkY + jnz @LoopY + mov esp,_esp + mov edi,_edi + mov esi,_esi + mov ebx,_ebx + end; + 32 : + asm + mov _ebx, ebx + mov _esi, esi + mov _edi, edi + mov _esp, esp + mov esi, SrcAddr // ESI - Source Offset + mov edi, DestAddr // EDI - Destination Offset + mov ax, Src.h // WorkY := Src.h + mov WorkY, ax + @LoopY: + mov ax, Src.w + shl ax, 2 + mov WorkX, ax // WorkX := Src.w * 4 + @Loopx: + mov al, [esi] // AL := source color + and al, [edi] + mov [edi], al + inc esi + inc edi + dec WorkX + jnz @LoopX + add esi, SrcMod + add edi, DestMod + dec WorkY + jnz @LoopY + mov esp,_esp + mov edi,_edi + mov esi,_esi + mov ebx,_ebx + end; + end; + SDL_UnlockSurface( SrcSurface ); + SDL_UnlockSurface( DestSurface ); +end; + + +procedure SDL_GTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); +var + R, G, B, Pixel1, Pixel2, TransparentColor : cardinal; + Src, Dest : TSDL_Rect; + Diff : integer; + SrcAddr, DestAddr : cardinal; + WorkX, WorkY : word; + SrcMod, DestMod : cardinal; + Bits : cardinal; +begin + if ( SrcSurface = nil ) or ( DestSurface = nil ) then + exit; // Remove this to make it faster + if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then + exit; // Remove this to make it faster + if SrcRect = nil then + begin + with Src do + begin + x := 0; + y := 0; + w := SrcSurface.w; + h := SrcSurface.h; + end; + end + else + Src := SrcRect^; + if DestRect = nil then + begin + Dest.x := 0; + Dest.y := 0; + end + else + Dest := DestRect^; + Dest.w := Src.w; + Dest.h := Src.h; + with DestSurface.Clip_Rect do + begin + // Source's right side is greater than the dest.cliprect + if Dest.x + Src.w > x + w then + begin + smallint( Src.w ) := x + w - Dest.x; + smallint( Dest.w ) := x + w - Dest.x; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's bottom side is greater than the dest.clip + if Dest.y + Src.h > y + h then + begin + smallint( Src.h ) := y + h - Dest.y; + smallint( Dest.h ) := y + h - Dest.y; + if smallint( Dest.h ) < 1 then + exit; + end; + // Source's left side is less than the dest.clip + if Dest.x < x then + begin + Diff := x - Dest.x; + Src.x := Src.x + Diff; + smallint( Src.w ) := smallint( Src.w ) - Diff; + Dest.x := x; + smallint( Dest.w ) := smallint( Dest.w ) - Diff; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's Top side is less than the dest.clip + if Dest.y < y then + begin + Diff := y - Dest.y; + Src.y := Src.y + Diff; + smallint( Src.h ) := smallint( Src.h ) - Diff; + Dest.y := y; + smallint( Dest.h ) := smallint( Dest.h ) - Diff; + if smallint( Dest.h ) < 1 then + exit; + end; + end; + with SrcSurface^ do + begin + SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) * + Format.BytesPerPixel; + SrcMod := Pitch - Src.w * Format.BytesPerPixel; + TransparentColor := Format.colorkey; + end; + with DestSurface^ do + begin + DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) * + Format.BytesPerPixel; + DestMod := Pitch - Dest.w * Format.BytesPerPixel; + Bits := Format.BitsPerPixel; + end; + SDL_LockSurface( SrcSurface ); + SDL_LockSurface( DestSurface ); + WorkY := Src.h; + case bits of + 8 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt8( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt8( DestAddr )^; + if Pixel2 > 0 then + begin + if Pixel2 and $E0 > Pixel1 and $E0 then R := Pixel2 and $E0 else R := Pixel1 and $E0; + if Pixel2 and $1C > Pixel1 and $1C then G := Pixel2 and $1C else G := Pixel1 and $1C; + if Pixel2 and $03 > Pixel1 and $03 then B := Pixel2 and $03 else B := Pixel1 and $03; + + if R > $E0 then + R := $E0; + if G > $1C then + G := $1C; + if B > $03 then + B := $03; + PUInt8( DestAddr )^ := R or G or B; + end + else + PUInt8( DestAddr )^ := Pixel1; + end; + inc( SrcAddr ); + inc( DestAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 15 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + if Pixel2 > 0 then + begin + + if Pixel2 and $7C00 > Pixel1 and $7C00 then R := Pixel2 and $7C00 else R := Pixel1 and $7C00; + if Pixel2 and $03E0 > Pixel1 and $03E0 then G := Pixel2 and $03E0 else G := Pixel1 and $03E0; + if Pixel2 and $001F > Pixel1 and $001F then B := Pixel2 and $001F else B := Pixel1 and $001F; + + PUInt16( DestAddr )^ := R or G or B; + end + else + PUInt16( DestAddr )^ := Pixel1; + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 16 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + if Pixel2 > 0 then + begin + + if Pixel2 and $F800 > Pixel1 and $F800 then R := Pixel2 and $F800 else R := Pixel1 and $F800; + if Pixel2 and $07E0 > Pixel1 and $07E0 then G := Pixel2 and $07E0 else G := Pixel1 and $07E0; + if Pixel2 and $001F > Pixel1 and $001F then B := Pixel2 and $001F else B := Pixel1 and $001F; + + PUInt16( DestAddr )^ := R or G or B; + end + else + PUInt16( DestAddr )^ := Pixel1; + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 24 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF; + if Pixel2 > 0 then + begin + + if Pixel2 and $FF0000 > Pixel1 and $FF0000 then R := Pixel2 and $FF0000 else R := Pixel1 and $FF0000; + if Pixel2 and $00FF00 > Pixel1 and $00FF00 then G := Pixel2 and $00FF00 else G := Pixel1 and $00FF00; + if Pixel2 and $0000FF > Pixel1 and $0000FF then B := Pixel2 and $0000FF else B := Pixel1 and $0000FF; + + PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B ); + end + else + PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1; + end; + inc( SrcAddr, 3 ); + inc( DestAddr, 3 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 32 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^; + if Pixel2 > 0 then + begin + + if Pixel2 and $FF0000 > Pixel1 and $FF0000 then R := Pixel2 and $FF0000 else R := Pixel1 and $FF0000; + if Pixel2 and $00FF00 > Pixel1 and $00FF00 then G := Pixel2 and $00FF00 else G := Pixel1 and $00FF00; + if Pixel2 and $0000FF > Pixel1 and $0000FF then B := Pixel2 and $0000FF else B := Pixel1 and $0000FF; + + PUInt32( DestAddr )^ := R or G or B; + end + else + PUInt32( DestAddr )^ := Pixel1; + end; + inc( SrcAddr, 4 ); + inc( DestAddr, 4 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + end; + SDL_UnlockSurface( SrcSurface ); + SDL_UnlockSurface( DestSurface ); +end; + + +procedure SDL_LTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); +var + R, G, B, Pixel1, Pixel2, TransparentColor : cardinal; + Src, Dest : TSDL_Rect; + Diff : integer; + SrcAddr, DestAddr : cardinal; + WorkX, WorkY : word; + SrcMod, DestMod : cardinal; + Bits : cardinal; +begin + if ( SrcSurface = nil ) or ( DestSurface = nil ) then + exit; // Remove this to make it faster + if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then + exit; // Remove this to make it faster + if SrcRect = nil then + begin + with Src do + begin + x := 0; + y := 0; + w := SrcSurface.w; + h := SrcSurface.h; + end; + end + else + Src := SrcRect^; + if DestRect = nil then + begin + Dest.x := 0; + Dest.y := 0; + end + else + Dest := DestRect^; + Dest.w := Src.w; + Dest.h := Src.h; + with DestSurface.Clip_Rect do + begin + // Source's right side is greater than the dest.cliprect + if Dest.x + Src.w > x + w then + begin + smallint( Src.w ) := x + w - Dest.x; + smallint( Dest.w ) := x + w - Dest.x; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's bottom side is greater than the dest.clip + if Dest.y + Src.h > y + h then + begin + smallint( Src.h ) := y + h - Dest.y; + smallint( Dest.h ) := y + h - Dest.y; + if smallint( Dest.h ) < 1 then + exit; + end; + // Source's left side is less than the dest.clip + if Dest.x < x then + begin + Diff := x - Dest.x; + Src.x := Src.x + Diff; + smallint( Src.w ) := smallint( Src.w ) - Diff; + Dest.x := x; + smallint( Dest.w ) := smallint( Dest.w ) - Diff; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's Top side is less than the dest.clip + if Dest.y < y then + begin + Diff := y - Dest.y; + Src.y := Src.y + Diff; + smallint( Src.h ) := smallint( Src.h ) - Diff; + Dest.y := y; + smallint( Dest.h ) := smallint( Dest.h ) - Diff; + if smallint( Dest.h ) < 1 then + exit; + end; + end; + with SrcSurface^ do + begin + SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) * + Format.BytesPerPixel; + SrcMod := Pitch - Src.w * Format.BytesPerPixel; + TransparentColor := Format.colorkey; + end; + with DestSurface^ do + begin + DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) * + Format.BytesPerPixel; + DestMod := Pitch - Dest.w * Format.BytesPerPixel; + Bits := Format.BitsPerPixel; + end; + SDL_LockSurface( SrcSurface ); + SDL_LockSurface( DestSurface ); + WorkY := Src.h; + case bits of + 8 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt8( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt8( DestAddr )^; + if Pixel2 > 0 then + begin + if Pixel2 and $E0 < Pixel1 and $E0 then R := Pixel2 and $E0 else R := Pixel1 and $E0; + if Pixel2 and $1C < Pixel1 and $1C then G := Pixel2 and $1C else G := Pixel1 and $1C; + if Pixel2 and $03 < Pixel1 and $03 then B := Pixel2 and $03 else B := Pixel1 and $03; + + if R > $E0 then + R := $E0; + if G > $1C then + G := $1C; + if B > $03 then + B := $03; + PUInt8( DestAddr )^ := R or G or B; + end + else + PUInt8( DestAddr )^ := Pixel1; + end; + inc( SrcAddr ); + inc( DestAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 15 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + if Pixel2 > 0 then + begin + + if Pixel2 and $7C00 < Pixel1 and $7C00 then R := Pixel2 and $7C00 else R := Pixel1 and $7C00; + if Pixel2 and $03E0 < Pixel1 and $03E0 then G := Pixel2 and $03E0 else G := Pixel1 and $03E0; + if Pixel2 and $001F < Pixel1 and $001F then B := Pixel2 and $001F else B := Pixel1 and $001F; + + PUInt16( DestAddr )^ := R or G or B; + end + else + PUInt16( DestAddr )^ := Pixel1; + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 16 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + if Pixel2 > 0 then + begin + + if Pixel2 and $F800 < Pixel1 and $F800 then R := Pixel2 and $F800 else R := Pixel1 and $F800; + if Pixel2 and $07E0 < Pixel1 and $07E0 then G := Pixel2 and $07E0 else G := Pixel1 and $07E0; + if Pixel2 and $001F < Pixel1 and $001F then B := Pixel2 and $001F else B := Pixel1 and $001F; + + PUInt16( DestAddr )^ := R or G or B; + end + else + PUInt16( DestAddr )^ := Pixel1; + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 24 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF; + if Pixel2 > 0 then + begin + + if Pixel2 and $FF0000 < Pixel1 and $FF0000 then R := Pixel2 and $FF0000 else R := Pixel1 and $FF0000; + if Pixel2 and $00FF00 < Pixel1 and $00FF00 then G := Pixel2 and $00FF00 else G := Pixel1 and $00FF00; + if Pixel2 and $0000FF < Pixel1 and $0000FF then B := Pixel2 and $0000FF else B := Pixel1 and $0000FF; + + PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B ); + end + else + PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1; + end; + inc( SrcAddr, 3 ); + inc( DestAddr, 3 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 32 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^; + if Pixel2 > 0 then + begin + + if Pixel2 and $FF0000 < Pixel1 and $FF0000 then R := Pixel2 and $FF0000 else R := Pixel1 and $FF0000; + if Pixel2 and $00FF00 < Pixel1 and $00FF00 then G := Pixel2 and $00FF00 else G := Pixel1 and $00FF00; + if Pixel2 and $0000FF < Pixel1 and $0000FF then B := Pixel2 and $0000FF else B := Pixel1 and $0000FF; + + PUInt32( DestAddr )^ := R or G or B; + end + else + PUInt32( DestAddr )^ := Pixel1; + end; + inc( SrcAddr, 4 ); + inc( DestAddr, 4 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + end; + SDL_UnlockSurface( SrcSurface ); + SDL_UnlockSurface( DestSurface ); +end; + +function SDL_ClipLine(var x1,y1,x2,y2: Integer; ClipRect: PSDL_Rect) : boolean; +var tflag, flag1, flag2: word; + txy, xedge, yedge: Integer; + slope: single; + + function ClipCode(x,y: Integer): word; + begin + Result := 0; + if x < ClipRect.x then Result := 1; + if x >= ClipRect.w + ClipRect.x then Result := Result or 2; + if y < ClipRect.y then Result := Result or 4; + if y >= ClipRect.h + ClipRect.y then Result := Result or 8; + end; + +begin + flag1 := ClipCode(x1,y1); + flag2 := ClipCode(x2,y2); + result := true; + + while true do + begin + if (flag1 or flag2) = 0 then Exit; // all in + + if (flag1 and flag2) <> 0 then + begin + result := false; + Exit; // all out + end; + + if flag2 = 0 then + begin + txy := x1; x1 := x2; x2 := txy; + txy := y1; y1 := y2; y2 := txy; + tflag := flag1; flag1 := flag2; flag2 := tflag; + end; + + if (flag2 and 3) <> 0 then + begin + if (flag2 and 1) <> 0 then + xedge := ClipRect.x + else + xedge := ClipRect.w + ClipRect.x -1; // back 1 pixel otherwise we end up in a loop + + slope := (y2 - y1) / (x2 - x1); + y2 := y1 + Round(slope * (xedge - x1)); + x2 := xedge; + end + else + begin + if (flag2 and 4) <> 0 then + yedge := ClipRect.y + else + yedge := ClipRect.h + ClipRect.y -1; // up 1 pixel otherwise we end up in a loop + + slope := (x2 - x1) / (y2 - y1); + x2 := x1 + Round(slope * (yedge - y1)); + y2 := yedge; + end; + + flag2 := ClipCode(x2, y2); + end; +end; + +end. + + diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlinput.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlinput.pas index e1b2347e..094f4e0f 100644 --- a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlinput.pas +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlinput.pas @@ -1,923 +1,923 @@ -unit sdlinput;
-{
- $Id: sdlinput.pas,v 1.9 2007/08/22 21:18:43 savage Exp $
-
-}
-{******************************************************************************}
-{ }
-{ JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer }
-{ SDL Input Wrapper }
-{ }
-{ }
-{ The initial developer of this Pascal code was : }
-{ Dominique Louis <Dominique@SavageSoftware.com.au> }
-{ }
-{ Portions created by Dominique Louis are }
-{ Copyright (C) 2003 - 2100 Dominique Louis. }
-{ }
-{ }
-{ Contributor(s) }
-{ -------------- }
-{ Dominique Louis <Dominique@SavageSoftware.com.au> }
-{ }
-{ Obtained through: }
-{ Joint Endeavour of Delphi Innovators ( Project JEDI ) }
-{ }
-{ You may retrieve the latest version of this file at the Project }
-{ JEDI home page, located at http://delphi-jedi.org }
-{ }
-{ The contents of this file are used with permission, subject to }
-{ the Mozilla Public License Version 1.1 (the "License"); you may }
-{ not use this file except in compliance with the License. You may }
-{ obtain a copy of the License at }
-{ http://www.mozilla.org/MPL/MPL-1.1.html }
-{ }
-{ Software distributed under the License is distributed on an }
-{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or }
-{ implied. See the License for the specific language governing }
-{ rights and limitations under the License. }
-{ }
-{ Description }
-{ ----------- }
-{ SDL Mouse, Keyboard and Joystick wrapper }
-{ }
-{ }
-{ Requires }
-{ -------- }
-{ SDL.dll on Windows platforms }
-{ libSDL-1.1.so.0 on Linux platform }
-{ }
-{ Programming Notes }
-{ ----------------- }
-{ }
-{ }
-{ }
-{ }
-{ Revision History }
-{ ---------------- }
-{ March 12 2003 - DL : Initial creation }
-{ }
-{ February 02 2004 - DL : Added Custom Cursor Support to the Mouse class }
-{
- $Log: sdlinput.pas,v $
- Revision 1.9 2007/08/22 21:18:43 savage
- Thanks to Dean for his MouseDelta patch.
-
- Revision 1.8 2005/08/03 18:57:32 savage
- Various updates and additions. Mainly to handle OpenGL 3D Window support and better cursor support for the mouse class
-
- Revision 1.7 2004/09/30 22:32:04 savage
- Updated with slightly different header comments
-
- Revision 1.6 2004/09/12 21:52:58 savage
- Slight changes to fix some issues with the sdl classes.
-
- Revision 1.5 2004/05/10 21:11:49 savage
- changes required to help get SoAoS off the ground.
-
- Revision 1.4 2004/05/03 22:38:40 savage
- Added the ability to enable or disable certain inputs @ runtime. Basically it just does not call UpdateInput if Enabled = false.
- Can also disable and enable input devices via the InputManager.
-
- Revision 1.3 2004/04/28 21:27:01 savage
- Updated Joystick code and event handlers. Needs testing...
-
- Revision 1.2 2004/02/14 22:36:29 savage
- Fixed inconsistencies of using LoadLibrary and LoadModule.
- Now all units make use of LoadModule rather than LoadLibrary and other dynamic proc procedures.
-
- Revision 1.1 2004/02/05 00:08:20 savage
- Module 1.0 release
-
-
-}
-{******************************************************************************}
-
-interface
-
-{$i jedi-sdl.inc}
-
-uses
- Classes,
- sdl;
-
-type
- TSDLInputType = ( itJoystick , itKeyBoard, itMouse );
- TSDLInputTypes = set of TSDLInputType;
-
- TSDLCustomInput = class( TObject )
- private
- FEnabled: Boolean;
- public
- constructor Create;
- function UpdateInput( event: TSDL_EVENT ) : Boolean; virtual; abstract;
- property Enabled : Boolean read FEnabled write FEnabled;
- end;
-
- TSDLJoyAxisMoveEvent = procedure ( Which: UInt8; Axis: UInt8; Value: SInt16 ) {$IFNDEF NOT_OO}of object{$ENDIF};
- TSDLJoyBallMoveEvent = procedure ( Which: UInt8; Ball: UInt8; RelativePos: TPoint ) {$IFNDEF NOT_OO}of object{$ENDIF};
- TSDLJoyHatMoveEvent = procedure ( Which: UInt8; Hat: UInt8; Value: SInt16 ) {$IFNDEF NOT_OO}of object{$ENDIF};
- TSDLJoyButtonEvent = procedure ( Which: UInt8; Button: UInt8; State: SInt16 ) {$IFNDEF NOT_OO}of object{$ENDIF};
-
-
- TSDLJoyStick = class( TSDLCustomInput )
- private
- FJoystick : PSDL_Joystick;
- FJoystickIndex : Integer;
- FJoyAxisMoveEvent : TSDLJoyAxisMoveEvent;
- FJoyBallMoveEvent : TSDLJoyBallMoveEvent;
- FJoyHatMoveEvent : TSDLJoyHatMoveEvent;
- FJoyButtonDownEvent : TSDLJoyButtonEvent;
- FJoyButtonUpEvent : TSDLJoyButtonEvent;
- procedure DoAxisMove( Event : TSDL_Event );
- procedure DoBallMove( Event : TSDL_Event );
- procedure DoHatMove( Event : TSDL_Event );
- procedure DoButtonDown( Event : TSDL_Event );
- procedure DoButtonUp( Event : TSDL_Event );
- function GetName: PChar;
- function GetNumAxes: integer;
- function GetNumBalls: integer;
- function GetNumButtons: integer;
- function GetNumHats: integer;
- public
- constructor Create( Index : Integer );
- destructor Destroy; override;
- procedure Open;
- procedure Close;
- function UpdateInput( Event: TSDL_EVENT ) : Boolean; override;
- property Name : PChar read GetName;
- property NumAxes : integer read GetNumAxes;
- property NumBalls : integer read GetNumBalls;
- property NumButtons : integer read GetNumButtons;
- property NumHats : integer read GetNumHats;
- property OnAxisMove : TSDLJoyAxisMoveEvent read FJoyAxisMoveEvent write FJoyAxisMoveEvent;
- property OnBallMove : TSDLJoyBallMoveEvent read FJoyBallMoveEvent write FJoyBallMoveEvent;
- property OnHatMove : TSDLJoyHatMoveEvent read FJoyHatMoveEvent write FJoyHatMoveEvent;
- property OnButtonDown : TSDLJoyButtonEvent read FJoyButtonDownEvent write FJoyButtonDownEvent;
- property OnButtonUp : TSDLJoyButtonEvent read FJoyButtonUpEvent write FJoyButtonUpEvent;
- end;
-
- TSDLJoySticks = class( TObject )
- private
- FNumOfJoySticks: Integer;
- FJoyStickList : TList;
- function GetJoyStick(Index: integer): TSDLJoyStick;
- procedure SetJoyStick(Index: integer; const Value: TSDLJoyStick);
- public
- constructor Create;
- destructor Destroy; override;
- function UpdateInput( event: TSDL_EVENT ) : Boolean;
- property NumOfJoySticks : Integer read FNumOfJoySticks write FNumOfJoySticks;
- property JoySticks[ Index : integer ] : TSDLJoyStick read GetJoyStick write SetJoyStick;
- end;
-
- TSDLKeyBoardEvent = procedure ( var Key: TSDLKey; Shift: TSDLMod; unicode : UInt16 ) {$IFNDEF NOT_OO}of object{$ENDIF};
-
- TSDLKeyBoard = class( TSDLCustomInput )
- private
- FKeys : PKeyStateArr;
- FOnKeyUp: TSDLKeyBoardEvent;
- FOnKeyDown: TSDLKeyBoardEvent;
- procedure DoKeyDown( keysym : PSDL_keysym );
- procedure DoKeyUp( keysym : PSDL_keysym );
- public
- function IsKeyDown( Key : TSDLKey ) : Boolean;
- function IsKeyUp( Key : TSDLKey ) : Boolean;
- function UpdateInput( event: TSDL_EVENT ) : Boolean; override;
- property Keys : PKeyStateArr read FKeys write FKeys;
- property OnKeyDown : TSDLKeyBoardEvent read FOnKeyDown write FOnKeyDown;
- property OnKeyUp : TSDLKeyBoardEvent read FOnKeyUp write FOnKeyUp;
- end;
-
- TSDLMouseButtonEvent = procedure ( Button : Integer; Shift: TSDLMod; MousePos : TPoint ) {$IFNDEF NOT_OO}of object{$ENDIF};
- TSDLMouseMoveEvent = procedure ( Shift: TSDLMod; CurrentPos : TPoint; RelativePos : TPoint ) {$IFNDEF NOT_OO}of object{$ENDIF};
- TSDLMouseWheelEvent = procedure ( WheelDelta : Integer; Shift: TSDLMod; MousePos : TPoint ) {$IFNDEF NOT_OO}of object{$ENDIF};
-
- TSDLCustomCursor = class( TObject )
- private
- FFileName : string;
- FHotPoint: TPoint;
- procedure SetFileName(const aValue: string );
- function ScanForChar( str : string; ch : Char; startPos : Integer; lookFor : Boolean ) : Integer;
- public
- constructor Create( const aFileName : string; aHotPoint: TPoint );
- procedure LoadFromFile( const aFileName : string ); virtual; abstract;
- procedure LoadFromStream( aStream : TStream ); virtual; abstract;
- procedure Show; virtual; abstract;
- property FileName : string read FFileName write SetFileName;
- property HotPoint : TPoint read FHotPoint write FHotPoint;
- end;
-
- TSDLXPMCursor = class( TSDLCustomCursor )
- private
- FCursor : PSDL_Cursor;
- procedure FreeCursor;
- public
- destructor Destroy; override;
- procedure LoadFromFile( const aFileName : string ); override;
- procedure LoadFromStream( aStream : TStream ); override;
- procedure Show; override;
- end;
-
- TSDLCursorList = class( TStringList )
- protected
- function GetObject( aIndex : Integer ): TSDLCustomCursor; reintroduce;
- procedure PutObject( aIndex : Integer; AObject : TSDLCustomCursor); reintroduce;
- public
- constructor Create;
- function AddCursor(const aName : string; aObject : TSDLCustomCursor): Integer; virtual;
- end;
-
- TSDLMouse = class( TSDLCustomInput )
- private
- FDragging : Boolean;
- FMousePos : TPoint;
- FOnMouseUp: TSDLMouseButtonEvent;
- FOnMouseDown: TSDLMouseButtonEvent;
- FOnMouseMove: TSDLMouseMoveEvent;
- FOnMouseWheel: TSDLMouseWheelEvent;
- FCursorList : TSDLCursorList; // Cursor Pointer
- procedure DoMouseMove( Event: TSDL_Event );
- procedure DoMouseDown( Event: TSDL_Event );
- procedure DoMouseUp( Event: TSDL_Event );
- procedure DoMouseWheelScroll( Event: TSDL_Event );
- function GetMousePosition: TPoint;
- procedure SetMousePosition(const Value: TPoint);
- function GetMouseDelta: TPoint;
- public
- destructor Destroy; override;
- function UpdateInput( event: TSDL_EVENT ) : Boolean; override;
- function MouseIsDown( Button : Integer ) : Boolean;
- function MouseIsUp( Button : Integer ) : Boolean;
- procedure ShowCursor;
- procedure HideCursor;
- property OnMouseDown : TSDLMouseButtonEvent read FOnMouseDown write FOnMouseDown;
- property OnMouseUp : TSDLMouseButtonEvent read FOnMouseUp write FOnMouseUp;
- property OnMouseMove : TSDLMouseMoveEvent read FOnMouseMove write FOnMouseMove;
- property OnMouseWheel : TSDLMouseWheelEvent read FOnMouseWheel write FOnMouseWheel;
- property MousePosition : TPoint read GetMousePosition write SetMousePosition;
- property MouseDelta: TPoint read GetMouseDelta;
- property Cursors : TSDLCursorList read FCursorList write FCursorList;
- end;
-
- TSDLInputManager = class( TObject )
- private
- FKeyBoard : TSDLKeyBoard;
- FMouse : TSDLMouse;
- FJoystick : TSDLJoysticks;
- public
- constructor Create( InitInputs : TSDLInputTypes );
- destructor Destroy; override;
- procedure Disable( InitInputs : TSDLInputTypes; JoyStickNumber : Integer = 0 );
- procedure Enable( InitInputs : TSDLInputTypes; JoyStickNumber : Integer = 0 );
- function UpdateInputs( event: TSDL_EVENT ) : Boolean;
- property KeyBoard : TSDLKeyBoard read FKeyBoard write FKeyBoard;
- property Mouse : TSDLMouse read FMouse write FMouse;
- property JoyStick : TSDLJoysticks read FJoyStick write FJoyStick;
- end;
-
-implementation
-
-uses
- SysUtils;
-
-{ TSDLCustomInput }
-constructor TSDLCustomInput.Create;
-begin
- inherited;
- FEnabled := true;
-end;
-
-{ TSDLJoysticks }
-constructor TSDLJoysticks.Create;
-var
- i : integer;
-begin
- inherited;
- if ( SDL_WasInit( SDL_INIT_JOYSTICK ) = 0 ) then
- SDL_InitSubSystem( SDL_INIT_JOYSTICK );
- FNumOfJoySticks := SDL_NumJoysticks;
- FJoyStickList := TList.Create;
- for i := 0 to FNumOfJoySticks - 1 do
- begin
- FJoyStickList.Add( TSDLJoyStick.Create( i ) );
- end;
-end;
-
-destructor TSDLJoysticks.Destroy;
-var
- i : integer;
-begin
- if FJoyStickList.Count > 0 then
- begin
- for i := 0 to FJoyStickList.Count - 1 do
- begin
- TSDLJoyStick( FJoyStickList.Items[i] ).Free;
- end;
- end;
- SDL_QuitSubSystem( SDL_INIT_JOYSTICK );
- inherited;
-end;
-
-function TSDLJoySticks.GetJoyStick(Index: integer): TSDLJoyStick;
-begin
- Result := TSDLJoyStick( FJoyStickList[ Index ] );
-end;
-
-procedure TSDLJoySticks.SetJoyStick(Index: integer;
- const Value: TSDLJoyStick);
-begin
- FJoyStickList[ Index ] := @Value;
-end;
-
-function TSDLJoysticks.UpdateInput(event: TSDL_EVENT): Boolean;
-var
- i : integer;
-begin
- result := false;
- if FJoyStickList.Count > 0 then
- begin
- for i := 0 to FJoyStickList.Count - 1 do
- begin
- TSDLJoyStick( FJoyStickList.Items[i] ).UpdateInput( event );
- end;
- end;
-end;
-
-{ TSDLKeyBoard }
-procedure TSDLKeyBoard.DoKeyDown(keysym: PSDL_keysym);
-begin
- if Assigned( FOnKeyDown ) then
- FOnKeyDown( keysym.sym , keysym.modifier, keysym.unicode );
-end;
-
-procedure TSDLKeyBoard.DoKeyUp(keysym: PSDL_keysym);
-begin
- if Assigned( FOnKeyUp ) then
- FOnKeyUp( keysym.sym , keysym.modifier, keysym.unicode );
-end;
-
-function TSDLKeyBoard.IsKeyDown( Key: TSDLKey ): Boolean;
-begin
- SDL_PumpEvents;
-
- // Populate Keys array
- FKeys := PKeyStateArr( SDL_GetKeyState( nil ) );
- Result := ( FKeys[Key] = SDL_PRESSED );
-end;
-
-function TSDLKeyBoard.IsKeyUp( Key: TSDLKey ): Boolean;
-begin
- SDL_PumpEvents;
-
- // Populate Keys array
- FKeys := PKeyStateArr( SDL_GetKeyState( nil ) );
- Result := ( FKeys[Key] = SDL_RELEASED );
-end;
-
-function TSDLKeyBoard.UpdateInput(event: TSDL_EVENT): Boolean;
-begin
- result := false;
- if ( FEnabled ) then
- begin
- case event.type_ of
- SDL_KEYDOWN :
- begin
- // handle key presses
- DoKeyDown( @event.key.keysym );
- result := true;
- end;
-
- SDL_KEYUP :
- begin
- // handle key releases
- DoKeyUp( @event.key.keysym );
- result := true;
- end;
- end;
- end;
-end;
-
-{ TSDLMouse }
-destructor TSDLMouse.Destroy;
-begin
-
- inherited;
-end;
-
-procedure TSDLMouse.DoMouseDown( Event: TSDL_Event );
-var
- CurrentPos : TPoint;
-begin
- FDragging := true;
- if Assigned( FOnMouseDown ) then
- begin
- CurrentPos.x := event.button.x;
- CurrentPos.y := event.button.y;
- FOnMouseDown( event.button.button, SDL_GetModState, CurrentPos );
- end;
-end;
-
-procedure TSDLMouse.DoMouseMove( Event: TSDL_Event );
-var
- CurrentPos, RelativePos : TPoint;
-begin
- if Assigned( FOnMouseMove ) then
- begin
- CurrentPos.x := event.motion.x;
- CurrentPos.y := event.motion.y;
- RelativePos.x := event.motion.xrel;
- RelativePos.y := event.motion.yrel;
- FOnMouseMove( SDL_GetModState, CurrentPos, RelativePos );
- end;
-end;
-
-procedure TSDLMouse.DoMouseUp( event: TSDL_EVENT );
-var
- Point : TPoint;
-begin
- FDragging := false;
- if Assigned( FOnMouseUp ) then
- begin
- Point.x := event.button.x;
- Point.y := event.button.y;
- FOnMouseUp( event.button.button, SDL_GetModState, Point );
- end;
-end;
-
-procedure TSDLMouse.DoMouseWheelScroll( event: TSDL_EVENT );
-var
- Point : TPoint;
-begin
- if Assigned( FOnMouseWheel ) then
- begin
- Point.x := event.button.x;
- Point.y := event.button.y;
- if ( event.button.button = SDL_BUTTON_WHEELUP ) then
- FOnMouseWheel( SDL_BUTTON_WHEELUP, SDL_GetModState, Point )
- else
- FOnMouseWheel( SDL_BUTTON_WHEELDOWN, SDL_GetModState, Point );
- end;
-end;
-
-function TSDLMouse.GetMouseDelta: TPoint;
-begin
- SDL_PumpEvents;
-
- SDL_GetRelativeMouseState( Result.X, Result.Y );
-end;
-
-function TSDLMouse.GetMousePosition: TPoint;
-begin
- SDL_PumpEvents;
-
- SDL_GetMouseState( FMousePos.X, FMousePos.Y );
- Result := FMousePos;
-end;
-
-procedure TSDLMouse.HideCursor;
-begin
- SDL_ShowCursor( SDL_DISABLE );
-end;
-
-function TSDLMouse.MouseIsDown(Button: Integer): Boolean;
-begin
- SDL_PumpEvents;
-
- Result := ( SDL_GetMouseState( FMousePos.X, FMousePos.Y ) and SDL_BUTTON( Button ) = 0 );
-end;
-
-function TSDLMouse.MouseIsUp(Button: Integer): Boolean;
-begin
- SDL_PumpEvents;
-
- Result := not ( SDL_GetMouseState( FMousePos.X, FMousePos.Y ) and SDL_BUTTON( Button ) = 0 );
-end;
-
-procedure TSDLMouse.SetMousePosition(const Value: TPoint);
-begin
- SDL_WarpMouse( Value.x, Value.y );
-end;
-
-procedure TSDLMouse.ShowCursor;
-begin
- SDL_ShowCursor( SDL_ENABLE );
-end;
-
-function TSDLMouse.UpdateInput(event: TSDL_EVENT): Boolean;
-begin
- result := false;
- if ( FEnabled ) then
- begin
- case event.type_ of
- SDL_MOUSEMOTION :
- begin
- // handle Mouse Move
- DoMouseMove( event );
- end;
-
- SDL_MOUSEBUTTONDOWN :
- begin
- // handle Mouse Down
- if ( event.button.button = SDL_BUTTON_WHEELUP )
- or ( event.button.button = SDL_BUTTON_WHEELDOWN ) then
- DoMouseWheelScroll( event )
- else
- DoMouseDown( event );
- end;
-
- SDL_MOUSEBUTTONUP :
- begin
- // handle Mouse Up
- if ( event.button.button = SDL_BUTTON_WHEELUP )
- or ( event.button.button = SDL_BUTTON_WHEELDOWN ) then
- DoMouseWheelScroll( event )
- else
- DoMouseUp( event );
- end;
- end;
- end;
-end;
-
-{ TSDLInputManager }
-constructor TSDLInputManager.Create(InitInputs: TSDLInputTypes);
-begin
- inherited Create;
- if itJoystick in InitInputs then
- FJoystick := TSDLJoysticks.Create;
-
- if itKeyBoard in InitInputs then
- FKeyBoard := TSDLKeyBoard.Create;
-
- if itMouse in InitInputs then
- FMouse := TSDLMouse.Create;
-end;
-
-destructor TSDLInputManager.Destroy;
-begin
- if FJoystick <> nil then
- FreeAndNil( FJoystick );
- if FKeyBoard <> nil then
- FreeAndNil( FKeyBoard );
- if FMouse <> nil then
- FreeAndNil( FMouse );
- inherited;
-end;
-
-procedure TSDLInputManager.Disable( InitInputs : TSDLInputTypes; JoyStickNumber : Integer );
-begin
- if itJoystick in InitInputs then
- FJoystick.JoySticks[ JoyStickNumber ].Enabled := false;
-
- if itKeyBoard in InitInputs then
- FKeyBoard.Enabled := false;
-
- if itMouse in InitInputs then
- FMouse.Enabled := false;
-end;
-
-procedure TSDLInputManager.Enable( InitInputs: TSDLInputTypes; JoyStickNumber: Integer );
-begin
- if itJoystick in InitInputs then
- FJoystick.JoySticks[ JoyStickNumber ].Enabled := true;
-
- if itKeyBoard in InitInputs then
- FKeyBoard.Enabled := true;
-
- if itMouse in InitInputs then
- FMouse.Enabled := true;
-end;
-
-function TSDLInputManager.UpdateInputs( event: TSDL_EVENT ): Boolean;
-begin
- Result := false;
- if ( FJoystick <> nil ) then
- Result := FJoystick.UpdateInput( event );
- if ( FKeyBoard <> nil ) then
- Result := FKeyBoard.UpdateInput( event );
- if ( FMouse <> nil ) then
- Result := FMouse.UpdateInput( event );
-end;
-
-{ TSDLJoyStick }
-procedure TSDLJoyStick.Close;
-begin
- SDL_JoystickClose( @FJoystick );
-end;
-
-constructor TSDLJoyStick.Create( Index : Integer );
-begin
- inherited Create;
- FJoystick := nil;
- FJoystickIndex := Index;
-end;
-
-destructor TSDLJoyStick.Destroy;
-begin
- if FJoystick <> nil then
- Close;
- inherited;
-end;
-
-procedure TSDLJoyStick.DoAxisMove(Event: TSDL_Event);
-begin
- if Assigned( FJoyAxisMoveEvent ) then
- begin
- FJoyAxisMoveEvent( Event.jaxis.which, Event.jaxis.axis, Event.jaxis.value );
- end
-end;
-
-procedure TSDLJoyStick.DoBallMove(Event: TSDL_Event);
-var
- BallPoint : TPoint;
-begin
- if Assigned( FJoyBallMoveEvent ) then
- begin
- BallPoint.x := Event.jball.xrel;
- BallPoint.y := Event.jball.yrel;
- FJoyBallMoveEvent( Event.jball.which, Event.jball.ball, BallPoint );
- end;
-end;
-
-procedure TSDLJoyStick.DoButtonDown(Event: TSDL_Event);
-begin
- if Assigned( FJoyButtonDownEvent ) then
- begin
- if ( Event.jbutton.state = SDL_PRESSED ) then
- FJoyButtonDownEvent( Event.jbutton.which, Event.jbutton.button, Event.jbutton.state );
- end;
-end;
-
-procedure TSDLJoyStick.DoButtonUp(Event: TSDL_Event);
-begin
- if Assigned( FJoyButtonUpEvent ) then
- begin
- if ( Event.jbutton.state = SDL_RELEASED ) then
- FJoyButtonUpEvent( Event.jbutton.which, Event.jbutton.button, Event.jbutton.state );
- end
-end;
-
-procedure TSDLJoyStick.DoHatMove(Event: TSDL_Event);
-begin
- if Assigned( FJoyHatMoveEvent ) then
- begin
- FJoyHatMoveEvent( Event.jhat.which, Event.jhat.hat, Event.jhat.value );
- end;
-end;
-
-function TSDLJoyStick.GetName: PChar;
-begin
- result := FJoystick.name;
-end;
-
-function TSDLJoyStick.GetNumAxes: integer;
-begin
- result := FJoystick.naxes;
-end;
-
-function TSDLJoyStick.GetNumBalls: integer;
-begin
- result := FJoystick.nballs;
-end;
-
-function TSDLJoyStick.GetNumButtons: integer;
-begin
- result := FJoystick.nbuttons;
-end;
-
-function TSDLJoyStick.GetNumHats: integer;
-begin
- result := FJoystick.nhats;
-end;
-
-procedure TSDLJoyStick.Open;
-begin
- FJoystick := SDL_JoyStickOpen( FJoystickIndex );
-end;
-
-function TSDLJoyStick.UpdateInput(Event: TSDL_EVENT): Boolean;
-begin
- Result := false;
-
- if ( FEnabled ) then
- begin
- case event.type_ of
- SDL_JOYAXISMOTION :
- begin
- DoAxisMove( Event );
- end;
-
- SDL_JOYBALLMOTION :
- begin
- DoBallMove( Event );
- end;
-
- SDL_JOYHATMOTION :
- begin
- DoHatMove( Event );
- end;
-
- SDL_JOYBUTTONDOWN :
- begin
- DoButtonDown( Event );
- end;
-
- SDL_JOYBUTTONUP :
- begin
- DoButtonUp( Event );
- end;
- end;
- end;
-end;
-
-{ TSDLCustomCursor }
-
-constructor TSDLCustomCursor.Create(const aFileName: string; aHotPoint: TPoint);
-begin
- inherited Create;
- FHotPoint := aHotPoint;
- LoadFromFile( aFileName );
-end;
-
-function TSDLCustomCursor.ScanForChar(str: string; ch: Char;
- startPos: Integer; lookFor: Boolean): Integer;
-begin
- Result := -1;
- while ( ( ( str[ startPos ] = ch ) <> lookFor ) and ( startPos < Length( str ) ) ) do
- inc( startPos );
- if startPos <> Length( str ) then
- Result := startPos;
-end;
-
-procedure TSDLCustomCursor.SetFileName(const aValue: string);
-begin
- LoadFromFile( aValue );
-end;
-
-{ TSDLXPMCursor }
-
-destructor TSDLXPMCursor.Destroy;
-begin
- FreeCursor;
- inherited;
-end;
-
-procedure TSDLXPMCursor.FreeCursor;
-begin
- if FCursor <> nil then
- begin
- SDL_FreeCursor( FCursor );
- FFileName := '';
- end;
-end;
-
-procedure TSDLXPMCursor.LoadFromFile(const aFileName: string);
-var
- xpmFile : Textfile;
- step : Integer;
- holdPos : Integer;
- counter : Integer;
- dimensions : array[ 1..3 ] of Integer;
- clr, clrNone, clrBlack, clrWhite : Char;
- data, mask : array of UInt8;
- i, col : Integer;
- LineString : string;
-begin
- FreeCursor;
- AssignFile( xpmFile, aFileName );
- Reset( xpmFile );
- step := 0;
- i := -1;
- clrBlack := 'X';
- clrWhite := ',';
- clrNone := ' ';
- counter := 0;
- while not ( eof( xpmFile ) ) do
- begin
- Readln( xpmFile, LineString );
- // scan for strings
- if LineString[ 1 ] = '"' then
- begin
- case step of
- 0 : // Get dimensions (should be width height number-of-colors ???)
- begin
- HoldPos := 2;
- counter := ScanForChar( LineString, ' ', HoldPos, False );
- counter := ScanForChar( LineString, ' ', counter, True );
- dimensions[ 1 ] := StrToInt( Copy( LineString, HoldPos, counter - HoldPos ) );
- counter := ScanForChar( LineString, ' ', counter, False );
- holdPos := counter;
- counter := ScanForChar( LineString, ' ', counter, True );
- dimensions[ 2 ] := StrToInt( Copy( LineString, holdPos, counter - HoldPos ) );
- counter := ScanForChar( LineString, ' ', counter, False );
- holdPos := counter;
- counter := ScanForChar( LineString, ' ', counter, True );
- dimensions[ 3 ] := StrToInt( Copy( LineString, holdPos, counter - HoldPos ) );
- step := 1;
- SetLength( data, ( dimensions[ 1 ] * dimensions[ 2 ] ) div 8 );
- SetLength( mask, ( dimensions[ 1 ] * dimensions[ 2 ] ) div 8 );
- //Log.LogStatus( 'Length = ' + IntToStr( ( dimensions[ 1 ] * dimensions[ 2 ] ) div 8 ), 'LoadCursorFromFile' );
- end;
- 1 : // get the symbols for transparent, black and white
- begin
- // get the symbol for the color
- clr := LineString[ 2 ];
- // look for the 'c' symbol
- counter := ScanForChar( LineString, 'c', 3, True );
- inc( counter );
- counter := ScanForChar( LineString, ' ', counter, False );
- if LowerCase( Copy( LineString, counter, 4 ) ) = 'none' then
- begin
- clrNone := clr;
- end;
- if LowerCase( Copy( LineString, counter, 7 ) ) = '#ffffff' then
- begin
- clrWhite := clr;
- end;
- if LowerCase( Copy( LineString, counter, 7 ) ) = '#000000' then
- begin
- clrBlack := clr;
- end;
- dec( dimensions[ 3 ] );
- if dimensions[ 3 ] = 0 then
- begin
- step := 2;
- counter := 0;
- end;
- end;
- 2 : // get cursor information -- modified from the SDL
- // documentation of SDL_CreateCursor.
- begin
- for col := 1 to dimensions[1] do
- begin
- if ( ( col mod 8 ) <> 1 ) then
- begin
- data[ i ] := data[ i ] shl 1;
- mask[ i ] := mask[ i ] shl 1;
- end
- else
- begin
- inc( i );
- data[ i ] := 0;
- mask[ i ] := 0;
- end;
- if LineString[ col ] = clrWhite then
- begin
- mask[ i ] := mask[ i ] or $01;
- end
- else if LineString[ col ] = clrBlack then
- begin
- data[ i ] := data[ i ] or $01;
- mask[ i ] := mask[ i ] or $01;
- end
- else if LineString[ col + 1 ] = clrNone then
- begin
- //
- end;
- end;
- inc(counter);
- if counter = dimensions[2] then
- step := 4;
- end;
- end;
- end;
- end;
- CloseFile( xpmFile );
- FCursor := SDL_CreateCursor( PUInt8( data ), PUInt8( mask ), dimensions[ 1 ], dimensions[ 2 ], FHotPoint.x, FHotPoint.y );
-end;
-
-procedure TSDLXPMCursor.LoadFromStream(aStream: TStream);
-begin
- inherited;
-
-end;
-
-procedure TSDLXPMCursor.Show;
-begin
- inherited;
- SDL_SetCursor( FCursor );
-end;
-
-{ TSDLCursorList }
-function TSDLCursorList.AddCursor(const aName : string; aObject : TSDLCustomCursor): Integer;
-begin
- result := inherited AddObject( aName, aObject );
-end;
-
-constructor TSDLCursorList.Create;
-begin
- inherited;
- Duplicates := dupIgnore;
-end;
-
-function TSDLCursorList.GetObject(aIndex: Integer): TSDLCustomCursor;
-begin
- result := TSDLCustomCursor( inherited GetObject( aIndex ) );
-end;
-
-procedure TSDLCursorList.PutObject(aIndex: Integer; aObject: TSDLCustomCursor);
-begin
- inherited PutObject( aIndex, aObject );
-end;
-
-end.
+unit sdlinput; +{ + $Id: sdlinput.pas,v 1.9 2007/08/22 21:18:43 savage Exp $ + +} +{******************************************************************************} +{ } +{ JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer } +{ SDL Input Wrapper } +{ } +{ } +{ The initial developer of this Pascal code was : } +{ Dominique Louis <Dominique@SavageSoftware.com.au> } +{ } +{ Portions created by Dominique Louis are } +{ Copyright (C) 2003 - 2100 Dominique Louis. } +{ } +{ } +{ Contributor(s) } +{ -------------- } +{ Dominique Louis <Dominique@SavageSoftware.com.au> } +{ } +{ Obtained through: } +{ Joint Endeavour of Delphi Innovators ( Project JEDI ) } +{ } +{ You may retrieve the latest version of this file at the Project } +{ JEDI home page, located at http://delphi-jedi.org } +{ } +{ The contents of this file are used with permission, subject to } +{ the Mozilla Public License Version 1.1 (the "License"); you may } +{ not use this file except in compliance with the License. You may } +{ obtain a copy of the License at } +{ http://www.mozilla.org/MPL/MPL-1.1.html } +{ } +{ Software distributed under the License is distributed on an } +{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or } +{ implied. See the License for the specific language governing } +{ rights and limitations under the License. } +{ } +{ Description } +{ ----------- } +{ SDL Mouse, Keyboard and Joystick wrapper } +{ } +{ } +{ Requires } +{ -------- } +{ SDL.dll on Windows platforms } +{ libSDL-1.1.so.0 on Linux platform } +{ } +{ Programming Notes } +{ ----------------- } +{ } +{ } +{ } +{ } +{ Revision History } +{ ---------------- } +{ March 12 2003 - DL : Initial creation } +{ } +{ February 02 2004 - DL : Added Custom Cursor Support to the Mouse class } +{ + $Log: sdlinput.pas,v $ + Revision 1.9 2007/08/22 21:18:43 savage + Thanks to Dean for his MouseDelta patch. + + Revision 1.8 2005/08/03 18:57:32 savage + Various updates and additions. Mainly to handle OpenGL 3D Window support and better cursor support for the mouse class + + Revision 1.7 2004/09/30 22:32:04 savage + Updated with slightly different header comments + + Revision 1.6 2004/09/12 21:52:58 savage + Slight changes to fix some issues with the sdl classes. + + Revision 1.5 2004/05/10 21:11:49 savage + changes required to help get SoAoS off the ground. + + Revision 1.4 2004/05/03 22:38:40 savage + Added the ability to enable or disable certain inputs @ runtime. Basically it just does not call UpdateInput if Enabled = false. + Can also disable and enable input devices via the InputManager. + + Revision 1.3 2004/04/28 21:27:01 savage + Updated Joystick code and event handlers. Needs testing... + + Revision 1.2 2004/02/14 22:36:29 savage + Fixed inconsistencies of using LoadLibrary and LoadModule. + Now all units make use of LoadModule rather than LoadLibrary and other dynamic proc procedures. + + Revision 1.1 2004/02/05 00:08:20 savage + Module 1.0 release + + +} +{******************************************************************************} + +interface + +{$i jedi-sdl.inc} + +uses + Classes, + sdl; + +type + TSDLInputType = ( itJoystick , itKeyBoard, itMouse ); + TSDLInputTypes = set of TSDLInputType; + + TSDLCustomInput = class( TObject ) + private + FEnabled: Boolean; + public + constructor Create; + function UpdateInput( event: TSDL_EVENT ) : Boolean; virtual; abstract; + property Enabled : Boolean read FEnabled write FEnabled; + end; + + TSDLJoyAxisMoveEvent = procedure ( Which: UInt8; Axis: UInt8; Value: SInt16 ) {$IFNDEF NOT_OO}of object{$ENDIF}; + TSDLJoyBallMoveEvent = procedure ( Which: UInt8; Ball: UInt8; RelativePos: TPoint ) {$IFNDEF NOT_OO}of object{$ENDIF}; + TSDLJoyHatMoveEvent = procedure ( Which: UInt8; Hat: UInt8; Value: SInt16 ) {$IFNDEF NOT_OO}of object{$ENDIF}; + TSDLJoyButtonEvent = procedure ( Which: UInt8; Button: UInt8; State: SInt16 ) {$IFNDEF NOT_OO}of object{$ENDIF}; + + + TSDLJoyStick = class( TSDLCustomInput ) + private + FJoystick : PSDL_Joystick; + FJoystickIndex : Integer; + FJoyAxisMoveEvent : TSDLJoyAxisMoveEvent; + FJoyBallMoveEvent : TSDLJoyBallMoveEvent; + FJoyHatMoveEvent : TSDLJoyHatMoveEvent; + FJoyButtonDownEvent : TSDLJoyButtonEvent; + FJoyButtonUpEvent : TSDLJoyButtonEvent; + procedure DoAxisMove( Event : TSDL_Event ); + procedure DoBallMove( Event : TSDL_Event ); + procedure DoHatMove( Event : TSDL_Event ); + procedure DoButtonDown( Event : TSDL_Event ); + procedure DoButtonUp( Event : TSDL_Event ); + function GetName: PChar; + function GetNumAxes: integer; + function GetNumBalls: integer; + function GetNumButtons: integer; + function GetNumHats: integer; + public + constructor Create( Index : Integer ); + destructor Destroy; override; + procedure Open; + procedure Close; + function UpdateInput( Event: TSDL_EVENT ) : Boolean; override; + property Name : PChar read GetName; + property NumAxes : integer read GetNumAxes; + property NumBalls : integer read GetNumBalls; + property NumButtons : integer read GetNumButtons; + property NumHats : integer read GetNumHats; + property OnAxisMove : TSDLJoyAxisMoveEvent read FJoyAxisMoveEvent write FJoyAxisMoveEvent; + property OnBallMove : TSDLJoyBallMoveEvent read FJoyBallMoveEvent write FJoyBallMoveEvent; + property OnHatMove : TSDLJoyHatMoveEvent read FJoyHatMoveEvent write FJoyHatMoveEvent; + property OnButtonDown : TSDLJoyButtonEvent read FJoyButtonDownEvent write FJoyButtonDownEvent; + property OnButtonUp : TSDLJoyButtonEvent read FJoyButtonUpEvent write FJoyButtonUpEvent; + end; + + TSDLJoySticks = class( TObject ) + private + FNumOfJoySticks: Integer; + FJoyStickList : TList; + function GetJoyStick(Index: integer): TSDLJoyStick; + procedure SetJoyStick(Index: integer; const Value: TSDLJoyStick); + public + constructor Create; + destructor Destroy; override; + function UpdateInput( event: TSDL_EVENT ) : Boolean; + property NumOfJoySticks : Integer read FNumOfJoySticks write FNumOfJoySticks; + property JoySticks[ Index : integer ] : TSDLJoyStick read GetJoyStick write SetJoyStick; + end; + + TSDLKeyBoardEvent = procedure ( var Key: TSDLKey; Shift: TSDLMod; unicode : UInt16 ) {$IFNDEF NOT_OO}of object{$ENDIF}; + + TSDLKeyBoard = class( TSDLCustomInput ) + private + FKeys : PKeyStateArr; + FOnKeyUp: TSDLKeyBoardEvent; + FOnKeyDown: TSDLKeyBoardEvent; + procedure DoKeyDown( keysym : PSDL_keysym ); + procedure DoKeyUp( keysym : PSDL_keysym ); + public + function IsKeyDown( Key : TSDLKey ) : Boolean; + function IsKeyUp( Key : TSDLKey ) : Boolean; + function UpdateInput( event: TSDL_EVENT ) : Boolean; override; + property Keys : PKeyStateArr read FKeys write FKeys; + property OnKeyDown : TSDLKeyBoardEvent read FOnKeyDown write FOnKeyDown; + property OnKeyUp : TSDLKeyBoardEvent read FOnKeyUp write FOnKeyUp; + end; + + TSDLMouseButtonEvent = procedure ( Button : Integer; Shift: TSDLMod; MousePos : TPoint ) {$IFNDEF NOT_OO}of object{$ENDIF}; + TSDLMouseMoveEvent = procedure ( Shift: TSDLMod; CurrentPos : TPoint; RelativePos : TPoint ) {$IFNDEF NOT_OO}of object{$ENDIF}; + TSDLMouseWheelEvent = procedure ( WheelDelta : Integer; Shift: TSDLMod; MousePos : TPoint ) {$IFNDEF NOT_OO}of object{$ENDIF}; + + TSDLCustomCursor = class( TObject ) + private + FFileName : string; + FHotPoint: TPoint; + procedure SetFileName(const aValue: string ); + function ScanForChar( str : string; ch : Char; startPos : Integer; lookFor : Boolean ) : Integer; + public + constructor Create( const aFileName : string; aHotPoint: TPoint ); + procedure LoadFromFile( const aFileName : string ); virtual; abstract; + procedure LoadFromStream( aStream : TStream ); virtual; abstract; + procedure Show; virtual; abstract; + property FileName : string read FFileName write SetFileName; + property HotPoint : TPoint read FHotPoint write FHotPoint; + end; + + TSDLXPMCursor = class( TSDLCustomCursor ) + private + FCursor : PSDL_Cursor; + procedure FreeCursor; + public + destructor Destroy; override; + procedure LoadFromFile( const aFileName : string ); override; + procedure LoadFromStream( aStream : TStream ); override; + procedure Show; override; + end; + + TSDLCursorList = class( TStringList ) + protected + function GetObject( aIndex : Integer ): TSDLCustomCursor; reintroduce; + procedure PutObject( aIndex : Integer; AObject : TSDLCustomCursor); reintroduce; + public + constructor Create; + function AddCursor(const aName : string; aObject : TSDLCustomCursor): Integer; virtual; + end; + + TSDLMouse = class( TSDLCustomInput ) + private + FDragging : Boolean; + FMousePos : TPoint; + FOnMouseUp: TSDLMouseButtonEvent; + FOnMouseDown: TSDLMouseButtonEvent; + FOnMouseMove: TSDLMouseMoveEvent; + FOnMouseWheel: TSDLMouseWheelEvent; + FCursorList : TSDLCursorList; // Cursor Pointer + procedure DoMouseMove( Event: TSDL_Event ); + procedure DoMouseDown( Event: TSDL_Event ); + procedure DoMouseUp( Event: TSDL_Event ); + procedure DoMouseWheelScroll( Event: TSDL_Event ); + function GetMousePosition: TPoint; + procedure SetMousePosition(const Value: TPoint); + function GetMouseDelta: TPoint; + public + destructor Destroy; override; + function UpdateInput( event: TSDL_EVENT ) : Boolean; override; + function MouseIsDown( Button : Integer ) : Boolean; + function MouseIsUp( Button : Integer ) : Boolean; + procedure ShowCursor; + procedure HideCursor; + property OnMouseDown : TSDLMouseButtonEvent read FOnMouseDown write FOnMouseDown; + property OnMouseUp : TSDLMouseButtonEvent read FOnMouseUp write FOnMouseUp; + property OnMouseMove : TSDLMouseMoveEvent read FOnMouseMove write FOnMouseMove; + property OnMouseWheel : TSDLMouseWheelEvent read FOnMouseWheel write FOnMouseWheel; + property MousePosition : TPoint read GetMousePosition write SetMousePosition; + property MouseDelta: TPoint read GetMouseDelta; + property Cursors : TSDLCursorList read FCursorList write FCursorList; + end; + + TSDLInputManager = class( TObject ) + private + FKeyBoard : TSDLKeyBoard; + FMouse : TSDLMouse; + FJoystick : TSDLJoysticks; + public + constructor Create( InitInputs : TSDLInputTypes ); + destructor Destroy; override; + procedure Disable( InitInputs : TSDLInputTypes; JoyStickNumber : Integer = 0 ); + procedure Enable( InitInputs : TSDLInputTypes; JoyStickNumber : Integer = 0 ); + function UpdateInputs( event: TSDL_EVENT ) : Boolean; + property KeyBoard : TSDLKeyBoard read FKeyBoard write FKeyBoard; + property Mouse : TSDLMouse read FMouse write FMouse; + property JoyStick : TSDLJoysticks read FJoyStick write FJoyStick; + end; + +implementation + +uses + SysUtils; + +{ TSDLCustomInput } +constructor TSDLCustomInput.Create; +begin + inherited; + FEnabled := true; +end; + +{ TSDLJoysticks } +constructor TSDLJoysticks.Create; +var + i : integer; +begin + inherited; + if ( SDL_WasInit( SDL_INIT_JOYSTICK ) = 0 ) then + SDL_InitSubSystem( SDL_INIT_JOYSTICK ); + FNumOfJoySticks := SDL_NumJoysticks; + FJoyStickList := TList.Create; + for i := 0 to FNumOfJoySticks - 1 do + begin + FJoyStickList.Add( TSDLJoyStick.Create( i ) ); + end; +end; + +destructor TSDLJoysticks.Destroy; +var + i : integer; +begin + if FJoyStickList.Count > 0 then + begin + for i := 0 to FJoyStickList.Count - 1 do + begin + TSDLJoyStick( FJoyStickList.Items[i] ).Free; + end; + end; + SDL_QuitSubSystem( SDL_INIT_JOYSTICK ); + inherited; +end; + +function TSDLJoySticks.GetJoyStick(Index: integer): TSDLJoyStick; +begin + Result := TSDLJoyStick( FJoyStickList[ Index ] ); +end; + +procedure TSDLJoySticks.SetJoyStick(Index: integer; + const Value: TSDLJoyStick); +begin + FJoyStickList[ Index ] := @Value; +end; + +function TSDLJoysticks.UpdateInput(event: TSDL_EVENT): Boolean; +var + i : integer; +begin + result := false; + if FJoyStickList.Count > 0 then + begin + for i := 0 to FJoyStickList.Count - 1 do + begin + TSDLJoyStick( FJoyStickList.Items[i] ).UpdateInput( event ); + end; + end; +end; + +{ TSDLKeyBoard } +procedure TSDLKeyBoard.DoKeyDown(keysym: PSDL_keysym); +begin + if Assigned( FOnKeyDown ) then + FOnKeyDown( keysym.sym , keysym.modifier, keysym.unicode ); +end; + +procedure TSDLKeyBoard.DoKeyUp(keysym: PSDL_keysym); +begin + if Assigned( FOnKeyUp ) then + FOnKeyUp( keysym.sym , keysym.modifier, keysym.unicode ); +end; + +function TSDLKeyBoard.IsKeyDown( Key: TSDLKey ): Boolean; +begin + SDL_PumpEvents; + + // Populate Keys array + FKeys := PKeyStateArr( SDL_GetKeyState( nil ) ); + Result := ( FKeys[Key] = SDL_PRESSED ); +end; + +function TSDLKeyBoard.IsKeyUp( Key: TSDLKey ): Boolean; +begin + SDL_PumpEvents; + + // Populate Keys array + FKeys := PKeyStateArr( SDL_GetKeyState( nil ) ); + Result := ( FKeys[Key] = SDL_RELEASED ); +end; + +function TSDLKeyBoard.UpdateInput(event: TSDL_EVENT): Boolean; +begin + result := false; + if ( FEnabled ) then + begin + case event.type_ of + SDL_KEYDOWN : + begin + // handle key presses + DoKeyDown( @event.key.keysym ); + result := true; + end; + + SDL_KEYUP : + begin + // handle key releases + DoKeyUp( @event.key.keysym ); + result := true; + end; + end; + end; +end; + +{ TSDLMouse } +destructor TSDLMouse.Destroy; +begin + + inherited; +end; + +procedure TSDLMouse.DoMouseDown( Event: TSDL_Event ); +var + CurrentPos : TPoint; +begin + FDragging := true; + if Assigned( FOnMouseDown ) then + begin + CurrentPos.x := event.button.x; + CurrentPos.y := event.button.y; + FOnMouseDown( event.button.button, SDL_GetModState, CurrentPos ); + end; +end; + +procedure TSDLMouse.DoMouseMove( Event: TSDL_Event ); +var + CurrentPos, RelativePos : TPoint; +begin + if Assigned( FOnMouseMove ) then + begin + CurrentPos.x := event.motion.x; + CurrentPos.y := event.motion.y; + RelativePos.x := event.motion.xrel; + RelativePos.y := event.motion.yrel; + FOnMouseMove( SDL_GetModState, CurrentPos, RelativePos ); + end; +end; + +procedure TSDLMouse.DoMouseUp( event: TSDL_EVENT ); +var + Point : TPoint; +begin + FDragging := false; + if Assigned( FOnMouseUp ) then + begin + Point.x := event.button.x; + Point.y := event.button.y; + FOnMouseUp( event.button.button, SDL_GetModState, Point ); + end; +end; + +procedure TSDLMouse.DoMouseWheelScroll( event: TSDL_EVENT ); +var + Point : TPoint; +begin + if Assigned( FOnMouseWheel ) then + begin + Point.x := event.button.x; + Point.y := event.button.y; + if ( event.button.button = SDL_BUTTON_WHEELUP ) then + FOnMouseWheel( SDL_BUTTON_WHEELUP, SDL_GetModState, Point ) + else + FOnMouseWheel( SDL_BUTTON_WHEELDOWN, SDL_GetModState, Point ); + end; +end; + +function TSDLMouse.GetMouseDelta: TPoint; +begin + SDL_PumpEvents; + + SDL_GetRelativeMouseState( Result.X, Result.Y ); +end; + +function TSDLMouse.GetMousePosition: TPoint; +begin + SDL_PumpEvents; + + SDL_GetMouseState( FMousePos.X, FMousePos.Y ); + Result := FMousePos; +end; + +procedure TSDLMouse.HideCursor; +begin + SDL_ShowCursor( SDL_DISABLE ); +end; + +function TSDLMouse.MouseIsDown(Button: Integer): Boolean; +begin + SDL_PumpEvents; + + Result := ( SDL_GetMouseState( FMousePos.X, FMousePos.Y ) and SDL_BUTTON( Button ) = 0 ); +end; + +function TSDLMouse.MouseIsUp(Button: Integer): Boolean; +begin + SDL_PumpEvents; + + Result := not ( SDL_GetMouseState( FMousePos.X, FMousePos.Y ) and SDL_BUTTON( Button ) = 0 ); +end; + +procedure TSDLMouse.SetMousePosition(const Value: TPoint); +begin + SDL_WarpMouse( Value.x, Value.y ); +end; + +procedure TSDLMouse.ShowCursor; +begin + SDL_ShowCursor( SDL_ENABLE ); +end; + +function TSDLMouse.UpdateInput(event: TSDL_EVENT): Boolean; +begin + result := false; + if ( FEnabled ) then + begin + case event.type_ of + SDL_MOUSEMOTION : + begin + // handle Mouse Move + DoMouseMove( event ); + end; + + SDL_MOUSEBUTTONDOWN : + begin + // handle Mouse Down + if ( event.button.button = SDL_BUTTON_WHEELUP ) + or ( event.button.button = SDL_BUTTON_WHEELDOWN ) then + DoMouseWheelScroll( event ) + else + DoMouseDown( event ); + end; + + SDL_MOUSEBUTTONUP : + begin + // handle Mouse Up + if ( event.button.button = SDL_BUTTON_WHEELUP ) + or ( event.button.button = SDL_BUTTON_WHEELDOWN ) then + DoMouseWheelScroll( event ) + else + DoMouseUp( event ); + end; + end; + end; +end; + +{ TSDLInputManager } +constructor TSDLInputManager.Create(InitInputs: TSDLInputTypes); +begin + inherited Create; + if itJoystick in InitInputs then + FJoystick := TSDLJoysticks.Create; + + if itKeyBoard in InitInputs then + FKeyBoard := TSDLKeyBoard.Create; + + if itMouse in InitInputs then + FMouse := TSDLMouse.Create; +end; + +destructor TSDLInputManager.Destroy; +begin + if FJoystick <> nil then + FreeAndNil( FJoystick ); + if FKeyBoard <> nil then + FreeAndNil( FKeyBoard ); + if FMouse <> nil then + FreeAndNil( FMouse ); + inherited; +end; + +procedure TSDLInputManager.Disable( InitInputs : TSDLInputTypes; JoyStickNumber : Integer ); +begin + if itJoystick in InitInputs then + FJoystick.JoySticks[ JoyStickNumber ].Enabled := false; + + if itKeyBoard in InitInputs then + FKeyBoard.Enabled := false; + + if itMouse in InitInputs then + FMouse.Enabled := false; +end; + +procedure TSDLInputManager.Enable( InitInputs: TSDLInputTypes; JoyStickNumber: Integer ); +begin + if itJoystick in InitInputs then + FJoystick.JoySticks[ JoyStickNumber ].Enabled := true; + + if itKeyBoard in InitInputs then + FKeyBoard.Enabled := true; + + if itMouse in InitInputs then + FMouse.Enabled := true; +end; + +function TSDLInputManager.UpdateInputs( event: TSDL_EVENT ): Boolean; +begin + Result := false; + if ( FJoystick <> nil ) then + Result := FJoystick.UpdateInput( event ); + if ( FKeyBoard <> nil ) then + Result := FKeyBoard.UpdateInput( event ); + if ( FMouse <> nil ) then + Result := FMouse.UpdateInput( event ); +end; + +{ TSDLJoyStick } +procedure TSDLJoyStick.Close; +begin + SDL_JoystickClose( @FJoystick ); +end; + +constructor TSDLJoyStick.Create( Index : Integer ); +begin + inherited Create; + FJoystick := nil; + FJoystickIndex := Index; +end; + +destructor TSDLJoyStick.Destroy; +begin + if FJoystick <> nil then + Close; + inherited; +end; + +procedure TSDLJoyStick.DoAxisMove(Event: TSDL_Event); +begin + if Assigned( FJoyAxisMoveEvent ) then + begin + FJoyAxisMoveEvent( Event.jaxis.which, Event.jaxis.axis, Event.jaxis.value ); + end +end; + +procedure TSDLJoyStick.DoBallMove(Event: TSDL_Event); +var + BallPoint : TPoint; +begin + if Assigned( FJoyBallMoveEvent ) then + begin + BallPoint.x := Event.jball.xrel; + BallPoint.y := Event.jball.yrel; + FJoyBallMoveEvent( Event.jball.which, Event.jball.ball, BallPoint ); + end; +end; + +procedure TSDLJoyStick.DoButtonDown(Event: TSDL_Event); +begin + if Assigned( FJoyButtonDownEvent ) then + begin + if ( Event.jbutton.state = SDL_PRESSED ) then + FJoyButtonDownEvent( Event.jbutton.which, Event.jbutton.button, Event.jbutton.state ); + end; +end; + +procedure TSDLJoyStick.DoButtonUp(Event: TSDL_Event); +begin + if Assigned( FJoyButtonUpEvent ) then + begin + if ( Event.jbutton.state = SDL_RELEASED ) then + FJoyButtonUpEvent( Event.jbutton.which, Event.jbutton.button, Event.jbutton.state ); + end +end; + +procedure TSDLJoyStick.DoHatMove(Event: TSDL_Event); +begin + if Assigned( FJoyHatMoveEvent ) then + begin + FJoyHatMoveEvent( Event.jhat.which, Event.jhat.hat, Event.jhat.value ); + end; +end; + +function TSDLJoyStick.GetName: PChar; +begin + result := FJoystick.name; +end; + +function TSDLJoyStick.GetNumAxes: integer; +begin + result := FJoystick.naxes; +end; + +function TSDLJoyStick.GetNumBalls: integer; +begin + result := FJoystick.nballs; +end; + +function TSDLJoyStick.GetNumButtons: integer; +begin + result := FJoystick.nbuttons; +end; + +function TSDLJoyStick.GetNumHats: integer; +begin + result := FJoystick.nhats; +end; + +procedure TSDLJoyStick.Open; +begin + FJoystick := SDL_JoyStickOpen( FJoystickIndex ); +end; + +function TSDLJoyStick.UpdateInput(Event: TSDL_EVENT): Boolean; +begin + Result := false; + + if ( FEnabled ) then + begin + case event.type_ of + SDL_JOYAXISMOTION : + begin + DoAxisMove( Event ); + end; + + SDL_JOYBALLMOTION : + begin + DoBallMove( Event ); + end; + + SDL_JOYHATMOTION : + begin + DoHatMove( Event ); + end; + + SDL_JOYBUTTONDOWN : + begin + DoButtonDown( Event ); + end; + + SDL_JOYBUTTONUP : + begin + DoButtonUp( Event ); + end; + end; + end; +end; + +{ TSDLCustomCursor } + +constructor TSDLCustomCursor.Create(const aFileName: string; aHotPoint: TPoint); +begin + inherited Create; + FHotPoint := aHotPoint; + LoadFromFile( aFileName ); +end; + +function TSDLCustomCursor.ScanForChar(str: string; ch: Char; + startPos: Integer; lookFor: Boolean): Integer; +begin + Result := -1; + while ( ( ( str[ startPos ] = ch ) <> lookFor ) and ( startPos < Length( str ) ) ) do + inc( startPos ); + if startPos <> Length( str ) then + Result := startPos; +end; + +procedure TSDLCustomCursor.SetFileName(const aValue: string); +begin + LoadFromFile( aValue ); +end; + +{ TSDLXPMCursor } + +destructor TSDLXPMCursor.Destroy; +begin + FreeCursor; + inherited; +end; + +procedure TSDLXPMCursor.FreeCursor; +begin + if FCursor <> nil then + begin + SDL_FreeCursor( FCursor ); + FFileName := ''; + end; +end; + +procedure TSDLXPMCursor.LoadFromFile(const aFileName: string); +var + xpmFile : Textfile; + step : Integer; + holdPos : Integer; + counter : Integer; + dimensions : array[ 1..3 ] of Integer; + clr, clrNone, clrBlack, clrWhite : Char; + data, mask : array of UInt8; + i, col : Integer; + LineString : string; +begin + FreeCursor; + AssignFile( xpmFile, aFileName ); + Reset( xpmFile ); + step := 0; + i := -1; + clrBlack := 'X'; + clrWhite := ','; + clrNone := ' '; + counter := 0; + while not ( eof( xpmFile ) ) do + begin + Readln( xpmFile, LineString ); + // scan for strings + if LineString[ 1 ] = '"' then + begin + case step of + 0 : // Get dimensions (should be width height number-of-colors ???) + begin + HoldPos := 2; + counter := ScanForChar( LineString, ' ', HoldPos, False ); + counter := ScanForChar( LineString, ' ', counter, True ); + dimensions[ 1 ] := StrToInt( Copy( LineString, HoldPos, counter - HoldPos ) ); + counter := ScanForChar( LineString, ' ', counter, False ); + holdPos := counter; + counter := ScanForChar( LineString, ' ', counter, True ); + dimensions[ 2 ] := StrToInt( Copy( LineString, holdPos, counter - HoldPos ) ); + counter := ScanForChar( LineString, ' ', counter, False ); + holdPos := counter; + counter := ScanForChar( LineString, ' ', counter, True ); + dimensions[ 3 ] := StrToInt( Copy( LineString, holdPos, counter - HoldPos ) ); + step := 1; + SetLength( data, ( dimensions[ 1 ] * dimensions[ 2 ] ) div 8 ); + SetLength( mask, ( dimensions[ 1 ] * dimensions[ 2 ] ) div 8 ); + //Log.LogStatus( 'Length = ' + IntToStr( ( dimensions[ 1 ] * dimensions[ 2 ] ) div 8 ), 'LoadCursorFromFile' ); + end; + 1 : // get the symbols for transparent, black and white + begin + // get the symbol for the color + clr := LineString[ 2 ]; + // look for the 'c' symbol + counter := ScanForChar( LineString, 'c', 3, True ); + inc( counter ); + counter := ScanForChar( LineString, ' ', counter, False ); + if LowerCase( Copy( LineString, counter, 4 ) ) = 'none' then + begin + clrNone := clr; + end; + if LowerCase( Copy( LineString, counter, 7 ) ) = '#ffffff' then + begin + clrWhite := clr; + end; + if LowerCase( Copy( LineString, counter, 7 ) ) = '#000000' then + begin + clrBlack := clr; + end; + dec( dimensions[ 3 ] ); + if dimensions[ 3 ] = 0 then + begin + step := 2; + counter := 0; + end; + end; + 2 : // get cursor information -- modified from the SDL + // documentation of SDL_CreateCursor. + begin + for col := 1 to dimensions[1] do + begin + if ( ( col mod 8 ) <> 1 ) then + begin + data[ i ] := data[ i ] shl 1; + mask[ i ] := mask[ i ] shl 1; + end + else + begin + inc( i ); + data[ i ] := 0; + mask[ i ] := 0; + end; + if LineString[ col ] = clrWhite then + begin + mask[ i ] := mask[ i ] or $01; + end + else if LineString[ col ] = clrBlack then + begin + data[ i ] := data[ i ] or $01; + mask[ i ] := mask[ i ] or $01; + end + else if LineString[ col + 1 ] = clrNone then + begin + // + end; + end; + inc(counter); + if counter = dimensions[2] then + step := 4; + end; + end; + end; + end; + CloseFile( xpmFile ); + FCursor := SDL_CreateCursor( PUInt8( data ), PUInt8( mask ), dimensions[ 1 ], dimensions[ 2 ], FHotPoint.x, FHotPoint.y ); +end; + +procedure TSDLXPMCursor.LoadFromStream(aStream: TStream); +begin + inherited; + +end; + +procedure TSDLXPMCursor.Show; +begin + inherited; + SDL_SetCursor( FCursor ); +end; + +{ TSDLCursorList } +function TSDLCursorList.AddCursor(const aName : string; aObject : TSDLCustomCursor): Integer; +begin + result := inherited AddObject( aName, aObject ); +end; + +constructor TSDLCursorList.Create; +begin + inherited; + Duplicates := dupIgnore; +end; + +function TSDLCursorList.GetObject(aIndex: Integer): TSDLCustomCursor; +begin + result := TSDLCustomCursor( inherited GetObject( aIndex ) ); +end; + +procedure TSDLCursorList.PutObject(aIndex: Integer; aObject: TSDLCustomCursor); +begin + inherited PutObject( aIndex, aObject ); +end; + +end. diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlstreams.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlstreams.pas index 64009176..8ba3946f 100644 --- a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlstreams.pas +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlstreams.pas @@ -1,216 +1,216 @@ -unit sdlstreams;
-{
- $Id: sdlstreams.pas,v 1.1 2004/02/05 00:08:20 savage Exp $
-
-}
-{******************************************************************}
-{ }
-{ SDL - Simple DirectMedia Layer }
-{ Copyright (C) 1997, 1998, 1999, 2000, 2001 Sam Lantinga }
-{ }
-{ Portions created by Chris Bruner are }
-{ Copyright (C) 2002 Chris Bruner. }
-{ }
-{ Contributor(s) }
-{ -------------- }
-{ }
-{ }
-{ Obtained through: }
-{ Joint Endeavour of Delphi Innovators ( Project JEDI ) }
-{ }
-{ You may retrieve the latest version of this file at the Project }
-{ JEDI home page, located at http://delphi-jedi.org }
-{ }
-{ The contents of this file are used with permission, subject to }
-{ the Mozilla Public License Version 1.1 (the "License"); you may }
-{ not use this file except in compliance with the License. You may }
-{ obtain a copy of the License at }
-{ http://www.mozilla.org/NPL/NPL-1_1Final.html }
-{ }
-{ Software distributed under the License is distributed on an }
-{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or }
-{ implied. See the License for the specific language governing }
-{ rights and limitations under the License. }
-{ }
-{ Description }
-{ ----------- }
-{ Shows how to use OpenGL to do 2D and 3D with the SDL libraries }
-{ }
-{ }
-{ Requires }
-{ -------- }
-{ SDL runtime libary somewhere in your path }
-{ The Latest SDL runtime can be found on http://www.libsdl.org }
-{ }
-{ Programming Notes }
-{ ----------------- }
-{ }
-{ }
-{ }
-{ }
-{ }
-{ Revision History }
-{ ---------------- }
-{ January 11 2002 - CB : Software embraced and extended by }
-{ Chris Bruner of Crystal Software }
-{ (Canada) Inc. }
-{ }
-{ February 11 2002 - DL : Added FreePascal support as suggested }
-{ by "QuePasha Pepe" <mrkroket@hotmail.com> }
-{ }
-{******************************************************************}
-{
- $Log: sdlstreams.pas,v $
- Revision 1.1 2004/02/05 00:08:20 savage
- Module 1.0 release
-
-
-}
-
-{$i jedi-sdl.inc}
-
-interface
-
-uses
- Classes,
- SysUtils,
- sdl,
- sdlutils;
-
-{$IFDEF FPC}
-type
- EinvalidContainer=class(Exception);
- {$ENDIF}
-
-function LoadSDLBMPFromStream( Stream : TStream ) : PSDL_Surface;
-procedure SaveSDLBMPToStream( SDL_Surface : PSDL_Surface; stream : TStream );
-function SDL_Swap16( D : UInt16 ) : Uint16;
-function SDL_Swap32( D : UInt32 ) : Uint32;
-function SDLStreamSetup( stream : TStream ) : PSDL_RWops;
-// this only closes the SDL_RWops part of the stream, not the stream itself
-procedure SDLStreamCloseRWops( SDL_RWops : PSDL_RWops );
-
-implementation
-
-function SDL_Swap16( D : UInt16 ) : Uint16;
-begin
- Result := ( D shl 8 ) or ( D shr 8 );
-end;
-
-function SDL_Swap32( D : UInt32 ) : Uint32;
-begin
- Result := ( ( D shl 24 ) or ( ( D shl 8 ) and $00FF0000 ) or ( ( D shr 8 ) and $0000FF00 ) or ( D shr 24 ) );
-end;
-
-(*function SDL_Swap64(D : UInt64) : Uint64;
-var hi,lo : Uint32;
-begin
- // Separate into high and low 32-bit resultues and swap them
- lo := Uint32(D and $0FFFFFFFF); // bloody pascal is too tight in it's type checking!
- D := D shr 32;
- hi = Uint32((D and $FFFFFFFF));
- result = SDL_Swap32(lo);
- result := result shl 32;
- result := result or SDL_Swap32(hi);
-end;
-*)
-
-function SdlStreamSeek( context : PSDL_RWops; offset : Integer; whence : Integer ) : integer; cdecl;
-var
- stream : TStream;
- origin : Word;
-begin
- stream := TStream( context.unknown );
- if ( stream = nil ) then
- raise EInvalidContainer.Create( 'SDLStreamSeek on nil' );
- case whence of
- 0 : origin := soFromBeginning; // Offset is from the beginning of the resource. Seek moves to the position Offset. Offset must be >= 0.
- 1 : origin := soFromCurrent; // Offset is from the current position in the resource. Seek moves to Position + Offset.
- 2 : origin := soFromEnd;
- else
- origin := soFromBeginning; // just in case
- end;
- Result := stream.Seek( offset, origin );
-end;
-
-function SDLStreamWrite( context : PSDL_RWops; Ptr : Pointer;
- size : Integer; num : Integer ) : Integer; cdecl;
-var
- stream : TStream;
-begin
- stream := TStream( context.unknown );
- if ( stream = nil ) then
- raise EInvalidContainer.Create( 'SDLStreamWrite on nil' );
- try
- Result := stream.Write( Ptr^, Size * num ) div size;
- except
- Result := -1;
- end;
-end;
-
-function SdlStreamRead( context : PSDL_RWops; Ptr : Pointer; size : Integer; maxnum
- : Integer ) : Integer; cdecl;
-var
- stream : TStream;
-begin
- stream := TStream( context.unknown );
- if ( stream = nil ) then
- raise EInvalidContainer.Create( 'SDLStreamRead on nil' );
- try
- Result := stream.read( Ptr^, Size * maxnum ) div size;
- except
- Result := -1;
- end;
-end;
-
-function SDLStreamClose( context : PSDL_RWops ) : Integer; cdecl;
-var
- stream : TStream;
-begin
- stream := TStream( context.unknown );
- if ( stream = nil ) then
- raise EInvalidContainer.Create( 'SDLStreamClose on nil' );
- stream.Free;
- Result := 1;
-end;
-
-function SDLStreamSetup( stream : TStream ) : PSDL_RWops;
-begin
- result := SDL_AllocRW;
- if ( result = nil ) then
- raise EInvalidContainer.Create( 'could not create SDLStream on nil' );
- result.unknown := TUnknown( stream );
- result.seek := SDLStreamSeek;
- result.read := SDLStreamRead;
- result.write := SDLStreamWrite;
- result.close := SDLStreamClose;
- Result.type_ := 2; // TUnknown
-end;
-
-// this only closes the SDL part of the stream, not the context
-
-procedure SDLStreamCloseRWops( SDL_RWops : PSDL_RWops );
-begin
- SDL_FreeRW( SDL_RWops );
-end;
-
-function LoadSDLBMPFromStream( stream : TStream ) : PSDL_Surface;
-var
- SDL_RWops : PSDL_RWops;
-begin
- SDL_RWops := SDLStreamSetup( stream );
- result := SDL_LoadBMP_RW( SDL_RWops, 0 );
- SDLStreamCloseRWops( SDL_RWops );
-end;
-
-procedure SaveSDLBMPToStream( SDL_Surface : PSDL_Surface; stream : TStream );
-var
- SDL_RWops : PSDL_RWops;
-begin
- SDL_RWops := SDLStreamSetup( stream );
- SDL_SaveBMP_RW( SDL_Surface, SDL_RWops, 0 );
- SDLStreamCloseRWops( SDL_RWops );
-end;
-
-end.
-
+unit sdlstreams; +{ + $Id: sdlstreams.pas,v 1.1 2004/02/05 00:08:20 savage Exp $ + +} +{******************************************************************} +{ } +{ SDL - Simple DirectMedia Layer } +{ Copyright (C) 1997, 1998, 1999, 2000, 2001 Sam Lantinga } +{ } +{ Portions created by Chris Bruner are } +{ Copyright (C) 2002 Chris Bruner. } +{ } +{ Contributor(s) } +{ -------------- } +{ } +{ } +{ Obtained through: } +{ Joint Endeavour of Delphi Innovators ( Project JEDI ) } +{ } +{ You may retrieve the latest version of this file at the Project } +{ JEDI home page, located at http://delphi-jedi.org } +{ } +{ The contents of this file are used with permission, subject to } +{ the Mozilla Public License Version 1.1 (the "License"); you may } +{ not use this file except in compliance with the License. You may } +{ obtain a copy of the License at } +{ http://www.mozilla.org/NPL/NPL-1_1Final.html } +{ } +{ Software distributed under the License is distributed on an } +{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or } +{ implied. See the License for the specific language governing } +{ rights and limitations under the License. } +{ } +{ Description } +{ ----------- } +{ Shows how to use OpenGL to do 2D and 3D with the SDL libraries } +{ } +{ } +{ Requires } +{ -------- } +{ SDL runtime libary somewhere in your path } +{ The Latest SDL runtime can be found on http://www.libsdl.org } +{ } +{ Programming Notes } +{ ----------------- } +{ } +{ } +{ } +{ } +{ } +{ Revision History } +{ ---------------- } +{ January 11 2002 - CB : Software embraced and extended by } +{ Chris Bruner of Crystal Software } +{ (Canada) Inc. } +{ } +{ February 11 2002 - DL : Added FreePascal support as suggested } +{ by "QuePasha Pepe" <mrkroket@hotmail.com> } +{ } +{******************************************************************} +{ + $Log: sdlstreams.pas,v $ + Revision 1.1 2004/02/05 00:08:20 savage + Module 1.0 release + + +} + +{$i jedi-sdl.inc} + +interface + +uses + Classes, + SysUtils, + sdl, + sdlutils; + +{$IFDEF FPC} +type + EinvalidContainer=class(Exception); + {$ENDIF} + +function LoadSDLBMPFromStream( Stream : TStream ) : PSDL_Surface; +procedure SaveSDLBMPToStream( SDL_Surface : PSDL_Surface; stream : TStream ); +function SDL_Swap16( D : UInt16 ) : Uint16; +function SDL_Swap32( D : UInt32 ) : Uint32; +function SDLStreamSetup( stream : TStream ) : PSDL_RWops; +// this only closes the SDL_RWops part of the stream, not the stream itself +procedure SDLStreamCloseRWops( SDL_RWops : PSDL_RWops ); + +implementation + +function SDL_Swap16( D : UInt16 ) : Uint16; +begin + Result := ( D shl 8 ) or ( D shr 8 ); +end; + +function SDL_Swap32( D : UInt32 ) : Uint32; +begin + Result := ( ( D shl 24 ) or ( ( D shl 8 ) and $00FF0000 ) or ( ( D shr 8 ) and $0000FF00 ) or ( D shr 24 ) ); +end; + +(*function SDL_Swap64(D : UInt64) : Uint64; +var hi,lo : Uint32; +begin + // Separate into high and low 32-bit resultues and swap them + lo := Uint32(D and $0FFFFFFFF); // bloody pascal is too tight in it's type checking! + D := D shr 32; + hi = Uint32((D and $FFFFFFFF)); + result = SDL_Swap32(lo); + result := result shl 32; + result := result or SDL_Swap32(hi); +end; +*) + +function SdlStreamSeek( context : PSDL_RWops; offset : Integer; whence : Integer ) : integer; cdecl; +var + stream : TStream; + origin : Word; +begin + stream := TStream( context.unknown ); + if ( stream = nil ) then + raise EInvalidContainer.Create( 'SDLStreamSeek on nil' ); + case whence of + 0 : origin := soFromBeginning; // Offset is from the beginning of the resource. Seek moves to the position Offset. Offset must be >= 0. + 1 : origin := soFromCurrent; // Offset is from the current position in the resource. Seek moves to Position + Offset. + 2 : origin := soFromEnd; + else + origin := soFromBeginning; // just in case + end; + Result := stream.Seek( offset, origin ); +end; + +function SDLStreamWrite( context : PSDL_RWops; Ptr : Pointer; + size : Integer; num : Integer ) : Integer; cdecl; +var + stream : TStream; +begin + stream := TStream( context.unknown ); + if ( stream = nil ) then + raise EInvalidContainer.Create( 'SDLStreamWrite on nil' ); + try + Result := stream.Write( Ptr^, Size * num ) div size; + except + Result := -1; + end; +end; + +function SdlStreamRead( context : PSDL_RWops; Ptr : Pointer; size : Integer; maxnum + : Integer ) : Integer; cdecl; +var + stream : TStream; +begin + stream := TStream( context.unknown ); + if ( stream = nil ) then + raise EInvalidContainer.Create( 'SDLStreamRead on nil' ); + try + Result := stream.read( Ptr^, Size * maxnum ) div size; + except + Result := -1; + end; +end; + +function SDLStreamClose( context : PSDL_RWops ) : Integer; cdecl; +var + stream : TStream; +begin + stream := TStream( context.unknown ); + if ( stream = nil ) then + raise EInvalidContainer.Create( 'SDLStreamClose on nil' ); + stream.Free; + Result := 1; +end; + +function SDLStreamSetup( stream : TStream ) : PSDL_RWops; +begin + result := SDL_AllocRW; + if ( result = nil ) then + raise EInvalidContainer.Create( 'could not create SDLStream on nil' ); + result.unknown := TUnknown( stream ); + result.seek := SDLStreamSeek; + result.read := SDLStreamRead; + result.write := SDLStreamWrite; + result.close := SDLStreamClose; + Result.type_ := 2; // TUnknown +end; + +// this only closes the SDL part of the stream, not the context + +procedure SDLStreamCloseRWops( SDL_RWops : PSDL_RWops ); +begin + SDL_FreeRW( SDL_RWops ); +end; + +function LoadSDLBMPFromStream( stream : TStream ) : PSDL_Surface; +var + SDL_RWops : PSDL_RWops; +begin + SDL_RWops := SDLStreamSetup( stream ); + result := SDL_LoadBMP_RW( SDL_RWops, 0 ); + SDLStreamCloseRWops( SDL_RWops ); +end; + +procedure SaveSDLBMPToStream( SDL_Surface : PSDL_Surface; stream : TStream ); +var + SDL_RWops : PSDL_RWops; +begin + SDL_RWops := SDLStreamSetup( stream ); + SDL_SaveBMP_RW( SDL_Surface, SDL_RWops, 0 ); + SDLStreamCloseRWops( SDL_RWops ); +end; + +end. + diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlticks.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlticks.pas index 8e00dd6f..a479b493 100644 --- a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlticks.pas +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlticks.pas @@ -1,197 +1,197 @@ -unit sdlticks;
-{
- $Id: sdlticks.pas,v 1.2 2006/11/08 08:22:48 savage Exp $
-
-}
-{******************************************************************************}
-{ }
-{ JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer }
-{ SDL GetTicks Class Wrapper }
-{ }
-{ }
-{ The initial developer of this Pascal code was : }
-{ Dominique Louis <Dominique@SavageSoftware.com.au> }
-{ }
-{ Portions created by Dominique Louis are }
-{ Copyright (C) 2004 - 2100 Dominique Louis. }
-{ }
-{ }
-{ Contributor(s) }
-{ -------------- }
-{ Dominique Louis <Dominique@SavageSoftware.com.au> }
-{ }
-{ Obtained through: }
-{ Joint Endeavour of Delphi Innovators ( Project JEDI ) }
-{ }
-{ You may retrieve the latest version of this file at the Project }
-{ JEDI home page, located at http://delphi-jedi.org }
-{ }
-{ The contents of this file are used with permission, subject to }
-{ the Mozilla Public License Version 1.1 (the "License"); you may }
-{ not use this file except in compliance with the License. You may }
-{ obtain a copy of the License at }
-{ http://www.mozilla.org/MPL/MPL-1.1.html }
-{ }
-{ Software distributed under the License is distributed on an }
-{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or }
-{ implied. See the License for the specific language governing }
-{ rights and limitations under the License. }
-{ }
-{ Description }
-{ ----------- }
-{ SDL Window Wrapper }
-{ }
-{ }
-{ Requires }
-{ -------- }
-{ SDL.dll on Windows platforms }
-{ libSDL-1.1.so.0 on Linux platform }
-{ }
-{ Programming Notes }
-{ ----------------- }
-{ }
-{ }
-{ }
-{ }
-{ Revision History }
-{ ---------------- }
-{ }
-{ September 23 2004 - DL : Initial Creation }
-{
- $Log: sdlticks.pas,v $
- Revision 1.2 2006/11/08 08:22:48 savage
- updates tp sdlgameinterface and sdlticks functions.
-
- Revision 1.1 2004/09/30 22:35:47 savage
- Changes, enhancements and additions as required to get SoAoS working.
-
-}
-{******************************************************************************}
-
-interface
-
-uses
- sdl;
-
-type
- TSDLTicks = class
- private
- FStartTime : UInt32;
- FTicksPerSecond : UInt32;
- FElapsedLastTime : UInt32;
- FFPSLastTime : UInt32;
- FLockFPSLastTime : UInt32;
- public
- constructor Create;
- destructor Destroy; override; // destructor
-
- {*****************************************************************************
- Init
- If the hi-res timer is present, the tick rate is stored and the function
- returns true. Otherwise, the function returns false, and the timer should
- not be used.
- *****************************************************************************}
- function Init : boolean;
-
- {***************************************************************************
- GetGetElapsedSeconds
- Returns the Elapsed time, since the function was last called.
- ***************************************************************************}
- function GetElapsedSeconds : Single;
-
- {***************************************************************************
- GetFPS
- Returns the average frames per second.
- If this is not called every frame, the client should track the number
- of frames itself, and reset the value after this is called.
- ***************************************************************************}
- function GetFPS : single;
-
- {***************************************************************************
- LockFPS
- Used to lock the frame rate to a set amount. This will block until enough
- time has passed to ensure that the fps won't go over the requested amount.
- Note that this can only keep the fps from going above the specified level;
- it can still drop below it. It is assumed that if used, this function will
- be called every frame. The value returned is the instantaneous fps, which
- will be less than or equal to the targetFPS.
- ***************************************************************************}
- procedure LockFPS( targetFPS : Byte );
- end;
-
-implementation
-
-{ TSDLTicks }
-constructor TSDLTicks.Create;
-begin
- inherited;
- FTicksPerSecond := 1000;
-end;
-
-destructor TSDLTicks.Destroy;
-begin
- inherited;
-end;
-
-function TSDLTicks.GetElapsedSeconds : Single;
-var
- currentTime : Cardinal;
-begin
- currentTime := SDL_GetTicks;
-
- result := ( currentTime - FElapsedLastTime ) / FTicksPerSecond;
-
- // reset the timer
- FElapsedLastTime := currentTime;
-end;
-
-function TSDLTicks.GetFPS : Single;
-var
- currentTime, FrameTime : UInt32;
- fps : single;
-begin
- currentTime := SDL_GetTicks;
-
- FrameTime := ( currentTime - FFPSLastTime );
-
- if FrameTime = 0 then
- FrameTime := 1;
-
- fps := FTicksPerSecond / FrameTime;
-
- // reset the timer
- FFPSLastTime := currentTime;
- result := fps;
-end;
-
-function TSDLTicks.Init : boolean;
-begin
- FStartTime := SDL_GetTicks;
- FElapsedLastTime := FStartTime;
- FFPSLastTime := FStartTime;
- FLockFPSLastTime := FStartTime;
- result := true;
-end;
-
-procedure TSDLTicks.LockFPS( targetFPS : Byte );
-var
- currentTime : UInt32;
- targetTime : single;
-begin
- if ( targetFPS = 0 ) then
- targetFPS := 1;
-
- targetTime := FTicksPerSecond / targetFPS;
-
- // delay to maintain a constant frame rate
- repeat
- currentTime := SDL_GetTicks;
- until ( ( currentTime - FLockFPSLastTime ) > targetTime );
-
- // reset the timer
- FLockFPSLastTime := currentTime;
-end;
-
-end.
-
+unit sdlticks; +{ + $Id: sdlticks.pas,v 1.2 2006/11/08 08:22:48 savage Exp $ + +} +{******************************************************************************} +{ } +{ JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer } +{ SDL GetTicks Class Wrapper } +{ } +{ } +{ The initial developer of this Pascal code was : } +{ Dominique Louis <Dominique@SavageSoftware.com.au> } +{ } +{ Portions created by Dominique Louis are } +{ Copyright (C) 2004 - 2100 Dominique Louis. } +{ } +{ } +{ Contributor(s) } +{ -------------- } +{ Dominique Louis <Dominique@SavageSoftware.com.au> } +{ } +{ Obtained through: } +{ Joint Endeavour of Delphi Innovators ( Project JEDI ) } +{ } +{ You may retrieve the latest version of this file at the Project } +{ JEDI home page, located at http://delphi-jedi.org } +{ } +{ The contents of this file are used with permission, subject to } +{ the Mozilla Public License Version 1.1 (the "License"); you may } +{ not use this file except in compliance with the License. You may } +{ obtain a copy of the License at } +{ http://www.mozilla.org/MPL/MPL-1.1.html } +{ } +{ Software distributed under the License is distributed on an } +{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or } +{ implied. See the License for the specific language governing } +{ rights and limitations under the License. } +{ } +{ Description } +{ ----------- } +{ SDL Window Wrapper } +{ } +{ } +{ Requires } +{ -------- } +{ SDL.dll on Windows platforms } +{ libSDL-1.1.so.0 on Linux platform } +{ } +{ Programming Notes } +{ ----------------- } +{ } +{ } +{ } +{ } +{ Revision History } +{ ---------------- } +{ } +{ September 23 2004 - DL : Initial Creation } +{ + $Log: sdlticks.pas,v $ + Revision 1.2 2006/11/08 08:22:48 savage + updates tp sdlgameinterface and sdlticks functions. + + Revision 1.1 2004/09/30 22:35:47 savage + Changes, enhancements and additions as required to get SoAoS working. + +} +{******************************************************************************} + +interface + +uses + sdl; + +type + TSDLTicks = class + private + FStartTime : UInt32; + FTicksPerSecond : UInt32; + FElapsedLastTime : UInt32; + FFPSLastTime : UInt32; + FLockFPSLastTime : UInt32; + public + constructor Create; + destructor Destroy; override; // destructor + + {***************************************************************************** + Init + If the hi-res timer is present, the tick rate is stored and the function + returns true. Otherwise, the function returns false, and the timer should + not be used. + *****************************************************************************} + function Init : boolean; + + {*************************************************************************** + GetGetElapsedSeconds + Returns the Elapsed time, since the function was last called. + ***************************************************************************} + function GetElapsedSeconds : Single; + + {*************************************************************************** + GetFPS + Returns the average frames per second. + If this is not called every frame, the client should track the number + of frames itself, and reset the value after this is called. + ***************************************************************************} + function GetFPS : single; + + {*************************************************************************** + LockFPS + Used to lock the frame rate to a set amount. This will block until enough + time has passed to ensure that the fps won't go over the requested amount. + Note that this can only keep the fps from going above the specified level; + it can still drop below it. It is assumed that if used, this function will + be called every frame. The value returned is the instantaneous fps, which + will be less than or equal to the targetFPS. + ***************************************************************************} + procedure LockFPS( targetFPS : Byte ); + end; + +implementation + +{ TSDLTicks } +constructor TSDLTicks.Create; +begin + inherited; + FTicksPerSecond := 1000; +end; + +destructor TSDLTicks.Destroy; +begin + inherited; +end; + +function TSDLTicks.GetElapsedSeconds : Single; +var + currentTime : Cardinal; +begin + currentTime := SDL_GetTicks; + + result := ( currentTime - FElapsedLastTime ) / FTicksPerSecond; + + // reset the timer + FElapsedLastTime := currentTime; +end; + +function TSDLTicks.GetFPS : Single; +var + currentTime, FrameTime : UInt32; + fps : single; +begin + currentTime := SDL_GetTicks; + + FrameTime := ( currentTime - FFPSLastTime ); + + if FrameTime = 0 then + FrameTime := 1; + + fps := FTicksPerSecond / FrameTime; + + // reset the timer + FFPSLastTime := currentTime; + result := fps; +end; + +function TSDLTicks.Init : boolean; +begin + FStartTime := SDL_GetTicks; + FElapsedLastTime := FStartTime; + FFPSLastTime := FStartTime; + FLockFPSLastTime := FStartTime; + result := true; +end; + +procedure TSDLTicks.LockFPS( targetFPS : Byte ); +var + currentTime : UInt32; + targetTime : single; +begin + if ( targetFPS = 0 ) then + targetFPS := 1; + + targetTime := FTicksPerSecond / targetFPS; + + // delay to maintain a constant frame rate + repeat + currentTime := SDL_GetTicks; + until ( ( currentTime - FLockFPSLastTime ) > targetTime ); + + // reset the timer + FLockFPSLastTime := currentTime; +end; + +end. +
\ No newline at end of file diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlutils.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlutils.pas index 7fbed878..e01f3cdb 100644 --- a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlutils.pas +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlutils.pas @@ -1,4363 +1,4363 @@ -unit sdlutils;
-{
- $Id: sdlutils.pas,v 1.5 2006/11/19 18:56:44 savage Exp $
-
-}
-{******************************************************************************}
-{ }
-{ Borland Delphi SDL - Simple DirectMedia Layer }
-{ SDL Utility functions }
-{ }
-{ }
-{ The initial developer of this Pascal code was : }
-{ Tom Jones <tigertomjones@gmx.de> }
-{ }
-{ Portions created by Tom Jones are }
-{ Copyright (C) 2000 - 2001 Tom Jones. }
-{ }
-{ }
-{ Contributor(s) }
-{ -------------- }
-{ Dominique Louis <Dominique@SavageSoftware.com.au> }
-{ Róbert Kisnémeth <mikrobi@freemail.hu> }
-{ }
-{ Obtained through: }
-{ Joint Endeavour of Delphi Innovators ( Project JEDI ) }
-{ }
-{ You may retrieve the latest version of this file at the Project }
-{ JEDI home page, located at http://delphi-jedi.org }
-{ }
-{ The contents of this file are used with permission, subject to }
-{ the Mozilla Public License Version 1.1 (the "License"); you may }
-{ not use this file except in compliance with the License. You may }
-{ obtain a copy of the License at }
-{ http://www.mozilla.org/MPL/MPL-1.1.html }
-{ }
-{ Software distributed under the License is distributed on an }
-{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or }
-{ implied. See the License for the specific language governing }
-{ rights and limitations under the License. }
-{ }
-{ Description }
-{ ----------- }
-{ Helper functions... }
-{ }
-{ }
-{ Requires }
-{ -------- }
-{ SDL.dll on Windows platforms }
-{ libSDL-1.1.so.0 on Linux platform }
-{ }
-{ Programming Notes }
-{ ----------------- }
-{ }
-{ }
-{ }
-{ }
-{ Revision History }
-{ ---------------- }
-{ 2000 - TJ : Initial creation }
-{ }
-{ July 13 2001 - DL : Added PutPixel and GetPixel routines. }
-{ }
-{ Sept 14 2001 - RK : Added flipping routines. }
-{ }
-{ Sept 19 2001 - RK : Added PutPixel & line drawing & blitting with ADD }
-{ effect. Fixed a bug in SDL_PutPixel & SDL_GetPixel }
-{ Added PSDLRect() }
-{ Sept 22 2001 - DL : Removed need for Windows.pas by defining types here}
-{ Also removed by poor attempt or a dialog box }
-{ }
-{ Sept 25 2001 - RK : Added PixelTest, NewPutPixel, SubPixel, SubLine, }
-{ SubSurface, MonoSurface & TexturedSurface }
-{ }
-{ Sept 26 2001 - DL : Made change so that it refers to native Pascal }
-{ types rather that Windows types. This makes it more}
-{ portable to Linix. }
-{ }
-{ Sept 27 2001 - RK : SDLUtils now can be compiled with FreePascal }
-{ }
-{ Oct 27 2001 - JF : Added ScrollY function }
-{ }
-{ Jan 21 2002 - RK : Added SDL_ZoomSurface and SDL_WarpSurface }
-{ }
-{ Mar 28 2002 - JF : Added SDL_RotateSurface }
-{ }
-{ May 13 2002 - RK : Improved SDL_FillRectAdd & SDL_FillRectSub }
-{ }
-{ May 27 2002 - YS : GradientFillRect function }
-{ }
-{ May 30 2002 - RK : Added SDL_2xBlit, SDL_Scanline2xBlit }
-{ & SDL_50Scanline2xBlit }
-{ }
-{ June 12 2002 - RK : Added SDL_PixelTestSurfaceVsRect }
-{ }
-{ June 12 2002 - JF : Updated SDL_PixelTestSurfaceVsRect }
-{ }
-{ November 9 2002 - JF : Added Jason's boolean Surface functions }
-{ }
-{ December 10 2002 - DE : Added Dean's SDL_ClipLine function }
-{ }
-{ April 26 2003 - SS : Incorporated JF's changes to SDL_ClipLine }
-{ Fixed SDL_ClipLine bug for non-zero cliprect x, y }
-{ Added overloaded SDL_DrawLine for dashed lines }
-{ }
-{******************************************************************************}
-{
- $Log: sdlutils.pas,v $
- Revision 1.5 2006/11/19 18:56:44 savage
- Removed Hints and Warnings.
-
- Revision 1.4 2004/06/02 19:38:53 savage
- Changes to SDL_GradientFillRect as suggested by
- Ángel Eduardo García Hernández. Many thanks.
-
- Revision 1.3 2004/05/29 23:11:54 savage
- Changes to SDL_ScaleSurfaceRect as suggested by
- Ángel Eduardo García Hernández to fix a colour issue with the function. Many thanks.
-
- Revision 1.2 2004/02/14 00:23:39 savage
- As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change.
-
- Revision 1.1 2004/02/05 00:08:20 savage
- Module 1.0 release
-
-
-}
-
-interface
-
-{$I jedi-sdl.inc}
-
-uses
-{$IFDEF UNIX}
- Types,
-{$IFNDEF DARWIN}
- Xlib,
-{$ENDIF}
-{$ENDIF}
- SysUtils,
- sdl;
-
-type
- TGradientStyle = ( gsHorizontal, gsVertical );
-
-// Pixel procedures
-function SDL_PixelTest( SrcSurface1 : PSDL_Surface; SrcRect1 : PSDL_Rect; SrcSurface2 :
- PSDL_Surface; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : Boolean;
-
-function SDL_GetPixel( SrcSurface : PSDL_Surface; x : integer; y : integer ) : Uint32;
-
-procedure SDL_PutPixel( DstSurface : PSDL_Surface; x : integer; y : integer; pixel :
- Uint32 );
-
-procedure SDL_AddPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color :
- cardinal );
-
-procedure SDL_SubPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color :
- cardinal );
-
-// Line procedures
-procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
- cardinal ); overload;
-
-procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
- cardinal; DashLength, DashSpace : byte ); overload;
-
-procedure SDL_AddLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
- cardinal );
-
-procedure SDL_SubLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
- cardinal );
-
-// Surface procedures
-procedure SDL_AddSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-
-procedure SDL_SubSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-
-procedure SDL_MonoSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Color : cardinal );
-
-procedure SDL_TexturedSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Texture : PSDL_Surface;
- TextureRect : PSDL_Rect );
-
-procedure SDL_ZoomSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; DstRect : PSDL_Rect );
-
-procedure SDL_WarpSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; UL, UR, LR, LL : PPoint );
-
-// Flip procedures
-procedure SDL_FlipRectH( DstSurface : PSDL_Surface; Rect : PSDL_Rect );
-
-procedure SDL_FlipRectV( DstSurface : PSDL_Surface; Rect : PSDL_Rect );
-
-function PSDLRect( aLeft, aTop, aWidth, aHeight : integer ) : PSDL_Rect;
-
-function SDLRect( aLeft, aTop, aWidth, aHeight : integer ) : TSDL_Rect; overload;
-
-function SDLRect( aRect : TRect ) : TSDL_Rect; overload;
-
-function SDL_ScaleSurfaceRect( SrcSurface : PSDL_Surface; SrcX1, SrcY1, SrcW, SrcH,
- Width, Height : integer ) : PSDL_Surface;
-
-procedure SDL_ScrollY( DstSurface : PSDL_Surface; DifY : integer );
-
-procedure SDL_ScrollX( DstSurface : PSDL_Surface; DifX : integer );
-
-procedure SDL_RotateDeg( DstSurface, SrcSurface : PSDL_Surface; SrcRect :
- PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Integer );
-
-procedure SDL_RotateRad( DstSurface, SrcSurface : PSDL_Surface; SrcRect :
- PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Single );
-
-function ValidateSurfaceRect( DstSurface : PSDL_Surface; dstrect : PSDL_Rect ) : TSDL_Rect;
-
-// Fill Rect routine
-procedure SDL_FillRectAdd( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );
-
-procedure SDL_FillRectSub( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );
-
-procedure SDL_GradientFillRect( DstSurface : PSDL_Surface; const Rect : PSDL_Rect; const StartColor, EndColor : TSDL_Color; const Style : TGradientStyle );
-
-// NOTE for All SDL_2xblit... function : the dest surface must be 2x of the source surface!
-procedure SDL_2xBlit( Src, Dest : PSDL_Surface );
-
-procedure SDL_Scanline2xBlit( Src, Dest : PSDL_Surface );
-
-procedure SDL_50Scanline2xBlit( Src, Dest : PSDL_Surface );
-
-//
-function SDL_PixelTestSurfaceVsRect( SrcSurface1 : PSDL_Surface; SrcRect1 :
- PSDL_Rect; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) :
- boolean;
-
-// Jason's boolean Surface functions
-procedure SDL_ORSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-
-procedure SDL_ANDSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-
-
-procedure SDL_GTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-
-procedure SDL_LTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-
-function SDL_ClipLine( var x1, y1, x2, y2 : Integer; ClipRect : PSDL_Rect ) : boolean;
-
-implementation
-
-uses
- Math;
-
-function SDL_PixelTest( SrcSurface1 : PSDL_Surface; SrcRect1 : PSDL_Rect; SrcSurface2 :
- PSDL_Surface; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : boolean;
-var
- Src_Rect1, Src_Rect2 : TSDL_Rect;
- right1, bottom1 : integer;
- right2, bottom2 : integer;
- Scan1Start, Scan2Start, ScanWidth, ScanHeight : cardinal;
- Mod1, Mod2 : cardinal;
- Addr1, Addr2 : PtrUInt;
- BPP : cardinal;
- Pitch1, Pitch2 : cardinal;
- TransparentColor1, TransparentColor2 : cardinal;
- tx, ty : cardinal;
-// StartTick : cardinal; // Auto Removed, Unused Variable
- Color1, Color2 : cardinal;
-begin
- Result := false;
- if SrcRect1 = nil then
- begin
- with Src_Rect1 do
- begin
- x := 0;
- y := 0;
- w := SrcSurface1.w;
- h := SrcSurface1.h;
- end;
- end
- else
- Src_Rect1 := SrcRect1^;
- if SrcRect2 = nil then
- begin
- with Src_Rect2 do
- begin
- x := 0;
- y := 0;
- w := SrcSurface2.w;
- h := SrcSurface2.h;
- end;
- end
- else
- Src_Rect2 := SrcRect2^;
- with Src_Rect1 do
- begin
- Right1 := Left1 + w;
- Bottom1 := Top1 + h;
- end;
- with Src_Rect2 do
- begin
- Right2 := Left2 + w;
- Bottom2 := Top2 + h;
- end;
- if ( Left1 >= Right2 ) or ( Right1 <= Left2 ) or ( Top1 >= Bottom2 ) or ( Bottom1 <=
- Top2 ) then
- exit;
- if Left1 <= Left2 then
- begin
- // 1. left, 2. right
- Scan1Start := Src_Rect1.x + Left2 - Left1;
- Scan2Start := Src_Rect2.x;
- ScanWidth := Right1 - Left2;
- with Src_Rect2 do
- if ScanWidth > w then
- ScanWidth := w;
- end
- else
- begin
- // 1. right, 2. left
- Scan1Start := Src_Rect1.x;
- Scan2Start := Src_Rect2.x + Left1 - Left2;
- ScanWidth := Right2 - Left1;
- with Src_Rect1 do
- if ScanWidth > w then
- ScanWidth := w;
- end;
- with SrcSurface1^ do
- begin
- Pitch1 := Pitch;
- Addr1 := PtrUInt( Pixels );
- inc( Addr1, Pitch1 * UInt32( Src_Rect1.y ) );
- with format^ do
- begin
- BPP := BytesPerPixel;
- TransparentColor1 := colorkey;
- end;
- end;
- with SrcSurface2^ do
- begin
- TransparentColor2 := format.colorkey;
- Pitch2 := Pitch;
- Addr2 := PtrUInt( Pixels );
- inc( Addr2, Pitch2 * UInt32( Src_Rect2.y ) );
- end;
- Mod1 := Pitch1 - ( ScanWidth * BPP );
- Mod2 := Pitch2 - ( ScanWidth * BPP );
- inc( Addr1, BPP * Scan1Start );
- inc( Addr2, BPP * Scan2Start );
- if Top1 <= Top2 then
- begin
- // 1. up, 2. down
- ScanHeight := Bottom1 - Top2;
- if ScanHeight > Src_Rect2.h then
- ScanHeight := Src_Rect2.h;
- inc( Addr1, Pitch1 * UInt32( Top2 - Top1 ) );
- end
- else
- begin
- // 1. down, 2. up
- ScanHeight := Bottom2 - Top1;
- if ScanHeight > Src_Rect1.h then
- ScanHeight := Src_Rect1.h;
- inc( Addr2, Pitch2 * UInt32( Top1 - Top2 ) );
- end;
- case BPP of
- 1 :
- for ty := 1 to ScanHeight do
- begin
- for tx := 1 to ScanWidth do
- begin
- if ( PByte( Addr1 )^ <> TransparentColor1 ) and ( PByte( Addr2 )^ <>
- TransparentColor2 ) then
- begin
- Result := true;
- exit;
- end;
- inc( Addr1 );
- inc( Addr2 );
- end;
- inc( Addr1, Mod1 );
- inc( Addr2, Mod2 );
- end;
- 2 :
- for ty := 1 to ScanHeight do
- begin
- for tx := 1 to ScanWidth do
- begin
- if ( PWord( Addr1 )^ <> TransparentColor1 ) and ( PWord( Addr2 )^ <>
- TransparentColor2 ) then
- begin
- Result := true;
- exit;
- end;
- inc( Addr1, 2 );
- inc( Addr2, 2 );
- end;
- inc( Addr1, Mod1 );
- inc( Addr2, Mod2 );
- end;
- 3 :
- for ty := 1 to ScanHeight do
- begin
- for tx := 1 to ScanWidth do
- begin
- Color1 := PLongWord( Addr1 )^ and $00FFFFFF;
- Color2 := PLongWord( Addr2 )^ and $00FFFFFF;
- if ( Color1 <> TransparentColor1 ) and ( Color2 <> TransparentColor2 )
- then
- begin
- Result := true;
- exit;
- end;
- inc( Addr1, 3 );
- inc( Addr2, 3 );
- end;
- inc( Addr1, Mod1 );
- inc( Addr2, Mod2 );
- end;
- 4 :
- for ty := 1 to ScanHeight do
- begin
- for tx := 1 to ScanWidth do
- begin
- if ( PLongWord( Addr1 )^ <> TransparentColor1 ) and ( PLongWord( Addr2 )^ <>
- TransparentColor2 ) then
- begin
- Result := true;
- exit;
- end;
- inc( Addr1, 4 );
- inc( Addr2, 4 );
- end;
- inc( Addr1, Mod1 );
- inc( Addr2, Mod2 );
- end;
- end;
-end;
-
-procedure SDL_AddPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color :
- cardinal );
-var
- SrcColor : cardinal;
- Addr : PtrUInt;
- R, G, B : cardinal;
-begin
- if Color = 0 then
- exit;
- with DstSurface^ do
- begin
- Addr := PtrUInt( Pixels ) + y * Pitch + x * format.BytesPerPixel;
- SrcColor := PUInt32( Addr )^;
- case format.BitsPerPixel of
- 8 :
- begin
- R := SrcColor and $E0 + Color and $E0;
- G := SrcColor and $1C + Color and $1C;
- B := SrcColor and $03 + Color and $03;
- if R > $E0 then
- R := $E0;
- if G > $1C then
- G := $1C;
- if B > $03 then
- B := $03;
- PUInt8( Addr )^ := R or G or B;
- end;
- 15 :
- begin
- R := SrcColor and $7C00 + Color and $7C00;
- G := SrcColor and $03E0 + Color and $03E0;
- B := SrcColor and $001F + Color and $001F;
- if R > $7C00 then
- R := $7C00;
- if G > $03E0 then
- G := $03E0;
- if B > $001F then
- B := $001F;
- PUInt16( Addr )^ := R or G or B;
- end;
- 16 :
- begin
- R := SrcColor and $F800 + Color and $F800;
- G := SrcColor and $07C0 + Color and $07C0;
- B := SrcColor and $001F + Color and $001F;
- if R > $F800 then
- R := $F800;
- if G > $07C0 then
- G := $07C0;
- if B > $001F then
- B := $001F;
- PUInt16( Addr )^ := R or G or B;
- end;
- 24 :
- begin
- R := SrcColor and $00FF0000 + Color and $00FF0000;
- G := SrcColor and $0000FF00 + Color and $0000FF00;
- B := SrcColor and $000000FF + Color and $000000FF;
- if R > $FF0000 then
- R := $FF0000;
- if G > $00FF00 then
- G := $00FF00;
- if B > $0000FF then
- B := $0000FF;
- PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B;
- end;
- 32 :
- begin
- R := SrcColor and $00FF0000 + Color and $00FF0000;
- G := SrcColor and $0000FF00 + Color and $0000FF00;
- B := SrcColor and $000000FF + Color and $000000FF;
- if R > $FF0000 then
- R := $FF0000;
- if G > $00FF00 then
- G := $00FF00;
- if B > $0000FF then
- B := $0000FF;
- PUInt32( Addr )^ := R or G or B;
- end;
- end;
- end;
-end;
-
-procedure SDL_SubPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color :
- cardinal );
-var
- SrcColor : cardinal;
- Addr : PtrUInt;
- R, G, B : cardinal;
-begin
- if Color = 0 then
- exit;
- with DstSurface^ do
- begin
- Addr := PtrUInt( Pixels ) + y * Pitch + x * format.BytesPerPixel;
- SrcColor := PUInt32( Addr )^;
- case format.BitsPerPixel of
- 8 :
- begin
- R := SrcColor and $E0 - Color and $E0;
- G := SrcColor and $1C - Color and $1C;
- B := SrcColor and $03 - Color and $03;
- if R > $E0 then
- R := 0;
- if G > $1C then
- G := 0;
- if B > $03 then
- B := 0;
- PUInt8( Addr )^ := R or G or B;
- end;
- 15 :
- begin
- R := SrcColor and $7C00 - Color and $7C00;
- G := SrcColor and $03E0 - Color and $03E0;
- B := SrcColor and $001F - Color and $001F;
- if R > $7C00 then
- R := 0;
- if G > $03E0 then
- G := 0;
- if B > $001F then
- B := 0;
- PUInt16( Addr )^ := R or G or B;
- end;
- 16 :
- begin
- R := SrcColor and $F800 - Color and $F800;
- G := SrcColor and $07C0 - Color and $07C0;
- B := SrcColor and $001F - Color and $001F;
- if R > $F800 then
- R := 0;
- if G > $07C0 then
- G := 0;
- if B > $001F then
- B := 0;
- PUInt16( Addr )^ := R or G or B;
- end;
- 24 :
- begin
- R := SrcColor and $00FF0000 - Color and $00FF0000;
- G := SrcColor and $0000FF00 - Color and $0000FF00;
- B := SrcColor and $000000FF - Color and $000000FF;
- if R > $FF0000 then
- R := 0;
- if G > $00FF00 then
- G := 0;
- if B > $0000FF then
- B := 0;
- PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B;
- end;
- 32 :
- begin
- R := SrcColor and $00FF0000 - Color and $00FF0000;
- G := SrcColor and $0000FF00 - Color and $0000FF00;
- B := SrcColor and $000000FF - Color and $000000FF;
- if R > $FF0000 then
- R := 0;
- if G > $00FF00 then
- G := 0;
- if B > $0000FF then
- B := 0;
- PUInt32( Addr )^ := R or G or B;
- end;
- end;
- end;
-end;
-// This procedure works on 8, 15, 16, 24 and 32 bits color depth surfaces.
-// In 8 bit color depth mode the procedure works with the default packed
-// palette (RRRGGGBB). It handles all clipping.
-
-procedure SDL_AddSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-var
- R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;
- Src, Dest : TSDL_Rect;
- Diff : integer;
- SrcAddr, DestAddr : PtrUInt;
- WorkX, WorkY : word;
- SrcMod, DestMod : cardinal;
- Bits : cardinal;
-begin
- if ( SrcSurface = nil ) or ( DestSurface = nil ) then
- exit; // Remove this to make it faster
- if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
- exit; // Remove this to make it faster
- if SrcRect = nil then
- begin
- with Src do
- begin
- x := 0;
- y := 0;
- w := SrcSurface.w;
- h := SrcSurface.h;
- end;
- end
- else
- Src := SrcRect^;
- if DestRect = nil then
- begin
- Dest.x := 0;
- Dest.y := 0;
- end
- else
- Dest := DestRect^;
- Dest.w := Src.w;
- Dest.h := Src.h;
- with DestSurface.Clip_Rect do
- begin
- // Source's right side is greater than the dest.cliprect
- if Dest.x + Src.w > x + w then
- begin
- smallint( Src.w ) := x + w - Dest.x;
- smallint( Dest.w ) := x + w - Dest.x;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's bottom side is greater than the dest.clip
- if Dest.y + Src.h > y + h then
- begin
- smallint( Src.h ) := y + h - Dest.y;
- smallint( Dest.h ) := y + h - Dest.y;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- // Source's left side is less than the dest.clip
- if Dest.x < x then
- begin
- Diff := x - Dest.x;
- Src.x := Src.x + Diff;
- smallint( Src.w ) := smallint( Src.w ) - Diff;
- Dest.x := x;
- smallint( Dest.w ) := smallint( Dest.w ) - Diff;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's Top side is less than the dest.clip
- if Dest.y < y then
- begin
- Diff := y - Dest.y;
- Src.y := Src.y + Diff;
- smallint( Src.h ) := smallint( Src.h ) - Diff;
- Dest.y := y;
- smallint( Dest.h ) := smallint( Dest.h ) - Diff;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- end;
- with SrcSurface^ do
- begin
- SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
- Format.BytesPerPixel;
- SrcMod := Pitch - Src.w * Format.BytesPerPixel;
- TransparentColor := Format.colorkey;
- end;
- with DestSurface^ do
- begin
- DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
- Format.BytesPerPixel;
- DestMod := Pitch - Dest.w * Format.BytesPerPixel;
- Bits := Format.BitsPerPixel;
- end;
- SDL_LockSurface( SrcSurface );
- SDL_LockSurface( DestSurface );
- WorkY := Src.h;
- case bits of
- 8 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt8( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt8( DestAddr )^;
- if Pixel2 > 0 then
- begin
- R := Pixel1 and $E0 + Pixel2 and $E0;
- G := Pixel1 and $1C + Pixel2 and $1C;
- B := Pixel1 and $03 + Pixel2 and $03;
- if R > $E0 then
- R := $E0;
- if G > $1C then
- G := $1C;
- if B > $03 then
- B := $03;
- PUInt8( DestAddr )^ := R or G or B;
- end
- else
- PUInt8( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr );
- inc( DestAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 15 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
- if Pixel2 > 0 then
- begin
- R := Pixel1 and $7C00 + Pixel2 and $7C00;
- G := Pixel1 and $03E0 + Pixel2 and $03E0;
- B := Pixel1 and $001F + Pixel2 and $001F;
- if R > $7C00 then
- R := $7C00;
- if G > $03E0 then
- G := $03E0;
- if B > $001F then
- B := $001F;
- PUInt16( DestAddr )^ := R or G or B;
- end
- else
- PUInt16( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 16 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
- if Pixel2 > 0 then
- begin
- R := Pixel1 and $F800 + Pixel2 and $F800;
- G := Pixel1 and $07E0 + Pixel2 and $07E0;
- B := Pixel1 and $001F + Pixel2 and $001F;
- if R > $F800 then
- R := $F800;
- if G > $07E0 then
- G := $07E0;
- if B > $001F then
- B := $001F;
- PUInt16( DestAddr )^ := R or G or B;
- end
- else
- PUInt16( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 24 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
- if Pixel2 > 0 then
- begin
- R := Pixel1 and $FF0000 + Pixel2 and $FF0000;
- G := Pixel1 and $00FF00 + Pixel2 and $00FF00;
- B := Pixel1 and $0000FF + Pixel2 and $0000FF;
- if R > $FF0000 then
- R := $FF0000;
- if G > $00FF00 then
- G := $00FF00;
- if B > $0000FF then
- B := $0000FF;
- PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B );
- end
- else
- PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1;
- end;
- inc( SrcAddr, 3 );
- inc( DestAddr, 3 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 32 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^;
- if Pixel2 > 0 then
- begin
- R := Pixel1 and $FF0000 + Pixel2 and $FF0000;
- G := Pixel1 and $00FF00 + Pixel2 and $00FF00;
- B := Pixel1 and $0000FF + Pixel2 and $0000FF;
- if R > $FF0000 then
- R := $FF0000;
- if G > $00FF00 then
- G := $00FF00;
- if B > $0000FF then
- B := $0000FF;
- PUInt32( DestAddr )^ := R or G or B;
- end
- else
- PUInt32( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr, 4 );
- inc( DestAddr, 4 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- end;
- SDL_UnlockSurface( SrcSurface );
- SDL_UnlockSurface( DestSurface );
-end;
-
-procedure SDL_SubSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-var
- R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;
- Src, Dest : TSDL_Rect;
- Diff : integer;
- SrcAddr, DestAddr : PtrUInt;
-//{*_ebx, *}{*_esi, *}{*_edi, _esp*} : cardinal; // Auto Removed, Unused Variable (_ebx) // Auto Removed, Unused Variable (_esi) // Auto Removed, Unused Variable (_edi)
- WorkX, WorkY : word;
- SrcMod, DestMod : cardinal;
- Bits : cardinal;
-begin
- if ( SrcSurface = nil ) or ( DestSurface = nil ) then
- exit; // Remove this to make it faster
- if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
- exit; // Remove this to make it faster
- if SrcRect = nil then
- begin
- with Src do
- begin
- x := 0;
- y := 0;
- w := SrcSurface.w;
- h := SrcSurface.h;
- end;
- end
- else
- Src := SrcRect^;
- if DestRect = nil then
- begin
- Dest.x := 0;
- Dest.y := 0;
- end
- else
- Dest := DestRect^;
- Dest.w := Src.w;
- Dest.h := Src.h;
- with DestSurface.Clip_Rect do
- begin
- // Source's right side is greater than the dest.cliprect
- if Dest.x + Src.w > x + w then
- begin
- smallint( Src.w ) := x + w - Dest.x;
- smallint( Dest.w ) := x + w - Dest.x;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's bottom side is greater than the dest.clip
- if Dest.y + Src.h > y + h then
- begin
- smallint( Src.h ) := y + h - Dest.y;
- smallint( Dest.h ) := y + h - Dest.y;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- // Source's left side is less than the dest.clip
- if Dest.x < x then
- begin
- Diff := x - Dest.x;
- Src.x := Src.x + Diff;
- smallint( Src.w ) := smallint( Src.w ) - Diff;
- Dest.x := x;
- smallint( Dest.w ) := smallint( Dest.w ) - Diff;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's Top side is less than the dest.clip
- if Dest.y < y then
- begin
- Diff := y - Dest.y;
- Src.y := Src.y + Diff;
- smallint( Src.h ) := smallint( Src.h ) - Diff;
- Dest.y := y;
- smallint( Dest.h ) := smallint( Dest.h ) - Diff;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- end;
- with SrcSurface^ do
- begin
- SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
- Format.BytesPerPixel;
- SrcMod := Pitch - Src.w * Format.BytesPerPixel;
- TransparentColor := Format.colorkey;
- end;
- with DestSurface^ do
- begin
- DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
- Format.BytesPerPixel;
- DestMod := Pitch - Dest.w * Format.BytesPerPixel;
- Bits := DestSurface.Format.BitsPerPixel;
- end;
- SDL_LockSurface( SrcSurface );
- SDL_LockSurface( DestSurface );
- WorkY := Src.h;
- case bits of
- 8 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt8( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt8( DestAddr )^;
- if Pixel2 > 0 then
- begin
- R := Pixel2 and $E0 - Pixel1 and $E0;
- G := Pixel2 and $1C - Pixel1 and $1C;
- B := Pixel2 and $03 - Pixel1 and $03;
- if R > $E0 then
- R := 0;
- if G > $1C then
- G := 0;
- if B > $03 then
- B := 0;
- PUInt8( DestAddr )^ := R or G or B;
- end;
- end;
- inc( SrcAddr );
- inc( DestAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 15 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
- if Pixel2 > 0 then
- begin
- R := Pixel2 and $7C00 - Pixel1 and $7C00;
- G := Pixel2 and $03E0 - Pixel1 and $03E0;
- B := Pixel2 and $001F - Pixel1 and $001F;
- if R > $7C00 then
- R := 0;
- if G > $03E0 then
- G := 0;
- if B > $001F then
- B := 0;
- PUInt16( DestAddr )^ := R or G or B;
- end;
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 16 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
- if Pixel2 > 0 then
- begin
- R := Pixel2 and $F800 - Pixel1 and $F800;
- G := Pixel2 and $07E0 - Pixel1 and $07E0;
- B := Pixel2 and $001F - Pixel1 and $001F;
- if R > $F800 then
- R := 0;
- if G > $07E0 then
- G := 0;
- if B > $001F then
- B := 0;
- PUInt16( DestAddr )^ := R or G or B;
- end;
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 24 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
- if Pixel2 > 0 then
- begin
- R := Pixel2 and $FF0000 - Pixel1 and $FF0000;
- G := Pixel2 and $00FF00 - Pixel1 and $00FF00;
- B := Pixel2 and $0000FF - Pixel1 and $0000FF;
- if R > $FF0000 then
- R := 0;
- if G > $00FF00 then
- G := 0;
- if B > $0000FF then
- B := 0;
- PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B );
- end;
- end;
- inc( SrcAddr, 3 );
- inc( DestAddr, 3 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 32 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^;
- if Pixel2 > 0 then
- begin
- R := Pixel2 and $FF0000 - Pixel1 and $FF0000;
- G := Pixel2 and $00FF00 - Pixel1 and $00FF00;
- B := Pixel2 and $0000FF - Pixel1 and $0000FF;
- if R > $FF0000 then
- R := 0;
- if G > $00FF00 then
- G := 0;
- if B > $0000FF then
- B := 0;
- PUInt32( DestAddr )^ := R or G or B;
- end
- else
- PUInt32( DestAddr )^ := Pixel2;
- end;
- inc( SrcAddr, 4 );
- inc( DestAddr, 4 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- end;
- SDL_UnlockSurface( SrcSurface );
- SDL_UnlockSurface( DestSurface );
-end;
-
-procedure SDL_MonoSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Color : cardinal );
-var
- Src, Dest : TSDL_Rect;
- Diff : integer;
- SrcAddr, DestAddr : PtrUInt;
-//{*_ebx, *}{*_esi, *}{*_edi, _esp*} : cardinal; // Auto Removed, Unused Variable (_ebx) // Auto Removed, Unused Variable (_esi) // Auto Removed, Unused Variable (_edi)
- WorkX, WorkY : word;
- SrcMod, DestMod : cardinal;
- TransparentColor, SrcColor : cardinal;
- BPP : cardinal;
-begin
- if ( SrcSurface = nil ) or ( DestSurface = nil ) then
- exit; // Remove this to make it faster
- if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
- exit; // Remove this to make it faster
- if SrcRect = nil then
- begin
- with Src do
- begin
- x := 0;
- y := 0;
- w := SrcSurface.w;
- h := SrcSurface.h;
- end;
- end
- else
- Src := SrcRect^;
- if DestRect = nil then
- begin
- Dest.x := 0;
- Dest.y := 0;
- end
- else
- Dest := DestRect^;
- Dest.w := Src.w;
- Dest.h := Src.h;
- with DestSurface.Clip_Rect do
- begin
- // Source's right side is greater than the dest.cliprect
- if Dest.x + Src.w > x + w then
- begin
- smallint( Src.w ) := x + w - Dest.x;
- smallint( Dest.w ) := x + w - Dest.x;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's bottom side is greater than the dest.clip
- if Dest.y + Src.h > y + h then
- begin
- smallint( Src.h ) := y + h - Dest.y;
- smallint( Dest.h ) := y + h - Dest.y;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- // Source's left side is less than the dest.clip
- if Dest.x < x then
- begin
- Diff := x - Dest.x;
- Src.x := Src.x + Diff;
- smallint( Src.w ) := smallint( Src.w ) - Diff;
- Dest.x := x;
- smallint( Dest.w ) := smallint( Dest.w ) - Diff;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's Top side is less than the dest.clip
- if Dest.y < y then
- begin
- Diff := y - Dest.y;
- Src.y := Src.y + Diff;
- smallint( Src.h ) := smallint( Src.h ) - Diff;
- Dest.y := y;
- smallint( Dest.h ) := smallint( Dest.h ) - Diff;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- end;
- with SrcSurface^ do
- begin
- SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
- Format.BytesPerPixel;
- SrcMod := Pitch - Src.w * Format.BytesPerPixel;
- TransparentColor := Format.colorkey;
- end;
- with DestSurface^ do
- begin
- DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
- Format.BytesPerPixel;
- DestMod := Pitch - Dest.w * Format.BytesPerPixel;
- BPP := DestSurface.Format.BytesPerPixel;
- end;
- SDL_LockSurface( SrcSurface );
- SDL_LockSurface( DestSurface );
- WorkY := Src.h;
- case BPP of
- 1 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- SrcColor := PUInt8( SrcAddr )^;
- if SrcColor <> TransparentColor then
- PUInt8( DestAddr )^ := SrcColor;
- inc( SrcAddr );
- inc( DestAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 2 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- SrcColor := PUInt16( SrcAddr )^;
- if SrcColor <> TransparentColor then
- PUInt16( DestAddr )^ := SrcColor;
- inc( SrcAddr );
- inc( DestAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 3 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- SrcColor := PUInt32( SrcAddr )^ and $FFFFFF;
- if SrcColor <> TransparentColor then
- PUInt32( DestAddr )^ := ( PUInt32( DestAddr )^ and $FFFFFF ) or SrcColor;
- inc( SrcAddr );
- inc( DestAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 4 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- SrcColor := PUInt32( SrcAddr )^;
- if SrcColor <> TransparentColor then
- PUInt32( DestAddr )^ := SrcColor;
- inc( SrcAddr );
- inc( DestAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- end;
- SDL_UnlockSurface( SrcSurface );
- SDL_UnlockSurface( DestSurface );
-end;
-// TextureRect.w and TextureRect.h are not used.
-// The TextureSurface's size MUST larger than the drawing rectangle!!!
-
-procedure SDL_TexturedSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Texture : PSDL_Surface;
- TextureRect : PSDL_Rect );
-var
- Src, Dest : TSDL_Rect;
- Diff : integer;
- SrcAddr, DestAddr, TextAddr : PtrUInt;
-//{*_ebx, *}{*_esi, *}{*_edi, _esp*}: cardinal; // Auto Removed, Unused Variable (_ebx) // Auto Removed, Unused Variable (_esi) // Auto Removed, Unused Variable (_edi)
- WorkX, WorkY : word;
- SrcMod, DestMod, TextMod : cardinal;
-SrcColor, TransparentColor{*, TextureColor*} : cardinal; // Auto Removed, Unused Variable (TextureColor)
- BPP : cardinal;
-begin
- if ( SrcSurface = nil ) or ( DestSurface = nil ) then
- exit; // Remove this to make it faster
- if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
- exit; // Remove this to make it faster
- if SrcRect = nil then
- begin
- with Src do
- begin
- x := 0;
- y := 0;
- w := SrcSurface.w;
- h := SrcSurface.h;
- end;
- end
- else
- Src := SrcRect^;
- if DestRect = nil then
- begin
- Dest.x := 0;
- Dest.y := 0;
- end
- else
- Dest := DestRect^;
- Dest.w := Src.w;
- Dest.h := Src.h;
- with DestSurface.Clip_Rect do
- begin
- // Source's right side is greater than the dest.cliprect
- if Dest.x + Src.w > x + w then
- begin
- smallint( Src.w ) := x + w - Dest.x;
- smallint( Dest.w ) := x + w - Dest.x;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's bottom side is greater than the dest.clip
- if Dest.y + Src.h > y + h then
- begin
- smallint( Src.h ) := y + h - Dest.y;
- smallint( Dest.h ) := y + h - Dest.y;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- // Source's left side is less than the dest.clip
- if Dest.x < x then
- begin
- Diff := x - Dest.x;
- Src.x := Src.x + Diff;
- smallint( Src.w ) := smallint( Src.w ) - Diff;
- Dest.x := x;
- smallint( Dest.w ) := smallint( Dest.w ) - Diff;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's Top side is less than the dest.clip
- if Dest.y < y then
- begin
- Diff := y - Dest.y;
- Src.y := Src.y + Diff;
- smallint( Src.h ) := smallint( Src.h ) - Diff;
- Dest.y := y;
- smallint( Dest.h ) := smallint( Dest.h ) - Diff;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- end;
- with SrcSurface^ do
- begin
- SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
- Format.BytesPerPixel;
- SrcMod := Pitch - Src.w * Format.BytesPerPixel;
- TransparentColor := format.colorkey;
- end;
- with DestSurface^ do
- begin
- DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
- Format.BytesPerPixel;
- DestMod := Pitch - Dest.w * Format.BytesPerPixel;
- BPP := DestSurface.Format.BitsPerPixel;
- end;
- with Texture^ do
- begin
- TextAddr := PtrUInt( Pixels ) + UInt32( TextureRect.y ) * Pitch +
- UInt32( TextureRect.x ) * Format.BytesPerPixel;
- TextMod := Pitch - Src.w * Format.BytesPerPixel;
- end;
- SDL_LockSurface( SrcSurface );
- SDL_LockSurface( DestSurface );
- SDL_LockSurface( Texture );
- WorkY := Src.h;
- case BPP of
- 1 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- SrcColor := PUInt8( SrcAddr )^;
- if SrcColor <> TransparentColor then
- PUInt8( DestAddr )^ := PUint8( TextAddr )^;
- inc( SrcAddr );
- inc( DestAddr );
- inc( TextAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- inc( TextAddr, TextMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 2 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- SrcColor := PUInt16( SrcAddr )^;
- if SrcColor <> TransparentColor then
- PUInt16( DestAddr )^ := PUInt16( TextAddr )^;
- inc( SrcAddr );
- inc( DestAddr );
- inc( TextAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- inc( TextAddr, TextMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 3 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- SrcColor := PUInt32( SrcAddr )^ and $FFFFFF;
- if SrcColor <> TransparentColor then
- PUInt32( DestAddr )^ := ( PUInt32( DestAddr )^ and $FFFFFF ) or ( PUInt32( TextAddr )^ and $FFFFFF );
- inc( SrcAddr );
- inc( DestAddr );
- inc( TextAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- inc( TextAddr, TextMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 4 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- SrcColor := PUInt32( SrcAddr )^;
- if SrcColor <> TransparentColor then
- PUInt32( DestAddr )^ := PUInt32( TextAddr )^;
- inc( SrcAddr );
- inc( DestAddr );
- inc( TextAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- inc( TextAddr, TextMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- end;
- SDL_UnlockSurface( SrcSurface );
- SDL_UnlockSurface( DestSurface );
- SDL_UnlockSurface( Texture );
-end;
-
-procedure SDL_ZoomSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; DstRect : PSDL_Rect );
-var
- xc, yc : cardinal;
- rx, wx, ry, wy, ry16 : cardinal;
- color : cardinal;
- modx, mody : cardinal;
-begin
- // Warning! No checks for surface pointers!!!
- if srcrect = nil then
- srcrect := @SrcSurface.clip_rect;
- if dstrect = nil then
- dstrect := @DstSurface.clip_rect;
- if SDL_MustLock( SrcSurface ) then
- SDL_LockSurface( SrcSurface );
- if SDL_MustLock( DstSurface ) then
- SDL_LockSurface( DstSurface );
- modx := trunc( ( srcrect.w / dstrect.w ) * 65536 );
- mody := trunc( ( srcrect.h / dstrect.h ) * 65536 );
- //rx := srcrect.x * 65536;
- ry := srcrect.y * 65536;
- wy := dstrect.y;
- for yc := 0 to dstrect.h - 1 do
- begin
- rx := srcrect.x * 65536;
- wx := dstrect.x;
- ry16 := ry shr 16;
- for xc := 0 to dstrect.w - 1 do
- begin
- color := SDL_GetPixel( SrcSurface, rx shr 16, ry16 );
- SDL_PutPixel( DstSurface, wx, wy, color );
- rx := rx + modx;
- inc( wx );
- end;
- ry := ry + mody;
- inc( wy );
- end;
- if SDL_MustLock( SrcSurface ) then
- SDL_UnlockSurface( SrcSurface );
- if SDL_MustLock( DstSurface ) then
- SDL_UnlockSurface( DstSurface );
-end;
-// Re-map a rectangular area into an area defined by four vertices
-// Converted from C to Pascal by KiCHY
-
-procedure SDL_WarpSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; UL, UR, LR, LL : PPoint );
-const
- SHIFTS = 15; // Extend ints to limit round-off error (try 2 - 20)
- THRESH = 1 shl SHIFTS; // Threshold for pixel size value
- procedure CopySourceToDest( UL, UR, LR, LL : TPoint; x1, y1, x2, y2 : cardinal );
- var
- tm, lm, rm, bm, m : TPoint;
- mx, my : cardinal;
- cr : cardinal;
- begin
- // Does the destination area specify a single pixel?
- if ( ( abs( ul.x - ur.x ) < THRESH ) and
- ( abs( ul.x - lr.x ) < THRESH ) and
- ( abs( ul.x - ll.x ) < THRESH ) and
- ( abs( ul.y - ur.y ) < THRESH ) and
- ( abs( ul.y - lr.y ) < THRESH ) and
- ( abs( ul.y - ll.y ) < THRESH ) ) then
- begin // Yes
- cr := SDL_GetPixel( SrcSurface, ( x1 shr SHIFTS ), ( y1 shr SHIFTS ) );
- SDL_PutPixel( DstSurface, ( ul.x shr SHIFTS ), ( ul.y shr SHIFTS ), cr );
- end
- else
- begin // No
- // Quarter the source and the destination, and then recurse
- tm.x := ( ul.x + ur.x ) shr 1;
- tm.y := ( ul.y + ur.y ) shr 1;
- bm.x := ( ll.x + lr.x ) shr 1;
- bm.y := ( ll.y + lr.y ) shr 1;
- lm.x := ( ul.x + ll.x ) shr 1;
- lm.y := ( ul.y + ll.y ) shr 1;
- rm.x := ( ur.x + lr.x ) shr 1;
- rm.y := ( ur.y + lr.y ) shr 1;
- m.x := ( tm.x + bm.x ) shr 1;
- m.y := ( tm.y + bm.y ) shr 1;
- mx := ( x1 + x2 ) shr 1;
- my := ( y1 + y2 ) shr 1;
- CopySourceToDest( ul, tm, m, lm, x1, y1, mx, my );
- CopySourceToDest( tm, ur, rm, m, mx, y1, x2, my );
- CopySourceToDest( m, rm, lr, bm, mx, my, x2, y2 );
- CopySourceToDest( lm, m, bm, ll, x1, my, mx, y2 );
- end;
- end;
-var
- _UL, _UR, _LR, _LL : TPoint;
- Rect_x, Rect_y, Rect_w, Rect_h : integer;
-begin
- if SDL_MustLock( SrcSurface ) then
- SDL_LockSurface( SrcSurface );
- if SDL_MustLock( DstSurface ) then
- SDL_LockSurface( DstSurface );
- if SrcRect = nil then
- begin
- Rect_x := 0;
- Rect_y := 0;
- Rect_w := ( SrcSurface.w - 1 ) shl SHIFTS;
- Rect_h := ( SrcSurface.h - 1 ) shl SHIFTS;
- end
- else
- begin
- Rect_x := SrcRect.x;
- Rect_y := SrcRect.y;
- Rect_w := ( SrcRect.w - 1 ) shl SHIFTS;
- Rect_h := ( SrcRect.h - 1 ) shl SHIFTS;
- end;
- // Shift all values to help reduce round-off error.
- _ul.x := ul.x shl SHIFTS;
- _ul.y := ul.y shl SHIFTS;
- _ur.x := ur.x shl SHIFTS;
- _ur.y := ur.y shl SHIFTS;
- _lr.x := lr.x shl SHIFTS;
- _lr.y := lr.y shl SHIFTS;
- _ll.x := ll.x shl SHIFTS;
- _ll.y := ll.y shl SHIFTS;
- CopySourceToDest( _ul, _ur, _lr, _ll, Rect_x, Rect_y, Rect_w, Rect_h );
- if SDL_MustLock( SrcSurface ) then
- SDL_UnlockSurface( SrcSurface );
- if SDL_MustLock( DstSurface ) then
- SDL_UnlockSurface( DstSurface );
-end;
-
-// Draw a line between x1,y1 and x2,y2 to the given surface
-// NOTE: The surface must be locked before calling this!
-
-procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
- cardinal );
-var
- dx, dy, sdx, sdy, x, y, px, py : integer;
-begin
- dx := x2 - x1;
- dy := y2 - y1;
- if dx < 0 then
- sdx := -1
- else
- sdx := 1;
- if dy < 0 then
- sdy := -1
- else
- sdy := 1;
- dx := sdx * dx + 1;
- dy := sdy * dy + 1;
- x := 0;
- y := 0;
- px := x1;
- py := y1;
- if dx >= dy then
- begin
- for x := 0 to dx - 1 do
- begin
- SDL_PutPixel( DstSurface, px, py, Color );
- y := y + dy;
- if y >= dx then
- begin
- y := y - dx;
- py := py + sdy;
- end;
- px := px + sdx;
- end;
- end
- else
- begin
- for y := 0 to dy - 1 do
- begin
- SDL_PutPixel( DstSurface, px, py, Color );
- x := x + dx;
- if x >= dy then
- begin
- x := x - dy;
- px := px + sdx;
- end;
- py := py + sdy;
- end;
- end;
-end;
-
-// Draw a dashed line between x1,y1 and x2,y2 to the given surface
-// NOTE: The surface must be locked before calling this!
-
-procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
- cardinal; DashLength, DashSpace : byte ); overload;
-var
- dx, dy, sdx, sdy, x, y, px, py, counter : integer; drawdash : boolean;
-begin
- counter := 0;
- drawdash := true; //begin line drawing with dash
-
- //Avoid invalid user-passed dash parameters
- if ( DashLength < 1 )
- then
- DashLength := 1;
- if ( DashSpace < 1 )
- then
- DashSpace := 0;
-
- dx := x2 - x1;
- dy := y2 - y1;
- if dx < 0 then
- sdx := -1
- else
- sdx := 1;
- if dy < 0 then
- sdy := -1
- else
- sdy := 1;
- dx := sdx * dx + 1;
- dy := sdy * dy + 1;
- x := 0;
- y := 0;
- px := x1;
- py := y1;
- if dx >= dy then
- begin
- for x := 0 to dx - 1 do
- begin
-
- //Alternate drawing dashes, or leaving spaces
- if drawdash then
- begin
- SDL_PutPixel( DstSurface, px, py, Color );
- inc( counter );
- if ( counter > DashLength - 1 ) and ( DashSpace > 0 ) then
- begin
- drawdash := false;
- counter := 0;
- end;
- end
- else //space
- begin
- inc( counter );
- if counter > DashSpace - 1 then
- begin
- drawdash := true;
- counter := 0;
- end;
- end;
-
- y := y + dy;
- if y >= dx then
- begin
- y := y - dx;
- py := py + sdy;
- end;
- px := px + sdx;
- end;
- end
- else
- begin
- for y := 0 to dy - 1 do
- begin
-
- //Alternate drawing dashes, or leaving spaces
- if drawdash then
- begin
- SDL_PutPixel( DstSurface, px, py, Color );
- inc( counter );
- if ( counter > DashLength - 1 ) and ( DashSpace > 0 ) then
- begin
- drawdash := false;
- counter := 0;
- end;
- end
- else //space
- begin
- inc( counter );
- if counter > DashSpace - 1 then
- begin
- drawdash := true;
- counter := 0;
- end;
- end;
-
- x := x + dx;
- if x >= dy then
- begin
- x := x - dy;
- px := px + sdx;
- end;
- py := py + sdy;
- end;
- end;
-end;
-
-procedure SDL_AddLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
- cardinal );
-var
- dx, dy, sdx, sdy, x, y, px, py : integer;
-begin
- dx := x2 - x1;
- dy := y2 - y1;
- if dx < 0 then
- sdx := -1
- else
- sdx := 1;
- if dy < 0 then
- sdy := -1
- else
- sdy := 1;
- dx := sdx * dx + 1;
- dy := sdy * dy + 1;
- x := 0;
- y := 0;
- px := x1;
- py := y1;
- if dx >= dy then
- begin
- for x := 0 to dx - 1 do
- begin
- SDL_AddPixel( DstSurface, px, py, Color );
- y := y + dy;
- if y >= dx then
- begin
- y := y - dx;
- py := py + sdy;
- end;
- px := px + sdx;
- end;
- end
- else
- begin
- for y := 0 to dy - 1 do
- begin
- SDL_AddPixel( DstSurface, px, py, Color );
- x := x + dx;
- if x >= dy then
- begin
- x := x - dy;
- px := px + sdx;
- end;
- py := py + sdy;
- end;
- end;
-end;
-
-procedure SDL_SubLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
- cardinal );
-var
- dx, dy, sdx, sdy, x, y, px, py : integer;
-begin
- dx := x2 - x1;
- dy := y2 - y1;
- if dx < 0 then
- sdx := -1
- else
- sdx := 1;
- if dy < 0 then
- sdy := -1
- else
- sdy := 1;
- dx := sdx * dx + 1;
- dy := sdy * dy + 1;
- x := 0;
- y := 0;
- px := x1;
- py := y1;
- if dx >= dy then
- begin
- for x := 0 to dx - 1 do
- begin
- SDL_SubPixel( DstSurface, px, py, Color );
- y := y + dy;
- if y >= dx then
- begin
- y := y - dx;
- py := py + sdy;
- end;
- px := px + sdx;
- end;
- end
- else
- begin
- for y := 0 to dy - 1 do
- begin
- SDL_SubPixel( DstSurface, px, py, Color );
- x := x + dx;
- if x >= dy then
- begin
- x := x - dy;
- px := px + sdx;
- end;
- py := py + sdy;
- end;
- end;
-end;
-
-// flips a rectangle vertically on given surface
-
-procedure SDL_FlipRectV( DstSurface : PSDL_Surface; Rect : PSDL_Rect );
-var
- TmpRect : TSDL_Rect;
- Locked : boolean;
- y, FlipLength, RowLength : integer;
- Row1, Row2 : Pointer;
- OneRow : TByteArray; // Optimize it if you wish
-begin
- if DstSurface <> nil then
- begin
- if Rect = nil then
- begin // if Rect=nil then we flip the whole surface
- TmpRect := SDLRect( 0, 0, DstSurface.w, DstSurface.h );
- Rect := @TmpRect;
- end;
- FlipLength := Rect^.h shr 1 - 1;
- RowLength := Rect^.w * DstSurface^.format.BytesPerPixel;
- if SDL_MustLock( DstSurface ) then
- begin
- Locked := true;
- SDL_LockSurface( DstSurface );
- end
- else
- Locked := false;
- Row1 := pointer( PtrUInt( DstSurface^.Pixels ) + UInt32( Rect^.y ) *
- DstSurface^.Pitch );
- Row2 := pointer( PtrUInt( DstSurface^.Pixels ) + ( UInt32( Rect^.y ) + Rect^.h - 1 )
- * DstSurface^.Pitch );
- for y := 0 to FlipLength do
- begin
- Move( Row1^, OneRow, RowLength );
- Move( Row2^, Row1^, RowLength );
- Move( OneRow, Row2^, RowLength );
- inc( PtrUInt( Row1 ), DstSurface^.Pitch );
- dec( PtrUInt( Row2 ), DstSurface^.Pitch );
- end;
- if Locked then
- SDL_UnlockSurface( DstSurface );
- end;
-end;
-
-// flips a rectangle horizontally on given surface
-
-procedure SDL_FlipRectH( DstSurface : PSDL_Surface; Rect : PSDL_Rect );
-type
- T24bit = packed array[ 0..2 ] of byte;
- T24bitArray = packed array[ 0..8191 ] of T24bit;
- P24bitArray = ^T24bitArray;
- TLongWordArray = array[ 0..8191 ] of LongWord;
- PLongWordArray = ^TLongWordArray;
-var
- TmpRect : TSDL_Rect;
- Row8bit : PByteArray;
- Row16bit : PWordArray;
- Row24bit : P24bitArray;
- Row32bit : PLongWordArray;
- y, x, RightSide, FlipLength : integer;
- Pixel : cardinal;
- Pixel24 : T24bit;
- Locked : boolean;
-begin
- if DstSurface <> nil then
- begin
- if Rect = nil then
- begin
- TmpRect := SDLRect( 0, 0, DstSurface.w, DstSurface.h );
- Rect := @TmpRect;
- end;
- FlipLength := Rect^.w shr 1 - 1;
- if SDL_MustLock( DstSurface ) then
- begin
- Locked := true;
- SDL_LockSurface( DstSurface );
- end
- else
- Locked := false;
- case DstSurface^.format.BytesPerPixel of
- 1 :
- begin
- Row8Bit := pointer( PtrUInt( DstSurface^.pixels ) + UInt32( Rect^.y ) *
- DstSurface^.pitch );
- for y := 1 to Rect^.h do
- begin
- RightSide := Rect^.w - 1;
- for x := 0 to FlipLength do
- begin
- Pixel := Row8Bit^[ x ];
- Row8Bit^[ x ] := Row8Bit^[ RightSide ];
- Row8Bit^[ RightSide ] := Pixel;
- dec( RightSide );
- end;
- inc( PtrUInt( Row8Bit ), DstSurface^.pitch );
- end;
- end;
- 2 :
- begin
- Row16Bit := pointer( PtrUInt( DstSurface^.pixels ) + UInt32( Rect^.y ) *
- DstSurface^.pitch );
- for y := 1 to Rect^.h do
- begin
- RightSide := Rect^.w - 1;
- for x := 0 to FlipLength do
- begin
- Pixel := Row16Bit^[ x ];
- Row16Bit^[ x ] := Row16Bit^[ RightSide ];
- Row16Bit^[ RightSide ] := Pixel;
- dec( RightSide );
- end;
- inc( PtrUInt( Row16Bit ), DstSurface^.pitch );
- end;
- end;
- 3 :
- begin
- Row24Bit := pointer( PtrUInt( DstSurface^.pixels ) + UInt32( Rect^.y ) *
- DstSurface^.pitch );
- for y := 1 to Rect^.h do
- begin
- RightSide := Rect^.w - 1;
- for x := 0 to FlipLength do
- begin
- Pixel24 := Row24Bit^[ x ];
- Row24Bit^[ x ] := Row24Bit^[ RightSide ];
- Row24Bit^[ RightSide ] := Pixel24;
- dec( RightSide );
- end;
- inc( PtrUInt( Row24Bit ), DstSurface^.pitch );
- end;
- end;
- 4 :
- begin
- Row32Bit := pointer( PtrUInt( DstSurface^.pixels ) + UInt32( Rect^.y ) *
- DstSurface^.pitch );
- for y := 1 to Rect^.h do
- begin
- RightSide := Rect^.w - 1;
- for x := 0 to FlipLength do
- begin
- Pixel := Row32Bit^[ x ];
- Row32Bit^[ x ] := Row32Bit^[ RightSide ];
- Row32Bit^[ RightSide ] := Pixel;
- dec( RightSide );
- end;
- inc( PtrUInt( Row32Bit ), DstSurface^.pitch );
- end;
- end;
- end;
- if Locked then
- SDL_UnlockSurface( DstSurface );
- end;
-end;
-
-// Use with caution! The procedure allocates memory for TSDL_Rect and return with its pointer.
-// But you MUST free it after you don't need it anymore!!!
-
-function PSDLRect( aLeft, aTop, aWidth, aHeight : integer ) : PSDL_Rect;
-var
- Rect : PSDL_Rect;
-begin
- New( Rect );
- with Rect^ do
- begin
- x := aLeft;
- y := aTop;
- w := aWidth;
- h := aHeight;
- end;
- Result := Rect;
-end;
-
-function SDLRect( aLeft, aTop, aWidth, aHeight : integer ) : TSDL_Rect;
-begin
- with result do
- begin
- x := aLeft;
- y := aTop;
- w := aWidth;
- h := aHeight;
- end;
-end;
-
-function SDLRect( aRect : TRect ) : TSDL_Rect;
-begin
- with aRect do
- result := SDLRect( Left, Top, Right - Left, Bottom - Top );
-end;
-
-procedure SDL_Stretch8( Surface, Dst_Surface : PSDL_Surface; x1, x2, y1, y2, yr, yw,
- depth : integer );
-var
- dx, dy, e, d, dx2 : integer;
- src_pitch, dst_pitch : uint16;
- src_pixels, dst_pixels : PUint8;
-begin
- if ( yw >= dst_surface^.h ) then
- exit;
- dx := ( x2 - x1 );
- dy := ( y2 - y1 );
- dy := dy shl 1;
- e := dy - dx;
- dx2 := dx shl 1;
- src_pitch := Surface^.pitch;
- dst_pitch := dst_surface^.pitch;
- src_pixels := PUint8( PtrUInt( Surface^.pixels ) + yr * src_pitch + y1 * depth );
- dst_pixels := PUint8( PtrUInt( dst_surface^.pixels ) + yw * dst_pitch + x1 *
- depth );
- for d := 0 to dx - 1 do
- begin
- move( src_pixels^, dst_pixels^, depth );
- while ( e >= 0 ) do
- begin
- inc( src_pixels, depth );
- e := e - dx2;
- end;
- inc( dst_pixels, depth );
- e := e + dy;
- end;
-end;
-
-function sign( x : integer ) : integer;
-begin
- if x > 0 then
- result := 1
- else
- result := -1;
-end;
-
-// Stretches a part of a surface
-
-function SDL_ScaleSurfaceRect( SrcSurface : PSDL_Surface; SrcX1, SrcY1, SrcW, SrcH,
- Width, Height : integer ) : PSDL_Surface;
-var
- dst_surface : PSDL_Surface;
- dx, dy, e, d, dx2, srcx2, srcy2 : integer;
- destx1, desty1 : integer;
-begin
- srcx2 := srcx1 + SrcW;
- srcy2 := srcy1 + SrcH;
- result := nil;
- destx1 := 0;
- desty1 := 0;
- dx := abs( integer( Height - desty1 ) );
- dy := abs( integer( SrcY2 - SrcY1 ) );
- e := ( dy shl 1 ) - dx;
- dx2 := dx shl 1;
- dy := dy shl 1;
- dst_surface := SDL_CreateRGBSurface( SDL_HWPALETTE, width - destx1, Height -
- desty1,
- SrcSurface^.Format^.BitsPerPixel,
- SrcSurface^.Format^.RMask,
- SrcSurface^.Format^.GMask,
- SrcSurface^.Format^.BMask,
- SrcSurface^.Format^.AMask );
- if ( dst_surface^.format^.BytesPerPixel = 1 ) then
- SDL_SetColors( dst_surface, @SrcSurface^.format^.palette^.colors^[ 0 ], 0, 256 );
- SDL_SetColorKey( dst_surface, sdl_srccolorkey, SrcSurface^.format^.colorkey );
- if ( SDL_MustLock( dst_surface ) ) then
- if ( SDL_LockSurface( dst_surface ) < 0 ) then
- exit;
- for d := 0 to dx - 1 do
- begin
- SDL_Stretch8( SrcSurface, dst_surface, destx1, Width, SrcX1, SrcX2, SrcY1, desty1,
- SrcSurface^.format^.BytesPerPixel );
- while e >= 0 do
- begin
- inc( SrcY1 );
- e := e - dx2;
- end;
- inc( desty1 );
- e := e + dy;
- end;
- if SDL_MUSTLOCK( dst_surface ) then
- SDL_UnlockSurface( dst_surface );
- result := dst_surface;
-end;
-
-procedure SDL_MoveLine( Surface : PSDL_Surface; x1, x2, y1, xofs, depth : integer );
-var
- src_pixels, dst_pixels : PUint8;
- i : integer;
-begin
- src_pixels := PUint8( PtrUInt( Surface^.pixels ) + Surface^.w * y1 * depth + x2 *
- depth );
- dst_pixels := PUint8( PtrUInt( Surface^.pixels ) + Surface^.w * y1 * depth + ( x2
- + xofs ) * depth );
- for i := x2 downto x1 do
- begin
- move( src_pixels^, dst_pixels^, depth );
- dec( src_pixels );
- dec( dst_pixels );
- end;
-end;
-{ Return the pixel value at (x, y)
-NOTE: The surface must be locked before calling this! }
-
-function SDL_GetPixel( SrcSurface : PSDL_Surface; x : integer; y : integer ) : Uint32;
-var
- bpp : UInt32;
- p : PInteger;
-begin
- bpp := SrcSurface.format.BytesPerPixel;
- // Here p is the address to the pixel we want to retrieve
- p := Pointer( PtrUInt( SrcSurface.pixels ) + UInt32( y ) * SrcSurface.pitch + UInt32( x ) *
- bpp );
- case bpp of
- 1 : result := PUint8( p )^;
- 2 : result := PUint16( p )^;
- 3 :
- if ( SDL_BYTEORDER = SDL_BIG_ENDIAN ) then
- result := PUInt8Array( p )[ 0 ] shl 16 or PUInt8Array( p )[ 1 ] shl 8 or
- PUInt8Array( p )[ 2 ]
- else
- result := PUInt8Array( p )[ 0 ] or PUInt8Array( p )[ 1 ] shl 8 or
- PUInt8Array( p )[ 2 ] shl 16;
- 4 : result := PUint32( p )^;
- else
- result := 0; // shouldn't happen, but avoids warnings
- end;
-end;
-{ Set the pixel at (x, y) to the given value
- NOTE: The surface must be locked before calling this! }
-
-procedure SDL_PutPixel( DstSurface : PSDL_Surface; x : integer; y : integer; pixel :
- Uint32 );
-var
- bpp : UInt32;
- p : PInteger;
-begin
- bpp := DstSurface.format.BytesPerPixel;
- p := Pointer( PtrUInt( DstSurface.pixels ) + UInt32( y ) * DstSurface.pitch + UInt32( x )
- * bpp );
- case bpp of
- 1 : PUint8( p )^ := pixel;
- 2 : PUint16( p )^ := pixel;
- 3 :
- if ( SDL_BYTEORDER = SDL_BIG_ENDIAN ) then
- begin
- PUInt8Array( p )[ 0 ] := ( pixel shr 16 ) and $FF;
- PUInt8Array( p )[ 1 ] := ( pixel shr 8 ) and $FF;
- PUInt8Array( p )[ 2 ] := pixel and $FF;
- end
- else
- begin
- PUInt8Array( p )[ 0 ] := pixel and $FF;
- PUInt8Array( p )[ 1 ] := ( pixel shr 8 ) and $FF;
- PUInt8Array( p )[ 2 ] := ( pixel shr 16 ) and $FF;
- end;
- 4 :
- PUint32( p )^ := pixel;
- end;
-end;
-
-procedure SDL_ScrollY( DstSurface : PSDL_Surface; DifY : integer );
-var
- r1, r2 : TSDL_Rect;
- //buffer: PSDL_Surface;
- YPos : Integer;
-begin
- if ( DstSurface <> nil ) and ( DifY <> 0 ) then
- begin
- //if DifY > 0 then // going up
- //begin
- ypos := 0;
- r1.x := 0;
- r2.x := 0;
- r1.w := DstSurface.w;
- r2.w := DstSurface.w;
- r1.h := DifY;
- r2.h := DifY;
- while ypos < DstSurface.h do
- begin
- r1.y := ypos;
- r2.y := ypos + DifY;
- SDL_BlitSurface( DstSurface, @r2, DstSurface, @r1 );
- ypos := ypos + DifY;
- end;
- //end
- //else
- //begin // Going Down
- //end;
- end;
-end;
-
-{procedure SDL_ScrollY(Surface: PSDL_Surface; DifY: integer);
-var
- r1, r2: TSDL_Rect;
- buffer: PSDL_Surface;
-begin
- if (Surface <> nil) and (Dify <> 0) then
- begin
- buffer := SDL_CreateRGBSurface(SDL_HWSURFACE, (Surface^.w - DifY) * 2,
- Surface^.h * 2,
- Surface^.Format^.BitsPerPixel, 0, 0, 0, 0);
- if buffer <> nil then
- begin
- if (buffer^.format^.BytesPerPixel = 1) then
- SDL_SetColors(buffer, @Surface^.format^.palette^.colors^[0], 0, 256);
- r1 := SDLRect(0, DifY, buffer^.w, buffer^.h);
- r2 := SDLRect(0, 0, buffer^.w, buffer^.h);
- SDL_BlitSurface(Surface, @r1, buffer, @r2);
- SDL_BlitSurface(buffer, @r2, Surface, @r2);
- SDL_FreeSurface(buffer);
- end;
- end;
-end;}
-
-procedure SDL_ScrollX( DstSurface : PSDL_Surface; DifX : integer );
-var
- r1, r2 : TSDL_Rect;
- buffer : PSDL_Surface;
-begin
- if ( DstSurface <> nil ) and ( DifX <> 0 ) then
- begin
- buffer := SDL_CreateRGBSurface( SDL_HWSURFACE, ( DstSurface^.w - DifX ) * 2,
- DstSurface^.h * 2,
- DstSurface^.Format^.BitsPerPixel,
- DstSurface^.Format^.RMask,
- DstSurface^.Format^.GMask,
- DstSurface^.Format^.BMask,
- DstSurface^.Format^.AMask );
- if buffer <> nil then
- begin
- if ( buffer^.format^.BytesPerPixel = 1 ) then
- SDL_SetColors( buffer, @DstSurface^.format^.palette^.colors^[ 0 ], 0, 256 );
- r1 := SDLRect( DifX, 0, buffer^.w, buffer^.h );
- r2 := SDLRect( 0, 0, buffer^.w, buffer^.h );
- SDL_BlitSurface( DstSurface, @r1, buffer, @r2 );
- SDL_BlitSurface( buffer, @r2, DstSurface, @r2 );
- SDL_FreeSurface( buffer );
- end;
- end;
-end;
-
-procedure SDL_RotateRad( DstSurface, SrcSurface : PSDL_Surface; SrcRect :
- PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Single );
-var
- aSin, aCos : Single;
- MX, MY, DX, DY, NX, NY, SX, SY, OX, OY, Width, Height, TX, TY, RX, RY, ROX, ROY : Integer;
- Colour, TempTransparentColour : UInt32;
- MAXX, MAXY : Integer;
-begin
- // Rotate the surface to the target surface.
- TempTransparentColour := SrcSurface.format.colorkey;
- {if srcRect.w > srcRect.h then
- begin
- Width := srcRect.w;
- Height := srcRect.w;
- end
- else
- begin
- Width := srcRect.h;
- Height := srcRect.h;
- end; }
-
- maxx := DstSurface.w;
- maxy := DstSurface.h;
- aCos := cos( Angle );
- aSin := sin( Angle );
-
- Width := round( abs( srcrect.h * acos ) + abs( srcrect.w * asin ) );
- Height := round( abs( srcrect.h * asin ) + abs( srcrect.w * acos ) );
-
- OX := Width div 2;
- OY := Height div 2; ;
- MX := ( srcRect.x + ( srcRect.x + srcRect.w ) ) div 2;
- MY := ( srcRect.y + ( srcRect.y + srcRect.h ) ) div 2;
- ROX := ( -( srcRect.w div 2 ) ) + Offsetx;
- ROY := ( -( srcRect.h div 2 ) ) + OffsetY;
- Tx := ox + round( ROX * aSin - ROY * aCos );
- Ty := oy + round( ROY * aSin + ROX * aCos );
- SX := 0;
- for DX := DestX - TX to DestX - TX + ( width ) do
- begin
- Inc( SX );
- SY := 0;
- for DY := DestY - TY to DestY - TY + ( Height ) do
- begin
- RX := SX - OX;
- RY := SY - OY;
- NX := round( mx + RX * aSin + RY * aCos ); //
- NY := round( my + RY * aSin - RX * aCos ); //
- // Used for testing only
- //SDL_PutPixel(DestSurface.SDLSurfacePointer,DX,DY,0);
- if ( ( DX > 0 ) and ( DX < MAXX ) ) and ( ( DY > 0 ) and ( DY < MAXY ) ) then
- begin
- if ( NX >= srcRect.x ) and ( NX <= srcRect.x + srcRect.w ) then
- begin
- if ( NY >= srcRect.y ) and ( NY <= srcRect.y + srcRect.h ) then
- begin
- Colour := SDL_GetPixel( SrcSurface, NX, NY );
- if Colour <> TempTransparentColour then
- begin
- SDL_PutPixel( DstSurface, DX, DY, Colour );
- end;
- end;
- end;
- end;
- inc( SY );
- end;
- end;
-end;
-
-procedure SDL_RotateDeg( DstSurface, SrcSurface : PSDL_Surface; SrcRect :
- PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Integer );
-begin
- SDL_RotateRad( DstSurface, SrcSurface, SrcRect, DestX, DestY, OffsetX, OffsetY, DegToRad( Angle ) );
-end;
-
-function ValidateSurfaceRect( DstSurface : PSDL_Surface; dstrect : PSDL_Rect ) : TSDL_Rect;
-var
- RealRect : TSDL_Rect;
- OutOfRange : Boolean;
-begin
- OutOfRange := false;
- if dstrect = nil then
- begin
- RealRect.x := 0;
- RealRect.y := 0;
- RealRect.w := DstSurface.w;
- RealRect.h := DstSurface.h;
- end
- else
- begin
- if dstrect.x < DstSurface.w then
- begin
- RealRect.x := dstrect.x;
- end
- else if dstrect.x < 0 then
- begin
- realrect.x := 0;
- end
- else
- begin
- OutOfRange := True;
- end;
- if dstrect.y < DstSurface.h then
- begin
- RealRect.y := dstrect.y;
- end
- else if dstrect.y < 0 then
- begin
- realrect.y := 0;
- end
- else
- begin
- OutOfRange := True;
- end;
- if OutOfRange = False then
- begin
- if realrect.x + dstrect.w <= DstSurface.w then
- begin
- RealRect.w := dstrect.w;
- end
- else
- begin
- RealRect.w := dstrect.w - realrect.x;
- end;
- if realrect.y + dstrect.h <= DstSurface.h then
- begin
- RealRect.h := dstrect.h;
- end
- else
- begin
- RealRect.h := dstrect.h - realrect.y;
- end;
- end;
- end;
- if OutOfRange = False then
- begin
- result := realrect;
- end
- else
- begin
- realrect.w := 0;
- realrect.h := 0;
- realrect.x := 0;
- realrect.y := 0;
- result := realrect;
- end;
-end;
-
-procedure SDL_FillRectAdd( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );
-var
- RealRect : TSDL_Rect;
- Addr : pointer;
- ModX, BPP : cardinal;
- x, y, R, G, B, SrcColor : cardinal;
-begin
- RealRect := ValidateSurfaceRect( DstSurface, DstRect );
- if ( RealRect.w > 0 ) and ( RealRect.h > 0 ) then
- begin
- SDL_LockSurface( DstSurface );
- BPP := DstSurface.format.BytesPerPixel;
- with DstSurface^ do
- begin
- Addr := pointer( PtrUInt( pixels ) + UInt32( RealRect.y ) * pitch + UInt32( RealRect.x ) * BPP );
- ModX := Pitch - UInt32( RealRect.w ) * BPP;
- end;
- case DstSurface.format.BitsPerPixel of
- 8 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $E0 + Color and $E0;
- G := SrcColor and $1C + Color and $1C;
- B := SrcColor and $03 + Color and $03;
- if R > $E0 then
- R := $E0;
- if G > $1C then
- G := $1C;
- if B > $03 then
- B := $03;
- PUInt8( Addr )^ := R or G or B;
- inc( PtrUInt( Addr ), BPP );
- end;
- inc( PtrUInt( Addr ), ModX );
- end;
- end;
- 15 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $7C00 + Color and $7C00;
- G := SrcColor and $03E0 + Color and $03E0;
- B := SrcColor and $001F + Color and $001F;
- if R > $7C00 then
- R := $7C00;
- if G > $03E0 then
- G := $03E0;
- if B > $001F then
- B := $001F;
- PUInt16( Addr )^ := R or G or B;
- inc( PtrUInt( Addr ), BPP );
- end;
- inc( PtrUInt( Addr ), ModX );
- end;
- end;
- 16 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $F800 + Color and $F800;
- G := SrcColor and $07C0 + Color and $07C0;
- B := SrcColor and $001F + Color and $001F;
- if R > $F800 then
- R := $F800;
- if G > $07C0 then
- G := $07C0;
- if B > $001F then
- B := $001F;
- PUInt16( Addr )^ := R or G or B;
- inc( PtrUInt( Addr ), BPP );
- end;
- inc( PtrUInt( Addr ), ModX );
- end;
- end;
- 24 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $00FF0000 + Color and $00FF0000;
- G := SrcColor and $0000FF00 + Color and $0000FF00;
- B := SrcColor and $000000FF + Color and $000000FF;
- if R > $FF0000 then
- R := $FF0000;
- if G > $00FF00 then
- G := $00FF00;
- if B > $0000FF then
- B := $0000FF;
- PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B;
- inc( PtrUInt( Addr ), BPP );
- end;
- inc( PtrUInt( Addr ), ModX );
- end;
- end;
- 32 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $00FF0000 + Color and $00FF0000;
- G := SrcColor and $0000FF00 + Color and $0000FF00;
- B := SrcColor and $000000FF + Color and $000000FF;
- if R > $FF0000 then
- R := $FF0000;
- if G > $00FF00 then
- G := $00FF00;
- if B > $0000FF then
- B := $0000FF;
- PUInt32( Addr )^ := R or G or B;
- inc( PtrUInt( Addr ), BPP );
- end;
- inc( PtrUInt( Addr ), ModX );
- end;
- end;
- end;
- SDL_UnlockSurface( DstSurface );
- end;
-end;
-
-procedure SDL_FillRectSub( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );
-var
- RealRect : TSDL_Rect;
- Addr : pointer;
- ModX, BPP : cardinal;
- x, y, R, G, B, SrcColor : cardinal;
-begin
- RealRect := ValidateSurfaceRect( DstSurface, DstRect );
- if ( RealRect.w > 0 ) and ( RealRect.h > 0 ) then
- begin
- SDL_LockSurface( DstSurface );
- BPP := DstSurface.format.BytesPerPixel;
- with DstSurface^ do
- begin
- Addr := pointer( PtrUInt( pixels ) + UInt32( RealRect.y ) * pitch + UInt32( RealRect.x ) * BPP );
- ModX := Pitch - UInt32( RealRect.w ) * BPP;
- end;
- case DstSurface.format.BitsPerPixel of
- 8 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $E0 - Color and $E0;
- G := SrcColor and $1C - Color and $1C;
- B := SrcColor and $03 - Color and $03;
- if R > $E0 then
- R := 0;
- if G > $1C then
- G := 0;
- if B > $03 then
- B := 0;
- PUInt8( Addr )^ := R or G or B;
- inc( PtrUInt( Addr ), BPP );
- end;
- inc( PtrUInt( Addr ), ModX );
- end;
- end;
- 15 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $7C00 - Color and $7C00;
- G := SrcColor and $03E0 - Color and $03E0;
- B := SrcColor and $001F - Color and $001F;
- if R > $7C00 then
- R := 0;
- if G > $03E0 then
- G := 0;
- if B > $001F then
- B := 0;
- PUInt16( Addr )^ := R or G or B;
- inc( PtrUInt( Addr ), BPP );
- end;
- inc( PtrUInt( Addr ), ModX );
- end;
- end;
- 16 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $F800 - Color and $F800;
- G := SrcColor and $07C0 - Color and $07C0;
- B := SrcColor and $001F - Color and $001F;
- if R > $F800 then
- R := 0;
- if G > $07C0 then
- G := 0;
- if B > $001F then
- B := 0;
- PUInt16( Addr )^ := R or G or B;
- inc( PtrUInt( Addr ), BPP );
- end;
- inc( PtrUInt( Addr ), ModX );
- end;
- end;
- 24 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $00FF0000 - Color and $00FF0000;
- G := SrcColor and $0000FF00 - Color and $0000FF00;
- B := SrcColor and $000000FF - Color and $000000FF;
- if R > $FF0000 then
- R := 0;
- if G > $00FF00 then
- G := 0;
- if B > $0000FF then
- B := 0;
- PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B;
- inc( PtrUInt( Addr ), BPP );
- end;
- inc( PtrUInt( Addr ), ModX );
- end;
- end;
- 32 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $00FF0000 - Color and $00FF0000;
- G := SrcColor and $0000FF00 - Color and $0000FF00;
- B := SrcColor and $000000FF - Color and $000000FF;
- if R > $FF0000 then
- R := 0;
- if G > $00FF00 then
- G := 0;
- if B > $0000FF then
- B := 0;
- PUInt32( Addr )^ := R or G or B;
- inc( PtrUInt( Addr ), BPP );
- end;
- inc( PtrUInt( Addr ), ModX );
- end;
- end;
- end;
- SDL_UnlockSurface( DstSurface );
- end;
-end;
-
-procedure SDL_GradientFillRect( DstSurface : PSDL_Surface; const Rect : PSDL_Rect; const StartColor, EndColor : TSDL_Color; const Style : TGradientStyle );
-var
- FBC : array[ 0..255 ] of Cardinal;
- // temp vars
- i, YR, YG, YB, SR, SG, SB, DR, DG, DB : Integer;
-
- TempStepV, TempStepH : Single;
- TempLeft, TempTop, TempHeight, TempWidth : integer;
- TempRect : TSDL_Rect;
-
-begin
- // calc FBC
- YR := StartColor.r;
- YG := StartColor.g;
- YB := StartColor.b;
- SR := YR;
- SG := YG;
- SB := YB;
- DR := EndColor.r - SR;
- DG := EndColor.g - SG;
- DB := EndColor.b - SB;
-
- for i := 0 to 255 do
- begin
- FBC[ i ] := SDL_MapRGB( DstSurface.format, YR, YG, YB );
- YR := SR + round( DR / 255 * i );
- YG := SG + round( DG / 255 * i );
- YB := SB + round( DB / 255 * i );
- end;
-
- // if aStyle = 1 then begin
- TempStepH := Rect.w / 255;
- TempStepV := Rect.h / 255;
- TempHeight := Trunc( TempStepV + 1 );
- TempWidth := Trunc( TempStepH + 1 );
- TempTop := 0;
- TempLeft := 0;
- TempRect.x := Rect.x;
- TempRect.y := Rect.y;
- TempRect.h := Rect.h;
- TempRect.w := Rect.w;
-
- case Style of
- gsHorizontal :
- begin
- TempRect.h := TempHeight;
- for i := 0 to 255 do
- begin
- TempRect.y := Rect.y + TempTop;
- SDL_FillRect( DstSurface, @TempRect, FBC[ i ] );
- TempTop := Trunc( TempStepV * i );
- end;
- end;
- gsVertical :
- begin
- TempRect.w := TempWidth;
- for i := 0 to 255 do
- begin
- TempRect.x := Rect.x + TempLeft;
- SDL_FillRect( DstSurface, @TempRect, FBC[ i ] );
- TempLeft := Trunc( TempStepH * i );
- end;
- end;
- end;
-end;
-
-procedure SDL_2xBlit( Src, Dest : PSDL_Surface );
-var
- ReadAddr, WriteAddr, ReadRow, WriteRow : PtrUInt;
- SrcPitch, DestPitch, x, y : UInt32;
-begin
- if ( Src = nil ) or ( Dest = nil ) then
- exit;
- if ( Src.w shl 1 ) < Dest.w then
- exit;
- if ( Src.h shl 1 ) < Dest.h then
- exit;
-
- if SDL_MustLock( Src ) then
- SDL_LockSurface( Src );
- if SDL_MustLock( Dest ) then
- SDL_LockSurface( Dest );
-
- ReadRow := PtrUInt( Src.Pixels );
- WriteRow := PtrUInt( Dest.Pixels );
-
- SrcPitch := Src.pitch;
- DestPitch := Dest.pitch;
-
- case Src.format.BytesPerPixel of
- 1 : for y := 1 to Src.h do
- begin
- ReadAddr := ReadRow;
- WriteAddr := WriteRow;
- for x := 1 to Src.w do
- begin
- PUInt8( WriteAddr )^ := PUInt8( ReadAddr )^;
- PUInt8( WriteAddr + 1 )^ := PUInt8( ReadAddr )^;
- PUInt8( WriteAddr + DestPitch )^ := PUInt8( ReadAddr )^;
- PUInt8( WriteAddr + DestPitch + 1 )^ := PUInt8( ReadAddr )^;
- inc( ReadAddr );
- inc( WriteAddr, 2 );
- end;
- inc( PtrUInt( ReadRow ), SrcPitch );
- inc( PtrUInt( WriteRow ), DestPitch * 2 );
- end;
- 2 : for y := 1 to Src.h do
- begin
- ReadAddr := ReadRow;
- WriteAddr := WriteRow;
- for x := 1 to Src.w do
- begin
- PUInt16( WriteAddr )^ := PUInt16( ReadAddr )^;
- PUInt16( WriteAddr + 2 )^ := PUInt16( ReadAddr )^;
- PUInt16( WriteAddr + DestPitch )^ := PUInt16( ReadAddr )^;
- PUInt16( WriteAddr + DestPitch + 2 )^ := PUInt16( ReadAddr )^;
- inc( ReadAddr, 2 );
- inc( WriteAddr, 4 );
- end;
- inc( PtrUInt( ReadRow ), SrcPitch );
- inc( PtrUInt( WriteRow ), DestPitch * 2 );
- end;
- 3 : for y := 1 to Src.h do
- begin
- ReadAddr := ReadRow;
- WriteAddr := WriteRow;
- for x := 1 to Src.w do
- begin
- PUInt32( WriteAddr )^ := ( PUInt32( WriteAddr )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
- PUInt32( WriteAddr + 3 )^ := ( PUInt32( WriteAddr + 3 )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
- PUInt32( WriteAddr + DestPitch )^ := ( PUInt32( WriteAddr + DestPitch )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
- PUInt32( WriteAddr + DestPitch + 3 )^ := ( PUInt32( WriteAddr + DestPitch + 3 )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
- inc( ReadAddr, 3 );
- inc( WriteAddr, 6 );
- end;
- inc( PtrUInt( ReadRow ), SrcPitch );
- inc( PtrUInt( WriteRow ), DestPitch * 2 );
- end;
- 4 : for y := 1 to Src.h do
- begin
- ReadAddr := ReadRow;
- WriteAddr := WriteRow;
- for x := 1 to Src.w do
- begin
- PUInt32( WriteAddr )^ := PUInt32( ReadAddr )^;
- PUInt32( WriteAddr + 4 )^ := PUInt32( ReadAddr )^;
- PUInt32( WriteAddr + DestPitch )^ := PUInt32( ReadAddr )^;
- PUInt32( WriteAddr + DestPitch + 4 )^ := PUInt32( ReadAddr )^;
- inc( ReadAddr, 4 );
- inc( WriteAddr, 8 );
- end;
- inc( PtrUInt( ReadRow ), SrcPitch );
- inc( PtrUInt( WriteRow ), DestPitch * 2 );
- end;
- end;
-
- if SDL_MustLock( Src ) then
- SDL_UnlockSurface( Src );
- if SDL_MustLock( Dest ) then
- SDL_UnlockSurface( Dest );
-end;
-
-procedure SDL_Scanline2xBlit( Src, Dest : PSDL_Surface );
-var
- ReadAddr, WriteAddr, ReadRow, WriteRow : PtrUInt;
- SrcPitch, DestPitch, x, y : UInt32;
-begin
- if ( Src = nil ) or ( Dest = nil ) then
- exit;
- if ( Src.w shl 1 ) < Dest.w then
- exit;
- if ( Src.h shl 1 ) < Dest.h then
- exit;
-
- if SDL_MustLock( Src ) then
- SDL_LockSurface( Src );
- if SDL_MustLock( Dest ) then
- SDL_LockSurface( Dest );
-
- ReadRow := PtrUInt( Src.Pixels );
- WriteRow := PtrUInt( Dest.Pixels );
-
- SrcPitch := Src.pitch;
- DestPitch := Dest.pitch;
-
- case Src.format.BytesPerPixel of
- 1 : for y := 1 to Src.h do
- begin
- ReadAddr := ReadRow;
- WriteAddr := WriteRow;
- for x := 1 to Src.w do
- begin
- PUInt8( WriteAddr )^ := PUInt8( ReadAddr )^;
- PUInt8( WriteAddr + 1 )^ := PUInt8( ReadAddr )^;
- inc( ReadAddr );
- inc( WriteAddr, 2 );
- end;
- inc( PtrUInt( ReadRow ), SrcPitch );
- inc( PtrUInt( WriteRow ), DestPitch * 2 );
- end;
- 2 : for y := 1 to Src.h do
- begin
- ReadAddr := ReadRow;
- WriteAddr := WriteRow;
- for x := 1 to Src.w do
- begin
- PUInt16( WriteAddr )^ := PUInt16( ReadAddr )^;
- PUInt16( WriteAddr + 2 )^ := PUInt16( ReadAddr )^;
- inc( ReadAddr, 2 );
- inc( WriteAddr, 4 );
- end;
- inc( PtrUInt( ReadRow ), SrcPitch );
- inc( PtrUInt( WriteRow ), DestPitch * 2 );
- end;
- 3 : for y := 1 to Src.h do
- begin
- ReadAddr := ReadRow;
- WriteAddr := WriteRow;
- for x := 1 to Src.w do
- begin
- PUInt32( WriteAddr )^ := ( PUInt32( WriteAddr )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
- PUInt32( WriteAddr + 3 )^ := ( PUInt32( WriteAddr + 3 )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
- inc( ReadAddr, 3 );
- inc( WriteAddr, 6 );
- end;
- inc( PtrUInt( ReadRow ), SrcPitch );
- inc( PtrUInt( WriteRow ), DestPitch * 2 );
- end;
- 4 : for y := 1 to Src.h do
- begin
- ReadAddr := ReadRow;
- WriteAddr := WriteRow;
- for x := 1 to Src.w do
- begin
- PUInt32( WriteAddr )^ := PUInt32( ReadAddr )^;
- PUInt32( WriteAddr + 4 )^ := PUInt32( ReadAddr )^;
- inc( ReadAddr, 4 );
- inc( WriteAddr, 8 );
- end;
- inc( PtrUInt( ReadRow ), SrcPitch );
- inc( PtrUInt( WriteRow ), DestPitch * 2 );
- end;
- end;
-
- if SDL_MustLock( Src ) then
- SDL_UnlockSurface( Src );
- if SDL_MustLock( Dest ) then
- SDL_UnlockSurface( Dest );
-end;
-
-procedure SDL_50Scanline2xBlit( Src, Dest : PSDL_Surface );
-var
- ReadAddr, WriteAddr, ReadRow, WriteRow : PtrUInt;
- SrcPitch, DestPitch, x, y, Color : UInt32;
-begin
- if ( Src = nil ) or ( Dest = nil ) then
- exit;
- if ( Src.w shl 1 ) < Dest.w then
- exit;
- if ( Src.h shl 1 ) < Dest.h then
- exit;
-
- if SDL_MustLock( Src ) then
- SDL_LockSurface( Src );
- if SDL_MustLock( Dest ) then
- SDL_LockSurface( Dest );
-
- ReadRow := PtrUInt( Src.Pixels );
- WriteRow := PtrUInt( Dest.Pixels );
-
- SrcPitch := Src.pitch;
- DestPitch := Dest.pitch;
-
- case Src.format.BitsPerPixel of
- 8 : for y := 1 to Src.h do
- begin
- ReadAddr := ReadRow;
- WriteAddr := WriteRow;
- for x := 1 to Src.w do
- begin
- Color := PUInt8( ReadAddr )^;
- PUInt8( WriteAddr )^ := Color;
- PUInt8( WriteAddr + 1 )^ := Color;
- Color := ( Color shr 1 ) and $6D; {%01101101}
- PUInt8( WriteAddr + DestPitch )^ := Color;
- PUInt8( WriteAddr + DestPitch + 1 )^ := Color;
- inc( ReadAddr );
- inc( WriteAddr, 2 );
- end;
- inc( PtrUInt( ReadRow ), SrcPitch );
- inc( PtrUInt( WriteRow ), DestPitch * 2 );
- end;
- 15 : for y := 1 to Src.h do
- begin
- ReadAddr := ReadRow;
- WriteAddr := WriteRow;
- for x := 1 to Src.w do
- begin
- Color := PUInt16( ReadAddr )^;
- PUInt16( WriteAddr )^ := Color;
- PUInt16( WriteAddr + 2 )^ := Color;
- Color := ( Color shr 1 ) and $3DEF; {%0011110111101111}
- PUInt16( WriteAddr + DestPitch )^ := Color;
- PUInt16( WriteAddr + DestPitch + 2 )^ := Color;
- inc( ReadAddr, 2 );
- inc( WriteAddr, 4 );
- end;
- inc( PtrUInt( ReadRow ), SrcPitch );
- inc( PtrUInt( WriteRow ), DestPitch * 2 );
- end;
- 16 : for y := 1 to Src.h do
- begin
- ReadAddr := ReadRow;
- WriteAddr := WriteRow;
- for x := 1 to Src.w do
- begin
- Color := PUInt16( ReadAddr )^;
- PUInt16( WriteAddr )^ := Color;
- PUInt16( WriteAddr + 2 )^ := Color;
- Color := ( Color shr 1 ) and $7BEF; {%0111101111101111}
- PUInt16( WriteAddr + DestPitch )^ := Color;
- PUInt16( WriteAddr + DestPitch + 2 )^ := Color;
- inc( ReadAddr, 2 );
- inc( WriteAddr, 4 );
- end;
- inc( PtrUInt( ReadRow ), SrcPitch );
- inc( PtrUInt( WriteRow ), DestPitch * 2 );
- end;
- 24 : for y := 1 to Src.h do
- begin
- ReadAddr := ReadRow;
- WriteAddr := WriteRow;
- for x := 1 to Src.w do
- begin
- Color := ( PUInt32( WriteAddr )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
- PUInt32( WriteAddr )^ := Color;
- PUInt32( WriteAddr + 3 )^ := Color;
- Color := ( Color shr 1 ) and $007F7F7F; {%011111110111111101111111}
- PUInt32( WriteAddr + DestPitch )^ := Color;
- PUInt32( WriteAddr + DestPitch + 3 )^ := Color;
- inc( ReadAddr, 3 );
- inc( WriteAddr, 6 );
- end;
- inc( PtrUInt( ReadRow ), SrcPitch );
- inc( PtrUInt( WriteRow ), DestPitch * 2 );
- end;
- 32 : for y := 1 to Src.h do
- begin
- ReadAddr := ReadRow;
- WriteAddr := WriteRow;
- for x := 1 to Src.w do
- begin
- Color := PUInt32( ReadAddr )^;
- PUInt32( WriteAddr )^ := Color;
- PUInt32( WriteAddr + 4 )^ := Color;
- Color := ( Color shr 1 ) and $7F7F7F7F;
- PUInt32( WriteAddr + DestPitch )^ := Color;
- PUInt32( WriteAddr + DestPitch + 4 )^ := Color;
- inc( ReadAddr, 4 );
- inc( WriteAddr, 8 );
- end;
- inc( PtrUInt( ReadRow ), SrcPitch );
- inc( PtrUInt( WriteRow ), DestPitch * 2 );
- end;
- end;
-
- if SDL_MustLock( Src ) then
- SDL_UnlockSurface( Src );
- if SDL_MustLock( Dest ) then
- SDL_UnlockSurface( Dest );
-end;
-
-function SDL_PixelTestSurfaceVsRect( SrcSurface1 : PSDL_Surface; SrcRect1 :
- PSDL_Rect; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) :
- boolean;
-var
- Src_Rect1, Src_Rect2 : TSDL_Rect;
- right1, bottom1 : integer;
- right2, bottom2 : integer;
- Scan1Start, {Scan2Start,} ScanWidth, ScanHeight : cardinal;
- Mod1 : cardinal;
- Addr1 : PtrUInt;
- BPP : cardinal;
- Pitch1 : cardinal;
- TransparentColor1 : cardinal;
- tx, ty : cardinal;
-// StartTick : cardinal; // Auto Removed, Unused Variable
- Color1 : cardinal;
-begin
- Result := false;
- if SrcRect1 = nil then
- begin
- with Src_Rect1 do
- begin
- x := 0;
- y := 0;
- w := SrcSurface1.w;
- h := SrcSurface1.h;
- end;
- end
- else
- Src_Rect1 := SrcRect1^;
-
- Src_Rect2 := SrcRect2^;
- with Src_Rect1 do
- begin
- Right1 := Left1 + w;
- Bottom1 := Top1 + h;
- end;
- with Src_Rect2 do
- begin
- Right2 := Left2 + w;
- Bottom2 := Top2 + h;
- end;
- if ( Left1 >= Right2 ) or ( Right1 <= Left2 ) or ( Top1 >= Bottom2 ) or ( Bottom1 <= Top2 ) then
- exit;
- if Left1 <= Left2 then
- begin
- // 1. left, 2. right
- Scan1Start := Src_Rect1.x + Left2 - Left1;
- //Scan2Start := Src_Rect2.x;
- ScanWidth := Right1 - Left2;
- with Src_Rect2 do
- if ScanWidth > w then
- ScanWidth := w;
- end
- else
- begin
- // 1. right, 2. left
- Scan1Start := Src_Rect1.x;
- //Scan2Start := Src_Rect2.x + Left1 - Left2;
- ScanWidth := Right2 - Left1;
- with Src_Rect1 do
- if ScanWidth > w then
- ScanWidth := w;
- end;
- with SrcSurface1^ do
- begin
- Pitch1 := Pitch;
- Addr1 := PtrUInt( Pixels );
- inc( Addr1, Pitch1 * UInt32( Src_Rect1.y ) );
- with format^ do
- begin
- BPP := BytesPerPixel;
- TransparentColor1 := colorkey;
- end;
- end;
-
- Mod1 := Pitch1 - ( ScanWidth * BPP );
-
- inc( Addr1, BPP * Scan1Start );
-
- if Top1 <= Top2 then
- begin
- // 1. up, 2. down
- ScanHeight := Bottom1 - Top2;
- if ScanHeight > Src_Rect2.h then
- ScanHeight := Src_Rect2.h;
- inc( Addr1, Pitch1 * UInt32( Top2 - Top1 ) );
- end
- else
- begin
- // 1. down, 2. up
- ScanHeight := Bottom2 - Top1;
- if ScanHeight > Src_Rect1.h then
- ScanHeight := Src_Rect1.h;
-
- end;
- case BPP of
- 1 :
- for ty := 1 to ScanHeight do
- begin
- for tx := 1 to ScanWidth do
- begin
- if ( PByte( Addr1 )^ <> TransparentColor1 ) then
- begin
- Result := true;
- exit;
- end;
- inc( Addr1 );
-
- end;
- inc( Addr1, Mod1 );
-
- end;
- 2 :
- for ty := 1 to ScanHeight do
- begin
- for tx := 1 to ScanWidth do
- begin
- if ( PWord( Addr1 )^ <> TransparentColor1 ) then
- begin
- Result := true;
- exit;
- end;
- inc( Addr1, 2 );
-
- end;
- inc( Addr1, Mod1 );
-
- end;
- 3 :
- for ty := 1 to ScanHeight do
- begin
- for tx := 1 to ScanWidth do
- begin
- Color1 := PLongWord( Addr1 )^ and $00FFFFFF;
-
- if ( Color1 <> TransparentColor1 )
- then
- begin
- Result := true;
- exit;
- end;
- inc( Addr1, 3 );
-
- end;
- inc( Addr1, Mod1 );
-
- end;
- 4 :
- for ty := 1 to ScanHeight do
- begin
- for tx := 1 to ScanWidth do
- begin
- if ( PLongWord( Addr1 )^ <> TransparentColor1 ) then
- begin
- Result := true;
- exit;
- end;
- inc( Addr1, 4 );
-
- end;
- inc( Addr1, Mod1 );
-
- end;
- end;
-end;
-
-procedure SDL_ORSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-var
-{*R, *}{*G, *}{*B, *}Pixel1, Pixel2, TransparentColor : cardinal; // Auto Removed, Unused Variable (R) // Auto Removed, Unused Variable (G) // Auto Removed, Unused Variable (B)
- Src, Dest : TSDL_Rect;
- Diff : integer;
- SrcAddr, DestAddr : PtrUInt;
- WorkX, WorkY : word;
- SrcMod, DestMod : cardinal;
- Bits : cardinal;
-begin
- if ( SrcSurface = nil ) or ( DestSurface = nil ) then
- exit; // Remove this to make it faster
- if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
- exit; // Remove this to make it faster
- if SrcRect = nil then
- begin
- with Src do
- begin
- x := 0;
- y := 0;
- w := SrcSurface.w;
- h := SrcSurface.h;
- end;
- end
- else
- Src := SrcRect^;
- if DestRect = nil then
- begin
- Dest.x := 0;
- Dest.y := 0;
- end
- else
- Dest := DestRect^;
- Dest.w := Src.w;
- Dest.h := Src.h;
- with DestSurface.Clip_Rect do
- begin
- // Source's right side is greater than the dest.cliprect
- if Dest.x + Src.w > x + w then
- begin
- smallint( Src.w ) := x + w - Dest.x;
- smallint( Dest.w ) := x + w - Dest.x;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's bottom side is greater than the dest.clip
- if Dest.y + Src.h > y + h then
- begin
- smallint( Src.h ) := y + h - Dest.y;
- smallint( Dest.h ) := y + h - Dest.y;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- // Source's left side is less than the dest.clip
- if Dest.x < x then
- begin
- Diff := x - Dest.x;
- Src.x := Src.x + Diff;
- smallint( Src.w ) := smallint( Src.w ) - Diff;
- Dest.x := x;
- smallint( Dest.w ) := smallint( Dest.w ) - Diff;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's Top side is less than the dest.clip
- if Dest.y < y then
- begin
- Diff := y - Dest.y;
- Src.y := Src.y + Diff;
- smallint( Src.h ) := smallint( Src.h ) - Diff;
- Dest.y := y;
- smallint( Dest.h ) := smallint( Dest.h ) - Diff;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- end;
- with SrcSurface^ do
- begin
- SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
- Format.BytesPerPixel;
- SrcMod := Pitch - Src.w * Format.BytesPerPixel;
- TransparentColor := Format.colorkey;
- end;
- with DestSurface^ do
- begin
- DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
- Format.BytesPerPixel;
- DestMod := Pitch - Dest.w * Format.BytesPerPixel;
- Bits := Format.BitsPerPixel;
- end;
- SDL_LockSurface( SrcSurface );
- SDL_LockSurface( DestSurface );
- WorkY := Src.h;
- case bits of
- 8 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt8( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt8( DestAddr )^;
- PUInt8( DestAddr )^ := Pixel2 or Pixel1;
- end;
- inc( SrcAddr );
- inc( DestAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 15 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
-
- PUInt16( DestAddr )^ := Pixel2 or Pixel1;
-
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 16 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
-
- PUInt16( DestAddr )^ := Pixel2 or Pixel1;
-
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 24 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
-
- PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel2 or Pixel1;
- end;
- inc( SrcAddr, 3 );
- inc( DestAddr, 3 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 32 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^;
-
- PUInt32( DestAddr )^ := Pixel2 or Pixel1;
- end;
- inc( SrcAddr, 4 );
- inc( DestAddr, 4 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- end;
- SDL_UnlockSurface( SrcSurface );
- SDL_UnlockSurface( DestSurface );
-end;
-
-procedure SDL_ANDSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-var
-{*R, *}{*G, *}{*B, *}Pixel1, Pixel2, TransparentColor : cardinal; // Auto Removed, Unused Variable (R) // Auto Removed, Unused Variable (G) // Auto Removed, Unused Variable (B)
- Src, Dest : TSDL_Rect;
- Diff : integer;
- SrcAddr, DestAddr : PtrUInt;
- WorkX, WorkY : word;
- SrcMod, DestMod : cardinal;
- Bits : cardinal;
-begin
- if ( SrcSurface = nil ) or ( DestSurface = nil ) then
- exit; // Remove this to make it faster
- if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
- exit; // Remove this to make it faster
- if SrcRect = nil then
- begin
- with Src do
- begin
- x := 0;
- y := 0;
- w := SrcSurface.w;
- h := SrcSurface.h;
- end;
- end
- else
- Src := SrcRect^;
- if DestRect = nil then
- begin
- Dest.x := 0;
- Dest.y := 0;
- end
- else
- Dest := DestRect^;
- Dest.w := Src.w;
- Dest.h := Src.h;
- with DestSurface.Clip_Rect do
- begin
- // Source's right side is greater than the dest.cliprect
- if Dest.x + Src.w > x + w then
- begin
- smallint( Src.w ) := x + w - Dest.x;
- smallint( Dest.w ) := x + w - Dest.x;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's bottom side is greater than the dest.clip
- if Dest.y + Src.h > y + h then
- begin
- smallint( Src.h ) := y + h - Dest.y;
- smallint( Dest.h ) := y + h - Dest.y;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- // Source's left side is less than the dest.clip
- if Dest.x < x then
- begin
- Diff := x - Dest.x;
- Src.x := Src.x + Diff;
- smallint( Src.w ) := smallint( Src.w ) - Diff;
- Dest.x := x;
- smallint( Dest.w ) := smallint( Dest.w ) - Diff;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's Top side is less than the dest.clip
- if Dest.y < y then
- begin
- Diff := y - Dest.y;
- Src.y := Src.y + Diff;
- smallint( Src.h ) := smallint( Src.h ) - Diff;
- Dest.y := y;
- smallint( Dest.h ) := smallint( Dest.h ) - Diff;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- end;
- with SrcSurface^ do
- begin
- SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
- Format.BytesPerPixel;
- SrcMod := Pitch - Src.w * Format.BytesPerPixel;
- TransparentColor := Format.colorkey;
- end;
- with DestSurface^ do
- begin
- DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
- Format.BytesPerPixel;
- DestMod := Pitch - Dest.w * Format.BytesPerPixel;
- Bits := Format.BitsPerPixel;
- end;
- SDL_LockSurface( SrcSurface );
- SDL_LockSurface( DestSurface );
- WorkY := Src.h;
- case bits of
- 8 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt8( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt8( DestAddr )^;
- PUInt8( DestAddr )^ := Pixel2 and Pixel1;
- end;
- inc( SrcAddr );
- inc( DestAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 15 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
-
- PUInt16( DestAddr )^ := Pixel2 and Pixel1;
-
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 16 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
-
- PUInt16( DestAddr )^ := Pixel2 and Pixel1;
-
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 24 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
-
- PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel2 and Pixel1;
- end;
- inc( SrcAddr, 3 );
- inc( DestAddr, 3 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 32 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^;
-
- PUInt32( DestAddr )^ := Pixel2 and Pixel1;
- end;
- inc( SrcAddr, 4 );
- inc( DestAddr, 4 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- end;
- SDL_UnlockSurface( SrcSurface );
- SDL_UnlockSurface( DestSurface );
-end;
-
-
-
-procedure SDL_GTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-var
- R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;
- Src, Dest : TSDL_Rect;
- Diff : integer;
- SrcAddr, DestAddr : PtrUInt;
- WorkX, WorkY : word;
- SrcMod, DestMod : cardinal;
- Bits : cardinal;
-begin
- if ( SrcSurface = nil ) or ( DestSurface = nil ) then
- exit; // Remove this to make it faster
- if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
- exit; // Remove this to make it faster
- if SrcRect = nil then
- begin
- with Src do
- begin
- x := 0;
- y := 0;
- w := SrcSurface.w;
- h := SrcSurface.h;
- end;
- end
- else
- Src := SrcRect^;
- if DestRect = nil then
- begin
- Dest.x := 0;
- Dest.y := 0;
- end
- else
- Dest := DestRect^;
- Dest.w := Src.w;
- Dest.h := Src.h;
- with DestSurface.Clip_Rect do
- begin
- // Source's right side is greater than the dest.cliprect
- if Dest.x + Src.w > x + w then
- begin
- smallint( Src.w ) := x + w - Dest.x;
- smallint( Dest.w ) := x + w - Dest.x;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's bottom side is greater than the dest.clip
- if Dest.y + Src.h > y + h then
- begin
- smallint( Src.h ) := y + h - Dest.y;
- smallint( Dest.h ) := y + h - Dest.y;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- // Source's left side is less than the dest.clip
- if Dest.x < x then
- begin
- Diff := x - Dest.x;
- Src.x := Src.x + Diff;
- smallint( Src.w ) := smallint( Src.w ) - Diff;
- Dest.x := x;
- smallint( Dest.w ) := smallint( Dest.w ) - Diff;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's Top side is less than the dest.clip
- if Dest.y < y then
- begin
- Diff := y - Dest.y;
- Src.y := Src.y + Diff;
- smallint( Src.h ) := smallint( Src.h ) - Diff;
- Dest.y := y;
- smallint( Dest.h ) := smallint( Dest.h ) - Diff;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- end;
- with SrcSurface^ do
- begin
- SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
- Format.BytesPerPixel;
- SrcMod := Pitch - Src.w * Format.BytesPerPixel;
- TransparentColor := Format.colorkey;
- end;
- with DestSurface^ do
- begin
- DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
- Format.BytesPerPixel;
- DestMod := Pitch - Dest.w * Format.BytesPerPixel;
- Bits := Format.BitsPerPixel;
- end;
- SDL_LockSurface( SrcSurface );
- SDL_LockSurface( DestSurface );
- WorkY := Src.h;
- case bits of
- 8 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt8( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt8( DestAddr )^;
- if Pixel2 > 0 then
- begin
- if Pixel2 and $E0 > Pixel1 and $E0 then
- R := Pixel2 and $E0
- else
- R := Pixel1 and $E0;
- if Pixel2 and $1C > Pixel1 and $1C then
- G := Pixel2 and $1C
- else
- G := Pixel1 and $1C;
- if Pixel2 and $03 > Pixel1 and $03 then
- B := Pixel2 and $03
- else
- B := Pixel1 and $03;
-
- if R > $E0 then
- R := $E0;
- if G > $1C then
- G := $1C;
- if B > $03 then
- B := $03;
- PUInt8( DestAddr )^ := R or G or B;
- end
- else
- PUInt8( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr );
- inc( DestAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 15 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
- if Pixel2 > 0 then
- begin
-
- if Pixel2 and $7C00 > Pixel1 and $7C00 then
- R := Pixel2 and $7C00
- else
- R := Pixel1 and $7C00;
- if Pixel2 and $03E0 > Pixel1 and $03E0 then
- G := Pixel2 and $03E0
- else
- G := Pixel1 and $03E0;
- if Pixel2 and $001F > Pixel1 and $001F then
- B := Pixel2 and $001F
- else
- B := Pixel1 and $001F;
-
- PUInt16( DestAddr )^ := R or G or B;
- end
- else
- PUInt16( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 16 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
- if Pixel2 > 0 then
- begin
-
- if Pixel2 and $F800 > Pixel1 and $F800 then
- R := Pixel2 and $F800
- else
- R := Pixel1 and $F800;
- if Pixel2 and $07E0 > Pixel1 and $07E0 then
- G := Pixel2 and $07E0
- else
- G := Pixel1 and $07E0;
- if Pixel2 and $001F > Pixel1 and $001F then
- B := Pixel2 and $001F
- else
- B := Pixel1 and $001F;
-
- PUInt16( DestAddr )^ := R or G or B;
- end
- else
- PUInt16( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 24 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
- if Pixel2 > 0 then
- begin
-
- if Pixel2 and $FF0000 > Pixel1 and $FF0000 then
- R := Pixel2 and $FF0000
- else
- R := Pixel1 and $FF0000;
- if Pixel2 and $00FF00 > Pixel1 and $00FF00 then
- G := Pixel2 and $00FF00
- else
- G := Pixel1 and $00FF00;
- if Pixel2 and $0000FF > Pixel1 and $0000FF then
- B := Pixel2 and $0000FF
- else
- B := Pixel1 and $0000FF;
-
- PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B );
- end
- else
- PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1;
- end;
- inc( SrcAddr, 3 );
- inc( DestAddr, 3 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 32 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^;
- if Pixel2 > 0 then
- begin
-
- if Pixel2 and $FF0000 > Pixel1 and $FF0000 then
- R := Pixel2 and $FF0000
- else
- R := Pixel1 and $FF0000;
- if Pixel2 and $00FF00 > Pixel1 and $00FF00 then
- G := Pixel2 and $00FF00
- else
- G := Pixel1 and $00FF00;
- if Pixel2 and $0000FF > Pixel1 and $0000FF then
- B := Pixel2 and $0000FF
- else
- B := Pixel1 and $0000FF;
-
- PUInt32( DestAddr )^ := R or G or B;
- end
- else
- PUInt32( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr, 4 );
- inc( DestAddr, 4 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- end;
- SDL_UnlockSurface( SrcSurface );
- SDL_UnlockSurface( DestSurface );
-end;
-
-
-procedure SDL_LTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-var
- R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;
- Src, Dest : TSDL_Rect;
- Diff : integer;
- SrcAddr, DestAddr : PtrUInt;
- WorkX, WorkY : word;
- SrcMod, DestMod : cardinal;
- Bits : cardinal;
-begin
- if ( SrcSurface = nil ) or ( DestSurface = nil ) then
- exit; // Remove this to make it faster
- if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
- exit; // Remove this to make it faster
- if SrcRect = nil then
- begin
- with Src do
- begin
- x := 0;
- y := 0;
- w := SrcSurface.w;
- h := SrcSurface.h;
- end;
- end
- else
- Src := SrcRect^;
- if DestRect = nil then
- begin
- Dest.x := 0;
- Dest.y := 0;
- end
- else
- Dest := DestRect^;
- Dest.w := Src.w;
- Dest.h := Src.h;
- with DestSurface.Clip_Rect do
- begin
- // Source's right side is greater than the dest.cliprect
- if Dest.x + Src.w > x + w then
- begin
- smallint( Src.w ) := x + w - Dest.x;
- smallint( Dest.w ) := x + w - Dest.x;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's bottom side is greater than the dest.clip
- if Dest.y + Src.h > y + h then
- begin
- smallint( Src.h ) := y + h - Dest.y;
- smallint( Dest.h ) := y + h - Dest.y;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- // Source's left side is less than the dest.clip
- if Dest.x < x then
- begin
- Diff := x - Dest.x;
- Src.x := Src.x + Diff;
- smallint( Src.w ) := smallint( Src.w ) - Diff;
- Dest.x := x;
- smallint( Dest.w ) := smallint( Dest.w ) - Diff;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's Top side is less than the dest.clip
- if Dest.y < y then
- begin
- Diff := y - Dest.y;
- Src.y := Src.y + Diff;
- smallint( Src.h ) := smallint( Src.h ) - Diff;
- Dest.y := y;
- smallint( Dest.h ) := smallint( Dest.h ) - Diff;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- end;
- with SrcSurface^ do
- begin
- SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
- Format.BytesPerPixel;
- SrcMod := Pitch - Src.w * Format.BytesPerPixel;
- TransparentColor := Format.colorkey;
- end;
- with DestSurface^ do
- begin
- DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
- Format.BytesPerPixel;
- DestMod := Pitch - Dest.w * Format.BytesPerPixel;
- Bits := Format.BitsPerPixel;
- end;
- SDL_LockSurface( SrcSurface );
- SDL_LockSurface( DestSurface );
- WorkY := Src.h;
- case bits of
- 8 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt8( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt8( DestAddr )^;
- if Pixel2 > 0 then
- begin
- if Pixel2 and $E0 < Pixel1 and $E0 then
- R := Pixel2 and $E0
- else
- R := Pixel1 and $E0;
- if Pixel2 and $1C < Pixel1 and $1C then
- G := Pixel2 and $1C
- else
- G := Pixel1 and $1C;
- if Pixel2 and $03 < Pixel1 and $03 then
- B := Pixel2 and $03
- else
- B := Pixel1 and $03;
-
- if R > $E0 then
- R := $E0;
- if G > $1C then
- G := $1C;
- if B > $03 then
- B := $03;
- PUInt8( DestAddr )^ := R or G or B;
- end
- else
- PUInt8( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr );
- inc( DestAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 15 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
- if Pixel2 > 0 then
- begin
-
- if Pixel2 and $7C00 < Pixel1 and $7C00 then
- R := Pixel2 and $7C00
- else
- R := Pixel1 and $7C00;
- if Pixel2 and $03E0 < Pixel1 and $03E0 then
- G := Pixel2 and $03E0
- else
- G := Pixel1 and $03E0;
- if Pixel2 and $001F < Pixel1 and $001F then
- B := Pixel2 and $001F
- else
- B := Pixel1 and $001F;
-
- PUInt16( DestAddr )^ := R or G or B;
- end
- else
- PUInt16( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 16 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
- if Pixel2 > 0 then
- begin
-
- if Pixel2 and $F800 < Pixel1 and $F800 then
- R := Pixel2 and $F800
- else
- R := Pixel1 and $F800;
- if Pixel2 and $07E0 < Pixel1 and $07E0 then
- G := Pixel2 and $07E0
- else
- G := Pixel1 and $07E0;
- if Pixel2 and $001F < Pixel1 and $001F then
- B := Pixel2 and $001F
- else
- B := Pixel1 and $001F;
-
- PUInt16( DestAddr )^ := R or G or B;
- end
- else
- PUInt16( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 24 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
- if Pixel2 > 0 then
- begin
-
- if Pixel2 and $FF0000 < Pixel1 and $FF0000 then
- R := Pixel2 and $FF0000
- else
- R := Pixel1 and $FF0000;
- if Pixel2 and $00FF00 < Pixel1 and $00FF00 then
- G := Pixel2 and $00FF00
- else
- G := Pixel1 and $00FF00;
- if Pixel2 and $0000FF < Pixel1 and $0000FF then
- B := Pixel2 and $0000FF
- else
- B := Pixel1 and $0000FF;
-
- PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B );
- end
- else
- PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1;
- end;
- inc( SrcAddr, 3 );
- inc( DestAddr, 3 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 32 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^;
- if Pixel2 > 0 then
- begin
-
- if Pixel2 and $FF0000 < Pixel1 and $FF0000 then
- R := Pixel2 and $FF0000
- else
- R := Pixel1 and $FF0000;
- if Pixel2 and $00FF00 < Pixel1 and $00FF00 then
- G := Pixel2 and $00FF00
- else
- G := Pixel1 and $00FF00;
- if Pixel2 and $0000FF < Pixel1 and $0000FF then
- B := Pixel2 and $0000FF
- else
- B := Pixel1 and $0000FF;
-
- PUInt32( DestAddr )^ := R or G or B;
- end
- else
- PUInt32( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr, 4 );
- inc( DestAddr, 4 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- end;
- SDL_UnlockSurface( SrcSurface );
- SDL_UnlockSurface( DestSurface );
-end;
-
-// Will clip the x1,x2,y1,x2 params to the ClipRect provided
-
-function SDL_ClipLine( var x1, y1, x2, y2 : Integer; ClipRect : PSDL_Rect ) : boolean;
-var
- tflag, flag1, flag2 : word;
- txy, xedge, yedge : Integer;
- slope : single;
-
- function ClipCode( x, y : Integer ) : word;
- begin
- Result := 0;
- if x < ClipRect.x then
- Result := 1;
- if x >= ClipRect.w + ClipRect.x then
- Result := Result or 2;
- if y < ClipRect.y then
- Result := Result or 4;
- if y >= ClipRect.h + ClipRect.y then
- Result := Result or 8;
- end;
-
-begin
- flag1 := ClipCode( x1, y1 );
- flag2 := ClipCode( x2, y2 );
- result := true;
-
- while true do
- begin
- if ( flag1 or flag2 ) = 0 then
- Exit; // all in
-
- if ( flag1 and flag2 ) <> 0 then
- begin
- result := false;
- Exit; // all out
- end;
-
- if flag2 = 0 then
- begin
- txy := x1; x1 := x2; x2 := txy;
- txy := y1; y1 := y2; y2 := txy;
- tflag := flag1; flag1 := flag2; flag2 := tflag;
- end;
-
- if ( flag2 and 3 ) <> 0 then
- begin
- if ( flag2 and 1 ) <> 0 then
- xedge := ClipRect.x
- else
- xedge := ClipRect.w + ClipRect.x - 1; // back 1 pixel otherwise we end up in a loop
-
- slope := ( y2 - y1 ) / ( x2 - x1 );
- y2 := y1 + Round( slope * ( xedge - x1 ) );
- x2 := xedge;
- end
- else
- begin
- if ( flag2 and 4 ) <> 0 then
- yedge := ClipRect.y
- else
- yedge := ClipRect.h + ClipRect.y - 1; // up 1 pixel otherwise we end up in a loop
-
- slope := ( x2 - x1 ) / ( y2 - y1 );
- x2 := x1 + Round( slope * ( yedge - y1 ) );
- y2 := yedge;
- end;
-
- flag2 := ClipCode( x2, y2 );
- end;
-end;
-
-end.
-
+unit sdlutils; +{ + $Id: sdlutils.pas,v 1.5 2006/11/19 18:56:44 savage Exp $ + +} +{******************************************************************************} +{ } +{ Borland Delphi SDL - Simple DirectMedia Layer } +{ SDL Utility functions } +{ } +{ } +{ The initial developer of this Pascal code was : } +{ Tom Jones <tigertomjones@gmx.de> } +{ } +{ Portions created by Tom Jones are } +{ Copyright (C) 2000 - 2001 Tom Jones. } +{ } +{ } +{ Contributor(s) } +{ -------------- } +{ Dominique Louis <Dominique@SavageSoftware.com.au> } +{ Róbert Kisnémeth <mikrobi@freemail.hu> } +{ } +{ Obtained through: } +{ Joint Endeavour of Delphi Innovators ( Project JEDI ) } +{ } +{ You may retrieve the latest version of this file at the Project } +{ JEDI home page, located at http://delphi-jedi.org } +{ } +{ The contents of this file are used with permission, subject to } +{ the Mozilla Public License Version 1.1 (the "License"); you may } +{ not use this file except in compliance with the License. You may } +{ obtain a copy of the License at } +{ http://www.mozilla.org/MPL/MPL-1.1.html } +{ } +{ Software distributed under the License is distributed on an } +{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or } +{ implied. See the License for the specific language governing } +{ rights and limitations under the License. } +{ } +{ Description } +{ ----------- } +{ Helper functions... } +{ } +{ } +{ Requires } +{ -------- } +{ SDL.dll on Windows platforms } +{ libSDL-1.1.so.0 on Linux platform } +{ } +{ Programming Notes } +{ ----------------- } +{ } +{ } +{ } +{ } +{ Revision History } +{ ---------------- } +{ 2000 - TJ : Initial creation } +{ } +{ July 13 2001 - DL : Added PutPixel and GetPixel routines. } +{ } +{ Sept 14 2001 - RK : Added flipping routines. } +{ } +{ Sept 19 2001 - RK : Added PutPixel & line drawing & blitting with ADD } +{ effect. Fixed a bug in SDL_PutPixel & SDL_GetPixel } +{ Added PSDLRect() } +{ Sept 22 2001 - DL : Removed need for Windows.pas by defining types here} +{ Also removed by poor attempt or a dialog box } +{ } +{ Sept 25 2001 - RK : Added PixelTest, NewPutPixel, SubPixel, SubLine, } +{ SubSurface, MonoSurface & TexturedSurface } +{ } +{ Sept 26 2001 - DL : Made change so that it refers to native Pascal } +{ types rather that Windows types. This makes it more} +{ portable to Linix. } +{ } +{ Sept 27 2001 - RK : SDLUtils now can be compiled with FreePascal } +{ } +{ Oct 27 2001 - JF : Added ScrollY function } +{ } +{ Jan 21 2002 - RK : Added SDL_ZoomSurface and SDL_WarpSurface } +{ } +{ Mar 28 2002 - JF : Added SDL_RotateSurface } +{ } +{ May 13 2002 - RK : Improved SDL_FillRectAdd & SDL_FillRectSub } +{ } +{ May 27 2002 - YS : GradientFillRect function } +{ } +{ May 30 2002 - RK : Added SDL_2xBlit, SDL_Scanline2xBlit } +{ & SDL_50Scanline2xBlit } +{ } +{ June 12 2002 - RK : Added SDL_PixelTestSurfaceVsRect } +{ } +{ June 12 2002 - JF : Updated SDL_PixelTestSurfaceVsRect } +{ } +{ November 9 2002 - JF : Added Jason's boolean Surface functions } +{ } +{ December 10 2002 - DE : Added Dean's SDL_ClipLine function } +{ } +{ April 26 2003 - SS : Incorporated JF's changes to SDL_ClipLine } +{ Fixed SDL_ClipLine bug for non-zero cliprect x, y } +{ Added overloaded SDL_DrawLine for dashed lines } +{ } +{******************************************************************************} +{ + $Log: sdlutils.pas,v $ + Revision 1.5 2006/11/19 18:56:44 savage + Removed Hints and Warnings. + + Revision 1.4 2004/06/02 19:38:53 savage + Changes to SDL_GradientFillRect as suggested by + Ángel Eduardo García Hernández. Many thanks. + + Revision 1.3 2004/05/29 23:11:54 savage + Changes to SDL_ScaleSurfaceRect as suggested by + Ángel Eduardo García Hernández to fix a colour issue with the function. Many thanks. + + Revision 1.2 2004/02/14 00:23:39 savage + As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change. + + Revision 1.1 2004/02/05 00:08:20 savage + Module 1.0 release + + +} + +interface + +{$I jedi-sdl.inc} + +uses +{$IFDEF UNIX} + Types, +{$IFNDEF DARWIN} + Xlib, +{$ENDIF} +{$ENDIF} + SysUtils, + sdl; + +type + TGradientStyle = ( gsHorizontal, gsVertical ); + +// Pixel procedures +function SDL_PixelTest( SrcSurface1 : PSDL_Surface; SrcRect1 : PSDL_Rect; SrcSurface2 : + PSDL_Surface; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : Boolean; + +function SDL_GetPixel( SrcSurface : PSDL_Surface; x : integer; y : integer ) : Uint32; + +procedure SDL_PutPixel( DstSurface : PSDL_Surface; x : integer; y : integer; pixel : + Uint32 ); + +procedure SDL_AddPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color : + cardinal ); + +procedure SDL_SubPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color : + cardinal ); + +// Line procedures +procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color : + cardinal ); overload; + +procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color : + cardinal; DashLength, DashSpace : byte ); overload; + +procedure SDL_AddLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color : + cardinal ); + +procedure SDL_SubLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color : + cardinal ); + +// Surface procedures +procedure SDL_AddSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); + +procedure SDL_SubSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); + +procedure SDL_MonoSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Color : cardinal ); + +procedure SDL_TexturedSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Texture : PSDL_Surface; + TextureRect : PSDL_Rect ); + +procedure SDL_ZoomSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; DstRect : PSDL_Rect ); + +procedure SDL_WarpSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; UL, UR, LR, LL : PPoint ); + +// Flip procedures +procedure SDL_FlipRectH( DstSurface : PSDL_Surface; Rect : PSDL_Rect ); + +procedure SDL_FlipRectV( DstSurface : PSDL_Surface; Rect : PSDL_Rect ); + +function PSDLRect( aLeft, aTop, aWidth, aHeight : integer ) : PSDL_Rect; + +function SDLRect( aLeft, aTop, aWidth, aHeight : integer ) : TSDL_Rect; overload; + +function SDLRect( aRect : TRect ) : TSDL_Rect; overload; + +function SDL_ScaleSurfaceRect( SrcSurface : PSDL_Surface; SrcX1, SrcY1, SrcW, SrcH, + Width, Height : integer ) : PSDL_Surface; + +procedure SDL_ScrollY( DstSurface : PSDL_Surface; DifY : integer ); + +procedure SDL_ScrollX( DstSurface : PSDL_Surface; DifX : integer ); + +procedure SDL_RotateDeg( DstSurface, SrcSurface : PSDL_Surface; SrcRect : + PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Integer ); + +procedure SDL_RotateRad( DstSurface, SrcSurface : PSDL_Surface; SrcRect : + PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Single ); + +function ValidateSurfaceRect( DstSurface : PSDL_Surface; dstrect : PSDL_Rect ) : TSDL_Rect; + +// Fill Rect routine +procedure SDL_FillRectAdd( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 ); + +procedure SDL_FillRectSub( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 ); + +procedure SDL_GradientFillRect( DstSurface : PSDL_Surface; const Rect : PSDL_Rect; const StartColor, EndColor : TSDL_Color; const Style : TGradientStyle ); + +// NOTE for All SDL_2xblit... function : the dest surface must be 2x of the source surface! +procedure SDL_2xBlit( Src, Dest : PSDL_Surface ); + +procedure SDL_Scanline2xBlit( Src, Dest : PSDL_Surface ); + +procedure SDL_50Scanline2xBlit( Src, Dest : PSDL_Surface ); + +// +function SDL_PixelTestSurfaceVsRect( SrcSurface1 : PSDL_Surface; SrcRect1 : + PSDL_Rect; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : + boolean; + +// Jason's boolean Surface functions +procedure SDL_ORSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); + +procedure SDL_ANDSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); + + +procedure SDL_GTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); + +procedure SDL_LTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); + +function SDL_ClipLine( var x1, y1, x2, y2 : Integer; ClipRect : PSDL_Rect ) : boolean; + +implementation + +uses + Math; + +function SDL_PixelTest( SrcSurface1 : PSDL_Surface; SrcRect1 : PSDL_Rect; SrcSurface2 : + PSDL_Surface; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : boolean; +var + Src_Rect1, Src_Rect2 : TSDL_Rect; + right1, bottom1 : integer; + right2, bottom2 : integer; + Scan1Start, Scan2Start, ScanWidth, ScanHeight : cardinal; + Mod1, Mod2 : cardinal; + Addr1, Addr2 : PtrUInt; + BPP : cardinal; + Pitch1, Pitch2 : cardinal; + TransparentColor1, TransparentColor2 : cardinal; + tx, ty : cardinal; +// StartTick : cardinal; // Auto Removed, Unused Variable + Color1, Color2 : cardinal; +begin + Result := false; + if SrcRect1 = nil then + begin + with Src_Rect1 do + begin + x := 0; + y := 0; + w := SrcSurface1.w; + h := SrcSurface1.h; + end; + end + else + Src_Rect1 := SrcRect1^; + if SrcRect2 = nil then + begin + with Src_Rect2 do + begin + x := 0; + y := 0; + w := SrcSurface2.w; + h := SrcSurface2.h; + end; + end + else + Src_Rect2 := SrcRect2^; + with Src_Rect1 do + begin + Right1 := Left1 + w; + Bottom1 := Top1 + h; + end; + with Src_Rect2 do + begin + Right2 := Left2 + w; + Bottom2 := Top2 + h; + end; + if ( Left1 >= Right2 ) or ( Right1 <= Left2 ) or ( Top1 >= Bottom2 ) or ( Bottom1 <= + Top2 ) then + exit; + if Left1 <= Left2 then + begin + // 1. left, 2. right + Scan1Start := Src_Rect1.x + Left2 - Left1; + Scan2Start := Src_Rect2.x; + ScanWidth := Right1 - Left2; + with Src_Rect2 do + if ScanWidth > w then + ScanWidth := w; + end + else + begin + // 1. right, 2. left + Scan1Start := Src_Rect1.x; + Scan2Start := Src_Rect2.x + Left1 - Left2; + ScanWidth := Right2 - Left1; + with Src_Rect1 do + if ScanWidth > w then + ScanWidth := w; + end; + with SrcSurface1^ do + begin + Pitch1 := Pitch; + Addr1 := PtrUInt( Pixels ); + inc( Addr1, Pitch1 * UInt32( Src_Rect1.y ) ); + with format^ do + begin + BPP := BytesPerPixel; + TransparentColor1 := colorkey; + end; + end; + with SrcSurface2^ do + begin + TransparentColor2 := format.colorkey; + Pitch2 := Pitch; + Addr2 := PtrUInt( Pixels ); + inc( Addr2, Pitch2 * UInt32( Src_Rect2.y ) ); + end; + Mod1 := Pitch1 - ( ScanWidth * BPP ); + Mod2 := Pitch2 - ( ScanWidth * BPP ); + inc( Addr1, BPP * Scan1Start ); + inc( Addr2, BPP * Scan2Start ); + if Top1 <= Top2 then + begin + // 1. up, 2. down + ScanHeight := Bottom1 - Top2; + if ScanHeight > Src_Rect2.h then + ScanHeight := Src_Rect2.h; + inc( Addr1, Pitch1 * UInt32( Top2 - Top1 ) ); + end + else + begin + // 1. down, 2. up + ScanHeight := Bottom2 - Top1; + if ScanHeight > Src_Rect1.h then + ScanHeight := Src_Rect1.h; + inc( Addr2, Pitch2 * UInt32( Top1 - Top2 ) ); + end; + case BPP of + 1 : + for ty := 1 to ScanHeight do + begin + for tx := 1 to ScanWidth do + begin + if ( PByte( Addr1 )^ <> TransparentColor1 ) and ( PByte( Addr2 )^ <> + TransparentColor2 ) then + begin + Result := true; + exit; + end; + inc( Addr1 ); + inc( Addr2 ); + end; + inc( Addr1, Mod1 ); + inc( Addr2, Mod2 ); + end; + 2 : + for ty := 1 to ScanHeight do + begin + for tx := 1 to ScanWidth do + begin + if ( PWord( Addr1 )^ <> TransparentColor1 ) and ( PWord( Addr2 )^ <> + TransparentColor2 ) then + begin + Result := true; + exit; + end; + inc( Addr1, 2 ); + inc( Addr2, 2 ); + end; + inc( Addr1, Mod1 ); + inc( Addr2, Mod2 ); + end; + 3 : + for ty := 1 to ScanHeight do + begin + for tx := 1 to ScanWidth do + begin + Color1 := PLongWord( Addr1 )^ and $00FFFFFF; + Color2 := PLongWord( Addr2 )^ and $00FFFFFF; + if ( Color1 <> TransparentColor1 ) and ( Color2 <> TransparentColor2 ) + then + begin + Result := true; + exit; + end; + inc( Addr1, 3 ); + inc( Addr2, 3 ); + end; + inc( Addr1, Mod1 ); + inc( Addr2, Mod2 ); + end; + 4 : + for ty := 1 to ScanHeight do + begin + for tx := 1 to ScanWidth do + begin + if ( PLongWord( Addr1 )^ <> TransparentColor1 ) and ( PLongWord( Addr2 )^ <> + TransparentColor2 ) then + begin + Result := true; + exit; + end; + inc( Addr1, 4 ); + inc( Addr2, 4 ); + end; + inc( Addr1, Mod1 ); + inc( Addr2, Mod2 ); + end; + end; +end; + +procedure SDL_AddPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color : + cardinal ); +var + SrcColor : cardinal; + Addr : PtrUInt; + R, G, B : cardinal; +begin + if Color = 0 then + exit; + with DstSurface^ do + begin + Addr := PtrUInt( Pixels ) + y * Pitch + x * format.BytesPerPixel; + SrcColor := PUInt32( Addr )^; + case format.BitsPerPixel of + 8 : + begin + R := SrcColor and $E0 + Color and $E0; + G := SrcColor and $1C + Color and $1C; + B := SrcColor and $03 + Color and $03; + if R > $E0 then + R := $E0; + if G > $1C then + G := $1C; + if B > $03 then + B := $03; + PUInt8( Addr )^ := R or G or B; + end; + 15 : + begin + R := SrcColor and $7C00 + Color and $7C00; + G := SrcColor and $03E0 + Color and $03E0; + B := SrcColor and $001F + Color and $001F; + if R > $7C00 then + R := $7C00; + if G > $03E0 then + G := $03E0; + if B > $001F then + B := $001F; + PUInt16( Addr )^ := R or G or B; + end; + 16 : + begin + R := SrcColor and $F800 + Color and $F800; + G := SrcColor and $07C0 + Color and $07C0; + B := SrcColor and $001F + Color and $001F; + if R > $F800 then + R := $F800; + if G > $07C0 then + G := $07C0; + if B > $001F then + B := $001F; + PUInt16( Addr )^ := R or G or B; + end; + 24 : + begin + R := SrcColor and $00FF0000 + Color and $00FF0000; + G := SrcColor and $0000FF00 + Color and $0000FF00; + B := SrcColor and $000000FF + Color and $000000FF; + if R > $FF0000 then + R := $FF0000; + if G > $00FF00 then + G := $00FF00; + if B > $0000FF then + B := $0000FF; + PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B; + end; + 32 : + begin + R := SrcColor and $00FF0000 + Color and $00FF0000; + G := SrcColor and $0000FF00 + Color and $0000FF00; + B := SrcColor and $000000FF + Color and $000000FF; + if R > $FF0000 then + R := $FF0000; + if G > $00FF00 then + G := $00FF00; + if B > $0000FF then + B := $0000FF; + PUInt32( Addr )^ := R or G or B; + end; + end; + end; +end; + +procedure SDL_SubPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color : + cardinal ); +var + SrcColor : cardinal; + Addr : PtrUInt; + R, G, B : cardinal; +begin + if Color = 0 then + exit; + with DstSurface^ do + begin + Addr := PtrUInt( Pixels ) + y * Pitch + x * format.BytesPerPixel; + SrcColor := PUInt32( Addr )^; + case format.BitsPerPixel of + 8 : + begin + R := SrcColor and $E0 - Color and $E0; + G := SrcColor and $1C - Color and $1C; + B := SrcColor and $03 - Color and $03; + if R > $E0 then + R := 0; + if G > $1C then + G := 0; + if B > $03 then + B := 0; + PUInt8( Addr )^ := R or G or B; + end; + 15 : + begin + R := SrcColor and $7C00 - Color and $7C00; + G := SrcColor and $03E0 - Color and $03E0; + B := SrcColor and $001F - Color and $001F; + if R > $7C00 then + R := 0; + if G > $03E0 then + G := 0; + if B > $001F then + B := 0; + PUInt16( Addr )^ := R or G or B; + end; + 16 : + begin + R := SrcColor and $F800 - Color and $F800; + G := SrcColor and $07C0 - Color and $07C0; + B := SrcColor and $001F - Color and $001F; + if R > $F800 then + R := 0; + if G > $07C0 then + G := 0; + if B > $001F then + B := 0; + PUInt16( Addr )^ := R or G or B; + end; + 24 : + begin + R := SrcColor and $00FF0000 - Color and $00FF0000; + G := SrcColor and $0000FF00 - Color and $0000FF00; + B := SrcColor and $000000FF - Color and $000000FF; + if R > $FF0000 then + R := 0; + if G > $00FF00 then + G := 0; + if B > $0000FF then + B := 0; + PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B; + end; + 32 : + begin + R := SrcColor and $00FF0000 - Color and $00FF0000; + G := SrcColor and $0000FF00 - Color and $0000FF00; + B := SrcColor and $000000FF - Color and $000000FF; + if R > $FF0000 then + R := 0; + if G > $00FF00 then + G := 0; + if B > $0000FF then + B := 0; + PUInt32( Addr )^ := R or G or B; + end; + end; + end; +end; +// This procedure works on 8, 15, 16, 24 and 32 bits color depth surfaces. +// In 8 bit color depth mode the procedure works with the default packed +// palette (RRRGGGBB). It handles all clipping. + +procedure SDL_AddSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); +var + R, G, B, Pixel1, Pixel2, TransparentColor : cardinal; + Src, Dest : TSDL_Rect; + Diff : integer; + SrcAddr, DestAddr : PtrUInt; + WorkX, WorkY : word; + SrcMod, DestMod : cardinal; + Bits : cardinal; +begin + if ( SrcSurface = nil ) or ( DestSurface = nil ) then + exit; // Remove this to make it faster + if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then + exit; // Remove this to make it faster + if SrcRect = nil then + begin + with Src do + begin + x := 0; + y := 0; + w := SrcSurface.w; + h := SrcSurface.h; + end; + end + else + Src := SrcRect^; + if DestRect = nil then + begin + Dest.x := 0; + Dest.y := 0; + end + else + Dest := DestRect^; + Dest.w := Src.w; + Dest.h := Src.h; + with DestSurface.Clip_Rect do + begin + // Source's right side is greater than the dest.cliprect + if Dest.x + Src.w > x + w then + begin + smallint( Src.w ) := x + w - Dest.x; + smallint( Dest.w ) := x + w - Dest.x; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's bottom side is greater than the dest.clip + if Dest.y + Src.h > y + h then + begin + smallint( Src.h ) := y + h - Dest.y; + smallint( Dest.h ) := y + h - Dest.y; + if smallint( Dest.h ) < 1 then + exit; + end; + // Source's left side is less than the dest.clip + if Dest.x < x then + begin + Diff := x - Dest.x; + Src.x := Src.x + Diff; + smallint( Src.w ) := smallint( Src.w ) - Diff; + Dest.x := x; + smallint( Dest.w ) := smallint( Dest.w ) - Diff; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's Top side is less than the dest.clip + if Dest.y < y then + begin + Diff := y - Dest.y; + Src.y := Src.y + Diff; + smallint( Src.h ) := smallint( Src.h ) - Diff; + Dest.y := y; + smallint( Dest.h ) := smallint( Dest.h ) - Diff; + if smallint( Dest.h ) < 1 then + exit; + end; + end; + with SrcSurface^ do + begin + SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) * + Format.BytesPerPixel; + SrcMod := Pitch - Src.w * Format.BytesPerPixel; + TransparentColor := Format.colorkey; + end; + with DestSurface^ do + begin + DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) * + Format.BytesPerPixel; + DestMod := Pitch - Dest.w * Format.BytesPerPixel; + Bits := Format.BitsPerPixel; + end; + SDL_LockSurface( SrcSurface ); + SDL_LockSurface( DestSurface ); + WorkY := Src.h; + case bits of + 8 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt8( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt8( DestAddr )^; + if Pixel2 > 0 then + begin + R := Pixel1 and $E0 + Pixel2 and $E0; + G := Pixel1 and $1C + Pixel2 and $1C; + B := Pixel1 and $03 + Pixel2 and $03; + if R > $E0 then + R := $E0; + if G > $1C then + G := $1C; + if B > $03 then + B := $03; + PUInt8( DestAddr )^ := R or G or B; + end + else + PUInt8( DestAddr )^ := Pixel1; + end; + inc( SrcAddr ); + inc( DestAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 15 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + if Pixel2 > 0 then + begin + R := Pixel1 and $7C00 + Pixel2 and $7C00; + G := Pixel1 and $03E0 + Pixel2 and $03E0; + B := Pixel1 and $001F + Pixel2 and $001F; + if R > $7C00 then + R := $7C00; + if G > $03E0 then + G := $03E0; + if B > $001F then + B := $001F; + PUInt16( DestAddr )^ := R or G or B; + end + else + PUInt16( DestAddr )^ := Pixel1; + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 16 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + if Pixel2 > 0 then + begin + R := Pixel1 and $F800 + Pixel2 and $F800; + G := Pixel1 and $07E0 + Pixel2 and $07E0; + B := Pixel1 and $001F + Pixel2 and $001F; + if R > $F800 then + R := $F800; + if G > $07E0 then + G := $07E0; + if B > $001F then + B := $001F; + PUInt16( DestAddr )^ := R or G or B; + end + else + PUInt16( DestAddr )^ := Pixel1; + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 24 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF; + if Pixel2 > 0 then + begin + R := Pixel1 and $FF0000 + Pixel2 and $FF0000; + G := Pixel1 and $00FF00 + Pixel2 and $00FF00; + B := Pixel1 and $0000FF + Pixel2 and $0000FF; + if R > $FF0000 then + R := $FF0000; + if G > $00FF00 then + G := $00FF00; + if B > $0000FF then + B := $0000FF; + PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B ); + end + else + PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1; + end; + inc( SrcAddr, 3 ); + inc( DestAddr, 3 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 32 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^; + if Pixel2 > 0 then + begin + R := Pixel1 and $FF0000 + Pixel2 and $FF0000; + G := Pixel1 and $00FF00 + Pixel2 and $00FF00; + B := Pixel1 and $0000FF + Pixel2 and $0000FF; + if R > $FF0000 then + R := $FF0000; + if G > $00FF00 then + G := $00FF00; + if B > $0000FF then + B := $0000FF; + PUInt32( DestAddr )^ := R or G or B; + end + else + PUInt32( DestAddr )^ := Pixel1; + end; + inc( SrcAddr, 4 ); + inc( DestAddr, 4 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + end; + SDL_UnlockSurface( SrcSurface ); + SDL_UnlockSurface( DestSurface ); +end; + +procedure SDL_SubSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); +var + R, G, B, Pixel1, Pixel2, TransparentColor : cardinal; + Src, Dest : TSDL_Rect; + Diff : integer; + SrcAddr, DestAddr : PtrUInt; +//{*_ebx, *}{*_esi, *}{*_edi, _esp*} : cardinal; // Auto Removed, Unused Variable (_ebx) // Auto Removed, Unused Variable (_esi) // Auto Removed, Unused Variable (_edi) + WorkX, WorkY : word; + SrcMod, DestMod : cardinal; + Bits : cardinal; +begin + if ( SrcSurface = nil ) or ( DestSurface = nil ) then + exit; // Remove this to make it faster + if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then + exit; // Remove this to make it faster + if SrcRect = nil then + begin + with Src do + begin + x := 0; + y := 0; + w := SrcSurface.w; + h := SrcSurface.h; + end; + end + else + Src := SrcRect^; + if DestRect = nil then + begin + Dest.x := 0; + Dest.y := 0; + end + else + Dest := DestRect^; + Dest.w := Src.w; + Dest.h := Src.h; + with DestSurface.Clip_Rect do + begin + // Source's right side is greater than the dest.cliprect + if Dest.x + Src.w > x + w then + begin + smallint( Src.w ) := x + w - Dest.x; + smallint( Dest.w ) := x + w - Dest.x; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's bottom side is greater than the dest.clip + if Dest.y + Src.h > y + h then + begin + smallint( Src.h ) := y + h - Dest.y; + smallint( Dest.h ) := y + h - Dest.y; + if smallint( Dest.h ) < 1 then + exit; + end; + // Source's left side is less than the dest.clip + if Dest.x < x then + begin + Diff := x - Dest.x; + Src.x := Src.x + Diff; + smallint( Src.w ) := smallint( Src.w ) - Diff; + Dest.x := x; + smallint( Dest.w ) := smallint( Dest.w ) - Diff; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's Top side is less than the dest.clip + if Dest.y < y then + begin + Diff := y - Dest.y; + Src.y := Src.y + Diff; + smallint( Src.h ) := smallint( Src.h ) - Diff; + Dest.y := y; + smallint( Dest.h ) := smallint( Dest.h ) - Diff; + if smallint( Dest.h ) < 1 then + exit; + end; + end; + with SrcSurface^ do + begin + SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) * + Format.BytesPerPixel; + SrcMod := Pitch - Src.w * Format.BytesPerPixel; + TransparentColor := Format.colorkey; + end; + with DestSurface^ do + begin + DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) * + Format.BytesPerPixel; + DestMod := Pitch - Dest.w * Format.BytesPerPixel; + Bits := DestSurface.Format.BitsPerPixel; + end; + SDL_LockSurface( SrcSurface ); + SDL_LockSurface( DestSurface ); + WorkY := Src.h; + case bits of + 8 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt8( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt8( DestAddr )^; + if Pixel2 > 0 then + begin + R := Pixel2 and $E0 - Pixel1 and $E0; + G := Pixel2 and $1C - Pixel1 and $1C; + B := Pixel2 and $03 - Pixel1 and $03; + if R > $E0 then + R := 0; + if G > $1C then + G := 0; + if B > $03 then + B := 0; + PUInt8( DestAddr )^ := R or G or B; + end; + end; + inc( SrcAddr ); + inc( DestAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 15 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + if Pixel2 > 0 then + begin + R := Pixel2 and $7C00 - Pixel1 and $7C00; + G := Pixel2 and $03E0 - Pixel1 and $03E0; + B := Pixel2 and $001F - Pixel1 and $001F; + if R > $7C00 then + R := 0; + if G > $03E0 then + G := 0; + if B > $001F then + B := 0; + PUInt16( DestAddr )^ := R or G or B; + end; + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 16 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + if Pixel2 > 0 then + begin + R := Pixel2 and $F800 - Pixel1 and $F800; + G := Pixel2 and $07E0 - Pixel1 and $07E0; + B := Pixel2 and $001F - Pixel1 and $001F; + if R > $F800 then + R := 0; + if G > $07E0 then + G := 0; + if B > $001F then + B := 0; + PUInt16( DestAddr )^ := R or G or B; + end; + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 24 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF; + if Pixel2 > 0 then + begin + R := Pixel2 and $FF0000 - Pixel1 and $FF0000; + G := Pixel2 and $00FF00 - Pixel1 and $00FF00; + B := Pixel2 and $0000FF - Pixel1 and $0000FF; + if R > $FF0000 then + R := 0; + if G > $00FF00 then + G := 0; + if B > $0000FF then + B := 0; + PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B ); + end; + end; + inc( SrcAddr, 3 ); + inc( DestAddr, 3 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 32 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^; + if Pixel2 > 0 then + begin + R := Pixel2 and $FF0000 - Pixel1 and $FF0000; + G := Pixel2 and $00FF00 - Pixel1 and $00FF00; + B := Pixel2 and $0000FF - Pixel1 and $0000FF; + if R > $FF0000 then + R := 0; + if G > $00FF00 then + G := 0; + if B > $0000FF then + B := 0; + PUInt32( DestAddr )^ := R or G or B; + end + else + PUInt32( DestAddr )^ := Pixel2; + end; + inc( SrcAddr, 4 ); + inc( DestAddr, 4 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + end; + SDL_UnlockSurface( SrcSurface ); + SDL_UnlockSurface( DestSurface ); +end; + +procedure SDL_MonoSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Color : cardinal ); +var + Src, Dest : TSDL_Rect; + Diff : integer; + SrcAddr, DestAddr : PtrUInt; +//{*_ebx, *}{*_esi, *}{*_edi, _esp*} : cardinal; // Auto Removed, Unused Variable (_ebx) // Auto Removed, Unused Variable (_esi) // Auto Removed, Unused Variable (_edi) + WorkX, WorkY : word; + SrcMod, DestMod : cardinal; + TransparentColor, SrcColor : cardinal; + BPP : cardinal; +begin + if ( SrcSurface = nil ) or ( DestSurface = nil ) then + exit; // Remove this to make it faster + if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then + exit; // Remove this to make it faster + if SrcRect = nil then + begin + with Src do + begin + x := 0; + y := 0; + w := SrcSurface.w; + h := SrcSurface.h; + end; + end + else + Src := SrcRect^; + if DestRect = nil then + begin + Dest.x := 0; + Dest.y := 0; + end + else + Dest := DestRect^; + Dest.w := Src.w; + Dest.h := Src.h; + with DestSurface.Clip_Rect do + begin + // Source's right side is greater than the dest.cliprect + if Dest.x + Src.w > x + w then + begin + smallint( Src.w ) := x + w - Dest.x; + smallint( Dest.w ) := x + w - Dest.x; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's bottom side is greater than the dest.clip + if Dest.y + Src.h > y + h then + begin + smallint( Src.h ) := y + h - Dest.y; + smallint( Dest.h ) := y + h - Dest.y; + if smallint( Dest.h ) < 1 then + exit; + end; + // Source's left side is less than the dest.clip + if Dest.x < x then + begin + Diff := x - Dest.x; + Src.x := Src.x + Diff; + smallint( Src.w ) := smallint( Src.w ) - Diff; + Dest.x := x; + smallint( Dest.w ) := smallint( Dest.w ) - Diff; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's Top side is less than the dest.clip + if Dest.y < y then + begin + Diff := y - Dest.y; + Src.y := Src.y + Diff; + smallint( Src.h ) := smallint( Src.h ) - Diff; + Dest.y := y; + smallint( Dest.h ) := smallint( Dest.h ) - Diff; + if smallint( Dest.h ) < 1 then + exit; + end; + end; + with SrcSurface^ do + begin + SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) * + Format.BytesPerPixel; + SrcMod := Pitch - Src.w * Format.BytesPerPixel; + TransparentColor := Format.colorkey; + end; + with DestSurface^ do + begin + DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) * + Format.BytesPerPixel; + DestMod := Pitch - Dest.w * Format.BytesPerPixel; + BPP := DestSurface.Format.BytesPerPixel; + end; + SDL_LockSurface( SrcSurface ); + SDL_LockSurface( DestSurface ); + WorkY := Src.h; + case BPP of + 1 : + begin + repeat + WorkX := Src.w; + repeat + SrcColor := PUInt8( SrcAddr )^; + if SrcColor <> TransparentColor then + PUInt8( DestAddr )^ := SrcColor; + inc( SrcAddr ); + inc( DestAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 2 : + begin + repeat + WorkX := Src.w; + repeat + SrcColor := PUInt16( SrcAddr )^; + if SrcColor <> TransparentColor then + PUInt16( DestAddr )^ := SrcColor; + inc( SrcAddr ); + inc( DestAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 3 : + begin + repeat + WorkX := Src.w; + repeat + SrcColor := PUInt32( SrcAddr )^ and $FFFFFF; + if SrcColor <> TransparentColor then + PUInt32( DestAddr )^ := ( PUInt32( DestAddr )^ and $FFFFFF ) or SrcColor; + inc( SrcAddr ); + inc( DestAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 4 : + begin + repeat + WorkX := Src.w; + repeat + SrcColor := PUInt32( SrcAddr )^; + if SrcColor <> TransparentColor then + PUInt32( DestAddr )^ := SrcColor; + inc( SrcAddr ); + inc( DestAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + end; + SDL_UnlockSurface( SrcSurface ); + SDL_UnlockSurface( DestSurface ); +end; +// TextureRect.w and TextureRect.h are not used. +// The TextureSurface's size MUST larger than the drawing rectangle!!! + +procedure SDL_TexturedSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Texture : PSDL_Surface; + TextureRect : PSDL_Rect ); +var + Src, Dest : TSDL_Rect; + Diff : integer; + SrcAddr, DestAddr, TextAddr : PtrUInt; +//{*_ebx, *}{*_esi, *}{*_edi, _esp*}: cardinal; // Auto Removed, Unused Variable (_ebx) // Auto Removed, Unused Variable (_esi) // Auto Removed, Unused Variable (_edi) + WorkX, WorkY : word; + SrcMod, DestMod, TextMod : cardinal; +SrcColor, TransparentColor{*, TextureColor*} : cardinal; // Auto Removed, Unused Variable (TextureColor) + BPP : cardinal; +begin + if ( SrcSurface = nil ) or ( DestSurface = nil ) then + exit; // Remove this to make it faster + if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then + exit; // Remove this to make it faster + if SrcRect = nil then + begin + with Src do + begin + x := 0; + y := 0; + w := SrcSurface.w; + h := SrcSurface.h; + end; + end + else + Src := SrcRect^; + if DestRect = nil then + begin + Dest.x := 0; + Dest.y := 0; + end + else + Dest := DestRect^; + Dest.w := Src.w; + Dest.h := Src.h; + with DestSurface.Clip_Rect do + begin + // Source's right side is greater than the dest.cliprect + if Dest.x + Src.w > x + w then + begin + smallint( Src.w ) := x + w - Dest.x; + smallint( Dest.w ) := x + w - Dest.x; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's bottom side is greater than the dest.clip + if Dest.y + Src.h > y + h then + begin + smallint( Src.h ) := y + h - Dest.y; + smallint( Dest.h ) := y + h - Dest.y; + if smallint( Dest.h ) < 1 then + exit; + end; + // Source's left side is less than the dest.clip + if Dest.x < x then + begin + Diff := x - Dest.x; + Src.x := Src.x + Diff; + smallint( Src.w ) := smallint( Src.w ) - Diff; + Dest.x := x; + smallint( Dest.w ) := smallint( Dest.w ) - Diff; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's Top side is less than the dest.clip + if Dest.y < y then + begin + Diff := y - Dest.y; + Src.y := Src.y + Diff; + smallint( Src.h ) := smallint( Src.h ) - Diff; + Dest.y := y; + smallint( Dest.h ) := smallint( Dest.h ) - Diff; + if smallint( Dest.h ) < 1 then + exit; + end; + end; + with SrcSurface^ do + begin + SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) * + Format.BytesPerPixel; + SrcMod := Pitch - Src.w * Format.BytesPerPixel; + TransparentColor := format.colorkey; + end; + with DestSurface^ do + begin + DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) * + Format.BytesPerPixel; + DestMod := Pitch - Dest.w * Format.BytesPerPixel; + BPP := DestSurface.Format.BitsPerPixel; + end; + with Texture^ do + begin + TextAddr := PtrUInt( Pixels ) + UInt32( TextureRect.y ) * Pitch + + UInt32( TextureRect.x ) * Format.BytesPerPixel; + TextMod := Pitch - Src.w * Format.BytesPerPixel; + end; + SDL_LockSurface( SrcSurface ); + SDL_LockSurface( DestSurface ); + SDL_LockSurface( Texture ); + WorkY := Src.h; + case BPP of + 1 : + begin + repeat + WorkX := Src.w; + repeat + SrcColor := PUInt8( SrcAddr )^; + if SrcColor <> TransparentColor then + PUInt8( DestAddr )^ := PUint8( TextAddr )^; + inc( SrcAddr ); + inc( DestAddr ); + inc( TextAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + inc( TextAddr, TextMod ); + dec( WorkY ); + until WorkY = 0; + end; + 2 : + begin + repeat + WorkX := Src.w; + repeat + SrcColor := PUInt16( SrcAddr )^; + if SrcColor <> TransparentColor then + PUInt16( DestAddr )^ := PUInt16( TextAddr )^; + inc( SrcAddr ); + inc( DestAddr ); + inc( TextAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + inc( TextAddr, TextMod ); + dec( WorkY ); + until WorkY = 0; + end; + 3 : + begin + repeat + WorkX := Src.w; + repeat + SrcColor := PUInt32( SrcAddr )^ and $FFFFFF; + if SrcColor <> TransparentColor then + PUInt32( DestAddr )^ := ( PUInt32( DestAddr )^ and $FFFFFF ) or ( PUInt32( TextAddr )^ and $FFFFFF ); + inc( SrcAddr ); + inc( DestAddr ); + inc( TextAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + inc( TextAddr, TextMod ); + dec( WorkY ); + until WorkY = 0; + end; + 4 : + begin + repeat + WorkX := Src.w; + repeat + SrcColor := PUInt32( SrcAddr )^; + if SrcColor <> TransparentColor then + PUInt32( DestAddr )^ := PUInt32( TextAddr )^; + inc( SrcAddr ); + inc( DestAddr ); + inc( TextAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + inc( TextAddr, TextMod ); + dec( WorkY ); + until WorkY = 0; + end; + end; + SDL_UnlockSurface( SrcSurface ); + SDL_UnlockSurface( DestSurface ); + SDL_UnlockSurface( Texture ); +end; + +procedure SDL_ZoomSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; DstRect : PSDL_Rect ); +var + xc, yc : cardinal; + rx, wx, ry, wy, ry16 : cardinal; + color : cardinal; + modx, mody : cardinal; +begin + // Warning! No checks for surface pointers!!! + if srcrect = nil then + srcrect := @SrcSurface.clip_rect; + if dstrect = nil then + dstrect := @DstSurface.clip_rect; + if SDL_MustLock( SrcSurface ) then + SDL_LockSurface( SrcSurface ); + if SDL_MustLock( DstSurface ) then + SDL_LockSurface( DstSurface ); + modx := trunc( ( srcrect.w / dstrect.w ) * 65536 ); + mody := trunc( ( srcrect.h / dstrect.h ) * 65536 ); + //rx := srcrect.x * 65536; + ry := srcrect.y * 65536; + wy := dstrect.y; + for yc := 0 to dstrect.h - 1 do + begin + rx := srcrect.x * 65536; + wx := dstrect.x; + ry16 := ry shr 16; + for xc := 0 to dstrect.w - 1 do + begin + color := SDL_GetPixel( SrcSurface, rx shr 16, ry16 ); + SDL_PutPixel( DstSurface, wx, wy, color ); + rx := rx + modx; + inc( wx ); + end; + ry := ry + mody; + inc( wy ); + end; + if SDL_MustLock( SrcSurface ) then + SDL_UnlockSurface( SrcSurface ); + if SDL_MustLock( DstSurface ) then + SDL_UnlockSurface( DstSurface ); +end; +// Re-map a rectangular area into an area defined by four vertices +// Converted from C to Pascal by KiCHY + +procedure SDL_WarpSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; UL, UR, LR, LL : PPoint ); +const + SHIFTS = 15; // Extend ints to limit round-off error (try 2 - 20) + THRESH = 1 shl SHIFTS; // Threshold for pixel size value + procedure CopySourceToDest( UL, UR, LR, LL : TPoint; x1, y1, x2, y2 : cardinal ); + var + tm, lm, rm, bm, m : TPoint; + mx, my : cardinal; + cr : cardinal; + begin + // Does the destination area specify a single pixel? + if ( ( abs( ul.x - ur.x ) < THRESH ) and + ( abs( ul.x - lr.x ) < THRESH ) and + ( abs( ul.x - ll.x ) < THRESH ) and + ( abs( ul.y - ur.y ) < THRESH ) and + ( abs( ul.y - lr.y ) < THRESH ) and + ( abs( ul.y - ll.y ) < THRESH ) ) then + begin // Yes + cr := SDL_GetPixel( SrcSurface, ( x1 shr SHIFTS ), ( y1 shr SHIFTS ) ); + SDL_PutPixel( DstSurface, ( ul.x shr SHIFTS ), ( ul.y shr SHIFTS ), cr ); + end + else + begin // No + // Quarter the source and the destination, and then recurse + tm.x := ( ul.x + ur.x ) shr 1; + tm.y := ( ul.y + ur.y ) shr 1; + bm.x := ( ll.x + lr.x ) shr 1; + bm.y := ( ll.y + lr.y ) shr 1; + lm.x := ( ul.x + ll.x ) shr 1; + lm.y := ( ul.y + ll.y ) shr 1; + rm.x := ( ur.x + lr.x ) shr 1; + rm.y := ( ur.y + lr.y ) shr 1; + m.x := ( tm.x + bm.x ) shr 1; + m.y := ( tm.y + bm.y ) shr 1; + mx := ( x1 + x2 ) shr 1; + my := ( y1 + y2 ) shr 1; + CopySourceToDest( ul, tm, m, lm, x1, y1, mx, my ); + CopySourceToDest( tm, ur, rm, m, mx, y1, x2, my ); + CopySourceToDest( m, rm, lr, bm, mx, my, x2, y2 ); + CopySourceToDest( lm, m, bm, ll, x1, my, mx, y2 ); + end; + end; +var + _UL, _UR, _LR, _LL : TPoint; + Rect_x, Rect_y, Rect_w, Rect_h : integer; +begin + if SDL_MustLock( SrcSurface ) then + SDL_LockSurface( SrcSurface ); + if SDL_MustLock( DstSurface ) then + SDL_LockSurface( DstSurface ); + if SrcRect = nil then + begin + Rect_x := 0; + Rect_y := 0; + Rect_w := ( SrcSurface.w - 1 ) shl SHIFTS; + Rect_h := ( SrcSurface.h - 1 ) shl SHIFTS; + end + else + begin + Rect_x := SrcRect.x; + Rect_y := SrcRect.y; + Rect_w := ( SrcRect.w - 1 ) shl SHIFTS; + Rect_h := ( SrcRect.h - 1 ) shl SHIFTS; + end; + // Shift all values to help reduce round-off error. + _ul.x := ul.x shl SHIFTS; + _ul.y := ul.y shl SHIFTS; + _ur.x := ur.x shl SHIFTS; + _ur.y := ur.y shl SHIFTS; + _lr.x := lr.x shl SHIFTS; + _lr.y := lr.y shl SHIFTS; + _ll.x := ll.x shl SHIFTS; + _ll.y := ll.y shl SHIFTS; + CopySourceToDest( _ul, _ur, _lr, _ll, Rect_x, Rect_y, Rect_w, Rect_h ); + if SDL_MustLock( SrcSurface ) then + SDL_UnlockSurface( SrcSurface ); + if SDL_MustLock( DstSurface ) then + SDL_UnlockSurface( DstSurface ); +end; + +// Draw a line between x1,y1 and x2,y2 to the given surface +// NOTE: The surface must be locked before calling this! + +procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color : + cardinal ); +var + dx, dy, sdx, sdy, x, y, px, py : integer; +begin + dx := x2 - x1; + dy := y2 - y1; + if dx < 0 then + sdx := -1 + else + sdx := 1; + if dy < 0 then + sdy := -1 + else + sdy := 1; + dx := sdx * dx + 1; + dy := sdy * dy + 1; + x := 0; + y := 0; + px := x1; + py := y1; + if dx >= dy then + begin + for x := 0 to dx - 1 do + begin + SDL_PutPixel( DstSurface, px, py, Color ); + y := y + dy; + if y >= dx then + begin + y := y - dx; + py := py + sdy; + end; + px := px + sdx; + end; + end + else + begin + for y := 0 to dy - 1 do + begin + SDL_PutPixel( DstSurface, px, py, Color ); + x := x + dx; + if x >= dy then + begin + x := x - dy; + px := px + sdx; + end; + py := py + sdy; + end; + end; +end; + +// Draw a dashed line between x1,y1 and x2,y2 to the given surface +// NOTE: The surface must be locked before calling this! + +procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color : + cardinal; DashLength, DashSpace : byte ); overload; +var + dx, dy, sdx, sdy, x, y, px, py, counter : integer; drawdash : boolean; +begin + counter := 0; + drawdash := true; //begin line drawing with dash + + //Avoid invalid user-passed dash parameters + if ( DashLength < 1 ) + then + DashLength := 1; + if ( DashSpace < 1 ) + then + DashSpace := 0; + + dx := x2 - x1; + dy := y2 - y1; + if dx < 0 then + sdx := -1 + else + sdx := 1; + if dy < 0 then + sdy := -1 + else + sdy := 1; + dx := sdx * dx + 1; + dy := sdy * dy + 1; + x := 0; + y := 0; + px := x1; + py := y1; + if dx >= dy then + begin + for x := 0 to dx - 1 do + begin + + //Alternate drawing dashes, or leaving spaces + if drawdash then + begin + SDL_PutPixel( DstSurface, px, py, Color ); + inc( counter ); + if ( counter > DashLength - 1 ) and ( DashSpace > 0 ) then + begin + drawdash := false; + counter := 0; + end; + end + else //space + begin + inc( counter ); + if counter > DashSpace - 1 then + begin + drawdash := true; + counter := 0; + end; + end; + + y := y + dy; + if y >= dx then + begin + y := y - dx; + py := py + sdy; + end; + px := px + sdx; + end; + end + else + begin + for y := 0 to dy - 1 do + begin + + //Alternate drawing dashes, or leaving spaces + if drawdash then + begin + SDL_PutPixel( DstSurface, px, py, Color ); + inc( counter ); + if ( counter > DashLength - 1 ) and ( DashSpace > 0 ) then + begin + drawdash := false; + counter := 0; + end; + end + else //space + begin + inc( counter ); + if counter > DashSpace - 1 then + begin + drawdash := true; + counter := 0; + end; + end; + + x := x + dx; + if x >= dy then + begin + x := x - dy; + px := px + sdx; + end; + py := py + sdy; + end; + end; +end; + +procedure SDL_AddLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color : + cardinal ); +var + dx, dy, sdx, sdy, x, y, px, py : integer; +begin + dx := x2 - x1; + dy := y2 - y1; + if dx < 0 then + sdx := -1 + else + sdx := 1; + if dy < 0 then + sdy := -1 + else + sdy := 1; + dx := sdx * dx + 1; + dy := sdy * dy + 1; + x := 0; + y := 0; + px := x1; + py := y1; + if dx >= dy then + begin + for x := 0 to dx - 1 do + begin + SDL_AddPixel( DstSurface, px, py, Color ); + y := y + dy; + if y >= dx then + begin + y := y - dx; + py := py + sdy; + end; + px := px + sdx; + end; + end + else + begin + for y := 0 to dy - 1 do + begin + SDL_AddPixel( DstSurface, px, py, Color ); + x := x + dx; + if x >= dy then + begin + x := x - dy; + px := px + sdx; + end; + py := py + sdy; + end; + end; +end; + +procedure SDL_SubLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color : + cardinal ); +var + dx, dy, sdx, sdy, x, y, px, py : integer; +begin + dx := x2 - x1; + dy := y2 - y1; + if dx < 0 then + sdx := -1 + else + sdx := 1; + if dy < 0 then + sdy := -1 + else + sdy := 1; + dx := sdx * dx + 1; + dy := sdy * dy + 1; + x := 0; + y := 0; + px := x1; + py := y1; + if dx >= dy then + begin + for x := 0 to dx - 1 do + begin + SDL_SubPixel( DstSurface, px, py, Color ); + y := y + dy; + if y >= dx then + begin + y := y - dx; + py := py + sdy; + end; + px := px + sdx; + end; + end + else + begin + for y := 0 to dy - 1 do + begin + SDL_SubPixel( DstSurface, px, py, Color ); + x := x + dx; + if x >= dy then + begin + x := x - dy; + px := px + sdx; + end; + py := py + sdy; + end; + end; +end; + +// flips a rectangle vertically on given surface + +procedure SDL_FlipRectV( DstSurface : PSDL_Surface; Rect : PSDL_Rect ); +var + TmpRect : TSDL_Rect; + Locked : boolean; + y, FlipLength, RowLength : integer; + Row1, Row2 : Pointer; + OneRow : TByteArray; // Optimize it if you wish +begin + if DstSurface <> nil then + begin + if Rect = nil then + begin // if Rect=nil then we flip the whole surface + TmpRect := SDLRect( 0, 0, DstSurface.w, DstSurface.h ); + Rect := @TmpRect; + end; + FlipLength := Rect^.h shr 1 - 1; + RowLength := Rect^.w * DstSurface^.format.BytesPerPixel; + if SDL_MustLock( DstSurface ) then + begin + Locked := true; + SDL_LockSurface( DstSurface ); + end + else + Locked := false; + Row1 := pointer( PtrUInt( DstSurface^.Pixels ) + UInt32( Rect^.y ) * + DstSurface^.Pitch ); + Row2 := pointer( PtrUInt( DstSurface^.Pixels ) + ( UInt32( Rect^.y ) + Rect^.h - 1 ) + * DstSurface^.Pitch ); + for y := 0 to FlipLength do + begin + Move( Row1^, OneRow, RowLength ); + Move( Row2^, Row1^, RowLength ); + Move( OneRow, Row2^, RowLength ); + inc( PtrUInt( Row1 ), DstSurface^.Pitch ); + dec( PtrUInt( Row2 ), DstSurface^.Pitch ); + end; + if Locked then + SDL_UnlockSurface( DstSurface ); + end; +end; + +// flips a rectangle horizontally on given surface + +procedure SDL_FlipRectH( DstSurface : PSDL_Surface; Rect : PSDL_Rect ); +type + T24bit = packed array[ 0..2 ] of byte; + T24bitArray = packed array[ 0..8191 ] of T24bit; + P24bitArray = ^T24bitArray; + TLongWordArray = array[ 0..8191 ] of LongWord; + PLongWordArray = ^TLongWordArray; +var + TmpRect : TSDL_Rect; + Row8bit : PByteArray; + Row16bit : PWordArray; + Row24bit : P24bitArray; + Row32bit : PLongWordArray; + y, x, RightSide, FlipLength : integer; + Pixel : cardinal; + Pixel24 : T24bit; + Locked : boolean; +begin + if DstSurface <> nil then + begin + if Rect = nil then + begin + TmpRect := SDLRect( 0, 0, DstSurface.w, DstSurface.h ); + Rect := @TmpRect; + end; + FlipLength := Rect^.w shr 1 - 1; + if SDL_MustLock( DstSurface ) then + begin + Locked := true; + SDL_LockSurface( DstSurface ); + end + else + Locked := false; + case DstSurface^.format.BytesPerPixel of + 1 : + begin + Row8Bit := pointer( PtrUInt( DstSurface^.pixels ) + UInt32( Rect^.y ) * + DstSurface^.pitch ); + for y := 1 to Rect^.h do + begin + RightSide := Rect^.w - 1; + for x := 0 to FlipLength do + begin + Pixel := Row8Bit^[ x ]; + Row8Bit^[ x ] := Row8Bit^[ RightSide ]; + Row8Bit^[ RightSide ] := Pixel; + dec( RightSide ); + end; + inc( PtrUInt( Row8Bit ), DstSurface^.pitch ); + end; + end; + 2 : + begin + Row16Bit := pointer( PtrUInt( DstSurface^.pixels ) + UInt32( Rect^.y ) * + DstSurface^.pitch ); + for y := 1 to Rect^.h do + begin + RightSide := Rect^.w - 1; + for x := 0 to FlipLength do + begin + Pixel := Row16Bit^[ x ]; + Row16Bit^[ x ] := Row16Bit^[ RightSide ]; + Row16Bit^[ RightSide ] := Pixel; + dec( RightSide ); + end; + inc( PtrUInt( Row16Bit ), DstSurface^.pitch ); + end; + end; + 3 : + begin + Row24Bit := pointer( PtrUInt( DstSurface^.pixels ) + UInt32( Rect^.y ) * + DstSurface^.pitch ); + for y := 1 to Rect^.h do + begin + RightSide := Rect^.w - 1; + for x := 0 to FlipLength do + begin + Pixel24 := Row24Bit^[ x ]; + Row24Bit^[ x ] := Row24Bit^[ RightSide ]; + Row24Bit^[ RightSide ] := Pixel24; + dec( RightSide ); + end; + inc( PtrUInt( Row24Bit ), DstSurface^.pitch ); + end; + end; + 4 : + begin + Row32Bit := pointer( PtrUInt( DstSurface^.pixels ) + UInt32( Rect^.y ) * + DstSurface^.pitch ); + for y := 1 to Rect^.h do + begin + RightSide := Rect^.w - 1; + for x := 0 to FlipLength do + begin + Pixel := Row32Bit^[ x ]; + Row32Bit^[ x ] := Row32Bit^[ RightSide ]; + Row32Bit^[ RightSide ] := Pixel; + dec( RightSide ); + end; + inc( PtrUInt( Row32Bit ), DstSurface^.pitch ); + end; + end; + end; + if Locked then + SDL_UnlockSurface( DstSurface ); + end; +end; + +// Use with caution! The procedure allocates memory for TSDL_Rect and return with its pointer. +// But you MUST free it after you don't need it anymore!!! + +function PSDLRect( aLeft, aTop, aWidth, aHeight : integer ) : PSDL_Rect; +var + Rect : PSDL_Rect; +begin + New( Rect ); + with Rect^ do + begin + x := aLeft; + y := aTop; + w := aWidth; + h := aHeight; + end; + Result := Rect; +end; + +function SDLRect( aLeft, aTop, aWidth, aHeight : integer ) : TSDL_Rect; +begin + with result do + begin + x := aLeft; + y := aTop; + w := aWidth; + h := aHeight; + end; +end; + +function SDLRect( aRect : TRect ) : TSDL_Rect; +begin + with aRect do + result := SDLRect( Left, Top, Right - Left, Bottom - Top ); +end; + +procedure SDL_Stretch8( Surface, Dst_Surface : PSDL_Surface; x1, x2, y1, y2, yr, yw, + depth : integer ); +var + dx, dy, e, d, dx2 : integer; + src_pitch, dst_pitch : uint16; + src_pixels, dst_pixels : PUint8; +begin + if ( yw >= dst_surface^.h ) then + exit; + dx := ( x2 - x1 ); + dy := ( y2 - y1 ); + dy := dy shl 1; + e := dy - dx; + dx2 := dx shl 1; + src_pitch := Surface^.pitch; + dst_pitch := dst_surface^.pitch; + src_pixels := PUint8( PtrUInt( Surface^.pixels ) + yr * src_pitch + y1 * depth ); + dst_pixels := PUint8( PtrUInt( dst_surface^.pixels ) + yw * dst_pitch + x1 * + depth ); + for d := 0 to dx - 1 do + begin + move( src_pixels^, dst_pixels^, depth ); + while ( e >= 0 ) do + begin + inc( src_pixels, depth ); + e := e - dx2; + end; + inc( dst_pixels, depth ); + e := e + dy; + end; +end; + +function sign( x : integer ) : integer; +begin + if x > 0 then + result := 1 + else + result := -1; +end; + +// Stretches a part of a surface + +function SDL_ScaleSurfaceRect( SrcSurface : PSDL_Surface; SrcX1, SrcY1, SrcW, SrcH, + Width, Height : integer ) : PSDL_Surface; +var + dst_surface : PSDL_Surface; + dx, dy, e, d, dx2, srcx2, srcy2 : integer; + destx1, desty1 : integer; +begin + srcx2 := srcx1 + SrcW; + srcy2 := srcy1 + SrcH; + result := nil; + destx1 := 0; + desty1 := 0; + dx := abs( integer( Height - desty1 ) ); + dy := abs( integer( SrcY2 - SrcY1 ) ); + e := ( dy shl 1 ) - dx; + dx2 := dx shl 1; + dy := dy shl 1; + dst_surface := SDL_CreateRGBSurface( SDL_HWPALETTE, width - destx1, Height - + desty1, + SrcSurface^.Format^.BitsPerPixel, + SrcSurface^.Format^.RMask, + SrcSurface^.Format^.GMask, + SrcSurface^.Format^.BMask, + SrcSurface^.Format^.AMask ); + if ( dst_surface^.format^.BytesPerPixel = 1 ) then + SDL_SetColors( dst_surface, @SrcSurface^.format^.palette^.colors^[ 0 ], 0, 256 ); + SDL_SetColorKey( dst_surface, sdl_srccolorkey, SrcSurface^.format^.colorkey ); + if ( SDL_MustLock( dst_surface ) ) then + if ( SDL_LockSurface( dst_surface ) < 0 ) then + exit; + for d := 0 to dx - 1 do + begin + SDL_Stretch8( SrcSurface, dst_surface, destx1, Width, SrcX1, SrcX2, SrcY1, desty1, + SrcSurface^.format^.BytesPerPixel ); + while e >= 0 do + begin + inc( SrcY1 ); + e := e - dx2; + end; + inc( desty1 ); + e := e + dy; + end; + if SDL_MUSTLOCK( dst_surface ) then + SDL_UnlockSurface( dst_surface ); + result := dst_surface; +end; + +procedure SDL_MoveLine( Surface : PSDL_Surface; x1, x2, y1, xofs, depth : integer ); +var + src_pixels, dst_pixels : PUint8; + i : integer; +begin + src_pixels := PUint8( PtrUInt( Surface^.pixels ) + Surface^.w * y1 * depth + x2 * + depth ); + dst_pixels := PUint8( PtrUInt( Surface^.pixels ) + Surface^.w * y1 * depth + ( x2 + + xofs ) * depth ); + for i := x2 downto x1 do + begin + move( src_pixels^, dst_pixels^, depth ); + dec( src_pixels ); + dec( dst_pixels ); + end; +end; +{ Return the pixel value at (x, y) +NOTE: The surface must be locked before calling this! } + +function SDL_GetPixel( SrcSurface : PSDL_Surface; x : integer; y : integer ) : Uint32; +var + bpp : UInt32; + p : PInteger; +begin + bpp := SrcSurface.format.BytesPerPixel; + // Here p is the address to the pixel we want to retrieve + p := Pointer( PtrUInt( SrcSurface.pixels ) + UInt32( y ) * SrcSurface.pitch + UInt32( x ) * + bpp ); + case bpp of + 1 : result := PUint8( p )^; + 2 : result := PUint16( p )^; + 3 : + if ( SDL_BYTEORDER = SDL_BIG_ENDIAN ) then + result := PUInt8Array( p )[ 0 ] shl 16 or PUInt8Array( p )[ 1 ] shl 8 or + PUInt8Array( p )[ 2 ] + else + result := PUInt8Array( p )[ 0 ] or PUInt8Array( p )[ 1 ] shl 8 or + PUInt8Array( p )[ 2 ] shl 16; + 4 : result := PUint32( p )^; + else + result := 0; // shouldn't happen, but avoids warnings + end; +end; +{ Set the pixel at (x, y) to the given value + NOTE: The surface must be locked before calling this! } + +procedure SDL_PutPixel( DstSurface : PSDL_Surface; x : integer; y : integer; pixel : + Uint32 ); +var + bpp : UInt32; + p : PInteger; +begin + bpp := DstSurface.format.BytesPerPixel; + p := Pointer( PtrUInt( DstSurface.pixels ) + UInt32( y ) * DstSurface.pitch + UInt32( x ) + * bpp ); + case bpp of + 1 : PUint8( p )^ := pixel; + 2 : PUint16( p )^ := pixel; + 3 : + if ( SDL_BYTEORDER = SDL_BIG_ENDIAN ) then + begin + PUInt8Array( p )[ 0 ] := ( pixel shr 16 ) and $FF; + PUInt8Array( p )[ 1 ] := ( pixel shr 8 ) and $FF; + PUInt8Array( p )[ 2 ] := pixel and $FF; + end + else + begin + PUInt8Array( p )[ 0 ] := pixel and $FF; + PUInt8Array( p )[ 1 ] := ( pixel shr 8 ) and $FF; + PUInt8Array( p )[ 2 ] := ( pixel shr 16 ) and $FF; + end; + 4 : + PUint32( p )^ := pixel; + end; +end; + +procedure SDL_ScrollY( DstSurface : PSDL_Surface; DifY : integer ); +var + r1, r2 : TSDL_Rect; + //buffer: PSDL_Surface; + YPos : Integer; +begin + if ( DstSurface <> nil ) and ( DifY <> 0 ) then + begin + //if DifY > 0 then // going up + //begin + ypos := 0; + r1.x := 0; + r2.x := 0; + r1.w := DstSurface.w; + r2.w := DstSurface.w; + r1.h := DifY; + r2.h := DifY; + while ypos < DstSurface.h do + begin + r1.y := ypos; + r2.y := ypos + DifY; + SDL_BlitSurface( DstSurface, @r2, DstSurface, @r1 ); + ypos := ypos + DifY; + end; + //end + //else + //begin // Going Down + //end; + end; +end; + +{procedure SDL_ScrollY(Surface: PSDL_Surface; DifY: integer); +var + r1, r2: TSDL_Rect; + buffer: PSDL_Surface; +begin + if (Surface <> nil) and (Dify <> 0) then + begin + buffer := SDL_CreateRGBSurface(SDL_HWSURFACE, (Surface^.w - DifY) * 2, + Surface^.h * 2, + Surface^.Format^.BitsPerPixel, 0, 0, 0, 0); + if buffer <> nil then + begin + if (buffer^.format^.BytesPerPixel = 1) then + SDL_SetColors(buffer, @Surface^.format^.palette^.colors^[0], 0, 256); + r1 := SDLRect(0, DifY, buffer^.w, buffer^.h); + r2 := SDLRect(0, 0, buffer^.w, buffer^.h); + SDL_BlitSurface(Surface, @r1, buffer, @r2); + SDL_BlitSurface(buffer, @r2, Surface, @r2); + SDL_FreeSurface(buffer); + end; + end; +end;} + +procedure SDL_ScrollX( DstSurface : PSDL_Surface; DifX : integer ); +var + r1, r2 : TSDL_Rect; + buffer : PSDL_Surface; +begin + if ( DstSurface <> nil ) and ( DifX <> 0 ) then + begin + buffer := SDL_CreateRGBSurface( SDL_HWSURFACE, ( DstSurface^.w - DifX ) * 2, + DstSurface^.h * 2, + DstSurface^.Format^.BitsPerPixel, + DstSurface^.Format^.RMask, + DstSurface^.Format^.GMask, + DstSurface^.Format^.BMask, + DstSurface^.Format^.AMask ); + if buffer <> nil then + begin + if ( buffer^.format^.BytesPerPixel = 1 ) then + SDL_SetColors( buffer, @DstSurface^.format^.palette^.colors^[ 0 ], 0, 256 ); + r1 := SDLRect( DifX, 0, buffer^.w, buffer^.h ); + r2 := SDLRect( 0, 0, buffer^.w, buffer^.h ); + SDL_BlitSurface( DstSurface, @r1, buffer, @r2 ); + SDL_BlitSurface( buffer, @r2, DstSurface, @r2 ); + SDL_FreeSurface( buffer ); + end; + end; +end; + +procedure SDL_RotateRad( DstSurface, SrcSurface : PSDL_Surface; SrcRect : + PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Single ); +var + aSin, aCos : Single; + MX, MY, DX, DY, NX, NY, SX, SY, OX, OY, Width, Height, TX, TY, RX, RY, ROX, ROY : Integer; + Colour, TempTransparentColour : UInt32; + MAXX, MAXY : Integer; +begin + // Rotate the surface to the target surface. + TempTransparentColour := SrcSurface.format.colorkey; + {if srcRect.w > srcRect.h then + begin + Width := srcRect.w; + Height := srcRect.w; + end + else + begin + Width := srcRect.h; + Height := srcRect.h; + end; } + + maxx := DstSurface.w; + maxy := DstSurface.h; + aCos := cos( Angle ); + aSin := sin( Angle ); + + Width := round( abs( srcrect.h * acos ) + abs( srcrect.w * asin ) ); + Height := round( abs( srcrect.h * asin ) + abs( srcrect.w * acos ) ); + + OX := Width div 2; + OY := Height div 2; ; + MX := ( srcRect.x + ( srcRect.x + srcRect.w ) ) div 2; + MY := ( srcRect.y + ( srcRect.y + srcRect.h ) ) div 2; + ROX := ( -( srcRect.w div 2 ) ) + Offsetx; + ROY := ( -( srcRect.h div 2 ) ) + OffsetY; + Tx := ox + round( ROX * aSin - ROY * aCos ); + Ty := oy + round( ROY * aSin + ROX * aCos ); + SX := 0; + for DX := DestX - TX to DestX - TX + ( width ) do + begin + Inc( SX ); + SY := 0; + for DY := DestY - TY to DestY - TY + ( Height ) do + begin + RX := SX - OX; + RY := SY - OY; + NX := round( mx + RX * aSin + RY * aCos ); // + NY := round( my + RY * aSin - RX * aCos ); // + // Used for testing only + //SDL_PutPixel(DestSurface.SDLSurfacePointer,DX,DY,0); + if ( ( DX > 0 ) and ( DX < MAXX ) ) and ( ( DY > 0 ) and ( DY < MAXY ) ) then + begin + if ( NX >= srcRect.x ) and ( NX <= srcRect.x + srcRect.w ) then + begin + if ( NY >= srcRect.y ) and ( NY <= srcRect.y + srcRect.h ) then + begin + Colour := SDL_GetPixel( SrcSurface, NX, NY ); + if Colour <> TempTransparentColour then + begin + SDL_PutPixel( DstSurface, DX, DY, Colour ); + end; + end; + end; + end; + inc( SY ); + end; + end; +end; + +procedure SDL_RotateDeg( DstSurface, SrcSurface : PSDL_Surface; SrcRect : + PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Integer ); +begin + SDL_RotateRad( DstSurface, SrcSurface, SrcRect, DestX, DestY, OffsetX, OffsetY, DegToRad( Angle ) ); +end; + +function ValidateSurfaceRect( DstSurface : PSDL_Surface; dstrect : PSDL_Rect ) : TSDL_Rect; +var + RealRect : TSDL_Rect; + OutOfRange : Boolean; +begin + OutOfRange := false; + if dstrect = nil then + begin + RealRect.x := 0; + RealRect.y := 0; + RealRect.w := DstSurface.w; + RealRect.h := DstSurface.h; + end + else + begin + if dstrect.x < DstSurface.w then + begin + RealRect.x := dstrect.x; + end + else if dstrect.x < 0 then + begin + realrect.x := 0; + end + else + begin + OutOfRange := True; + end; + if dstrect.y < DstSurface.h then + begin + RealRect.y := dstrect.y; + end + else if dstrect.y < 0 then + begin + realrect.y := 0; + end + else + begin + OutOfRange := True; + end; + if OutOfRange = False then + begin + if realrect.x + dstrect.w <= DstSurface.w then + begin + RealRect.w := dstrect.w; + end + else + begin + RealRect.w := dstrect.w - realrect.x; + end; + if realrect.y + dstrect.h <= DstSurface.h then + begin + RealRect.h := dstrect.h; + end + else + begin + RealRect.h := dstrect.h - realrect.y; + end; + end; + end; + if OutOfRange = False then + begin + result := realrect; + end + else + begin + realrect.w := 0; + realrect.h := 0; + realrect.x := 0; + realrect.y := 0; + result := realrect; + end; +end; + +procedure SDL_FillRectAdd( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 ); +var + RealRect : TSDL_Rect; + Addr : pointer; + ModX, BPP : cardinal; + x, y, R, G, B, SrcColor : cardinal; +begin + RealRect := ValidateSurfaceRect( DstSurface, DstRect ); + if ( RealRect.w > 0 ) and ( RealRect.h > 0 ) then + begin + SDL_LockSurface( DstSurface ); + BPP := DstSurface.format.BytesPerPixel; + with DstSurface^ do + begin + Addr := pointer( PtrUInt( pixels ) + UInt32( RealRect.y ) * pitch + UInt32( RealRect.x ) * BPP ); + ModX := Pitch - UInt32( RealRect.w ) * BPP; + end; + case DstSurface.format.BitsPerPixel of + 8 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $E0 + Color and $E0; + G := SrcColor and $1C + Color and $1C; + B := SrcColor and $03 + Color and $03; + if R > $E0 then + R := $E0; + if G > $1C then + G := $1C; + if B > $03 then + B := $03; + PUInt8( Addr )^ := R or G or B; + inc( PtrUInt( Addr ), BPP ); + end; + inc( PtrUInt( Addr ), ModX ); + end; + end; + 15 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $7C00 + Color and $7C00; + G := SrcColor and $03E0 + Color and $03E0; + B := SrcColor and $001F + Color and $001F; + if R > $7C00 then + R := $7C00; + if G > $03E0 then + G := $03E0; + if B > $001F then + B := $001F; + PUInt16( Addr )^ := R or G or B; + inc( PtrUInt( Addr ), BPP ); + end; + inc( PtrUInt( Addr ), ModX ); + end; + end; + 16 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $F800 + Color and $F800; + G := SrcColor and $07C0 + Color and $07C0; + B := SrcColor and $001F + Color and $001F; + if R > $F800 then + R := $F800; + if G > $07C0 then + G := $07C0; + if B > $001F then + B := $001F; + PUInt16( Addr )^ := R or G or B; + inc( PtrUInt( Addr ), BPP ); + end; + inc( PtrUInt( Addr ), ModX ); + end; + end; + 24 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $00FF0000 + Color and $00FF0000; + G := SrcColor and $0000FF00 + Color and $0000FF00; + B := SrcColor and $000000FF + Color and $000000FF; + if R > $FF0000 then + R := $FF0000; + if G > $00FF00 then + G := $00FF00; + if B > $0000FF then + B := $0000FF; + PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B; + inc( PtrUInt( Addr ), BPP ); + end; + inc( PtrUInt( Addr ), ModX ); + end; + end; + 32 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $00FF0000 + Color and $00FF0000; + G := SrcColor and $0000FF00 + Color and $0000FF00; + B := SrcColor and $000000FF + Color and $000000FF; + if R > $FF0000 then + R := $FF0000; + if G > $00FF00 then + G := $00FF00; + if B > $0000FF then + B := $0000FF; + PUInt32( Addr )^ := R or G or B; + inc( PtrUInt( Addr ), BPP ); + end; + inc( PtrUInt( Addr ), ModX ); + end; + end; + end; + SDL_UnlockSurface( DstSurface ); + end; +end; + +procedure SDL_FillRectSub( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 ); +var + RealRect : TSDL_Rect; + Addr : pointer; + ModX, BPP : cardinal; + x, y, R, G, B, SrcColor : cardinal; +begin + RealRect := ValidateSurfaceRect( DstSurface, DstRect ); + if ( RealRect.w > 0 ) and ( RealRect.h > 0 ) then + begin + SDL_LockSurface( DstSurface ); + BPP := DstSurface.format.BytesPerPixel; + with DstSurface^ do + begin + Addr := pointer( PtrUInt( pixels ) + UInt32( RealRect.y ) * pitch + UInt32( RealRect.x ) * BPP ); + ModX := Pitch - UInt32( RealRect.w ) * BPP; + end; + case DstSurface.format.BitsPerPixel of + 8 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $E0 - Color and $E0; + G := SrcColor and $1C - Color and $1C; + B := SrcColor and $03 - Color and $03; + if R > $E0 then + R := 0; + if G > $1C then + G := 0; + if B > $03 then + B := 0; + PUInt8( Addr )^ := R or G or B; + inc( PtrUInt( Addr ), BPP ); + end; + inc( PtrUInt( Addr ), ModX ); + end; + end; + 15 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $7C00 - Color and $7C00; + G := SrcColor and $03E0 - Color and $03E0; + B := SrcColor and $001F - Color and $001F; + if R > $7C00 then + R := 0; + if G > $03E0 then + G := 0; + if B > $001F then + B := 0; + PUInt16( Addr )^ := R or G or B; + inc( PtrUInt( Addr ), BPP ); + end; + inc( PtrUInt( Addr ), ModX ); + end; + end; + 16 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $F800 - Color and $F800; + G := SrcColor and $07C0 - Color and $07C0; + B := SrcColor and $001F - Color and $001F; + if R > $F800 then + R := 0; + if G > $07C0 then + G := 0; + if B > $001F then + B := 0; + PUInt16( Addr )^ := R or G or B; + inc( PtrUInt( Addr ), BPP ); + end; + inc( PtrUInt( Addr ), ModX ); + end; + end; + 24 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $00FF0000 - Color and $00FF0000; + G := SrcColor and $0000FF00 - Color and $0000FF00; + B := SrcColor and $000000FF - Color and $000000FF; + if R > $FF0000 then + R := 0; + if G > $00FF00 then + G := 0; + if B > $0000FF then + B := 0; + PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B; + inc( PtrUInt( Addr ), BPP ); + end; + inc( PtrUInt( Addr ), ModX ); + end; + end; + 32 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $00FF0000 - Color and $00FF0000; + G := SrcColor and $0000FF00 - Color and $0000FF00; + B := SrcColor and $000000FF - Color and $000000FF; + if R > $FF0000 then + R := 0; + if G > $00FF00 then + G := 0; + if B > $0000FF then + B := 0; + PUInt32( Addr )^ := R or G or B; + inc( PtrUInt( Addr ), BPP ); + end; + inc( PtrUInt( Addr ), ModX ); + end; + end; + end; + SDL_UnlockSurface( DstSurface ); + end; +end; + +procedure SDL_GradientFillRect( DstSurface : PSDL_Surface; const Rect : PSDL_Rect; const StartColor, EndColor : TSDL_Color; const Style : TGradientStyle ); +var + FBC : array[ 0..255 ] of Cardinal; + // temp vars + i, YR, YG, YB, SR, SG, SB, DR, DG, DB : Integer; + + TempStepV, TempStepH : Single; + TempLeft, TempTop, TempHeight, TempWidth : integer; + TempRect : TSDL_Rect; + +begin + // calc FBC + YR := StartColor.r; + YG := StartColor.g; + YB := StartColor.b; + SR := YR; + SG := YG; + SB := YB; + DR := EndColor.r - SR; + DG := EndColor.g - SG; + DB := EndColor.b - SB; + + for i := 0 to 255 do + begin + FBC[ i ] := SDL_MapRGB( DstSurface.format, YR, YG, YB ); + YR := SR + round( DR / 255 * i ); + YG := SG + round( DG / 255 * i ); + YB := SB + round( DB / 255 * i ); + end; + + // if aStyle = 1 then begin + TempStepH := Rect.w / 255; + TempStepV := Rect.h / 255; + TempHeight := Trunc( TempStepV + 1 ); + TempWidth := Trunc( TempStepH + 1 ); + TempTop := 0; + TempLeft := 0; + TempRect.x := Rect.x; + TempRect.y := Rect.y; + TempRect.h := Rect.h; + TempRect.w := Rect.w; + + case Style of + gsHorizontal : + begin + TempRect.h := TempHeight; + for i := 0 to 255 do + begin + TempRect.y := Rect.y + TempTop; + SDL_FillRect( DstSurface, @TempRect, FBC[ i ] ); + TempTop := Trunc( TempStepV * i ); + end; + end; + gsVertical : + begin + TempRect.w := TempWidth; + for i := 0 to 255 do + begin + TempRect.x := Rect.x + TempLeft; + SDL_FillRect( DstSurface, @TempRect, FBC[ i ] ); + TempLeft := Trunc( TempStepH * i ); + end; + end; + end; +end; + +procedure SDL_2xBlit( Src, Dest : PSDL_Surface ); +var + ReadAddr, WriteAddr, ReadRow, WriteRow : PtrUInt; + SrcPitch, DestPitch, x, y : UInt32; +begin + if ( Src = nil ) or ( Dest = nil ) then + exit; + if ( Src.w shl 1 ) < Dest.w then + exit; + if ( Src.h shl 1 ) < Dest.h then + exit; + + if SDL_MustLock( Src ) then + SDL_LockSurface( Src ); + if SDL_MustLock( Dest ) then + SDL_LockSurface( Dest ); + + ReadRow := PtrUInt( Src.Pixels ); + WriteRow := PtrUInt( Dest.Pixels ); + + SrcPitch := Src.pitch; + DestPitch := Dest.pitch; + + case Src.format.BytesPerPixel of + 1 : for y := 1 to Src.h do + begin + ReadAddr := ReadRow; + WriteAddr := WriteRow; + for x := 1 to Src.w do + begin + PUInt8( WriteAddr )^ := PUInt8( ReadAddr )^; + PUInt8( WriteAddr + 1 )^ := PUInt8( ReadAddr )^; + PUInt8( WriteAddr + DestPitch )^ := PUInt8( ReadAddr )^; + PUInt8( WriteAddr + DestPitch + 1 )^ := PUInt8( ReadAddr )^; + inc( ReadAddr ); + inc( WriteAddr, 2 ); + end; + inc( PtrUInt( ReadRow ), SrcPitch ); + inc( PtrUInt( WriteRow ), DestPitch * 2 ); + end; + 2 : for y := 1 to Src.h do + begin + ReadAddr := ReadRow; + WriteAddr := WriteRow; + for x := 1 to Src.w do + begin + PUInt16( WriteAddr )^ := PUInt16( ReadAddr )^; + PUInt16( WriteAddr + 2 )^ := PUInt16( ReadAddr )^; + PUInt16( WriteAddr + DestPitch )^ := PUInt16( ReadAddr )^; + PUInt16( WriteAddr + DestPitch + 2 )^ := PUInt16( ReadAddr )^; + inc( ReadAddr, 2 ); + inc( WriteAddr, 4 ); + end; + inc( PtrUInt( ReadRow ), SrcPitch ); + inc( PtrUInt( WriteRow ), DestPitch * 2 ); + end; + 3 : for y := 1 to Src.h do + begin + ReadAddr := ReadRow; + WriteAddr := WriteRow; + for x := 1 to Src.w do + begin + PUInt32( WriteAddr )^ := ( PUInt32( WriteAddr )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF ); + PUInt32( WriteAddr + 3 )^ := ( PUInt32( WriteAddr + 3 )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF ); + PUInt32( WriteAddr + DestPitch )^ := ( PUInt32( WriteAddr + DestPitch )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF ); + PUInt32( WriteAddr + DestPitch + 3 )^ := ( PUInt32( WriteAddr + DestPitch + 3 )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF ); + inc( ReadAddr, 3 ); + inc( WriteAddr, 6 ); + end; + inc( PtrUInt( ReadRow ), SrcPitch ); + inc( PtrUInt( WriteRow ), DestPitch * 2 ); + end; + 4 : for y := 1 to Src.h do + begin + ReadAddr := ReadRow; + WriteAddr := WriteRow; + for x := 1 to Src.w do + begin + PUInt32( WriteAddr )^ := PUInt32( ReadAddr )^; + PUInt32( WriteAddr + 4 )^ := PUInt32( ReadAddr )^; + PUInt32( WriteAddr + DestPitch )^ := PUInt32( ReadAddr )^; + PUInt32( WriteAddr + DestPitch + 4 )^ := PUInt32( ReadAddr )^; + inc( ReadAddr, 4 ); + inc( WriteAddr, 8 ); + end; + inc( PtrUInt( ReadRow ), SrcPitch ); + inc( PtrUInt( WriteRow ), DestPitch * 2 ); + end; + end; + + if SDL_MustLock( Src ) then + SDL_UnlockSurface( Src ); + if SDL_MustLock( Dest ) then + SDL_UnlockSurface( Dest ); +end; + +procedure SDL_Scanline2xBlit( Src, Dest : PSDL_Surface ); +var + ReadAddr, WriteAddr, ReadRow, WriteRow : PtrUInt; + SrcPitch, DestPitch, x, y : UInt32; +begin + if ( Src = nil ) or ( Dest = nil ) then + exit; + if ( Src.w shl 1 ) < Dest.w then + exit; + if ( Src.h shl 1 ) < Dest.h then + exit; + + if SDL_MustLock( Src ) then + SDL_LockSurface( Src ); + if SDL_MustLock( Dest ) then + SDL_LockSurface( Dest ); + + ReadRow := PtrUInt( Src.Pixels ); + WriteRow := PtrUInt( Dest.Pixels ); + + SrcPitch := Src.pitch; + DestPitch := Dest.pitch; + + case Src.format.BytesPerPixel of + 1 : for y := 1 to Src.h do + begin + ReadAddr := ReadRow; + WriteAddr := WriteRow; + for x := 1 to Src.w do + begin + PUInt8( WriteAddr )^ := PUInt8( ReadAddr )^; + PUInt8( WriteAddr + 1 )^ := PUInt8( ReadAddr )^; + inc( ReadAddr ); + inc( WriteAddr, 2 ); + end; + inc( PtrUInt( ReadRow ), SrcPitch ); + inc( PtrUInt( WriteRow ), DestPitch * 2 ); + end; + 2 : for y := 1 to Src.h do + begin + ReadAddr := ReadRow; + WriteAddr := WriteRow; + for x := 1 to Src.w do + begin + PUInt16( WriteAddr )^ := PUInt16( ReadAddr )^; + PUInt16( WriteAddr + 2 )^ := PUInt16( ReadAddr )^; + inc( ReadAddr, 2 ); + inc( WriteAddr, 4 ); + end; + inc( PtrUInt( ReadRow ), SrcPitch ); + inc( PtrUInt( WriteRow ), DestPitch * 2 ); + end; + 3 : for y := 1 to Src.h do + begin + ReadAddr := ReadRow; + WriteAddr := WriteRow; + for x := 1 to Src.w do + begin + PUInt32( WriteAddr )^ := ( PUInt32( WriteAddr )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF ); + PUInt32( WriteAddr + 3 )^ := ( PUInt32( WriteAddr + 3 )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF ); + inc( ReadAddr, 3 ); + inc( WriteAddr, 6 ); + end; + inc( PtrUInt( ReadRow ), SrcPitch ); + inc( PtrUInt( WriteRow ), DestPitch * 2 ); + end; + 4 : for y := 1 to Src.h do + begin + ReadAddr := ReadRow; + WriteAddr := WriteRow; + for x := 1 to Src.w do + begin + PUInt32( WriteAddr )^ := PUInt32( ReadAddr )^; + PUInt32( WriteAddr + 4 )^ := PUInt32( ReadAddr )^; + inc( ReadAddr, 4 ); + inc( WriteAddr, 8 ); + end; + inc( PtrUInt( ReadRow ), SrcPitch ); + inc( PtrUInt( WriteRow ), DestPitch * 2 ); + end; + end; + + if SDL_MustLock( Src ) then + SDL_UnlockSurface( Src ); + if SDL_MustLock( Dest ) then + SDL_UnlockSurface( Dest ); +end; + +procedure SDL_50Scanline2xBlit( Src, Dest : PSDL_Surface ); +var + ReadAddr, WriteAddr, ReadRow, WriteRow : PtrUInt; + SrcPitch, DestPitch, x, y, Color : UInt32; +begin + if ( Src = nil ) or ( Dest = nil ) then + exit; + if ( Src.w shl 1 ) < Dest.w then + exit; + if ( Src.h shl 1 ) < Dest.h then + exit; + + if SDL_MustLock( Src ) then + SDL_LockSurface( Src ); + if SDL_MustLock( Dest ) then + SDL_LockSurface( Dest ); + + ReadRow := PtrUInt( Src.Pixels ); + WriteRow := PtrUInt( Dest.Pixels ); + + SrcPitch := Src.pitch; + DestPitch := Dest.pitch; + + case Src.format.BitsPerPixel of + 8 : for y := 1 to Src.h do + begin + ReadAddr := ReadRow; + WriteAddr := WriteRow; + for x := 1 to Src.w do + begin + Color := PUInt8( ReadAddr )^; + PUInt8( WriteAddr )^ := Color; + PUInt8( WriteAddr + 1 )^ := Color; + Color := ( Color shr 1 ) and $6D; {%01101101} + PUInt8( WriteAddr + DestPitch )^ := Color; + PUInt8( WriteAddr + DestPitch + 1 )^ := Color; + inc( ReadAddr ); + inc( WriteAddr, 2 ); + end; + inc( PtrUInt( ReadRow ), SrcPitch ); + inc( PtrUInt( WriteRow ), DestPitch * 2 ); + end; + 15 : for y := 1 to Src.h do + begin + ReadAddr := ReadRow; + WriteAddr := WriteRow; + for x := 1 to Src.w do + begin + Color := PUInt16( ReadAddr )^; + PUInt16( WriteAddr )^ := Color; + PUInt16( WriteAddr + 2 )^ := Color; + Color := ( Color shr 1 ) and $3DEF; {%0011110111101111} + PUInt16( WriteAddr + DestPitch )^ := Color; + PUInt16( WriteAddr + DestPitch + 2 )^ := Color; + inc( ReadAddr, 2 ); + inc( WriteAddr, 4 ); + end; + inc( PtrUInt( ReadRow ), SrcPitch ); + inc( PtrUInt( WriteRow ), DestPitch * 2 ); + end; + 16 : for y := 1 to Src.h do + begin + ReadAddr := ReadRow; + WriteAddr := WriteRow; + for x := 1 to Src.w do + begin + Color := PUInt16( ReadAddr )^; + PUInt16( WriteAddr )^ := Color; + PUInt16( WriteAddr + 2 )^ := Color; + Color := ( Color shr 1 ) and $7BEF; {%0111101111101111} + PUInt16( WriteAddr + DestPitch )^ := Color; + PUInt16( WriteAddr + DestPitch + 2 )^ := Color; + inc( ReadAddr, 2 ); + inc( WriteAddr, 4 ); + end; + inc( PtrUInt( ReadRow ), SrcPitch ); + inc( PtrUInt( WriteRow ), DestPitch * 2 ); + end; + 24 : for y := 1 to Src.h do + begin + ReadAddr := ReadRow; + WriteAddr := WriteRow; + for x := 1 to Src.w do + begin + Color := ( PUInt32( WriteAddr )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF ); + PUInt32( WriteAddr )^ := Color; + PUInt32( WriteAddr + 3 )^ := Color; + Color := ( Color shr 1 ) and $007F7F7F; {%011111110111111101111111} + PUInt32( WriteAddr + DestPitch )^ := Color; + PUInt32( WriteAddr + DestPitch + 3 )^ := Color; + inc( ReadAddr, 3 ); + inc( WriteAddr, 6 ); + end; + inc( PtrUInt( ReadRow ), SrcPitch ); + inc( PtrUInt( WriteRow ), DestPitch * 2 ); + end; + 32 : for y := 1 to Src.h do + begin + ReadAddr := ReadRow; + WriteAddr := WriteRow; + for x := 1 to Src.w do + begin + Color := PUInt32( ReadAddr )^; + PUInt32( WriteAddr )^ := Color; + PUInt32( WriteAddr + 4 )^ := Color; + Color := ( Color shr 1 ) and $7F7F7F7F; + PUInt32( WriteAddr + DestPitch )^ := Color; + PUInt32( WriteAddr + DestPitch + 4 )^ := Color; + inc( ReadAddr, 4 ); + inc( WriteAddr, 8 ); + end; + inc( PtrUInt( ReadRow ), SrcPitch ); + inc( PtrUInt( WriteRow ), DestPitch * 2 ); + end; + end; + + if SDL_MustLock( Src ) then + SDL_UnlockSurface( Src ); + if SDL_MustLock( Dest ) then + SDL_UnlockSurface( Dest ); +end; + +function SDL_PixelTestSurfaceVsRect( SrcSurface1 : PSDL_Surface; SrcRect1 : + PSDL_Rect; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : + boolean; +var + Src_Rect1, Src_Rect2 : TSDL_Rect; + right1, bottom1 : integer; + right2, bottom2 : integer; + Scan1Start, {Scan2Start,} ScanWidth, ScanHeight : cardinal; + Mod1 : cardinal; + Addr1 : PtrUInt; + BPP : cardinal; + Pitch1 : cardinal; + TransparentColor1 : cardinal; + tx, ty : cardinal; +// StartTick : cardinal; // Auto Removed, Unused Variable + Color1 : cardinal; +begin + Result := false; + if SrcRect1 = nil then + begin + with Src_Rect1 do + begin + x := 0; + y := 0; + w := SrcSurface1.w; + h := SrcSurface1.h; + end; + end + else + Src_Rect1 := SrcRect1^; + + Src_Rect2 := SrcRect2^; + with Src_Rect1 do + begin + Right1 := Left1 + w; + Bottom1 := Top1 + h; + end; + with Src_Rect2 do + begin + Right2 := Left2 + w; + Bottom2 := Top2 + h; + end; + if ( Left1 >= Right2 ) or ( Right1 <= Left2 ) or ( Top1 >= Bottom2 ) or ( Bottom1 <= Top2 ) then + exit; + if Left1 <= Left2 then + begin + // 1. left, 2. right + Scan1Start := Src_Rect1.x + Left2 - Left1; + //Scan2Start := Src_Rect2.x; + ScanWidth := Right1 - Left2; + with Src_Rect2 do + if ScanWidth > w then + ScanWidth := w; + end + else + begin + // 1. right, 2. left + Scan1Start := Src_Rect1.x; + //Scan2Start := Src_Rect2.x + Left1 - Left2; + ScanWidth := Right2 - Left1; + with Src_Rect1 do + if ScanWidth > w then + ScanWidth := w; + end; + with SrcSurface1^ do + begin + Pitch1 := Pitch; + Addr1 := PtrUInt( Pixels ); + inc( Addr1, Pitch1 * UInt32( Src_Rect1.y ) ); + with format^ do + begin + BPP := BytesPerPixel; + TransparentColor1 := colorkey; + end; + end; + + Mod1 := Pitch1 - ( ScanWidth * BPP ); + + inc( Addr1, BPP * Scan1Start ); + + if Top1 <= Top2 then + begin + // 1. up, 2. down + ScanHeight := Bottom1 - Top2; + if ScanHeight > Src_Rect2.h then + ScanHeight := Src_Rect2.h; + inc( Addr1, Pitch1 * UInt32( Top2 - Top1 ) ); + end + else + begin + // 1. down, 2. up + ScanHeight := Bottom2 - Top1; + if ScanHeight > Src_Rect1.h then + ScanHeight := Src_Rect1.h; + + end; + case BPP of + 1 : + for ty := 1 to ScanHeight do + begin + for tx := 1 to ScanWidth do + begin + if ( PByte( Addr1 )^ <> TransparentColor1 ) then + begin + Result := true; + exit; + end; + inc( Addr1 ); + + end; + inc( Addr1, Mod1 ); + + end; + 2 : + for ty := 1 to ScanHeight do + begin + for tx := 1 to ScanWidth do + begin + if ( PWord( Addr1 )^ <> TransparentColor1 ) then + begin + Result := true; + exit; + end; + inc( Addr1, 2 ); + + end; + inc( Addr1, Mod1 ); + + end; + 3 : + for ty := 1 to ScanHeight do + begin + for tx := 1 to ScanWidth do + begin + Color1 := PLongWord( Addr1 )^ and $00FFFFFF; + + if ( Color1 <> TransparentColor1 ) + then + begin + Result := true; + exit; + end; + inc( Addr1, 3 ); + + end; + inc( Addr1, Mod1 ); + + end; + 4 : + for ty := 1 to ScanHeight do + begin + for tx := 1 to ScanWidth do + begin + if ( PLongWord( Addr1 )^ <> TransparentColor1 ) then + begin + Result := true; + exit; + end; + inc( Addr1, 4 ); + + end; + inc( Addr1, Mod1 ); + + end; + end; +end; + +procedure SDL_ORSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); +var +{*R, *}{*G, *}{*B, *}Pixel1, Pixel2, TransparentColor : cardinal; // Auto Removed, Unused Variable (R) // Auto Removed, Unused Variable (G) // Auto Removed, Unused Variable (B) + Src, Dest : TSDL_Rect; + Diff : integer; + SrcAddr, DestAddr : PtrUInt; + WorkX, WorkY : word; + SrcMod, DestMod : cardinal; + Bits : cardinal; +begin + if ( SrcSurface = nil ) or ( DestSurface = nil ) then + exit; // Remove this to make it faster + if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then + exit; // Remove this to make it faster + if SrcRect = nil then + begin + with Src do + begin + x := 0; + y := 0; + w := SrcSurface.w; + h := SrcSurface.h; + end; + end + else + Src := SrcRect^; + if DestRect = nil then + begin + Dest.x := 0; + Dest.y := 0; + end + else + Dest := DestRect^; + Dest.w := Src.w; + Dest.h := Src.h; + with DestSurface.Clip_Rect do + begin + // Source's right side is greater than the dest.cliprect + if Dest.x + Src.w > x + w then + begin + smallint( Src.w ) := x + w - Dest.x; + smallint( Dest.w ) := x + w - Dest.x; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's bottom side is greater than the dest.clip + if Dest.y + Src.h > y + h then + begin + smallint( Src.h ) := y + h - Dest.y; + smallint( Dest.h ) := y + h - Dest.y; + if smallint( Dest.h ) < 1 then + exit; + end; + // Source's left side is less than the dest.clip + if Dest.x < x then + begin + Diff := x - Dest.x; + Src.x := Src.x + Diff; + smallint( Src.w ) := smallint( Src.w ) - Diff; + Dest.x := x; + smallint( Dest.w ) := smallint( Dest.w ) - Diff; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's Top side is less than the dest.clip + if Dest.y < y then + begin + Diff := y - Dest.y; + Src.y := Src.y + Diff; + smallint( Src.h ) := smallint( Src.h ) - Diff; + Dest.y := y; + smallint( Dest.h ) := smallint( Dest.h ) - Diff; + if smallint( Dest.h ) < 1 then + exit; + end; + end; + with SrcSurface^ do + begin + SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) * + Format.BytesPerPixel; + SrcMod := Pitch - Src.w * Format.BytesPerPixel; + TransparentColor := Format.colorkey; + end; + with DestSurface^ do + begin + DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) * + Format.BytesPerPixel; + DestMod := Pitch - Dest.w * Format.BytesPerPixel; + Bits := Format.BitsPerPixel; + end; + SDL_LockSurface( SrcSurface ); + SDL_LockSurface( DestSurface ); + WorkY := Src.h; + case bits of + 8 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt8( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt8( DestAddr )^; + PUInt8( DestAddr )^ := Pixel2 or Pixel1; + end; + inc( SrcAddr ); + inc( DestAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 15 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + + PUInt16( DestAddr )^ := Pixel2 or Pixel1; + + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 16 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + + PUInt16( DestAddr )^ := Pixel2 or Pixel1; + + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 24 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF; + + PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel2 or Pixel1; + end; + inc( SrcAddr, 3 ); + inc( DestAddr, 3 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 32 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^; + + PUInt32( DestAddr )^ := Pixel2 or Pixel1; + end; + inc( SrcAddr, 4 ); + inc( DestAddr, 4 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + end; + SDL_UnlockSurface( SrcSurface ); + SDL_UnlockSurface( DestSurface ); +end; + +procedure SDL_ANDSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); +var +{*R, *}{*G, *}{*B, *}Pixel1, Pixel2, TransparentColor : cardinal; // Auto Removed, Unused Variable (R) // Auto Removed, Unused Variable (G) // Auto Removed, Unused Variable (B) + Src, Dest : TSDL_Rect; + Diff : integer; + SrcAddr, DestAddr : PtrUInt; + WorkX, WorkY : word; + SrcMod, DestMod : cardinal; + Bits : cardinal; +begin + if ( SrcSurface = nil ) or ( DestSurface = nil ) then + exit; // Remove this to make it faster + if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then + exit; // Remove this to make it faster + if SrcRect = nil then + begin + with Src do + begin + x := 0; + y := 0; + w := SrcSurface.w; + h := SrcSurface.h; + end; + end + else + Src := SrcRect^; + if DestRect = nil then + begin + Dest.x := 0; + Dest.y := 0; + end + else + Dest := DestRect^; + Dest.w := Src.w; + Dest.h := Src.h; + with DestSurface.Clip_Rect do + begin + // Source's right side is greater than the dest.cliprect + if Dest.x + Src.w > x + w then + begin + smallint( Src.w ) := x + w - Dest.x; + smallint( Dest.w ) := x + w - Dest.x; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's bottom side is greater than the dest.clip + if Dest.y + Src.h > y + h then + begin + smallint( Src.h ) := y + h - Dest.y; + smallint( Dest.h ) := y + h - Dest.y; + if smallint( Dest.h ) < 1 then + exit; + end; + // Source's left side is less than the dest.clip + if Dest.x < x then + begin + Diff := x - Dest.x; + Src.x := Src.x + Diff; + smallint( Src.w ) := smallint( Src.w ) - Diff; + Dest.x := x; + smallint( Dest.w ) := smallint( Dest.w ) - Diff; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's Top side is less than the dest.clip + if Dest.y < y then + begin + Diff := y - Dest.y; + Src.y := Src.y + Diff; + smallint( Src.h ) := smallint( Src.h ) - Diff; + Dest.y := y; + smallint( Dest.h ) := smallint( Dest.h ) - Diff; + if smallint( Dest.h ) < 1 then + exit; + end; + end; + with SrcSurface^ do + begin + SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) * + Format.BytesPerPixel; + SrcMod := Pitch - Src.w * Format.BytesPerPixel; + TransparentColor := Format.colorkey; + end; + with DestSurface^ do + begin + DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) * + Format.BytesPerPixel; + DestMod := Pitch - Dest.w * Format.BytesPerPixel; + Bits := Format.BitsPerPixel; + end; + SDL_LockSurface( SrcSurface ); + SDL_LockSurface( DestSurface ); + WorkY := Src.h; + case bits of + 8 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt8( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt8( DestAddr )^; + PUInt8( DestAddr )^ := Pixel2 and Pixel1; + end; + inc( SrcAddr ); + inc( DestAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 15 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + + PUInt16( DestAddr )^ := Pixel2 and Pixel1; + + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 16 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + + PUInt16( DestAddr )^ := Pixel2 and Pixel1; + + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 24 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF; + + PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel2 and Pixel1; + end; + inc( SrcAddr, 3 ); + inc( DestAddr, 3 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 32 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^; + + PUInt32( DestAddr )^ := Pixel2 and Pixel1; + end; + inc( SrcAddr, 4 ); + inc( DestAddr, 4 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + end; + SDL_UnlockSurface( SrcSurface ); + SDL_UnlockSurface( DestSurface ); +end; + + + +procedure SDL_GTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); +var + R, G, B, Pixel1, Pixel2, TransparentColor : cardinal; + Src, Dest : TSDL_Rect; + Diff : integer; + SrcAddr, DestAddr : PtrUInt; + WorkX, WorkY : word; + SrcMod, DestMod : cardinal; + Bits : cardinal; +begin + if ( SrcSurface = nil ) or ( DestSurface = nil ) then + exit; // Remove this to make it faster + if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then + exit; // Remove this to make it faster + if SrcRect = nil then + begin + with Src do + begin + x := 0; + y := 0; + w := SrcSurface.w; + h := SrcSurface.h; + end; + end + else + Src := SrcRect^; + if DestRect = nil then + begin + Dest.x := 0; + Dest.y := 0; + end + else + Dest := DestRect^; + Dest.w := Src.w; + Dest.h := Src.h; + with DestSurface.Clip_Rect do + begin + // Source's right side is greater than the dest.cliprect + if Dest.x + Src.w > x + w then + begin + smallint( Src.w ) := x + w - Dest.x; + smallint( Dest.w ) := x + w - Dest.x; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's bottom side is greater than the dest.clip + if Dest.y + Src.h > y + h then + begin + smallint( Src.h ) := y + h - Dest.y; + smallint( Dest.h ) := y + h - Dest.y; + if smallint( Dest.h ) < 1 then + exit; + end; + // Source's left side is less than the dest.clip + if Dest.x < x then + begin + Diff := x - Dest.x; + Src.x := Src.x + Diff; + smallint( Src.w ) := smallint( Src.w ) - Diff; + Dest.x := x; + smallint( Dest.w ) := smallint( Dest.w ) - Diff; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's Top side is less than the dest.clip + if Dest.y < y then + begin + Diff := y - Dest.y; + Src.y := Src.y + Diff; + smallint( Src.h ) := smallint( Src.h ) - Diff; + Dest.y := y; + smallint( Dest.h ) := smallint( Dest.h ) - Diff; + if smallint( Dest.h ) < 1 then + exit; + end; + end; + with SrcSurface^ do + begin + SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) * + Format.BytesPerPixel; + SrcMod := Pitch - Src.w * Format.BytesPerPixel; + TransparentColor := Format.colorkey; + end; + with DestSurface^ do + begin + DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) * + Format.BytesPerPixel; + DestMod := Pitch - Dest.w * Format.BytesPerPixel; + Bits := Format.BitsPerPixel; + end; + SDL_LockSurface( SrcSurface ); + SDL_LockSurface( DestSurface ); + WorkY := Src.h; + case bits of + 8 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt8( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt8( DestAddr )^; + if Pixel2 > 0 then + begin + if Pixel2 and $E0 > Pixel1 and $E0 then + R := Pixel2 and $E0 + else + R := Pixel1 and $E0; + if Pixel2 and $1C > Pixel1 and $1C then + G := Pixel2 and $1C + else + G := Pixel1 and $1C; + if Pixel2 and $03 > Pixel1 and $03 then + B := Pixel2 and $03 + else + B := Pixel1 and $03; + + if R > $E0 then + R := $E0; + if G > $1C then + G := $1C; + if B > $03 then + B := $03; + PUInt8( DestAddr )^ := R or G or B; + end + else + PUInt8( DestAddr )^ := Pixel1; + end; + inc( SrcAddr ); + inc( DestAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 15 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + if Pixel2 > 0 then + begin + + if Pixel2 and $7C00 > Pixel1 and $7C00 then + R := Pixel2 and $7C00 + else + R := Pixel1 and $7C00; + if Pixel2 and $03E0 > Pixel1 and $03E0 then + G := Pixel2 and $03E0 + else + G := Pixel1 and $03E0; + if Pixel2 and $001F > Pixel1 and $001F then + B := Pixel2 and $001F + else + B := Pixel1 and $001F; + + PUInt16( DestAddr )^ := R or G or B; + end + else + PUInt16( DestAddr )^ := Pixel1; + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 16 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + if Pixel2 > 0 then + begin + + if Pixel2 and $F800 > Pixel1 and $F800 then + R := Pixel2 and $F800 + else + R := Pixel1 and $F800; + if Pixel2 and $07E0 > Pixel1 and $07E0 then + G := Pixel2 and $07E0 + else + G := Pixel1 and $07E0; + if Pixel2 and $001F > Pixel1 and $001F then + B := Pixel2 and $001F + else + B := Pixel1 and $001F; + + PUInt16( DestAddr )^ := R or G or B; + end + else + PUInt16( DestAddr )^ := Pixel1; + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 24 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF; + if Pixel2 > 0 then + begin + + if Pixel2 and $FF0000 > Pixel1 and $FF0000 then + R := Pixel2 and $FF0000 + else + R := Pixel1 and $FF0000; + if Pixel2 and $00FF00 > Pixel1 and $00FF00 then + G := Pixel2 and $00FF00 + else + G := Pixel1 and $00FF00; + if Pixel2 and $0000FF > Pixel1 and $0000FF then + B := Pixel2 and $0000FF + else + B := Pixel1 and $0000FF; + + PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B ); + end + else + PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1; + end; + inc( SrcAddr, 3 ); + inc( DestAddr, 3 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 32 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^; + if Pixel2 > 0 then + begin + + if Pixel2 and $FF0000 > Pixel1 and $FF0000 then + R := Pixel2 and $FF0000 + else + R := Pixel1 and $FF0000; + if Pixel2 and $00FF00 > Pixel1 and $00FF00 then + G := Pixel2 and $00FF00 + else + G := Pixel1 and $00FF00; + if Pixel2 and $0000FF > Pixel1 and $0000FF then + B := Pixel2 and $0000FF + else + B := Pixel1 and $0000FF; + + PUInt32( DestAddr )^ := R or G or B; + end + else + PUInt32( DestAddr )^ := Pixel1; + end; + inc( SrcAddr, 4 ); + inc( DestAddr, 4 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + end; + SDL_UnlockSurface( SrcSurface ); + SDL_UnlockSurface( DestSurface ); +end; + + +procedure SDL_LTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); +var + R, G, B, Pixel1, Pixel2, TransparentColor : cardinal; + Src, Dest : TSDL_Rect; + Diff : integer; + SrcAddr, DestAddr : PtrUInt; + WorkX, WorkY : word; + SrcMod, DestMod : cardinal; + Bits : cardinal; +begin + if ( SrcSurface = nil ) or ( DestSurface = nil ) then + exit; // Remove this to make it faster + if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then + exit; // Remove this to make it faster + if SrcRect = nil then + begin + with Src do + begin + x := 0; + y := 0; + w := SrcSurface.w; + h := SrcSurface.h; + end; + end + else + Src := SrcRect^; + if DestRect = nil then + begin + Dest.x := 0; + Dest.y := 0; + end + else + Dest := DestRect^; + Dest.w := Src.w; + Dest.h := Src.h; + with DestSurface.Clip_Rect do + begin + // Source's right side is greater than the dest.cliprect + if Dest.x + Src.w > x + w then + begin + smallint( Src.w ) := x + w - Dest.x; + smallint( Dest.w ) := x + w - Dest.x; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's bottom side is greater than the dest.clip + if Dest.y + Src.h > y + h then + begin + smallint( Src.h ) := y + h - Dest.y; + smallint( Dest.h ) := y + h - Dest.y; + if smallint( Dest.h ) < 1 then + exit; + end; + // Source's left side is less than the dest.clip + if Dest.x < x then + begin + Diff := x - Dest.x; + Src.x := Src.x + Diff; + smallint( Src.w ) := smallint( Src.w ) - Diff; + Dest.x := x; + smallint( Dest.w ) := smallint( Dest.w ) - Diff; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's Top side is less than the dest.clip + if Dest.y < y then + begin + Diff := y - Dest.y; + Src.y := Src.y + Diff; + smallint( Src.h ) := smallint( Src.h ) - Diff; + Dest.y := y; + smallint( Dest.h ) := smallint( Dest.h ) - Diff; + if smallint( Dest.h ) < 1 then + exit; + end; + end; + with SrcSurface^ do + begin + SrcAddr := PtrUInt( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) * + Format.BytesPerPixel; + SrcMod := Pitch - Src.w * Format.BytesPerPixel; + TransparentColor := Format.colorkey; + end; + with DestSurface^ do + begin + DestAddr := PtrUInt( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) * + Format.BytesPerPixel; + DestMod := Pitch - Dest.w * Format.BytesPerPixel; + Bits := Format.BitsPerPixel; + end; + SDL_LockSurface( SrcSurface ); + SDL_LockSurface( DestSurface ); + WorkY := Src.h; + case bits of + 8 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt8( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt8( DestAddr )^; + if Pixel2 > 0 then + begin + if Pixel2 and $E0 < Pixel1 and $E0 then + R := Pixel2 and $E0 + else + R := Pixel1 and $E0; + if Pixel2 and $1C < Pixel1 and $1C then + G := Pixel2 and $1C + else + G := Pixel1 and $1C; + if Pixel2 and $03 < Pixel1 and $03 then + B := Pixel2 and $03 + else + B := Pixel1 and $03; + + if R > $E0 then + R := $E0; + if G > $1C then + G := $1C; + if B > $03 then + B := $03; + PUInt8( DestAddr )^ := R or G or B; + end + else + PUInt8( DestAddr )^ := Pixel1; + end; + inc( SrcAddr ); + inc( DestAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 15 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + if Pixel2 > 0 then + begin + + if Pixel2 and $7C00 < Pixel1 and $7C00 then + R := Pixel2 and $7C00 + else + R := Pixel1 and $7C00; + if Pixel2 and $03E0 < Pixel1 and $03E0 then + G := Pixel2 and $03E0 + else + G := Pixel1 and $03E0; + if Pixel2 and $001F < Pixel1 and $001F then + B := Pixel2 and $001F + else + B := Pixel1 and $001F; + + PUInt16( DestAddr )^ := R or G or B; + end + else + PUInt16( DestAddr )^ := Pixel1; + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 16 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + if Pixel2 > 0 then + begin + + if Pixel2 and $F800 < Pixel1 and $F800 then + R := Pixel2 and $F800 + else + R := Pixel1 and $F800; + if Pixel2 and $07E0 < Pixel1 and $07E0 then + G := Pixel2 and $07E0 + else + G := Pixel1 and $07E0; + if Pixel2 and $001F < Pixel1 and $001F then + B := Pixel2 and $001F + else + B := Pixel1 and $001F; + + PUInt16( DestAddr )^ := R or G or B; + end + else + PUInt16( DestAddr )^ := Pixel1; + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 24 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF; + if Pixel2 > 0 then + begin + + if Pixel2 and $FF0000 < Pixel1 and $FF0000 then + R := Pixel2 and $FF0000 + else + R := Pixel1 and $FF0000; + if Pixel2 and $00FF00 < Pixel1 and $00FF00 then + G := Pixel2 and $00FF00 + else + G := Pixel1 and $00FF00; + if Pixel2 and $0000FF < Pixel1 and $0000FF then + B := Pixel2 and $0000FF + else + B := Pixel1 and $0000FF; + + PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B ); + end + else + PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1; + end; + inc( SrcAddr, 3 ); + inc( DestAddr, 3 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 32 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^; + if Pixel2 > 0 then + begin + + if Pixel2 and $FF0000 < Pixel1 and $FF0000 then + R := Pixel2 and $FF0000 + else + R := Pixel1 and $FF0000; + if Pixel2 and $00FF00 < Pixel1 and $00FF00 then + G := Pixel2 and $00FF00 + else + G := Pixel1 and $00FF00; + if Pixel2 and $0000FF < Pixel1 and $0000FF then + B := Pixel2 and $0000FF + else + B := Pixel1 and $0000FF; + + PUInt32( DestAddr )^ := R or G or B; + end + else + PUInt32( DestAddr )^ := Pixel1; + end; + inc( SrcAddr, 4 ); + inc( DestAddr, 4 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + end; + SDL_UnlockSurface( SrcSurface ); + SDL_UnlockSurface( DestSurface ); +end; + +// Will clip the x1,x2,y1,x2 params to the ClipRect provided + +function SDL_ClipLine( var x1, y1, x2, y2 : Integer; ClipRect : PSDL_Rect ) : boolean; +var + tflag, flag1, flag2 : word; + txy, xedge, yedge : Integer; + slope : single; + + function ClipCode( x, y : Integer ) : word; + begin + Result := 0; + if x < ClipRect.x then + Result := 1; + if x >= ClipRect.w + ClipRect.x then + Result := Result or 2; + if y < ClipRect.y then + Result := Result or 4; + if y >= ClipRect.h + ClipRect.y then + Result := Result or 8; + end; + +begin + flag1 := ClipCode( x1, y1 ); + flag2 := ClipCode( x2, y2 ); + result := true; + + while true do + begin + if ( flag1 or flag2 ) = 0 then + Exit; // all in + + if ( flag1 and flag2 ) <> 0 then + begin + result := false; + Exit; // all out + end; + + if flag2 = 0 then + begin + txy := x1; x1 := x2; x2 := txy; + txy := y1; y1 := y2; y2 := txy; + tflag := flag1; flag1 := flag2; flag2 := tflag; + end; + + if ( flag2 and 3 ) <> 0 then + begin + if ( flag2 and 1 ) <> 0 then + xedge := ClipRect.x + else + xedge := ClipRect.w + ClipRect.x - 1; // back 1 pixel otherwise we end up in a loop + + slope := ( y2 - y1 ) / ( x2 - x1 ); + y2 := y1 + Round( slope * ( xedge - x1 ) ); + x2 := xedge; + end + else + begin + if ( flag2 and 4 ) <> 0 then + yedge := ClipRect.y + else + yedge := ClipRect.h + ClipRect.y - 1; // up 1 pixel otherwise we end up in a loop + + slope := ( x2 - x1 ) / ( y2 - y1 ); + x2 := x1 + Round( slope * ( yedge - y1 ) ); + y2 := yedge; + end; + + flag2 := ClipCode( x2, y2 ); + end; +end; + +end. + diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlwindow.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlwindow.pas index ba60714b..99eea304 100644 --- a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlwindow.pas +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlwindow.pas @@ -1,566 +1,566 @@ -unit sdlwindow;
-{
- $Id: sdlwindow.pas,v 1.9 2006/10/22 18:55:25 savage Exp $
-
-}
-{******************************************************************************}
-{ }
-{ JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer }
-{ SDL Window Wrapper }
-{ }
-{ }
-{ The initial developer of this Pascal code was : }
-{ Dominique Louis <Dominique@SavageSoftware.com.au> }
-{ }
-{ Portions created by Dominique Louis are }
-{ Copyright (C) 2004 - 2100 Dominique Louis. }
-{ }
-{ }
-{ Contributor(s) }
-{ -------------- }
-{ Dominique Louis <Dominique@SavageSoftware.com.au> }
-{ }
-{ Obtained through: }
-{ Joint Endeavour of Delphi Innovators ( Project JEDI ) }
-{ }
-{ You may retrieve the latest version of this file at the Project }
-{ JEDI home page, located at http://delphi-jedi.org }
-{ }
-{ The contents of this file are used with permission, subject to }
-{ the Mozilla Public License Version 1.1 (the "License"); you may }
-{ not use this file except in compliance with the License. You may }
-{ obtain a copy of the License at }
-{ http://www.mozilla.org/MPL/MPL-1.1.html }
-{ }
-{ Software distributed under the License is distributed on an }
-{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or }
-{ implied. See the License for the specific language governing }
-{ rights and limitations under the License. }
-{ }
-{ Description }
-{ ----------- }
-{ SDL Window Wrapper }
-{ }
-{ }
-{ Requires }
-{ -------- }
-{ SDL.dll on Windows platforms }
-{ libSDL-1.1.so.0 on Linux platform }
-{ }
-{ Programming Notes }
-{ ----------------- }
-{ }
-{ }
-{ }
-{ }
-{ Revision History }
-{ ---------------- }
-{ January 31 2003 - DL : Initial creation }
-{ }
-{
- $Log: sdlwindow.pas,v $
- Revision 1.9 2006/10/22 18:55:25 savage
- Slight Change to handle OpenGL context
-
- Revision 1.8 2005/08/03 18:57:32 savage
- Various updates and additions. Mainly to handle OpenGL 3D Window support and better cursor support for the mouse class
-
- Revision 1.7 2004/09/30 22:35:47 savage
- Changes, enhancements and additions as required to get SoAoS working.
-
- Revision 1.6 2004/09/12 21:52:58 savage
- Slight changes to fix some issues with the sdl classes.
-
- Revision 1.5 2004/05/10 21:11:49 savage
- changes required to help get SoAoS off the ground.
-
- Revision 1.4 2004/05/01 14:59:27 savage
- Updated code
-
- Revision 1.3 2004/04/23 10:45:28 savage
- Changes made by Dean Ellis to work more modularly.
-
- Revision 1.2 2004/03/31 10:06:41 savage
- Changed so that it now compiles, but is untested.
-
- Revision 1.1 2004/02/05 00:08:20 savage
- Module 1.0 release
-
-}
-{******************************************************************************}
-
-interface
-
-{$i jedi-sdl.inc}
-
-uses
- Classes,
- sdl,
- sdlinput,
- sdlticks;
-
-type
- TSDLNotifyEvent = procedure {$IFNDEF NOT_OO}of object{$ENDIF};
- TSDLUpdateEvent = procedure( aElapsedTime : single ) {$IFNDEF NOT_OO}of object{$ENDIF};
- TSDLResizeEvent = procedure( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 ) {$IFNDEF NOT_OO}of object{$ENDIF};
- TSDLUserEvent = procedure( aType : UInt8; aCode : integer; aData1 : Pointer; aData2 : Pointer ) {$IFNDEF NOT_OO}of object{$ENDIF};
- TSDLActiveEvent = procedure( aGain: UInt8; aState: UInt8 ) {$IFNDEF NOT_OO}of object{$ENDIF};
-
- TSDLBaseWindow = class( TObject )
- private
- FDisplaySurface : PSDL_Surface;
- FVideoFlags : Uint32;
- FOnDestroy: TSDLNotifyEvent;
- FOnCreate: TSDLNotifyEvent;
- FOnShow: TSDLNotifyEvent;
- FOnResize: TSDLResizeEvent;
- FOnUpdate: TSDLUpdateEvent;
- FOnRender: TSDLNotifyEvent;
- FOnClose: TSDLNotifyEvent;
- FLoaded: Boolean;
- FRendering: Boolean;
- FHeight: integer;
- FBitDepth: integer;
- FWidth: integer;
- FInputManager: TSDLInputManager;
- FCaptionText : PChar;
- FIconName : PChar;
- FOnActive: TSDLActiveEvent;
- FOnQuit: TSDLNotifyEvent;
- FOnExpose: TSDLNotifyEvent;
- FOnUser: TSDLUserEvent;
- FTimer : TSDLTicks;
- protected
- procedure DoActive( aGain: UInt8; aState: UInt8 );
- procedure DoCreate;
- procedure DoClose;
- procedure DoDestroy;
- procedure DoUpdate( aElapsedTime : single );
- procedure DoQuit;
- procedure DoRender;
- procedure DoResize( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 );
- procedure DoShow;
- procedure DoUser( aType : UInt8; aCode : integer; aData1 : Pointer; aData2 : Pointer );
- procedure DoExpose;
- procedure Render; virtual;
- procedure Update( aElapsedTime : single ); virtual;
- procedure InitialiseObjects; virtual;
- procedure RestoreObjects; virtual;
- procedure DeleteObjects; virtual;
- function Flip : integer; virtual;
- property OnActive : TSDLActiveEvent read FOnActive write FOnActive;
- property OnClose: TSDLNotifyEvent read FOnClose write FOnClose;
- property OnDestroy : TSDLNotifyEvent read FOnDestroy write FOnDestroy;
- property OnCreate : TSDLNotifyEvent read FOnCreate write FOnCreate;
- property OnUpdate: TSDLUpdateEvent read FOnUpdate write FOnUpdate;
- property OnQuit : TSDLNotifyEvent read FOnQuit write FOnQuit;
- property OnResize : TSDLResizeEvent read FOnResize write FOnResize;
- property OnRender: TSDLNotifyEvent read FOnRender write FOnRender;
- property OnShow : TSDLNotifyEvent read FOnShow write FOnShow;
- property OnUser : TSDLUserEvent read FOnUser write FOnUser;
- property OnExpose : TSDLNotifyEvent read FOnExpose write FOnExpose;
- property DisplaySurface: PSDL_Surface read FDisplaySurface;
- public
- property InputManager : TSDLInputManager read FInputManager;
- property Loaded : Boolean read FLoaded;
- property Width : integer read FWidth;
- property Height : integer read FHeight;
- property BitDepth : integer read FBitDepth;
- property Rendering : Boolean read FRendering write FRendering;
- procedure SetCaption( const aCaptionText : string; const aIconName : string );
- procedure GetCaption( var aCaptionText : string; var aIconName : string );
- procedure SetIcon( aIcon : PSDL_Surface; aMask: UInt8 );
- procedure ActivateVideoMode;
- constructor Create( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 ); virtual;
- destructor Destroy; override;
- procedure InitialiseEnvironment;
- function Show : Boolean; virtual;
- end;
-
- TSDLCustomWindow = class( TSDLBaseWindow )
- public
- property OnCreate;
- property OnDestroy;
- property OnClose;
- property OnShow;
- property OnResize;
- property OnRender;
- property OnUpdate;
- property DisplaySurface;
- end;
-
- TSDL2DWindow = class( TSDLCustomWindow )
- public
- constructor Create( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 = SDL_DOUBLEBUF or SDL_SWSURFACE); override;
- procedure Render; override;
- procedure Update( aElapsedTime : single ); override;
- procedure InitialiseObjects; override;
- procedure RestoreObjects; override;
- procedure DeleteObjects; override;
- function Flip : integer; override;
- end;
-
- TSDL3DWindow = class( TSDLCustomWindow )
- public
- constructor Create( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 = SDL_OPENGL or SDL_DOUBLEBUF); override;
- function Flip : integer; override;
- procedure Render; override;
- procedure Update( aElapsedTime : single ); override;
- procedure InitialiseObjects; override;
- procedure RestoreObjects; override;
- procedure DeleteObjects; override;
- end;
-
-
-
-implementation
-
-uses
- logger,
- SysUtils;
-
-{ TSDLBaseWindow }
-procedure TSDLBaseWindow.ActivateVideoMode;
-begin
- FDisplaySurface := SDL_SetVideoMode( FWidth, FHeight, FBitDepth, FVideoFlags);
- if (FDisplaySurface = nil) then
- begin
- Log.LogError( Format('Could not set video mode: %s', [SDL_GetError]), 'Main');
- exit;
- end;
-
- SetCaption( 'Made with JEDI-SDL', 'JEDI-SDL Icon' );
-end;
-
-constructor TSDLBaseWindow.Create( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 );
-begin
- inherited Create;
- SDL_Init(SDL_INIT_EVERYTHING);
- FInputManager := TSDLInputManager.Create( [ itJoystick, itKeyBoard, itMouse ]);
- FTimer := TSDLTicks.Create;
-
- FWidth := aWidth;
- FHeight := aHeight;
- FBitDepth := aBitDepth;
- FVideoFlags := aVideoFlags;
-
- DoCreate;
-end;
-
-procedure TSDLBaseWindow.DeleteObjects;
-begin
- FLoaded := False;
-end;
-
-destructor TSDLBaseWindow.Destroy;
-begin
- DoDestroy;
- if FLoaded then
- DeleteObjects;
- if FInputManager <> nil then
- FreeAndNil( FInputManager );
- if FTimer <> nil then
- FreeAndNil( FTimer );
- if FDisplaySurface <> nil then
- SDL_FreeSurface( FDisplaySurface );
- inherited Destroy;
- SDL_Quit;
-end;
-
-procedure TSDLBaseWindow.DoActive(aGain, aState: UInt8);
-begin
- if Assigned( FOnActive ) then
- begin
- FOnActive( aGain, aState );
- end;
-end;
-
-procedure TSDLBaseWindow.DoClose;
-begin
- if Assigned( FOnClose ) then
- begin
- FOnClose;
- end;
-end;
-
-procedure TSDLBaseWindow.DoCreate;
-begin
- if Assigned( FOnCreate ) then
- begin
- FOnCreate;
- end;
-end;
-
-procedure TSDLBaseWindow.DoDestroy;
-begin
- if Assigned( FOnDestroy ) then
- begin
- FOnDestroy;
- end;
-end;
-
-procedure TSDLBaseWindow.DoExpose;
-begin
- if Assigned( FOnExpose ) then
- begin
- FOnExpose;
- end;
-end;
-
-procedure TSDLBaseWindow.DoUpdate( aElapsedTime : single );
-begin
- if Assigned( FOnUpdate ) then
- begin
- FOnUpdate( aElapsedTime );
- end;
-end;
-
-procedure TSDLBaseWindow.DoQuit;
-begin
- FRendering := false;
- if Assigned( FOnQuit ) then
- begin
- FOnQuit;
- end;
-end;
-
-procedure TSDLBaseWindow.DoRender;
-begin
- if Assigned( FOnRender ) then
- begin
- FOnRender;
- end;
-end;
-
-procedure TSDLBaseWindow.DoResize( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 );
-begin
- // resize to the new size
- SDL_FreeSurface(FDisplaySurface);
- FWidth := aWidth;
- FHeight := aHeight;
- FBitDepth := aBitDepth;
- FVideoFlags := aVideoFlags;
- FDisplaySurface := SDL_SetVideoMode(aWidth, aHeight, aBitDepth, aVideoFlags);
- if Assigned( FOnResize ) then
- begin
- FOnResize( aWidth, aHeight, aBitDepth, aVideoFlags );
- end;
-end;
-
-procedure TSDLBaseWindow.DoShow;
-begin
- if Assigned( FOnShow ) then
- begin
- FOnShow;
- end;
-end;
-
-procedure TSDLBaseWindow.DoUser(aType: UInt8; aCode: integer; aData1, aData2: Pointer);
-begin
- if Assigned( FOnUser ) then
- begin
- FOnUser( aType, aCode, aData1, aData2 );
- end;
-end;
-
-function TSDLBaseWindow.Flip : integer;
-begin
- result := 0;
-end;
-
-procedure TSDLBaseWindow.GetCaption( var aCaptionText : string; var aIconName : string );
-begin
- aCaptionText := string( FCaptionText );
- aIconName := string( FIconName );
-end;
-
-procedure TSDLBaseWindow.InitialiseEnvironment;
-begin
- InitialiseObjects;
- RestoreObjects;
-end;
-
-procedure TSDLBaseWindow.InitialiseObjects;
-begin
- FLoaded := True;
-end;
-
-procedure TSDLBaseWindow.Update( aElapsedTime : single );
-begin
- DoUpdate( aElapsedTime );
-end;
-
-procedure TSDLBaseWindow.Render;
-begin
- DoRender;
-end;
-
-procedure TSDLBaseWindow.RestoreObjects;
-begin
- FLoaded := false;
-end;
-
-procedure TSDLBaseWindow.SetCaption( const aCaptionText : string; const aIconName : string );
-begin
- if FCaptionText <> aCaptionText then
- begin
- FCaptionText := PChar( aCaptionText );
- FIconName := PChar( aIconName );
- SDL_WM_SetCaption( FCaptionText, FIconName );
- end;
-end;
-
-procedure TSDLBaseWindow.SetIcon(aIcon: PSDL_Surface; aMask: UInt8);
-begin
- SDL_WM_SetIcon( aIcon, aMask );
-end;
-
-function TSDLBaseWindow.Show : Boolean;
-var
- eBaseWindowEvent : TSDL_Event;
-begin
- DoShow;
-
- FTimer.Init;
-
- FRendering := true;
- // repeat until we are told not to render
- while FRendering do
- begin
- // wait for an event
- while SDL_PollEvent( @eBaseWindowEvent ) > 0 do
- begin
-
- // check for a quit event
- case eBaseWindowEvent.type_ of
- SDL_ACTIVEEVENT :
- begin
- DoActive( eBaseWindowEvent.active.gain, eBaseWindowEvent.active.state );
- end;
-
- SDL_QUITEV :
- begin
- DoQuit;
- DoClose;
- end;
-
- SDL_USEREVENT :
- begin
- DoUser( eBaseWindowEvent.user.type_, eBaseWindowEvent.user.code, eBaseWindowEvent.user.data1, eBaseWindowEvent.user.data2 );
- end;
-
- SDL_VIDEOEXPOSE :
- begin
- DoExpose;
- end;
-
- SDL_VIDEORESIZE :
- begin
- DoResize( eBaseWindowEvent.resize.w, eBaseWindowEvent.resize.h, FDisplaySurface.format.BitsPerPixel, FVideoflags );
- end;
-
-
- end;
- InputManager.UpdateInputs( eBaseWindowEvent );
- end;
- // Prepare the Next Frame
- Update( FTimer.GetElapsedSeconds );
- // Display the Next Frame
- Render;
- // Flip the surfaces
- Flip;
- end;
-
- Result := FRendering;
-end;
-
-{ TSDL2DWindow }
-
-constructor TSDL2DWindow.Create(aWidth, aHeight, aBitDepth: integer; aVideoFlags: Uint32);
-begin
- // make sure double buffer is always included in the video flags
- inherited Create(aWidth,aHeight, aBitDepth, aVideoFlags or SDL_DOUBLEBUF);
-end;
-
-procedure TSDL2DWindow.DeleteObjects;
-begin
- inherited;
-
-end;
-
-function TSDL2DWindow.Flip: integer;
-begin
- // let's show the back buffer
- result := SDL_Flip( FDisplaySurface );
-end;
-
-procedure TSDL2DWindow.InitialiseObjects;
-begin
- inherited;
-
-end;
-
-procedure TSDL2DWindow.Update( aElapsedTime : single );
-begin
- inherited;
-
-end;
-
-procedure TSDL2DWindow.Render;
-begin
- inherited;
-
-end;
-
-procedure TSDL2DWindow.RestoreObjects;
-begin
- inherited;
-
-end;
-
-{ TSDL3DWindow }
-
-constructor TSDL3DWindow.Create(aWidth,
- aHeight, aBitDepth: integer; aVideoFlags: Uint32);
-begin
- // make sure opengl is always included in the video flags
- inherited Create(aWidth,aHeight, aBitDepth, aVideoFlags or SDL_OPENGL or SDL_DOUBLEBUF);
-end;
-
-procedure TSDL3DWindow.DeleteObjects;
-begin
- inherited;
-
-end;
-
-function TSDL3DWindow.Flip : integer;
-begin
- SDL_GL_SwapBuffers;
- result := 0;
-end;
-
-procedure TSDL3DWindow.InitialiseObjects;
-begin
- inherited;
-
-end;
-
-procedure TSDL3DWindow.Update( aElapsedTime : single );
-begin
- inherited;
-
-end;
-
-procedure TSDL3DWindow.Render;
-begin
- inherited;
-
-end;
-
-procedure TSDL3DWindow.RestoreObjects;
-begin
- inherited;
-
-end;
-
-end.
+unit sdlwindow; +{ + $Id: sdlwindow.pas,v 1.9 2006/10/22 18:55:25 savage Exp $ + +} +{******************************************************************************} +{ } +{ JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer } +{ SDL Window Wrapper } +{ } +{ } +{ The initial developer of this Pascal code was : } +{ Dominique Louis <Dominique@SavageSoftware.com.au> } +{ } +{ Portions created by Dominique Louis are } +{ Copyright (C) 2004 - 2100 Dominique Louis. } +{ } +{ } +{ Contributor(s) } +{ -------------- } +{ Dominique Louis <Dominique@SavageSoftware.com.au> } +{ } +{ Obtained through: } +{ Joint Endeavour of Delphi Innovators ( Project JEDI ) } +{ } +{ You may retrieve the latest version of this file at the Project } +{ JEDI home page, located at http://delphi-jedi.org } +{ } +{ The contents of this file are used with permission, subject to } +{ the Mozilla Public License Version 1.1 (the "License"); you may } +{ not use this file except in compliance with the License. You may } +{ obtain a copy of the License at } +{ http://www.mozilla.org/MPL/MPL-1.1.html } +{ } +{ Software distributed under the License is distributed on an } +{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or } +{ implied. See the License for the specific language governing } +{ rights and limitations under the License. } +{ } +{ Description } +{ ----------- } +{ SDL Window Wrapper } +{ } +{ } +{ Requires } +{ -------- } +{ SDL.dll on Windows platforms } +{ libSDL-1.1.so.0 on Linux platform } +{ } +{ Programming Notes } +{ ----------------- } +{ } +{ } +{ } +{ } +{ Revision History } +{ ---------------- } +{ January 31 2003 - DL : Initial creation } +{ } +{ + $Log: sdlwindow.pas,v $ + Revision 1.9 2006/10/22 18:55:25 savage + Slight Change to handle OpenGL context + + Revision 1.8 2005/08/03 18:57:32 savage + Various updates and additions. Mainly to handle OpenGL 3D Window support and better cursor support for the mouse class + + Revision 1.7 2004/09/30 22:35:47 savage + Changes, enhancements and additions as required to get SoAoS working. + + Revision 1.6 2004/09/12 21:52:58 savage + Slight changes to fix some issues with the sdl classes. + + Revision 1.5 2004/05/10 21:11:49 savage + changes required to help get SoAoS off the ground. + + Revision 1.4 2004/05/01 14:59:27 savage + Updated code + + Revision 1.3 2004/04/23 10:45:28 savage + Changes made by Dean Ellis to work more modularly. + + Revision 1.2 2004/03/31 10:06:41 savage + Changed so that it now compiles, but is untested. + + Revision 1.1 2004/02/05 00:08:20 savage + Module 1.0 release + +} +{******************************************************************************} + +interface + +{$i jedi-sdl.inc} + +uses + Classes, + sdl, + sdlinput, + sdlticks; + +type + TSDLNotifyEvent = procedure {$IFNDEF NOT_OO}of object{$ENDIF}; + TSDLUpdateEvent = procedure( aElapsedTime : single ) {$IFNDEF NOT_OO}of object{$ENDIF}; + TSDLResizeEvent = procedure( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 ) {$IFNDEF NOT_OO}of object{$ENDIF}; + TSDLUserEvent = procedure( aType : UInt8; aCode : integer; aData1 : Pointer; aData2 : Pointer ) {$IFNDEF NOT_OO}of object{$ENDIF}; + TSDLActiveEvent = procedure( aGain: UInt8; aState: UInt8 ) {$IFNDEF NOT_OO}of object{$ENDIF}; + + TSDLBaseWindow = class( TObject ) + private + FDisplaySurface : PSDL_Surface; + FVideoFlags : Uint32; + FOnDestroy: TSDLNotifyEvent; + FOnCreate: TSDLNotifyEvent; + FOnShow: TSDLNotifyEvent; + FOnResize: TSDLResizeEvent; + FOnUpdate: TSDLUpdateEvent; + FOnRender: TSDLNotifyEvent; + FOnClose: TSDLNotifyEvent; + FLoaded: Boolean; + FRendering: Boolean; + FHeight: integer; + FBitDepth: integer; + FWidth: integer; + FInputManager: TSDLInputManager; + FCaptionText : PChar; + FIconName : PChar; + FOnActive: TSDLActiveEvent; + FOnQuit: TSDLNotifyEvent; + FOnExpose: TSDLNotifyEvent; + FOnUser: TSDLUserEvent; + FTimer : TSDLTicks; + protected + procedure DoActive( aGain: UInt8; aState: UInt8 ); + procedure DoCreate; + procedure DoClose; + procedure DoDestroy; + procedure DoUpdate( aElapsedTime : single ); + procedure DoQuit; + procedure DoRender; + procedure DoResize( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 ); + procedure DoShow; + procedure DoUser( aType : UInt8; aCode : integer; aData1 : Pointer; aData2 : Pointer ); + procedure DoExpose; + procedure Render; virtual; + procedure Update( aElapsedTime : single ); virtual; + procedure InitialiseObjects; virtual; + procedure RestoreObjects; virtual; + procedure DeleteObjects; virtual; + function Flip : integer; virtual; + property OnActive : TSDLActiveEvent read FOnActive write FOnActive; + property OnClose: TSDLNotifyEvent read FOnClose write FOnClose; + property OnDestroy : TSDLNotifyEvent read FOnDestroy write FOnDestroy; + property OnCreate : TSDLNotifyEvent read FOnCreate write FOnCreate; + property OnUpdate: TSDLUpdateEvent read FOnUpdate write FOnUpdate; + property OnQuit : TSDLNotifyEvent read FOnQuit write FOnQuit; + property OnResize : TSDLResizeEvent read FOnResize write FOnResize; + property OnRender: TSDLNotifyEvent read FOnRender write FOnRender; + property OnShow : TSDLNotifyEvent read FOnShow write FOnShow; + property OnUser : TSDLUserEvent read FOnUser write FOnUser; + property OnExpose : TSDLNotifyEvent read FOnExpose write FOnExpose; + property DisplaySurface: PSDL_Surface read FDisplaySurface; + public + property InputManager : TSDLInputManager read FInputManager; + property Loaded : Boolean read FLoaded; + property Width : integer read FWidth; + property Height : integer read FHeight; + property BitDepth : integer read FBitDepth; + property Rendering : Boolean read FRendering write FRendering; + procedure SetCaption( const aCaptionText : string; const aIconName : string ); + procedure GetCaption( var aCaptionText : string; var aIconName : string ); + procedure SetIcon( aIcon : PSDL_Surface; aMask: UInt8 ); + procedure ActivateVideoMode; + constructor Create( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 ); virtual; + destructor Destroy; override; + procedure InitialiseEnvironment; + function Show : Boolean; virtual; + end; + + TSDLCustomWindow = class( TSDLBaseWindow ) + public + property OnCreate; + property OnDestroy; + property OnClose; + property OnShow; + property OnResize; + property OnRender; + property OnUpdate; + property DisplaySurface; + end; + + TSDL2DWindow = class( TSDLCustomWindow ) + public + constructor Create( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 = SDL_DOUBLEBUF or SDL_SWSURFACE); override; + procedure Render; override; + procedure Update( aElapsedTime : single ); override; + procedure InitialiseObjects; override; + procedure RestoreObjects; override; + procedure DeleteObjects; override; + function Flip : integer; override; + end; + + TSDL3DWindow = class( TSDLCustomWindow ) + public + constructor Create( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 = SDL_OPENGL or SDL_DOUBLEBUF); override; + function Flip : integer; override; + procedure Render; override; + procedure Update( aElapsedTime : single ); override; + procedure InitialiseObjects; override; + procedure RestoreObjects; override; + procedure DeleteObjects; override; + end; + + + +implementation + +uses + logger, + SysUtils; + +{ TSDLBaseWindow } +procedure TSDLBaseWindow.ActivateVideoMode; +begin + FDisplaySurface := SDL_SetVideoMode( FWidth, FHeight, FBitDepth, FVideoFlags); + if (FDisplaySurface = nil) then + begin + Log.LogError( Format('Could not set video mode: %s', [SDL_GetError]), 'Main'); + exit; + end; + + SetCaption( 'Made with JEDI-SDL', 'JEDI-SDL Icon' ); +end; + +constructor TSDLBaseWindow.Create( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 ); +begin + inherited Create; + SDL_Init(SDL_INIT_EVERYTHING); + FInputManager := TSDLInputManager.Create( [ itJoystick, itKeyBoard, itMouse ]); + FTimer := TSDLTicks.Create; + + FWidth := aWidth; + FHeight := aHeight; + FBitDepth := aBitDepth; + FVideoFlags := aVideoFlags; + + DoCreate; +end; + +procedure TSDLBaseWindow.DeleteObjects; +begin + FLoaded := False; +end; + +destructor TSDLBaseWindow.Destroy; +begin + DoDestroy; + if FLoaded then + DeleteObjects; + if FInputManager <> nil then + FreeAndNil( FInputManager ); + if FTimer <> nil then + FreeAndNil( FTimer ); + if FDisplaySurface <> nil then + SDL_FreeSurface( FDisplaySurface ); + inherited Destroy; + SDL_Quit; +end; + +procedure TSDLBaseWindow.DoActive(aGain, aState: UInt8); +begin + if Assigned( FOnActive ) then + begin + FOnActive( aGain, aState ); + end; +end; + +procedure TSDLBaseWindow.DoClose; +begin + if Assigned( FOnClose ) then + begin + FOnClose; + end; +end; + +procedure TSDLBaseWindow.DoCreate; +begin + if Assigned( FOnCreate ) then + begin + FOnCreate; + end; +end; + +procedure TSDLBaseWindow.DoDestroy; +begin + if Assigned( FOnDestroy ) then + begin + FOnDestroy; + end; +end; + +procedure TSDLBaseWindow.DoExpose; +begin + if Assigned( FOnExpose ) then + begin + FOnExpose; + end; +end; + +procedure TSDLBaseWindow.DoUpdate( aElapsedTime : single ); +begin + if Assigned( FOnUpdate ) then + begin + FOnUpdate( aElapsedTime ); + end; +end; + +procedure TSDLBaseWindow.DoQuit; +begin + FRendering := false; + if Assigned( FOnQuit ) then + begin + FOnQuit; + end; +end; + +procedure TSDLBaseWindow.DoRender; +begin + if Assigned( FOnRender ) then + begin + FOnRender; + end; +end; + +procedure TSDLBaseWindow.DoResize( aWidth : integer; aHeight : integer; aBitDepth : integer; aVideoFlags : Uint32 ); +begin + // resize to the new size + SDL_FreeSurface(FDisplaySurface); + FWidth := aWidth; + FHeight := aHeight; + FBitDepth := aBitDepth; + FVideoFlags := aVideoFlags; + FDisplaySurface := SDL_SetVideoMode(aWidth, aHeight, aBitDepth, aVideoFlags); + if Assigned( FOnResize ) then + begin + FOnResize( aWidth, aHeight, aBitDepth, aVideoFlags ); + end; +end; + +procedure TSDLBaseWindow.DoShow; +begin + if Assigned( FOnShow ) then + begin + FOnShow; + end; +end; + +procedure TSDLBaseWindow.DoUser(aType: UInt8; aCode: integer; aData1, aData2: Pointer); +begin + if Assigned( FOnUser ) then + begin + FOnUser( aType, aCode, aData1, aData2 ); + end; +end; + +function TSDLBaseWindow.Flip : integer; +begin + result := 0; +end; + +procedure TSDLBaseWindow.GetCaption( var aCaptionText : string; var aIconName : string ); +begin + aCaptionText := string( FCaptionText ); + aIconName := string( FIconName ); +end; + +procedure TSDLBaseWindow.InitialiseEnvironment; +begin + InitialiseObjects; + RestoreObjects; +end; + +procedure TSDLBaseWindow.InitialiseObjects; +begin + FLoaded := True; +end; + +procedure TSDLBaseWindow.Update( aElapsedTime : single ); +begin + DoUpdate( aElapsedTime ); +end; + +procedure TSDLBaseWindow.Render; +begin + DoRender; +end; + +procedure TSDLBaseWindow.RestoreObjects; +begin + FLoaded := false; +end; + +procedure TSDLBaseWindow.SetCaption( const aCaptionText : string; const aIconName : string ); +begin + if FCaptionText <> aCaptionText then + begin + FCaptionText := PChar( aCaptionText ); + FIconName := PChar( aIconName ); + SDL_WM_SetCaption( FCaptionText, FIconName ); + end; +end; + +procedure TSDLBaseWindow.SetIcon(aIcon: PSDL_Surface; aMask: UInt8); +begin + SDL_WM_SetIcon( aIcon, aMask ); +end; + +function TSDLBaseWindow.Show : Boolean; +var + eBaseWindowEvent : TSDL_Event; +begin + DoShow; + + FTimer.Init; + + FRendering := true; + // repeat until we are told not to render + while FRendering do + begin + // wait for an event + while SDL_PollEvent( @eBaseWindowEvent ) > 0 do + begin + + // check for a quit event + case eBaseWindowEvent.type_ of + SDL_ACTIVEEVENT : + begin + DoActive( eBaseWindowEvent.active.gain, eBaseWindowEvent.active.state ); + end; + + SDL_QUITEV : + begin + DoQuit; + DoClose; + end; + + SDL_USEREVENT : + begin + DoUser( eBaseWindowEvent.user.type_, eBaseWindowEvent.user.code, eBaseWindowEvent.user.data1, eBaseWindowEvent.user.data2 ); + end; + + SDL_VIDEOEXPOSE : + begin + DoExpose; + end; + + SDL_VIDEORESIZE : + begin + DoResize( eBaseWindowEvent.resize.w, eBaseWindowEvent.resize.h, FDisplaySurface.format.BitsPerPixel, FVideoflags ); + end; + + + end; + InputManager.UpdateInputs( eBaseWindowEvent ); + end; + // Prepare the Next Frame + Update( FTimer.GetElapsedSeconds ); + // Display the Next Frame + Render; + // Flip the surfaces + Flip; + end; + + Result := FRendering; +end; + +{ TSDL2DWindow } + +constructor TSDL2DWindow.Create(aWidth, aHeight, aBitDepth: integer; aVideoFlags: Uint32); +begin + // make sure double buffer is always included in the video flags + inherited Create(aWidth,aHeight, aBitDepth, aVideoFlags or SDL_DOUBLEBUF); +end; + +procedure TSDL2DWindow.DeleteObjects; +begin + inherited; + +end; + +function TSDL2DWindow.Flip: integer; +begin + // let's show the back buffer + result := SDL_Flip( FDisplaySurface ); +end; + +procedure TSDL2DWindow.InitialiseObjects; +begin + inherited; + +end; + +procedure TSDL2DWindow.Update( aElapsedTime : single ); +begin + inherited; + +end; + +procedure TSDL2DWindow.Render; +begin + inherited; + +end; + +procedure TSDL2DWindow.RestoreObjects; +begin + inherited; + +end; + +{ TSDL3DWindow } + +constructor TSDL3DWindow.Create(aWidth, + aHeight, aBitDepth: integer; aVideoFlags: Uint32); +begin + // make sure opengl is always included in the video flags + inherited Create(aWidth,aHeight, aBitDepth, aVideoFlags or SDL_OPENGL or SDL_DOUBLEBUF); +end; + +procedure TSDL3DWindow.DeleteObjects; +begin + inherited; + +end; + +function TSDL3DWindow.Flip : integer; +begin + SDL_GL_SwapBuffers; + result := 0; +end; + +procedure TSDL3DWindow.InitialiseObjects; +begin + inherited; + +end; + +procedure TSDL3DWindow.Update( aElapsedTime : single ); +begin + inherited; + +end; + +procedure TSDL3DWindow.Render; +begin + inherited; + +end; + +procedure TSDL3DWindow.RestoreObjects; +begin + inherited; + +end; + +end. diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/userpreferences.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/userpreferences.pas index 97e26520..aed326d1 100644 --- a/Game/Code/lib/JEDI-SDL/SDL/Pas/userpreferences.pas +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/userpreferences.pas @@ -1,159 +1,159 @@ -unit userpreferences;
-{
- $Id: userpreferences.pas,v 1.1 2004/09/30 22:35:47 savage Exp $
-
-}
-{******************************************************************************}
-{ }
-{ JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer }
-{ Base Class for User Preferences }
-{ }
-{ The initial developer of this Pascal code was : }
-{ Dominqiue Louis <Dominique@SavageSoftware.com.au> }
-{ }
-{ Portions created by Dominqiue Louis are }
-{ Copyright (C) 2000 - 2001 Dominqiue Louis. }
-{ }
-{ }
-{ Contributor(s) }
-{ -------------- }
-{ }
-{ }
-{ Obtained through: }
-{ Joint Endeavour of Delphi Innovators ( Project JEDI ) }
-{ }
-{ You may retrieve the latest version of this file at the Project }
-{ JEDI home page, located at http://delphi-jedi.org }
-{ }
-{ The contents of this file are used with permission, subject to }
-{ the Mozilla Public License Version 1.1 (the "License"); you may }
-{ not use this file except in compliance with the License. You may }
-{ obtain a copy of the License at }
-{ http://www.mozilla.org/MPL/MPL-1.1.html }
-{ }
-{ Software distributed under the License is distributed on an }
-{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or }
-{ implied. See the License for the specific language governing }
-{ rights and limitations under the License. }
-{ }
-{ Description }
-{ ----------- }
-{ }
-{ }
-{ }
-{ }
-{ }
-{ }
-{ }
-{ Requires }
-{ -------- }
-{ The SDL Runtime libraris on Win32 : SDL.dll on Linux : libSDL.so }
-{ They are available from... }
-{ http://www.libsdl.org . }
-{ }
-{ Programming Notes }
-{ ----------------- }
-{ }
-{ }
-{ }
-{ }
-{ Revision History }
-{ ---------------- }
-{ September 23 2004 - DL : Initial Creation }
-{
- $Log: userpreferences.pas,v $
- Revision 1.1 2004/09/30 22:35:47 savage
- Changes, enhancements and additions as required to get SoAoS working.
-
-
-}
-{******************************************************************************}
-
-interface
-
-uses
- Classes;
-
-type
- TUserPreferences = class
- private
- FAutoSave: Boolean;
- procedure CheckAutoSave;
- protected
- function GetDefaultBoolean( const Index : Integer ) : Boolean; virtual; abstract;
- function GetBoolean( const Index : Integer ) : Boolean; virtual; abstract;
- procedure SetBoolean( const Index : Integer; const Value : Boolean ); virtual;
- function GetDefaultDateTime( const Index : Integer ) : TDateTime; virtual; abstract;
- function GetDateTime( const Index : Integer ) : TDateTime; virtual; abstract;
- procedure SetDateTime( const Index : Integer; const Value : TDateTime ); virtual;
- function GetDefaultInteger( const Index : Integer ) : Integer; virtual; abstract;
- function GetInteger( const Index : Integer ) : Integer; virtual; abstract;
- procedure SetInteger( const Index : Integer; const Value : Integer ); virtual;
- function GetDefaultFloat( const Index : Integer ) : single; virtual; abstract;
- function GetFloat( const Index : Integer ) : single; virtual; abstract;
- procedure SetFloat( const Index : Integer; const Value : single ); virtual;
- function GetDefaultString( const Index : Integer ) : string; virtual; abstract;
- function GetString( const Index : Integer ) : string; virtual; abstract;
- procedure SetString( const Index : Integer; const Value : string ); virtual;
- function GetDefaultBinaryStream( const Index : Integer ) : TStream; virtual; abstract;
- function GetBinaryStream( const Index : Integer ) : TStream; virtual; abstract;
- procedure SetBinaryStream( const Index : Integer; const Value : TStream ); virtual;
- public
- procedure Update; virtual; abstract;
- constructor Create; virtual;
- destructor Destroy; override;
- property AutoSave : Boolean read FAutoSave write FAutoSave;
- end;
-
-implementation
-
-{ TUserPreferences }
-procedure TUserPreferences.CheckAutoSave;
-begin
- if FAutoSave then
- Update;
-end;
-
-constructor TUserPreferences.Create;
-begin
- inherited;
- FAutoSave := false;
-end;
-
-destructor TUserPreferences.Destroy;
-begin
-
- inherited;
-end;
-
-procedure TUserPreferences.SetBinaryStream( const Index : Integer; const Value : TStream );
-begin
- CheckAutoSave;
-end;
-
-procedure TUserPreferences.SetBoolean(const Index: Integer; const Value: Boolean);
-begin
- CheckAutoSave;
-end;
-
-procedure TUserPreferences.SetDateTime(const Index: Integer; const Value: TDateTime);
-begin
- CheckAutoSave;
-end;
-
-procedure TUserPreferences.SetFloat(const Index: Integer; const Value: single);
-begin
- CheckAutoSave;
-end;
-
-procedure TUserPreferences.SetInteger(const Index, Value: Integer);
-begin
- CheckAutoSave;
-end;
-
-procedure TUserPreferences.SetString(const Index: Integer; const Value: string);
-begin
- CheckAutoSave;
-end;
-
-end.
+unit userpreferences; +{ + $Id: userpreferences.pas,v 1.1 2004/09/30 22:35:47 savage Exp $ + +} +{******************************************************************************} +{ } +{ JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer } +{ Base Class for User Preferences } +{ } +{ The initial developer of this Pascal code was : } +{ Dominqiue Louis <Dominique@SavageSoftware.com.au> } +{ } +{ Portions created by Dominqiue Louis are } +{ Copyright (C) 2000 - 2001 Dominqiue Louis. } +{ } +{ } +{ Contributor(s) } +{ -------------- } +{ } +{ } +{ Obtained through: } +{ Joint Endeavour of Delphi Innovators ( Project JEDI ) } +{ } +{ You may retrieve the latest version of this file at the Project } +{ JEDI home page, located at http://delphi-jedi.org } +{ } +{ The contents of this file are used with permission, subject to } +{ the Mozilla Public License Version 1.1 (the "License"); you may } +{ not use this file except in compliance with the License. You may } +{ obtain a copy of the License at } +{ http://www.mozilla.org/MPL/MPL-1.1.html } +{ } +{ Software distributed under the License is distributed on an } +{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or } +{ implied. See the License for the specific language governing } +{ rights and limitations under the License. } +{ } +{ Description } +{ ----------- } +{ } +{ } +{ } +{ } +{ } +{ } +{ } +{ Requires } +{ -------- } +{ The SDL Runtime libraris on Win32 : SDL.dll on Linux : libSDL.so } +{ They are available from... } +{ http://www.libsdl.org . } +{ } +{ Programming Notes } +{ ----------------- } +{ } +{ } +{ } +{ } +{ Revision History } +{ ---------------- } +{ September 23 2004 - DL : Initial Creation } +{ + $Log: userpreferences.pas,v $ + Revision 1.1 2004/09/30 22:35:47 savage + Changes, enhancements and additions as required to get SoAoS working. + + +} +{******************************************************************************} + +interface + +uses + Classes; + +type + TUserPreferences = class + private + FAutoSave: Boolean; + procedure CheckAutoSave; + protected + function GetDefaultBoolean( const Index : Integer ) : Boolean; virtual; abstract; + function GetBoolean( const Index : Integer ) : Boolean; virtual; abstract; + procedure SetBoolean( const Index : Integer; const Value : Boolean ); virtual; + function GetDefaultDateTime( const Index : Integer ) : TDateTime; virtual; abstract; + function GetDateTime( const Index : Integer ) : TDateTime; virtual; abstract; + procedure SetDateTime( const Index : Integer; const Value : TDateTime ); virtual; + function GetDefaultInteger( const Index : Integer ) : Integer; virtual; abstract; + function GetInteger( const Index : Integer ) : Integer; virtual; abstract; + procedure SetInteger( const Index : Integer; const Value : Integer ); virtual; + function GetDefaultFloat( const Index : Integer ) : single; virtual; abstract; + function GetFloat( const Index : Integer ) : single; virtual; abstract; + procedure SetFloat( const Index : Integer; const Value : single ); virtual; + function GetDefaultString( const Index : Integer ) : string; virtual; abstract; + function GetString( const Index : Integer ) : string; virtual; abstract; + procedure SetString( const Index : Integer; const Value : string ); virtual; + function GetDefaultBinaryStream( const Index : Integer ) : TStream; virtual; abstract; + function GetBinaryStream( const Index : Integer ) : TStream; virtual; abstract; + procedure SetBinaryStream( const Index : Integer; const Value : TStream ); virtual; + public + procedure Update; virtual; abstract; + constructor Create; virtual; + destructor Destroy; override; + property AutoSave : Boolean read FAutoSave write FAutoSave; + end; + +implementation + +{ TUserPreferences } +procedure TUserPreferences.CheckAutoSave; +begin + if FAutoSave then + Update; +end; + +constructor TUserPreferences.Create; +begin + inherited; + FAutoSave := false; +end; + +destructor TUserPreferences.Destroy; +begin + + inherited; +end; + +procedure TUserPreferences.SetBinaryStream( const Index : Integer; const Value : TStream ); +begin + CheckAutoSave; +end; + +procedure TUserPreferences.SetBoolean(const Index: Integer; const Value: Boolean); +begin + CheckAutoSave; +end; + +procedure TUserPreferences.SetDateTime(const Index: Integer; const Value: TDateTime); +begin + CheckAutoSave; +end; + +procedure TUserPreferences.SetFloat(const Index: Integer; const Value: single); +begin + CheckAutoSave; +end; + +procedure TUserPreferences.SetInteger(const Index, Value: Integer); +begin + CheckAutoSave; +end; + +procedure TUserPreferences.SetString(const Index: Integer; const Value: string); +begin + CheckAutoSave; +end; + +end. diff --git a/Game/Code/lib/JEDI-SDL/SDL_Image/Pas/sdl_image.pas b/Game/Code/lib/JEDI-SDL/SDL_Image/Pas/sdl_image.pas index f1de4bc2..4468f036 100644 --- a/Game/Code/lib/JEDI-SDL/SDL_Image/Pas/sdl_image.pas +++ b/Game/Code/lib/JEDI-SDL/SDL_Image/Pas/sdl_image.pas @@ -1,350 +1,350 @@ -unit sdl_image;
-{
- $Id: sdl_image.pas,v 1.15 2007/12/05 22:52:23 savage Exp $
-
-}
-{******************************************************************************}
-{ }
-{ Borland Delphi SDL_Image - An example image loading library for use }
-{ with SDL }
-{ Conversion of the Simple DirectMedia Layer Image Headers }
-{ }
-{ Portions created by Sam Lantinga <slouken@devolution.com> are }
-{ Copyright (C) 1997, 1998, 1999, 2000, 2001 Sam Lantinga }
-{ 5635-34 Springhouse Dr. }
-{ Pleasanton, CA 94588 (USA) }
-{ }
-{ All Rights Reserved. }
-{ }
-{ The original files are : SDL_image.h }
-{ }
-{ The initial developer of this Pascal code was : }
-{ Matthias Thoma <ma.thoma@gmx.de> }
-{ }
-{ Portions created by Matthias Thoma are }
-{ Copyright (C) 2000 - 2001 Matthias Thoma. }
-{ }
-{ }
-{ Contributor(s) }
-{ -------------- }
-{ Dominique Louis <Dominique@SavageSoftware.com.au> }
-{ }
-{ Obtained through: }
-{ Joint Endeavour of Delphi Innovators ( Project JEDI ) }
-{ }
-{ You may retrieve the latest version of this file at the Project }
-{ JEDI home page, located at http://delphi-jedi.org }
-{ }
-{ The contents of this file are used with permission, subject to }
-{ the Mozilla Public License Version 1.1 (the "License"); you may }
-{ not use this file except in compliance with the License. You may }
-{ obtain a copy of the License at }
-{ http://www.mozilla.org/MPL/MPL-1.1.html }
-{ }
-{ Software distributed under the License is distributed on an }
-{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or }
-{ implied. See the License for the specific language governing }
-{ rights and limitations under the License. }
-{ }
-{ Description }
-{ ----------- }
-{ A simple library to load images of various formats as SDL surfaces }
-{ }
-{ Requires }
-{ -------- }
-{ SDL.pas in your search path. }
-{ }
-{ Programming Notes }
-{ ----------------- }
-{ See the Aliens Demo on how to make use of this libaray }
-{ }
-{ Revision History }
-{ ---------------- }
-{ April 02 2001 - MT : Initial Translation }
-{ }
-{ May 08 2001 - DL : Added ExternalSym derectives and copyright header }
-{ }
-{ April 03 2003 - DL : Added jedi-sdl.inc include file to support more }
-{ Pascal compilers. Initial support is now included }
-{ for GnuPascal, VirtualPascal, TMT and obviously }
-{ continue support for Delphi Kylix and FreePascal. }
-{ }
-{ April 08 2003 - MK : Aka Mr Kroket - Added Better FPC support }
-{ }
-{ April 24 2003 - DL : under instruction from Alexey Barkovoy, I have added}
-{ better TMT Pascal support and under instruction }
-{ from Prof. Abimbola Olowofoyeku (The African Chief),}
-{ I have added better Gnu Pascal support }
-{ }
-{ April 30 2003 - DL : under instruction from David Mears AKA }
-{ Jason Siletto, I have added FPC Linux support. }
-{ This was compiled with fpc 1.1, so remember to set }
-{ include file path. ie. -Fi/usr/share/fpcsrc/rtl/* }
-{ }
-{
- $Log: sdl_image.pas,v $
- Revision 1.15 2007/12/05 22:52:23 savage
- Better Mac OS X support for Frameworks.
-
- Revision 1.14 2007/05/29 21:31:13 savage
- Changes as suggested by Almindor for 64bit compatibility.
-
- Revision 1.13 2007/05/20 20:30:54 savage
- Initial Changes to Handle 64 Bits
-
- Revision 1.12 2006/12/02 00:14:40 savage
- Updated to latest version
-
- Revision 1.11 2005/04/10 18:22:59 savage
- Changes as suggested by Michalis, thanks.
-
- Revision 1.10 2005/04/10 11:48:33 savage
- Changes as suggested by Michalis, thanks.
-
- Revision 1.9 2005/01/05 01:47:07 savage
- Changed LibName to reflect what MacOS X should have. ie libSDL*-1.2.0.dylib respectively.
-
- Revision 1.8 2005/01/04 23:14:44 savage
- Changed LibName to reflect what most Linux distros will have. ie libSDL*-1.2.so.0 respectively.
-
- Revision 1.7 2005/01/01 02:03:12 savage
- Updated to v1.2.4
-
- Revision 1.6 2004/08/14 22:54:30 savage
- Updated so that Library name defines are correctly defined for MacOS X.
-
- Revision 1.5 2004/05/10 14:10:04 savage
- Initial MacOS X support. Fixed defines for MACOS ( Classic ) and DARWIN ( MacOS X ).
-
- Revision 1.4 2004/04/13 09:32:08 savage
- Changed Shared object names back to just the .so extension to avoid conflicts on various Linux/Unix distros. Therefore developers will need to create Symbolic links to the actual Share Objects if necessary.
-
- Revision 1.3 2004/04/01 20:53:23 savage
- Changed Linux Shared Object names so they reflect the Symbolic Links that are created when installing the RPMs from the SDL site.
-
- Revision 1.2 2004/03/30 20:23:28 savage
- Tidied up use of UNIX compiler directive.
-
- Revision 1.1 2004/02/14 23:35:42 savage
- version 1 of sdl_image, sdl_mixer and smpeg.
-
-
-}
-{******************************************************************************}
-
-{$I jedi-sdl.inc}
-
-interface
-
-uses
-{$IFDEF __GPC__}
- gpc,
-{$ENDIF}
- sdl;
-
-const
-{$IFDEF WINDOWS}
- SDL_ImageLibName = 'SDL_Image.dll';
-{$ENDIF}
-
-{$IFDEF UNIX}
-{$IFDEF DARWIN}
- SDL_ImageLibName = 'libSDL_image-1.2.0.dylib';
- {$linklib libSDL_image}
-{$ELSE}
- {$IFDEF FPC}
- SDL_ImageLibName = 'libSDL_image.so';
- {$ELSE}
- SDL_ImageLibName = 'libSDL_image-1.2.so.0';
- {$ENDIF}
-{$ENDIF}
-{$ENDIF}
-
-{$IFDEF MACOS}
- SDL_ImageLibName = 'SDL_image';
- {$linklib libSDL_image}
-{$ENDIF}
-
- // Printable format: "%d.%d.%d", MAJOR, MINOR, PATCHLEVEL
- SDL_IMAGE_MAJOR_VERSION = 1;
-{$EXTERNALSYM SDL_IMAGE_MAJOR_VERSION}
- SDL_IMAGE_MINOR_VERSION = 2;
-{$EXTERNALSYM SDL_IMAGE_MINOR_VERSION}
- SDL_IMAGE_PATCHLEVEL = 6;
-{$EXTERNALSYM SDL_IMAGE_PATCHLEVEL}
-
-{ This macro can be used to fill a version structure with the compile-time
- version of the SDL_image library. }
-procedure SDL_IMAGE_VERSION( var X : TSDL_Version );
-{$EXTERNALSYM SDL_IMAGE_VERSION}
-
-{ This function gets the version of the dynamically linked SDL_image library.
- it should NOT be used to fill a version structure, instead you should
- use the SDL_IMAGE_VERSION() macro.
- }
-function IMG_Linked_Version : PSDL_version;
-external {$IFDEF __GPC__}name 'IMG_Linked_Version'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_Linked_Version}
-
-{ Load an image from an SDL data source.
- The 'type' may be one of: "BMP", "GIF", "PNG", etc.
-
- If the image format supports a transparent pixel, SDL will set the
- colorkey for the surface. You can enable RLE acceleration on the
- surface afterwards by calling:
- SDL_SetColorKey(image, SDL_RLEACCEL, image.format.colorkey);
-}
-function IMG_LoadTyped_RW(src: PSDL_RWops; freesrc: Integer; _type: PChar): PSDL_Surface;
-cdecl; external {$IFDEF __GPC__}name 'IMG_LoadTyped_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_LoadTyped_RW}
-{ Convenience functions }
-function IMG_Load(const _file: PChar): PSDL_Surface;
-cdecl; external {$IFDEF __GPC__}name 'IMG_Load'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_Load}
-function IMG_Load_RW(src: PSDL_RWops; freesrc: Integer): PSDL_Surface;
-cdecl; external {$IFDEF __GPC__}name 'IMG_Load_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_Load_RW}
-
-{ Invert the alpha of a surface for use with OpenGL
- This function is now a no-op, and only provided for backwards compatibility. }
-function IMG_InvertAlpha(_on: Integer): Integer;
-cdecl; external {$IFDEF __GPC__}name 'IMG_InvertAlpha'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_InvertAlpha}
-
-{ Functions to detect a file type, given a seekable source }
-function IMG_isBMP(src: PSDL_RWops): Integer;
-cdecl; external {$IFDEF __GPC__}name 'IMG_isBMP'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_isBMP}
-
-function IMG_isGIF(src: PSDL_RWops): Integer;
-cdecl; external {$IFDEF __GPC__}name 'IMG_isGIF'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_isGIF}
-
-function IMG_isJPG(src: PSDL_RWops): Integer;
-cdecl; external {$IFDEF __GPC__}name 'IMG_isJPG'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_isJPG}
-
-function IMG_isLBM(src: PSDL_RWops): Integer;
-cdecl; external {$IFDEF __GPC__}name 'IMG_isLBM'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_isLBM}
-
-function IMG_isPCX(src: PSDL_RWops): Integer;
-cdecl; external {$IFDEF __GPC__}name 'IMG_isPCX'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_isPCX}
-
-function IMG_isPNG(src: PSDL_RWops): Integer;
-cdecl; external {$IFDEF __GPC__}name 'IMG_isPNG'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_isPNG}
-
-function IMG_isPNM(src: PSDL_RWops): Integer;
-cdecl; external {$IFDEF __GPC__}name 'IMG_isPNM'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_isPNM}
-
-function IMG_isTIF(src: PSDL_RWops): Integer;
-cdecl; external {$IFDEF __GPC__}name 'IMG_isTIF'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_isTIF}
-
-function IMG_isXCF(src: PSDL_RWops): Integer;
-cdecl; external {$IFDEF __GPC__}name 'IMG_isXCF'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_isXCF}
-
-function IMG_isXPM(src: PSDL_RWops): Integer;
-cdecl; external {$IFDEF __GPC__}name 'IMG_isXPM'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_isXPM}
-
-function IMG_isXV(src: PSDL_RWops): Integer;
-cdecl; external {$IFDEF __GPC__}name 'IMG_isXV'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_isXV}
-
-
-{ Individual loading functions }
-function IMG_LoadBMP_RW(src: PSDL_RWops): PSDL_Surface;
-cdecl; external {$IFDEF __GPC__}name 'IMG_LoadBMP_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_LoadBMP_RW}
-
-function IMG_LoadGIF_RW(src: PSDL_RWops): PSDL_Surface;
-cdecl; external {$IFDEF __GPC__}name 'IMG_LoadGIF_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_LoadGIF_RW}
-
-function IMG_LoadJPG_RW(src: PSDL_RWops): PSDL_Surface;
-cdecl; external {$IFDEF __GPC__}name 'IMG_LoadJPG_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_LoadJPG_RW}
-
-function IMG_LoadLBM_RW(src: PSDL_RWops): PSDL_Surface;
-cdecl; external {$IFDEF __GPC__}name 'IMG_LoadLBM_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_LoadLBM_RW}
-
-function IMG_LoadPCX_RW(src: PSDL_RWops): PSDL_Surface;
-cdecl; external {$IFDEF __GPC__}name 'IMG_LoadPCX_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_LoadPCX_RW}
-
-function IMG_LoadPNM_RW(src: PSDL_RWops): PSDL_Surface;
-cdecl; external {$IFDEF __GPC__}name 'IMG_LoadPNM_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_LoadPNM_RW}
-
-function IMG_LoadPNG_RW(src: PSDL_RWops): PSDL_Surface;
-cdecl; external {$IFDEF __GPC__}name 'IMG_LoadPNG_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_LoadPNG_RW}
-
-function IMG_LoadTGA_RW(src: PSDL_RWops): PSDL_Surface;
-cdecl; external {$IFDEF __GPC__}name 'IMG_LoadTGA_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_LoadTGA_RW}
-
-function IMG_LoadTIF_RW(src: PSDL_RWops): PSDL_Surface;
-cdecl; external {$IFDEF __GPC__}name 'IMG_LoadTIF_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_LoadTIF_RW}
-
-function IMG_LoadXCF_RW(src: PSDL_RWops): PSDL_Surface;
-cdecl; external {$IFDEF __GPC__}name 'IMG_LoadXCF_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_LoadXCF_RW}
-
-function IMG_LoadXPM_RW(src: PSDL_RWops): PSDL_Surface;
-cdecl; external {$IFDEF __GPC__}name 'IMG_LoadXPM_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_LoadXPM_RW}
-
-function IMG_LoadXV_RW(src: PSDL_RWops): PSDL_Surface;
-cdecl; external {$IFDEF __GPC__}name 'IMG_LoadXV_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_LoadXV_RW}
-
-function IMG_ReadXPMFromArray( xpm : PPChar ): PSDL_Surface;
-cdecl; external {$IFDEF __GPC__}name 'IMG_ReadXPMFromArray'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-{$EXTERNALSYM IMG_ReadXPMFromArray}
-
-
-
-
-{ used internally, NOT an exported function }
-//function IMG_string_equals( const str1 : PChar; const str2 : PChar ) : integer;
-//cdecl; external {$IFDEF __GPC__}name 'IMG_string_equals'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__};
-//{ $ EXTERNALSYM IMG_string_equals}
-
-{ Error Macros }
-{ We'll use SDL for reporting errors }
-procedure IMG_SetError( fmt : PChar );
-
-function IMG_GetError : PChar;
-
-implementation
-
-{$IFDEF __GPC__}
- {$L 'sdl_image'} { link sdl_image.dll.a or libsdl_image.so or libsdl_image.a }
-{$ENDIF}
-
-procedure SDL_IMAGE_VERSION( var X : TSDL_Version );
-begin
- X.major := SDL_IMAGE_MAJOR_VERSION;
- X.minor := SDL_IMAGE_MINOR_VERSION;
- X.patch := SDL_IMAGE_PATCHLEVEL;
-end;
-
-procedure IMG_SetError( fmt : PChar );
-begin
- SDL_SetError( fmt );
-end;
-
-function IMG_GetError : PChar;
-begin
- result := SDL_GetError;
-end;
-
-end.
+unit sdl_image; +{ + $Id: sdl_image.pas,v 1.15 2007/12/05 22:52:23 savage Exp $ + +} +{******************************************************************************} +{ } +{ Borland Delphi SDL_Image - An example image loading library for use } +{ with SDL } +{ Conversion of the Simple DirectMedia Layer Image Headers } +{ } +{ Portions created by Sam Lantinga <slouken@devolution.com> are } +{ Copyright (C) 1997, 1998, 1999, 2000, 2001 Sam Lantinga } +{ 5635-34 Springhouse Dr. } +{ Pleasanton, CA 94588 (USA) } +{ } +{ All Rights Reserved. } +{ } +{ The original files are : SDL_image.h } +{ } +{ The initial developer of this Pascal code was : } +{ Matthias Thoma <ma.thoma@gmx.de> } +{ } +{ Portions created by Matthias Thoma are } +{ Copyright (C) 2000 - 2001 Matthias Thoma. } +{ } +{ } +{ Contributor(s) } +{ -------------- } +{ Dominique Louis <Dominique@SavageSoftware.com.au> } +{ } +{ Obtained through: } +{ Joint Endeavour of Delphi Innovators ( Project JEDI ) } +{ } +{ You may retrieve the latest version of this file at the Project } +{ JEDI home page, located at http://delphi-jedi.org } +{ } +{ The contents of this file are used with permission, subject to } +{ the Mozilla Public License Version 1.1 (the "License"); you may } +{ not use this file except in compliance with the License. You may } +{ obtain a copy of the License at } +{ http://www.mozilla.org/MPL/MPL-1.1.html } +{ } +{ Software distributed under the License is distributed on an } +{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or } +{ implied. See the License for the specific language governing } +{ rights and limitations under the License. } +{ } +{ Description } +{ ----------- } +{ A simple library to load images of various formats as SDL surfaces } +{ } +{ Requires } +{ -------- } +{ SDL.pas in your search path. } +{ } +{ Programming Notes } +{ ----------------- } +{ See the Aliens Demo on how to make use of this libaray } +{ } +{ Revision History } +{ ---------------- } +{ April 02 2001 - MT : Initial Translation } +{ } +{ May 08 2001 - DL : Added ExternalSym derectives and copyright header } +{ } +{ April 03 2003 - DL : Added jedi-sdl.inc include file to support more } +{ Pascal compilers. Initial support is now included } +{ for GnuPascal, VirtualPascal, TMT and obviously } +{ continue support for Delphi Kylix and FreePascal. } +{ } +{ April 08 2003 - MK : Aka Mr Kroket - Added Better FPC support } +{ } +{ April 24 2003 - DL : under instruction from Alexey Barkovoy, I have added} +{ better TMT Pascal support and under instruction } +{ from Prof. Abimbola Olowofoyeku (The African Chief),} +{ I have added better Gnu Pascal support } +{ } +{ April 30 2003 - DL : under instruction from David Mears AKA } +{ Jason Siletto, I have added FPC Linux support. } +{ This was compiled with fpc 1.1, so remember to set } +{ include file path. ie. -Fi/usr/share/fpcsrc/rtl/* } +{ } +{ + $Log: sdl_image.pas,v $ + Revision 1.15 2007/12/05 22:52:23 savage + Better Mac OS X support for Frameworks. + + Revision 1.14 2007/05/29 21:31:13 savage + Changes as suggested by Almindor for 64bit compatibility. + + Revision 1.13 2007/05/20 20:30:54 savage + Initial Changes to Handle 64 Bits + + Revision 1.12 2006/12/02 00:14:40 savage + Updated to latest version + + Revision 1.11 2005/04/10 18:22:59 savage + Changes as suggested by Michalis, thanks. + + Revision 1.10 2005/04/10 11:48:33 savage + Changes as suggested by Michalis, thanks. + + Revision 1.9 2005/01/05 01:47:07 savage + Changed LibName to reflect what MacOS X should have. ie libSDL*-1.2.0.dylib respectively. + + Revision 1.8 2005/01/04 23:14:44 savage + Changed LibName to reflect what most Linux distros will have. ie libSDL*-1.2.so.0 respectively. + + Revision 1.7 2005/01/01 02:03:12 savage + Updated to v1.2.4 + + Revision 1.6 2004/08/14 22:54:30 savage + Updated so that Library name defines are correctly defined for MacOS X. + + Revision 1.5 2004/05/10 14:10:04 savage + Initial MacOS X support. Fixed defines for MACOS ( Classic ) and DARWIN ( MacOS X ). + + Revision 1.4 2004/04/13 09:32:08 savage + Changed Shared object names back to just the .so extension to avoid conflicts on various Linux/Unix distros. Therefore developers will need to create Symbolic links to the actual Share Objects if necessary. + + Revision 1.3 2004/04/01 20:53:23 savage + Changed Linux Shared Object names so they reflect the Symbolic Links that are created when installing the RPMs from the SDL site. + + Revision 1.2 2004/03/30 20:23:28 savage + Tidied up use of UNIX compiler directive. + + Revision 1.1 2004/02/14 23:35:42 savage + version 1 of sdl_image, sdl_mixer and smpeg. + + +} +{******************************************************************************} + +{$I jedi-sdl.inc} + +interface + +uses +{$IFDEF __GPC__} + gpc, +{$ENDIF} + sdl; + +const +{$IFDEF WINDOWS} + SDL_ImageLibName = 'SDL_Image.dll'; +{$ENDIF} + +{$IFDEF UNIX} +{$IFDEF DARWIN} + SDL_ImageLibName = 'libSDL_image-1.2.0.dylib'; + {$linklib libSDL_image} +{$ELSE} + {$IFDEF FPC} + SDL_ImageLibName = 'libSDL_image.so'; + {$ELSE} + SDL_ImageLibName = 'libSDL_image-1.2.so.0'; + {$ENDIF} +{$ENDIF} +{$ENDIF} + +{$IFDEF MACOS} + SDL_ImageLibName = 'SDL_image'; + {$linklib libSDL_image} +{$ENDIF} + + // Printable format: "%d.%d.%d", MAJOR, MINOR, PATCHLEVEL + SDL_IMAGE_MAJOR_VERSION = 1; +{$EXTERNALSYM SDL_IMAGE_MAJOR_VERSION} + SDL_IMAGE_MINOR_VERSION = 2; +{$EXTERNALSYM SDL_IMAGE_MINOR_VERSION} + SDL_IMAGE_PATCHLEVEL = 6; +{$EXTERNALSYM SDL_IMAGE_PATCHLEVEL} + +{ This macro can be used to fill a version structure with the compile-time + version of the SDL_image library. } +procedure SDL_IMAGE_VERSION( var X : TSDL_Version ); +{$EXTERNALSYM SDL_IMAGE_VERSION} + +{ This function gets the version of the dynamically linked SDL_image library. + it should NOT be used to fill a version structure, instead you should + use the SDL_IMAGE_VERSION() macro. + } +function IMG_Linked_Version : PSDL_version; +external {$IFDEF __GPC__}name 'IMG_Linked_Version'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_Linked_Version} + +{ Load an image from an SDL data source. + The 'type' may be one of: "BMP", "GIF", "PNG", etc. + + If the image format supports a transparent pixel, SDL will set the + colorkey for the surface. You can enable RLE acceleration on the + surface afterwards by calling: + SDL_SetColorKey(image, SDL_RLEACCEL, image.format.colorkey); +} +function IMG_LoadTyped_RW(src: PSDL_RWops; freesrc: Integer; _type: PChar): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'IMG_LoadTyped_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_LoadTyped_RW} +{ Convenience functions } +function IMG_Load(const _file: PChar): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'IMG_Load'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_Load} +function IMG_Load_RW(src: PSDL_RWops; freesrc: Integer): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'IMG_Load_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_Load_RW} + +{ Invert the alpha of a surface for use with OpenGL + This function is now a no-op, and only provided for backwards compatibility. } +function IMG_InvertAlpha(_on: Integer): Integer; +cdecl; external {$IFDEF __GPC__}name 'IMG_InvertAlpha'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_InvertAlpha} + +{ Functions to detect a file type, given a seekable source } +function IMG_isBMP(src: PSDL_RWops): Integer; +cdecl; external {$IFDEF __GPC__}name 'IMG_isBMP'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_isBMP} + +function IMG_isGIF(src: PSDL_RWops): Integer; +cdecl; external {$IFDEF __GPC__}name 'IMG_isGIF'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_isGIF} + +function IMG_isJPG(src: PSDL_RWops): Integer; +cdecl; external {$IFDEF __GPC__}name 'IMG_isJPG'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_isJPG} + +function IMG_isLBM(src: PSDL_RWops): Integer; +cdecl; external {$IFDEF __GPC__}name 'IMG_isLBM'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_isLBM} + +function IMG_isPCX(src: PSDL_RWops): Integer; +cdecl; external {$IFDEF __GPC__}name 'IMG_isPCX'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_isPCX} + +function IMG_isPNG(src: PSDL_RWops): Integer; +cdecl; external {$IFDEF __GPC__}name 'IMG_isPNG'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_isPNG} + +function IMG_isPNM(src: PSDL_RWops): Integer; +cdecl; external {$IFDEF __GPC__}name 'IMG_isPNM'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_isPNM} + +function IMG_isTIF(src: PSDL_RWops): Integer; +cdecl; external {$IFDEF __GPC__}name 'IMG_isTIF'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_isTIF} + +function IMG_isXCF(src: PSDL_RWops): Integer; +cdecl; external {$IFDEF __GPC__}name 'IMG_isXCF'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_isXCF} + +function IMG_isXPM(src: PSDL_RWops): Integer; +cdecl; external {$IFDEF __GPC__}name 'IMG_isXPM'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_isXPM} + +function IMG_isXV(src: PSDL_RWops): Integer; +cdecl; external {$IFDEF __GPC__}name 'IMG_isXV'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_isXV} + + +{ Individual loading functions } +function IMG_LoadBMP_RW(src: PSDL_RWops): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'IMG_LoadBMP_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_LoadBMP_RW} + +function IMG_LoadGIF_RW(src: PSDL_RWops): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'IMG_LoadGIF_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_LoadGIF_RW} + +function IMG_LoadJPG_RW(src: PSDL_RWops): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'IMG_LoadJPG_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_LoadJPG_RW} + +function IMG_LoadLBM_RW(src: PSDL_RWops): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'IMG_LoadLBM_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_LoadLBM_RW} + +function IMG_LoadPCX_RW(src: PSDL_RWops): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'IMG_LoadPCX_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_LoadPCX_RW} + +function IMG_LoadPNM_RW(src: PSDL_RWops): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'IMG_LoadPNM_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_LoadPNM_RW} + +function IMG_LoadPNG_RW(src: PSDL_RWops): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'IMG_LoadPNG_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_LoadPNG_RW} + +function IMG_LoadTGA_RW(src: PSDL_RWops): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'IMG_LoadTGA_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_LoadTGA_RW} + +function IMG_LoadTIF_RW(src: PSDL_RWops): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'IMG_LoadTIF_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_LoadTIF_RW} + +function IMG_LoadXCF_RW(src: PSDL_RWops): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'IMG_LoadXCF_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_LoadXCF_RW} + +function IMG_LoadXPM_RW(src: PSDL_RWops): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'IMG_LoadXPM_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_LoadXPM_RW} + +function IMG_LoadXV_RW(src: PSDL_RWops): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'IMG_LoadXV_RW'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_LoadXV_RW} + +function IMG_ReadXPMFromArray( xpm : PPChar ): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'IMG_ReadXPMFromArray'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +{$EXTERNALSYM IMG_ReadXPMFromArray} + + + + +{ used internally, NOT an exported function } +//function IMG_string_equals( const str1 : PChar; const str2 : PChar ) : integer; +//cdecl; external {$IFDEF __GPC__}name 'IMG_string_equals'{$ELSE} SDL_ImageLibName{$ENDIF __GPC__}; +//{ $ EXTERNALSYM IMG_string_equals} + +{ Error Macros } +{ We'll use SDL for reporting errors } +procedure IMG_SetError( fmt : PChar ); + +function IMG_GetError : PChar; + +implementation + +{$IFDEF __GPC__} + {$L 'sdl_image'} { link sdl_image.dll.a or libsdl_image.so or libsdl_image.a } +{$ENDIF} + +procedure SDL_IMAGE_VERSION( var X : TSDL_Version ); +begin + X.major := SDL_IMAGE_MAJOR_VERSION; + X.minor := SDL_IMAGE_MINOR_VERSION; + X.patch := SDL_IMAGE_PATCHLEVEL; +end; + +procedure IMG_SetError( fmt : PChar ); +begin + SDL_SetError( fmt ); +end; + +function IMG_GetError : PChar; +begin + result := SDL_GetError; +end; + +end. diff --git a/Game/Code/lib/JEDI-SDL/SDL_ttf/Pas/sdl_ttf.pas b/Game/Code/lib/JEDI-SDL/SDL_ttf/Pas/sdl_ttf.pas index 38447252..5c626372 100644 --- a/Game/Code/lib/JEDI-SDL/SDL_ttf/Pas/sdl_ttf.pas +++ b/Game/Code/lib/JEDI-SDL/SDL_ttf/Pas/sdl_ttf.pas @@ -1,506 +1,506 @@ -unit sdl_ttf;
-{
- $Id: sdl_ttf.pas,v 1.19 2007/12/05 22:54:20 savage Exp $
-
-}
-{******************************************************************************}
-{ }
-{ JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer }
-{ Conversion of the Simple DirectMedia Layer Headers }
-{ }
-{ Portions created by Sam Lantinga <slouken@devolution.com> are }
-{ Copyright (C) 1997, 1998, 1999, 2000, 2001 Sam Lantinga }
-{ 5635-34 Springhouse Dr. }
-{ Pleasanton, CA 94588 (USA) }
-{ }
-{ All Rights Reserved. }
-{ }
-{ The original files are : SDL_ttf.h }
-{ }
-{ The initial developer of this Pascal code was : }
-{ Dominqiue Louis <Dominique@SavageSoftware.com.au> }
-{ }
-{ Portions created by Dominqiue Louis are }
-{ Copyright (C) 2000 - 2001 Dominqiue Louis. }
-{ }
-{ }
-{ Contributor(s) }
-{ -------------- }
-{ Tom Jones <tigertomjones@gmx.de> His Project inspired this conversion }
-{ }
-{ Obtained through: }
-{ Joint Endeavour of Delphi Innovators ( Project JEDI ) }
-{ }
-{ You may retrieve the latest version of this file at the Project }
-{ JEDI home page, located at http://delphi-jedi.org }
-{ }
-{ The contents of this file are used with permission, subject to }
-{ the Mozilla Public License Version 1.1 (the "License"); you may }
-{ not use this file except in compliance with the License. You may }
-{ obtain a copy of the License at }
-{ http://www.mozilla.org/MPL/MPL-1.1.html }
-{ }
-{ Software distributed under the License is distributed on an }
-{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or }
-{ implied. See the License for the specific language governing }
-{ rights and limitations under the License. }
-{ }
-{ Description }
-{ ----------- }
-{ }
-{ }
-{ }
-{ }
-{ }
-{ }
-{ }
-{ Requires }
-{ -------- }
-{ The SDL Runtime libraris on Win32 : SDL.dll on Linux : libSDL.so }
-{ They are available from... }
-{ http://www.libsdl.org . }
-{ }
-{ Programming Notes }
-{ ----------------- }
-{ }
-{ }
-{ }
-{ }
-{ Revision History }
-{ ---------------- }
-{ December 08 2002 - DL : Fixed definition of TTF_RenderUnicode_Solid }
-{ }
-{ April 03 2003 - DL : Added jedi-sdl.inc include file to support more }
-{ Pascal compilers. Initial support is now included }
-{ for GnuPascal, VirtualPascal, TMT and obviously }
-{ continue support for Delphi Kylix and FreePascal. }
-{ }
-{ April 24 2003 - DL : under instruction from Alexey Barkovoy, I have added}
-{ better TMT Pascal support and under instruction }
-{ from Prof. Abimbola Olowofoyeku (The African Chief),}
-{ I have added better Gnu Pascal support }
-{ }
-{ April 30 2003 - DL : under instruction from David Mears AKA }
-{ Jason Siletto, I have added FPC Linux support. }
-{ This was compiled with fpc 1.1, so remember to set }
-{ include file path. ie. -Fi/usr/share/fpcsrc/rtl/* }
-{ }
-{
- $Log: sdl_ttf.pas,v $
- Revision 1.19 2007/12/05 22:54:20 savage
- Better Mac OS X support for Frameworks.
-
- Revision 1.18 2007/06/01 11:16:33 savage
- Added IFDEF UNIX for Workaround.
-
- Revision 1.17 2007/06/01 08:38:21 savage
- Added TTF_RenderText_Solid workaround as suggested by Michalis Kamburelis
-
- Revision 1.16 2007/05/29 21:32:14 savage
- Changes as suggested by Almindor for 64bit compatibility.
-
- Revision 1.15 2007/05/20 20:32:45 savage
- Initial Changes to Handle 64 Bits
-
- Revision 1.14 2006/12/02 00:19:01 savage
- Updated to latest version
-
- Revision 1.13 2005/04/10 11:48:33 savage
- Changes as suggested by Michalis, thanks.
-
- Revision 1.12 2005/01/05 01:47:14 savage
- Changed LibName to reflect what MacOS X should have. ie libSDL*-1.2.0.dylib respectively.
-
- Revision 1.11 2005/01/04 23:14:57 savage
- Changed LibName to reflect what most Linux distros will have. ie libSDL*-1.2.so.0 respectively.
-
- Revision 1.10 2005/01/02 19:07:32 savage
- Slight bug fix to use LongInt instead of Long ( Thanks Michalis Kamburelis )
-
- Revision 1.9 2005/01/01 02:15:20 savage
- Updated to v2.0.7
-
- Revision 1.8 2004/10/07 21:02:32 savage
- Fix for FPC
-
- Revision 1.7 2004/09/30 22:39:50 savage
- Added a true type font class which contains a wrap text function.
- Changed the sdl_ttf.pas header to reflect the future of jedi-sdl.
-
- Revision 1.6 2004/08/14 22:54:30 savage
- Updated so that Library name defines are correctly defined for MacOS X.
-
- Revision 1.5 2004/05/10 14:10:04 savage
- Initial MacOS X support. Fixed defines for MACOS ( Classic ) and DARWIN ( MacOS X ).
-
- Revision 1.4 2004/04/13 09:32:08 savage
- Changed Shared object names back to just the .so extension to avoid conflicts on various Linux/Unix distros. Therefore developers will need to create Symbolic links to the actual Share Objects if necessary.
-
- Revision 1.3 2004/04/01 20:53:24 savage
- Changed Linux Shared Object names so they reflect the Symbolic Links that are created when installing the RPMs from the SDL site.
-
- Revision 1.2 2004/03/30 20:23:28 savage
- Tidied up use of UNIX compiler directive.
-
- Revision 1.1 2004/02/16 22:16:40 savage
- v1.0 changes
-
-
-}
-{******************************************************************************}
-
-{$I jedi-sdl.inc}
-
-{
- Define this to workaround a known bug in some freetype versions.
- The error manifests as TTF_RenderGlyph_Solid returning nil (error)
- and error message (in SDL_Error) is
- "Failed loading DPMSDisable: /usr/lib/libX11.so.6: undefined symbol: DPMSDisable"
- See [http://lists.libsdl.org/pipermail/sdl-libsdl.org/2007-March/060459.html]
-}
-{$IFDEF UNIX}
-{$DEFINE Workaround_TTF_RenderText_Solid}
-{$ENDIF}
-
-
-interface
-
-uses
-{$IFDEF __GPC__}
- gpc,
-{$ENDIF}
-
-{$IFDEF WINDOWS}
- {$IFNDEF __GPC__}
- Windows,
- {$ENDIF}
-{$ENDIF}
- sdl;
-
-const
-{$IFDEF WINDOWS}
- SDLttfLibName = 'SDL_ttf.dll';
-{$ENDIF}
-
-{$IFDEF UNIX}
-{$IFDEF DARWIN}
- SDLttfLibName = 'libSDL_ttf-2.0.0.dylib';
- {$linklib libSDL_ttf}
-{$ELSE}
- {$IFDEF FPC}
- SDLttfLibName = 'libSDL_ttf.so';
- {$ELSE}
- SDLttfLibName = 'libSDL_ttf-2.0.so.0';
- {$ENDIF}
-{$ENDIF}
-{$ENDIF}
-
-{$IFDEF MACOS}
- SDLttfLibName = 'SDL_ttf';
- {$linklib libSDL_ttf}
-{$ENDIF}
-
- {* Printable format: "%d.%d.%d", MAJOR, MINOR, PATCHLEVEL *}
- SDL_TTF_MAJOR_VERSION = 2;
-{$EXTERNALSYM SDL_TTF_MAJOR_VERSION}
- SDL_TTF_MINOR_VERSION = 0;
-{$EXTERNALSYM SDL_TTF_MINOR_VERSION}
- SDL_TTF_PATCHLEVEL = 9;
-{$EXTERNALSYM SDL_TTF_PATCHLEVEL}
-
- // Backwards compatibility
- TTF_MAJOR_VERSION = SDL_TTF_MAJOR_VERSION;
- TTF_MINOR_VERSION = SDL_TTF_MINOR_VERSION;
- TTF_PATCHLEVEL = SDL_TTF_PATCHLEVEL;
-
-{*
- Set and retrieve the font style
- This font style is implemented by modifying the font glyphs, and
- doesn't reflect any inherent properties of the truetype font file.
-*}
- TTF_STYLE_NORMAL = $00;
- TTF_STYLE_BOLD = $01;
- TTF_STYLE_ITALIC = $02;
- TTF_STYLE_UNDERLINE = $04;
-
-// ZERO WIDTH NO-BREAKSPACE (Unicode byte order mark)
- UNICODE_BOM_NATIVE = $FEFF;
- UNICODE_BOM_SWAPPED = $FFFE;
-
-type
- PTTF_Font = ^TTTF_font;
- TTTF_Font = record
- end;
-
-{ This macro can be used to fill a version structure with the compile-time
- version of the SDL_ttf library. }
-procedure SDL_TTF_VERSION( var X : TSDL_version );
-{$EXTERNALSYM SDL_TTF_VERSION}
-
-{ This function gets the version of the dynamically linked SDL_ttf library.
- It should NOT be used to fill a version structure, instead you should use the
- SDL_TTF_VERSION() macro. }
-function TTF_Linked_Version : PSDL_version;
-cdecl; external {$IFDEF __GPC__}name 'TTF_Linked_Version'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_Linked_Version}
-
-{ This function tells the library whether UNICODE text is generally
- byteswapped. A UNICODE BOM character in a string will override
- this setting for the remainder of that string.
-}
-procedure TTF_ByteSwappedUNICODE( swapped : integer );
-cdecl; external {$IFDEF __GPC__}name 'TTF_ByteSwappedUNICODE'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_ByteSwappedUNICODE}
-
-//returns 0 on succes, -1 if error occurs
-function TTF_Init : integer;
-cdecl; external {$IFDEF __GPC__}name 'TTF_Init'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_Init}
-
-{
- Open a font file and create a font of the specified point size.
- Some .fon fonts will have several sizes embedded in the file, so the
- point size becomes the index of choosing which size. If the value
- is too high, the last indexed size will be the default.
-}
-function TTF_OpenFont( const filename : Pchar; ptsize : integer ) : PTTF_Font;
-cdecl; external {$IFDEF __GPC__}name 'TTF_OpenFont'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_OpenFont}
-
-function TTF_OpenFontIndex( const filename : Pchar; ptsize : integer; index : Longint ): PTTF_Font;
-cdecl; external {$IFDEF __GPC__}name 'TTF_OpenFontIndex'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_OpenFontIndex}
-
-function TTF_OpenFontRW( src : PSDL_RWops; freesrc : integer; ptsize : integer ): PTTF_Font;
-cdecl; external {$IFDEF __GPC__}name 'TTF_OpenFontRW'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_OpenFontRW}
-
-function TTF_OpenFontIndexRW( src : PSDL_RWops; freesrc : integer; ptsize : integer; index : Longint ): PTTF_Font;
-cdecl; external {$IFDEF __GPC__}name 'TTF_OpenFontIndexRW'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_OpenFontIndexRW}
-
-function TTF_GetFontStyle( font : PTTF_Font) : integer;
-cdecl; external {$IFDEF __GPC__}name 'TTF_GetFontStyle'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_GetFontStyle}
-
-procedure TTF_SetFontStyle( font : PTTF_Font; style : integer );
-cdecl; external {$IFDEF __GPC__}name 'TTF_SetFontStyle'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_SetFontStyle}
-
-{ Get the total height of the font - usually equal to point size }
-function TTF_FontHeight( font : PTTF_Font ) : Integer;
-cdecl; external {$IFDEF __GPC__}name 'TTF_FontHeight'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_FontHeight}
-
-{ Get the offset from the baseline to the top of the font
- This is a positive value, relative to the baseline.
-}
-function TTF_FontAscent( font : PTTF_Font ) : Integer;
-cdecl; external {$IFDEF __GPC__}name 'TTF_FontAscent'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_FontAscent}
-{ Get the offset from the baseline to the bottom of the font
- This is a negative value, relative to the baseline.
-}
-function TTF_FontDescent( font : PTTF_Font ) : Integer;
-cdecl; external {$IFDEF __GPC__}name 'TTF_FontDescent'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_FontDescent}
-
-{ Get the recommended spacing between lines of text for this font }
-function TTF_FontLineSkip( font : PTTF_Font ): Integer;
-cdecl; external {$IFDEF __GPC__}name 'TTF_FontLineSkip'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_FontLineSkip}
-
-{ Get the number of faces of the font }
-function TTF_FontFaces( font : PTTF_Font ) : Longint;
-cdecl; external {$IFDEF __GPC__}name 'TTF_FontFaces'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_FontFaces}
-
-{ Get the font face attributes, if any }
-function TTF_FontFaceIsFixedWidth( font : PTTF_Font ): Integer;
-cdecl; external {$IFDEF __GPC__}name 'TTF_FontFaceIsFixedWidth'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_FontFaceIsFixedWidth}
-
-function TTF_FontFaceFamilyName( font : PTTF_Font ): PChar;
-cdecl; external {$IFDEF __GPC__}name 'TTF_FontFaceFamilyName'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_FontFaceFamilyName}
-
-function TTF_FontFaceStyleName( font : PTTF_Font ): PChar;
-cdecl; external {$IFDEF __GPC__}name 'TTF_FontFaceStyleName'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_FontFaceStyleName}
-
-{ Get the metrics (dimensions) of a glyph }
-function TTF_GlyphMetrics( font : PTTF_Font; ch : Uint16;
- var minx : integer; var maxx : integer;
- var miny : integer; var maxy : integer;
- var advance : integer ): Integer;
-cdecl; external {$IFDEF __GPC__}name 'TTF_GlyphMetrics'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_GlyphMetrics}
-
-{ Get the dimensions of a rendered string of text }
-function TTF_SizeText( font : PTTF_Font; const text : PChar; var w : integer; var y : integer ): Integer;
-cdecl; external {$IFDEF __GPC__}name 'TTF_SizeText'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_SizeText}
-
-function TTF_SizeUTF8( font : PTTF_Font; const text : PChar; var w : integer; var y : integer): Integer;
-cdecl; external {$IFDEF __GPC__}name 'TTF_SizeUTF8'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_SizeUTF8}
-
-function TTF_SizeUNICODE( font : PTTF_Font; const text : PUint16; var w : integer; var y : integer): Integer;
-cdecl; external {$IFDEF __GPC__}name 'TTF_SizeUNICODE'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_SizeUNICODE}
-
-{ Create an 8-bit palettized surface and render the given text at
- fast quality with the given font and color. The 0 pixel is the
- colorkey, giving a transparent background, and the 1 pixel is set
- to the text color.
- This function returns the new surface, or NULL if there was an error.
-}
-function TTF_RenderText_Solid( font : PTTF_Font;
- const text : PChar; fg : TSDL_Color ): PSDL_Surface;
-{$IFNDEF Workaround_TTF_RenderText_Solid}
-cdecl; external {$IFDEF __GPC__}name 'TTF_RenderText_Solid'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_RenderText_Solid}
-{$ENDIF}
-
-function TTF_RenderUTF8_Solid( font : PTTF_Font;
- const text : PChar; fg : TSDL_Color ): PSDL_Surface;
-cdecl; external {$IFDEF __GPC__}name 'TTF_RenderUTF8_Solid'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_RenderUTF8_Solid}
-
-function TTF_RenderUNICODE_Solid( font : PTTF_Font;
- const text :PUint16; fg : TSDL_Color ): PSDL_Surface;
-cdecl; external {$IFDEF __GPC__}name 'TTF_RenderUNICODE_Solid'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_RenderUNICODE_Solid}
-
-{
-Create an 8-bit palettized surface and render the given glyph at
- fast quality with the given font and color. The 0 pixel is the
- colorkey, giving a transparent background, and the 1 pixel is set
- to the text color. The glyph is rendered without any padding or
- centering in the X direction, and aligned normally in the Y direction.
- This function returns the new surface, or NULL if there was an error.
-}
-function TTF_RenderGlyph_Solid( font : PTTF_Font;
- ch : Uint16; fg : TSDL_Color ): PSDL_Surface;
-cdecl; external {$IFDEF __GPC__}name 'TTF_RenderGlyph_Solid'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_RenderGlyph_Solid}
-
-{ Create an 8-bit palettized surface and render the given text at
- high quality with the given font and colors. The 0 pixel is background,
- while other pixels have varying degrees of the foreground color.
- This function returns the new surface, or NULL if there was an error.
-}
-function TTF_RenderText_Shaded( font : PTTF_Font;
- const text : PChar; fg : TSDL_Color; bg : TSDL_Color ): PSDL_Surface;
-cdecl; external {$IFDEF __GPC__}name 'TTF_RenderText_Shaded'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_RenderText_Shaded}
-function TTF_RenderUTF8_Shaded( font : PTTF_Font;
- const text : PChar; fg : TSDL_Color; bg : TSDL_Color ): PSDL_Surface;
-cdecl; external {$IFDEF __GPC__}name 'TTF_RenderUTF8_Shaded'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_RenderUTF8_Shaded}
-function TTF_RenderUNICODE_Shaded( font : PTTF_Font;
- const text : PUint16; fg : TSDL_Color; bg : TSDL_Color ): PSDL_Surface;
-cdecl; external {$IFDEF __GPC__}name 'TTF_RenderUNICODE_Shaded'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_RenderUNICODE_Shaded}
-
-{ Create an 8-bit palettized surface and render the given glyph at
- high quality with the given font and colors. The 0 pixel is background,
- while other pixels have varying degrees of the foreground color.
- The glyph is rendered without any padding or centering in the X
- direction, and aligned normally in the Y direction.
- This function returns the new surface, or NULL if there was an error.
-}
-function TTF_RenderGlyph_Shaded( font : PTTF_Font; ch : Uint16; fg : TSDL_Color;
- bg : TSDL_Color ): PSDL_Surface;
-cdecl; external {$IFDEF __GPC__}name 'TTF_RenderGlyph_Shaded'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_RenderGlyph_Shaded}
-
-{ Create a 32-bit ARGB surface and render the given text at high quality,
- using alpha blending to dither the font with the given color.
- This function returns the new surface, or NULL if there was an error.
-}
-function TTF_RenderText_Blended( font : PTTF_Font;
- const text : PChar; fg : TSDL_Color ): PSDL_Surface;
-cdecl; external {$IFDEF __GPC__}name 'TTF_RenderText_Blended'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_RenderText_Blended}
-function TTF_RenderUTF8_Blended( font : PTTF_Font;
- const text : PChar; fg : TSDL_Color ): PSDL_Surface;
-cdecl; external {$IFDEF __GPC__}name 'TTF_RenderUTF8_Blended'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_RenderUTF8_Blended}
-function TTF_RenderUNICODE_Blended( font : PTTF_Font;
- const text: PUint16; fg : TSDL_Color ): PSDL_Surface;
-cdecl; external {$IFDEF __GPC__}name 'TTF_RenderUNICODE_Blended'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_RenderUNICODE_Blended}
-
-{ Create a 32-bit ARGB surface and render the given glyph at high quality,
- using alpha blending to dither the font with the given color.
- The glyph is rendered without any padding or centering in the X
- direction, and aligned normally in the Y direction.
- This function returns the new surface, or NULL if there was an error.
-}
-function TTF_RenderGlyph_Blended( font : PTTF_Font; ch : Uint16; fg : TSDL_Color ): PSDL_Surface;
-cdecl; external {$IFDEF __GPC__}name 'TTF_RenderGlyph_Blended'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_RenderGlyph_Blended}
-
-{ For compatibility with previous versions, here are the old functions }
-{#define TTF_RenderText(font, text, fg, bg)
- TTF_RenderText_Shaded(font, text, fg, bg)
-#define TTF_RenderUTF8(font, text, fg, bg)
- TTF_RenderUTF8_Shaded(font, text, fg, bg)
-#define TTF_RenderUNICODE(font, text, fg, bg)
- TTF_RenderUNICODE_Shaded(font, text, fg, bg)}
-
-{ Close an opened font file }
-procedure TTF_CloseFont( font : PTTF_Font );
-cdecl; external {$IFDEF __GPC__}name 'TTF_CloseFont'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_CloseFont}
-
-//De-initialize TTF engine
-procedure TTF_Quit;
-cdecl; external {$IFDEF __GPC__}name 'TTF_Quit'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_Quit}
-
-// Check if the TTF engine is initialized
-function TTF_WasInit : integer;
-cdecl; external {$IFDEF __GPC__}name 'TTF_WasInit'{$ELSE} SDLttfLibName{$ENDIF __GPC__};
-{$EXTERNALSYM TTF_WasInit}
-
-// We'll use SDL for reporting errors
-procedure TTF_SetError( fmt : PChar );
-
-function TTF_GetError : PChar;
-
-implementation
-
-{$IFDEF __GPC__}
- {$L 'sdl_ttf'} { link sdl_ttf.dll.a or libsdl_ttf.so or libsdl_ttf.a }
-{$ENDIF}
-
-procedure SDL_TTF_VERSION( var X : TSDL_version );
-begin
- X.major := SDL_TTF_MAJOR_VERSION;
- X.minor := SDL_TTF_MINOR_VERSION;
- X.patch := SDL_TTF_PATCHLEVEL;
-end;
-
-procedure TTF_SetError( fmt : PChar );
-begin
- SDL_SetError( fmt );
-end;
-
-function TTF_GetError : PChar;
-begin
- result := SDL_GetError;
-end;
-
-{$IFDEF Workaround_TTF_RenderText_Solid}
-function TTF_RenderText_Solid( font : PTTF_Font;
- const text : PChar; fg : TSDL_Color ): PSDL_Surface;
-const
- Black: TSDL_Color = (r: 0; g: 0; b: 0; unused: 0);
-begin
- Result := TTF_RenderText_Shaded(font, text, fg, Black);
-end;
-{$ENDIF Workaround_TTF_RenderText_Solid}
-
-end.
+unit sdl_ttf; +{ + $Id: sdl_ttf.pas,v 1.19 2007/12/05 22:54:20 savage Exp $ + +} +{******************************************************************************} +{ } +{ JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer } +{ Conversion of the Simple DirectMedia Layer Headers } +{ } +{ Portions created by Sam Lantinga <slouken@devolution.com> are } +{ Copyright (C) 1997, 1998, 1999, 2000, 2001 Sam Lantinga } +{ 5635-34 Springhouse Dr. } +{ Pleasanton, CA 94588 (USA) } +{ } +{ All Rights Reserved. } +{ } +{ The original files are : SDL_ttf.h } +{ } +{ The initial developer of this Pascal code was : } +{ Dominqiue Louis <Dominique@SavageSoftware.com.au> } +{ } +{ Portions created by Dominqiue Louis are } +{ Copyright (C) 2000 - 2001 Dominqiue Louis. } +{ } +{ } +{ Contributor(s) } +{ -------------- } +{ Tom Jones <tigertomjones@gmx.de> His Project inspired this conversion } +{ } +{ Obtained through: } +{ Joint Endeavour of Delphi Innovators ( Project JEDI ) } +{ } +{ You may retrieve the latest version of this file at the Project } +{ JEDI home page, located at http://delphi-jedi.org } +{ } +{ The contents of this file are used with permission, subject to } +{ the Mozilla Public License Version 1.1 (the "License"); you may } +{ not use this file except in compliance with the License. You may } +{ obtain a copy of the License at } +{ http://www.mozilla.org/MPL/MPL-1.1.html } +{ } +{ Software distributed under the License is distributed on an } +{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or } +{ implied. See the License for the specific language governing } +{ rights and limitations under the License. } +{ } +{ Description } +{ ----------- } +{ } +{ } +{ } +{ } +{ } +{ } +{ } +{ Requires } +{ -------- } +{ The SDL Runtime libraris on Win32 : SDL.dll on Linux : libSDL.so } +{ They are available from... } +{ http://www.libsdl.org . } +{ } +{ Programming Notes } +{ ----------------- } +{ } +{ } +{ } +{ } +{ Revision History } +{ ---------------- } +{ December 08 2002 - DL : Fixed definition of TTF_RenderUnicode_Solid } +{ } +{ April 03 2003 - DL : Added jedi-sdl.inc include file to support more } +{ Pascal compilers. Initial support is now included } +{ for GnuPascal, VirtualPascal, TMT and obviously } +{ continue support for Delphi Kylix and FreePascal. } +{ } +{ April 24 2003 - DL : under instruction from Alexey Barkovoy, I have added} +{ better TMT Pascal support and under instruction } +{ from Prof. Abimbola Olowofoyeku (The African Chief),} +{ I have added better Gnu Pascal support } +{ } +{ April 30 2003 - DL : under instruction from David Mears AKA } +{ Jason Siletto, I have added FPC Linux support. } +{ This was compiled with fpc 1.1, so remember to set } +{ include file path. ie. -Fi/usr/share/fpcsrc/rtl/* } +{ } +{ + $Log: sdl_ttf.pas,v $ + Revision 1.19 2007/12/05 22:54:20 savage + Better Mac OS X support for Frameworks. + + Revision 1.18 2007/06/01 11:16:33 savage + Added IFDEF UNIX for Workaround. + + Revision 1.17 2007/06/01 08:38:21 savage + Added TTF_RenderText_Solid workaround as suggested by Michalis Kamburelis + + Revision 1.16 2007/05/29 21:32:14 savage + Changes as suggested by Almindor for 64bit compatibility. + + Revision 1.15 2007/05/20 20:32:45 savage + Initial Changes to Handle 64 Bits + + Revision 1.14 2006/12/02 00:19:01 savage + Updated to latest version + + Revision 1.13 2005/04/10 11:48:33 savage + Changes as suggested by Michalis, thanks. + + Revision 1.12 2005/01/05 01:47:14 savage + Changed LibName to reflect what MacOS X should have. ie libSDL*-1.2.0.dylib respectively. + + Revision 1.11 2005/01/04 23:14:57 savage + Changed LibName to reflect what most Linux distros will have. ie libSDL*-1.2.so.0 respectively. + + Revision 1.10 2005/01/02 19:07:32 savage + Slight bug fix to use LongInt instead of Long ( Thanks Michalis Kamburelis ) + + Revision 1.9 2005/01/01 02:15:20 savage + Updated to v2.0.7 + + Revision 1.8 2004/10/07 21:02:32 savage + Fix for FPC + + Revision 1.7 2004/09/30 22:39:50 savage + Added a true type font class which contains a wrap text function. + Changed the sdl_ttf.pas header to reflect the future of jedi-sdl. + + Revision 1.6 2004/08/14 22:54:30 savage + Updated so that Library name defines are correctly defined for MacOS X. + + Revision 1.5 2004/05/10 14:10:04 savage + Initial MacOS X support. Fixed defines for MACOS ( Classic ) and DARWIN ( MacOS X ). + + Revision 1.4 2004/04/13 09:32:08 savage + Changed Shared object names back to just the .so extension to avoid conflicts on various Linux/Unix distros. Therefore developers will need to create Symbolic links to the actual Share Objects if necessary. + + Revision 1.3 2004/04/01 20:53:24 savage + Changed Linux Shared Object names so they reflect the Symbolic Links that are created when installing the RPMs from the SDL site. + + Revision 1.2 2004/03/30 20:23:28 savage + Tidied up use of UNIX compiler directive. + + Revision 1.1 2004/02/16 22:16:40 savage + v1.0 changes + + +} +{******************************************************************************} + +{$I jedi-sdl.inc} + +{ + Define this to workaround a known bug in some freetype versions. + The error manifests as TTF_RenderGlyph_Solid returning nil (error) + and error message (in SDL_Error) is + "Failed loading DPMSDisable: /usr/lib/libX11.so.6: undefined symbol: DPMSDisable" + See [http://lists.libsdl.org/pipermail/sdl-libsdl.org/2007-March/060459.html] +} +{$IFDEF UNIX} +{$DEFINE Workaround_TTF_RenderText_Solid} +{$ENDIF} + + +interface + +uses +{$IFDEF __GPC__} + gpc, +{$ENDIF} + +{$IFDEF WINDOWS} + {$IFNDEF __GPC__} + Windows, + {$ENDIF} +{$ENDIF} + sdl; + +const +{$IFDEF WINDOWS} + SDLttfLibName = 'SDL_ttf.dll'; +{$ENDIF} + +{$IFDEF UNIX} +{$IFDEF DARWIN} + SDLttfLibName = 'libSDL_ttf-2.0.0.dylib'; + {$linklib libSDL_ttf} +{$ELSE} + {$IFDEF FPC} + SDLttfLibName = 'libSDL_ttf.so'; + {$ELSE} + SDLttfLibName = 'libSDL_ttf-2.0.so.0'; + {$ENDIF} +{$ENDIF} +{$ENDIF} + +{$IFDEF MACOS} + SDLttfLibName = 'SDL_ttf'; + {$linklib libSDL_ttf} +{$ENDIF} + + {* Printable format: "%d.%d.%d", MAJOR, MINOR, PATCHLEVEL *} + SDL_TTF_MAJOR_VERSION = 2; +{$EXTERNALSYM SDL_TTF_MAJOR_VERSION} + SDL_TTF_MINOR_VERSION = 0; +{$EXTERNALSYM SDL_TTF_MINOR_VERSION} + SDL_TTF_PATCHLEVEL = 9; +{$EXTERNALSYM SDL_TTF_PATCHLEVEL} + + // Backwards compatibility + TTF_MAJOR_VERSION = SDL_TTF_MAJOR_VERSION; + TTF_MINOR_VERSION = SDL_TTF_MINOR_VERSION; + TTF_PATCHLEVEL = SDL_TTF_PATCHLEVEL; + +{* + Set and retrieve the font style + This font style is implemented by modifying the font glyphs, and + doesn't reflect any inherent properties of the truetype font file. +*} + TTF_STYLE_NORMAL = $00; + TTF_STYLE_BOLD = $01; + TTF_STYLE_ITALIC = $02; + TTF_STYLE_UNDERLINE = $04; + +// ZERO WIDTH NO-BREAKSPACE (Unicode byte order mark) + UNICODE_BOM_NATIVE = $FEFF; + UNICODE_BOM_SWAPPED = $FFFE; + +type + PTTF_Font = ^TTTF_font; + TTTF_Font = record + end; + +{ This macro can be used to fill a version structure with the compile-time + version of the SDL_ttf library. } +procedure SDL_TTF_VERSION( var X : TSDL_version ); +{$EXTERNALSYM SDL_TTF_VERSION} + +{ This function gets the version of the dynamically linked SDL_ttf library. + It should NOT be used to fill a version structure, instead you should use the + SDL_TTF_VERSION() macro. } +function TTF_Linked_Version : PSDL_version; +cdecl; external {$IFDEF __GPC__}name 'TTF_Linked_Version'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_Linked_Version} + +{ This function tells the library whether UNICODE text is generally + byteswapped. A UNICODE BOM character in a string will override + this setting for the remainder of that string. +} +procedure TTF_ByteSwappedUNICODE( swapped : integer ); +cdecl; external {$IFDEF __GPC__}name 'TTF_ByteSwappedUNICODE'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_ByteSwappedUNICODE} + +//returns 0 on succes, -1 if error occurs +function TTF_Init : integer; +cdecl; external {$IFDEF __GPC__}name 'TTF_Init'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_Init} + +{ + Open a font file and create a font of the specified point size. + Some .fon fonts will have several sizes embedded in the file, so the + point size becomes the index of choosing which size. If the value + is too high, the last indexed size will be the default. +} +function TTF_OpenFont( const filename : Pchar; ptsize : integer ) : PTTF_Font; +cdecl; external {$IFDEF __GPC__}name 'TTF_OpenFont'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_OpenFont} + +function TTF_OpenFontIndex( const filename : Pchar; ptsize : integer; index : Longint ): PTTF_Font; +cdecl; external {$IFDEF __GPC__}name 'TTF_OpenFontIndex'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_OpenFontIndex} + +function TTF_OpenFontRW( src : PSDL_RWops; freesrc : integer; ptsize : integer ): PTTF_Font; +cdecl; external {$IFDEF __GPC__}name 'TTF_OpenFontRW'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_OpenFontRW} + +function TTF_OpenFontIndexRW( src : PSDL_RWops; freesrc : integer; ptsize : integer; index : Longint ): PTTF_Font; +cdecl; external {$IFDEF __GPC__}name 'TTF_OpenFontIndexRW'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_OpenFontIndexRW} + +function TTF_GetFontStyle( font : PTTF_Font) : integer; +cdecl; external {$IFDEF __GPC__}name 'TTF_GetFontStyle'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_GetFontStyle} + +procedure TTF_SetFontStyle( font : PTTF_Font; style : integer ); +cdecl; external {$IFDEF __GPC__}name 'TTF_SetFontStyle'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_SetFontStyle} + +{ Get the total height of the font - usually equal to point size } +function TTF_FontHeight( font : PTTF_Font ) : Integer; +cdecl; external {$IFDEF __GPC__}name 'TTF_FontHeight'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_FontHeight} + +{ Get the offset from the baseline to the top of the font + This is a positive value, relative to the baseline. +} +function TTF_FontAscent( font : PTTF_Font ) : Integer; +cdecl; external {$IFDEF __GPC__}name 'TTF_FontAscent'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_FontAscent} +{ Get the offset from the baseline to the bottom of the font + This is a negative value, relative to the baseline. +} +function TTF_FontDescent( font : PTTF_Font ) : Integer; +cdecl; external {$IFDEF __GPC__}name 'TTF_FontDescent'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_FontDescent} + +{ Get the recommended spacing between lines of text for this font } +function TTF_FontLineSkip( font : PTTF_Font ): Integer; +cdecl; external {$IFDEF __GPC__}name 'TTF_FontLineSkip'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_FontLineSkip} + +{ Get the number of faces of the font } +function TTF_FontFaces( font : PTTF_Font ) : Longint; +cdecl; external {$IFDEF __GPC__}name 'TTF_FontFaces'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_FontFaces} + +{ Get the font face attributes, if any } +function TTF_FontFaceIsFixedWidth( font : PTTF_Font ): Integer; +cdecl; external {$IFDEF __GPC__}name 'TTF_FontFaceIsFixedWidth'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_FontFaceIsFixedWidth} + +function TTF_FontFaceFamilyName( font : PTTF_Font ): PChar; +cdecl; external {$IFDEF __GPC__}name 'TTF_FontFaceFamilyName'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_FontFaceFamilyName} + +function TTF_FontFaceStyleName( font : PTTF_Font ): PChar; +cdecl; external {$IFDEF __GPC__}name 'TTF_FontFaceStyleName'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_FontFaceStyleName} + +{ Get the metrics (dimensions) of a glyph } +function TTF_GlyphMetrics( font : PTTF_Font; ch : Uint16; + var minx : integer; var maxx : integer; + var miny : integer; var maxy : integer; + var advance : integer ): Integer; +cdecl; external {$IFDEF __GPC__}name 'TTF_GlyphMetrics'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_GlyphMetrics} + +{ Get the dimensions of a rendered string of text } +function TTF_SizeText( font : PTTF_Font; const text : PChar; var w : integer; var y : integer ): Integer; +cdecl; external {$IFDEF __GPC__}name 'TTF_SizeText'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_SizeText} + +function TTF_SizeUTF8( font : PTTF_Font; const text : PChar; var w : integer; var y : integer): Integer; +cdecl; external {$IFDEF __GPC__}name 'TTF_SizeUTF8'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_SizeUTF8} + +function TTF_SizeUNICODE( font : PTTF_Font; const text : PUint16; var w : integer; var y : integer): Integer; +cdecl; external {$IFDEF __GPC__}name 'TTF_SizeUNICODE'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_SizeUNICODE} + +{ Create an 8-bit palettized surface and render the given text at + fast quality with the given font and color. The 0 pixel is the + colorkey, giving a transparent background, and the 1 pixel is set + to the text color. + This function returns the new surface, or NULL if there was an error. +} +function TTF_RenderText_Solid( font : PTTF_Font; + const text : PChar; fg : TSDL_Color ): PSDL_Surface; +{$IFNDEF Workaround_TTF_RenderText_Solid} +cdecl; external {$IFDEF __GPC__}name 'TTF_RenderText_Solid'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_RenderText_Solid} +{$ENDIF} + +function TTF_RenderUTF8_Solid( font : PTTF_Font; + const text : PChar; fg : TSDL_Color ): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'TTF_RenderUTF8_Solid'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_RenderUTF8_Solid} + +function TTF_RenderUNICODE_Solid( font : PTTF_Font; + const text :PUint16; fg : TSDL_Color ): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'TTF_RenderUNICODE_Solid'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_RenderUNICODE_Solid} + +{ +Create an 8-bit palettized surface and render the given glyph at + fast quality with the given font and color. The 0 pixel is the + colorkey, giving a transparent background, and the 1 pixel is set + to the text color. The glyph is rendered without any padding or + centering in the X direction, and aligned normally in the Y direction. + This function returns the new surface, or NULL if there was an error. +} +function TTF_RenderGlyph_Solid( font : PTTF_Font; + ch : Uint16; fg : TSDL_Color ): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'TTF_RenderGlyph_Solid'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_RenderGlyph_Solid} + +{ Create an 8-bit palettized surface and render the given text at + high quality with the given font and colors. The 0 pixel is background, + while other pixels have varying degrees of the foreground color. + This function returns the new surface, or NULL if there was an error. +} +function TTF_RenderText_Shaded( font : PTTF_Font; + const text : PChar; fg : TSDL_Color; bg : TSDL_Color ): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'TTF_RenderText_Shaded'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_RenderText_Shaded} +function TTF_RenderUTF8_Shaded( font : PTTF_Font; + const text : PChar; fg : TSDL_Color; bg : TSDL_Color ): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'TTF_RenderUTF8_Shaded'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_RenderUTF8_Shaded} +function TTF_RenderUNICODE_Shaded( font : PTTF_Font; + const text : PUint16; fg : TSDL_Color; bg : TSDL_Color ): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'TTF_RenderUNICODE_Shaded'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_RenderUNICODE_Shaded} + +{ Create an 8-bit palettized surface and render the given glyph at + high quality with the given font and colors. The 0 pixel is background, + while other pixels have varying degrees of the foreground color. + The glyph is rendered without any padding or centering in the X + direction, and aligned normally in the Y direction. + This function returns the new surface, or NULL if there was an error. +} +function TTF_RenderGlyph_Shaded( font : PTTF_Font; ch : Uint16; fg : TSDL_Color; + bg : TSDL_Color ): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'TTF_RenderGlyph_Shaded'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_RenderGlyph_Shaded} + +{ Create a 32-bit ARGB surface and render the given text at high quality, + using alpha blending to dither the font with the given color. + This function returns the new surface, or NULL if there was an error. +} +function TTF_RenderText_Blended( font : PTTF_Font; + const text : PChar; fg : TSDL_Color ): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'TTF_RenderText_Blended'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_RenderText_Blended} +function TTF_RenderUTF8_Blended( font : PTTF_Font; + const text : PChar; fg : TSDL_Color ): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'TTF_RenderUTF8_Blended'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_RenderUTF8_Blended} +function TTF_RenderUNICODE_Blended( font : PTTF_Font; + const text: PUint16; fg : TSDL_Color ): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'TTF_RenderUNICODE_Blended'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_RenderUNICODE_Blended} + +{ Create a 32-bit ARGB surface and render the given glyph at high quality, + using alpha blending to dither the font with the given color. + The glyph is rendered without any padding or centering in the X + direction, and aligned normally in the Y direction. + This function returns the new surface, or NULL if there was an error. +} +function TTF_RenderGlyph_Blended( font : PTTF_Font; ch : Uint16; fg : TSDL_Color ): PSDL_Surface; +cdecl; external {$IFDEF __GPC__}name 'TTF_RenderGlyph_Blended'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_RenderGlyph_Blended} + +{ For compatibility with previous versions, here are the old functions } +{#define TTF_RenderText(font, text, fg, bg) + TTF_RenderText_Shaded(font, text, fg, bg) +#define TTF_RenderUTF8(font, text, fg, bg) + TTF_RenderUTF8_Shaded(font, text, fg, bg) +#define TTF_RenderUNICODE(font, text, fg, bg) + TTF_RenderUNICODE_Shaded(font, text, fg, bg)} + +{ Close an opened font file } +procedure TTF_CloseFont( font : PTTF_Font ); +cdecl; external {$IFDEF __GPC__}name 'TTF_CloseFont'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_CloseFont} + +//De-initialize TTF engine +procedure TTF_Quit; +cdecl; external {$IFDEF __GPC__}name 'TTF_Quit'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_Quit} + +// Check if the TTF engine is initialized +function TTF_WasInit : integer; +cdecl; external {$IFDEF __GPC__}name 'TTF_WasInit'{$ELSE} SDLttfLibName{$ENDIF __GPC__}; +{$EXTERNALSYM TTF_WasInit} + +// We'll use SDL for reporting errors +procedure TTF_SetError( fmt : PChar ); + +function TTF_GetError : PChar; + +implementation + +{$IFDEF __GPC__} + {$L 'sdl_ttf'} { link sdl_ttf.dll.a or libsdl_ttf.so or libsdl_ttf.a } +{$ENDIF} + +procedure SDL_TTF_VERSION( var X : TSDL_version ); +begin + X.major := SDL_TTF_MAJOR_VERSION; + X.minor := SDL_TTF_MINOR_VERSION; + X.patch := SDL_TTF_PATCHLEVEL; +end; + +procedure TTF_SetError( fmt : PChar ); +begin + SDL_SetError( fmt ); +end; + +function TTF_GetError : PChar; +begin + result := SDL_GetError; +end; + +{$IFDEF Workaround_TTF_RenderText_Solid} +function TTF_RenderText_Solid( font : PTTF_Font; + const text : PChar; fg : TSDL_Color ): PSDL_Surface; +const + Black: TSDL_Color = (r: 0; g: 0; b: 0; unused: 0); +begin + Result := TTF_RenderText_Shaded(font, text, fg, Black); +end; +{$ENDIF Workaround_TTF_RenderText_Solid} + +end. diff --git a/Game/Code/lib/JEDI-SDL/SDL_ttf/Pas/sdltruetypefont.pas b/Game/Code/lib/JEDI-SDL/SDL_ttf/Pas/sdltruetypefont.pas index a0f25e12..a457c1d9 100644 --- a/Game/Code/lib/JEDI-SDL/SDL_ttf/Pas/sdltruetypefont.pas +++ b/Game/Code/lib/JEDI-SDL/SDL_ttf/Pas/sdltruetypefont.pas @@ -1,565 +1,565 @@ -unit sdltruetypefont;
-{
- $Id: sdltruetypefont.pas,v 1.5 2005/05/26 21:22:28 savage Exp $
-
-}
-{******************************************************************************}
-{ }
-{ JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer }
-{ Wrapper class for SDL_ttf }
-{ }
-{ The initial developer of this Pascal code was : }
-{ Dominqiue Louis <Dominique@SavageSoftware.com.au> }
-{ }
-{ Portions created by Dominqiue Louis are }
-{ Copyright (C) 2000 - 2001 Dominqiue Louis. }
-{ }
-{ }
-{ Contributor(s) }
-{ -------------- }
-{ }
-{ }
-{ Obtained through: }
-{ Joint Endeavour of Delphi Innovators ( Project JEDI ) }
-{ }
-{ You may retrieve the latest version of this file at the Project }
-{ JEDI home page, located at http://delphi-jedi.org }
-{ }
-{ The contents of this file are used with permission, subject to }
-{ the Mozilla Public License Version 1.1 (the "License"); you may }
-{ not use this file except in compliance with the License. You may }
-{ obtain a copy of the License at }
-{ http://www.mozilla.org/MPL/MPL-1.1.html }
-{ }
-{ Software distributed under the License is distributed on an }
-{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or }
-{ implied. See the License for the specific language governing }
-{ rights and limitations under the License. }
-{ }
-{ Description }
-{ ----------- }
-{ }
-{ }
-{ }
-{ }
-{ }
-{ }
-{ }
-{ Requires }
-{ -------- }
-{ The SDL Runtime libraris on Win32 : SDL.dll on Linux : libSDL.so }
-{ They are available from... }
-{ http://www.libsdl.org . }
-{ }
-{ Programming Notes }
-{ ----------------- }
-{ }
-{ }
-{ }
-{ }
-{ Revision History }
-{ ---------------- }
-{ September 23 2004 - DL : Initial Creation }
-{
- $Log: sdltruetypefont.pas,v $
- Revision 1.5 2005/05/26 21:22:28 savage
- Update to Input code.
-
- Revision 1.1 2005/05/25 23:15:42 savage
- Latest Changes
-
- Revision 1.4 2005/05/25 22:55:01 savage
- Added InputRect support.
-
- Revision 1.3 2005/05/13 14:02:49 savage
- Made it use UniCode rendering by default.
-
- Revision 1.2 2005/05/13 11:37:52 savage
- Improved wordwrapping algorithm
-
- Revision 1.1 2004/09/30 22:39:50 savage
- Added a true type font class which contains a wrap text function.
- Changed the sdl_ttf.pas header to reflect the future of jedi-sdl.
-
-
-}
-{******************************************************************************}
-
-interface
-
-uses
- sdl,
- sdl_ttf;
-
-type
- TRenderType = ( rtLatin1, rtUTF8, rtUnicode );
- TSDLFontStyle = ( fsBold, fsItalic, fsUnderline, fsStrikeOut );
-
- TSDLFontStyles = set of TSDLFontStyle;
-
- TTrueTypeFont = class( TObject )
- private
- FFont : PTTF_Font;
- FSolid : Boolean;
- FBackGroundColour : TSDL_Color;
- FForeGroundColour : TSDL_Color;
- FRenderType : TRenderType;
- FStyle : TSDLFontStyles;
- FFontFile : string;
- FFontSize : integer;
- procedure PrepareFont;
-
- protected
-
- public
- constructor Create( aFontFile : string; aRenderStyle : TSDLFontStyles = [ ]; aFontSize : integer = 14 );
- destructor Destroy; override;
- function DrawText( aText : WideString ) : PSDL_Surface; overload;
- function DrawText( aText : WideString; aWidth, aHeight : Integer ) : PSDL_Surface; overload;
- function Input(aDestination: PSDL_Surface; aX, aY, aWidth, aHeight: integer; var aText: string; aMaxChars: integer = 10 ): PSDL_Surface;
- property BackGroundColour : TSDL_Color read FBackGroundColour write FBackGroundColour;
- property ForeGroundColour : TSDL_Color read FForeGroundColour write FForeGroundColour;
- property FontFile : string read FFontFile write FFontFile;
- property RenderType : TRenderType read FRenderType write FRenderType;
- property Solid : Boolean read FSolid write FSolid;
- property Style : TSDLFontStyles read FStyle write FStyle;
- property FontSize : integer read FFontSize write FFontSize;
- end;
-
-
-implementation
-
-uses
- SysUtils;
-
-{ TTrueTypeFont }
-
-constructor TTrueTypeFont.Create( aFontFile : string; aRenderStyle : TSDLFontStyles; aFontSize : integer );
-begin
- inherited Create;
- if FileExists( aFontFile ) then
- begin
- FStyle := aRenderStyle;
- FFontSize := aFontSize;
- FSolid := false;
- FBackGroundColour.r := 255;
- FBackGroundColour.g := 255;
- FBackGroundColour.b := 255;
- FForeGroundColour.r := 0;
- FForeGroundColour.g := 0;
- FForeGroundColour.b := 0;
- FRenderType := rtUnicode;
- if ( TTF_Init >= 0 ) then
- begin
- FFontFile := aFontFile;
- end
- else
- raise Exception.Create( 'Failed to Initialiase SDL_TTF' );
- end
- else
- raise Exception.Create( 'Font File does not exist' );
-end;
-
-destructor TTrueTypeFont.Destroy;
-begin
- if FFont <> nil then
- TTF_CloseFont( FFont );
- TTF_Quit;
- inherited;
-end;
-
-function TTrueTypeFont.DrawText( aText : WideString ) : PSDL_Surface;
-begin
- PrepareFont;
-
- result := nil;
-
- case FRenderType of
- rtLatin1 :
- begin
- if ( FSolid ) then
- begin
- result := TTF_RenderText_Solid( FFont, PChar( string( aText ) ), FForeGroundColour );
- end
- else
- begin
- result := TTF_RenderText_Shaded( FFont, PChar( string( aText ) ), FForeGroundColour, FBackGroundColour );
- end;
- end;
-
- rtUTF8 :
- begin
- if ( FSolid ) then
- begin
- result := TTF_RenderUTF8_Solid( FFont, PChar( string( aText ) ), FForeGroundColour );
- end
- else
- begin
- result := TTF_RenderUTF8_Shaded( FFont, PChar( string( aText ) ), FForeGroundColour, FBackGroundColour );
- end;
- end;
-
- rtUnicode :
- begin
- if ( FSolid ) then
- begin
- result := TTF_RenderUNICODE_Solid( FFont, PUInt16( aText ), FForeGroundColour );
- end
- else
- begin
- result := TTF_RenderUNICODE_Shaded( FFont, PUInt16( aText ), FForeGroundColour, FBackGroundColour );
- end;
- end;
- end;
-end;
-
-function TTrueTypeFont.DrawText( aText : WideString; aWidth, aHeight : Integer ) : PSDL_Surface;
-var
- textw, texth, i, yPos : integer;
- strChopped : WideString;
- SurfaceList : array of PSDL_Surface;
- strlist : array of WideString;
- ReturnedSurface : PSDL_Surface;
- BltRect : TSDL_Rect;
-begin
- PrepareFont;
-
- // Do an initial check to see if it already fits
- case FRenderType of
- rtLatin1 :
- begin
- if TTF_SizeText( FFont, PChar( string( aText ) ), textw, texth ) = 0 then
- begin
- if ( textw < aWidth )
- and ( texth < aHeight ) then
- begin
- result := DrawText( aText );
- exit;
- end
- end;
- end;
-
- rtUTF8 :
- begin
- if TTF_SizeUTF8( FFont, PChar( string( aText ) ), textw, texth ) = 0 then
- begin
- if ( textw < aWidth )
- and ( texth < aHeight ) then
- begin
- result := DrawText( aText );
- exit;
- end
- end;
- end;
-
- rtUnicode :
- begin
- if TTF_SizeUNICODE( FFont, PUInt16( aText ), textw, texth ) = 0 then
- begin
- if ( textw < aWidth )
- and ( texth < aHeight ) then
- begin
- result := DrawText( aText );
- exit;
- end
- end;
- end;
- end;
-
- // Create the Surface we will be returning
- ReturnedSurface := SDL_DisplayFormat( SDL_CreateRGBSurface( SDL_SRCCOLORKEY or SDL_RLEACCEL or SDL_HWACCEL, aWidth, aHeight, 16, 0, 0, 0, 0 ) );
-
- // If we are still here there is some serious parsing to do
- case FRenderType of
- rtLatin1 :
- begin
- strChopped := aText;
- i := Length( strChopped );
- while ( i <> 0 ) do
- begin
- if ( string( strChopped[ i ] ) <> ' ' ) and ( Integer( string( strChopped[ i ] ) ) <> 13 ) then
- dec( i )
- else
- begin
- dec( i );
- if TTF_SizeText( FFont, PChar( string( Copy( strChopped, 0, i ) ) ), textw, texth ) = 0 then
- begin
- if ( textw < aWidth )
- and ( texth < aHeight ) then
- begin
- SetLength( strlist, Length( strlist ) + 1 );
- strlist[ Length( strlist ) - 1 ] := Copy( strChopped, 0, i );
- strChopped := Copy( strChopped, i + 2, Length( strChopped ) - ( i - 1 ) );
- i := Length( strChopped );
- if TTF_SizeText( FFont, PChar( string( strChopped ) ), textw, texth ) = 0 then
- begin
- if ( textw < aWidth )
- and ( texth < aHeight ) then
- begin
- SetLength( strlist, Length( strlist ) + 1 );
- strlist[ Length( strlist ) - 1 ] := Copy( strChopped, 0, i );
- strChopped := Copy( strChopped, i + 2, Length( strChopped ) - ( i - 1 ) );
- i := Length( strChopped );
- end;
- end;
- end;
- end;
- end;
- end;
-
- SetLength( SurfaceList, Length( strlist ) );
- for i := Low( strlist ) to High( strlist ) do
- begin
- if ( FSolid ) then
- begin
- SurfaceList[ i ] := TTF_RenderText_Solid( FFont, PChar( string( strlist[ i ] ) ), FForeGroundColour );
- end
- else
- begin
- SurfaceList[ i ] := TTF_RenderText_Shaded( FFont, PChar( string( strlist[ i ] ) ), FForeGroundColour, FBackGroundColour );
- end;
- end;
- end;
-
- rtUTF8 :
- begin
- strChopped := aText;
- i := Length( strChopped );
- while ( i <> 0 ) do
- begin
- if ( string( strChopped[ i ] ) <> ' ' ) and ( Integer( string( strChopped[ i ] ) ) <> 13 ) then
- dec( i )
- else
- begin
- dec( i );
- if TTF_SizeUTF8( FFont, PChar( string( Copy( strChopped, 0, i ) ) ), textw, texth ) = 0 then
- begin
- if ( textw < aWidth )
- and ( texth < aHeight ) then
- begin
- SetLength( strlist, Length( strlist ) + 1 );
- strlist[ Length( strlist ) - 1 ] := Copy( strChopped, 0, i );
- strChopped := Copy( strChopped, i + 2, Length( strChopped ) - ( i - 1 ) );
- i := Length( strChopped );
- if TTF_SizeUTF8( FFont, PChar( string( strChopped ) ), textw, texth ) = 0 then
- begin
- if ( textw < aWidth )
- and ( texth < aHeight ) then
- begin
- SetLength( strlist, Length( strlist ) + 1 );
- strlist[ Length( strlist ) - 1 ] := Copy( strChopped, 0, i );
- strChopped := Copy( strChopped, i + 2, Length( strChopped ) - ( i - 1 ) );
- i := Length( strChopped );
- end;
- end;
- end;
- end;
- end;
- end;
-
- SetLength( SurfaceList, Length( strlist ) );
- for i := Low( strlist ) to High( strlist ) do
- begin
- if ( FSolid ) then
- begin
- SurfaceList[ i ] := TTF_RenderUTF8_Solid( FFont, PChar( string( strlist[ i ] ) ), FForeGroundColour );
- end
- else
- begin
- SurfaceList[ i ] := TTF_RenderUTF8_Shaded( FFont, PChar( string( strlist[ i ] ) ), FForeGroundColour, FBackGroundColour );
- end;
- end;
- end;
-
- rtUnicode :
- begin
- strChopped := aText;
- i := Length( strChopped );
- while ( i <> 0 ) do
- begin
- if ( string( strChopped[ i ] ) <> ' ' ) and ( Integer( string( strChopped[ i ] ) ) <> 13 ) then
- dec( i )
- else
- begin
- dec( i );
- if TTF_SizeUNICODE( FFont, PUInt16( Copy( strChopped, 0, i ) ), textw, texth ) = 0 then
- begin
- if ( textw < aWidth )
- and ( texth < aHeight ) then
- begin
- SetLength( strlist, Length( strlist ) + 1 );
- strlist[ Length( strlist ) - 1 ] := Copy( strChopped, 0, i );
- strChopped := Copy( strChopped, i + 2, Length( strChopped ) - ( i - 1 ) );
- i := Length( strChopped );
- if TTF_SizeUNICODE( FFont, PUInt16( strChopped ), textw, texth ) = 0 then
- begin
- if ( textw < aWidth )
- and ( texth < aHeight ) then
- begin
- SetLength( strlist, Length( strlist ) + 1 );
- strlist[ Length( strlist ) - 1 ] := Copy( strChopped, 0, i );
- strChopped := Copy( strChopped, i + 2, Length( strChopped ) - ( i - 1 ) );
- i := Length( strChopped );
- end;
- end;
- end;
- end;
- end;
- end;
- SetLength( SurfaceList, Length( strlist ) );
- for i := Low( strlist ) to High( strlist ) do
- begin
- if ( FSolid ) then
- begin
- SurfaceList[ i ] := TTF_RenderUNICODE_Solid( FFont, PUInt16( strlist[ i ] ), FForeGroundColour );
- end
- else
- begin
- SurfaceList[ i ] := TTF_RenderUNICODE_Shaded( FFont, PUInt16( strlist[ i ] ), FForeGroundColour, FBackGroundColour );
- end;
- end;
- end;
- end;
-
- // Now Draw the SurfaceList onto the resulting Surface
- yPos := 6;
- for i := Low( SurfaceList ) to High( SurfaceList ) do
- begin
- BltRect.x := 6;
- BltRect.y := yPos;
- BltRect.w := SurfaceList[ i ].w;
- BltRect.h := SurfaceList[ i ].h;
- SDL_BlitSurface( SurfaceList[ i ], nil, ReturnedSurface, @BltRect );
- yPos := yPos + TTF_FontHeight( FFont );
- end;
- result := ReturnedSurface;
-
- for i := Low( SurfaceList ) to High( SurfaceList ) do
- begin
- SDL_FreeSurface( SurfaceList[ i ] );
- end;
- SetLength( SurfaceList, 0 );
- SetLength( strlist, 0 );
-end;
-
-function TTrueTypeFont.Input(aDestination: PSDL_Surface; aX, aY, aWidth: integer; aHeight : integer; var aText : string; aMaxChars: integer): PSDL_Surface;
-var
- event : TSDL_Event;
- ch : integer;
-
- BackSurface, TextSurface : PSDL_Surface;
- rect : SDL_Rect;
- textw, texth : integer;
- Done : boolean;
- PassedInText : string;
-begin
- PassedInText := aText;
-
- BackSurface := SDL_AllocSurface( aDestination.flags,
- aDestination.w,
- aDestination.h,
- aDestination.format.BitsPerPixel,
- aDestination.format.Rmask,
- aDestination.format.Gmask,
- aDestination.format.Bmask, 0 );
-
- rect.x := aX;
- rect.y := aY;
- rect.w := aWidth;
- rect.h := aHeight;
-
- SDL_BlitSurface( aDestination, nil, BackSurface, nil );
- SDL_FillRect( BackSurface, @rect, SDL_MapRGB( aDestination.format, 0, 0, 0 ) );
-
- TextSurface := DrawText( aText + '|' );
-
- // start input
- SDL_EnableUNICODE( 1 );
- Done := false;
- while ( not Done ) and ( SDL_WaitEvent( @event ) > 0 ) do
- begin
- if event.type_ = SDL_KEYDOWN then
- begin
- ch := event.key.keysym.unicode;
- case ch of
- SDLK_RETURN :
- begin
- Done := true;
- end;
-
- SDLK_ESCAPE :
- begin
- aText := PassedInText;
- Done := true;
- end;
-
- SDLK_BACKSPACE :
- begin
- if ( Length( aText ) > 0 ) then
- begin
- aText := Copy( aText, 0, Length( aText ) - 1 );
- if TextSurface <> nil then
- SDL_FreeSurface( TextSurface );
- TextSurface := DrawText( aText + '|' );
- end;
- end;
- else
- begin
- if Length( aText ) < aMaxChars then
- begin
- if ( chr( ch ) <> '' ) then
- begin
- aText := aText + chr( ch );
-
- if ( aText <> '' )
- and ( TTF_SizeUNICODE( FFont, PUInt16( aText ), textw, texth ) = 0 ) then
- begin
- if ( textw > aWidth ) then
- aText := Copy( aText, 0, Length( aText ) - 1 );
- end;
-
- if TextSurface <> nil then
- SDL_FreeSurface( TextSurface );
- TextSurface := DrawText( aText + '|' );
- end;
- end;
- end;
- end;
- end;
- SDL_BlitSurface( BackSurface, nil, aDestination, nil );
- SDL_BlitSurface( TextSurface, nil, aDestination, @rect );
- SDL_Flip( aDestination );
- end;
-
- if TextSurface <> nil then
- SDL_FreeSurface( TextSurface );
- if aText <> '' then
- TextSurface := DrawText( aText );
- SDL_FreeSurface( BackSurface );
- result := TextSurface;
-end;
-
-procedure TTrueTypeFont.PrepareFont;
-var
- renderstyle : integer;
-begin
- if FFont <> nil then
- TTF_CloseFont( FFont );
-
- FFont := TTF_OpenFont( PChar( FFontFile ), FFontSize );
-
- renderstyle := TTF_STYLE_NORMAL;
- if ( fsBold in FStyle ) then
- renderstyle := renderstyle or TTF_STYLE_BOLD;
-
- if ( fsItalic in FStyle ) then
- renderstyle := renderstyle or TTF_STYLE_ITALIC;
-
- if ( fsUnderline in FStyle ) then
- renderstyle := renderstyle or TTF_STYLE_UNDERLINE;
-
- TTF_SetFontStyle( FFont, renderstyle );
-end;
-
-end.
-
+unit sdltruetypefont; +{ + $Id: sdltruetypefont.pas,v 1.5 2005/05/26 21:22:28 savage Exp $ + +} +{******************************************************************************} +{ } +{ JEDI-SDL : Pascal units for SDL - Simple DirectMedia Layer } +{ Wrapper class for SDL_ttf } +{ } +{ The initial developer of this Pascal code was : } +{ Dominqiue Louis <Dominique@SavageSoftware.com.au> } +{ } +{ Portions created by Dominqiue Louis are } +{ Copyright (C) 2000 - 2001 Dominqiue Louis. } +{ } +{ } +{ Contributor(s) } +{ -------------- } +{ } +{ } +{ Obtained through: } +{ Joint Endeavour of Delphi Innovators ( Project JEDI ) } +{ } +{ You may retrieve the latest version of this file at the Project } +{ JEDI home page, located at http://delphi-jedi.org } +{ } +{ The contents of this file are used with permission, subject to } +{ the Mozilla Public License Version 1.1 (the "License"); you may } +{ not use this file except in compliance with the License. You may } +{ obtain a copy of the License at } +{ http://www.mozilla.org/MPL/MPL-1.1.html } +{ } +{ Software distributed under the License is distributed on an } +{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or } +{ implied. See the License for the specific language governing } +{ rights and limitations under the License. } +{ } +{ Description } +{ ----------- } +{ } +{ } +{ } +{ } +{ } +{ } +{ } +{ Requires } +{ -------- } +{ The SDL Runtime libraris on Win32 : SDL.dll on Linux : libSDL.so } +{ They are available from... } +{ http://www.libsdl.org . } +{ } +{ Programming Notes } +{ ----------------- } +{ } +{ } +{ } +{ } +{ Revision History } +{ ---------------- } +{ September 23 2004 - DL : Initial Creation } +{ + $Log: sdltruetypefont.pas,v $ + Revision 1.5 2005/05/26 21:22:28 savage + Update to Input code. + + Revision 1.1 2005/05/25 23:15:42 savage + Latest Changes + + Revision 1.4 2005/05/25 22:55:01 savage + Added InputRect support. + + Revision 1.3 2005/05/13 14:02:49 savage + Made it use UniCode rendering by default. + + Revision 1.2 2005/05/13 11:37:52 savage + Improved wordwrapping algorithm + + Revision 1.1 2004/09/30 22:39:50 savage + Added a true type font class which contains a wrap text function. + Changed the sdl_ttf.pas header to reflect the future of jedi-sdl. + + +} +{******************************************************************************} + +interface + +uses + sdl, + sdl_ttf; + +type + TRenderType = ( rtLatin1, rtUTF8, rtUnicode ); + TSDLFontStyle = ( fsBold, fsItalic, fsUnderline, fsStrikeOut ); + + TSDLFontStyles = set of TSDLFontStyle; + + TTrueTypeFont = class( TObject ) + private + FFont : PTTF_Font; + FSolid : Boolean; + FBackGroundColour : TSDL_Color; + FForeGroundColour : TSDL_Color; + FRenderType : TRenderType; + FStyle : TSDLFontStyles; + FFontFile : string; + FFontSize : integer; + procedure PrepareFont; + + protected + + public + constructor Create( aFontFile : string; aRenderStyle : TSDLFontStyles = [ ]; aFontSize : integer = 14 ); + destructor Destroy; override; + function DrawText( aText : WideString ) : PSDL_Surface; overload; + function DrawText( aText : WideString; aWidth, aHeight : Integer ) : PSDL_Surface; overload; + function Input(aDestination: PSDL_Surface; aX, aY, aWidth, aHeight: integer; var aText: string; aMaxChars: integer = 10 ): PSDL_Surface; + property BackGroundColour : TSDL_Color read FBackGroundColour write FBackGroundColour; + property ForeGroundColour : TSDL_Color read FForeGroundColour write FForeGroundColour; + property FontFile : string read FFontFile write FFontFile; + property RenderType : TRenderType read FRenderType write FRenderType; + property Solid : Boolean read FSolid write FSolid; + property Style : TSDLFontStyles read FStyle write FStyle; + property FontSize : integer read FFontSize write FFontSize; + end; + + +implementation + +uses + SysUtils; + +{ TTrueTypeFont } + +constructor TTrueTypeFont.Create( aFontFile : string; aRenderStyle : TSDLFontStyles; aFontSize : integer ); +begin + inherited Create; + if FileExists( aFontFile ) then + begin + FStyle := aRenderStyle; + FFontSize := aFontSize; + FSolid := false; + FBackGroundColour.r := 255; + FBackGroundColour.g := 255; + FBackGroundColour.b := 255; + FForeGroundColour.r := 0; + FForeGroundColour.g := 0; + FForeGroundColour.b := 0; + FRenderType := rtUnicode; + if ( TTF_Init >= 0 ) then + begin + FFontFile := aFontFile; + end + else + raise Exception.Create( 'Failed to Initialiase SDL_TTF' ); + end + else + raise Exception.Create( 'Font File does not exist' ); +end; + +destructor TTrueTypeFont.Destroy; +begin + if FFont <> nil then + TTF_CloseFont( FFont ); + TTF_Quit; + inherited; +end; + +function TTrueTypeFont.DrawText( aText : WideString ) : PSDL_Surface; +begin + PrepareFont; + + result := nil; + + case FRenderType of + rtLatin1 : + begin + if ( FSolid ) then + begin + result := TTF_RenderText_Solid( FFont, PChar( string( aText ) ), FForeGroundColour ); + end + else + begin + result := TTF_RenderText_Shaded( FFont, PChar( string( aText ) ), FForeGroundColour, FBackGroundColour ); + end; + end; + + rtUTF8 : + begin + if ( FSolid ) then + begin + result := TTF_RenderUTF8_Solid( FFont, PChar( string( aText ) ), FForeGroundColour ); + end + else + begin + result := TTF_RenderUTF8_Shaded( FFont, PChar( string( aText ) ), FForeGroundColour, FBackGroundColour ); + end; + end; + + rtUnicode : + begin + if ( FSolid ) then + begin + result := TTF_RenderUNICODE_Solid( FFont, PUInt16( aText ), FForeGroundColour ); + end + else + begin + result := TTF_RenderUNICODE_Shaded( FFont, PUInt16( aText ), FForeGroundColour, FBackGroundColour ); + end; + end; + end; +end; + +function TTrueTypeFont.DrawText( aText : WideString; aWidth, aHeight : Integer ) : PSDL_Surface; +var + textw, texth, i, yPos : integer; + strChopped : WideString; + SurfaceList : array of PSDL_Surface; + strlist : array of WideString; + ReturnedSurface : PSDL_Surface; + BltRect : TSDL_Rect; +begin + PrepareFont; + + // Do an initial check to see if it already fits + case FRenderType of + rtLatin1 : + begin + if TTF_SizeText( FFont, PChar( string( aText ) ), textw, texth ) = 0 then + begin + if ( textw < aWidth ) + and ( texth < aHeight ) then + begin + result := DrawText( aText ); + exit; + end + end; + end; + + rtUTF8 : + begin + if TTF_SizeUTF8( FFont, PChar( string( aText ) ), textw, texth ) = 0 then + begin + if ( textw < aWidth ) + and ( texth < aHeight ) then + begin + result := DrawText( aText ); + exit; + end + end; + end; + + rtUnicode : + begin + if TTF_SizeUNICODE( FFont, PUInt16( aText ), textw, texth ) = 0 then + begin + if ( textw < aWidth ) + and ( texth < aHeight ) then + begin + result := DrawText( aText ); + exit; + end + end; + end; + end; + + // Create the Surface we will be returning + ReturnedSurface := SDL_DisplayFormat( SDL_CreateRGBSurface( SDL_SRCCOLORKEY or SDL_RLEACCEL or SDL_HWACCEL, aWidth, aHeight, 16, 0, 0, 0, 0 ) ); + + // If we are still here there is some serious parsing to do + case FRenderType of + rtLatin1 : + begin + strChopped := aText; + i := Length( strChopped ); + while ( i <> 0 ) do + begin + if ( string( strChopped[ i ] ) <> ' ' ) and ( Integer( string( strChopped[ i ] ) ) <> 13 ) then + dec( i ) + else + begin + dec( i ); + if TTF_SizeText( FFont, PChar( string( Copy( strChopped, 0, i ) ) ), textw, texth ) = 0 then + begin + if ( textw < aWidth ) + and ( texth < aHeight ) then + begin + SetLength( strlist, Length( strlist ) + 1 ); + strlist[ Length( strlist ) - 1 ] := Copy( strChopped, 0, i ); + strChopped := Copy( strChopped, i + 2, Length( strChopped ) - ( i - 1 ) ); + i := Length( strChopped ); + if TTF_SizeText( FFont, PChar( string( strChopped ) ), textw, texth ) = 0 then + begin + if ( textw < aWidth ) + and ( texth < aHeight ) then + begin + SetLength( strlist, Length( strlist ) + 1 ); + strlist[ Length( strlist ) - 1 ] := Copy( strChopped, 0, i ); + strChopped := Copy( strChopped, i + 2, Length( strChopped ) - ( i - 1 ) ); + i := Length( strChopped ); + end; + end; + end; + end; + end; + end; + + SetLength( SurfaceList, Length( strlist ) ); + for i := Low( strlist ) to High( strlist ) do + begin + if ( FSolid ) then + begin + SurfaceList[ i ] := TTF_RenderText_Solid( FFont, PChar( string( strlist[ i ] ) ), FForeGroundColour ); + end + else + begin + SurfaceList[ i ] := TTF_RenderText_Shaded( FFont, PChar( string( strlist[ i ] ) ), FForeGroundColour, FBackGroundColour ); + end; + end; + end; + + rtUTF8 : + begin + strChopped := aText; + i := Length( strChopped ); + while ( i <> 0 ) do + begin + if ( string( strChopped[ i ] ) <> ' ' ) and ( Integer( string( strChopped[ i ] ) ) <> 13 ) then + dec( i ) + else + begin + dec( i ); + if TTF_SizeUTF8( FFont, PChar( string( Copy( strChopped, 0, i ) ) ), textw, texth ) = 0 then + begin + if ( textw < aWidth ) + and ( texth < aHeight ) then + begin + SetLength( strlist, Length( strlist ) + 1 ); + strlist[ Length( strlist ) - 1 ] := Copy( strChopped, 0, i ); + strChopped := Copy( strChopped, i + 2, Length( strChopped ) - ( i - 1 ) ); + i := Length( strChopped ); + if TTF_SizeUTF8( FFont, PChar( string( strChopped ) ), textw, texth ) = 0 then + begin + if ( textw < aWidth ) + and ( texth < aHeight ) then + begin + SetLength( strlist, Length( strlist ) + 1 ); + strlist[ Length( strlist ) - 1 ] := Copy( strChopped, 0, i ); + strChopped := Copy( strChopped, i + 2, Length( strChopped ) - ( i - 1 ) ); + i := Length( strChopped ); + end; + end; + end; + end; + end; + end; + + SetLength( SurfaceList, Length( strlist ) ); + for i := Low( strlist ) to High( strlist ) do + begin + if ( FSolid ) then + begin + SurfaceList[ i ] := TTF_RenderUTF8_Solid( FFont, PChar( string( strlist[ i ] ) ), FForeGroundColour ); + end + else + begin + SurfaceList[ i ] := TTF_RenderUTF8_Shaded( FFont, PChar( string( strlist[ i ] ) ), FForeGroundColour, FBackGroundColour ); + end; + end; + end; + + rtUnicode : + begin + strChopped := aText; + i := Length( strChopped ); + while ( i <> 0 ) do + begin + if ( string( strChopped[ i ] ) <> ' ' ) and ( Integer( string( strChopped[ i ] ) ) <> 13 ) then + dec( i ) + else + begin + dec( i ); + if TTF_SizeUNICODE( FFont, PUInt16( Copy( strChopped, 0, i ) ), textw, texth ) = 0 then + begin + if ( textw < aWidth ) + and ( texth < aHeight ) then + begin + SetLength( strlist, Length( strlist ) + 1 ); + strlist[ Length( strlist ) - 1 ] := Copy( strChopped, 0, i ); + strChopped := Copy( strChopped, i + 2, Length( strChopped ) - ( i - 1 ) ); + i := Length( strChopped ); + if TTF_SizeUNICODE( FFont, PUInt16( strChopped ), textw, texth ) = 0 then + begin + if ( textw < aWidth ) + and ( texth < aHeight ) then + begin + SetLength( strlist, Length( strlist ) + 1 ); + strlist[ Length( strlist ) - 1 ] := Copy( strChopped, 0, i ); + strChopped := Copy( strChopped, i + 2, Length( strChopped ) - ( i - 1 ) ); + i := Length( strChopped ); + end; + end; + end; + end; + end; + end; + SetLength( SurfaceList, Length( strlist ) ); + for i := Low( strlist ) to High( strlist ) do + begin + if ( FSolid ) then + begin + SurfaceList[ i ] := TTF_RenderUNICODE_Solid( FFont, PUInt16( strlist[ i ] ), FForeGroundColour ); + end + else + begin + SurfaceList[ i ] := TTF_RenderUNICODE_Shaded( FFont, PUInt16( strlist[ i ] ), FForeGroundColour, FBackGroundColour ); + end; + end; + end; + end; + + // Now Draw the SurfaceList onto the resulting Surface + yPos := 6; + for i := Low( SurfaceList ) to High( SurfaceList ) do + begin + BltRect.x := 6; + BltRect.y := yPos; + BltRect.w := SurfaceList[ i ].w; + BltRect.h := SurfaceList[ i ].h; + SDL_BlitSurface( SurfaceList[ i ], nil, ReturnedSurface, @BltRect ); + yPos := yPos + TTF_FontHeight( FFont ); + end; + result := ReturnedSurface; + + for i := Low( SurfaceList ) to High( SurfaceList ) do + begin + SDL_FreeSurface( SurfaceList[ i ] ); + end; + SetLength( SurfaceList, 0 ); + SetLength( strlist, 0 ); +end; + +function TTrueTypeFont.Input(aDestination: PSDL_Surface; aX, aY, aWidth: integer; aHeight : integer; var aText : string; aMaxChars: integer): PSDL_Surface; +var + event : TSDL_Event; + ch : integer; + + BackSurface, TextSurface : PSDL_Surface; + rect : SDL_Rect; + textw, texth : integer; + Done : boolean; + PassedInText : string; +begin + PassedInText := aText; + + BackSurface := SDL_AllocSurface( aDestination.flags, + aDestination.w, + aDestination.h, + aDestination.format.BitsPerPixel, + aDestination.format.Rmask, + aDestination.format.Gmask, + aDestination.format.Bmask, 0 ); + + rect.x := aX; + rect.y := aY; + rect.w := aWidth; + rect.h := aHeight; + + SDL_BlitSurface( aDestination, nil, BackSurface, nil ); + SDL_FillRect( BackSurface, @rect, SDL_MapRGB( aDestination.format, 0, 0, 0 ) ); + + TextSurface := DrawText( aText + '|' ); + + // start input + SDL_EnableUNICODE( 1 ); + Done := false; + while ( not Done ) and ( SDL_WaitEvent( @event ) > 0 ) do + begin + if event.type_ = SDL_KEYDOWN then + begin + ch := event.key.keysym.unicode; + case ch of + SDLK_RETURN : + begin + Done := true; + end; + + SDLK_ESCAPE : + begin + aText := PassedInText; + Done := true; + end; + + SDLK_BACKSPACE : + begin + if ( Length( aText ) > 0 ) then + begin + aText := Copy( aText, 0, Length( aText ) - 1 ); + if TextSurface <> nil then + SDL_FreeSurface( TextSurface ); + TextSurface := DrawText( aText + '|' ); + end; + end; + else + begin + if Length( aText ) < aMaxChars then + begin + if ( chr( ch ) <> '' ) then + begin + aText := aText + chr( ch ); + + if ( aText <> '' ) + and ( TTF_SizeUNICODE( FFont, PUInt16( aText ), textw, texth ) = 0 ) then + begin + if ( textw > aWidth ) then + aText := Copy( aText, 0, Length( aText ) - 1 ); + end; + + if TextSurface <> nil then + SDL_FreeSurface( TextSurface ); + TextSurface := DrawText( aText + '|' ); + end; + end; + end; + end; + end; + SDL_BlitSurface( BackSurface, nil, aDestination, nil ); + SDL_BlitSurface( TextSurface, nil, aDestination, @rect ); + SDL_Flip( aDestination ); + end; + + if TextSurface <> nil then + SDL_FreeSurface( TextSurface ); + if aText <> '' then + TextSurface := DrawText( aText ); + SDL_FreeSurface( BackSurface ); + result := TextSurface; +end; + +procedure TTrueTypeFont.PrepareFont; +var + renderstyle : integer; +begin + if FFont <> nil then + TTF_CloseFont( FFont ); + + FFont := TTF_OpenFont( PChar( FFontFile ), FFontSize ); + + renderstyle := TTF_STYLE_NORMAL; + if ( fsBold in FStyle ) then + renderstyle := renderstyle or TTF_STYLE_BOLD; + + if ( fsItalic in FStyle ) then + renderstyle := renderstyle or TTF_STYLE_ITALIC; + + if ( fsUnderline in FStyle ) then + renderstyle := renderstyle or TTF_STYLE_UNDERLINE; + + TTF_SetFontStyle( FFont, renderstyle ); +end; + +end. + diff --git a/Game/Code/lib/JEDI-SDL/fpc-install.sh b/Game/Code/lib/JEDI-SDL/fpc-install.sh index ea6c4928..b7a5cf69 100644 --- a/Game/Code/lib/JEDI-SDL/fpc-install.sh +++ b/Game/Code/lib/JEDI-SDL/fpc-install.sh @@ -1,252 +1,252 @@ -#!/bin/sh
-#
-# FreePascal & Delphi Installation script for JEDI-SDL
-# portions of which are based on the FreePascal install script
-# Copyright 1996-2002 Michael Van Canneyt and Peter Vreman
-#
-# Copyright (c)2004-2100, JEDI-SDL Team
-# All Rights Reserved
-#
-# Don NOT edit this file.
-# Everything should be configuration while the script is running.
-#
-############################################################################
-
-# Release Version
-VERSION=1.0
-
-# some useful functions
-# ask displays 1st parameter, and ask new value for variable, whose name is
-# in the second parameter.
-ask ()
-{
-askvar=$2
-eval old=\$$askvar
-eval echo -n \""$1 [$old] : "\"
-read $askvar
-eval test -z \"\$$askvar\" && eval $askvar=\'$old\'
-}
-# yesno gives 1 on no, 0 on yes $1 gives text to display.
-yesno ()
-{
- while true; do
- echo -n "$1 (Y/n) ? "
- read ans
- case X$ans in
- X|Xy|XY) return 0;;
- Xn|XN) return 1;;
- esac
- done
-}
-
-# Untar files ($3,optional) from file ($1) to the given directory ($2)
-unztar ()
-{
- tar -xzf $HERE/$1 --directory $2 $3
-}
-
-# Untar tar.gz file ($2) from file ($1) and untar result to the given directory ($3)
-unztarfromtar ()
-{
- tar -xOf $HERE/$1 $2 | tar --directory $3 -xzf -
-}
-# Get file list from tar archive ($1) in variable ($2)
-# optionally filter result through sed ($3)
-listtarfiles ()
-{
- askvar=$2
- if [ ! -z $3 ]; then
- list=`tar tvf $1 | awk '{ print $(NF) }' | sed -n /$3/p`
- else
- list=`tar tvf $1 | awk '{ print $(NF) }'`
- fi
- eval $askvar='$list'
-}
-# Make all the necessary directories to get $1
-makedirhierarch ()
-{
- OLDDIR=`pwd`
- case $1 in
- /*) cd /;;
- esac
- OLDIFS=$IFS;IFS=/;eval set $1; IFS=$OLDIFS
- for i
- do
- test -d $i || mkdir $i || break
- cd $i ||break
- done
- cd $OLDDIR
-}
-
-# check to see if something is in the path
-checkpath ()
-{
- ARG=$1
- OLDIFS=$IFS; IFS=":";eval set $PATH;IFS=$OLDIFS
- for i
- do
- if [ $i = $ARG ]; then
- return 0
- fi
- done
- return 1
-}
-
-# --------------------------------------------------------------------------
-# welcome message.
-#
-
-clear
-echo "This shell script will attempt to install the Free Pascal Compiler"
-echo "version $VERSION with the items you select"
-echo
-
-# Here we start the thing.
-HERE=`pwd`
-
-# Install in /usr/local or /usr ?
-if checkpath /usr/local/bin; then
- PREFIX=/usr/local
-else
- PREFIX=/usr
-fi
-# If we can't write on prefix, select subdir of home dir
-if [ ! -w $PREFIX ]; then
- PREFIX=$HOME/JEDI-SDLv$VERSION
-fi
-ask "Install prefix (/usr or /usr/local) " PREFIX
-makedirhierarch $PREFIX
-
-# Set some defaults.
-LIBDIR=$PREFIX/lib/JEDI-SDL/$VERSION
-SRCDIR=$PREFIX/src/JEDI-SDLv$VERSION
-EXECDIR=$PREFIX/bin
-OSNAME=`uname -s | tr A-Z a-z`
-
-BSDHIER=0
-case $OSNAME in
-*bsd)
- BSDHIER=1;;
-esac
-
-
-if [ "${BSDHIER}" = "1" ]; then
-DOCDIR=$PREFIX/share/doc/JEDI-SDLv$VERSION
-else
-DOCDIR=$PREFIX/doc/JEDI-SDLv$VERSION
-fi
-
-echo $DOCDIR
-
-DEMODIR=$PREFIX/demos
-
-# Install SDL headers
-if yesno "Install SDL headers"; then
-
-fi
-
-# Install SDL_image headers
-if yesno "Install SDL_image headers"; then
-
-fi
-
-# Install compiler/RTL. Mandatory.
-echo Installing compiler and RTL ...
-unztarfromtar binary.tar base${OSNAME}.tar.gz $PREFIX
-rm -f $EXECDIR/ppc386
-ln -sf $LIBDIR/ppc386 $EXECDIR/ppc386
-echo Installing utilities...
-unztarfromtar binary.tar util${OSNAME}.tar.gz $PREFIX
-if yesno "Install FCL"; then
- unztarfromtar binary.tar unitsfcl${OSNAME}.tar.gz $PREFIX
-fi
-if yesno "Install packages"; then
- listtarfiles binary.tar packages units
- for f in $packages
- do
- if [ $f != unitsfcl${OSNAME}.tar.gz ]; then
- basename $f .tar.gz |\
- sed -e s/units// -e s/${OSNAME}// |\
- xargs echo Installing
- unztarfromtar binary.tar $f $PREFIX
- fi
- done
-fi
-rm -f *${OSNAME}.tar.gz
-echo Done.
-echo
-
-# Install the sources. Optional.
-if yesno "Install sources"; then
- echo Installing sources in $SRCDIR ...
- unztarfromtar sources.tar basesrc.tar.gz $PREFIX
- if yesno "Install compiler source"; then
- unztarfromtar sources.tar compilersrc.tar.gz $PREFIX
- fi
- if yesno "Install RTL source"; then
- unztarfromtar sources.tar rtlsrc.tar.gz $PREFIX
- fi
- if yesno "Install FCL source"; then
- unztarfromtar sources.tar fclsrc.tar.gz $PREFIX
- fi
- if yesno "Install IDE source"; then
- unztarfromtar sources.tar idesrc.tar.gz $PREFIX
- fi
- if yesno "Install installer source"; then
- unztarfromtar sources.tar installersrc.tar.gz $PREFIX
- fi
- if yesno "Install Packages source"; then
- listtarfiles sources.tar packages units
- for f in $packages
- do
- basename $f .tar.gz |\
- sed -e s/units// -e s/src// |\
- xargs echo Installing sources for
- unztarfromtar sources.tar $f $PREFIX
- done
- fi
- # rm -f *src.tar.gz
- echo Done.
-fi
-echo
-
-# Install the documentation. Optional.
-if yesno "Install documentation"; then
- echo Installing documentation in $DOCDIR ...
- unztar docs.tar.gz $DOCDIR
- echo Done.
-fi
-echo
-
-# Install the demos. Optional.
-if yesno "Install demos"; then
- ask "Install demos in" DEMODIR
- echo Installing demos in $DEMODIR ...
- makedirhierarch $DEMODIR
- unztar demo.tar.gz $DEMODIR
- echo Done.
-fi
-echo
-
-# update fpc.cfg file
-if yesno "Update fpc.cfg file automagically"; then
- echo Updating fpc.cfg in $DOCDIR ...
- echo
- echo Done.
-fi
-
-# update Borland IDE file
-if yesno "Update the Kylix IDE automagically"; then
- echo Updating the Kylix IDE in $DOCDIR ...
- echo
- echo Done.
-fi
-
-$LIBDIR/samplecfg $LIBDIR
-
-# The End
-echo
-echo End of installation.
-echo
-echo Refer to the documentation for more information.
+#!/bin/sh +# +# FreePascal & Delphi Installation script for JEDI-SDL +# portions of which are based on the FreePascal install script +# Copyright 1996-2002 Michael Van Canneyt and Peter Vreman +# +# Copyright (c)2004-2100, JEDI-SDL Team +# All Rights Reserved +# +# Don NOT edit this file. +# Everything should be configuration while the script is running. +# +############################################################################ + +# Release Version +VERSION=1.0 + +# some useful functions +# ask displays 1st parameter, and ask new value for variable, whose name is +# in the second parameter. +ask () +{ +askvar=$2 +eval old=\$$askvar +eval echo -n \""$1 [$old] : "\" +read $askvar +eval test -z \"\$$askvar\" && eval $askvar=\'$old\' +} +# yesno gives 1 on no, 0 on yes $1 gives text to display. +yesno () +{ + while true; do + echo -n "$1 (Y/n) ? " + read ans + case X$ans in + X|Xy|XY) return 0;; + Xn|XN) return 1;; + esac + done +} + +# Untar files ($3,optional) from file ($1) to the given directory ($2) +unztar () +{ + tar -xzf $HERE/$1 --directory $2 $3 +} + +# Untar tar.gz file ($2) from file ($1) and untar result to the given directory ($3) +unztarfromtar () +{ + tar -xOf $HERE/$1 $2 | tar --directory $3 -xzf - +} +# Get file list from tar archive ($1) in variable ($2) +# optionally filter result through sed ($3) +listtarfiles () +{ + askvar=$2 + if [ ! -z $3 ]; then + list=`tar tvf $1 | awk '{ print $(NF) }' | sed -n /$3/p` + else + list=`tar tvf $1 | awk '{ print $(NF) }'` + fi + eval $askvar='$list' +} +# Make all the necessary directories to get $1 +makedirhierarch () +{ + OLDDIR=`pwd` + case $1 in + /*) cd /;; + esac + OLDIFS=$IFS;IFS=/;eval set $1; IFS=$OLDIFS + for i + do + test -d $i || mkdir $i || break + cd $i ||break + done + cd $OLDDIR +} + +# check to see if something is in the path +checkpath () +{ + ARG=$1 + OLDIFS=$IFS; IFS=":";eval set $PATH;IFS=$OLDIFS + for i + do + if [ $i = $ARG ]; then + return 0 + fi + done + return 1 +} + +# -------------------------------------------------------------------------- +# welcome message. +# + +clear +echo "This shell script will attempt to install the Free Pascal Compiler" +echo "version $VERSION with the items you select" +echo + +# Here we start the thing. +HERE=`pwd` + +# Install in /usr/local or /usr ? +if checkpath /usr/local/bin; then + PREFIX=/usr/local +else + PREFIX=/usr +fi +# If we can't write on prefix, select subdir of home dir +if [ ! -w $PREFIX ]; then + PREFIX=$HOME/JEDI-SDLv$VERSION +fi +ask "Install prefix (/usr or /usr/local) " PREFIX +makedirhierarch $PREFIX + +# Set some defaults. +LIBDIR=$PREFIX/lib/JEDI-SDL/$VERSION +SRCDIR=$PREFIX/src/JEDI-SDLv$VERSION +EXECDIR=$PREFIX/bin +OSNAME=`uname -s | tr A-Z a-z` + +BSDHIER=0 +case $OSNAME in +*bsd) + BSDHIER=1;; +esac + + +if [ "${BSDHIER}" = "1" ]; then +DOCDIR=$PREFIX/share/doc/JEDI-SDLv$VERSION +else +DOCDIR=$PREFIX/doc/JEDI-SDLv$VERSION +fi + +echo $DOCDIR + +DEMODIR=$PREFIX/demos + +# Install SDL headers +if yesno "Install SDL headers"; then + +fi + +# Install SDL_image headers +if yesno "Install SDL_image headers"; then + +fi + +# Install compiler/RTL. Mandatory. +echo Installing compiler and RTL ... +unztarfromtar binary.tar base${OSNAME}.tar.gz $PREFIX +rm -f $EXECDIR/ppc386 +ln -sf $LIBDIR/ppc386 $EXECDIR/ppc386 +echo Installing utilities... +unztarfromtar binary.tar util${OSNAME}.tar.gz $PREFIX +if yesno "Install FCL"; then + unztarfromtar binary.tar unitsfcl${OSNAME}.tar.gz $PREFIX +fi +if yesno "Install packages"; then + listtarfiles binary.tar packages units + for f in $packages + do + if [ $f != unitsfcl${OSNAME}.tar.gz ]; then + basename $f .tar.gz |\ + sed -e s/units// -e s/${OSNAME}// |\ + xargs echo Installing + unztarfromtar binary.tar $f $PREFIX + fi + done +fi +rm -f *${OSNAME}.tar.gz +echo Done. +echo + +# Install the sources. Optional. +if yesno "Install sources"; then + echo Installing sources in $SRCDIR ... + unztarfromtar sources.tar basesrc.tar.gz $PREFIX + if yesno "Install compiler source"; then + unztarfromtar sources.tar compilersrc.tar.gz $PREFIX + fi + if yesno "Install RTL source"; then + unztarfromtar sources.tar rtlsrc.tar.gz $PREFIX + fi + if yesno "Install FCL source"; then + unztarfromtar sources.tar fclsrc.tar.gz $PREFIX + fi + if yesno "Install IDE source"; then + unztarfromtar sources.tar idesrc.tar.gz $PREFIX + fi + if yesno "Install installer source"; then + unztarfromtar sources.tar installersrc.tar.gz $PREFIX + fi + if yesno "Install Packages source"; then + listtarfiles sources.tar packages units + for f in $packages + do + basename $f .tar.gz |\ + sed -e s/units// -e s/src// |\ + xargs echo Installing sources for + unztarfromtar sources.tar $f $PREFIX + done + fi + # rm -f *src.tar.gz + echo Done. +fi +echo + +# Install the documentation. Optional. +if yesno "Install documentation"; then + echo Installing documentation in $DOCDIR ... + unztar docs.tar.gz $DOCDIR + echo Done. +fi +echo + +# Install the demos. Optional. +if yesno "Install demos"; then + ask "Install demos in" DEMODIR + echo Installing demos in $DEMODIR ... + makedirhierarch $DEMODIR + unztar demo.tar.gz $DEMODIR + echo Done. +fi +echo + +# update fpc.cfg file +if yesno "Update fpc.cfg file automagically"; then + echo Updating fpc.cfg in $DOCDIR ... + echo + echo Done. +fi + +# update Borland IDE file +if yesno "Update the Kylix IDE automagically"; then + echo Updating the Kylix IDE in $DOCDIR ... + echo + echo Done. +fi + +$LIBDIR/samplecfg $LIBDIR + +# The End +echo +echo End of installation. +echo +echo Refer to the documentation for more information. echo
\ No newline at end of file diff --git a/Game/Code/lib/SQLite/example/TestSqlite.dpr b/Game/Code/lib/SQLite/example/TestSqlite.dpr index 82f2a468..596a3a04 100644 --- a/Game/Code/lib/SQLite/example/TestSqlite.dpr +++ b/Game/Code/lib/SQLite/example/TestSqlite.dpr @@ -1,15 +1,15 @@ -program TestSqlite;
-
-uses
- Forms,
- uTestSqlite in 'uTestSqlite.pas' {Form1},
- SQLiteTable3 in 'SQLiteTable3.pas',
- SQLite3 in 'SQLite3.pas';
-
-{$R *.res}
-
-begin
- Application.Initialize;
- Application.CreateForm(TForm1, Form1);
- Application.Run;
-end.
+program TestSqlite; + +uses + Forms, + uTestSqlite in 'uTestSqlite.pas' {Form1}, + SQLiteTable3 in 'SQLiteTable3.pas', + SQLite3 in 'SQLite3.pas'; + +{$R *.res} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/Game/Code/lib/SQLite/example/TestSqlite.exe b/Game/Code/lib/SQLite/example/TestSqlite.exe Binary files differdeleted file mode 100644 index 12f77a3d..00000000 --- a/Game/Code/lib/SQLite/example/TestSqlite.exe +++ /dev/null diff --git a/Game/Code/lib/SQLite/example/uTestSqlite.pas b/Game/Code/lib/SQLite/example/uTestSqlite.pas index 6691fece..484be71c 100644 --- a/Game/Code/lib/SQLite/example/uTestSqlite.pas +++ b/Game/Code/lib/SQLite/example/uTestSqlite.pas @@ -1,233 +1,233 @@ -unit uTestSqlite;
-
-interface
-
-uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, StdCtrls,SQLiteTable3, ExtCtrls, jpeg;
-
-type
- TForm1 = class(TForm)
- btnTest: TButton;
- memNotes: TMemo;
- Label1: TLabel;
- Label2: TLabel;
- ebName: TEdit;
- Label3: TLabel;
- ebNumber: TEdit;
- Label4: TLabel;
- ebID: TEdit;
- Image1: TImage;
- btnLoadImage: TButton;
- btnDisplayImage: TButton;
- procedure btnTestClick(Sender: TObject);
- procedure btnLoadImageClick(Sender: TObject);
- procedure btnDisplayImageClick(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$R *.dfm}
-
-procedure TForm1.btnTestClick(Sender: TObject);
-var
-slDBpath: string;
-sldb: TSQLiteDatabase;
-sltb: TSQLIteTable;
-sSQL: String;
-Notes: String;
-
-begin
-
-slDBPath := ExtractFilepath(application.exename)
-+ 'test.db';
-
-sldb := TSQLiteDatabase.Create(slDBPath);
-try
-
-if sldb.TableExists('testTable') then begin
-sSQL := 'DROP TABLE testtable';
-sldb.execsql(sSQL);
-end;
-
-sSQL := 'CREATE TABLE testtable ([ID] INTEGER PRIMARY KEY,[OtherID] INTEGER NULL,';
-sSQL := sSQL + '[Name] VARCHAR (255),[Number] FLOAT, [notes] BLOB, [picture] BLOB COLLATE NOCASE);';
-
-sldb.execsql(sSQL);
-
-sldb.execsql('CREATE INDEX TestTableName ON [testtable]([Name]);');
-
-//begin a transaction
-sldb.BeginTransaction;
-
-sSQL := 'INSERT INTO testtable(Name,OtherID,Number,Notes) VALUES ("Some Name",4,587.6594,"Here are some notes");';
-//do the insert
-sldb.ExecSQL(sSQL);
-
-sSQL := 'INSERT INTO testtable(Name,OtherID,Number,Notes) VALUES ("Another Name",12,4758.3265,"More notes");';
-//do the insert
-sldb.ExecSQL(sSQL);
-
-//end the transaction
-sldb.Commit;
-
-//query the data
-sltb := slDb.GetTable('SELECT * FROM testtable');
-try
-
-if sltb.Count > 0 then
-begin
-//display first row
-
-ebName.Text := sltb.FieldAsString(sltb.FieldIndex['Name']);
-ebID.Text := inttostr(sltb.FieldAsInteger(sltb.FieldIndex['ID']));
-ebNumber.Text := floattostr( sltb.FieldAsDouble(sltb.FieldIndex['Number']));
-Notes := sltb.FieldAsBlobText(sltb.FieldIndex['Notes']);
-memNotes.Text := notes;
-
-end;
-
-finally
-sltb.Free;
-end;
-
-finally
-sldb.Free;
-
-end;
-
-end;
-
-procedure TForm1.btnLoadImageClick(Sender: TObject);
-var
-slDBpath: string;
-sldb: TSQLiteDatabase;
-sltb: TSQLIteTable;
-iID: integer;
-fs: TFileStream;
-
-begin
-
-slDBPath := ExtractFilepath(application.exename)
-+ 'test.db';
-
-if not FileExists(slDBPath) then begin
-MessageDLg('Test.db does not exist. Click Test Sqlite 3 to create it.',mtInformation,[mbOK],0);
-exit;
-end;
-
-sldb := TSQLiteDatabase.Create(slDBPath);
-try
-
-//get an ID
-//query the data
-sltb := slDb.GetTable('SELECT ID FROM testtable');
-try
-
-if sltb.Count = 0 then begin
-MessageDLg('There are no rows in the database. Click Test Sqlite 3 to insert a row.',mtInformation,[mbOK],0);
-exit;
-end;
-
-iID := sltb.FieldAsInteger(sltb.FieldIndex['ID']);
-
-finally
-sltb.Free;
-end;
-
-//load an image
-fs := TFileStream.Create(ExtractFileDir(application.ExeName) + '\sunset.jpg',fmOpenRead);
-try
-
-//insert the image into the db
-sldb.UpdateBlob('UPDATE testtable set picture = ? WHERE ID = ' + inttostr(iID),fs);
-
-finally
-fs.Free;
-end;
-
-finally
-sldb.Free;
-
-end;
-
-end;
-
-procedure TForm1.btnDisplayImageClick(Sender: TObject);
-var
-slDBpath: string;
-sldb: TSQLiteDatabase;
-sltb: TSQLIteTable;
-iID: integer;
-ms: TMemoryStream;
-pic: TJPegImage;
-
-begin
-
-slDBPath := ExtractFilepath(application.exename)
-+ 'test.db';
-
-if not FileExists(slDBPath) then begin
-MessageDLg('Test.db does not exist. Click Test Sqlite 3 to create it, then Load image to load an image.',mtInformation,[mbOK],0);
-exit;
-end;
-
-sldb := TSQLiteDatabase.Create(slDBPath);
-try
-
-//get an ID
-//query the data
-sltb := slDb.GetTable('SELECT ID FROM testtable');
-try
-
-if not sltb.Count = 0 then begin
-MessageDLg('No rows in the test database. Click Test Sqlite 3 to insert a row, then Load image to load an image.',mtInformation,[mbOK],0);
-exit;
-end;
-
-iID := sltb.FieldAsInteger(sltb.FieldIndex['ID']);
-
-finally
-sltb.Free;
-end;
-
-sltb := sldb.GetTable('SELECT picture FROM testtable where ID = ' + inttostr(iID));
-try
-
-ms := sltb.FieldAsBlob(sltb.FieldIndex['picture']);
-//note that the memory stream is freed when the TSqliteTable is destroyed.
-
-if (ms = nil) then begin
-MessageDLg('No image in the test database. Click Load image to load an image.',mtInformation,[mbOK],0);
-exit;
-end;
-
-ms.Position := 0;
-
-pic := TJPEGImage.Create;
-pic.LoadFromStream(ms);
-
-self.Image1.Picture.Graphic := pic;
-
-pic.Free;
-
-finally
-sltb.Free;
-end;
-
-finally
-sldb.Free;
-
-end;
-
-
-end;
-
-end.
+unit uTestSqlite; + +interface + +uses + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls,SQLiteTable3, ExtCtrls, jpeg; + +type + TForm1 = class(TForm) + btnTest: TButton; + memNotes: TMemo; + Label1: TLabel; + Label2: TLabel; + ebName: TEdit; + Label3: TLabel; + ebNumber: TEdit; + Label4: TLabel; + ebID: TEdit; + Image1: TImage; + btnLoadImage: TButton; + btnDisplayImage: TButton; + procedure btnTestClick(Sender: TObject); + procedure btnLoadImageClick(Sender: TObject); + procedure btnDisplayImageClick(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.dfm} + +procedure TForm1.btnTestClick(Sender: TObject); +var +slDBpath: string; +sldb: TSQLiteDatabase; +sltb: TSQLIteTable; +sSQL: String; +Notes: String; + +begin + +slDBPath := ExtractFilepath(application.exename) ++ 'test.db'; + +sldb := TSQLiteDatabase.Create(slDBPath); +try + +if sldb.TableExists('testTable') then begin +sSQL := 'DROP TABLE testtable'; +sldb.execsql(sSQL); +end; + +sSQL := 'CREATE TABLE testtable ([ID] INTEGER PRIMARY KEY,[OtherID] INTEGER NULL,'; +sSQL := sSQL + '[Name] VARCHAR (255),[Number] FLOAT, [notes] BLOB, [picture] BLOB COLLATE NOCASE);'; + +sldb.execsql(sSQL); + +sldb.execsql('CREATE INDEX TestTableName ON [testtable]([Name]);'); + +//begin a transaction +sldb.BeginTransaction; + +sSQL := 'INSERT INTO testtable(Name,OtherID,Number,Notes) VALUES ("Some Name",4,587.6594,"Here are some notes");'; +//do the insert +sldb.ExecSQL(sSQL); + +sSQL := 'INSERT INTO testtable(Name,OtherID,Number,Notes) VALUES ("Another Name",12,4758.3265,"More notes");'; +//do the insert +sldb.ExecSQL(sSQL); + +//end the transaction +sldb.Commit; + +//query the data +sltb := slDb.GetTable('SELECT * FROM testtable'); +try + +if sltb.Count > 0 then +begin +//display first row + +ebName.Text := sltb.FieldAsString(sltb.FieldIndex['Name']); +ebID.Text := inttostr(sltb.FieldAsInteger(sltb.FieldIndex['ID'])); +ebNumber.Text := floattostr( sltb.FieldAsDouble(sltb.FieldIndex['Number'])); +Notes := sltb.FieldAsBlobText(sltb.FieldIndex['Notes']); +memNotes.Text := notes; + +end; + +finally +sltb.Free; +end; + +finally +sldb.Free; + +end; + +end; + +procedure TForm1.btnLoadImageClick(Sender: TObject); +var +slDBpath: string; +sldb: TSQLiteDatabase; +sltb: TSQLIteTable; +iID: integer; +fs: TFileStream; + +begin + +slDBPath := ExtractFilepath(application.exename) ++ 'test.db'; + +if not FileExists(slDBPath) then begin +MessageDLg('Test.db does not exist. Click Test Sqlite 3 to create it.',mtInformation,[mbOK],0); +exit; +end; + +sldb := TSQLiteDatabase.Create(slDBPath); +try + +//get an ID +//query the data +sltb := slDb.GetTable('SELECT ID FROM testtable'); +try + +if sltb.Count = 0 then begin +MessageDLg('There are no rows in the database. Click Test Sqlite 3 to insert a row.',mtInformation,[mbOK],0); +exit; +end; + +iID := sltb.FieldAsInteger(sltb.FieldIndex['ID']); + +finally +sltb.Free; +end; + +//load an image +fs := TFileStream.Create(ExtractFileDir(application.ExeName) + '\sunset.jpg',fmOpenRead); +try + +//insert the image into the db +sldb.UpdateBlob('UPDATE testtable set picture = ? WHERE ID = ' + inttostr(iID),fs); + +finally +fs.Free; +end; + +finally +sldb.Free; + +end; + +end; + +procedure TForm1.btnDisplayImageClick(Sender: TObject); +var +slDBpath: string; +sldb: TSQLiteDatabase; +sltb: TSQLIteTable; +iID: integer; +ms: TMemoryStream; +pic: TJPegImage; + +begin + +slDBPath := ExtractFilepath(application.exename) ++ 'test.db'; + +if not FileExists(slDBPath) then begin +MessageDLg('Test.db does not exist. Click Test Sqlite 3 to create it, then Load image to load an image.',mtInformation,[mbOK],0); +exit; +end; + +sldb := TSQLiteDatabase.Create(slDBPath); +try + +//get an ID +//query the data +sltb := slDb.GetTable('SELECT ID FROM testtable'); +try + +if not sltb.Count = 0 then begin +MessageDLg('No rows in the test database. Click Test Sqlite 3 to insert a row, then Load image to load an image.',mtInformation,[mbOK],0); +exit; +end; + +iID := sltb.FieldAsInteger(sltb.FieldIndex['ID']); + +finally +sltb.Free; +end; + +sltb := sldb.GetTable('SELECT picture FROM testtable where ID = ' + inttostr(iID)); +try + +ms := sltb.FieldAsBlob(sltb.FieldIndex['picture']); +//note that the memory stream is freed when the TSqliteTable is destroyed. + +if (ms = nil) then begin +MessageDLg('No image in the test database. Click Load image to load an image.',mtInformation,[mbOK],0); +exit; +end; + +ms.Position := 0; + +pic := TJPEGImage.Create; +pic.LoadFromStream(ms); + +self.Image1.Picture.Graphic := pic; + +pic.Free; + +finally +sltb.Free; +end; + +finally +sldb.Free; + +end; + + +end; + +end. diff --git a/Game/Code/lib/SQLite/readme.txt b/Game/Code/lib/SQLite/readme.txt index 3b064e68..0bfdd93e 100644 --- a/Game/Code/lib/SQLite/readme.txt +++ b/Game/Code/lib/SQLite/readme.txt @@ -1,82 +1,82 @@ -14 Aug 2005
-
-The following changes were made by Lukas Gebauer (geby@volny.cz). In addition, some changes from a previous D5-compatible version were merged, and the supplied sqlite3.dll is updated to version 3.2.2
-
-Notes from Lukas:
-
-- added support for delphi 4+
-
-- datatype constants matches SQlite datatypes contants. (otherwise in some situations you got bad column datatype!)
-
-- removed dependency on strutils
-
-- code is reformated to better look (official borland formationg
-rules)
-
-- added some pragma's after database is open (temp is in memory)
-
-- TSQLiteDatabase.GetTableValue(const SQL: string): int64 for easy call of SQL commands what returning one number only. (like select
-count(*)...)
-
-- TSQLiteDatabase.GetTableString(const SQL: string): String for easy call of SQL commands what returning one string only. (like PRAGMA
-integrity_check)
-
-- TSQLiteDatabase.SetTimeout(Value: integer); you can set timeout for accessing to some table. Good for database sharing!
-
-- TSQLiteDatabase.version: string; returns SQLITE version string
-
-- removed bool fieldtype (it is not natural SQLite3 type)
-
-- fild type detection by Sqite3_columnType knows REAL too.
-
-- integer filedtype is based on Int64
-
-- GetFields can get data from any supported fieldtype
-
-- changed some integers to cardinal for avoid signed and unsigned mismatch
-
-- TSqliteTable.FieldAsInteger(I: cardinal): int64; returns int64
-
-
-3 May 2005 Fixed bug where strupper called on column type before checking for nil
-
-2 May 2005 Add extra check for nil in TSqliteTable.Destroy, thanks to Tim Maddrell
-
-22 Apr 2005 Revise TSqliteTable.Destroy to fix memory leak with dtStr type (thanks to
-Jose Brito)
-
-21 Apr 2005 Quick revision to fix case sensitivity in detecting column type,
-and remove PRAGMA full_column_names = 1 which is deprecated. Warning: may break code. Fix your SQL code so that all column names in a result set are unique.
-
-21 Feb 2005 Sqlite DLL now 3.1.3
-
-19 Feb 2005 Revised for Sqlite 3.1.2
-
-21 Dec 2004 First public release
-
-The following notice appears in the Sqlite source code:
-
-*
-** 2001 September 15
-**
-**
-** The author disclaims copyright to this source code. In place of
-
-** a legal notice, here is a blessing:
-
-**
- May you do good and not evil.
-
-** May you find forgiveness for yourself and forgive others.
-
-** May you share freely, never taking more than you give.
-
-
-For more information about SQLite, see http://www.sqlite.org
-
-For more information about this simple wrapper, see http://www.itwriting.com/sqlitesimple.php
-
-
-
-
-
+14 Aug 2005 + +The following changes were made by Lukas Gebauer (geby@volny.cz). In addition, some changes from a previous D5-compatible version were merged, and the supplied sqlite3.dll is updated to version 3.2.2 + +Notes from Lukas: + +- added support for delphi 4+ + +- datatype constants matches SQlite datatypes contants. (otherwise in some situations you got bad column datatype!) + +- removed dependency on strutils + +- code is reformated to better look (official borland formationg +rules) + +- added some pragma's after database is open (temp is in memory) + +- TSQLiteDatabase.GetTableValue(const SQL: string): int64 for easy call of SQL commands what returning one number only. (like select +count(*)...) + +- TSQLiteDatabase.GetTableString(const SQL: string): String for easy call of SQL commands what returning one string only. (like PRAGMA +integrity_check) + +- TSQLiteDatabase.SetTimeout(Value: integer); you can set timeout for accessing to some table. Good for database sharing! + +- TSQLiteDatabase.version: string; returns SQLITE version string + +- removed bool fieldtype (it is not natural SQLite3 type) + +- fild type detection by Sqite3_columnType knows REAL too. + +- integer filedtype is based on Int64 + +- GetFields can get data from any supported fieldtype + +- changed some integers to cardinal for avoid signed and unsigned mismatch + +- TSqliteTable.FieldAsInteger(I: cardinal): int64; returns int64 + + +3 May 2005 Fixed bug where strupper called on column type before checking for nil + +2 May 2005 Add extra check for nil in TSqliteTable.Destroy, thanks to Tim Maddrell + +22 Apr 2005 Revise TSqliteTable.Destroy to fix memory leak with dtStr type (thanks to +Jose Brito) + +21 Apr 2005 Quick revision to fix case sensitivity in detecting column type, +and remove PRAGMA full_column_names = 1 which is deprecated. Warning: may break code. Fix your SQL code so that all column names in a result set are unique. + +21 Feb 2005 Sqlite DLL now 3.1.3 + +19 Feb 2005 Revised for Sqlite 3.1.2 + +21 Dec 2004 First public release + +The following notice appears in the Sqlite source code: + +* +** 2001 September 15 +** +** +** The author disclaims copyright to this source code. In place of + +** a legal notice, here is a blessing: + +** + May you do good and not evil. + +** May you find forgiveness for yourself and forgive others. + +** May you share freely, never taking more than you give. + + +For more information about SQLite, see http://www.sqlite.org + +For more information about this simple wrapper, see http://www.itwriting.com/sqlitesimple.php + + + + + diff --git a/Game/Code/lib/bass/bass.txt b/Game/Code/lib/bass/bass.txt index d7c5aecf..cdaa7bf0 100644 --- a/Game/Code/lib/bass/bass.txt +++ b/Game/Code/lib/bass/bass.txt @@ -1,1658 +1,1658 @@ -BASS 2.4
-Copyright (c) 1999-2008 Un4seen Developments Ltd. All rights reserved.
-
-Files that you should have found in the BASS package
-====================================================
-Win32 version
--------------
-BASS.TXT This file
-BASS.DLL The BASS module
-BASS.CHM BASS documentation
-MP3-FREE
- BASS.DLL BASS module using the Windows MP3 decoder
-C\ C/C++ API and examples...
- BASS.H BASS C/C++ header file
- BASS.LIB BASS import library
- BASS.DSW Visual C++ workspace for examples
- MAKEFILE Makefile for all examples
- MAKEFILE.IN Makefile helper macros
- 3DTEST\ 3D/EAX example
- 3DTEST.C
- 3DTEST.RC
- 3DTEST.DSP
- MAKEFILE
- BASSTEST\ Simple playback example
- BASSTEST.C
- BASSTEST.RC
- BASSTEST.DSP
- MAKEFILE
- CONTEST\ Console example
- CONTEST.C
- CONTEST.DSP
- MAKEFILE
- CUSTLOOP\ Custom looping example
- CUSTLOOP.C
- CUSTLOOP.DSP
- MAKEFILE
- DSPTEST\ DSP example
- DSPTEST.C
- DSPTEST.RC
- DSPTEST.DSP
- MAKEFILE
- FXTEST\ DX8 effect example
- FXTEST.C
- FXTEST.RC
- FXTEST.DSP
- MAKEFILE
- LIVEFX\ Full-duplex example
- LIVEFX.C
- LIVEFX.RC
- LIVEFX.DSP
- MAKEFILE
- LIVESPEC\ "Live" version of spectrum analyser example
- LIVESPEC.C
- LIVESPEC.DSP
- MAKEFILE
- MULTI\ Multiple device example
- MULTI.C
- MULTI.RC
- MULTI.DSP
- MAKEFILE
- NETRADIO\ Internet streaming example
- NETRADIO.C
- NETRADIO.RC
- NETRADIO.DSP
- MAKEFILE
- PLUGINS\ Plugins example
- PLUGINS.C
- PLUGINS.RC
- PLUGINS.DSP
- MAKEFILE
- RECTEST\ Recording example
- RECTEST.C
- RECTEST.RC
- RECTEST.DSP
- MAKEFILE
- SPEAKERS\ Multi-speaker example
- SPEAKERS.C
- SPEAKERS.RC
- SPEAKERS.DSP
- MAKEFILE
- SPECTRUM\ Spectrum analyser example
- SPECTRUM.C
- SPECTRUM.DSP
- MAKEFILE
- SYNTH\ Synth example
- SYNTH.C
- SYNTH.DSP
- MAKEFILE
- WRITEWAV\ WAVE writer example
- WRITEWAV.C
- WRITEWAV.DSP
- MAKEFILE
- BIN\ Precompiled examples
- 3DTEST.EXE
- BASSTEST.EXE
- CONTEST.EXE
- CUSTLOOP.EXE
- DSPTEST.EXE
- FXTEST.EXE
- LIVEFX.EXE
- LIVESPEC.EXE
- MULTI.EXE
- NETRADIO.EXE
- RECTEST.EXE
- SPEAKERS.EXE
- SPECTRUM.EXE
- SYNTH.EXE
- WRITEWAV.EXE
-VB\ Visual Basic API and examples...
- BASS.BAS BASS Visual Basic module
- 3DTEST\ 3D/EAX example
- PRJ3DTEST.VBP
- PRJ3DTEST.FRM
- PRJDEVICE.FRM
- BASSTEST\ Simple playback example
- PRJBASSTEST.VBP
- FRMBASSTEST.FRM
- CUSTLOOP\ Custom looping example
- PRJCUSTLOOP.VBP
- FRMCUSTLOOP.FRM
- MODCUSTLOOP.BAS
- DSPTEST\ DSP example
- PRJDSPTEST.VBP
- FRMDSPTEST.FRM
- MODDSPTEST.BAS
- FXTEST\ DX8 effect example
- PRJFXTEST.VBP
- FRMFXTEST.FRM
- LIVEFX\ Full-duplex example
- PRJLIVEFX.VBP
- FRMLIVEFX.FRM
- MODLIVEFX.BAS
- LIVESPEC\ "Live" version of spectrum analyser example
- PRJLIVESPEC.VBP
- FRMLIVESPEC.FRM
- MODLIVESPEC.BAS
- MULTI\ Multiple device example
- PRJMULTI.VBP
- PRJMULTI.FRM
- PRJDEVICE.FRM
- NETRADIO\ Internet streaming example
- PRJNETRADIO.VBP
- FRMNETRADIO.FRM
- MODNETRADIO.BAS
- CLSFILEIO.CLS
- PLUGINS\ Plugins example
- PRJPLUGINS.VBP
- FRMPLUGINS.FRM
- RECTEST\ Recording example
- PRJRECTEST.VBP
- FRMRECTEST.FRM
- MODRECTEST.BAS
- SPEAKERS\ Multi-speaker example
- PRJSPEAKERS.VBP
- FRMSPEAKERS.FRM
- SPECTRUM\ Spectrum analyser example
- PRJSPECTRUM.VBP
- FRMSPECTRUM.FRM
- MODSPECTRUM.BAS
- SYNTH\ Synth example
- PRJSYNTH.VBP
- FRMSYNTH.FRM
- MODSYNTH.BAS
- WRITEWAV\ WAVE writer example
- PRJWRITEWAVE.VBP
- PRJWRITEWAVE.FRM
- MEMORY\ Playing from memory example by Jobnik
- PRJMEMORY.VBP
- FRMMEMORY.FRM
- SYNCTEST.BAS
- CBASS_TIME.CLS
-DELPHI\ Delphi API and examples...
- BASS.PAS BASS Delphi unit
- 3DTEST\ 3D/EAX example
- D3TEST.DPR
- DTMAIN.PAS
- DTMAIN.DFM
- DTSELECT.PAS
- DTSELECT.DFM
- BASSTEST\ Simple playback example
- BASSTEST.DPR
- BTMAIN.PAS
- BTMAIN.DFM
- CONTEST\ Console example
- CONTEST.DPR
- CUSTLOOP\ Custom looping example
- CUSTLOOP.DPR
- UNIT1.PAS
- UNIT1.DFM
- DSPTEST\ DSP example
- DSPTEST.DPR
- DTMAIN.PAS
- DTMAIN.DFM
- FXTEST\ DX8 effect example
- FXTEST.DPR
- TEST.PAS
- TEST.DFM
- LIVEFX\ Full-duplex example
- LIVEFX.DPR
- UNIT1.PAS
- UNIT1.DFM
- MULTI\ Multiple device example
- MULTI.DPR
- UNIT1.PAS
- UNIT1.DFM
- UNIT2.PAS
- UNIT2.DFM
- NETRADIO\ Internet streaming example
- NETRADIO.DPR
- UNIT1.PAS
- UNIT1.DFM
- PLUGINS\ Plugins example
- PLUGINS.DPR
- UNIT1.PAS
- UNIT1.DFM
- RECORDTEST\ Recording example
- RECORDTEST.DPR
- UNIT1.PAS
- UNIT1.DFM
- SAMPLEVIS\ Visualisation example
- SAMPLEVIS.DPR
- MAIN.PAS
- MAIN.DFM
- SPECTRUM_VIS.PAS
- CIRCLE_VIS.PAS
- OSC_VIS.PAS
- COMMONTYPES.PAS
- SPEAKERS\ Multi-speaker example
- SPEAKERS.DPR
- UNIT1.PAS
- UNIT1.DFM
- STREAMTEST\ User stream example
- STREAMTEST.DPR
- STMAIN.PAS
- STMAIN.DFM
- WRITEWAV\ WAVE writer example
- WRITEWAV.DPR
- UNITMAIN.PAS
- UNITMAIN.DFM
- DYNAMIC\ Dynamic-loading Delphi API
- DYNAMIC_BASS.PAS Dynamic-loading Delphi unit
-MASM\ MASM API and examples...
- BASS.INC BASS MASM include file
- PLAYER\ Example MOD player
- PLAYER.EXE
- PLAYER.ASM
- RSRC.RC
- TOOLBAR.BMP
- COMPILE.BAT
-
-NOTE: To run the example EXEs, first you will have to copy BASS.DLL into the
- same directory as them.
-
-NOTE: To avoid unnecessary bloatage, the BASS DLLs are not digitally signed.
- Signed versions are available on request (email: bass@un4seen.com).
-
-MacOSX version
---------------
-BASS.TXT This file
-LIBBASS.DYLIB The BASS module
-BASS.CHM BASS documentation
-CHMOX.APP CHM file viewer
-BASS.H BASS C/C++ header file
-MAKEFILE Makefile for all examples
-MAKEFILE.IN Makefile helper macros
-MP3-FREE
- LIBBASS.DYLIB BASS module using the OSX MP3 decoder
-3DTEST\ 3D example
- 3DTEST.C
- MAKEFILE
- 3DTEST.NIB
-BASSTEST\ Simple playback example
- BASSTEST.C
- MAKEFILE
- BASSTEST.NIB
-CONTEST\ Console example
- CONTEST.C
- MAKEFILE
-CUSTLOOP\ Custom looping example
- CUSTLOOP.C
- MAKEFILE
-DSPTEST\ DSP example
- DSPTEST.C
- DSPTEST.RC
- MAKEFILE
- DSPTEST.NIB
-LIVESPEC\ "Live" version of spectrum analyser example
- LIVESPEC.C
- MAKEFILE
-MULTI\ Multiple device example
- MULTI.C
- MAKEFILE
- MULTI.NIB
-NETRADIO\ Internet streaming example
- NETRADIO.C
- MAKEFILE
- NETRADIO.NIB
-PLUGINS\ Plugins example
- PLUGINS.C
- MAKEFILE
- PLUGINS.NIB
-RECTEST\ Recording example
- RECTEST.C
- MAKEFILE
- RECTEST.NIB
-SPEAKERS\ Multi-speaker example
- SPEAKERS.C
- MAKEFILE
- SPEAKERS.NIB
-SPECTRUM\ Spectrum analyser example
- SPECTRUM.C
- MAKEFILE
-WRITEWAV\ WAVE writer example
- WRITEWAV.C
- MAKEFILE
-
-
-What's the point?
-=================
-BASS is an audio library for use in Windows and MacOSX software. Its
-purpose is to provide the most powerful and efficient (yet easy to use),
-sample, stream, MOD music, and recording functions. All in a tiny DLL,
-under 100KB in size.
-
-See the documentation for descriptions of all the BASS functions. You
-should also look at the included example program source-codes for some
-examples of how to use BASS in your own programs.
-
-
-Requirements
-============
-Win32 version
--------------
-BASS requires DirectX 3 or above for output. BASS does not require that a
-soundcard with DirectSound/DirectSound3D hardware accelerated drivers is
-installed, but it does improve performance if there is one. BASS also takes
-advantage of MMX, which improves the performance of the MOD music playback.
-
-MacOSX version
---------------
-OSX 10.3 or above is recommended. BASS uses CoreAudio for output, so there
-are no special library/driver requirements. BASS supports both PowerPC and
-Intel Macs.
-
-
-Main Features
-=============
-* Samples
- supports WAV/AIFF/MP3/MP2/MP1/OGG and custom generated samples
-
-* Sample streams
- stream any sample data in 8/16/32 bit, with both "push" and "pull" systems
-
-* File streams
- MP3/MP2/MP1/OGG/WAV/AIFF file streaming
-
-* Internet file streaming
- stream files from the internet, including Shout/Icecast
-
-* User file streaming
- stream files from anywhere using any delivery method
-
-* Multi-channel streaming
- support for more than plain stereo, including multi-channel OGG/WAV/AIFF files
-
-* MOD music
- uses the same engine as XMPlay = best accuracy, speed, and quality
-
-* MO3 music
- MP3/OGG compressed MOD music
-
-* Add-on system
- support for more formats is available via add-ons (aka plugins)
-
-* Multiple outputs
- simultaneously use multiple soundcards, and move channels between them
-
-* Recording
- flexible recording system, with support for multiple devices
-
-* Decode without playback
- streams and MOD musics can be outputted in any way you want
-
-* Speaker assignment
- assign streams and MOD musics to specific speakers
-
-* High precision synchronization
- synchronize events in your software to the streams and MOD musics
-
-* DirectX 8 effects
- chorus/compressor/distortion/echo/flanger/gargle/parameq/reverb
-
-* User defined DSP functions
- custom effects may be applied to musics and streams
-
-* 32 bit floating-point decoding and processing
- floating-point stream/music decoding, DSP, FX, and recording
-
-* 3D sound
- play samples/streams/musics in any 3D position, with EAX support
-
-* Small
- BASS is under 100KB (on Windows), so won't bloat your distribution
-
-
-Using BASS
-==========
-There is no guarantee that all future BASS versions will be compatible
-with all previous versions, so your program should use BASS_GetVersion
-to check the version that is loaded. This also means that you should
-put the BASS module in the same directory as your executable (not just
-somewhere in the path), to avoid the possibility of a wrong version being
-loaded.
-
-If you are updating your software from a previous BASS version, then
-you should check the "History" section (below), to see if any of the
-functions that you are using have been affected by a change.
-
-Win32 version
--------------
-C/C++, Visual Basic, Delphi and MASM APIs are provided, to use BASS with
-another language you'll first have to convert the header file. Or, as a
-last resort, you could use LoadLibrary and GetProcAddress.
-
-The downside is that you have to manually import each function that you
-use, with the GetProcAddress function. But it has been made a lot simpler
-to import BASS this way by the use of the BASSDEF #define. Here's a small
-example:
-
-#define BASSDEF(f) (WINAPI *f) // define the functions as pointers
-#include "bass.h"
-...
-HINSTANCE bass=LoadLibrary("BASS.DLL"); // load BASS
-BASS_Init=GetProcAddress(bass,"BASS_Init"); // get BASS_Init
-BASS_Init(-1,44100,0,hWnd,NULL); // call BASS_Init
-
-To use BASS with Borland C++ Builder, you'll first have to create a
-Borland C++ Builder import library for it. This is done by using the
-IMPLIB tool that comes with Borland C++ Builder. Simply execute this:
-
- IMPLIB BASSBCB.LIB BASS.DLL
-
-... and then use BASSBCB.LIB in your projects to import BASS.
-
-To use BASS with LCC-Win32, you'll first have to create a compatible
-import library for it. This is done by using the PEDUMP and BUILDLIB
-tools that come with LCC-Win32. Run these 2 commands:
-
- PEDUMP /EXP BASS.LIB > BASSLCC.EXP
- BUILDLIB BASSLCC.EXP BASSLCC.LIB
-
-... and then use BASSLCC.LIB in your projects to import BASS.
-
-For the BASS functions that return strings (char*), VB users should use
-the VBStrFromAnsiPtr function to convert the returned pointer into a VB
-string.
-
-MacOSX version
---------------
-A separate "LIB" file is not required for OSX. Using XCode, you can simply
-add the DYLIB file to the project. Or using a makefile, you can build your
-programs like this, for example:
-
- gcc yoursource -L. -lbass -o yourprog
-
-The LIBBASS.DYLIB file must be put in the same directory as the executable
-(it can't just be somewhere in the path). See the example makefiles.
-
-LIBBASS.DYLIB is a universal binary, with support for both PowerPC and
-Intel Macs. If you want PowerPC-only or Intel-only versions, the included
-makefile can create them for you, by typing "make ppc" or "make i386". It
-will also process any BASS add-ons placed in the same directory.
-
-
-Latest Version
-==============
-The latest version of BASS can always be found at the BASS website:
-
- www.un4seen.com
-
-
-Licence
-=======
-BASS is free for non-commercial use. If you are a non-commercial entity
-(eg. an individual) and you are not charging for your product, and the
-product has no other commercial purpose, then you can use BASS in it
-for free. If you wish to use BASS in commercial products, then please
-also see the next section.
-
-TO THE MAXIMUM EXTENT PERMITTED BY APPLICABLE LAW, BASS IS PROVIDED
-"AS IS", WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED,
-INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY
-AND/OR FITNESS FOR A PARTICULAR PURPOSE. THE AUTHORS SHALL NOT BE HELD
-LIABLE FOR ANY DAMAGE THAT MAY RESULT FROM THE USE OF BASS. YOU USE
-BASS ENTIRELY AT YOUR OWN RISK.
-
-Usage of BASS indicates that you agree to the above conditions.
-
-All trademarks and other registered names contained in the BASS
-package are the property of their respective owners.
-
-Commercial licensing
---------------------
-BASS is available for use in your commercial products. The licence
-types available are as follows:
-
-SHAREWARE: Allows the usage of BASS in an unlimited number of your
-shareware products, which must sell for no more than 40 Euros each.
-If you are an individual (not a corporation) making and selling your
-own software (and its price is within the limit), this is the licence
-for you.
-
-SINGLE COMMERCIAL: Allows the usage of BASS in a single commercial
-product.
-
-UNLIMITED COMMERCIAL: Allows the usage of BASS in an unlimited number
-of your commercial products. This licence is on a per site basis. So
-if your company has two sites that use BASS, then two licences are
-required.
-
-Please note the products must be end-user products, eg. not components
-used by other products.
-
-These licences only cover your own software, not the publishing of
-other's software. If you publish other's software, its developers (or
-the software itself) will need to be licensed to use BASS.
-
-These licences are on a per-platform basis, with reductions available
-when licensing for both platforms. In all cases there are no royalties
-to pay, and you can use future BASS updates without further cost. One
-licence covers one person or entity and is not transferable.
-
-These licences do not allow reselling/sublicensing of BASS. For example,
-if a product is a development system, the users of said product are not
-licensed to use BASS in their productions; they will need their own
-licences.
-
-If the standard licences do not meet your requirements, or if you have
-any questions, please get in touch (email: bass@un4seen.com).
-
-Visit the BASS website for the latest pricing:
-
- www.un4seen.com
-
-MP3
----
-MP3 technology is patented, and Thomson license the use of their and
-Fraunhofer's patents. The inclusion of an MP3 decoder (eg. BASS) in a
-commercial product requires an MP3 patent licence. Contact Thomson for
-details:
-
- www.mp3licensing.com
-
-Alternatively, the "MP3-FREE" BASS version does not include its own MP3
-decoder but instead makes use of the operating system's already licensed
-decoder.
-
-NOTE: When using the OS's MP3 decoder, BASS still does the file handling
- so all the usual features are still supported, including streaming,
- tag reading, pre-scanning, gapless playback, etc...
-
-
-History
-=======
-These are the major (and not so major) changes at each version stage.
-There are of course bug fixes and other little improvements made along
-the way too! To make upgrading simpler, all functions affected by a
-change to the BASS interface are listed.
-
-2.4 - 2/4/2008
---------------
-* "Push" streaming
- STREAMPROC_PUSH (BASS_StreamCreate "proc")
- BASS_StreamPutData
- LIVEFX and MULTI examples updated
-* "Push" buffered file streaming
- STREAMFILE_BUFFERPUSH (BASS_StreamCreateFileUser system)
- BASS_StreamPutFileData
-* STREAMFILEPROC replaced by table of callbacks for each file operation
- BASS_FILEPROCS (FILECLOSEPROC/FILELENPROC/FILEREADPROC/FILESEEKPROC)
- STREAMFILEPROC *removed*
-* 64-bit file positioning
- BASS_SampleLoad
- BASS_MusicLoad
- BASS_StreamCreateFile
- BASS_StreamGetFilePosition
-* File buffer level retrieval
- BASS_FILEPOS_BUFFER (BASS_StreamGetFilePosition mode)
-* Sinc interpolated MOD music mixing
- BASS_MUSIC_SINCINTER (BASS_MusicLoad flag)
-* MO3 v2.4 support
- BASS_MusicLoad
-* MOD orders positioning incorporated into channel functions
- BASS_ChannelGetLength
- BASS_ChannelSetPosition
- BASS_ChannelGetPosition
- BASS_MusicGetOrderPosition *removed*
- BASS_MusicGetOrders *removed*
-* Channel attribute functions consolidated
- BASS_ChannelSetAttribute
- BASS_ChannelGetAttribute
- BASS_ChannelSlideAttribute
- BASS_ChannelIsSliding
- BASS_ChannelSetAttributes *removed*
- BASS_ChannelGetAttributes *removed*
- BASS_ChannelSlideAttributes *removed*
- BASS_ChannelSetEAXMix *removed*
- BASS_ChannelGetEAXMix *removed*
- BASS_MusicSetAttribute *removed*
- BASS_MusicGetAttribute *removed*
-* Floating-point volume and panning
- BASS_SetVolume
- BASS_GetVolume
- BASS_RecordSetInput
- BASS_RecordGetInput
- BASS_ATTRIB_PAN/VOL (BASS_ChannelGet/Set/SlideAttribute options)
- BASS_ATTRIB_MUSIC_VOL_CHAN/INST (BASS_ChannelGet/Set/SlideAttribute options)
- BASS_SAMPLE (volume/pan/outvol members)
- BASS_CONFIG_MAXVOL *removed*
- BASSTEST and RECTEST examples updated
-* Output device volume control on Vista (as on other OS)
- BASS_SetVolume
- BASS_GetVolume
-* Multiple update threads
- BASS_CONFIG_UPDATETHREADS
- BASSTEST example updated
-* Global volume range increased to 10000
- BASS_CONFIG_GVOL_SAMPLE/STREAM/MUSIC (BASS_SetConfig options)
- BASSTEST example updated
-* Setting and retrieving of a sample's data
- BASS_SampleSetData
- BASS_SampleGetData
- BASS_SampleCreate
- BASS_SampleCreateDone *removed*
-* Channel flag setting mask
- BASS_ChannelFlags
- BASS_ChannelSetFlags *removed*
- SPEAKERS example updated
-* 256 sample FFT
- BASS_DATA_FFT256 (BASS_ChannelGetDat flag)
-* Channel locking to prevent access by other threads
- BASS_ChannelLock
-* Manual channel buffer updating
- BASS_ChannelUpdate
- BASS_ChannelPreBuf *removed*
-* Configurable manual update length
- BASS_Update
-* Extended device information retrieval and detection of new/removed devices
- BASS_GetDeviceInfo
- BASS_RecordGetDeviceInfo
- BASS_DEVICEINFO structure
- BASS_GetDeviceDescription *removed*
- BASS_RecordGetDeviceDescription *removed*
- BASS_INFO (driver member) *removed*
- BASS_RECORDINFO (driver member) *removed*
- MULTI example updated
-* Default device change tracking on Windows (as on OSX)
- BASS_Init
- BASS_RecordInit
-* Speaker detection from Windows control panel
- BASS_DEVICE_CPSPEAKERS (BASS_Init flag)
-* Channel automatically stopped & resumed for DX8 effects
- BASS_ChannelSetFX
- BASS_ChannelRemoveFX
-* "double" precision position conversion
- BASS_ChannelBytes2Seconds
- BASS_ChannelSeconds2Bytes
-* Separate config functions for pointers
- BASS_SetConfigPtr
- BASS_GetConfigPtr
- BASS_CONFIG_NET_AGENT/PROXY (BASS_SetConfigPtr options)
-* Configurable file format verification length
- BASS_CONFIG_VERIFY (BASS_SetConfig option)
-* Stream filename retrieval
- BASS_CHANNELINFO (file member)
-* Channel sample retrieval
- BASS_CHANNELINFO (sample member)
-* META syncs no longer receive metadata in the "data" parameter
- BASS_SYNC_META (BASS_ChannelSetSync type)
-* Separate sync for OGG logical bitstream changes (instead of BASS_SYNC_META)
- BASS_SYNC_OGG_CHANGE (BASS_ChannelSetSync type)
- NETRADIO example updated (C version)
-* Message syncing removed (use PostMessage instead)
- BASS_SYNC_MESSAGE (BASS_ChannelSetSync flag) *removed*
-* Data retrieval from stopped/paused channels
- BASS_ChannelGetData
-* Callback "user" parameters changed to pointers
- BASS_StreamCreate / STREAMPROC
- BASS_StreamCreateFileUser
- BASS_StreamCreateURL / DOWNLOADPROC
- BASS_RecordStart / RECORDPROC
- BASS_ChannelSetDSP / DSPPROC
- BASS_ChannelSetSync / SYNCPROC
-
-2.3.0.3 - 30/7/2007
--------------------
-* FX state resetting
- BASS_FXReset
-* PLS/M3U playlist URL processing
- BASS_CONFIG_NET_PLAYLIST
- NETRADIO example updated
-* Internet stream connection status retrieval
- BASS_FILEPOS_CONNECTED (BASS_StreamGetFilePosition mode)
-* Lyrics3v2 tags
- BASS_TAG_LYRICS3 (BASS_ChannelGetTags type)
-* IT virtual channel configuration
- BASS_CONFIG_MUSIC_VIRTUAL
-* Accurate speaker detection on Vista
- BASS_INFO (speakers member)
-* Device output/input rate retrieval on Vista
- BASS_INFO (freq member)
- BASS_RECORDINFO (freq member)
-* Syncing upon position changes
- BASS_SYNC_SETPOS (BASS_ChannelSetSync type)
-* Improved stall handling
- BASS_SYNC_STALL
-* Invalid decoding channel flags produce an error instead of being ignored
- BASS_StreamCreate/File/User/Url
- BASS_MusicLoad
-
-2.3.0.2 - 22/1/2007
--------------------
-* Retrieval of a sample's existing channel handles
- BASS_SampleGetChannels
-* 8192 sample FFT
- BASS_DATA_FFT8192 (BASS_ChannelGetData flag)
-* Adjustable recording buffer
- BASS_CONFIG_REC_BUFFER (BASS_SetConfig option)
-* Stopping decoding channels before the end
- BASS_ChannelStop
-* Sample channels created paused to prevent overriding before playback
- BASS_SampleGetChannel
-* Separate "MP3-FREE" version using Windows/OSX MP3 decoder
- BASS_CONFIG_MP3_CODEC *removed*
-
-2.3.0.1 - 12/6/2006
--------------------
-* Ability to move a channel to another device
- BASS_ChannelSetDevice
- MULTI example updated
-* Support for ID3v2.4 tags at end of file
- BASS_TAG_ID3V2 (BASS_ChannelGetTags type)
-
-2.3 - 21/5/2006
----------------
-* MOD message/instrument/sample text retrieval, merged with stream tag retrieval function
- BASS_ChannelGetTags
- BASS_TAG_MUSIC_NAME/MESSAGE/INST/SAMPLE (BASS_ChannelGetTags types)
- BASS_MusicGetName *removed*
- BASS_StreamGetTags *removed*
-* Plugin information retrieval
- BASS_PluginGetInfo
- BASS_PLUGININFO/FORM structures
- BASS_CHANNELINFO (plugin member)
- PLUGINS example updated
-* RIFF/WAVE "INFO" tag retrieval
- BASS_TAG_RIFF_INFO (BASS_StreamGetTags type)
-* More specific WAVE format information
- BASS_CTYPE_STREAM_WAV_PCM/FLOAT (channel types)
- BASS_CTYPE_STREAM_WAV (channel type flag)
-* Proxy server configuration
- BASS_CONFIG_NET_PROXY (BASS_SetConfig option)
- BASS_CONFIG_NET_NOPROXY *removed*
- NETRADIO example updated
-* Passive FTP mode
- BASS_CONFIG_NET_PASSIVE (BASS_SetConfig option)
-* Agent changes take immediate effect
- BASS_CONFIG_NET_AGENT (BASS_SetConfig option)
-* Minimum time gap between creating new sample channels
- BASS_SAMPLE (mingap member)
- BASS_SampleGetChannel
-* Support for Unicode plugin filenames
- BASS_PluginLoad
-* Device output/input rate retrieval (MacOSX only)
- BASS_INFO (freq member)
- BASS_RECORDINFO (freq member)
-* Extended version info (minor revision)
- BASS_GetVersion
-* Unsupported codec error code
- BASS_ERROR_CODEC
-* Optional use of the Windows MP3 codec
- BASS_CONFIG_MP3_CODEC (BASS_SetConfig option)
-* 3D support for MacOSX
- BASS_Set3DFactors
- BASS_Get3DFactors
- BASS_Set3DPosition
- BASS_Get3DPosition
- BASS_Apply3D
- BASS_ChannelSet3DAttributes
- BASS_ChannelGet3DAttributes
- BASS_ChannelSet3DPosition
- BASS_ChannelGet3DPosition
- 3DTEST example added (Win32 example also updated)
-* VB version of SYNTH example added
-
-2.2 - 2/10/2005
----------------
-* Add-on plugin system
- BASS_PluginLoad
- BASS_PluginFree
- BASS_StreamCreateFile/User/Url
- BASS_SampleLoad
- PLUGINS example added
-* MOD position & syncing in bytes
- BASS_ChannelSetPosition
- BASS_ChannelGetPosition
- BASS_MusicGetOrderPosition added for orders position
- BASS_SYNC_MUSICPOS added for orders syncing
- MAKEMUSICPOS macro/define
- CUSTLOOP example updated
-* Stream/MOD "length" functions combined (also works with samples), new MOD orders length function
- BASS_ChannelGetLength
- BASS_MusicGetOrders
- BASS_StreamGetLength *removed*
- BASS_MusicGetLength *removed*
-* Support for AIFF files
- BASS_StreamCreateFile/User/Url
- BASS_SampleLoad
-* Support for 24 and 32-bit (integer) WAV files
- BASS_StreamCreateFile/User/Url
- BASS_SampleLoad
-* WAV files are no longer converted to the "device" resolution
- BASS_StreamCreateFile/User/Url
-* Recording master control
- BASS_RecordGetInput
- BASS_RecordSetInput
-* Adjustable prebuffering
- BASS_ChannelPreBuf
-* Floating-point data retrieval
- BASS_DATA_FLOAT (BASS_ChannelGetData flag)
-* Support for floating-point samples
- BASS_SampleLoad
- BASS_SampleCreate
-* Multi-channel samples
- BASS_SampleLoad/Create
- BASS_SAMPLE (chans member)
-* Sample lengths given in bytes
- BASS_SampleCreate
- BASS_SAMPLE (length member)
-* MOD music 8-bit resolution option
- BASS_MusicLoad
-* OGG vendor tag retrieval
- BASS_TAG_VENDOR (BASS_StreamGetTags type)
-* Configurable "User-Agent" header for internet streams
- BASS_CONFIG_NET_AGENT (BASS_SetConfig option)
-* Shoutcast metadata is now requested automatically
- BASS_STREAM_META flag *removed*
-* Download callbacks receive all data from start of file/stream (including any non-audio data)
- DOWNLOADPROC
-* Length when streaming in blocks is unavailable (BASS_ERROR_NOTAVAIL, not just 0)
- BASS_ChannelGetLength
-* Support for growing custom file streams
- BASS_FILE_LEN (STREAMFILEPROC action)
-* Query file action removed
- BASS_FILE_QUERY *removed*
-* Recording channel syncing
- BASS_ChannelSetSync
-* Info structure "size" members removed
- BASS_INFO structure
- BASS_RECORDINFO structure
-* Little bit of flag reshuffling
- BASS_MP3_SETPOS renamed to BASS_STREAM_PRESCAN
- BASS_MUSIC_CALCLEN value changed and renamed to BASS_MUSIC_PRESCAN
- BASS_MUSIC_POSRESET value changed
-* Add-on API enhancements
-* MacOSX port introduced
-
-2.1 - 28/11/2004
-----------------
-* Improved "mixtime" sync system, allowing custom looping
- SYNCPROC
- CUSTLOOP example added
-* FX can now be in the DSP chain, so can be prioritized and applied in floating-point
- BASS_ChannelSetFX
- BASS_CONFIG_FLOATDSP (BASS_SetConfig option)
-* Ability to set channel flags (eg. looping) independent of playback
- BASS_ChannelSetFlags
- SPEAKERS example updated
-* Stream/MOD "play" and channel "resume" functions combined
- BASS_ChannelPlay
- BASS_StreamPlay *removed*
- BASS_MusicPlay *removed*
- BASS_MusicPlayEx *removed*
- BASS_ChannelResume *removed*
-* Stream/MOD prebuffering functions combined
- BASS_ChannelPreBuf
- BASS_StreamPreBuf *removed*
- BASS_MusicPreBuf *removed*
-* MOD attribute functions combined, with added BPM/speed/globalvolume options
- BASS_MusicSetAttribute
- BASS_MusicGetAttribute
- BASS_MUSIC_ATTRIB_AMPLIFY
- BASS_MUSIC_ATTRIB_PANSEP
- BASS_MUSIC_ATTRIB_PSCALER
- BASS_MUSIC_ATTRIB_BPM
- BASS_MUSIC_ATTRIB_SPEED
- BASS_MUSIC_ATTRIB_VOL_GLOBAL
- BASS_MUSIC_ATTRIB_VOL_CHAN
- BASS_MUSIC_ATTRIB_VOL_INST
- BASS_MusicSetAmplify *removed*
- BASS_MusicSetPanSep *removed*
- BASS_MusicSetPositionScaler *removed*
- BASS_MusicSetVolume *removed*
- BASS_MusicGetVolume *removed*
-* Flag to reset bpm/etc as well as notes when seeking in MOD musics
- BASS_MUSIC_POSRESETEX (BASS_MusicLoad & BASS_ChannelSetFlags flag)
-* More flexible and concise sample channel creation system
- BASS_SampleGetChannel
- BASS_SamplePlay *removed*
- BASS_SamplePlayEx *removed*
- BASS_SamplePlay3D *removed*
- BASS_SamplePlay3DEx *removed*
-* Support for up to 30 speakers
- BASS_SPEAKER_N macro/define
-* More precise level measurement
- BASS_ChannelGetLevel
-* Level can now be retrieved from decoding channels
- BASS_ChannelGetLevel
-* Retrieval of a sample/channel's original sample resolution
- BASS_SAMPLE (origres member)
- BASS_CHANNELINFO (origres member)
-* Support for streaming WAV files in "blocks"
- BASS_StreamCreateURL
- BASS_StreamCreateFileUser
-* Status info (HTTP/ICY tags) available during connection to server
- BASS_STREAM_STATUS (BASS_StreamCreateURL flag)
- DOWNLOADPROC
- NETRADIO example updated (Delphi version also added)
-* Adjustable internet stream prebuffering
- BASS_CONFIG_NET_PREBUF (BASS_SetConfig option)
-* Option to bypass proxy server
- BASS_CONFIG_NET_NOPROXY (BASS_SetConfig option)
-* Option whether to allow channels to be played after BASS_Pause
- BASS_CONFIG_PAUSE_NOPLAY (BASS_SetConfig option)
-* Recording channel count now a separate parameter
- BASS_RecordStart (chans parameter)
-* Synchronizer for when a channel is freed
- BASS_SYNC_FREE (BASS_ChannelSetSync type)
-* Data start file position retrieval
- BASS_FILEPOS_START (BASS_StreamGetFilePosition mode)
-* Performance improvements
- MP2 decoding ~20% faster
- MP3/MP1 decoding & FFT processing all up to 10% faster
- OGG decoding ~3% faster
-* C/C++ examples reorganised, with makefiles & VC++ projects
-* Add-on API enhancements
-* More DLL shrinkage :)
-
-2.0 - 31/10/2003
-----------------
-* Multiple output device support
- BASS_Init (device number changes)
- BASS_SetDevice
- BASS_GetDevice
- BASS_ChannelGetDevice
- MULTI example updated (VB version also added)
-* Multiple recording device support
- BASS_RecordSetDevice
- BASS_RecordGetDevice
- BASS_RecordStart
- BASS_ChannelGetDevice
- HRECORD handle
- RECORDPROC (handle parameter)
-* Recording with DSP/FX
- BASS_ChannelSetDSP
- BASS_ChannelSetFX
-* Recording position retrieval
- BASS_ChannelGetPosition
-* Start recording paused
- BASS_RECORD_PAUSE (BASS_RecordStart flag)
-* Multi-channel streams, inc. support for multichannel OGG & WAV files
- BASS_StreamCreate
- BASS_StreamCreateFile/User/Url
-* FFT for individual channels, inc. multi-channel streams
- BASS_DATA_FFT_INDIVIDUAL (BASS_ChannelGetData flag)
- BASS_DATA_FFT512S/1024S/2048S/4096S *removed*
-* DSP prioritizing
- BASS_ChannelSetDSP
- DSPTEST example updated
-* Seeking in internet streamed files
- BASS_ChannelSetPosition
-* Enhanced custom file stream systems
- BASS_StreamCreateFileUser
- BASS_FILE_SEEK (STREAMFILEPROC action)
- BASS_STREAM_FILEPROC flag *removed*
-* Enhanced custom stream system with automatic stalling/resuming
- STREAMPROC
- BASS_STREAMPROC_END (STREAMPROC flag)
-* Synchronizer for stalled/resumed playback
- BASS_SYNC_STALL (BASS_ChannelSetSync type)
-* Synchronizer for completed download
- BASS_SYNC_DOWNLOAD (BASS_ChannelSetSync type)
-* End sync support for custom streams
- BASS_SYNC_END (BASS_ChannelSetSync type)
-* Synchronizer support for decoding channels
- BASS_ChannelSetSync
-* Unified configuration function
- BASS_SetConfig
- BASS_GetConfig
- BASS_SetBufferLength *removed*
- BASS_SetNetConfig *removed*
- BASS_SetGlobalVolumes *removed*
- BASS_GetGlobalVolumes *removed*
- BASS_SetLogCurves *removed*
- BASS_Set3DAlgorithm *removed*
- BASS_DEVICE_FLOATDSP flag *removed*
-* Internet stream saving to disk replaced by more flexible callback
- BASS_StreamCreateURL
- DOWNLOADPROC
- VB NETRADIO example updated
-* Buffer length retrieval when "streaming in blocks"
- BASS_FILEPOS_END (BASS_StreamGetFilePosition mode)
-* Individual sample rate setting for MOD musics
- BASS_MusicLoad
-* Channel type and default sample rate retrieval
- BASS_ChannelGetInfo (replaces BASS_ChannelGetFlags)
- BASS_CHANNELINFO
-* MOD music flag retrieval
- BASS_CHANNELINFO (flags member)
-* Adjustable instrument volumes in MOD musics
- BASS_MusicSetVolume (replaces BASS_MusicSetChannelVol)
- BASS_MusicGetVolume (replaces BASS_MusicGetChannelVol)
-* Automatically free a MOD music when it stops or ends
- BASS_MUSIC_AUTOFREE (BASS_MusicLoad flag)
-* Class GUID added to initialization parameters
- BASS_Init
- BASS_SetCLSID *removed*
-* Update period adjustable at any time
- BASS_CONFIG_UPDATEPERIOD (BASS_SetConfig option)
- BASS_DEVICE_NOTHREAD flag *removed*
-* Customizable maximum volume setting
- BASS_CONFIG_MAXVOL (BASS_SetConfig option)
- BASS_DEVICE_VOL1000 flag *removed*
-* Device volume is now always left as it is during init/freeing
- BASS_DEVICE_LEAVEVOL flag *removed*
-* Device driver name retrieval
- BASS_INFO (driver member)
- BASS_RECORDINFO (driver member)
-* Error codes are local to the current thread
- BASS_ErrorGetCode
-* Performance improvements
- MP2 decoding 15-20% faster
- MP3 decoding ~5% faster
-* Built-in CD functions removed (replaced in BASSCD)
- BASS_CDDoor *removed*
- BASS_CDFree *removed*
- BASS_CDGetID *removed*
- BASS_CDGetTrackLength *removed*
- BASS_CDGetTracks *removed*
- BASS_CDInDrive *removed*
- BASS_CDInit *removed*
- BASS_CDPlay *removed*
-* Force channels to use software mixing
- BASS_SAMPLE_SOFTWARE (BASS_StreamCreate/File/User/URL & BASS_MusicLoad flag)
-* Support for high-pass filter and forward/reverse (S9E/F) IT/MPT effects
-* BASS_MUSIC flags rearranged to mirror BASS_SAMPLE/STREAM counterparts
-* Output automatically started during initialization
-* BASS_ChannelGetData once again accepts any "length" param
-* All function comments have been removed from the API headers to avoid
- outdated/incorrect information - the BASS.CHM documentation should be used.
-* TMT Pascal API removed from main distribution - now available on the website
-* A few more 'K' knocked off the DLL size :)
-
-1.8a - 18/6/2003
-----------------
-* Tweaks 'n' fixes, including...
- Fixed seeking bug on 32-bit OGG streams
- Fixed seeking on a decoding channel after it has reached the end
- Low FPU precision (eg. when using Direct3D) issue addressed
- Improved speakers (BASS_INFO) detection
- BASS_ChannelSeconds2Bytes return value is rounded down to nearest sample
- BASS_ChannelGetData "length" param must equal a whole number of samples
- Slide syncs are triggered by "-2" volume slides on "autofree" streams
-* Support for UNICODE filenames
- BASS_UNICODE (BASS_SampleLoad/BASS_StreamCreateFile/BASS_MusicLoad flag)
-* 4096 sample FFT
- BASS_DATA_FFT4096/S (BASS_ChannelGetData flags)
-* Another 'K' knocked off the DLL size
-
-1.8 - 9/3/2003
---------------
-* 32-bit floating-point channels
- BASS_SAMPLE_FLOAT (BASS_StreamCreate/URL/File flag)
- BASS_MUSIC_FLOAT (BASS_MusicLoad flag)
- BASS_SAMPLE_FLOAT (BASS_RecordStart flag)
- BASS_DEVICE_FLOATDSP (BASS_Init flag)
- DSPTEST example updated
-* Support for 32-bit floating-point (type 3) WAV files
- BASS_StreamCreateFile/URL
- BASS_SampleLoad
-* Channel speaker assignment
- BASS_SPEAKER_FRONT (BASS_MusicLoad/BASS_StreamCreate/File/URL flag)
- BASS_SPEAKER_REAR "
- BASS_SPEAKER_CENLFE "
- BASS_SPEAKER_REAR2 "
- BASS_SPEAKER_FRONTLEFT "
- BASS_SPEAKER_FRONTRIGHT "
- BASS_SPEAKER_REARLEFT "
- BASS_SPEAKER_REARRIGHT "
- BASS_SPEAKER_CENTER "
- BASS_SPEAKER_LFE "
- BASS_SPEAKER_REAR2LEFT "
- BASS_SPEAKER_REAR2RIGHT "
- BASS_INFO (speakers member)
- BASS_DEVICE_SPEAKERS (BASS_Init flag)
- 4SPEAKER example replaced by SPEAKERS example
-* Recording input type retrieval
- BASS_INPUT_TYPE_xxx (BASS_RecordGetInput)
- RECTEST example updated
-* Non-interpolated MOD mixing
- BASS_MUSIC_NONINTER (BASS_MusicLoad/PlayEx flag)
-* Performance improvements
- FFT up to 100% faster!
- MP3(MPEG2/2.5) decoding up to 60% faster
- MMX mixers 5-10% faster
- MP3(MPEG1)/MP2/MP1/OGG decoding all ~5% faster
-* Optional disabling of FFT windowing
- BASS_DATA_FFT_NOWINDOW (BASS_ChannelGetData flag)
-* BASS_ERROR_FILEFORM - error code to distinguish between file and sample format
- BASS_MusicLoad
- BASS_SampleLoad
- BASS_StreamCreate/File/URL
-* BASS_StreamGetFilePosition mode flags added
- BASS_FILEPOS_DECODE/DOWNLOAD/END
-* DirectX 9 detection
- BASS_INFO (dsver member)
-* Initialization flags retrieval
- BASS_INFO (initflags member)
-* Half-rate MP3 playback option removed
- BASS_MP3_HALFRATE flag *removed*
-* New internal "plugin" system - BASSWMA is further integrated as a result
-* Improved documentation - integrated with BASSWMA, search option added
-* VB version of DSPTEST example added
-* Delphi RECORDTEST example added
-* Guess what... reduced DLL size again :)
-
-1.7 - 27/10/2002
-----------------
-* New alternative DX8 (DMO) effects implementation
- BASS_StreamCreate/File/URL
- BASS_MusicLoad
- BASS_ChannelSetFX
- SYNTH example updated
-* User file streaming
- BASS_STREAM_FILEPROC (BASS_StreamCreate flag)
- STREAMFILEPROC
-* DSP & FX support for decoding channels
- BASS_ChannelSetDSP
- BASS_ChannelSetFX
-* Support for DX8 (DMO) effects in IT/XM/MO3 files
- BASS_MusicLoad
-* Support for chained OGG streaming (and syncing)
- BASS_StreamCreateURL
- BASS_SYNC_META (BASS_ChannelSetSync type)
-* Attribute (volume/frequency/pan) sliding
- BASS_ChannelSlideAttributes
- BASS_ChannelIsSliding
- BASS_SYNC_SLIDE (BASS_ChannelSetSync type)
-* Recording without a callback function
- BASS_RecordStart
- LIVEFX example added
-* Query a channel's buffered data
- BASS_DATA_AVAILABLE (BASS_ChannelGetData flag)
-* Discard data from the recording buffer
- BASS_ChannelGetData
-* Adjustable internet stream config (timeout/buffer lengths)
- BASS_SetNetConfig
-* Recommended minimum buffer length
- BASS_INFO (minbuf member)
-* MOD music flags adjustment without changing playback position
- BASS_MusicPlayEx
- PLAYER (MASM) example updated
-* More functions are now useable in MOD music "mixtime" syncs
- SYNCPROC
- BASS_ChannelSetPosition
- BASS_MusicPlayEx
- BASS_MusicSetAmplify
- BASS_MusicSetPanSep
-* Maximum buffer length increased to 5 seconds
- BASS_SetBufferLength
-* Support for extended filter range in IT files
- BASS_MusicLoad
-* Speedier MOD music file verification
- BASS_MusicLoad
-* Delphi 3DTEST example fixed
-* Magically reduced DLL size again :)
-
-1.6a - 25/8/2002
-----------------
-* OGG support updated to 1.0
-* Stereo FFT
- BASS_DATA_FFT512S/1024S/2048S (BASS_ChannelGetData flags)
-* Support for "Invert Loop" (EFx) MOD effect
-* Reduced DLL size
-* New Delphi examples
- WRITEWAV - WAVE writer example
- SAMPLEVIS - Visualisation example
-
-1.6 - 13/6/2002
----------------
-* 64-bit stream lengths and positions
- BASS_StreamGetLength
- BASS_ChannelBytes2Seconds
- BASS_ChannelSeconds2Bytes
- BASS_ChannelGetPosition
- BASS_ChannelSetPosition
- BASS_ChannelSetSync
-* Recording input selection
- BASS_RECORDINFO (inputs & singlein members)
- BASS_RecordGetInputName
- BASS_RecordGetInput
- BASS_RecordSetInput
-* Adjustable recording update period
- BASS_RecordStart
-* Load OGG files as samples
- BASS_SampleLoad
-* CD drive door opening & closing
- BASS_CDDoor
-* CDDB2 ID retrieval
- BASS_CDID_CDDB2 (BASS_CDGetID flag)
-* Streaming beyond initial file length
- BASS_StreamCreateFile
-* Recording position bytes<->seconds translation
- BASS_ChannelBytes2Seconds
- BASS_ChannelSeconds2Bytes
-* Improved multi-threaded support (play from any thread)
- BASS_MusicPlay/Ex
- BASS_SamplePlay/3D/Ex
- BASS_StreamPlay
- BASS_DEVICE_NOSYNC flag *removed*
-* Paused channel status
- BASS_ACTIVE_PAUSED (BASS_ChannelIsActive)
-* Integrated WMA stream freeing
- BASS_StreamFree
- BASS_Free
-* Pin-point accurate OGG seeking without BASS_MP3_SETPOS flag
-* Win2k DS buffer bug fix
-
-1.5a - 14/4/2002
-----------------
-* NT4 fix (also enables "nosound" device without DX installed)
- BASS_ERROR_DX error code
-* MOD music loading without the samples
- BASS_MUSIC_NOSAMPLE (BASS_MusicLoad flag)
-* Custom decoding channels
- BASS_STREAM_DECODE (BASS_StreamCreate flag)
-* 5 second HTTP connection timeout
- BASS_ERROR_TIMEOUT (BASS_StreamCreateURL error code)
-
-1.5 - 31/3/2002
----------------
-* Improved performance
- MMX mixers lot faster (over 50% faster in some cases!)
- OGG decoding 15-20% faster
- MP3 decoding 5-10% faster
-* Recording
- BASS_RecordGetDeviceDescription
- BASS_RecordInit
- BASS_RecordFree
- BASS_RecordGetInfo
- BASS_RecordStart
-* OGG support built-in (OGG/VORBIS DLLs not required)
- BASS_DEVICE_OGG flag *removed*
-* MOD music seeking in seconds
- BASS_MusicPlayEx
- BASS_ChannelSetPosition
-* Shoutcast metadata retrieval
- BASS_STREAM_META (BASS_StreamCreateURL flag)
- BASS_TAG_META (BASS_StreamGetTags type)
- BASS_SYNC_META (BASS_ChannelSetSync type)
-* 1000 volume levels
- BASS_DEVICE_VOL1000 (BASS_Init/CDInit flag)
-* CDDB ID retrieval
- BASS_CDID_CDDB (BASS_CDGetID flag)
-* Leave the CD volume as it is during init/closing
- BASS_DEVICE_LEAVEVOL (BASS_CDInit flag)
-* FFT enabled on decoding channels
- BASS_ChannelGetData
-* Left level duplicated on right for mono channels
- BASS_ChannelGetLevel
-* Improved MPEG length estimation without BASS_MP3_SETPOS flag
- BASS_StreamGetLength
-* Support for Modplug/ADPCM compressed files
- BASS_MusicLoad
-* Device description function parameter change
- BASS_GetDeviceDescription
-* MASM API
-
-1.4 - 30/1/2002
----------------
-* Channel decoding without playback
- BASS_MUSIC_DECODE (BASS_MusicLoad flag)
- BASS_STREAM_DECODE (BASS_StreamCreateFile/URL flag)
- BASS_ChannelGetData
-* Windows message sync callbacks
- BASS_SYNC_MESSAGE (BASS_ChannelSetSync flag)
-* Adjustable channel volumes in MOD musics
- BASS_MusicSetChannelVol
- BASS_MusicGetChannelVol
-* Customizable DirectSound initialization object
- BASS_SetCLSID
-* Retrieve HMUSIC/HSTREAM/HCHANNEL IDirectSoundBuffer interfaces
- BASS_GetDSoundObject
-* A3D functions removed (use BASS_SetCLSID/BASS_GetDSoundObject to access A3D)
- BASS_DEVICE_A3D (BASS_Init flag)
- BASS_SetA3DResManager
- BASS_GetA3DResManager
- BASS_SetA3DHFAbsorbtion
- BASS_GetA3DHFAbsorbtion
-* Callback functions now work in VB6
- DSPPROC
- STREAMPROC
- SYNCPROC
-* Improved PCM WAVE streaming performance
- BASS_StreamCreateFile
- BASS_StreamCreateURL
-* OGG modules updated to RC3
-* Stereo sample support in MO3 format
-* MO3 encoder now distributed separately from BASS
-
-1.3 - 17/11/2001
-----------------
-* Manual buffer updating
- BASS_DEVICE_NOTHREAD (BASS_Init flag)
- BASS_Update
-* Adjustable buffer update period (allows small buffer sizes)
- BASS_Init
-* Output device latency retrieval
- BASS_INFO (latency member)
-* MPEG/OGG seeking without BASS_MP3_SETPOS flag
- BASS_ChannelSetPosition
-* Internet file streaming from offsets
- BASS_StreamCreateURL
-* File stream tag/comment retrieval (ID3/ID3v2/OGG/HTTP/ICY tags)
- BASS_StreamGetTags
-* Byte<->time position translation
- BASS_ChannelBytes2Seconds
- BASS_ChannelSeconds2Bytes
-* UMX (Unreal/Tournament music package) format support
- BASS_MusicLoad
-* S3M/IT sync fx changed to S2x (S0x conflicted with S00)
- BASS_SYNC_MUSICFX
-* Stereo sample support in IT/XM/S3M formats
-* MO3: OGG compression supported
-
-1.2 - 25/9/2001
----------------
-* OGG (Ogg Vorbis) stream support
- BASS_DEVICE_OGG (BASS_Init flag)
- BASS_StreamCreateFile
- BASS_StreamCreateURL
-* Channel linking (start/stop/pause/resume channels together)
- BASS_ChannelSetLink
- BASS_ChannelRemoveLink
-* MOD music playback length calculation
- BASS_MUSIC_CALCLEN (BASS_MusicLoad flag)
- BASS_MusicGetLength
-* Pre-buffering
- BASS_MusicPreBuf
- BASS_StreamPreBuf
-* Samples with single simultaneous playbacks have same HSAMPLE/HCHANNEL handle
- BASS_SamplePlay/Ex
-* Stopping a custom stream flushes its buffer contents
- BASS_ChannelStop
-
-1.1a - 31/8/2001
-----------------
-* NT4 bug fixed
-* XM Wxx effect syncing
- BASS_SYNC_MUSICFX
-* MP3/2/1 rewinding without BASS_MP3_SETPOS
- BASS_ChannelSetPosition
-
-1.1 - 11/8/2001
----------------
-* DX8 (DMO) effects
- BASS_SAMPLE_FX (BASS_StreamCreate/File/URL flag)
- BASS_MUSIC_FX (BASS_MusicLoad flag)
- BASS_ChannelSetFX
- BASS_ChannelRemoveFX
- BASS_FXSetParameters
- BASS_FXGetParameters
- BASS_FXCHORUS structure
- BASS_FXCOMPRESSOR structure
- BASS_FXDISTORTION structure
- BASS_FXECHO structure
- BASS_FXFLANGER structure
- BASS_FXGARGLE structure
- BASS_FXI3DL2REVERB structure
- BASS_FXPARAMEQ structure
- BASS_FXREVERB structure
-* Internet file streaming in blocks (inc. Shoutcast/Icecast stream support)
- BASS_STREAM_BLOCK (BASS_StreamCreateURL flag)
-* 512/1024/2048 sample FFT
- BASS_DATA_FFT512/1024/2048 (BASS_ChannelGetData flags)
-* CD identification
- BASS_CDGetID
-* Improved DX version detection
- BASS_INFO (dsver member)
-
-1.0 - 20/6/2001
----------------
-* Load MP3/MP2/MP1 files as samples
- BASS_SampleLoad
-* Internet file streaming from FTP servers
- BASS_StreamCreateURL
-* Save a local copy of internet file streams
- BASS_StreamCreateURL
-* Sample accurate file stream seeking
- BASS_ChannelSetPosition
- BASS_StreamGetBlockLength *removed*
-* Stream position synchronizer
- BASS_SYNC_POS
-* Increased synchronizer precision
-* Improved MPEG file detection and error detection
-* Stop MOD musics on a backwards jump effect
- BASS_MUSIC_STOPBACK (BASS_MusicLoad/PlayEx flag)
-* Leave the volume as it is during closing (as well as initialization)
- BASS_DEVICE_LEAVEVOL (BASS_Init flag)
-* Optional automatic use of foreground window handle during initialization
- BASS_Init
-* Reduced DLL size
-* VB API fixes
-
-0.9 - 18/4/2001
----------------
-* Internet file streaming
- BASS_StreamCreateURL
-* MP1 & MP2 (MPEG layer 1 & 2) support
- BASS_StreamCreateFile/URL
-* MPEG 2.5 support (12000/11025/8000hz sample rates)
- BASS_StreamCreateFile/URL
-* Decoding/download/end file stream position retrieval
- BASS_StreamGetFilePosition
-* XMPlay surround sound for MOD musics
- BASS_MUSIC_SURROUND (BASS_MusicLoad/PlayEx flag)
- BASS_MUSIC_SURROUND2 (BASS_MusicLoad/PlayEx flag)
-* Restrict the download rate of internet file streams
- BASS_STREAM_RESTRATE (BASS_StreamCreateURL flag)
-* Check if an internet file stream is stalled
- BASS_ChannelIsActive
-* Automatically free a stream when it stops or ends
- BASS_STREAM_AUTOFREE (BASS_StreamCreate/File/URL flag)
-* Leave the volume as it is during initialization
- BASS_DEVICE_LEAVEVOL (BASS_Init flag)
-* Number of CD tracks retrieval
- BASS_CDGetTracks
-* CD track length retrieval
- BASS_CDGetTrackLength
-* Exact stream length set after whole file is streamed
- BASS_StreamGetLength
-* TMT Pascal API and samples
-* Dynamic-loading Delphi API
-
-0.8a - 28/2/2000
-----------------
-* Updated Delphi API and samples
-
-0.8 - 24/1/2000
----------------
-* Improved MP3 performance on P2/K6 and above CPUs - fast!
-* User DSP functions on streams and MOD musics
- BASS_ChannelSetDSP
- BASS_ChannelRemoveDSP
-* DX7 voice allocation & management
- BASS_SAMPLE_VAM (BASS_SampleLoad/Create flag)
- BASS_VAM_xxx flags
- BASS_SAMPLE (vam & priority members)
-* DX7 software 3D algorithm selection
- BASS_Set3DAlgorithm
-* DirectSound interface retrieval
- BASS_GetDSoundObject
-* Log/linear volume & panning curves
- BASS_SetLogCurves
-* User data passed to callback functions
- STREAMPROC - BASS_StreamCreate
- SYNCPROC - BASS_ChannelSetSync
-* New synchronizer
- BASS_SYNC_MUSICFX
-* New synchronizer flag
- BASS_SYNC_MIXTIME
-* Disable synchronizers option - saves a little CPU time
- BASS_DEVICE_NOSYNC (BASS_Init flag)
-* Hi-res floating-point CPU usage monitoring
- BASS_GetCPU
-* Wait for playback to start when playing a CD
- BASS_CDPlay
-* DirectSound (dsound.dll) version retrieval
- BASS_INFO (dsver member)
-* Removed volume sliding functions (they were fairly pointless)
- BASS_SlideVolume
- BASS_IsSliding
-* MO3: read/write encoder settings
-* MO3: remove inst/samp/message texts now optional
-* MO3: LAME encoder settings
-
-0.7 - 3/10/1999
----------------
-* MO3 (MP3 compressed MODs)
-* A3D functions
- BASS_DEVICE_A3D (BASS_Init flag)
- BASS_INFO (a3d member)
- BASS_SetA3DResManager
- BASS_GetA3DResManager
- BASS_SetA3DHFAbsorbtion
- BASS_GetA3DHFAbsorbtion
-* Music/stream immediate sample data retrieval
- BASS_ChannelGetData
-* File stream (WAV/MP3) length retrieval
- BASS_StreamGetLength
- BASS_StreamGetBlockLength
-* File stream seeking
- BASS_ChannelSetPosition
-* Mono MP3 option (lower CPU usage)
- BASS_StreamCreateFile
-* Music length retrieval
- BASS_MusicGetLength
-* Music name retrieval
- BASS_MusicGetName
-* Stop notes when moving MOD music position
- BASS_MUSIC_POSRESET (BASS_MusicLoad/BASS_MusicPlayEx flag)
-* BASS_ERROR_FREQ - invalid sample rate error code
- BASS_SampleCreate
- BASS_SamplePlayEx
- BASS_SamplePlay3DEx
- BASS_StreamCreate
- BASS_ChannelSetAttributes
-* Delphi and VB APIs
-
-0.6a - 26/7/1999
-----------------
-* Half rate MP3 option (lower CPU usage)
- BASS_MP3_HALFRATE
-* Loading/streaming from file offsets
- BASS_MusicLoad
- BASS_SampleLoad
- BASS_StreamCreateFile
-* Global music/sample/stream volume levels
- BASS_SetGlobalVolumes
- BASS_GetGlobalVolumes
-* Other new function
- BASS_SampleStop
-* New synchronizer
- BASS_SYNC_END
-* New sample overrider
- BASS_SAMPLE_OVER_DIST
-* LoadLibrary/GetProcAddress instructions and example
-
-0.5 - 4/7/1999
---------------
-* Documentation!
-* File streaming (MP3 and WAV)
- BASS_StreamCreateFile
-* Custom generated samples
- BASS_SampleCreate
- BASS_SampleCreateDone
-* Other new function
- BASS_MusicSetPositionScaler
-* Renamed function
- BASS_ChannelClearSync -> BASS_ChannelRemoveSync
-* Alterations made to
- BASS_ChannelGetPosition
- BASS_SampleLoad
- BASS_StreamPlay
-
-0.4 - 30/3/1999
----------------
-* Compressed WAV samples support (using audio CODECs)
-* Updated CD volume handling - now works with SB Live
-* More linear channel volume/pan scales (were slightly off before)
-* "no sound" device option
-* 3D sound functions
- BASS_Set3DFactors
- BASS_Get3DFactors
- BASS_Set3DPosition
- BASS_Get3DPosition
- BASS_Apply3D
- BASS_SamplePlay3D
- BASS_SamplePlay3DEx
- BASS_ChannelSet3DAttributes
- BASS_ChannelGet3DAttributes
- BASS_ChannelSet3DPosition
- BASS_ChannelGet3DPosition
-* EAX functions
- BASS_SetEAXParameters
- BASS_GetEAXParameters
- BASS_ChannelSetEAXMix
- BASS_ChannelGetEAXMix
-* Other new functions
- BASS_GetDeviceDescription
- BASS_SetBufferLen
- BASS_ChannelGetFlags
- BASS_ChannelPause
- BASS_ChannelResume
- BASS_ChannelSetPosition
-* Replaced function
- BASS_CDResume -> BASS_ChannelResume
-* Alterations made to
- BASS_Init
- BASS_CDInit
- BASS_SampleLoad
- BASS_StreamPlay
- BASS_INFO structure
- BASS_SAMPLE structure
- BASS_DEVICE_xxx flags
- BASS_SAMPLE_xxx flags
-
-0.3 - 8/3/1999
---------------
-* Synchronization functions
- BASS_ChannelSetSync
- BASS_ChannelClearSync
-* Other new functions
- BASS_GetVersion
- BASS_ChannelGetPosition
- BASS_ChannelGetLevel
- BASS_ChannelGetAttributes
- BASS_ChannelSetAttributes
-* Replaced functions
- BASS_MusicStop -> BASS_ChannelStop
- BASS_MusicSetVolume -> BASS_ChannelSetAttributes
- BASS_CDStop -> BASS_ChannelStop
- BASS_CDSetVolume -> BASS_ChannelSetAttributes
- BASS_CDGetVolume -> BASS_ChannelGetAttributes
- BASS_ChannelUpdate -> BASS_ChannelSetAttributes
-* Alterations made to
- BASS_MusicPlayEx
- BASS_StreamPlay
- BASS_INFO structure
-
-0.2 - 28/2/1999
----------------
-* First public release
-
-
-Credits
-=======
-Ogg Vorbis decoding is based on libogg/vorbis,
-Copyright (c) 2002-2004 Xiph.org Foundation
-
-CHMOX is (c) 2004 Stéphane Boisson, http://chmox.sourceforge.net/
-
-API/Sample contributors
------------------------
-Visual Basic: Adam Hoult, Hendrik Knaepen, Arthur Aminov,
- Peter Hebels
-Delphi: Titus Miloi, Rogier Timmermans, Alessandro Cappellozza,
- Jesse Naranjo, Chris Troesken
-MASM: Octavian Chis
-
-
-Bug reports, Suggestions, Comments, Enquiries, etc...
-=====================================================
-If you have any of the aforementioned please visit the BASS forum at
-the website. If you can't find an answer there, you can also email:
-
- bass@un4seen.com
-
+BASS 2.4 +Copyright (c) 1999-2008 Un4seen Developments Ltd. All rights reserved. + +Files that you should have found in the BASS package +==================================================== +Win32 version +------------- +BASS.TXT This file +BASS.DLL The BASS module +BASS.CHM BASS documentation +MP3-FREE + BASS.DLL BASS module using the Windows MP3 decoder +C\ C/C++ API and examples... + BASS.H BASS C/C++ header file + BASS.LIB BASS import library + BASS.DSW Visual C++ workspace for examples + MAKEFILE Makefile for all examples + MAKEFILE.IN Makefile helper macros + 3DTEST\ 3D/EAX example + 3DTEST.C + 3DTEST.RC + 3DTEST.DSP + MAKEFILE + BASSTEST\ Simple playback example + BASSTEST.C + BASSTEST.RC + BASSTEST.DSP + MAKEFILE + CONTEST\ Console example + CONTEST.C + CONTEST.DSP + MAKEFILE + CUSTLOOP\ Custom looping example + CUSTLOOP.C + CUSTLOOP.DSP + MAKEFILE + DSPTEST\ DSP example + DSPTEST.C + DSPTEST.RC + DSPTEST.DSP + MAKEFILE + FXTEST\ DX8 effect example + FXTEST.C + FXTEST.RC + FXTEST.DSP + MAKEFILE + LIVEFX\ Full-duplex example + LIVEFX.C + LIVEFX.RC + LIVEFX.DSP + MAKEFILE + LIVESPEC\ "Live" version of spectrum analyser example + LIVESPEC.C + LIVESPEC.DSP + MAKEFILE + MULTI\ Multiple device example + MULTI.C + MULTI.RC + MULTI.DSP + MAKEFILE + NETRADIO\ Internet streaming example + NETRADIO.C + NETRADIO.RC + NETRADIO.DSP + MAKEFILE + PLUGINS\ Plugins example + PLUGINS.C + PLUGINS.RC + PLUGINS.DSP + MAKEFILE + RECTEST\ Recording example + RECTEST.C + RECTEST.RC + RECTEST.DSP + MAKEFILE + SPEAKERS\ Multi-speaker example + SPEAKERS.C + SPEAKERS.RC + SPEAKERS.DSP + MAKEFILE + SPECTRUM\ Spectrum analyser example + SPECTRUM.C + SPECTRUM.DSP + MAKEFILE + SYNTH\ Synth example + SYNTH.C + SYNTH.DSP + MAKEFILE + WRITEWAV\ WAVE writer example + WRITEWAV.C + WRITEWAV.DSP + MAKEFILE + BIN\ Precompiled examples + 3DTEST.EXE + BASSTEST.EXE + CONTEST.EXE + CUSTLOOP.EXE + DSPTEST.EXE + FXTEST.EXE + LIVEFX.EXE + LIVESPEC.EXE + MULTI.EXE + NETRADIO.EXE + RECTEST.EXE + SPEAKERS.EXE + SPECTRUM.EXE + SYNTH.EXE + WRITEWAV.EXE +VB\ Visual Basic API and examples... + BASS.BAS BASS Visual Basic module + 3DTEST\ 3D/EAX example + PRJ3DTEST.VBP + PRJ3DTEST.FRM + PRJDEVICE.FRM + BASSTEST\ Simple playback example + PRJBASSTEST.VBP + FRMBASSTEST.FRM + CUSTLOOP\ Custom looping example + PRJCUSTLOOP.VBP + FRMCUSTLOOP.FRM + MODCUSTLOOP.BAS + DSPTEST\ DSP example + PRJDSPTEST.VBP + FRMDSPTEST.FRM + MODDSPTEST.BAS + FXTEST\ DX8 effect example + PRJFXTEST.VBP + FRMFXTEST.FRM + LIVEFX\ Full-duplex example + PRJLIVEFX.VBP + FRMLIVEFX.FRM + MODLIVEFX.BAS + LIVESPEC\ "Live" version of spectrum analyser example + PRJLIVESPEC.VBP + FRMLIVESPEC.FRM + MODLIVESPEC.BAS + MULTI\ Multiple device example + PRJMULTI.VBP + PRJMULTI.FRM + PRJDEVICE.FRM + NETRADIO\ Internet streaming example + PRJNETRADIO.VBP + FRMNETRADIO.FRM + MODNETRADIO.BAS + CLSFILEIO.CLS + PLUGINS\ Plugins example + PRJPLUGINS.VBP + FRMPLUGINS.FRM + RECTEST\ Recording example + PRJRECTEST.VBP + FRMRECTEST.FRM + MODRECTEST.BAS + SPEAKERS\ Multi-speaker example + PRJSPEAKERS.VBP + FRMSPEAKERS.FRM + SPECTRUM\ Spectrum analyser example + PRJSPECTRUM.VBP + FRMSPECTRUM.FRM + MODSPECTRUM.BAS + SYNTH\ Synth example + PRJSYNTH.VBP + FRMSYNTH.FRM + MODSYNTH.BAS + WRITEWAV\ WAVE writer example + PRJWRITEWAVE.VBP + PRJWRITEWAVE.FRM + MEMORY\ Playing from memory example by Jobnik + PRJMEMORY.VBP + FRMMEMORY.FRM + SYNCTEST.BAS + CBASS_TIME.CLS +DELPHI\ Delphi API and examples... + BASS.PAS BASS Delphi unit + 3DTEST\ 3D/EAX example + D3TEST.DPR + DTMAIN.PAS + DTMAIN.DFM + DTSELECT.PAS + DTSELECT.DFM + BASSTEST\ Simple playback example + BASSTEST.DPR + BTMAIN.PAS + BTMAIN.DFM + CONTEST\ Console example + CONTEST.DPR + CUSTLOOP\ Custom looping example + CUSTLOOP.DPR + UNIT1.PAS + UNIT1.DFM + DSPTEST\ DSP example + DSPTEST.DPR + DTMAIN.PAS + DTMAIN.DFM + FXTEST\ DX8 effect example + FXTEST.DPR + TEST.PAS + TEST.DFM + LIVEFX\ Full-duplex example + LIVEFX.DPR + UNIT1.PAS + UNIT1.DFM + MULTI\ Multiple device example + MULTI.DPR + UNIT1.PAS + UNIT1.DFM + UNIT2.PAS + UNIT2.DFM + NETRADIO\ Internet streaming example + NETRADIO.DPR + UNIT1.PAS + UNIT1.DFM + PLUGINS\ Plugins example + PLUGINS.DPR + UNIT1.PAS + UNIT1.DFM + RECORDTEST\ Recording example + RECORDTEST.DPR + UNIT1.PAS + UNIT1.DFM + SAMPLEVIS\ Visualisation example + SAMPLEVIS.DPR + MAIN.PAS + MAIN.DFM + SPECTRUM_VIS.PAS + CIRCLE_VIS.PAS + OSC_VIS.PAS + COMMONTYPES.PAS + SPEAKERS\ Multi-speaker example + SPEAKERS.DPR + UNIT1.PAS + UNIT1.DFM + STREAMTEST\ User stream example + STREAMTEST.DPR + STMAIN.PAS + STMAIN.DFM + WRITEWAV\ WAVE writer example + WRITEWAV.DPR + UNITMAIN.PAS + UNITMAIN.DFM + DYNAMIC\ Dynamic-loading Delphi API + DYNAMIC_BASS.PAS Dynamic-loading Delphi unit +MASM\ MASM API and examples... + BASS.INC BASS MASM include file + PLAYER\ Example MOD player + PLAYER.EXE + PLAYER.ASM + RSRC.RC + TOOLBAR.BMP + COMPILE.BAT + +NOTE: To run the example EXEs, first you will have to copy BASS.DLL into the + same directory as them. + +NOTE: To avoid unnecessary bloatage, the BASS DLLs are not digitally signed. + Signed versions are available on request (email: bass@un4seen.com). + +MacOSX version +-------------- +BASS.TXT This file +LIBBASS.DYLIB The BASS module +BASS.CHM BASS documentation +CHMOX.APP CHM file viewer +BASS.H BASS C/C++ header file +MAKEFILE Makefile for all examples +MAKEFILE.IN Makefile helper macros +MP3-FREE + LIBBASS.DYLIB BASS module using the OSX MP3 decoder +3DTEST\ 3D example + 3DTEST.C + MAKEFILE + 3DTEST.NIB +BASSTEST\ Simple playback example + BASSTEST.C + MAKEFILE + BASSTEST.NIB +CONTEST\ Console example + CONTEST.C + MAKEFILE +CUSTLOOP\ Custom looping example + CUSTLOOP.C + MAKEFILE +DSPTEST\ DSP example + DSPTEST.C + DSPTEST.RC + MAKEFILE + DSPTEST.NIB +LIVESPEC\ "Live" version of spectrum analyser example + LIVESPEC.C + MAKEFILE +MULTI\ Multiple device example + MULTI.C + MAKEFILE + MULTI.NIB +NETRADIO\ Internet streaming example + NETRADIO.C + MAKEFILE + NETRADIO.NIB +PLUGINS\ Plugins example + PLUGINS.C + MAKEFILE + PLUGINS.NIB +RECTEST\ Recording example + RECTEST.C + MAKEFILE + RECTEST.NIB +SPEAKERS\ Multi-speaker example + SPEAKERS.C + MAKEFILE + SPEAKERS.NIB +SPECTRUM\ Spectrum analyser example + SPECTRUM.C + MAKEFILE +WRITEWAV\ WAVE writer example + WRITEWAV.C + MAKEFILE + + +What's the point? +================= +BASS is an audio library for use in Windows and MacOSX software. Its +purpose is to provide the most powerful and efficient (yet easy to use), +sample, stream, MOD music, and recording functions. All in a tiny DLL, +under 100KB in size. + +See the documentation for descriptions of all the BASS functions. You +should also look at the included example program source-codes for some +examples of how to use BASS in your own programs. + + +Requirements +============ +Win32 version +------------- +BASS requires DirectX 3 or above for output. BASS does not require that a +soundcard with DirectSound/DirectSound3D hardware accelerated drivers is +installed, but it does improve performance if there is one. BASS also takes +advantage of MMX, which improves the performance of the MOD music playback. + +MacOSX version +-------------- +OSX 10.3 or above is recommended. BASS uses CoreAudio for output, so there +are no special library/driver requirements. BASS supports both PowerPC and +Intel Macs. + + +Main Features +============= +* Samples + supports WAV/AIFF/MP3/MP2/MP1/OGG and custom generated samples + +* Sample streams + stream any sample data in 8/16/32 bit, with both "push" and "pull" systems + +* File streams + MP3/MP2/MP1/OGG/WAV/AIFF file streaming + +* Internet file streaming + stream files from the internet, including Shout/Icecast + +* User file streaming + stream files from anywhere using any delivery method + +* Multi-channel streaming + support for more than plain stereo, including multi-channel OGG/WAV/AIFF files + +* MOD music + uses the same engine as XMPlay = best accuracy, speed, and quality + +* MO3 music + MP3/OGG compressed MOD music + +* Add-on system + support for more formats is available via add-ons (aka plugins) + +* Multiple outputs + simultaneously use multiple soundcards, and move channels between them + +* Recording + flexible recording system, with support for multiple devices + +* Decode without playback + streams and MOD musics can be outputted in any way you want + +* Speaker assignment + assign streams and MOD musics to specific speakers + +* High precision synchronization + synchronize events in your software to the streams and MOD musics + +* DirectX 8 effects + chorus/compressor/distortion/echo/flanger/gargle/parameq/reverb + +* User defined DSP functions + custom effects may be applied to musics and streams + +* 32 bit floating-point decoding and processing + floating-point stream/music decoding, DSP, FX, and recording + +* 3D sound + play samples/streams/musics in any 3D position, with EAX support + +* Small + BASS is under 100KB (on Windows), so won't bloat your distribution + + +Using BASS +========== +There is no guarantee that all future BASS versions will be compatible +with all previous versions, so your program should use BASS_GetVersion +to check the version that is loaded. This also means that you should +put the BASS module in the same directory as your executable (not just +somewhere in the path), to avoid the possibility of a wrong version being +loaded. + +If you are updating your software from a previous BASS version, then +you should check the "History" section (below), to see if any of the +functions that you are using have been affected by a change. + +Win32 version +------------- +C/C++, Visual Basic, Delphi and MASM APIs are provided, to use BASS with +another language you'll first have to convert the header file. Or, as a +last resort, you could use LoadLibrary and GetProcAddress. + +The downside is that you have to manually import each function that you +use, with the GetProcAddress function. But it has been made a lot simpler +to import BASS this way by the use of the BASSDEF #define. Here's a small +example: + +#define BASSDEF(f) (WINAPI *f) // define the functions as pointers +#include "bass.h" +... +HINSTANCE bass=LoadLibrary("BASS.DLL"); // load BASS +BASS_Init=GetProcAddress(bass,"BASS_Init"); // get BASS_Init +BASS_Init(-1,44100,0,hWnd,NULL); // call BASS_Init + +To use BASS with Borland C++ Builder, you'll first have to create a +Borland C++ Builder import library for it. This is done by using the +IMPLIB tool that comes with Borland C++ Builder. Simply execute this: + + IMPLIB BASSBCB.LIB BASS.DLL + +... and then use BASSBCB.LIB in your projects to import BASS. + +To use BASS with LCC-Win32, you'll first have to create a compatible +import library for it. This is done by using the PEDUMP and BUILDLIB +tools that come with LCC-Win32. Run these 2 commands: + + PEDUMP /EXP BASS.LIB > BASSLCC.EXP + BUILDLIB BASSLCC.EXP BASSLCC.LIB + +... and then use BASSLCC.LIB in your projects to import BASS. + +For the BASS functions that return strings (char*), VB users should use +the VBStrFromAnsiPtr function to convert the returned pointer into a VB +string. + +MacOSX version +-------------- +A separate "LIB" file is not required for OSX. Using XCode, you can simply +add the DYLIB file to the project. Or using a makefile, you can build your +programs like this, for example: + + gcc yoursource -L. -lbass -o yourprog + +The LIBBASS.DYLIB file must be put in the same directory as the executable +(it can't just be somewhere in the path). See the example makefiles. + +LIBBASS.DYLIB is a universal binary, with support for both PowerPC and +Intel Macs. If you want PowerPC-only or Intel-only versions, the included +makefile can create them for you, by typing "make ppc" or "make i386". It +will also process any BASS add-ons placed in the same directory. + + +Latest Version +============== +The latest version of BASS can always be found at the BASS website: + + www.un4seen.com + + +Licence +======= +BASS is free for non-commercial use. If you are a non-commercial entity +(eg. an individual) and you are not charging for your product, and the +product has no other commercial purpose, then you can use BASS in it +for free. If you wish to use BASS in commercial products, then please +also see the next section. + +TO THE MAXIMUM EXTENT PERMITTED BY APPLICABLE LAW, BASS IS PROVIDED +"AS IS", WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, +INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY +AND/OR FITNESS FOR A PARTICULAR PURPOSE. THE AUTHORS SHALL NOT BE HELD +LIABLE FOR ANY DAMAGE THAT MAY RESULT FROM THE USE OF BASS. YOU USE +BASS ENTIRELY AT YOUR OWN RISK. + +Usage of BASS indicates that you agree to the above conditions. + +All trademarks and other registered names contained in the BASS +package are the property of their respective owners. + +Commercial licensing +-------------------- +BASS is available for use in your commercial products. The licence +types available are as follows: + +SHAREWARE: Allows the usage of BASS in an unlimited number of your +shareware products, which must sell for no more than 40 Euros each. +If you are an individual (not a corporation) making and selling your +own software (and its price is within the limit), this is the licence +for you. + +SINGLE COMMERCIAL: Allows the usage of BASS in a single commercial +product. + +UNLIMITED COMMERCIAL: Allows the usage of BASS in an unlimited number +of your commercial products. This licence is on a per site basis. So +if your company has two sites that use BASS, then two licences are +required. + +Please note the products must be end-user products, eg. not components +used by other products. + +These licences only cover your own software, not the publishing of +other's software. If you publish other's software, its developers (or +the software itself) will need to be licensed to use BASS. + +These licences are on a per-platform basis, with reductions available +when licensing for both platforms. In all cases there are no royalties +to pay, and you can use future BASS updates without further cost. One +licence covers one person or entity and is not transferable. + +These licences do not allow reselling/sublicensing of BASS. For example, +if a product is a development system, the users of said product are not +licensed to use BASS in their productions; they will need their own +licences. + +If the standard licences do not meet your requirements, or if you have +any questions, please get in touch (email: bass@un4seen.com). + +Visit the BASS website for the latest pricing: + + www.un4seen.com + +MP3 +--- +MP3 technology is patented, and Thomson license the use of their and +Fraunhofer's patents. The inclusion of an MP3 decoder (eg. BASS) in a +commercial product requires an MP3 patent licence. Contact Thomson for +details: + + www.mp3licensing.com + +Alternatively, the "MP3-FREE" BASS version does not include its own MP3 +decoder but instead makes use of the operating system's already licensed +decoder. + +NOTE: When using the OS's MP3 decoder, BASS still does the file handling + so all the usual features are still supported, including streaming, + tag reading, pre-scanning, gapless playback, etc... + + +History +======= +These are the major (and not so major) changes at each version stage. +There are of course bug fixes and other little improvements made along +the way too! To make upgrading simpler, all functions affected by a +change to the BASS interface are listed. + +2.4 - 2/4/2008 +-------------- +* "Push" streaming + STREAMPROC_PUSH (BASS_StreamCreate "proc") + BASS_StreamPutData + LIVEFX and MULTI examples updated +* "Push" buffered file streaming + STREAMFILE_BUFFERPUSH (BASS_StreamCreateFileUser system) + BASS_StreamPutFileData +* STREAMFILEPROC replaced by table of callbacks for each file operation + BASS_FILEPROCS (FILECLOSEPROC/FILELENPROC/FILEREADPROC/FILESEEKPROC) + STREAMFILEPROC *removed* +* 64-bit file positioning + BASS_SampleLoad + BASS_MusicLoad + BASS_StreamCreateFile + BASS_StreamGetFilePosition +* File buffer level retrieval + BASS_FILEPOS_BUFFER (BASS_StreamGetFilePosition mode) +* Sinc interpolated MOD music mixing + BASS_MUSIC_SINCINTER (BASS_MusicLoad flag) +* MO3 v2.4 support + BASS_MusicLoad +* MOD orders positioning incorporated into channel functions + BASS_ChannelGetLength + BASS_ChannelSetPosition + BASS_ChannelGetPosition + BASS_MusicGetOrderPosition *removed* + BASS_MusicGetOrders *removed* +* Channel attribute functions consolidated + BASS_ChannelSetAttribute + BASS_ChannelGetAttribute + BASS_ChannelSlideAttribute + BASS_ChannelIsSliding + BASS_ChannelSetAttributes *removed* + BASS_ChannelGetAttributes *removed* + BASS_ChannelSlideAttributes *removed* + BASS_ChannelSetEAXMix *removed* + BASS_ChannelGetEAXMix *removed* + BASS_MusicSetAttribute *removed* + BASS_MusicGetAttribute *removed* +* Floating-point volume and panning + BASS_SetVolume + BASS_GetVolume + BASS_RecordSetInput + BASS_RecordGetInput + BASS_ATTRIB_PAN/VOL (BASS_ChannelGet/Set/SlideAttribute options) + BASS_ATTRIB_MUSIC_VOL_CHAN/INST (BASS_ChannelGet/Set/SlideAttribute options) + BASS_SAMPLE (volume/pan/outvol members) + BASS_CONFIG_MAXVOL *removed* + BASSTEST and RECTEST examples updated +* Output device volume control on Vista (as on other OS) + BASS_SetVolume + BASS_GetVolume +* Multiple update threads + BASS_CONFIG_UPDATETHREADS + BASSTEST example updated +* Global volume range increased to 10000 + BASS_CONFIG_GVOL_SAMPLE/STREAM/MUSIC (BASS_SetConfig options) + BASSTEST example updated +* Setting and retrieving of a sample's data + BASS_SampleSetData + BASS_SampleGetData + BASS_SampleCreate + BASS_SampleCreateDone *removed* +* Channel flag setting mask + BASS_ChannelFlags + BASS_ChannelSetFlags *removed* + SPEAKERS example updated +* 256 sample FFT + BASS_DATA_FFT256 (BASS_ChannelGetDat flag) +* Channel locking to prevent access by other threads + BASS_ChannelLock +* Manual channel buffer updating + BASS_ChannelUpdate + BASS_ChannelPreBuf *removed* +* Configurable manual update length + BASS_Update +* Extended device information retrieval and detection of new/removed devices + BASS_GetDeviceInfo + BASS_RecordGetDeviceInfo + BASS_DEVICEINFO structure + BASS_GetDeviceDescription *removed* + BASS_RecordGetDeviceDescription *removed* + BASS_INFO (driver member) *removed* + BASS_RECORDINFO (driver member) *removed* + MULTI example updated +* Default device change tracking on Windows (as on OSX) + BASS_Init + BASS_RecordInit +* Speaker detection from Windows control panel + BASS_DEVICE_CPSPEAKERS (BASS_Init flag) +* Channel automatically stopped & resumed for DX8 effects + BASS_ChannelSetFX + BASS_ChannelRemoveFX +* "double" precision position conversion + BASS_ChannelBytes2Seconds + BASS_ChannelSeconds2Bytes +* Separate config functions for pointers + BASS_SetConfigPtr + BASS_GetConfigPtr + BASS_CONFIG_NET_AGENT/PROXY (BASS_SetConfigPtr options) +* Configurable file format verification length + BASS_CONFIG_VERIFY (BASS_SetConfig option) +* Stream filename retrieval + BASS_CHANNELINFO (file member) +* Channel sample retrieval + BASS_CHANNELINFO (sample member) +* META syncs no longer receive metadata in the "data" parameter + BASS_SYNC_META (BASS_ChannelSetSync type) +* Separate sync for OGG logical bitstream changes (instead of BASS_SYNC_META) + BASS_SYNC_OGG_CHANGE (BASS_ChannelSetSync type) + NETRADIO example updated (C version) +* Message syncing removed (use PostMessage instead) + BASS_SYNC_MESSAGE (BASS_ChannelSetSync flag) *removed* +* Data retrieval from stopped/paused channels + BASS_ChannelGetData +* Callback "user" parameters changed to pointers + BASS_StreamCreate / STREAMPROC + BASS_StreamCreateFileUser + BASS_StreamCreateURL / DOWNLOADPROC + BASS_RecordStart / RECORDPROC + BASS_ChannelSetDSP / DSPPROC + BASS_ChannelSetSync / SYNCPROC + +2.3.0.3 - 30/7/2007 +------------------- +* FX state resetting + BASS_FXReset +* PLS/M3U playlist URL processing + BASS_CONFIG_NET_PLAYLIST + NETRADIO example updated +* Internet stream connection status retrieval + BASS_FILEPOS_CONNECTED (BASS_StreamGetFilePosition mode) +* Lyrics3v2 tags + BASS_TAG_LYRICS3 (BASS_ChannelGetTags type) +* IT virtual channel configuration + BASS_CONFIG_MUSIC_VIRTUAL +* Accurate speaker detection on Vista + BASS_INFO (speakers member) +* Device output/input rate retrieval on Vista + BASS_INFO (freq member) + BASS_RECORDINFO (freq member) +* Syncing upon position changes + BASS_SYNC_SETPOS (BASS_ChannelSetSync type) +* Improved stall handling + BASS_SYNC_STALL +* Invalid decoding channel flags produce an error instead of being ignored + BASS_StreamCreate/File/User/Url + BASS_MusicLoad + +2.3.0.2 - 22/1/2007 +------------------- +* Retrieval of a sample's existing channel handles + BASS_SampleGetChannels +* 8192 sample FFT + BASS_DATA_FFT8192 (BASS_ChannelGetData flag) +* Adjustable recording buffer + BASS_CONFIG_REC_BUFFER (BASS_SetConfig option) +* Stopping decoding channels before the end + BASS_ChannelStop +* Sample channels created paused to prevent overriding before playback + BASS_SampleGetChannel +* Separate "MP3-FREE" version using Windows/OSX MP3 decoder + BASS_CONFIG_MP3_CODEC *removed* + +2.3.0.1 - 12/6/2006 +------------------- +* Ability to move a channel to another device + BASS_ChannelSetDevice + MULTI example updated +* Support for ID3v2.4 tags at end of file + BASS_TAG_ID3V2 (BASS_ChannelGetTags type) + +2.3 - 21/5/2006 +--------------- +* MOD message/instrument/sample text retrieval, merged with stream tag retrieval function + BASS_ChannelGetTags + BASS_TAG_MUSIC_NAME/MESSAGE/INST/SAMPLE (BASS_ChannelGetTags types) + BASS_MusicGetName *removed* + BASS_StreamGetTags *removed* +* Plugin information retrieval + BASS_PluginGetInfo + BASS_PLUGININFO/FORM structures + BASS_CHANNELINFO (plugin member) + PLUGINS example updated +* RIFF/WAVE "INFO" tag retrieval + BASS_TAG_RIFF_INFO (BASS_StreamGetTags type) +* More specific WAVE format information + BASS_CTYPE_STREAM_WAV_PCM/FLOAT (channel types) + BASS_CTYPE_STREAM_WAV (channel type flag) +* Proxy server configuration + BASS_CONFIG_NET_PROXY (BASS_SetConfig option) + BASS_CONFIG_NET_NOPROXY *removed* + NETRADIO example updated +* Passive FTP mode + BASS_CONFIG_NET_PASSIVE (BASS_SetConfig option) +* Agent changes take immediate effect + BASS_CONFIG_NET_AGENT (BASS_SetConfig option) +* Minimum time gap between creating new sample channels + BASS_SAMPLE (mingap member) + BASS_SampleGetChannel +* Support for Unicode plugin filenames + BASS_PluginLoad +* Device output/input rate retrieval (MacOSX only) + BASS_INFO (freq member) + BASS_RECORDINFO (freq member) +* Extended version info (minor revision) + BASS_GetVersion +* Unsupported codec error code + BASS_ERROR_CODEC +* Optional use of the Windows MP3 codec + BASS_CONFIG_MP3_CODEC (BASS_SetConfig option) +* 3D support for MacOSX + BASS_Set3DFactors + BASS_Get3DFactors + BASS_Set3DPosition + BASS_Get3DPosition + BASS_Apply3D + BASS_ChannelSet3DAttributes + BASS_ChannelGet3DAttributes + BASS_ChannelSet3DPosition + BASS_ChannelGet3DPosition + 3DTEST example added (Win32 example also updated) +* VB version of SYNTH example added + +2.2 - 2/10/2005 +--------------- +* Add-on plugin system + BASS_PluginLoad + BASS_PluginFree + BASS_StreamCreateFile/User/Url + BASS_SampleLoad + PLUGINS example added +* MOD position & syncing in bytes + BASS_ChannelSetPosition + BASS_ChannelGetPosition + BASS_MusicGetOrderPosition added for orders position + BASS_SYNC_MUSICPOS added for orders syncing + MAKEMUSICPOS macro/define + CUSTLOOP example updated +* Stream/MOD "length" functions combined (also works with samples), new MOD orders length function + BASS_ChannelGetLength + BASS_MusicGetOrders + BASS_StreamGetLength *removed* + BASS_MusicGetLength *removed* +* Support for AIFF files + BASS_StreamCreateFile/User/Url + BASS_SampleLoad +* Support for 24 and 32-bit (integer) WAV files + BASS_StreamCreateFile/User/Url + BASS_SampleLoad +* WAV files are no longer converted to the "device" resolution + BASS_StreamCreateFile/User/Url +* Recording master control + BASS_RecordGetInput + BASS_RecordSetInput +* Adjustable prebuffering + BASS_ChannelPreBuf +* Floating-point data retrieval + BASS_DATA_FLOAT (BASS_ChannelGetData flag) +* Support for floating-point samples + BASS_SampleLoad + BASS_SampleCreate +* Multi-channel samples + BASS_SampleLoad/Create + BASS_SAMPLE (chans member) +* Sample lengths given in bytes + BASS_SampleCreate + BASS_SAMPLE (length member) +* MOD music 8-bit resolution option + BASS_MusicLoad +* OGG vendor tag retrieval + BASS_TAG_VENDOR (BASS_StreamGetTags type) +* Configurable "User-Agent" header for internet streams + BASS_CONFIG_NET_AGENT (BASS_SetConfig option) +* Shoutcast metadata is now requested automatically + BASS_STREAM_META flag *removed* +* Download callbacks receive all data from start of file/stream (including any non-audio data) + DOWNLOADPROC +* Length when streaming in blocks is unavailable (BASS_ERROR_NOTAVAIL, not just 0) + BASS_ChannelGetLength +* Support for growing custom file streams + BASS_FILE_LEN (STREAMFILEPROC action) +* Query file action removed + BASS_FILE_QUERY *removed* +* Recording channel syncing + BASS_ChannelSetSync +* Info structure "size" members removed + BASS_INFO structure + BASS_RECORDINFO structure +* Little bit of flag reshuffling + BASS_MP3_SETPOS renamed to BASS_STREAM_PRESCAN + BASS_MUSIC_CALCLEN value changed and renamed to BASS_MUSIC_PRESCAN + BASS_MUSIC_POSRESET value changed +* Add-on API enhancements +* MacOSX port introduced + +2.1 - 28/11/2004 +---------------- +* Improved "mixtime" sync system, allowing custom looping + SYNCPROC + CUSTLOOP example added +* FX can now be in the DSP chain, so can be prioritized and applied in floating-point + BASS_ChannelSetFX + BASS_CONFIG_FLOATDSP (BASS_SetConfig option) +* Ability to set channel flags (eg. looping) independent of playback + BASS_ChannelSetFlags + SPEAKERS example updated +* Stream/MOD "play" and channel "resume" functions combined + BASS_ChannelPlay + BASS_StreamPlay *removed* + BASS_MusicPlay *removed* + BASS_MusicPlayEx *removed* + BASS_ChannelResume *removed* +* Stream/MOD prebuffering functions combined + BASS_ChannelPreBuf + BASS_StreamPreBuf *removed* + BASS_MusicPreBuf *removed* +* MOD attribute functions combined, with added BPM/speed/globalvolume options + BASS_MusicSetAttribute + BASS_MusicGetAttribute + BASS_MUSIC_ATTRIB_AMPLIFY + BASS_MUSIC_ATTRIB_PANSEP + BASS_MUSIC_ATTRIB_PSCALER + BASS_MUSIC_ATTRIB_BPM + BASS_MUSIC_ATTRIB_SPEED + BASS_MUSIC_ATTRIB_VOL_GLOBAL + BASS_MUSIC_ATTRIB_VOL_CHAN + BASS_MUSIC_ATTRIB_VOL_INST + BASS_MusicSetAmplify *removed* + BASS_MusicSetPanSep *removed* + BASS_MusicSetPositionScaler *removed* + BASS_MusicSetVolume *removed* + BASS_MusicGetVolume *removed* +* Flag to reset bpm/etc as well as notes when seeking in MOD musics + BASS_MUSIC_POSRESETEX (BASS_MusicLoad & BASS_ChannelSetFlags flag) +* More flexible and concise sample channel creation system + BASS_SampleGetChannel + BASS_SamplePlay *removed* + BASS_SamplePlayEx *removed* + BASS_SamplePlay3D *removed* + BASS_SamplePlay3DEx *removed* +* Support for up to 30 speakers + BASS_SPEAKER_N macro/define +* More precise level measurement + BASS_ChannelGetLevel +* Level can now be retrieved from decoding channels + BASS_ChannelGetLevel +* Retrieval of a sample/channel's original sample resolution + BASS_SAMPLE (origres member) + BASS_CHANNELINFO (origres member) +* Support for streaming WAV files in "blocks" + BASS_StreamCreateURL + BASS_StreamCreateFileUser +* Status info (HTTP/ICY tags) available during connection to server + BASS_STREAM_STATUS (BASS_StreamCreateURL flag) + DOWNLOADPROC + NETRADIO example updated (Delphi version also added) +* Adjustable internet stream prebuffering + BASS_CONFIG_NET_PREBUF (BASS_SetConfig option) +* Option to bypass proxy server + BASS_CONFIG_NET_NOPROXY (BASS_SetConfig option) +* Option whether to allow channels to be played after BASS_Pause + BASS_CONFIG_PAUSE_NOPLAY (BASS_SetConfig option) +* Recording channel count now a separate parameter + BASS_RecordStart (chans parameter) +* Synchronizer for when a channel is freed + BASS_SYNC_FREE (BASS_ChannelSetSync type) +* Data start file position retrieval + BASS_FILEPOS_START (BASS_StreamGetFilePosition mode) +* Performance improvements + MP2 decoding ~20% faster + MP3/MP1 decoding & FFT processing all up to 10% faster + OGG decoding ~3% faster +* C/C++ examples reorganised, with makefiles & VC++ projects +* Add-on API enhancements +* More DLL shrinkage :) + +2.0 - 31/10/2003 +---------------- +* Multiple output device support + BASS_Init (device number changes) + BASS_SetDevice + BASS_GetDevice + BASS_ChannelGetDevice + MULTI example updated (VB version also added) +* Multiple recording device support + BASS_RecordSetDevice + BASS_RecordGetDevice + BASS_RecordStart + BASS_ChannelGetDevice + HRECORD handle + RECORDPROC (handle parameter) +* Recording with DSP/FX + BASS_ChannelSetDSP + BASS_ChannelSetFX +* Recording position retrieval + BASS_ChannelGetPosition +* Start recording paused + BASS_RECORD_PAUSE (BASS_RecordStart flag) +* Multi-channel streams, inc. support for multichannel OGG & WAV files + BASS_StreamCreate + BASS_StreamCreateFile/User/Url +* FFT for individual channels, inc. multi-channel streams + BASS_DATA_FFT_INDIVIDUAL (BASS_ChannelGetData flag) + BASS_DATA_FFT512S/1024S/2048S/4096S *removed* +* DSP prioritizing + BASS_ChannelSetDSP + DSPTEST example updated +* Seeking in internet streamed files + BASS_ChannelSetPosition +* Enhanced custom file stream systems + BASS_StreamCreateFileUser + BASS_FILE_SEEK (STREAMFILEPROC action) + BASS_STREAM_FILEPROC flag *removed* +* Enhanced custom stream system with automatic stalling/resuming + STREAMPROC + BASS_STREAMPROC_END (STREAMPROC flag) +* Synchronizer for stalled/resumed playback + BASS_SYNC_STALL (BASS_ChannelSetSync type) +* Synchronizer for completed download + BASS_SYNC_DOWNLOAD (BASS_ChannelSetSync type) +* End sync support for custom streams + BASS_SYNC_END (BASS_ChannelSetSync type) +* Synchronizer support for decoding channels + BASS_ChannelSetSync +* Unified configuration function + BASS_SetConfig + BASS_GetConfig + BASS_SetBufferLength *removed* + BASS_SetNetConfig *removed* + BASS_SetGlobalVolumes *removed* + BASS_GetGlobalVolumes *removed* + BASS_SetLogCurves *removed* + BASS_Set3DAlgorithm *removed* + BASS_DEVICE_FLOATDSP flag *removed* +* Internet stream saving to disk replaced by more flexible callback + BASS_StreamCreateURL + DOWNLOADPROC + VB NETRADIO example updated +* Buffer length retrieval when "streaming in blocks" + BASS_FILEPOS_END (BASS_StreamGetFilePosition mode) +* Individual sample rate setting for MOD musics + BASS_MusicLoad +* Channel type and default sample rate retrieval + BASS_ChannelGetInfo (replaces BASS_ChannelGetFlags) + BASS_CHANNELINFO +* MOD music flag retrieval + BASS_CHANNELINFO (flags member) +* Adjustable instrument volumes in MOD musics + BASS_MusicSetVolume (replaces BASS_MusicSetChannelVol) + BASS_MusicGetVolume (replaces BASS_MusicGetChannelVol) +* Automatically free a MOD music when it stops or ends + BASS_MUSIC_AUTOFREE (BASS_MusicLoad flag) +* Class GUID added to initialization parameters + BASS_Init + BASS_SetCLSID *removed* +* Update period adjustable at any time + BASS_CONFIG_UPDATEPERIOD (BASS_SetConfig option) + BASS_DEVICE_NOTHREAD flag *removed* +* Customizable maximum volume setting + BASS_CONFIG_MAXVOL (BASS_SetConfig option) + BASS_DEVICE_VOL1000 flag *removed* +* Device volume is now always left as it is during init/freeing + BASS_DEVICE_LEAVEVOL flag *removed* +* Device driver name retrieval + BASS_INFO (driver member) + BASS_RECORDINFO (driver member) +* Error codes are local to the current thread + BASS_ErrorGetCode +* Performance improvements + MP2 decoding 15-20% faster + MP3 decoding ~5% faster +* Built-in CD functions removed (replaced in BASSCD) + BASS_CDDoor *removed* + BASS_CDFree *removed* + BASS_CDGetID *removed* + BASS_CDGetTrackLength *removed* + BASS_CDGetTracks *removed* + BASS_CDInDrive *removed* + BASS_CDInit *removed* + BASS_CDPlay *removed* +* Force channels to use software mixing + BASS_SAMPLE_SOFTWARE (BASS_StreamCreate/File/User/URL & BASS_MusicLoad flag) +* Support for high-pass filter and forward/reverse (S9E/F) IT/MPT effects +* BASS_MUSIC flags rearranged to mirror BASS_SAMPLE/STREAM counterparts +* Output automatically started during initialization +* BASS_ChannelGetData once again accepts any "length" param +* All function comments have been removed from the API headers to avoid + outdated/incorrect information - the BASS.CHM documentation should be used. +* TMT Pascal API removed from main distribution - now available on the website +* A few more 'K' knocked off the DLL size :) + +1.8a - 18/6/2003 +---------------- +* Tweaks 'n' fixes, including... + Fixed seeking bug on 32-bit OGG streams + Fixed seeking on a decoding channel after it has reached the end + Low FPU precision (eg. when using Direct3D) issue addressed + Improved speakers (BASS_INFO) detection + BASS_ChannelSeconds2Bytes return value is rounded down to nearest sample + BASS_ChannelGetData "length" param must equal a whole number of samples + Slide syncs are triggered by "-2" volume slides on "autofree" streams +* Support for UNICODE filenames + BASS_UNICODE (BASS_SampleLoad/BASS_StreamCreateFile/BASS_MusicLoad flag) +* 4096 sample FFT + BASS_DATA_FFT4096/S (BASS_ChannelGetData flags) +* Another 'K' knocked off the DLL size + +1.8 - 9/3/2003 +-------------- +* 32-bit floating-point channels + BASS_SAMPLE_FLOAT (BASS_StreamCreate/URL/File flag) + BASS_MUSIC_FLOAT (BASS_MusicLoad flag) + BASS_SAMPLE_FLOAT (BASS_RecordStart flag) + BASS_DEVICE_FLOATDSP (BASS_Init flag) + DSPTEST example updated +* Support for 32-bit floating-point (type 3) WAV files + BASS_StreamCreateFile/URL + BASS_SampleLoad +* Channel speaker assignment + BASS_SPEAKER_FRONT (BASS_MusicLoad/BASS_StreamCreate/File/URL flag) + BASS_SPEAKER_REAR " + BASS_SPEAKER_CENLFE " + BASS_SPEAKER_REAR2 " + BASS_SPEAKER_FRONTLEFT " + BASS_SPEAKER_FRONTRIGHT " + BASS_SPEAKER_REARLEFT " + BASS_SPEAKER_REARRIGHT " + BASS_SPEAKER_CENTER " + BASS_SPEAKER_LFE " + BASS_SPEAKER_REAR2LEFT " + BASS_SPEAKER_REAR2RIGHT " + BASS_INFO (speakers member) + BASS_DEVICE_SPEAKERS (BASS_Init flag) + 4SPEAKER example replaced by SPEAKERS example +* Recording input type retrieval + BASS_INPUT_TYPE_xxx (BASS_RecordGetInput) + RECTEST example updated +* Non-interpolated MOD mixing + BASS_MUSIC_NONINTER (BASS_MusicLoad/PlayEx flag) +* Performance improvements + FFT up to 100% faster! + MP3(MPEG2/2.5) decoding up to 60% faster + MMX mixers 5-10% faster + MP3(MPEG1)/MP2/MP1/OGG decoding all ~5% faster +* Optional disabling of FFT windowing + BASS_DATA_FFT_NOWINDOW (BASS_ChannelGetData flag) +* BASS_ERROR_FILEFORM - error code to distinguish between file and sample format + BASS_MusicLoad + BASS_SampleLoad + BASS_StreamCreate/File/URL +* BASS_StreamGetFilePosition mode flags added + BASS_FILEPOS_DECODE/DOWNLOAD/END +* DirectX 9 detection + BASS_INFO (dsver member) +* Initialization flags retrieval + BASS_INFO (initflags member) +* Half-rate MP3 playback option removed + BASS_MP3_HALFRATE flag *removed* +* New internal "plugin" system - BASSWMA is further integrated as a result +* Improved documentation - integrated with BASSWMA, search option added +* VB version of DSPTEST example added +* Delphi RECORDTEST example added +* Guess what... reduced DLL size again :) + +1.7 - 27/10/2002 +---------------- +* New alternative DX8 (DMO) effects implementation + BASS_StreamCreate/File/URL + BASS_MusicLoad + BASS_ChannelSetFX + SYNTH example updated +* User file streaming + BASS_STREAM_FILEPROC (BASS_StreamCreate flag) + STREAMFILEPROC +* DSP & FX support for decoding channels + BASS_ChannelSetDSP + BASS_ChannelSetFX +* Support for DX8 (DMO) effects in IT/XM/MO3 files + BASS_MusicLoad +* Support for chained OGG streaming (and syncing) + BASS_StreamCreateURL + BASS_SYNC_META (BASS_ChannelSetSync type) +* Attribute (volume/frequency/pan) sliding + BASS_ChannelSlideAttributes + BASS_ChannelIsSliding + BASS_SYNC_SLIDE (BASS_ChannelSetSync type) +* Recording without a callback function + BASS_RecordStart + LIVEFX example added +* Query a channel's buffered data + BASS_DATA_AVAILABLE (BASS_ChannelGetData flag) +* Discard data from the recording buffer + BASS_ChannelGetData +* Adjustable internet stream config (timeout/buffer lengths) + BASS_SetNetConfig +* Recommended minimum buffer length + BASS_INFO (minbuf member) +* MOD music flags adjustment without changing playback position + BASS_MusicPlayEx + PLAYER (MASM) example updated +* More functions are now useable in MOD music "mixtime" syncs + SYNCPROC + BASS_ChannelSetPosition + BASS_MusicPlayEx + BASS_MusicSetAmplify + BASS_MusicSetPanSep +* Maximum buffer length increased to 5 seconds + BASS_SetBufferLength +* Support for extended filter range in IT files + BASS_MusicLoad +* Speedier MOD music file verification + BASS_MusicLoad +* Delphi 3DTEST example fixed +* Magically reduced DLL size again :) + +1.6a - 25/8/2002 +---------------- +* OGG support updated to 1.0 +* Stereo FFT + BASS_DATA_FFT512S/1024S/2048S (BASS_ChannelGetData flags) +* Support for "Invert Loop" (EFx) MOD effect +* Reduced DLL size +* New Delphi examples + WRITEWAV - WAVE writer example + SAMPLEVIS - Visualisation example + +1.6 - 13/6/2002 +--------------- +* 64-bit stream lengths and positions + BASS_StreamGetLength + BASS_ChannelBytes2Seconds + BASS_ChannelSeconds2Bytes + BASS_ChannelGetPosition + BASS_ChannelSetPosition + BASS_ChannelSetSync +* Recording input selection + BASS_RECORDINFO (inputs & singlein members) + BASS_RecordGetInputName + BASS_RecordGetInput + BASS_RecordSetInput +* Adjustable recording update period + BASS_RecordStart +* Load OGG files as samples + BASS_SampleLoad +* CD drive door opening & closing + BASS_CDDoor +* CDDB2 ID retrieval + BASS_CDID_CDDB2 (BASS_CDGetID flag) +* Streaming beyond initial file length + BASS_StreamCreateFile +* Recording position bytes<->seconds translation + BASS_ChannelBytes2Seconds + BASS_ChannelSeconds2Bytes +* Improved multi-threaded support (play from any thread) + BASS_MusicPlay/Ex + BASS_SamplePlay/3D/Ex + BASS_StreamPlay + BASS_DEVICE_NOSYNC flag *removed* +* Paused channel status + BASS_ACTIVE_PAUSED (BASS_ChannelIsActive) +* Integrated WMA stream freeing + BASS_StreamFree + BASS_Free +* Pin-point accurate OGG seeking without BASS_MP3_SETPOS flag +* Win2k DS buffer bug fix + +1.5a - 14/4/2002 +---------------- +* NT4 fix (also enables "nosound" device without DX installed) + BASS_ERROR_DX error code +* MOD music loading without the samples + BASS_MUSIC_NOSAMPLE (BASS_MusicLoad flag) +* Custom decoding channels + BASS_STREAM_DECODE (BASS_StreamCreate flag) +* 5 second HTTP connection timeout + BASS_ERROR_TIMEOUT (BASS_StreamCreateURL error code) + +1.5 - 31/3/2002 +--------------- +* Improved performance + MMX mixers lot faster (over 50% faster in some cases!) + OGG decoding 15-20% faster + MP3 decoding 5-10% faster +* Recording + BASS_RecordGetDeviceDescription + BASS_RecordInit + BASS_RecordFree + BASS_RecordGetInfo + BASS_RecordStart +* OGG support built-in (OGG/VORBIS DLLs not required) + BASS_DEVICE_OGG flag *removed* +* MOD music seeking in seconds + BASS_MusicPlayEx + BASS_ChannelSetPosition +* Shoutcast metadata retrieval + BASS_STREAM_META (BASS_StreamCreateURL flag) + BASS_TAG_META (BASS_StreamGetTags type) + BASS_SYNC_META (BASS_ChannelSetSync type) +* 1000 volume levels + BASS_DEVICE_VOL1000 (BASS_Init/CDInit flag) +* CDDB ID retrieval + BASS_CDID_CDDB (BASS_CDGetID flag) +* Leave the CD volume as it is during init/closing + BASS_DEVICE_LEAVEVOL (BASS_CDInit flag) +* FFT enabled on decoding channels + BASS_ChannelGetData +* Left level duplicated on right for mono channels + BASS_ChannelGetLevel +* Improved MPEG length estimation without BASS_MP3_SETPOS flag + BASS_StreamGetLength +* Support for Modplug/ADPCM compressed files + BASS_MusicLoad +* Device description function parameter change + BASS_GetDeviceDescription +* MASM API + +1.4 - 30/1/2002 +--------------- +* Channel decoding without playback + BASS_MUSIC_DECODE (BASS_MusicLoad flag) + BASS_STREAM_DECODE (BASS_StreamCreateFile/URL flag) + BASS_ChannelGetData +* Windows message sync callbacks + BASS_SYNC_MESSAGE (BASS_ChannelSetSync flag) +* Adjustable channel volumes in MOD musics + BASS_MusicSetChannelVol + BASS_MusicGetChannelVol +* Customizable DirectSound initialization object + BASS_SetCLSID +* Retrieve HMUSIC/HSTREAM/HCHANNEL IDirectSoundBuffer interfaces + BASS_GetDSoundObject +* A3D functions removed (use BASS_SetCLSID/BASS_GetDSoundObject to access A3D) + BASS_DEVICE_A3D (BASS_Init flag) + BASS_SetA3DResManager + BASS_GetA3DResManager + BASS_SetA3DHFAbsorbtion + BASS_GetA3DHFAbsorbtion +* Callback functions now work in VB6 + DSPPROC + STREAMPROC + SYNCPROC +* Improved PCM WAVE streaming performance + BASS_StreamCreateFile + BASS_StreamCreateURL +* OGG modules updated to RC3 +* Stereo sample support in MO3 format +* MO3 encoder now distributed separately from BASS + +1.3 - 17/11/2001 +---------------- +* Manual buffer updating + BASS_DEVICE_NOTHREAD (BASS_Init flag) + BASS_Update +* Adjustable buffer update period (allows small buffer sizes) + BASS_Init +* Output device latency retrieval + BASS_INFO (latency member) +* MPEG/OGG seeking without BASS_MP3_SETPOS flag + BASS_ChannelSetPosition +* Internet file streaming from offsets + BASS_StreamCreateURL +* File stream tag/comment retrieval (ID3/ID3v2/OGG/HTTP/ICY tags) + BASS_StreamGetTags +* Byte<->time position translation + BASS_ChannelBytes2Seconds + BASS_ChannelSeconds2Bytes +* UMX (Unreal/Tournament music package) format support + BASS_MusicLoad +* S3M/IT sync fx changed to S2x (S0x conflicted with S00) + BASS_SYNC_MUSICFX +* Stereo sample support in IT/XM/S3M formats +* MO3: OGG compression supported + +1.2 - 25/9/2001 +--------------- +* OGG (Ogg Vorbis) stream support + BASS_DEVICE_OGG (BASS_Init flag) + BASS_StreamCreateFile + BASS_StreamCreateURL +* Channel linking (start/stop/pause/resume channels together) + BASS_ChannelSetLink + BASS_ChannelRemoveLink +* MOD music playback length calculation + BASS_MUSIC_CALCLEN (BASS_MusicLoad flag) + BASS_MusicGetLength +* Pre-buffering + BASS_MusicPreBuf + BASS_StreamPreBuf +* Samples with single simultaneous playbacks have same HSAMPLE/HCHANNEL handle + BASS_SamplePlay/Ex +* Stopping a custom stream flushes its buffer contents + BASS_ChannelStop + +1.1a - 31/8/2001 +---------------- +* NT4 bug fixed +* XM Wxx effect syncing + BASS_SYNC_MUSICFX +* MP3/2/1 rewinding without BASS_MP3_SETPOS + BASS_ChannelSetPosition + +1.1 - 11/8/2001 +--------------- +* DX8 (DMO) effects + BASS_SAMPLE_FX (BASS_StreamCreate/File/URL flag) + BASS_MUSIC_FX (BASS_MusicLoad flag) + BASS_ChannelSetFX + BASS_ChannelRemoveFX + BASS_FXSetParameters + BASS_FXGetParameters + BASS_FXCHORUS structure + BASS_FXCOMPRESSOR structure + BASS_FXDISTORTION structure + BASS_FXECHO structure + BASS_FXFLANGER structure + BASS_FXGARGLE structure + BASS_FXI3DL2REVERB structure + BASS_FXPARAMEQ structure + BASS_FXREVERB structure +* Internet file streaming in blocks (inc. Shoutcast/Icecast stream support) + BASS_STREAM_BLOCK (BASS_StreamCreateURL flag) +* 512/1024/2048 sample FFT + BASS_DATA_FFT512/1024/2048 (BASS_ChannelGetData flags) +* CD identification + BASS_CDGetID +* Improved DX version detection + BASS_INFO (dsver member) + +1.0 - 20/6/2001 +--------------- +* Load MP3/MP2/MP1 files as samples + BASS_SampleLoad +* Internet file streaming from FTP servers + BASS_StreamCreateURL +* Save a local copy of internet file streams + BASS_StreamCreateURL +* Sample accurate file stream seeking + BASS_ChannelSetPosition + BASS_StreamGetBlockLength *removed* +* Stream position synchronizer + BASS_SYNC_POS +* Increased synchronizer precision +* Improved MPEG file detection and error detection +* Stop MOD musics on a backwards jump effect + BASS_MUSIC_STOPBACK (BASS_MusicLoad/PlayEx flag) +* Leave the volume as it is during closing (as well as initialization) + BASS_DEVICE_LEAVEVOL (BASS_Init flag) +* Optional automatic use of foreground window handle during initialization + BASS_Init +* Reduced DLL size +* VB API fixes + +0.9 - 18/4/2001 +--------------- +* Internet file streaming + BASS_StreamCreateURL +* MP1 & MP2 (MPEG layer 1 & 2) support + BASS_StreamCreateFile/URL +* MPEG 2.5 support (12000/11025/8000hz sample rates) + BASS_StreamCreateFile/URL +* Decoding/download/end file stream position retrieval + BASS_StreamGetFilePosition +* XMPlay surround sound for MOD musics + BASS_MUSIC_SURROUND (BASS_MusicLoad/PlayEx flag) + BASS_MUSIC_SURROUND2 (BASS_MusicLoad/PlayEx flag) +* Restrict the download rate of internet file streams + BASS_STREAM_RESTRATE (BASS_StreamCreateURL flag) +* Check if an internet file stream is stalled + BASS_ChannelIsActive +* Automatically free a stream when it stops or ends + BASS_STREAM_AUTOFREE (BASS_StreamCreate/File/URL flag) +* Leave the volume as it is during initialization + BASS_DEVICE_LEAVEVOL (BASS_Init flag) +* Number of CD tracks retrieval + BASS_CDGetTracks +* CD track length retrieval + BASS_CDGetTrackLength +* Exact stream length set after whole file is streamed + BASS_StreamGetLength +* TMT Pascal API and samples +* Dynamic-loading Delphi API + +0.8a - 28/2/2000 +---------------- +* Updated Delphi API and samples + +0.8 - 24/1/2000 +--------------- +* Improved MP3 performance on P2/K6 and above CPUs - fast! +* User DSP functions on streams and MOD musics + BASS_ChannelSetDSP + BASS_ChannelRemoveDSP +* DX7 voice allocation & management + BASS_SAMPLE_VAM (BASS_SampleLoad/Create flag) + BASS_VAM_xxx flags + BASS_SAMPLE (vam & priority members) +* DX7 software 3D algorithm selection + BASS_Set3DAlgorithm +* DirectSound interface retrieval + BASS_GetDSoundObject +* Log/linear volume & panning curves + BASS_SetLogCurves +* User data passed to callback functions + STREAMPROC - BASS_StreamCreate + SYNCPROC - BASS_ChannelSetSync +* New synchronizer + BASS_SYNC_MUSICFX +* New synchronizer flag + BASS_SYNC_MIXTIME +* Disable synchronizers option - saves a little CPU time + BASS_DEVICE_NOSYNC (BASS_Init flag) +* Hi-res floating-point CPU usage monitoring + BASS_GetCPU +* Wait for playback to start when playing a CD + BASS_CDPlay +* DirectSound (dsound.dll) version retrieval + BASS_INFO (dsver member) +* Removed volume sliding functions (they were fairly pointless) + BASS_SlideVolume + BASS_IsSliding +* MO3: read/write encoder settings +* MO3: remove inst/samp/message texts now optional +* MO3: LAME encoder settings + +0.7 - 3/10/1999 +--------------- +* MO3 (MP3 compressed MODs) +* A3D functions + BASS_DEVICE_A3D (BASS_Init flag) + BASS_INFO (a3d member) + BASS_SetA3DResManager + BASS_GetA3DResManager + BASS_SetA3DHFAbsorbtion + BASS_GetA3DHFAbsorbtion +* Music/stream immediate sample data retrieval + BASS_ChannelGetData +* File stream (WAV/MP3) length retrieval + BASS_StreamGetLength + BASS_StreamGetBlockLength +* File stream seeking + BASS_ChannelSetPosition +* Mono MP3 option (lower CPU usage) + BASS_StreamCreateFile +* Music length retrieval + BASS_MusicGetLength +* Music name retrieval + BASS_MusicGetName +* Stop notes when moving MOD music position + BASS_MUSIC_POSRESET (BASS_MusicLoad/BASS_MusicPlayEx flag) +* BASS_ERROR_FREQ - invalid sample rate error code + BASS_SampleCreate + BASS_SamplePlayEx + BASS_SamplePlay3DEx + BASS_StreamCreate + BASS_ChannelSetAttributes +* Delphi and VB APIs + +0.6a - 26/7/1999 +---------------- +* Half rate MP3 option (lower CPU usage) + BASS_MP3_HALFRATE +* Loading/streaming from file offsets + BASS_MusicLoad + BASS_SampleLoad + BASS_StreamCreateFile +* Global music/sample/stream volume levels + BASS_SetGlobalVolumes + BASS_GetGlobalVolumes +* Other new function + BASS_SampleStop +* New synchronizer + BASS_SYNC_END +* New sample overrider + BASS_SAMPLE_OVER_DIST +* LoadLibrary/GetProcAddress instructions and example + +0.5 - 4/7/1999 +-------------- +* Documentation! +* File streaming (MP3 and WAV) + BASS_StreamCreateFile +* Custom generated samples + BASS_SampleCreate + BASS_SampleCreateDone +* Other new function + BASS_MusicSetPositionScaler +* Renamed function + BASS_ChannelClearSync -> BASS_ChannelRemoveSync +* Alterations made to + BASS_ChannelGetPosition + BASS_SampleLoad + BASS_StreamPlay + +0.4 - 30/3/1999 +--------------- +* Compressed WAV samples support (using audio CODECs) +* Updated CD volume handling - now works with SB Live +* More linear channel volume/pan scales (were slightly off before) +* "no sound" device option +* 3D sound functions + BASS_Set3DFactors + BASS_Get3DFactors + BASS_Set3DPosition + BASS_Get3DPosition + BASS_Apply3D + BASS_SamplePlay3D + BASS_SamplePlay3DEx + BASS_ChannelSet3DAttributes + BASS_ChannelGet3DAttributes + BASS_ChannelSet3DPosition + BASS_ChannelGet3DPosition +* EAX functions + BASS_SetEAXParameters + BASS_GetEAXParameters + BASS_ChannelSetEAXMix + BASS_ChannelGetEAXMix +* Other new functions + BASS_GetDeviceDescription + BASS_SetBufferLen + BASS_ChannelGetFlags + BASS_ChannelPause + BASS_ChannelResume + BASS_ChannelSetPosition +* Replaced function + BASS_CDResume -> BASS_ChannelResume +* Alterations made to + BASS_Init + BASS_CDInit + BASS_SampleLoad + BASS_StreamPlay + BASS_INFO structure + BASS_SAMPLE structure + BASS_DEVICE_xxx flags + BASS_SAMPLE_xxx flags + +0.3 - 8/3/1999 +-------------- +* Synchronization functions + BASS_ChannelSetSync + BASS_ChannelClearSync +* Other new functions + BASS_GetVersion + BASS_ChannelGetPosition + BASS_ChannelGetLevel + BASS_ChannelGetAttributes + BASS_ChannelSetAttributes +* Replaced functions + BASS_MusicStop -> BASS_ChannelStop + BASS_MusicSetVolume -> BASS_ChannelSetAttributes + BASS_CDStop -> BASS_ChannelStop + BASS_CDSetVolume -> BASS_ChannelSetAttributes + BASS_CDGetVolume -> BASS_ChannelGetAttributes + BASS_ChannelUpdate -> BASS_ChannelSetAttributes +* Alterations made to + BASS_MusicPlayEx + BASS_StreamPlay + BASS_INFO structure + +0.2 - 28/2/1999 +--------------- +* First public release + + +Credits +======= +Ogg Vorbis decoding is based on libogg/vorbis, +Copyright (c) 2002-2004 Xiph.org Foundation + +CHMOX is (c) 2004 Stéphane Boisson, http://chmox.sourceforge.net/ + +API/Sample contributors +----------------------- +Visual Basic: Adam Hoult, Hendrik Knaepen, Arthur Aminov, + Peter Hebels +Delphi: Titus Miloi, Rogier Timmermans, Alessandro Cappellozza, + Jesse Naranjo, Chris Troesken +MASM: Octavian Chis + + +Bug reports, Suggestions, Comments, Enquiries, etc... +===================================================== +If you have any of the aforementioned please visit the BASS forum at +the website. If you can't find an answer there, you can also email: + + bass@un4seen.com + diff --git a/Game/Code/lib/ffmpeg/avcodec.pas b/Game/Code/lib/ffmpeg/avcodec.pas index d4271697..c2493605 100644 --- a/Game/Code/lib/ffmpeg/avcodec.pas +++ b/Game/Code/lib/ffmpeg/avcodec.pas @@ -1,3292 +1,3292 @@ -(*
- * copyright (c) 2001 Fabrice Bellard
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser 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
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
- *)
-
-(* This is a part of Pascal porting of ffmpeg.
- * Originally by Victor Zinetz for Delphi and Free Pascal on Windows.
- * For Mac OS X, some modifications were made by The Creative CAT, denoted as CAT
- * in the source codes *)
-
-(*
- * Min. version: 51.16.0
- * Max. version: 51.56.0, revision 13019, Tue Apr 29 14:08:01 2008 UTC
- *)
-
-unit avcodec;
-
-{$IFDEF FPC}
- {$MODE DELPHI }
- {$PACKENUM 4} (* use 4-byte enums *)
- {$PACKRECORDS C} (* C/C++-compatible record packing *)
-{$ELSE}
- {$MINENUMSIZE 4} (* use 4-byte enums *)
-{$ENDIF}
-
-{$IFDEF DARWIN}
- {$linklib libavcodec}
-{$ENDIF}
-
-interface
-
-uses
- avutil,
- rational,
- opt,
- {$IFDEF UNIX}
- BaseUnix,
- {$ENDIF}
- UConfig;
-
-const
- (* Max. supported version by this header *)
- LIBAVCODEC_MAX_VERSION_MAJOR = 51;
- LIBAVCODEC_MAX_VERSION_MINOR = 56;
- LIBAVCODEC_MAX_VERSION_RELEASE = 0;
- LIBAVCODEC_MAX_VERSION = (LIBAVCODEC_MAX_VERSION_MAJOR * VERSION_MAJOR) +
- (LIBAVCODEC_MAX_VERSION_MINOR * VERSION_MINOR) +
- (LIBAVCODEC_MAX_VERSION_RELEASE * VERSION_RELEASE);
-
-(* Check if linked version is supported *)
-{$IF (LIBAVCODEC_VERSION > LIBAVCODEC_MAX_VERSION)}
- {$MESSAGE Warn 'Linked version of libavcodec may be unsupported!'}
-{$IFEND}
-
-const
- AV_NOPTS_VALUE: int64 = $8000000000000000;
- AV_TIME_BASE = 1000000;
- AV_TIME_BASE_Q : TAVRational = (num:1; den:AV_TIME_BASE); (* added by CAT *)
-
-(**
- * Identifies the syntax and semantics of the bitstream.
- * The principle is roughly:
- * Two decoders with the same ID can decode the same streams.
- * Two encoders with the same ID can encode compatible streams.
- * There may be slight deviations from the principle due to implementation
- * details.
- *
- * If you add a codec ID to this list, add it so that
- * 1. no value of a existing codec ID changes (that would break ABI),
- * 2. it is as close as possible to similar codecs.
- *)
-type
- TCodecID = (
- CODEC_ID_NONE,
-
- (* video codecs *)
- CODEC_ID_MPEG1VIDEO,
- CODEC_ID_MPEG2VIDEO, //* prefered ID for MPEG Video 1/2 decoding */
- CODEC_ID_MPEG2VIDEO_XVMC,
- CODEC_ID_H261,
- CODEC_ID_H263,
- CODEC_ID_RV10,
- CODEC_ID_RV20,
- CODEC_ID_MJPEG,
- CODEC_ID_MJPEGB,
- CODEC_ID_LJPEG,
- CODEC_ID_SP5X,
- CODEC_ID_JPEGLS,
- CODEC_ID_MPEG4,
- CODEC_ID_RAWVIDEO,
- CODEC_ID_MSMPEG4V1,
- CODEC_ID_MSMPEG4V2,
- CODEC_ID_MSMPEG4V3,
- CODEC_ID_WMV1,
- CODEC_ID_WMV2,
- CODEC_ID_H263P,
- CODEC_ID_H263I,
- CODEC_ID_FLV1,
- CODEC_ID_SVQ1,
- CODEC_ID_SVQ3,
- CODEC_ID_DVVIDEO,
- CODEC_ID_HUFFYUV,
- CODEC_ID_CYUV,
- CODEC_ID_H264,
- CODEC_ID_INDEO3,
- CODEC_ID_VP3,
- CODEC_ID_THEORA,
- CODEC_ID_ASV1,
- CODEC_ID_ASV2,
- CODEC_ID_FFV1,
- CODEC_ID_4XM,
- CODEC_ID_VCR1,
- CODEC_ID_CLJR,
- CODEC_ID_MDEC,
- CODEC_ID_ROQ,
- CODEC_ID_INTERPLAY_VIDEO,
- CODEC_ID_XAN_WC3,
- CODEC_ID_XAN_WC4,
- CODEC_ID_RPZA,
- CODEC_ID_CINEPAK,
- CODEC_ID_WS_VQA,
- CODEC_ID_MSRLE,
- CODEC_ID_MSVIDEO1,
- CODEC_ID_IDCIN,
- CODEC_ID_8BPS,
- CODEC_ID_SMC,
- CODEC_ID_FLIC,
- CODEC_ID_TRUEMOTION1,
- CODEC_ID_VMDVIDEO,
- CODEC_ID_MSZH,
- CODEC_ID_ZLIB,
- CODEC_ID_QTRLE,
- CODEC_ID_SNOW,
- CODEC_ID_TSCC,
- CODEC_ID_ULTI,
- CODEC_ID_QDRAW,
- CODEC_ID_VIXL,
- CODEC_ID_QPEG,
- CODEC_ID_XVID,
- CODEC_ID_PNG,
- CODEC_ID_PPM,
- CODEC_ID_PBM,
- CODEC_ID_PGM,
- CODEC_ID_PGMYUV,
- CODEC_ID_PAM,
- CODEC_ID_FFVHUFF,
- CODEC_ID_RV30,
- CODEC_ID_RV40,
- CODEC_ID_VC1,
- CODEC_ID_WMV3,
- CODEC_ID_LOCO,
- CODEC_ID_WNV1,
- CODEC_ID_AASC,
- CODEC_ID_INDEO2,
- CODEC_ID_FRAPS,
- CODEC_ID_TRUEMOTION2,
- CODEC_ID_BMP,
- CODEC_ID_CSCD,
- CODEC_ID_MMVIDEO,
- CODEC_ID_ZMBV,
- CODEC_ID_AVS,
- CODEC_ID_SMACKVIDEO,
- CODEC_ID_NUV,
- CODEC_ID_KMVC,
- CODEC_ID_FLASHSV,
- CODEC_ID_CAVS,
- CODEC_ID_JPEG2000,
- CODEC_ID_VMNC,
- CODEC_ID_VP5,
- CODEC_ID_VP6,
- CODEC_ID_VP6F,
- CODEC_ID_TARGA,
- CODEC_ID_DSICINVIDEO,
- CODEC_ID_TIERTEXSEQVIDEO,
- CODEC_ID_TIFF,
- CODEC_ID_GIF,
- CODEC_ID_FFH264,
- CODEC_ID_DXA,
- CODEC_ID_DNXHD,
- CODEC_ID_THP,
- CODEC_ID_SGI,
- CODEC_ID_C93,
- CODEC_ID_BETHSOFTVID,
- CODEC_ID_PTX,
- CODEC_ID_TXD,
- CODEC_ID_VP6A,
- CODEC_ID_AMV,
- CODEC_ID_VB,
- CODEC_ID_PCX,
- CODEC_ID_SUNRAST,
- CODEC_ID_INDEO4,
- CODEC_ID_INDEO5,
- CODEC_ID_MIMIC,
- CODEC_ID_RL2,
- CODEC_ID_8SVX_EXP,
- CODEC_ID_8SVX_FIB,
- CODEC_ID_ESCAPE124,
- CODEC_ID_DIRAC,
- CODEC_ID_BFI,
-
- //* various PCM "codecs" */
- CODEC_ID_PCM_S16LE= $10000,
- CODEC_ID_PCM_S16BE,
- CODEC_ID_PCM_U16LE,
- CODEC_ID_PCM_U16BE,
- CODEC_ID_PCM_S8,
- CODEC_ID_PCM_U8,
- CODEC_ID_PCM_MULAW,
- CODEC_ID_PCM_ALAW,
- CODEC_ID_PCM_S32LE,
- CODEC_ID_PCM_S32BE,
- CODEC_ID_PCM_U32LE,
- CODEC_ID_PCM_U32BE,
- CODEC_ID_PCM_S24LE,
- CODEC_ID_PCM_S24BE,
- CODEC_ID_PCM_U24LE,
- CODEC_ID_PCM_U24BE,
- CODEC_ID_PCM_S24DAUD,
- CODEC_ID_PCM_ZORK,
- CODEC_ID_PCM_S16LE_PLANAR,
-
- //* various ADPCM codecs */
- CODEC_ID_ADPCM_IMA_QT= $11000,
- CODEC_ID_ADPCM_IMA_WAV,
- CODEC_ID_ADPCM_IMA_DK3,
- CODEC_ID_ADPCM_IMA_DK4,
- CODEC_ID_ADPCM_IMA_WS,
- CODEC_ID_ADPCM_IMA_SMJPEG,
- CODEC_ID_ADPCM_MS,
- CODEC_ID_ADPCM_4XM,
- CODEC_ID_ADPCM_XA,
- CODEC_ID_ADPCM_ADX,
- CODEC_ID_ADPCM_EA,
- CODEC_ID_ADPCM_G726,
- CODEC_ID_ADPCM_CT,
- CODEC_ID_ADPCM_SWF,
- CODEC_ID_ADPCM_YAMAHA,
- CODEC_ID_ADPCM_SBPRO_4,
- CODEC_ID_ADPCM_SBPRO_3,
- CODEC_ID_ADPCM_SBPRO_2,
- CODEC_ID_ADPCM_THP,
- CODEC_ID_ADPCM_IMA_AMV,
- CODEC_ID_ADPCM_EA_R1,
- CODEC_ID_ADPCM_EA_R3,
- CODEC_ID_ADPCM_EA_R2,
- CODEC_ID_ADPCM_IMA_EA_SEAD,
- CODEC_ID_ADPCM_IMA_EA_EACS,
- CODEC_ID_ADPCM_EA_XAS,
- CODEC_ID_ADPCM_EA_MAXIS_XA,
-
- //* AMR */
- CODEC_ID_AMR_NB= $12000,
- CODEC_ID_AMR_WB,
-
- //* RealAudio codecs*/
- CODEC_ID_RA_144= $13000,
- CODEC_ID_RA_288,
-
- //* various DPCM codecs */
- CODEC_ID_ROQ_DPCM= $14000,
- CODEC_ID_INTERPLAY_DPCM,
- CODEC_ID_XAN_DPCM,
- CODEC_ID_SOL_DPCM,
-
- (* audio codecs *)
- CODEC_ID_MP2= $15000,
- CODEC_ID_MP3, ///< preferred ID for decoding MPEG audio layer 1, 2 or 3
- CODEC_ID_AAC,
- {$IF LIBAVCODEC_VERSION < 52000000} // 52.0.0
- _CODEC_ID_MPEG4AAC, // will be redefined to CODEC_ID_AAC below
- {$IFEND}
- CODEC_ID_AC3,
- CODEC_ID_DTS,
- CODEC_ID_VORBIS,
- CODEC_ID_DVAUDIO,
- CODEC_ID_WMAV1,
- CODEC_ID_WMAV2,
- CODEC_ID_MACE3,
- CODEC_ID_MACE6,
- CODEC_ID_VMDAUDIO,
- CODEC_ID_SONIC,
- CODEC_ID_SONIC_LS,
- CODEC_ID_FLAC,
- CODEC_ID_MP3ADU,
- CODEC_ID_MP3ON4,
- CODEC_ID_SHORTEN,
- CODEC_ID_ALAC,
- CODEC_ID_WESTWOOD_SND1,
- CODEC_ID_GSM, ///< as in Berlin toast format
- CODEC_ID_QDM2,
- CODEC_ID_COOK,
- CODEC_ID_TRUESPEECH,
- CODEC_ID_TTA,
- CODEC_ID_SMACKAUDIO,
- CODEC_ID_QCELP,
- CODEC_ID_WAVPACK,
- CODEC_ID_DSICINAUDIO,
- CODEC_ID_IMC,
- CODEC_ID_MUSEPACK7,
- CODEC_ID_MLP,
- CODEC_ID_GSM_MS, { as found in WAV }
- CODEC_ID_ATRAC3,
- CODEC_ID_VOXWARE,
- CODEC_ID_APE,
- CODEC_ID_NELLYMOSER,
- CODEC_ID_MUSEPACK8,
- CODEC_ID_SPEEX,
- CODEC_ID_WMAVOICE,
- CODEC_ID_WMAPRO,
- CODEC_ID_WMALOSSLESS,
-
- //* subtitle codecs */
- CODEC_ID_DVD_SUBTITLE= $17000,
- CODEC_ID_DVB_SUBTITLE,
- CODEC_ID_TEXT, ///< raw UTF-8 text
- CODEC_ID_XSUB,
- CODEC_ID_SSA,
- CODEC_ID_MOV_TEXT,
-
- (* other specific kind of codecs (generally used for attachments) *)
- CODEC_ID_TTF= $18000,
-
- CODEC_ID_MPEG2TS= $20000, {*< _FAKE_ codec to indicate a raw MPEG-2 TS
- * stream (only used by libavformat) *}
- __CODEC_ID_4BYTE = $FFFFF // ensure 4-byte enum
- );
-
-{$IF LIBAVCODEC_VERSION < 52000000} // 52.0.0
-{* CODEC_ID_MP3LAME is obsolete *}
-const
- CODEC_ID_MP3LAME = CODEC_ID_MP3;
- CODEC_ID_MPEG4AAC = CODEC_ID_AAC;
-{$IFEND}
-
-type
- TCodecType = (
- CODEC_TYPE_UNKNOWN = -1,
- CODEC_TYPE_VIDEO,
- CODEC_TYPE_AUDIO,
- CODEC_TYPE_DATA,
- CODEC_TYPE_SUBTITLE,
- CODEC_TYPE_ATTACHMENT,
- CODEC_TYPE_NB
- );
-
-{**
- * currently unused, may be used if 24/32 bits samples ever supported */
- * all in native endian
- *}
-type
- TSampleFormat = (
- SAMPLE_FMT_NONE = -1,
- SAMPLE_FMT_U8, ///< unsigned 8 bits
- SAMPLE_FMT_S16, ///< signed 16 bits
- SAMPLE_FMT_S24, ///< signed 24 bits
- SAMPLE_FMT_S32, ///< signed 32 bits
- SAMPLE_FMT_FLT ///< float
- );
-
-const
- {* in bytes *}
- AVCODEC_MAX_AUDIO_FRAME_SIZE = 192000; // 1 second of 48khz 32bit audio
-
-{**
- * Required number of additionally allocated bytes at the end of the input bitstream for decoding.
- * This is mainly needed because some optimized bitstream readers read
- * 32 or 64 bit at once and could read over the end.<br>
- * Note: If the first 23 bits of the additional bytes are not 0, then damaged
- * MPEG bitstreams could cause overread and segfault.
- *}
- FF_INPUT_BUFFER_PADDING_SIZE = 8;
-
-{**
- * minimum encoding buffer size.
- * Used to avoid some checks during header writing.
- *}
- FF_MIN_BUFFER_SIZE = 16384;
-
-type
-{*
- * motion estimation type.
- *}
- TMotion_Est_ID = (
- ME_ZERO = 1, ///< no search, that is use 0,0 vector whenever one is needed
- ME_FULL,
- ME_LOG,
- ME_PHODS,
- ME_EPZS, ///< enhanced predictive zonal search
- ME_X1, ///< reserved for experiments
- ME_HEX, ///< hexagon based search
- ME_UMH, ///< uneven multi-hexagon search
- ME_ITER ///< iterative search
- );
-
- TAVDiscard = (
- {* We leave some space between them for extensions (drop some
- * keyframes for intra-only or drop just some bidir frames). *}
- AVDISCARD_NONE =-16, ///< discard nothing
- AVDISCARD_DEFAULT= 0, ///< discard useless packets like 0 size packets in avi
- AVDISCARD_NONREF = 8, ///< discard all non reference
- AVDISCARD_BIDIR = 16, ///< discard all bidirectional frames
- AVDISCARD_NONKEY = 32, ///< discard all frames except keyframes
- AVDISCARD_ALL = 48 ///< discard all
- );
-
- PRcOverride = ^TRcOverride;
- TRcOverride = record {16}
- start_frame: integer;
- end_frame: integer;
- qscale: integer; // if this is 0 then quality_factor will be used instead
- quality_factor: single;
- end;
-
-const
- FF_MAX_B_FRAMES = 16;
-
-{* encoding support
- These flags can be passed in AVCodecContext.flags before initialization.
- Note: Not everything is supported yet.
-*}
-
- CODEC_FLAG_QSCALE = $0002; ///< Use fixed qscale.
- CODEC_FLAG_4MV = $0004; ///< 4 MV per MB allowed / advanced prediction for H263.
- CODEC_FLAG_QPEL = $0010; ///< use qpel MC.
- CODEC_FLAG_GMC = $0020; ///< use GMC.
- CODEC_FLAG_MV0 = $0040; ///< always try a MB with MV=<0,0>.
- CODEC_FLAG_PART = $0080; ///< Use data partitioning.
- {**
- * The parent program guarantees that the input for B-frames containing
- * streams is not written to for at least s->max_b_frames+1 frames, if
- * this is not set the input will be copied.
- *}
- CODEC_FLAG_INPUT_PRESERVED = $0100;
- CODEC_FLAG_PASS1 = $0200; ///< use internal 2pass ratecontrol in first pass mode
- CODEC_FLAG_PASS2 = $0400; ///< use internal 2pass ratecontrol in second pass mode
- CODEC_FLAG_EXTERN_HUFF = $1000; ///< use external huffman table (for mjpeg)
- CODEC_FLAG_GRAY = $2000; ///< only decode/encode grayscale
- CODEC_FLAG_EMU_EDGE = $4000; ///< don't draw edges
- CODEC_FLAG_PSNR = $8000; ///< error[?] variables will be set during encoding
- CODEC_FLAG_TRUNCATED = $00010000; //** input bitstream might be truncated at a random location instead
- // of only at frame boundaries */
- CODEC_FLAG_NORMALIZE_AQP = $00020000; ///< normalize adaptive quantization
- CODEC_FLAG_INTERLACED_DCT = $00040000; ///< use interlaced dct
- CODEC_FLAG_LOW_DELAY = $00080000; ///< force low delay
- CODEC_FLAG_ALT_SCAN = $00100000; ///< use alternate scan
- CODEC_FLAG_TRELLIS_QUANT = $00200000; ///< use trellis quantization
- CODEC_FLAG_GLOBAL_HEADER = $00400000; ///< place global headers in extradata instead of every keyframe
- CODEC_FLAG_BITEXACT = $00800000; ///< use only bitexact stuff (except (i)dct)
- {* Fx : Flag for h263+ extra options *}
- {$IF LIBAVCODEC_VERSION < 52000000} // 52.0.0
- CODEC_FLAG_H263P_AIC = $01000000; ///< H263 Advanced intra coding / MPEG4 AC prediction (remove this)
- {$IFEND}
- CODEC_FLAG_AC_PRED = $01000000; ///< H263 Advanced intra coding / MPEG4 AC prediction
- CODEC_FLAG_H263P_UMV = $02000000; ///< Unlimited motion vector
- CODEC_FLAG_CBP_RD = $04000000; ///< use rate distortion optimization for cbp
- CODEC_FLAG_QP_RD = $08000000; ///< use rate distortion optimization for qp selectioon
- CODEC_FLAG_H263P_AIV = $00000008; ///< H263 Alternative inter vlc
- CODEC_FLAG_OBMC = $00000001; ///< OBMC
- CODEC_FLAG_LOOP_FILTER = $00000800; ///< loop filter
- CODEC_FLAG_H263P_SLICE_STRUCT = $10000000;
- CODEC_FLAG_INTERLACED_ME = $20000000; ///< interlaced motion estimation
- CODEC_FLAG_SVCD_SCAN_OFFSET = $40000000; ///< will reserve space for SVCD scan offset user data
- CODEC_FLAG_CLOSED_GOP = $80000000;
- CODEC_FLAG2_FAST = $00000001; ///< allow non spec compliant speedup tricks
- CODEC_FLAG2_STRICT_GOP = $00000002; ///< strictly enforce GOP size
- CODEC_FLAG2_NO_OUTPUT = $00000004; ///< skip bitstream encoding
- CODEC_FLAG2_LOCAL_HEADER = $00000008; ///< place global headers at every keyframe instead of in extradata
- CODEC_FLAG2_BPYRAMID = $00000010; ///< H.264 allow b-frames to be used as references
- CODEC_FLAG2_WPRED = $00000020; ///< H.264 weighted biprediction for b-frames
- CODEC_FLAG2_MIXED_REFS = $00000040; ///< H.264 multiple references per partition
- CODEC_FLAG2_8X8DCT = $00000080; ///< H.264 high profile 8x8 transform
- CODEC_FLAG2_FASTPSKIP = $00000100; ///< H.264 fast pskip
- CODEC_FLAG2_AUD = $00000200; ///< H.264 access unit delimiters
- CODEC_FLAG2_BRDO = $00000400; ///< b-frame rate-distortion optimization
- CODEC_FLAG2_INTRA_VLC = $00000800; ///< use MPEG-2 intra VLC table
- CODEC_FLAG2_MEMC_ONLY = $00001000; ///< only do ME/MC (I frames -> ref, P frame -> ME+MC)
- CODEC_FLAG2_DROP_FRAME_TIMECODE = $00002000; ///< timecode is in drop frame format.
- CODEC_FLAG2_SKIP_RD = $00004000; ///< RD optimal MB level residual skipping
- CODEC_FLAG2_CHUNKS = $00008000; ///< Input bitstream might be truncated at a packet boundaries instead of only at frame boundaries.
- CODEC_FLAG2_NON_LINEAR_QUANT = $00010000; ///< Use MPEG-2 nonlinear quantizer.
- CODEC_FLAG2_BIT_RESERVOIR = $00020000; ///< Use a bit reservoir when encoding if possible
-
-(* Unsupported options :
- * Syntax Arithmetic coding (SAC)
- * Reference Picture Selection
- * Independant Segment Decoding *)
-(* /Fx *)
-(* codec capabilities *)
-
-const
- CODEC_CAP_DRAW_HORIZ_BAND = $0001; ///< decoder can use draw_horiz_band callback
- (**
- * Codec uses get_buffer() for allocating buffers.
- * direct rendering method 1
- *)
- CODEC_CAP_DR1 = $0002;
- (* if 'parse_only' field is true, then avcodec_parse_frame() can be used *)
- CODEC_CAP_PARSE_ONLY = $0004;
- CODEC_CAP_TRUNCATED = $0008;
- (* codec can export data for HW decoding (XvMC) *)
- CODEC_CAP_HWACCEL = $0010;
- (**
- * codec has a non zero delay and needs to be feeded with NULL at the end to get the delayed data.
- * if this is not set, the codec is guranteed to never be feeded with NULL data
- *)
- CODEC_CAP_DELAY = $0020;
- (**
- * Codec can be fed a final frame with a smaller size.
- * This can be used to prevent truncation of the last audio samples.
- *)
- CODEC_CAP_SMALL_LAST_FRAME = $0040;
-
- //the following defines may change, don't expect compatibility if you use them
- MB_TYPE_INTRA4x4 = $001;
- MB_TYPE_INTRA16x16 = $002; //FIXME h264 specific
- MB_TYPE_INTRA_PCM = $004; //FIXME h264 specific
- MB_TYPE_16x16 = $008;
- MB_TYPE_16x8 = $010;
- MB_TYPE_8x16 = $020;
- MB_TYPE_8x8 = $040;
- MB_TYPE_INTERLACED = $080;
- MB_TYPE_DIRECT2 = $100; //FIXME
- MB_TYPE_ACPRED = $200;
- MB_TYPE_GMC = $400;
- MB_TYPE_SKIP = $800;
- MB_TYPE_P0L0 = $1000;
- MB_TYPE_P1L0 = $2000;
- MB_TYPE_P0L1 = $4000;
- MB_TYPE_P1L1 = $8000;
- MB_TYPE_L0 = (MB_TYPE_P0L0 or MB_TYPE_P1L0);
- MB_TYPE_L1 = (MB_TYPE_P0L1 or MB_TYPE_P1L1);
- MB_TYPE_L0L1 = (MB_TYPE_L0 or MB_TYPE_L1);
- MB_TYPE_QUANT = $0010000;
- MB_TYPE_CBP = $0020000;
- //Note bits 24-31 are reserved for codec specific use (h264 ref0, mpeg1 0mv, ...)
-
-type
-(**
- * Pan Scan area.
- * This specifies the area which should be displayed.
- * Note there may be multiple such areas for one frame.
- *)
- PAVPanScan = ^TAVPanScan;
- TAVPanScan = record {24}
- (*** id.
- * - encoding: set by user.
- * - decoding: set by libavcodec. *)
- id: integer;
-
- (*** width and height in 1/16 pel
- * - encoding: set by user.
- * - decoding: set by libavcodec. *)
- width: integer;
- height: integer;
-
- (*** position of the top left corner in 1/16 pel for up to 3 fields/frames.
- * - encoding: set by user.
- * - decoding: set by libavcodec. *)
- position: array [0..2] of array [0..1] of smallint;
- end;
-
-const
- FF_QSCALE_TYPE_MPEG1 = 0;
- FF_QSCALE_TYPE_MPEG2 = 1;
- FF_QSCALE_TYPE_H264 = 2;
-
- FF_BUFFER_TYPE_INTERNAL = 1;
- FF_BUFFER_TYPE_USER = 2; ///< Direct rendering buffers (image is (de)allocated by user)
- FF_BUFFER_TYPE_SHARED = 4; ///< buffer from somewhere else, don't dealloc image (data/base), all other tables are not shared
- FF_BUFFER_TYPE_COPY = 8; ///< just a (modified) copy of some other buffer, don't dealloc anything.
-
-
- FF_I_TYPE = 1; ///< Intra
- FF_P_TYPE = 2; ///< Predicted
- FF_B_TYPE = 3; ///< Bi-dir predicted
- FF_S_TYPE = 4; ///< S(GMC)-VOP MPEG4
- FF_SI_TYPE = 5; ///< Switching Intra
- FF_SP_TYPE = 6; ///< Switching Predicted
- FF_BI_TYPE = 7;
-
- FF_BUFFER_HINTS_VALID = $01; // Buffer hints value is meaningful (if 0 ignore)
- FF_BUFFER_HINTS_READABLE = $02; // Codec will read from buffer
- FF_BUFFER_HINTS_PRESERVE = $04; // User must not alter buffer content
- FF_BUFFER_HINTS_REUSABLE = $08; // Codec will reuse the buffer (update)
-
-type
- {**
- * Audio Video Frame.
- * New fields can be added to the end of FF_COMMON_FRAME with minor version
- * bumps.
- * Removal, reordering and changes to existing fields require a major
- * version bump. No fields should be added into AVFrame before or after
- * FF_COMMON_FRAME!
- * sizeof(AVFrame) must not be used outside libav*.
- *}
- PAVFrame = ^TAVFrame;
- TAVFrame = record {200}
- (**
- * pointer to the picture planes.
- * This might be different from the first allocated byte
- * - encoding:
- * - decoding:
- *)
- data: array [0..3] of pbyte;
- linesize: array [0..3] of integer;
- (**
- * pointer to the first allocated byte of the picture. Can be used in get_buffer/release_buffer.
- * This isn't used by libavcodec unless the default get/release_buffer() is used.
- * - encoding:
- * - decoding:
- *)
- base: array [0..3] of pbyte;
- (**
- * 1 -> keyframe, 0-> not
- * - encoding: Set by libavcodec.
- * - decoding: Set by libavcodec.
- *)
- key_frame: integer;
- (**
- * Picture type of the frame, see ?_TYPE below.
- * - encoding: Set by libavcodec. for coded_picture (and set by user for input).
- * - decoding: Set by libavcodec.
- *)
- pict_type: integer;
- (**
- * presentation timestamp in time_base units (time when frame should be shown to user)
- * If AV_NOPTS_VALUE then frame_rate = 1/time_base will be assumed.
- * - encoding: MUST be set by user.
- * - decoding: Set by libavcodec.
- *)
- pts: int64;
- (**\
- * picture number in bitstream order
- * - encoding: set by
- * - decoding: Set by libavcodec.
- *)
- coded_picture_number: integer;
- (**
- * picture number in display order
- * - encoding: set by
- * - decoding: Set by libavcodec.
- *)
- display_picture_number: integer;
- (**
- * quality (between 1 (good) and FF_LAMBDA_MAX (bad))
- * - encoding: Set by libavcodec. for coded_picture (and set by user for input).
- * - decoding: Set by libavcodec.
- *)
- quality: integer;
- (**
- * buffer age (1->was last buffer and dint change, 2->..., ...).
- * Set to INT_MAX if the buffer has not been used yet.
- * - encoding: unused
- * - decoding: MUST be set by get_buffer().
- *)
- age: integer;
- (**
- * is this picture used as reference
- * The values for this are the same as the MpegEncContext.picture_structure
- * variable, that is 1->top field, 2->bottom field, 3->frame/both fields.
- * - encoding: unused
- * - decoding: Set by libavcodec. (before get_buffer() call)).
- *)
- reference: integer;
- (**
- * QP table
- * - encoding: unused
- * - decoding: Set by libavcodec.
- *)
- qscale_table: PShortint;
- (**
- * QP store stride
- * - encoding: unused
- * - decoding: Set by libavcodec.
- *)
- qstride: integer;
- (**
- * mbskip_table[mb]>=1 if MB didn't change
- * stride= mb_width = (width+15)>>4
- * - encoding: unused
- * - decoding: Set by libavcodec.
- *)
- mbskip_table: pbyte;
- (**
- * motion vector table
- * @code
- * example:
- * int mv_sample_log2= 4 - motion_subsample_log2;
- * int mb_width= (width+15)>>4;
- * int mv_stride= (mb_width << mv_sample_log2) + 1;
- * motion_val[direction][x + y*mv_stride][0->mv_x, 1->mv_y];
- * @endcode
- * - encoding: Set by user.
- * - decoding: Set by libavcodec.
- *)
- //int16_t (*motion_val[2])[2];
- motion_val: array [0..1] of pointer;
- (**
- * macroblock type table
- * mb_type_base + mb_width + 2
- * - encoding: Set by user.
- * - decoding: Set by libavcodec.
- *)
- mb_type: PCardinal;
- (**
- * log2 of the size of the block which a single vector in motion_val represents:
- * (4->16x16, 3->8x8, 2-> 4x4, 1-> 2x2)
- * - encoding: unused
- * - decoding: Set by libavcodec.
- *)
- motion_subsample_log2: byte;
- (**
- * for some private data of the user
- * - encoding: unused
- * - decoding: Set by user.
- *)
- opaque: pointer;
- (**
- * error
- * - encoding: Set by libavcodec. if flags&CODEC_FLAG_PSNR.
- * - decoding: unused
- *)
- error: array [0..3] of uint64;
- (**
- * type of the buffer (to keep track of who has to deallocate data[*])
- * - encoding: Set by the one who allocates it.
- * - decoding: Set by the one who allocates it.
- * Note: User allocated (direct rendering) & internal buffers cannot coexist currently.
- *)
- type_: integer;
- (**
- * When decoding, this signals how much the picture must be delayed.
- * extra_delay = repeat_pict / (2*fps)
- * - encoding: unused
- * - decoding: Set by libavcodec.
- *)
- repeat_pict: integer;
- (**
- *
- *)
- qscale_type: integer;
- (**
- * The content of the picture is interlaced.
- * - encoding: Set by user.
- * - decoding: Set by libavcodec. (default 0)
- *)
- interlaced_frame: integer;
- (**
- * If the content is interlaced, is top field displayed first.
- * - encoding: Set by user.
- * - decoding: Set by libavcodec.
- *)
- top_field_first: integer;
- (**
- * Pan scan.
- * - encoding: Set by user.
- * - decoding: Set by libavcodec.
- *)
- pan_scan: PAVPanScan;
- (**
- * Tell user application that palette has changed from previous frame.
- * - encoding: ??? (no palette-enabled encoder yet)
- * - decoding: Set by libavcodec. (default 0).
- *)
- palette_has_changed: integer;
- (**
- * codec suggestion on buffer type if != 0
- * - encoding: unused
- * - decoding: Set by libavcodec. (before get_buffer() call)).
- *)
- buffer_hints: integer;
- (**
- * DCT coefficients
- * - encoding: unused
- * - decoding: Set by libavcodec.
- *)
- dct_coeff: PsmallInt;
- (**
- * motion referece frame index
- * - encoding: Set by user.
- * - decoding: Set by libavcodec.
- *)
- ref_index: array [0..1] of PShortint;
- end;
-
-const
- DEFAULT_FRAME_RATE_BASE = 1001000;
-
- FF_ASPECT_EXTENDED = 15;
-
- FF_RC_STRATEGY_XVID = 1;
-
- FF_BUG_AUTODETECT = 1; ///< autodetection
- FF_BUG_OLD_MSMPEG4 = 2;
- FF_BUG_XVID_ILACE = 4;
- FF_BUG_UMP4 = 8;
- FF_BUG_NO_PADDING = 16;
- FF_BUG_AMV = 32;
- FF_BUG_AC_VLC = 0; ///< will be removed, libavcodec can now handle these non compliant files by default
- FF_BUG_QPEL_CHROMA = 64;
- FF_BUG_STD_QPEL = 128;
- FF_BUG_QPEL_CHROMA2 = 256;
- FF_BUG_DIRECT_BLOCKSIZE = 512;
- FF_BUG_EDGE = 1024;
- FF_BUG_HPEL_CHROMA = 2048;
- FF_BUG_DC_CLIP = 4096;
- FF_BUG_MS = 8192; ///< workaround various bugs in microsofts broken decoders
- //FF_BUG_FAKE_SCALABILITY = 16 //Autodetection should work 100%.
-
- FF_COMPLIANCE_VERY_STRICT = 2; ///< strictly conform to a older more strict version of the spec or reference software
- FF_COMPLIANCE_STRICT = 1; ///< strictly conform to all the things in the spec no matter what consequences
- FF_COMPLIANCE_NORMAL = 0;
- FF_COMPLIANCE_INOFFICIAL = -1; ///< allow inofficial extensions
- FF_COMPLIANCE_EXPERIMENTAL = -2; ///< allow non standarized experimental things
-
- FF_ER_CAREFUL = 1;
- FF_ER_COMPLIANT = 2;
- FF_ER_AGGRESSIVE = 3;
- FF_ER_VERY_AGGRESSIVE = 4;
-
- FF_DCT_AUTO = 0;
- FF_DCT_FASTINT = 1;
- FF_DCT_INT = 2;
- FF_DCT_MMX = 3;
- FF_DCT_MLIB = 4;
- FF_DCT_ALTIVEC = 5;
- FF_DCT_FAAN = 6;
-
- FF_IDCT_AUTO = 0;
- FF_IDCT_INT = 1;
- FF_IDCT_SIMPLE = 2;
- FF_IDCT_SIMPLEMMX = 3;
- FF_IDCT_LIBMPEG2MMX = 4;
- FF_IDCT_PS2 = 5;
- FF_IDCT_MLIB = 6;
- FF_IDCT_ARM = 7;
- FF_IDCT_ALTIVEC = 8;
- FF_IDCT_SH4 = 9;
- FF_IDCT_SIMPLEARM = 10;
- FF_IDCT_H264 = 11;
- FF_IDCT_VP3 = 12;
- FF_IDCT_IPP = 13;
- FF_IDCT_XVIDMMX = 14;
- FF_IDCT_CAVS = 15;
- FF_IDCT_SIMPLEARMV5TE= 16;
- FF_IDCT_SIMPLEARMV6 = 17;
- FF_IDCT_SIMPLEVIS = 18;
- FF_IDCT_WMV2 = 19;
- FF_IDCT_FAAN = 20;
-
- FF_EC_GUESS_MVS = 1;
- FF_EC_DEBLOCK = 2;
-
- FF_MM_FORCE = $80000000; (* force usage of selected flags (OR) *)
- (* lower 16 bits - CPU features *)
- FF_MM_MMX = $0001; ///< standard MMX
- FF_MM_3DNOW = $0004; ///< AMD 3DNOW
- FF_MM_MMXEXT = $0002; ///< SSE integer functions or AMD MMX ext
- FF_MM_SSE = $0008; ///< SSE functions
- FF_MM_SSE2 = $0010; ///< PIV SSE2 functions
- FF_MM_3DNOWEXT = $0020; ///< AMD 3DNowExt
- FF_MM_SSE3 = $0040; ///< Prescott SSE3 functions
- FF_MM_SSSE3 = $0080; ///< Conroe SSSE3 functions
- FF_MM_IWMMXT = $0100; ///< XScale IWMMXT
-
- FF_PRED_LEFT = 0;
- FF_PRED_PLANE = 1;
- FF_PRED_MEDIAN = 2;
-
- FF_DEBUG_PICT_INFO = 1;
- FF_DEBUG_RC = 2;
- FF_DEBUG_BITSTREAM = 4;
- FF_DEBUG_MB_TYPE = 8;
- FF_DEBUG_QP = 16;
- FF_DEBUG_MV = 32;
- FF_DEBUG_DCT_COEFF = $00000040;
- FF_DEBUG_SKIP = $00000080;
- FF_DEBUG_STARTCODE = $00000100;
- FF_DEBUG_PTS = $00000200;
- FF_DEBUG_ER = $00000400;
- FF_DEBUG_MMCO = $00000800;
- FF_DEBUG_BUGS = $00001000;
- FF_DEBUG_VIS_QP = $00002000;
- FF_DEBUG_VIS_MB_TYPE = $00004000;
-
- FF_DEBUG_VIS_MV_P_FOR = $00000001; //visualize forward predicted MVs of P frames
- FF_DEBUG_VIS_MV_B_FOR = $00000002; //visualize forward predicted MVs of B frames
- FF_DEBUG_VIS_MV_B_BACK = $00000004; //visualize backward predicted MVs of B frames
-
- FF_CMP_SAD = 0;
- FF_CMP_SSE = 1;
- FF_CMP_SATD = 2;
- FF_CMP_DCT = 3;
- FF_CMP_PSNR = 4;
- FF_CMP_BIT = 5;
- FF_CMP_RD = 6;
- FF_CMP_ZERO = 7;
- FF_CMP_VSAD = 8;
- FF_CMP_VSSE = 9;
- FF_CMP_NSSE = 10;
- FF_CMP_W53 = 11;
- FF_CMP_W97 = 12;
- FF_CMP_DCTMAX = 13;
- FF_CMP_DCT264 = 14;
- FF_CMP_CHROMA = 256;
-
- FF_DTG_AFD_SAME = 8;
- FF_DTG_AFD_4_3 = 9;
- FF_DTG_AFD_16_9 = 10;
- FF_DTG_AFD_14_9 = 11;
- FF_DTG_AFD_4_3_SP_14_9 = 13;
- FF_DTG_AFD_16_9_SP_14_9 = 14;
- FF_DTG_AFD_SP_4_3 = 15;
-
- FF_DEFAULT_QUANT_BIAS = 999999;
-
- FF_LAMBDA_SHIFT = 7;
- FF_LAMBDA_SCALE = (1 shl FF_LAMBDA_SHIFT);
- FF_QP2LAMBDA = 118; ///< factor to convert from H.263 QP to lambda
- FF_LAMBDA_MAX = (256 * 128 - 1);
-
- FF_QUALITY_SCALE = FF_LAMBDA_SCALE; //FIXME maybe remove
-
- FF_CODER_TYPE_VLC = 0;
- FF_CODER_TYPE_AC = 1;
- FF_CODER_TYPE_RAW = 2;
- FF_CODER_TYPE_RLE = 3;
- FF_CODER_TYPE_DEFLATE = 4;
-
- SLICE_FLAG_CODED_ORDER = $0001; ///< draw_horiz_band() is called in coded order instead of display
- SLICE_FLAG_ALLOW_FIELD = $0002; ///< allow draw_horiz_band() with field slices (MPEG2 field pics)
- SLICE_FLAG_ALLOW_PLANE = $0004; ///< allow draw_horiz_band() with 1 component at a time (SVQ1)
-
- FF_MB_DECISION_SIMPLE = 0; ///< uses mb_cmp
- FF_MB_DECISION_BITS = 1; ///< chooses the one which needs the fewest bits
- FF_MB_DECISION_RD = 2; ///< rate distortion
-
- FF_AA_AUTO = 0;
- FF_AA_FASTINT = 1; //not implemented yet
- FF_AA_INT = 2;
- FF_AA_FLOAT = 3;
-
- FF_PROFILE_UNKNOWN = -99;
- FF_PROFILE_AAC_MAIN = 0;
- FF_PROFILE_AAC_LOW = 1;
- FF_PROFILE_AAC_SSR = 2;
- FF_PROFILE_AAC_LTP = 3;
-
- FF_LEVEL_UNKNOWN = -99;
-
- X264_PART_I4X4 = $001; (* Analyse i4x4 *)
- X264_PART_I8X8 = $002; (* Analyse i8x8 (requires 8x8 transform) *)
- X264_PART_P8X8 = $010; (* Analyse p16x8, p8x16 and p8x8 *)
- X264_PART_P4X4 = $020; (* Analyse p8x4, p4x8, p4x4 *)
- X264_PART_B8X8 = $100; (* Analyse b16x8, b8x16 and b8x8 *)
-
- FF_COMPRESSION_DEFAULT = -1;
-
-const
- AVPALETTE_SIZE = 1024;
- AVPALETTE_COUNT = 256;
-
-type
-(**
- * AVPaletteControl
- * This structure defines a method for communicating palette changes
- * between and demuxer and a decoder.
- *
- * @deprecated Use AVPacket to send palette changes instead.
- * This is totally broken.
- *)
- PAVPaletteControl = ^TAVPaletteControl;
- TAVPaletteControl = record
- (* demuxer sets this to 1 to indicate the palette has changed;
- * decoder resets to 0 *)
- palette_changed: integer;
-
- (* 4-byte ARGB palette entries, stored in native byte order; note that
- * the individual palette components should be on a 8-bit scale; if
- * the palette data comes from a IBM VGA native format, the component
- * data is probably 6 bits in size and needs to be scaled *)
- palette: array [0..AVPALETTE_COUNT - 1] of cardinal;
- end; {deprecated;}
-
-type
- PAVClass = ^TAVClass; {const}
- PAVCodecContext = ^TAVCodecContext;
-
- PAVCodec = ^TAVCodec;
-
- // int[4]
- PQuadIntArray = ^TQuadIntArray;
- TQuadIntArray = array[0..3] of integer;
- // int (*func)(struct AVCodecContext *c2, void *arg)
- TExecuteFunc = function(c2: PAVCodecContext; arg: Pointer): integer; cdecl;
-
- TAVClass = record {12}
- class_name: pchar;
- (* actually passing a pointer to an AVCodecContext
- or AVFormatContext, which begin with an AVClass.
- Needed because av_log is in libavcodec and has no visibility
- of AVIn/OutputFormat *)
- item_name: function (): pchar; cdecl;
- option: PAVOption;
- end;
-
- (**
- * main external API structure.
- * New fields can be added to the end with minor version bumps.
- * Removal, reordering and changes to existing fields require a major
- * version bump.
- * sizeof(AVCodecContext) must not be used outside libav*.
- *)
- TAVCodecContext = record {720}
- (**
- * information on struct for av_log
- * - set by avcodec_alloc_context
- *)
- av_class: PAVClass;
- (**
- * the average bitrate
- * - encoding: Set by user; unused for constant quantizer encoding.
- * - decoding: Set by libavcodec. 0 or some bitrate if this info is available in the stream.
- *)
- bit_rate: integer;
-
- (**
- * number of bits the bitstream is allowed to diverge from the reference.
- * the reference can be CBR (for CBR pass1) or VBR (for pass2)
- * - encoding: Set by user; unused for constant quantizer encoding.
- * - decoding: unused
- *)
- bit_rate_tolerance: integer;
-
- (**
- * CODEC_FLAG_*.
- * - encoding: Set by user.
- * - decoding: Set by user.
- *)
- flags: integer;
-
- (**
- * Some codecs need additional format info. It is stored here.
- * If any muxer uses this then ALL demuxers/parsers AND encoders for the
- * specific codec MUST set it correctly otherwise stream copy breaks.
- * In general use of this field by muxers is not recommanded.
- * - encoding: Set by libavcodec.
- * - decoding: Set by libavcodec. (FIXME: Is this OK?)
- *)
- sub_id: integer;
-
- (**
- * Motion estimation algorithm used for video coding.
- * 1 (zero), 2 (full), 3 (log), 4 (phods), 5 (epzs), 6 (x1), 7 (hex),
- * 8 (umh), 9 (iter) [7, 8 are x264 specific, 9 is snow specific]
- * - encoding: MUST be set by user.
- * - decoding: unused
- *)
- me_method: integer;
-
- (**
- * some codecs need / can use extradata like Huffman tables.
- * mjpeg: Huffman tables
- * rv10: additional flags
- * mpeg4: global headers (they can be in the bitstream or here)
- * The allocated memory should be FF_INPUT_BUFFER_PADDING_SIZE bytes larger
- * than extradata_size to avoid prolems if it is read with the bitstream reader.
- * The bytewise contents of extradata must not depend on the architecture or CPU endianness.
- * - encoding: Set/allocated/freed by libavcodec.
- * - decoding: Set/allocated/freed by user.
- *)
- extradata: pbyte;
- extradata_size: integer;
-
- (**
- * This is the fundamental unit of time (in seconds) in terms
- * of which frame timestamps are represented. For fixed-fps content,
- * timebase should be 1/framerate and timestamp increments should be
- * identically 1.
- * - encoding: MUST be set by user.
- * - decoding: Set by libavcodec.
- *)
- time_base: TAVRational;
-
- (* video only *)
- (**
- * picture width / height.
- * - encoding: MUST be set by user.
- * - decoding: Set by libavcodec.
- * Note: For compatibility it is possible to set this instead of
- * coded_width/height before decoding.
- *)
- width, height: integer;
-
- (**
- * the number of pictures in a group of pictures, or 0 for intra_only
- * - encoding: Set by user.
- * - decoding: unused
- *)
- gop_size: integer;
-
- (**
- * Pixel format, see PIX_FMT_xxx.
- * - encoding: Set by user.
- * - decoding: Set by libavcodec.
- *)
- pix_fmt: TAVPixelFormat;
-
- (**
- * Frame rate emulation. If not zero, the lower layer (i.e. format handler)
- * has to read frames at native frame rate.
- * - encoding: Set by user.
- * - decoding: unused
- *)
- rate_emu: integer;
-
- (**
- * If non NULL, 'draw_horiz_band' is called by the libavcodec
- * decoder to draw a horizontal band. It improves cache usage. Not
- * all codecs can do that. You must check the codec capabilities
- * beforehand.
- * - encoding: unused
- * - decoding: Set by user.
- * @param height the height of the slice
- * @param y the y position of the slice
- * @param type 1->top field, 2->bottom field, 3->frame
- * @param offset offset into the AVFrame.data from which the slice should be read
- *)
- draw_horiz_band: procedure (s: PAVCodecContext;
- {const} src: PAVFrame; offset: PQuadIntArray;
- y: integer; type_: integer; height: integer); cdecl;
-
- (* audio only *)
- sample_rate: integer; ///< samples per second
- channels: integer; ///< number of audio channels
-
- (**
- * audio sample format
- * - encoding: Set by user.
- * - decoding: Set by libavcodec.
- *)
- sample_fmt: TSampleFormat; ///< sample format, currenly unused
-
- (* The following data should not be initialized. *)
- (**
- * Samples per packet, initialized when calling 'init'.
- *)
- frame_size: integer;
- frame_number: integer; ///< audio or video frame number
- real_pict_num: integer; ///< returns the real picture number of previous encoded frame
-
- (**
- * Number of frames the decoded output will be delayed relative to
- * the encoded input.
- * - encoding: Set by libavcodec.
- * - decoding: unused
- *)
- delay: integer;
-
- (* - encoding parameters *)
- qcompress: single; ///< amount of qscale change between easy & hard scenes (0.0-1.0)
- qblur: single; ///< amount of qscale smoothing over time (0.0-1.0)
-
- (**
- * minimum quantizer
- * - encoding: Set by user.
- * - decoding: unused
- *)
- qmin: integer;
-
- (**
- * maximum quantizer
- * - encoding: Set by user.
- * - decoding: unused
- *)
- qmax: integer;
-
- (**
- * maximum quantizer difference between frames
- * - encoding: Set by user.
- * - decoding: unused
- *)
- max_qdiff: integer;
-
- (**
- * maximum number of B-frames between non-B-frames
- * Note: The output will be delayed by max_b_frames+1 relative to the input.
- * - encoding: Set by user.
- * - decoding: unused
- *)
- max_b_frames: integer;
-
- (**
- * qscale factor between IP and B-frames
- * - encoding: Set by user.
- * - decoding: unused
- *)
- b_quant_factor: single;
-
- (** obsolete FIXME remove *)
- rc_strategy: integer;
-
- b_frame_strategy: integer;
-
- (**
- * hurry up amount
- * - encoding: unused
- * - decoding: Set by user. 1-> Skip B-frames, 2-> Skip IDCT/dequant too, 5-> Skip everything except header
- * @deprecated Deprecated in favor of skip_idct and skip_frame.
- *)
- hurry_up: integer;
-
- codec: PAVCodec;
-
- priv_data: pointer;
-
- {$IF LIBAVCODEC_VERSION < 52000000} // 52.0.0
- (* unused, FIXME remove*)
- rtp_mode: integer;
- {$IFEND}
-
- rtp_payload_size: integer; (* The size of the RTP payload: the coder will *)
- (* do it's best to deliver a chunk with size *)
- (* below rtp_payload_size, the chunk will start *)
- (* with a start code on some codecs like H.263 *)
- (* This doesn't take account of any particular *)
- (* headers inside the transmited RTP payload *)
-
-
- (* The RTP callback: This function is called *)
- (* every time the encoder has a packet to send *)
- (* Depends on the encoder if the data starts *)
- (* with a Start Code (it should) H.263 does. *)
- (* mb_nb contains the number of macroblocks *)
- (* encoded in the RTP payload *)
- rtp_callback: procedure (avctx: PAVCodecContext; data: pointer;
- size: integer; mb_nb: integer); cdecl;
-
- (* statistics, used for 2-pass encoding *)
- mv_bits: integer;
- header_bits: integer;
- i_tex_bits: integer;
- p_tex_bits: integer;
- i_count: integer;
- p_count: integer;
- skip_count: integer;
- misc_bits: integer;
-
- (**
- * number of bits used for the previously encoded frame
- * - encoding: Set by libavcodec.
- * - decoding: unused
- *)
- frame_bits: integer;
-
- (**
- * Private data of the user, can be used to carry app specific stuff.
- * - encoding: Set by user.
- * - decoding: Set by user.
- *)
- opaque: pointer;
-
- codec_name: array [0..31] of char;
- codec_type: TCodecType; (* see CODEC_TYPE_xxx *)
- codec_id: TCodecID; (* see CODEC_ID_xxx *)
-
- (**
- * fourcc (LSB first, so "ABCD" -> ('D'<<24) + ('C'<<16) + ('B'<<8) + 'A').
- * This is used to work around some encoder bugs.
- * A demuxer should set this to what is stored in the field used to identify the codec.
- * If there are multiple such fields in a container then the demuxer should choose the one
- * which maximizes the information about the used codec.
- * If the codec tag field in a container is larger then 32 bits then the demuxer should
- * remap the longer ID to 32 bits with a table or other structure. Alternatively a new
- * extra_codec_tag + size could be added but for this a clear advantage must be demonstrated
- * first.
- * - encoding: Set by user, if not then the default based on codec_id will be used.
- * - decoding: Set by user, will be converted to uppercase by libavcodec during init.
- *)
- codec_tag: cardinal; // ìîæíî array [0..3] of char - òîãäà âèäíî FOURCC
-
- (**
- * Work around bugs in encoders which sometimes cannot be detected automatically.
- * - encoding: Set by user
- * - decoding: Set by user
- *)
- workaround_bugs: integer;
-
- (**
- * luma single coefficient elimination threshold
- * - encoding: Set by user.
- * - decoding: unused
- *)
- luma_elim_threshold: integer;
-
- (**
- * chroma single coeff elimination threshold
- * - encoding: Set by user.
- * - decoding: unused
- *)
- chroma_elim_threshold: integer;
-
- (**
- * strictly follow the standard (MPEG4, ...).
- * - encoding: Set by user.
- * - decoding: unused
- *)
- strict_std_compliance: integer;
-
- (**
- * qscale offset between IP and B-frames
- * If > 0 then the last P-frame quantizer will be used (q= lastp_q*factor+offset).
- * If < 0 then normal ratecontrol will be done (q= -normal_q*factor+offset).
- * - encoding: Set by user.
- * - decoding: unused
- *)
- b_quant_offset: single;
-
- (**
- * Error resilience; higher values will detect more errors but may
- * misdetect some more or less valid parts as errors.
- * - encoding: unused
- * - decoding: Set by user.
- *)
- error_resilience: integer;
-
- (**
- * Called at the beginning of each frame to get a buffer for it.
- * If pic.reference is set then the frame will be read later by libavcodec.
- * avcodec_align_dimensions() should be used to find the required width and
- * height, as they normally need to be rounded up to the next multiple of 16.
- * - encoding: unused
- * - decoding: Set by libavcodec., user can override.
- *)
- get_buffer: function (c: PAVCodecContext; pic: PAVFrame): integer; cdecl;
-
- (**
- * Called to release buffers which were allocated with get_buffer.
- * A released buffer can be reused in get_buffer().
- * pic.data[*] must be set to NULL.
- * - encoding: unused
- * - decoding: Set by libavcodec., user can override.
- *)
- release_buffer: procedure (c: PAVCodecContext; pic: PAVFrame); cdecl;
-
- (**
- * If 1 the stream has a 1 frame delay during decoding.
- * - encoding: Set by libavcodec.
- * - decoding: Set by libavcodec.
- *)
- has_b_frames: integer;
-
- (**
- * number of bytes per packet if constant and known or 0
- * Used by some WAV based audio codecs.
- *)
- block_align: integer;
-
- parse_only: integer; (* - decoding only: if true, only parsing is done
- (function avcodec_parse_frame()). The frame
- data is returned. Only MPEG codecs support this now. *)
-
- (**
- * 0-> h263 quant 1-> mpeg quant
- * - encoding: Set by user.
- * - decoding: unused
- *)
- mpeg_quant: integer;
-
- (**
- * pass1 encoding statistics output buffer
- * - encoding: Set by libavcodec.
- * - decoding: unused
- *)
- stats_out: pchar;
-
- (**
- * pass2 encoding statistics input buffer
- * Concatenated stuff from stats_out of pass1 should be placed here.
- * - encoding: Allocated/set/freed by user.
- * - decoding: unused
- *)
- stats_in: pchar;
-
- (**
- * ratecontrol qmin qmax limiting method
- * 0-> clipping, 1-> use a nice continous function to limit qscale wthin qmin/qmax.
- * - encoding: Set by user.
- * - decoding: unused
- *)
- rc_qsquish: single;
-
- rc_qmod_amp: single;
- rc_qmod_freq: integer;
-
- (**
- * ratecontrol override, see RcOverride
- * - encoding: Allocated/set/freed by user.
- * - decoding: unused
- *)
- rc_override: PRcOverride;
- rc_override_count: integer;
-
- (**
- * rate control equation
- * - encoding: Set by user
- * - decoding: unused
- *)
- rc_eq: pchar; {const char*}
-
- (**
- * maximum bitrate
- * - encoding: Set by user.
- * - decoding: unused
- *)
- rc_max_rate: integer;
-
- (**
- * minimum bitrate
- * - encoding: Set by user.
- * - decoding: unused
- *)
- rc_min_rate: integer;
-
- (**
- * decoder bitstream buffer size
- * - encoding: Set by user.
- * - decoding: unused
- *)
- rc_buffer_size: integer;
- rc_buffer_aggressivity: single;
-
- (**
- * qscale factor between P and I-frames
- * If > 0 then the last p frame quantizer will be used (q= lastp_q*factor+offset).
- * If < 0 then normal ratecontrol will be done (q= -normal_q*factor+offset).
- * - encoding: Set by user.
- * - decoding: unused
- *)
- i_quant_factor: single;
-
- (**
- * qscale offset between P and I-frames
- * - encoding: Set by user.
- * - decoding: unused
- *)
- i_quant_offset: single;
-
- (**
- * initial complexity for pass1 ratecontrol
- * - encoding: Set by user.
- * - decoding: unused
- *)
- rc_initial_cplx: single;
-
- (**
- * DCT algorithm, see FF_DCT_* below
- * - encoding: Set by user.
- * - decoding: unused
- *)
- dct_algo: integer;
-
- (**
- * luminance masking (0-> disabled)
- * - encoding: Set by user.
- * - decoding: unused
- *)
- lumi_masking: single;
-
- (**
- * temporary complexity masking (0-> disabled)
- * - encoding: Set by user.
- * - decoding: unused
- *)
- temporal_cplx_masking: single;
-
- (**
- * spatial complexity masking (0-> disabled)
- * - encoding: Set by user.
- * - decoding: unused
- *)
- spatial_cplx_masking: single;
-
- (**
- * p block masking (0-> disabled)
- * - encoding: Set by user.
- * - decoding: unused
- *)
- p_masking: single;
-
- (**
- * darkness masking (0-> disabled)
- * - encoding: Set by user.
- * - decoding: unused
- *)
- dark_masking: single;
-
- {$IF LIBAVCODEC_VERSION < 52000000} // 52.0.0
- (* for binary compatibility *)
- unused: integer;
- {$IFEND}
-
- (**
- * IDCT algorithm, see FF_IDCT_* below.
- * - encoding: Set by user.
- * - decoding: Set by user.
- *)
- idct_algo: integer;
-
- (**
- * slice count
- * - encoding: Set by libavcodec.
- * - decoding: Set by user (or 0).
- *)
- slice_count: integer;
-
- (**
- * slice offsets in the frame in bytes
- * - encoding: Set/allocated by libavcodec.
- * - decoding: Set/allocated by user (or NULL).
- *)
- slice_offset: Pinteger;
-
- (**
- * error concealment flags
- * - encoding: unused
- * - decoding: Set by user.
- *)
- error_concealment: integer;
-
- (**
- * dsp_mask could be add used to disable unwanted CPU features
- * CPU features (i.e. MMX, SSE. ...)
- *
- * With the FORCE flag you may instead enable given CPU features.
- * (Dangerous: Usable in case of misdetection, improper usage however will
- * result into program crash.)
- *)
- dsp_mask: cardinal;
-
- (**
- * bits per sample/pixel from the demuxer (needed for huffyuv).
- * - encoding: Set by libavcodec.
- * - decoding: Set by user.
- *)
- bits_per_sample: integer;
-
- (**
- * prediction method (needed for huffyuv)
- * - encoding: Set by user.
- * - decoding: unused
- *)
- prediction_method: integer;
-
- (**
- * sample aspect ratio (0 if unknown)
- * Numerator and denominator must be relatively prime and smaller than 256 for some video standards.
- * - encoding: Set by user.
- * - decoding: Set by libavcodec.
- *)
- sample_aspect_ratio: TAVRational;
-
- (**
- * the picture in the bitstream
- * - encoding: Set by libavcodec.
- * - decoding: Set by libavcodec.
- *)
- coded_frame: PAVFrame;
-
- (**
- * debug
- * - encoding: Set by user.
- * - decoding: Set by user.
- *)
- debug: integer;
-
- (**
- * debug
- * - encoding: Set by user.
- * - decoding: Set by user.
- *)
- debug_mv: integer;
-
- (**
- * error
- * - encoding: Set by libavcodec if flags&CODEC_FLAG_PSNR.
- * - decoding: unused
- *)
- error: array [0..3] of uint64;
-
- (**
- * minimum MB quantizer
- * - encoding: unused
- * - decoding: unused
- *)
- mb_qmin: integer;
-
- (**
- * maximum MB quantizer
- * - encoding: unused
- * - decoding: unused
- *)
- mb_qmax: integer;
-
- (**
- * motion estimation comparison function
- * - encoding: Set by user.
- * - decoding: unused
- *)
- me_cmp: integer;
-
- (**
- * subpixel motion estimation comparison function
- * - encoding: Set by user.
- * - decoding: unused
- *)
- me_sub_cmp: integer;
- (**
- * macroblock comparison function (not supported yet)
- * - encoding: Set by user.
- * - decoding: unused
- *)
- mb_cmp: integer;
- (**
- * interlaced DCT comparison function
- * - encoding: Set by user.
- * - decoding: unused
- *)
- ildct_cmp: integer;
-
- (**
- * ME diamond size & shape
- * - encoding: Set by user.
- * - decoding: unused
- *)
- dia_size: integer;
-
- (**
- * amount of previous MV predictors (2a+1 x 2a+1 square)
- * - encoding: Set by user.
- * - decoding: unused
- *)
- last_predictor_count: integer;
-
- (**
- * prepass for motion estimation
- * - encoding: Set by user.
- * - decoding: unused
- *)
- pre_me: integer;
-
- (**
- * motion estimation prepass comparison function
- * - encoding: Set by user.
- * - decoding: unused
- *)
- me_pre_cmp: integer;
-
- (**
- * ME prepass diamond size & shape
- * - encoding: Set by user.
- * - decoding: unused
- *)
- pre_dia_size: integer;
-
- (**
- * subpel ME quality
- * - encoding: Set by user.
- * - decoding: unused
- *)
- me_subpel_quality: integer;
-
- (**
- * callback to negotiate the pixelFormat
- * @param fmt is the list of formats which are supported by the codec,
- * it is terminated by -1 as 0 is a valid format, the formats are ordered by quality.
- * The first is always the native one.
- * @return the chosen format
- * - encoding: unused
- * - decoding: Set by user, if not set the native format will be chosen.
- *)
- get_format: function (s: PAVCodecContext; {const} fmt: PAVPixelFormat): TAVPixelFormat; cdecl;
-
- (**
- * DTG active format information (additional aspect ratio
- * information only used in DVB MPEG-2 transport streams)
- * 0 if not set.
- *
- * - encoding: unused
- * - decoding: Set by decoder.
- *)
- dtg_active_format: integer;
-
- (**
- * maximum motion estimation search range in subpel units
- * If 0 then no limit.
- *
- * - encoding: Set by user.
- * - decoding: unused
- *)
- me_range: integer;
-
- (**
- * intra quantizer bias
- * - encoding: Set by user.
- * - decoding: unused
- *)
- intra_quant_bias: integer;
-
- (**
- * inter quantizer bias
- * - encoding: Set by user.
- * - decoding: unused
- *)
- inter_quant_bias: integer;
-
- (**
- * color table ID
- * - encoding: unused
- * - decoding: Which clrtable should be used for 8bit RGB images.
- * Tables have to be stored somewhere. FIXME
- *)
- color_table_id: integer;
-
- (**
- * internal_buffer count
- * Don't touch, used by libavcodec default_get_buffer().
- *)
- internal_buffer_count: integer;
-
- (**
- * internal_buffers
- * Don't touch, used by libavcodec default_get_buffer().
- *)
- internal_buffer: pointer;
-
- (**
- * Global quality for codecs which cannot change it per frame.
- * This should be proportional to MPEG-1/2/4 qscale.
- * - encoding: Set by user.
- * - decoding: unused
- *)
- global_quality: integer;
-
- (**
- * coder type
- * - encoding: Set by user.
- * - decoding: unused
- *)
- coder_type: integer;
-
- (**
- * context model
- * - encoding: Set by user.
- * - decoding: unused
- *)
- context_model: integer;
-
- {
- (**
- *
- * - encoding: unused
- * - decoding: Set by user.
- *)
- realloc: function (s: PAVCodecContext; buf: Pbyte; buf_size: integer): Pbyte; cdecl;
- }
-
- (**
- * slice flags
- * - encoding: unused
- * - decoding: Set by user.
- *)
- slice_flags: integer;
-
- (**
- * XVideo Motion Acceleration
- * - encoding: forbidden
- * - decoding: set by decoder
- *)
- xvmc_acceleration: integer;
-
- (**
- * macroblock decision mode
- * - encoding: Set by user.
- * - decoding: unused
- *)
- mb_decision: integer;
-
- (**
- * custom intra quantization matrix
- * - encoding: Set by user, can be NULL.
- * - decoding: Set by libavcodec.
- *)
- intra_matrix: Pword;
-
- (**
- * custom inter quantization matrix
- * - encoding: Set by user, can be NULL.
- * - decoding: Set by libavcodec.
- *)
- inter_matrix: Pword;
-
- (**
- * fourcc from the AVI stream header (LSB first, so "ABCD" -> ('D'<<24) + ('C'<<16) + ('B'<<8) + 'A').
- * This is used to work around some encoder bugs.
- * - encoding: unused
- * - decoding: Set by user, will be converted to uppercase by libavcodec during init.
- *)
- stream_codec_tag: array [0..3] of char; //cardinal;
-
- (**
- * scene change detection threshold
- * 0 is default, larger means fewer detected scene changes.
- * - encoding: Set by user.
- * - decoding: unused
- *)
- scenechange_threshold: integer;
-
- (**
- * minimum Lagrange multipler
- * - encoding: Set by user.
- * - decoding: unused
- *)
- lmin: integer;
-
- (**
- * maximum Lagrange multipler
- * - encoding: Set by user.
- * - decoding: unused
- *)
- lmax: integer;
-
- (**
- * palette control structure
- * - encoding: ??? (no palette-enabled encoder yet)
- * - decoding: Set by user.
- *)
- palctrl: PAVPaletteControl;
-
- (**
- * noise reduction strength
- * - encoding: Set by user.
- * - decoding: unused
- *)
- noise_reduction: integer;
-
- (**
- * Called at the beginning of a frame to get cr buffer for it.
- * Buffer type (size, hints) must be the same. libavcodec won't check it.
- * libavcodec will pass previous buffer in pic, function should return
- * same buffer or new buffer with old frame "painted" into it.
- * If pic.data[0] == NULL must behave like get_buffer().
- * - encoding: unused
- * - decoding: Set by libavcodec., user can override
- *)
- reget_buffer: function (c: PAVCodecContext; pic: PAVFrame): integer; cdecl;
-
- (**
- * Number of bits which should be loaded into the rc buffer before decoding starts.
- * - encoding: Set by user.
- * - decoding: unused
- *)
- rc_initial_buffer_occupancy: integer;
-
- (**
- *
- * - encoding: Set by user.
- * - decoding: unused
- *)
- inter_threshold: integer;
-
- (**
- * CODEC_FLAG2_*
- * - encoding: Set by user.
- * - decoding: Set by user.
- *)
- flags2: integer;
-
- (**
- * Simulates errors in the bitstream to test error concealment.
- * - encoding: Set by user.
- * - decoding: unused
- *)
- error_rate: integer;
-
- (**
- * MP3 antialias algorithm, see FF_AA_* below.
- * - encoding: unused
- * - decoding: Set by user.
- *)
- antialias_algo: integer;
-
- (**
- * quantizer noise shaping
- * - encoding: Set by user.
- * - decoding: unused
- *)
- quantizer_noise_shaping: integer;
-
- (**
- * thread count
- * is used to decide how many independent tasks should be passed to execute()
- * - encoding: Set by user.
- * - decoding: Set by user.
- *)
- thread_count: integer;
-
- (**
- * The codec may call this to execute several independent things.
- * It will return only after finishing all tasks.
- * The user may replace this with some multithreaded implementation,
- * the default implementation will execute the parts serially.
- * @param count the number of things to execute
- * - encoding: Set by libavcodec, user can override.
- * - decoding: Set by libavcodec, user can override.
- *)
- execute: function (c: PAVCodecContext; func: TExecuteFunc; arg: PPointer; ret: PInteger; count: integer): integer; cdecl;
-
- (**
- * thread opaque
- * Can be used by execute() to store some per AVCodecContext stuff.
- * - encoding: set by execute()
- * - decoding: set by execute()
- *)
- thread_opaque: pointer;
-
- (**
- * Motion estimation threshold below which no motion estimation is
- * performed, but instead the user specified motion vectors are used.
- *
- * - encoding: Set by user.
- * - decoding: unused
- *)
- me_threshold: integer;
-
- (**
- * Macroblock threshold below which the user specified macroblock types will be used.
- * - encoding: Set by user.
- * - decoding: unused
- *)
- mb_threshold: integer;
-
- (**
- * precision of the intra DC coefficient - 8
- * - encoding: Set by user.
- * - decoding: unused
- *)
- intra_dc_precision: integer;
-
- (**
- * noise vs. sse weight for the nsse comparsion function
- * - encoding: Set by user.
- * - decoding: unused
- *)
- nsse_weight: integer;
-
- (**
- * Number of macroblock rows at the top which are skipped.
- * - encoding: unused
- * - decoding: Set by user.
- *)
- skip_top: integer;
-
- (**
- * Number of macroblock rows at the bottom which are skipped.
- * - encoding: unused
- * - decoding: Set by user.
- *)
- skip_bottom: integer;
-
- (**
- * profile
- * - encoding: Set by user.
- * - decoding: Set by libavcodec.
- *)
- profile: integer;
-
- (**
- * level
- * - encoding: Set by user.
- * - decoding: Set by libavcodec.
- *)
- level: integer;
-
- (**
- * low resolution decoding, 1-> 1/2 size, 2->1/4 size
- * - encoding: unused
- * - decoding: Set by user.
- *)
- lowres: integer;
-
- (**
- * Bitstream width / height, may be different from width/height if lowres
- * or other things are used.
- * - encoding: unused
- * - decoding: Set by user before init if known. Codec should override / dynamically change if needed.
- *)
- coded_width, coded_height: integer;
-
- (**
- * frame skip threshold
- * - encoding: Set by user.
- * - decoding: unused
- *)
- frame_skip_threshold: integer;
-
- (**
- * frame skip factor
- * - encoding: Set by user.
- * - decoding: unused
- *)
- frame_skip_factor: integer;
-
- (**
- * frame skip exponent
- * - encoding: Set by user.
- * - decoding: unused
- *)
- frame_skip_exp: integer;
-
- (**
- * frame skip comparison function
- * - encoding: Set by user.
- * - decoding: unused
- *)
- frame_skip_cmp: integer;
-
- (**
- * Border processing masking, raises the quantizer for mbs on the borders
- * of the picture.
- * - encoding: Set by user.
- * - decoding: unused
- *)
- border_masking: single;
-
- (**
- * minimum MB lagrange multipler
- * - encoding: Set by user.
- * - decoding: unused
- *)
- mb_lmin: integer;
-
- (**
- * maximum MB lagrange multipler
- * - encoding: Set by user.
- * - decoding: unused
- *)
- mb_lmax: integer;
-
- (**
- *
- * - encoding: Set by user.
- * - decoding: unused
- *)
- me_penalty_compensation: integer;
-
- (**
- *
- * - encoding: unused
- * - decoding: Set by user.
- *)
- skip_loop_filter: TAVDiscard;
-
- (**
- *
- * - encoding: unused
- * - decoding: Set by user.
- *)
- skip_idct: TAVDiscard;
-
- (**
- *
- * - encoding: unused
- * - decoding: Set by user.
- *)
- skip_frame: TAVDiscard;
-
- (**
- *
- * - encoding: Set by user.
- * - decoding: unused
- *)
- bidir_refine: integer;
-
- (**
- *
- * - encoding: Set by user.
- * - decoding: unused
- *)
- brd_scale: integer;
-
- (**
- * constant rate factor - quality-based VBR - values ~correspond to qps
- * - encoding: Set by user.
- * - decoding: unused
- *)
- {$IF LIBAVCODEC_VERSION >= 51021000} // 51.21.0
- crf: single;
- {$ELSE}
- crf: integer;
- {$IFEND}
-
- (**
- * constant quantization parameter rate control method
- * - encoding: Set by user.
- * - decoding: unused
- *)
- cqp: integer;
-
- (**
- * minimum GOP size
- * - encoding: Set by user.
- * - decoding: unused
- *)
- keyint_min: integer;
-
- (**
- * number of reference frames
- * - encoding: Set by user.
- * - decoding: unused
- *)
- refs: integer;
-
- (**
- * chroma qp offset from luma
- * - encoding: Set by user.
- * - decoding: unused
- *)
- chromaoffset: integer;
-
- (**
- * Influences how often B-frames are used.
- * - encoding: Set by user.
- * - decoding: unused
- *)
- bframebias: integer;
-
- (**
- * trellis RD quantization
- * - encoding: Set by user.
- * - decoding: unused
- *)
- trellis: integer;
-
- (**
- * Reduce fluctuations in qp (before curve compression).
- * - encoding: Set by user.
- * - decoding: unused
- *)
- complexityblur: single;
-
- (**
- * in-loop deblocking filter alphac0 parameter
- * alpha is in the range -6...6
- * - encoding: Set by user.
- * - decoding: unused
- *)
- deblockalpha: integer;
-
- (**
- * in-loop deblocking filter beta parameter
- * beta is in the range -6...6
- * - encoding: Set by user.
- * - decoding: unused
- *)
- deblockbeta: integer;
-
- (**
- * macroblock subpartition sizes to consider - p8x8, p4x4, b8x8, i8x8, i4x4
- * - encoding: Set by user.
- * - decoding: unused
- *)
- partitions: integer;
-
- (**
- * direct MV prediction mode - 0 (none), 1 (spatial), 2 (temporal)
- * - encoding: Set by user.
- * - decoding: unused
- *)
- directpred: integer;
-
- (**
- * Audio cutoff bandwidth (0 means "automatic")
- * - encoding: Set by user.
- * - decoding: unused
- *)
- cutoff: integer;
-
- (**
- * Multiplied by qscale for each frame and added to scene_change_score.
- * - encoding: Set by user.
- * - decoding: unused
- *)
- scenechange_factor: integer;
-
- (**
- *
- * Note: Value depends upon the compare function used for fullpel ME.
- * - encoding: Set by user.
- * - decoding: unused
- *)
- mv0_threshold: integer;
-
- (**
- * Adjusts sensitivity of b_frame_strategy 1.
- * - encoding: Set by user.
- * - decoding: unused
- *)
- b_sensitivity: integer;
-
- (**
- * - encoding: Set by user.
- * - decoding: unused
- *)
- compression_level: integer;
-
- (**
- * Sets whether to use LPC mode - used by FLAC encoder.
- * - encoding: Set by user.
- * - decoding: unused
- *)
- use_lpc: integer;
-
- (**
- * LPC coefficient precision - used by FLAC encoder
- * - encoding: Set by user.
- * - decoding: unused
- *)
- lpc_coeff_precision: integer;
-
- (**
- * - encoding: Set by user.
- * - decoding: unused
- *)
- min_prediction_order: integer;
-
- (**
- * - encoding: Set by user.
- * - decoding: unused
- *)
- max_prediction_order: integer;
-
- (**
- * search method for selecting prediction order
- * - encoding: Set by user.
- * - decoding: unused
- *)
- prediction_order_method: integer;
-
- (**
- * - encoding: Set by user.
- * - decoding: unused
- *)
- min_partition_order: integer;
-
- (**
- * - encoding: Set by user.
- * - decoding: unused
- *)
- max_partition_order: integer;
-
- {$IF LIBAVCODEC_VERSION >= 51026000} // 51.26.0
- (**
- * GOP timecode frame start number, in non drop frame format
- * - encoding: Set by user.
- * - decoding: unused
- *)
- timecode_frame_start: int64;
- {$IFEND}
-
- {$IF LIBAVCODEC_VERSION >= 51042000} // 51.42.0
- (**
- * Decoder should decode to this many channels if it can (0 for default)
- * - encoding: unused
- * - decoding: Set by user.
- *)
- request_channels: integer;
- {$IFEND}
-
- {$IF LIBAVCODEC_VERSION > 51049000} // > 51.49.0
- (**
- * Percentage of dynamic range compression to be applied by the decoder.
- * The default value is 1.0, corresponding to full compression.
- * - encoding: unused
- * - decoding: Set by user.
- *)
- drc_scale: Single;
- {$IFEND}
- end;
-
-(**
- * AVCodec.
- *)
- TAVCodec = record
- name: pchar;
- type_: TCodecType;
- id: TCodecID;
- priv_data_size: integer;
- init: function (avctx: PAVCodecContext): integer; cdecl; (* typo corretion by the Creative CAT *)
- encode: function (avctx: PAVCodecContext; buf: pchar; buf_size: integer; data: pointer): integer; cdecl;
- close: function (avctx: PAVCodecContext): integer; cdecl;
- decode: function (avctx: PAVCodecContext; outdata: pointer; outdata_size: PInteger;
- {const} buf: pchar; buf_size: integer): integer; cdecl;
- (**
- * Codec capabilities.
- * see CODEC_CAP_*
- *)
- capabilities: integer;
- next: PAVCodec;
- (**
- * Flush buffers.
- * Will be called when seeking
- *)
- flush: procedure (avctx: PAVCodecContext); cdecl;
- {const} supported_framerates: PAVRational; ///< array of supported framerates, or NULL if any, array is terminated by {0,0}
- {const} pix_fmts: PAVPixelFormat; ///< array of supported pixel formats, or NULL if unknown, array is terminated by -1
- {$IF LIBAVCODEC_VERSION >= 51055000} // 51.55.0
- {const} long_name: PChar; ///< descriptive name for the codec, meant to be more human readable than \p name
- {$IFEND}
- {$IF LIBAVCODEC_VERSION >= 51056000} // 51.56.0
- {const} supported_samplerates: PInteger; ///< array of supported audio samplerates, or NULL if unknown, array is terminated by 0
- {$IFEND}
- end;
-
-(**
- * four components are given, that's all.
- * the last component is alpha
- *)
- PAVPicture = ^TAVPicture;
- TAVPicture = record
- data: array [0..3] of pchar;
- linesize: array [0..3] of integer; ///< number of bytes per line
- end;
-
-type
- PAVSubtitleRect = ^TAVSubtitleRect;
- TAVSubtitleRect = record
- x: word;
- y: word;
- w: word;
- h: word;
- nb_colors: word;
- linesize: integer;
- rgba_palette: PCardinal;
- bitmap: pchar;
- end;
-
- PAVSubtitle = ^TAVSubtitle;
- TAVSubtitle = record {20}
- format: word; (* 0 = graphics *)
- start_display_time: cardinal; (* relative to packet pts, in ms *)
- end_display_time: cardinal; (* relative to packet pts, in ms *)
- num_rects: cardinal;
- rects: PAVSubtitleRect;
- end;
-
-
-(* resample.c *)
-
- PReSampleContext = pointer;
- PAVResampleContext = pointer;
- PImgReSampleContext = pointer;
-
-function audio_resample_init (output_channels: integer; input_channels: integer;
- output_rate: integer; input_rate: integer): PReSampleContext;
- cdecl; external av__codec;
-
-function audio_resample (s: PReSampleContext; output: PSmallint; input: PSmallint; nb_samples: integer): integer;
- cdecl; external av__codec;
-
-procedure audio_resample_close (s: PReSampleContext);
- cdecl; external av__codec;
-
-
-function av_resample_init (out_rate: integer; in_rate: integer; filter_length: integer;
- log2_phase_count: integer; linear: integer; cutoff: double): PAVResampleContext;
- cdecl; external av__codec;
-
-function av_resample (c: PAVResampleContext; dst: PSmallint; src: PSmallint; consumed: PInteger;
- src_size: integer; dst_size: integer; update_ctx: integer): integer;
- cdecl; external av__codec;
-
-procedure av_resample_compensate (c: PAVResampleContext; sample_delta: integer;
- compensation_distance: integer);
- cdecl; external av__codec;
-
-procedure av_resample_close (c: PAVResampleContext);
- cdecl; external av__codec;
-
-
-{$IF LIBAVCODEC_VERSION < 52000000} // 52.0.0
-(* YUV420 format is assumed ! *)
-
-(**
- * @deprecated Use the software scaler (swscale) instead.
- *)
-function img_resample_init (output_width: integer; output_height: integer;
- input_width: integer; input_height: integer): PImgReSampleContext;
- cdecl; external av__codec; deprecated;
-
-(**
- * @deprecated Use the software scaler (swscale) instead.
- *)
-function img_resample_full_init (owidth: integer; oheight: integer;
- iwidth: integer; iheight: integer;
- topBand: integer; bottomBand: integer;
- leftBand: integer; rightBand: integer;
- padtop: integer; padbottom: integer;
- padleft: integer; padright: integer): PImgReSampleContext;
- cdecl; external av__codec; deprecated;
-
-(**
- * @deprecated Use the software scaler (swscale) instead.
- *)
-procedure img_resample (s: PImgReSampleContext; output: PAVPicture; {const} input: PAVPicture);
- cdecl; external av__codec; deprecated;
-
-(**
- * @deprecated Use the software scaler (swscale) instead.
- *)
-procedure img_resample_close (s: PImgReSampleContext);
- cdecl; external av__codec; deprecated;
-
-{$IFEND}
-
-(**
- * Allocate memory for a picture. Call avpicture_free to free it.
- *
- * @param picture the picture to be filled in.
- * @param pix_fmt the format of the picture.
- * @param width the width of the picture.
- * @param height the height of the picture.
- * @return Zero if successful, a negative value if not.
- *)
-function avpicture_alloc (picture: PAVPicture; pix_fmt: TAVPixelFormat;
- width: integer; height: integer): integer;
- cdecl; external av__codec;
-
-(**
- * Free a picture previously allocated by avpicture_alloc().
- *
- * @param picture the AVPicture to be freed
- *)
-procedure avpicture_free (picture: PAVPicture);
- cdecl; external av__codec;
-
-(**
- * Fill in the AVPicture fields.
- * The fields of the given AVPicture are filled in by using the 'ptr' address
- * which points to the image data buffer. Depending on the specified picture
- * format, one or multiple image data pointers and line sizes will be set.
- * If a planar format is specified, several pointers will be set pointing to
- * the different picture planes and the line sizes of the different planes
- * will be stored in the lines_sizes array.
- *
- * @param picture AVPicture whose fields are to be filled in
- * @param ptr Buffer which will contain or contains the actual image data
- * @param pix_fmt The format in which the picture data is stored.
- * @param width the width of the image in pixels
- * @param height the height of the image in pixels
- * @return size of the image data in bytes
- *)
-function avpicture_fill (picture: PAVPicture; ptr: pointer;
- pix_fmt: TAVPixelFormat; width: integer; height: integer): integer;
- cdecl; external av__codec;
-
-function avpicture_layout ({const} src: PAVPicture; pix_fmt: TAVPixelFormat;
- width: integer; height: integer;
- dest: pchar; dest_size: integer): integer;
- cdecl; external av__codec;
-
-(**
- * Calculate the size in bytes that a picture of the given width and height
- * would occupy if stored in the given picture format.
- *
- * @param pix_fmt the given picture format
- * @param width the width of the image
- * @param height the height of the image
- * @return Image data size in bytes
- *)
-function avpicture_get_size (pix_fmt: TAVPixelFormat; width: integer; height: integer): integer;
- cdecl; external av__codec;
-
-procedure avcodec_get_chroma_sub_sample (pix_fmt: TAVPixelFormat; h_shift: Pinteger; v_shift: pinteger);
- cdecl; external av__codec;
-
-function avcodec_get_pix_fmt_name(pix_fmt: TAVPixelFormat): pchar;
- cdecl; external av__codec;
-
-procedure avcodec_set_dimensions(s: PAVCodecContext; width: integer; height: integer);
- cdecl; external av__codec;
-
-function avcodec_get_pix_fmt(const name: pchar): TAVPixelFormat;
- cdecl; external av__codec;
-
-function avcodec_pix_fmt_to_codec_tag(p: TAVPixelFormat): cardinal;
- cdecl; external av__codec;
-
-const
- FF_LOSS_RESOLUTION = $0001; {**< loss due to resolution change *}
- FF_LOSS_DEPTH = $0002; {**< loss due to color depth change *}
- FF_LOSS_COLORSPACE = $0004; {**< loss due to color space conversion *}
- FF_LOSS_ALPHA = $0008; {**< loss of alpha bits *}
- FF_LOSS_COLORQUANT = $0010; {**< loss due to color quantization *}
- FF_LOSS_CHROMA = $0020; {**< loss of chroma (e.g. RGB to gray conversion) *}
-
-(**
- * Computes what kind of losses will occur when converting from one specific
- * pixel format to another.
- * When converting from one pixel format to another, information loss may occur.
- * For example, when converting from RGB24 to GRAY, the color information will
- * be lost. Similarly, other losses occur when converting from some formats to
- * other formats. These losses can involve loss of chroma, but also loss of
- * resolution, loss of color depth, loss due to the color space conversion, loss
- * of the alpha bits or loss due to color quantization.
- * avcodec_get_fix_fmt_loss() informs you about the various types of losses
- * which will occur when converting from one pixel format to another.
- *
- * @param[in] dst_pix_fmt destination pixel format
- * @param[in] src_pix_fmt source pixel format
- * @param[in] has_alpha Whether the source pixel format alpha channel is used.
- * @return Combination of flags informing you what kind of losses will occur.
- *)
-function avcodec_get_pix_fmt_loss (dst_pix_fmt: TAVPixelFormat; src_pix_fmt: TAVPixelFormat;
- has_alpha: integer): integer;
- cdecl; external av__codec;
-
-(**
- * Finds the best pixel format to convert to given a certain source pixel
- * format. When converting from one pixel format to another, information loss
- * may occur. For example, when converting from RGB24 to GRAY, the color
- * information will be lost. Similarly, other losses occur when converting from
- * some formats to other formats. avcodec_find_best_pix_fmt() searches which of
- * the given pixel formats should be used to suffer the least amount of loss.
- * The pixel formats from which it chooses one, are determined by the
- * \p pix_fmt_mask parameter.
- *
- * @code
- * src_pix_fmt = PIX_FMT_YUV420P;
- * pix_fmt_mask = (1 << PIX_FMT_YUV422P) || (1 << PIX_FMT_RGB24);
- * dst_pix_fmt = avcodec_find_best_pix_fmt(pix_fmt_mask, src_pix_fmt, alpha, &loss);
- * @endcode
- *
- * @param[in] pix_fmt_mask bitmask determining which pixel format to choose from
- * @param[in] src_pix_fmt source pixel format
- * @param[in] has_alpha Whether the source pixel format alpha channel is used.
- * @param[out] loss_ptr Combination of flags informing you what kind of losses will occur.
- * @return The best pixel format to convert to or -1 if none was found.
- *)
-function avcodec_find_best_pix_fmt (pix_fmt_mask: integer; src_pix_fmt: TAVPixelFormat;
- has_alpha: integer; loss_ptr: pinteger): integer;
- cdecl; external av__codec;
-
-{$IF LIBAVCODEC_VERSION >= 51041000} // 51.41.0
-(**
- * Print in buf the string corresponding to the pixel format with
- * number pix_fmt, or an header if pix_fmt is negative.
- *
- * @param[in] buf the buffer where to write the string
- * @param[in] buf_size the size of buf
- * @param[in] pix_fmt the number of the pixel format to print the corresponding info string, or
- * a negative value to print the corresponding header.
- * Meaningful values for obtaining a pixel format info vary from 0 to PIX_FMT_NB -1.
- *)
-procedure avcodec_pix_fmt_string (buf: PChar; buf_size: integer; pix_fmt: integer);
- cdecl; external av__codec;
-{$IFEND}
-
-const
- FF_ALPHA_TRANSP = $0001; {* image has some totally transparent pixels *}
- FF_ALPHA_SEMI_TRANSP = $0002; {* image has some transparent pixels *}
-
-(**
- * Tell if an image really has transparent alpha values.
- * @return ored mask of FF_ALPHA_xxx constants
- *)
-function img_get_alpha_info ({const} src: PAVPicture;
- pix_fmt: TAVPixelFormat;
- width: integer; height: integer): integer;
- cdecl; external av__codec;
-
-{$IF LIBAVCODEC_VERSION < 52000000} // 52.0.0
-(**
- * convert among pixel formats
- * @deprecated Use the software scaler (swscale) instead.
- *)
-function img_convert (dst: PAVPicture; dst_pix_fmt: TAVPixelFormat;
- const src: PAVPicture; pix_fmt: TAVPixelFormat;
- width: integer; height: integer): integer;
- cdecl; external av__codec; deprecated;
-{$IFEND}
-
-(* deinterlace a picture *)
-(* deinterlace - if not supported return -1 *)
-function avpicture_deinterlace (dst: PAVPicture; const src: PAVPicture;
- pix_fmt: TAVPixelFormat; width: integer; height: integer): integer;
- cdecl; external av__codec;
-
-{* external high level API *}
-
-{$IF LIBAVCODEC_VERSION < 52000000} // 52.0.0
-{
-var
- first_avcodec: PAVCodec; external av__codec;
-}
-{$IFEND}
-
-{$IF LIBAVCODEC_VERSION >= 51049000} // 51.49.0
-function av_codec_next(c: PAVCodec): PAVCodec;
- cdecl; external av__codec;
-{$IFEND}
-
-(* returns LIBAVCODEC_VERSION_INT constant *)
-function avcodec_version (): cardinal;
- cdecl; external av__codec;
-
-(* returns LIBAVCODEC_BUILD constant *)
-function avcodec_build (): cardinal;
- cdecl; external av__codec;
-
-(**
- * Initializes libavcodec.
- *
- * @warning This function \e must be called before any other libavcodec
- * function.
- *)
-procedure avcodec_init ();
- cdecl; external av__codec;
-
-procedure register_avcodec (format: PAVCodec);
- cdecl; external av__codec;
-
-(**
- * Finds a registered encoder with a matching codec ID.
- *
- * @param id CodecID of the requested encoder
- * @return An encoder if one was found, NULL otherwise.
- *)
-function avcodec_find_encoder (id: TCodecID): PAVCodec;
- cdecl; external av__codec;
-
-(**
- * Finds a registered encoder with the specified name.
- *
- * @param name name of the requested encoder
- * @return An encoder if one was found, NULL otherwise.
- *)
-function avcodec_find_encoder_by_name (name: pchar): PAVCodec;
- cdecl; external av__codec;
-
-(**
- * Finds a registered decoder with a matching codec ID.
- *
- * @param id CodecID of the requested decoder
- * @return A decoder if one was found, NULL otherwise.
- *)
-function avcodec_find_decoder(id: TCodecID): PAVCodec;
- cdecl; external av__codec;
-
-(**
- * Finds a registered decoder with the specified name.
- *
- * @param name name of the requested decoder
- * @return A decoder if one was found, NULL otherwise.
- *)
-function avcodec_find_decoder_by_name (name: pchar): PAVCodec;
- cdecl; external av__codec;
-procedure avcodec_string(buf: pchar; buf_size: integer; enc: PAVCodecContext; encode: integer);
- cdecl; external av__codec;
-
-(**
- * Sets the fields of the given AVCodecContext to default values.
- *
- * @param s The AVCodecContext of which the fields should be set to default values.
- *)
-procedure avcodec_get_context_defaults (s: PAVCodecContext);
- cdecl; external av__codec;
-
-{$IF LIBAVCODEC_VERSION >= 51039000} // 51.39.0
-(** THIS FUNCTION IS NOT YET PART OF THE PUBLIC API!
- * we WILL change its arguments and name a few times! *)
-procedure avcodec_get_context_defaults2(s: PAVCodecContext; ctype: TCodecType);
- cdecl; external av__codec;
-{$IFEND}
-
-(**
- * Allocates an AVCodecContext and sets its fields to default values. The
- * resulting struct can be deallocated by simply calling av_free().
- *
- * @return An AVCodecContext filled with default values or NULL on failure.
- * @see avcodec_get_context_defaults
- *)
-function avcodec_alloc_context(): PAVCodecContext;
- cdecl; external av__codec;
-
-{$IF LIBAVCODEC_VERSION >= 51039000} // 51.39.0
-(** THIS FUNCTION IS NOT YET PART OF THE PUBLIC API!
- * we WILL change its arguments and name a few times! *)
-function avcodec_alloc_context2(ctype: TCodecType): PAVCodecContext;
- cdecl; external av__codec;
-{$IFEND}
-
-(**
- * Sets the fields of the given AVFrame to default values.
- *
- * @param pic The AVFrame of which the fields should be set to default values.
- *)
-procedure avcodec_get_frame_defaults (pic: PAVFrame);
- cdecl; external av__codec;
-
-(**
- * Allocates an AVFrame and sets its fields to default values. The resulting
- * struct can be deallocated by simply calling av_free().
- *
- * @return An AVFrame filled with default values or NULL on failure.
- * @see avcodec_get_frame_defaults
- *)
-function avcodec_alloc_frame(): PAVFrame;
- cdecl; external av__codec;
-
-function avcodec_default_get_buffer (s: PAVCodecContext; pic: PAVFrame): integer;
- cdecl; external av__codec;
-procedure avcodec_default_release_buffer (s: PAVCodecContext; pic: PAVFrame);
- cdecl; external av__codec;
-function avcodec_default_reget_buffer (s: PAVCodecContext; pic: PAVFrame): integer;
- cdecl; external av__codec;
-procedure avcodec_align_dimensions(s: PAVCodecContext; width: Pinteger; height: PInteger);
- cdecl; external av__codec;
-
-(**
- * Checks if the given dimension of a picture is valid, meaning that all
- * bytes of the picture can be addressed with a signed int.
- *
- * @param[in] w Width of the picture.
- * @param[in] h Height of the picture.
- * @return Zero if valid, a negative value if invalid.
- *)
-function avcodec_check_dimensions (av_log_ctx: pointer; w: cardinal; h: cardinal): integer;
- cdecl; external av__codec;
-function avcodec_default_get_format(s: PAVCodecContext; const fmt: PAVPixelFormat): TAVPixelFormat;
- cdecl; external av__codec;
-
-function avcodec_thread_init (s: PAVCodecContext; thread_count: integer): integer;
- cdecl; external av__codec;
-procedure avcodec_thread_free (s: PAVCodecContext);
- cdecl; external av__codec;
-function avcodec_thread_execute (s: PAVCodecContext; func: TExecuteFunc; arg: PPointer; ret: Pinteger; count: integer): integer;
- cdecl; external av__codec;
-function avcodec_default_execute (s: PAVCodecContext; func: TExecuteFunc; arg: PPointer; ret: Pinteger; count: integer): integer;
- cdecl; external av__codec;
-//FIXME func typedef
-
-(**
- * Initializes the AVCodecContext to use the given AVCodec. Prior to using this
- * function the context has to be allocated.
- *
- * The functions avcodec_find_decoder_by_name(), avcodec_find_encoder_by_name(),
- * avcodec_find_decoder() and avcodec_find_encoder() provide an easy way for
- * retrieving a codec.
- *
- * @warning This function is not thread safe!
- *
- * @code
- * avcodec_register_all();
- * codec = avcodec_find_decoder(CODEC_ID_H264);
- * if (!codec)
- * exit(1);
- *
- * context = avcodec_alloc_context();
- *
- * if (avcodec_open(context, codec) < 0)
- * exit(1);
- * @endcode
- *
- * @param avctx The context which will be set up to use the given codec.
- * @param codec The codec to use within the context.
- * @return zero on success, a negative value on error
- * @see avcodec_alloc_context, avcodec_find_decoder, avcodec_find_encoder
- *)
-function avcodec_open (avctx: PAVCodecContext; codec: PAVCodec): integer;
- cdecl; external av__codec;
-
-(**
- * @deprecated Use avcodec_decode_audio2() instead.
- *)
-function avcodec_decode_audio (avctx: PAVCodecContext; samples: Pword;
- var frame_size_ptr: integer;
- {const} buf: pchar; buf_size: integer): integer;
- cdecl; external av__codec;
-
-{$IF LIBAVCODEC_VERSION >= 51030000} // 51.30.0
-(**
- * Decodes an audio frame from \p buf into \p samples.
- * The avcodec_decode_audio2() function decodes an audio frame from the input
- * buffer \p buf of size \p buf_size. To decode it, it makes use of the
- * audio codec which was coupled with \p avctx using avcodec_open(). The
- * resulting decoded frame is stored in output buffer \p samples. If no frame
- * could be decompressed, \p frame_size_ptr is zero. Otherwise, it is the
- * decompressed frame size in \e bytes.
- *
- * @warning You \e must set \p frame_size_ptr to the allocated size of the
- * output buffer before calling avcodec_decode_audio2().
- *
- * @warning The input buffer must be \c FF_INPUT_BUFFER_PADDING_SIZE larger than
- * the actual read bytes because some optimized bitstream readers read 32 or 64
- * bits at once and could read over the end.
- *
- * @warning The end of the input buffer \p buf should be set to 0 to ensure that
- * no overreading happens for damaged MPEG streams.
- *
- * @note You might have to align the input buffer \p buf and output buffer \p
- * samples. The alignment requirements depend on the CPU: On some CPUs it isn't
- * necessary at all, on others it won't work at all if not aligned and on others
- * it will work but it will have an impact on performance. In practice, the
- * bitstream should have 4 byte alignment at minimum and all sample data should
- * be 16 byte aligned unless the CPU doesn't need it (AltiVec and SSE do). If
- * the linesize is not a multiple of 16 then there's no sense in aligning the
- * start of the buffer to 16.
- *
- * @param avctx the codec context
- * @param[out] samples the output buffer
- * @param[in,out] frame_size_ptr the output buffer size in bytes
- * @param[in] buf the input buffer
- * @param[in] buf_size the input buffer size in bytes
- * @return On error a negative value is returned, otherwise the number of bytes
- * used or zero if no frame could be decompressed.
- *)
-function avcodec_decode_audio2(avctx : PAVCodecContext; samples : PSmallint;
- var frame_size_ptr : integer;
- {const} buf: pchar; buf_size: integer): integer;
- cdecl; external av__codec;
-{$IFEND}
-
-(**
- * Decodes a video frame from \p buf into \p picture.
- * The avcodec_decode_video() function decodes a video frame from the input
- * buffer \p buf of size \p buf_size. To decode it, it makes use of the
- * video codec which was coupled with \p avctx using avcodec_open(). The
- * resulting decoded frame is stored in \p picture.
- *
- * @warning The input buffer must be \c FF_INPUT_BUFFER_PADDING_SIZE larger than
- * the actual read bytes because some optimized bitstream readers read 32 or 64
- * bits at once and could read over the end.
- *
- * @warning The end of the input buffer \p buf should be set to 0 to ensure that
- * no overreading happens for damaged MPEG streams.
- *
- * @note You might have to align the input buffer \p buf and output buffer \p
- * samples. The alignment requirements depend on the CPU: on some CPUs it isn't
- * necessary at all, on others it won't work at all if not aligned and on others
- * it will work but it will have an impact on performance. In practice, the
- * bitstream should have 4 byte alignment at minimum and all sample data should
- * be 16 byte aligned unless the CPU doesn't need it (AltiVec and SSE do). If
- * the linesize is not a multiple of 16 then there's no sense in aligning the
- * start of the buffer to 16.
- *
- * @param avctx the codec context
- * @param[out] picture The AVFrame in which the decoded video frame will be stored.
- * @param[in] buf the input buffer
- * @param[in] buf_size the size of the input buffer in bytes
- * @param[in,out] got_picture_ptr Zero if no frame could be decompressed, otherwise, it is nonzero.
- * @return On error a negative value is returned, otherwise the number of bytes
- * used or zero if no frame could be decompressed.
- *)
-function avcodec_decode_video (avctx: PAVCodecContext; picture: PAVFrame;
- var got_picture_ptr: integer;
- {const} buf: PByte; buf_size: integer): integer;
- cdecl; external av__codec;
-
-(* Decode a subtitle message. Return -1 if error, otherwise return the
- * number of bytes used. If no subtitle could be decompressed,
- * got_sub_ptr is zero. Otherwise, the subtitle is stored in *sub. *)
-function avcodec_decode_subtitle (avctx: PAVCodecContext; sub: PAVSubtitle;
- var got_sub_ptr: integer;
- {const} buf: pchar; buf_size: integer): integer;
- cdecl; external av__codec;
-function avcodec_parse_frame (avctx: PAVCodecContext; pdata: PPointer;
- data_size_ptr: pinteger;
- buf: pchar; buf_size: integer): integer;
- cdecl; external av__codec;
-
-(**
- * Encodes an audio frame from \p samples into \p buf.
- * The avcodec_encode_audio() function encodes an audio frame from the input
- * buffer \p samples. To encode it, it makes use of the audio codec which was
- * coupled with \p avctx using avcodec_open(). The resulting encoded frame is
- * stored in output buffer \p buf.
- *
- * @note The output buffer should be at least \c FF_MIN_BUFFER_SIZE bytes large.
- *
- * @param avctx the codec context
- * @param[out] buf the output buffer
- * @param[in] buf_size the output buffer size
- * @param[in] samples the input buffer containing the samples
- * The number of samples read from this buffer is frame_size*channels,
- * both of which are defined in \p avctx.
- * @return On error a negative value is returned, on success zero or the number
- * of bytes used to encode the data read from the input buffer.
- *)
-function avcodec_encode_audio (avctx: PAVCodecContext; buf: PByte;
- buf_size: integer; {const} samples: PWord): integer;
- cdecl; external av__codec;
-
-(**
- * Encodes a video frame from \p pict into \p buf.
- * The avcodec_encode_video() function encodes a video frame from the input
- * \p pict. To encode it, it makes use of the video codec which was coupled with
- * \p avctx using avcodec_open(). The resulting encoded bytes representing the
- * frame are stored in the output buffer \p buf. The input picture should be
- * stored using a specific format, namely \c avctx.pix_fmt.
- *
- * @param avctx the codec context
- * @param[out] buf the output buffer for the bitstream of encoded frame
- * @param[in] buf_size the size of the output buffer in bytes
- * @param[in] pict the input picture to encode
- * @return On error a negative value is returned, on success zero or the number
- * of bytes used from the input buffer.
- *)
-function avcodec_encode_video (avctx: PAVCodecContext; buf: PByte;
- buf_size: integer; pict: PAVFrame): integer;
- cdecl; external av__codec;
-function avcodec_encode_subtitle (avctx: PAVCodecContext; buf: pchar;
- buf_size: integer; {const} sub: PAVSubtitle): integer;
- cdecl; external av__codec;
-
-function avcodec_close (avctx: PAVCodecContext): integer;
- cdecl; external av__codec;
-
-procedure avcodec_register_all ();
- cdecl; external av__codec;
-
-(**
- * Flush buffers, should be called when seeking or when switching to a different stream.
- *)
-procedure avcodec_flush_buffers (avctx: PAVCodecContext);
- cdecl; external av__codec;
-
-procedure avcodec_default_free_buffers (s: PAVCodecContext);
- cdecl; external av__codec;
-
-(* misc useful functions *)
-
-(**
- * Returns a single letter to describe the given picture type \p pict_type.
- *
- * @param[in] pict_type the picture type
- * @return A single character representing the picture type.
- *)
-function av_get_pict_type_char (pict_type: integer): char;
- cdecl; external av__codec;
-
-(**
- * Returns codec bits per sample.
- *
- * @param[in] codec_id the codec
- * @return Number of bits per sample or zero if unknown for the given codec.
- *)
-function av_get_bits_per_sample (codec_id: TCodecID): integer;
- cdecl; external av__codec;
-
-{$IF LIBAVCODEC_VERSION >= 51041000} // 51.41.0
-(**
- * Returns sample format bits per sample.
- *
- * @param[in] sample_fmt the sample format
- * @return Number of bits per sample or zero if unknown for the given sample format.
- *)
-function av_get_bits_per_sample_format(sample_fmt: TSampleFormat): integer;
- cdecl; external av__codec;
-{$IFEND}
-
-const
- AV_PARSER_PTS_NB = 4;
- PARSER_FLAG_COMPLETE_FRAMES = $0001;
-
-type
- {* frame parsing *}
- PAVCodecParserContext = ^TAVCodecParserContext;
- PAVCodecParser = ^TAVCodecParser;
-
- TAVCodecParserContext = record
- priv_data: pointer;
- parser: PAVCodecParser;
- frame_offset: int64; (* offset of the current frame *)
- cur_offset: int64; (* current offset (incremented by each av_parser_parse()) *)
- last_frame_offset: int64; (* offset of the last frame *)
- (* video info *)
- pict_type: integer; (* XXX: put it back in AVCodecContext *)
- repeat_pict: integer; (* XXX: put it back in AVCodecContext *)
- pts: int64; (* pts of the current frame *)
- dts: int64; (* dts of the current frame *)
-
- (* private data *)
- last_pts: int64;
- last_dts: int64;
- fetch_timestamp: integer;
-
- cur_frame_start_index: integer;
- cur_frame_offset: array [0..AV_PARSER_PTS_NB - 1] of int64;
- cur_frame_pts: array [0..AV_PARSER_PTS_NB - 1] of int64;
- cur_frame_dts: array [0..AV_PARSER_PTS_NB - 1] of int64;
-
- flags: integer;
-
- {$IF LIBAVCODEC_VERSION >= 51040003} // 51.40.3
- offset: int64; ///< byte offset from starting packet start
- last_offset: int64;
- {$IFEND}
- end;
-
- TAVCodecParser = record
- codec_ids: array [0..4] of integer; (* several codec IDs are permitted *)
- priv_data_size: integer;
- parser_init: function (s: PAVCodecParserContext): integer; cdecl;
- parser_parse: function (s: PAVCodecParserContext; avctx: PAVCodecContext;
- {const} poutbuf: PPointer; poutbuf_size: PInteger;
- {const} buf: pchar; buf_size: integer): integer; cdecl;
- parser_close: procedure (s: PAVCodecParserContext); cdecl;
- split: function (avctx: PAVCodecContext; {const} buf: pchar;
- buf_size: integer): integer; cdecl;
- next: PAVCodecParser;
- end;
-
-
-{$IF LIBAVCODEC_VERSION < 52000000} // 52.0.0
-{
-var
- av_first_parser: PAVCodecParser; external av__codec;
-}
-{$IFEND}
-
-{$IF LIBAVCODEC_VERSION >= 51049000} // 51.49.0
-function av_parser_next(c: PAVCodecParser): PAVCodecParser;
- cdecl; external av__codec;
-{$IFEND}
-
-procedure av_register_codec_parser (parser: PAVCodecParser);
- cdecl; external av__codec;
-
-function av_parser_init (codec_id: integer): PAVCodecParserContext;
- cdecl; external av__codec;
-
-function av_parser_parse (s: PAVCodecParserContext;
- avctx: PAVCodecContext;
- poutbuf: PPointer; poutbuf_size: pinteger;
- const buf: pchar; buf_size: integer;
- pts: int64; dts: int64): integer;
- cdecl; external av__codec;
-function av_parser_change (s: PAVCodecParserContext;
- avctx: PAVCodecContext;
- poutbuf: PPointer; poutbuf_size: PInteger;
- const buf: pchar; buf_size: integer; keyframe: integer): integer;
- cdecl; external av__codec;
-procedure av_parser_close (s: PAVCodecParserContext);
- cdecl; external av__codec;
-
-type
- PAVBitStreamFilterContext = ^TAVBitStreamFilterContext;
- PAVBitStreamFilter = ^TAVBitStreamFilter;
-
- TAVBitStreamFilterContext = record
- priv_data: pointer;
- filter: PAVBitStreamFilter;
- parser: PAVCodecParserContext;
- next: PAVBitStreamFilterContext;
- end;
-
- TAVBitStreamFilter = record
- name: pchar;
- priv_data_size: integer;
- filter: function (bsfc: PAVBitStreamFilterContext;
- avctx: PAVCodecContext; args: pchar;
- poutbuf: PPointer; poutbuf_size: PInteger;
- buf: PByte; buf_size: integer; keyframe: integer): integer; cdecl;
- {$IF LIBAVCODEC_VERSION >= 51043000} // 51.43.0
- close: procedure (bsfc: PAVBitStreamFilterContext);
- {$IFEND}
- next: PAVBitStreamFilter;
- end;
-
-procedure av_register_bitstream_filter (bsf: PAVBitStreamFilter);
- cdecl; external av__codec;
-
-function av_bitstream_filter_init (name: pchar): PAVBitStreamFilterContext;
- cdecl; external av__codec;
-
-function av_bitstream_filter_filter (bsfc: PAVBitStreamFilterContext;
- avctx: PAVCodecContext; args: pchar;
- poutbuf: PPointer; poutbuf_size: PInteger;
- buf: PByte; buf_size: integer; keyframe: integer): integer;
- cdecl; external av__codec;
-procedure av_bitstream_filter_close (bsf: PAVBitStreamFilterContext);
- cdecl; external av__codec;
-
-{$IF LIBAVCODEC_VERSION >= 51049000} // 51.49.0
-function av_bitstream_filter_next(f: PAVBitStreamFilter): PAVBitStreamFilter;
- cdecl; external av__codec;
-{$IFEND}
-
-(* memory *)
-
-(**
- * Reallocates the given block if it is not large enough, otherwise it
- * does nothing.
- *
- * @see av_realloc
- *)
-procedure av_fast_realloc (ptr: pointer; size: PCardinal; min_size: Cardinal);
- cdecl; external av__codec;
-
-(* for static data only *)
-
-(**
- * Frees all static arrays and resets their pointers to 0.
- * Call this function to release all statically allocated tables.
- *
- * @deprecated. Code which uses av_free_static is broken/misdesigned
- * and should correctly use static arrays
- *
- *)
-procedure av_free_static ();
- cdecl; external av__codec; deprecated;
-
-(**
- * Allocation of static arrays.
- *
- * @warning Do not use for normal allocation.
- *
- * @param[in] size The amount of memory you need in bytes.
- * @return block of memory of the requested size
- * @deprecated. Code which uses av_mallocz_static is broken/misdesigned
- * and should correctly use static arrays
- *)
-procedure av_mallocz_static(size: cardinal);
- cdecl; external av__codec; deprecated; {av_malloc_attrib av_alloc_size(1)}
-
-{$IF LIBAVCODEC_VERSION < 51035000} // 51.35.0
-procedure av_realloc_static(ptr: pointer; size: Cardinal);
- cdecl; external av__codec;
-{$IFEND}
-
-{$IF LIBAVCODEC_VERSION >= 51039000} // 51.39.0
-(**
- * Copy image 'src' to 'dst'.
- *)
-procedure av_picture_copy(dst: PAVPicture; {const} src: PAVPicture;
- pix_fmt: integer; width: integer; height: integer);
- cdecl; external av__codec;
-
-(**
- * Crop image top and left side.
- *)
-function av_picture_crop(dst: PAVPicture; {const} src: PAVPicture;
- pix_fmt: integer; top_band: integer; left_band: integer): integer;
- cdecl; external av__codec;
-
-(**
- * Pad image.
- *)
-function av_picture_pad(dst: PAVPicture; {const} src: PAVPicture; height: integer; width: integer; pix_fmt: integer;
- padtop: integer; padbottom: integer; padleft: integer; padright: integer; color: PInteger): integer;
- cdecl; external av__codec;
-{$IFEND}
-
-{$IF LIBAVCODEC_VERSION < 52000000} // 52.0.0
-(**
- * @deprecated Use the software scaler (swscale) instead.
- *)
-procedure img_copy (dst: PAVPicture; const src: PAVPicture;
- pix_fmt: TAVPixelFormat; width: integer; height: integer);
- cdecl; external av__codec; deprecated;
-
-(**
- * @deprecated Use the software scaler (swscale) instead.
- *)
-function img_crop (dst: PAVPicture; const src: PAVPicture;
- pix_fmt: TAVPixelFormat; top_band, left_band: integer): integer;
- cdecl; external av__codec; deprecated;
-
-(**
- * @deprecated Use the software scaler (swscale) instead.
- *)
-function img_pad (dst: PAVPicture; const src: PAVPicture; height, width: integer;
- pix_fmt: TAVPixelFormat; padtop, padbottom, padleft, padright: integer;
- color: PInteger): integer;
- cdecl; external av__codec; deprecated;
-{$IFEND}
-
-function av_xiphlacing(s: PByte; v: Cardinal): Cardinal;
- cdecl; external av__codec;
-
-{$IF LIBAVCODEC_VERSION >= 51041000} // 51.41.0
-(**
- * Parses \p str and put in \p width_ptr and \p height_ptr the detected values.
- *
- * @return 0 in case of a successful parsing, a negative value otherwise
- * @param[in] str the string to parse: it has to be a string in the format
- * <width>x<height> or a valid video frame size abbreviation.
- * @param[in,out] width_ptr pointer to the variable which will contain the detected
- * frame width value
- * @param[in,out] height_ptr pointer to the variable which will contain the detected
- * frame height value
- *)
-function av_parse_video_frame_size(width_ptr: PInteger; height_ptr: PInteger; {const} str: PChar): integer;
- cdecl; external av__codec;
-
-(**
- * Parses \p str and put in \p frame_rate the detected values.
- *
- * @return 0 in case of a successful parsing, a negative value otherwise
- * @param[in] str the string to parse: it has to be a string in the format
- * <frame_rate_nom>/<frame_rate_den>, a float number or a valid video rate abbreviation
- * @param[in,out] frame_rate pointer to the AVRational which will contain the detected
- * frame rate
- *)
-function av_parse_video_frame_rate(frame_rate: PAVRational; {const} str: PChar): integer;
- cdecl; external av__codec;
-{$IFEND}
-
-{* error handling *}
-
-const
-{$IFDEF UNIX}
- ENOENT = ESysENOENT;
- EIO = ESysEIO;
- ENOMEM = ESysENOMEM;
- EINVAL = ESysEINVAL;
- EDOM = ESysEDOM;
- ENOSYS = ESysENOSYS;
- EILSEQ = ESysEILSEQ;
-{$ELSE}
- ENOENT = 2;
- EIO = 5;
- ENOMEM = 12;
- EINVAL = 22;
- EDOM = 33;
- {$IFDEF MSWINDOWS}
- // Note: we assume that ffmpeg was compiled with MinGW.
- // This must be changed if DLLs were compiled with cygwin.
- ENOSYS = 40; // MSVC/MINGW: 40, CYGWIN: 88, LINUX/FPC: 38
- EILSEQ = 42; // MSVC/MINGW: 42, CYGWIN: 138, LINUX/FPC: 84
- {$ENDIF}
-{$ENDIF}
-
-const
-{$IF EINVAL > 0}
- AVERROR_SIGN = -1;
-{$ELSE}
- {* Some platforms have E* and errno already negated. *}
- AVERROR_SIGN = 1;
-{$IFEND}
-
-(*
-#if EINVAL > 0
-#define AVERROR(e) (-(e)) {**< Returns a negative error code from a POSIX error code, to return from library functions. *}
-#define AVUNERROR(e) (-(e)) {**< Returns a POSIX error code from a library function error return value. *}
-#else
-{* Some platforms have E* and errno already negated. *}
-#define AVERROR(e) (e)
-#define AVUNERROR(e) (e)
-#endif
-*)
-
-const
- AVERROR_UNKNOWN = AVERROR_SIGN * EINVAL; (**< unknown error *)
- AVERROR_IO = AVERROR_SIGN * EIO; (**< I/O error *)
- AVERROR_NUMEXPECTED = AVERROR_SIGN * EDOM; (**< Number syntax expected in filename. *)
- AVERROR_INVALIDDATA = AVERROR_SIGN * EINVAL; (**< invalid data found *)
- AVERROR_NOMEM = AVERROR_SIGN * ENOMEM; (**< not enough memory *)
- AVERROR_NOFMT = AVERROR_SIGN * EILSEQ; (**< unknown format *)
- AVERROR_NOTSUPP = AVERROR_SIGN * ENOSYS; (**< Operation not supported. *)
- AVERROR_NOENT = AVERROR_SIGN * ENOENT; {**< No such file or directory. *}
- // Note: function calls as constant-initializers are invalid
- //AVERROR_PATCHWELCOME = -MKTAG('P','A','W','E'); {**< Not yet implemented in FFmpeg. Patches welcome. *}
- AVERROR_PATCHWELCOME = -(ord('P') or (ord('A') shl 8) or (ord('W') shl 16) or (ord('E') shl 24));
-
-implementation
-
-end.
+(* + * copyright (c) 2001 Fabrice Bellard + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser 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 + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + *) + +(* This is a part of Pascal porting of ffmpeg. + * Originally by Victor Zinetz for Delphi and Free Pascal on Windows. + * For Mac OS X, some modifications were made by The Creative CAT, denoted as CAT + * in the source codes *) + +(* + * Min. version: 51.16.0 + * Max. version: 51.56.0, revision 13019, Tue Apr 29 14:08:01 2008 UTC + *) + +unit avcodec; + +{$IFDEF FPC} + {$MODE DELPHI } + {$PACKENUM 4} (* use 4-byte enums *) + {$PACKRECORDS C} (* C/C++-compatible record packing *) +{$ELSE} + {$MINENUMSIZE 4} (* use 4-byte enums *) +{$ENDIF} + +{$IFDEF DARWIN} + {$linklib libavcodec} +{$ENDIF} + +interface + +uses + avutil, + rational, + opt, + {$IFDEF UNIX} + BaseUnix, + {$ENDIF} + UConfig; + +const + (* Max. supported version by this header *) + LIBAVCODEC_MAX_VERSION_MAJOR = 51; + LIBAVCODEC_MAX_VERSION_MINOR = 56; + LIBAVCODEC_MAX_VERSION_RELEASE = 0; + LIBAVCODEC_MAX_VERSION = (LIBAVCODEC_MAX_VERSION_MAJOR * VERSION_MAJOR) + + (LIBAVCODEC_MAX_VERSION_MINOR * VERSION_MINOR) + + (LIBAVCODEC_MAX_VERSION_RELEASE * VERSION_RELEASE); + +(* Check if linked version is supported *) +{$IF (LIBAVCODEC_VERSION > LIBAVCODEC_MAX_VERSION)} + {$MESSAGE Warn 'Linked version of libavcodec may be unsupported!'} +{$IFEND} + +const + AV_NOPTS_VALUE: int64 = $8000000000000000; + AV_TIME_BASE = 1000000; + AV_TIME_BASE_Q : TAVRational = (num:1; den:AV_TIME_BASE); (* added by CAT *) + +(** + * Identifies the syntax and semantics of the bitstream. + * The principle is roughly: + * Two decoders with the same ID can decode the same streams. + * Two encoders with the same ID can encode compatible streams. + * There may be slight deviations from the principle due to implementation + * details. + * + * If you add a codec ID to this list, add it so that + * 1. no value of a existing codec ID changes (that would break ABI), + * 2. it is as close as possible to similar codecs. + *) +type + TCodecID = ( + CODEC_ID_NONE, + + (* video codecs *) + CODEC_ID_MPEG1VIDEO, + CODEC_ID_MPEG2VIDEO, //* prefered ID for MPEG Video 1/2 decoding */ + CODEC_ID_MPEG2VIDEO_XVMC, + CODEC_ID_H261, + CODEC_ID_H263, + CODEC_ID_RV10, + CODEC_ID_RV20, + CODEC_ID_MJPEG, + CODEC_ID_MJPEGB, + CODEC_ID_LJPEG, + CODEC_ID_SP5X, + CODEC_ID_JPEGLS, + CODEC_ID_MPEG4, + CODEC_ID_RAWVIDEO, + CODEC_ID_MSMPEG4V1, + CODEC_ID_MSMPEG4V2, + CODEC_ID_MSMPEG4V3, + CODEC_ID_WMV1, + CODEC_ID_WMV2, + CODEC_ID_H263P, + CODEC_ID_H263I, + CODEC_ID_FLV1, + CODEC_ID_SVQ1, + CODEC_ID_SVQ3, + CODEC_ID_DVVIDEO, + CODEC_ID_HUFFYUV, + CODEC_ID_CYUV, + CODEC_ID_H264, + CODEC_ID_INDEO3, + CODEC_ID_VP3, + CODEC_ID_THEORA, + CODEC_ID_ASV1, + CODEC_ID_ASV2, + CODEC_ID_FFV1, + CODEC_ID_4XM, + CODEC_ID_VCR1, + CODEC_ID_CLJR, + CODEC_ID_MDEC, + CODEC_ID_ROQ, + CODEC_ID_INTERPLAY_VIDEO, + CODEC_ID_XAN_WC3, + CODEC_ID_XAN_WC4, + CODEC_ID_RPZA, + CODEC_ID_CINEPAK, + CODEC_ID_WS_VQA, + CODEC_ID_MSRLE, + CODEC_ID_MSVIDEO1, + CODEC_ID_IDCIN, + CODEC_ID_8BPS, + CODEC_ID_SMC, + CODEC_ID_FLIC, + CODEC_ID_TRUEMOTION1, + CODEC_ID_VMDVIDEO, + CODEC_ID_MSZH, + CODEC_ID_ZLIB, + CODEC_ID_QTRLE, + CODEC_ID_SNOW, + CODEC_ID_TSCC, + CODEC_ID_ULTI, + CODEC_ID_QDRAW, + CODEC_ID_VIXL, + CODEC_ID_QPEG, + CODEC_ID_XVID, + CODEC_ID_PNG, + CODEC_ID_PPM, + CODEC_ID_PBM, + CODEC_ID_PGM, + CODEC_ID_PGMYUV, + CODEC_ID_PAM, + CODEC_ID_FFVHUFF, + CODEC_ID_RV30, + CODEC_ID_RV40, + CODEC_ID_VC1, + CODEC_ID_WMV3, + CODEC_ID_LOCO, + CODEC_ID_WNV1, + CODEC_ID_AASC, + CODEC_ID_INDEO2, + CODEC_ID_FRAPS, + CODEC_ID_TRUEMOTION2, + CODEC_ID_BMP, + CODEC_ID_CSCD, + CODEC_ID_MMVIDEO, + CODEC_ID_ZMBV, + CODEC_ID_AVS, + CODEC_ID_SMACKVIDEO, + CODEC_ID_NUV, + CODEC_ID_KMVC, + CODEC_ID_FLASHSV, + CODEC_ID_CAVS, + CODEC_ID_JPEG2000, + CODEC_ID_VMNC, + CODEC_ID_VP5, + CODEC_ID_VP6, + CODEC_ID_VP6F, + CODEC_ID_TARGA, + CODEC_ID_DSICINVIDEO, + CODEC_ID_TIERTEXSEQVIDEO, + CODEC_ID_TIFF, + CODEC_ID_GIF, + CODEC_ID_FFH264, + CODEC_ID_DXA, + CODEC_ID_DNXHD, + CODEC_ID_THP, + CODEC_ID_SGI, + CODEC_ID_C93, + CODEC_ID_BETHSOFTVID, + CODEC_ID_PTX, + CODEC_ID_TXD, + CODEC_ID_VP6A, + CODEC_ID_AMV, + CODEC_ID_VB, + CODEC_ID_PCX, + CODEC_ID_SUNRAST, + CODEC_ID_INDEO4, + CODEC_ID_INDEO5, + CODEC_ID_MIMIC, + CODEC_ID_RL2, + CODEC_ID_8SVX_EXP, + CODEC_ID_8SVX_FIB, + CODEC_ID_ESCAPE124, + CODEC_ID_DIRAC, + CODEC_ID_BFI, + + //* various PCM "codecs" */ + CODEC_ID_PCM_S16LE= $10000, + CODEC_ID_PCM_S16BE, + CODEC_ID_PCM_U16LE, + CODEC_ID_PCM_U16BE, + CODEC_ID_PCM_S8, + CODEC_ID_PCM_U8, + CODEC_ID_PCM_MULAW, + CODEC_ID_PCM_ALAW, + CODEC_ID_PCM_S32LE, + CODEC_ID_PCM_S32BE, + CODEC_ID_PCM_U32LE, + CODEC_ID_PCM_U32BE, + CODEC_ID_PCM_S24LE, + CODEC_ID_PCM_S24BE, + CODEC_ID_PCM_U24LE, + CODEC_ID_PCM_U24BE, + CODEC_ID_PCM_S24DAUD, + CODEC_ID_PCM_ZORK, + CODEC_ID_PCM_S16LE_PLANAR, + + //* various ADPCM codecs */ + CODEC_ID_ADPCM_IMA_QT= $11000, + CODEC_ID_ADPCM_IMA_WAV, + CODEC_ID_ADPCM_IMA_DK3, + CODEC_ID_ADPCM_IMA_DK4, + CODEC_ID_ADPCM_IMA_WS, + CODEC_ID_ADPCM_IMA_SMJPEG, + CODEC_ID_ADPCM_MS, + CODEC_ID_ADPCM_4XM, + CODEC_ID_ADPCM_XA, + CODEC_ID_ADPCM_ADX, + CODEC_ID_ADPCM_EA, + CODEC_ID_ADPCM_G726, + CODEC_ID_ADPCM_CT, + CODEC_ID_ADPCM_SWF, + CODEC_ID_ADPCM_YAMAHA, + CODEC_ID_ADPCM_SBPRO_4, + CODEC_ID_ADPCM_SBPRO_3, + CODEC_ID_ADPCM_SBPRO_2, + CODEC_ID_ADPCM_THP, + CODEC_ID_ADPCM_IMA_AMV, + CODEC_ID_ADPCM_EA_R1, + CODEC_ID_ADPCM_EA_R3, + CODEC_ID_ADPCM_EA_R2, + CODEC_ID_ADPCM_IMA_EA_SEAD, + CODEC_ID_ADPCM_IMA_EA_EACS, + CODEC_ID_ADPCM_EA_XAS, + CODEC_ID_ADPCM_EA_MAXIS_XA, + + //* AMR */ + CODEC_ID_AMR_NB= $12000, + CODEC_ID_AMR_WB, + + //* RealAudio codecs*/ + CODEC_ID_RA_144= $13000, + CODEC_ID_RA_288, + + //* various DPCM codecs */ + CODEC_ID_ROQ_DPCM= $14000, + CODEC_ID_INTERPLAY_DPCM, + CODEC_ID_XAN_DPCM, + CODEC_ID_SOL_DPCM, + + (* audio codecs *) + CODEC_ID_MP2= $15000, + CODEC_ID_MP3, ///< preferred ID for decoding MPEG audio layer 1, 2 or 3 + CODEC_ID_AAC, + {$IF LIBAVCODEC_VERSION < 52000000} // 52.0.0 + _CODEC_ID_MPEG4AAC, // will be redefined to CODEC_ID_AAC below + {$IFEND} + CODEC_ID_AC3, + CODEC_ID_DTS, + CODEC_ID_VORBIS, + CODEC_ID_DVAUDIO, + CODEC_ID_WMAV1, + CODEC_ID_WMAV2, + CODEC_ID_MACE3, + CODEC_ID_MACE6, + CODEC_ID_VMDAUDIO, + CODEC_ID_SONIC, + CODEC_ID_SONIC_LS, + CODEC_ID_FLAC, + CODEC_ID_MP3ADU, + CODEC_ID_MP3ON4, + CODEC_ID_SHORTEN, + CODEC_ID_ALAC, + CODEC_ID_WESTWOOD_SND1, + CODEC_ID_GSM, ///< as in Berlin toast format + CODEC_ID_QDM2, + CODEC_ID_COOK, + CODEC_ID_TRUESPEECH, + CODEC_ID_TTA, + CODEC_ID_SMACKAUDIO, + CODEC_ID_QCELP, + CODEC_ID_WAVPACK, + CODEC_ID_DSICINAUDIO, + CODEC_ID_IMC, + CODEC_ID_MUSEPACK7, + CODEC_ID_MLP, + CODEC_ID_GSM_MS, { as found in WAV } + CODEC_ID_ATRAC3, + CODEC_ID_VOXWARE, + CODEC_ID_APE, + CODEC_ID_NELLYMOSER, + CODEC_ID_MUSEPACK8, + CODEC_ID_SPEEX, + CODEC_ID_WMAVOICE, + CODEC_ID_WMAPRO, + CODEC_ID_WMALOSSLESS, + + //* subtitle codecs */ + CODEC_ID_DVD_SUBTITLE= $17000, + CODEC_ID_DVB_SUBTITLE, + CODEC_ID_TEXT, ///< raw UTF-8 text + CODEC_ID_XSUB, + CODEC_ID_SSA, + CODEC_ID_MOV_TEXT, + + (* other specific kind of codecs (generally used for attachments) *) + CODEC_ID_TTF= $18000, + + CODEC_ID_MPEG2TS= $20000, {*< _FAKE_ codec to indicate a raw MPEG-2 TS + * stream (only used by libavformat) *} + __CODEC_ID_4BYTE = $FFFFF // ensure 4-byte enum + ); + +{$IF LIBAVCODEC_VERSION < 52000000} // 52.0.0 +{* CODEC_ID_MP3LAME is obsolete *} +const + CODEC_ID_MP3LAME = CODEC_ID_MP3; + CODEC_ID_MPEG4AAC = CODEC_ID_AAC; +{$IFEND} + +type + TCodecType = ( + CODEC_TYPE_UNKNOWN = -1, + CODEC_TYPE_VIDEO, + CODEC_TYPE_AUDIO, + CODEC_TYPE_DATA, + CODEC_TYPE_SUBTITLE, + CODEC_TYPE_ATTACHMENT, + CODEC_TYPE_NB + ); + +{** + * currently unused, may be used if 24/32 bits samples ever supported */ + * all in native endian + *} +type + TSampleFormat = ( + SAMPLE_FMT_NONE = -1, + SAMPLE_FMT_U8, ///< unsigned 8 bits + SAMPLE_FMT_S16, ///< signed 16 bits + SAMPLE_FMT_S24, ///< signed 24 bits + SAMPLE_FMT_S32, ///< signed 32 bits + SAMPLE_FMT_FLT ///< float + ); + +const + {* in bytes *} + AVCODEC_MAX_AUDIO_FRAME_SIZE = 192000; // 1 second of 48khz 32bit audio + +{** + * Required number of additionally allocated bytes at the end of the input bitstream for decoding. + * This is mainly needed because some optimized bitstream readers read + * 32 or 64 bit at once and could read over the end.<br> + * Note: If the first 23 bits of the additional bytes are not 0, then damaged + * MPEG bitstreams could cause overread and segfault. + *} + FF_INPUT_BUFFER_PADDING_SIZE = 8; + +{** + * minimum encoding buffer size. + * Used to avoid some checks during header writing. + *} + FF_MIN_BUFFER_SIZE = 16384; + +type +{* + * motion estimation type. + *} + TMotion_Est_ID = ( + ME_ZERO = 1, ///< no search, that is use 0,0 vector whenever one is needed + ME_FULL, + ME_LOG, + ME_PHODS, + ME_EPZS, ///< enhanced predictive zonal search + ME_X1, ///< reserved for experiments + ME_HEX, ///< hexagon based search + ME_UMH, ///< uneven multi-hexagon search + ME_ITER ///< iterative search + ); + + TAVDiscard = ( + {* We leave some space between them for extensions (drop some + * keyframes for intra-only or drop just some bidir frames). *} + AVDISCARD_NONE =-16, ///< discard nothing + AVDISCARD_DEFAULT= 0, ///< discard useless packets like 0 size packets in avi + AVDISCARD_NONREF = 8, ///< discard all non reference + AVDISCARD_BIDIR = 16, ///< discard all bidirectional frames + AVDISCARD_NONKEY = 32, ///< discard all frames except keyframes + AVDISCARD_ALL = 48 ///< discard all + ); + + PRcOverride = ^TRcOverride; + TRcOverride = record {16} + start_frame: integer; + end_frame: integer; + qscale: integer; // if this is 0 then quality_factor will be used instead + quality_factor: single; + end; + +const + FF_MAX_B_FRAMES = 16; + +{* encoding support + These flags can be passed in AVCodecContext.flags before initialization. + Note: Not everything is supported yet. +*} + + CODEC_FLAG_QSCALE = $0002; ///< Use fixed qscale. + CODEC_FLAG_4MV = $0004; ///< 4 MV per MB allowed / advanced prediction for H263. + CODEC_FLAG_QPEL = $0010; ///< use qpel MC. + CODEC_FLAG_GMC = $0020; ///< use GMC. + CODEC_FLAG_MV0 = $0040; ///< always try a MB with MV=<0,0>. + CODEC_FLAG_PART = $0080; ///< Use data partitioning. + {** + * The parent program guarantees that the input for B-frames containing + * streams is not written to for at least s->max_b_frames+1 frames, if + * this is not set the input will be copied. + *} + CODEC_FLAG_INPUT_PRESERVED = $0100; + CODEC_FLAG_PASS1 = $0200; ///< use internal 2pass ratecontrol in first pass mode + CODEC_FLAG_PASS2 = $0400; ///< use internal 2pass ratecontrol in second pass mode + CODEC_FLAG_EXTERN_HUFF = $1000; ///< use external huffman table (for mjpeg) + CODEC_FLAG_GRAY = $2000; ///< only decode/encode grayscale + CODEC_FLAG_EMU_EDGE = $4000; ///< don't draw edges + CODEC_FLAG_PSNR = $8000; ///< error[?] variables will be set during encoding + CODEC_FLAG_TRUNCATED = $00010000; //** input bitstream might be truncated at a random location instead + // of only at frame boundaries */ + CODEC_FLAG_NORMALIZE_AQP = $00020000; ///< normalize adaptive quantization + CODEC_FLAG_INTERLACED_DCT = $00040000; ///< use interlaced dct + CODEC_FLAG_LOW_DELAY = $00080000; ///< force low delay + CODEC_FLAG_ALT_SCAN = $00100000; ///< use alternate scan + CODEC_FLAG_TRELLIS_QUANT = $00200000; ///< use trellis quantization + CODEC_FLAG_GLOBAL_HEADER = $00400000; ///< place global headers in extradata instead of every keyframe + CODEC_FLAG_BITEXACT = $00800000; ///< use only bitexact stuff (except (i)dct) + {* Fx : Flag for h263+ extra options *} + {$IF LIBAVCODEC_VERSION < 52000000} // 52.0.0 + CODEC_FLAG_H263P_AIC = $01000000; ///< H263 Advanced intra coding / MPEG4 AC prediction (remove this) + {$IFEND} + CODEC_FLAG_AC_PRED = $01000000; ///< H263 Advanced intra coding / MPEG4 AC prediction + CODEC_FLAG_H263P_UMV = $02000000; ///< Unlimited motion vector + CODEC_FLAG_CBP_RD = $04000000; ///< use rate distortion optimization for cbp + CODEC_FLAG_QP_RD = $08000000; ///< use rate distortion optimization for qp selectioon + CODEC_FLAG_H263P_AIV = $00000008; ///< H263 Alternative inter vlc + CODEC_FLAG_OBMC = $00000001; ///< OBMC + CODEC_FLAG_LOOP_FILTER = $00000800; ///< loop filter + CODEC_FLAG_H263P_SLICE_STRUCT = $10000000; + CODEC_FLAG_INTERLACED_ME = $20000000; ///< interlaced motion estimation + CODEC_FLAG_SVCD_SCAN_OFFSET = $40000000; ///< will reserve space for SVCD scan offset user data + CODEC_FLAG_CLOSED_GOP = $80000000; + CODEC_FLAG2_FAST = $00000001; ///< allow non spec compliant speedup tricks + CODEC_FLAG2_STRICT_GOP = $00000002; ///< strictly enforce GOP size + CODEC_FLAG2_NO_OUTPUT = $00000004; ///< skip bitstream encoding + CODEC_FLAG2_LOCAL_HEADER = $00000008; ///< place global headers at every keyframe instead of in extradata + CODEC_FLAG2_BPYRAMID = $00000010; ///< H.264 allow b-frames to be used as references + CODEC_FLAG2_WPRED = $00000020; ///< H.264 weighted biprediction for b-frames + CODEC_FLAG2_MIXED_REFS = $00000040; ///< H.264 multiple references per partition + CODEC_FLAG2_8X8DCT = $00000080; ///< H.264 high profile 8x8 transform + CODEC_FLAG2_FASTPSKIP = $00000100; ///< H.264 fast pskip + CODEC_FLAG2_AUD = $00000200; ///< H.264 access unit delimiters + CODEC_FLAG2_BRDO = $00000400; ///< b-frame rate-distortion optimization + CODEC_FLAG2_INTRA_VLC = $00000800; ///< use MPEG-2 intra VLC table + CODEC_FLAG2_MEMC_ONLY = $00001000; ///< only do ME/MC (I frames -> ref, P frame -> ME+MC) + CODEC_FLAG2_DROP_FRAME_TIMECODE = $00002000; ///< timecode is in drop frame format. + CODEC_FLAG2_SKIP_RD = $00004000; ///< RD optimal MB level residual skipping + CODEC_FLAG2_CHUNKS = $00008000; ///< Input bitstream might be truncated at a packet boundaries instead of only at frame boundaries. + CODEC_FLAG2_NON_LINEAR_QUANT = $00010000; ///< Use MPEG-2 nonlinear quantizer. + CODEC_FLAG2_BIT_RESERVOIR = $00020000; ///< Use a bit reservoir when encoding if possible + +(* Unsupported options : + * Syntax Arithmetic coding (SAC) + * Reference Picture Selection + * Independant Segment Decoding *) +(* /Fx *) +(* codec capabilities *) + +const + CODEC_CAP_DRAW_HORIZ_BAND = $0001; ///< decoder can use draw_horiz_band callback + (** + * Codec uses get_buffer() for allocating buffers. + * direct rendering method 1 + *) + CODEC_CAP_DR1 = $0002; + (* if 'parse_only' field is true, then avcodec_parse_frame() can be used *) + CODEC_CAP_PARSE_ONLY = $0004; + CODEC_CAP_TRUNCATED = $0008; + (* codec can export data for HW decoding (XvMC) *) + CODEC_CAP_HWACCEL = $0010; + (** + * codec has a non zero delay and needs to be feeded with NULL at the end to get the delayed data. + * if this is not set, the codec is guranteed to never be feeded with NULL data + *) + CODEC_CAP_DELAY = $0020; + (** + * Codec can be fed a final frame with a smaller size. + * This can be used to prevent truncation of the last audio samples. + *) + CODEC_CAP_SMALL_LAST_FRAME = $0040; + + //the following defines may change, don't expect compatibility if you use them + MB_TYPE_INTRA4x4 = $001; + MB_TYPE_INTRA16x16 = $002; //FIXME h264 specific + MB_TYPE_INTRA_PCM = $004; //FIXME h264 specific + MB_TYPE_16x16 = $008; + MB_TYPE_16x8 = $010; + MB_TYPE_8x16 = $020; + MB_TYPE_8x8 = $040; + MB_TYPE_INTERLACED = $080; + MB_TYPE_DIRECT2 = $100; //FIXME + MB_TYPE_ACPRED = $200; + MB_TYPE_GMC = $400; + MB_TYPE_SKIP = $800; + MB_TYPE_P0L0 = $1000; + MB_TYPE_P1L0 = $2000; + MB_TYPE_P0L1 = $4000; + MB_TYPE_P1L1 = $8000; + MB_TYPE_L0 = (MB_TYPE_P0L0 or MB_TYPE_P1L0); + MB_TYPE_L1 = (MB_TYPE_P0L1 or MB_TYPE_P1L1); + MB_TYPE_L0L1 = (MB_TYPE_L0 or MB_TYPE_L1); + MB_TYPE_QUANT = $0010000; + MB_TYPE_CBP = $0020000; + //Note bits 24-31 are reserved for codec specific use (h264 ref0, mpeg1 0mv, ...) + +type +(** + * Pan Scan area. + * This specifies the area which should be displayed. + * Note there may be multiple such areas for one frame. + *) + PAVPanScan = ^TAVPanScan; + TAVPanScan = record {24} + (*** id. + * - encoding: set by user. + * - decoding: set by libavcodec. *) + id: integer; + + (*** width and height in 1/16 pel + * - encoding: set by user. + * - decoding: set by libavcodec. *) + width: integer; + height: integer; + + (*** position of the top left corner in 1/16 pel for up to 3 fields/frames. + * - encoding: set by user. + * - decoding: set by libavcodec. *) + position: array [0..2] of array [0..1] of smallint; + end; + +const + FF_QSCALE_TYPE_MPEG1 = 0; + FF_QSCALE_TYPE_MPEG2 = 1; + FF_QSCALE_TYPE_H264 = 2; + + FF_BUFFER_TYPE_INTERNAL = 1; + FF_BUFFER_TYPE_USER = 2; ///< Direct rendering buffers (image is (de)allocated by user) + FF_BUFFER_TYPE_SHARED = 4; ///< buffer from somewhere else, don't dealloc image (data/base), all other tables are not shared + FF_BUFFER_TYPE_COPY = 8; ///< just a (modified) copy of some other buffer, don't dealloc anything. + + + FF_I_TYPE = 1; ///< Intra + FF_P_TYPE = 2; ///< Predicted + FF_B_TYPE = 3; ///< Bi-dir predicted + FF_S_TYPE = 4; ///< S(GMC)-VOP MPEG4 + FF_SI_TYPE = 5; ///< Switching Intra + FF_SP_TYPE = 6; ///< Switching Predicted + FF_BI_TYPE = 7; + + FF_BUFFER_HINTS_VALID = $01; // Buffer hints value is meaningful (if 0 ignore) + FF_BUFFER_HINTS_READABLE = $02; // Codec will read from buffer + FF_BUFFER_HINTS_PRESERVE = $04; // User must not alter buffer content + FF_BUFFER_HINTS_REUSABLE = $08; // Codec will reuse the buffer (update) + +type + {** + * Audio Video Frame. + * New fields can be added to the end of FF_COMMON_FRAME with minor version + * bumps. + * Removal, reordering and changes to existing fields require a major + * version bump. No fields should be added into AVFrame before or after + * FF_COMMON_FRAME! + * sizeof(AVFrame) must not be used outside libav*. + *} + PAVFrame = ^TAVFrame; + TAVFrame = record {200} + (** + * pointer to the picture planes. + * This might be different from the first allocated byte + * - encoding: + * - decoding: + *) + data: array [0..3] of pbyte; + linesize: array [0..3] of integer; + (** + * pointer to the first allocated byte of the picture. Can be used in get_buffer/release_buffer. + * This isn't used by libavcodec unless the default get/release_buffer() is used. + * - encoding: + * - decoding: + *) + base: array [0..3] of pbyte; + (** + * 1 -> keyframe, 0-> not + * - encoding: Set by libavcodec. + * - decoding: Set by libavcodec. + *) + key_frame: integer; + (** + * Picture type of the frame, see ?_TYPE below. + * - encoding: Set by libavcodec. for coded_picture (and set by user for input). + * - decoding: Set by libavcodec. + *) + pict_type: integer; + (** + * presentation timestamp in time_base units (time when frame should be shown to user) + * If AV_NOPTS_VALUE then frame_rate = 1/time_base will be assumed. + * - encoding: MUST be set by user. + * - decoding: Set by libavcodec. + *) + pts: int64; + (**\ + * picture number in bitstream order + * - encoding: set by + * - decoding: Set by libavcodec. + *) + coded_picture_number: integer; + (** + * picture number in display order + * - encoding: set by + * - decoding: Set by libavcodec. + *) + display_picture_number: integer; + (** + * quality (between 1 (good) and FF_LAMBDA_MAX (bad)) + * - encoding: Set by libavcodec. for coded_picture (and set by user for input). + * - decoding: Set by libavcodec. + *) + quality: integer; + (** + * buffer age (1->was last buffer and dint change, 2->..., ...). + * Set to INT_MAX if the buffer has not been used yet. + * - encoding: unused + * - decoding: MUST be set by get_buffer(). + *) + age: integer; + (** + * is this picture used as reference + * The values for this are the same as the MpegEncContext.picture_structure + * variable, that is 1->top field, 2->bottom field, 3->frame/both fields. + * - encoding: unused + * - decoding: Set by libavcodec. (before get_buffer() call)). + *) + reference: integer; + (** + * QP table + * - encoding: unused + * - decoding: Set by libavcodec. + *) + qscale_table: PShortint; + (** + * QP store stride + * - encoding: unused + * - decoding: Set by libavcodec. + *) + qstride: integer; + (** + * mbskip_table[mb]>=1 if MB didn't change + * stride= mb_width = (width+15)>>4 + * - encoding: unused + * - decoding: Set by libavcodec. + *) + mbskip_table: pbyte; + (** + * motion vector table + * @code + * example: + * int mv_sample_log2= 4 - motion_subsample_log2; + * int mb_width= (width+15)>>4; + * int mv_stride= (mb_width << mv_sample_log2) + 1; + * motion_val[direction][x + y*mv_stride][0->mv_x, 1->mv_y]; + * @endcode + * - encoding: Set by user. + * - decoding: Set by libavcodec. + *) + //int16_t (*motion_val[2])[2]; + motion_val: array [0..1] of pointer; + (** + * macroblock type table + * mb_type_base + mb_width + 2 + * - encoding: Set by user. + * - decoding: Set by libavcodec. + *) + mb_type: PCardinal; + (** + * log2 of the size of the block which a single vector in motion_val represents: + * (4->16x16, 3->8x8, 2-> 4x4, 1-> 2x2) + * - encoding: unused + * - decoding: Set by libavcodec. + *) + motion_subsample_log2: byte; + (** + * for some private data of the user + * - encoding: unused + * - decoding: Set by user. + *) + opaque: pointer; + (** + * error + * - encoding: Set by libavcodec. if flags&CODEC_FLAG_PSNR. + * - decoding: unused + *) + error: array [0..3] of uint64; + (** + * type of the buffer (to keep track of who has to deallocate data[*]) + * - encoding: Set by the one who allocates it. + * - decoding: Set by the one who allocates it. + * Note: User allocated (direct rendering) & internal buffers cannot coexist currently. + *) + type_: integer; + (** + * When decoding, this signals how much the picture must be delayed. + * extra_delay = repeat_pict / (2*fps) + * - encoding: unused + * - decoding: Set by libavcodec. + *) + repeat_pict: integer; + (** + * + *) + qscale_type: integer; + (** + * The content of the picture is interlaced. + * - encoding: Set by user. + * - decoding: Set by libavcodec. (default 0) + *) + interlaced_frame: integer; + (** + * If the content is interlaced, is top field displayed first. + * - encoding: Set by user. + * - decoding: Set by libavcodec. + *) + top_field_first: integer; + (** + * Pan scan. + * - encoding: Set by user. + * - decoding: Set by libavcodec. + *) + pan_scan: PAVPanScan; + (** + * Tell user application that palette has changed from previous frame. + * - encoding: ??? (no palette-enabled encoder yet) + * - decoding: Set by libavcodec. (default 0). + *) + palette_has_changed: integer; + (** + * codec suggestion on buffer type if != 0 + * - encoding: unused + * - decoding: Set by libavcodec. (before get_buffer() call)). + *) + buffer_hints: integer; + (** + * DCT coefficients + * - encoding: unused + * - decoding: Set by libavcodec. + *) + dct_coeff: PsmallInt; + (** + * motion referece frame index + * - encoding: Set by user. + * - decoding: Set by libavcodec. + *) + ref_index: array [0..1] of PShortint; + end; + +const + DEFAULT_FRAME_RATE_BASE = 1001000; + + FF_ASPECT_EXTENDED = 15; + + FF_RC_STRATEGY_XVID = 1; + + FF_BUG_AUTODETECT = 1; ///< autodetection + FF_BUG_OLD_MSMPEG4 = 2; + FF_BUG_XVID_ILACE = 4; + FF_BUG_UMP4 = 8; + FF_BUG_NO_PADDING = 16; + FF_BUG_AMV = 32; + FF_BUG_AC_VLC = 0; ///< will be removed, libavcodec can now handle these non compliant files by default + FF_BUG_QPEL_CHROMA = 64; + FF_BUG_STD_QPEL = 128; + FF_BUG_QPEL_CHROMA2 = 256; + FF_BUG_DIRECT_BLOCKSIZE = 512; + FF_BUG_EDGE = 1024; + FF_BUG_HPEL_CHROMA = 2048; + FF_BUG_DC_CLIP = 4096; + FF_BUG_MS = 8192; ///< workaround various bugs in microsofts broken decoders + //FF_BUG_FAKE_SCALABILITY = 16 //Autodetection should work 100%. + + FF_COMPLIANCE_VERY_STRICT = 2; ///< strictly conform to a older more strict version of the spec or reference software + FF_COMPLIANCE_STRICT = 1; ///< strictly conform to all the things in the spec no matter what consequences + FF_COMPLIANCE_NORMAL = 0; + FF_COMPLIANCE_INOFFICIAL = -1; ///< allow inofficial extensions + FF_COMPLIANCE_EXPERIMENTAL = -2; ///< allow non standarized experimental things + + FF_ER_CAREFUL = 1; + FF_ER_COMPLIANT = 2; + FF_ER_AGGRESSIVE = 3; + FF_ER_VERY_AGGRESSIVE = 4; + + FF_DCT_AUTO = 0; + FF_DCT_FASTINT = 1; + FF_DCT_INT = 2; + FF_DCT_MMX = 3; + FF_DCT_MLIB = 4; + FF_DCT_ALTIVEC = 5; + FF_DCT_FAAN = 6; + + FF_IDCT_AUTO = 0; + FF_IDCT_INT = 1; + FF_IDCT_SIMPLE = 2; + FF_IDCT_SIMPLEMMX = 3; + FF_IDCT_LIBMPEG2MMX = 4; + FF_IDCT_PS2 = 5; + FF_IDCT_MLIB = 6; + FF_IDCT_ARM = 7; + FF_IDCT_ALTIVEC = 8; + FF_IDCT_SH4 = 9; + FF_IDCT_SIMPLEARM = 10; + FF_IDCT_H264 = 11; + FF_IDCT_VP3 = 12; + FF_IDCT_IPP = 13; + FF_IDCT_XVIDMMX = 14; + FF_IDCT_CAVS = 15; + FF_IDCT_SIMPLEARMV5TE= 16; + FF_IDCT_SIMPLEARMV6 = 17; + FF_IDCT_SIMPLEVIS = 18; + FF_IDCT_WMV2 = 19; + FF_IDCT_FAAN = 20; + + FF_EC_GUESS_MVS = 1; + FF_EC_DEBLOCK = 2; + + FF_MM_FORCE = $80000000; (* force usage of selected flags (OR) *) + (* lower 16 bits - CPU features *) + FF_MM_MMX = $0001; ///< standard MMX + FF_MM_3DNOW = $0004; ///< AMD 3DNOW + FF_MM_MMXEXT = $0002; ///< SSE integer functions or AMD MMX ext + FF_MM_SSE = $0008; ///< SSE functions + FF_MM_SSE2 = $0010; ///< PIV SSE2 functions + FF_MM_3DNOWEXT = $0020; ///< AMD 3DNowExt + FF_MM_SSE3 = $0040; ///< Prescott SSE3 functions + FF_MM_SSSE3 = $0080; ///< Conroe SSSE3 functions + FF_MM_IWMMXT = $0100; ///< XScale IWMMXT + + FF_PRED_LEFT = 0; + FF_PRED_PLANE = 1; + FF_PRED_MEDIAN = 2; + + FF_DEBUG_PICT_INFO = 1; + FF_DEBUG_RC = 2; + FF_DEBUG_BITSTREAM = 4; + FF_DEBUG_MB_TYPE = 8; + FF_DEBUG_QP = 16; + FF_DEBUG_MV = 32; + FF_DEBUG_DCT_COEFF = $00000040; + FF_DEBUG_SKIP = $00000080; + FF_DEBUG_STARTCODE = $00000100; + FF_DEBUG_PTS = $00000200; + FF_DEBUG_ER = $00000400; + FF_DEBUG_MMCO = $00000800; + FF_DEBUG_BUGS = $00001000; + FF_DEBUG_VIS_QP = $00002000; + FF_DEBUG_VIS_MB_TYPE = $00004000; + + FF_DEBUG_VIS_MV_P_FOR = $00000001; //visualize forward predicted MVs of P frames + FF_DEBUG_VIS_MV_B_FOR = $00000002; //visualize forward predicted MVs of B frames + FF_DEBUG_VIS_MV_B_BACK = $00000004; //visualize backward predicted MVs of B frames + + FF_CMP_SAD = 0; + FF_CMP_SSE = 1; + FF_CMP_SATD = 2; + FF_CMP_DCT = 3; + FF_CMP_PSNR = 4; + FF_CMP_BIT = 5; + FF_CMP_RD = 6; + FF_CMP_ZERO = 7; + FF_CMP_VSAD = 8; + FF_CMP_VSSE = 9; + FF_CMP_NSSE = 10; + FF_CMP_W53 = 11; + FF_CMP_W97 = 12; + FF_CMP_DCTMAX = 13; + FF_CMP_DCT264 = 14; + FF_CMP_CHROMA = 256; + + FF_DTG_AFD_SAME = 8; + FF_DTG_AFD_4_3 = 9; + FF_DTG_AFD_16_9 = 10; + FF_DTG_AFD_14_9 = 11; + FF_DTG_AFD_4_3_SP_14_9 = 13; + FF_DTG_AFD_16_9_SP_14_9 = 14; + FF_DTG_AFD_SP_4_3 = 15; + + FF_DEFAULT_QUANT_BIAS = 999999; + + FF_LAMBDA_SHIFT = 7; + FF_LAMBDA_SCALE = (1 shl FF_LAMBDA_SHIFT); + FF_QP2LAMBDA = 118; ///< factor to convert from H.263 QP to lambda + FF_LAMBDA_MAX = (256 * 128 - 1); + + FF_QUALITY_SCALE = FF_LAMBDA_SCALE; //FIXME maybe remove + + FF_CODER_TYPE_VLC = 0; + FF_CODER_TYPE_AC = 1; + FF_CODER_TYPE_RAW = 2; + FF_CODER_TYPE_RLE = 3; + FF_CODER_TYPE_DEFLATE = 4; + + SLICE_FLAG_CODED_ORDER = $0001; ///< draw_horiz_band() is called in coded order instead of display + SLICE_FLAG_ALLOW_FIELD = $0002; ///< allow draw_horiz_band() with field slices (MPEG2 field pics) + SLICE_FLAG_ALLOW_PLANE = $0004; ///< allow draw_horiz_band() with 1 component at a time (SVQ1) + + FF_MB_DECISION_SIMPLE = 0; ///< uses mb_cmp + FF_MB_DECISION_BITS = 1; ///< chooses the one which needs the fewest bits + FF_MB_DECISION_RD = 2; ///< rate distortion + + FF_AA_AUTO = 0; + FF_AA_FASTINT = 1; //not implemented yet + FF_AA_INT = 2; + FF_AA_FLOAT = 3; + + FF_PROFILE_UNKNOWN = -99; + FF_PROFILE_AAC_MAIN = 0; + FF_PROFILE_AAC_LOW = 1; + FF_PROFILE_AAC_SSR = 2; + FF_PROFILE_AAC_LTP = 3; + + FF_LEVEL_UNKNOWN = -99; + + X264_PART_I4X4 = $001; (* Analyse i4x4 *) + X264_PART_I8X8 = $002; (* Analyse i8x8 (requires 8x8 transform) *) + X264_PART_P8X8 = $010; (* Analyse p16x8, p8x16 and p8x8 *) + X264_PART_P4X4 = $020; (* Analyse p8x4, p4x8, p4x4 *) + X264_PART_B8X8 = $100; (* Analyse b16x8, b8x16 and b8x8 *) + + FF_COMPRESSION_DEFAULT = -1; + +const + AVPALETTE_SIZE = 1024; + AVPALETTE_COUNT = 256; + +type +(** + * AVPaletteControl + * This structure defines a method for communicating palette changes + * between and demuxer and a decoder. + * + * @deprecated Use AVPacket to send palette changes instead. + * This is totally broken. + *) + PAVPaletteControl = ^TAVPaletteControl; + TAVPaletteControl = record + (* demuxer sets this to 1 to indicate the palette has changed; + * decoder resets to 0 *) + palette_changed: integer; + + (* 4-byte ARGB palette entries, stored in native byte order; note that + * the individual palette components should be on a 8-bit scale; if + * the palette data comes from a IBM VGA native format, the component + * data is probably 6 bits in size and needs to be scaled *) + palette: array [0..AVPALETTE_COUNT - 1] of cardinal; + end; {deprecated;} + +type + PAVClass = ^TAVClass; {const} + PAVCodecContext = ^TAVCodecContext; + + PAVCodec = ^TAVCodec; + + // int[4] + PQuadIntArray = ^TQuadIntArray; + TQuadIntArray = array[0..3] of integer; + // int (*func)(struct AVCodecContext *c2, void *arg) + TExecuteFunc = function(c2: PAVCodecContext; arg: Pointer): integer; cdecl; + + TAVClass = record {12} + class_name: pchar; + (* actually passing a pointer to an AVCodecContext + or AVFormatContext, which begin with an AVClass. + Needed because av_log is in libavcodec and has no visibility + of AVIn/OutputFormat *) + item_name: function (): pchar; cdecl; + option: PAVOption; + end; + + (** + * main external API structure. + * New fields can be added to the end with minor version bumps. + * Removal, reordering and changes to existing fields require a major + * version bump. + * sizeof(AVCodecContext) must not be used outside libav*. + *) + TAVCodecContext = record {720} + (** + * information on struct for av_log + * - set by avcodec_alloc_context + *) + av_class: PAVClass; + (** + * the average bitrate + * - encoding: Set by user; unused for constant quantizer encoding. + * - decoding: Set by libavcodec. 0 or some bitrate if this info is available in the stream. + *) + bit_rate: integer; + + (** + * number of bits the bitstream is allowed to diverge from the reference. + * the reference can be CBR (for CBR pass1) or VBR (for pass2) + * - encoding: Set by user; unused for constant quantizer encoding. + * - decoding: unused + *) + bit_rate_tolerance: integer; + + (** + * CODEC_FLAG_*. + * - encoding: Set by user. + * - decoding: Set by user. + *) + flags: integer; + + (** + * Some codecs need additional format info. It is stored here. + * If any muxer uses this then ALL demuxers/parsers AND encoders for the + * specific codec MUST set it correctly otherwise stream copy breaks. + * In general use of this field by muxers is not recommanded. + * - encoding: Set by libavcodec. + * - decoding: Set by libavcodec. (FIXME: Is this OK?) + *) + sub_id: integer; + + (** + * Motion estimation algorithm used for video coding. + * 1 (zero), 2 (full), 3 (log), 4 (phods), 5 (epzs), 6 (x1), 7 (hex), + * 8 (umh), 9 (iter) [7, 8 are x264 specific, 9 is snow specific] + * - encoding: MUST be set by user. + * - decoding: unused + *) + me_method: integer; + + (** + * some codecs need / can use extradata like Huffman tables. + * mjpeg: Huffman tables + * rv10: additional flags + * mpeg4: global headers (they can be in the bitstream or here) + * The allocated memory should be FF_INPUT_BUFFER_PADDING_SIZE bytes larger + * than extradata_size to avoid prolems if it is read with the bitstream reader. + * The bytewise contents of extradata must not depend on the architecture or CPU endianness. + * - encoding: Set/allocated/freed by libavcodec. + * - decoding: Set/allocated/freed by user. + *) + extradata: pbyte; + extradata_size: integer; + + (** + * This is the fundamental unit of time (in seconds) in terms + * of which frame timestamps are represented. For fixed-fps content, + * timebase should be 1/framerate and timestamp increments should be + * identically 1. + * - encoding: MUST be set by user. + * - decoding: Set by libavcodec. + *) + time_base: TAVRational; + + (* video only *) + (** + * picture width / height. + * - encoding: MUST be set by user. + * - decoding: Set by libavcodec. + * Note: For compatibility it is possible to set this instead of + * coded_width/height before decoding. + *) + width, height: integer; + + (** + * the number of pictures in a group of pictures, or 0 for intra_only + * - encoding: Set by user. + * - decoding: unused + *) + gop_size: integer; + + (** + * Pixel format, see PIX_FMT_xxx. + * - encoding: Set by user. + * - decoding: Set by libavcodec. + *) + pix_fmt: TAVPixelFormat; + + (** + * Frame rate emulation. If not zero, the lower layer (i.e. format handler) + * has to read frames at native frame rate. + * - encoding: Set by user. + * - decoding: unused + *) + rate_emu: integer; + + (** + * If non NULL, 'draw_horiz_band' is called by the libavcodec + * decoder to draw a horizontal band. It improves cache usage. Not + * all codecs can do that. You must check the codec capabilities + * beforehand. + * - encoding: unused + * - decoding: Set by user. + * @param height the height of the slice + * @param y the y position of the slice + * @param type 1->top field, 2->bottom field, 3->frame + * @param offset offset into the AVFrame.data from which the slice should be read + *) + draw_horiz_band: procedure (s: PAVCodecContext; + {const} src: PAVFrame; offset: PQuadIntArray; + y: integer; type_: integer; height: integer); cdecl; + + (* audio only *) + sample_rate: integer; ///< samples per second + channels: integer; ///< number of audio channels + + (** + * audio sample format + * - encoding: Set by user. + * - decoding: Set by libavcodec. + *) + sample_fmt: TSampleFormat; ///< sample format, currenly unused + + (* The following data should not be initialized. *) + (** + * Samples per packet, initialized when calling 'init'. + *) + frame_size: integer; + frame_number: integer; ///< audio or video frame number + real_pict_num: integer; ///< returns the real picture number of previous encoded frame + + (** + * Number of frames the decoded output will be delayed relative to + * the encoded input. + * - encoding: Set by libavcodec. + * - decoding: unused + *) + delay: integer; + + (* - encoding parameters *) + qcompress: single; ///< amount of qscale change between easy & hard scenes (0.0-1.0) + qblur: single; ///< amount of qscale smoothing over time (0.0-1.0) + + (** + * minimum quantizer + * - encoding: Set by user. + * - decoding: unused + *) + qmin: integer; + + (** + * maximum quantizer + * - encoding: Set by user. + * - decoding: unused + *) + qmax: integer; + + (** + * maximum quantizer difference between frames + * - encoding: Set by user. + * - decoding: unused + *) + max_qdiff: integer; + + (** + * maximum number of B-frames between non-B-frames + * Note: The output will be delayed by max_b_frames+1 relative to the input. + * - encoding: Set by user. + * - decoding: unused + *) + max_b_frames: integer; + + (** + * qscale factor between IP and B-frames + * - encoding: Set by user. + * - decoding: unused + *) + b_quant_factor: single; + + (** obsolete FIXME remove *) + rc_strategy: integer; + + b_frame_strategy: integer; + + (** + * hurry up amount + * - encoding: unused + * - decoding: Set by user. 1-> Skip B-frames, 2-> Skip IDCT/dequant too, 5-> Skip everything except header + * @deprecated Deprecated in favor of skip_idct and skip_frame. + *) + hurry_up: integer; + + codec: PAVCodec; + + priv_data: pointer; + + {$IF LIBAVCODEC_VERSION < 52000000} // 52.0.0 + (* unused, FIXME remove*) + rtp_mode: integer; + {$IFEND} + + rtp_payload_size: integer; (* The size of the RTP payload: the coder will *) + (* do it's best to deliver a chunk with size *) + (* below rtp_payload_size, the chunk will start *) + (* with a start code on some codecs like H.263 *) + (* This doesn't take account of any particular *) + (* headers inside the transmited RTP payload *) + + + (* The RTP callback: This function is called *) + (* every time the encoder has a packet to send *) + (* Depends on the encoder if the data starts *) + (* with a Start Code (it should) H.263 does. *) + (* mb_nb contains the number of macroblocks *) + (* encoded in the RTP payload *) + rtp_callback: procedure (avctx: PAVCodecContext; data: pointer; + size: integer; mb_nb: integer); cdecl; + + (* statistics, used for 2-pass encoding *) + mv_bits: integer; + header_bits: integer; + i_tex_bits: integer; + p_tex_bits: integer; + i_count: integer; + p_count: integer; + skip_count: integer; + misc_bits: integer; + + (** + * number of bits used for the previously encoded frame + * - encoding: Set by libavcodec. + * - decoding: unused + *) + frame_bits: integer; + + (** + * Private data of the user, can be used to carry app specific stuff. + * - encoding: Set by user. + * - decoding: Set by user. + *) + opaque: pointer; + + codec_name: array [0..31] of char; + codec_type: TCodecType; (* see CODEC_TYPE_xxx *) + codec_id: TCodecID; (* see CODEC_ID_xxx *) + + (** + * fourcc (LSB first, so "ABCD" -> ('D'<<24) + ('C'<<16) + ('B'<<8) + 'A'). + * This is used to work around some encoder bugs. + * A demuxer should set this to what is stored in the field used to identify the codec. + * If there are multiple such fields in a container then the demuxer should choose the one + * which maximizes the information about the used codec. + * If the codec tag field in a container is larger then 32 bits then the demuxer should + * remap the longer ID to 32 bits with a table or other structure. Alternatively a new + * extra_codec_tag + size could be added but for this a clear advantage must be demonstrated + * first. + * - encoding: Set by user, if not then the default based on codec_id will be used. + * - decoding: Set by user, will be converted to uppercase by libavcodec during init. + *) + codec_tag: cardinal; // ìîæíî array [0..3] of char - òîãäà âèäíî FOURCC + + (** + * Work around bugs in encoders which sometimes cannot be detected automatically. + * - encoding: Set by user + * - decoding: Set by user + *) + workaround_bugs: integer; + + (** + * luma single coefficient elimination threshold + * - encoding: Set by user. + * - decoding: unused + *) + luma_elim_threshold: integer; + + (** + * chroma single coeff elimination threshold + * - encoding: Set by user. + * - decoding: unused + *) + chroma_elim_threshold: integer; + + (** + * strictly follow the standard (MPEG4, ...). + * - encoding: Set by user. + * - decoding: unused + *) + strict_std_compliance: integer; + + (** + * qscale offset between IP and B-frames + * If > 0 then the last P-frame quantizer will be used (q= lastp_q*factor+offset). + * If < 0 then normal ratecontrol will be done (q= -normal_q*factor+offset). + * - encoding: Set by user. + * - decoding: unused + *) + b_quant_offset: single; + + (** + * Error resilience; higher values will detect more errors but may + * misdetect some more or less valid parts as errors. + * - encoding: unused + * - decoding: Set by user. + *) + error_resilience: integer; + + (** + * Called at the beginning of each frame to get a buffer for it. + * If pic.reference is set then the frame will be read later by libavcodec. + * avcodec_align_dimensions() should be used to find the required width and + * height, as they normally need to be rounded up to the next multiple of 16. + * - encoding: unused + * - decoding: Set by libavcodec., user can override. + *) + get_buffer: function (c: PAVCodecContext; pic: PAVFrame): integer; cdecl; + + (** + * Called to release buffers which were allocated with get_buffer. + * A released buffer can be reused in get_buffer(). + * pic.data[*] must be set to NULL. + * - encoding: unused + * - decoding: Set by libavcodec., user can override. + *) + release_buffer: procedure (c: PAVCodecContext; pic: PAVFrame); cdecl; + + (** + * If 1 the stream has a 1 frame delay during decoding. + * - encoding: Set by libavcodec. + * - decoding: Set by libavcodec. + *) + has_b_frames: integer; + + (** + * number of bytes per packet if constant and known or 0 + * Used by some WAV based audio codecs. + *) + block_align: integer; + + parse_only: integer; (* - decoding only: if true, only parsing is done + (function avcodec_parse_frame()). The frame + data is returned. Only MPEG codecs support this now. *) + + (** + * 0-> h263 quant 1-> mpeg quant + * - encoding: Set by user. + * - decoding: unused + *) + mpeg_quant: integer; + + (** + * pass1 encoding statistics output buffer + * - encoding: Set by libavcodec. + * - decoding: unused + *) + stats_out: pchar; + + (** + * pass2 encoding statistics input buffer + * Concatenated stuff from stats_out of pass1 should be placed here. + * - encoding: Allocated/set/freed by user. + * - decoding: unused + *) + stats_in: pchar; + + (** + * ratecontrol qmin qmax limiting method + * 0-> clipping, 1-> use a nice continous function to limit qscale wthin qmin/qmax. + * - encoding: Set by user. + * - decoding: unused + *) + rc_qsquish: single; + + rc_qmod_amp: single; + rc_qmod_freq: integer; + + (** + * ratecontrol override, see RcOverride + * - encoding: Allocated/set/freed by user. + * - decoding: unused + *) + rc_override: PRcOverride; + rc_override_count: integer; + + (** + * rate control equation + * - encoding: Set by user + * - decoding: unused + *) + rc_eq: pchar; {const char*} + + (** + * maximum bitrate + * - encoding: Set by user. + * - decoding: unused + *) + rc_max_rate: integer; + + (** + * minimum bitrate + * - encoding: Set by user. + * - decoding: unused + *) + rc_min_rate: integer; + + (** + * decoder bitstream buffer size + * - encoding: Set by user. + * - decoding: unused + *) + rc_buffer_size: integer; + rc_buffer_aggressivity: single; + + (** + * qscale factor between P and I-frames + * If > 0 then the last p frame quantizer will be used (q= lastp_q*factor+offset). + * If < 0 then normal ratecontrol will be done (q= -normal_q*factor+offset). + * - encoding: Set by user. + * - decoding: unused + *) + i_quant_factor: single; + + (** + * qscale offset between P and I-frames + * - encoding: Set by user. + * - decoding: unused + *) + i_quant_offset: single; + + (** + * initial complexity for pass1 ratecontrol + * - encoding: Set by user. + * - decoding: unused + *) + rc_initial_cplx: single; + + (** + * DCT algorithm, see FF_DCT_* below + * - encoding: Set by user. + * - decoding: unused + *) + dct_algo: integer; + + (** + * luminance masking (0-> disabled) + * - encoding: Set by user. + * - decoding: unused + *) + lumi_masking: single; + + (** + * temporary complexity masking (0-> disabled) + * - encoding: Set by user. + * - decoding: unused + *) + temporal_cplx_masking: single; + + (** + * spatial complexity masking (0-> disabled) + * - encoding: Set by user. + * - decoding: unused + *) + spatial_cplx_masking: single; + + (** + * p block masking (0-> disabled) + * - encoding: Set by user. + * - decoding: unused + *) + p_masking: single; + + (** + * darkness masking (0-> disabled) + * - encoding: Set by user. + * - decoding: unused + *) + dark_masking: single; + + {$IF LIBAVCODEC_VERSION < 52000000} // 52.0.0 + (* for binary compatibility *) + unused: integer; + {$IFEND} + + (** + * IDCT algorithm, see FF_IDCT_* below. + * - encoding: Set by user. + * - decoding: Set by user. + *) + idct_algo: integer; + + (** + * slice count + * - encoding: Set by libavcodec. + * - decoding: Set by user (or 0). + *) + slice_count: integer; + + (** + * slice offsets in the frame in bytes + * - encoding: Set/allocated by libavcodec. + * - decoding: Set/allocated by user (or NULL). + *) + slice_offset: Pinteger; + + (** + * error concealment flags + * - encoding: unused + * - decoding: Set by user. + *) + error_concealment: integer; + + (** + * dsp_mask could be add used to disable unwanted CPU features + * CPU features (i.e. MMX, SSE. ...) + * + * With the FORCE flag you may instead enable given CPU features. + * (Dangerous: Usable in case of misdetection, improper usage however will + * result into program crash.) + *) + dsp_mask: cardinal; + + (** + * bits per sample/pixel from the demuxer (needed for huffyuv). + * - encoding: Set by libavcodec. + * - decoding: Set by user. + *) + bits_per_sample: integer; + + (** + * prediction method (needed for huffyuv) + * - encoding: Set by user. + * - decoding: unused + *) + prediction_method: integer; + + (** + * sample aspect ratio (0 if unknown) + * Numerator and denominator must be relatively prime and smaller than 256 for some video standards. + * - encoding: Set by user. + * - decoding: Set by libavcodec. + *) + sample_aspect_ratio: TAVRational; + + (** + * the picture in the bitstream + * - encoding: Set by libavcodec. + * - decoding: Set by libavcodec. + *) + coded_frame: PAVFrame; + + (** + * debug + * - encoding: Set by user. + * - decoding: Set by user. + *) + debug: integer; + + (** + * debug + * - encoding: Set by user. + * - decoding: Set by user. + *) + debug_mv: integer; + + (** + * error + * - encoding: Set by libavcodec if flags&CODEC_FLAG_PSNR. + * - decoding: unused + *) + error: array [0..3] of uint64; + + (** + * minimum MB quantizer + * - encoding: unused + * - decoding: unused + *) + mb_qmin: integer; + + (** + * maximum MB quantizer + * - encoding: unused + * - decoding: unused + *) + mb_qmax: integer; + + (** + * motion estimation comparison function + * - encoding: Set by user. + * - decoding: unused + *) + me_cmp: integer; + + (** + * subpixel motion estimation comparison function + * - encoding: Set by user. + * - decoding: unused + *) + me_sub_cmp: integer; + (** + * macroblock comparison function (not supported yet) + * - encoding: Set by user. + * - decoding: unused + *) + mb_cmp: integer; + (** + * interlaced DCT comparison function + * - encoding: Set by user. + * - decoding: unused + *) + ildct_cmp: integer; + + (** + * ME diamond size & shape + * - encoding: Set by user. + * - decoding: unused + *) + dia_size: integer; + + (** + * amount of previous MV predictors (2a+1 x 2a+1 square) + * - encoding: Set by user. + * - decoding: unused + *) + last_predictor_count: integer; + + (** + * prepass for motion estimation + * - encoding: Set by user. + * - decoding: unused + *) + pre_me: integer; + + (** + * motion estimation prepass comparison function + * - encoding: Set by user. + * - decoding: unused + *) + me_pre_cmp: integer; + + (** + * ME prepass diamond size & shape + * - encoding: Set by user. + * - decoding: unused + *) + pre_dia_size: integer; + + (** + * subpel ME quality + * - encoding: Set by user. + * - decoding: unused + *) + me_subpel_quality: integer; + + (** + * callback to negotiate the pixelFormat + * @param fmt is the list of formats which are supported by the codec, + * it is terminated by -1 as 0 is a valid format, the formats are ordered by quality. + * The first is always the native one. + * @return the chosen format + * - encoding: unused + * - decoding: Set by user, if not set the native format will be chosen. + *) + get_format: function (s: PAVCodecContext; {const} fmt: PAVPixelFormat): TAVPixelFormat; cdecl; + + (** + * DTG active format information (additional aspect ratio + * information only used in DVB MPEG-2 transport streams) + * 0 if not set. + * + * - encoding: unused + * - decoding: Set by decoder. + *) + dtg_active_format: integer; + + (** + * maximum motion estimation search range in subpel units + * If 0 then no limit. + * + * - encoding: Set by user. + * - decoding: unused + *) + me_range: integer; + + (** + * intra quantizer bias + * - encoding: Set by user. + * - decoding: unused + *) + intra_quant_bias: integer; + + (** + * inter quantizer bias + * - encoding: Set by user. + * - decoding: unused + *) + inter_quant_bias: integer; + + (** + * color table ID + * - encoding: unused + * - decoding: Which clrtable should be used for 8bit RGB images. + * Tables have to be stored somewhere. FIXME + *) + color_table_id: integer; + + (** + * internal_buffer count + * Don't touch, used by libavcodec default_get_buffer(). + *) + internal_buffer_count: integer; + + (** + * internal_buffers + * Don't touch, used by libavcodec default_get_buffer(). + *) + internal_buffer: pointer; + + (** + * Global quality for codecs which cannot change it per frame. + * This should be proportional to MPEG-1/2/4 qscale. + * - encoding: Set by user. + * - decoding: unused + *) + global_quality: integer; + + (** + * coder type + * - encoding: Set by user. + * - decoding: unused + *) + coder_type: integer; + + (** + * context model + * - encoding: Set by user. + * - decoding: unused + *) + context_model: integer; + + { + (** + * + * - encoding: unused + * - decoding: Set by user. + *) + realloc: function (s: PAVCodecContext; buf: Pbyte; buf_size: integer): Pbyte; cdecl; + } + + (** + * slice flags + * - encoding: unused + * - decoding: Set by user. + *) + slice_flags: integer; + + (** + * XVideo Motion Acceleration + * - encoding: forbidden + * - decoding: set by decoder + *) + xvmc_acceleration: integer; + + (** + * macroblock decision mode + * - encoding: Set by user. + * - decoding: unused + *) + mb_decision: integer; + + (** + * custom intra quantization matrix + * - encoding: Set by user, can be NULL. + * - decoding: Set by libavcodec. + *) + intra_matrix: Pword; + + (** + * custom inter quantization matrix + * - encoding: Set by user, can be NULL. + * - decoding: Set by libavcodec. + *) + inter_matrix: Pword; + + (** + * fourcc from the AVI stream header (LSB first, so "ABCD" -> ('D'<<24) + ('C'<<16) + ('B'<<8) + 'A'). + * This is used to work around some encoder bugs. + * - encoding: unused + * - decoding: Set by user, will be converted to uppercase by libavcodec during init. + *) + stream_codec_tag: array [0..3] of char; //cardinal; + + (** + * scene change detection threshold + * 0 is default, larger means fewer detected scene changes. + * - encoding: Set by user. + * - decoding: unused + *) + scenechange_threshold: integer; + + (** + * minimum Lagrange multipler + * - encoding: Set by user. + * - decoding: unused + *) + lmin: integer; + + (** + * maximum Lagrange multipler + * - encoding: Set by user. + * - decoding: unused + *) + lmax: integer; + + (** + * palette control structure + * - encoding: ??? (no palette-enabled encoder yet) + * - decoding: Set by user. + *) + palctrl: PAVPaletteControl; + + (** + * noise reduction strength + * - encoding: Set by user. + * - decoding: unused + *) + noise_reduction: integer; + + (** + * Called at the beginning of a frame to get cr buffer for it. + * Buffer type (size, hints) must be the same. libavcodec won't check it. + * libavcodec will pass previous buffer in pic, function should return + * same buffer or new buffer with old frame "painted" into it. + * If pic.data[0] == NULL must behave like get_buffer(). + * - encoding: unused + * - decoding: Set by libavcodec., user can override + *) + reget_buffer: function (c: PAVCodecContext; pic: PAVFrame): integer; cdecl; + + (** + * Number of bits which should be loaded into the rc buffer before decoding starts. + * - encoding: Set by user. + * - decoding: unused + *) + rc_initial_buffer_occupancy: integer; + + (** + * + * - encoding: Set by user. + * - decoding: unused + *) + inter_threshold: integer; + + (** + * CODEC_FLAG2_* + * - encoding: Set by user. + * - decoding: Set by user. + *) + flags2: integer; + + (** + * Simulates errors in the bitstream to test error concealment. + * - encoding: Set by user. + * - decoding: unused + *) + error_rate: integer; + + (** + * MP3 antialias algorithm, see FF_AA_* below. + * - encoding: unused + * - decoding: Set by user. + *) + antialias_algo: integer; + + (** + * quantizer noise shaping + * - encoding: Set by user. + * - decoding: unused + *) + quantizer_noise_shaping: integer; + + (** + * thread count + * is used to decide how many independent tasks should be passed to execute() + * - encoding: Set by user. + * - decoding: Set by user. + *) + thread_count: integer; + + (** + * The codec may call this to execute several independent things. + * It will return only after finishing all tasks. + * The user may replace this with some multithreaded implementation, + * the default implementation will execute the parts serially. + * @param count the number of things to execute + * - encoding: Set by libavcodec, user can override. + * - decoding: Set by libavcodec, user can override. + *) + execute: function (c: PAVCodecContext; func: TExecuteFunc; arg: PPointer; ret: PInteger; count: integer): integer; cdecl; + + (** + * thread opaque + * Can be used by execute() to store some per AVCodecContext stuff. + * - encoding: set by execute() + * - decoding: set by execute() + *) + thread_opaque: pointer; + + (** + * Motion estimation threshold below which no motion estimation is + * performed, but instead the user specified motion vectors are used. + * + * - encoding: Set by user. + * - decoding: unused + *) + me_threshold: integer; + + (** + * Macroblock threshold below which the user specified macroblock types will be used. + * - encoding: Set by user. + * - decoding: unused + *) + mb_threshold: integer; + + (** + * precision of the intra DC coefficient - 8 + * - encoding: Set by user. + * - decoding: unused + *) + intra_dc_precision: integer; + + (** + * noise vs. sse weight for the nsse comparsion function + * - encoding: Set by user. + * - decoding: unused + *) + nsse_weight: integer; + + (** + * Number of macroblock rows at the top which are skipped. + * - encoding: unused + * - decoding: Set by user. + *) + skip_top: integer; + + (** + * Number of macroblock rows at the bottom which are skipped. + * - encoding: unused + * - decoding: Set by user. + *) + skip_bottom: integer; + + (** + * profile + * - encoding: Set by user. + * - decoding: Set by libavcodec. + *) + profile: integer; + + (** + * level + * - encoding: Set by user. + * - decoding: Set by libavcodec. + *) + level: integer; + + (** + * low resolution decoding, 1-> 1/2 size, 2->1/4 size + * - encoding: unused + * - decoding: Set by user. + *) + lowres: integer; + + (** + * Bitstream width / height, may be different from width/height if lowres + * or other things are used. + * - encoding: unused + * - decoding: Set by user before init if known. Codec should override / dynamically change if needed. + *) + coded_width, coded_height: integer; + + (** + * frame skip threshold + * - encoding: Set by user. + * - decoding: unused + *) + frame_skip_threshold: integer; + + (** + * frame skip factor + * - encoding: Set by user. + * - decoding: unused + *) + frame_skip_factor: integer; + + (** + * frame skip exponent + * - encoding: Set by user. + * - decoding: unused + *) + frame_skip_exp: integer; + + (** + * frame skip comparison function + * - encoding: Set by user. + * - decoding: unused + *) + frame_skip_cmp: integer; + + (** + * Border processing masking, raises the quantizer for mbs on the borders + * of the picture. + * - encoding: Set by user. + * - decoding: unused + *) + border_masking: single; + + (** + * minimum MB lagrange multipler + * - encoding: Set by user. + * - decoding: unused + *) + mb_lmin: integer; + + (** + * maximum MB lagrange multipler + * - encoding: Set by user. + * - decoding: unused + *) + mb_lmax: integer; + + (** + * + * - encoding: Set by user. + * - decoding: unused + *) + me_penalty_compensation: integer; + + (** + * + * - encoding: unused + * - decoding: Set by user. + *) + skip_loop_filter: TAVDiscard; + + (** + * + * - encoding: unused + * - decoding: Set by user. + *) + skip_idct: TAVDiscard; + + (** + * + * - encoding: unused + * - decoding: Set by user. + *) + skip_frame: TAVDiscard; + + (** + * + * - encoding: Set by user. + * - decoding: unused + *) + bidir_refine: integer; + + (** + * + * - encoding: Set by user. + * - decoding: unused + *) + brd_scale: integer; + + (** + * constant rate factor - quality-based VBR - values ~correspond to qps + * - encoding: Set by user. + * - decoding: unused + *) + {$IF LIBAVCODEC_VERSION >= 51021000} // 51.21.0 + crf: single; + {$ELSE} + crf: integer; + {$IFEND} + + (** + * constant quantization parameter rate control method + * - encoding: Set by user. + * - decoding: unused + *) + cqp: integer; + + (** + * minimum GOP size + * - encoding: Set by user. + * - decoding: unused + *) + keyint_min: integer; + + (** + * number of reference frames + * - encoding: Set by user. + * - decoding: unused + *) + refs: integer; + + (** + * chroma qp offset from luma + * - encoding: Set by user. + * - decoding: unused + *) + chromaoffset: integer; + + (** + * Influences how often B-frames are used. + * - encoding: Set by user. + * - decoding: unused + *) + bframebias: integer; + + (** + * trellis RD quantization + * - encoding: Set by user. + * - decoding: unused + *) + trellis: integer; + + (** + * Reduce fluctuations in qp (before curve compression). + * - encoding: Set by user. + * - decoding: unused + *) + complexityblur: single; + + (** + * in-loop deblocking filter alphac0 parameter + * alpha is in the range -6...6 + * - encoding: Set by user. + * - decoding: unused + *) + deblockalpha: integer; + + (** + * in-loop deblocking filter beta parameter + * beta is in the range -6...6 + * - encoding: Set by user. + * - decoding: unused + *) + deblockbeta: integer; + + (** + * macroblock subpartition sizes to consider - p8x8, p4x4, b8x8, i8x8, i4x4 + * - encoding: Set by user. + * - decoding: unused + *) + partitions: integer; + + (** + * direct MV prediction mode - 0 (none), 1 (spatial), 2 (temporal) + * - encoding: Set by user. + * - decoding: unused + *) + directpred: integer; + + (** + * Audio cutoff bandwidth (0 means "automatic") + * - encoding: Set by user. + * - decoding: unused + *) + cutoff: integer; + + (** + * Multiplied by qscale for each frame and added to scene_change_score. + * - encoding: Set by user. + * - decoding: unused + *) + scenechange_factor: integer; + + (** + * + * Note: Value depends upon the compare function used for fullpel ME. + * - encoding: Set by user. + * - decoding: unused + *) + mv0_threshold: integer; + + (** + * Adjusts sensitivity of b_frame_strategy 1. + * - encoding: Set by user. + * - decoding: unused + *) + b_sensitivity: integer; + + (** + * - encoding: Set by user. + * - decoding: unused + *) + compression_level: integer; + + (** + * Sets whether to use LPC mode - used by FLAC encoder. + * - encoding: Set by user. + * - decoding: unused + *) + use_lpc: integer; + + (** + * LPC coefficient precision - used by FLAC encoder + * - encoding: Set by user. + * - decoding: unused + *) + lpc_coeff_precision: integer; + + (** + * - encoding: Set by user. + * - decoding: unused + *) + min_prediction_order: integer; + + (** + * - encoding: Set by user. + * - decoding: unused + *) + max_prediction_order: integer; + + (** + * search method for selecting prediction order + * - encoding: Set by user. + * - decoding: unused + *) + prediction_order_method: integer; + + (** + * - encoding: Set by user. + * - decoding: unused + *) + min_partition_order: integer; + + (** + * - encoding: Set by user. + * - decoding: unused + *) + max_partition_order: integer; + + {$IF LIBAVCODEC_VERSION >= 51026000} // 51.26.0 + (** + * GOP timecode frame start number, in non drop frame format + * - encoding: Set by user. + * - decoding: unused + *) + timecode_frame_start: int64; + {$IFEND} + + {$IF LIBAVCODEC_VERSION >= 51042000} // 51.42.0 + (** + * Decoder should decode to this many channels if it can (0 for default) + * - encoding: unused + * - decoding: Set by user. + *) + request_channels: integer; + {$IFEND} + + {$IF LIBAVCODEC_VERSION > 51049000} // > 51.49.0 + (** + * Percentage of dynamic range compression to be applied by the decoder. + * The default value is 1.0, corresponding to full compression. + * - encoding: unused + * - decoding: Set by user. + *) + drc_scale: Single; + {$IFEND} + end; + +(** + * AVCodec. + *) + TAVCodec = record + name: pchar; + type_: TCodecType; + id: TCodecID; + priv_data_size: integer; + init: function (avctx: PAVCodecContext): integer; cdecl; (* typo corretion by the Creative CAT *) + encode: function (avctx: PAVCodecContext; buf: pchar; buf_size: integer; data: pointer): integer; cdecl; + close: function (avctx: PAVCodecContext): integer; cdecl; + decode: function (avctx: PAVCodecContext; outdata: pointer; outdata_size: PInteger; + {const} buf: pchar; buf_size: integer): integer; cdecl; + (** + * Codec capabilities. + * see CODEC_CAP_* + *) + capabilities: integer; + next: PAVCodec; + (** + * Flush buffers. + * Will be called when seeking + *) + flush: procedure (avctx: PAVCodecContext); cdecl; + {const} supported_framerates: PAVRational; ///< array of supported framerates, or NULL if any, array is terminated by {0,0} + {const} pix_fmts: PAVPixelFormat; ///< array of supported pixel formats, or NULL if unknown, array is terminated by -1 + {$IF LIBAVCODEC_VERSION >= 51055000} // 51.55.0 + {const} long_name: PChar; ///< descriptive name for the codec, meant to be more human readable than \p name + {$IFEND} + {$IF LIBAVCODEC_VERSION >= 51056000} // 51.56.0 + {const} supported_samplerates: PInteger; ///< array of supported audio samplerates, or NULL if unknown, array is terminated by 0 + {$IFEND} + end; + +(** + * four components are given, that's all. + * the last component is alpha + *) + PAVPicture = ^TAVPicture; + TAVPicture = record + data: array [0..3] of pchar; + linesize: array [0..3] of integer; ///< number of bytes per line + end; + +type + PAVSubtitleRect = ^TAVSubtitleRect; + TAVSubtitleRect = record + x: word; + y: word; + w: word; + h: word; + nb_colors: word; + linesize: integer; + rgba_palette: PCardinal; + bitmap: pchar; + end; + + PAVSubtitle = ^TAVSubtitle; + TAVSubtitle = record {20} + format: word; (* 0 = graphics *) + start_display_time: cardinal; (* relative to packet pts, in ms *) + end_display_time: cardinal; (* relative to packet pts, in ms *) + num_rects: cardinal; + rects: PAVSubtitleRect; + end; + + +(* resample.c *) + + PReSampleContext = pointer; + PAVResampleContext = pointer; + PImgReSampleContext = pointer; + +function audio_resample_init (output_channels: integer; input_channels: integer; + output_rate: integer; input_rate: integer): PReSampleContext; + cdecl; external av__codec; + +function audio_resample (s: PReSampleContext; output: PSmallint; input: PSmallint; nb_samples: integer): integer; + cdecl; external av__codec; + +procedure audio_resample_close (s: PReSampleContext); + cdecl; external av__codec; + + +function av_resample_init (out_rate: integer; in_rate: integer; filter_length: integer; + log2_phase_count: integer; linear: integer; cutoff: double): PAVResampleContext; + cdecl; external av__codec; + +function av_resample (c: PAVResampleContext; dst: PSmallint; src: PSmallint; consumed: PInteger; + src_size: integer; dst_size: integer; update_ctx: integer): integer; + cdecl; external av__codec; + +procedure av_resample_compensate (c: PAVResampleContext; sample_delta: integer; + compensation_distance: integer); + cdecl; external av__codec; + +procedure av_resample_close (c: PAVResampleContext); + cdecl; external av__codec; + + +{$IF LIBAVCODEC_VERSION < 52000000} // 52.0.0 +(* YUV420 format is assumed ! *) + +(** + * @deprecated Use the software scaler (swscale) instead. + *) +function img_resample_init (output_width: integer; output_height: integer; + input_width: integer; input_height: integer): PImgReSampleContext; + cdecl; external av__codec; deprecated; + +(** + * @deprecated Use the software scaler (swscale) instead. + *) +function img_resample_full_init (owidth: integer; oheight: integer; + iwidth: integer; iheight: integer; + topBand: integer; bottomBand: integer; + leftBand: integer; rightBand: integer; + padtop: integer; padbottom: integer; + padleft: integer; padright: integer): PImgReSampleContext; + cdecl; external av__codec; deprecated; + +(** + * @deprecated Use the software scaler (swscale) instead. + *) +procedure img_resample (s: PImgReSampleContext; output: PAVPicture; {const} input: PAVPicture); + cdecl; external av__codec; deprecated; + +(** + * @deprecated Use the software scaler (swscale) instead. + *) +procedure img_resample_close (s: PImgReSampleContext); + cdecl; external av__codec; deprecated; + +{$IFEND} + +(** + * Allocate memory for a picture. Call avpicture_free to free it. + * + * @param picture the picture to be filled in. + * @param pix_fmt the format of the picture. + * @param width the width of the picture. + * @param height the height of the picture. + * @return Zero if successful, a negative value if not. + *) +function avpicture_alloc (picture: PAVPicture; pix_fmt: TAVPixelFormat; + width: integer; height: integer): integer; + cdecl; external av__codec; + +(** + * Free a picture previously allocated by avpicture_alloc(). + * + * @param picture the AVPicture to be freed + *) +procedure avpicture_free (picture: PAVPicture); + cdecl; external av__codec; + +(** + * Fill in the AVPicture fields. + * The fields of the given AVPicture are filled in by using the 'ptr' address + * which points to the image data buffer. Depending on the specified picture + * format, one or multiple image data pointers and line sizes will be set. + * If a planar format is specified, several pointers will be set pointing to + * the different picture planes and the line sizes of the different planes + * will be stored in the lines_sizes array. + * + * @param picture AVPicture whose fields are to be filled in + * @param ptr Buffer which will contain or contains the actual image data + * @param pix_fmt The format in which the picture data is stored. + * @param width the width of the image in pixels + * @param height the height of the image in pixels + * @return size of the image data in bytes + *) +function avpicture_fill (picture: PAVPicture; ptr: pointer; + pix_fmt: TAVPixelFormat; width: integer; height: integer): integer; + cdecl; external av__codec; + +function avpicture_layout ({const} src: PAVPicture; pix_fmt: TAVPixelFormat; + width: integer; height: integer; + dest: pchar; dest_size: integer): integer; + cdecl; external av__codec; + +(** + * Calculate the size in bytes that a picture of the given width and height + * would occupy if stored in the given picture format. + * + * @param pix_fmt the given picture format + * @param width the width of the image + * @param height the height of the image + * @return Image data size in bytes + *) +function avpicture_get_size (pix_fmt: TAVPixelFormat; width: integer; height: integer): integer; + cdecl; external av__codec; + +procedure avcodec_get_chroma_sub_sample (pix_fmt: TAVPixelFormat; h_shift: Pinteger; v_shift: pinteger); + cdecl; external av__codec; + +function avcodec_get_pix_fmt_name(pix_fmt: TAVPixelFormat): pchar; + cdecl; external av__codec; + +procedure avcodec_set_dimensions(s: PAVCodecContext; width: integer; height: integer); + cdecl; external av__codec; + +function avcodec_get_pix_fmt(const name: pchar): TAVPixelFormat; + cdecl; external av__codec; + +function avcodec_pix_fmt_to_codec_tag(p: TAVPixelFormat): cardinal; + cdecl; external av__codec; + +const + FF_LOSS_RESOLUTION = $0001; {**< loss due to resolution change *} + FF_LOSS_DEPTH = $0002; {**< loss due to color depth change *} + FF_LOSS_COLORSPACE = $0004; {**< loss due to color space conversion *} + FF_LOSS_ALPHA = $0008; {**< loss of alpha bits *} + FF_LOSS_COLORQUANT = $0010; {**< loss due to color quantization *} + FF_LOSS_CHROMA = $0020; {**< loss of chroma (e.g. RGB to gray conversion) *} + +(** + * Computes what kind of losses will occur when converting from one specific + * pixel format to another. + * When converting from one pixel format to another, information loss may occur. + * For example, when converting from RGB24 to GRAY, the color information will + * be lost. Similarly, other losses occur when converting from some formats to + * other formats. These losses can involve loss of chroma, but also loss of + * resolution, loss of color depth, loss due to the color space conversion, loss + * of the alpha bits or loss due to color quantization. + * avcodec_get_fix_fmt_loss() informs you about the various types of losses + * which will occur when converting from one pixel format to another. + * + * @param[in] dst_pix_fmt destination pixel format + * @param[in] src_pix_fmt source pixel format + * @param[in] has_alpha Whether the source pixel format alpha channel is used. + * @return Combination of flags informing you what kind of losses will occur. + *) +function avcodec_get_pix_fmt_loss (dst_pix_fmt: TAVPixelFormat; src_pix_fmt: TAVPixelFormat; + has_alpha: integer): integer; + cdecl; external av__codec; + +(** + * Finds the best pixel format to convert to given a certain source pixel + * format. When converting from one pixel format to another, information loss + * may occur. For example, when converting from RGB24 to GRAY, the color + * information will be lost. Similarly, other losses occur when converting from + * some formats to other formats. avcodec_find_best_pix_fmt() searches which of + * the given pixel formats should be used to suffer the least amount of loss. + * The pixel formats from which it chooses one, are determined by the + * \p pix_fmt_mask parameter. + * + * @code + * src_pix_fmt = PIX_FMT_YUV420P; + * pix_fmt_mask = (1 << PIX_FMT_YUV422P) || (1 << PIX_FMT_RGB24); + * dst_pix_fmt = avcodec_find_best_pix_fmt(pix_fmt_mask, src_pix_fmt, alpha, &loss); + * @endcode + * + * @param[in] pix_fmt_mask bitmask determining which pixel format to choose from + * @param[in] src_pix_fmt source pixel format + * @param[in] has_alpha Whether the source pixel format alpha channel is used. + * @param[out] loss_ptr Combination of flags informing you what kind of losses will occur. + * @return The best pixel format to convert to or -1 if none was found. + *) +function avcodec_find_best_pix_fmt (pix_fmt_mask: integer; src_pix_fmt: TAVPixelFormat; + has_alpha: integer; loss_ptr: pinteger): integer; + cdecl; external av__codec; + +{$IF LIBAVCODEC_VERSION >= 51041000} // 51.41.0 +(** + * Print in buf the string corresponding to the pixel format with + * number pix_fmt, or an header if pix_fmt is negative. + * + * @param[in] buf the buffer where to write the string + * @param[in] buf_size the size of buf + * @param[in] pix_fmt the number of the pixel format to print the corresponding info string, or + * a negative value to print the corresponding header. + * Meaningful values for obtaining a pixel format info vary from 0 to PIX_FMT_NB -1. + *) +procedure avcodec_pix_fmt_string (buf: PChar; buf_size: integer; pix_fmt: integer); + cdecl; external av__codec; +{$IFEND} + +const + FF_ALPHA_TRANSP = $0001; {* image has some totally transparent pixels *} + FF_ALPHA_SEMI_TRANSP = $0002; {* image has some transparent pixels *} + +(** + * Tell if an image really has transparent alpha values. + * @return ored mask of FF_ALPHA_xxx constants + *) +function img_get_alpha_info ({const} src: PAVPicture; + pix_fmt: TAVPixelFormat; + width: integer; height: integer): integer; + cdecl; external av__codec; + +{$IF LIBAVCODEC_VERSION < 52000000} // 52.0.0 +(** + * convert among pixel formats + * @deprecated Use the software scaler (swscale) instead. + *) +function img_convert (dst: PAVPicture; dst_pix_fmt: TAVPixelFormat; + const src: PAVPicture; pix_fmt: TAVPixelFormat; + width: integer; height: integer): integer; + cdecl; external av__codec; deprecated; +{$IFEND} + +(* deinterlace a picture *) +(* deinterlace - if not supported return -1 *) +function avpicture_deinterlace (dst: PAVPicture; const src: PAVPicture; + pix_fmt: TAVPixelFormat; width: integer; height: integer): integer; + cdecl; external av__codec; + +{* external high level API *} + +{$IF LIBAVCODEC_VERSION < 52000000} // 52.0.0 +{ +var + first_avcodec: PAVCodec; external av__codec; +} +{$IFEND} + +{$IF LIBAVCODEC_VERSION >= 51049000} // 51.49.0 +function av_codec_next(c: PAVCodec): PAVCodec; + cdecl; external av__codec; +{$IFEND} + +(* returns LIBAVCODEC_VERSION_INT constant *) +function avcodec_version (): cardinal; + cdecl; external av__codec; + +(* returns LIBAVCODEC_BUILD constant *) +function avcodec_build (): cardinal; + cdecl; external av__codec; + +(** + * Initializes libavcodec. + * + * @warning This function \e must be called before any other libavcodec + * function. + *) +procedure avcodec_init (); + cdecl; external av__codec; + +procedure register_avcodec (format: PAVCodec); + cdecl; external av__codec; + +(** + * Finds a registered encoder with a matching codec ID. + * + * @param id CodecID of the requested encoder + * @return An encoder if one was found, NULL otherwise. + *) +function avcodec_find_encoder (id: TCodecID): PAVCodec; + cdecl; external av__codec; + +(** + * Finds a registered encoder with the specified name. + * + * @param name name of the requested encoder + * @return An encoder if one was found, NULL otherwise. + *) +function avcodec_find_encoder_by_name (name: pchar): PAVCodec; + cdecl; external av__codec; + +(** + * Finds a registered decoder with a matching codec ID. + * + * @param id CodecID of the requested decoder + * @return A decoder if one was found, NULL otherwise. + *) +function avcodec_find_decoder(id: TCodecID): PAVCodec; + cdecl; external av__codec; + +(** + * Finds a registered decoder with the specified name. + * + * @param name name of the requested decoder + * @return A decoder if one was found, NULL otherwise. + *) +function avcodec_find_decoder_by_name (name: pchar): PAVCodec; + cdecl; external av__codec; +procedure avcodec_string(buf: pchar; buf_size: integer; enc: PAVCodecContext; encode: integer); + cdecl; external av__codec; + +(** + * Sets the fields of the given AVCodecContext to default values. + * + * @param s The AVCodecContext of which the fields should be set to default values. + *) +procedure avcodec_get_context_defaults (s: PAVCodecContext); + cdecl; external av__codec; + +{$IF LIBAVCODEC_VERSION >= 51039000} // 51.39.0 +(** THIS FUNCTION IS NOT YET PART OF THE PUBLIC API! + * we WILL change its arguments and name a few times! *) +procedure avcodec_get_context_defaults2(s: PAVCodecContext; ctype: TCodecType); + cdecl; external av__codec; +{$IFEND} + +(** + * Allocates an AVCodecContext and sets its fields to default values. The + * resulting struct can be deallocated by simply calling av_free(). + * + * @return An AVCodecContext filled with default values or NULL on failure. + * @see avcodec_get_context_defaults + *) +function avcodec_alloc_context(): PAVCodecContext; + cdecl; external av__codec; + +{$IF LIBAVCODEC_VERSION >= 51039000} // 51.39.0 +(** THIS FUNCTION IS NOT YET PART OF THE PUBLIC API! + * we WILL change its arguments and name a few times! *) +function avcodec_alloc_context2(ctype: TCodecType): PAVCodecContext; + cdecl; external av__codec; +{$IFEND} + +(** + * Sets the fields of the given AVFrame to default values. + * + * @param pic The AVFrame of which the fields should be set to default values. + *) +procedure avcodec_get_frame_defaults (pic: PAVFrame); + cdecl; external av__codec; + +(** + * Allocates an AVFrame and sets its fields to default values. The resulting + * struct can be deallocated by simply calling av_free(). + * + * @return An AVFrame filled with default values or NULL on failure. + * @see avcodec_get_frame_defaults + *) +function avcodec_alloc_frame(): PAVFrame; + cdecl; external av__codec; + +function avcodec_default_get_buffer (s: PAVCodecContext; pic: PAVFrame): integer; + cdecl; external av__codec; +procedure avcodec_default_release_buffer (s: PAVCodecContext; pic: PAVFrame); + cdecl; external av__codec; +function avcodec_default_reget_buffer (s: PAVCodecContext; pic: PAVFrame): integer; + cdecl; external av__codec; +procedure avcodec_align_dimensions(s: PAVCodecContext; width: Pinteger; height: PInteger); + cdecl; external av__codec; + +(** + * Checks if the given dimension of a picture is valid, meaning that all + * bytes of the picture can be addressed with a signed int. + * + * @param[in] w Width of the picture. + * @param[in] h Height of the picture. + * @return Zero if valid, a negative value if invalid. + *) +function avcodec_check_dimensions (av_log_ctx: pointer; w: cardinal; h: cardinal): integer; + cdecl; external av__codec; +function avcodec_default_get_format(s: PAVCodecContext; const fmt: PAVPixelFormat): TAVPixelFormat; + cdecl; external av__codec; + +function avcodec_thread_init (s: PAVCodecContext; thread_count: integer): integer; + cdecl; external av__codec; +procedure avcodec_thread_free (s: PAVCodecContext); + cdecl; external av__codec; +function avcodec_thread_execute (s: PAVCodecContext; func: TExecuteFunc; arg: PPointer; ret: Pinteger; count: integer): integer; + cdecl; external av__codec; +function avcodec_default_execute (s: PAVCodecContext; func: TExecuteFunc; arg: PPointer; ret: Pinteger; count: integer): integer; + cdecl; external av__codec; +//FIXME func typedef + +(** + * Initializes the AVCodecContext to use the given AVCodec. Prior to using this + * function the context has to be allocated. + * + * The functions avcodec_find_decoder_by_name(), avcodec_find_encoder_by_name(), + * avcodec_find_decoder() and avcodec_find_encoder() provide an easy way for + * retrieving a codec. + * + * @warning This function is not thread safe! + * + * @code + * avcodec_register_all(); + * codec = avcodec_find_decoder(CODEC_ID_H264); + * if (!codec) + * exit(1); + * + * context = avcodec_alloc_context(); + * + * if (avcodec_open(context, codec) < 0) + * exit(1); + * @endcode + * + * @param avctx The context which will be set up to use the given codec. + * @param codec The codec to use within the context. + * @return zero on success, a negative value on error + * @see avcodec_alloc_context, avcodec_find_decoder, avcodec_find_encoder + *) +function avcodec_open (avctx: PAVCodecContext; codec: PAVCodec): integer; + cdecl; external av__codec; + +(** + * @deprecated Use avcodec_decode_audio2() instead. + *) +function avcodec_decode_audio (avctx: PAVCodecContext; samples: Pword; + var frame_size_ptr: integer; + {const} buf: pchar; buf_size: integer): integer; + cdecl; external av__codec; + +{$IF LIBAVCODEC_VERSION >= 51030000} // 51.30.0 +(** + * Decodes an audio frame from \p buf into \p samples. + * The avcodec_decode_audio2() function decodes an audio frame from the input + * buffer \p buf of size \p buf_size. To decode it, it makes use of the + * audio codec which was coupled with \p avctx using avcodec_open(). The + * resulting decoded frame is stored in output buffer \p samples. If no frame + * could be decompressed, \p frame_size_ptr is zero. Otherwise, it is the + * decompressed frame size in \e bytes. + * + * @warning You \e must set \p frame_size_ptr to the allocated size of the + * output buffer before calling avcodec_decode_audio2(). + * + * @warning The input buffer must be \c FF_INPUT_BUFFER_PADDING_SIZE larger than + * the actual read bytes because some optimized bitstream readers read 32 or 64 + * bits at once and could read over the end. + * + * @warning The end of the input buffer \p buf should be set to 0 to ensure that + * no overreading happens for damaged MPEG streams. + * + * @note You might have to align the input buffer \p buf and output buffer \p + * samples. The alignment requirements depend on the CPU: On some CPUs it isn't + * necessary at all, on others it won't work at all if not aligned and on others + * it will work but it will have an impact on performance. In practice, the + * bitstream should have 4 byte alignment at minimum and all sample data should + * be 16 byte aligned unless the CPU doesn't need it (AltiVec and SSE do). If + * the linesize is not a multiple of 16 then there's no sense in aligning the + * start of the buffer to 16. + * + * @param avctx the codec context + * @param[out] samples the output buffer + * @param[in,out] frame_size_ptr the output buffer size in bytes + * @param[in] buf the input buffer + * @param[in] buf_size the input buffer size in bytes + * @return On error a negative value is returned, otherwise the number of bytes + * used or zero if no frame could be decompressed. + *) +function avcodec_decode_audio2(avctx : PAVCodecContext; samples : PSmallint; + var frame_size_ptr : integer; + {const} buf: pchar; buf_size: integer): integer; + cdecl; external av__codec; +{$IFEND} + +(** + * Decodes a video frame from \p buf into \p picture. + * The avcodec_decode_video() function decodes a video frame from the input + * buffer \p buf of size \p buf_size. To decode it, it makes use of the + * video codec which was coupled with \p avctx using avcodec_open(). The + * resulting decoded frame is stored in \p picture. + * + * @warning The input buffer must be \c FF_INPUT_BUFFER_PADDING_SIZE larger than + * the actual read bytes because some optimized bitstream readers read 32 or 64 + * bits at once and could read over the end. + * + * @warning The end of the input buffer \p buf should be set to 0 to ensure that + * no overreading happens for damaged MPEG streams. + * + * @note You might have to align the input buffer \p buf and output buffer \p + * samples. The alignment requirements depend on the CPU: on some CPUs it isn't + * necessary at all, on others it won't work at all if not aligned and on others + * it will work but it will have an impact on performance. In practice, the + * bitstream should have 4 byte alignment at minimum and all sample data should + * be 16 byte aligned unless the CPU doesn't need it (AltiVec and SSE do). If + * the linesize is not a multiple of 16 then there's no sense in aligning the + * start of the buffer to 16. + * + * @param avctx the codec context + * @param[out] picture The AVFrame in which the decoded video frame will be stored. + * @param[in] buf the input buffer + * @param[in] buf_size the size of the input buffer in bytes + * @param[in,out] got_picture_ptr Zero if no frame could be decompressed, otherwise, it is nonzero. + * @return On error a negative value is returned, otherwise the number of bytes + * used or zero if no frame could be decompressed. + *) +function avcodec_decode_video (avctx: PAVCodecContext; picture: PAVFrame; + var got_picture_ptr: integer; + {const} buf: PByte; buf_size: integer): integer; + cdecl; external av__codec; + +(* Decode a subtitle message. Return -1 if error, otherwise return the + * number of bytes used. If no subtitle could be decompressed, + * got_sub_ptr is zero. Otherwise, the subtitle is stored in *sub. *) +function avcodec_decode_subtitle (avctx: PAVCodecContext; sub: PAVSubtitle; + var got_sub_ptr: integer; + {const} buf: pchar; buf_size: integer): integer; + cdecl; external av__codec; +function avcodec_parse_frame (avctx: PAVCodecContext; pdata: PPointer; + data_size_ptr: pinteger; + buf: pchar; buf_size: integer): integer; + cdecl; external av__codec; + +(** + * Encodes an audio frame from \p samples into \p buf. + * The avcodec_encode_audio() function encodes an audio frame from the input + * buffer \p samples. To encode it, it makes use of the audio codec which was + * coupled with \p avctx using avcodec_open(). The resulting encoded frame is + * stored in output buffer \p buf. + * + * @note The output buffer should be at least \c FF_MIN_BUFFER_SIZE bytes large. + * + * @param avctx the codec context + * @param[out] buf the output buffer + * @param[in] buf_size the output buffer size + * @param[in] samples the input buffer containing the samples + * The number of samples read from this buffer is frame_size*channels, + * both of which are defined in \p avctx. + * @return On error a negative value is returned, on success zero or the number + * of bytes used to encode the data read from the input buffer. + *) +function avcodec_encode_audio (avctx: PAVCodecContext; buf: PByte; + buf_size: integer; {const} samples: PWord): integer; + cdecl; external av__codec; + +(** + * Encodes a video frame from \p pict into \p buf. + * The avcodec_encode_video() function encodes a video frame from the input + * \p pict. To encode it, it makes use of the video codec which was coupled with + * \p avctx using avcodec_open(). The resulting encoded bytes representing the + * frame are stored in the output buffer \p buf. The input picture should be + * stored using a specific format, namely \c avctx.pix_fmt. + * + * @param avctx the codec context + * @param[out] buf the output buffer for the bitstream of encoded frame + * @param[in] buf_size the size of the output buffer in bytes + * @param[in] pict the input picture to encode + * @return On error a negative value is returned, on success zero or the number + * of bytes used from the input buffer. + *) +function avcodec_encode_video (avctx: PAVCodecContext; buf: PByte; + buf_size: integer; pict: PAVFrame): integer; + cdecl; external av__codec; +function avcodec_encode_subtitle (avctx: PAVCodecContext; buf: pchar; + buf_size: integer; {const} sub: PAVSubtitle): integer; + cdecl; external av__codec; + +function avcodec_close (avctx: PAVCodecContext): integer; + cdecl; external av__codec; + +procedure avcodec_register_all (); + cdecl; external av__codec; + +(** + * Flush buffers, should be called when seeking or when switching to a different stream. + *) +procedure avcodec_flush_buffers (avctx: PAVCodecContext); + cdecl; external av__codec; + +procedure avcodec_default_free_buffers (s: PAVCodecContext); + cdecl; external av__codec; + +(* misc useful functions *) + +(** + * Returns a single letter to describe the given picture type \p pict_type. + * + * @param[in] pict_type the picture type + * @return A single character representing the picture type. + *) +function av_get_pict_type_char (pict_type: integer): char; + cdecl; external av__codec; + +(** + * Returns codec bits per sample. + * + * @param[in] codec_id the codec + * @return Number of bits per sample or zero if unknown for the given codec. + *) +function av_get_bits_per_sample (codec_id: TCodecID): integer; + cdecl; external av__codec; + +{$IF LIBAVCODEC_VERSION >= 51041000} // 51.41.0 +(** + * Returns sample format bits per sample. + * + * @param[in] sample_fmt the sample format + * @return Number of bits per sample or zero if unknown for the given sample format. + *) +function av_get_bits_per_sample_format(sample_fmt: TSampleFormat): integer; + cdecl; external av__codec; +{$IFEND} + +const + AV_PARSER_PTS_NB = 4; + PARSER_FLAG_COMPLETE_FRAMES = $0001; + +type + {* frame parsing *} + PAVCodecParserContext = ^TAVCodecParserContext; + PAVCodecParser = ^TAVCodecParser; + + TAVCodecParserContext = record + priv_data: pointer; + parser: PAVCodecParser; + frame_offset: int64; (* offset of the current frame *) + cur_offset: int64; (* current offset (incremented by each av_parser_parse()) *) + last_frame_offset: int64; (* offset of the last frame *) + (* video info *) + pict_type: integer; (* XXX: put it back in AVCodecContext *) + repeat_pict: integer; (* XXX: put it back in AVCodecContext *) + pts: int64; (* pts of the current frame *) + dts: int64; (* dts of the current frame *) + + (* private data *) + last_pts: int64; + last_dts: int64; + fetch_timestamp: integer; + + cur_frame_start_index: integer; + cur_frame_offset: array [0..AV_PARSER_PTS_NB - 1] of int64; + cur_frame_pts: array [0..AV_PARSER_PTS_NB - 1] of int64; + cur_frame_dts: array [0..AV_PARSER_PTS_NB - 1] of int64; + + flags: integer; + + {$IF LIBAVCODEC_VERSION >= 51040003} // 51.40.3 + offset: int64; ///< byte offset from starting packet start + last_offset: int64; + {$IFEND} + end; + + TAVCodecParser = record + codec_ids: array [0..4] of integer; (* several codec IDs are permitted *) + priv_data_size: integer; + parser_init: function (s: PAVCodecParserContext): integer; cdecl; + parser_parse: function (s: PAVCodecParserContext; avctx: PAVCodecContext; + {const} poutbuf: PPointer; poutbuf_size: PInteger; + {const} buf: pchar; buf_size: integer): integer; cdecl; + parser_close: procedure (s: PAVCodecParserContext); cdecl; + split: function (avctx: PAVCodecContext; {const} buf: pchar; + buf_size: integer): integer; cdecl; + next: PAVCodecParser; + end; + + +{$IF LIBAVCODEC_VERSION < 52000000} // 52.0.0 +{ +var + av_first_parser: PAVCodecParser; external av__codec; +} +{$IFEND} + +{$IF LIBAVCODEC_VERSION >= 51049000} // 51.49.0 +function av_parser_next(c: PAVCodecParser): PAVCodecParser; + cdecl; external av__codec; +{$IFEND} + +procedure av_register_codec_parser (parser: PAVCodecParser); + cdecl; external av__codec; + +function av_parser_init (codec_id: integer): PAVCodecParserContext; + cdecl; external av__codec; + +function av_parser_parse (s: PAVCodecParserContext; + avctx: PAVCodecContext; + poutbuf: PPointer; poutbuf_size: pinteger; + const buf: pchar; buf_size: integer; + pts: int64; dts: int64): integer; + cdecl; external av__codec; +function av_parser_change (s: PAVCodecParserContext; + avctx: PAVCodecContext; + poutbuf: PPointer; poutbuf_size: PInteger; + const buf: pchar; buf_size: integer; keyframe: integer): integer; + cdecl; external av__codec; +procedure av_parser_close (s: PAVCodecParserContext); + cdecl; external av__codec; + +type + PAVBitStreamFilterContext = ^TAVBitStreamFilterContext; + PAVBitStreamFilter = ^TAVBitStreamFilter; + + TAVBitStreamFilterContext = record + priv_data: pointer; + filter: PAVBitStreamFilter; + parser: PAVCodecParserContext; + next: PAVBitStreamFilterContext; + end; + + TAVBitStreamFilter = record + name: pchar; + priv_data_size: integer; + filter: function (bsfc: PAVBitStreamFilterContext; + avctx: PAVCodecContext; args: pchar; + poutbuf: PPointer; poutbuf_size: PInteger; + buf: PByte; buf_size: integer; keyframe: integer): integer; cdecl; + {$IF LIBAVCODEC_VERSION >= 51043000} // 51.43.0 + close: procedure (bsfc: PAVBitStreamFilterContext); + {$IFEND} + next: PAVBitStreamFilter; + end; + +procedure av_register_bitstream_filter (bsf: PAVBitStreamFilter); + cdecl; external av__codec; + +function av_bitstream_filter_init (name: pchar): PAVBitStreamFilterContext; + cdecl; external av__codec; + +function av_bitstream_filter_filter (bsfc: PAVBitStreamFilterContext; + avctx: PAVCodecContext; args: pchar; + poutbuf: PPointer; poutbuf_size: PInteger; + buf: PByte; buf_size: integer; keyframe: integer): integer; + cdecl; external av__codec; +procedure av_bitstream_filter_close (bsf: PAVBitStreamFilterContext); + cdecl; external av__codec; + +{$IF LIBAVCODEC_VERSION >= 51049000} // 51.49.0 +function av_bitstream_filter_next(f: PAVBitStreamFilter): PAVBitStreamFilter; + cdecl; external av__codec; +{$IFEND} + +(* memory *) + +(** + * Reallocates the given block if it is not large enough, otherwise it + * does nothing. + * + * @see av_realloc + *) +procedure av_fast_realloc (ptr: pointer; size: PCardinal; min_size: Cardinal); + cdecl; external av__codec; + +(* for static data only *) + +(** + * Frees all static arrays and resets their pointers to 0. + * Call this function to release all statically allocated tables. + * + * @deprecated. Code which uses av_free_static is broken/misdesigned + * and should correctly use static arrays + * + *) +procedure av_free_static (); + cdecl; external av__codec; deprecated; + +(** + * Allocation of static arrays. + * + * @warning Do not use for normal allocation. + * + * @param[in] size The amount of memory you need in bytes. + * @return block of memory of the requested size + * @deprecated. Code which uses av_mallocz_static is broken/misdesigned + * and should correctly use static arrays + *) +procedure av_mallocz_static(size: cardinal); + cdecl; external av__codec; deprecated; {av_malloc_attrib av_alloc_size(1)} + +{$IF LIBAVCODEC_VERSION < 51035000} // 51.35.0 +procedure av_realloc_static(ptr: pointer; size: Cardinal); + cdecl; external av__codec; +{$IFEND} + +{$IF LIBAVCODEC_VERSION >= 51039000} // 51.39.0 +(** + * Copy image 'src' to 'dst'. + *) +procedure av_picture_copy(dst: PAVPicture; {const} src: PAVPicture; + pix_fmt: integer; width: integer; height: integer); + cdecl; external av__codec; + +(** + * Crop image top and left side. + *) +function av_picture_crop(dst: PAVPicture; {const} src: PAVPicture; + pix_fmt: integer; top_band: integer; left_band: integer): integer; + cdecl; external av__codec; + +(** + * Pad image. + *) +function av_picture_pad(dst: PAVPicture; {const} src: PAVPicture; height: integer; width: integer; pix_fmt: integer; + padtop: integer; padbottom: integer; padleft: integer; padright: integer; color: PInteger): integer; + cdecl; external av__codec; +{$IFEND} + +{$IF LIBAVCODEC_VERSION < 52000000} // 52.0.0 +(** + * @deprecated Use the software scaler (swscale) instead. + *) +procedure img_copy (dst: PAVPicture; const src: PAVPicture; + pix_fmt: TAVPixelFormat; width: integer; height: integer); + cdecl; external av__codec; deprecated; + +(** + * @deprecated Use the software scaler (swscale) instead. + *) +function img_crop (dst: PAVPicture; const src: PAVPicture; + pix_fmt: TAVPixelFormat; top_band, left_band: integer): integer; + cdecl; external av__codec; deprecated; + +(** + * @deprecated Use the software scaler (swscale) instead. + *) +function img_pad (dst: PAVPicture; const src: PAVPicture; height, width: integer; + pix_fmt: TAVPixelFormat; padtop, padbottom, padleft, padright: integer; + color: PInteger): integer; + cdecl; external av__codec; deprecated; +{$IFEND} + +function av_xiphlacing(s: PByte; v: Cardinal): Cardinal; + cdecl; external av__codec; + +{$IF LIBAVCODEC_VERSION >= 51041000} // 51.41.0 +(** + * Parses \p str and put in \p width_ptr and \p height_ptr the detected values. + * + * @return 0 in case of a successful parsing, a negative value otherwise + * @param[in] str the string to parse: it has to be a string in the format + * <width>x<height> or a valid video frame size abbreviation. + * @param[in,out] width_ptr pointer to the variable which will contain the detected + * frame width value + * @param[in,out] height_ptr pointer to the variable which will contain the detected + * frame height value + *) +function av_parse_video_frame_size(width_ptr: PInteger; height_ptr: PInteger; {const} str: PChar): integer; + cdecl; external av__codec; + +(** + * Parses \p str and put in \p frame_rate the detected values. + * + * @return 0 in case of a successful parsing, a negative value otherwise + * @param[in] str the string to parse: it has to be a string in the format + * <frame_rate_nom>/<frame_rate_den>, a float number or a valid video rate abbreviation + * @param[in,out] frame_rate pointer to the AVRational which will contain the detected + * frame rate + *) +function av_parse_video_frame_rate(frame_rate: PAVRational; {const} str: PChar): integer; + cdecl; external av__codec; +{$IFEND} + +{* error handling *} + +const +{$IFDEF UNIX} + ENOENT = ESysENOENT; + EIO = ESysEIO; + ENOMEM = ESysENOMEM; + EINVAL = ESysEINVAL; + EDOM = ESysEDOM; + ENOSYS = ESysENOSYS; + EILSEQ = ESysEILSEQ; +{$ELSE} + ENOENT = 2; + EIO = 5; + ENOMEM = 12; + EINVAL = 22; + EDOM = 33; + {$IFDEF MSWINDOWS} + // Note: we assume that ffmpeg was compiled with MinGW. + // This must be changed if DLLs were compiled with cygwin. + ENOSYS = 40; // MSVC/MINGW: 40, CYGWIN: 88, LINUX/FPC: 38 + EILSEQ = 42; // MSVC/MINGW: 42, CYGWIN: 138, LINUX/FPC: 84 + {$ENDIF} +{$ENDIF} + +const +{$IF EINVAL > 0} + AVERROR_SIGN = -1; +{$ELSE} + {* Some platforms have E* and errno already negated. *} + AVERROR_SIGN = 1; +{$IFEND} + +(* +#if EINVAL > 0 +#define AVERROR(e) (-(e)) {**< Returns a negative error code from a POSIX error code, to return from library functions. *} +#define AVUNERROR(e) (-(e)) {**< Returns a POSIX error code from a library function error return value. *} +#else +{* Some platforms have E* and errno already negated. *} +#define AVERROR(e) (e) +#define AVUNERROR(e) (e) +#endif +*) + +const + AVERROR_UNKNOWN = AVERROR_SIGN * EINVAL; (**< unknown error *) + AVERROR_IO = AVERROR_SIGN * EIO; (**< I/O error *) + AVERROR_NUMEXPECTED = AVERROR_SIGN * EDOM; (**< Number syntax expected in filename. *) + AVERROR_INVALIDDATA = AVERROR_SIGN * EINVAL; (**< invalid data found *) + AVERROR_NOMEM = AVERROR_SIGN * ENOMEM; (**< not enough memory *) + AVERROR_NOFMT = AVERROR_SIGN * EILSEQ; (**< unknown format *) + AVERROR_NOTSUPP = AVERROR_SIGN * ENOSYS; (**< Operation not supported. *) + AVERROR_NOENT = AVERROR_SIGN * ENOENT; {**< No such file or directory. *} + // Note: function calls as constant-initializers are invalid + //AVERROR_PATCHWELCOME = -MKTAG('P','A','W','E'); {**< Not yet implemented in FFmpeg. Patches welcome. *} + AVERROR_PATCHWELCOME = -(ord('P') or (ord('A') shl 8) or (ord('W') shl 16) or (ord('E') shl 24)); + +implementation + +end. diff --git a/Game/Code/lib/ffmpeg/avutil.pas b/Game/Code/lib/ffmpeg/avutil.pas index dec63aa7..d0499755 100644 --- a/Game/Code/lib/ffmpeg/avutil.pas +++ b/Game/Code/lib/ffmpeg/avutil.pas @@ -1,301 +1,301 @@ -(*
- * copyright (c) 2006 Michael Niedermayer <michaelni@gmx.at>
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser 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
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
- *)
-
-(* This is a part of Pascal porting of ffmpeg.
- * Originally by Victor Zinetz for Delphi and Free Pascal on Windows.
- * For Mac OS X, some modifications were made by The Creative CAT, denoted as CAT
- * in the source codes *)
-
-(*
- * avutil.h:
- * Min. version: ?
- * Max. version: revision 12410, Mon Mar 10 18:42:09 2008 UTC
- *
- * mem.h:
- * revision 12501, Wed Mar 19 07:43:43 2008 UTC
- *
- * log.h:
- * revision 13068, Tue May 6 08:41:13 2008 UTC
- *)
-
-unit avutil;
-
-{$IFDEF FPC}
- {$MODE DELPHI}
- {$PACKENUM 4} (* use 4-byte enums *)
- {$PACKRECORDS C} (* C/C++-compatible record packing *)
-{$ELSE}
- {$MINENUMSIZE 4} (* use 4-byte enums *)
-{$ENDIF}
-
-{$IFDEF DARWIN}
- {$linklib libavutil}
-{$ENDIF}
-
-interface
-
-uses
- mathematics,
- rational,
- UConfig;
-
-const
- (* Max. supported version by this header *)
- LIBAVUTIL_MAX_VERSION_MAJOR = 49;
- LIBAVUTIL_MAX_VERSION_MINOR = 6;
- LIBAVUTIL_MAX_VERSION_RELEASE = 0;
- LIBAVUTIL_MAX_VERSION = (LIBAVUTIL_MAX_VERSION_MAJOR * VERSION_MAJOR) +
- (LIBAVUTIL_MAX_VERSION_MINOR * VERSION_MINOR) +
- (LIBAVUTIL_MAX_VERSION_RELEASE * VERSION_RELEASE);
-
-(* Check if linked versions are supported *)
-{$IF (LIBAVUTIL_VERSION > LIBAVUTIL_MAX_VERSION)}
- {$MESSAGE Warn 'Linked version of libavutil may be unsupported!'}
-{$IFEND}
-
-{$IFDEF FPC}
- // check for version of FPC < 2.2.0
- {$IF (FPC_VERSION < 2) or ((FPC_VERSION = 2) and (FPC_RELEASE < 2))}
- type uint64 = QWord;
- {$IFEND}
-{$ENDIF}
-
-type
-(**
- * Pixel format. Notes:
- *
- * PIX_FMT_RGB32 is handled in an endian-specific manner. A RGBA
- * color is put together as:
- * (A << 24) | (R << 16) | (G << 8) | B
- * This is stored as BGRA on little endian CPU architectures and ARGB on
- * big endian CPUs.
- *
- * When the pixel format is palettized RGB (PIX_FMT_PAL8), the palettized
- * image data is stored in AVFrame.data[0]. The palette is transported in
- * AVFrame.data[1] and, is 1024 bytes long (256 4-byte entries) and is
- * formatted the same as in PIX_FMT_RGB32 described above (i.e., it is
- * also endian-specific). Note also that the individual RGB palette
- * components stored in AVFrame.data[1] should be in the range 0..255.
- * This is important as many custom PAL8 video codecs that were designed
- * to run on the IBM VGA graphics adapter use 6-bit palette components.
- *)
-
- PAVPixelFormat = ^TAVPixelFormat;
- TAVPixelFormat = (
- PIX_FMT_NONE= -1,
- PIX_FMT_YUV420P, ///< Planar YUV 4:2:0, 12bpp, (1 Cr & Cb sample per 2x2 Y samples)
- PIX_FMT_YUYV422, ///< Packed YUV 4:2:2, 16bpp, Y0 Cb Y1 Cr
- PIX_FMT_RGB24, ///< Packed RGB 8:8:8, 24bpp, RGBRGB...
- PIX_FMT_BGR24, ///< Packed RGB 8:8:8, 24bpp, BGRBGR...
- PIX_FMT_YUV422P, ///< Planar YUV 4:2:2, 16bpp, (1 Cr & Cb sample per 2x1 Y samples)
- PIX_FMT_YUV444P, ///< Planar YUV 4:4:4, 24bpp, (1 Cr & Cb sample per 1x1 Y samples)
- PIX_FMT_RGB32, ///< Packed RGB 8:8:8, 32bpp, (msb)8A 8R 8G 8B(lsb), in cpu endianness
- PIX_FMT_YUV410P, ///< Planar YUV 4:1:0, 9bpp, (1 Cr & Cb sample per 4x4 Y samples)
- PIX_FMT_YUV411P, ///< Planar YUV 4:1:1, 12bpp, (1 Cr & Cb sample per 4x1 Y samples)
- PIX_FMT_RGB565, ///< Packed RGB 5:6:5, 16bpp, (msb) 5R 6G 5B(lsb), in cpu endianness
- PIX_FMT_RGB555, ///< Packed RGB 5:5:5, 16bpp, (msb)1A 5R 5G 5B(lsb), in cpu endianness most significant bit to 1
- PIX_FMT_GRAY8, ///< Y , 8bpp
- PIX_FMT_MONOWHITE, ///< Y , 1bpp, 0 is white, 1 is black
- PIX_FMT_MONOBLACK, ///< Y , 1bpp, 0 is black, 1 is white
- PIX_FMT_PAL8, ///< 8 bit with PIX_FMT_RGB32 palette
- PIX_FMT_YUVJ420P, ///< Planar YUV 4:2:0, 12bpp, full scale (jpeg)
- PIX_FMT_YUVJ422P, ///< Planar YUV 4:2:2, 16bpp, full scale (jpeg)
- PIX_FMT_YUVJ444P, ///< Planar YUV 4:4:4, 24bpp, full scale (jpeg)
- PIX_FMT_XVMC_MPEG2_MC,///< XVideo Motion Acceleration via common packet passing(xvmc_render.h)
- PIX_FMT_XVMC_MPEG2_IDCT,
- PIX_FMT_UYVY422, ///< Packed YUV 4:2:2, 16bpp, Cb Y0 Cr Y1
- PIX_FMT_UYYVYY411, ///< Packed YUV 4:1:1, 12bpp, Cb Y0 Y1 Cr Y2 Y3
- PIX_FMT_BGR32, ///< Packed RGB 8:8:8, 32bpp, (msb)8A 8B 8G 8R(lsb), in cpu endianness
- PIX_FMT_BGR565, ///< Packed RGB 5:6:5, 16bpp, (msb) 5B 6G 5R(lsb), in cpu endianness
- PIX_FMT_BGR555, ///< Packed RGB 5:5:5, 16bpp, (msb)1A 5B 5G 5R(lsb), in cpu endianness most significant bit to 1
- PIX_FMT_BGR8, ///< Packed RGB 3:3:2, 8bpp, (msb)2B 3G 3R(lsb)
- PIX_FMT_BGR4, ///< Packed RGB 1:2:1, 4bpp, (msb)1B 2G 1R(lsb)
- PIX_FMT_BGR4_BYTE, ///< Packed RGB 1:2:1, 8bpp, (msb)1B 2G 1R(lsb)
- PIX_FMT_RGB8, ///< Packed RGB 3:3:2, 8bpp, (msb)2R 3G 3B(lsb)
- PIX_FMT_RGB4, ///< Packed RGB 1:2:1, 4bpp, (msb)2R 3G 3B(lsb)
- PIX_FMT_RGB4_BYTE, ///< Packed RGB 1:2:1, 8bpp, (msb)2R 3G 3B(lsb)
- PIX_FMT_NV12, ///< Planar YUV 4:2:0, 12bpp, 1 plane for Y and 1 for UV
- PIX_FMT_NV21, ///< as above, but U and V bytes are swapped
-
- PIX_FMT_RGB32_1, ///< Packed RGB 8:8:8, 32bpp, (msb)8R 8G 8B 8A(lsb), in cpu endianness
- PIX_FMT_BGR32_1, ///< Packed RGB 8:8:8, 32bpp, (msb)8B 8G 8R 8A(lsb), in cpu endianness
-
- PIX_FMT_GRAY16BE, ///< Y , 16bpp, big-endian
- PIX_FMT_GRAY16LE, ///< Y , 16bpp, little-endian
- PIX_FMT_YUV440P, ///< Planar YUV 4:4:0 (1 Cr & Cb sample per 1x2 Y samples)
- PIX_FMT_YUVJ440P, ///< Planar YUV 4:4:0 full scale (jpeg)
- PIX_FMT_YUVA420P, ///< Planar YUV 4:2:0, 20bpp, (1 Cr & Cb sample per 2x2 Y & A samples)
- PIX_FMT_NB ///< number of pixel formats, DO NOT USE THIS if you want to link with shared libav* because the number of formats might differ between versions
- );
-
-const
-{$ifdef WORDS_BIGENDIAN}
- PIX_FMT_RGBA = PIX_FMT_RGB32_1;
- PIX_FMT_BGRA = PIX_FMT_BGR32_1;
- PIX_FMT_ARGB = PIX_FMT_RGB32;
- PIX_FMT_ABGR = PIX_FMT_BGR32;
- PIX_FMT_GRAY16 = PIX_FMT_GRAY16BE;
-{$else}
- PIX_FMT_RGBA = PIX_FMT_BGR32;
- PIX_FMT_BGRA = PIX_FMT_RGB32;
- PIX_FMT_ARGB = PIX_FMT_BGR32_1;
- PIX_FMT_ABGR = PIX_FMT_RGB32_1;
- PIX_FMT_GRAY16 = PIX_FMT_GRAY16LE;
-{$endif}
-
-{$IF LIBAVUTIL_VERSION_MAJOR < 50} // 50.0.0
- PIX_FMT_UYVY411 = PIX_FMT_UYYVYY411;
- PIX_FMT_RGBA32 = PIX_FMT_RGB32;
- PIX_FMT_YUV422 = PIX_FMT_YUYV422;
-{$IFEND}
-
-(* common.h *)
-
-function MKTAG(a,b,c,d: char): integer;
-
-(* mem.h *)
-
-(**
- * Allocate a block of \p size bytes with alignment suitable for all
- * memory accesses (including vectors if available on the CPU).
- * @param size Size in bytes for the memory block to be allocated.
- * @return Pointer to the allocated block, NULL if it cannot allocate
- * it.
- * @see av_mallocz()
- *)
-function av_malloc (size: cardinal): pointer;
- cdecl; external av__util; {av_malloc_attrib av_alloc_size(1)}
-
-(**
- * Allocate or reallocate a block of memory.
- * If \p ptr is NULL and \p size > 0, allocate a new block. If \p
- * size is zero, free the memory block pointed by \p ptr.
- * @param size Size in bytes for the memory block to be allocated or
- * reallocated.
- * @param ptr Pointer to a memory block already allocated with
- * av_malloc(z)() or av_realloc() or NULL.
- * @return Pointer to a newly reallocated block or NULL if it cannot
- * reallocate or the function is used to free the memory block.
- * @see av_fast_realloc()
- *)
-function av_realloc (ptr: pointer; size: cardinal): pointer;
- cdecl; external av__util; {av_alloc_size(2)}
-
-(**
- * Free a memory block which has been allocated with av_malloc(z)() or
- * av_realloc().
- * @param ptr Pointer to the memory block which should be freed.
- * @note ptr = NULL is explicitly allowed.
- * @note It is recommended that you use av_freep() instead.
- * @see av_freep()
- *)
-procedure av_free (ptr: pointer);
- cdecl; external av__util;
-
-(**
- * Allocate a block of \p size bytes with alignment suitable for all
- * memory accesses (including vectors if available on the CPU) and
- * set to zeroes all the bytes of the block.
- * @param size Size in bytes for the memory block to be allocated.
- * @return Pointer to the allocated block, NULL if it cannot allocate
- * it.
- * @see av_malloc()
- *)
-function av_mallocz (size: cardinal): pointer;
- cdecl; external av__util; {av_malloc_attrib av_alloc_size(1)}
-
-(**
- * Duplicate the string \p s.
- * @param s String to be duplicated.
- * @return Pointer to a newly allocated string containing a
- * copy of \p s or NULL if it cannot be allocated.
- *)
-function av_strdup({const} s: pchar): pchar;
- cdecl; external av__util; {av_malloc_attrib}
-
-(**
- * Free a memory block which has been allocated with av_malloc(z)() or
- * av_realloc() and set to NULL the pointer to it.
- * @param ptr Pointer to the pointer to the memory block which should
- * be freed.
- * @see av_free()
- *)
-procedure av_freep (ptr: pointer);
- cdecl; external av__util;
-
-(* log.h *)
-
-const
-{$IF LIBAVUTIL_VERSION_MAJOR < 50}
- AV_LOG_QUIET = -1;
- AV_LOG_FATAL = 0;
- AV_LOG_ERROR = 0;
- AV_LOG_WARNING = 1;
- AV_LOG_INFO = 1;
- AV_LOG_VERBOSE = 1;
- AV_LOG_DEBUG = 2;
-{$ELSE}
- AV_LOG_QUIET = -8;
-
-(**
- * something went really wrong and we will crash now
- *)
- AV_LOG_PANIC = 0;
-
-(**
- * something went wrong and recovery is not possible
- * like no header in a format which depends on it or a combination
- * of parameters which are not allowed
- *)
- AV_LOG_FATAL = 8;
-
-(**
- * something went wrong and cannot losslessly be recovered
- * but not all future data is affected
- *)
- AV_LOG_ERROR = 16;
-
-(**
- * something somehow does not look correct / something which may or may not
- * lead to some problems like use of -vstrict -2
- *)
- AV_LOG_WARNING = 24;
-
- AV_LOG_INFO = 32;
- AV_LOG_VERBOSE = 40;
-
-(**
- * stuff which is only useful for libav* developers
- *)
- AV_LOG_DEBUG = 48;
-{$IFEND}
-
-function av_log_get_level(): integer;
- cdecl; external av__util;
-procedure av_log_set_level(level: integer);
- cdecl; external av__util;
-
-
-implementation
-
-function MKTAG(a,b,c,d: char): integer;
-begin
- Result := (ord(a) or (ord(b) shl 8) or (ord(c) shl 16) or (ord(d) shl 24));
-end;
-
-end.
+(* + * copyright (c) 2006 Michael Niedermayer <michaelni@gmx.at> + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser 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 + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + *) + +(* This is a part of Pascal porting of ffmpeg. + * Originally by Victor Zinetz for Delphi and Free Pascal on Windows. + * For Mac OS X, some modifications were made by The Creative CAT, denoted as CAT + * in the source codes *) + +(* + * avutil.h: + * Min. version: ? + * Max. version: revision 12410, Mon Mar 10 18:42:09 2008 UTC + * + * mem.h: + * revision 12501, Wed Mar 19 07:43:43 2008 UTC + * + * log.h: + * revision 13068, Tue May 6 08:41:13 2008 UTC + *) + +unit avutil; + +{$IFDEF FPC} + {$MODE DELPHI} + {$PACKENUM 4} (* use 4-byte enums *) + {$PACKRECORDS C} (* C/C++-compatible record packing *) +{$ELSE} + {$MINENUMSIZE 4} (* use 4-byte enums *) +{$ENDIF} + +{$IFDEF DARWIN} + {$linklib libavutil} +{$ENDIF} + +interface + +uses + mathematics, + rational, + UConfig; + +const + (* Max. supported version by this header *) + LIBAVUTIL_MAX_VERSION_MAJOR = 49; + LIBAVUTIL_MAX_VERSION_MINOR = 6; + LIBAVUTIL_MAX_VERSION_RELEASE = 0; + LIBAVUTIL_MAX_VERSION = (LIBAVUTIL_MAX_VERSION_MAJOR * VERSION_MAJOR) + + (LIBAVUTIL_MAX_VERSION_MINOR * VERSION_MINOR) + + (LIBAVUTIL_MAX_VERSION_RELEASE * VERSION_RELEASE); + +(* Check if linked versions are supported *) +{$IF (LIBAVUTIL_VERSION > LIBAVUTIL_MAX_VERSION)} + {$MESSAGE Warn 'Linked version of libavutil may be unsupported!'} +{$IFEND} + +{$IFDEF FPC} + // check for version of FPC < 2.2.0 + {$IF (FPC_VERSION < 2) or ((FPC_VERSION = 2) and (FPC_RELEASE < 2))} + type uint64 = QWord; + {$IFEND} +{$ENDIF} + +type +(** + * Pixel format. Notes: + * + * PIX_FMT_RGB32 is handled in an endian-specific manner. A RGBA + * color is put together as: + * (A << 24) | (R << 16) | (G << 8) | B + * This is stored as BGRA on little endian CPU architectures and ARGB on + * big endian CPUs. + * + * When the pixel format is palettized RGB (PIX_FMT_PAL8), the palettized + * image data is stored in AVFrame.data[0]. The palette is transported in + * AVFrame.data[1] and, is 1024 bytes long (256 4-byte entries) and is + * formatted the same as in PIX_FMT_RGB32 described above (i.e., it is + * also endian-specific). Note also that the individual RGB palette + * components stored in AVFrame.data[1] should be in the range 0..255. + * This is important as many custom PAL8 video codecs that were designed + * to run on the IBM VGA graphics adapter use 6-bit palette components. + *) + + PAVPixelFormat = ^TAVPixelFormat; + TAVPixelFormat = ( + PIX_FMT_NONE= -1, + PIX_FMT_YUV420P, ///< Planar YUV 4:2:0, 12bpp, (1 Cr & Cb sample per 2x2 Y samples) + PIX_FMT_YUYV422, ///< Packed YUV 4:2:2, 16bpp, Y0 Cb Y1 Cr + PIX_FMT_RGB24, ///< Packed RGB 8:8:8, 24bpp, RGBRGB... + PIX_FMT_BGR24, ///< Packed RGB 8:8:8, 24bpp, BGRBGR... + PIX_FMT_YUV422P, ///< Planar YUV 4:2:2, 16bpp, (1 Cr & Cb sample per 2x1 Y samples) + PIX_FMT_YUV444P, ///< Planar YUV 4:4:4, 24bpp, (1 Cr & Cb sample per 1x1 Y samples) + PIX_FMT_RGB32, ///< Packed RGB 8:8:8, 32bpp, (msb)8A 8R 8G 8B(lsb), in cpu endianness + PIX_FMT_YUV410P, ///< Planar YUV 4:1:0, 9bpp, (1 Cr & Cb sample per 4x4 Y samples) + PIX_FMT_YUV411P, ///< Planar YUV 4:1:1, 12bpp, (1 Cr & Cb sample per 4x1 Y samples) + PIX_FMT_RGB565, ///< Packed RGB 5:6:5, 16bpp, (msb) 5R 6G 5B(lsb), in cpu endianness + PIX_FMT_RGB555, ///< Packed RGB 5:5:5, 16bpp, (msb)1A 5R 5G 5B(lsb), in cpu endianness most significant bit to 1 + PIX_FMT_GRAY8, ///< Y , 8bpp + PIX_FMT_MONOWHITE, ///< Y , 1bpp, 0 is white, 1 is black + PIX_FMT_MONOBLACK, ///< Y , 1bpp, 0 is black, 1 is white + PIX_FMT_PAL8, ///< 8 bit with PIX_FMT_RGB32 palette + PIX_FMT_YUVJ420P, ///< Planar YUV 4:2:0, 12bpp, full scale (jpeg) + PIX_FMT_YUVJ422P, ///< Planar YUV 4:2:2, 16bpp, full scale (jpeg) + PIX_FMT_YUVJ444P, ///< Planar YUV 4:4:4, 24bpp, full scale (jpeg) + PIX_FMT_XVMC_MPEG2_MC,///< XVideo Motion Acceleration via common packet passing(xvmc_render.h) + PIX_FMT_XVMC_MPEG2_IDCT, + PIX_FMT_UYVY422, ///< Packed YUV 4:2:2, 16bpp, Cb Y0 Cr Y1 + PIX_FMT_UYYVYY411, ///< Packed YUV 4:1:1, 12bpp, Cb Y0 Y1 Cr Y2 Y3 + PIX_FMT_BGR32, ///< Packed RGB 8:8:8, 32bpp, (msb)8A 8B 8G 8R(lsb), in cpu endianness + PIX_FMT_BGR565, ///< Packed RGB 5:6:5, 16bpp, (msb) 5B 6G 5R(lsb), in cpu endianness + PIX_FMT_BGR555, ///< Packed RGB 5:5:5, 16bpp, (msb)1A 5B 5G 5R(lsb), in cpu endianness most significant bit to 1 + PIX_FMT_BGR8, ///< Packed RGB 3:3:2, 8bpp, (msb)2B 3G 3R(lsb) + PIX_FMT_BGR4, ///< Packed RGB 1:2:1, 4bpp, (msb)1B 2G 1R(lsb) + PIX_FMT_BGR4_BYTE, ///< Packed RGB 1:2:1, 8bpp, (msb)1B 2G 1R(lsb) + PIX_FMT_RGB8, ///< Packed RGB 3:3:2, 8bpp, (msb)2R 3G 3B(lsb) + PIX_FMT_RGB4, ///< Packed RGB 1:2:1, 4bpp, (msb)2R 3G 3B(lsb) + PIX_FMT_RGB4_BYTE, ///< Packed RGB 1:2:1, 8bpp, (msb)2R 3G 3B(lsb) + PIX_FMT_NV12, ///< Planar YUV 4:2:0, 12bpp, 1 plane for Y and 1 for UV + PIX_FMT_NV21, ///< as above, but U and V bytes are swapped + + PIX_FMT_RGB32_1, ///< Packed RGB 8:8:8, 32bpp, (msb)8R 8G 8B 8A(lsb), in cpu endianness + PIX_FMT_BGR32_1, ///< Packed RGB 8:8:8, 32bpp, (msb)8B 8G 8R 8A(lsb), in cpu endianness + + PIX_FMT_GRAY16BE, ///< Y , 16bpp, big-endian + PIX_FMT_GRAY16LE, ///< Y , 16bpp, little-endian + PIX_FMT_YUV440P, ///< Planar YUV 4:4:0 (1 Cr & Cb sample per 1x2 Y samples) + PIX_FMT_YUVJ440P, ///< Planar YUV 4:4:0 full scale (jpeg) + PIX_FMT_YUVA420P, ///< Planar YUV 4:2:0, 20bpp, (1 Cr & Cb sample per 2x2 Y & A samples) + PIX_FMT_NB ///< number of pixel formats, DO NOT USE THIS if you want to link with shared libav* because the number of formats might differ between versions + ); + +const +{$ifdef WORDS_BIGENDIAN} + PIX_FMT_RGBA = PIX_FMT_RGB32_1; + PIX_FMT_BGRA = PIX_FMT_BGR32_1; + PIX_FMT_ARGB = PIX_FMT_RGB32; + PIX_FMT_ABGR = PIX_FMT_BGR32; + PIX_FMT_GRAY16 = PIX_FMT_GRAY16BE; +{$else} + PIX_FMT_RGBA = PIX_FMT_BGR32; + PIX_FMT_BGRA = PIX_FMT_RGB32; + PIX_FMT_ARGB = PIX_FMT_BGR32_1; + PIX_FMT_ABGR = PIX_FMT_RGB32_1; + PIX_FMT_GRAY16 = PIX_FMT_GRAY16LE; +{$endif} + +{$IF LIBAVUTIL_VERSION_MAJOR < 50} // 50.0.0 + PIX_FMT_UYVY411 = PIX_FMT_UYYVYY411; + PIX_FMT_RGBA32 = PIX_FMT_RGB32; + PIX_FMT_YUV422 = PIX_FMT_YUYV422; +{$IFEND} + +(* common.h *) + +function MKTAG(a,b,c,d: char): integer; + +(* mem.h *) + +(** + * Allocate a block of \p size bytes with alignment suitable for all + * memory accesses (including vectors if available on the CPU). + * @param size Size in bytes for the memory block to be allocated. + * @return Pointer to the allocated block, NULL if it cannot allocate + * it. + * @see av_mallocz() + *) +function av_malloc (size: cardinal): pointer; + cdecl; external av__util; {av_malloc_attrib av_alloc_size(1)} + +(** + * Allocate or reallocate a block of memory. + * If \p ptr is NULL and \p size > 0, allocate a new block. If \p + * size is zero, free the memory block pointed by \p ptr. + * @param size Size in bytes for the memory block to be allocated or + * reallocated. + * @param ptr Pointer to a memory block already allocated with + * av_malloc(z)() or av_realloc() or NULL. + * @return Pointer to a newly reallocated block or NULL if it cannot + * reallocate or the function is used to free the memory block. + * @see av_fast_realloc() + *) +function av_realloc (ptr: pointer; size: cardinal): pointer; + cdecl; external av__util; {av_alloc_size(2)} + +(** + * Free a memory block which has been allocated with av_malloc(z)() or + * av_realloc(). + * @param ptr Pointer to the memory block which should be freed. + * @note ptr = NULL is explicitly allowed. + * @note It is recommended that you use av_freep() instead. + * @see av_freep() + *) +procedure av_free (ptr: pointer); + cdecl; external av__util; + +(** + * Allocate a block of \p size bytes with alignment suitable for all + * memory accesses (including vectors if available on the CPU) and + * set to zeroes all the bytes of the block. + * @param size Size in bytes for the memory block to be allocated. + * @return Pointer to the allocated block, NULL if it cannot allocate + * it. + * @see av_malloc() + *) +function av_mallocz (size: cardinal): pointer; + cdecl; external av__util; {av_malloc_attrib av_alloc_size(1)} + +(** + * Duplicate the string \p s. + * @param s String to be duplicated. + * @return Pointer to a newly allocated string containing a + * copy of \p s or NULL if it cannot be allocated. + *) +function av_strdup({const} s: pchar): pchar; + cdecl; external av__util; {av_malloc_attrib} + +(** + * Free a memory block which has been allocated with av_malloc(z)() or + * av_realloc() and set to NULL the pointer to it. + * @param ptr Pointer to the pointer to the memory block which should + * be freed. + * @see av_free() + *) +procedure av_freep (ptr: pointer); + cdecl; external av__util; + +(* log.h *) + +const +{$IF LIBAVUTIL_VERSION_MAJOR < 50} + AV_LOG_QUIET = -1; + AV_LOG_FATAL = 0; + AV_LOG_ERROR = 0; + AV_LOG_WARNING = 1; + AV_LOG_INFO = 1; + AV_LOG_VERBOSE = 1; + AV_LOG_DEBUG = 2; +{$ELSE} + AV_LOG_QUIET = -8; + +(** + * something went really wrong and we will crash now + *) + AV_LOG_PANIC = 0; + +(** + * something went wrong and recovery is not possible + * like no header in a format which depends on it or a combination + * of parameters which are not allowed + *) + AV_LOG_FATAL = 8; + +(** + * something went wrong and cannot losslessly be recovered + * but not all future data is affected + *) + AV_LOG_ERROR = 16; + +(** + * something somehow does not look correct / something which may or may not + * lead to some problems like use of -vstrict -2 + *) + AV_LOG_WARNING = 24; + + AV_LOG_INFO = 32; + AV_LOG_VERBOSE = 40; + +(** + * stuff which is only useful for libav* developers + *) + AV_LOG_DEBUG = 48; +{$IFEND} + +function av_log_get_level(): integer; + cdecl; external av__util; +procedure av_log_set_level(level: integer); + cdecl; external av__util; + + +implementation + +function MKTAG(a,b,c,d: char): integer; +begin + Result := (ord(a) or (ord(b) shl 8) or (ord(c) shl 16) or (ord(d) shl 24)); +end; + +end. diff --git a/Game/Code/lib/midi/CIRCBUF.PAS b/Game/Code/lib/midi/CIRCBUF.PAS index c741230e..77cb3643 100644 --- a/Game/Code/lib/midi/CIRCBUF.PAS +++ b/Game/Code/lib/midi/CIRCBUF.PAS @@ -1,183 +1,183 @@ -{ $Header: /MidiComp/CIRCBUF.PAS 2 10/06/97 7:33 Davec $ }
-
-{ Written by David Churcher <dchurcher@cix.compulink.co.uk>,
- released to the public domain. }
-
-
-{ A First-In First-Out circular buffer.
- Port of circbuf.c from Microsoft's Windows MIDI monitor example.
- I did do a version of this as an object (see Rev 1.1) but it was getting too
- complicated and I couldn't see any real benefits to it so I dumped it
- for an ordinary memory buffer with pointers.
-
- This unit is a bit C-like, everything is done with pointers and extensive
- use is made of the undocumented feature of the Inc() function that
- increments pointers by the size of the object pointed to.
- All of this could probably be done using Pascal array notation with
- range-checking turned off, but I'm not sure it's worth it.
-}
-
-Unit Circbuf;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
- {$H+} // use AnsiString
-{$ENDIF}
-
-Uses
- Windows,
- MMSystem;
-
-type
- { MIDI input event }
- TMidiBufferItem = record
- timestamp: DWORD; { Timestamp in milliseconds after midiInStart }
- data: DWORD; { MIDI message received }
- sysex: PMidiHdr; { Pointer to sysex MIDIHDR, nil if not sysex }
- end;
- PMidiBufferItem = ^TMidiBufferItem;
-
- { MIDI input buffer }
- TCircularBuffer = record
- RecordHandle: HGLOBAL; { Windows memory handle for this record }
- BufferHandle: HGLOBAL; { Windows memory handle for the buffer }
- pStart: PMidiBufferItem; { ptr to start of buffer }
- pEnd: PMidiBufferItem; { ptr to end of buffer }
- pNextPut: PMidiBufferItem; { next location to fill }
- pNextGet: PMidiBufferItem; { next location to empty }
- Error: Word; { error code from MMSYSTEM functions }
- Capacity: Word; { buffer size (in TMidiBufferItems) }
- EventCount: Word; { Number of events in buffer }
- end;
-
- PCircularBuffer = ^TCircularBuffer;
-
-function GlobalSharedLockedAlloc( Capacity: Word; var hMem: HGLOBAL ): Pointer;
-procedure GlobalSharedLockedFree( hMem: HGLOBAL; ptr: Pointer );
-
-function CircbufAlloc( Capacity: Word ): PCircularBuffer;
-procedure CircbufFree( PBuffer: PCircularBuffer );
-function CircbufRemoveEvent( PBuffer: PCircularBuffer ): Boolean;
-function CircbufReadEvent( PBuffer: PCircularBuffer; PEvent: PMidiBufferItem ): Boolean;
-{ Note: The PutEvent function is in the DLL }
-
-implementation
-
-{ Allocates in global shared memory, returns pointer and handle }
-function GlobalSharedLockedAlloc( Capacity: Word; var hMem: HGLOBAL ): Pointer;
-var
- ptr: Pointer;
-begin
- { Allocate the buffer memory }
- hMem := GlobalAlloc(GMEM_SHARE Or GMEM_MOVEABLE Or GMEM_ZEROINIT, Capacity );
-
- if (hMem = 0) then
- ptr := Nil
- else
- begin
- ptr := GlobalLock(hMem);
- if (ptr = Nil) then
- GlobalFree(hMem);
- end;
-
- GlobalSharedLockedAlloc := Ptr;
-end;
-
-procedure GlobalSharedLockedFree( hMem: HGLOBAL; ptr: Pointer );
-begin
- if (hMem <> 0) then
- begin
- GlobalUnlock(hMem);
- GlobalFree(hMem);
- end;
-end;
-
-function CircbufAlloc( Capacity: Word ): PCircularBuffer;
-var
- NewCircularBuffer: PCircularBuffer;
- NewMIDIBuffer: PMidiBufferItem;
- hMem: HGLOBAL;
-begin
- { TODO: Validate circbuf size, <64K }
- NewCircularBuffer :=
- GlobalSharedLockedAlloc( Sizeof(TCircularBuffer), hMem );
- if (NewCircularBuffer <> Nil) then
- begin
- NewCircularBuffer^.RecordHandle := hMem;
- NewMIDIBuffer :=
- GlobalSharedLockedAlloc( Capacity * Sizeof(TMidiBufferItem), hMem );
- if (NewMIDIBuffer = Nil) then
- begin
- { TODO: Exception here? }
- GlobalSharedLockedFree( NewCircularBuffer^.RecordHandle,
- NewCircularBuffer );
- NewCircularBuffer := Nil;
- end
- else
- begin
- NewCircularBuffer^.pStart := NewMidiBuffer;
- { Point to item at end of buffer }
- NewCircularBuffer^.pEnd := NewMidiBuffer;
- Inc(NewCircularBuffer^.pEnd, Capacity);
- { Start off the get and put pointers in the same position. These
- will get out of sync as the interrupts start rolling in }
- NewCircularBuffer^.pNextPut := NewMidiBuffer;
- NewCircularBuffer^.pNextGet := NewMidiBuffer;
- NewCircularBuffer^.Error := 0;
- NewCircularBuffer^.Capacity := Capacity;
- NewCircularBuffer^.EventCount := 0;
- end;
- end;
- CircbufAlloc := NewCircularBuffer;
-end;
-
-procedure CircbufFree( pBuffer: PCircularBuffer );
-begin
- if (pBuffer <> Nil) then
- begin
- GlobalSharedLockedFree(pBuffer^.BufferHandle, pBuffer^.pStart);
- GlobalSharedLockedFree(pBuffer^.RecordHandle, pBuffer);
- end;
-end;
-
-{ Reads first event in queue without removing it.
- Returns true if successful, False if no events in queue }
-function CircbufReadEvent( PBuffer: PCircularBuffer; PEvent: PMidiBufferItem ): Boolean;
-var
- PCurrentEvent: PMidiBufferItem;
-begin
- if (PBuffer^.EventCount <= 0) then
- CircbufReadEvent := False
- else
- begin
- PCurrentEvent := PBuffer^.PNextget;
-
- { Copy the object from the "tail" of the buffer to the caller's object }
- PEvent^.Timestamp := PCurrentEvent^.Timestamp;
- PEvent^.Data := PCurrentEvent^.Data;
- PEvent^.Sysex := PCurrentEvent^.Sysex;
- CircbufReadEvent := True;
- end;
-end;
-
-{ Remove current event from the queue }
-function CircbufRemoveEvent(PBuffer: PCircularBuffer): Boolean;
-begin
- if (PBuffer^.EventCount > 0) then
- begin
- Dec( Pbuffer^.EventCount);
-
- { Advance the buffer pointer, with wrap }
- Inc( Pbuffer^.PNextGet );
- If (PBuffer^.PNextGet = PBuffer^.PEnd) then
- PBuffer^.PNextGet := PBuffer^.PStart;
-
- CircbufRemoveEvent := True;
- end
- else
- CircbufRemoveEvent := False;
-end;
-
-end.
+{ $Header: /MidiComp/CIRCBUF.PAS 2 10/06/97 7:33 Davec $ } + +{ Written by David Churcher <dchurcher@cix.compulink.co.uk>, + released to the public domain. } + + +{ A First-In First-Out circular buffer. + Port of circbuf.c from Microsoft's Windows MIDI monitor example. + I did do a version of this as an object (see Rev 1.1) but it was getting too + complicated and I couldn't see any real benefits to it so I dumped it + for an ordinary memory buffer with pointers. + + This unit is a bit C-like, everything is done with pointers and extensive + use is made of the undocumented feature of the Inc() function that + increments pointers by the size of the object pointed to. + All of this could probably be done using Pascal array notation with + range-checking turned off, but I'm not sure it's worth it. +} + +Unit Circbuf; + +interface + +{$IFDEF FPC} + {$MODE Delphi} + {$H+} // use AnsiString +{$ENDIF} + +Uses + Windows, + MMSystem; + +type + { MIDI input event } + TMidiBufferItem = record + timestamp: DWORD; { Timestamp in milliseconds after midiInStart } + data: DWORD; { MIDI message received } + sysex: PMidiHdr; { Pointer to sysex MIDIHDR, nil if not sysex } + end; + PMidiBufferItem = ^TMidiBufferItem; + + { MIDI input buffer } + TCircularBuffer = record + RecordHandle: HGLOBAL; { Windows memory handle for this record } + BufferHandle: HGLOBAL; { Windows memory handle for the buffer } + pStart: PMidiBufferItem; { ptr to start of buffer } + pEnd: PMidiBufferItem; { ptr to end of buffer } + pNextPut: PMidiBufferItem; { next location to fill } + pNextGet: PMidiBufferItem; { next location to empty } + Error: Word; { error code from MMSYSTEM functions } + Capacity: Word; { buffer size (in TMidiBufferItems) } + EventCount: Word; { Number of events in buffer } + end; + + PCircularBuffer = ^TCircularBuffer; + +function GlobalSharedLockedAlloc( Capacity: Word; var hMem: HGLOBAL ): Pointer; +procedure GlobalSharedLockedFree( hMem: HGLOBAL; ptr: Pointer ); + +function CircbufAlloc( Capacity: Word ): PCircularBuffer; +procedure CircbufFree( PBuffer: PCircularBuffer ); +function CircbufRemoveEvent( PBuffer: PCircularBuffer ): Boolean; +function CircbufReadEvent( PBuffer: PCircularBuffer; PEvent: PMidiBufferItem ): Boolean; +{ Note: The PutEvent function is in the DLL } + +implementation + +{ Allocates in global shared memory, returns pointer and handle } +function GlobalSharedLockedAlloc( Capacity: Word; var hMem: HGLOBAL ): Pointer; +var + ptr: Pointer; +begin + { Allocate the buffer memory } + hMem := GlobalAlloc(GMEM_SHARE Or GMEM_MOVEABLE Or GMEM_ZEROINIT, Capacity ); + + if (hMem = 0) then + ptr := Nil + else + begin + ptr := GlobalLock(hMem); + if (ptr = Nil) then + GlobalFree(hMem); + end; + + GlobalSharedLockedAlloc := Ptr; +end; + +procedure GlobalSharedLockedFree( hMem: HGLOBAL; ptr: Pointer ); +begin + if (hMem <> 0) then + begin + GlobalUnlock(hMem); + GlobalFree(hMem); + end; +end; + +function CircbufAlloc( Capacity: Word ): PCircularBuffer; +var + NewCircularBuffer: PCircularBuffer; + NewMIDIBuffer: PMidiBufferItem; + hMem: HGLOBAL; +begin + { TODO: Validate circbuf size, <64K } + NewCircularBuffer := + GlobalSharedLockedAlloc( Sizeof(TCircularBuffer), hMem ); + if (NewCircularBuffer <> Nil) then + begin + NewCircularBuffer^.RecordHandle := hMem; + NewMIDIBuffer := + GlobalSharedLockedAlloc( Capacity * Sizeof(TMidiBufferItem), hMem ); + if (NewMIDIBuffer = Nil) then + begin + { TODO: Exception here? } + GlobalSharedLockedFree( NewCircularBuffer^.RecordHandle, + NewCircularBuffer ); + NewCircularBuffer := Nil; + end + else + begin + NewCircularBuffer^.pStart := NewMidiBuffer; + { Point to item at end of buffer } + NewCircularBuffer^.pEnd := NewMidiBuffer; + Inc(NewCircularBuffer^.pEnd, Capacity); + { Start off the get and put pointers in the same position. These + will get out of sync as the interrupts start rolling in } + NewCircularBuffer^.pNextPut := NewMidiBuffer; + NewCircularBuffer^.pNextGet := NewMidiBuffer; + NewCircularBuffer^.Error := 0; + NewCircularBuffer^.Capacity := Capacity; + NewCircularBuffer^.EventCount := 0; + end; + end; + CircbufAlloc := NewCircularBuffer; +end; + +procedure CircbufFree( pBuffer: PCircularBuffer ); +begin + if (pBuffer <> Nil) then + begin + GlobalSharedLockedFree(pBuffer^.BufferHandle, pBuffer^.pStart); + GlobalSharedLockedFree(pBuffer^.RecordHandle, pBuffer); + end; +end; + +{ Reads first event in queue without removing it. + Returns true if successful, False if no events in queue } +function CircbufReadEvent( PBuffer: PCircularBuffer; PEvent: PMidiBufferItem ): Boolean; +var + PCurrentEvent: PMidiBufferItem; +begin + if (PBuffer^.EventCount <= 0) then + CircbufReadEvent := False + else + begin + PCurrentEvent := PBuffer^.PNextget; + + { Copy the object from the "tail" of the buffer to the caller's object } + PEvent^.Timestamp := PCurrentEvent^.Timestamp; + PEvent^.Data := PCurrentEvent^.Data; + PEvent^.Sysex := PCurrentEvent^.Sysex; + CircbufReadEvent := True; + end; +end; + +{ Remove current event from the queue } +function CircbufRemoveEvent(PBuffer: PCircularBuffer): Boolean; +begin + if (PBuffer^.EventCount > 0) then + begin + Dec( Pbuffer^.EventCount); + + { Advance the buffer pointer, with wrap } + Inc( Pbuffer^.PNextGet ); + If (PBuffer^.PNextGet = PBuffer^.PEnd) then + PBuffer^.PNextGet := PBuffer^.PStart; + + CircbufRemoveEvent := True; + end + else + CircbufRemoveEvent := False; +end; + +end. diff --git a/Game/Code/lib/midi/DELPHMCB.PAS b/Game/Code/lib/midi/DELPHMCB.PAS index 5d4ad75a..f7ceaa5e 100644 --- a/Game/Code/lib/midi/DELPHMCB.PAS +++ b/Game/Code/lib/midi/DELPHMCB.PAS @@ -1,138 +1,138 @@ -{ $Header: /MidiComp/DELPHMCB.PAS 2 10/06/97 7:33 Davec $ }
-
-{MIDI callback for Delphi, was DLL for Delphi 1}
-
-unit Delphmcb;
-
-{ These segment options required for the MIDI callback functions }
-{$C PRELOAD FIXED PERMANENT}
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
- {$H+} // use AnsiString
-{$ENDIF}
-
-uses
- Windows,
- MMsystem,
- Circbuf,
- MidiDefs,
- MidiCons;
-
-procedure midiHandler(
- hMidiIn: HMidiIn;
- wMsg: UINT;
- dwInstance: DWORD;
- dwParam1: DWORD;
- dwParam2: DWORD); stdcall; export;
-function CircbufPutEvent(PBuffer: PCircularBuffer; PTheEvent: PMidiBufferItem): Boolean; stdcall; export;
-
-implementation
-
-{ Add an event to the circular input buffer. }
-function CircbufPutEvent(PBuffer: PCircularBuffer; PTheEvent: PMidiBufferItem): Boolean; stdcall;
-begin
- If (PBuffer^.EventCount < PBuffer^.Capacity) Then
- begin
- Inc(Pbuffer^.EventCount);
-
- { Todo: better way of copying this record }
- with PBuffer^.PNextput^ do
- begin
- Timestamp := PTheEvent^.Timestamp;
- Data := PTheEvent^.Data;
- Sysex := PTheEvent^.Sysex;
- end;
-
- { Move to next put location, with wrap }
- Inc(Pbuffer^.PNextPut);
- If (PBuffer^.PNextPut = PBuffer^.PEnd) then
- PBuffer^.PNextPut := PBuffer^.PStart;
-
- CircbufPutEvent := True;
- end
- else
- CircbufPutEvent := False;
-end;
-
-{ This is the callback function specified when the MIDI device was opened
- by midiInOpen. It's called at interrupt time when MIDI input is seen
- by the MIDI device driver(s). See the docs for midiInOpen for restrictions
- on the Windows functions that can be called in this interrupt. }
-procedure midiHandler(
- hMidiIn: HMidiIn;
- wMsg: UINT;
- dwInstance: DWORD;
- dwParam1: DWORD;
- dwParam2: DWORD); stdcall;
-var
- thisEvent: TMidiBufferItem;
- thisCtlInfo: PMidiCtlInfo;
- thisBuffer: PCircularBuffer;
-Begin
- case wMsg of
-
- mim_Open: {nothing};
-
- mim_Error: {TODO: handle (message to trigger exception?) };
-
- mim_Data, mim_Longdata, mim_Longerror:
- { Note: mim_Longerror included because there's a bug in the Maui
- input driver that sends MIM_LONGERROR for subsequent buffers when
- the input buffer is smaller than the sysex block being received }
-
- begin
- { TODO: Make filtered messages customisable, I'm sure someone wants to
- do something with MTC! }
- if (dwParam1 <> MIDI_ACTIVESENSING) and
- (dwParam1 <> MIDI_TIMINGCLOCK) then
- begin
-
- { The device driver passes us the instance data pointer we
- specified for midiInOpen. Use this to get the buffer address
- and window handle for the MIDI control }
- thisCtlInfo := PMidiCtlInfo(dwInstance);
- thisBuffer := thisCtlInfo^.PBuffer;
-
- { Screen out short messages if we've been asked to }
- if ((wMsg <> mim_Data) or (thisCtlInfo^.SysexOnly = False))
- and (thisCtlInfo <> Nil) and (thisBuffer <> Nil) then
- begin
- with thisEvent do
- begin
- timestamp := dwParam2;
- if (wMsg = mim_Longdata) or
- (wMsg = mim_Longerror) then
- begin
- data := 0;
- sysex := PMidiHdr(dwParam1);
- end
- else
- begin
- data := dwParam1;
- sysex := Nil;
- end;
- end;
- if CircbufPutEvent( thisBuffer, @thisEvent ) then
- { Send a message to the control to say input's arrived }
- PostMessage(thisCtlInfo^.hWindow, mim_Data, 0, 0)
- else
- { Buffer overflow }
- PostMessage(thisCtlInfo^.hWindow, mim_Overflow, 0, 0);
- end;
- end;
- end;
-
- mom_Done: { Sysex output complete, dwParam1 is pointer to MIDIHDR }
- begin
- { Notify the control that its sysex output is finished.
- The control should call midiOutUnprepareHeader before freeing the buffer }
- PostMessage(PMidiCtlInfo(dwInstance)^.hWindow, mom_Done, 0, dwParam1);
- end;
-
- end; { Case }
-end;
-
-end.
+{ $Header: /MidiComp/DELPHMCB.PAS 2 10/06/97 7:33 Davec $ } + +{MIDI callback for Delphi, was DLL for Delphi 1} + +unit Delphmcb; + +{ These segment options required for the MIDI callback functions } +{$C PRELOAD FIXED PERMANENT} + +interface + +{$IFDEF FPC} + {$MODE Delphi} + {$H+} // use AnsiString +{$ENDIF} + +uses + Windows, + MMsystem, + Circbuf, + MidiDefs, + MidiCons; + +procedure midiHandler( + hMidiIn: HMidiIn; + wMsg: UINT; + dwInstance: DWORD; + dwParam1: DWORD; + dwParam2: DWORD); stdcall; export; +function CircbufPutEvent(PBuffer: PCircularBuffer; PTheEvent: PMidiBufferItem): Boolean; stdcall; export; + +implementation + +{ Add an event to the circular input buffer. } +function CircbufPutEvent(PBuffer: PCircularBuffer; PTheEvent: PMidiBufferItem): Boolean; stdcall; +begin + If (PBuffer^.EventCount < PBuffer^.Capacity) Then + begin + Inc(Pbuffer^.EventCount); + + { Todo: better way of copying this record } + with PBuffer^.PNextput^ do + begin + Timestamp := PTheEvent^.Timestamp; + Data := PTheEvent^.Data; + Sysex := PTheEvent^.Sysex; + end; + + { Move to next put location, with wrap } + Inc(Pbuffer^.PNextPut); + If (PBuffer^.PNextPut = PBuffer^.PEnd) then + PBuffer^.PNextPut := PBuffer^.PStart; + + CircbufPutEvent := True; + end + else + CircbufPutEvent := False; +end; + +{ This is the callback function specified when the MIDI device was opened + by midiInOpen. It's called at interrupt time when MIDI input is seen + by the MIDI device driver(s). See the docs for midiInOpen for restrictions + on the Windows functions that can be called in this interrupt. } +procedure midiHandler( + hMidiIn: HMidiIn; + wMsg: UINT; + dwInstance: DWORD; + dwParam1: DWORD; + dwParam2: DWORD); stdcall; +var + thisEvent: TMidiBufferItem; + thisCtlInfo: PMidiCtlInfo; + thisBuffer: PCircularBuffer; +Begin + case wMsg of + + mim_Open: {nothing}; + + mim_Error: {TODO: handle (message to trigger exception?) }; + + mim_Data, mim_Longdata, mim_Longerror: + { Note: mim_Longerror included because there's a bug in the Maui + input driver that sends MIM_LONGERROR for subsequent buffers when + the input buffer is smaller than the sysex block being received } + + begin + { TODO: Make filtered messages customisable, I'm sure someone wants to + do something with MTC! } + if (dwParam1 <> MIDI_ACTIVESENSING) and + (dwParam1 <> MIDI_TIMINGCLOCK) then + begin + + { The device driver passes us the instance data pointer we + specified for midiInOpen. Use this to get the buffer address + and window handle for the MIDI control } + thisCtlInfo := PMidiCtlInfo(dwInstance); + thisBuffer := thisCtlInfo^.PBuffer; + + { Screen out short messages if we've been asked to } + if ((wMsg <> mim_Data) or (thisCtlInfo^.SysexOnly = False)) + and (thisCtlInfo <> Nil) and (thisBuffer <> Nil) then + begin + with thisEvent do + begin + timestamp := dwParam2; + if (wMsg = mim_Longdata) or + (wMsg = mim_Longerror) then + begin + data := 0; + sysex := PMidiHdr(dwParam1); + end + else + begin + data := dwParam1; + sysex := Nil; + end; + end; + if CircbufPutEvent( thisBuffer, @thisEvent ) then + { Send a message to the control to say input's arrived } + PostMessage(thisCtlInfo^.hWindow, mim_Data, 0, 0) + else + { Buffer overflow } + PostMessage(thisCtlInfo^.hWindow, mim_Overflow, 0, 0); + end; + end; + end; + + mom_Done: { Sysex output complete, dwParam1 is pointer to MIDIHDR } + begin + { Notify the control that its sysex output is finished. + The control should call midiOutUnprepareHeader before freeing the buffer } + PostMessage(PMidiCtlInfo(dwInstance)^.hWindow, mom_Done, 0, dwParam1); + end; + + end; { Case } +end; + +end. diff --git a/Game/Code/lib/midi/MIDIDEFS.PAS b/Game/Code/lib/midi/MIDIDEFS.PAS index e97a8627..fc8eed26 100644 --- a/Game/Code/lib/midi/MIDIDEFS.PAS +++ b/Game/Code/lib/midi/MIDIDEFS.PAS @@ -1,55 +1,55 @@ -{ $Header: /MidiComp/MIDIDEFS.PAS 2 10/06/97 7:33 Davec $ }
-
-{ Written by David Churcher <dchurcher@cix.compulink.co.uk>,
- released to the public domain. }
-
-
-{ Common definitions used by DELPHMID.DPR and the MIDI components.
- This must be a separate unit to prevent large chunks of the VCL being
- linked into the DLL. }
-unit Mididefs;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
- {$H+} // use AnsiString
-{$ENDIF}
-
-uses
- Windows,
- MMsystem,
- Circbuf;
-
-type
-
- {-------------------------------------------------------------------}
- { This is the information about the control that must be accessed by
- the MIDI input callback function in the DLL at interrupt time }
- PMidiCtlInfo = ^TMidiCtlInfo;
- TMidiCtlInfo = record
- hMem: THandle; { Memory handle for this record }
- PBuffer: PCircularBuffer; { Pointer to the MIDI input data buffer }
- hWindow: HWnd; { Control's window handle }
- SysexOnly: Boolean; { Only process System Exclusive input }
- end;
-
- { Information for the output timer callback function, also required at
- interrupt time. }
- PMidiOutTimerInfo = ^TMidiOutTimerInfo;
- TMidiOutTimerInfo = record
- hMem: THandle; { Memory handle for this record }
- PBuffer: PCircularBuffer; { Pointer to MIDI output data buffer }
- hWindow: HWnd; { Control's window handle }
- TimeToNextEvent: DWORD; { Delay to next event after timer set }
- MIDIHandle: HMidiOut; { MIDI handle to send output to
- (copy of component's FMidiHandle property) }
- PeriodMin: Word; { Multimedia timer minimum period supported }
- PeriodMax: Word; { Multimedia timer maximum period supported }
- TimerId: Word; { Multimedia timer ID of current event }
- end;
-
-implementation
-
-
-end.
+{ $Header: /MidiComp/MIDIDEFS.PAS 2 10/06/97 7:33 Davec $ } + +{ Written by David Churcher <dchurcher@cix.compulink.co.uk>, + released to the public domain. } + + +{ Common definitions used by DELPHMID.DPR and the MIDI components. + This must be a separate unit to prevent large chunks of the VCL being + linked into the DLL. } +unit Mididefs; + +interface + +{$IFDEF FPC} + {$MODE Delphi} + {$H+} // use AnsiString +{$ENDIF} + +uses + Windows, + MMsystem, + Circbuf; + +type + + {-------------------------------------------------------------------} + { This is the information about the control that must be accessed by + the MIDI input callback function in the DLL at interrupt time } + PMidiCtlInfo = ^TMidiCtlInfo; + TMidiCtlInfo = record + hMem: THandle; { Memory handle for this record } + PBuffer: PCircularBuffer; { Pointer to the MIDI input data buffer } + hWindow: HWnd; { Control's window handle } + SysexOnly: Boolean; { Only process System Exclusive input } + end; + + { Information for the output timer callback function, also required at + interrupt time. } + PMidiOutTimerInfo = ^TMidiOutTimerInfo; + TMidiOutTimerInfo = record + hMem: THandle; { Memory handle for this record } + PBuffer: PCircularBuffer; { Pointer to MIDI output data buffer } + hWindow: HWnd; { Control's window handle } + TimeToNextEvent: DWORD; { Delay to next event after timer set } + MIDIHandle: HMidiOut; { MIDI handle to send output to + (copy of component's FMidiHandle property) } + PeriodMin: Word; { Multimedia timer minimum period supported } + PeriodMax: Word; { Multimedia timer maximum period supported } + TimerId: Word; { Multimedia timer ID of current event } + end; + +implementation + + +end. diff --git a/Game/Code/lib/midi/MIDITYPE.PAS b/Game/Code/lib/midi/MIDITYPE.PAS index a4166c42..b1ec1bdd 100644 --- a/Game/Code/lib/midi/MIDITYPE.PAS +++ b/Game/Code/lib/midi/MIDITYPE.PAS @@ -1,90 +1,90 @@ -{ $Header: /MidiComp/MIDITYPE.PAS 2 10/06/97 7:33 Davec $ }
-
-{ Written by David Churcher <dchurcher@cix.compulink.co.uk>,
- released to the public domain. }
-
-
-unit Miditype;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
- {$H+} // use AnsiString
-{$ENDIF}
-
-uses
- Classes,
- Windows,
- Messages,
- MMSystem,
- MidiDefs,
- Circbuf;
-
-type
- {-------------------------------------------------------------------}
- { A MIDI input/output event }
- TMyMidiEvent = class(TPersistent)
- public
- MidiMessage: Byte; { MIDI message status byte }
- Data1: Byte; { MIDI message data 1 byte }
- Data2: Byte; { MIDI message data 2 byte }
- Time: DWORD; { Time in ms since midiInOpen }
- SysexLength: Word; { Length of sysex data (0 if none) }
- Sysex: PChar; { Pointer to sysex data buffer }
- destructor Destroy; override; { Frees sysex data buffer if nec. }
- end;
- PMyMidiEvent = ^TMyMidiEvent;
-
- {-------------------------------------------------------------------}
- { Encapsulates the MIDIHDR with its memory handle and sysex buffer }
- PMyMidiHdr = ^TMyMidiHdr;
- TMyMidiHdr = class(TObject)
- public
- hdrHandle: THandle;
- hdrPointer: PMIDIHDR;
- sysexHandle: THandle;
- sysexPointer: Pointer;
- constructor Create(BufferSize: Word);
- destructor Destroy; override;
- end;
-
-implementation
-
-{-------------------------------------------------------------------}
-{ Free any sysex buffer associated with the event }
-destructor TMyMidiEvent.Destroy;
-begin
- if (Sysex <> Nil) then
- Freemem(Sysex, SysexLength);
-
- inherited Destroy;
-end;
-
-{-------------------------------------------------------------------}
-{ Allocate memory for the sysex header and buffer }
-constructor TMyMidiHdr.Create(BufferSize:Word);
-begin
- inherited Create;
-
- if BufferSize > 0 then
- begin
- hdrPointer := GlobalSharedLockedAlloc(sizeof(TMIDIHDR), hdrHandle);
- sysexPointer := GlobalSharedLockedAlloc(BufferSize, sysexHandle);
-
- hdrPointer^.lpData := sysexPointer;
- hdrPointer^.dwBufferLength := BufferSize;
- end;
-end;
-
-{-------------------------------------------------------------------}
-destructor TMyMidiHdr.Destroy;
-begin
- GlobalSharedLockedFree( hdrHandle, hdrPointer );
- GlobalSharedLockedFree( sysexHandle, sysexPointer );
- inherited Destroy;
-end;
-
-
-
-end.
+{ $Header: /MidiComp/MIDITYPE.PAS 2 10/06/97 7:33 Davec $ } + +{ Written by David Churcher <dchurcher@cix.compulink.co.uk>, + released to the public domain. } + + +unit Miditype; + +interface + +{$IFDEF FPC} + {$MODE Delphi} + {$H+} // use AnsiString +{$ENDIF} + +uses + Classes, + Windows, + Messages, + MMSystem, + MidiDefs, + Circbuf; + +type + {-------------------------------------------------------------------} + { A MIDI input/output event } + TMyMidiEvent = class(TPersistent) + public + MidiMessage: Byte; { MIDI message status byte } + Data1: Byte; { MIDI message data 1 byte } + Data2: Byte; { MIDI message data 2 byte } + Time: DWORD; { Time in ms since midiInOpen } + SysexLength: Word; { Length of sysex data (0 if none) } + Sysex: PChar; { Pointer to sysex data buffer } + destructor Destroy; override; { Frees sysex data buffer if nec. } + end; + PMyMidiEvent = ^TMyMidiEvent; + + {-------------------------------------------------------------------} + { Encapsulates the MIDIHDR with its memory handle and sysex buffer } + PMyMidiHdr = ^TMyMidiHdr; + TMyMidiHdr = class(TObject) + public + hdrHandle: THandle; + hdrPointer: PMIDIHDR; + sysexHandle: THandle; + sysexPointer: Pointer; + constructor Create(BufferSize: Word); + destructor Destroy; override; + end; + +implementation + +{-------------------------------------------------------------------} +{ Free any sysex buffer associated with the event } +destructor TMyMidiEvent.Destroy; +begin + if (Sysex <> Nil) then + Freemem(Sysex, SysexLength); + + inherited Destroy; +end; + +{-------------------------------------------------------------------} +{ Allocate memory for the sysex header and buffer } +constructor TMyMidiHdr.Create(BufferSize:Word); +begin + inherited Create; + + if BufferSize > 0 then + begin + hdrPointer := GlobalSharedLockedAlloc(sizeof(TMIDIHDR), hdrHandle); + sysexPointer := GlobalSharedLockedAlloc(BufferSize, sysexHandle); + + hdrPointer^.lpData := sysexPointer; + hdrPointer^.dwBufferLength := BufferSize; + end; +end; + +{-------------------------------------------------------------------} +destructor TMyMidiHdr.Destroy; +begin + GlobalSharedLockedFree( hdrHandle, hdrPointer ); + GlobalSharedLockedFree( sysexHandle, sysexPointer ); + inherited Destroy; +end; + + + +end. diff --git a/Game/Code/lib/midi/MidiFile.pas b/Game/Code/lib/midi/MidiFile.pas index 2da052f4..4279d305 100644 --- a/Game/Code/lib/midi/MidiFile.pas +++ b/Game/Code/lib/midi/MidiFile.pas @@ -1,964 +1,964 @@ -{
- Load a midifile and get access to tracks and events
- I did build this component to convert midifiles to wave files
- or play the files on a software synthesizer which I'm currenly
- building.
-
- version 1.0 first release
-
- version 1.1
- added some function
- function KeyToStr(key : integer) : string;
- function MyTimeToStr(val : integer) : string;
- Bpm can be set to change speed
-
- version 1.2
- added some functions
- function GetTrackLength:integer;
- function Ready: boolean;
-
- version 1.3
- update by Chulwoong,
- He knows how to use the MM timer, the timing is much better now, thank you
-
- for comments/bugs
- F.Bouwmans
- fbouwmans@spiditel.nl
-
- if you think this component is nice and you use it, sent me a short email.
- I've seen that other of my components have been downloaded a lot, but I've
- got no clue wether they are actually used.
- Don't worry because you are free to use these components
-
- Timing has improved, however because the messages are handled by the normal
- windows message loop (of the main window) it is still influenced by actions
- done on the window (minimize/maximize ..).
- Use of a second thread with higher priority which only handles the
- timer message should increase performance. If somebody knows such a component
- which is freeware please let me know.
-
- interface description:
-
- procedure ReadFile:
- actually read the file which is set in Filename
-
- function GetTrack(index: integer) : TMidiTrack;
-
- property Filename
- set/read filename of midifile
-
- property NumberOfTracks
- read number of tracks in current file
-
- property TicksPerQuarter: integer
- ticks per quarter, tells how to interpret the time value in midi events
-
- property FileFormat: TFileFormat
- tells the format of the current midifile
-
- property Bpm:integer
- tells Beats per minut
-
- property OnMidiEvent:TOnMidiEvent
- called while playing for each midi event
-
- procedure StartPlaying;
- start playing the current loaded midifile from the beginning
-
- procedure StopPlaying;
- stop playing the current midifile
-
- procedure PlayToTime(time : integer);
- if playing yourself then events from last time to this time are produced
-
-
- function KeyToStr(key : integer) : string;
- give note string on key value: e.g. C4
-
- function MyTimeToStr(val : integer) : string;
- give time string from msec time
-
- function GetTrackLength:integer;
- gives the track lenght in msec (assuming the bpm at the start oof the file)
-
- function Ready: boolean;
- now you can check wether the playback is finished
-
-}
-
-unit MidiFile;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
- {$H+} // use AnsiString
-{$ENDIF}
-
-uses
- Windows,
- //Forms,
- Messages,
- SysUtils,
- UCommon,
- Classes;
-
-type
- TChunkType = (illegal, header, track);
- TFileFormat = (single, multi_synch, multi_asynch);
- PByte = ^byte;
-
- TMidiEvent = record
- event: byte;
- data1: byte;
- data2: byte;
- str: string;
- dticks: integer;
- time: integer;
- mtime: integer;
- len: integer;
- end;
- PMidiEvent = ^TMidiEvent;
-
- TOnMidiEvent = procedure(event: PMidiEvent) of object;
- TEvent = procedure of object;
-
- TMidiTrack = class(TObject)
- protected
- events: TList;
- name: string;
- instrument: string;
- currentTime: integer;
- currentPos: integer;
- ready: boolean;
- trackLenght: integer;
- procedure checkReady;
- public
- OnMidiEvent: TOnMidiEvent;
- OnTrackReady: TEvent;
- constructor Create;
- destructor Destroy; override;
-
- procedure Rewind(pos: integer);
- procedure PlayUntil(pos: integer);
- procedure GoUntil(pos: integer);
-
- procedure putEvent(event: PMidiEvent);
- function getEvent(index: integer): PMidiEvent;
- function getName: string;
- function getInstrument: string;
- function getEventCount: integer;
- function getCurrentTime: integer;
- function getTrackLength: integer;
- function isReady:boolean;
- end;
-
- TMidiFile = class(TComponent)
- private
- { Private declarations }
- procedure MidiTimer(sender : TObject);
- procedure WndProc(var Msg : TMessage);
- protected
- { Protected declarations }
- midiFile: file of byte;
- chunkType: TChunkType;
- chunkLength: integer;
- chunkData: PByte;
- chunkIndex: PByte;
- chunkEnd: PByte;
- FPriority: DWORD;
-
- // midi file attributes
- FFileFormat: TFileFormat;
- numberTracks: integer;
- deltaTicks: integer;
- FBpm: integer;
- FBeatsPerMeasure: integer;
- FusPerTick: double;
- FFilename: string;
-
- Tracks: TList;
- currentTrack: TMidiTrack;
- FOnMidiEvent: TOnMidiEvent;
- FOnUpdateEvent: TNotifyEvent;
-
- // playing attributes
- playing: boolean;
- PlayStartTime: integer;
- currentTime: integer; // Current playtime in msec
- currentPos: Double; // Current Position in ticks
-
- procedure OnTrackReady;
- procedure setFilename(val: string);
- procedure ReadChunkHeader;
- procedure ReadChunkContent;
- procedure ReadChunk;
- procedure ProcessHeaderChunk;
- procedure ProcessTrackChunk;
- function ReadVarLength: integer;
- function ReadString(l: integer): string;
- procedure SetOnMidiEvent(handler: TOnMidiEvent);
- procedure SetBpm(val: integer);
- public
- { Public declarations }
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
-
- procedure ReadFile;
- function GetTrack(index: integer): TMidiTrack;
-
- procedure StartPlaying;
- procedure StopPlaying;
- procedure ContinuePlaying;
-
- procedure PlayToTime(time: integer);
- procedure GoToTime(time: integer);
- function GetCurrentTime: integer;
- function GetFusPerTick : Double;
- function GetTrackLength:integer;
- function Ready: boolean;
- published
- { Published declarations }
- property Filename: string read FFilename write setFilename;
- property NumberOfTracks: integer read numberTracks;
- property TicksPerQuarter: integer read deltaTicks;
- property FileFormat: TFileFormat read FFileFormat;
- property Bpm: integer read FBpm write SetBpm;
- property OnMidiEvent: TOnMidiEvent read FOnMidiEvent write SetOnMidiEvent;
- property OnUpdateEvent: TNotifyEvent read FOnUpdateEvent write FOnUpdateEvent;
- end;
-
-function KeyToStr(key: integer): string;
-function MyTimeToStr(val: integer): string;
-procedure Register;
-
-implementation
-
-uses mmsystem;
-
-type
-{$IFDEF FPC}
- TTimerProc = TTIMECALLBACK;
- TTimeCaps = TIMECAPS;
-{$ELSE}
- TTimerProc = TFNTimeCallBack;
-{$ENDIF}
-
-const TIMER_RESOLUTION=10;
-const WM_MULTIMEDIA_TIMER=WM_USER+127;
-
-var MIDIFileHandle : HWND;
- TimerProc : TTimerProc;
- MIDITimerID : Integer;
- TimerPeriod : Integer;
-
-procedure TimerCallBackProc(uTimerID,uMsg: Cardinal; dwUser,dwParam1,dwParam2:DWORD);stdcall;
-begin
- PostMessage(HWND(dwUser),WM_MULTIMEDIA_TIMER,0,0);
-end;
-
-procedure SetMIDITimer;
- var TimeCaps : TTimeCaps;
-begin
- timeGetDevCaps(@TimeCaps,SizeOf(TimeCaps));
- if TIMER_RESOLUTION < TimeCaps.wPeriodMin then
- TimerPeriod:=TimeCaps.wPeriodMin
- else if TIMER_RESOLUTION > TimeCaps.wPeriodMax then
- TimerPeriod:=TimeCaps.wPeriodMax
- else
- TimerPeriod:=TIMER_RESOLUTION;
-
- timeBeginPeriod(TimerPeriod);
- MIDITimerID:=timeSetEvent(TimerPeriod,TimerPeriod,TimerProc,
- DWORD(MIDIFileHandle),TIME_PERIODIC);
- if MIDITimerID=0 then
- timeEndPeriod(TimerPeriod);
-end;
-
-procedure KillMIDITimer;
-begin
- timeKillEvent(MIDITimerID);
- timeEndPeriod(TimerPeriod);
-end;
-
-constructor TMidiTrack.Create;
-begin
- inherited Create;
- events := TList.Create;
- currentTime := 0;
- currentPos := 0;
-end;
-
-destructor TMidiTrack.Destroy;
-var
- i: integer;
-begin
- for i := 0 to events.count - 1 do
- Dispose(PMidiEvent(events.items[i]));
- events.Free;
- inherited Destroy;
-end;
-
-procedure TMidiTRack.putEvent(event: PMidiEvent);
-var
- command: integer;
- i: integer;
- pevent: PMidiEvent;
-begin
- if (event.event = $FF) then
- begin
- if (event.data1 = 3) then
- name := event.str;
- if (event.data1 = 4) then
- instrument := event.str;
- end;
- currentTime := currentTime + event.dticks;
- event.time := currentTime; // for the moment just add dticks
- event.len := 0;
- events.add(TObject(event));
- command := event.event and $F0;
-
- if ((command = $80) // note off
- or ((command = $90) and (event.data2 = 0))) //note on with speed 0
- then
- begin
- // this is a note off, try to find the accompanion note on
- command := event.event or $90;
- i := events.count - 2;
- while i >= 0 do
- begin
- pevent := PMidiEvent(events[i]);
- if (pevent.event = command) and
- (pevent.data1 = event.data1)
- then
- begin
- pevent.len := currentTIme - pevent.time;
- i := 0;
- event.len := -1;
- end;
- dec(i);
- end;
- end;
-end;
-
-function TMidiTrack.getName: string;
-begin
- result := name;
-end;
-
-function TMidiTrack.getInstrument: string;
-begin
- result := instrument;
-end;
-
-function TMiditrack.getEventCount: integer;
-begin
- result := events.count;
-end;
-
-function TMiditrack.getEvent(index: integer): PMidiEvent;
-begin
- if ((index < events.count) and (index >= 0)) then
- result := events[index]
- else
- result := nil;
-end;
-
-function TMiditrack.getCurrentTime: integer;
-begin
- result := currentTime;
-end;
-
-procedure TMiditrack.Rewind(pos: integer);
-begin
- if currentPos = events.count then
- dec(currentPos);
- while ((currentPos > 0) and
- (PMidiEvent(events[currentPos]).time > pos))
- do
- begin
- dec(currentPos);
- end;
- checkReady;
-end;
-
-procedure TMiditrack.PlayUntil(pos: integer);
-begin
- if assigned(OnMidiEvent) then
- begin
- while ((currentPos < events.count) and
- (PMidiEvent(events[currentPos]).time < pos)) do
- begin
- OnMidiEvent(PMidiEvent(events[currentPos]));
- inc(currentPos);
- end;
- end;
- checkReady;
-end;
-
-procedure TMidiTrack.GoUntil(pos: integer);
-begin
- while ((currentPos < events.count) and
- (PMidiEvent(events[currentPos]).time < pos)) do
- begin
- inc(currentPos);
- end;
- checkReady;
-end;
-
-procedure TMidiTrack.checkReady;
-begin
- if currentPos >= events.count then
- begin
- ready := true;
- if assigned(OnTrackReady) then
- OnTrackReady;
- end
- else
- ready := false;
-end;
-
-function TMidiTrack.getTrackLength: integer;
-begin
- result := PMidiEvent(events[events.count-1]).time
-end;
-
-function TMidiTrack.isReady: boolean;
-begin
- result := ready;
-end;
-
-constructor TMidifile.Create(AOwner: TComponent);
-begin
- inherited Create(AOWner);
- MIDIFileHandle:=AllocateHWnd(WndProc);
- chunkData := nil;
- chunkType := illegal;
- Tracks := TList.Create;
- TimerProc:=@TimerCallBackProc;
- FPriority:=GetPriorityClass(MIDIFileHandle);
-end;
-
-destructor TMidifile.Destroy;
-var
- i: integer;
-begin
- if not (chunkData = nil) then FreeMem(chunkData);
- for i := 0 to Tracks.Count - 1 do
- TMidiTrack(Tracks.Items[i]).Free;
- Tracks.Free;
- SetPriorityClass(MIDIFileHandle,FPriority);
-
- if MIDITimerID<>0 then KillMIDITimer;
-
- DeallocateHWnd(MIDIFileHandle);
-
- inherited Destroy;
-end;
-
-function TMidiFile.GetTrack(index: integer): TMidiTrack;
-begin
- result := Tracks.Items[index];
-end;
-
-procedure TMidifile.setFilename(val: string);
-begin
- FFilename := val;
-// ReadFile;
-end;
-
-procedure TMidifile.SetOnMidiEvent(handler: TOnMidiEvent);
-var
- i: integer;
-begin
-// if not (FOnMidiEvent = handler) then
-// begin
- FOnMidiEvent := handler;
- for i := 0 to tracks.count - 1 do
- TMidiTrack(tracks.items[i]).OnMidiEvent := handler;
-// end;
-end;
-
-procedure TMidifile.MidiTimer(Sender: TObject);
-begin
- if playing then
- begin
- PlayToTime(GetTickCount - PlayStartTime);
- if assigned(FOnUpdateEvent) then FOnUpdateEvent(self);
- end;
-end;
-
-procedure TMidifile.StartPlaying;
-var
- i: integer;
-begin
- for i := 0 to tracks.count - 1 do
- TMidiTrack(tracks[i]).Rewind(0);
- playStartTime := getTickCount;
- playing := true;
-
- SetPriorityClass(MIDIFileHandle,REALTIME_PRIORITY_CLASS);
-
- SetMIDITimer;
- currentPos := 0.0;
- currentTime := 0;
-end;
-
-procedure TMidifile.ContinuePlaying;
-begin
- PlayStartTime := GetTickCount - currentTime;
- playing := true;
-
- SetPriorityClass(MIDIFileHandle,REALTIME_PRIORITY_CLASS);
-
- SetMIDITimer;
-end;
-
-procedure TMidifile.StopPlaying;
-begin
- playing := false;
- KillMIDITimer;
- SetPriorityClass(MIDIFileHandle,FPriority);
-end;
-
-function TMidiFile.GetCurrentTime: integer;
-begin
- Result := currentTime;
-end;
-
-procedure TMidifile.PlayToTime(time: integer);
-var
- i: integer;
- track: TMidiTrack;
- pos: integer;
- deltaTime: integer;
-begin
- // calculate the pos in the file.
- // pos is actually tick
- // Current FusPerTick is uses to determine the actual pos
-
- deltaTime := time - currentTime;
- currentPos := currentPos + (deltaTime * 1000) / FusPerTick;
- pos := round(currentPos);
-
- for i := 0 to tracks.count - 1 do
- begin
- TMidiTrack(tracks.items[i]).PlayUntil(pos);
- end;
- currentTime := time;
-end;
-
-procedure TMidifile.GoToTime(time: integer);
-var
- i: integer;
- track: TMidiTrack;
- pos: integer;
-begin
- // this function should be changed because FusPerTick might not be constant
- pos := round((time * 1000) / FusPerTick);
- for i := 0 to tracks.count - 1 do
- begin
- TMidiTrack(tracks.items[i]).Rewind(0);
- TMidiTrack(tracks.items[i]).GoUntil(pos);
- end;
-end;
-
-procedure TMidifile.SetBpm(val: integer);
-var
- us_per_quarter: integer;
-begin
- if not (val = FBpm) then
- begin
- us_per_quarter := 60000000 div val;
-
- FBpm := 60000000 div us_per_quarter;
- FusPerTick := us_per_quarter / deltaTicks;
- end;
-end;
-
-procedure TMidifile.ReadChunkHeader;
-var
- theByte: array[0..7] of byte;
-begin
- BlockRead(midiFile, theByte, 8);
- if (theByte[0] = $4D) and (theByte[1] = $54) then
- begin
- if (theByte[2] = $68) and (theByte[3] = $64) then
- chunkType := header
- else if (theByte[2] = $72) and (theByte[3] = $6B) then
- chunkType := track
- else
- chunkType := illegal;
- end
- else
- begin
- chunkType := illegal;
- end;
- chunkLength := theByte[7] + theByte[6] * $100 + theByte[5] * $10000 + theByte[4] * $1000000;
-end;
-
-procedure TMidifile.ReadChunkContent;
-begin
- if not (chunkData = nil) then
- FreeMem(chunkData);
- GetMem(chunkData, chunkLength + 10);
- BlockRead(midiFile, chunkData^, chunkLength);
- chunkIndex := chunkData;
- chunkEnd := PByte(integer(chunkIndex) + integer(chunkLength) - 1);
-end;
-
-procedure TMidifile.ReadChunk;
-begin
- ReadChunkHeader;
- ReadChunkContent;
- case chunkType of
- header:
- ProcessHeaderChunk;
- track:
- ProcessTrackCHunk;
- end;
-end;
-
-procedure TMidifile.ProcessHeaderChunk;
-begin
- chunkIndex := chunkData;
- inc(chunkIndex);
- if chunkType = header then
- begin
- case chunkIndex^ of
- 0: FfileFormat := single;
- 1: FfileFormat := multi_synch;
- 2: FfileFormat := multi_asynch;
- end;
- inc(chunkIndex);
- numberTracks := chunkIndex^ * $100;
- inc(chunkIndex);
- numberTracks := numberTracks + chunkIndex^;
- inc(chunkIndex);
- deltaTicks := chunkIndex^ * $100;
- inc(chunkIndex);
- deltaTicks := deltaTicks + chunkIndex^;
- end;
-end;
-
-procedure TMidifile.ProcessTrackChunk;
-var
- dTime: integer;
- event: integer;
- len: integer;
- str: string;
- midiEvent: PMidiEvent;
- i: integer;
- us_per_quarter: integer;
-begin
- chunkIndex := chunkData;
-// inc(chunkIndex);
- event := 0;
- if chunkType = track then
- begin
- currentTrack := TMidiTrack.Create;
- currentTrack.OnMidiEvent := FOnMidiEvent;
- Tracks.add(currentTrack);
- while integer(chunkIndex) < integer(chunkEnd) do
- begin
- // each event starts with var length delta time
- dTime := ReadVarLength;
- if chunkIndex^ >= $80 then
- begin
- event := chunkIndex^;
- inc(chunkIndex);
- end;
- // else it is a running status event (just the same event as before)
-
- if event = $FF then
- begin
-{ case chunkIndex^ of
- $00: // sequence number, not implemented jet
- begin
- inc(chunkIndex); // $02
- inc(chunkIndex);
- end;
- $01 .. $0f: // text events FF ty len text
- begin
- New(midiEvent);
- midiEvent.event := $FF;
- midiEvent.data1 := chunkIndex^; // type is stored in data1
- midiEvent.dticks := dtime;
-
- inc(chunkIndex);
- len := ReadVarLength;
- midiEvent.str := ReadString(len);
-
- currentTrack.putEvent(midiEvent);
- end;
- $20: // Midi channel prefix FF 20 01 cc
- begin
- inc(chunkIndex); // $01
- inc(chunkIndex); // channel
- inc(chunkIndex);
- end;
- $2F: // End of track FF 2F 00
- begin
- inc(chunkIndex); // $00
- inc(chunkIndex);
- end;
- $51: // Set Tempo FF 51 03 tttttt
- begin
- inc(chunkIndex); // $03
- inc(chunkIndex); // tt
- inc(chunkIndex); // tt
- inc(chunkIndex); // tt
- inc(chunkIndex);
- end;
- $54: // SMPTE offset FF 54 05 hr mn se fr ff
- begin
- inc(chunkIndex); // $05
- inc(chunkIndex); // hr
- inc(chunkIndex); // mn
- inc(chunkIndex); // se
- inc(chunkIndex); // fr
- inc(chunkIndex); // ff
- inc(chunkIndex);
- end;
- $58: // Time signature FF 58 04 nn dd cc bb
- begin
- inc(chunkIndex); // $04
- inc(chunkIndex); // nn
- inc(chunkIndex); // dd
- inc(chunkIndex); // cc
- inc(chunkIndex); // bb
- inc(chunkIndex);
- end;
- $59: // Key signature FF 59 02 df mi
- begin
- inc(chunkIndex); // $02
- inc(chunkIndex); // df
- inc(chunkIndex); // mi
- inc(chunkIndex);
- end;
- $7F: // Sequence specific Meta-event
- begin
- inc(chunkIndex);
- len := ReadVarLength;
- str := ReadString(len);
- end;
- else // unknown meta event
- }
- begin
- New(midiEvent);
- midiEvent.event := $FF;
- midiEvent.data1 := chunkIndex^; // type is stored in data1
- midiEvent.dticks := dtime;
-
- inc(chunkIndex);
- len := ReadVarLength;
- midiEvent.str := ReadString(len);
- currentTrack.putEvent(midiEvent);
-
- case midiEvent.data1 of
- $51:
- begin
- us_per_quarter :=
- (integer(byte(midiEvent.str[1])) shl 16 +
- integer(byte(midiEvent.str[2])) shl 8 +
- integer(byte(midiEvent.str[3])));
- FBpm := 60000000 div us_per_quarter;
- FusPerTick := us_per_quarter / deltaTicks;
- end;
- end;
- end;
-// end;
- end
- else
- begin
- // these are all midi events
- New(midiEvent);
- midiEvent.event := event;
- midiEvent.dticks := dtime;
-// inc(chunkIndex);
- case event of
- $80..$8F, // note off
- $90..$9F, // note on
- $A0..$AF, // key aftertouch
- $B0..$BF, // control change
- $E0..$EF: // pitch wheel change
- begin
- midiEvent.data1 := chunkIndex^; inc(chunkIndex);
- midiEvent.data2 := chunkIndex^; inc(chunkIndex);
- end;
- $C0..$CF, // program change
- $D0..$DF: // channel aftertouch
- begin
- midiEvent.data1 := chunkIndex^; inc(chunkIndex);
- end;
- else
- // error
- end;
- currentTrack.putEvent(midiEvent);
- end;
- end;
- end;
-end;
-
-
-function TMidifile.ReadVarLength: integer;
-var
- i: integer;
- b: byte;
-begin
- b := 128;
- i := 0;
- while b > 127 do
- begin
- i := i shl 7;
- b := chunkIndex^;
- i := i + b and $7F;
- inc(chunkIndex);
- end;
- result := i;
-end;
-
-function TMidifile.ReadString(l: integer): string;
-var
- s: PChar;
- i: integer;
-begin
- GetMem(s, l + 1); ;
- s[l] := chr(0);
- for i := 0 to l - 1 do
- begin
- s[i] := Chr(chunkIndex^);
- inc(chunkIndex);
- end;
- result := string(s);
-end;
-
-procedure TMidifile.ReadFile;
-var
- i: integer;
-begin
- for i := 0 to Tracks.Count - 1 do
- TMidiTrack(Tracks.Items[i]).Free;
- Tracks.Clear;
- chunkType := illegal;
-
- AssignFile(midiFile, FFilename);
- FileMode := 0;
- Reset(midiFile);
- while not eof(midiFile) do
- ReadChunk;
- CloseFile(midiFile);
- numberTracks := Tracks.Count;
-end;
-
-function KeyToStr(key: integer): string;
-var
- n: integer;
- str: string;
-begin
- n := key mod 12;
- case n of
- 0: str := 'C';
- 1: str := 'C#';
- 2: str := 'D';
- 3: str := 'D#';
- 4: str := 'E';
- 5: str := 'F';
- 6: str := 'F#';
- 7: str := 'G';
- 8: str := 'G#';
- 9: str := 'A';
- 10: str := 'A#';
- 11: str := 'B';
- end;
- Result := str + IntToStr(key div 12);
-end;
-
-function IntToLenStr(val: integer; len: integer): string;
-var
- str: string;
-begin
- str := IntToStr(val);
- while Length(str) < len do
- str := '0' + str;
- Result := str;
-end;
-
-function MyTimeToStr(val: integer): string;
- var
- hour: integer;
- min: integer;
- sec: integer;
- msec: integer;
-begin
- msec := val mod 1000;
- sec := val div 1000;
- min := sec div 60;
- sec := sec mod 60;
- hour := min div 60;
- min := min mod 60;
- Result := IntToStr(hour) + ':' + IntToLenStr(min, 2) + ':' + IntToLenStr(sec, 2) + '.' + IntToLenStr(msec, 3);
-end;
-
-function TMidiFIle.GetFusPerTick : Double;
-begin
- Result := FusPerTick;
-end;
-
-function TMidiFIle.GetTrackLength:integer;
-var i,length : integer;
- time : extended;
-begin
- length := 0;
- for i := 0 to Tracks.Count - 1 do
- if TMidiTrack(Tracks.Items[i]).getTrackLength > length then
- length := TMidiTrack(Tracks.Items[i]).getTrackLength;
- time := length * FusPerTick;
- time := time / 1000.0;
- result := round(time);
-end;
-
-function TMidiFIle.Ready: boolean;
-var i : integer;
-begin
- result := true;
- for i := 0 to Tracks.Count - 1 do
- if not TMidiTrack(Tracks.Items[i]).isready then
- result := false;
-end;
-
-procedure TMidiFile.OnTrackReady;
-begin
- if ready then
- if assigned(FOnUpdateEvent) then FOnUpdateEvent(self);
-end;
-
-procedure TMidiFile.WndProc(var Msg : TMessage);
-begin
- with MSG do
- begin
- case Msg of
- WM_MULTIMEDIA_TIMER:
- begin
- //try
- MidiTimer(self);
- //except
- // Note: HandleException() is called by default if exception is not handled
- // Application.HandleException(Self);
- //end;
- end;
- else
- begin
- Result := DefWindowProc(MIDIFileHandle, Msg, wParam, lParam);
- end;
- end;
- end;
-end;
-
-procedure Register;
-begin
- RegisterComponents('Synth', [TMidiFile]);
-end;
-
-end.
-
+{ + Load a midifile and get access to tracks and events + I did build this component to convert midifiles to wave files + or play the files on a software synthesizer which I'm currenly + building. + + version 1.0 first release + + version 1.1 + added some function + function KeyToStr(key : integer) : string; + function MyTimeToStr(val : integer) : string; + Bpm can be set to change speed + + version 1.2 + added some functions + function GetTrackLength:integer; + function Ready: boolean; + + version 1.3 + update by Chulwoong, + He knows how to use the MM timer, the timing is much better now, thank you + + for comments/bugs + F.Bouwmans + fbouwmans@spiditel.nl + + if you think this component is nice and you use it, sent me a short email. + I've seen that other of my components have been downloaded a lot, but I've + got no clue wether they are actually used. + Don't worry because you are free to use these components + + Timing has improved, however because the messages are handled by the normal + windows message loop (of the main window) it is still influenced by actions + done on the window (minimize/maximize ..). + Use of a second thread with higher priority which only handles the + timer message should increase performance. If somebody knows such a component + which is freeware please let me know. + + interface description: + + procedure ReadFile: + actually read the file which is set in Filename + + function GetTrack(index: integer) : TMidiTrack; + + property Filename + set/read filename of midifile + + property NumberOfTracks + read number of tracks in current file + + property TicksPerQuarter: integer + ticks per quarter, tells how to interpret the time value in midi events + + property FileFormat: TFileFormat + tells the format of the current midifile + + property Bpm:integer + tells Beats per minut + + property OnMidiEvent:TOnMidiEvent + called while playing for each midi event + + procedure StartPlaying; + start playing the current loaded midifile from the beginning + + procedure StopPlaying; + stop playing the current midifile + + procedure PlayToTime(time : integer); + if playing yourself then events from last time to this time are produced + + + function KeyToStr(key : integer) : string; + give note string on key value: e.g. C4 + + function MyTimeToStr(val : integer) : string; + give time string from msec time + + function GetTrackLength:integer; + gives the track lenght in msec (assuming the bpm at the start oof the file) + + function Ready: boolean; + now you can check wether the playback is finished + +} + +unit MidiFile; + +interface + +{$IFDEF FPC} + {$MODE Delphi} + {$H+} // use AnsiString +{$ENDIF} + +uses + Windows, + //Forms, + Messages, + SysUtils, + UCommon, + Classes; + +type + TChunkType = (illegal, header, track); + TFileFormat = (single, multi_synch, multi_asynch); + PByte = ^byte; + + TMidiEvent = record + event: byte; + data1: byte; + data2: byte; + str: string; + dticks: integer; + time: integer; + mtime: integer; + len: integer; + end; + PMidiEvent = ^TMidiEvent; + + TOnMidiEvent = procedure(event: PMidiEvent) of object; + TEvent = procedure of object; + + TMidiTrack = class(TObject) + protected + events: TList; + name: string; + instrument: string; + currentTime: integer; + currentPos: integer; + ready: boolean; + trackLenght: integer; + procedure checkReady; + public + OnMidiEvent: TOnMidiEvent; + OnTrackReady: TEvent; + constructor Create; + destructor Destroy; override; + + procedure Rewind(pos: integer); + procedure PlayUntil(pos: integer); + procedure GoUntil(pos: integer); + + procedure putEvent(event: PMidiEvent); + function getEvent(index: integer): PMidiEvent; + function getName: string; + function getInstrument: string; + function getEventCount: integer; + function getCurrentTime: integer; + function getTrackLength: integer; + function isReady:boolean; + end; + + TMidiFile = class(TComponent) + private + { Private declarations } + procedure MidiTimer(sender : TObject); + procedure WndProc(var Msg : TMessage); + protected + { Protected declarations } + midiFile: file of byte; + chunkType: TChunkType; + chunkLength: integer; + chunkData: PByte; + chunkIndex: PByte; + chunkEnd: PByte; + FPriority: DWORD; + + // midi file attributes + FFileFormat: TFileFormat; + numberTracks: integer; + deltaTicks: integer; + FBpm: integer; + FBeatsPerMeasure: integer; + FusPerTick: double; + FFilename: string; + + Tracks: TList; + currentTrack: TMidiTrack; + FOnMidiEvent: TOnMidiEvent; + FOnUpdateEvent: TNotifyEvent; + + // playing attributes + playing: boolean; + PlayStartTime: integer; + currentTime: integer; // Current playtime in msec + currentPos: Double; // Current Position in ticks + + procedure OnTrackReady; + procedure setFilename(val: string); + procedure ReadChunkHeader; + procedure ReadChunkContent; + procedure ReadChunk; + procedure ProcessHeaderChunk; + procedure ProcessTrackChunk; + function ReadVarLength: integer; + function ReadString(l: integer): string; + procedure SetOnMidiEvent(handler: TOnMidiEvent); + procedure SetBpm(val: integer); + public + { Public declarations } + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + procedure ReadFile; + function GetTrack(index: integer): TMidiTrack; + + procedure StartPlaying; + procedure StopPlaying; + procedure ContinuePlaying; + + procedure PlayToTime(time: integer); + procedure GoToTime(time: integer); + function GetCurrentTime: integer; + function GetFusPerTick : Double; + function GetTrackLength:integer; + function Ready: boolean; + published + { Published declarations } + property Filename: string read FFilename write setFilename; + property NumberOfTracks: integer read numberTracks; + property TicksPerQuarter: integer read deltaTicks; + property FileFormat: TFileFormat read FFileFormat; + property Bpm: integer read FBpm write SetBpm; + property OnMidiEvent: TOnMidiEvent read FOnMidiEvent write SetOnMidiEvent; + property OnUpdateEvent: TNotifyEvent read FOnUpdateEvent write FOnUpdateEvent; + end; + +function KeyToStr(key: integer): string; +function MyTimeToStr(val: integer): string; +procedure Register; + +implementation + +uses mmsystem; + +type +{$IFDEF FPC} + TTimerProc = TTIMECALLBACK; + TTimeCaps = TIMECAPS; +{$ELSE} + TTimerProc = TFNTimeCallBack; +{$ENDIF} + +const TIMER_RESOLUTION=10; +const WM_MULTIMEDIA_TIMER=WM_USER+127; + +var MIDIFileHandle : HWND; + TimerProc : TTimerProc; + MIDITimerID : Integer; + TimerPeriod : Integer; + +procedure TimerCallBackProc(uTimerID,uMsg: Cardinal; dwUser,dwParam1,dwParam2:DWORD);stdcall; +begin + PostMessage(HWND(dwUser),WM_MULTIMEDIA_TIMER,0,0); +end; + +procedure SetMIDITimer; + var TimeCaps : TTimeCaps; +begin + timeGetDevCaps(@TimeCaps,SizeOf(TimeCaps)); + if TIMER_RESOLUTION < TimeCaps.wPeriodMin then + TimerPeriod:=TimeCaps.wPeriodMin + else if TIMER_RESOLUTION > TimeCaps.wPeriodMax then + TimerPeriod:=TimeCaps.wPeriodMax + else + TimerPeriod:=TIMER_RESOLUTION; + + timeBeginPeriod(TimerPeriod); + MIDITimerID:=timeSetEvent(TimerPeriod,TimerPeriod,TimerProc, + DWORD(MIDIFileHandle),TIME_PERIODIC); + if MIDITimerID=0 then + timeEndPeriod(TimerPeriod); +end; + +procedure KillMIDITimer; +begin + timeKillEvent(MIDITimerID); + timeEndPeriod(TimerPeriod); +end; + +constructor TMidiTrack.Create; +begin + inherited Create; + events := TList.Create; + currentTime := 0; + currentPos := 0; +end; + +destructor TMidiTrack.Destroy; +var + i: integer; +begin + for i := 0 to events.count - 1 do + Dispose(PMidiEvent(events.items[i])); + events.Free; + inherited Destroy; +end; + +procedure TMidiTRack.putEvent(event: PMidiEvent); +var + command: integer; + i: integer; + pevent: PMidiEvent; +begin + if (event.event = $FF) then + begin + if (event.data1 = 3) then + name := event.str; + if (event.data1 = 4) then + instrument := event.str; + end; + currentTime := currentTime + event.dticks; + event.time := currentTime; // for the moment just add dticks + event.len := 0; + events.add(TObject(event)); + command := event.event and $F0; + + if ((command = $80) // note off + or ((command = $90) and (event.data2 = 0))) //note on with speed 0 + then + begin + // this is a note off, try to find the accompanion note on + command := event.event or $90; + i := events.count - 2; + while i >= 0 do + begin + pevent := PMidiEvent(events[i]); + if (pevent.event = command) and + (pevent.data1 = event.data1) + then + begin + pevent.len := currentTIme - pevent.time; + i := 0; + event.len := -1; + end; + dec(i); + end; + end; +end; + +function TMidiTrack.getName: string; +begin + result := name; +end; + +function TMidiTrack.getInstrument: string; +begin + result := instrument; +end; + +function TMiditrack.getEventCount: integer; +begin + result := events.count; +end; + +function TMiditrack.getEvent(index: integer): PMidiEvent; +begin + if ((index < events.count) and (index >= 0)) then + result := events[index] + else + result := nil; +end; + +function TMiditrack.getCurrentTime: integer; +begin + result := currentTime; +end; + +procedure TMiditrack.Rewind(pos: integer); +begin + if currentPos = events.count then + dec(currentPos); + while ((currentPos > 0) and + (PMidiEvent(events[currentPos]).time > pos)) + do + begin + dec(currentPos); + end; + checkReady; +end; + +procedure TMiditrack.PlayUntil(pos: integer); +begin + if assigned(OnMidiEvent) then + begin + while ((currentPos < events.count) and + (PMidiEvent(events[currentPos]).time < pos)) do + begin + OnMidiEvent(PMidiEvent(events[currentPos])); + inc(currentPos); + end; + end; + checkReady; +end; + +procedure TMidiTrack.GoUntil(pos: integer); +begin + while ((currentPos < events.count) and + (PMidiEvent(events[currentPos]).time < pos)) do + begin + inc(currentPos); + end; + checkReady; +end; + +procedure TMidiTrack.checkReady; +begin + if currentPos >= events.count then + begin + ready := true; + if assigned(OnTrackReady) then + OnTrackReady; + end + else + ready := false; +end; + +function TMidiTrack.getTrackLength: integer; +begin + result := PMidiEvent(events[events.count-1]).time +end; + +function TMidiTrack.isReady: boolean; +begin + result := ready; +end; + +constructor TMidifile.Create(AOwner: TComponent); +begin + inherited Create(AOWner); + MIDIFileHandle:=AllocateHWnd(WndProc); + chunkData := nil; + chunkType := illegal; + Tracks := TList.Create; + TimerProc:=@TimerCallBackProc; + FPriority:=GetPriorityClass(MIDIFileHandle); +end; + +destructor TMidifile.Destroy; +var + i: integer; +begin + if not (chunkData = nil) then FreeMem(chunkData); + for i := 0 to Tracks.Count - 1 do + TMidiTrack(Tracks.Items[i]).Free; + Tracks.Free; + SetPriorityClass(MIDIFileHandle,FPriority); + + if MIDITimerID<>0 then KillMIDITimer; + + DeallocateHWnd(MIDIFileHandle); + + inherited Destroy; +end; + +function TMidiFile.GetTrack(index: integer): TMidiTrack; +begin + result := Tracks.Items[index]; +end; + +procedure TMidifile.setFilename(val: string); +begin + FFilename := val; +// ReadFile; +end; + +procedure TMidifile.SetOnMidiEvent(handler: TOnMidiEvent); +var + i: integer; +begin +// if not (FOnMidiEvent = handler) then +// begin + FOnMidiEvent := handler; + for i := 0 to tracks.count - 1 do + TMidiTrack(tracks.items[i]).OnMidiEvent := handler; +// end; +end; + +procedure TMidifile.MidiTimer(Sender: TObject); +begin + if playing then + begin + PlayToTime(GetTickCount - PlayStartTime); + if assigned(FOnUpdateEvent) then FOnUpdateEvent(self); + end; +end; + +procedure TMidifile.StartPlaying; +var + i: integer; +begin + for i := 0 to tracks.count - 1 do + TMidiTrack(tracks[i]).Rewind(0); + playStartTime := getTickCount; + playing := true; + + SetPriorityClass(MIDIFileHandle,REALTIME_PRIORITY_CLASS); + + SetMIDITimer; + currentPos := 0.0; + currentTime := 0; +end; + +procedure TMidifile.ContinuePlaying; +begin + PlayStartTime := GetTickCount - currentTime; + playing := true; + + SetPriorityClass(MIDIFileHandle,REALTIME_PRIORITY_CLASS); + + SetMIDITimer; +end; + +procedure TMidifile.StopPlaying; +begin + playing := false; + KillMIDITimer; + SetPriorityClass(MIDIFileHandle,FPriority); +end; + +function TMidiFile.GetCurrentTime: integer; +begin + Result := currentTime; +end; + +procedure TMidifile.PlayToTime(time: integer); +var + i: integer; + track: TMidiTrack; + pos: integer; + deltaTime: integer; +begin + // calculate the pos in the file. + // pos is actually tick + // Current FusPerTick is uses to determine the actual pos + + deltaTime := time - currentTime; + currentPos := currentPos + (deltaTime * 1000) / FusPerTick; + pos := round(currentPos); + + for i := 0 to tracks.count - 1 do + begin + TMidiTrack(tracks.items[i]).PlayUntil(pos); + end; + currentTime := time; +end; + +procedure TMidifile.GoToTime(time: integer); +var + i: integer; + track: TMidiTrack; + pos: integer; +begin + // this function should be changed because FusPerTick might not be constant + pos := round((time * 1000) / FusPerTick); + for i := 0 to tracks.count - 1 do + begin + TMidiTrack(tracks.items[i]).Rewind(0); + TMidiTrack(tracks.items[i]).GoUntil(pos); + end; +end; + +procedure TMidifile.SetBpm(val: integer); +var + us_per_quarter: integer; +begin + if not (val = FBpm) then + begin + us_per_quarter := 60000000 div val; + + FBpm := 60000000 div us_per_quarter; + FusPerTick := us_per_quarter / deltaTicks; + end; +end; + +procedure TMidifile.ReadChunkHeader; +var + theByte: array[0..7] of byte; +begin + BlockRead(midiFile, theByte, 8); + if (theByte[0] = $4D) and (theByte[1] = $54) then + begin + if (theByte[2] = $68) and (theByte[3] = $64) then + chunkType := header + else if (theByte[2] = $72) and (theByte[3] = $6B) then + chunkType := track + else + chunkType := illegal; + end + else + begin + chunkType := illegal; + end; + chunkLength := theByte[7] + theByte[6] * $100 + theByte[5] * $10000 + theByte[4] * $1000000; +end; + +procedure TMidifile.ReadChunkContent; +begin + if not (chunkData = nil) then + FreeMem(chunkData); + GetMem(chunkData, chunkLength + 10); + BlockRead(midiFile, chunkData^, chunkLength); + chunkIndex := chunkData; + chunkEnd := PByte(integer(chunkIndex) + integer(chunkLength) - 1); +end; + +procedure TMidifile.ReadChunk; +begin + ReadChunkHeader; + ReadChunkContent; + case chunkType of + header: + ProcessHeaderChunk; + track: + ProcessTrackCHunk; + end; +end; + +procedure TMidifile.ProcessHeaderChunk; +begin + chunkIndex := chunkData; + inc(chunkIndex); + if chunkType = header then + begin + case chunkIndex^ of + 0: FfileFormat := single; + 1: FfileFormat := multi_synch; + 2: FfileFormat := multi_asynch; + end; + inc(chunkIndex); + numberTracks := chunkIndex^ * $100; + inc(chunkIndex); + numberTracks := numberTracks + chunkIndex^; + inc(chunkIndex); + deltaTicks := chunkIndex^ * $100; + inc(chunkIndex); + deltaTicks := deltaTicks + chunkIndex^; + end; +end; + +procedure TMidifile.ProcessTrackChunk; +var + dTime: integer; + event: integer; + len: integer; + str: string; + midiEvent: PMidiEvent; + i: integer; + us_per_quarter: integer; +begin + chunkIndex := chunkData; +// inc(chunkIndex); + event := 0; + if chunkType = track then + begin + currentTrack := TMidiTrack.Create; + currentTrack.OnMidiEvent := FOnMidiEvent; + Tracks.add(currentTrack); + while integer(chunkIndex) < integer(chunkEnd) do + begin + // each event starts with var length delta time + dTime := ReadVarLength; + if chunkIndex^ >= $80 then + begin + event := chunkIndex^; + inc(chunkIndex); + end; + // else it is a running status event (just the same event as before) + + if event = $FF then + begin +{ case chunkIndex^ of + $00: // sequence number, not implemented jet + begin + inc(chunkIndex); // $02 + inc(chunkIndex); + end; + $01 .. $0f: // text events FF ty len text + begin + New(midiEvent); + midiEvent.event := $FF; + midiEvent.data1 := chunkIndex^; // type is stored in data1 + midiEvent.dticks := dtime; + + inc(chunkIndex); + len := ReadVarLength; + midiEvent.str := ReadString(len); + + currentTrack.putEvent(midiEvent); + end; + $20: // Midi channel prefix FF 20 01 cc + begin + inc(chunkIndex); // $01 + inc(chunkIndex); // channel + inc(chunkIndex); + end; + $2F: // End of track FF 2F 00 + begin + inc(chunkIndex); // $00 + inc(chunkIndex); + end; + $51: // Set Tempo FF 51 03 tttttt + begin + inc(chunkIndex); // $03 + inc(chunkIndex); // tt + inc(chunkIndex); // tt + inc(chunkIndex); // tt + inc(chunkIndex); + end; + $54: // SMPTE offset FF 54 05 hr mn se fr ff + begin + inc(chunkIndex); // $05 + inc(chunkIndex); // hr + inc(chunkIndex); // mn + inc(chunkIndex); // se + inc(chunkIndex); // fr + inc(chunkIndex); // ff + inc(chunkIndex); + end; + $58: // Time signature FF 58 04 nn dd cc bb + begin + inc(chunkIndex); // $04 + inc(chunkIndex); // nn + inc(chunkIndex); // dd + inc(chunkIndex); // cc + inc(chunkIndex); // bb + inc(chunkIndex); + end; + $59: // Key signature FF 59 02 df mi + begin + inc(chunkIndex); // $02 + inc(chunkIndex); // df + inc(chunkIndex); // mi + inc(chunkIndex); + end; + $7F: // Sequence specific Meta-event + begin + inc(chunkIndex); + len := ReadVarLength; + str := ReadString(len); + end; + else // unknown meta event + } + begin + New(midiEvent); + midiEvent.event := $FF; + midiEvent.data1 := chunkIndex^; // type is stored in data1 + midiEvent.dticks := dtime; + + inc(chunkIndex); + len := ReadVarLength; + midiEvent.str := ReadString(len); + currentTrack.putEvent(midiEvent); + + case midiEvent.data1 of + $51: + begin + us_per_quarter := + (integer(byte(midiEvent.str[1])) shl 16 + + integer(byte(midiEvent.str[2])) shl 8 + + integer(byte(midiEvent.str[3]))); + FBpm := 60000000 div us_per_quarter; + FusPerTick := us_per_quarter / deltaTicks; + end; + end; + end; +// end; + end + else + begin + // these are all midi events + New(midiEvent); + midiEvent.event := event; + midiEvent.dticks := dtime; +// inc(chunkIndex); + case event of + $80..$8F, // note off + $90..$9F, // note on + $A0..$AF, // key aftertouch + $B0..$BF, // control change + $E0..$EF: // pitch wheel change + begin + midiEvent.data1 := chunkIndex^; inc(chunkIndex); + midiEvent.data2 := chunkIndex^; inc(chunkIndex); + end; + $C0..$CF, // program change + $D0..$DF: // channel aftertouch + begin + midiEvent.data1 := chunkIndex^; inc(chunkIndex); + end; + else + // error + end; + currentTrack.putEvent(midiEvent); + end; + end; + end; +end; + + +function TMidifile.ReadVarLength: integer; +var + i: integer; + b: byte; +begin + b := 128; + i := 0; + while b > 127 do + begin + i := i shl 7; + b := chunkIndex^; + i := i + b and $7F; + inc(chunkIndex); + end; + result := i; +end; + +function TMidifile.ReadString(l: integer): string; +var + s: PChar; + i: integer; +begin + GetMem(s, l + 1); ; + s[l] := chr(0); + for i := 0 to l - 1 do + begin + s[i] := Chr(chunkIndex^); + inc(chunkIndex); + end; + result := string(s); +end; + +procedure TMidifile.ReadFile; +var + i: integer; +begin + for i := 0 to Tracks.Count - 1 do + TMidiTrack(Tracks.Items[i]).Free; + Tracks.Clear; + chunkType := illegal; + + AssignFile(midiFile, FFilename); + FileMode := 0; + Reset(midiFile); + while not eof(midiFile) do + ReadChunk; + CloseFile(midiFile); + numberTracks := Tracks.Count; +end; + +function KeyToStr(key: integer): string; +var + n: integer; + str: string; +begin + n := key mod 12; + case n of + 0: str := 'C'; + 1: str := 'C#'; + 2: str := 'D'; + 3: str := 'D#'; + 4: str := 'E'; + 5: str := 'F'; + 6: str := 'F#'; + 7: str := 'G'; + 8: str := 'G#'; + 9: str := 'A'; + 10: str := 'A#'; + 11: str := 'B'; + end; + Result := str + IntToStr(key div 12); +end; + +function IntToLenStr(val: integer; len: integer): string; +var + str: string; +begin + str := IntToStr(val); + while Length(str) < len do + str := '0' + str; + Result := str; +end; + +function MyTimeToStr(val: integer): string; + var + hour: integer; + min: integer; + sec: integer; + msec: integer; +begin + msec := val mod 1000; + sec := val div 1000; + min := sec div 60; + sec := sec mod 60; + hour := min div 60; + min := min mod 60; + Result := IntToStr(hour) + ':' + IntToLenStr(min, 2) + ':' + IntToLenStr(sec, 2) + '.' + IntToLenStr(msec, 3); +end; + +function TMidiFIle.GetFusPerTick : Double; +begin + Result := FusPerTick; +end; + +function TMidiFIle.GetTrackLength:integer; +var i,length : integer; + time : extended; +begin + length := 0; + for i := 0 to Tracks.Count - 1 do + if TMidiTrack(Tracks.Items[i]).getTrackLength > length then + length := TMidiTrack(Tracks.Items[i]).getTrackLength; + time := length * FusPerTick; + time := time / 1000.0; + result := round(time); +end; + +function TMidiFIle.Ready: boolean; +var i : integer; +begin + result := true; + for i := 0 to Tracks.Count - 1 do + if not TMidiTrack(Tracks.Items[i]).isready then + result := false; +end; + +procedure TMidiFile.OnTrackReady; +begin + if ready then + if assigned(FOnUpdateEvent) then FOnUpdateEvent(self); +end; + +procedure TMidiFile.WndProc(var Msg : TMessage); +begin + with MSG do + begin + case Msg of + WM_MULTIMEDIA_TIMER: + begin + //try + MidiTimer(self); + //except + // Note: HandleException() is called by default if exception is not handled + // Application.HandleException(Self); + //end; + end; + else + begin + Result := DefWindowProc(MIDIFileHandle, Msg, wParam, lParam); + end; + end; + end; +end; + +procedure Register; +begin + RegisterComponents('Synth', [TMidiFile]); +end; + +end. + diff --git a/Game/Code/lib/midi/MidiScope.pas b/Game/Code/lib/midi/MidiScope.pas index 43efc4e8..42fc65fc 100644 --- a/Game/Code/lib/midi/MidiScope.pas +++ b/Game/Code/lib/midi/MidiScope.pas @@ -1,198 +1,198 @@ -{
- Shows a large black area where midi note/controller events are shown
- just to monitor midi activity (for the MidiPlayer)
-
- version 1.0 first release
-
- for comments/bugs
- F.Bouwmans
- fbouwmans@spiditel.nl
-
- if you think this component is nice and you use it, sent me a short email.
- I've seen that other of my components have been downloaded a lot, but I've
- got no clue wether they are actually used.
- Don't worry because you are free to use these components
-}
-
-unit MidiScope;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
- {$H+} // use AnsiString
-{$ENDIF}
-
-uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
-
-type
- TMidiScope = class(TGraphicControl)
- private
- { Private declarations }
- protected
- { Protected declarations }
- notes : array[0..15,0..127] of integer;
- controllers : array[0..15,0..17] of integer;
- aftertouch : array[0..15,0..127] of integer;
-
- selectedChannel : integer;
-
- procedure PaintSlide(ch,pos,val: integer);
-
- procedure NoteOn(channel, note, speed : integer);
- procedure Controller(channel,number,value : integer);
- procedure AfterTch(channel, note, value : integer);
-
- public
- { Public declarations }
- constructor Create(AOwner: TComponent); override;
- procedure MidiEvent(event,data1,data2 : integer);
- procedure Paint; override;
- published
- { Published declarations }
- end;
-
-
-procedure Register;
-
-const
- BarHeight = 16;
- BarHeightInc = BarHeight+2;
- BarWidth = 3;
- BarWidthInc = BarWidth+1;
- HeightDiv = 128 div BarHeight;
-
-implementation
-
-uses Midicons;
-
-procedure Register;
-begin
- RegisterComponents('Synth', [TMidiScope]);
-end;
-
-constructor TMidiScope.Create(AOwner: TComponent);
-var
- i,j : integer;
-begin
- inherited Create(AOwner);
- Height := BarHeightinc * 16 + 4;
- Width := 147*BarWidthInc + 4 + 20; // for channel number
- for i := 0 to 15 do
- begin
- for j := 0 to 127 do
- begin
- notes[i,j] := 0;
- aftertouch[i,j] := 0;
- end;
- end;
- for i := 0 to 17 do
- begin
- for j := 0 to 15 do
- controllers[i,j] := 0;
- end;
-end;
-
-procedure TMidiScope.PaintSlide(ch,pos,val: integer);
-var x,y:integer;
-begin
- Canvas.Brush.Color := clBlack;
- Canvas.Pen.color := clBlack;
- x := pos * BarWidthInc + 2;
- y := 2 + ch * BarHeightInc;
- Canvas.Rectangle(x, y, x+BarWidthInc, y+BarHeightInc);
- Canvas.Brush.Color := clGreen;
- Canvas.Pen.Color := clGreen;
- Canvas.Rectangle(x, y + (BarHeight - (val div HeightDiv )), x + BarWidth, y + BarHeight)
-end;
-
-procedure TMidiScope.Paint;
-var i,j : integer;
-x : integer;
-begin
- Canvas.Brush.color := clBlack;
- Canvas.Rectangle(0,0,Width,Height);
- Canvas.Pen.Color := clGreen;
- x := 128*BarWidthInc+2;
- Canvas.MoveTo(x,0);
- Canvas.LineTo(x,Height);
- x := 148*BarWIdthInc+2;
- canvas.Font.Color := clGreen;
- for i := 0 to 15 do
- Canvas.TextOut(x,((i+1)*BarHeightInc) - Canvas.font.size-3,IntToStr(i+1));
- canvas.Pen.color := clBlack;
- begin
- for j := 0 to 127 do
- begin
- PaintSlide(i,j,notes[i,j]);
- end;
- for j := 0 to 17 do
- begin
- PaintSlide(i,j+129,controllers[i,j]);
- end;
- end;
-end;
-procedure TMidiScope.NoteOn(channel, note, speed : integer);
-begin
- notes[channel,note] := speed;
- PaintSlide(channel,note,notes[channel,note]);
-end;
-procedure TMidiScope.AfterTch(channel, note, value : integer);
-begin
- aftertouch[channel,note] := value;
-end;
-
-procedure TMidiScope.Controller(channel,number,value : integer);
-var i : integer;
-begin
- if number < 18 then
- begin
- controllers[channel,number] := value;
- PaintSlide(channel,number+129,value);
- end
- else if number >= $7B then
- begin
- // all notes of for channel
- for i := 0 to 127 do
- begin
- if notes[channel,i] > 0 then
- begin
- notes[channel,i] := 0;
- PaintSlide(channel,i,0);
- end;
- end;
- end;
-end;
-
-procedure TMidiScope.MidiEvent(event,data1,data2 : integer);
-begin
- case (event AND $F0) of
- MIDI_NOTEON :
- begin
- NoteOn((event AND $F),data1,data2);
- end;
- MIDI_NOTEOFF:
- begin
- NoteOn((event AND $F),data1,0);
- end;
- MIDI_CONTROLCHANGE :
- begin
- Controller((event AND $F),data1,data2);
- end;
- MIDI_CHANAFTERTOUCH:
- begin
- Controller((Event AND $F),16,Data1);
- end;
- MIDI_PITCHBEND:
- begin
- begin
- Controller((Event AND $F),17,data2);
- end;
- end;
- MIDI_KEYAFTERTOUCH:
- begin
- end;
- end;
-end;
-end.
+{ + Shows a large black area where midi note/controller events are shown + just to monitor midi activity (for the MidiPlayer) + + version 1.0 first release + + for comments/bugs + F.Bouwmans + fbouwmans@spiditel.nl + + if you think this component is nice and you use it, sent me a short email. + I've seen that other of my components have been downloaded a lot, but I've + got no clue wether they are actually used. + Don't worry because you are free to use these components +} + +unit MidiScope; + +interface + +{$IFDEF FPC} + {$MODE Delphi} + {$H+} // use AnsiString +{$ENDIF} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; + +type + TMidiScope = class(TGraphicControl) + private + { Private declarations } + protected + { Protected declarations } + notes : array[0..15,0..127] of integer; + controllers : array[0..15,0..17] of integer; + aftertouch : array[0..15,0..127] of integer; + + selectedChannel : integer; + + procedure PaintSlide(ch,pos,val: integer); + + procedure NoteOn(channel, note, speed : integer); + procedure Controller(channel,number,value : integer); + procedure AfterTch(channel, note, value : integer); + + public + { Public declarations } + constructor Create(AOwner: TComponent); override; + procedure MidiEvent(event,data1,data2 : integer); + procedure Paint; override; + published + { Published declarations } + end; + + +procedure Register; + +const + BarHeight = 16; + BarHeightInc = BarHeight+2; + BarWidth = 3; + BarWidthInc = BarWidth+1; + HeightDiv = 128 div BarHeight; + +implementation + +uses Midicons; + +procedure Register; +begin + RegisterComponents('Synth', [TMidiScope]); +end; + +constructor TMidiScope.Create(AOwner: TComponent); +var + i,j : integer; +begin + inherited Create(AOwner); + Height := BarHeightinc * 16 + 4; + Width := 147*BarWidthInc + 4 + 20; // for channel number + for i := 0 to 15 do + begin + for j := 0 to 127 do + begin + notes[i,j] := 0; + aftertouch[i,j] := 0; + end; + end; + for i := 0 to 17 do + begin + for j := 0 to 15 do + controllers[i,j] := 0; + end; +end; + +procedure TMidiScope.PaintSlide(ch,pos,val: integer); +var x,y:integer; +begin + Canvas.Brush.Color := clBlack; + Canvas.Pen.color := clBlack; + x := pos * BarWidthInc + 2; + y := 2 + ch * BarHeightInc; + Canvas.Rectangle(x, y, x+BarWidthInc, y+BarHeightInc); + Canvas.Brush.Color := clGreen; + Canvas.Pen.Color := clGreen; + Canvas.Rectangle(x, y + (BarHeight - (val div HeightDiv )), x + BarWidth, y + BarHeight) +end; + +procedure TMidiScope.Paint; +var i,j : integer; +x : integer; +begin + Canvas.Brush.color := clBlack; + Canvas.Rectangle(0,0,Width,Height); + Canvas.Pen.Color := clGreen; + x := 128*BarWidthInc+2; + Canvas.MoveTo(x,0); + Canvas.LineTo(x,Height); + x := 148*BarWIdthInc+2; + canvas.Font.Color := clGreen; + for i := 0 to 15 do + Canvas.TextOut(x,((i+1)*BarHeightInc) - Canvas.font.size-3,IntToStr(i+1)); + canvas.Pen.color := clBlack; + begin + for j := 0 to 127 do + begin + PaintSlide(i,j,notes[i,j]); + end; + for j := 0 to 17 do + begin + PaintSlide(i,j+129,controllers[i,j]); + end; + end; +end; +procedure TMidiScope.NoteOn(channel, note, speed : integer); +begin + notes[channel,note] := speed; + PaintSlide(channel,note,notes[channel,note]); +end; +procedure TMidiScope.AfterTch(channel, note, value : integer); +begin + aftertouch[channel,note] := value; +end; + +procedure TMidiScope.Controller(channel,number,value : integer); +var i : integer; +begin + if number < 18 then + begin + controllers[channel,number] := value; + PaintSlide(channel,number+129,value); + end + else if number >= $7B then + begin + // all notes of for channel + for i := 0 to 127 do + begin + if notes[channel,i] > 0 then + begin + notes[channel,i] := 0; + PaintSlide(channel,i,0); + end; + end; + end; +end; + +procedure TMidiScope.MidiEvent(event,data1,data2 : integer); +begin + case (event AND $F0) of + MIDI_NOTEON : + begin + NoteOn((event AND $F),data1,data2); + end; + MIDI_NOTEOFF: + begin + NoteOn((event AND $F),data1,0); + end; + MIDI_CONTROLCHANGE : + begin + Controller((event AND $F),data1,data2); + end; + MIDI_CHANAFTERTOUCH: + begin + Controller((Event AND $F),16,Data1); + end; + MIDI_PITCHBEND: + begin + begin + Controller((Event AND $F),17,data2); + end; + end; + MIDI_KEYAFTERTOUCH: + begin + end; + end; +end; +end. diff --git a/Game/Code/lib/midi/Midicons.pas b/Game/Code/lib/midi/Midicons.pas index 45bae463..35dbb5f3 100644 --- a/Game/Code/lib/midi/Midicons.pas +++ b/Game/Code/lib/midi/Midicons.pas @@ -1,47 +1,47 @@ -{ $Header: /MidiComp/MIDICONS.PAS 2 10/06/97 7:33 Davec $ }
-
-{ Written by David Churcher <dchurcher@cix.compulink.co.uk>,
- released to the public domain. }
-
-
-{ MIDI Constants }
-unit Midicons;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
- {$H+} // use AnsiString
-{$ENDIF}
-
-uses Messages;
-
-const
- MIDI_ALLNOTESOFF = $7B;
- MIDI_NOTEON = $90;
- MIDI_NOTEOFF = $80;
- MIDI_KEYAFTERTOUCH = $a0;
- MIDI_CONTROLCHANGE = $b0;
- MIDI_PROGRAMCHANGE = $c0;
- MIDI_CHANAFTERTOUCH = $d0;
- MIDI_PITCHBEND = $e0;
- MIDI_SYSTEMMESSAGE = $f0;
- MIDI_BEGINSYSEX = $f0;
- MIDI_MTCQUARTERFRAME = $f1;
- MIDI_SONGPOSPTR = $f2;
- MIDI_SONGSELECT = $f3;
- MIDI_ENDSYSEX = $F7;
- MIDI_TIMINGCLOCK = $F8;
- MIDI_START = $FA;
- MIDI_CONTINUE = $FB;
- MIDI_STOP = $FC;
- MIDI_ACTIVESENSING = $FE;
- MIDI_SYSTEMRESET = $FF;
-
- MIM_OVERFLOW = WM_USER; { Input buffer overflow }
- MOM_PLAYBACK_DONE = WM_USER+1; { Timed playback complete }
-
-
-implementation
-
-end.
+{ $Header: /MidiComp/MIDICONS.PAS 2 10/06/97 7:33 Davec $ } + +{ Written by David Churcher <dchurcher@cix.compulink.co.uk>, + released to the public domain. } + + +{ MIDI Constants } +unit Midicons; + +interface + +{$IFDEF FPC} + {$MODE Delphi} + {$H+} // use AnsiString +{$ENDIF} + +uses Messages; + +const + MIDI_ALLNOTESOFF = $7B; + MIDI_NOTEON = $90; + MIDI_NOTEOFF = $80; + MIDI_KEYAFTERTOUCH = $a0; + MIDI_CONTROLCHANGE = $b0; + MIDI_PROGRAMCHANGE = $c0; + MIDI_CHANAFTERTOUCH = $d0; + MIDI_PITCHBEND = $e0; + MIDI_SYSTEMMESSAGE = $f0; + MIDI_BEGINSYSEX = $f0; + MIDI_MTCQUARTERFRAME = $f1; + MIDI_SONGPOSPTR = $f2; + MIDI_SONGSELECT = $f3; + MIDI_ENDSYSEX = $F7; + MIDI_TIMINGCLOCK = $F8; + MIDI_START = $FA; + MIDI_CONTINUE = $FB; + MIDI_STOP = $FC; + MIDI_ACTIVESENSING = $FE; + MIDI_SYSTEMRESET = $FF; + + MIM_OVERFLOW = WM_USER; { Input buffer overflow } + MOM_PLAYBACK_DONE = WM_USER+1; { Timed playback complete } + + +implementation + +end. diff --git a/Game/Code/lib/midi/Midiin.pas b/Game/Code/lib/midi/Midiin.pas index a122bcb0..3688d5c9 100644 --- a/Game/Code/lib/midi/Midiin.pas +++ b/Game/Code/lib/midi/Midiin.pas @@ -1,725 +1,725 @@ -{ $Header: /MidiComp/Midiin.pas 2 10/06/97 7:33 Davec $ }
-
-{ Written by David Churcher <dchurcher@cix.compulink.co.uk>,
- released to the public domain. }
-
-unit MidiIn;
-
-{
- Properties:
- DeviceID: Windows numeric device ID for the MIDI input device.
- Between 0 and NumDevs-1.
- Read-only while device is open, exception when changed while open
-
- MIDIHandle: The input handle to the MIDI device.
- 0 when device is not open
- Read-only, runtime-only
-
- MessageCount: Number of input messages waiting in input buffer
-
- Capacity: Number of messages input buffer can hold
- Defaults to 1024
- Limited to (64K/event size)
- Read-only when device is open (exception when changed while open)
-
- SysexBufferSize: Size in bytes of each sysex buffer
- Defaults to 10K
- Minimum 0K (no buffers), Maximum 64K-1
-
- SysexBufferCount: Number of sysex buffers
- Defaults to 16
- Minimum 0 (no buffers), Maximum (avail mem/SysexBufferSize)
- Check where these buffers are allocated?
-
- SysexOnly: True to ignore all non-sysex input events. May be changed while
- device is open. Handy for patch editors where you have lots of short MIDI
- events on the wire which you are always going to ignore anyway.
-
- DriverVersion: Version number of MIDI device driver. High-order byte is
- major version, low-order byte is minor version.
-
- ProductName: Name of product (e.g. 'MPU 401 In')
-
- MID and PID: Manufacturer ID and Product ID, see
- "Manufacturer and Product IDs" in MMSYSTEM.HLP for list of possible values.
-
- Methods:
- GetMidiEvent: Read Midi event at the head of the FIFO input buffer.
- Returns a TMyMidiEvent object containing MIDI message data, timestamp,
- and sysex data if applicable.
- This method automatically removes the event from the input buffer.
- It makes a copy of the received sysex buffer and puts the buffer back
- on the input device.
- The TMyMidiEvent object must be freed by calling MyMidiEvent.Free.
-
- Open: Opens device. Note no input will appear until you call the Start
- method.
-
- Close: Closes device. Any pending system exclusive output will be cancelled.
-
- Start: Starts receiving MIDI input.
-
- Stop: Stops receiving MIDI input.
-
- Events:
- OnMidiInput: Called when MIDI input data arrives. Use the GetMidiEvent to
- get the MIDI input data.
-
- OnOverflow: Called if the MIDI input buffer overflows. The caller must
- clear the buffer before any more MIDI input can be received.
-
- Notes:
- Buffering: Uses a circular buffer, separate pointers for next location
- to fill and next location to empty because a MIDI input interrupt may
- be adding data to the buffer while the buffer is being read. Buffer
- pointers wrap around from end to start of buffer automatically. If
- buffer overflows then the OnBufferOverflow event is triggered and no
- further input will be received until the buffer is emptied by calls
- to GetMidiEvent.
-
- Sysex buffers: There are (SysexBufferCount) buffers on the input device.
- When sysex events arrive these buffers are removed from the input device and
- added to the circular buffer by the interrupt handler in the DLL. When the sysex events
- are removed from the circular buffer by the GetMidiEvent method the buffers are
- put back on the input. If all the buffers are used up there will be no
- more sysex input until at least one sysex event is removed from the input buffer.
- In other words if you're expecting lots of sysex input you need to set the
- SysexBufferCount property high enough so that you won't run out of
- input buffers before you get a chance to read them with GetMidiEvent.
-
- If the synth sends a block of sysex that's longer than SysexBufferSize it
- will be received as separate events.
- TODO: Component derived from this one that handles >64K sysex blocks cleanly
- and can stream them to disk.
-
- Midi Time Code (MTC) and Active Sensing: The DLL is currently hardcoded
- to filter these short events out, so that we don't spend all our time
- processing them.
- TODO: implement a filter property to select the events that will be filtered
- out.
-}
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
- {$H+} // use AnsiString
-{$ENDIF}
-
-uses
- Classes,
- SysUtils,
- Messages,
- Windows,
- MMSystem,
- UCommon,
- MidiDefs,
- MidiType,
- MidiCons,
- Circbuf,
- Delphmcb;
-
-type
- MidiInputState = (misOpen, misClosed, misCreating, misDestroying);
- EMidiInputError = class(Exception);
-
- {-------------------------------------------------------------------}
- TMidiInput = class(TComponent)
- private
- Handle: THandle; { Window handle used for callback notification }
- FDeviceID: Word; { MIDI device ID }
- FMIDIHandle: HMIDIIn; { Handle to input device }
- FState: MidiInputState; { Current device state }
-
- FError: Word;
- FSysexOnly: Boolean;
-
- { Stuff from MIDIINCAPS }
- FDriverVersion: MMVERSION;
- FProductName: string;
- FMID: Word; { Manufacturer ID }
- FPID: Word; { Product ID }
-
- { Queue }
- FCapacity: Word; { Buffer capacity }
- PBuffer: PCircularBuffer; { Low-level MIDI input buffer created by Open method }
- FNumdevs: Word; { Number of input devices on system }
-
- { Events }
- FOnMIDIInput: TNotifyEvent; { MIDI Input arrived }
- FOnOverflow: TNotifyEvent; { Input buffer overflow }
- { TODO: Some sort of error handling event for MIM_ERROR }
-
- { Sysex }
- FSysexBufferSize: Word;
- FSysexBufferCount: Word;
- MidiHdrs: Tlist;
-
- PCtlInfo: PMidiCtlInfo; { Pointer to control info for DLL }
-
- protected
- procedure Prepareheaders;
- procedure UnprepareHeaders;
- procedure AddBuffers;
- procedure SetDeviceID(DeviceID: Word);
- procedure SetProductName(NewProductName: string);
- function GetEventCount: Word;
- procedure SetSysexBufferSize(BufferSize: Word);
- procedure SetSysexBufferCount(BufferCount: Word);
- procedure SetSysexOnly(bSysexOnly: Boolean);
- function MidiInErrorString(WError: Word): string;
-
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
-
- property MIDIHandle: HMIDIIn read FMIDIHandle;
-
- property DriverVersion: MMVERSION read FDriverVersion;
- property MID: Word read FMID; { Manufacturer ID }
- property PID: Word read FPID; { Product ID }
-
- property Numdevs: Word read FNumdevs;
-
- property MessageCount: Word read GetEventCount;
- { TODO: property to select which incoming messages get filtered out }
-
- procedure Open;
- procedure Close;
- procedure Start;
- procedure Stop;
- { Get first message in input queue }
- function GetMidiEvent: TMyMidiEvent;
- procedure MidiInput(var Message: TMessage);
-
- { Some functions to decode and classify incoming messages would be good }
-
- published
-
- { TODO: Property editor with dropdown list of product names }
- property ProductName: string read FProductName write SetProductName;
-
- property DeviceID: Word read FDeviceID write SetDeviceID default 0;
- property Capacity: Word read FCapacity write FCapacity default 1024;
- property Error: Word read FError;
- property SysexBufferSize: Word
- read FSysexBufferSize
- write SetSysexBufferSize
- default 10000;
- property SysexBufferCount: Word
- read FSysexBufferCount
- write SetSysexBufferCount
- default 16;
- property SysexOnly: Boolean
- read FSysexOnly
- write SetSysexOnly
- default False;
-
- { Events }
- property OnMidiInput: TNotifyEvent read FOnMidiInput write FOnMidiInput;
- property OnOverflow: TNotifyEvent read FOnOverflow write FOnOverflow;
-
- end;
-
-procedure Register;
-
-{====================================================================}
-implementation
-
-uses Controls,
- Graphics;
-
-(* Not used in Delphi 3
-{ This is the callback procedure in the external DLL.
- It's used when midiInOpen is called by the Open method.
- There are special requirements and restrictions for this callback
- procedure (see midiInOpen in MMSYSTEM.HLP) so it's impractical to
- make it an object method }
-{$IFDEF WIN32}
-function midiHandler(
- hMidiIn: HMidiIn;
- wMsg: UINT;
- dwInstance: DWORD;
- dwParam1: DWORD;
- dwParam2: DWORD): Boolean; stdcall; external 'DELMID32.DLL';
-{$ELSE}
-procedure midiHandler(
- hMidiIn: HMidiIn;
- wMsg: Word;
- dwInstance: DWORD;
- dwParam1: DWORD;
- dwParam2: DWORD); far; external 'DELPHMID';
-{$ENDIF}
-*)
-{-------------------------------------------------------------------}
-
-constructor TMidiInput.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
- FState := misCreating;
-
- FSysexOnly := False;
- FNumDevs := midiInGetNumDevs;
- MidiHdrs := nil;
-
- { Set defaults }
- if (FNumDevs > 0) then
- SetDeviceID(0);
- FCapacity := 1024;
- FSysexBufferSize := 4096;
- FSysexBufferCount := 16;
-
- { Create the window for callback notification }
- if not (csDesigning in ComponentState) then
- begin
- Handle := AllocateHwnd(MidiInput);
- end;
-
- FState := misClosed;
-
-end;
-
-{-------------------------------------------------------------------}
-{ Close the device if it's open }
-
-destructor TMidiInput.Destroy;
-begin
- if (FMidiHandle <> 0) then
- begin
- Close;
- FMidiHandle := 0;
- end;
-
- if (PCtlInfo <> nil) then
- GlobalSharedLockedFree(PCtlinfo^.hMem, PCtlInfo);
-
- DeallocateHwnd(Handle);
- inherited Destroy;
-end;
-
-{-------------------------------------------------------------------}
-{ Convert the numeric return code from an MMSYSTEM function to a string
- using midiInGetErrorText. TODO: These errors aren't very helpful
- (e.g. "an invalid parameter was passed to a system function") so
- sort out some proper error strings. }
-
-function TMidiInput.MidiInErrorString(WError: Word): string;
-var
- errorDesc: PChar;
-begin
- errorDesc := nil;
- try
- errorDesc := StrAlloc(MAXERRORLENGTH);
- if midiInGetErrorText(WError, errorDesc, MAXERRORLENGTH) = 0 then
- result := StrPas(errorDesc)
- else
- result := 'Specified error number is out of range';
- finally
- if errorDesc <> nil then StrDispose(errorDesc);
- end;
-end;
-
-{-------------------------------------------------------------------}
-{ Set the sysex buffer size, fail if device is already open }
-
-procedure TMidiInput.SetSysexBufferSize(BufferSize: Word);
-begin
- if FState = misOpen then
- raise EMidiInputError.Create('Change to SysexBufferSize while device was open')
- else
- { TODO: Validate the sysex buffer size. Is this necessary for WIN32? }
- FSysexBufferSize := BufferSize;
-end;
-
-{-------------------------------------------------------------------}
-{ Set the sysex buffer count, fail if device is already open }
-
-procedure TMidiInput.SetSysexBuffercount(Buffercount: Word);
-begin
- if FState = misOpen then
- raise EMidiInputError.Create('Change to SysexBuffercount while device was open')
- else
- { TODO: Validate the sysex buffer count }
- FSysexBuffercount := Buffercount;
-end;
-
-{-------------------------------------------------------------------}
-{ Set the Sysex Only flag to eliminate unwanted short MIDI input messages }
-
-procedure TMidiInput.SetSysexOnly(bSysexOnly: Boolean);
-begin
- FSysexOnly := bSysexOnly;
- { Update the interrupt handler's copy of this property }
- if PCtlInfo <> nil then
- PCtlInfo^.SysexOnly := bSysexOnly;
-end;
-
-{-------------------------------------------------------------------}
-{ Set the Device ID to select a new MIDI input device
- Note: If no MIDI devices are installed, throws an 'Invalid Device ID' exception }
-
-procedure TMidiInput.SetDeviceID(DeviceID: Word);
-var
- MidiInCaps: TMidiInCaps;
-begin
- if FState = misOpen then
- raise EMidiInputError.Create('Change to DeviceID while device was open')
- else
- if (DeviceID >= midiInGetNumDevs) then
- raise EMidiInputError.Create('Invalid device ID')
- else
- begin
- FDeviceID := DeviceID;
-
- { Set the name and other MIDIINCAPS properties to match the ID }
- FError :=
- midiInGetDevCaps(DeviceID, @MidiInCaps, sizeof(TMidiInCaps));
- if Ferror <> MMSYSERR_NOERROR then
- raise EMidiInputError.Create(MidiInErrorString(FError));
-
- FProductName := StrPas(MidiInCaps.szPname);
- FDriverVersion := MidiInCaps.vDriverVersion;
- FMID := MidiInCaps.wMID;
- FPID := MidiInCaps.wPID;
-
- end;
-end;
-
-{-------------------------------------------------------------------}
-{ Set the product name and put the matching input device number in FDeviceID.
- This is handy if you want to save a configured input/output device
- by device name instead of device number, because device numbers may
- change if users add or remove MIDI devices.
- Exception if input device with matching name not found,
- or if input device is open }
-
-procedure TMidiInput.SetProductName(NewProductName: string);
-var
- MidiInCaps: TMidiInCaps;
- testDeviceID: Word;
- testProductName: string;
-begin
- if FState = misOpen then
- raise EMidiInputError.Create('Change to ProductName while device was open')
- else
- { Don't set the name if the component is reading properties because
- the saved Productname will be from the machine the application was compiled
- on, which may not be the same for the corresponding DeviceID on the user's
- machine. The FProductname property will still be set by SetDeviceID }
- if not (csLoading in ComponentState) then
- begin
- begin
- for testDeviceID := 0 to (midiInGetNumDevs - 1) do
- begin
- FError :=
- midiInGetDevCaps(testDeviceID, @MidiInCaps, sizeof(TMidiInCaps));
- if Ferror <> MMSYSERR_NOERROR then
- raise EMidiInputError.Create(MidiInErrorString(FError));
- testProductName := StrPas(MidiInCaps.szPname);
- if testProductName = NewProductName then
- begin
- FProductName := NewProductName;
- Break;
- end;
- end;
- if FProductName <> NewProductName then
- raise EMidiInputError.Create('MIDI Input Device ' +
- NewProductName + ' not installed ')
- else
- SetDeviceID(testDeviceID);
- end;
- end;
-end;
-
-
-{-------------------------------------------------------------------}
-{ Get the sysex buffers ready }
-
-procedure TMidiInput.PrepareHeaders;
-var
- ctr: Word;
- MyMidiHdr: TMyMidiHdr;
-begin
- if (FSysexBufferCount > 0) and (FSysexBufferSize > 0)
- and (FMidiHandle <> 0) then
- begin
- Midihdrs := TList.Create;
- for ctr := 1 to FSysexBufferCount do
- begin
- { Initialize the header and allocate buffer memory }
- MyMidiHdr := TMyMidiHdr.Create(FSysexBufferSize);
-
- { Store the address of the MyMidiHdr object in the contained MIDIHDR
- structure so we can get back to the object when a pointer to the
- MIDIHDR is received.
- E.g. see TMidiOutput.Output method }
- MyMidiHdr.hdrPointer^.dwUser := DWORD(MyMidiHdr);
-
- { Get MMSYSTEM's blessing for this header }
- FError := midiInPrepareHeader(FMidiHandle, MyMidiHdr.hdrPointer,
- sizeof(TMIDIHDR));
- if Ferror <> MMSYSERR_NOERROR then
- raise EMidiInputError.Create(MidiInErrorString(FError));
-
- { Save it in our list }
- MidiHdrs.Add(MyMidiHdr);
- end;
- end;
-
-end;
-
-{-------------------------------------------------------------------}
-{ Clean up from PrepareHeaders }
-
-procedure TMidiInput.UnprepareHeaders;
-var
- ctr: Word;
-begin
- if (MidiHdrs <> nil) then { will be Nil if 0 sysex buffers }
- begin
- for ctr := 0 to MidiHdrs.Count - 1 do
- begin
- FError := midiInUnprepareHeader(FMidiHandle,
- TMyMidiHdr(MidiHdrs.Items[ctr]).hdrPointer,
- sizeof(TMIDIHDR));
- if Ferror <> MMSYSERR_NOERROR then
- raise EMidiInputError.Create(MidiInErrorString(FError));
- TMyMidiHdr(MidiHdrs.Items[ctr]).Free;
- end;
- MidiHdrs.Free;
- MidiHdrs := nil;
- end;
-end;
-
-{-------------------------------------------------------------------}
-{ Add sysex buffers, if required, to input device }
-
-procedure TMidiInput.AddBuffers;
-var
- ctr: Word;
-begin
- if MidiHdrs <> nil then { will be Nil if 0 sysex buffers }
- begin
- if MidiHdrs.Count > 0 then
- begin
- for ctr := 0 to MidiHdrs.Count - 1 do
- begin
- FError := midiInAddBuffer(FMidiHandle,
- TMyMidiHdr(MidiHdrs.Items[ctr]).hdrPointer,
- sizeof(TMIDIHDR));
- if FError <> MMSYSERR_NOERROR then
- raise EMidiInputError.Create(MidiInErrorString(FError));
- end;
- end;
- end;
-end;
-
-{-------------------------------------------------------------------}
-
-procedure TMidiInput.Open;
-var
- hMem: THandle;
-begin
- try
- { Create the buffer for the MIDI input messages }
- if (PBuffer = nil) then
- PBuffer := CircBufAlloc(FCapacity);
-
- { Create the control info for the DLL }
- if (PCtlInfo = nil) then
- begin
- PCtlInfo := GlobalSharedLockedAlloc(Sizeof(TMidiCtlInfo), hMem);
- PctlInfo^.hMem := hMem;
- end;
- PctlInfo^.pBuffer := PBuffer;
- Pctlinfo^.hWindow := Handle; { Control's window handle }
- PCtlInfo^.SysexOnly := FSysexOnly;
- FError := midiInOpen(@FMidiHandle, FDeviceId,
- DWORD(@midiHandler),
- DWORD(PCtlInfo),
- CALLBACK_FUNCTION);
-
- if (FError <> MMSYSERR_NOERROR) then
- { TODO: use CreateFmtHelp to add MIDI device name/ID to message }
- raise EMidiInputError.Create(MidiInErrorString(FError));
-
- { Get sysex buffers ready }
- PrepareHeaders;
-
- { Add them to the input }
- AddBuffers;
-
- FState := misOpen;
-
- except
- if PBuffer <> nil then
- begin
- CircBufFree(PBuffer);
- PBuffer := nil;
- end;
-
- if PCtlInfo <> nil then
- begin
- GlobalSharedLockedFree(PCtlInfo^.hMem, PCtlInfo);
- PCtlInfo := nil;
- end;
-
- end;
-
-end;
-
-{-------------------------------------------------------------------}
-
-function TMidiInput.GetMidiEvent: TMyMidiEvent;
-var
- thisItem: TMidiBufferItem;
-begin
- if (FState = misOpen) and
- CircBufReadEvent(PBuffer, @thisItem) then
- begin
- Result := TMyMidiEvent.Create;
- with thisItem do
- begin
- Result.Time := Timestamp;
- if (Sysex = nil) then
- begin
- { Short message }
- Result.MidiMessage := LoByte(LoWord(Data));
- Result.Data1 := HiByte(LoWord(Data));
- Result.Data2 := LoByte(HiWord(Data));
- Result.Sysex := nil;
- Result.SysexLength := 0;
- end
- else
- { Long Sysex message }
- begin
- Result.MidiMessage := MIDI_BEGINSYSEX;
- Result.Data1 := 0;
- Result.Data2 := 0;
- Result.SysexLength := Sysex^.dwBytesRecorded;
- if Sysex^.dwBytesRecorded <> 0 then
- begin
- { Put a copy of the sysex buffer in the object }
- GetMem(Result.Sysex, Sysex^.dwBytesRecorded);
- StrMove(Result.Sysex, Sysex^.lpData, Sysex^.dwBytesRecorded);
- end;
-
- { Put the header back on the input buffer }
- FError := midiInPrepareHeader(FMidiHandle, Sysex,
- sizeof(TMIDIHDR));
- if Ferror = 0 then
- FError := midiInAddBuffer(FMidiHandle,
- Sysex, sizeof(TMIDIHDR));
- if Ferror <> MMSYSERR_NOERROR then
- raise EMidiInputError.Create(MidiInErrorString(FError));
- end;
- end;
- CircbufRemoveEvent(PBuffer);
- end
- else
- { Device isn't open, return a nil event }
- Result := nil;
-end;
-
-{-------------------------------------------------------------------}
-
-function TMidiInput.GetEventCount: Word;
-begin
- if FState = misOpen then
- Result := PBuffer^.EventCount
- else
- Result := 0;
-end;
-
-{-------------------------------------------------------------------}
-
-procedure TMidiInput.Close;
-begin
- if FState = misOpen then
- begin
- FState := misClosed;
-
- { MidiInReset cancels any pending output.
- Note that midiInReset causes an MIM_LONGDATA callback for each sysex
- buffer on the input, so the callback function and Midi input buffer
- should still be viable at this stage.
- All the resulting MIM_LONGDATA callbacks will be completed by the time
- MidiInReset returns, though. }
- FError := MidiInReset(FMidiHandle);
- if Ferror <> MMSYSERR_NOERROR then
- raise EMidiInputError.Create(MidiInErrorString(FError));
-
- { Remove sysex buffers from input device and free them }
- UnPrepareHeaders;
-
- { Close the device (finally!) }
- FError := MidiInClose(FMidiHandle);
- if Ferror <> MMSYSERR_NOERROR then
- raise EMidiInputError.Create(MidiInErrorString(FError));
-
- FMidiHandle := 0;
-
- if (PBuffer <> nil) then
- begin
- CircBufFree(PBuffer);
- PBuffer := nil;
- end;
- end;
-end;
-
-{-------------------------------------------------------------------}
-
-procedure TMidiInput.Start;
-begin
- if FState = misOpen then
- begin
- FError := MidiInStart(FMidiHandle);
- if Ferror <> MMSYSERR_NOERROR then
- raise EMidiInputError.Create(MidiInErrorString(FError));
- end;
-end;
-
-{-------------------------------------------------------------------}
-
-procedure TMidiInput.Stop;
-begin
- if FState = misOpen then
- begin
- FError := MidiInStop(FMidiHandle);
- if Ferror <> MMSYSERR_NOERROR then
- raise EMidiInputError.Create(MidiInErrorString(FError));
- end;
-end;
-
-{-------------------------------------------------------------------}
-
-procedure TMidiInput.MidiInput(var Message: TMessage);
-{ Triggered by incoming message from DLL.
- Note DLL has already put the message in the queue }
-begin
- case Message.Msg of
- mim_data:
- { Trigger the user's MIDI input event, if they've specified one and
- we're not in the process of closing the device. The check for
- GetEventCount > 0 prevents unnecessary event calls where the user has
- already cleared all the events from the input buffer using a GetMidiEvent
- loop in the OnMidiInput event handler }
- if Assigned(FOnMIDIInput) and (FState = misOpen)
- and (GetEventCount > 0) then
- FOnMIDIInput(Self);
-
- mim_Overflow: { input circular buffer overflow }
- if Assigned(FOnOverflow) and (FState = misOpen) then
- FOnOverflow(Self);
- end;
-end;
-
-{-------------------------------------------------------------------}
-
-procedure Register;
-begin
- RegisterComponents('Synth', [TMIDIInput]);
-end;
-
-end.
-
+{ $Header: /MidiComp/Midiin.pas 2 10/06/97 7:33 Davec $ } + +{ Written by David Churcher <dchurcher@cix.compulink.co.uk>, + released to the public domain. } + +unit MidiIn; + +{ + Properties: + DeviceID: Windows numeric device ID for the MIDI input device. + Between 0 and NumDevs-1. + Read-only while device is open, exception when changed while open + + MIDIHandle: The input handle to the MIDI device. + 0 when device is not open + Read-only, runtime-only + + MessageCount: Number of input messages waiting in input buffer + + Capacity: Number of messages input buffer can hold + Defaults to 1024 + Limited to (64K/event size) + Read-only when device is open (exception when changed while open) + + SysexBufferSize: Size in bytes of each sysex buffer + Defaults to 10K + Minimum 0K (no buffers), Maximum 64K-1 + + SysexBufferCount: Number of sysex buffers + Defaults to 16 + Minimum 0 (no buffers), Maximum (avail mem/SysexBufferSize) + Check where these buffers are allocated? + + SysexOnly: True to ignore all non-sysex input events. May be changed while + device is open. Handy for patch editors where you have lots of short MIDI + events on the wire which you are always going to ignore anyway. + + DriverVersion: Version number of MIDI device driver. High-order byte is + major version, low-order byte is minor version. + + ProductName: Name of product (e.g. 'MPU 401 In') + + MID and PID: Manufacturer ID and Product ID, see + "Manufacturer and Product IDs" in MMSYSTEM.HLP for list of possible values. + + Methods: + GetMidiEvent: Read Midi event at the head of the FIFO input buffer. + Returns a TMyMidiEvent object containing MIDI message data, timestamp, + and sysex data if applicable. + This method automatically removes the event from the input buffer. + It makes a copy of the received sysex buffer and puts the buffer back + on the input device. + The TMyMidiEvent object must be freed by calling MyMidiEvent.Free. + + Open: Opens device. Note no input will appear until you call the Start + method. + + Close: Closes device. Any pending system exclusive output will be cancelled. + + Start: Starts receiving MIDI input. + + Stop: Stops receiving MIDI input. + + Events: + OnMidiInput: Called when MIDI input data arrives. Use the GetMidiEvent to + get the MIDI input data. + + OnOverflow: Called if the MIDI input buffer overflows. The caller must + clear the buffer before any more MIDI input can be received. + + Notes: + Buffering: Uses a circular buffer, separate pointers for next location + to fill and next location to empty because a MIDI input interrupt may + be adding data to the buffer while the buffer is being read. Buffer + pointers wrap around from end to start of buffer automatically. If + buffer overflows then the OnBufferOverflow event is triggered and no + further input will be received until the buffer is emptied by calls + to GetMidiEvent. + + Sysex buffers: There are (SysexBufferCount) buffers on the input device. + When sysex events arrive these buffers are removed from the input device and + added to the circular buffer by the interrupt handler in the DLL. When the sysex events + are removed from the circular buffer by the GetMidiEvent method the buffers are + put back on the input. If all the buffers are used up there will be no + more sysex input until at least one sysex event is removed from the input buffer. + In other words if you're expecting lots of sysex input you need to set the + SysexBufferCount property high enough so that you won't run out of + input buffers before you get a chance to read them with GetMidiEvent. + + If the synth sends a block of sysex that's longer than SysexBufferSize it + will be received as separate events. + TODO: Component derived from this one that handles >64K sysex blocks cleanly + and can stream them to disk. + + Midi Time Code (MTC) and Active Sensing: The DLL is currently hardcoded + to filter these short events out, so that we don't spend all our time + processing them. + TODO: implement a filter property to select the events that will be filtered + out. +} + +interface + +{$IFDEF FPC} + {$MODE Delphi} + {$H+} // use AnsiString +{$ENDIF} + +uses + Classes, + SysUtils, + Messages, + Windows, + MMSystem, + UCommon, + MidiDefs, + MidiType, + MidiCons, + Circbuf, + Delphmcb; + +type + MidiInputState = (misOpen, misClosed, misCreating, misDestroying); + EMidiInputError = class(Exception); + + {-------------------------------------------------------------------} + TMidiInput = class(TComponent) + private + Handle: THandle; { Window handle used for callback notification } + FDeviceID: Word; { MIDI device ID } + FMIDIHandle: HMIDIIn; { Handle to input device } + FState: MidiInputState; { Current device state } + + FError: Word; + FSysexOnly: Boolean; + + { Stuff from MIDIINCAPS } + FDriverVersion: MMVERSION; + FProductName: string; + FMID: Word; { Manufacturer ID } + FPID: Word; { Product ID } + + { Queue } + FCapacity: Word; { Buffer capacity } + PBuffer: PCircularBuffer; { Low-level MIDI input buffer created by Open method } + FNumdevs: Word; { Number of input devices on system } + + { Events } + FOnMIDIInput: TNotifyEvent; { MIDI Input arrived } + FOnOverflow: TNotifyEvent; { Input buffer overflow } + { TODO: Some sort of error handling event for MIM_ERROR } + + { Sysex } + FSysexBufferSize: Word; + FSysexBufferCount: Word; + MidiHdrs: Tlist; + + PCtlInfo: PMidiCtlInfo; { Pointer to control info for DLL } + + protected + procedure Prepareheaders; + procedure UnprepareHeaders; + procedure AddBuffers; + procedure SetDeviceID(DeviceID: Word); + procedure SetProductName(NewProductName: string); + function GetEventCount: Word; + procedure SetSysexBufferSize(BufferSize: Word); + procedure SetSysexBufferCount(BufferCount: Word); + procedure SetSysexOnly(bSysexOnly: Boolean); + function MidiInErrorString(WError: Word): string; + + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + property MIDIHandle: HMIDIIn read FMIDIHandle; + + property DriverVersion: MMVERSION read FDriverVersion; + property MID: Word read FMID; { Manufacturer ID } + property PID: Word read FPID; { Product ID } + + property Numdevs: Word read FNumdevs; + + property MessageCount: Word read GetEventCount; + { TODO: property to select which incoming messages get filtered out } + + procedure Open; + procedure Close; + procedure Start; + procedure Stop; + { Get first message in input queue } + function GetMidiEvent: TMyMidiEvent; + procedure MidiInput(var Message: TMessage); + + { Some functions to decode and classify incoming messages would be good } + + published + + { TODO: Property editor with dropdown list of product names } + property ProductName: string read FProductName write SetProductName; + + property DeviceID: Word read FDeviceID write SetDeviceID default 0; + property Capacity: Word read FCapacity write FCapacity default 1024; + property Error: Word read FError; + property SysexBufferSize: Word + read FSysexBufferSize + write SetSysexBufferSize + default 10000; + property SysexBufferCount: Word + read FSysexBufferCount + write SetSysexBufferCount + default 16; + property SysexOnly: Boolean + read FSysexOnly + write SetSysexOnly + default False; + + { Events } + property OnMidiInput: TNotifyEvent read FOnMidiInput write FOnMidiInput; + property OnOverflow: TNotifyEvent read FOnOverflow write FOnOverflow; + + end; + +procedure Register; + +{====================================================================} +implementation + +uses Controls, + Graphics; + +(* Not used in Delphi 3 +{ This is the callback procedure in the external DLL. + It's used when midiInOpen is called by the Open method. + There are special requirements and restrictions for this callback + procedure (see midiInOpen in MMSYSTEM.HLP) so it's impractical to + make it an object method } +{$IFDEF WIN32} +function midiHandler( + hMidiIn: HMidiIn; + wMsg: UINT; + dwInstance: DWORD; + dwParam1: DWORD; + dwParam2: DWORD): Boolean; stdcall; external 'DELMID32.DLL'; +{$ELSE} +procedure midiHandler( + hMidiIn: HMidiIn; + wMsg: Word; + dwInstance: DWORD; + dwParam1: DWORD; + dwParam2: DWORD); far; external 'DELPHMID'; +{$ENDIF} +*) +{-------------------------------------------------------------------} + +constructor TMidiInput.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FState := misCreating; + + FSysexOnly := False; + FNumDevs := midiInGetNumDevs; + MidiHdrs := nil; + + { Set defaults } + if (FNumDevs > 0) then + SetDeviceID(0); + FCapacity := 1024; + FSysexBufferSize := 4096; + FSysexBufferCount := 16; + + { Create the window for callback notification } + if not (csDesigning in ComponentState) then + begin + Handle := AllocateHwnd(MidiInput); + end; + + FState := misClosed; + +end; + +{-------------------------------------------------------------------} +{ Close the device if it's open } + +destructor TMidiInput.Destroy; +begin + if (FMidiHandle <> 0) then + begin + Close; + FMidiHandle := 0; + end; + + if (PCtlInfo <> nil) then + GlobalSharedLockedFree(PCtlinfo^.hMem, PCtlInfo); + + DeallocateHwnd(Handle); + inherited Destroy; +end; + +{-------------------------------------------------------------------} +{ Convert the numeric return code from an MMSYSTEM function to a string + using midiInGetErrorText. TODO: These errors aren't very helpful + (e.g. "an invalid parameter was passed to a system function") so + sort out some proper error strings. } + +function TMidiInput.MidiInErrorString(WError: Word): string; +var + errorDesc: PChar; +begin + errorDesc := nil; + try + errorDesc := StrAlloc(MAXERRORLENGTH); + if midiInGetErrorText(WError, errorDesc, MAXERRORLENGTH) = 0 then + result := StrPas(errorDesc) + else + result := 'Specified error number is out of range'; + finally + if errorDesc <> nil then StrDispose(errorDesc); + end; +end; + +{-------------------------------------------------------------------} +{ Set the sysex buffer size, fail if device is already open } + +procedure TMidiInput.SetSysexBufferSize(BufferSize: Word); +begin + if FState = misOpen then + raise EMidiInputError.Create('Change to SysexBufferSize while device was open') + else + { TODO: Validate the sysex buffer size. Is this necessary for WIN32? } + FSysexBufferSize := BufferSize; +end; + +{-------------------------------------------------------------------} +{ Set the sysex buffer count, fail if device is already open } + +procedure TMidiInput.SetSysexBuffercount(Buffercount: Word); +begin + if FState = misOpen then + raise EMidiInputError.Create('Change to SysexBuffercount while device was open') + else + { TODO: Validate the sysex buffer count } + FSysexBuffercount := Buffercount; +end; + +{-------------------------------------------------------------------} +{ Set the Sysex Only flag to eliminate unwanted short MIDI input messages } + +procedure TMidiInput.SetSysexOnly(bSysexOnly: Boolean); +begin + FSysexOnly := bSysexOnly; + { Update the interrupt handler's copy of this property } + if PCtlInfo <> nil then + PCtlInfo^.SysexOnly := bSysexOnly; +end; + +{-------------------------------------------------------------------} +{ Set the Device ID to select a new MIDI input device + Note: If no MIDI devices are installed, throws an 'Invalid Device ID' exception } + +procedure TMidiInput.SetDeviceID(DeviceID: Word); +var + MidiInCaps: TMidiInCaps; +begin + if FState = misOpen then + raise EMidiInputError.Create('Change to DeviceID while device was open') + else + if (DeviceID >= midiInGetNumDevs) then + raise EMidiInputError.Create('Invalid device ID') + else + begin + FDeviceID := DeviceID; + + { Set the name and other MIDIINCAPS properties to match the ID } + FError := + midiInGetDevCaps(DeviceID, @MidiInCaps, sizeof(TMidiInCaps)); + if Ferror <> MMSYSERR_NOERROR then + raise EMidiInputError.Create(MidiInErrorString(FError)); + + FProductName := StrPas(MidiInCaps.szPname); + FDriverVersion := MidiInCaps.vDriverVersion; + FMID := MidiInCaps.wMID; + FPID := MidiInCaps.wPID; + + end; +end; + +{-------------------------------------------------------------------} +{ Set the product name and put the matching input device number in FDeviceID. + This is handy if you want to save a configured input/output device + by device name instead of device number, because device numbers may + change if users add or remove MIDI devices. + Exception if input device with matching name not found, + or if input device is open } + +procedure TMidiInput.SetProductName(NewProductName: string); +var + MidiInCaps: TMidiInCaps; + testDeviceID: Word; + testProductName: string; +begin + if FState = misOpen then + raise EMidiInputError.Create('Change to ProductName while device was open') + else + { Don't set the name if the component is reading properties because + the saved Productname will be from the machine the application was compiled + on, which may not be the same for the corresponding DeviceID on the user's + machine. The FProductname property will still be set by SetDeviceID } + if not (csLoading in ComponentState) then + begin + begin + for testDeviceID := 0 to (midiInGetNumDevs - 1) do + begin + FError := + midiInGetDevCaps(testDeviceID, @MidiInCaps, sizeof(TMidiInCaps)); + if Ferror <> MMSYSERR_NOERROR then + raise EMidiInputError.Create(MidiInErrorString(FError)); + testProductName := StrPas(MidiInCaps.szPname); + if testProductName = NewProductName then + begin + FProductName := NewProductName; + Break; + end; + end; + if FProductName <> NewProductName then + raise EMidiInputError.Create('MIDI Input Device ' + + NewProductName + ' not installed ') + else + SetDeviceID(testDeviceID); + end; + end; +end; + + +{-------------------------------------------------------------------} +{ Get the sysex buffers ready } + +procedure TMidiInput.PrepareHeaders; +var + ctr: Word; + MyMidiHdr: TMyMidiHdr; +begin + if (FSysexBufferCount > 0) and (FSysexBufferSize > 0) + and (FMidiHandle <> 0) then + begin + Midihdrs := TList.Create; + for ctr := 1 to FSysexBufferCount do + begin + { Initialize the header and allocate buffer memory } + MyMidiHdr := TMyMidiHdr.Create(FSysexBufferSize); + + { Store the address of the MyMidiHdr object in the contained MIDIHDR + structure so we can get back to the object when a pointer to the + MIDIHDR is received. + E.g. see TMidiOutput.Output method } + MyMidiHdr.hdrPointer^.dwUser := DWORD(MyMidiHdr); + + { Get MMSYSTEM's blessing for this header } + FError := midiInPrepareHeader(FMidiHandle, MyMidiHdr.hdrPointer, + sizeof(TMIDIHDR)); + if Ferror <> MMSYSERR_NOERROR then + raise EMidiInputError.Create(MidiInErrorString(FError)); + + { Save it in our list } + MidiHdrs.Add(MyMidiHdr); + end; + end; + +end; + +{-------------------------------------------------------------------} +{ Clean up from PrepareHeaders } + +procedure TMidiInput.UnprepareHeaders; +var + ctr: Word; +begin + if (MidiHdrs <> nil) then { will be Nil if 0 sysex buffers } + begin + for ctr := 0 to MidiHdrs.Count - 1 do + begin + FError := midiInUnprepareHeader(FMidiHandle, + TMyMidiHdr(MidiHdrs.Items[ctr]).hdrPointer, + sizeof(TMIDIHDR)); + if Ferror <> MMSYSERR_NOERROR then + raise EMidiInputError.Create(MidiInErrorString(FError)); + TMyMidiHdr(MidiHdrs.Items[ctr]).Free; + end; + MidiHdrs.Free; + MidiHdrs := nil; + end; +end; + +{-------------------------------------------------------------------} +{ Add sysex buffers, if required, to input device } + +procedure TMidiInput.AddBuffers; +var + ctr: Word; +begin + if MidiHdrs <> nil then { will be Nil if 0 sysex buffers } + begin + if MidiHdrs.Count > 0 then + begin + for ctr := 0 to MidiHdrs.Count - 1 do + begin + FError := midiInAddBuffer(FMidiHandle, + TMyMidiHdr(MidiHdrs.Items[ctr]).hdrPointer, + sizeof(TMIDIHDR)); + if FError <> MMSYSERR_NOERROR then + raise EMidiInputError.Create(MidiInErrorString(FError)); + end; + end; + end; +end; + +{-------------------------------------------------------------------} + +procedure TMidiInput.Open; +var + hMem: THandle; +begin + try + { Create the buffer for the MIDI input messages } + if (PBuffer = nil) then + PBuffer := CircBufAlloc(FCapacity); + + { Create the control info for the DLL } + if (PCtlInfo = nil) then + begin + PCtlInfo := GlobalSharedLockedAlloc(Sizeof(TMidiCtlInfo), hMem); + PctlInfo^.hMem := hMem; + end; + PctlInfo^.pBuffer := PBuffer; + Pctlinfo^.hWindow := Handle; { Control's window handle } + PCtlInfo^.SysexOnly := FSysexOnly; + FError := midiInOpen(@FMidiHandle, FDeviceId, + DWORD(@midiHandler), + DWORD(PCtlInfo), + CALLBACK_FUNCTION); + + if (FError <> MMSYSERR_NOERROR) then + { TODO: use CreateFmtHelp to add MIDI device name/ID to message } + raise EMidiInputError.Create(MidiInErrorString(FError)); + + { Get sysex buffers ready } + PrepareHeaders; + + { Add them to the input } + AddBuffers; + + FState := misOpen; + + except + if PBuffer <> nil then + begin + CircBufFree(PBuffer); + PBuffer := nil; + end; + + if PCtlInfo <> nil then + begin + GlobalSharedLockedFree(PCtlInfo^.hMem, PCtlInfo); + PCtlInfo := nil; + end; + + end; + +end; + +{-------------------------------------------------------------------} + +function TMidiInput.GetMidiEvent: TMyMidiEvent; +var + thisItem: TMidiBufferItem; +begin + if (FState = misOpen) and + CircBufReadEvent(PBuffer, @thisItem) then + begin + Result := TMyMidiEvent.Create; + with thisItem do + begin + Result.Time := Timestamp; + if (Sysex = nil) then + begin + { Short message } + Result.MidiMessage := LoByte(LoWord(Data)); + Result.Data1 := HiByte(LoWord(Data)); + Result.Data2 := LoByte(HiWord(Data)); + Result.Sysex := nil; + Result.SysexLength := 0; + end + else + { Long Sysex message } + begin + Result.MidiMessage := MIDI_BEGINSYSEX; + Result.Data1 := 0; + Result.Data2 := 0; + Result.SysexLength := Sysex^.dwBytesRecorded; + if Sysex^.dwBytesRecorded <> 0 then + begin + { Put a copy of the sysex buffer in the object } + GetMem(Result.Sysex, Sysex^.dwBytesRecorded); + StrMove(Result.Sysex, Sysex^.lpData, Sysex^.dwBytesRecorded); + end; + + { Put the header back on the input buffer } + FError := midiInPrepareHeader(FMidiHandle, Sysex, + sizeof(TMIDIHDR)); + if Ferror = 0 then + FError := midiInAddBuffer(FMidiHandle, + Sysex, sizeof(TMIDIHDR)); + if Ferror <> MMSYSERR_NOERROR then + raise EMidiInputError.Create(MidiInErrorString(FError)); + end; + end; + CircbufRemoveEvent(PBuffer); + end + else + { Device isn't open, return a nil event } + Result := nil; +end; + +{-------------------------------------------------------------------} + +function TMidiInput.GetEventCount: Word; +begin + if FState = misOpen then + Result := PBuffer^.EventCount + else + Result := 0; +end; + +{-------------------------------------------------------------------} + +procedure TMidiInput.Close; +begin + if FState = misOpen then + begin + FState := misClosed; + + { MidiInReset cancels any pending output. + Note that midiInReset causes an MIM_LONGDATA callback for each sysex + buffer on the input, so the callback function and Midi input buffer + should still be viable at this stage. + All the resulting MIM_LONGDATA callbacks will be completed by the time + MidiInReset returns, though. } + FError := MidiInReset(FMidiHandle); + if Ferror <> MMSYSERR_NOERROR then + raise EMidiInputError.Create(MidiInErrorString(FError)); + + { Remove sysex buffers from input device and free them } + UnPrepareHeaders; + + { Close the device (finally!) } + FError := MidiInClose(FMidiHandle); + if Ferror <> MMSYSERR_NOERROR then + raise EMidiInputError.Create(MidiInErrorString(FError)); + + FMidiHandle := 0; + + if (PBuffer <> nil) then + begin + CircBufFree(PBuffer); + PBuffer := nil; + end; + end; +end; + +{-------------------------------------------------------------------} + +procedure TMidiInput.Start; +begin + if FState = misOpen then + begin + FError := MidiInStart(FMidiHandle); + if Ferror <> MMSYSERR_NOERROR then + raise EMidiInputError.Create(MidiInErrorString(FError)); + end; +end; + +{-------------------------------------------------------------------} + +procedure TMidiInput.Stop; +begin + if FState = misOpen then + begin + FError := MidiInStop(FMidiHandle); + if Ferror <> MMSYSERR_NOERROR then + raise EMidiInputError.Create(MidiInErrorString(FError)); + end; +end; + +{-------------------------------------------------------------------} + +procedure TMidiInput.MidiInput(var Message: TMessage); +{ Triggered by incoming message from DLL. + Note DLL has already put the message in the queue } +begin + case Message.Msg of + mim_data: + { Trigger the user's MIDI input event, if they've specified one and + we're not in the process of closing the device. The check for + GetEventCount > 0 prevents unnecessary event calls where the user has + already cleared all the events from the input buffer using a GetMidiEvent + loop in the OnMidiInput event handler } + if Assigned(FOnMIDIInput) and (FState = misOpen) + and (GetEventCount > 0) then + FOnMIDIInput(Self); + + mim_Overflow: { input circular buffer overflow } + if Assigned(FOnOverflow) and (FState = misOpen) then + FOnOverflow(Self); + end; +end; + +{-------------------------------------------------------------------} + +procedure Register; +begin + RegisterComponents('Synth', [TMIDIInput]); +end; + +end. + diff --git a/Game/Code/lib/midi/Midiout.pas b/Game/Code/lib/midi/Midiout.pas index 81b00e9f..2463ae8a 100644 --- a/Game/Code/lib/midi/Midiout.pas +++ b/Game/Code/lib/midi/Midiout.pas @@ -1,617 +1,617 @@ -{ $Header: /MidiComp/MidiOut.pas 2 10/06/97 7:33 Davec $ }
-
-{ Written by David Churcher <dchurcher@cix.compulink.co.uk>,
- released to the public domain. }
-
-{ Thanks very much to Fred Kohler for the Technology code. }
-
-unit MidiOut;
-
-{
- MIDI Output component.
-
- Properties:
- DeviceID: Windows numeric device ID for the MIDI output device.
- Between 0 and (midioutGetNumDevs-1), or MIDI_MAPPER (-1).
- Special value MIDI_MAPPER specifies output to the Windows MIDI mapper
- Read-only while device is open, exception if changed while open
-
- MIDIHandle: The output handle to the MIDI device.
- 0 when device is not open
- Read-only, runtime-only
-
- ProductName: Name of the output device product that corresponds to the
- DeviceID property (e.g. 'MPU 401 out').
- You can write to this while the device is closed to select a particular
- output device by name (the DeviceID property will change to match).
- Exception if this property is changed while the device is open.
-
- Numdevs: Number of MIDI output devices installed on the system. This
- is the value returned by midiOutGetNumDevs. It's included for
- completeness.
-
- Technology: Type of technology used by the MIDI device. You can set this
- property to one of the values listed for OutportTech (below) and the component
- will find an appropriate MIDI device. For example:
- MidiOutput.Technology := opt_FMSynth;
- will set MidiInput.DeviceID to the MIDI device ID of the FM synth, if one
- is installed. If no such device is available an exception is raised,
- see MidiOutput.SetTechnology.
-
- See the MIDIOUTCAPS entry in MMSYSTEM.HLP for descriptions of the
- following properties:
- DriverVersion
- Voices
- Notes
- ChannelMask
- Support
-
- Error: The error code for the last MMSYSTEM error. See the MMSYSERR_
- entries in MMSYSTEM.INT for possible values.
-
- Methods:
- Open: Open MIDI device specified by DeviceID property for output
-
- Close: Close device
-
- PutMidiEvent(Event:TMyMidiEvent): Output a note or sysex message to the
- device. This method takes a TMyMidiEvent object and transmits it.
- Notes:
- 1. If the object contains a sysex event the OnMidiOutput event will
- be triggered when the sysex transmission is complete.
- 2. You can queue up multiple blocks of system exclusive data for
- transmission by chucking them at this method; they will be
- transmitted as quickly as the device can manage.
- 3. This method will not free the TMyMidiEvent object, the caller
- must do that. Any sysex data in the TMyMidiEvent is copied before
- transmission so you can free the TMyMidiEvent immediately after
- calling PutMidiEvent, even if output has not yet finished.
-
- PutShort(MidiMessage: Byte; Data1: Byte; Data2: Byte): Output a short
- MIDI message. Handy when you can't be bothered to build a TMyMidiEvent.
- If the message you're sending doesn't use Data1 or Data2, set them to 0.
-
- PutLong(TheSysex: Pointer; msgLength: Word): Output sysex data.
- SysexPointer: Pointer to sysex data to send
- msgLength: Length of sysex data.
- This is handy when you don't have a TMyMidiEvent.
-
- SetVolume(Left: Word, Right: Word): Set the volume of the
- left and right channels on the output device (only on internal devices?).
- 0xFFFF is maximum volume. If the device doesn't support separate
- left/right volume control, the value of the Left parameter will be used.
- Check the Support property to see whether the device supports volume
- control. See also other notes on volume control under midiOutSetVolume()
- in MMSYSTEM.HLP.
-
- Events:
- OnMidiOutput: Procedure called when output of a system exclusive block
- is completed.
-
- Notes:
- I haven't implemented any methods for midiOutCachePatches and
- midiOutCacheDrumpatches, mainly 'cause I don't have any way of testing
- them. Does anyone really use these?
-}
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
- {$H+} // use AnsiString
-{$ENDIF}
-
-uses
- SysUtils,
- Windows,
- Messages,
- Classes,
- MMSystem,
- UCommon,
- Circbuf,
- MidiType,
- MidiDefs,
- Delphmcb;
-
-{$IFDEF FPC}
-type TmidioutCaps = MIDIOUTCAPS;
-{$ENDIF}
-
-type
- midioutputState = (mosOpen, mosClosed);
- EmidioutputError = class(Exception);
-
- { These are the equivalent of constants prefixed with mod_
- as defined in MMSystem. See SetTechnology }
- OutPortTech = (
- opt_None, { none }
- opt_MidiPort, { output port }
- opt_Synth, { generic internal synth }
- opt_SQSynth, { square wave internal synth }
- opt_FMSynth, { FM internal synth }
- opt_Mapper); { MIDI mapper }
- TechNameMap = array[OutPortTech] of string[18];
-
-
-const
- TechName: TechNameMap = (
- 'None', 'MIDI Port', 'Generic Synth', 'Square Wave Synth',
- 'FM Synth', 'MIDI Mapper');
-
-{-------------------------------------------------------------------}
-type
- TMidiOutput = class(TComponent)
- protected
- Handle: THandle; { Window handle used for callback notification }
- FDeviceID: Cardinal; { MIDI device ID }
- FMIDIHandle: Hmidiout; { Handle to output device }
- FState: midioutputState; { Current device state }
- PCtlInfo: PMidiCtlInfo; { Pointer to control info for DLL }
-
- PBuffer: PCircularBuffer; { Output queue for PutTimedEvent, set by Open }
-
- FError: Word; { Last MMSYSTEM error }
-
- { Stuff from midioutCAPS }
- FDriverVersion: MMVERSION; { Driver version from midioutGetDevCaps }
- FProductName: string; { product name }
- FTechnology: OutPortTech; { Type of MIDI output device }
- FVoices: Word; { Number of voices (internal synth) }
- FNotes: Word; { Number of notes (internal synth) }
- FChannelMask: Word; { Bit set for each MIDI channels that the
- device responds to (internal synth) }
- FSupport: DWORD; { Technology supported (volume control,
- patch caching etc. }
- FNumdevs: Word; { Number of MIDI output devices on system }
-
-
- FOnMIDIOutput: TNotifyEvent; { Sysex output finished }
-
- procedure MidiOutput(var Message: TMessage);
- procedure SetDeviceID(DeviceID: Cardinal);
- procedure SetProductName(NewProductName: string);
- procedure SetTechnology(NewTechnology: OutPortTech);
- function midioutErrorString(WError: Word): string;
-
- public
- { Properties }
- property MIDIHandle: Hmidiout read FMIDIHandle;
- property DriverVersion: MMVERSION { Driver version from midioutGetDevCaps }
- read FDriverVersion;
- property Technology: OutPortTech { Type of MIDI output device }
- read FTechnology
- write SetTechnology
- default opt_Synth;
- property Voices: Word { Number of voices (internal synth) }
- read FVoices;
- property Notes: Word { Number of notes (internal synth) }
- read FNotes;
- property ChannelMask: Word { Bit set for each MIDI channels that the }
- read FChannelMask; { device responds to (internal synth) }
- property Support: DWORD { Technology supported (volume control, }
- read FSupport; { patch caching etc. }
- property Error: Word read FError;
- property Numdevs: Word read FNumdevs;
-
- { Methods }
- function Open: Boolean; virtual;
- function Close: Boolean; virtual;
- procedure PutMidiEvent(theEvent: TMyMidiEvent); virtual;
- procedure PutShort(MidiMessage: Byte; Data1: Byte; Data2: Byte); virtual;
- procedure PutLong(TheSysex: Pointer; msgLength: Word); virtual;
- procedure SetVolume(Left: Word; Right: Word);
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
-
- { Some functions to decode and classify incoming messages would be nice }
-
- published
- { TODO: Property editor with dropdown list of product names }
- property ProductName: string read FProductName write SetProductName;
-
- property DeviceID: Cardinal read FDeviceID write SetDeviceID default 0;
- { TODO: midiOutGetVolume? Or two properties for Left and Right volume?
- Is it worth it??
- midiOutMessage?? Does anyone use this? }
-
- { Events }
- property Onmidioutput: TNotifyEvent
- read FOnmidioutput
- write FOnmidioutput;
- end;
-
-procedure Register;
-
-{-------------------------------------------------------------------}
-implementation
-
-(* Not used in Delphi 3
-
-{ This is the callback procedure in the external DLL.
- It's used when midioutOpen is called by the Open method.
- There are special requirements and restrictions for this callback
- procedure (see midioutOpen in MMSYSTEM.HLP) so it's impractical to
- make it an object method }
-{$IFDEF WIN32}
-function midiHandler(
- hMidiIn: HMidiIn;
- wMsg: UINT;
- dwInstance: DWORD;
- dwParam1: DWORD;
- dwParam2: DWORD): Boolean; stdcall; external 'DELMID32.DLL';
-{$ELSE}
-function midiHandler(
- hMidiIn: HMidiIn;
- wMsg: Word;
- dwInstance: DWORD;
- dwParam1: DWORD;
- dwParam2: DWORD): Boolean; far; external 'DELPHMID.DLL';
-{$ENDIF}
-*)
-
-{-------------------------------------------------------------------}
-
-constructor Tmidioutput.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
- FState := mosClosed;
- FNumdevs := midiOutGetNumDevs;
-
- { Create the window for callback notification }
- if not (csDesigning in ComponentState) then
- begin
- Handle := AllocateHwnd(MidiOutput);
- end;
-
-end;
-
-{-------------------------------------------------------------------}
-
-destructor Tmidioutput.Destroy;
-begin
- if FState = mosOpen then
- Close;
- if (PCtlInfo <> nil) then
- GlobalSharedLockedFree(PCtlinfo^.hMem, PCtlInfo);
- DeallocateHwnd(Handle);
- inherited Destroy;
-end;
-
-{-------------------------------------------------------------------}
-{ Convert the numeric return code from an MMSYSTEM function to a string
- using midioutGetErrorText. TODO: These errors aren't very helpful
- (e.g. "an invalid parameter was passed to a system function") so
- some proper error strings would be nice. }
-
-
-function Tmidioutput.midioutErrorString(WError: Word): string;
-var
- errorDesc: PChar;
-begin
- errorDesc := nil;
- try
- errorDesc := StrAlloc(MAXERRORLENGTH);
- if midioutGetErrorText(WError, errorDesc, MAXERRORLENGTH) = 0 then
- result := StrPas(errorDesc)
- else
- result := 'Specified error number is out of range';
- finally
- if errorDesc <> nil then StrDispose(errorDesc);
- end;
-end;
-
-{-------------------------------------------------------------------}
-{ Set the output device ID and change the other properties to match }
-
-procedure Tmidioutput.SetDeviceID(DeviceID: Cardinal);
-var
- midioutCaps: TmidioutCaps;
-begin
- if FState = mosOpen then
- raise EmidioutputError.Create('Change to DeviceID while device was open')
- else
- if (DeviceID >= midioutGetNumDevs) and (DeviceID <> MIDI_MAPPER) then
- raise EmidioutputError.Create('Invalid device ID')
- else
- begin
- FDeviceID := DeviceID;
-
- { Set the name and other midioutCAPS properties to match the ID }
- FError :=
- midioutGetDevCaps(DeviceID, @midioutCaps, sizeof(TmidioutCaps));
- if Ferror > 0 then
- raise EmidioutputError.Create(midioutErrorString(FError));
-
- with midiOutCaps do
- begin
- FProductName := StrPas(szPname);
- FDriverVersion := vDriverVersion;
- FTechnology := OutPortTech(wTechnology);
- FVoices := wVoices;
- FNotes := wNotes;
- FChannelMask := wChannelMask;
- FSupport := dwSupport;
- end;
-
- end;
-end;
-
-{-------------------------------------------------------------------}
-{ Set the product name property and put the matching output device number
- in FDeviceID.
- This is handy if you want to save a configured output/output device
- by device name instead of device number, because device numbers may
- change if users install or remove MIDI devices.
- Exception if output device with matching name not found,
- or if output device is open }
-
-procedure Tmidioutput.SetProductName(NewProductName: string);
-var
- midioutCaps: TmidioutCaps;
- testDeviceID: Integer;
- testProductName: string;
-begin
- if FState = mosOpen then
- raise EmidioutputError.Create('Change to ProductName while device was open')
- else
- { Don't set the name if the component is reading properties because
- the saved Productname will be from the machine the application was compiled
- on, which may not be the same for the corresponding DeviceID on the user's
- machine. The FProductname property will still be set by SetDeviceID }
- if not (csLoading in ComponentState) then
- begin
- { Loop uses -1 to test for MIDI_MAPPER as well }
- for testDeviceID := -1 to (midioutGetNumDevs - 1) do
- begin
- FError :=
- midioutGetDevCaps(testDeviceID, @midioutCaps, sizeof(TmidioutCaps));
- if Ferror > 0 then
- raise EmidioutputError.Create(midioutErrorString(FError));
- testProductName := StrPas(midioutCaps.szPname);
- if testProductName = NewProductName then
- begin
- FProductName := NewProductName;
- Break;
- end;
- end;
- if FProductName <> NewProductName then
- raise EmidioutputError.Create('MIDI output Device ' +
- NewProductName + ' not installed')
- else
- SetDeviceID(testDeviceID);
- end;
-end;
-
-{-------------------------------------------------------------------}
-{ Set the output technology property and put the matching output device
- number in FDeviceID.
- This is handy, for example, if you want to be able to switch between a
- sound card and a MIDI port }
-
-procedure TMidiOutput.SetTechnology(NewTechnology: OutPortTech);
-var
- midiOutCaps: TMidiOutCaps;
- testDeviceID: Integer;
- testTechnology: OutPortTech;
-begin
- if FState = mosOpen then
- raise EMidiOutputError.Create(
- 'Change to Product Technology while device was open')
- else
- begin
- { Loop uses -1 to test for MIDI_MAPPER as well }
- for testDeviceID := -1 to (midiOutGetNumDevs - 1) do
- begin
- FError :=
- midiOutGetDevCaps(testDeviceID,
- @midiOutCaps, sizeof(TMidiOutCaps));
- if Ferror > 0 then
- raise EMidiOutputError.Create(MidiOutErrorString(FError));
- testTechnology := OutPortTech(midiOutCaps.wTechnology);
- if testTechnology = NewTechnology then
- begin
- FTechnology := NewTechnology;
- Break;
- end;
- end;
- if FTechnology <> NewTechnology then
- raise EMidiOutputError.Create('MIDI output technology ' +
- TechName[NewTechnology] + ' not installed')
- else
- SetDeviceID(testDeviceID);
- end;
-end;
-
-{-------------------------------------------------------------------}
-
-function Tmidioutput.Open: Boolean;
-var
- hMem: THandle;
-begin
- Result := False;
- try
- { Create the control info for the DLL }
- if (PCtlInfo = nil) then
- begin
- PCtlInfo := GlobalSharedLockedAlloc(Sizeof(TMidiCtlInfo), hMem);
- PctlInfo^.hMem := hMem;
- end;
-
- Pctlinfo^.hWindow := Handle; { Control's window handle }
-
- FError := midioutOpen(@FMidiHandle, FDeviceId,
- DWORD(@midiHandler),
- DWORD(PCtlInfo),
- CALLBACK_FUNCTION);
-{ FError := midioutOpen(@FMidiHandle, FDeviceId,
- Handle,
- DWORD(PCtlInfo),
- CALLBACK_WINDOW); }
- if (FError <> 0) then
- { TODO: use CreateFmtHelp to add MIDI device name/ID to message }
- raise EmidioutputError.Create(midioutErrorString(FError))
- else
- begin
- Result := True;
- FState := mosOpen;
- end;
-
- except
- if PCtlInfo <> nil then
- begin
- GlobalSharedLockedFree(PCtlInfo^.hMem, PCtlInfo);
- PCtlInfo := nil;
- end;
- end;
-
-end;
-
-{-------------------------------------------------------------------}
-
-procedure TMidiOutput.PutShort(MidiMessage: Byte; Data1: Byte; Data2: Byte);
-var
- thisMsg: DWORD;
-begin
- thisMsg := DWORD(MidiMessage) or
- (DWORD(Data1) shl 8) or
- (DWORD(Data2) shl 16);
-
- FError := midiOutShortMsg(FMidiHandle, thisMsg);
- if Ferror > 0 then
- raise EmidioutputError.Create(midioutErrorString(FError));
-end;
-
-{-------------------------------------------------------------------}
-
-procedure TMidiOutput.PutLong(TheSysex: Pointer; msgLength: Word);
-{ Notes: This works asynchronously; you send your sysex output by
-calling this function, which returns immediately. When the MIDI device
-driver has finished sending the data the MidiOutPut function in this
-component is called, which will in turn call the OnMidiOutput method
-if the component user has defined one. }
-{ TODO: Combine common functions with PutTimedLong into subroutine }
-
-var
- MyMidiHdr: TMyMidiHdr;
-begin
- { Initialize the header and allocate buffer memory }
- MyMidiHdr := TMyMidiHdr.Create(msgLength);
-
- { Copy the data over to the MidiHdr buffer
- We can't just use the caller's PChar because the buffer memory
- has to be global, shareable, and locked. }
- StrMove(MyMidiHdr.SysexPointer, TheSysex, msgLength);
-
- { Store the MyMidiHdr address in the header so we can find it again quickly
- (see the MidiOutput proc) }
- MyMidiHdr.hdrPointer^.dwUser := DWORD(MyMidiHdr);
-
- { Get MMSYSTEM's blessing for this header }
- FError := midiOutPrepareHeader(FMidiHandle, MyMidiHdr.hdrPointer,
- sizeof(TMIDIHDR));
- if Ferror > 0 then
- raise EMidiOutputError.Create(MidiOutErrorString(FError));
-
- { Send it }
- FError := midiOutLongMsg(FMidiHandle, MyMidiHdr.hdrPointer,
- sizeof(TMIDIHDR));
- if Ferror > 0 then
- raise EMidiOutputError.Create(MidiOutErrorString(FError));
-
-end;
-
-{-------------------------------------------------------------------}
-
-procedure Tmidioutput.PutMidiEvent(theEvent: TMyMidiEvent);
-begin
- if FState <> mosOpen then
- raise EMidiOutputError.Create('MIDI Output device not open');
-
- with theEvent do
- begin
- if Sysex = nil then
- begin
- PutShort(MidiMessage, Data1, Data2)
- end
- else
- PutLong(Sysex, SysexLength);
- end;
-end;
-
-{-------------------------------------------------------------------}
-
-function Tmidioutput.Close: Boolean;
-begin
- Result := False;
- if FState = mosOpen then
- begin
-
- { Note this sends a lot of fast control change messages which some synths can't handle.
- TODO: Make this optional. }
-{ FError := midioutReset(FMidiHandle);
- if Ferror <> 0 then
- raise EMidiOutputError.Create(MidiOutErrorString(FError)); }
-
- FError := midioutClose(FMidiHandle);
- if Ferror <> 0 then
- raise EMidiOutputError.Create(MidiOutErrorString(FError))
- else
- Result := True;
- end;
-
- FMidiHandle := 0;
- FState := mosClosed;
-
-end;
-
-{-------------------------------------------------------------------}
-
-procedure TMidiOutput.SetVolume(Left: Word; Right: Word);
-var
- dwVolume: DWORD;
-begin
- dwVolume := (DWORD(Left) shl 16) or Right;
- FError := midiOutSetVolume(DeviceID, dwVolume);
- if Ferror <> 0 then
- raise EMidiOutputError.Create(MidiOutErrorString(FError));
-end;
-
-{-------------------------------------------------------------------}
-
-procedure Tmidioutput.midioutput(var Message: TMessage);
-{ Triggered when sysex output from PutLong is complete }
-var
- MyMidiHdr: TMyMidiHdr;
- thisHdr: PMidiHdr;
-begin
- if Message.Msg = Mom_Done then
- begin
- { Find the MIDIHDR we used for the output. Message.lParam is its address }
- thisHdr := PMidiHdr(Message.lParam);
-
- { Remove it from the output device }
- midiOutUnprepareHeader(FMidiHandle, thisHdr, sizeof(TMIDIHDR));
-
- { Get the address of the MyMidiHdr object containing this MIDIHDR structure.
- We stored this address in the PutLong procedure }
- MyMidiHdr := TMyMidiHdr(thisHdr^.dwUser);
-
- { Header and copy of sysex data no longer required since output is complete }
- MyMidiHdr.Free;
-
- { Call the user's event handler if any }
- if Assigned(FOnmidioutput) then
- FOnmidioutput(Self);
- end;
- { TODO: Case for MOM_PLAYBACK_DONE }
-end;
-
-{-------------------------------------------------------------------}
-
-procedure Register;
-begin
- RegisterComponents('Synth', [Tmidioutput]);
-end;
-
-end.
-
+{ $Header: /MidiComp/MidiOut.pas 2 10/06/97 7:33 Davec $ } + +{ Written by David Churcher <dchurcher@cix.compulink.co.uk>, + released to the public domain. } + +{ Thanks very much to Fred Kohler for the Technology code. } + +unit MidiOut; + +{ + MIDI Output component. + + Properties: + DeviceID: Windows numeric device ID for the MIDI output device. + Between 0 and (midioutGetNumDevs-1), or MIDI_MAPPER (-1). + Special value MIDI_MAPPER specifies output to the Windows MIDI mapper + Read-only while device is open, exception if changed while open + + MIDIHandle: The output handle to the MIDI device. + 0 when device is not open + Read-only, runtime-only + + ProductName: Name of the output device product that corresponds to the + DeviceID property (e.g. 'MPU 401 out'). + You can write to this while the device is closed to select a particular + output device by name (the DeviceID property will change to match). + Exception if this property is changed while the device is open. + + Numdevs: Number of MIDI output devices installed on the system. This + is the value returned by midiOutGetNumDevs. It's included for + completeness. + + Technology: Type of technology used by the MIDI device. You can set this + property to one of the values listed for OutportTech (below) and the component + will find an appropriate MIDI device. For example: + MidiOutput.Technology := opt_FMSynth; + will set MidiInput.DeviceID to the MIDI device ID of the FM synth, if one + is installed. If no such device is available an exception is raised, + see MidiOutput.SetTechnology. + + See the MIDIOUTCAPS entry in MMSYSTEM.HLP for descriptions of the + following properties: + DriverVersion + Voices + Notes + ChannelMask + Support + + Error: The error code for the last MMSYSTEM error. See the MMSYSERR_ + entries in MMSYSTEM.INT for possible values. + + Methods: + Open: Open MIDI device specified by DeviceID property for output + + Close: Close device + + PutMidiEvent(Event:TMyMidiEvent): Output a note or sysex message to the + device. This method takes a TMyMidiEvent object and transmits it. + Notes: + 1. If the object contains a sysex event the OnMidiOutput event will + be triggered when the sysex transmission is complete. + 2. You can queue up multiple blocks of system exclusive data for + transmission by chucking them at this method; they will be + transmitted as quickly as the device can manage. + 3. This method will not free the TMyMidiEvent object, the caller + must do that. Any sysex data in the TMyMidiEvent is copied before + transmission so you can free the TMyMidiEvent immediately after + calling PutMidiEvent, even if output has not yet finished. + + PutShort(MidiMessage: Byte; Data1: Byte; Data2: Byte): Output a short + MIDI message. Handy when you can't be bothered to build a TMyMidiEvent. + If the message you're sending doesn't use Data1 or Data2, set them to 0. + + PutLong(TheSysex: Pointer; msgLength: Word): Output sysex data. + SysexPointer: Pointer to sysex data to send + msgLength: Length of sysex data. + This is handy when you don't have a TMyMidiEvent. + + SetVolume(Left: Word, Right: Word): Set the volume of the + left and right channels on the output device (only on internal devices?). + 0xFFFF is maximum volume. If the device doesn't support separate + left/right volume control, the value of the Left parameter will be used. + Check the Support property to see whether the device supports volume + control. See also other notes on volume control under midiOutSetVolume() + in MMSYSTEM.HLP. + + Events: + OnMidiOutput: Procedure called when output of a system exclusive block + is completed. + + Notes: + I haven't implemented any methods for midiOutCachePatches and + midiOutCacheDrumpatches, mainly 'cause I don't have any way of testing + them. Does anyone really use these? +} + +interface + +{$IFDEF FPC} + {$MODE Delphi} + {$H+} // use AnsiString +{$ENDIF} + +uses + SysUtils, + Windows, + Messages, + Classes, + MMSystem, + UCommon, + Circbuf, + MidiType, + MidiDefs, + Delphmcb; + +{$IFDEF FPC} +type TmidioutCaps = MIDIOUTCAPS; +{$ENDIF} + +type + midioutputState = (mosOpen, mosClosed); + EmidioutputError = class(Exception); + + { These are the equivalent of constants prefixed with mod_ + as defined in MMSystem. See SetTechnology } + OutPortTech = ( + opt_None, { none } + opt_MidiPort, { output port } + opt_Synth, { generic internal synth } + opt_SQSynth, { square wave internal synth } + opt_FMSynth, { FM internal synth } + opt_Mapper); { MIDI mapper } + TechNameMap = array[OutPortTech] of string[18]; + + +const + TechName: TechNameMap = ( + 'None', 'MIDI Port', 'Generic Synth', 'Square Wave Synth', + 'FM Synth', 'MIDI Mapper'); + +{-------------------------------------------------------------------} +type + TMidiOutput = class(TComponent) + protected + Handle: THandle; { Window handle used for callback notification } + FDeviceID: Cardinal; { MIDI device ID } + FMIDIHandle: Hmidiout; { Handle to output device } + FState: midioutputState; { Current device state } + PCtlInfo: PMidiCtlInfo; { Pointer to control info for DLL } + + PBuffer: PCircularBuffer; { Output queue for PutTimedEvent, set by Open } + + FError: Word; { Last MMSYSTEM error } + + { Stuff from midioutCAPS } + FDriverVersion: MMVERSION; { Driver version from midioutGetDevCaps } + FProductName: string; { product name } + FTechnology: OutPortTech; { Type of MIDI output device } + FVoices: Word; { Number of voices (internal synth) } + FNotes: Word; { Number of notes (internal synth) } + FChannelMask: Word; { Bit set for each MIDI channels that the + device responds to (internal synth) } + FSupport: DWORD; { Technology supported (volume control, + patch caching etc. } + FNumdevs: Word; { Number of MIDI output devices on system } + + + FOnMIDIOutput: TNotifyEvent; { Sysex output finished } + + procedure MidiOutput(var Message: TMessage); + procedure SetDeviceID(DeviceID: Cardinal); + procedure SetProductName(NewProductName: string); + procedure SetTechnology(NewTechnology: OutPortTech); + function midioutErrorString(WError: Word): string; + + public + { Properties } + property MIDIHandle: Hmidiout read FMIDIHandle; + property DriverVersion: MMVERSION { Driver version from midioutGetDevCaps } + read FDriverVersion; + property Technology: OutPortTech { Type of MIDI output device } + read FTechnology + write SetTechnology + default opt_Synth; + property Voices: Word { Number of voices (internal synth) } + read FVoices; + property Notes: Word { Number of notes (internal synth) } + read FNotes; + property ChannelMask: Word { Bit set for each MIDI channels that the } + read FChannelMask; { device responds to (internal synth) } + property Support: DWORD { Technology supported (volume control, } + read FSupport; { patch caching etc. } + property Error: Word read FError; + property Numdevs: Word read FNumdevs; + + { Methods } + function Open: Boolean; virtual; + function Close: Boolean; virtual; + procedure PutMidiEvent(theEvent: TMyMidiEvent); virtual; + procedure PutShort(MidiMessage: Byte; Data1: Byte; Data2: Byte); virtual; + procedure PutLong(TheSysex: Pointer; msgLength: Word); virtual; + procedure SetVolume(Left: Word; Right: Word); + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + { Some functions to decode and classify incoming messages would be nice } + + published + { TODO: Property editor with dropdown list of product names } + property ProductName: string read FProductName write SetProductName; + + property DeviceID: Cardinal read FDeviceID write SetDeviceID default 0; + { TODO: midiOutGetVolume? Or two properties for Left and Right volume? + Is it worth it?? + midiOutMessage?? Does anyone use this? } + + { Events } + property Onmidioutput: TNotifyEvent + read FOnmidioutput + write FOnmidioutput; + end; + +procedure Register; + +{-------------------------------------------------------------------} +implementation + +(* Not used in Delphi 3 + +{ This is the callback procedure in the external DLL. + It's used when midioutOpen is called by the Open method. + There are special requirements and restrictions for this callback + procedure (see midioutOpen in MMSYSTEM.HLP) so it's impractical to + make it an object method } +{$IFDEF WIN32} +function midiHandler( + hMidiIn: HMidiIn; + wMsg: UINT; + dwInstance: DWORD; + dwParam1: DWORD; + dwParam2: DWORD): Boolean; stdcall; external 'DELMID32.DLL'; +{$ELSE} +function midiHandler( + hMidiIn: HMidiIn; + wMsg: Word; + dwInstance: DWORD; + dwParam1: DWORD; + dwParam2: DWORD): Boolean; far; external 'DELPHMID.DLL'; +{$ENDIF} +*) + +{-------------------------------------------------------------------} + +constructor Tmidioutput.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FState := mosClosed; + FNumdevs := midiOutGetNumDevs; + + { Create the window for callback notification } + if not (csDesigning in ComponentState) then + begin + Handle := AllocateHwnd(MidiOutput); + end; + +end; + +{-------------------------------------------------------------------} + +destructor Tmidioutput.Destroy; +begin + if FState = mosOpen then + Close; + if (PCtlInfo <> nil) then + GlobalSharedLockedFree(PCtlinfo^.hMem, PCtlInfo); + DeallocateHwnd(Handle); + inherited Destroy; +end; + +{-------------------------------------------------------------------} +{ Convert the numeric return code from an MMSYSTEM function to a string + using midioutGetErrorText. TODO: These errors aren't very helpful + (e.g. "an invalid parameter was passed to a system function") so + some proper error strings would be nice. } + + +function Tmidioutput.midioutErrorString(WError: Word): string; +var + errorDesc: PChar; +begin + errorDesc := nil; + try + errorDesc := StrAlloc(MAXERRORLENGTH); + if midioutGetErrorText(WError, errorDesc, MAXERRORLENGTH) = 0 then + result := StrPas(errorDesc) + else + result := 'Specified error number is out of range'; + finally + if errorDesc <> nil then StrDispose(errorDesc); + end; +end; + +{-------------------------------------------------------------------} +{ Set the output device ID and change the other properties to match } + +procedure Tmidioutput.SetDeviceID(DeviceID: Cardinal); +var + midioutCaps: TmidioutCaps; +begin + if FState = mosOpen then + raise EmidioutputError.Create('Change to DeviceID while device was open') + else + if (DeviceID >= midioutGetNumDevs) and (DeviceID <> MIDI_MAPPER) then + raise EmidioutputError.Create('Invalid device ID') + else + begin + FDeviceID := DeviceID; + + { Set the name and other midioutCAPS properties to match the ID } + FError := + midioutGetDevCaps(DeviceID, @midioutCaps, sizeof(TmidioutCaps)); + if Ferror > 0 then + raise EmidioutputError.Create(midioutErrorString(FError)); + + with midiOutCaps do + begin + FProductName := StrPas(szPname); + FDriverVersion := vDriverVersion; + FTechnology := OutPortTech(wTechnology); + FVoices := wVoices; + FNotes := wNotes; + FChannelMask := wChannelMask; + FSupport := dwSupport; + end; + + end; +end; + +{-------------------------------------------------------------------} +{ Set the product name property and put the matching output device number + in FDeviceID. + This is handy if you want to save a configured output/output device + by device name instead of device number, because device numbers may + change if users install or remove MIDI devices. + Exception if output device with matching name not found, + or if output device is open } + +procedure Tmidioutput.SetProductName(NewProductName: string); +var + midioutCaps: TmidioutCaps; + testDeviceID: Integer; + testProductName: string; +begin + if FState = mosOpen then + raise EmidioutputError.Create('Change to ProductName while device was open') + else + { Don't set the name if the component is reading properties because + the saved Productname will be from the machine the application was compiled + on, which may not be the same for the corresponding DeviceID on the user's + machine. The FProductname property will still be set by SetDeviceID } + if not (csLoading in ComponentState) then + begin + { Loop uses -1 to test for MIDI_MAPPER as well } + for testDeviceID := -1 to (midioutGetNumDevs - 1) do + begin + FError := + midioutGetDevCaps(testDeviceID, @midioutCaps, sizeof(TmidioutCaps)); + if Ferror > 0 then + raise EmidioutputError.Create(midioutErrorString(FError)); + testProductName := StrPas(midioutCaps.szPname); + if testProductName = NewProductName then + begin + FProductName := NewProductName; + Break; + end; + end; + if FProductName <> NewProductName then + raise EmidioutputError.Create('MIDI output Device ' + + NewProductName + ' not installed') + else + SetDeviceID(testDeviceID); + end; +end; + +{-------------------------------------------------------------------} +{ Set the output technology property and put the matching output device + number in FDeviceID. + This is handy, for example, if you want to be able to switch between a + sound card and a MIDI port } + +procedure TMidiOutput.SetTechnology(NewTechnology: OutPortTech); +var + midiOutCaps: TMidiOutCaps; + testDeviceID: Integer; + testTechnology: OutPortTech; +begin + if FState = mosOpen then + raise EMidiOutputError.Create( + 'Change to Product Technology while device was open') + else + begin + { Loop uses -1 to test for MIDI_MAPPER as well } + for testDeviceID := -1 to (midiOutGetNumDevs - 1) do + begin + FError := + midiOutGetDevCaps(testDeviceID, + @midiOutCaps, sizeof(TMidiOutCaps)); + if Ferror > 0 then + raise EMidiOutputError.Create(MidiOutErrorString(FError)); + testTechnology := OutPortTech(midiOutCaps.wTechnology); + if testTechnology = NewTechnology then + begin + FTechnology := NewTechnology; + Break; + end; + end; + if FTechnology <> NewTechnology then + raise EMidiOutputError.Create('MIDI output technology ' + + TechName[NewTechnology] + ' not installed') + else + SetDeviceID(testDeviceID); + end; +end; + +{-------------------------------------------------------------------} + +function Tmidioutput.Open: Boolean; +var + hMem: THandle; +begin + Result := False; + try + { Create the control info for the DLL } + if (PCtlInfo = nil) then + begin + PCtlInfo := GlobalSharedLockedAlloc(Sizeof(TMidiCtlInfo), hMem); + PctlInfo^.hMem := hMem; + end; + + Pctlinfo^.hWindow := Handle; { Control's window handle } + + FError := midioutOpen(@FMidiHandle, FDeviceId, + DWORD(@midiHandler), + DWORD(PCtlInfo), + CALLBACK_FUNCTION); +{ FError := midioutOpen(@FMidiHandle, FDeviceId, + Handle, + DWORD(PCtlInfo), + CALLBACK_WINDOW); } + if (FError <> 0) then + { TODO: use CreateFmtHelp to add MIDI device name/ID to message } + raise EmidioutputError.Create(midioutErrorString(FError)) + else + begin + Result := True; + FState := mosOpen; + end; + + except + if PCtlInfo <> nil then + begin + GlobalSharedLockedFree(PCtlInfo^.hMem, PCtlInfo); + PCtlInfo := nil; + end; + end; + +end; + +{-------------------------------------------------------------------} + +procedure TMidiOutput.PutShort(MidiMessage: Byte; Data1: Byte; Data2: Byte); +var + thisMsg: DWORD; +begin + thisMsg := DWORD(MidiMessage) or + (DWORD(Data1) shl 8) or + (DWORD(Data2) shl 16); + + FError := midiOutShortMsg(FMidiHandle, thisMsg); + if Ferror > 0 then + raise EmidioutputError.Create(midioutErrorString(FError)); +end; + +{-------------------------------------------------------------------} + +procedure TMidiOutput.PutLong(TheSysex: Pointer; msgLength: Word); +{ Notes: This works asynchronously; you send your sysex output by +calling this function, which returns immediately. When the MIDI device +driver has finished sending the data the MidiOutPut function in this +component is called, which will in turn call the OnMidiOutput method +if the component user has defined one. } +{ TODO: Combine common functions with PutTimedLong into subroutine } + +var + MyMidiHdr: TMyMidiHdr; +begin + { Initialize the header and allocate buffer memory } + MyMidiHdr := TMyMidiHdr.Create(msgLength); + + { Copy the data over to the MidiHdr buffer + We can't just use the caller's PChar because the buffer memory + has to be global, shareable, and locked. } + StrMove(MyMidiHdr.SysexPointer, TheSysex, msgLength); + + { Store the MyMidiHdr address in the header so we can find it again quickly + (see the MidiOutput proc) } + MyMidiHdr.hdrPointer^.dwUser := DWORD(MyMidiHdr); + + { Get MMSYSTEM's blessing for this header } + FError := midiOutPrepareHeader(FMidiHandle, MyMidiHdr.hdrPointer, + sizeof(TMIDIHDR)); + if Ferror > 0 then + raise EMidiOutputError.Create(MidiOutErrorString(FError)); + + { Send it } + FError := midiOutLongMsg(FMidiHandle, MyMidiHdr.hdrPointer, + sizeof(TMIDIHDR)); + if Ferror > 0 then + raise EMidiOutputError.Create(MidiOutErrorString(FError)); + +end; + +{-------------------------------------------------------------------} + +procedure Tmidioutput.PutMidiEvent(theEvent: TMyMidiEvent); +begin + if FState <> mosOpen then + raise EMidiOutputError.Create('MIDI Output device not open'); + + with theEvent do + begin + if Sysex = nil then + begin + PutShort(MidiMessage, Data1, Data2) + end + else + PutLong(Sysex, SysexLength); + end; +end; + +{-------------------------------------------------------------------} + +function Tmidioutput.Close: Boolean; +begin + Result := False; + if FState = mosOpen then + begin + + { Note this sends a lot of fast control change messages which some synths can't handle. + TODO: Make this optional. } +{ FError := midioutReset(FMidiHandle); + if Ferror <> 0 then + raise EMidiOutputError.Create(MidiOutErrorString(FError)); } + + FError := midioutClose(FMidiHandle); + if Ferror <> 0 then + raise EMidiOutputError.Create(MidiOutErrorString(FError)) + else + Result := True; + end; + + FMidiHandle := 0; + FState := mosClosed; + +end; + +{-------------------------------------------------------------------} + +procedure TMidiOutput.SetVolume(Left: Word; Right: Word); +var + dwVolume: DWORD; +begin + dwVolume := (DWORD(Left) shl 16) or Right; + FError := midiOutSetVolume(DeviceID, dwVolume); + if Ferror <> 0 then + raise EMidiOutputError.Create(MidiOutErrorString(FError)); +end; + +{-------------------------------------------------------------------} + +procedure Tmidioutput.midioutput(var Message: TMessage); +{ Triggered when sysex output from PutLong is complete } +var + MyMidiHdr: TMyMidiHdr; + thisHdr: PMidiHdr; +begin + if Message.Msg = Mom_Done then + begin + { Find the MIDIHDR we used for the output. Message.lParam is its address } + thisHdr := PMidiHdr(Message.lParam); + + { Remove it from the output device } + midiOutUnprepareHeader(FMidiHandle, thisHdr, sizeof(TMIDIHDR)); + + { Get the address of the MyMidiHdr object containing this MIDIHDR structure. + We stored this address in the PutLong procedure } + MyMidiHdr := TMyMidiHdr(thisHdr^.dwUser); + + { Header and copy of sysex data no longer required since output is complete } + MyMidiHdr.Free; + + { Call the user's event handler if any } + if Assigned(FOnmidioutput) then + FOnmidioutput(Self); + end; + { TODO: Case for MOM_PLAYBACK_DONE } +end; + +{-------------------------------------------------------------------} + +procedure Register; +begin + RegisterComponents('Synth', [Tmidioutput]); +end; + +end. + diff --git a/Game/Code/lib/midi/demo/MidiTest.pas b/Game/Code/lib/midi/demo/MidiTest.pas index 0cf3e302..793db730 100644 --- a/Game/Code/lib/midi/demo/MidiTest.pas +++ b/Game/Code/lib/midi/demo/MidiTest.pas @@ -1,249 +1,249 @@ -// Test application for TMidiFile
-
-unit MidiTest;
-
-interface
-
-uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls, MidiFile, ExtCtrls, MidiOut, MidiType, MidiScope, Grids;
-type
- TMidiPlayer = class(TForm)
- OpenDialog1: TOpenDialog;
- Button1: TButton;
- Button3: TButton;
- Button4: TButton;
- MidiOutput1: TMidiOutput;
- cmbInput: TComboBox;
- MidiFile1: TMidiFile;
- MidiScope1: TMidiScope;
- Label3: TLabel;
- edtBpm: TEdit;
- Memo2: TMemo;
- edtTime: TEdit;
- Button2: TButton;
- TrackGrid: TStringGrid;
- TracksGrid: TStringGrid;
- edtLength: TEdit;
- procedure Button1Click(Sender: TObject);
- procedure MidiFile1MidiEvent(event: PMidiEvent);
- procedure Button3Click(Sender: TObject);
- procedure Button4Click(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- procedure cmbInputChange(Sender: TObject);
- procedure MidiFile1UpdateEvent(Sender: TObject);
- procedure Button2Click(Sender: TObject);
- procedure edtBpmKeyPress(Sender: TObject; var Key: Char);
- procedure TracksGridSelectCell(Sender: TObject; Col, Row: Integer;
- var CanSelect: Boolean);
- procedure FormShow(Sender: TObject);
- private
- { Private declarations }
- MidiOpened : boolean;
- procedure SentAllNotesOff;
-
- procedure MidiOpen;
- procedure MidiClose;
-
- public
- { Public declarations }
- end;
-
-var
- MidiPlayer: TMidiPlayer;
-
-implementation
-
-{$R *.DFM}
-
-procedure TMidiPlayer.Button1Click(Sender: TObject);
-var
- i,j: integer;
- track : TMidiTrack;
- event : PMidiEvent;
-begin
- if opendialog1.execute then
- begin
- midifile1.filename := opendialog1.filename;
- midifile1.readfile;
-// label1.caption := IntToStr(midifile1.NumberOfTracks);
- edtBpm.text := IntToStr(midifile1.Bpm);
-// TracksGrid.cells.clear;
- for i := 0 to midifile1.NumberOfTracks-1 do
- begin
- track := midifile1.getTrack(i);
- TracksGrid.cells[0,i] := 'Tr: '+ track.getName + ' '+ track.getInstrument ;
- end;
- edtLength.Text := MyTimeToStr(MidiFile1.GetTrackLength);
- end;
-end;
-
-procedure TMidiPlayer.MidiFile1MidiEvent(event: PMidiEvent);
-var mEvent : TMyMidiEvent;
-begin
- mEvent := TMyMidiEvent.Create;
- if not (event.event = $FF) then
- begin
- mEvent.MidiMessage := event.event;
- mEvent.data1 := event.data1;
- mEvent.data2 := event.data2;
- midioutput1.PutMidiEvent(mEvent);
- end
- else
- begin
- if (event.data1 >= 1) and (event.data1 < 15) then
- begin
- memo2.Lines.add(IntToStr(event.data1) + ' '+ event.str);
- end
- end;
- midiScope1.MidiEvent(event.event,event.data1,event.data2);
- mEvent.Destroy;
-end;
-
-procedure TMidiPlayer.SentAllNotesOff;
-var mEvent : TMyMidiEvent;
-channel : integer;
-begin
- mEvent := TMyMidiEvent.Create;
- for channel:= 0 to 15 do
- begin
- mEvent.MidiMessage := $B0 + channel;
- mEvent.data1 := $78;
- mEvent.data2 := 0;
- if MidiOpened then
- midioutput1.PutMidiEvent(mEvent);
- midiScope1.MidiEvent(mEvent.MidiMessage,mEvent.data1,mEvent.data2);
- end;
- mEvent.Destroy;
-end;
-
-procedure TMidiPlayer.Button3Click(Sender: TObject);
-begin
- midifile1.StartPlaying;
-end;
-
-procedure TMidiPlayer.Button4Click(Sender: TObject);
-begin
- midifile1.StopPlaying;
- SentAllNotesOff;
-end;
-
-procedure TMidiPlayer.MidiOpen;
-begin
- if not (cmbInput.Text = '') then
- begin
- MidiOutput1.ProductName := cmbInput.Text;
- MidiOutput1.OPEN;
- MidiOpened := true;
- end;
-end;
-
-procedure TMidiPlayer.MidiClose;
-begin
- if MidiOpened then
- begin
- MidiOutput1.Close;
- MidiOpened := false;
- end;
-end;
-
-
-procedure TMidiPlayer.FormCreate(Sender: TObject);
-var thisDevice : integer;
-begin
- for thisDevice := 0 to MidiOutput1.NumDevs - 1 do
- begin
- MidiOutput1.DeviceID := thisDevice;
- cmbInput.Items.Add(MidiOutput1.ProductName);
- end;
- cmbInput.ItemIndex := 0;
- MidiOpened := false;
- MidiOpen;
-end;
-
-procedure TMidiPlayer.cmbInputChange(Sender: TObject);
-begin
- MidiClose;
- MidiOPen;
-end;
-
-procedure TMidiPlayer.MidiFile1UpdateEvent(Sender: TObject);
-begin
- edtTime.Text := MyTimeToStr(MidiFile1.GetCurrentTime);
- edtTime.update;
- if MidiFile1.ready then
- begin
- midifile1.StopPlaying;
- SentAllNotesOff;
- end;
-end;
-
-procedure TMidiPlayer.Button2Click(Sender: TObject);
-begin
- MidiFile1.ContinuePlaying;
-end;
-
-procedure TMidiPlayer.edtBpmKeyPress(Sender: TObject; var Key: Char);
-begin
- if Key = char(13) then
- begin
- MidiFile1.Bpm := StrToInt(edtBpm.Text);
- edtBpm.text := IntToStr(midifile1.Bpm);
- abort;
- end;
-
-end;
-
-procedure TMidiPlayer.TracksGridSelectCell(Sender: TObject; Col,
- Row: Integer; var CanSelect: Boolean);
-var
- MidiTrack : TMidiTrack;
- i : integer;
- j : integer;
- event : PMidiEvent;
-begin
- CanSelect := false;
- if Row < MidiFile1.NumberOfTracks then
- begin
- CanSelect := true;
- MidiTrack := MidiFile1.GetTrack(Row);
- TrackGrid.RowCount := 2;
- TrackGrid.RowCount := MidiTrack.getEventCount;
- j := 1;
- for i := 0 to MidiTrack.GetEventCount-1 do
- begin
- event := MidiTrack.getEvent(i);
- if not (event.len = -1) then
- begin // do not print when
- TrackGrid.cells[0,j] := IntToStr(i);
- TrackGrid.cells[1,j] := MyTimeToStr(event.time);
- TrackGrid.cells[2,j] := IntToHex(event.event,2);
- if not (event.event = $FF) then
- begin
- TrackGrid.cells[3,j] := IntToStr(event.len);
- TrackGrid.cells[4,j] := KeyToStr(event.data1);
- TrackGrid.cells[5,j] := IntToStr(event.data2);
- end
- else
- begin
- TrackGrid.cells[3,j] := IntToStr(event.data1);
- TrackGrid.cells[4,j] := '';
- TrackGrid.cells[5,j] := event.str;
- end;
- inc(j);
- end;
- end;
- TrackGrid.RowCount := j;
- end;
-end;
-
-procedure TMidiPlayer.FormShow(Sender: TObject);
-begin
- TrackGrid.ColWidths[0] := 30;
- TrackGrid.ColWidths[2] := 30;
- TrackGrid.ColWidths[3] := 30;
- TrackGrid.ColWidths[4] := 30;
- TrackGrid.ColWidths[5] := 100;
-end;
-
-end.
+// Test application for TMidiFile + +unit MidiTest; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, MidiFile, ExtCtrls, MidiOut, MidiType, MidiScope, Grids; +type + TMidiPlayer = class(TForm) + OpenDialog1: TOpenDialog; + Button1: TButton; + Button3: TButton; + Button4: TButton; + MidiOutput1: TMidiOutput; + cmbInput: TComboBox; + MidiFile1: TMidiFile; + MidiScope1: TMidiScope; + Label3: TLabel; + edtBpm: TEdit; + Memo2: TMemo; + edtTime: TEdit; + Button2: TButton; + TrackGrid: TStringGrid; + TracksGrid: TStringGrid; + edtLength: TEdit; + procedure Button1Click(Sender: TObject); + procedure MidiFile1MidiEvent(event: PMidiEvent); + procedure Button3Click(Sender: TObject); + procedure Button4Click(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure cmbInputChange(Sender: TObject); + procedure MidiFile1UpdateEvent(Sender: TObject); + procedure Button2Click(Sender: TObject); + procedure edtBpmKeyPress(Sender: TObject; var Key: Char); + procedure TracksGridSelectCell(Sender: TObject; Col, Row: Integer; + var CanSelect: Boolean); + procedure FormShow(Sender: TObject); + private + { Private declarations } + MidiOpened : boolean; + procedure SentAllNotesOff; + + procedure MidiOpen; + procedure MidiClose; + + public + { Public declarations } + end; + +var + MidiPlayer: TMidiPlayer; + +implementation + +{$R *.DFM} + +procedure TMidiPlayer.Button1Click(Sender: TObject); +var + i,j: integer; + track : TMidiTrack; + event : PMidiEvent; +begin + if opendialog1.execute then + begin + midifile1.filename := opendialog1.filename; + midifile1.readfile; +// label1.caption := IntToStr(midifile1.NumberOfTracks); + edtBpm.text := IntToStr(midifile1.Bpm); +// TracksGrid.cells.clear; + for i := 0 to midifile1.NumberOfTracks-1 do + begin + track := midifile1.getTrack(i); + TracksGrid.cells[0,i] := 'Tr: '+ track.getName + ' '+ track.getInstrument ; + end; + edtLength.Text := MyTimeToStr(MidiFile1.GetTrackLength); + end; +end; + +procedure TMidiPlayer.MidiFile1MidiEvent(event: PMidiEvent); +var mEvent : TMyMidiEvent; +begin + mEvent := TMyMidiEvent.Create; + if not (event.event = $FF) then + begin + mEvent.MidiMessage := event.event; + mEvent.data1 := event.data1; + mEvent.data2 := event.data2; + midioutput1.PutMidiEvent(mEvent); + end + else + begin + if (event.data1 >= 1) and (event.data1 < 15) then + begin + memo2.Lines.add(IntToStr(event.data1) + ' '+ event.str); + end + end; + midiScope1.MidiEvent(event.event,event.data1,event.data2); + mEvent.Destroy; +end; + +procedure TMidiPlayer.SentAllNotesOff; +var mEvent : TMyMidiEvent; +channel : integer; +begin + mEvent := TMyMidiEvent.Create; + for channel:= 0 to 15 do + begin + mEvent.MidiMessage := $B0 + channel; + mEvent.data1 := $78; + mEvent.data2 := 0; + if MidiOpened then + midioutput1.PutMidiEvent(mEvent); + midiScope1.MidiEvent(mEvent.MidiMessage,mEvent.data1,mEvent.data2); + end; + mEvent.Destroy; +end; + +procedure TMidiPlayer.Button3Click(Sender: TObject); +begin + midifile1.StartPlaying; +end; + +procedure TMidiPlayer.Button4Click(Sender: TObject); +begin + midifile1.StopPlaying; + SentAllNotesOff; +end; + +procedure TMidiPlayer.MidiOpen; +begin + if not (cmbInput.Text = '') then + begin + MidiOutput1.ProductName := cmbInput.Text; + MidiOutput1.OPEN; + MidiOpened := true; + end; +end; + +procedure TMidiPlayer.MidiClose; +begin + if MidiOpened then + begin + MidiOutput1.Close; + MidiOpened := false; + end; +end; + + +procedure TMidiPlayer.FormCreate(Sender: TObject); +var thisDevice : integer; +begin + for thisDevice := 0 to MidiOutput1.NumDevs - 1 do + begin + MidiOutput1.DeviceID := thisDevice; + cmbInput.Items.Add(MidiOutput1.ProductName); + end; + cmbInput.ItemIndex := 0; + MidiOpened := false; + MidiOpen; +end; + +procedure TMidiPlayer.cmbInputChange(Sender: TObject); +begin + MidiClose; + MidiOPen; +end; + +procedure TMidiPlayer.MidiFile1UpdateEvent(Sender: TObject); +begin + edtTime.Text := MyTimeToStr(MidiFile1.GetCurrentTime); + edtTime.update; + if MidiFile1.ready then + begin + midifile1.StopPlaying; + SentAllNotesOff; + end; +end; + +procedure TMidiPlayer.Button2Click(Sender: TObject); +begin + MidiFile1.ContinuePlaying; +end; + +procedure TMidiPlayer.edtBpmKeyPress(Sender: TObject; var Key: Char); +begin + if Key = char(13) then + begin + MidiFile1.Bpm := StrToInt(edtBpm.Text); + edtBpm.text := IntToStr(midifile1.Bpm); + abort; + end; + +end; + +procedure TMidiPlayer.TracksGridSelectCell(Sender: TObject; Col, + Row: Integer; var CanSelect: Boolean); +var + MidiTrack : TMidiTrack; + i : integer; + j : integer; + event : PMidiEvent; +begin + CanSelect := false; + if Row < MidiFile1.NumberOfTracks then + begin + CanSelect := true; + MidiTrack := MidiFile1.GetTrack(Row); + TrackGrid.RowCount := 2; + TrackGrid.RowCount := MidiTrack.getEventCount; + j := 1; + for i := 0 to MidiTrack.GetEventCount-1 do + begin + event := MidiTrack.getEvent(i); + if not (event.len = -1) then + begin // do not print when + TrackGrid.cells[0,j] := IntToStr(i); + TrackGrid.cells[1,j] := MyTimeToStr(event.time); + TrackGrid.cells[2,j] := IntToHex(event.event,2); + if not (event.event = $FF) then + begin + TrackGrid.cells[3,j] := IntToStr(event.len); + TrackGrid.cells[4,j] := KeyToStr(event.data1); + TrackGrid.cells[5,j] := IntToStr(event.data2); + end + else + begin + TrackGrid.cells[3,j] := IntToStr(event.data1); + TrackGrid.cells[4,j] := ''; + TrackGrid.cells[5,j] := event.str; + end; + inc(j); + end; + end; + TrackGrid.RowCount := j; + end; +end; + +procedure TMidiPlayer.FormShow(Sender: TObject); +begin + TrackGrid.ColWidths[0] := 30; + TrackGrid.ColWidths[2] := 30; + TrackGrid.ColWidths[3] := 30; + TrackGrid.ColWidths[4] := 30; + TrackGrid.ColWidths[5] := 100; +end; + +end. diff --git a/Game/Code/lib/midi/demo/Project1.dpr b/Game/Code/lib/midi/demo/Project1.dpr index 4237e983..7aa4e512 100644 --- a/Game/Code/lib/midi/demo/Project1.dpr +++ b/Game/Code/lib/midi/demo/Project1.dpr @@ -1,13 +1,13 @@ -program Project1;
-
-uses
- Forms,
- MidiTest in 'MidiTest.pas' {MidiPlayer};
-
-{$R *.RES}
-
-begin
- Application.Initialize;
- Application.CreateForm(TMidiPlayer, MidiPlayer);
- Application.Run;
-end.
+program Project1; + +uses + Forms, + MidiTest in 'MidiTest.pas' {MidiPlayer}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TMidiPlayer, MidiPlayer); + Application.Run; +end. diff --git a/Game/Code/lib/midi/midiComp.cfg b/Game/Code/lib/midi/midiComp.cfg index 2ee4ea3a..8b774c81 100644 --- a/Game/Code/lib/midi/midiComp.cfg +++ b/Game/Code/lib/midi/midiComp.cfg @@ -1,35 +1,35 @@ --$A+
--$B-
--$C+
--$D+
--$E-
--$F-
--$G+
--$H+
--$I+
--$J+
--$K-
--$L+
--$M-
--$N+
--$O+
--$P+
--$Q-
--$R-
--$S-
--$T-
--$U-
--$V+
--$W-
--$X+
--$Y-
--$Z1
--cg
--AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
--H+
--W+
--M
--$M16384,1048576
--K$00400000
--LE"d:\program files\borland\delphi5\Projects\Bpl"
--LN"d:\program files\borland\delphi5\Projects\Bpl"
+-$A+ +-$B- +-$C+ +-$D+ +-$E- +-$F- +-$G+ +-$H+ +-$I+ +-$J+ +-$K- +-$L+ +-$M- +-$N+ +-$O+ +-$P+ +-$Q- +-$R- +-$S- +-$T- +-$U- +-$V+ +-$W- +-$X+ +-$Y- +-$Z1 +-cg +-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +-H+ +-W+ +-M +-$M16384,1048576 +-K$00400000 +-LE"d:\program files\borland\delphi5\Projects\Bpl" +-LN"d:\program files\borland\delphi5\Projects\Bpl" diff --git a/Game/Code/lib/midi/readme.txt b/Game/Code/lib/midi/readme.txt index 5e4207f6..7112aecf 100644 --- a/Game/Code/lib/midi/readme.txt +++ b/Game/Code/lib/midi/readme.txt @@ -1,60 +1,60 @@ -
-Midi components
- TMidiFile, TMidiScope
- TMidiIn and TMidiOut of david Churcher are included because they are used in
- the demo application
-
-Freeware.
-
-100% source code, demo application.
-
-Included Components/Classes
-
-TMidiFile, read a midifile and have the contents available in memory
- list of Tracks, track is list of events
-
-
-TMidiScope, show all activity on a midi device
-
-TMidiIn and TMidiOut of David Churcher are included because they are used
-in the demo application
-
-Midiplayer is a demo application which plays a midifile on a midi output
- it is build fairly simple with the included components. The timer is used
- to time the midievents. The timing is therefor as good as the windows timer.
-
-
- The header of midifile,midiscope contains help information on the properties/functions
- The example Midiplayer gives a good idea how to use the components
-
-Installation
- open midiComp.dpk with file/open
- compile and install the package
- make sure that the directory where the files are located is in the library path
- (tools/environment options/library)
-
-to run the demo
- open project1.dpr in the demo directory and press run.
-
-
-
-history
-1.0 18-1-1999 first release
-
-1.1 5-3-1999 update
- added some functions for display purposes
- improved demo to include event viewer
- bpm can be changed
-
-1.2 24-2-2000 update
- added some functions to see the length of a song and ready function to know when playback is ready
-
-for comments/bugs in these components:
-
-Frans Bouwmans
-fbouwmans@spiditel.nl
-
-I'm busy building a software music synthesizer, which will be available in source
-to the public. If you are interrested in helping me with certain soundmodules
-(effects, filters, sound generators) just sent me an email.
-
+ +Midi components + TMidiFile, TMidiScope + TMidiIn and TMidiOut of david Churcher are included because they are used in + the demo application + +Freeware. + +100% source code, demo application. + +Included Components/Classes + +TMidiFile, read a midifile and have the contents available in memory + list of Tracks, track is list of events + + +TMidiScope, show all activity on a midi device + +TMidiIn and TMidiOut of David Churcher are included because they are used +in the demo application + +Midiplayer is a demo application which plays a midifile on a midi output + it is build fairly simple with the included components. The timer is used + to time the midievents. The timing is therefor as good as the windows timer. + + + The header of midifile,midiscope contains help information on the properties/functions + The example Midiplayer gives a good idea how to use the components + +Installation + open midiComp.dpk with file/open + compile and install the package + make sure that the directory where the files are located is in the library path + (tools/environment options/library) + +to run the demo + open project1.dpr in the demo directory and press run. + + + +history +1.0 18-1-1999 first release + +1.1 5-3-1999 update + added some functions for display purposes + improved demo to include event viewer + bpm can be changed + +1.2 24-2-2000 update + added some functions to see the length of a song and ready function to know when playback is ready + +for comments/bugs in these components: + +Frans Bouwmans +fbouwmans@spiditel.nl + +I'm busy building a software music synthesizer, which will be available in source +to the public. If you are interrested in helping me with certain soundmodules +(effects, filters, sound generators) just sent me an email. + diff --git a/Game/Code/lib/other/DirWatch.pas b/Game/Code/lib/other/DirWatch.pas index adeb34ed..d302cade 100644 --- a/Game/Code/lib/other/DirWatch.pas +++ b/Game/Code/lib/other/DirWatch.pas @@ -1,343 +1,343 @@ -unit DirWatch;
-
-// -----------------------------------------------------------------------------
-// Component Name: TDirectoryWatch .
-// Module: DirWatch .
-// Description: Implements watching for file changes in a designated .
-// directory (or directories). .
-// Version: 1.4 .
-// Date: 10-MAR-2003 .
-// Target: Win32, Delphi 3 - Delphi 7 .
-// Author: Angus Johnson, angusj-AT-myrealbox-DOT-com .
-// A portion of code has been copied from the Drag & Drop .
-// Component Suite which I co-authored with Anders Melander. .
-// Copyright: © 2003 Angus Johnson .
-// .
-// Usage: 1. Add a TDirectoryWatch component to your form. .
-// 2. Set its Directory property .
-// 3. If you wish to watch its subdirectories too then set .
-// the WatchSubDir property to true .
-// 4. Assign the OnChange event .
-// 5. Set Active to true .
-// -----------------------------------------------------------------------------
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
- {$H+} // use AnsiString
-{$ENDIF}
-
-uses
- Windows,
- Messages,
- SysUtils,
- UCommon,
- Classes;
-
-type
- TNotifyFilters = set of (nfFilename, nfDirname, nfAttrib,
- nfSize, nfLastWrite, nfSecurity);
-
- TWatchThread = class; //forward declaration
-
- TDirectoryWatch = class(TComponent)
- private
- fWindowHandle: THandle;
- fWatchThread: TWatchThread;
- fWatchSubDirs: boolean;
- fDirectory: string;
- fActive: boolean;
- fNotifyFilters: TNotifyFilters; //see FindFirstChangeNotification in winAPI
- fOnChangeEvent: TNotifyEvent;
- procedure SetActive(aActive: boolean);
- procedure SetDirectory(aDir: string);
- procedure SetWatchSubDirs(aWatchSubDirs: boolean);
- procedure SetNotifyFilters(aNotifyFilters: TNotifyFilters);
- procedure WndProc(var aMsg: TMessage);
- public
- constructor Create(aOwner: TComponent); override;
- destructor Destroy; override;
- published
- property Directory: string read fDirectory write SetDirectory;
- property NotifyFilters: TNotifyFilters
- read fNotifyFilters write SetNotifyFilters;
- property WatchSubDirs: boolean read fWatchSubDirs write SetWatchSubDirs;
- property Active: boolean read fActive write SetActive;
- property OnChange: TNotifyEvent read fOnChangeEvent write fOnChangeEvent;
- end;
-
- TWatchThread = class(TThread)
- private
- fOwnerHdl: Thandle;
- fChangeNotify : THandle; //Signals whenever Windows detects a change in .
- //the watched directory .
- fBreakEvent: THandle; //Signals when either the Directory property .
- //changes or when the thread terminates .
- fDirectory: string;
- fWatchSubDirs: longbool;
- fNotifyFilters: dword;
- fFinished: boolean;
- protected
- procedure SetDirectory(const Value: string);
- procedure ProcessFilenameChanges;
- procedure Execute; override;
- public
- constructor Create( OwnerHdl: THandle;
- const InitialDir: string; WatchSubDirs: boolean; NotifyFilters: dword);
- destructor Destroy; override;
- procedure Terminate;
- property Directory: string write SetDirectory;
- end;
-
-procedure Register;
-
-implementation
-
-const
- NOTIFYCHANGE_MESSAGE = WM_USER + 1;
-
-resourcestring
- sInvalidDir = 'Invalid Directory: ';
-
-//----------------------------------------------------------------------------
-// Miscellaneous functions ...
-//----------------------------------------------------------------------------
-
-procedure Register;
-begin
- RegisterComponents('Samples', [TDirectoryWatch]);
-end;
-//----------------------------------------------------------------------------
-
-function DirectoryExists(const Name: string): Boolean;
-var
- Code: Integer;
-begin
- Code := GetFileAttributes(PChar(Name));
- Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
-end;
-
-//----------------------------------------------------------------------------
-// TDirectoryWatch methods ...
-//----------------------------------------------------------------------------
-
-constructor TDirectoryWatch.Create(aOwner: TComponent);
-begin
- inherited Create(aOwner);
- //default Notify values - notify if either a file name or a directory name
- //changes or if a file is modified ...
- fNotifyFilters := [nfFilename, nfDirname, nfLastWrite];
- fDirectory := 'C:\';
- //this non-visual control needs to handle messages, so ...
- if not (csDesigning in ComponentState) then
- fWindowHandle := AllocateHWnd(WndProc);
-end;
-//----------------------------------------------------------------------------
-
-destructor TDirectoryWatch.Destroy;
-begin
- Active := false;
- if not (csDesigning in ComponentState) then
- DeallocateHWnd(fWindowHandle);
- inherited Destroy;
-end;
-//----------------------------------------------------------------------------
-
-procedure TDirectoryWatch.WndProc(var aMsg: TMessage);
-begin
- with aMsg do
- if Msg = NOTIFYCHANGE_MESSAGE then
- begin
- if assigned(OnChange) then OnChange(self);
- end else
- Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
-end;
-//------------------------------------------------------------------------------
-
-procedure TDirectoryWatch.SetNotifyFilters(aNotifyFilters: TNotifyFilters);
-begin
- if aNotifyFilters = fNotifyFilters then exit;
- fNotifyFilters := aNotifyFilters;
- if assigned(fWatchThread) then
- begin
- Active := false;
- Active := true;
- end;
-end;
-//------------------------------------------------------------------------------
-
-procedure TDirectoryWatch.SetWatchSubDirs(aWatchSubDirs: boolean);
-begin
- if aWatchSubDirs = fWatchSubDirs then exit;
- fWatchSubDirs := aWatchSubDirs;
- if assigned(fWatchThread) then
- begin
- Active := false;
- Active := true;
- end;
-end;
-//------------------------------------------------------------------------------
-
-procedure TDirectoryWatch.SetDirectory(aDir: string);
-begin
- if aDir = '' then
- begin
- Active := false;
- fDirectory := '';
- exit;
- end;
- if (aDir[length(aDir)] <> '\') then aDir := aDir + '\';
- if aDir = fDirectory then exit;
- if not (csDesigning in ComponentState) and not DirectoryExists(aDir) then
- raise Exception.Create( sInvalidDir + aDir);
- fDirectory := aDir;
- if assigned(fWatchThread) then
- fWatchThread.Directory := fDirectory;
-end;
-//------------------------------------------------------------------------------
-
-procedure TDirectoryWatch.SetActive(aActive: boolean);
-var
- nf: dword;
-begin
- if aActive = fActive then exit;
- fActive := aActive;
- if csDesigning in ComponentState then exit;
- if fActive then
- begin
- if not DirectoryExists(fDirectory) then
- begin
- fActive := false;
- raise Exception.Create(sInvalidDir + fDirectory);
- end;
- nf := 0;
- if nfFilename in fNotifyFilters then
- nf := nf or FILE_NOTIFY_CHANGE_FILE_NAME;
- if nfDirname in fNotifyFilters then
- nf := nf or FILE_NOTIFY_CHANGE_DIR_NAME;
- if nfAttrib in fNotifyFilters then
- nf := nf or FILE_NOTIFY_CHANGE_ATTRIBUTES;
- if nfSize in fNotifyFilters then
- nf := nf or FILE_NOTIFY_CHANGE_SIZE;
- if nfLastWrite in fNotifyFilters then
- nf := nf or FILE_NOTIFY_CHANGE_LAST_WRITE;
- if nfSecurity in fNotifyFilters then
- nf := nf or FILE_NOTIFY_CHANGE_SECURITY;
- fWatchThread := TWatchThread.Create(
- fWindowHandle, fDirectory, fWatchSubDirs, nf);
- end else
- begin
- fWatchThread.Terminate;
- fWatchThread := nil;
- end;
-end;
-
-//----------------------------------------------------------------------------
-// TWatchThread methods ...
-//----------------------------------------------------------------------------
-
-constructor TWatchThread.Create(OwnerHdl: THandle;
- const InitialDir: string; WatchSubDirs: boolean; NotifyFilters: dword);
-begin
- inherited Create(True);
- fOwnerHdl := OwnerHdl;
- if WatchSubDirs then
- cardinal(fWatchSubDirs) := 1 //workaround a Win9x OS issue
- else
- fWatchSubDirs := false;
- FreeOnTerminate := true;
- Priority := tpLowest;
- fDirectory := InitialDir;
- fNotifyFilters := NotifyFilters;
- fBreakEvent := windows.CreateEvent(nil, False, False, nil);
- Resume;
-end;
-//------------------------------------------------------------------------------
-
-destructor TWatchThread.Destroy;
-begin
- CloseHandle(fBreakEvent);
- inherited Destroy;
-end;
-//------------------------------------------------------------------------------
-
-procedure TWatchThread.SetDirectory(const Value: string);
-begin
- if (Value = FDirectory) then exit;
- FDirectory := Value;
- SetEvent(fBreakEvent);
-end;
-//------------------------------------------------------------------------------
-
-procedure TWatchThread.Terminate;
-begin
- inherited Terminate;
- SetEvent(fBreakEvent);
- while not fFinished do sleep(10); //avoids a reported resource leak
- //if called while closing the application.
-end;
-//------------------------------------------------------------------------------
-
-procedure TWatchThread.Execute;
-begin
- //OUTER LOOP - manages Directory property reassignments
- while (not Terminated) do
- begin
- fChangeNotify := FindFirstChangeNotification(pchar(fDirectory),
- fWatchSubDirs, fNotifyFilters);
- if (fChangeNotify = INVALID_HANDLE_VALUE) then
- //Can't monitor the specified directory so we'll just wait for
- //a new Directory assignment or the thread terminating ...
- WaitForSingleObject(fBreakEvent, INFINITE)
- else
- try
- //Now do the INNER loop...
- ProcessFilenameChanges;
- finally
- FindCloseChangeNotification(fChangeNotify);
- end;
- end;
- fFinished := true;
-end;
-//------------------------------------------------------------------------------
-
-procedure TWatchThread.ProcessFilenameChanges;
-var
- WaitResult : DWORD;
- HandleArray : array[0..1] of THandle;
-const
- TEN_MSECS = 10;
- HUNDRED_MSECS = 100;
-begin
- HandleArray[0] := fBreakEvent;
- HandleArray[1] := fChangeNotify;
- //INNER LOOP - exits only when fBreakEvent signaled
- while (not Terminated) do
- begin
- //waits for either fChangeNotify or fBreakEvent ...
- WaitResult := WaitForMultipleObjects(2, @HandleArray, False, INFINITE);
- if (WaitResult = WAIT_OBJECT_0 + 1) then //fChangeNotify
- begin
- repeat //ie: if a number of files are changing in a block
- //just post the one notification message ...
- FindNextChangeNotification(fChangeNotify);
- until Terminated or
- (WaitForSingleObject(fChangeNotify, TEN_MSECS) <> WAIT_OBJECT_0);
- if Terminated then break;
- //OK, now notify the main thread (before restarting inner loop)...
- PostMessage(fOwnerHdl, NOTIFYCHANGE_MESSAGE, 0, 0);
- end else //fBreakEvent ...
- begin
- //If the Directory property is undergoing multiple rapid reassignments
- //wait 'til this stops before restarting monitoring of a new directory ...
- while (not Terminated) and
- (WaitForSingleObject(fBreakEvent, HUNDRED_MSECS) = WAIT_OBJECT_0) do;
- break; //EXIT LOOP HERE
- end;
- end;
-end;
-//------------------------------------------------------------------------------
-//------------------------------------------------------------------------------
-
+unit DirWatch; + +// ----------------------------------------------------------------------------- +// Component Name: TDirectoryWatch . +// Module: DirWatch . +// Description: Implements watching for file changes in a designated . +// directory (or directories). . +// Version: 1.4 . +// Date: 10-MAR-2003 . +// Target: Win32, Delphi 3 - Delphi 7 . +// Author: Angus Johnson, angusj-AT-myrealbox-DOT-com . +// A portion of code has been copied from the Drag & Drop . +// Component Suite which I co-authored with Anders Melander. . +// Copyright: © 2003 Angus Johnson . +// . +// Usage: 1. Add a TDirectoryWatch component to your form. . +// 2. Set its Directory property . +// 3. If you wish to watch its subdirectories too then set . +// the WatchSubDir property to true . +// 4. Assign the OnChange event . +// 5. Set Active to true . +// ----------------------------------------------------------------------------- + +interface + +{$IFDEF FPC} + {$MODE Delphi} + {$H+} // use AnsiString +{$ENDIF} + +uses + Windows, + Messages, + SysUtils, + UCommon, + Classes; + +type + TNotifyFilters = set of (nfFilename, nfDirname, nfAttrib, + nfSize, nfLastWrite, nfSecurity); + + TWatchThread = class; //forward declaration + + TDirectoryWatch = class(TComponent) + private + fWindowHandle: THandle; + fWatchThread: TWatchThread; + fWatchSubDirs: boolean; + fDirectory: string; + fActive: boolean; + fNotifyFilters: TNotifyFilters; //see FindFirstChangeNotification in winAPI + fOnChangeEvent: TNotifyEvent; + procedure SetActive(aActive: boolean); + procedure SetDirectory(aDir: string); + procedure SetWatchSubDirs(aWatchSubDirs: boolean); + procedure SetNotifyFilters(aNotifyFilters: TNotifyFilters); + procedure WndProc(var aMsg: TMessage); + public + constructor Create(aOwner: TComponent); override; + destructor Destroy; override; + published + property Directory: string read fDirectory write SetDirectory; + property NotifyFilters: TNotifyFilters + read fNotifyFilters write SetNotifyFilters; + property WatchSubDirs: boolean read fWatchSubDirs write SetWatchSubDirs; + property Active: boolean read fActive write SetActive; + property OnChange: TNotifyEvent read fOnChangeEvent write fOnChangeEvent; + end; + + TWatchThread = class(TThread) + private + fOwnerHdl: Thandle; + fChangeNotify : THandle; //Signals whenever Windows detects a change in . + //the watched directory . + fBreakEvent: THandle; //Signals when either the Directory property . + //changes or when the thread terminates . + fDirectory: string; + fWatchSubDirs: longbool; + fNotifyFilters: dword; + fFinished: boolean; + protected + procedure SetDirectory(const Value: string); + procedure ProcessFilenameChanges; + procedure Execute; override; + public + constructor Create( OwnerHdl: THandle; + const InitialDir: string; WatchSubDirs: boolean; NotifyFilters: dword); + destructor Destroy; override; + procedure Terminate; + property Directory: string write SetDirectory; + end; + +procedure Register; + +implementation + +const + NOTIFYCHANGE_MESSAGE = WM_USER + 1; + +resourcestring + sInvalidDir = 'Invalid Directory: '; + +//---------------------------------------------------------------------------- +// Miscellaneous functions ... +//---------------------------------------------------------------------------- + +procedure Register; +begin + RegisterComponents('Samples', [TDirectoryWatch]); +end; +//---------------------------------------------------------------------------- + +function DirectoryExists(const Name: string): Boolean; +var + Code: Integer; +begin + Code := GetFileAttributes(PChar(Name)); + Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0); +end; + +//---------------------------------------------------------------------------- +// TDirectoryWatch methods ... +//---------------------------------------------------------------------------- + +constructor TDirectoryWatch.Create(aOwner: TComponent); +begin + inherited Create(aOwner); + //default Notify values - notify if either a file name or a directory name + //changes or if a file is modified ... + fNotifyFilters := [nfFilename, nfDirname, nfLastWrite]; + fDirectory := 'C:\'; + //this non-visual control needs to handle messages, so ... + if not (csDesigning in ComponentState) then + fWindowHandle := AllocateHWnd(WndProc); +end; +//---------------------------------------------------------------------------- + +destructor TDirectoryWatch.Destroy; +begin + Active := false; + if not (csDesigning in ComponentState) then + DeallocateHWnd(fWindowHandle); + inherited Destroy; +end; +//---------------------------------------------------------------------------- + +procedure TDirectoryWatch.WndProc(var aMsg: TMessage); +begin + with aMsg do + if Msg = NOTIFYCHANGE_MESSAGE then + begin + if assigned(OnChange) then OnChange(self); + end else + Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam); +end; +//------------------------------------------------------------------------------ + +procedure TDirectoryWatch.SetNotifyFilters(aNotifyFilters: TNotifyFilters); +begin + if aNotifyFilters = fNotifyFilters then exit; + fNotifyFilters := aNotifyFilters; + if assigned(fWatchThread) then + begin + Active := false; + Active := true; + end; +end; +//------------------------------------------------------------------------------ + +procedure TDirectoryWatch.SetWatchSubDirs(aWatchSubDirs: boolean); +begin + if aWatchSubDirs = fWatchSubDirs then exit; + fWatchSubDirs := aWatchSubDirs; + if assigned(fWatchThread) then + begin + Active := false; + Active := true; + end; +end; +//------------------------------------------------------------------------------ + +procedure TDirectoryWatch.SetDirectory(aDir: string); +begin + if aDir = '' then + begin + Active := false; + fDirectory := ''; + exit; + end; + if (aDir[length(aDir)] <> '\') then aDir := aDir + '\'; + if aDir = fDirectory then exit; + if not (csDesigning in ComponentState) and not DirectoryExists(aDir) then + raise Exception.Create( sInvalidDir + aDir); + fDirectory := aDir; + if assigned(fWatchThread) then + fWatchThread.Directory := fDirectory; +end; +//------------------------------------------------------------------------------ + +procedure TDirectoryWatch.SetActive(aActive: boolean); +var + nf: dword; +begin + if aActive = fActive then exit; + fActive := aActive; + if csDesigning in ComponentState then exit; + if fActive then + begin + if not DirectoryExists(fDirectory) then + begin + fActive := false; + raise Exception.Create(sInvalidDir + fDirectory); + end; + nf := 0; + if nfFilename in fNotifyFilters then + nf := nf or FILE_NOTIFY_CHANGE_FILE_NAME; + if nfDirname in fNotifyFilters then + nf := nf or FILE_NOTIFY_CHANGE_DIR_NAME; + if nfAttrib in fNotifyFilters then + nf := nf or FILE_NOTIFY_CHANGE_ATTRIBUTES; + if nfSize in fNotifyFilters then + nf := nf or FILE_NOTIFY_CHANGE_SIZE; + if nfLastWrite in fNotifyFilters then + nf := nf or FILE_NOTIFY_CHANGE_LAST_WRITE; + if nfSecurity in fNotifyFilters then + nf := nf or FILE_NOTIFY_CHANGE_SECURITY; + fWatchThread := TWatchThread.Create( + fWindowHandle, fDirectory, fWatchSubDirs, nf); + end else + begin + fWatchThread.Terminate; + fWatchThread := nil; + end; +end; + +//---------------------------------------------------------------------------- +// TWatchThread methods ... +//---------------------------------------------------------------------------- + +constructor TWatchThread.Create(OwnerHdl: THandle; + const InitialDir: string; WatchSubDirs: boolean; NotifyFilters: dword); +begin + inherited Create(True); + fOwnerHdl := OwnerHdl; + if WatchSubDirs then + cardinal(fWatchSubDirs) := 1 //workaround a Win9x OS issue + else + fWatchSubDirs := false; + FreeOnTerminate := true; + Priority := tpLowest; + fDirectory := InitialDir; + fNotifyFilters := NotifyFilters; + fBreakEvent := windows.CreateEvent(nil, False, False, nil); + Resume; +end; +//------------------------------------------------------------------------------ + +destructor TWatchThread.Destroy; +begin + CloseHandle(fBreakEvent); + inherited Destroy; +end; +//------------------------------------------------------------------------------ + +procedure TWatchThread.SetDirectory(const Value: string); +begin + if (Value = FDirectory) then exit; + FDirectory := Value; + SetEvent(fBreakEvent); +end; +//------------------------------------------------------------------------------ + +procedure TWatchThread.Terminate; +begin + inherited Terminate; + SetEvent(fBreakEvent); + while not fFinished do sleep(10); //avoids a reported resource leak + //if called while closing the application. +end; +//------------------------------------------------------------------------------ + +procedure TWatchThread.Execute; +begin + //OUTER LOOP - manages Directory property reassignments + while (not Terminated) do + begin + fChangeNotify := FindFirstChangeNotification(pchar(fDirectory), + fWatchSubDirs, fNotifyFilters); + if (fChangeNotify = INVALID_HANDLE_VALUE) then + //Can't monitor the specified directory so we'll just wait for + //a new Directory assignment or the thread terminating ... + WaitForSingleObject(fBreakEvent, INFINITE) + else + try + //Now do the INNER loop... + ProcessFilenameChanges; + finally + FindCloseChangeNotification(fChangeNotify); + end; + end; + fFinished := true; +end; +//------------------------------------------------------------------------------ + +procedure TWatchThread.ProcessFilenameChanges; +var + WaitResult : DWORD; + HandleArray : array[0..1] of THandle; +const + TEN_MSECS = 10; + HUNDRED_MSECS = 100; +begin + HandleArray[0] := fBreakEvent; + HandleArray[1] := fChangeNotify; + //INNER LOOP - exits only when fBreakEvent signaled + while (not Terminated) do + begin + //waits for either fChangeNotify or fBreakEvent ... + WaitResult := WaitForMultipleObjects(2, @HandleArray, False, INFINITE); + if (WaitResult = WAIT_OBJECT_0 + 1) then //fChangeNotify + begin + repeat //ie: if a number of files are changing in a block + //just post the one notification message ... + FindNextChangeNotification(fChangeNotify); + until Terminated or + (WaitForSingleObject(fChangeNotify, TEN_MSECS) <> WAIT_OBJECT_0); + if Terminated then break; + //OK, now notify the main thread (before restarting inner loop)... + PostMessage(fOwnerHdl, NOTIFYCHANGE_MESSAGE, 0, 0); + end else //fBreakEvent ... + begin + //If the Directory property is undergoing multiple rapid reassignments + //wait 'til this stops before restarting monitoring of a new directory ... + while (not Terminated) and + (WaitForSingleObject(fBreakEvent, HUNDRED_MSECS) = WAIT_OBJECT_0) do; + break; //EXIT LOOP HERE + end; + end; +end; +//------------------------------------------------------------------------------ +//------------------------------------------------------------------------------ + end.
\ No newline at end of file diff --git a/Game/Code/lib/portaudio/delphi/portaudio.pas b/Game/Code/lib/portaudio/delphi/portaudio.pas index 94516c7a..b5b9f04e 100644 --- a/Game/Code/lib/portaudio/delphi/portaudio.pas +++ b/Game/Code/lib/portaudio/delphi/portaudio.pas @@ -1,1158 +1,1158 @@ -{*
- * $Id: portaudio.h,v 1.7 2007/08/16 20:45:34 richardash1981 Exp $
- * PortAudio Portable Real-Time Audio Library
- * PortAudio API Header File
- * Latest version available at: http://www.portaudio.com/
- *
- * Copyright (c) 1999-2002 Ross Bencina and Phil Burk
- *
- * Permission is hereby granted, free of charge, to any person obtaining
- * a copy of this software and associated documentation files
- * (the "Software"), to deal in the Software without restriction,
- * including without limitation the rights to use, copy, modify, merge,
- * publish, distribute, sublicense, and/or sell copies of the Software,
- * and to permit persons to whom the Software is furnished to do so,
- * subject to the following conditions:
- *
- * The above copyright notice and this permission notice shall be
- * included in all copies or substantial portions of the Software.
- *
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
- * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
- * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
- * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR
- * ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
- * CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
- * WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
- *}
-
-{*
- * The text above constitutes the entire PortAudio license; however,
- * the PortAudio community also makes the following non-binding requests:
- *
- * Any person wishing to distribute modifications to the Software is
- * requested to send the modifications to the original developer so that
- * they can be incorporated into the canonical version. It is also
- * requested that these non-binding requests be included along with the
- * license above.
- *}
-
-{** @file
- @brief The PortAudio API.
-*}
-
-unit portaudio;
-
-{$IFDEF FPC}
- {$PACKRECORDS C} (* GCC/Visual C/C++ compatible record packing *)
- {$MODE DELPHI }
-{$ENDIF}
-
-interface
-
-//uses;
-
-const
-{$IFDEF MSWINDOWS}
- LibName = 'portaudio_x86.dll';
-{$ENDIF}
-{$IFDEF LINUX}
- LibName = 'libportaudio.so';
-{$ENDIF}
-{$IFDEF DARWIN}
-// this is for portaudio version 19
- LibName = 'libportaudio.2.dylib';
- {$LINKLIB libportaudio.2}
-{$ENDIF}
-
-{** Retrieve the release number of the currently running PortAudio build,
- eg 1900.
-*}
-function Pa_GetVersion(): Integer; cdecl; external LibName;
-
-
-{** Retrieve a textual description of the current PortAudio build,
- eg "PortAudio V19-devel 13 October 2002".
-*}
-function Pa_GetVersionText(): PChar; cdecl; external LibName;
-
-
-{** Error codes returned by PortAudio functions.
- Note that with the exception of paNoError, all PaErrorCodes are negative.
-*}
-
-type TPaError = Integer;
-type TPaErrorCode = {enum}Integer; const
-{enum_begin PaErrorCode}
- paNoError = 0;
-
- paNotInitialized = -10000;
- paUnanticipatedHostError = (paNotInitialized+ 1);
- paInvalidChannelCount = (paNotInitialized+ 2);
- paInvalidSampleRate = (paNotInitialized+ 3);
- paInvalidDevice = (paNotInitialized+ 4);
- paInvalidFlag = (paNotInitialized+ 5);
- paSampleFormatNotSupported = (paNotInitialized+ 6);
- paBadIODeviceCombination = (paNotInitialized+ 7);
- paInsufficientMemory = (paNotInitialized+ 8);
- paBufferTooBig = (paNotInitialized+ 9);
- paBufferTooSmall = (paNotInitialized+10);
- paNullCallback = (paNotInitialized+11);
- paBadStreamPtr = (paNotInitialized+12);
- paTimedOut = (paNotInitialized+13);
- paInternalError = (paNotInitialized+14);
- paDeviceUnavailable = (paNotInitialized+15);
- paIncompatibleHostApiSpecificStreamInfo = (paNotInitialized+16);
- paStreamIsStopped = (paNotInitialized+17);
- paStreamIsNotStopped = (paNotInitialized+18);
- paInputOverflowed = (paNotInitialized+19);
- paOutputUnderflowed = (paNotInitialized+20);
- paHostApiNotFound = (paNotInitialized+21);
- paInvalidHostApi = (paNotInitialized+22);
- paCanNotReadFromACallbackStream = (paNotInitialized+23); {**< @todo review error code name *}
- paCanNotWriteToACallbackStream = (paNotInitialized+24); {**< @todo review error code name *}
- paCanNotReadFromAnOutputOnlyStream = (paNotInitialized+25); {**< @todo review error code name *}
- paCanNotWriteToAnInputOnlyStream = (paNotInitialized+26); {**< @todo review error code name *}
- paIncompatibleStreamHostApi = (paNotInitialized+27);
- paBadBufferPtr = (paNotInitialized+28);
-{enum_end PaErrorCode}
-
-
-{** Translate the supplied PortAudio error code into a human readable
- message.
-*}
-function Pa_GetErrorText( errorCode: TPaError ): PChar; cdecl; external LibName;
-
-
-{** Library initialization function - call this before using PortAudio.
- This function initialises internal data structures and prepares underlying
- host APIs for use. With the exception of Pa_GetVersion(), Pa_GetVersionText(),
- and Pa_GetErrorText(), this function MUST be called before using any other
- PortAudio API functions.
-
- If Pa_Initialize() is called multiple times, each successful
- call must be matched with a corresponding call to Pa_Terminate().
- Pairs of calls to Pa_Initialize()/Pa_Terminate() may overlap, and are not
- required to be fully nested.
-
- Note that if Pa_Initialize() returns an error code, Pa_Terminate() should
- NOT be called.
-
- @return paNoError if successful, otherwise an error code indicating the cause
- of failure.
-
- @see Pa_Terminate
-*}
-function Pa_Initialize(): TPaError; cdecl; external LibName;
-
-
-{** Library termination function - call this when finished using PortAudio.
- This function deallocates all resources allocated by PortAudio since it was
- initializied by a call to Pa_Initialize(). In cases where Pa_Initialise() has
- been called multiple times, each call must be matched with a corresponding call
- to Pa_Terminate(). The final matching call to Pa_Terminate() will automatically
- close any PortAudio streams that are still open.
-
- Pa_Terminate() MUST be called before exiting a program which uses PortAudio.
- Failure to do so may result in serious resource leaks, such as audio devices
- not being available until the next reboot.
-
- @return paNoError if successful, otherwise an error code indicating the cause
- of failure.
-
- @see Pa_Initialize
-*}
-function Pa_Terminate(): TPaError; cdecl; external LibName;
-
-
-
-{** The type used to refer to audio devices. Values of this type usually
- range from 0 to (Pa_GetDeviceCount()-1), and may also take on the PaNoDevice
- and paUseHostApiSpecificDeviceSpecification values.
-
- @see Pa_GetDeviceCount, paNoDevice, paUseHostApiSpecificDeviceSpecification
-*}
-type TPaDeviceIndex = Integer;
-
-
-{** A special PaDeviceIndex value indicating that no device is available,
- or should be used.
-
- @see PaDeviceIndex
-*}
-const paNoDevice = TPaDeviceIndex(-1);
-
-
-{** A special PaDeviceIndex value indicating that the device(s) to be used
- are specified in the host api specific stream info structure.
-
- @see PaDeviceIndex
-*}
-const paUseHostApiSpecificDeviceSpecification = TPaDeviceIndex(-2);
-
-
-{* Host API enumeration mechanism *}
-
-{** The type used to enumerate to host APIs at runtime. Values of this type
- range from 0 to (Pa_GetHostApiCount()-1).
-
- @see Pa_GetHostApiCount
-*}
-type TPaHostApiIndex = Integer;
-
-{** Retrieve the number of available host APIs. Even if a host API is
- available it may have no devices available.
-
- @return A non-negative value indicating the number of available host APIs
- or, a PaErrorCode (which are always negative) if PortAudio is not initialized
- or an error is encountered.
-
- @see PaHostApiIndex
-*}
-function Pa_GetHostApiCount(): TPaHostApiIndex; cdecl; external LibName;
-
-
-{** Retrieve the index of the default host API. The default host API will be
- the lowest common denominator host API on the current platform and is
- unlikely to provide the best performance.
-
- @return A non-negative value ranging from 0 to (Pa_GetHostApiCount()-1)
- indicating the default host API index or, a PaErrorCode (which are always
- negative) if PortAudio is not initialized or an error is encountered.
-*}
-function Pa_GetDefaultHostApi(): TPaHostApiIndex; cdecl; external LibName;
-
-
-{** Unchanging unique identifiers for each supported host API. This type
- is used in the PaHostApiInfo structure. The values are guaranteed to be
- unique and to never change, thus allowing code to be written that
- conditionally uses host API specific extensions.
-
- New type ids will be allocated when support for a host API reaches
- "public alpha" status, prior to that developers should use the
- paInDevelopment type id.
-
- @see PaHostApiInfo
-*}
-type TPaHostApiTypeId = {enum}Integer; const
-{enum_begin PaHostApiTypeId}
- paInDevelopment=0; {* use while developing support for a new host API *}
- paDirectSound=1;
- paMME=2;
- paASIO=3;
- paSoundManager=4;
- paCoreAudio=5;
- paOSS=7;
- paALSA=8;
- paAL=9;
- paBeOS=10;
- paWDMKS=11;
- paJACK=12;
- paWASAPI=13;
- paAudioScienceHPI=14;
-{enum_end PaHostApiTypeId}
-
-{** A structure containing information about a particular host API. *}
-
-type
- PPaHostApiInfo = ^TPaHostApiInfo;
- TPaHostApiInfo = record
- {** this is struct version 1 *}
- structVersion: Integer;
- {** The well known unique identifier of this host API @see PaHostApiTypeId *}
- _type: TPaHostApiTypeId;
- {** A textual description of the host API for display on user interfaces. *}
- name: PChar;
-
- {** The number of devices belonging to this host API. This field may be
- used in conjunction with Pa_HostApiDeviceIndexToDeviceIndex() to enumerate
- all devices for this host API.
- @see Pa_HostApiDeviceIndexToDeviceIndex
- *}
- deviceCount: Integer;
-
- {** The default input device for this host API. The value will be a
- device index ranging from 0 to (Pa_GetDeviceCount()-1), or paNoDevice
- if no default input device is available.
- *}
- defaultInputDevice: TPaDeviceIndex;
-
- {** The default output device for this host API. The value will be a
- device index ranging from 0 to (Pa_GetDeviceCount()-1), or paNoDevice
- if no default output device is available.
- *}
- defaultOutputDevice: TPaDeviceIndex;
- end;
-
-
-{** Retrieve a pointer to a structure containing information about a specific
- host Api.
-
- @param hostApi A valid host API index ranging from 0 to (Pa_GetHostApiCount()-1)
-
- @return A pointer to an immutable PaHostApiInfo structure describing
- a specific host API. If the hostApi parameter is out of range or an error
- is encountered, the function returns NULL.
-
- The returned structure is owned by the PortAudio implementation and must not
- be manipulated or freed. The pointer is only guaranteed to be valid between
- calls to Pa_Initialize() and Pa_Terminate().
-*}
-function Pa_GetHostApiInfo( hostApi: TPaHostApiIndex ): PPaHostApiInfo; cdecl; external LibName;
-
-
-{** Convert a static host API unique identifier, into a runtime
- host API index.
-
- @param type A unique host API identifier belonging to the PaHostApiTypeId
- enumeration.
-
- @return A valid PaHostApiIndex ranging from 0 to (Pa_GetHostApiCount()-1) or,
- a PaErrorCode (which are always negative) if PortAudio is not initialized
- or an error is encountered.
-
- The paHostApiNotFound error code indicates that the host API specified by the
- type parameter is not available.
-
- @see PaHostApiTypeId
-*}
-function Pa_HostApiTypeIdToHostApiIndex( _type: TPaHostApiTypeId ): TPaHostApiIndex; cdecl; external LibName;
-
-
-{** Convert a host-API-specific device index to standard PortAudio device index.
- This function may be used in conjunction with the deviceCount field of
- PaHostApiInfo to enumerate all devices for the specified host API.
-
- @param hostApi A valid host API index ranging from 0 to (Pa_GetHostApiCount()-1)
-
- @param hostApiDeviceIndex A valid per-host device index in the range
- 0 to (Pa_GetHostApiInfo(hostApi)->deviceCount-1)
-
- @return A non-negative PaDeviceIndex ranging from 0 to (Pa_GetDeviceCount()-1)
- or, a PaErrorCode (which are always negative) if PortAudio is not initialized
- or an error is encountered.
-
- A paInvalidHostApi error code indicates that the host API index specified by
- the hostApi parameter is out of range.
-
- A paInvalidDevice error code indicates that the hostApiDeviceIndex parameter
- is out of range.
-
- @see PaHostApiInfo
-*}
-function Pa_HostApiDeviceIndexToDeviceIndex( hostApi: TPaHostApiIndex;
- hostApiDeviceIndex: Integer ): TPaDeviceIndex; cdecl; external LibName;
-
-
-
-{** Structure used to return information about a host error condition.
-*}
-type
- PPaHostErrorInfo = ^TPaHostErrorInfo;
- TPaHostErrorInfo = record
- hostApiType: TPaHostApiTypeId; {**< the host API which returned the error code *}
- errorCode: Longint; {**< the error code returned *}
- errorText: PChar; {**< a textual description of the error if available, otherwise a zero-length string *}
- end;
-
-
-{** Return information about the last host error encountered. The error
- information returned by Pa_GetLastHostErrorInfo() will never be modified
- asyncronously by errors occurring in other PortAudio owned threads
- (such as the thread that manages the stream callback.)
-
- This function is provided as a last resort, primarily to enhance debugging
- by providing clients with access to all available error information.
-
- @return A pointer to an immutable structure constaining information about
- the host error. The values in this structure will only be valid if a
- PortAudio function has previously returned the paUnanticipatedHostError
- error code.
-*}
-function Pa_GetLastHostErrorInfo(): PPaHostErrorInfo; cdecl; external LibName;
-
-
-
-{* Device enumeration and capabilities *}
-
-{** Retrieve the number of available devices. The number of available devices
- may be zero.
-
- @return A non-negative value indicating the number of available devices or,
- a PaErrorCode (which are always negative) if PortAudio is not initialized
- or an error is encountered.
-*}
-function Pa_GetDeviceCount(): TPaDeviceIndex; cdecl; external LibName;
-
-
-{** Retrieve the index of the default input device. The result can be
- used in the inputDevice parameter to Pa_OpenStream().
-
- @return The default input device index for the default host API, or paNoDevice
- if no default input device is available or an error was encountered.
-*}
-function Pa_GetDefaultInputDevice(): TPaDeviceIndex; cdecl; external LibName;
-
-
-{** Retrieve the index of the default output device. The result can be
- used in the outputDevice parameter to Pa_OpenStream().
-
- @return The default output device index for the defualt host API, or paNoDevice
- if no default output device is available or an error was encountered.
-
- @note
- On the PC, the user can specify a default device by
- setting an environment variable. For example, to use device #1.
-<pre>
- set PA_RECOMMENDED_OUTPUT_DEVICE=1
-</pre>
- The user should first determine the available device ids by using
- the supplied application "pa_devs".
-*}
-function Pa_GetDefaultOutputDevice(): TPaDeviceIndex; cdecl; external LibName;
-
-
-{** The type used to represent monotonic time in seconds that can be used
- for syncronisation. The type is used for the outTime argument to the
- PaStreamCallback and as the result of Pa_GetStreamTime().
-
- @see PaStreamCallback, Pa_GetStreamTime
-*}
-type TPaTime = Double;
-
-
-{** A type used to specify one or more sample formats. Each value indicates
- a possible format for sound data passed to and from the stream callback,
- Pa_ReadStream and Pa_WriteStream.
-
- The standard formats paFloat32, paInt16, paInt32, paInt24, paInt8
- and aUInt8 are usually implemented by all implementations.
-
- The floating point representation (paFloat32) uses +1.0 and -1.0 as the
- maximum and minimum respectively.
-
- paUInt8 is an unsigned 8 bit format where 128 is considered "ground"
-
- The paNonInterleaved flag indicates that a multichannel buffer is passed
- as a set of non-interleaved pointers.
-
- @see Pa_OpenStream, Pa_OpenDefaultStream, PaDeviceInfo
- @see paFloat32, paInt16, paInt32, paInt24, paInt8
- @see paUInt8, paCustomFormat, paNonInterleaved
-*}
-type TPaSampleFormat = Longword;
-const
- paFloat32 = TPaSampleFormat($00000001); {**< @see PaSampleFormat *}
- paInt32 = TPaSampleFormat($00000002); {**< @see PaSampleFormat *}
- paInt24 = TPaSampleFormat($00000004); {**< Packed 24 bit format. @see PaSampleFormat *}
- paInt16 = TPaSampleFormat($00000008); {**< @see PaSampleFormat *}
- paInt8 = TPaSampleFormat($00000010); {**< @see PaSampleFormat *}
- paUInt8 = TPaSampleFormat($00000020); {**< @see PaSampleFormat *}
- paCustomFormat = TPaSampleFormat($00010000); {**< @see PaSampleFormat *}
- paNonInterleaved = TPaSampleFormat($80000000);
-
-{** A structure providing information and capabilities of PortAudio devices.
- Devices may support input, output or both input and output.
-*}
-type
- PPaDeviceInfo = ^TPaDeviceInfo;
- TPaDeviceInfo = record
- structVersion: Integer; {* this is struct version 2 *}
- name: PChar;
- hostApi: TPaHostApiIndex; {* note this is a host API index, not a type id*}
-
- maxInputChannels: Integer;
- maxOutputChannels: Integer;
-
- {* Default latency values for interactive performance. *}
- defaultLowInputLatency: TPaTime;
- defaultLowOutputLatency: TPaTime;
- {* Default latency values for robust non-interactive applications (eg. playing sound files). *}
- defaultHighInputLatency: TPaTime;
- defaultHighOutputLatency: TPaTime;
-
- defaultSampleRate: Double;
- end;
-
-
-{** Retrieve a pointer to a PaDeviceInfo structure containing information
- about the specified device.
- @return A pointer to an immutable PaDeviceInfo structure. If the device
- parameter is out of range the function returns NULL.
-
- @param device A valid device index in the range 0 to (Pa_GetDeviceCount()-1)
-
- @note PortAudio manages the memory referenced by the returned pointer,
- the client must not manipulate or free the memory. The pointer is only
- guaranteed to be valid between calls to Pa_Initialize() and Pa_Terminate().
-
- @see PaDeviceInfo, PaDeviceIndex
-*}
-function Pa_GetDeviceInfo( device: TPaDeviceIndex ): PPaDeviceInfo; cdecl; external LibName;
-
-
-{** Parameters for one direction (input or output) of a stream.
-*}
-type
- PPaStreamParameters = ^TPaStreamParameters;
- TPaStreamParameters = record
- {** A valid device index in the range 0 to (Pa_GetDeviceCount()-1)
- specifying the device to be used or the special constant
- paUseHostApiSpecificDeviceSpecification which indicates that the actual
- device(s) to use are specified in hostApiSpecificStreamInfo.
- This field must not be set to paNoDevice.
- *}
- device: TPaDeviceIndex;
-
- {** The number of channels of sound to be delivered to the
- stream callback or accessed by Pa_ReadStream() or Pa_WriteStream().
- It can range from 1 to the value of maxInputChannels in the
- PaDeviceInfo record for the device specified by the device parameter.
- *}
- channelCount: Integer;
-
- {** The sample format of the buffer provided to the stream callback,
- a_ReadStream() or Pa_WriteStream(). It may be any of the formats described
- by the PaSampleFormat enumeration.
- *}
- sampleFormat: TPaSampleFormat;
-
- {** The desired latency in seconds. Where practical, implementations should
- configure their latency based on these parameters, otherwise they may
- choose the closest viable latency instead. Unless the suggested latency
- is greater than the absolute upper limit for the device implementations
- should round the suggestedLatency up to the next practial value - ie to
- provide an equal or higher latency than suggestedLatency wherever possibe.
- Actual latency values for an open stream may be retrieved using the
- inputLatency and outputLatency fields of the PaStreamInfo structure
- returned by Pa_GetStreamInfo().
- @see default*Latency in PaDeviceInfo, *Latency in PaStreamInfo
- *}
- suggestedLatency: TPaTime;
-
- {** An optional pointer to a host api specific data structure
- containing additional information for device setup and/or stream processing.
- hostApiSpecificStreamInfo is never required for correct operation,
- if not used it should be set to NULL.
- *}
- hostApiSpecificStreamInfo: Pointer;
- end;
-
-
-{** Return code for Pa_IsFormatSupported indicating success. *}
-const paFormatIsSupported = (0);
-
-{** Determine whether it would be possible to open a stream with the specified
- parameters.
-
- @param inputParameters A structure that describes the input parameters used to
- open a stream. The suggestedLatency field is ignored. See PaStreamParameters
- for a description of these parameters. inputParameters must be NULL for
- output-only streams.
-
- @param outputParameters A structure that describes the output parameters used
- to open a stream. The suggestedLatency field is ignored. See PaStreamParameters
- for a description of these parameters. outputParameters must be NULL for
- input-only streams.
-
- @param sampleRate The required sampleRate. For full-duplex streams it is the
- sample rate for both input and output
-
- @return Returns 0 if the format is supported, and an error code indicating why
- the format is not supported otherwise. The constant paFormatIsSupported is
- provided to compare with the return value for success.
-
- @see paFormatIsSupported, PaStreamParameters
-*}
-function Pa_IsFormatSupported( inputParameters: PPaStreamParameters;
- outputParameters: PPaStreamParameters;
- sampleRate: Double ): TPaError; cdecl; external LibName;
-
-
-
-{* Streaming types and functions *}
-
-
-{**
- A single PaStream can provide multiple channels of real-time
- streaming audio input and output to a client application. A stream
- provides access to audio hardware represented by one or more
- PaDevices. Depending on the underlying Host API, it may be possible
- to open multiple streams using the same device, however this behavior
- is implementation defined. Portable applications should assume that
- a PaDevice may be simultaneously used by at most one PaStream.
-
- Pointers to PaStream objects are passed between PortAudio functions that
- operate on streams.
-
- @see Pa_OpenStream, Pa_OpenDefaultStream, Pa_OpenDefaultStream, Pa_CloseStream,
- Pa_StartStream, Pa_StopStream, Pa_AbortStream, Pa_IsStreamActive,
- Pa_GetStreamTime, Pa_GetStreamCpuLoad
-
-*}
-type
- PPaStream = Pointer;
-
-{** Can be passed as the framesPerBuffer parameter to Pa_OpenStream()
- or Pa_OpenDefaultStream() to indicate that the stream callback will
- accept buffers of any size.
-*}
-const paFramesPerBufferUnspecified = (0);
-
-
-{** Flags used to control the behavior of a stream. They are passed as
- parameters to Pa_OpenStream or Pa_OpenDefaultStream. Multiple flags may be
- ORed together.
-
- @see Pa_OpenStream, Pa_OpenDefaultStream
- @see paNoFlag, paClipOff, paDitherOff, paNeverDropInput,
- paPrimeOutputBuffersUsingStreamCallback, paPlatformSpecificFlags
-*}
-type TPaStreamFlags = Longword;
-
-{** @see PaStreamFlags *}
-const paNoFlag = TPaStreamFlags(0);
-
-{** Disable default clipping of out of range samples.
- @see PaStreamFlags
-*}
-const paClipOff = TPaStreamFlags($00000001);
-
-{** Disable default dithering.
- @see PaStreamFlags
-*}
-const paDitherOff = TPaStreamFlags($00000002);
-
-{** Flag requests that where possible a full duplex stream will not discard
- overflowed input samples without calling the stream callback. This flag is
- only valid for full duplex callback streams and only when used in combination
- with the paFramesPerBufferUnspecified (0) framesPerBuffer parameter. Using
- this flag incorrectly results in a paInvalidFlag error being returned from
- Pa_OpenStream and Pa_OpenDefaultStream.
-
- @see PaStreamFlags, paFramesPerBufferUnspecified
-*}
-const paNeverDropInput = TPaStreamFlags($00000004);
-
-{** Call the stream callback to fill initial output buffers, rather than the
- default behavior of priming the buffers with zeros (silence). This flag has
- no effect for input-only and blocking read/write streams.
-
- @see PaStreamFlags
-*}
-const paPrimeOutputBuffersUsingStreamCallback = TPaStreamFlags($00000008);
-
-{** A mask specifying the platform specific bits.
- @see PaStreamFlags
-*}
-const paPlatformSpecificFlags = TPaStreamFlags($FFFF0000);
-
-{**
- Timing information for the buffers passed to the stream callback.
-*}
-type
- PPaStreamCallbackTimeInfo = ^TPaStreamCallbackTimeInfo;
- TPaStreamCallbackTimeInfo = record
- inputBufferAdcTime: TPaTime;
- currentTime: TPaTime;
- outputBufferDacTime: TPaTime;
- end;
-
-
-{**
- Flag bit constants for the statusFlags to PaStreamCallback.
-
- @see paInputUnderflow, paInputOverflow, paOutputUnderflow, paOutputOverflow,
- paPrimingOutput
-*}
-type TPaStreamCallbackFlags = Longword;
-
-{** In a stream opened with paFramesPerBufferUnspecified, indicates that
- input data is all silence (zeros) because no real data is available. In a
- stream opened without paFramesPerBufferUnspecified, it indicates that one or
- more zero samples have been inserted into the input buffer to compensate
- for an input underflow.
- @see PaStreamCallbackFlags
-*}
-const paInputUnderflow = TPaStreamCallbackFlags($00000001);
-
-{** In a stream opened with paFramesPerBufferUnspecified, indicates that data
- prior to the first sample of the input buffer was discarded due to an
- overflow, possibly because the stream callback is using too much CPU time.
- Otherwise indicates that data prior to one or more samples in the
- input buffer was discarded.
- @see PaStreamCallbackFlags
-*}
-const paInputOverflow = TPaStreamCallbackFlags($00000002);
-
-{** Indicates that output data (or a gap) was inserted, possibly because the
- stream callback is using too much CPU time.
- @see PaStreamCallbackFlags
-*}
-const paOutputUnderflow = TPaStreamCallbackFlags($00000004);
-
-{** Indicates that output data will be discarded because no room is available.
- @see PaStreamCallbackFlags
-*}
-const paOutputOverflow = TPaStreamCallbackFlags($00000008);
-
-{** Some of all of the output data will be used to prime the stream, input
- data may be zero.
- @see PaStreamCallbackFlags
-*}
-const paPrimingOutput = TPaStreamCallbackFlags($00000010);
-
-{**
- Allowable return values for the PaStreamCallback.
- @see PaStreamCallback
-*}
-type TPaStreamCallbackResult = {enum}Integer; const
-{enum_begin PaStreamCallbackResult}
- paContinue=0;
- paComplete=1;
- paAbort=2;
-{enum_end PaStreamCallbackResult}
-
-{**
- Functions of type PaStreamCallback are implemented by PortAudio clients.
- They consume, process or generate audio in response to requests from an
- active PortAudio stream.
-
- @param input and @param output are arrays of interleaved samples,
- the format, packing and number of channels used by the buffers are
- determined by parameters to Pa_OpenStream().
-
- @param frameCount The number of sample frames to be processed by
- the stream callback.
-
- @param timeInfo The time in seconds when the first sample of the input
- buffer was received at the audio input, the time in seconds when the first
- sample of the output buffer will begin being played at the audio output, and
- the time in seconds when the stream callback was called.
- See also Pa_GetStreamTime()
-
- @param statusFlags Flags indicating whether input and/or output buffers
- have been inserted or will be dropped to overcome underflow or overflow
- conditions.
-
- @param userData The value of a user supplied pointer passed to
- Pa_OpenStream() intended for storing synthesis data etc.
-
- @return
- The stream callback should return one of the values in the
- PaStreamCallbackResult enumeration. To ensure that the callback continues
- to be called, it should return paContinue (0). Either paComplete or paAbort
- can be returned to finish stream processing, after either of these values is
- returned the callback will not be called again. If paAbort is returned the
- stream will finish as soon as possible. If paComplete is returned, the stream
- will continue until all buffers generated by the callback have been played.
- This may be useful in applications such as soundfile players where a specific
- duration of output is required. However, it is not necessary to utilise this
- mechanism as Pa_StopStream(), Pa_AbortStream() or Pa_CloseStream() can also
- be used to stop the stream. The callback must always fill the entire output
- buffer irrespective of its return value.
-
- @see Pa_OpenStream, Pa_OpenDefaultStream
-
- @note With the exception of Pa_GetStreamCpuLoad() it is not permissable to call
- PortAudio API functions from within the stream callback.
-*}
-type
- PPaStreamCallback = ^TPaStreamCallback;
- TPaStreamCallback = function(
- input: Pointer; output: Pointer;
- frameCount: Longword;
- timeInfo: PPaStreamCallbackTimeInfo;
- statusFlags: TPaStreamCallbackFlags;
- userData: Pointer ): Integer; cdecl;
-
-
-{** Opens a stream for either input, output or both.
-
- @param stream The address of a PaStream pointer which will receive
- a pointer to the newly opened stream.
-
- @param inputParameters A structure that describes the input parameters used by
- the opened stream. See PaStreamParameters for a description of these parameters.
- inputParameters must be NULL for output-only streams.
-
- @param outputParameters A structure that describes the output parameters used by
- the opened stream. See PaStreamParameters for a description of these parameters.
- outputParameters must be NULL for input-only streams.
-
- @param sampleRate The desired sampleRate. For full-duplex streams it is the
- sample rate for both input and output
-
- @param framesPerBuffer The number of frames passed to the stream callback
- function, or the preferred block granularity for a blocking read/write stream.
- The special value paFramesPerBufferUnspecified (0) may be used to request that
- the stream callback will recieve an optimal (and possibly varying) number of
- frames based on host requirements and the requested latency settings.
- Note: With some host APIs, the use of non-zero framesPerBuffer for a callback
- stream may introduce an additional layer of buffering which could introduce
- additional latency. PortAudio guarantees that the additional latency
- will be kept to the theoretical minimum however, it is strongly recommended
- that a non-zero framesPerBuffer value only be used when your algorithm
- requires a fixed number of frames per stream callback.
-
- @param streamFlags Flags which modify the behaviour of the streaming process.
- This parameter may contain a combination of flags ORed together. Some flags may
- only be relevant to certain buffer formats.
-
- @param streamCallback A pointer to a client supplied function that is responsible
- for processing and filling input and output buffers. If this parameter is NULL
- the stream will be opened in 'blocking read/write' mode. In blocking mode,
- the client can receive sample data using Pa_ReadStream and write sample data
- using Pa_WriteStream, the number of samples that may be read or written
- without blocking is returned by Pa_GetStreamReadAvailable and
- Pa_GetStreamWriteAvailable respectively.
-
- @param userData A client supplied pointer which is passed to the stream callback
- function. It could for example, contain a pointer to instance data necessary
- for processing the audio buffers. This parameter is ignored if streamCallback
- is NULL.
-
- @return
- Upon success Pa_OpenStream() returns paNoError and places a pointer to a
- valid PaStream in the stream argument. The stream is inactive (stopped).
- If a call to Pa_OpenStream() fails, a non-zero error code is returned (see
- PaError for possible error codes) and the value of stream is invalid.
-
- @see PaStreamParameters, PaStreamCallback, Pa_ReadStream, Pa_WriteStream,
- Pa_GetStreamReadAvailable, Pa_GetStreamWriteAvailable
-*}
-function Pa_OpenStream( var stream: PPaStream;
- inputParameters: PPaStreamParameters;
- outputParameters: PPaStreamParameters;
- sampleRate: Double;
- framesPerBuffer: Longword;
- streamFlags: TPaStreamFlags;
- streamCallback: PPaStreamCallback;
- userData: Pointer ): TPaError; cdecl; external LibName;
-
-
-{** A simplified version of Pa_OpenStream() that opens the default input
- and/or output devices.
-
- @param stream The address of a PaStream pointer which will receive
- a pointer to the newly opened stream.
-
- @param numInputChannels The number of channels of sound that will be supplied
- to the stream callback or returned by Pa_ReadStream. It can range from 1 to
- the value of maxInputChannels in the PaDeviceInfo record for the default input
- device. If 0 the stream is opened as an output-only stream.
-
- @param numOutputChannels The number of channels of sound to be delivered to the
- stream callback or passed to Pa_WriteStream. It can range from 1 to the value
- of maxOutputChannels in the PaDeviceInfo record for the default output dvice.
- If 0 the stream is opened as an output-only stream.
-
- @param sampleFormat The sample format of both the input and output buffers
- provided to the callback or passed to and from Pa_ReadStream and Pa_WriteStream.
- sampleFormat may be any of the formats described by the PaSampleFormat
- enumeration.
-
- @param sampleRate Same as Pa_OpenStream parameter of the same name.
- @param framesPerBuffer Same as Pa_OpenStream parameter of the same name.
- @param streamCallback Same as Pa_OpenStream parameter of the same name.
- @param userData Same as Pa_OpenStream parameter of the same name.
-
- @return As for Pa_OpenStream
-
- @see Pa_OpenStream, PaStreamCallback
-*}
-function Pa_OpenDefaultStream( var stream: PPaStream;
- numInputChannels: Integer;
- numOutputChannels: Integer;
- sampleFormat: TPaSampleFormat;
- sampleRate: Double;
- framesPerBuffer: Longword;
- streamCallback: PPaStreamCallback;
- userData: Pointer ): TPaError; cdecl; external LibName;
-
-
-{** Closes an audio stream. If the audio stream is active it
- discards any pending buffers as if Pa_AbortStream() had been called.
-*}
-function Pa_CloseStream( stream: PPaStream ): TPaError; cdecl; external LibName;
-
-
-{** Functions of type PaStreamFinishedCallback are implemented by PortAudio
- clients. They can be registered with a stream using the Pa_SetStreamFinishedCallback
- function. Once registered they are called when the stream becomes inactive
- (ie once a call to Pa_StopStream() will not block).
- A stream will become inactive after the stream callback returns non-zero,
- or when Pa_StopStream or Pa_AbortStream is called. For a stream providing audio
- output, if the stream callback returns paComplete, or Pa_StopStream is called,
- the stream finished callback will not be called until all generated sample data
- has been played.
-
- @param userData The userData parameter supplied to Pa_OpenStream()
-
- @see Pa_SetStreamFinishedCallback
-*}
-type
- PPaStreamFinishedCallback = ^TPaStreamFinishedCallback;
- TPaStreamFinishedCallback = procedure( userData: Pointer ); cdecl;
-
-
-{** Register a stream finished callback function which will be called when the
- stream becomes inactive. See the description of PaStreamFinishedCallback for
- further details about when the callback will be called.
-
- @param stream a pointer to a PaStream that is in the stopped state - if the
- stream is not stopped, the stream's finished callback will remain unchanged
- and an error code will be returned.
-
- @param streamFinishedCallback a pointer to a function with the same signature
- as PaStreamFinishedCallback, that will be called when the stream becomes
- inactive. Passing NULL for this parameter will un-register a previously
- registered stream finished callback function.
-
- @return on success returns paNoError, otherwise an error code indicating the cause
- of the error.
-
- @see PaStreamFinishedCallback
-*}
-function Pa_SetStreamFinishedCallback( stream: PPaStream;
- streamFinishedCallback: PPaStreamFinishedCallback ): TPaError; cdecl; external LibName;
-
-
-{** Commences audio processing.
-*}
-function Pa_StartStream( stream: PPaStream ): TPaError; cdecl; external LibName;
-
-
-{** Terminates audio processing. It waits until all pending
- audio buffers have been played before it returns.
-*}
-function Pa_StopStream( stream: PPaStream ): TPaError; cdecl; external LibName;
-
-
-{** Terminates audio processing immediately without waiting for pending
- buffers to complete.
-*}
-function Pa_AbortStream( stream: PPaStream ): TPaError; cdecl; external LibName;
-
-
-{** Determine whether the stream is stopped.
- A stream is considered to be stopped prior to a successful call to
- Pa_StartStream and after a successful call to Pa_StopStream or Pa_AbortStream.
- If a stream callback returns a value other than paContinue the stream is NOT
- considered to be stopped.
-
- @return Returns one (1) when the stream is stopped, zero (0) when
- the stream is running or, a PaErrorCode (which are always negative) if
- PortAudio is not initialized or an error is encountered.
-
- @see Pa_StopStream, Pa_AbortStream, Pa_IsStreamActive
-*}
-function Pa_IsStreamStopped( stream: PPaStream ): TPaError; cdecl; external LibName;
-
-
-{** Determine whether the stream is active.
- A stream is active after a successful call to Pa_StartStream(), until it
- becomes inactive either as a result of a call to Pa_StopStream() or
- Pa_AbortStream(), or as a result of a return value other than paContinue from
- the stream callback. In the latter case, the stream is considered inactive
- after the last buffer has finished playing.
-
- @return Returns one (1) when the stream is active (ie playing or recording
- audio), zero (0) when not playing or, a PaErrorCode (which are always negative)
- if PortAudio is not initialized or an error is encountered.
-
- @see Pa_StopStream, Pa_AbortStream, Pa_IsStreamStopped
-*}
-function Pa_IsStreamActive( stream: PPaStream ): TPaError; cdecl; external LibName;
-
-
-
-{** A structure containing unchanging information about an open stream.
- @see Pa_GetStreamInfo
-*}
-type
- PPaStreamInfo = ^TPaStreamInfo;
- TPaStreamInfo = record
- {** this is struct version 1 *}
- structVersion: Integer;
-
- {** The input latency of the stream in seconds. This value provides the most
- accurate estimate of input latency available to the implementation. It may
- differ significantly from the suggestedLatency value passed to Pa_OpenStream().
- The value of this field will be zero (0.) for output-only streams.
- @see PaTime
- *}
- inputLatency: TPaTime;
-
- {** The output latency of the stream in seconds. This value provides the most
- accurate estimate of output latency available to the implementation. It may
- differ significantly from the suggestedLatency value passed to Pa_OpenStream().
- The value of this field will be zero (0.) for input-only streams.
- @see PaTime
- *}
- outputLatency: TPaTime;
-
- {** The sample rate of the stream in Hertz (samples per second). In cases
- where the hardware sample rate is inaccurate and PortAudio is aware of it,
- the value of this field may be different from the sampleRate parameter
- passed to Pa_OpenStream(). If information about the actual hardware sample
- rate is not available, this field will have the same value as the sampleRate
- parameter passed to Pa_OpenStream().
- *}
- sampleRate: Double;
- end;
-
-
-{** Retrieve a pointer to a PaStreamInfo structure containing information
- about the specified stream.
- @return A pointer to an immutable PaStreamInfo structure. If the stream
- parameter invalid, or an error is encountered, the function returns NULL.
-
- @param stream A pointer to an open stream previously created with Pa_OpenStream.
-
- @note PortAudio manages the memory referenced by the returned pointer,
- the client must not manipulate or free the memory. The pointer is only
- guaranteed to be valid until the specified stream is closed.
-
- @see PaStreamInfo
-*}
-function Pa_GetStreamInfo( stream: PPaStream ): PPaStreamInfo; cdecl; external LibName;
-
-
-{** Determine the current time for the stream according to the same clock used
- to generate buffer timestamps. This time may be used for syncronising other
- events to the audio stream, for example synchronizing audio to MIDI.
-
- @return The stream's current time in seconds, or 0 if an error occurred.
-
- @see PaTime, PaStreamCallback
-*}
-function Pa_GetStreamTime( stream: PPaStream ): TPaTime; cdecl; external LibName;
-
-
-{** Retrieve CPU usage information for the specified stream.
- The "CPU Load" is a fraction of total CPU time consumed by a callback stream's
- audio processing routines including, but not limited to the client supplied
- stream callback. This function does not work with blocking read/write streams.
-
- This function may be called from the stream callback function or the
- application.
-
- @return
- A floating point value, typically between 0.0 and 1.0, where 1.0 indicates
- that the stream callback is consuming the maximum number of CPU cycles possible
- to maintain real-time operation. A value of 0.5 would imply that PortAudio and
- the stream callback was consuming roughly 50% of the available CPU time. The
- return value may exceed 1.0. A value of 0.0 will always be returned for a
- blocking read/write stream, or if an error occurrs.
-*}
-function Pa_GetStreamCpuLoad( stream: PPaStream ): Double; cdecl; external LibName;
-
-
-{** Read samples from an input stream. The function doesn't return until
- the entire buffer has been filled - this may involve waiting for the operating
- system to supply the data.
-
- @param stream A pointer to an open stream previously created with Pa_OpenStream.
-
- @param buffer A pointer to a buffer of sample frames. The buffer contains
- samples in the format specified by the inputParameters->sampleFormat field
- used to open the stream, and the number of channels specified by
- inputParameters->numChannels. If non-interleaved samples were requested,
- buffer is a pointer to the first element of an array of non-interleaved
- buffer pointers, one for each channel.
-
- @param frames The number of frames to be read into buffer. This parameter
- is not constrained to a specific range, however high performance applications
- will want to match this parameter to the framesPerBuffer parameter used
- when opening the stream.
-
- @return On success PaNoError will be returned, or PaInputOverflowed if input
- data was discarded by PortAudio after the previous call and before this call.
-*}
-function Pa_ReadStream( stream: PPaStream;
- buffer: Pointer;
- frames: Longword ): TPaError; cdecl; external LibName;
-
-
-{** Write samples to an output stream. This function doesn't return until the
- entire buffer has been consumed - this may involve waiting for the operating
- system to consume the data.
-
- @param stream A pointer to an open stream previously created with Pa_OpenStream.
-
- @param buffer A pointer to a buffer of sample frames. The buffer contains
- samples in the format specified by the outputParameters->sampleFormat field
- used to open the stream, and the number of channels specified by
- outputParameters->numChannels. If non-interleaved samples were requested,
- buffer is a pointer to the first element of an array of non-interleaved
- buffer pointers, one for each channel.
-
- @param frames The number of frames to be written from buffer. This parameter
- is not constrained to a specific range, however high performance applications
- will want to match this parameter to the framesPerBuffer parameter used
- when opening the stream.
-
- @return On success PaNoError will be returned, or paOutputUnderflowed if
- additional output data was inserted after the previous call and before this
- call.
-*}
-function Pa_WriteStream( stream: PPaStream;
- buffer: Pointer;
- frames: Longword ): TPaError; cdecl; external LibName;
-
-
-{** Retrieve the number of frames that can be read from the stream without
- waiting.
-
- @return Returns a non-negative value representing the maximum number of frames
- that can be read from the stream without blocking or busy waiting or, a
- PaErrorCode (which are always negative) if PortAudio is not initialized or an
- error is encountered.
-*}
-function Pa_GetStreamReadAvailable( stream: PPaStream ): Longint; cdecl; external LibName;
-
-
-{** Retrieve the number of frames that can be written to the stream without
- waiting.
-
- @return Returns a non-negative value representing the maximum number of frames
- that can be written to the stream without blocking or busy waiting or, a
- PaErrorCode (which are always negative) if PortAudio is not initialized or an
- error is encountered.
-*}
-function Pa_GetStreamWriteAvailable( stream: PPaStream ): Longint; cdecl; external LibName;
-
-
-{** Retrieve the host type handling an open stream.
-
- @return Returns a non-negative value representing the host API type
- handling an open stream or, a PaErrorCode (which are always negative)
- if PortAudio is not initialized or an error is encountered.
-*}
-function Pa_GetStreamHostApiType( stream: PPaStream ): TPaHostApiTypeId; cdecl; external LibName;
-
-
-{* Miscellaneous utilities *}
-
-
-{** Retrieve the size of a given sample format in bytes.
-
- @return The size in bytes of a single sample in the specified format,
- or paSampleFormatNotSupported if the format is not supported.
-*}
-function Pa_GetSampleSize( format: TPaSampleFormat ): TPaError; cdecl; external LibName;
-
-
-{** Put the caller to sleep for at least 'msec' milliseconds. This function is
- provided only as a convenience for authors of portable code (such as the tests
- and examples in the PortAudio distribution.)
-
- The function may sleep longer than requested so don't rely on this for accurate
- musical timing.
-*}
-procedure Pa_Sleep( msec: Longint ); cdecl; external LibName;
-
-implementation
-
-end.
+{* + * $Id: portaudio.h,v 1.7 2007/08/16 20:45:34 richardash1981 Exp $ + * PortAudio Portable Real-Time Audio Library + * PortAudio API Header File + * Latest version available at: http://www.portaudio.com/ + * + * Copyright (c) 1999-2002 Ross Bencina and Phil Burk + * + * Permission is hereby granted, free of charge, to any person obtaining + * a copy of this software and associated documentation files + * (the "Software"), to deal in the Software without restriction, + * including without limitation the rights to use, copy, modify, merge, + * publish, distribute, sublicense, and/or sell copies of the Software, + * and to permit persons to whom the Software is furnished to do so, + * subject to the following conditions: + * + * The above copyright notice and this permission notice shall be + * included in all copies or substantial portions of the Software. + * + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, + * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF + * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. + * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR + * ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF + * CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION + * WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + *} + +{* + * The text above constitutes the entire PortAudio license; however, + * the PortAudio community also makes the following non-binding requests: + * + * Any person wishing to distribute modifications to the Software is + * requested to send the modifications to the original developer so that + * they can be incorporated into the canonical version. It is also + * requested that these non-binding requests be included along with the + * license above. + *} + +{** @file + @brief The PortAudio API. +*} + +unit portaudio; + +{$IFDEF FPC} + {$PACKRECORDS C} (* GCC/Visual C/C++ compatible record packing *) + {$MODE DELPHI } +{$ENDIF} + +interface + +//uses; + +const +{$IFDEF MSWINDOWS} + LibName = 'portaudio_x86.dll'; +{$ENDIF} +{$IFDEF LINUX} + LibName = 'libportaudio.so'; +{$ENDIF} +{$IFDEF DARWIN} +// this is for portaudio version 19 + LibName = 'libportaudio.2.dylib'; + {$LINKLIB libportaudio.2} +{$ENDIF} + +{** Retrieve the release number of the currently running PortAudio build, + eg 1900. +*} +function Pa_GetVersion(): Integer; cdecl; external LibName; + + +{** Retrieve a textual description of the current PortAudio build, + eg "PortAudio V19-devel 13 October 2002". +*} +function Pa_GetVersionText(): PChar; cdecl; external LibName; + + +{** Error codes returned by PortAudio functions. + Note that with the exception of paNoError, all PaErrorCodes are negative. +*} + +type TPaError = Integer; +type TPaErrorCode = {enum}Integer; const +{enum_begin PaErrorCode} + paNoError = 0; + + paNotInitialized = -10000; + paUnanticipatedHostError = (paNotInitialized+ 1); + paInvalidChannelCount = (paNotInitialized+ 2); + paInvalidSampleRate = (paNotInitialized+ 3); + paInvalidDevice = (paNotInitialized+ 4); + paInvalidFlag = (paNotInitialized+ 5); + paSampleFormatNotSupported = (paNotInitialized+ 6); + paBadIODeviceCombination = (paNotInitialized+ 7); + paInsufficientMemory = (paNotInitialized+ 8); + paBufferTooBig = (paNotInitialized+ 9); + paBufferTooSmall = (paNotInitialized+10); + paNullCallback = (paNotInitialized+11); + paBadStreamPtr = (paNotInitialized+12); + paTimedOut = (paNotInitialized+13); + paInternalError = (paNotInitialized+14); + paDeviceUnavailable = (paNotInitialized+15); + paIncompatibleHostApiSpecificStreamInfo = (paNotInitialized+16); + paStreamIsStopped = (paNotInitialized+17); + paStreamIsNotStopped = (paNotInitialized+18); + paInputOverflowed = (paNotInitialized+19); + paOutputUnderflowed = (paNotInitialized+20); + paHostApiNotFound = (paNotInitialized+21); + paInvalidHostApi = (paNotInitialized+22); + paCanNotReadFromACallbackStream = (paNotInitialized+23); {**< @todo review error code name *} + paCanNotWriteToACallbackStream = (paNotInitialized+24); {**< @todo review error code name *} + paCanNotReadFromAnOutputOnlyStream = (paNotInitialized+25); {**< @todo review error code name *} + paCanNotWriteToAnInputOnlyStream = (paNotInitialized+26); {**< @todo review error code name *} + paIncompatibleStreamHostApi = (paNotInitialized+27); + paBadBufferPtr = (paNotInitialized+28); +{enum_end PaErrorCode} + + +{** Translate the supplied PortAudio error code into a human readable + message. +*} +function Pa_GetErrorText( errorCode: TPaError ): PChar; cdecl; external LibName; + + +{** Library initialization function - call this before using PortAudio. + This function initialises internal data structures and prepares underlying + host APIs for use. With the exception of Pa_GetVersion(), Pa_GetVersionText(), + and Pa_GetErrorText(), this function MUST be called before using any other + PortAudio API functions. + + If Pa_Initialize() is called multiple times, each successful + call must be matched with a corresponding call to Pa_Terminate(). + Pairs of calls to Pa_Initialize()/Pa_Terminate() may overlap, and are not + required to be fully nested. + + Note that if Pa_Initialize() returns an error code, Pa_Terminate() should + NOT be called. + + @return paNoError if successful, otherwise an error code indicating the cause + of failure. + + @see Pa_Terminate +*} +function Pa_Initialize(): TPaError; cdecl; external LibName; + + +{** Library termination function - call this when finished using PortAudio. + This function deallocates all resources allocated by PortAudio since it was + initializied by a call to Pa_Initialize(). In cases where Pa_Initialise() has + been called multiple times, each call must be matched with a corresponding call + to Pa_Terminate(). The final matching call to Pa_Terminate() will automatically + close any PortAudio streams that are still open. + + Pa_Terminate() MUST be called before exiting a program which uses PortAudio. + Failure to do so may result in serious resource leaks, such as audio devices + not being available until the next reboot. + + @return paNoError if successful, otherwise an error code indicating the cause + of failure. + + @see Pa_Initialize +*} +function Pa_Terminate(): TPaError; cdecl; external LibName; + + + +{** The type used to refer to audio devices. Values of this type usually + range from 0 to (Pa_GetDeviceCount()-1), and may also take on the PaNoDevice + and paUseHostApiSpecificDeviceSpecification values. + + @see Pa_GetDeviceCount, paNoDevice, paUseHostApiSpecificDeviceSpecification +*} +type TPaDeviceIndex = Integer; + + +{** A special PaDeviceIndex value indicating that no device is available, + or should be used. + + @see PaDeviceIndex +*} +const paNoDevice = TPaDeviceIndex(-1); + + +{** A special PaDeviceIndex value indicating that the device(s) to be used + are specified in the host api specific stream info structure. + + @see PaDeviceIndex +*} +const paUseHostApiSpecificDeviceSpecification = TPaDeviceIndex(-2); + + +{* Host API enumeration mechanism *} + +{** The type used to enumerate to host APIs at runtime. Values of this type + range from 0 to (Pa_GetHostApiCount()-1). + + @see Pa_GetHostApiCount +*} +type TPaHostApiIndex = Integer; + +{** Retrieve the number of available host APIs. Even if a host API is + available it may have no devices available. + + @return A non-negative value indicating the number of available host APIs + or, a PaErrorCode (which are always negative) if PortAudio is not initialized + or an error is encountered. + + @see PaHostApiIndex +*} +function Pa_GetHostApiCount(): TPaHostApiIndex; cdecl; external LibName; + + +{** Retrieve the index of the default host API. The default host API will be + the lowest common denominator host API on the current platform and is + unlikely to provide the best performance. + + @return A non-negative value ranging from 0 to (Pa_GetHostApiCount()-1) + indicating the default host API index or, a PaErrorCode (which are always + negative) if PortAudio is not initialized or an error is encountered. +*} +function Pa_GetDefaultHostApi(): TPaHostApiIndex; cdecl; external LibName; + + +{** Unchanging unique identifiers for each supported host API. This type + is used in the PaHostApiInfo structure. The values are guaranteed to be + unique and to never change, thus allowing code to be written that + conditionally uses host API specific extensions. + + New type ids will be allocated when support for a host API reaches + "public alpha" status, prior to that developers should use the + paInDevelopment type id. + + @see PaHostApiInfo +*} +type TPaHostApiTypeId = {enum}Integer; const +{enum_begin PaHostApiTypeId} + paInDevelopment=0; {* use while developing support for a new host API *} + paDirectSound=1; + paMME=2; + paASIO=3; + paSoundManager=4; + paCoreAudio=5; + paOSS=7; + paALSA=8; + paAL=9; + paBeOS=10; + paWDMKS=11; + paJACK=12; + paWASAPI=13; + paAudioScienceHPI=14; +{enum_end PaHostApiTypeId} + +{** A structure containing information about a particular host API. *} + +type + PPaHostApiInfo = ^TPaHostApiInfo; + TPaHostApiInfo = record + {** this is struct version 1 *} + structVersion: Integer; + {** The well known unique identifier of this host API @see PaHostApiTypeId *} + _type: TPaHostApiTypeId; + {** A textual description of the host API for display on user interfaces. *} + name: PChar; + + {** The number of devices belonging to this host API. This field may be + used in conjunction with Pa_HostApiDeviceIndexToDeviceIndex() to enumerate + all devices for this host API. + @see Pa_HostApiDeviceIndexToDeviceIndex + *} + deviceCount: Integer; + + {** The default input device for this host API. The value will be a + device index ranging from 0 to (Pa_GetDeviceCount()-1), or paNoDevice + if no default input device is available. + *} + defaultInputDevice: TPaDeviceIndex; + + {** The default output device for this host API. The value will be a + device index ranging from 0 to (Pa_GetDeviceCount()-1), or paNoDevice + if no default output device is available. + *} + defaultOutputDevice: TPaDeviceIndex; + end; + + +{** Retrieve a pointer to a structure containing information about a specific + host Api. + + @param hostApi A valid host API index ranging from 0 to (Pa_GetHostApiCount()-1) + + @return A pointer to an immutable PaHostApiInfo structure describing + a specific host API. If the hostApi parameter is out of range or an error + is encountered, the function returns NULL. + + The returned structure is owned by the PortAudio implementation and must not + be manipulated or freed. The pointer is only guaranteed to be valid between + calls to Pa_Initialize() and Pa_Terminate(). +*} +function Pa_GetHostApiInfo( hostApi: TPaHostApiIndex ): PPaHostApiInfo; cdecl; external LibName; + + +{** Convert a static host API unique identifier, into a runtime + host API index. + + @param type A unique host API identifier belonging to the PaHostApiTypeId + enumeration. + + @return A valid PaHostApiIndex ranging from 0 to (Pa_GetHostApiCount()-1) or, + a PaErrorCode (which are always negative) if PortAudio is not initialized + or an error is encountered. + + The paHostApiNotFound error code indicates that the host API specified by the + type parameter is not available. + + @see PaHostApiTypeId +*} +function Pa_HostApiTypeIdToHostApiIndex( _type: TPaHostApiTypeId ): TPaHostApiIndex; cdecl; external LibName; + + +{** Convert a host-API-specific device index to standard PortAudio device index. + This function may be used in conjunction with the deviceCount field of + PaHostApiInfo to enumerate all devices for the specified host API. + + @param hostApi A valid host API index ranging from 0 to (Pa_GetHostApiCount()-1) + + @param hostApiDeviceIndex A valid per-host device index in the range + 0 to (Pa_GetHostApiInfo(hostApi)->deviceCount-1) + + @return A non-negative PaDeviceIndex ranging from 0 to (Pa_GetDeviceCount()-1) + or, a PaErrorCode (which are always negative) if PortAudio is not initialized + or an error is encountered. + + A paInvalidHostApi error code indicates that the host API index specified by + the hostApi parameter is out of range. + + A paInvalidDevice error code indicates that the hostApiDeviceIndex parameter + is out of range. + + @see PaHostApiInfo +*} +function Pa_HostApiDeviceIndexToDeviceIndex( hostApi: TPaHostApiIndex; + hostApiDeviceIndex: Integer ): TPaDeviceIndex; cdecl; external LibName; + + + +{** Structure used to return information about a host error condition. +*} +type + PPaHostErrorInfo = ^TPaHostErrorInfo; + TPaHostErrorInfo = record + hostApiType: TPaHostApiTypeId; {**< the host API which returned the error code *} + errorCode: Longint; {**< the error code returned *} + errorText: PChar; {**< a textual description of the error if available, otherwise a zero-length string *} + end; + + +{** Return information about the last host error encountered. The error + information returned by Pa_GetLastHostErrorInfo() will never be modified + asyncronously by errors occurring in other PortAudio owned threads + (such as the thread that manages the stream callback.) + + This function is provided as a last resort, primarily to enhance debugging + by providing clients with access to all available error information. + + @return A pointer to an immutable structure constaining information about + the host error. The values in this structure will only be valid if a + PortAudio function has previously returned the paUnanticipatedHostError + error code. +*} +function Pa_GetLastHostErrorInfo(): PPaHostErrorInfo; cdecl; external LibName; + + + +{* Device enumeration and capabilities *} + +{** Retrieve the number of available devices. The number of available devices + may be zero. + + @return A non-negative value indicating the number of available devices or, + a PaErrorCode (which are always negative) if PortAudio is not initialized + or an error is encountered. +*} +function Pa_GetDeviceCount(): TPaDeviceIndex; cdecl; external LibName; + + +{** Retrieve the index of the default input device. The result can be + used in the inputDevice parameter to Pa_OpenStream(). + + @return The default input device index for the default host API, or paNoDevice + if no default input device is available or an error was encountered. +*} +function Pa_GetDefaultInputDevice(): TPaDeviceIndex; cdecl; external LibName; + + +{** Retrieve the index of the default output device. The result can be + used in the outputDevice parameter to Pa_OpenStream(). + + @return The default output device index for the defualt host API, or paNoDevice + if no default output device is available or an error was encountered. + + @note + On the PC, the user can specify a default device by + setting an environment variable. For example, to use device #1. +<pre> + set PA_RECOMMENDED_OUTPUT_DEVICE=1 +</pre> + The user should first determine the available device ids by using + the supplied application "pa_devs". +*} +function Pa_GetDefaultOutputDevice(): TPaDeviceIndex; cdecl; external LibName; + + +{** The type used to represent monotonic time in seconds that can be used + for syncronisation. The type is used for the outTime argument to the + PaStreamCallback and as the result of Pa_GetStreamTime(). + + @see PaStreamCallback, Pa_GetStreamTime +*} +type TPaTime = Double; + + +{** A type used to specify one or more sample formats. Each value indicates + a possible format for sound data passed to and from the stream callback, + Pa_ReadStream and Pa_WriteStream. + + The standard formats paFloat32, paInt16, paInt32, paInt24, paInt8 + and aUInt8 are usually implemented by all implementations. + + The floating point representation (paFloat32) uses +1.0 and -1.0 as the + maximum and minimum respectively. + + paUInt8 is an unsigned 8 bit format where 128 is considered "ground" + + The paNonInterleaved flag indicates that a multichannel buffer is passed + as a set of non-interleaved pointers. + + @see Pa_OpenStream, Pa_OpenDefaultStream, PaDeviceInfo + @see paFloat32, paInt16, paInt32, paInt24, paInt8 + @see paUInt8, paCustomFormat, paNonInterleaved +*} +type TPaSampleFormat = Longword; +const + paFloat32 = TPaSampleFormat($00000001); {**< @see PaSampleFormat *} + paInt32 = TPaSampleFormat($00000002); {**< @see PaSampleFormat *} + paInt24 = TPaSampleFormat($00000004); {**< Packed 24 bit format. @see PaSampleFormat *} + paInt16 = TPaSampleFormat($00000008); {**< @see PaSampleFormat *} + paInt8 = TPaSampleFormat($00000010); {**< @see PaSampleFormat *} + paUInt8 = TPaSampleFormat($00000020); {**< @see PaSampleFormat *} + paCustomFormat = TPaSampleFormat($00010000); {**< @see PaSampleFormat *} + paNonInterleaved = TPaSampleFormat($80000000); + +{** A structure providing information and capabilities of PortAudio devices. + Devices may support input, output or both input and output. +*} +type + PPaDeviceInfo = ^TPaDeviceInfo; + TPaDeviceInfo = record + structVersion: Integer; {* this is struct version 2 *} + name: PChar; + hostApi: TPaHostApiIndex; {* note this is a host API index, not a type id*} + + maxInputChannels: Integer; + maxOutputChannels: Integer; + + {* Default latency values for interactive performance. *} + defaultLowInputLatency: TPaTime; + defaultLowOutputLatency: TPaTime; + {* Default latency values for robust non-interactive applications (eg. playing sound files). *} + defaultHighInputLatency: TPaTime; + defaultHighOutputLatency: TPaTime; + + defaultSampleRate: Double; + end; + + +{** Retrieve a pointer to a PaDeviceInfo structure containing information + about the specified device. + @return A pointer to an immutable PaDeviceInfo structure. If the device + parameter is out of range the function returns NULL. + + @param device A valid device index in the range 0 to (Pa_GetDeviceCount()-1) + + @note PortAudio manages the memory referenced by the returned pointer, + the client must not manipulate or free the memory. The pointer is only + guaranteed to be valid between calls to Pa_Initialize() and Pa_Terminate(). + + @see PaDeviceInfo, PaDeviceIndex +*} +function Pa_GetDeviceInfo( device: TPaDeviceIndex ): PPaDeviceInfo; cdecl; external LibName; + + +{** Parameters for one direction (input or output) of a stream. +*} +type + PPaStreamParameters = ^TPaStreamParameters; + TPaStreamParameters = record + {** A valid device index in the range 0 to (Pa_GetDeviceCount()-1) + specifying the device to be used or the special constant + paUseHostApiSpecificDeviceSpecification which indicates that the actual + device(s) to use are specified in hostApiSpecificStreamInfo. + This field must not be set to paNoDevice. + *} + device: TPaDeviceIndex; + + {** The number of channels of sound to be delivered to the + stream callback or accessed by Pa_ReadStream() or Pa_WriteStream(). + It can range from 1 to the value of maxInputChannels in the + PaDeviceInfo record for the device specified by the device parameter. + *} + channelCount: Integer; + + {** The sample format of the buffer provided to the stream callback, + a_ReadStream() or Pa_WriteStream(). It may be any of the formats described + by the PaSampleFormat enumeration. + *} + sampleFormat: TPaSampleFormat; + + {** The desired latency in seconds. Where practical, implementations should + configure their latency based on these parameters, otherwise they may + choose the closest viable latency instead. Unless the suggested latency + is greater than the absolute upper limit for the device implementations + should round the suggestedLatency up to the next practial value - ie to + provide an equal or higher latency than suggestedLatency wherever possibe. + Actual latency values for an open stream may be retrieved using the + inputLatency and outputLatency fields of the PaStreamInfo structure + returned by Pa_GetStreamInfo(). + @see default*Latency in PaDeviceInfo, *Latency in PaStreamInfo + *} + suggestedLatency: TPaTime; + + {** An optional pointer to a host api specific data structure + containing additional information for device setup and/or stream processing. + hostApiSpecificStreamInfo is never required for correct operation, + if not used it should be set to NULL. + *} + hostApiSpecificStreamInfo: Pointer; + end; + + +{** Return code for Pa_IsFormatSupported indicating success. *} +const paFormatIsSupported = (0); + +{** Determine whether it would be possible to open a stream with the specified + parameters. + + @param inputParameters A structure that describes the input parameters used to + open a stream. The suggestedLatency field is ignored. See PaStreamParameters + for a description of these parameters. inputParameters must be NULL for + output-only streams. + + @param outputParameters A structure that describes the output parameters used + to open a stream. The suggestedLatency field is ignored. See PaStreamParameters + for a description of these parameters. outputParameters must be NULL for + input-only streams. + + @param sampleRate The required sampleRate. For full-duplex streams it is the + sample rate for both input and output + + @return Returns 0 if the format is supported, and an error code indicating why + the format is not supported otherwise. The constant paFormatIsSupported is + provided to compare with the return value for success. + + @see paFormatIsSupported, PaStreamParameters +*} +function Pa_IsFormatSupported( inputParameters: PPaStreamParameters; + outputParameters: PPaStreamParameters; + sampleRate: Double ): TPaError; cdecl; external LibName; + + + +{* Streaming types and functions *} + + +{** + A single PaStream can provide multiple channels of real-time + streaming audio input and output to a client application. A stream + provides access to audio hardware represented by one or more + PaDevices. Depending on the underlying Host API, it may be possible + to open multiple streams using the same device, however this behavior + is implementation defined. Portable applications should assume that + a PaDevice may be simultaneously used by at most one PaStream. + + Pointers to PaStream objects are passed between PortAudio functions that + operate on streams. + + @see Pa_OpenStream, Pa_OpenDefaultStream, Pa_OpenDefaultStream, Pa_CloseStream, + Pa_StartStream, Pa_StopStream, Pa_AbortStream, Pa_IsStreamActive, + Pa_GetStreamTime, Pa_GetStreamCpuLoad + +*} +type + PPaStream = Pointer; + +{** Can be passed as the framesPerBuffer parameter to Pa_OpenStream() + or Pa_OpenDefaultStream() to indicate that the stream callback will + accept buffers of any size. +*} +const paFramesPerBufferUnspecified = (0); + + +{** Flags used to control the behavior of a stream. They are passed as + parameters to Pa_OpenStream or Pa_OpenDefaultStream. Multiple flags may be + ORed together. + + @see Pa_OpenStream, Pa_OpenDefaultStream + @see paNoFlag, paClipOff, paDitherOff, paNeverDropInput, + paPrimeOutputBuffersUsingStreamCallback, paPlatformSpecificFlags +*} +type TPaStreamFlags = Longword; + +{** @see PaStreamFlags *} +const paNoFlag = TPaStreamFlags(0); + +{** Disable default clipping of out of range samples. + @see PaStreamFlags +*} +const paClipOff = TPaStreamFlags($00000001); + +{** Disable default dithering. + @see PaStreamFlags +*} +const paDitherOff = TPaStreamFlags($00000002); + +{** Flag requests that where possible a full duplex stream will not discard + overflowed input samples without calling the stream callback. This flag is + only valid for full duplex callback streams and only when used in combination + with the paFramesPerBufferUnspecified (0) framesPerBuffer parameter. Using + this flag incorrectly results in a paInvalidFlag error being returned from + Pa_OpenStream and Pa_OpenDefaultStream. + + @see PaStreamFlags, paFramesPerBufferUnspecified +*} +const paNeverDropInput = TPaStreamFlags($00000004); + +{** Call the stream callback to fill initial output buffers, rather than the + default behavior of priming the buffers with zeros (silence). This flag has + no effect for input-only and blocking read/write streams. + + @see PaStreamFlags +*} +const paPrimeOutputBuffersUsingStreamCallback = TPaStreamFlags($00000008); + +{** A mask specifying the platform specific bits. + @see PaStreamFlags +*} +const paPlatformSpecificFlags = TPaStreamFlags($FFFF0000); + +{** + Timing information for the buffers passed to the stream callback. +*} +type + PPaStreamCallbackTimeInfo = ^TPaStreamCallbackTimeInfo; + TPaStreamCallbackTimeInfo = record + inputBufferAdcTime: TPaTime; + currentTime: TPaTime; + outputBufferDacTime: TPaTime; + end; + + +{** + Flag bit constants for the statusFlags to PaStreamCallback. + + @see paInputUnderflow, paInputOverflow, paOutputUnderflow, paOutputOverflow, + paPrimingOutput +*} +type TPaStreamCallbackFlags = Longword; + +{** In a stream opened with paFramesPerBufferUnspecified, indicates that + input data is all silence (zeros) because no real data is available. In a + stream opened without paFramesPerBufferUnspecified, it indicates that one or + more zero samples have been inserted into the input buffer to compensate + for an input underflow. + @see PaStreamCallbackFlags +*} +const paInputUnderflow = TPaStreamCallbackFlags($00000001); + +{** In a stream opened with paFramesPerBufferUnspecified, indicates that data + prior to the first sample of the input buffer was discarded due to an + overflow, possibly because the stream callback is using too much CPU time. + Otherwise indicates that data prior to one or more samples in the + input buffer was discarded. + @see PaStreamCallbackFlags +*} +const paInputOverflow = TPaStreamCallbackFlags($00000002); + +{** Indicates that output data (or a gap) was inserted, possibly because the + stream callback is using too much CPU time. + @see PaStreamCallbackFlags +*} +const paOutputUnderflow = TPaStreamCallbackFlags($00000004); + +{** Indicates that output data will be discarded because no room is available. + @see PaStreamCallbackFlags +*} +const paOutputOverflow = TPaStreamCallbackFlags($00000008); + +{** Some of all of the output data will be used to prime the stream, input + data may be zero. + @see PaStreamCallbackFlags +*} +const paPrimingOutput = TPaStreamCallbackFlags($00000010); + +{** + Allowable return values for the PaStreamCallback. + @see PaStreamCallback +*} +type TPaStreamCallbackResult = {enum}Integer; const +{enum_begin PaStreamCallbackResult} + paContinue=0; + paComplete=1; + paAbort=2; +{enum_end PaStreamCallbackResult} + +{** + Functions of type PaStreamCallback are implemented by PortAudio clients. + They consume, process or generate audio in response to requests from an + active PortAudio stream. + + @param input and @param output are arrays of interleaved samples, + the format, packing and number of channels used by the buffers are + determined by parameters to Pa_OpenStream(). + + @param frameCount The number of sample frames to be processed by + the stream callback. + + @param timeInfo The time in seconds when the first sample of the input + buffer was received at the audio input, the time in seconds when the first + sample of the output buffer will begin being played at the audio output, and + the time in seconds when the stream callback was called. + See also Pa_GetStreamTime() + + @param statusFlags Flags indicating whether input and/or output buffers + have been inserted or will be dropped to overcome underflow or overflow + conditions. + + @param userData The value of a user supplied pointer passed to + Pa_OpenStream() intended for storing synthesis data etc. + + @return + The stream callback should return one of the values in the + PaStreamCallbackResult enumeration. To ensure that the callback continues + to be called, it should return paContinue (0). Either paComplete or paAbort + can be returned to finish stream processing, after either of these values is + returned the callback will not be called again. If paAbort is returned the + stream will finish as soon as possible. If paComplete is returned, the stream + will continue until all buffers generated by the callback have been played. + This may be useful in applications such as soundfile players where a specific + duration of output is required. However, it is not necessary to utilise this + mechanism as Pa_StopStream(), Pa_AbortStream() or Pa_CloseStream() can also + be used to stop the stream. The callback must always fill the entire output + buffer irrespective of its return value. + + @see Pa_OpenStream, Pa_OpenDefaultStream + + @note With the exception of Pa_GetStreamCpuLoad() it is not permissable to call + PortAudio API functions from within the stream callback. +*} +type + PPaStreamCallback = ^TPaStreamCallback; + TPaStreamCallback = function( + input: Pointer; output: Pointer; + frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; + statusFlags: TPaStreamCallbackFlags; + userData: Pointer ): Integer; cdecl; + + +{** Opens a stream for either input, output or both. + + @param stream The address of a PaStream pointer which will receive + a pointer to the newly opened stream. + + @param inputParameters A structure that describes the input parameters used by + the opened stream. See PaStreamParameters for a description of these parameters. + inputParameters must be NULL for output-only streams. + + @param outputParameters A structure that describes the output parameters used by + the opened stream. See PaStreamParameters for a description of these parameters. + outputParameters must be NULL for input-only streams. + + @param sampleRate The desired sampleRate. For full-duplex streams it is the + sample rate for both input and output + + @param framesPerBuffer The number of frames passed to the stream callback + function, or the preferred block granularity for a blocking read/write stream. + The special value paFramesPerBufferUnspecified (0) may be used to request that + the stream callback will recieve an optimal (and possibly varying) number of + frames based on host requirements and the requested latency settings. + Note: With some host APIs, the use of non-zero framesPerBuffer for a callback + stream may introduce an additional layer of buffering which could introduce + additional latency. PortAudio guarantees that the additional latency + will be kept to the theoretical minimum however, it is strongly recommended + that a non-zero framesPerBuffer value only be used when your algorithm + requires a fixed number of frames per stream callback. + + @param streamFlags Flags which modify the behaviour of the streaming process. + This parameter may contain a combination of flags ORed together. Some flags may + only be relevant to certain buffer formats. + + @param streamCallback A pointer to a client supplied function that is responsible + for processing and filling input and output buffers. If this parameter is NULL + the stream will be opened in 'blocking read/write' mode. In blocking mode, + the client can receive sample data using Pa_ReadStream and write sample data + using Pa_WriteStream, the number of samples that may be read or written + without blocking is returned by Pa_GetStreamReadAvailable and + Pa_GetStreamWriteAvailable respectively. + + @param userData A client supplied pointer which is passed to the stream callback + function. It could for example, contain a pointer to instance data necessary + for processing the audio buffers. This parameter is ignored if streamCallback + is NULL. + + @return + Upon success Pa_OpenStream() returns paNoError and places a pointer to a + valid PaStream in the stream argument. The stream is inactive (stopped). + If a call to Pa_OpenStream() fails, a non-zero error code is returned (see + PaError for possible error codes) and the value of stream is invalid. + + @see PaStreamParameters, PaStreamCallback, Pa_ReadStream, Pa_WriteStream, + Pa_GetStreamReadAvailable, Pa_GetStreamWriteAvailable +*} +function Pa_OpenStream( var stream: PPaStream; + inputParameters: PPaStreamParameters; + outputParameters: PPaStreamParameters; + sampleRate: Double; + framesPerBuffer: Longword; + streamFlags: TPaStreamFlags; + streamCallback: PPaStreamCallback; + userData: Pointer ): TPaError; cdecl; external LibName; + + +{** A simplified version of Pa_OpenStream() that opens the default input + and/or output devices. + + @param stream The address of a PaStream pointer which will receive + a pointer to the newly opened stream. + + @param numInputChannels The number of channels of sound that will be supplied + to the stream callback or returned by Pa_ReadStream. It can range from 1 to + the value of maxInputChannels in the PaDeviceInfo record for the default input + device. If 0 the stream is opened as an output-only stream. + + @param numOutputChannels The number of channels of sound to be delivered to the + stream callback or passed to Pa_WriteStream. It can range from 1 to the value + of maxOutputChannels in the PaDeviceInfo record for the default output dvice. + If 0 the stream is opened as an output-only stream. + + @param sampleFormat The sample format of both the input and output buffers + provided to the callback or passed to and from Pa_ReadStream and Pa_WriteStream. + sampleFormat may be any of the formats described by the PaSampleFormat + enumeration. + + @param sampleRate Same as Pa_OpenStream parameter of the same name. + @param framesPerBuffer Same as Pa_OpenStream parameter of the same name. + @param streamCallback Same as Pa_OpenStream parameter of the same name. + @param userData Same as Pa_OpenStream parameter of the same name. + + @return As for Pa_OpenStream + + @see Pa_OpenStream, PaStreamCallback +*} +function Pa_OpenDefaultStream( var stream: PPaStream; + numInputChannels: Integer; + numOutputChannels: Integer; + sampleFormat: TPaSampleFormat; + sampleRate: Double; + framesPerBuffer: Longword; + streamCallback: PPaStreamCallback; + userData: Pointer ): TPaError; cdecl; external LibName; + + +{** Closes an audio stream. If the audio stream is active it + discards any pending buffers as if Pa_AbortStream() had been called. +*} +function Pa_CloseStream( stream: PPaStream ): TPaError; cdecl; external LibName; + + +{** Functions of type PaStreamFinishedCallback are implemented by PortAudio + clients. They can be registered with a stream using the Pa_SetStreamFinishedCallback + function. Once registered they are called when the stream becomes inactive + (ie once a call to Pa_StopStream() will not block). + A stream will become inactive after the stream callback returns non-zero, + or when Pa_StopStream or Pa_AbortStream is called. For a stream providing audio + output, if the stream callback returns paComplete, or Pa_StopStream is called, + the stream finished callback will not be called until all generated sample data + has been played. + + @param userData The userData parameter supplied to Pa_OpenStream() + + @see Pa_SetStreamFinishedCallback +*} +type + PPaStreamFinishedCallback = ^TPaStreamFinishedCallback; + TPaStreamFinishedCallback = procedure( userData: Pointer ); cdecl; + + +{** Register a stream finished callback function which will be called when the + stream becomes inactive. See the description of PaStreamFinishedCallback for + further details about when the callback will be called. + + @param stream a pointer to a PaStream that is in the stopped state - if the + stream is not stopped, the stream's finished callback will remain unchanged + and an error code will be returned. + + @param streamFinishedCallback a pointer to a function with the same signature + as PaStreamFinishedCallback, that will be called when the stream becomes + inactive. Passing NULL for this parameter will un-register a previously + registered stream finished callback function. + + @return on success returns paNoError, otherwise an error code indicating the cause + of the error. + + @see PaStreamFinishedCallback +*} +function Pa_SetStreamFinishedCallback( stream: PPaStream; + streamFinishedCallback: PPaStreamFinishedCallback ): TPaError; cdecl; external LibName; + + +{** Commences audio processing. +*} +function Pa_StartStream( stream: PPaStream ): TPaError; cdecl; external LibName; + + +{** Terminates audio processing. It waits until all pending + audio buffers have been played before it returns. +*} +function Pa_StopStream( stream: PPaStream ): TPaError; cdecl; external LibName; + + +{** Terminates audio processing immediately without waiting for pending + buffers to complete. +*} +function Pa_AbortStream( stream: PPaStream ): TPaError; cdecl; external LibName; + + +{** Determine whether the stream is stopped. + A stream is considered to be stopped prior to a successful call to + Pa_StartStream and after a successful call to Pa_StopStream or Pa_AbortStream. + If a stream callback returns a value other than paContinue the stream is NOT + considered to be stopped. + + @return Returns one (1) when the stream is stopped, zero (0) when + the stream is running or, a PaErrorCode (which are always negative) if + PortAudio is not initialized or an error is encountered. + + @see Pa_StopStream, Pa_AbortStream, Pa_IsStreamActive +*} +function Pa_IsStreamStopped( stream: PPaStream ): TPaError; cdecl; external LibName; + + +{** Determine whether the stream is active. + A stream is active after a successful call to Pa_StartStream(), until it + becomes inactive either as a result of a call to Pa_StopStream() or + Pa_AbortStream(), or as a result of a return value other than paContinue from + the stream callback. In the latter case, the stream is considered inactive + after the last buffer has finished playing. + + @return Returns one (1) when the stream is active (ie playing or recording + audio), zero (0) when not playing or, a PaErrorCode (which are always negative) + if PortAudio is not initialized or an error is encountered. + + @see Pa_StopStream, Pa_AbortStream, Pa_IsStreamStopped +*} +function Pa_IsStreamActive( stream: PPaStream ): TPaError; cdecl; external LibName; + + + +{** A structure containing unchanging information about an open stream. + @see Pa_GetStreamInfo +*} +type + PPaStreamInfo = ^TPaStreamInfo; + TPaStreamInfo = record + {** this is struct version 1 *} + structVersion: Integer; + + {** The input latency of the stream in seconds. This value provides the most + accurate estimate of input latency available to the implementation. It may + differ significantly from the suggestedLatency value passed to Pa_OpenStream(). + The value of this field will be zero (0.) for output-only streams. + @see PaTime + *} + inputLatency: TPaTime; + + {** The output latency of the stream in seconds. This value provides the most + accurate estimate of output latency available to the implementation. It may + differ significantly from the suggestedLatency value passed to Pa_OpenStream(). + The value of this field will be zero (0.) for input-only streams. + @see PaTime + *} + outputLatency: TPaTime; + + {** The sample rate of the stream in Hertz (samples per second). In cases + where the hardware sample rate is inaccurate and PortAudio is aware of it, + the value of this field may be different from the sampleRate parameter + passed to Pa_OpenStream(). If information about the actual hardware sample + rate is not available, this field will have the same value as the sampleRate + parameter passed to Pa_OpenStream(). + *} + sampleRate: Double; + end; + + +{** Retrieve a pointer to a PaStreamInfo structure containing information + about the specified stream. + @return A pointer to an immutable PaStreamInfo structure. If the stream + parameter invalid, or an error is encountered, the function returns NULL. + + @param stream A pointer to an open stream previously created with Pa_OpenStream. + + @note PortAudio manages the memory referenced by the returned pointer, + the client must not manipulate or free the memory. The pointer is only + guaranteed to be valid until the specified stream is closed. + + @see PaStreamInfo +*} +function Pa_GetStreamInfo( stream: PPaStream ): PPaStreamInfo; cdecl; external LibName; + + +{** Determine the current time for the stream according to the same clock used + to generate buffer timestamps. This time may be used for syncronising other + events to the audio stream, for example synchronizing audio to MIDI. + + @return The stream's current time in seconds, or 0 if an error occurred. + + @see PaTime, PaStreamCallback +*} +function Pa_GetStreamTime( stream: PPaStream ): TPaTime; cdecl; external LibName; + + +{** Retrieve CPU usage information for the specified stream. + The "CPU Load" is a fraction of total CPU time consumed by a callback stream's + audio processing routines including, but not limited to the client supplied + stream callback. This function does not work with blocking read/write streams. + + This function may be called from the stream callback function or the + application. + + @return + A floating point value, typically between 0.0 and 1.0, where 1.0 indicates + that the stream callback is consuming the maximum number of CPU cycles possible + to maintain real-time operation. A value of 0.5 would imply that PortAudio and + the stream callback was consuming roughly 50% of the available CPU time. The + return value may exceed 1.0. A value of 0.0 will always be returned for a + blocking read/write stream, or if an error occurrs. +*} +function Pa_GetStreamCpuLoad( stream: PPaStream ): Double; cdecl; external LibName; + + +{** Read samples from an input stream. The function doesn't return until + the entire buffer has been filled - this may involve waiting for the operating + system to supply the data. + + @param stream A pointer to an open stream previously created with Pa_OpenStream. + + @param buffer A pointer to a buffer of sample frames. The buffer contains + samples in the format specified by the inputParameters->sampleFormat field + used to open the stream, and the number of channels specified by + inputParameters->numChannels. If non-interleaved samples were requested, + buffer is a pointer to the first element of an array of non-interleaved + buffer pointers, one for each channel. + + @param frames The number of frames to be read into buffer. This parameter + is not constrained to a specific range, however high performance applications + will want to match this parameter to the framesPerBuffer parameter used + when opening the stream. + + @return On success PaNoError will be returned, or PaInputOverflowed if input + data was discarded by PortAudio after the previous call and before this call. +*} +function Pa_ReadStream( stream: PPaStream; + buffer: Pointer; + frames: Longword ): TPaError; cdecl; external LibName; + + +{** Write samples to an output stream. This function doesn't return until the + entire buffer has been consumed - this may involve waiting for the operating + system to consume the data. + + @param stream A pointer to an open stream previously created with Pa_OpenStream. + + @param buffer A pointer to a buffer of sample frames. The buffer contains + samples in the format specified by the outputParameters->sampleFormat field + used to open the stream, and the number of channels specified by + outputParameters->numChannels. If non-interleaved samples were requested, + buffer is a pointer to the first element of an array of non-interleaved + buffer pointers, one for each channel. + + @param frames The number of frames to be written from buffer. This parameter + is not constrained to a specific range, however high performance applications + will want to match this parameter to the framesPerBuffer parameter used + when opening the stream. + + @return On success PaNoError will be returned, or paOutputUnderflowed if + additional output data was inserted after the previous call and before this + call. +*} +function Pa_WriteStream( stream: PPaStream; + buffer: Pointer; + frames: Longword ): TPaError; cdecl; external LibName; + + +{** Retrieve the number of frames that can be read from the stream without + waiting. + + @return Returns a non-negative value representing the maximum number of frames + that can be read from the stream without blocking or busy waiting or, a + PaErrorCode (which are always negative) if PortAudio is not initialized or an + error is encountered. +*} +function Pa_GetStreamReadAvailable( stream: PPaStream ): Longint; cdecl; external LibName; + + +{** Retrieve the number of frames that can be written to the stream without + waiting. + + @return Returns a non-negative value representing the maximum number of frames + that can be written to the stream without blocking or busy waiting or, a + PaErrorCode (which are always negative) if PortAudio is not initialized or an + error is encountered. +*} +function Pa_GetStreamWriteAvailable( stream: PPaStream ): Longint; cdecl; external LibName; + + +{** Retrieve the host type handling an open stream. + + @return Returns a non-negative value representing the host API type + handling an open stream or, a PaErrorCode (which are always negative) + if PortAudio is not initialized or an error is encountered. +*} +function Pa_GetStreamHostApiType( stream: PPaStream ): TPaHostApiTypeId; cdecl; external LibName; + + +{* Miscellaneous utilities *} + + +{** Retrieve the size of a given sample format in bytes. + + @return The size in bytes of a single sample in the specified format, + or paSampleFormatNotSupported if the format is not supported. +*} +function Pa_GetSampleSize( format: TPaSampleFormat ): TPaError; cdecl; external LibName; + + +{** Put the caller to sleep for at least 'msec' milliseconds. This function is + provided only as a convenience for authors of portable code (such as the tests + and examples in the PortAudio distribution.) + + The function may sleep longer than requested so don't rely on this for accurate + musical timing. +*} +procedure Pa_Sleep( msec: Longint ); cdecl; external LibName; + +implementation + +end. diff --git a/Game/Code/lib/portmixer/delphi/portmixer.pas b/Game/Code/lib/portmixer/delphi/portmixer.pas index 80d7676a..025ce2a5 100644 --- a/Game/Code/lib/portmixer/delphi/portmixer.pas +++ b/Game/Code/lib/portmixer/delphi/portmixer.pas @@ -1,150 +1,150 @@ -{*
- * PortMixer
- * PortMixer API Header File
- *
- * Copyright (c) 2002, 2006
- *
- * Written by Dominic Mazzoni
- * and Leland Lucius
- *
- * PortMixer is intended to work side-by-side with PortAudio,
- * the Portable Real-Time Audio Library by Ross Bencina and
- * Phil Burk.
- *
- * Permission is hereby granted, free of charge, to any person obtaining
- * a copy of this software and associated documentation files
- * (the "Software"), to deal in the Software without restriction,
- * including without limitation the rights to use, copy, modify, merge,
- * publish, distribute, sublicense, and/or sell copies of the Software,
- * and to permit persons to whom the Software is furnished to do so,
- * subject to the following conditions:
- *
- * The above copyright notice and this permission notice shall be
- * included in all copies or substantial portions of the Software.
- *
- * Any person wishing to distribute modifications to the Software is
- * requested to send the modifications to the original developer so that
- * they can be incorporated into the canonical version.
- *
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
- * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
- * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
- * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR
- * ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
- * CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
- * WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
- *
- *}
-unit portmixer;
-
-{$IFDEF FPC}
- {$PACKRECORDS C} (* GCC/Visual C/C++ compatible record packing *)
- {$MODE DELPHI }
-{$ENDIF}
-
-interface
-
-uses
- portaudio;
-
-const
-{$IFDEF MSWINDOWS}
- LibName = 'portmixer.dll';
-{$ENDIF}
-{$IFDEF LINUX}
- LibName = 'libportmixer.so';
-{$ENDIF}
-{$IFDEF DARWIN}
-// LibName = 'libportmixer.dylib';
-// {$LINKLIB libportaudio}
-{$ENDIF}
-
-type
- PPxMixer = Pointer;
- TPxVolume = Single; {* 0.0 (min) --> 1.0 (max) *}
- TPxBalance = Single; {* -1.0 (left) --> 1.0 (right) *}
-
-{*
- Px_OpenMixer() returns a mixer which will work with the given PortAudio
- audio device. Pass 0 as the index for the first (default) mixer.
-*}
-
-function Px_OpenMixer( pa_stream: Pointer; i: Integer ): PPxMixer; cdecl; external LibName;
-
-{*
- Px_CloseMixer() closes a mixer opened using Px_OpenMixer and frees any
- memory associated with it.
-*}
-
-procedure Px_CloseMixer( mixer: PPxMixer ); cdecl; external LibName;
-
-{*
- Px_GetNumMixers returns the number of mixers which could be
- used with the given PortAudio device. On most systems, there
- will be only one mixer for each device; however there may be
- multiple mixers for each device, or possibly multiple mixers
- which are independent of any particular PortAudio device.
-*}
-
-function Px_GetNumMixers( mixer: PPxMixer ): Integer; cdecl; external LibName;
-function Px_GetMixerName( mixer: PPxMixer; i: Integer ): PChar; cdecl; external LibName;
-
-{*
- Master (output) volume
-*}
-
-function Px_GetMasterVolume( mixer: PPxMixer ): TPxVolume; cdecl; external LibName;
-procedure Px_SetMasterVolume( mixer: PPxMixer; volume: TPxVolume ); cdecl; external LibName;
-
-{*
- Main output volume
-*}
-
-function Px_GetPCMOutputVolume( mixer: PPxMixer ): TPxVolume; cdecl; external LibName;
-procedure Px_SetPCMOutputVolume( mixer: PPxMixer; volume: TPxVolume ); cdecl; external LibName;
-function Px_SupportsPCMOutputVolume( mixer: PPxMixer ): Integer; cdecl; external LibName;
-
-{*
- All output volumes
-*}
-
-function Px_GetNumOutputVolumes( mixer: PPxMixer ): Integer; cdecl; external LibName;
-function Px_GetOutputVolumeName( mixer: PPxMixer; i: Integer ): PChar; cdecl; external LibName;
-function Px_GetOutputVolume( mixer: PPxMixer; i: Integer ): TPxVolume; cdecl; external LibName;
-procedure Px_SetOutputVolume( mixer: PPxMixer; i: Integer; volume: TPxVolume ); cdecl; external LibName;
-
-{*
- Input source
-*}
-
-function Px_GetNumInputSources( mixer: PPxMixer ): Integer; cdecl; external LibName;
-function Px_GetInputSourceName( mixer: PPxMixer; i: Integer): PChar; cdecl; external LibName;
-function Px_GetCurrentInputSource( mixer: PPxMixer ): Integer; cdecl; external LibName; {* may return -1 == none *}
-procedure Px_SetCurrentInputSource( mixer: PPxMixer; i: Integer ); cdecl; external LibName;
-
-{*
- Input volume
-*}
-
-function Px_GetInputVolume( mixer: PPxMixer ): TPxVolume; cdecl; external LibName;
-procedure Px_SetInputVolume( mixer: PPxMixer; volume: TPxVolume ); cdecl; external LibName;
-
-{*
- Balance
-*}
-
-function Px_SupportsOutputBalance( mixer: PPxMixer ): Integer; cdecl; external LibName;
-function Px_GetOutputBalance( mixer: PPxMixer ): TPxBalance; cdecl; external LibName;
-procedure Px_SetOutputBalance( mixer: PPxMixer; balance: TPxBalance ); cdecl; external LibName;
-
-{*
- Playthrough
-*}
-
-function Px_SupportsPlaythrough( mixer: PPxMixer ): Integer; cdecl; external LibName;
-function Px_GetPlaythrough( mixer: PPxMixer ): TPxVolume; cdecl; external LibName;
-procedure Px_SetPlaythrough( mixer: PPxMixer; volume: TPxVolume ); cdecl; external LibName;
-
-implementation
-
-end.
+{* + * PortMixer + * PortMixer API Header File + * + * Copyright (c) 2002, 2006 + * + * Written by Dominic Mazzoni + * and Leland Lucius + * + * PortMixer is intended to work side-by-side with PortAudio, + * the Portable Real-Time Audio Library by Ross Bencina and + * Phil Burk. + * + * Permission is hereby granted, free of charge, to any person obtaining + * a copy of this software and associated documentation files + * (the "Software"), to deal in the Software without restriction, + * including without limitation the rights to use, copy, modify, merge, + * publish, distribute, sublicense, and/or sell copies of the Software, + * and to permit persons to whom the Software is furnished to do so, + * subject to the following conditions: + * + * The above copyright notice and this permission notice shall be + * included in all copies or substantial portions of the Software. + * + * Any person wishing to distribute modifications to the Software is + * requested to send the modifications to the original developer so that + * they can be incorporated into the canonical version. + * + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, + * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF + * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. + * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR + * ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF + * CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION + * WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + * + *} +unit portmixer; + +{$IFDEF FPC} + {$PACKRECORDS C} (* GCC/Visual C/C++ compatible record packing *) + {$MODE DELPHI } +{$ENDIF} + +interface + +uses + portaudio; + +const +{$IFDEF MSWINDOWS} + LibName = 'portmixer.dll'; +{$ENDIF} +{$IFDEF LINUX} + LibName = 'libportmixer.so'; +{$ENDIF} +{$IFDEF DARWIN} +// LibName = 'libportmixer.dylib'; +// {$LINKLIB libportaudio} +{$ENDIF} + +type + PPxMixer = Pointer; + TPxVolume = Single; {* 0.0 (min) --> 1.0 (max) *} + TPxBalance = Single; {* -1.0 (left) --> 1.0 (right) *} + +{* + Px_OpenMixer() returns a mixer which will work with the given PortAudio + audio device. Pass 0 as the index for the first (default) mixer. +*} + +function Px_OpenMixer( pa_stream: Pointer; i: Integer ): PPxMixer; cdecl; external LibName; + +{* + Px_CloseMixer() closes a mixer opened using Px_OpenMixer and frees any + memory associated with it. +*} + +procedure Px_CloseMixer( mixer: PPxMixer ); cdecl; external LibName; + +{* + Px_GetNumMixers returns the number of mixers which could be + used with the given PortAudio device. On most systems, there + will be only one mixer for each device; however there may be + multiple mixers for each device, or possibly multiple mixers + which are independent of any particular PortAudio device. +*} + +function Px_GetNumMixers( mixer: PPxMixer ): Integer; cdecl; external LibName; +function Px_GetMixerName( mixer: PPxMixer; i: Integer ): PChar; cdecl; external LibName; + +{* + Master (output) volume +*} + +function Px_GetMasterVolume( mixer: PPxMixer ): TPxVolume; cdecl; external LibName; +procedure Px_SetMasterVolume( mixer: PPxMixer; volume: TPxVolume ); cdecl; external LibName; + +{* + Main output volume +*} + +function Px_GetPCMOutputVolume( mixer: PPxMixer ): TPxVolume; cdecl; external LibName; +procedure Px_SetPCMOutputVolume( mixer: PPxMixer; volume: TPxVolume ); cdecl; external LibName; +function Px_SupportsPCMOutputVolume( mixer: PPxMixer ): Integer; cdecl; external LibName; + +{* + All output volumes +*} + +function Px_GetNumOutputVolumes( mixer: PPxMixer ): Integer; cdecl; external LibName; +function Px_GetOutputVolumeName( mixer: PPxMixer; i: Integer ): PChar; cdecl; external LibName; +function Px_GetOutputVolume( mixer: PPxMixer; i: Integer ): TPxVolume; cdecl; external LibName; +procedure Px_SetOutputVolume( mixer: PPxMixer; i: Integer; volume: TPxVolume ); cdecl; external LibName; + +{* + Input source +*} + +function Px_GetNumInputSources( mixer: PPxMixer ): Integer; cdecl; external LibName; +function Px_GetInputSourceName( mixer: PPxMixer; i: Integer): PChar; cdecl; external LibName; +function Px_GetCurrentInputSource( mixer: PPxMixer ): Integer; cdecl; external LibName; {* may return -1 == none *} +procedure Px_SetCurrentInputSource( mixer: PPxMixer; i: Integer ); cdecl; external LibName; + +{* + Input volume +*} + +function Px_GetInputVolume( mixer: PPxMixer ): TPxVolume; cdecl; external LibName; +procedure Px_SetInputVolume( mixer: PPxMixer; volume: TPxVolume ); cdecl; external LibName; + +{* + Balance +*} + +function Px_SupportsOutputBalance( mixer: PPxMixer ): Integer; cdecl; external LibName; +function Px_GetOutputBalance( mixer: PPxMixer ): TPxBalance; cdecl; external LibName; +procedure Px_SetOutputBalance( mixer: PPxMixer; balance: TPxBalance ); cdecl; external LibName; + +{* + Playthrough +*} + +function Px_SupportsPlaythrough( mixer: PPxMixer ): Integer; cdecl; external LibName; +function Px_GetPlaythrough( mixer: PPxMixer ): TPxVolume; cdecl; external LibName; +procedure Px_SetPlaythrough( mixer: PPxMixer; volume: TPxVolume ); cdecl; external LibName; + +implementation + +end. diff --git a/Game/Code/lib/projectM/cwrapper/Makefile.in b/Game/Code/lib/projectM/cwrapper/Makefile.in index d2be8613..d2be8613 100755..100644 --- a/Game/Code/lib/projectM/cwrapper/Makefile.in +++ b/Game/Code/lib/projectM/cwrapper/Makefile.in diff --git a/Game/Code/lib/projectM/cwrapper/projectM-cwrapper.cpp b/Game/Code/lib/projectM/cwrapper/projectM-cwrapper.cpp index 4b81130d..4b81130d 100755..100644 --- a/Game/Code/lib/projectM/cwrapper/projectM-cwrapper.cpp +++ b/Game/Code/lib/projectM/cwrapper/projectM-cwrapper.cpp diff --git a/Game/Code/lib/projectM/cwrapper/projectM-cwrapper.h b/Game/Code/lib/projectM/cwrapper/projectM-cwrapper.h index 60e1dbb8..630becbb 100755..100644 --- a/Game/Code/lib/projectM/cwrapper/projectM-cwrapper.h +++ b/Game/Code/lib/projectM/cwrapper/projectM-cwrapper.h @@ -1,65 +1,65 @@ -#ifndef __PROJECTM_CWRAPPER_H__
-#define __PROJECTM_CWRAPPER_H__
-
-#include "projectM.hpp"
-
-#define PROJECTM_VERSION_1_00_00 1000000 // 1.00.00 = 1.0 or 1.01
-#define PROJECTM_VERSION_1_10_00 1010000 // 1.10.00 = 1.1
-
-// version of projectM to wrap (see PROJECTM_VERSION)
-#ifndef PROJECTM_VERSION_INT
-#define PROJECTM_VERSION_INT PROJECTM_VERSION_1_10_00
-#endif
-
-extern "C" {
-
- #if (PROJECTM_VERSION_INT >= 1010000)
- struct Settings {
- int meshX;
- int meshY;
- int fps;
- int textureSize;
- int windowWidth;
- int windowHeight;
- const char* presetURL;
- const char* titleFontURL;
- const char* menuFontURL;
- int smoothPresetDuration;
- int presetDuration;
- float beatSensitivity;
- char aspectCorrection;
- float easterEgg;
- char shuffleEnabled;
- };
- #endif
-
- typedef void* projectM_ptr;
-
- DLLEXPORT projectM_ptr projectM_create1(char* config_file);
- #if (PROJECTM_VERSION_INT < 1010000)
- DLLEXPORT projectM_ptr projectM_create2(int gx, int gy, int fps, int texsize,
- int width, int height, char* preset_url,
- char* title_fonturl, char* title_menuurl);
- #endif
-
- DLLEXPORT void projectM_resetGL(projectM_ptr pm, int width, int height);
- DLLEXPORT void projectM_setTitle(projectM_ptr pm, char* title);
- DLLEXPORT void projectM_renderFrame(projectM_ptr pm);
- DLLEXPORT unsigned projectM_initRenderToTexture(projectM_ptr pm);
- DLLEXPORT void projectM_key_handler(projectM_ptr pm, projectMEvent event,
- projectMKeycode keycode, projectMModifier modifier);
-
- DLLEXPORT void projectM_free(projectM_ptr pm);
-
- DLLEXPORT void PCM_addPCMfloat(projectM_ptr pm, float *PCMdata, int samples);
- DLLEXPORT void PCM_addPCM16(projectM_ptr pm, short [2][512]);
- DLLEXPORT void PCM_addPCM16Data(projectM_ptr pm, const short* pcm_data, short samples);
- DLLEXPORT void PCM_addPCM8(projectM_ptr pm, unsigned char [2][1024]);
- DLLEXPORT void PCM_addPCM8_512(projectM_ptr pm, const unsigned char [2][512]);
-
- #if (PROJECTM_VERSION_INT >= 1010000)
- DLLEXPORT void projectM_settings(projectM_ptr pm, Settings* settings);
- #endif
-}
-
-#endif
+#ifndef __PROJECTM_CWRAPPER_H__ +#define __PROJECTM_CWRAPPER_H__ + +#include "projectM.hpp" + +#define PROJECTM_VERSION_1_00_00 1000000 // 1.00.00 = 1.0 or 1.01 +#define PROJECTM_VERSION_1_10_00 1010000 // 1.10.00 = 1.1 + +// version of projectM to wrap (see PROJECTM_VERSION) +#ifndef PROJECTM_VERSION_INT +#define PROJECTM_VERSION_INT PROJECTM_VERSION_1_10_00 +#endif + +extern "C" { + + #if (PROJECTM_VERSION_INT >= 1010000) + struct Settings { + int meshX; + int meshY; + int fps; + int textureSize; + int windowWidth; + int windowHeight; + const char* presetURL; + const char* titleFontURL; + const char* menuFontURL; + int smoothPresetDuration; + int presetDuration; + float beatSensitivity; + char aspectCorrection; + float easterEgg; + char shuffleEnabled; + }; + #endif + + typedef void* projectM_ptr; + + DLLEXPORT projectM_ptr projectM_create1(char* config_file); + #if (PROJECTM_VERSION_INT < 1010000) + DLLEXPORT projectM_ptr projectM_create2(int gx, int gy, int fps, int texsize, + int width, int height, char* preset_url, + char* title_fonturl, char* title_menuurl); + #endif + + DLLEXPORT void projectM_resetGL(projectM_ptr pm, int width, int height); + DLLEXPORT void projectM_setTitle(projectM_ptr pm, char* title); + DLLEXPORT void projectM_renderFrame(projectM_ptr pm); + DLLEXPORT unsigned projectM_initRenderToTexture(projectM_ptr pm); + DLLEXPORT void projectM_key_handler(projectM_ptr pm, projectMEvent event, + projectMKeycode keycode, projectMModifier modifier); + + DLLEXPORT void projectM_free(projectM_ptr pm); + + DLLEXPORT void PCM_addPCMfloat(projectM_ptr pm, float *PCMdata, int samples); + DLLEXPORT void PCM_addPCM16(projectM_ptr pm, short [2][512]); + DLLEXPORT void PCM_addPCM16Data(projectM_ptr pm, const short* pcm_data, short samples); + DLLEXPORT void PCM_addPCM8(projectM_ptr pm, unsigned char [2][1024]); + DLLEXPORT void PCM_addPCM8_512(projectM_ptr pm, const unsigned char [2][512]); + + #if (PROJECTM_VERSION_INT >= 1010000) + DLLEXPORT void projectM_settings(projectM_ptr pm, Settings* settings); + #endif +} + +#endif diff --git a/Game/Code/lib/requirements.txt b/Game/Code/lib/requirements.txt index 09b2b0fa..a5af1ac4 100644 --- a/Game/Code/lib/requirements.txt +++ b/Game/Code/lib/requirements.txt @@ -1,39 +1,39 @@ -Included in SVN ..
----------------------------------------------------------------------------
-
-
-Jedi-sdl
- http://sourceforge.net/projects/jedi-sdl
-
-pngImage
- http://pngdelphi.sourceforge.net/
-
-BASS.pas
- http://www.un4seen.com/download.php?bass23
-
-zlportio
- http://www.specosoft.com/en/download.html
-
-ffmpeg
- http://www.iversenit.dk/dev/ffmpeg-headers/
-
-SQLLite Wrapper
- http://www.itwriting.com/sqlitesimple.php
-
-======================================
-For LINUX build
-======================================
-On top of the above pas files, you will need development libraries for them.
-
-here are the instructions needed to compile on ubunty ( 7.04 )
-
- sudo apt-get install libavcodec-dev libavformat-dev libsqlite3-dev libsdl-ttf2.0-dev libsdl-image1.2-dev portaudio19-dev
-
-in order to build the configure file ( with autogen.sh )
-
- sudo apt-get install automake autoconf
-
-
-for Fedora 8 ( contributed by kdub )
-
- yum install ffmpeg-devel portaudio-devel SDL_ttf-devel SDL_image-devel sqlite-devel
+Included in SVN .. +--------------------------------------------------------------------------- + + +Jedi-sdl + http://sourceforge.net/projects/jedi-sdl + +pngImage + http://pngdelphi.sourceforge.net/ + +BASS.pas + http://www.un4seen.com/download.php?bass23 + +zlportio + http://www.specosoft.com/en/download.html + +ffmpeg + http://www.iversenit.dk/dev/ffmpeg-headers/ + +SQLLite Wrapper + http://www.itwriting.com/sqlitesimple.php + +====================================== +For LINUX build +====================================== +On top of the above pas files, you will need development libraries for them. + +here are the instructions needed to compile on ubunty ( 7.04 ) + + sudo apt-get install libavcodec-dev libavformat-dev libsqlite3-dev libsdl-ttf2.0-dev libsdl-image1.2-dev portaudio19-dev + +in order to build the configure file ( with autogen.sh ) + + sudo apt-get install automake autoconf + + +for Fedora 8 ( contributed by kdub ) + + yum install ffmpeg-devel portaudio-devel SDL_ttf-devel SDL_image-devel sqlite-devel diff --git a/Game/Code/lib/samplerate/samplerate.pas b/Game/Code/lib/samplerate/samplerate.pas index ab163882..3ef78abe 100644 --- a/Game/Code/lib/samplerate/samplerate.pas +++ b/Game/Code/lib/samplerate/samplerate.pas @@ -1,203 +1,203 @@ -{*
-** Copyright (C) 2002-2004 Erik de Castro Lopo <erikd@mega-nerd.com>
-**
-** This program is free software; you can redistribute it and/or modify
-** it under the terms of the GNU General Public License as published by
-** the Free Software Foundation; either version 2 of the License, or
-** (at your option) any later version.
-**
-** This program 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 General Public License for more details.
-**
-** You should have received a copy of the GNU General Public License
-** along with this program; if not, write to the Free Software
-** Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
-*}
-
-{*
-** API documentation is available here:
-** http://www.mega-nerd.com/SRC/api.html
-*}
-
-unit samplerate;
-
-{$IFDEF FPC}
- {$PACKRECORDS C} (* GCC/Visual C/C++ compatible record packing *)
- {$MODE DELPHI}
-{$ENDIF}
-
-interface
-
-const
-{$IFDEF MSWINDOWS}
- LibName = 'libsamplerate.dll';
-{$ENDIF}
-{$IFDEF LINUX}
- LibName = 'samplerate';
-{$ENDIF}
-{$IFDEF DARWIN}
-// LibName = 'libsamplerate.dylib';
-// {$LINKLIB libsamplerate}
-{$ENDIF}
-
-{ Opaque data type SRC_STATE. }
-type
- PSRC_STATE = ^SRC_STATE;
- SRC_STATE = record
- end;
-
-{ SRC_DATA is used to pass data to src_simple() and src_process(). }
-type
- PSRC_DATA = ^SRC_DATA;
- SRC_DATA = record
- data_in: Pdouble;
- data_out: Pdouble;
- input_frames: longint;
- output_frames: longint;
- input_frames_used: longint;
- output_frames_gen: longint;
- end_of_input: integer;
- src_ratio: double;
- end;
-
-{ SRC_CB_DATA is used with callback based API. }
-type
- SRC_CB_DATA = record
- frames: longint;
- data_in: Psingle;
- end;
-
-type
- PPsingle = ^Psingle;
-
-{*
-** User supplied callback function type for use with src_callback_new()
-** and src_callback_read(). First parameter is the same pointer that was
-** passed into src_callback_new(). Second parameter is pointer to a
-** pointer. The user supplied callback function must modify *data to
-** point to the start of the user supplied float array. The user supplied
-** function must return the number of frames that **data points to.
-*}
-src_callback_t = function (cb_data: pointer; data: PPsingle): longint; cdecl;
-
-{*
-** Standard initialisation function : return an anonymous pointer to the
-** internal state of the converter. Choose a converter from the enums below.
-** Error returned in *error.
-*}
-function src_new(converter_type: integer; channels: integer; error: Pinteger): PSRC_STATE; cdecl; external LibName;
-
-{*
-** Initilisation for callback based API : return an anonymous pointer to the
-** internal state of the converter. Choose a converter from the enums below.
-** The cb_data pointer can point to any data or be set to NULL. Whatever the
-** value, when processing, user supplied function "func" gets called with
-** cb_data as first parameter.
-*}
-function src_callback_new(func: src_callback_t; converter_type: integer; channels: integer;
- error: Pinteger; cb_data: pointer): PSRC_STATE; cdecl; external LibName;
-
-{*
-** Cleanup all internal allocations.
-** Always returns NULL.
-*}
-function src_delete(state: PSRC_STATE): PSRC_STATE; cdecl; external LibName;
-
-{*
-** Standard processing function.
-** Returns non zero on error.
-*}
-function src_process(state: PSRC_STATE; data: PSRC_DATA): integer; cdecl; external LibName;
-
-{*
-** Callback based processing function. Read up to frames worth of data from
-** the converter int *data and return frames read or -1 on error.
-*}
-function src_callback_read(state: PSRC_STATE; src_ratio: double;
- frames: longint; data: Psingle): longint; cdecl; external LibName;
-
-{*
-** Simple interface for performing a single conversion from input buffer to
-** output buffer at a fixed conversion ratio.
-** Simple interface does not require initialisation as it can only operate on
-** a single buffer worth of audio.
-*}
-function src_simple(data: PSRC_DATA; converter_type: integer; channels: integer): integer; cdecl; external LibName;
-
-{*
-** This library contains a number of different sample rate converters,
-** numbered 0 through N.
-**
-** Return a string giving either a name or a more full description of each
-** sample rate converter or NULL if no sample rate converter exists for
-** the given value. The converters are sequentially numbered from 0 to N.
-*}
-(* Const before type ignored *)
-function src_get_name(converter_type: integer): Pchar; cdecl; external LibName;
-
-(* Const before type ignored *)
-function src_get_description(converter_type: integer): Pchar; cdecl; external LibName;
-
-(* Const before type ignored *)
-function src_get_version(): Pchar; cdecl; external LibName;
-
-{*
-** Set a new SRC ratio. This allows step responses
-** in the conversion ratio.
-** Returns non zero on error.
-*}
-function src_set_ratio(state: PSRC_STATE; new_ratio: double): integer; cdecl; external LibName;
-
-{*
-** Reset the internal SRC state.
-** Does not modify the quality settings.
-** Does not free any memory allocations.
-** Returns non zero on error.
-*}
-function src_reset(state: PSRC_STATE): integer; cdecl; external LibName;
-
-{*
-** Return TRUE if ratio is a valid conversion ratio, FALSE
-** otherwise.
-*}
-function src_is_valid_ratio(ratio: double): integer; cdecl; external LibName;
-
-{*
-** Return an error number.
-*}
-function src_error(state: PSRC_STATE): integer; cdecl; external LibName;
-
-{*
-** Convert the error number into a string.
-*}
-(* Const before type ignored *)
-function src_strerror(error: integer): Pchar; cdecl; external LibName;
-
-{*
-** The following enums can be used to set the interpolator type
-** using the function src_set_converter().
-*}
-type TConverterType = {enum}integer; const
-{enum_begin TConverterType}
- SRC_SINC_BEST_QUALITY = 0;
- SRC_SINC_MEDIUM_QUALITY = 1;
- SRC_SINC_FASTEST = 2;
- SRC_ZERO_ORDER_HOLD = 3;
- SRC_LINEAR = 4;
-{enum_end TConverterType}
-
-{*
-** Extra helper functions for converting from short to float and
-** back again.
-*}
-(* Const before type ignored *)
-procedure src_short_to_float_array(input: Psmallint; output: Psingle; len: integer); cdecl; external LibName;
-
-(* Const before type ignored *)
-procedure src_float_to_short_array(input: Psingle; output: Psmallint; len: integer); cdecl; external LibName;
-
-implementation
-
-end.
+{* +** Copyright (C) 2002-2004 Erik de Castro Lopo <erikd@mega-nerd.com> +** +** This program is free software; you can redistribute it and/or modify +** it under the terms of the GNU General Public License as published by +** the Free Software Foundation; either version 2 of the License, or +** (at your option) any later version. +** +** This program 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 General Public License for more details. +** +** You should have received a copy of the GNU General Public License +** along with this program; if not, write to the Free Software +** Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. +*} + +{* +** API documentation is available here: +** http://www.mega-nerd.com/SRC/api.html +*} + +unit samplerate; + +{$IFDEF FPC} + {$PACKRECORDS C} (* GCC/Visual C/C++ compatible record packing *) + {$MODE DELPHI} +{$ENDIF} + +interface + +const +{$IFDEF MSWINDOWS} + LibName = 'libsamplerate.dll'; +{$ENDIF} +{$IFDEF LINUX} + LibName = 'samplerate'; +{$ENDIF} +{$IFDEF DARWIN} +// LibName = 'libsamplerate.dylib'; +// {$LINKLIB libsamplerate} +{$ENDIF} + +{ Opaque data type SRC_STATE. } +type + PSRC_STATE = ^SRC_STATE; + SRC_STATE = record + end; + +{ SRC_DATA is used to pass data to src_simple() and src_process(). } +type + PSRC_DATA = ^SRC_DATA; + SRC_DATA = record + data_in: Pdouble; + data_out: Pdouble; + input_frames: longint; + output_frames: longint; + input_frames_used: longint; + output_frames_gen: longint; + end_of_input: integer; + src_ratio: double; + end; + +{ SRC_CB_DATA is used with callback based API. } +type + SRC_CB_DATA = record + frames: longint; + data_in: Psingle; + end; + +type + PPsingle = ^Psingle; + +{* +** User supplied callback function type for use with src_callback_new() +** and src_callback_read(). First parameter is the same pointer that was +** passed into src_callback_new(). Second parameter is pointer to a +** pointer. The user supplied callback function must modify *data to +** point to the start of the user supplied float array. The user supplied +** function must return the number of frames that **data points to. +*} +src_callback_t = function (cb_data: pointer; data: PPsingle): longint; cdecl; + +{* +** Standard initialisation function : return an anonymous pointer to the +** internal state of the converter. Choose a converter from the enums below. +** Error returned in *error. +*} +function src_new(converter_type: integer; channels: integer; error: Pinteger): PSRC_STATE; cdecl; external LibName; + +{* +** Initilisation for callback based API : return an anonymous pointer to the +** internal state of the converter. Choose a converter from the enums below. +** The cb_data pointer can point to any data or be set to NULL. Whatever the +** value, when processing, user supplied function "func" gets called with +** cb_data as first parameter. +*} +function src_callback_new(func: src_callback_t; converter_type: integer; channels: integer; + error: Pinteger; cb_data: pointer): PSRC_STATE; cdecl; external LibName; + +{* +** Cleanup all internal allocations. +** Always returns NULL. +*} +function src_delete(state: PSRC_STATE): PSRC_STATE; cdecl; external LibName; + +{* +** Standard processing function. +** Returns non zero on error. +*} +function src_process(state: PSRC_STATE; data: PSRC_DATA): integer; cdecl; external LibName; + +{* +** Callback based processing function. Read up to frames worth of data from +** the converter int *data and return frames read or -1 on error. +*} +function src_callback_read(state: PSRC_STATE; src_ratio: double; + frames: longint; data: Psingle): longint; cdecl; external LibName; + +{* +** Simple interface for performing a single conversion from input buffer to +** output buffer at a fixed conversion ratio. +** Simple interface does not require initialisation as it can only operate on +** a single buffer worth of audio. +*} +function src_simple(data: PSRC_DATA; converter_type: integer; channels: integer): integer; cdecl; external LibName; + +{* +** This library contains a number of different sample rate converters, +** numbered 0 through N. +** +** Return a string giving either a name or a more full description of each +** sample rate converter or NULL if no sample rate converter exists for +** the given value. The converters are sequentially numbered from 0 to N. +*} +(* Const before type ignored *) +function src_get_name(converter_type: integer): Pchar; cdecl; external LibName; + +(* Const before type ignored *) +function src_get_description(converter_type: integer): Pchar; cdecl; external LibName; + +(* Const before type ignored *) +function src_get_version(): Pchar; cdecl; external LibName; + +{* +** Set a new SRC ratio. This allows step responses +** in the conversion ratio. +** Returns non zero on error. +*} +function src_set_ratio(state: PSRC_STATE; new_ratio: double): integer; cdecl; external LibName; + +{* +** Reset the internal SRC state. +** Does not modify the quality settings. +** Does not free any memory allocations. +** Returns non zero on error. +*} +function src_reset(state: PSRC_STATE): integer; cdecl; external LibName; + +{* +** Return TRUE if ratio is a valid conversion ratio, FALSE +** otherwise. +*} +function src_is_valid_ratio(ratio: double): integer; cdecl; external LibName; + +{* +** Return an error number. +*} +function src_error(state: PSRC_STATE): integer; cdecl; external LibName; + +{* +** Convert the error number into a string. +*} +(* Const before type ignored *) +function src_strerror(error: integer): Pchar; cdecl; external LibName; + +{* +** The following enums can be used to set the interpolator type +** using the function src_set_converter(). +*} +type TConverterType = {enum}integer; const +{enum_begin TConverterType} + SRC_SINC_BEST_QUALITY = 0; + SRC_SINC_MEDIUM_QUALITY = 1; + SRC_SINC_FASTEST = 2; + SRC_ZERO_ORDER_HOLD = 3; + SRC_LINEAR = 4; +{enum_end TConverterType} + +{* +** Extra helper functions for converting from short to float and +** back again. +*} +(* Const before type ignored *) +procedure src_short_to_float_array(input: Psmallint; output: Psingle; len: integer); cdecl; external LibName; + +(* Const before type ignored *) +procedure src_float_to_short_array(input: Psingle; output: Psmallint; len: integer); cdecl; external LibName; + +implementation + +end. diff --git a/Game/Code/lib/zlib/zlib.pas b/Game/Code/lib/zlib/zlib.pas index c1e21a4c..f613e20c 100644 --- a/Game/Code/lib/zlib/zlib.pas +++ b/Game/Code/lib/zlib/zlib.pas @@ -1,211 +1,211 @@ -(*
- * zlib pascal headers
- * This file is part of Free Pascal, released under the LGPL.
- *)
-
-{$ifdef FPC}
- {$ifndef NO_SMART_LINK}
- {$smartlink on}
- {$endif}
-{$endif}
-unit zlib;
-
-interface
-
-{$ifdef FPC}
- {$mode objfpc} // Needed for array of const
- {$H+} // use AnsiString
- {$PACKRECORDS C}
-{$endif}
-
-const
- ZLIB_VERSION = '1.2.3';
-
-{$ifdef MSWINDOWS}
- libz = 'zlib1';
-{$else}
- libz = 'z';
- {$IFDEF DARWIN}
- {$linklib libz}
- {$ENDIF}
-{$endif}
-
-type
- { Compatible with paszlib }
- Uint = Cardinal;
- Ulong = Longword;
- Ulongf = Longword;
- Pulongf = ^Ulongf;
- z_off_t = longint;
- pbyte = ^byte;
- pbytef = ^byte;
- voidpf = pointer;
-
- TAllocfunc = function (opaque: voidpf; items: uInt; size: uInt): voidpf; cdecl;
- TFreeFunc = procedure (opaque: voidpf; address: voidpf); cdecl;
-
- TInternalState = record
- end;
- PInternalState = ^TInternalstate;
-
- TZStream = record
- next_in: pbytef;
- avail_in: uInt;
- total_in: uLong;
- next_out: pbytef;
- avail_out: uInt;
- total_out: uLong;
- msg: pchar;
- state: PInternalState;
- zalloc: TAllocFunc;
- zfree: TFreeFunc;
- opaque: voidpf;
- data_type: integer;
- adler: uLong;
- reserved: uLong;
- end;
- TZStreamRec = TZStream;
- PZstream = ^TZStream;
- gzFile = pointer;
-
-
-const
- Z_NO_FLUSH = 0;
- Z_PARTIAL_FLUSH = 1;
- Z_SYNC_FLUSH = 2;
- Z_FULL_FLUSH = 3;
- Z_FINISH = 4;
- Z_BLOCK = 5;
-
- Z_OK = 0;
- Z_STREAM_END = 1;
- Z_NEED_DICT = 2;
- Z_ERRNO = -(1);
- Z_STREAM_ERROR = -(2);
- Z_DATA_ERROR = -(3);
- Z_MEM_ERROR = -(4);
- Z_BUF_ERROR = -(5);
- Z_VERSION_ERROR = -(6);
-
- Z_NO_COMPRESSION = 0;
- Z_BEST_SPEED = 1;
- Z_BEST_COMPRESSION = 9;
- Z_DEFAULT_COMPRESSION = -(1);
-
- Z_FILTERED = 1;
- Z_HUFFMAN_ONLY = 2;
- Z_RLE = 3;
- Z_FIXED = 4;
- Z_DEFAULT_STRATEGY = 0;
-
- Z_BINARY = 0;
- Z_TEXT = 1;
- Z_ASCII = Z_TEXT;
- Z_UNKNOWN = 2;
-
- Z_DEFLATED = 8;
-
- Z_NULL = 0;
-
-function zlibVersionpchar(): pchar; cdecl; external libz name 'zlibVersion';
-function zlibVersion(): string;
-
-function deflate(var strm: TZStream; flush: integer): integer; cdecl; external libz name 'deflate';
-function deflateEnd(var strm: TZStream): integer; cdecl; external libz name 'deflateEnd';
-function inflate(var strm: TZStream; flush: integer): integer; cdecl; external libz name 'inflate';
-function inflateEnd(var strm: TZStream): integer; cdecl; external libz name 'inflateEnd';
-function deflateSetDictionary(var strm: TZStream; dictionary: pbytef; dictLength: uInt): integer; cdecl; external libz name 'deflateSetDictionary';
-function deflateCopy(var dest, source: TZstream): integer; cdecl; external libz name 'deflateCopy';
-function deflateReset(var strm: TZStream): integer; cdecl; external libz name 'deflateReset';
-function deflateParams(var strm: TZStream; level: integer; strategy: integer): integer; cdecl; external libz name 'deflateParams';
-//...
-function inflateSetDictionary(var strm: TZStream; dictionary: pbytef; dictLength: uInt): integer; cdecl; external libz name 'inflateSetDictionary';
-function inflateSync(var strm: TZStream): integer; cdecl; external libz name 'inflateSync';
-//...
-function inflateReset(var strm: TZStream): integer; cdecl; external libz name 'inflateReset';
-
-function compress(dest: pbytef; destLen: puLongf; source : pbytef; sourceLen: uLong): integer; cdecl; external libz name 'compress';
-function compress2(dest: pbytef; destLen: puLongf; source : pbytef; sourceLen: uLong; level: integer): integer; cdecl; external libz name 'compress2';
-function uncompress(dest: pbytef; destLen: puLongf; source : pbytef; sourceLen: uLong): integer; cdecl; external libz name 'uncompress';
-
-function gzopen(path: pchar; mode: pchar): gzFile; cdecl; external libz name 'gzopen';
-function gzdopen(fd: integer; mode: pchar): gzFile; cdecl; external libz name 'gzdopen';
-function gzsetparams(thefile: gzFile; level: integer; strategy: integer): integer; cdecl; external libz name 'gzsetparams';
-function gzread(thefile: gzFile; buf: pointer; len: cardinal): integer; cdecl; external libz name 'gzread';
-function gzwrite(thefile: gzFile; buf: pointer; len: cardinal): integer; cdecl; external libz name 'gzwrite';
-function gzprintf(thefile: gzFile; format: pbytef; args: array of const): integer; cdecl; external libz name 'gzprintf';
-function gzputs(thefile: gzFile; s: pbytef): integer; cdecl; external libz name 'gzputs';
-function gzgets(thefile: gzFile; buf: pbytef; len: integer): pchar; cdecl; external libz name 'gzgets';
-function gzputc(thefile: gzFile; c: integer): integer; cdecl; external libz name 'gzputc';
-function gzgetc(thefile: gzFile): integer; cdecl; external libz name 'gzgetc';
-function gzflush(thefile: gzFile; flush: integer): integer; cdecl; external libz name 'gzflush';
-function gzseek(thefile: gzFile; offset: z_off_t; whence: integer): z_off_t; cdecl; external libz name 'gzseek';
-function gzrewind(thefile: gzFile): integer; cdecl; external libz name 'gzrewind';
-function gztell(thefile: gzFile): z_off_t; cdecl; external libz name 'gztell';
-function gzeof(thefile: gzFile): integer; cdecl; external libz name 'gzeof';
-function gzclose(thefile: gzFile): integer; cdecl; external libz name 'gzclose';
-function gzerror(thefile: gzFile; var errnum: integer): pchar; cdecl; external libz name 'gzerror';
-
-function adler32(adler: uLong; buf: pbytef; len: uInt): uLong; cdecl; external libz name 'adler32';
-function crc32(crc: uLong; buf: pbytef; len: uInt): uLong; cdecl; external libz name 'crc32';
-
-function deflateInit_(var strm: TZStream; level: integer; version: pchar; stream_size: integer): integer; cdecl; external libz name 'deflateInit_';
-function deflateInit(var strm: TZStream; level : integer) : integer;
-function inflateInit_(var strm: TZStream; version: pchar; stream_size: integer): integer; cdecl; external libz name 'inflateInit_';
-function inflateInit(var strm:TZStream) : integer;
-function deflateInit2_(var strm: TZStream; level: integer; method: integer; windowBits: integer; memLevel: integer; strategy: integer; version: pchar; stream_size: integer): integer; cdecl; external libz name 'deflateInit2_';
-function deflateInit2(var strm: TZStream; level, method, windowBits, memLevel, strategy: integer): integer;
-function inflateInit2_(var strm: TZStream; windowBits: integer; version: pchar; stream_size: integer): integer; cdecl; external libz name 'inflateInit2_';
-function inflateInit2(var strm: TZStream; windowBits: integer): integer;
-
-function zErrorpchar(err: integer): pchar; cdecl; external libz name 'zError';
-function zError(err: integer): string;
-function inflateSyncPoint(z: PZstream): integer; cdecl; external libz name 'inflateSyncPoint';
-function get_crc_table(): pointer; cdecl; external libz name 'get_crc_table';
-
-function zlibAllocMem(AppData: Pointer; Items, Size: Integer): Pointer; cdecl;
-procedure zlibFreeMem(AppData, Block: Pointer); cdecl;
-
-implementation
-
-function zlibversion(): string;
-begin
- zlibversion := string(zlibversionpchar);
-end;
-
-function deflateInit(var strm: TZStream; level: integer) : integer;
-begin
- deflateInit := deflateInit_(strm, level, ZLIB_VERSION, sizeof(TZStream));
-end;
-
-function inflateInit(var strm: TZStream): integer;
-begin
- inflateInit := inflateInit_(strm, ZLIB_VERSION, sizeof(TZStream));
-end;
-
-function deflateInit2(var strm: TZStream; level, method, windowBits, memLevel, strategy: integer) : integer;
-begin
- deflateInit2 := deflateInit2_(strm, level, method, windowBits, memLevel, strategy, ZLIB_VERSION, sizeof(TZStream));
-end;
-
-function inflateInit2(var strm: TZStream; windowBits: integer): integer;
-begin
- inflateInit2 := inflateInit2_(strm, windowBits, ZLIB_VERSION, sizeof(TZStream));
-end;
-
-function zError(err: integer): string;
-begin
- zerror := string(zErrorpchar(err));
-end;
-
-function zlibAllocMem(AppData: Pointer; Items, Size: Integer): Pointer; cdecl;
-begin
- Result := GetMemory(Items * Size);
-end;
-
-procedure zlibFreeMem(AppData, Block: Pointer); cdecl;
-begin
- FreeMem(Block);
-end;
-
-end.
+(* + * zlib pascal headers + * This file is part of Free Pascal, released under the LGPL. + *) + +{$ifdef FPC} + {$ifndef NO_SMART_LINK} + {$smartlink on} + {$endif} +{$endif} +unit zlib; + +interface + +{$ifdef FPC} + {$mode objfpc} // Needed for array of const + {$H+} // use AnsiString + {$PACKRECORDS C} +{$endif} + +const + ZLIB_VERSION = '1.2.3'; + +{$ifdef MSWINDOWS} + libz = 'zlib1'; +{$else} + libz = 'z'; + {$IFDEF DARWIN} + {$linklib libz} + {$ENDIF} +{$endif} + +type + { Compatible with paszlib } + Uint = Cardinal; + Ulong = Longword; + Ulongf = Longword; + Pulongf = ^Ulongf; + z_off_t = longint; + pbyte = ^byte; + pbytef = ^byte; + voidpf = pointer; + + TAllocfunc = function (opaque: voidpf; items: uInt; size: uInt): voidpf; cdecl; + TFreeFunc = procedure (opaque: voidpf; address: voidpf); cdecl; + + TInternalState = record + end; + PInternalState = ^TInternalstate; + + TZStream = record + next_in: pbytef; + avail_in: uInt; + total_in: uLong; + next_out: pbytef; + avail_out: uInt; + total_out: uLong; + msg: pchar; + state: PInternalState; + zalloc: TAllocFunc; + zfree: TFreeFunc; + opaque: voidpf; + data_type: integer; + adler: uLong; + reserved: uLong; + end; + TZStreamRec = TZStream; + PZstream = ^TZStream; + gzFile = pointer; + + +const + Z_NO_FLUSH = 0; + Z_PARTIAL_FLUSH = 1; + Z_SYNC_FLUSH = 2; + Z_FULL_FLUSH = 3; + Z_FINISH = 4; + Z_BLOCK = 5; + + Z_OK = 0; + Z_STREAM_END = 1; + Z_NEED_DICT = 2; + Z_ERRNO = -(1); + Z_STREAM_ERROR = -(2); + Z_DATA_ERROR = -(3); + Z_MEM_ERROR = -(4); + Z_BUF_ERROR = -(5); + Z_VERSION_ERROR = -(6); + + Z_NO_COMPRESSION = 0; + Z_BEST_SPEED = 1; + Z_BEST_COMPRESSION = 9; + Z_DEFAULT_COMPRESSION = -(1); + + Z_FILTERED = 1; + Z_HUFFMAN_ONLY = 2; + Z_RLE = 3; + Z_FIXED = 4; + Z_DEFAULT_STRATEGY = 0; + + Z_BINARY = 0; + Z_TEXT = 1; + Z_ASCII = Z_TEXT; + Z_UNKNOWN = 2; + + Z_DEFLATED = 8; + + Z_NULL = 0; + +function zlibVersionpchar(): pchar; cdecl; external libz name 'zlibVersion'; +function zlibVersion(): string; + +function deflate(var strm: TZStream; flush: integer): integer; cdecl; external libz name 'deflate'; +function deflateEnd(var strm: TZStream): integer; cdecl; external libz name 'deflateEnd'; +function inflate(var strm: TZStream; flush: integer): integer; cdecl; external libz name 'inflate'; +function inflateEnd(var strm: TZStream): integer; cdecl; external libz name 'inflateEnd'; +function deflateSetDictionary(var strm: TZStream; dictionary: pbytef; dictLength: uInt): integer; cdecl; external libz name 'deflateSetDictionary'; +function deflateCopy(var dest, source: TZstream): integer; cdecl; external libz name 'deflateCopy'; +function deflateReset(var strm: TZStream): integer; cdecl; external libz name 'deflateReset'; +function deflateParams(var strm: TZStream; level: integer; strategy: integer): integer; cdecl; external libz name 'deflateParams'; +//... +function inflateSetDictionary(var strm: TZStream; dictionary: pbytef; dictLength: uInt): integer; cdecl; external libz name 'inflateSetDictionary'; +function inflateSync(var strm: TZStream): integer; cdecl; external libz name 'inflateSync'; +//... +function inflateReset(var strm: TZStream): integer; cdecl; external libz name 'inflateReset'; + +function compress(dest: pbytef; destLen: puLongf; source : pbytef; sourceLen: uLong): integer; cdecl; external libz name 'compress'; +function compress2(dest: pbytef; destLen: puLongf; source : pbytef; sourceLen: uLong; level: integer): integer; cdecl; external libz name 'compress2'; +function uncompress(dest: pbytef; destLen: puLongf; source : pbytef; sourceLen: uLong): integer; cdecl; external libz name 'uncompress'; + +function gzopen(path: pchar; mode: pchar): gzFile; cdecl; external libz name 'gzopen'; +function gzdopen(fd: integer; mode: pchar): gzFile; cdecl; external libz name 'gzdopen'; +function gzsetparams(thefile: gzFile; level: integer; strategy: integer): integer; cdecl; external libz name 'gzsetparams'; +function gzread(thefile: gzFile; buf: pointer; len: cardinal): integer; cdecl; external libz name 'gzread'; +function gzwrite(thefile: gzFile; buf: pointer; len: cardinal): integer; cdecl; external libz name 'gzwrite'; +function gzprintf(thefile: gzFile; format: pbytef; args: array of const): integer; cdecl; external libz name 'gzprintf'; +function gzputs(thefile: gzFile; s: pbytef): integer; cdecl; external libz name 'gzputs'; +function gzgets(thefile: gzFile; buf: pbytef; len: integer): pchar; cdecl; external libz name 'gzgets'; +function gzputc(thefile: gzFile; c: integer): integer; cdecl; external libz name 'gzputc'; +function gzgetc(thefile: gzFile): integer; cdecl; external libz name 'gzgetc'; +function gzflush(thefile: gzFile; flush: integer): integer; cdecl; external libz name 'gzflush'; +function gzseek(thefile: gzFile; offset: z_off_t; whence: integer): z_off_t; cdecl; external libz name 'gzseek'; +function gzrewind(thefile: gzFile): integer; cdecl; external libz name 'gzrewind'; +function gztell(thefile: gzFile): z_off_t; cdecl; external libz name 'gztell'; +function gzeof(thefile: gzFile): integer; cdecl; external libz name 'gzeof'; +function gzclose(thefile: gzFile): integer; cdecl; external libz name 'gzclose'; +function gzerror(thefile: gzFile; var errnum: integer): pchar; cdecl; external libz name 'gzerror'; + +function adler32(adler: uLong; buf: pbytef; len: uInt): uLong; cdecl; external libz name 'adler32'; +function crc32(crc: uLong; buf: pbytef; len: uInt): uLong; cdecl; external libz name 'crc32'; + +function deflateInit_(var strm: TZStream; level: integer; version: pchar; stream_size: integer): integer; cdecl; external libz name 'deflateInit_'; +function deflateInit(var strm: TZStream; level : integer) : integer; +function inflateInit_(var strm: TZStream; version: pchar; stream_size: integer): integer; cdecl; external libz name 'inflateInit_'; +function inflateInit(var strm:TZStream) : integer; +function deflateInit2_(var strm: TZStream; level: integer; method: integer; windowBits: integer; memLevel: integer; strategy: integer; version: pchar; stream_size: integer): integer; cdecl; external libz name 'deflateInit2_'; +function deflateInit2(var strm: TZStream; level, method, windowBits, memLevel, strategy: integer): integer; +function inflateInit2_(var strm: TZStream; windowBits: integer; version: pchar; stream_size: integer): integer; cdecl; external libz name 'inflateInit2_'; +function inflateInit2(var strm: TZStream; windowBits: integer): integer; + +function zErrorpchar(err: integer): pchar; cdecl; external libz name 'zError'; +function zError(err: integer): string; +function inflateSyncPoint(z: PZstream): integer; cdecl; external libz name 'inflateSyncPoint'; +function get_crc_table(): pointer; cdecl; external libz name 'get_crc_table'; + +function zlibAllocMem(AppData: Pointer; Items, Size: Integer): Pointer; cdecl; +procedure zlibFreeMem(AppData, Block: Pointer); cdecl; + +implementation + +function zlibversion(): string; +begin + zlibversion := string(zlibversionpchar); +end; + +function deflateInit(var strm: TZStream; level: integer) : integer; +begin + deflateInit := deflateInit_(strm, level, ZLIB_VERSION, sizeof(TZStream)); +end; + +function inflateInit(var strm: TZStream): integer; +begin + inflateInit := inflateInit_(strm, ZLIB_VERSION, sizeof(TZStream)); +end; + +function deflateInit2(var strm: TZStream; level, method, windowBits, memLevel, strategy: integer) : integer; +begin + deflateInit2 := deflateInit2_(strm, level, method, windowBits, memLevel, strategy, ZLIB_VERSION, sizeof(TZStream)); +end; + +function inflateInit2(var strm: TZStream; windowBits: integer): integer; +begin + inflateInit2 := inflateInit2_(strm, windowBits, ZLIB_VERSION, sizeof(TZStream)); +end; + +function zError(err: integer): string; +begin + zerror := string(zErrorpchar(err)); +end; + +function zlibAllocMem(AppData: Pointer; Items, Size: Integer): Pointer; cdecl; +begin + Result := GetMemory(Items * Size); +end; + +procedure zlibFreeMem(AppData, Block: Pointer); cdecl; +begin + FreeMem(Block); +end; + +end. diff --git a/Game/Code/lib/zlportio/Example/README.TXT b/Game/Code/lib/zlportio/Example/README.TXT index dd71c689..f8eb7241 100644 --- a/Game/Code/lib/zlportio/Example/README.TXT +++ b/Game/Code/lib/zlportio/Example/README.TXT @@ -1,27 +1,27 @@ -
-PortIO example
-Copyright (C) 2001 Zloba Alexander
-http://www.specosoft.com
-Description
------------
- This example show how tow to get direct access port input and output under
- all versions of Microsoft Windows using ZlPortio library,
-
-Terms of Use
-------------
-
-This software is provided "as is", without any guarantee made
-as to its suitability or fitness for any particular use. It may
-contain bugs, so use of this tool is at your own risk. We take
-no responsilbity for any damage that may unintentionally be caused
-through its use.
-
-Reporting Problems
-------------------
-
-If you encounter problems, please visit http://www.specosoft.com
-and download the latest version to see if the issue has been resolved.
-If not, please send a bug report to:
-
- zal@specosoft.com
-
+ +PortIO example +Copyright (C) 2001 Zloba Alexander +http://www.specosoft.com +Description +----------- + This example show how tow to get direct access port input and output under + all versions of Microsoft Windows using ZlPortio library, + +Terms of Use +------------ + +This software is provided "as is", without any guarantee made +as to its suitability or fitness for any particular use. It may +contain bugs, so use of this tool is at your own risk. We take +no responsilbity for any damage that may unintentionally be caused +through its use. + +Reporting Problems +------------------ + +If you encounter problems, please visit http://www.specosoft.com +and download the latest version to see if the issue has been resolved. +If not, please send a bug report to: + + zal@specosoft.com + diff --git a/Game/Code/lib/zlportio/Example/install.txt b/Game/Code/lib/zlportio/Example/install.txt index 8d4f45a6..fed162bf 100644 --- a/Game/Code/lib/zlportio/Example/install.txt +++ b/Game/Code/lib/zlportio/Example/install.txt @@ -1,6 +1,6 @@ -
-Installation:
-
-Copy files: zlportio.pas, ddkint.pas to your project directory
-or common unit directory.
-
+ +Installation: + +Copy files: zlportio.pas, ddkint.pas to your project directory +or common unit directory. + diff --git a/Game/Code/lib/zlportio/Example/mainform.pas b/Game/Code/lib/zlportio/Example/mainform.pas index 295958c2..2b26228e 100644 --- a/Game/Code/lib/zlportio/Example/mainform.pas +++ b/Game/Code/lib/zlportio/Example/mainform.pas @@ -1,205 +1,205 @@ -{$A-,H+}
-unit mainform;
-
-interface
-
-uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls,zlportio, ComCtrls, shellapi,rdtsc;
-
-type
- TMain = class(TForm)
- lb1: TLabel;
- ePort: TEdit;
- lb2: TLabel;
- eData: TEdit;
- eRData: TEdit;
- btnExit: TButton;
- lb3: TLabel;
- coDataType: TComboBox;
- Lb4: TLabel;
- gb1: TGroupBox;
- sbBar: TStatusBar;
- lb5: TLabel;
- btnWrite: TButton;
- btnRead: TButton;
- cbDirect: TCheckBox;
- llbWWW: TLabel;
- procedure btnExitClick(Sender: TObject);
- procedure ePortKeyUp(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- procedure ePortKeyPress(Sender: TObject; var Key: Char);
- procedure FormCreate(Sender: TObject);
- procedure coDataTypeChange(Sender: TObject);
- procedure ePortKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- procedure btnWriteClick(Sender: TObject);
- procedure eDataKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- procedure btnReadClick(Sender: TObject);
- procedure cbDirectClick(Sender: TObject);
- procedure llbWWWClick(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- procedure setrdata(const Data:dword);
- function str2int(const value:string;const HEX:boolean):integer;
- end;
-
-var
- Main: TMain;
-implementation
-
-{$R *.DFM}
-{$R-}
-
-function TMain.str2int(const value:string;const HEX:boolean):integer;
-begin
- if HEX then
- result := strtoint('$' + value)
- else
- result := strtoint(value);
-end;
-
-
-procedure TMain.btnExitClick(Sender: TObject);
-begin
- close;
-end;
-
-procedure TMain.ePortKeyUp(Sender: TObject; var Key: Word;
- Shift: TShiftState);
-begin
-try
- Case key of
- 38: begin
- key := 0;
- end;
- 40: begin
- key := 0;
- end
- end;
-except
-end;
-end;
-
-procedure TMain.ePortKeyPress(Sender: TObject; var Key: Char);
-begin
- // filter on hex
- if pos(key,#13#8'0123456789abcdefABCDEF')=0 then
- key := #0;
-end;
-
-procedure TMain.FormCreate(Sender: TObject);
-begin
- coDataType.itemindex :=0;
- coDataType.Tag := 2;
- if ZLIOStarted then
- sbBar.SimpleText := 'Driver successfully started !'
- else
- sbBar.SimpleText := 'Couldnt start driver. Something wrong !';
-end;
-
-procedure TMain.coDataTypeChange(Sender: TObject);
-var s:string;
-begin
- coDataType.Tag := 2 shl (coDataType.itemindex);
- erdata.MaxLength := coDataType.Tag;
- edata.MaxLength := coDataType.Tag;
- s := edata.Text;
- delete(s,1,length(s)-coDataType.Tag);
- edata.text := s;
-end;
-
-procedure TMain.ePortKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
-var Port,data:dword;
-begin
-try
- try
- Port := str2int(ePort.Text,true);
- except
- Port := 0;
- end;
- Case key of
- 13: begin
- zlioportwrite(port,coDataType.itemindex,str2int(eData.Text, true));
- end;
- 38: begin
- inc(Port);
- ePort.Text := inttohex(Port,3);
- key := 0;
- end;
- 40: begin
- if port > 0 then
- dec(Port);
- ePort.Text := inttohex(Port,3);
- key := 0;
- end
- end;
- setthreadpriority(GetCurrentThread,THREAD_PRIORITY_TIME_CRITICAL);
- data := zlioportread(Port,coDataType.itemindex);
- setrdata(data);
-except
-end;
-
-end;
-
-procedure TMain.setrdata(const Data:dword);
-begin
- erData.Text := inttohex(Data,coDataType.Tag);
-end;
-
-procedure TMain.btnWriteClick(Sender: TObject);
-var i:word;
-begin
- i := 13;
- ePortKeyDown( self,i,[])
-end;
-
-
-
-procedure TMain.eDataKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
-var data:dword;
-begin
- try
- Data := str2int(eData.Text,true);
- except Data := 0; end;
- Case key of
- 13: begin
- ePortKeyDown( self,key,[])
- end;
- 38: begin
- inc(Data);
- eData.Text := inttohex(Data,coDataType.Tag);
- key := 0;
- end;
- 40: begin
- dec(Data);
- eData.Text := inttohex(Data,coDataType.Tag);
- key := 0;
- end
- end;
-
-end;
-
-procedure TMain.btnReadClick(Sender: TObject);
-var k:word;
-begin
- k := 0;
- ePortKeyDown(self, k,[]);
-end;
-
-procedure TMain.cbDirectClick(Sender: TObject);
-begin
-zliosetiopm(cbDirect.Checked);
-end;
-
-procedure TMain.llbWWWClick(Sender: TObject);
-begin
- shellexecute( 0,'open','http://www.specosoft.com/update/portio_15.htm',nil,nil,SW_SHOW);
-end;
-
-end.
+{$A-,H+} +unit mainform; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls,zlportio, ComCtrls, shellapi,rdtsc; + +type + TMain = class(TForm) + lb1: TLabel; + ePort: TEdit; + lb2: TLabel; + eData: TEdit; + eRData: TEdit; + btnExit: TButton; + lb3: TLabel; + coDataType: TComboBox; + Lb4: TLabel; + gb1: TGroupBox; + sbBar: TStatusBar; + lb5: TLabel; + btnWrite: TButton; + btnRead: TButton; + cbDirect: TCheckBox; + llbWWW: TLabel; + procedure btnExitClick(Sender: TObject); + procedure ePortKeyUp(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure ePortKeyPress(Sender: TObject; var Key: Char); + procedure FormCreate(Sender: TObject); + procedure coDataTypeChange(Sender: TObject); + procedure ePortKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure btnWriteClick(Sender: TObject); + procedure eDataKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure btnReadClick(Sender: TObject); + procedure cbDirectClick(Sender: TObject); + procedure llbWWWClick(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + procedure setrdata(const Data:dword); + function str2int(const value:string;const HEX:boolean):integer; + end; + +var + Main: TMain; +implementation + +{$R *.DFM} +{$R-} + +function TMain.str2int(const value:string;const HEX:boolean):integer; +begin + if HEX then + result := strtoint('$' + value) + else + result := strtoint(value); +end; + + +procedure TMain.btnExitClick(Sender: TObject); +begin + close; +end; + +procedure TMain.ePortKeyUp(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin +try + Case key of + 38: begin + key := 0; + end; + 40: begin + key := 0; + end + end; +except +end; +end; + +procedure TMain.ePortKeyPress(Sender: TObject; var Key: Char); +begin + // filter on hex + if pos(key,#13#8'0123456789abcdefABCDEF')=0 then + key := #0; +end; + +procedure TMain.FormCreate(Sender: TObject); +begin + coDataType.itemindex :=0; + coDataType.Tag := 2; + if ZLIOStarted then + sbBar.SimpleText := 'Driver successfully started !' + else + sbBar.SimpleText := 'Couldnt start driver. Something wrong !'; +end; + +procedure TMain.coDataTypeChange(Sender: TObject); +var s:string; +begin + coDataType.Tag := 2 shl (coDataType.itemindex); + erdata.MaxLength := coDataType.Tag; + edata.MaxLength := coDataType.Tag; + s := edata.Text; + delete(s,1,length(s)-coDataType.Tag); + edata.text := s; +end; + +procedure TMain.ePortKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +var Port,data:dword; +begin +try + try + Port := str2int(ePort.Text,true); + except + Port := 0; + end; + Case key of + 13: begin + zlioportwrite(port,coDataType.itemindex,str2int(eData.Text, true)); + end; + 38: begin + inc(Port); + ePort.Text := inttohex(Port,3); + key := 0; + end; + 40: begin + if port > 0 then + dec(Port); + ePort.Text := inttohex(Port,3); + key := 0; + end + end; + setthreadpriority(GetCurrentThread,THREAD_PRIORITY_TIME_CRITICAL); + data := zlioportread(Port,coDataType.itemindex); + setrdata(data); +except +end; + +end; + +procedure TMain.setrdata(const Data:dword); +begin + erData.Text := inttohex(Data,coDataType.Tag); +end; + +procedure TMain.btnWriteClick(Sender: TObject); +var i:word; +begin + i := 13; + ePortKeyDown( self,i,[]) +end; + + + +procedure TMain.eDataKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +var data:dword; +begin + try + Data := str2int(eData.Text,true); + except Data := 0; end; + Case key of + 13: begin + ePortKeyDown( self,key,[]) + end; + 38: begin + inc(Data); + eData.Text := inttohex(Data,coDataType.Tag); + key := 0; + end; + 40: begin + dec(Data); + eData.Text := inttohex(Data,coDataType.Tag); + key := 0; + end + end; + +end; + +procedure TMain.btnReadClick(Sender: TObject); +var k:word; +begin + k := 0; + ePortKeyDown(self, k,[]); +end; + +procedure TMain.cbDirectClick(Sender: TObject); +begin +zliosetiopm(cbDirect.Checked); +end; + +procedure TMain.llbWWWClick(Sender: TObject); +begin + shellexecute( 0,'open','http://www.specosoft.com/update/portio_15.htm',nil,nil,SW_SHOW); +end; + +end. diff --git a/Game/Code/lib/zlportio/Example/portio.dpr b/Game/Code/lib/zlportio/Example/portio.dpr index 5d86ae5d..42fcc9e9 100644 --- a/Game/Code/lib/zlportio/Example/portio.dpr +++ b/Game/Code/lib/zlportio/Example/portio.dpr @@ -1,14 +1,14 @@ -{$A-,H+}
-program portio;
-
-uses
- Forms,
- mainform in 'mainform.pas' {Main};
-
-{$R *.RES}
-
-begin
- Application.Initialize;
- Application.CreateForm(TMain, Main);
- Application.Run;
-end.
+{$A-,H+} +program portio; + +uses + Forms, + mainform in 'mainform.pas' {Main}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TMain, Main); + Application.Run; +end. diff --git a/Game/Code/lib/zlportio/README.TXT b/Game/Code/lib/zlportio/README.TXT index 137f5c07..3bce114e 100644 --- a/Game/Code/lib/zlportio/README.TXT +++ b/Game/Code/lib/zlportio/README.TXT @@ -1,27 +1,27 @@ -
-ZLPortIO
-Copyright (C) 2001 Zloba Alexander
-http://www.specosoft.com
-Description
------------
- This unit allow your application direct access port input and output under
- all versions of Microsoft Windows,
-
-Terms of Use
-------------
-
-This software is provided "as is", without any guarantee made
-as to its suitability or fitness for any particular use. It may
-contain bugs, so use of this tool is at your own risk. We take
-no responsilbity for any damage that may unintentionally be caused
-through its use.
-
-Reporting Problems
-------------------
-
-If you encounter problems, please visit http://www.specosoft.com
-and download the latest version to see if the issue has been resolved.
-If not, please send a bug report to:
-
- zal@specosoft.com
-
+ +ZLPortIO +Copyright (C) 2001 Zloba Alexander +http://www.specosoft.com +Description +----------- + This unit allow your application direct access port input and output under + all versions of Microsoft Windows, + +Terms of Use +------------ + +This software is provided "as is", without any guarantee made +as to its suitability or fitness for any particular use. It may +contain bugs, so use of this tool is at your own risk. We take +no responsilbity for any damage that may unintentionally be caused +through its use. + +Reporting Problems +------------------ + +If you encounter problems, please visit http://www.specosoft.com +and download the latest version to see if the issue has been resolved. +If not, please send a bug report to: + + zal@specosoft.com + diff --git a/Game/Code/lib/zlportio/ddkint.pas b/Game/Code/lib/zlportio/ddkint.pas index 2b70ee54..65b208d9 100644 --- a/Game/Code/lib/zlportio/ddkint.pas +++ b/Game/Code/lib/zlportio/ddkint.pas @@ -1,253 +1,253 @@ -{ -----------------------------------------------------------------------------}
-{ Copyright 2000-2001, Zloba Alexander. All Rights Reserved. }
-{ This unit can be freely used and distributed in commercial and private }
-{ environments, provided this notice is not modified in any way. }
-{ -----------------------------------------------------------------------------}
-{ Feel free to contact me if you have any questions, comments or suggestions at}
-{ zal@specosoft.com (Zloba Alexander) }
-{ You can always find the latest version of this unit at: }
-{ http://www.specosoft.com }
-
-{ -----------------------------------------------------------------------------}
-{ Date last modified: 08/10/2001 }
-{ -----------------------------------------------------------------------------}
-{ Description: }
-{ This unit include service function to work with NT drivers and some }
-{ constant from ntddk.h }
-{------------------------------------------------------------------------------}
-{ Revision History: }
-{ 1.00: + First public release }
-{ 1.10: + added compiler directives for correct compilation }
-{ 1.20: + optimized code }
-{ 1.30: + added constant for compatibility with delphi 3.0 }
-{------------------------------------------------------------------------------}
-
-{$A-,H-}
-unit ddkint;
-
-interface
-uses
- windows,
- winsvc;
-
-function CTL_CODE(const DeviceType,Func,Method,Access:Cardinal):cardinal;
-
-const
- FILE_DEVICE_BEEP = $00000001;
- FILE_DEVICE_CD_ROM = $00000002;
- FILE_DEVICE_CD_ROM_FILE_SYSTEM = $00000003;
- FILE_DEVICE_CONTROLLER = $00000004;
- FILE_DEVICE_DATALINK = $00000005;
- FILE_DEVICE_DFS = $00000006;
- FILE_DEVICE_DISK = $00000007;
- FILE_DEVICE_DISK_FILE_SYSTEM = $00000008;
- FILE_DEVICE_FILE_SYSTEM = $00000009;
- FILE_DEVICE_INPORT_PORT = $0000000a;
- FILE_DEVICE_KEYBOARD = $0000000b;
- FILE_DEVICE_MAILSLOT = $0000000c;
- FILE_DEVICE_MIDI_IN = $0000000d;
- FILE_DEVICE_MIDI_OUT = $0000000e;
- FILE_DEVICE_MOUSE = $0000000f;
- FILE_DEVICE_MULTI_UNC_PROVIDER = $00000010;
- FILE_DEVICE_NAMED_PIPE = $00000011;
- FILE_DEVICE_NETWORK = $00000012;
- FILE_DEVICE_NETWORK_BROWSER = $00000013;
- FILE_DEVICE_NETWORK_FILE_SYSTEM= $00000014;
- FILE_DEVICE_NULL = $00000015;
- FILE_DEVICE_PARALLEL_PORT = $00000016;
- FILE_DEVICE_PHYSICAL_NETCARD = $00000017;
- FILE_DEVICE_PRINTER = $00000018;
- FILE_DEVICE_SCANNER = $00000019;
- FILE_DEVICE_SERIAL_MOUSE_PORT = $0000001a;
- FILE_DEVICE_SERIAL_PORT = $0000001b;
- FILE_DEVICE_SCREEN = $0000001c;
- FILE_DEVICE_SOUND = $0000001d;
- FILE_DEVICE_STREAMS = $0000001e;
- FILE_DEVICE_TAPE = $0000001f;
- FILE_DEVICE_TAPE_FILE_SYSTEM = $00000020;
- FILE_DEVICE_TRANSPORT = $00000021;
- FILE_DEVICE_UNKNOWN = $00000022;
- FILE_DEVICE_VIDEO = $00000023;
- FILE_DEVICE_VIRTUAL_DISK = $00000024;
- FILE_DEVICE_WAVE_IN = $00000025;
- FILE_DEVICE_WAVE_OUT = $00000026;
- FILE_DEVICE_8042_PORT = $00000027;
- FILE_DEVICE_NETWORK_REDIRECTOR = $00000028;
- FILE_DEVICE_BATTERY = $00000029;
- FILE_DEVICE_BUS_EXTENDER = $0000002a;
- FILE_DEVICE_MODEM = $0000002b;
- FILE_DEVICE_VDM = $0000002c;
- FILE_DEVICE_MASS_STORAGE = $0000002d;
- FILE_DEVICE_SMB = $0000002e;
- FILE_DEVICE_KS = $0000002f;
- FILE_DEVICE_CHANGER = $00000030;
- FILE_DEVICE_SMARTCARD = $00000031;
- FILE_DEVICE_ACPI = $00000032;
- FILE_DEVICE_DVD = $00000033;
- FILE_DEVICE_FULLSCREEN_VIDEO = $00000034;
- FILE_DEVICE_DFS_FILE_SYSTEM = $00000035;
- FILE_DEVICE_DFS_VOLUME = $00000036;
- FILE_DEVICE_SERENUM = $00000037;
- FILE_DEVICE_TERMSRV = $00000038;
- FILE_DEVICE_KSEC = $00000039;
-
- FILE_DEVICE_KRNLDRVR = $80ff;
-
- METHOD_BUFFERED = 0;
- METHOD_IN_DIRECT = 1;
- METHOD_OUT_DIRECT = 2;
- METHOD_NEITHER = 3;
-
- FILE_ANY_ACCESS = 0;
- FILE_SPECIAL_ACCESS = (FILE_ANY_ACCESS);
- FILE_READ_ACCESS = ( $0001 ); // file & pipe
- FILE_WRITE_ACCESS = ( $0002 ); // file & pipe
-
- {$IFDEF VER100 or VER110}
- // for compatibilty with delphi 3.0
-const
- SERVICE_KERNEL_DRIVER = $00000001;
- SERVICE_DEMAND_START = $00000003;
- SERVICE_ERROR_NORMAL = $00000001;
-
-{$ENDIF}
-
-function driverstart(const name:pchar):integer;
-function driverstop(const name:pchar):integer;
-
-// for this function must have Administrators or Power users rigths
-function driverinstall(const path,name:pchar):integer;
-function driverremove(const name:pchar):integer;
-
-
-// exlpanation function
-function messagestring(const error:integer):string;
-
-implementation
-
-function CTL_CODE(const DeviceType,Func,Method,Access:Cardinal):cardinal;
-begin
- Result := DeviceType shl 16 or Access shl 14 or Func shl 2 or Method;
-end;
-
-
-function driverinstall(const path,name:pchar):integer;
-var hService: SC_HANDLE;
- hSCMan : SC_HANDLE;
-begin
-
- Result := 0;
-
- hSCMan := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
- if hSCMan = 0 then begin
- result := getlasterror;
- exit;
- end;
-
- hService := CreateService(hSCMan, name,name,
- SERVICE_ALL_ACCESS, SERVICE_KERNEL_DRIVER, SERVICE_DEMAND_START,
- SERVICE_ERROR_NORMAL, path,
- nil, nil, nil, nil, nil);
-
- if (hService = 0) then begin
- result := getlasterror;
- CloseServiceHandle(hSCMan);
- exit;
- end
- else
- CloseServiceHandle(hService);
- CloseServiceHandle(hSCMan);
-end;
-
-function driverstart(const name:pchar):integer;
-var
- hService: SC_HANDLE;
- hSCMan : SC_HANDLE;
- args:pchar;
-begin
-
- hSCMan := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
- if hSCMan = 0 then begin
- result := getlasterror;
- exit;
- end;
-
- // get a handle to the service
- hService := OpenService(hSCMan, name, SERVICE_START);
- if hService <> 0 then Begin
- // start the driver
- args := nil;
- Result := 0;
- if integer(StartService(hService, 0, args ))=0 then
- result := getlasterror;
- CloseServiceHandle(hService);
- end
- else
- result := getlasterror;
- CloseServiceHandle(hSCMan);
-end;
-
-function driverstop(const name:pchar):integer;
-Var
- serviceStatus: TServiceStatus;
- hService: SC_HANDLE;
- hSCMan : SC_HANDLE;
-begin
-
- hSCMan := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
- if hSCMan = 0 then begin
- result := getlasterror;
- exit;
- end;
-
- // get a handle to the service
- hService := OpenService(hSCMan, Name, SERVICE_STOP);
- if hService <> 0 then Begin
- // start the driver
- Result := 0;
- if integer(ControlService(hService, SERVICE_CONTROL_STOP, serviceStatus))=0 then
- result := getlasterror;
- CloseServiceHandle(hService);
- end
- else
- result := getlasterror;
- CloseServiceHandle(hSCMan);
-end;
-
-function driverremove(const name:pchar):integer;
-Var
- hService: SC_HANDLE;
- hSCMan : SC_HANDLE;
-begin
-
- hSCMan := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
- if hSCMan = 0 then begin
- result := getlasterror;
- exit;
- end;
-
- // get a handle to the service
- hService := OpenService(hSCMan, Name, SERVICE_ALL_ACCESS);
- if hService <> 0 then Begin
- // remove driver description from the registry
- Result := 0;
- if integer(DeleteService(hService)) = 0 then
- result := getlasterror;
- CloseServiceHandle(hService);
- end
- else
- result := getlasterror;
- CloseServiceHandle(hSCMan);
-end;
-
-function messagestring(const error:integer):string;
-var p:pchar;
-begin
- GetMem(p, 200);
- FillChar(p^, 200, 0);
- formatmessage(FORMAT_MESSAGE_FROM_SYSTEM,nil,error,0,p,199,nil);
- Result := p;
- freemem(p,200);
-end;
-
-end.
+{ -----------------------------------------------------------------------------} +{ Copyright 2000-2001, Zloba Alexander. All Rights Reserved. } +{ This unit can be freely used and distributed in commercial and private } +{ environments, provided this notice is not modified in any way. } +{ -----------------------------------------------------------------------------} +{ Feel free to contact me if you have any questions, comments or suggestions at} +{ zal@specosoft.com (Zloba Alexander) } +{ You can always find the latest version of this unit at: } +{ http://www.specosoft.com } + +{ -----------------------------------------------------------------------------} +{ Date last modified: 08/10/2001 } +{ -----------------------------------------------------------------------------} +{ Description: } +{ This unit include service function to work with NT drivers and some } +{ constant from ntddk.h } +{------------------------------------------------------------------------------} +{ Revision History: } +{ 1.00: + First public release } +{ 1.10: + added compiler directives for correct compilation } +{ 1.20: + optimized code } +{ 1.30: + added constant for compatibility with delphi 3.0 } +{------------------------------------------------------------------------------} + +{$A-,H-} +unit ddkint; + +interface +uses + windows, + winsvc; + +function CTL_CODE(const DeviceType,Func,Method,Access:Cardinal):cardinal; + +const + FILE_DEVICE_BEEP = $00000001; + FILE_DEVICE_CD_ROM = $00000002; + FILE_DEVICE_CD_ROM_FILE_SYSTEM = $00000003; + FILE_DEVICE_CONTROLLER = $00000004; + FILE_DEVICE_DATALINK = $00000005; + FILE_DEVICE_DFS = $00000006; + FILE_DEVICE_DISK = $00000007; + FILE_DEVICE_DISK_FILE_SYSTEM = $00000008; + FILE_DEVICE_FILE_SYSTEM = $00000009; + FILE_DEVICE_INPORT_PORT = $0000000a; + FILE_DEVICE_KEYBOARD = $0000000b; + FILE_DEVICE_MAILSLOT = $0000000c; + FILE_DEVICE_MIDI_IN = $0000000d; + FILE_DEVICE_MIDI_OUT = $0000000e; + FILE_DEVICE_MOUSE = $0000000f; + FILE_DEVICE_MULTI_UNC_PROVIDER = $00000010; + FILE_DEVICE_NAMED_PIPE = $00000011; + FILE_DEVICE_NETWORK = $00000012; + FILE_DEVICE_NETWORK_BROWSER = $00000013; + FILE_DEVICE_NETWORK_FILE_SYSTEM= $00000014; + FILE_DEVICE_NULL = $00000015; + FILE_DEVICE_PARALLEL_PORT = $00000016; + FILE_DEVICE_PHYSICAL_NETCARD = $00000017; + FILE_DEVICE_PRINTER = $00000018; + FILE_DEVICE_SCANNER = $00000019; + FILE_DEVICE_SERIAL_MOUSE_PORT = $0000001a; + FILE_DEVICE_SERIAL_PORT = $0000001b; + FILE_DEVICE_SCREEN = $0000001c; + FILE_DEVICE_SOUND = $0000001d; + FILE_DEVICE_STREAMS = $0000001e; + FILE_DEVICE_TAPE = $0000001f; + FILE_DEVICE_TAPE_FILE_SYSTEM = $00000020; + FILE_DEVICE_TRANSPORT = $00000021; + FILE_DEVICE_UNKNOWN = $00000022; + FILE_DEVICE_VIDEO = $00000023; + FILE_DEVICE_VIRTUAL_DISK = $00000024; + FILE_DEVICE_WAVE_IN = $00000025; + FILE_DEVICE_WAVE_OUT = $00000026; + FILE_DEVICE_8042_PORT = $00000027; + FILE_DEVICE_NETWORK_REDIRECTOR = $00000028; + FILE_DEVICE_BATTERY = $00000029; + FILE_DEVICE_BUS_EXTENDER = $0000002a; + FILE_DEVICE_MODEM = $0000002b; + FILE_DEVICE_VDM = $0000002c; + FILE_DEVICE_MASS_STORAGE = $0000002d; + FILE_DEVICE_SMB = $0000002e; + FILE_DEVICE_KS = $0000002f; + FILE_DEVICE_CHANGER = $00000030; + FILE_DEVICE_SMARTCARD = $00000031; + FILE_DEVICE_ACPI = $00000032; + FILE_DEVICE_DVD = $00000033; + FILE_DEVICE_FULLSCREEN_VIDEO = $00000034; + FILE_DEVICE_DFS_FILE_SYSTEM = $00000035; + FILE_DEVICE_DFS_VOLUME = $00000036; + FILE_DEVICE_SERENUM = $00000037; + FILE_DEVICE_TERMSRV = $00000038; + FILE_DEVICE_KSEC = $00000039; + + FILE_DEVICE_KRNLDRVR = $80ff; + + METHOD_BUFFERED = 0; + METHOD_IN_DIRECT = 1; + METHOD_OUT_DIRECT = 2; + METHOD_NEITHER = 3; + + FILE_ANY_ACCESS = 0; + FILE_SPECIAL_ACCESS = (FILE_ANY_ACCESS); + FILE_READ_ACCESS = ( $0001 ); // file & pipe + FILE_WRITE_ACCESS = ( $0002 ); // file & pipe + + {$IFDEF VER100 or VER110} + // for compatibilty with delphi 3.0 +const + SERVICE_KERNEL_DRIVER = $00000001; + SERVICE_DEMAND_START = $00000003; + SERVICE_ERROR_NORMAL = $00000001; + +{$ENDIF} + +function driverstart(const name:pchar):integer; +function driverstop(const name:pchar):integer; + +// for this function must have Administrators or Power users rigths +function driverinstall(const path,name:pchar):integer; +function driverremove(const name:pchar):integer; + + +// exlpanation function +function messagestring(const error:integer):string; + +implementation + +function CTL_CODE(const DeviceType,Func,Method,Access:Cardinal):cardinal; +begin + Result := DeviceType shl 16 or Access shl 14 or Func shl 2 or Method; +end; + + +function driverinstall(const path,name:pchar):integer; +var hService: SC_HANDLE; + hSCMan : SC_HANDLE; +begin + + Result := 0; + + hSCMan := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS); + if hSCMan = 0 then begin + result := getlasterror; + exit; + end; + + hService := CreateService(hSCMan, name,name, + SERVICE_ALL_ACCESS, SERVICE_KERNEL_DRIVER, SERVICE_DEMAND_START, + SERVICE_ERROR_NORMAL, path, + nil, nil, nil, nil, nil); + + if (hService = 0) then begin + result := getlasterror; + CloseServiceHandle(hSCMan); + exit; + end + else + CloseServiceHandle(hService); + CloseServiceHandle(hSCMan); +end; + +function driverstart(const name:pchar):integer; +var + hService: SC_HANDLE; + hSCMan : SC_HANDLE; + args:pchar; +begin + + hSCMan := OpenSCManager(nil, nil, SC_MANAGER_CONNECT); + if hSCMan = 0 then begin + result := getlasterror; + exit; + end; + + // get a handle to the service + hService := OpenService(hSCMan, name, SERVICE_START); + if hService <> 0 then Begin + // start the driver + args := nil; + Result := 0; + if integer(StartService(hService, 0, args ))=0 then + result := getlasterror; + CloseServiceHandle(hService); + end + else + result := getlasterror; + CloseServiceHandle(hSCMan); +end; + +function driverstop(const name:pchar):integer; +Var + serviceStatus: TServiceStatus; + hService: SC_HANDLE; + hSCMan : SC_HANDLE; +begin + + hSCMan := OpenSCManager(nil, nil, SC_MANAGER_CONNECT); + if hSCMan = 0 then begin + result := getlasterror; + exit; + end; + + // get a handle to the service + hService := OpenService(hSCMan, Name, SERVICE_STOP); + if hService <> 0 then Begin + // start the driver + Result := 0; + if integer(ControlService(hService, SERVICE_CONTROL_STOP, serviceStatus))=0 then + result := getlasterror; + CloseServiceHandle(hService); + end + else + result := getlasterror; + CloseServiceHandle(hSCMan); +end; + +function driverremove(const name:pchar):integer; +Var + hService: SC_HANDLE; + hSCMan : SC_HANDLE; +begin + + hSCMan := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS); + if hSCMan = 0 then begin + result := getlasterror; + exit; + end; + + // get a handle to the service + hService := OpenService(hSCMan, Name, SERVICE_ALL_ACCESS); + if hService <> 0 then Begin + // remove driver description from the registry + Result := 0; + if integer(DeleteService(hService)) = 0 then + result := getlasterror; + CloseServiceHandle(hService); + end + else + result := getlasterror; + CloseServiceHandle(hSCMan); +end; + +function messagestring(const error:integer):string; +var p:pchar; +begin + GetMem(p, 200); + FillChar(p^, 200, 0); + formatmessage(FORMAT_MESSAGE_FROM_SYSTEM,nil,error,0,p,199,nil); + Result := p; + freemem(p,200); +end; + +end. diff --git a/Game/Code/lib/zlportio/install.txt b/Game/Code/lib/zlportio/install.txt index 7a92b29d..2c242ed1 100644 --- a/Game/Code/lib/zlportio/install.txt +++ b/Game/Code/lib/zlportio/install.txt @@ -1,8 +1,8 @@ -
-Installation:
-
-Copy files: zlportio.pas, ddkint.pas to your project directory
-or common unit directory.
-
-Copy file zlportio.sys to your project directory.
-It should be in the one directory with you application.
+ +Installation: + +Copy files: zlportio.pas, ddkint.pas to your project directory +or common unit directory. + +Copy file zlportio.sys to your project directory. +It should be in the one directory with you application. diff --git a/Game/Code/lib/zlportio/zlportio.pas b/Game/Code/lib/zlportio/zlportio.pas index 2cf57334..94cbfdd1 100644 --- a/Game/Code/lib/zlportio/zlportio.pas +++ b/Game/Code/lib/zlportio/zlportio.pas @@ -1,285 +1,285 @@ -{ -----------------------------------------------------------------------------}
-{ Copyright 2000-2001, Zloba Alexander. All Rights Reserved. }
-{ This unit can be freely used and distributed in commercial and private }
-{ environments, provided this notice is not modified in any way. }
-{ -----------------------------------------------------------------------------}
-{ Feel free to contact me if you have any questions, comments or suggestions at}
-{ zal@specosoft.com (Zloba Alexander) }
-{ You can always find the latest version of this unit at: }
-{ http://www.specosoft.com }
-
-{ -----------------------------------------------------------------------------}
-{ Date last modified: 08/10/2001 }
-{ -----------------------------------------------------------------------------}
-{ ZLPortIO driver interface unit v1.20 }
-{ -----------------------------------------------------------------------------}
-{ Description: }
-{ This unit allow your application direct access port input and output under }
-{ all versions of Microsoft Windows® }
-{ Depends: }
-{ zlportio.sys ddkint.pas }
-{ You must distribute zlportio.sys with your application }
-{ Procedures and functions: }
-{ procedure zlioportread( const Port,DataType:dword ):dword; }
-{ procedure zlioportwrite( const Port,DataType,Data:dword ); }
-{ }
-{ function portreadb( const Port:dword ):byte; }
-{ function portreadw( const Port:dword ):word; }
-{ function portreadl( const Port:dword ):dword; }
-{ }
-{ procedure portwriteb( const Port:Dword;const Data:byte ); }
-{ procedure portwritew( const Port:dword;const Data:word ); }
-{ procedure portwritel( const Port,Data:dword ); }
-{ }
-{ Examples: }
-{ // get data bits from LPT port }
-{ databits := portreadb( $378 ) }
-{ // set data bits from LPT port }
-{ portwriteb( $378, databits ) }
-{ // The second parameter determine the databus length for operation }
-{ -----------------------------------------------------------------------------}
-{ Revision History: }
-{ 1.00: + First public release }
-{ 1.10: + Added new functions (portreadX,portwriteX) for convenience of usage }
-{ 1.20: + Added new function (zliosetiopm) for enabling direct access to ports}
-{ 1.30: + added compiler directives for correct compilation }
-{ 1.40: + added opportunity to run multiply instances client to driver }
-{ 1.50: - fixed bug with work under win98 }
-{------------------------------------------------------------------------------}
-
-{$A-,H-}
-unit zlportio;
-
-interface
-
-uses windows,
- sysutils,
- ddkint;
-
-Const
- ZLIO_BYTE = 0;
- ZLIO_WORD = 1;
- ZLIO_DWORD = 2;
-
-var
-
-// if TRUE then driver was started
-// in other case something wrong
-// We start driver in initialization section of unit.
-
- ZlIOStarted:boolean = false;
-
-// if TRUE then we can use asm IN,OUT under NT/2000
-// see zliosetiopm for more details
- ZlIODirect:boolean = false;
-
-// handle to opened driver
-
- HZLIO:THandle;
-
-
-function portreadb( const Port:dword ):byte;
-function portreadw( const Port:dword ):word;
-function portreadl( const Port:dword ):dword;
-
-procedure portwriteb( const Port:Dword;const Data:byte );
-procedure portwritew( const Port:dword;const Data:word );
-procedure portwritel( const Port,Data:dword );
-
-
-procedure zlioportwrite( const Port,DataType,Data:dword );
-function zlioportread( const Port,DataType:dword ):dword;
-
-// if you need the best perfomance for your IO operations
-// call zliosetiopm(TRUE). This allow your application
-// to use asm command IN,OUT directly in your code.
-
-procedure zliosetiopm( const Direct:boolean );
-
-// internal
-
-function zliostart:boolean;
-procedure zliostop;
-
-
-implementation
-
-const
- ZLIODriverName='zlportio';
-
-var
- IOCTL_ZLUNI_PORT_READ:cardinal;
- IOCTL_ZLUNI_PORT_WRITE:cardinal;
- IOCTL_ZLUNI_IOPM_ON:cardinal;
- IOCTL_ZLUNI_IOPM_OFF:cardinal;
-
-type
-TzlIOData = record
- Port,DataType,Data:dword;
-end;
-
-
-procedure zlioportwrite( const Port,DataType,Data:dword );
-var resdata:TZLIOData;
- cBR:cardinal;
-begin
- if (not ZLIODirect) then begin
- resdata.Port := Port;
- resdata.Data := Data;
- resdata.DataType := DataType;
- if ZLIOStarted then
- DeviceIoControl(HZLIO,IOCTL_ZLUNI_PORT_WRITE,@resdata,sizeof(resdata),nil,0,cBR,nil );
- end
- else begin
- Case DataType of
- ZLIO_BYTE : asm mov edx,Port;mov eax,data;out dx,al; end;
- ZLIO_WORD : asm mov edx,Port;mov eax,data;out dx,ax; end;
- ZLIO_DWORD: asm mov edx,Port;mov eax,data;out dx,eax; end;
- end;
- end;
-end;
-
-function zlioportread(const Port,DataType:dword):dword;
-var resdata:TZLIOData;
- cBR:cardinal;i:dword;
-begin
- if (not ZLIODirect) then begin
- resdata.Port := Port;
- resdata.DataType := DataType;
- if ZLIOStarted then
- DeviceIoControl(HZLIO,IOCTL_ZLUNI_PORT_READ,@resdata,sizeof(resdata),@i,sizeof(dword),cBR,nil );
- end
- else begin
- Case DataType of
- ZLIO_BYTE : asm mov edx,Port;xor eax,eax;in al,dx;mov i,eax; end;
- ZLIO_WORD : asm mov edx,Port;xor eax,eax;in ax,dx;mov i,eax; end;
- ZLIO_DWORD: asm mov edx,Port;xor eax,eax;in eax,dx;mov i,eax end;
- end;
- end;
- result := i;
-end;
-
-function portreadb( const Port:dword ):byte;
-begin
- Result := zlioportread(Port,ZLIO_BYTE);
-end;
-
-function portreadw( const Port:dword ):word;
-begin
- Result := zlioportread(Port,ZLIO_WORD);
-end;
-
-function portreadl( const Port:dword ):dword;
-begin
- Result := zlioportread(Port,ZLIO_DWORD);
-end;
-
-procedure portwriteb( const Port:Dword;const Data:byte );
-begin
- zlioportwrite(Port,ZLIO_BYTE,Data);
-end;
-
-procedure portwritew( const Port:dword;const Data:word );
-begin
- zlioportwrite(Port,ZLIO_WORD,Data);
-end;
-
-procedure portwritel( const Port,Data:dword );
-begin
- zlioportwrite(Port,ZLIO_DWORD,Data);
-end;
-
-procedure zliosetiopm( const Direct:boolean );
-var cBR:cardinal;
-begin
- if Win32Platform=VER_PLATFORM_WIN32_NT then
- if ZLIOStarted then begin
- if Direct then
- DeviceIoControl(HZLIO,IOCTL_ZLUNI_IOPM_ON,nil,0,nil,0,cBR,nil )
- else
- DeviceIoControl(HZLIO,IOCTL_ZLUNI_IOPM_OFF,nil,0,nil,0,cBR,nil );
- ZLIODirect := Direct;
- end
-end;
-
-
-
-
-function zliostart;
-var dir:shortstring;
-begin
- if Win32Platform<>VER_PLATFORM_WIN32_NT then begin
- result := true;
- exit;
- end;
-// Result := false;
- zliostop;
- dir := ExtractFileDir(ParamStr(0))+'\'+ZLIODriverName+'.sys'#0;
- driverinstall(pchar(@dir[1]),ZLIODriverName+#0);
- Result := driverstart(ZLIODriverName) = 0;
-end;
-
-procedure zliostop;
-begin
- if Win32Platform<>VER_PLATFORM_WIN32_NT then
- exit;
- driverstop(ZLIODriverName);
- driverremove(ZLIODriverName);
-end;
-
-function zlioopen( var Handle:thandle):boolean;
-var cERR:integer;
- s:string;
-begin
- if Win32Platform<>VER_PLATFORM_WIN32_NT then begin
- result := true;
- exit;
- end;
- Result := false;
- Handle := THandle(-1);
- Handle := createFile('\\.\ZLPORTIO',
- GENERIC_READ or GENERIC_WRITE,
- 0,
- nil,
- OPEN_EXISTING,
- FILE_ATTRIBUTE_NORMAL,
- 0 );
- cERR := getlasterror;
- s := messagestring( cerr);
- if (cERR = ERROR_ALREADY_EXISTS)or(cERR = ERROR_SUCCESS) then Result := True;
-end;
-
-procedure zlioclose( const Handle:thandle);
-begin
- if (Win32Platform=VER_PLATFORM_WIN32_NT) then
- closehandle(Handle);
-end;
-
-
-initialization
-
-IOCTL_ZLUNI_PORT_READ := CTL_CODE(FILE_DEVICE_KRNLDRVR, 1, METHOD_BUFFERED, FILE_ANY_ACCESS);
-IOCTL_ZLUNI_PORT_WRITE := CTL_CODE(FILE_DEVICE_KRNLDRVR, 2, METHOD_BUFFERED, FILE_ANY_ACCESS);
-IOCTL_ZLUNI_IOPM_ON := CTL_CODE(FILE_DEVICE_KRNLDRVR, 3, METHOD_BUFFERED, FILE_ANY_ACCESS);
-IOCTL_ZLUNI_IOPM_OFF := CTL_CODE(FILE_DEVICE_KRNLDRVR, 4, METHOD_BUFFERED, FILE_ANY_ACCESS);
-
- if Win32Platform<>VER_PLATFORM_WIN32_NT then begin
- zliostarted := true;
- zliodirect := true;
- end
- else begin
- if not zlioopen(HZLIO) then begin
- if zliostart then
- ZLIOStarted := zlioopen(HZLIO) or (Win32Platform<>VER_PLATFORM_WIN32_NT);
- end
- else
- ZLIOStarted := true;
- end;
-finalization
-
-if ZLIOStarted then
- zliostop;
-
-
-
-end.
+{ -----------------------------------------------------------------------------} +{ Copyright 2000-2001, Zloba Alexander. All Rights Reserved. } +{ This unit can be freely used and distributed in commercial and private } +{ environments, provided this notice is not modified in any way. } +{ -----------------------------------------------------------------------------} +{ Feel free to contact me if you have any questions, comments or suggestions at} +{ zal@specosoft.com (Zloba Alexander) } +{ You can always find the latest version of this unit at: } +{ http://www.specosoft.com } + +{ -----------------------------------------------------------------------------} +{ Date last modified: 08/10/2001 } +{ -----------------------------------------------------------------------------} +{ ZLPortIO driver interface unit v1.20 } +{ -----------------------------------------------------------------------------} +{ Description: } +{ This unit allow your application direct access port input and output under } +{ all versions of Microsoft Windows® } +{ Depends: } +{ zlportio.sys ddkint.pas } +{ You must distribute zlportio.sys with your application } +{ Procedures and functions: } +{ procedure zlioportread( const Port,DataType:dword ):dword; } +{ procedure zlioportwrite( const Port,DataType,Data:dword ); } +{ } +{ function portreadb( const Port:dword ):byte; } +{ function portreadw( const Port:dword ):word; } +{ function portreadl( const Port:dword ):dword; } +{ } +{ procedure portwriteb( const Port:Dword;const Data:byte ); } +{ procedure portwritew( const Port:dword;const Data:word ); } +{ procedure portwritel( const Port,Data:dword ); } +{ } +{ Examples: } +{ // get data bits from LPT port } +{ databits := portreadb( $378 ) } +{ // set data bits from LPT port } +{ portwriteb( $378, databits ) } +{ // The second parameter determine the databus length for operation } +{ -----------------------------------------------------------------------------} +{ Revision History: } +{ 1.00: + First public release } +{ 1.10: + Added new functions (portreadX,portwriteX) for convenience of usage } +{ 1.20: + Added new function (zliosetiopm) for enabling direct access to ports} +{ 1.30: + added compiler directives for correct compilation } +{ 1.40: + added opportunity to run multiply instances client to driver } +{ 1.50: - fixed bug with work under win98 } +{------------------------------------------------------------------------------} + +{$A-,H-} +unit zlportio; + +interface + +uses windows, + sysutils, + ddkint; + +Const + ZLIO_BYTE = 0; + ZLIO_WORD = 1; + ZLIO_DWORD = 2; + +var + +// if TRUE then driver was started +// in other case something wrong +// We start driver in initialization section of unit. + + ZlIOStarted:boolean = false; + +// if TRUE then we can use asm IN,OUT under NT/2000 +// see zliosetiopm for more details + ZlIODirect:boolean = false; + +// handle to opened driver + + HZLIO:THandle; + + +function portreadb( const Port:dword ):byte; +function portreadw( const Port:dword ):word; +function portreadl( const Port:dword ):dword; + +procedure portwriteb( const Port:Dword;const Data:byte ); +procedure portwritew( const Port:dword;const Data:word ); +procedure portwritel( const Port,Data:dword ); + + +procedure zlioportwrite( const Port,DataType,Data:dword ); +function zlioportread( const Port,DataType:dword ):dword; + +// if you need the best perfomance for your IO operations +// call zliosetiopm(TRUE). This allow your application +// to use asm command IN,OUT directly in your code. + +procedure zliosetiopm( const Direct:boolean ); + +// internal + +function zliostart:boolean; +procedure zliostop; + + +implementation + +const + ZLIODriverName='zlportio'; + +var + IOCTL_ZLUNI_PORT_READ:cardinal; + IOCTL_ZLUNI_PORT_WRITE:cardinal; + IOCTL_ZLUNI_IOPM_ON:cardinal; + IOCTL_ZLUNI_IOPM_OFF:cardinal; + +type +TzlIOData = record + Port,DataType,Data:dword; +end; + + +procedure zlioportwrite( const Port,DataType,Data:dword ); +var resdata:TZLIOData; + cBR:cardinal; +begin + if (not ZLIODirect) then begin + resdata.Port := Port; + resdata.Data := Data; + resdata.DataType := DataType; + if ZLIOStarted then + DeviceIoControl(HZLIO,IOCTL_ZLUNI_PORT_WRITE,@resdata,sizeof(resdata),nil,0,cBR,nil ); + end + else begin + Case DataType of + ZLIO_BYTE : asm mov edx,Port;mov eax,data;out dx,al; end; + ZLIO_WORD : asm mov edx,Port;mov eax,data;out dx,ax; end; + ZLIO_DWORD: asm mov edx,Port;mov eax,data;out dx,eax; end; + end; + end; +end; + +function zlioportread(const Port,DataType:dword):dword; +var resdata:TZLIOData; + cBR:cardinal;i:dword; +begin + if (not ZLIODirect) then begin + resdata.Port := Port; + resdata.DataType := DataType; + if ZLIOStarted then + DeviceIoControl(HZLIO,IOCTL_ZLUNI_PORT_READ,@resdata,sizeof(resdata),@i,sizeof(dword),cBR,nil ); + end + else begin + Case DataType of + ZLIO_BYTE : asm mov edx,Port;xor eax,eax;in al,dx;mov i,eax; end; + ZLIO_WORD : asm mov edx,Port;xor eax,eax;in ax,dx;mov i,eax; end; + ZLIO_DWORD: asm mov edx,Port;xor eax,eax;in eax,dx;mov i,eax end; + end; + end; + result := i; +end; + +function portreadb( const Port:dword ):byte; +begin + Result := zlioportread(Port,ZLIO_BYTE); +end; + +function portreadw( const Port:dword ):word; +begin + Result := zlioportread(Port,ZLIO_WORD); +end; + +function portreadl( const Port:dword ):dword; +begin + Result := zlioportread(Port,ZLIO_DWORD); +end; + +procedure portwriteb( const Port:Dword;const Data:byte ); +begin + zlioportwrite(Port,ZLIO_BYTE,Data); +end; + +procedure portwritew( const Port:dword;const Data:word ); +begin + zlioportwrite(Port,ZLIO_WORD,Data); +end; + +procedure portwritel( const Port,Data:dword ); +begin + zlioportwrite(Port,ZLIO_DWORD,Data); +end; + +procedure zliosetiopm( const Direct:boolean ); +var cBR:cardinal; +begin + if Win32Platform=VER_PLATFORM_WIN32_NT then + if ZLIOStarted then begin + if Direct then + DeviceIoControl(HZLIO,IOCTL_ZLUNI_IOPM_ON,nil,0,nil,0,cBR,nil ) + else + DeviceIoControl(HZLIO,IOCTL_ZLUNI_IOPM_OFF,nil,0,nil,0,cBR,nil ); + ZLIODirect := Direct; + end +end; + + + + +function zliostart; +var dir:shortstring; +begin + if Win32Platform<>VER_PLATFORM_WIN32_NT then begin + result := true; + exit; + end; +// Result := false; + zliostop; + dir := ExtractFileDir(ParamStr(0))+'\'+ZLIODriverName+'.sys'#0; + driverinstall(pchar(@dir[1]),ZLIODriverName+#0); + Result := driverstart(ZLIODriverName) = 0; +end; + +procedure zliostop; +begin + if Win32Platform<>VER_PLATFORM_WIN32_NT then + exit; + driverstop(ZLIODriverName); + driverremove(ZLIODriverName); +end; + +function zlioopen( var Handle:thandle):boolean; +var cERR:integer; + s:string; +begin + if Win32Platform<>VER_PLATFORM_WIN32_NT then begin + result := true; + exit; + end; + Result := false; + Handle := THandle(-1); + Handle := createFile('\\.\ZLPORTIO', + GENERIC_READ or GENERIC_WRITE, + 0, + nil, + OPEN_EXISTING, + FILE_ATTRIBUTE_NORMAL, + 0 ); + cERR := getlasterror; + s := messagestring( cerr); + if (cERR = ERROR_ALREADY_EXISTS)or(cERR = ERROR_SUCCESS) then Result := True; +end; + +procedure zlioclose( const Handle:thandle); +begin + if (Win32Platform=VER_PLATFORM_WIN32_NT) then + closehandle(Handle); +end; + + +initialization + +IOCTL_ZLUNI_PORT_READ := CTL_CODE(FILE_DEVICE_KRNLDRVR, 1, METHOD_BUFFERED, FILE_ANY_ACCESS); +IOCTL_ZLUNI_PORT_WRITE := CTL_CODE(FILE_DEVICE_KRNLDRVR, 2, METHOD_BUFFERED, FILE_ANY_ACCESS); +IOCTL_ZLUNI_IOPM_ON := CTL_CODE(FILE_DEVICE_KRNLDRVR, 3, METHOD_BUFFERED, FILE_ANY_ACCESS); +IOCTL_ZLUNI_IOPM_OFF := CTL_CODE(FILE_DEVICE_KRNLDRVR, 4, METHOD_BUFFERED, FILE_ANY_ACCESS); + + if Win32Platform<>VER_PLATFORM_WIN32_NT then begin + zliostarted := true; + zliodirect := true; + end + else begin + if not zlioopen(HZLIO) then begin + if zliostart then + ZLIOStarted := zlioopen(HZLIO) or (Win32Platform<>VER_PLATFORM_WIN32_NT); + end + else + ZLIOStarted := true; + end; +finalization + +if ZLIOStarted then + zliostop; + + + +end. |