aboutsummaryrefslogtreecommitdiffstats
path: root/src/lib
diff options
context:
space:
mode:
authorAlexander Sulfrian <alexander@sulfrian.net>2011-11-07 15:26:44 +0100
committerAlexander Sulfrian <alexander@sulfrian.net>2013-01-05 17:17:49 +0100
commit3260749d369d3466c345d40a8b2189c32c8c1b60 (patch)
treebdf235d333e6b4d0b0edb11bde421617a180ff92 /src/lib
parentde5a3593ae7bc6fb5aab9d76d01d3faa47b91bba (diff)
downloadusdx-3260749d369d3466c345d40a8b2189c32c8c1b60.tar.gz
usdx-3260749d369d3466c345d40a8b2189c32c8c1b60.tar.xz
usdx-3260749d369d3466c345d40a8b2189c32c8c1b60.zip
removed pascal code
Diffstat (limited to '')
-rw-r--r--src/lib/FreeImage/FreeBitmap.pas1742
-rw-r--r--src/lib/FreeImage/FreeImage.pas771
-rw-r--r--src/lib/JEDI-SDL/OpenGL/Pas/geometry.pas1994
-rw-r--r--src/lib/JEDI-SDL/OpenGL/Pas/gl.pas2301
-rw-r--r--src/lib/JEDI-SDL/OpenGL/Pas/glext.pas9579
-rw-r--r--src/lib/JEDI-SDL/OpenGL/Pas/glu.pas582
-rw-r--r--src/lib/JEDI-SDL/OpenGL/Pas/glut.pas688
-rw-r--r--src/lib/JEDI-SDL/OpenGL/Pas/glx.pas279
-rw-r--r--src/lib/JEDI-SDL/SDL/Pas/libxmlparser.pas2688
-rw-r--r--src/lib/JEDI-SDL/SDL/Pas/logger.pas189
-rw-r--r--src/lib/JEDI-SDL/SDL/Pas/moduleloader.pas320
-rw-r--r--src/lib/JEDI-SDL/SDL/Pas/registryuserpreferences.pas229
-rw-r--r--src/lib/JEDI-SDL/SDL/Pas/sdl.pas4332
-rw-r--r--src/lib/JEDI-SDL/SDL/Pas/sdl_cpuinfo.pas155
-rw-r--r--src/lib/JEDI-SDL/SDL/Pas/sdlgameinterface.pas202
-rw-r--r--src/lib/JEDI-SDL/SDL/Pas/sdli386utils.pas5236
-rw-r--r--src/lib/JEDI-SDL/SDL/Pas/sdlinput.pas923
-rw-r--r--src/lib/JEDI-SDL/SDL/Pas/sdlstreams.pas216
-rw-r--r--src/lib/JEDI-SDL/SDL/Pas/sdlticks.pas197
-rw-r--r--src/lib/JEDI-SDL/SDL/Pas/sdlutils.pas4363
-rw-r--r--src/lib/JEDI-SDL/SDL/Pas/sdlwindow.pas566
-rw-r--r--src/lib/JEDI-SDL/SDL/Pas/userpreferences.pas159
-rw-r--r--src/lib/JEDI-SDL/SDL_Image/Pas/sdl_image.pas350
-rw-r--r--src/lib/SQLite/SQLite3.pas253
-rw-r--r--src/lib/SQLite/SQLiteTable3.pas1500
-rw-r--r--src/lib/SQLite/example/uTestSqlite.pas233
-rw-r--r--src/lib/TntUnicodeControls/TntClasses.pas1799
-rw-r--r--src/lib/TntUnicodeControls/TntFormatStrUtils.pas521
-rw-r--r--src/lib/TntUnicodeControls/TntSysUtils.pas1753
-rw-r--r--src/lib/TntUnicodeControls/TntSystem.pas1427
-rw-r--r--src/lib/TntUnicodeControls/TntWideStrUtils.pas455
-rw-r--r--src/lib/TntUnicodeControls/TntWideStrings.pas846
-rw-r--r--src/lib/TntUnicodeControls/TntWindows.pas1501
-rw-r--r--src/lib/bass/delphi/bass.pas900
-rw-r--r--src/lib/collections/CollArray.pas183
-rw-r--r--src/lib/collections/CollHash.pas1497
-rw-r--r--src/lib/collections/CollLibrary.pas131
-rw-r--r--src/lib/collections/CollList.pas270
-rw-r--r--src/lib/collections/CollPArray.pas689
-rw-r--r--src/lib/collections/CollWrappers.pas876
-rw-r--r--src/lib/collections/Collections.pas5318
-rw-r--r--src/lib/ctypes/ctypes.pas72
-rw-r--r--src/lib/ffmpeg/avcodec.pas4533
-rw-r--r--src/lib/ffmpeg/avformat.pas1750
-rw-r--r--src/lib/ffmpeg/avio.pas590
-rw-r--r--src/lib/ffmpeg/avutil.pas420
-rw-r--r--src/lib/ffmpeg/mathematics.pas104
-rw-r--r--src/lib/ffmpeg/opt.pas272
-rw-r--r--src/lib/ffmpeg/rational.pas179
-rw-r--r--src/lib/ffmpeg/swscale.pas355
-rw-r--r--src/lib/fft/UFFT.pas602
-rw-r--r--src/lib/freetype/demo/nehe/UFreeType.pas326
-rw-r--r--src/lib/freetype/freetype.pas1845
-rw-r--r--src/lib/libpng/png.pas974
-rw-r--r--src/lib/midi/MidiFile.pas968
-rw-r--r--src/lib/midi/MidiScope.pas198
-rw-r--r--src/lib/midi/Midicons.pas47
-rw-r--r--src/lib/midi/Midiin.pas727
-rw-r--r--src/lib/midi/Midiout.pas619
-rw-r--r--src/lib/midi/demo/MidiTest.pas249
-rw-r--r--src/lib/other/DirWatch.pas345
-rw-r--r--src/lib/other/WinAllocation.pas101
-rw-r--r--src/lib/pcre/pcre.pas852
-rw-r--r--src/lib/portaudio/portaudio.pas1160
-rw-r--r--src/lib/portmixer/portmixer.pas149
-rw-r--r--src/lib/projectM/projectM.pas232
-rw-r--r--src/lib/samplerate/samplerate.pas199
-rw-r--r--src/lib/zlib/zlib.pas215
68 files changed, 0 insertions, 76296 deletions
diff --git a/src/lib/FreeImage/FreeBitmap.pas b/src/lib/FreeImage/FreeBitmap.pas
deleted file mode 100644
index d32fb5cb..00000000
--- a/src/lib/FreeImage/FreeBitmap.pas
+++ /dev/null
@@ -1,1742 +0,0 @@
-unit FreeBitmap;
-
-// ==========================================================
-//
-// Delphi wrapper for FreeImage 3
-//
-// Design and implementation by
-// - Anatoliy Pulyaevskiy (xvel84@rambler.ru)
-//
-// Contributors:
-// - Enzo Costantini (enzocostantini@libero.it)
-//
-// This file is part of FreeImage 3
-//
-// COVERED CODE IS PROVIDED UNDER THIS LICENSE ON AN "AS IS" BASIS, WITHOUT WARRANTY
-// OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, WITHOUT LIMITATION, WARRANTIES
-// THAT THE COVERED CODE IS FREE OF DEFECTS, MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE
-// OR NON-INFRINGING. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE COVERED
-// CODE IS WITH YOU. SHOULD ANY COVERED CODE PROVE DEFECTIVE IN ANY RESPECT, YOU (NOT
-// THE INITIAL DEVELOPER OR ANY OTHER CONTRIBUTOR) ASSUME THE COST OF ANY NECESSARY
-// SERVICING, REPAIR OR CORRECTION. THIS DISCLAIMER OF WARRANTY CONSTITUTES AN ESSENTIAL
-// PART OF THIS LICENSE. NO USE OF ANY COVERED CODE IS AUTHORIZED HEREUNDER EXCEPT UNDER
-// THIS DISCLAIMER.
-//
-// Use at your own risk!
-//
-// ==========================================================
-//
-// From begining all code of this file is based on C++ wrapper to
-// FreeImage - FreeImagePlus.
-//
-// ==========================================================
-
-{$IFDEF FPC}
- {$MODE Delphi}
- {$H+} // use long strings
-{$ENDIF}
-
-interface
-
-uses
- SysUtils, Classes, Windows, FreeImage;
-
-type
- { TFreeObject }
-
- TFreeObject = class(TObject)
- public
- function IsValid: Boolean; virtual;
- end;
-
- { TFreeTag }
-
- TFreeTag = class(TFreeObject)
- private
- // fields
- FTag: PFITAG;
-
- // getters & setters
- function GetCount: Cardinal;
- function GetDescription: string;
- function GetID: Word;
- function GetKey: string;
- function GetLength: Cardinal;
- function GetTagType: FREE_IMAGE_MDTYPE;
- function GetValue: Pointer;
- procedure SetCount(const Value: Cardinal);
- procedure SetDescription(const Value: string);
- procedure SetID(const Value: Word);
- procedure SetKey(const Value: string);
- procedure SetLength(const Value: Cardinal);
- procedure SetTagType(const Value: FREE_IMAGE_MDTYPE);
- procedure SetValue(const Value: Pointer);
- public
- // construction & destruction
- constructor Create(ATag: PFITAG = nil); virtual;
- destructor Destroy; override;
-
- // methods
- function Clone: TFreeTag;
- function IsValid: Boolean; override;
- function ToString(Model: FREE_IMAGE_MDMODEL; Make: PChar = nil): string;
-
- // properties
- property Key: string read GetKey write SetKey;
- property Description: string read GetDescription write SetDescription;
- property ID: Word read GetID write SetID;
- property TagType: FREE_IMAGE_MDTYPE read GetTagType write SetTagType;
- property Count: Cardinal read GetCount write SetCount;
- property Length: Cardinal read GetLength write SetLength;
- property Value: Pointer read GetValue write SetValue;
- property Tag: PFITAG read FTag;
- end;
-
- { forward declarations }
-
- TFreeBitmap = class;
- TFreeMemoryIO = class;
-
- { TFreeBitmap }
-
- TFreeBitmapChangingEvent = procedure(Sender: TFreeBitmap; var OldDib, NewDib: PFIBITMAP; var Handled: Boolean) of object;
-
- TFreeBitmap = class(TFreeObject)
- private
- // fields
- FDib: PFIBITMAP;
- FOnChange: TNotifyEvent;
- FOnChanging: TFreeBitmapChangingEvent;
-
- procedure SetDib(Value: PFIBITMAP);
- protected
- function DoChanging(var OldDib, NewDib: PFIBITMAP): Boolean; dynamic;
- function Replace(NewDib: PFIBITMAP): Boolean; dynamic;
- public
- constructor Create(ImageType: FREE_IMAGE_TYPE = FIT_BITMAP; Width: Integer = 0; Height: Integer = 0; Bpp: Integer = 0);
- destructor Destroy; override;
- function SetSize(ImageType: FREE_IMAGE_TYPE; Width, Height, Bpp: Integer; RedMask: Cardinal = 0; GreenMask: Cardinal = 0; BlueMask: Cardinal = 0): Boolean;
- procedure Change; dynamic;
- procedure Assign(Source: TFreeBitmap);
- function CopySubImage(Left, Top, Right, Bottom: Integer; Dest: TFreeBitmap): Boolean;
- function PasteSubImage(Src: TFreeBitmap; Left, Top: Integer; Alpha: Integer = 256): Boolean;
- procedure Clear; virtual;
- function Load(const FileName: string; Flag: Integer = 0): Boolean;
- function LoadU(const FileName: WideString; Flag: Integer = 0): Boolean;
- function LoadFromHandle(IO: PFreeImageIO; Handle: fi_handle; Flag: Integer = 0): Boolean;
- function LoadFromMemory(MemIO: TFreeMemoryIO; Flag: Integer = 0): Boolean;
- function LoadFromStream(Stream: TStream; Flag: Integer = 0): Boolean;
- // save functions
- function CanSave(fif: FREE_IMAGE_FORMAT): Boolean;
- function Save(const FileName: string; Flag: Integer = 0): Boolean;
- function SaveU(const FileName: WideString; Flag: Integer = 0): Boolean;
- function SaveToHandle(fif: FREE_IMAGE_FORMAT; IO: PFreeImageIO; Handle: fi_handle; Flag: Integer = 0): Boolean;
- function SaveToMemory(fif: FREE_IMAGE_FORMAT; MemIO: TFreeMemoryIO; Flag: Integer = 0): Boolean;
- function SaveToStream(fif: FREE_IMAGE_FORMAT; Stream: TStream; Flag: Integer = 0): Boolean;
- // image information
- function GetImageType: FREE_IMAGE_TYPE;
- function GetWidth: Integer;
- function GetHeight: Integer;
- function GetScanWidth: Integer;
- function IsValid: Boolean; override;
- function GetInfo: PBitmapInfo;
- function GetInfoHeader: PBitmapInfoHeader;
- function GetImageSize: Cardinal;
- function GetBitsPerPixel: Integer;
- function GetLine: Integer;
- function GetHorizontalResolution: Double;
- function GetVerticalResolution: Double;
- procedure SetHorizontalResolution(Value: Double);
- procedure SetVerticalResolution(Value: Double);
- // palette operations
- function GetPalette: PRGBQUAD;
- function GetPaletteSize: Integer;
- function GetColorsUsed: Integer;
- function GetColorType: FREE_IMAGE_COLOR_TYPE;
- function IsGrayScale: Boolean;
- // pixels access
- function AccessPixels: PByte;
- function GetScanLine(ScanLine: Integer): PByte;
- function GetPixelIndex(X, Y: Cardinal; var Value: PByte): Boolean;
- function GetPixelColor(X, Y: Cardinal; Value: PRGBQUAD): Boolean;
- function SetPixelIndex(X, Y: Cardinal; Value: PByte): Boolean;
- function SetPixelColor(X, Y: Cardinal; Value: PRGBQUAD): Boolean;
- // convertion
- function ConvertToStandardType(ScaleLinear: Boolean): Boolean;
- function ConvertToType(ImageType: FREE_IMAGE_TYPE; ScaleLinear: Boolean): Boolean;
- function Threshold(T: Byte): Boolean;
- function ConvertTo4Bits: Boolean;
- function ConvertTo8Bits: Boolean;
- function ConvertTo16Bits555: Boolean;
- function ConvertTo16Bits565: Boolean;
- function ConvertTo24Bits: Boolean;
- function ConvertTo32Bits: Boolean;
- function ConvertToGrayscale: Boolean;
- function ColorQuantize(Algorithm: FREE_IMAGE_QUANTIZE): Boolean;
- function Dither(Algorithm: FREE_IMAGE_DITHER): Boolean;
- function ConvertToRGBF: Boolean;
- function ToneMapping(TMO: FREE_IMAGE_TMO; FirstParam, SecondParam: Double): Boolean;
- // transparency
- function IsTransparent: Boolean;
- function GetTransparencyCount: Cardinal;
- function GetTransparencyTable: PByte;
- procedure SetTransparencyTable(Table: PByte; Count: Integer);
- function HasFileBkColor: Boolean;
- function GetFileBkColor(var BkColor: PRGBQuad): Boolean;
- function SetFileBkColor(BkColor: PRGBQuad): Boolean;
- // channel processing routines
- function GetChannel(Bitmap: TFreeBitmap; Channel: FREE_IMAGE_COLOR_CHANNEL): Boolean;
- function SetChannel(Bitmap: TFreeBitmap; Channel: FREE_IMAGE_COLOR_CHANNEL): Boolean;
- function SplitChannels(RedChannel, GreenChannel, BlueChannel: TFreeBitmap): Boolean;
- function CombineChannels(Red, Green, Blue: TFreeBitmap): Boolean;
- // rotation and flipping
- function RotateEx(Angle, XShift, YShift, XOrigin, YOrigin: Double; UseMask: Boolean): Boolean;
- function Rotate(Angle: Double): Boolean;
- function FlipHorizontal: Boolean;
- function FlipVertical: Boolean;
- // color manipulation routines
- function Invert: Boolean;
- function AdjustCurve(Lut: PByte; Channel: FREE_IMAGE_COLOR_CHANNEL): Boolean;
- function AdjustGamma(Gamma: Double): Boolean;
- function AdjustBrightness(Percentage: Double): Boolean;
- function AdjustContrast(Percentage: Double): Boolean;
- function GetHistogram(Histo: PDWORD; Channel: FREE_IMAGE_COLOR_CHANNEL = FICC_BLACK): Boolean;
- // upsampling / downsampling
- procedure MakeThumbnail(const Width, Height: Integer; DestBitmap: TFreeBitmap);
- function Rescale(NewWidth, NewHeight: Integer; Filter: FREE_IMAGE_FILTER; Dest: TFreeBitmap = nil): Boolean;
- // metadata routines
- function FindFirstMetadata(Model: FREE_IMAGE_MDMODEL; var Tag: TFreeTag): PFIMETADATA;
- function FindNextMetadata(MDHandle: PFIMETADATA; var Tag: TFreeTag): Boolean;
- procedure FindCloseMetadata(MDHandle: PFIMETADATA);
- function SetMetadata(Model: FREE_IMAGE_MDMODEL; const Key: string; Tag: TFreeTag): Boolean;
- function GetMetadata(Model: FREE_IMAGE_MDMODEL; const Key: string; var Tag: TFreeTag): Boolean;
- function GetMetadataCount(Model: FREE_IMAGE_MDMODEL): Cardinal;
-
- // properties
- property Dib: PFIBITMAP read FDib write SetDib;
- property OnChange: TNotifyEvent read FOnChange write FOnChange;
- property OnChanging: TFreeBitmapChangingEvent read FOnChanging write FOnChanging;
- end;
-
- { TFreeWinBitmap }
-
-
- { TFreeMemoryIO }
-
- TFreeMemoryIO = class(TFreeObject)
- private
- FHMem: PFIMEMORY;
- public
- // construction and destruction
- constructor Create(Data: PByte = nil; SizeInBytes: DWORD = 0);
- destructor Destroy; override;
-
- function GetFileType: FREE_IMAGE_FORMAT;
- function Read(fif: FREE_IMAGE_FORMAT; Flag: Integer = 0): PFIBITMAP;
- function Write(fif: FREE_IMAGE_FORMAT; dib: PFIBITMAP; Flag: Integer = 0): Boolean;
- function Tell: Longint;
- function Seek(Offset: Longint; Origin: Word): Boolean;
- function Acquire(var Data: PByte; var SizeInBytes: DWORD): Boolean;
- // overriden methods
- function IsValid: Boolean; override;
- end;
-
- { TFreeMultiBitmap }
-
- TFreeMultiBitmap = class(TFreeObject)
- private
- FMPage: PFIMULTIBITMAP;
- FMemoryCache: Boolean;
- public
- // constructor and destructor
- constructor Create(KeepCacheInMemory: Boolean = False);
- destructor Destroy; override;
-
- // methods
- function Open(const FileName: string; CreateNew, ReadOnly: Boolean; Flags: Integer = 0): Boolean;
- function Close(Flags: Integer = 0): Boolean;
- function GetPageCount: Integer;
- procedure AppendPage(Bitmap: TFreeBitmap);
- procedure InsertPage(Page: Integer; Bitmap: TFreeBitmap);
- procedure DeletePage(Page: Integer);
- function MovePage(Target, Source: Integer): Boolean;
- procedure LockPage(Page: Integer; DestBitmap: TFreeBitmap);
- procedure UnlockPage(Bitmap: TFreeBitmap; Changed: Boolean);
- function GetLockedPageNumbers(var Pages: Integer; var Count: Integer): Boolean;
- // overriden methods
- function IsValid: Boolean; override;
-
- // properties
- // change of this property influences only on the next opening of a file
- property MemoryCache: Boolean read FMemoryCache write FMemoryCache;
- end;
-
-implementation
-
-const
- ThumbSize = 150;
-
-// marker used for clipboard copy / paste
-
-procedure SetFreeImageMarker(bmih: PBitmapInfoHeader; dib: PFIBITMAP);
-begin
- // Windows constants goes from 0L to 5L
- // Add $FF to avoid conflicts
- bmih.biCompression := $FF + FreeImage_GetImageType(dib);
-end;
-
-function GetFreeImageMarker(bmih: PBitmapInfoHeader): FREE_IMAGE_TYPE;
-begin
- Result := FREE_IMAGE_TYPE(bmih.biCompression - $FF);
-end;
-
-{ TFreePersistent }
-
-function TFreeObject.IsValid: Boolean;
-begin
- Result := False
-end;
-
-{ TFreeBitmap }
-
-function TFreeBitmap.AccessPixels: PByte;
-begin
- Result := FreeImage_GetBits(FDib)
-end;
-
-function TFreeBitmap.AdjustBrightness(Percentage: Double): Boolean;
-begin
- if FDib <> nil then
- begin
- Result := FreeImage_AdjustBrightness(FDib, Percentage);
- Change;
- end
- else
- Result := False
-end;
-
-function TFreeBitmap.AdjustContrast(Percentage: Double): Boolean;
-begin
- if FDib <> nil then
- begin
- Result := FreeImage_AdjustContrast(FDib, Percentage);
- Change;
- end
- else
- Result := False
-end;
-
-function TFreeBitmap.AdjustCurve(Lut: PByte;
- Channel: FREE_IMAGE_COLOR_CHANNEL): Boolean;
-begin
- if FDib <> nil then
- begin
- Result := FreeImage_AdjustCurve(FDib, Lut, Channel);
- Change;
- end
- else
- Result := False
-end;
-
-function TFreeBitmap.AdjustGamma(Gamma: Double): Boolean;
-begin
- if FDib <> nil then
- begin
- Result := FreeImage_AdjustGamma(FDib, Gamma);
- Change;
- end
- else
- Result := False
-end;
-
-procedure TFreeBitmap.Assign(Source: TFreeBitmap);
-var
- SourceBmp: TFreeBitmap;
- Clone: PFIBITMAP;
-begin
- if Source = nil then
- begin
- Clear;
- Exit;
- end;
-
- if Source is TFreeBitmap then
- begin
- SourceBmp := TFreeBitmap(Source);
- if SourceBmp <> Self then
- begin
- if SourceBmp.IsValid then
- begin
- Clone := FreeImage_Clone(SourceBmp.FDib);
- Replace(Clone);
- end
- else
- Clear;
- end;
- end;
-end;
-
-function TFreeBitmap.CanSave(fif: FREE_IMAGE_FORMAT): Boolean;
-var
- ImageType: FREE_IMAGE_TYPE;
- Bpp: Word;
-begin
- Result := False;
- if not IsValid then Exit;
-
- if fif <> FIF_UNKNOWN then
- begin
- // check that the dib can be saved in this format
- ImageType := FreeImage_GetImageType(FDib);
- if ImageType = FIT_BITMAP then
- begin
- // standard bitmap type
- Bpp := FreeImage_GetBPP(FDib);
- Result := FreeImage_FIFSupportsWriting(fif)
- and FreeImage_FIFSupportsExportBPP(fif, Bpp);
- end
- else // special bitmap type
- Result := FreeImage_FIFSupportsExportType(fif, ImageType);
- end;
-end;
-
-procedure TFreeBitmap.Change;
-begin
- if Assigned(FOnChange) then FOnChange(Self)
-end;
-
-procedure TFreeBitmap.Clear;
-begin
- if FDib <> nil then
- begin
- FreeImage_Unload(FDib);
- FDib := nil;
- Change;
- end;
-end;
-
-function TFreeBitmap.ColorQuantize(
- Algorithm: FREE_IMAGE_QUANTIZE): Boolean;
-var
- dib8: PFIBITMAP;
-begin
- if FDib <> nil then
- begin
- dib8 := FreeImage_ColorQuantize(FDib, Algorithm);
- Result := Replace(dib8);
- end
- else
- Result := False;
-end;
-
-function TFreeBitmap.CombineChannels(Red, Green,
- Blue: TFreeBitmap): Boolean;
-var
- Width, Height: Integer;
-begin
- if FDib = nil then
- begin
- Width := Red.GetWidth;
- Height := Red.GetHeight;
- FDib := FreeImage_Allocate(Width, Height, 24, FI_RGBA_RED_MASK,
- FI_RGBA_GREEN_MASK, FI_RGBA_BLUE_MASK);
- end;
-
- if FDib <> nil then
- begin
- Result := FreeImage_SetChannel(FDib, Red.FDib, FICC_RED) and
- FreeImage_SetChannel(FDib, Green.FDib, FICC_GREEN) and
- FreeImage_SetChannel(FDib, Blue.FDib, FICC_BLUE);
-
- Change
- end
- else
- Result := False;
-end;
-
-function TFreeBitmap.ConvertTo16Bits555: Boolean;
-var
- dib16_555: PFIBITMAP;
-begin
- if FDib <> nil then
- begin
- dib16_555 := FreeImage_ConvertTo16Bits555(FDib);
- Result := Replace(dib16_555);
- end
- else
- Result := False
-end;
-
-function TFreeBitmap.ConvertTo16Bits565: Boolean;
-var
- dib16_565: PFIBITMAP;
-begin
- if FDib <> nil then
- begin
- dib16_565 := FreeImage_ConvertTo16Bits565(FDib);
- Result := Replace(dib16_565);
- end
- else
- Result := False
-end;
-
-function TFreeBitmap.ConvertTo24Bits: Boolean;
-var
- dibRGB: PFIBITMAP;
-begin
- if FDib <> nil then
- begin
- dibRGB := FreeImage_ConvertTo24Bits(FDib);
- Result := Replace(dibRGB);
- end
- else
- Result := False
-end;
-
-function TFreeBitmap.ConvertTo32Bits: Boolean;
-var
- dib32: PFIBITMAP;
-begin
- if FDib <> nil then
- begin
- dib32 := FreeImage_ConvertTo32Bits(FDib);
- Result := Replace(dib32);
- end
- else
- Result := False
-end;
-
-function TFreeBitmap.ConvertTo4Bits: Boolean;
-var
- dib4: PFIBITMAP;
-begin
- Result := False;
- if IsValid then
- begin
- dib4 := FreeImage_ConvertTo4Bits(FDib);
- Result := Replace(dib4);
- end;
-end;
-
-function TFreeBitmap.ConvertTo8Bits: Boolean;
-var
- dib8: PFIBITMAP;
-begin
- if FDib <> nil then
- begin
- dib8 := FreeImage_ConvertTo8Bits(FDib);
- Result := Replace(dib8);
- end
- else
- Result := False
-end;
-
-function TFreeBitmap.ConvertToGrayscale: Boolean;
-var
- dib8: PFIBITMAP;
-begin
- Result := False;
-
- if IsValid then
- begin
- dib8 := FreeImage_ConvertToGreyscale(FDib);
- Result := Replace(dib8);
- end
-end;
-
-function TFreeBitmap.ConvertToRGBF: Boolean;
-var
- ImageType: FREE_IMAGE_TYPE;
- NewDib: PFIBITMAP;
-begin
- Result := False;
- if not IsValid then Exit;
-
- ImageType := GetImageType;
-
- if (ImageType = FIT_BITMAP) then
- begin
- if GetBitsPerPixel < 24 then
- if not ConvertTo24Bits then
- Exit
- end;
- NewDib := FreeImage_ConvertToRGBF(FDib);
- Result := Replace(NewDib);
-end;
-
-function TFreeBitmap.ConvertToStandardType(ScaleLinear: Boolean): Boolean;
-var
- dibStandard: PFIBITMAP;
-begin
- if IsValid then
- begin
- dibStandard := FreeImage_ConvertToStandardType(FDib, ScaleLinear);
- Result := Replace(dibStandard);
- end
- else
- Result := False;
-end;
-
-function TFreeBitmap.ConvertToType(ImageType: FREE_IMAGE_TYPE;
- ScaleLinear: Boolean): Boolean;
-var
- dib: PFIBITMAP;
-begin
- if FDib <> nil then
- begin
- dib := FreeImage_ConvertToType(FDib, ImageType, ScaleLinear);
- Result := Replace(dib)
- end
- else
- Result := False
-end;
-
-function TFreeBitmap.CopySubImage(Left, Top, Right, Bottom: Integer;
- Dest: TFreeBitmap): Boolean;
-begin
- if FDib <> nil then
- begin
- Dest.FDib := FreeImage_Copy(FDib, Left, Top, Right, Bottom);
- Result := Dest.IsValid;
- end else
- Result := False;
-end;
-
-constructor TFreeBitmap.Create(ImageType: FREE_IMAGE_TYPE; Width, Height,
- Bpp: Integer);
-begin
- inherited Create;
-
- FDib := nil;
- if (Width > 0) and (Height > 0) and (Bpp > 0) then
- SetSize(ImageType, Width, Height, Bpp);
-end;
-
-destructor TFreeBitmap.Destroy;
-begin
- if FDib <> nil then
- FreeImage_Unload(FDib);
- inherited;
-end;
-
-function TFreeBitmap.Dither(Algorithm: FREE_IMAGE_DITHER): Boolean;
-var
- dib: PFIBITMAP;
-begin
- if FDib <> nil then
- begin
- dib := FreeImage_Dither(FDib, Algorithm);
- Result := Replace(dib);
- end
- else
- Result := False;
-end;
-
-function TFreeBitmap.DoChanging(var OldDib, NewDib: PFIBITMAP): Boolean;
-begin
- Result := False;
- if (OldDib <> NewDib) and Assigned(FOnChanging) then
- FOnChanging(Self, OldDib, NewDib, Result);
-end;
-
-procedure TFreeBitmap.FindCloseMetadata(MDHandle: PFIMETADATA);
-begin
- FreeImage_FindCloseMetadata(MDHandle);
-end;
-
-function TFreeBitmap.FindFirstMetadata(Model: FREE_IMAGE_MDMODEL;
- var Tag: TFreeTag): PFIMETADATA;
-begin
- Result := FreeImage_FindFirstMetadata(Model, FDib, Tag.FTag);
-end;
-
-function TFreeBitmap.FindNextMetadata(MDHandle: PFIMETADATA;
- var Tag: TFreeTag): Boolean;
-begin
- Result := FreeImage_FindNextMetadata(MDHandle, Tag.FTag);
-end;
-
-function TFreeBitmap.FlipHorizontal: Boolean;
-begin
- if FDib <> nil then
- begin
- Result := FreeImage_FlipHorizontal(FDib);
- Change;
- end
- else
- Result := False
-end;
-
-function TFreeBitmap.FlipVertical: Boolean;
-begin
- if FDib <> nil then
- begin
- Result := FreeImage_FlipVertical(FDib);
- Change;
- end
- else
- Result := False
-end;
-
-function TFreeBitmap.GetBitsPerPixel: Integer;
-begin
- Result := FreeImage_GetBPP(FDib)
-end;
-
-function TFreeBitmap.GetChannel(Bitmap: TFreeBitmap;
- Channel: FREE_IMAGE_COLOR_CHANNEL): Boolean;
-begin
- if FDib <> nil then
- begin
- Bitmap.Dib := FreeImage_GetChannel(FDib, Channel);
- Result := Bitmap.IsValid;
- end
- else
- Result := False
-end;
-
-function TFreeBitmap.GetColorsUsed: Integer;
-begin
- Result := FreeImage_GetColorsUsed(FDib)
-end;
-
-function TFreeBitmap.GetColorType: FREE_IMAGE_COLOR_TYPE;
-begin
- Result := FreeImage_GetColorType(FDib);
-end;
-
-function TFreeBitmap.GetFileBkColor(var BkColor: PRGBQuad): Boolean;
-begin
- Result := FreeImage_GetBackgroundColor(FDib, BkColor)
-end;
-
-function TFreeBitmap.GetHeight: Integer;
-begin
- Result := FreeImage_GetHeight(FDib)
-end;
-
-function TFreeBitmap.GetHistogram(Histo: PDWORD;
- Channel: FREE_IMAGE_COLOR_CHANNEL): Boolean;
-begin
- if FDib <> nil then
- Result := FreeImage_GetHistogram(FDib, Histo, Channel)
- else
- Result := False
-end;
-
-function TFreeBitmap.GetHorizontalResolution: Double;
-begin
- Result := FreeImage_GetDotsPerMeterX(FDib) / 100
-end;
-
-function TFreeBitmap.GetImageSize: Cardinal;
-begin
- Result := FreeImage_GetDIBSize(FDib);
-end;
-
-function TFreeBitmap.GetImageType: FREE_IMAGE_TYPE;
-begin
- Result := FreeImage_GetImageType(FDib);
-end;
-
-function TFreeBitmap.GetInfo: PBitmapInfo;
-begin
- Result := FreeImage_GetInfo(FDib^)
-end;
-
-function TFreeBitmap.GetInfoHeader: PBITMAPINFOHEADER;
-begin
- Result := FreeImage_GetInfoHeader(FDib)
-end;
-
-function TFreeBitmap.GetLine: Integer;
-begin
- Result := FreeImage_GetLine(FDib)
-end;
-
-function TFreeBitmap.GetMetadata(Model: FREE_IMAGE_MDMODEL;
- const Key: string; var Tag: TFreeTag): Boolean;
-begin
- Result := FreeImage_GetMetaData(Model, FDib, PChar(Key), Tag.FTag);
-end;
-
-function TFreeBitmap.GetMetadataCount(Model: FREE_IMAGE_MDMODEL): Cardinal;
-begin
- Result := FreeImage_GetMetadataCount(Model, FDib);
-end;
-
-function TFreeBitmap.GetPalette: PRGBQUAD;
-begin
- Result := FreeImage_GetPalette(FDib)
-end;
-
-function TFreeBitmap.GetPaletteSize: Integer;
-begin
- Result := FreeImage_GetColorsUsed(FDib) * SizeOf(RGBQUAD)
-end;
-
-function TFreeBitmap.GetPixelColor(X, Y: Cardinal; Value: PRGBQUAD): Boolean;
-begin
- Result := FreeImage_GetPixelColor(FDib, X, Y, Value)
-end;
-
-function TFreeBitmap.GetPixelIndex(X, Y: Cardinal;
- var Value: PByte): Boolean;
-begin
- Result := FreeImage_GetPixelIndex(FDib, X, Y, Value)
-end;
-
-function TFreeBitmap.GetScanLine(ScanLine: Integer): PByte;
-var
- H: Integer;
-begin
- H := FreeImage_GetHeight(FDib);
- if ScanLine < H then
- Result := FreeImage_GetScanLine(FDib, ScanLine)
- else
- Result := nil;
-end;
-
-function TFreeBitmap.GetScanWidth: Integer;
-begin
- Result := FreeImage_GetPitch(FDib)
-end;
-
-function TFreeBitmap.GetTransparencyCount: Cardinal;
-begin
- Result := FreeImage_GetTransparencyCount(FDib)
-end;
-
-function TFreeBitmap.GetTransparencyTable: PByte;
-begin
- Result := FreeImage_GetTransparencyTable(FDib)
-end;
-
-function TFreeBitmap.GetVerticalResolution: Double;
-begin
- Result := FreeImage_GetDotsPerMeterY(Fdib) / 100
-end;
-
-function TFreeBitmap.GetWidth: Integer;
-begin
- Result := FreeImage_GetWidth(FDib)
-end;
-
-function TFreeBitmap.HasFileBkColor: Boolean;
-begin
- Result := FreeImage_HasBackgroundColor(FDib)
-end;
-
-function TFreeBitmap.Invert: Boolean;
-begin
- if FDib <> nil then
- begin
- Result := FreeImage_Invert(FDib);
- Change;
- end
- else
- Result := False
-end;
-
-function TFreeBitmap.IsGrayScale: Boolean;
-begin
- Result := (FreeImage_GetBPP(FDib) = 8)
- and (FreeImage_GetColorType(FDib) = FIC_PALETTE);
-end;
-
-function TFreeBitmap.IsTransparent: Boolean;
-begin
- Result := FreeImage_IsTransparent(FDib);
-end;
-
-function TFreeBitmap.IsValid: Boolean;
-begin
- Result := FDib <> nil
-end;
-
-function TFreeBitmap.Load(const FileName: string; Flag: Integer): Boolean;
-var
- fif: FREE_IMAGE_FORMAT;
-begin
-
- // check the file signature and get its format
- fif := FreeImage_GetFileType(PChar(Filename), 0);
- if fif = FIF_UNKNOWN then
- // no signature?
- // try to guess the file format from the file extention
- fif := FreeImage_GetFIFFromFilename(PChar(FileName));
-
- // check that the plugin has reading capabilities ...
- if (fif <> FIF_UNKNOWN) and FreeImage_FIFSupportsReading(FIF) then
- begin
- // free the previous dib
- if FDib <> nil then
- FreeImage_Unload(dib);
-
- // load the file
- FDib := FreeImage_Load(fif, PChar(FileName), Flag);
-
- Change;
- Result := IsValid;
- end else
- Result := False;
-end;
-
-function TFreeBitmap.LoadFromHandle(IO: PFreeImageIO; Handle: fi_handle;
- Flag: Integer): Boolean;
-var
- fif: FREE_IMAGE_FORMAT;
-begin
- // check the file signature and get its format
- fif := FreeImage_GetFileTypeFromHandle(IO, Handle, 16);
- if (fif <> FIF_UNKNOWN) and FreeImage_FIFSupportsReading(fif) then
- begin
- // free the previous dib
- if FDib <> nil then
- FreeImage_Unload(FDib);
-
- // load the file
- FDib := FreeImage_LoadFromHandle(fif, IO, Handle, Flag);
-
- Change;
- Result := IsValid;
- end else
- Result := False;
-end;
-
-function TFreeBitmap.LoadFromMemory(MemIO: TFreeMemoryIO;
- Flag: Integer): Boolean;
-var
- fif: FREE_IMAGE_FORMAT;
-begin
-
- // check the file signature and get its format
- fif := MemIO.GetFileType;
- if (fif <> FIF_UNKNOWN) and FreeImage_FIFSupportsReading(fif) then
- begin
- // free the previous dib
- if FDib <> nil then
- FreeImage_Unload(FDib);
-
- // load the file
- FDib := MemIO.Read(fif, Flag);
-
- Result := IsValid;
- Change;
- end else
- Result := False;
-end;
-
-function TFreeBitmap.LoadFromStream(Stream: TStream;
- Flag: Integer): Boolean;
-var
- MemIO: TFreeMemoryIO;
- Data: PByte;
- MemStream: TMemoryStream;
- Size: Cardinal;
-begin
- Size := Stream.Size;
-
- MemStream := TMemoryStream.Create;
- try
- MemStream.CopyFrom(Stream, Size);
- Data := MemStream.Memory;
-
- MemIO := TFreeMemoryIO.Create(Data, Size);
- try
- Result := LoadFromMemory(MemIO);
- finally
- MemIO.Free;
- end;
- finally
- MemStream.Free;
- end;
-end;
-
-function TFreeBitmap.LoadU(const FileName: WideString;
- Flag: Integer): Boolean;
-var
- fif: FREE_IMAGE_FORMAT;
-begin
-
- // check the file signature and get its format
- fif := FreeImage_GetFileTypeU(PWideChar(Filename), 0);
- if fif = FIF_UNKNOWN then
- // no signature?
- // try to guess the file format from the file extention
- fif := FreeImage_GetFIFFromFilenameU(PWideChar(FileName));
-
- // check that the plugin has reading capabilities ...
- if (fif <> FIF_UNKNOWN) and FreeImage_FIFSupportsReading(FIF) then
- begin
- // free the previous dib
- if FDib <> nil then
- FreeImage_Unload(dib);
-
- // load the file
- FDib := FreeImage_LoadU(fif, PWideChar(FileName), Flag);
-
- Change;
- Result := IsValid;
- end else
- Result := False;
-end;
-
-procedure TFreeBitmap.MakeThumbnail(const Width, Height: Integer;
- DestBitmap: TFreeBitmap);
-type
- PRGB24 = ^TRGB24;
- TRGB24 = packed record
- B: Byte;
- G: Byte;
- R: Byte;
- end;
-var
- x, y, ix, iy: integer;
- x1, x2, x3: integer;
-
- xscale, yscale: single;
- iRed, iGrn, iBlu, iRatio: Longword;
- p, c1, c2, c3, c4, c5: TRGB24;
- pt, pt1: PRGB24;
- iSrc, iDst, s1: integer;
- i, j, r, g, b, tmpY: integer;
-
- RowDest, RowSource, RowSourceStart: integer;
- w, h: Integer;
- dxmin, dymin: integer;
- ny1, ny2, ny3: integer;
- dx, dy: integer;
- lutX, lutY: array of integer;
-
- SrcBmp, DestBmp: PFIBITMAP;
-begin
- if not IsValid then Exit;
-
- if (GetWidth <= ThumbSize) and (GetHeight <= ThumbSize) then
- begin
- DestBitmap.Assign(Self);
- Exit;
- end;
-
- w := Width;
- h := Height;
-
- // prepare bitmaps
- if GetBitsPerPixel <> 24 then
- SrcBmp := FreeImage_ConvertTo24Bits(FDib)
- else
- SrcBmp := FDib;
- DestBmp := FreeImage_Allocate(w, h, 24);
- Assert(DestBmp <> nil, 'TFreeBitmap.MakeThumbnail error');
-
-{ iDst := (w * 24 + 31) and not 31;
- iDst := iDst div 8; //BytesPerScanline
- iSrc := (GetWidth * 24 + 31) and not 31;
- iSrc := iSrc div 8;
-}
- // BytesPerScanline
- iDst := FreeImage_GetPitch(DestBmp);
- iSrc := FreeImage_GetPitch(SrcBmp);
-
- xscale := 1 / (w / FreeImage_GetWidth(SrcBmp));
- yscale := 1 / (h / FreeImage_GetHeight(SrcBmp));
-
- // X lookup table
- SetLength(lutX, w);
- x1 := 0;
- x2 := trunc(xscale);
- for x := 0 to w - 1 do
- begin
- lutX[x] := x2 - x1;
- x1 := x2;
- x2 := trunc((x + 2) * xscale);
- end;
-
- // Y lookup table
- SetLength(lutY, h);
- x1 := 0;
- x2 := trunc(yscale);
- for x := 0 to h - 1 do
- begin
- lutY[x] := x2 - x1;
- x1 := x2;
- x2 := trunc((x + 2) * yscale);
- end;
-
- Dec(w);
- Dec(h);
- RowDest := integer(FreeImage_GetScanLine(DestBmp, 0));
- RowSourceStart := integer(FreeImage_GetScanLine(SrcBmp, 0));
- RowSource := RowSourceStart;
-
- for y := 0 to h do
- // resampling
- begin
- dy := lutY[y];
- x1 := 0;
- x3 := 0;
- for x := 0 to w do // loop through row
- begin
- dx:= lutX[x];
- iRed:= 0;
- iGrn:= 0;
- iBlu:= 0;
- RowSource := RowSourceStart;
- for iy := 1 to dy do
- begin
- pt := PRGB24(RowSource + x1);
- for ix := 1 to dx do
- begin
- iRed := iRed + pt.R;
- iGrn := iGrn + pt.G;
- iBlu := iBlu + pt.B;
- inc(pt);
- end;
- RowSource := RowSource + iSrc;
- end;
- iRatio := 65535 div (dx * dy);
- pt1 := PRGB24(RowDest + x3);
- pt1.R := (iRed * iRatio) shr 16;
- pt1.G := (iGrn * iRatio) shr 16;
- pt1.B := (iBlu * iRatio) shr 16;
- x1 := x1 + 3 * dx;
- inc(x3,3);
- end;
- RowDest := RowDest + iDst;
- RowSourceStart := RowSource;
- end; // resampling
-
- if FreeImage_GetHeight(DestBmp) >= 3 then
- // Sharpening...
- begin
- s1 := integer(FreeImage_GetScanLine(DestBmp, 0));
- iDst := integer(FreeImage_GetScanLine(DestBmp, 1)) - s1;
- ny1 := Integer(s1);
- ny2 := ny1 + iDst;
- ny3 := ny2 + iDst;
- for y := 1 to FreeImage_GetHeight(DestBmp) - 2 do
- begin
- for x := 0 to FreeImage_GetWidth(DestBmp) - 3 do
- begin
- x1 := x * 3;
- x2 := x1 + 3;
- x3 := x1 + 6;
-
- c1 := pRGB24(ny1 + x1)^;
- c2 := pRGB24(ny1 + x3)^;
- c3 := pRGB24(ny2 + x2)^;
- c4 := pRGB24(ny3 + x1)^;
- c5 := pRGB24(ny3 + x3)^;
-
- r := (c1.R + c2.R + (c3.R * -12) + c4.R + c5.R) div -8;
- g := (c1.G + c2.G + (c3.G * -12) + c4.G + c5.G) div -8;
- b := (c1.B + c2.B + (c3.B * -12) + c4.B + c5.B) div -8;
-
- if r < 0 then r := 0 else if r > 255 then r := 255;
- if g < 0 then g := 0 else if g > 255 then g := 255;
- if b < 0 then b := 0 else if b > 255 then b := 255;
-
- pt1 := pRGB24(ny2 + x2);
- pt1.R := r;
- pt1.G := g;
- pt1.B := b;
- end;
- inc(ny1, iDst);
- inc(ny2, iDst);
- inc(ny3, iDst);
- end;
- end; // sharpening
-
- if SrcBmp <> FDib then
- FreeImage_Unload(SrcBmp);
- DestBitmap.Replace(DestBmp);
-end;
-
-function TFreeBitmap.PasteSubImage(Src: TFreeBitmap; Left, Top,
- Alpha: Integer): Boolean;
-begin
- if FDib <> nil then
- begin
- Result := FreeImage_Paste(FDib, Src.Dib, Left, Top, Alpha);
- Change;
- end else
- Result := False;
-end;
-
-function TFreeBitmap.Replace(NewDib: PFIBITMAP): Boolean;
-begin
- Result := False;
- if NewDib = nil then Exit;
-
- if not DoChanging(FDib, NewDib) and IsValid then
- FreeImage_Unload(FDib);
-
- FDib := NewDib;
- Result := True;
- Change;
-end;
-
-function TFreeBitmap.Rescale(NewWidth, NewHeight: Integer;
- Filter: FREE_IMAGE_FILTER; Dest: TFreeBitmap): Boolean;
-var
- Bpp: Integer;
- DstDib: PFIBITMAP;
-begin
- Result := False;
-
- if FDib <> nil then
- begin
- Bpp := FreeImage_GetBPP(FDib);
-
- if Bpp < 8 then
- if not ConvertToGrayscale then Exit
- else
- if Bpp = 16 then
- // convert to 24-bit
- if not ConvertTo24Bits then Exit;
-
- // perform upsampling / downsampling
- DstDib := FreeImage_Rescale(FDib, NewWidth, NewHeight, Filter);
- if Dest = nil then
- Result := Replace(DstDib)
- else
- Result := Dest.Replace(DstDib)
- end
-end;
-
-function TFreeBitmap.Rotate(Angle: Double): Boolean;
-var
- Bpp: Integer;
- Rotated: PFIBITMAP;
-begin
- Result := False;
- if IsValid then
- begin
- Bpp := FreeImage_GetBPP(FDib);
- if Bpp in [1, 8, 24, 32] then
- begin
- Rotated := FreeImage_RotateClassic(FDib, Angle);
- Result := Replace(Rotated);
- end
- end;
-end;
-
-function TFreeBitmap.RotateEx(Angle, XShift, YShift, XOrigin,
- YOrigin: Double; UseMask: Boolean): Boolean;
-var
- Rotated: PFIBITMAP;
-begin
- Result := False;
- if FDib <> nil then
- begin
- if FreeImage_GetBPP(FDib) >= 8 then
- begin
- Rotated := FreeImage_RotateEx(FDib, Angle, XShift, YShift, XOrigin, YOrigin, UseMask);
- Result := Replace(Rotated);
- end
- end;
-end;
-
-function TFreeBitmap.Save(const FileName: string; Flag: Integer): Boolean;
-var
- fif: FREE_IMAGE_FORMAT;
-begin
- Result := False;
-
- // try to guess the file format from the file extension
- fif := FreeImage_GetFIFFromFilename(PChar(Filename));
- if CanSave(fif) then
- Result := FreeImage_Save(fif, FDib, PChar(FileName), Flag);
-end;
-
-function TFreeBitmap.SaveToHandle(fif: FREE_IMAGE_FORMAT; IO: PFreeImageIO;
- Handle: fi_handle; Flag: Integer): Boolean;
-begin
- Result := False;
- if CanSave(fif) then
- Result := FreeImage_SaveToHandle(fif, FDib, IO, Handle, Flag)
-end;
-
-function TFreeBitmap.SaveToMemory(fif: FREE_IMAGE_FORMAT;
- MemIO: TFreeMemoryIO; Flag: Integer): Boolean;
-begin
- Result := False;
-
- if CanSave(fif) then
- Result := MemIO.Write(fif, FDib, Flag)
-end;
-
-function TFreeBitmap.SaveToStream(fif: FREE_IMAGE_FORMAT; Stream: TStream;
- Flag: Integer): Boolean;
-var
- MemIO: TFreeMemoryIO;
- Data: PByte;
- Size: Cardinal;
-begin
- MemIO := TFreeMemoryIO.Create;
- try
- Result := SaveToMemory(fif, MemIO, Flag);
- if Result then
- begin
- MemIO.Acquire(Data, Size);
- Stream.WriteBuffer(Data^, Size);
- end;
- finally
- MemIO.Free;
- end;
-end;
-
-function TFreeBitmap.SaveU(const FileName: WideString;
- Flag: Integer): Boolean;
-var
- fif: FREE_IMAGE_FORMAT;
-begin
- Result := False;
-
- // try to guess the file format from the file extension
- fif := FreeImage_GetFIFFromFilenameU(PWideChar(Filename));
- if CanSave(fif) then
- Result := FreeImage_SaveU(fif, FDib, PWideChar(FileName), Flag);
-end;
-
-function TFreeBitmap.SetChannel(Bitmap: TFreeBitmap;
- Channel: FREE_IMAGE_COLOR_CHANNEL): Boolean;
-begin
- if FDib <> nil then
- begin
- Result := FreeImage_SetChannel(FDib, Bitmap.FDib, Channel);
- Change;
- end
- else
- Result := False
-end;
-
-procedure TFreeBitmap.SetDib(Value: PFIBITMAP);
-begin
- Replace(Value);
-end;
-
-function TFreeBitmap.SetFileBkColor(BkColor: PRGBQuad): Boolean;
-begin
- Result := FreeImage_SetBackgroundColor(FDib, BkColor);
- Change;
-end;
-
-procedure TFreeBitmap.SetHorizontalResolution(Value: Double);
-begin
- if IsValid then
- begin
- FreeImage_SetDotsPerMeterX(FDib, Trunc(Value * 100 + 0.5));
- Change;
- end;
-end;
-
-function TFreeBitmap.SetMetadata(Model: FREE_IMAGE_MDMODEL;
- const Key: string; Tag: TFreeTag): Boolean;
-begin
- Result := FreeImage_SetMetadata(Model, FDib, PChar(Key), Tag.Tag);
-end;
-
-function TFreeBitmap.SetPixelColor(X, Y: Cardinal;
- Value: PRGBQUAD): Boolean;
-begin
- Result := FreeImage_SetPixelColor(FDib, X, Y, Value);
- Change;
-end;
-
-function TFreeBitmap.SetPixelIndex(X, Y: Cardinal; Value: PByte): Boolean;
-begin
- Result := FreeImage_SetPixelIndex(FDib, X, Y, Value);
- Change;
-end;
-
-function TFreeBitmap.SetSize(ImageType: FREE_IMAGE_TYPE; Width, Height,
- Bpp: Integer; RedMask, GreenMask, BlueMask: Cardinal): Boolean;
-var
- Pal: PRGBQuad;
- I: Cardinal;
-begin
- Result := False;
-
- if FDib <> nil then
- FreeImage_Unload(FDib);
-
- FDib := FreeImage_Allocate(Width, Height, Bpp, RedMask, GreenMask, BlueMask);
- if FDib = nil then Exit;
-
- if ImageType = FIT_BITMAP then
- case Bpp of
- 1, 4, 8:
- begin
- Pal := FreeImage_GetPalette(FDib);
- for I := 0 to FreeImage_GetColorsUsed(FDib) - 1 do
- begin
- Pal.rgbBlue := I;
- Pal.rgbGreen := I;
- Pal.rgbRed := I;
- Inc(Pal, SizeOf(RGBQUAD));
- end;
- end;
- end;
-
- Result := True;
- Change;
-end;
-
-procedure TFreeBitmap.SetTransparencyTable(Table: PByte; Count: Integer);
-begin
- FreeImage_SetTransparencyTable(FDib, Table, Count);
- Change;
-end;
-
-procedure TFreeBitmap.SetVerticalResolution(Value: Double);
-begin
- if IsValid then
- begin
- FreeImage_SetDotsPerMeterY(FDib, Trunc(Value * 100 + 0.5));
- Change;
- end;
-end;
-
-function TFreeBitmap.SplitChannels(RedChannel, GreenChannel,
- BlueChannel: TFreeBitmap): Boolean;
-begin
- if FDib <> nil then
- begin
- RedChannel.FDib := FreeImage_GetChannel(FDib, FICC_RED);
- GreenChannel.FDib := FreeImage_GetChannel(FDib, FICC_GREEN);
- BlueChannel.FDib := FreeImage_GetChannel(FDib, FICC_BLUE);
- Result := RedChannel.IsValid and GreenChannel.IsValid and BlueChannel.IsValid;
- end
- else
- Result := False
-end;
-
-function TFreeBitmap.Threshold(T: Byte): Boolean;
-var
- dib1: PFIBITMAP;
-begin
- if FDib <> nil then
- begin
- dib1 := FreeImage_Threshold(FDib, T);
- Result := Replace(dib1);
- end
- else
- Result := False
-end;
-
-function TFreeBitmap.ToneMapping(TMO: FREE_IMAGE_TMO; FirstParam,
- SecondParam: Double): Boolean;
-var
- NewDib: PFIBITMAP;
-begin
- Result := False;
- if not IsValid then Exit;
-
- NewDib := FreeImage_ToneMapping(Fdib, TMO, FirstParam, SecondParam);
- Result := Replace(NewDib);
-end;
-
-
-{ TFreeMultiBitmap }
-
-procedure TFreeMultiBitmap.AppendPage(Bitmap: TFreeBitmap);
-begin
- if IsValid then
- FreeImage_AppendPage(FMPage, Bitmap.FDib);
-end;
-
-function TFreeMultiBitmap.Close(Flags: Integer): Boolean;
-begin
- Result := FreeImage_CloseMultiBitmap(FMPage, Flags);
- FMPage := nil;
-end;
-
-constructor TFreeMultiBitmap.Create(KeepCacheInMemory: Boolean);
-begin
- inherited Create;
- FMemoryCache := KeepCacheInMemory;
-end;
-
-procedure TFreeMultiBitmap.DeletePage(Page: Integer);
-begin
- if IsValid then
- FreeImage_DeletePage(FMPage, Page);
-end;
-
-destructor TFreeMultiBitmap.Destroy;
-begin
- if FMPage <> nil then Close;
- inherited;
-end;
-
-function TFreeMultiBitmap.GetLockedPageNumbers(var Pages,
- Count: Integer): Boolean;
-begin
- Result := False;
- if not IsValid then Exit;
- Result := FreeImage_GetLockedPageNumbers(FMPage, Pages, Count)
-end;
-
-function TFreeMultiBitmap.GetPageCount: Integer;
-begin
- Result := 0;
- if IsValid then
- Result := FreeImage_GetPageCount(FMPage)
-end;
-
-procedure TFreeMultiBitmap.InsertPage(Page: Integer; Bitmap: TFreeBitmap);
-begin
- if IsValid then
- FreeImage_InsertPage(FMPage, Page, Bitmap.FDib);
-end;
-
-function TFreeMultiBitmap.IsValid: Boolean;
-begin
- Result := FMPage <> nil
-end;
-
-procedure TFreeMultiBitmap.LockPage(Page: Integer; DestBitmap: TFreeBitmap);
-begin
- if not IsValid then Exit;
-
- if Assigned(DestBitmap) then
- begin
- DestBitmap.Replace(FreeImage_LockPage(FMPage, Page));
- end;
-end;
-
-function TFreeMultiBitmap.MovePage(Target, Source: Integer): Boolean;
-begin
- Result := False;
- if not IsValid then Exit;
- Result := FreeImage_MovePage(FMPage, Target, Source);
-end;
-
-function TFreeMultiBitmap.Open(const FileName: string; CreateNew,
- ReadOnly: Boolean; Flags: Integer): Boolean;
-var
- fif: FREE_IMAGE_FORMAT;
-begin
- Result := False;
-
- // try to guess the file format from the filename
- fif := FreeImage_GetFIFFromFilename(PChar(FileName));
-
- // check for supported file types
- if (fif <> FIF_UNKNOWN) and (not fif in [FIF_TIFF, FIF_ICO, FIF_GIF]) then
- Exit;
-
- // open the stream
- FMPage := FreeImage_OpenMultiBitmap(fif, PChar(FileName), CreateNew, ReadOnly, FMemoryCache, Flags);
-
- Result := FMPage <> nil;
-end;
-
-procedure TFreeMultiBitmap.UnlockPage(Bitmap: TFreeBitmap;
- Changed: Boolean);
-begin
- if IsValid then
- begin
- FreeImage_UnlockPage(FMPage, Bitmap.FDib, Changed);
- // clear the image so that it becomes invalid.
- // don't use Bitmap.Clear method because it calls FreeImage_Unload
- // just clear the pointer
- Bitmap.FDib := nil;
- Bitmap.Change;
- end;
-end;
-
-{ TFreeMemoryIO }
-
-function TFreeMemoryIO.Acquire(var Data: PByte;
- var SizeInBytes: DWORD): Boolean;
-begin
- Result := FreeImage_AcquireMemory(FHMem, Data, SizeInBytes);
-end;
-
-constructor TFreeMemoryIO.Create(Data: PByte; SizeInBytes: DWORD);
-begin
- inherited Create;
- FHMem := FreeImage_OpenMemory(Data, SizeInBytes);
-end;
-
-destructor TFreeMemoryIO.Destroy;
-begin
- FreeImage_CloseMemory(FHMem);
- inherited;
-end;
-
-function TFreeMemoryIO.GetFileType: FREE_IMAGE_FORMAT;
-begin
- Result := FreeImage_GetFileTypeFromMemory(FHMem);
-end;
-
-function TFreeMemoryIO.IsValid: Boolean;
-begin
- Result := FHMem <> nil
-end;
-
-function TFreeMemoryIO.Read(fif: FREE_IMAGE_FORMAT;
- Flag: Integer): PFIBITMAP;
-begin
- Result := FreeImage_LoadFromMemory(fif, FHMem, Flag)
-end;
-
-function TFreeMemoryIO.Seek(Offset: Longint; Origin: Word): Boolean;
-begin
- Result := FreeImage_SeekMemory(FHMem, Offset, Origin)
-end;
-
-function TFreeMemoryIO.Tell: Longint;
-begin
- Result := FreeImage_TellMemory(FHMem)
-end;
-
-function TFreeMemoryIO.Write(fif: FREE_IMAGE_FORMAT; dib: PFIBITMAP;
- Flag: Integer): Boolean;
-begin
- Result := FreeImage_SaveToMemory(fif, dib, FHMem, Flag)
-end;
-
-{ TFreeTag }
-
-function TFreeTag.Clone: TFreeTag;
-var
- CloneTag: PFITAG;
-begin
- Result := nil;
- if not IsValid then Exit;
-
- CloneTag := FreeImage_CloneTag(FTag);
- Result := TFreeTag.Create(CloneTag);
-end;
-
-constructor TFreeTag.Create(ATag: PFITAG);
-begin
- inherited Create;
-
- if ATag <> nil then
- FTag := ATag
- else
- FTag := FreeImage_CreateTag;
-end;
-
-destructor TFreeTag.Destroy;
-begin
- if IsValid then
- FreeImage_DeleteTag(FTag);
-
- inherited;
-end;
-
-function TFreeTag.GetCount: Cardinal;
-begin
- Result := 0;
- if not IsValid then Exit;
-
- Result := FreeImage_GetTagCount(FTag);
-end;
-
-function TFreeTag.GetDescription: string;
-begin
- Result := '';
- if not IsValid then Exit;
-
- Result := FreeImage_GetTagDescription(FTag);
-end;
-
-function TFreeTag.GetID: Word;
-begin
- Result := 0;
- if not IsValid then Exit;
-
- Result := FreeImage_GetTagID(FTag);
-end;
-
-function TFreeTag.GetKey: string;
-begin
- Result := '';
- if not IsValid then Exit;
-
- Result := FreeImage_GetTagKey(FTag);
-end;
-
-function TFreeTag.GetLength: Cardinal;
-begin
- Result := 0;
- if not IsValid then Exit;
-
- Result := FreeImage_GetTagLength(FTag);
-end;
-
-function TFreeTag.GetTagType: FREE_IMAGE_MDTYPE;
-begin
- Result := FIDT_NOTYPE;
- if not IsValid then Exit;
-
- Result := FreeImage_GetTagType(FTag);
-end;
-
-function TFreeTag.GetValue: Pointer;
-begin
- Result := nil;
- if not IsValid then Exit;
-
- Result := FreeImage_GetTagValue(FTag);
-end;
-
-function TFreeTag.IsValid: Boolean;
-begin
- Result := FTag <> nil;
-end;
-
-procedure TFreeTag.SetCount(const Value: Cardinal);
-begin
- if IsValid then
- FreeImage_SetTagCount(FTag, Value);
-end;
-
-procedure TFreeTag.SetDescription(const Value: string);
-begin
- if IsValid then
- FreeImage_SetTagDescription(FTag, PChar(Value));
-end;
-
-procedure TFreeTag.SetID(const Value: Word);
-begin
- if IsValid then
- FreeImage_SetTagID(FTag, Value);
-end;
-
-procedure TFreeTag.SetKey(const Value: string);
-begin
- if IsValid then
- FreeImage_SetTagKey(FTag, PChar(Value));
-end;
-
-procedure TFreeTag.SetLength(const Value: Cardinal);
-begin
- if IsValid then
- FreeImage_SetTagLength(FTag, Value);
-end;
-
-procedure TFreeTag.SetTagType(const Value: FREE_IMAGE_MDTYPE);
-begin
- if IsValid then
- FreeImage_SetTagType(FTag, Value);
-end;
-
-procedure TFreeTag.SetValue(const Value: Pointer);
-begin
- if IsValid then
- FreeImage_SetTagValue(FTag, Value);
-end;
-
-function TFreeTag.ToString(Model: FREE_IMAGE_MDMODEL; Make: PChar): string;
-begin
- Result := FreeImage_TagToString(Model, FTag, Make);
-end;
-
-end.
diff --git a/src/lib/FreeImage/FreeImage.pas b/src/lib/FreeImage/FreeImage.pas
deleted file mode 100644
index 69c0a0d1..00000000
--- a/src/lib/FreeImage/FreeImage.pas
+++ /dev/null
@@ -1,771 +0,0 @@
-unit FreeImage;
-
-{$I switches.inc}
-
-
-// ==========================================================
-// Delphi wrapper for FreeImage 3
-//
-// Design and implementation by
-// - Simon Beavis
-// - Peter Byström
-// - Anatoliy Pulyaevskiy (xvel84@rambler.ru)
-//
-// This file is part of FreeImage 3
-//
-// COVERED CODE IS PROVIDED UNDER THIS LICENSE ON AN "AS IS" BASIS, WITHOUT WARRANTY
-// OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, WITHOUT LIMITATION, WARRANTIES
-// THAT THE COVERED CODE IS FREE OF DEFECTS, MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE
-// OR NON-INFRINGING. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE COVERED
-// CODE IS WITH YOU. SHOULD ANY COVERED CODE PROVE DEFECTIVE IN ANY RESPECT, YOU (NOT
-// THE INITIAL DEVELOPER OR ANY OTHER CONTRIBUTOR) ASSUME THE COST OF ANY NECESSARY
-// SERVICING, REPAIR OR CORRECTION. THIS DISCLAIMER OF WARRANTY CONSTITUTES AN ESSENTIAL
-// PART OF THIS LICENSE. NO USE OF ANY COVERED CODE IS AUTHORIZED HEREUNDER EXCEPT UNDER
-// THIS DISCLAIMER.
-//
-// Use at your own risk!
-// ==========================================================
-
-interface
-
-uses
- {$IFDEF MSWINDOWS}
- Windows,
- {$ENDIF}
- ctypes;
-
-{$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 MSWINDOWS}
- {$DEFINE DLL_STDCALL}
-{$ELSE}
- {$DEFINE DLL_CDECL}
-{$ENDIF}
-
-const
-{$IF Defined(MSWINDOWS)}
- FIDLL = 'freeimage.dll';
-{$ELSEIF Defined(DARWIN)}
- FIDLL = 'libfreeimage.dylib';
-{$ELSEIF Defined(UNIX)}
- FIDLL = 'libfreeimage.so';
-{$IFEND}
-
-{$IFNDEF MSWINDOWS}
-type
- // define portable types for 32-bit / 64-bit OS
- BOOL = cint32;
- BYTE = cuint8;
- WORD = cuint16;
- DWORD = cuint32;
- LONG = cint32;
-{$ENDIF}
-
-// --------------------------------------------------------------------------
-// Bitmap types -------------------------------------------------------------
-// --------------------------------------------------------------------------
-
-type
- FIBITMAP = record
- data : Pointer;
- end;
- PFIBITMAP = ^FIBITMAP;
-
- FIMULTIBITMAP = record
- data : Pointer;
- end;
- PFIMULTIBITMAP = ^FIMULTIBITMAP;
-
-// --------------------------------------------------------------------------
-// Indexes for byte arrays, masks and shifts for treating pixels as words ---
-// These coincide with the order of RGBQUAD and RGBTRIPLE -------------------
-// Little Endian (x86 / MS Windows, Linux) : BGR(A) order -------------------
-// --------------------------------------------------------------------------
-
-const
- FI_RGBA_RED = 2;
- FI_RGBA_GREEN = 1;
- FI_RGBA_BLUE = 0;
- FI_RGBA_ALPHA = 3;
- FI_RGBA_RED_MASK = $00FF0000;
- FI_RGBA_GREEN_MASK = $0000FF00;
- FI_RGBA_BLUE_MASK = $000000FF;
- FI_RGBA_ALPHA_MASK = $FF000000;
- FI_RGBA_RED_SHIFT = 16;
- FI_RGBA_GREEN_SHIFT = 8;
- FI_RGBA_BLUE_SHIFT = 0;
- FI_RGBA_ALPHA_SHIFT = 24;
-
-// --------------------------------------------------------------------------
-// The 16bit macros only include masks and shifts, --------------------------
-// since each color element is not byte aligned -----------------------------
-// --------------------------------------------------------------------------
-
-const
- FI16_555_RED_MASK = $7C00;
- FI16_555_GREEN_MASK = $03E0;
- FI16_555_BLUE_MASK = $001F;
- FI16_555_RED_SHIFT = 10;
- FI16_555_GREEN_SHIFT = 5;
- FI16_555_BLUE_SHIFT = 0;
- FI16_565_RED_MASK = $F800;
- FI16_565_GREEN_MASK = $07E0;
- FI16_565_BLUE_MASK = $001F;
- FI16_565_RED_SHIFT = 11;
- FI16_565_GREEN_SHIFT = 5;
- FI16_565_BLUE_SHIFT = 0;
-
-// --------------------------------------------------------------------------
-// ICC profile support ------------------------------------------------------
-// --------------------------------------------------------------------------
-
-const
- FIICC_DEFAULT = $0;
- FIICC_COLOR_IS_CMYK = $1;
-
-type
- FIICCPROFILE = record
- flags : WORD; // info flag
- size : DWORD; // profile's size measured in bytes
- data : Pointer; // points to a block of contiguous memory containing the profile
- end;
- PFIICCPROFILE = ^FIICCPROFILE;
-
-// --------------------------------------------------------------------------
-// Important enums ----------------------------------------------------------
-// --------------------------------------------------------------------------
-
-type
- FREE_IMAGE_FORMAT = cint;
- FREE_IMAGE_TYPE = cint;
- FREE_IMAGE_COLOR_TYPE = cint;
- FREE_IMAGE_QUANTIZE = cint;
- FREE_IMAGE_DITHER = cint;
- FREE_IMAGE_FILTER = cint;
- FREE_IMAGE_COLOR_CHANNEL = cint;
- FREE_IMAGE_MDTYPE = cint;
- FREE_IMAGE_MDMODEL = cint;
- FREE_IMAGE_JPEG_OPERATION = cint;
- FREE_IMAGE_TMO = cint;
-
-const
- // I/O image format identifiers.
- FIF_UNKNOWN = FREE_IMAGE_FORMAT(-1);
- FIF_BMP = FREE_IMAGE_FORMAT(0);
- FIF_ICO = FREE_IMAGE_FORMAT(1);
- FIF_JPEG = FREE_IMAGE_FORMAT(2);
- FIF_JNG = FREE_IMAGE_FORMAT(3);
- FIF_KOALA = FREE_IMAGE_FORMAT(4);
- FIF_LBM = FREE_IMAGE_FORMAT(5);
- FIF_IFF = FIF_LBM;
- FIF_MNG = FREE_IMAGE_FORMAT(6);
- FIF_PBM = FREE_IMAGE_FORMAT(7);
- FIF_PBMRAW = FREE_IMAGE_FORMAT(8);
- FIF_PCD = FREE_IMAGE_FORMAT(9);
- FIF_PCX = FREE_IMAGE_FORMAT(10);
- FIF_PGM = FREE_IMAGE_FORMAT(11);
- FIF_PGMRAW = FREE_IMAGE_FORMAT(12);
- FIF_PNG = FREE_IMAGE_FORMAT(13);
- FIF_PPM = FREE_IMAGE_FORMAT(14);
- FIF_PPMRAW = FREE_IMAGE_FORMAT(15);
- FIF_RAS = FREE_IMAGE_FORMAT(16);
- FIF_TARGA = FREE_IMAGE_FORMAT(17);
- FIF_TIFF = FREE_IMAGE_FORMAT(18);
- FIF_WBMP = FREE_IMAGE_FORMAT(19);
- FIF_PSD = FREE_IMAGE_FORMAT(20);
- FIF_CUT = FREE_IMAGE_FORMAT(21);
- FIF_XBM = FREE_IMAGE_FORMAT(22);
- FIF_XPM = FREE_IMAGE_FORMAT(23);
- FIF_DDS = FREE_IMAGE_FORMAT(24);
- FIF_GIF = FREE_IMAGE_FORMAT(25);
- FIF_HDR = FREE_IMAGE_FORMAT(26);
- FIF_FAXG3 = FREE_IMAGE_FORMAT(27);
- FIF_SGI = FREE_IMAGE_FORMAT(28);
-
- // Image type used in FreeImage.
- FIT_UNKNOWN = FREE_IMAGE_TYPE(0); // unknown type
- FIT_BITMAP = FREE_IMAGE_TYPE(1); // standard image: 1-, 4-, 8-, 16-, 24-, 32-bit
- FIT_UINT16 = FREE_IMAGE_TYPE(2); // array of unsigned short: unsigned 16-bit
- FIT_INT16 = FREE_IMAGE_TYPE(3); // array of short: signed 16-bit
- FIT_UINT32 = FREE_IMAGE_TYPE(4); // array of unsigned long: unsigned 32-bit
- FIT_INT32 = FREE_IMAGE_TYPE(5); // array of long: signed 32-bit
- FIT_FLOAT = FREE_IMAGE_TYPE(6); // array of float: 32-bit IEEE floating point
- FIT_DOUBLE = FREE_IMAGE_TYPE(7); // array of double: 64-bit IEEE floating point
- FIT_COMPLEX = FREE_IMAGE_TYPE(8); // array of FICOMPLEX: 2 x 64-bit IEEE floating point
- FIT_RGB16 = FREE_IMAGE_TYPE(9); // 48-bit RGB image: 3 x 16-bit
- FIT_RGBA16 = FREE_IMAGE_TYPE(10); // 64-bit RGBA image: 4 x 16-bit
- FIT_RGBF = FREE_IMAGE_TYPE(11); // 96-bit RGB float image: 3 x 32-bit IEEE floating point
- FIT_RGBAF = FREE_IMAGE_TYPE(12); // 128-bit RGBA float image: 4 x 32-bit IEEE floating point
-
- // Image color type used in FreeImage.
- FIC_MINISWHITE = FREE_IMAGE_COLOR_TYPE(0); // min value is white
- FIC_MINISBLACK = FREE_IMAGE_COLOR_TYPE(1); // min value is black
- FIC_RGB = FREE_IMAGE_COLOR_TYPE(2); // RGB color model
- FIC_PALETTE = FREE_IMAGE_COLOR_TYPE(3); // color map indexed
- FIC_RGBALPHA = FREE_IMAGE_COLOR_TYPE(4); // RGB color model with alpha channel
- FIC_CMYK = FREE_IMAGE_COLOR_TYPE(5); // CMYK color model
-
- // Color quantization algorithms. Constants used in FreeImage_ColorQuantize.
- FIQ_WUQUANT = FREE_IMAGE_QUANTIZE(0); // Xiaolin Wu color quantization algorithm
- FIQ_NNQUANT = FREE_IMAGE_QUANTIZE(1); // NeuQuant neural-net quantization algorithm by Anthony Dekker
-
- // Dithering algorithms. Constants used FreeImage_Dither.
- FID_FS = FREE_IMAGE_DITHER(0); // Floyd & Steinberg error diffusion
- FID_BAYER4x4 = FREE_IMAGE_DITHER(1); // Bayer ordered dispersed dot dithering (order 2 dithering matrix)
- FID_BAYER8x8 = FREE_IMAGE_DITHER(2); // Bayer ordered dispersed dot dithering (order 3 dithering matrix)
- FID_CLUSTER6x6 = FREE_IMAGE_DITHER(3); // Ordered clustered dot dithering (order 3 - 6x6 matrix)
- FID_CLUSTER8x8 = FREE_IMAGE_DITHER(4); // Ordered clustered dot dithering (order 4 - 8x8 matrix)
- FID_CLUSTER16x16 = FREE_IMAGE_DITHER(5); // Ordered clustered dot dithering (order 8 - 16x16 matrix)
-
- // Lossless JPEG transformations Constants used in FreeImage_JPEGTransform
- FIJPEG_OP_NONE = FREE_IMAGE_JPEG_OPERATION(0); // no transformation
- FIJPEG_OP_FLIP_H = FREE_IMAGE_JPEG_OPERATION(1); // horizontal flip
- FIJPEG_OP_FLIP_V = FREE_IMAGE_JPEG_OPERATION(2); // vertical flip
- FIJPEG_OP_TRANSPOSE = FREE_IMAGE_JPEG_OPERATION(3); // transpose across UL-to-LR axis
- FIJPEG_OP_TRANSVERSE = FREE_IMAGE_JPEG_OPERATION(4); // transpose across UR-to-LL axis
- FIJPEG_OP_ROTATE_90 = FREE_IMAGE_JPEG_OPERATION(5); // 90-degree clockwise rotation
- FIJPEG_OP_ROTATE_180 = FREE_IMAGE_JPEG_OPERATION(6); // 180-degree rotation
- FIJPEG_OP_ROTATE_270 = FREE_IMAGE_JPEG_OPERATION(7); // 270-degree clockwise (or 90 ccw)
-
- // Tone mapping operators. Constants used in FreeImage_ToneMapping.
- FITMO_DRAGO03 = FREE_IMAGE_TMO(0); // Adaptive logarithmic mapping (F. Drago, 2003)
- FITMO_REINHARD05 = FREE_IMAGE_TMO(1); // Dynamic range reduction inspired by photoreceptor physiology (E. Reinhard, 2005)
-
- // Upsampling / downsampling filters. Constants used in FreeImage_Rescale.
- FILTER_BOX = FREE_IMAGE_FILTER(0); // Box, pulse, Fourier window, 1st order (constant) b-spline
- FILTER_BICUBIC = FREE_IMAGE_FILTER(1); // Mitchell & Netravali's two-param cubic filter
- FILTER_BILINEAR = FREE_IMAGE_FILTER(2); // Bilinear filter
- FILTER_BSPLINE = FREE_IMAGE_FILTER(3); // 4th order (cubic) b-spline
- FILTER_CATMULLROM = FREE_IMAGE_FILTER(4); // Catmull-Rom spline, Overhauser spline
- FILTER_LANCZOS3 = FREE_IMAGE_FILTER(5); // Lanczos3 filter
-
- // Color channels. Constants used in color manipulation routines.
- FICC_RGB = FREE_IMAGE_COLOR_CHANNEL(0); // Use red, green and blue channels
- FICC_RED = FREE_IMAGE_COLOR_CHANNEL(1); // Use red channel
- FICC_GREEN = FREE_IMAGE_COLOR_CHANNEL(2); // Use green channel
- FICC_BLUE = FREE_IMAGE_COLOR_CHANNEL(3); // Use blue channel
- FICC_ALPHA = FREE_IMAGE_COLOR_CHANNEL(4); // Use alpha channel
- FICC_BLACK = FREE_IMAGE_COLOR_CHANNEL(5); // Use black channel
- FICC_REAL = FREE_IMAGE_COLOR_CHANNEL(6); // Complex images: use real part
- FICC_IMAG = FREE_IMAGE_COLOR_CHANNEL(7); // Complex images: use imaginary part
- FICC_MAG = FREE_IMAGE_COLOR_CHANNEL(8); // Complex images: use magnitude
- FICC_PHASE = FREE_IMAGE_COLOR_CHANNEL(9); // Complex images: use phase
-
- // Tag data type information (based on TIFF specifications)
- FIDT_NOTYPE = FREE_IMAGE_MDTYPE(0); // placeholder
- FIDT_BYTE = FREE_IMAGE_MDTYPE(1); // 8-bit unsigned integer
- FIDT_ASCII = FREE_IMAGE_MDTYPE(2); // 8-bit bytes w/ last byte null
- FIDT_SHORT = FREE_IMAGE_MDTYPE(3); // 16-bit unsigned integer
- FIDT_LONG = FREE_IMAGE_MDTYPE(4); // 32-bit unsigned integer
- FIDT_RATIONAL = FREE_IMAGE_MDTYPE(5); // 64-bit unsigned fraction
- FIDT_SBYTE = FREE_IMAGE_MDTYPE(6); // 8-bit signed integer
- FIDT_UNDEFINED = FREE_IMAGE_MDTYPE(7); // 8-bit untyped data
- FIDT_SSHORT = FREE_IMAGE_MDTYPE(8); // 16-bit signed integer
- FIDT_SLONG = FREE_IMAGE_MDTYPE(9); // 32-bit signed integer
- FIDT_SRATIONAL = FREE_IMAGE_MDTYPE(10); // 64-bit signed fraction
- FIDT_FLOAT = FREE_IMAGE_MDTYPE(11); // 32-bit IEEE floating point
- FIDT_DOUBLE = FREE_IMAGE_MDTYPE(12); // 64-bit IEEE floating point
- FIDT_IFD = FREE_IMAGE_MDTYPE(13); // 32-bit unsigned integer (offset)
- FIDT_PALETTE = FREE_IMAGE_MDTYPE(14); // 32-bit RGBQUAD
-
- // Metadata models supported by FreeImage
- FIMD_NODATA = FREE_IMAGE_MDMODEL(-1);
- FIMD_COMMENTS = FREE_IMAGE_MDMODEL(0); // single comment or keywords
- FIMD_EXIF_MAIN = FREE_IMAGE_MDMODEL(1); // Exif-TIFF metadata
- FIMD_EXIF_EXIF = FREE_IMAGE_MDMODEL(2); // Exif-specific metadata
- FIMD_EXIF_GPS = FREE_IMAGE_MDMODEL(3); // Exif GPS metadata
- FIMD_EXIF_MAKERNOTE = FREE_IMAGE_MDMODEL(4); // Exif maker note metadata
- FIMD_EXIF_INTEROP = FREE_IMAGE_MDMODEL(5); // Exif interoperability metadata
- FIMD_IPTC = FREE_IMAGE_MDMODEL(6); // IPTC/NAA metadata
- FIMD_XMP = FREE_IMAGE_MDMODEL(7); // Abobe XMP metadata
- FIMD_GEOTIFF = FREE_IMAGE_MDMODEL(8); // GeoTIFF metadata (to be implemented)
- FIMD_ANIMATION = FREE_IMAGE_MDMODEL(9); // Animation metadata
- FIMD_CUSTOM = FREE_IMAGE_MDMODEL(10); // Used to attach other metadata types to a dib
-
-//{$endif}
-
-type
- // Handle to a metadata model
- FIMETADATA = record
- data: Pointer;
- end;
- PFIMETADATA = ^FIMETADATA;
-
- // Handle to a metadata tag
- FITAG = record
- data: Pointer;
- end;
- PFITAG = ^FITAG;
-
-// --------------------------------------------------------------------------
-// File IO routines ---------------------------------------------------------
-// --------------------------------------------------------------------------
-
-type
- FI_Handle = Pointer;
-
- FI_ReadProc = function(buffer : pointer; size : cuint; count : cuint; handle : fi_handle) : cuint; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF}
- FI_WriteProc = function(buffer : pointer; size, count : cuint; handle : FI_Handle) : cuint; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF}
- FI_SeekProc = function(handle : fi_handle; offset : clong; origin : cint) : cint; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF}
- FI_TellProc = function(handle : fi_handle) : clong; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF}
-
- FreeImageIO = packed record
- read_proc : FI_ReadProc; // pointer to the function used to read data
- write_proc: FI_WriteProc; // pointer to the function used to write data
- seek_proc : FI_SeekProc; // pointer to the function used to seek
- tell_proc : FI_TellProc; // pointer to the function used to aquire the current position
- end;
- PFreeImageIO = ^FreeImageIO;
-
- // Handle to a memory I/O stream
- FIMEMORY = record
- data: Pointer;
- end;
- PFIMEMORY = ^FIMEMORY;
-
-const
- // constants used in FreeImage_Seek for Origin parameter
- SEEK_SET = 0;
- SEEK_CUR = 1;
- SEEK_END = 2;
-
-// --------------------------------------------------------------------------
-// Plugin routines ----------------------------------------------------------
-// --------------------------------------------------------------------------
-
-type
- PPluginStruct = ^PluginStruct;
-
- FI_InitProc = procedure(Plugin: PPluginStruct; Format_ID: cint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF}
- FI_FormatProc = function: PChar; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF}
- FI_DescriptionProc = function: PChar; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF}
- FI_ExtensionListProc = function: PChar; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF}
- FI_RegExprProc = function: PChar; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF}
- FI_OpenProc = function(IO: PFreeImageIO; Handle: FI_Handle; Read: BOOL): Pointer; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF}
- FI_CloseProc = procedure(IO: PFreeImageIO; Handle: FI_Handle; Data: Pointer); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF}
- FI_PageCountProc = function(IO: PFreeImageIO; Handle: FI_Handle; Data: Pointer): cint; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF}
- FI_PageCapabilityProc = function(IO: PFreeImageIO; Handle: FI_Handle; Data: Pointer): cint; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF}
- FI_LoadProc = function(IO: PFreeImageIO; Handle: FI_Handle; Page, Flags: cint; data: pointer): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF}
- FI_SaveProc = function(IO: PFreeImageIO; Dib: PFIBITMAP; Handle: FI_Handle; Page, Flags: cint; Data: Pointer): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF}
- FI_ValidateProc = function(IO: PFreeImageIO; Handle: FI_Handle): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF}
- FI_MimeProc = function: PChar; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF}
- FI_SupportsExportBPPProc = function(Bpp: cint): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF}
- FI_SupportsExportTypeProc = function(AType: FREE_IMAGE_TYPE): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF}
- FI_SupportsICCProfilesProc = function: BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF}
-
- PluginStruct = record
- format_proc: FI_FormatProc;
- description_proc: FI_DescriptionProc;
- extension_proc: FI_ExtensionListProc;
- regexpr_proc: FI_RegExprProc;
- open_proc: FI_OpenProc;
- close_proc: FI_CloseProc;
- pagecount_proc: FI_PageCountProc;
- pagecapability_proc: FI_PageCapabilityProc;
- load_proc: FI_LoadProc;
- save_proc: FI_SaveProc;
- validate_proc: FI_ValidateProc;
- mime_proc: FI_MimeProc;
- supports_export_bpp_proc: FI_SupportsExportBPPProc;
- supports_export_type_proc: FI_SupportsExportTypeProc;
- supports_icc_profiles_proc: FI_SupportsICCProfilesProc;
- end;
-
-// --------------------------------------------------------------------------
-// Load/Save flag constants -------------------------------------------------
-// --------------------------------------------------------------------------
-
-const
- BMP_DEFAULT = 0;
- BMP_SAVE_RLE = 1;
- CUT_DEFAULT = 0;
- DDS_DEFAULT = 0;
- FAXG3_DEFAULT = 0;
- GIF_DEFAULT = 0;
- ICO_DEFAULT = 0;
- ICO_MAKEALPHA = 0; // convert to 32bpp and create an alpha channel from the AND-mask when loading
- IFF_DEFAULT = 0;
- JPEG_DEFAULT = 0;
- JPEG_FAST = 1;
- JPEG_ACCURATE = 2;
- JPEG_QUALITYSUPERB = $0080;
- JPEG_QUALITYGOOD = $0100;
- JPEG_QUALITYNORMAL = $0200;
- JPEG_QUALITYAVERAGE = $0400;
- JPEG_QUALITYBAD = $0800;
- JPEG_CMYK = $1000; // load separated CMYK "as is" (use | to combine with other flags)
- KOALA_DEFAULT = 0;
- LBM_DEFAULT = 0;
- MNG_DEFAULT = 0;
- PCD_DEFAULT = 0;
- PCD_BASE = 1; // load the bitmap sized 768 x 512
- PCD_BASEDIV4 = 2; // load the bitmap sized 384 x 256
- PCD_BASEDIV16 = 3; // load the bitmap sized 192 x 128
- PCX_DEFAULT = 0;
- PNG_DEFAULT = 0;
- PNG_IGNOREGAMMA = 1; // avoid gamma correction
- PNM_DEFAULT = 0;
- PNM_SAVE_RAW = 0; // If set the writer saves in RAW format (i.e. P4, P5 or P6)
- PNM_SAVE_ASCII = 1; // If set the writer saves in ASCII format (i.e. P1, P2 or P3)
- PSD_DEFAULT = 0;
- RAS_DEFAULT = 0;
- SGI_DEFAULT = 0;
- TARGA_DEFAULT = 0;
- TARGA_LOAD_RGB888 = 1; // If set the loader converts RGB555 and ARGB8888 -> RGB888.
- TIFF_DEFAULT = 0;
- TIFF_CMYK = $0001; // reads/stores tags for separated CMYK (use | to combine with compression flags)
- TIFF_PACKBITS = $0100; // save using PACKBITS compression
- TIFF_DEFLATE = $0200; // save using DEFLATE compression
- TIFF_ADOBE_DEFLATE = $0400; // save using ADOBE DEFLATE compression
- TIFF_NONE = $0800; // save without any compression
- TIFF_CCITTFAX = $1000; // save using CCITT Group 3 fax encoding
- TIFF_CCITTFAX4 = $2000; // save using CCITT Group 4 fax encoding
- TIFF_LZW = $4000; // save using LZW compression
- TIFF_JPEG = $8000; // save using JPEG compression
- WBMP_DEFAULT = 0;
- XBM_DEFAULT = 0;
- XPM_DEFAULT = 0;
-
-// --------------------------------------------------------------------------
-// Init/Error routines ------------------------------------------------------
-// --------------------------------------------------------------------------
-
-procedure FreeImage_Initialise(load_local_plugins_only : BOOL = False); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_DeInitialise; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// --------------------------------------------------------------------------
-// Version routines ---------------------------------------------------------
-// --------------------------------------------------------------------------
-
-function FreeImage_GetVersion : PChar; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetCopyrightMessage : PChar; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// --------------------------------------------------------------------------
-// Message output functions -------------------------------------------------
-// --------------------------------------------------------------------------
-
-procedure FreeImage_OutPutMessageProc(fif: cint; fmt: PChar); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-type FreeImage_OutputMessageFunction = function(fif: FREE_IMAGE_FORMAT; msg: PChar): pointer; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF}
-procedure FreeImage_SetOutputMessage(omf: FreeImage_OutputMessageFunction); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// --------------------------------------------------------------------------
-// Allocate/Unload routines -------------------------------------------------
-// --------------------------------------------------------------------------
-
-function FreeImage_Allocate(width, height, bpp: cint; red_mask: cuint = 0; green_mask: cuint = 0; blue_mask: cuint = 0): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_AllocateT(Atype: FREE_IMAGE_TYPE; Width, Height: cint; bpp: cint = 8; red_mask: cuint = 0; green_mask: cuint = 0; blue_mask: cuint = 0): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_Clone(dib: PFIBITMAP): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_Unload(dib: PFIBITMAP); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// --------------------------------------------------------------------------
-// Load / Save routines -----------------------------------------------------
-// --------------------------------------------------------------------------
-
-function FreeImage_Load(fif: FREE_IMAGE_FORMAT; const filename: PChar; flags: cint = 0): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_LoadU(fif: FREE_IMAGE_FORMAT; const filename: PWideChar; flags: cint = 0): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_LoadFromHandle(fif: FREE_IMAGE_FORMAT; io: PFreeImageIO; handle: fi_handle; flags: cint = 0): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_Save(fif: FREE_IMAGE_FORMAT; dib: PFIBITMAP; filename: PChar; flags: cint = 0): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_SaveU(fif: FREE_IMAGE_FORMAT; dib: PFIBITMAP; const filename: PWideChar; flags: cint = 0): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_SaveToHandle(fif: FREE_IMAGE_FORMAT; dib: PFIBITMAP; io : PFreeImageIO; handle : fi_handle; flags : cint = 0) : BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// --------------------------------------------------------------------------
-// Memory I/O stream routines -----------------------------------------------
-// --------------------------------------------------------------------------
-
-function FreeImage_OpenMemory(data: PByte = nil; size_in_bytes: DWORD = 0): PFIMEMORY; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_CloseMemory(stream: PFIMEMORY); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_LoadFromMemory(fif: FREE_IMAGE_FORMAT; stream: PFIMEMORY; flags: cint = 0): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_SaveToMemory(fif: FREE_IMAGE_FORMAT; dib: PFIBITMAP; stream: PFIMEMORY; flags: cint = 0): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_TellMemory(stream: PFIMEMORY): clong; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_SeekMemory(stream: PFIMEMORY; offset: clong; origin: cint): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_AcquireMemory(stream: PFIMEMORY; var data: PByte; var size_in_bytes: DWORD): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// --------------------------------------------------------------------------
-// Plugin Interface ---------------------------------------------------------
-// --------------------------------------------------------------------------
-
-function FreeImage_RegisterLocalPlugin(proc_address: FI_InitProc; format, description, extension, regexpr: PChar): FREE_IMAGE_FORMAT; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_RegisterExternalPlugin(path, format, description, extension, regexpr: PChar): FREE_IMAGE_FORMAT; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetFIFCount: cint; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_SetPluginEnabled(fif: FREE_IMAGE_FORMAT; enable: BOOL); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_IsPluginEnabled(fif: FREE_IMAGE_FORMAT): cint; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetFIFFromFormat(const format: PChar): FREE_IMAGE_FORMAT; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetFIFFromMime(const format: PChar): FREE_IMAGE_FORMAT; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetFormatFromFIF(fif: FREE_IMAGE_FORMAT): PChar; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetFIFExtensionList(fif: FREE_IMAGE_FORMAT): PChar; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetFIFDescription(fif: FREE_IMAGE_FORMAT): PChar; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetFIFRegExpr(fif: FREE_IMAGE_FORMAT): PChar; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetFIFFromFilename(const fname: PChar): FREE_IMAGE_FORMAT; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetFIFFromFilenameU(const fname:PWideChar): FREE_IMAGE_FORMAT; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_FIFSupportsReading(fif: FREE_IMAGE_FORMAT): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_FIFSupportsWriting(fif: FREE_IMAGE_FORMAT): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_FIFSupportsExportBPP(fif: FREE_IMAGE_FORMAT; bpp: cint): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_FIFSupportsICCProfiles(fif: FREE_IMAGE_FORMAT): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_FIFSupportsExportType(fif: FREE_IMAGE_FORMAT; image_type: FREE_IMAGE_TYPE): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// --------------------------------------------------------------------------
-// Multipaging interface ----------------------------------------------------
-// --------------------------------------------------------------------------
-
-function FreeImage_OpenMultiBitmap(fif: FREE_IMAGE_FORMAT; filename: PChar; create_new, read_only, keep_cache_in_memory: BOOL; flags: cint = 0): PFIMULTIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_CloseMultiBitmap(bitmap: PFIMULTIBITMAP; flags: cint = 0): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetPageCount(bitmap: PFIMULTIBITMAP): cint; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_AppendPage(bitmap: PFIMULTIBITMAP; data: PFIBITMAP); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_InsertPage(bitmap: PFIMULTIBITMAP; page: cint; data: PFIBITMAP); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_DeletePage(bitmap: PFIMULTIBITMAP; page: cint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_LockPage(bitmap: PFIMULTIBITMAP; page: cint): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_UnlockPage(bitmap: PFIMULTIBITMAP; page: PFIBITMAP; changed: BOOL); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_MovePage(bitmap: PFIMULTIBITMAP; target, source: cint): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetLockedPageNumbers(bitmap: PFIMULTIBITMAP; var pages: cint; var count : cint): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// --------------------------------------------------------------------------
-// Filetype request routines ------------------------------------------------
-// --------------------------------------------------------------------------
-
-function FreeImage_GetFileType(const filename: PChar; size: cint): FREE_IMAGE_FORMAT; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetFileTypeU(const filename: PWideChar; size: cint): FREE_IMAGE_FORMAT; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetFileTypeFromHandle(io: PFreeImageIO; handle: FI_Handle; size: cint = 0): FREE_IMAGE_FORMAT; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetFileTypeFromMemory(stream: PFIMEMORY; size: cint = 0): FREE_IMAGE_FORMAT; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// --------------------------------------------------------------------------
-// ImageType request routine ------------------------------------------------
-// --------------------------------------------------------------------------
-
-function FreeImage_GetImageType(dib: PFIBITMAP): FREE_IMAGE_TYPE; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// --------------------------------------------------------------------------
-// FreeImage helper routines ------------------------------------------------
-// --------------------------------------------------------------------------
-
-function FreeImage_IsLittleEndian: BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_LookupX11Color(const szColor: PChar; var nRed, nGreen, nBlue: PByte): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_LookupSVGColor(const szColor: PChar; var nRed, nGreen, nBlue: PByte): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// --------------------------------------------------------------------------
-// Pixels access routines ---------------------------------------------------
-// --------------------------------------------------------------------------
-
-function FreeImage_GetBits(dib: PFIBITMAP): PByte; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetScanLine(dib: PFIBITMAP; scanline: cint): PByte; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-function FreeImage_GetPixelIndex(dib: PFIBITMAP; X, Y: cuint; Value: PByte): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetPixelColor(dib: PFIBITMAP; X, Y: cuint; Value: PRGBQuad): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_SetPixelIndex(dib: PFIBITMAP; X, Y: cuint; Value: PByte): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_SetPixelColor(dib: PFIBITMAP; X, Y: cuint; Value: PRGBQuad): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// --------------------------------------------------------------------------
-// DIB info routines --------------------------------------------------------
-// --------------------------------------------------------------------------
-
-function FreeImage_GetColorsUsed(dib: PFIBITMAP): cuint; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetBPP(dib: PFIBITMAP): cuint; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetWidth(dib: PFIBITMAP): cuint; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetHeight(dib: PFIBITMAP): cuint; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetLine(dib: PFIBITMAP): cuint; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetPitch(dib : PFIBITMAP) : cuint; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetDIBSize(dib: PFIBITMAP): cuint; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetPalette(dib: PFIBITMAP): PRGBQUAD; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-function FreeImage_GetDotsPerMeterX(dib: PFIBITMAP): cuint; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetDotsPerMeterY(dib: PFIBITMAP): cuint; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_SetDotsPerMeterX(dib: PFIBITMAP; res: cuint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_SetDotsPerMeterY(dib: PFIBITMAP; res: cuint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-function FreeImage_GetInfoHeader(dib: PFIBITMAP): PBITMAPINFOHEADER; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetInfo(var dib: FIBITMAP): PBITMAPINFO; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetColorType(dib: PFIBITMAP): FREE_IMAGE_COLOR_TYPE; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-function FreeImage_GetRedMask(dib: PFIBITMAP): cuint; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetGreenMask(dib: PFIBITMAP): cuint; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetBlueMask(dib: PFIBITMAP): cuint; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-function FreeImage_GetTransparencyCount(dib: PFIBITMAP): cuint; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetTransparencyTable(dib: PFIBITMAP): PByte; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_SetTransparent(dib: PFIBITMAP; enabled: BOOL); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_SetTransparencyTable(dib: PFIBITMAP; table: PByte; count: cint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_IsTransparent(dib: PFIBITMAP): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-function FreeImage_HasBackgroundColor(dib: PFIBITMAP): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetBackgroundColor(dib: PFIBITMAP; var bkcolor: PRGBQUAD): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_SetBackgroundColor(dib: PFIBITMAP; bkcolor: PRGBQUAD): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// --------------------------------------------------------------------------
-// ICC profile routines -----------------------------------------------------
-// --------------------------------------------------------------------------
-
-function FreeImage_GetICCProfile(var dib: FIBITMAP): PFIICCPROFILE; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_CreateICCProfile(var dib: FIBITMAP; data: Pointer; size: clong): PFIICCPROFILE; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_DestroyICCProfile(var dib : FIBITMAP); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// --------------------------------------------------------------------------
-// Line conversion routines -------------------------------------------------
-// --------------------------------------------------------------------------
-
-procedure FreeImage_ConvertLine1To4(target, source: PBYTE; width_in_pixels: cint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine8To4(target, source: PBYTE; width_in_pixels: cint; palette: PRGBQuad); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine16To4_555(target, source: PBYTE; width_in_pixels: cint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine16To4_565(target, source: PBYTE; width_in_pixels: cint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine24To4(target, source: PBYTE; width_in_pixels: cint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine32To4(target, source: PBYTE; width_in_pixels: cint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-procedure FreeImage_ConvertLine1To8(target, source: PBYTE; width_in_pixels: cint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine4To8(target, source: PBYTE; width_in_pixels: cint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine16To8_555(target, source: PBYTE; width_in_pixels: cint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine16To8_565(target, source: PBYTE; width_in_pixels: cint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine24To8(target, source: PBYTE; width_in_pixels: cint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine32To8(target, source: PBYTE; width_in_pixels: cint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-procedure FreeImage_ConvertLine1To16_555(target, source: PBYTE; width_in_pixels: cint; palette: PRGBQUAD); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine4To16_555(target, source: PBYTE; width_in_pixels: cint; palette: PRGBQUAD); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine8To16_555(target, source: PBYTE; width_in_pixels: cint; palette: PRGBQUAD); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine16_565_To16_555(target, source: PBYTE; width_in_pixels: cint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine24To16_555(target, source: PBYTE; width_in_pixels: cint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine32To16_555(target, source: PBYTE; width_in_pixels: cint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-procedure FreeImage_ConvertLine1To16_565(target, source : PBYTE; width_in_pixels: cint; palette: PRGBQUAD); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine4To16_565(target, source : PBYTE; width_in_pixels : cint; palette : PRGBQUAD); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine8To16_565(target, source: PBYTE; width_in_pixels: cint; palette: PRGBQUAD); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine16_555_To16_565(target, source: PBYTE; width_in_pixels: cint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine24To16_565(target, source: PBYTE; width_in_pixels: cint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine32To16_565(target, source : PBYTE; width_in_pixels : cint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-procedure FreeImage_ConvertLine1To24(target, source: PBYTE; width_in_pixels: cint; palette: PRGBQUAD); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine4To24(target, source : PBYTE; width_in_pixels: cint; palette: PRGBQUAD); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine8To24(target, source: PBYTE; width_in_pixels: cint; palette: PRGBQUAD); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine16To24_555(target, source: PBYTE; width_in_pixels: cint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine16To24_565(target, source: PBYTE; width_in_pixels: cint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine32To24(target, source: PBYTE; width_in_pixels: cint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-procedure FreeImage_ConvertLine1To32(target, source: PBYTE; width_in_pixels: cint; palette: PRGBQUAD); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine4To32(target, source: PBYTE; width_in_pixels: cint; palette: PRGBQUAD); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine8To32(target, source: PBYTE; width_in_pixels: cint; palette: PRGBQUAD); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine16To32_555(target, source: PBYTE; width_in_pixels: cint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine16To32_565(target, source: PBYTE; width_in_pixels: cint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertLine24To32(target, source: PBYTE; width_in_pixels: cint); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// --------------------------------------------------------------------------
-// Smart conversion routines ------------------------------------------------
-// --------------------------------------------------------------------------
-
-function FreeImage_ConvertTo4Bits(dib: PFIBITMAP): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_ConvertTo8Bits(dib: PFIBITMAP): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_ConvertToGreyscale(dib: PFIBITMAP): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_ConvertTo16Bits555(dib: PFIBITMAP): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_ConvertTo16Bits565(dib: PFIBITMAP): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_ConvertTo24Bits(dib: PFIBITMAP): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_ConvertTo32Bits(dib: PFIBITMAP): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_ColorQuantize(dib: PFIBITMAP; quantize: FREE_IMAGE_QUANTIZE): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_ColorQuantizeEx(dib: PFIBITMAP; quantize: FREE_IMAGE_QUANTIZE = FIQ_WUQUANT; PaletteSize: cint = 256; ReserveSize: cint = 0; ReservePalette: PRGBQuad = nil): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_Threshold(dib: PFIBITMAP; T: Byte): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_Dither(dib: PFIBITMAP; algorithm: FREE_IMAGE_DITHER): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-function FreeImage_ConvertFromRawBits(bits: PBYTE; width, height, pitch: cint; bpp, red_mask, green_mask, blue_mask: cuint; topdown: BOOL): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_ConvertToRawBits(bits: PBYTE; dib: PFIBITMAP; pitch: cint; bpp, red_mask, green_mask, blue_mask: cuint; topdown: BOOL); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-function FreeImage_ConvertToRGBF(dib: PFIBITMAP): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-function FreeImage_ConvertToStandardType(src: PFIBITMAP; scale_linear: BOOL = True): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_ConvertToType(src: PFIBITMAP; dst_type: FREE_IMAGE_TYPE; scale_linear: BOOL = True): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// tone mapping operators
-function FreeImage_ToneMapping(dib: PFIBITMAP; tmo: FREE_IMAGE_TMO; first_param: cdouble = 0; second_param: cdouble = 0): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_TmoDrago03(src: PFIBITMAP; gamma: cdouble = 2.2; exposure: cdouble = 0): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_TmoReinhard05(src: PFIBITMAP; intensity: cdouble = 0; contrast: cdouble = 0): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// --------------------------------------------------------------------------
-// ZLib interface -----------------------------------------------------------
-// --------------------------------------------------------------------------
-
-function FreeImage_ZLibCompress(target: PBYTE; target_size: DWORD; source: PBYTE; source_size: DWORD): DWORD; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_ZLibUncompress(target: PBYTE; target_size: DWORD; source: PBYTE; source_size: DWORD): DWORD; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-function FreeImage_ZLibGZip(target: PBYTE; target_size: DWORD; source: PBYTE; source_size: DWORD): DWORD; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_ZLibGUnzip(target: PBYTE; target_size: DWORD; source: PBYTE; source_size: DWORD): DWORD; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_ZLibCRC32(crc: DWORD; source: PByte; source_size: DWORD): DWORD; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// --------------------------------------------------------------------------
-// Metadata routines --------------------------------------------------------
-// --------------------------------------------------------------------------
-
-// tag creation / destruction
-function FreeImage_CreateTag: PFITAG; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_DeleteTag(tag: PFITAG); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_CloneTag(tag: PFITAG): PFITAG; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// tag getters and setters
-function FreeImage_GetTagKey(tag: PFITAG): PChar; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetTagDescription(tag: PFITAG): PChar; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetTagID(tag: PFITAG): Word; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetTagType(tag: PFITAG): FREE_IMAGE_MDTYPE; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetTagCount(tag: PFITAG): DWORD; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetTagLength(tag: PFITAG): DWORD; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetTagValue(tag: PFITAG): Pointer; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-function FreeImage_SetTagKey(tag: PFITAG; const key: PChar): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_SetTagDescription(tag: PFITAG; const description: PChar): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_SetTagID(tag: PFITAG; id: Word): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_SetTagType(tag: PFITAG; atype: FREE_IMAGE_MDTYPE): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_SetTagCount(tag: PFITAG; count: DWORD): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_SetTagLength(tag: PFITAG; length: DWORD): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_SetTagValue(tag: PFITAG; const value: Pointer): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// iterator
-function FreeImage_FindFirstMetadata(model: FREE_IMAGE_MDMODEL; dib: PFIBITMAP; var tag: PFITAG): PFIMETADATA; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_FindNextMetadata(mdhandle: PFIMETADATA; var tag: PFITAG): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-procedure FreeImage_FindCloseMetadata(mdhandle: PFIMETADATA); {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// metadata setter and getter
-function FreeImage_SetMetadata(model: FREE_IMAGE_MDMODEL; dib: PFIBITMAP; const key: PChar; tag: PFITAG): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetMetadata(model: FREE_IMAGE_MDMODEL; dib: PFIBITMAP; const key: PChar; var tag: PFITAG): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// helpers
-function FreeImage_GetMetadataCount(model: FREE_IMAGE_MDMODEL; dib: PFIBITMAP): cuint; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// tag to C string conversion
-function FreeImage_TagToString(model: FREE_IMAGE_MDMODEL; tag: PFITAG; Make: PChar = nil): PChar; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// --------------------------------------------------------------------------
-// Image manipulation toolkit -----------------------------------------------
-// --------------------------------------------------------------------------
-
-// rotation and flipping
-function FreeImage_RotateClassic(dib: PFIBITMAP; angle: cdouble): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_RotateEx(dib: PFIBITMAP; angle, x_shift, y_shift, x_origin, y_origin: cdouble; use_mask: BOOL): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_FlipHorizontal(dib: PFIBITMAP): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_FlipVertical(dib: PFIBITMAP): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_JPEGTransform(const src_file: PChar; const dst_file: PChar; operation: FREE_IMAGE_JPEG_OPERATION; perfect: BOOL = False): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// upsampling / downsampling
-function FreeImage_Rescale(dib: PFIBITMAP; dst_width, dst_height: cint; filter: FREE_IMAGE_FILTER): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_MakeThumbnail(dib: PFIBITMAP; max_pixel_size: cint; convert:BOOL = TRUE): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// color manipulation routines (point operations)
-function FreeImage_AdjustCurve(dib: PFIBITMAP; LUT: PBYTE; channel: FREE_IMAGE_COLOR_CHANNEL): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_AdjustGamma(dib: PFIBITMAP; gamma: cdouble): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_AdjustBrightness(dib: PFIBITMAP; percentage: cdouble): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_AdjustContrast(dib: PFIBITMAP; percentage: cdouble): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_Invert(dib: PFIBITMAP): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetHistogram(dib: PFIBITMAP; histo: PDWORD; channel: FREE_IMAGE_COLOR_CHANNEL = FICC_BLACK): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// channel processing routines
-function FreeImage_GetChannel(dib: PFIBITMAP; channel: FREE_IMAGE_COLOR_CHANNEL): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_SetChannel(dib, dib8: PFIBITMAP; channel: FREE_IMAGE_COLOR_CHANNEL): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_GetComplexChannel(src: PFIBITMAP; channel: FREE_IMAGE_COLOR_CHANNEL): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_SetComplexChannel(src: PFIBITMAP; channel: FREE_IMAGE_COLOR_CHANNEL): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-// copy / paste / composite routines
-
-function FreeImage_Copy(dib: PFIBITMAP; left, top, right, bottom: cint): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_Paste(dst, src: PFIBITMAP; left, top, alpha: cint): BOOL; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-function FreeImage_Composite(fg: PFIBITMAP; useFileBkg: BOOL = False; appBkColor: PRGBQUAD = nil; bg: PFIBITMAP = nil): PFIBITMAP; {$IFDEF DLL_STDCALL} stdcall; {$ENDIF} {$IFDEF DLL_CDECL} cdecl; {$ENDIF} external FIDLL;
-
-{$MINENUMSIZE 1}
-implementation
-
-end.
diff --git a/src/lib/JEDI-SDL/OpenGL/Pas/geometry.pas b/src/lib/JEDI-SDL/OpenGL/Pas/geometry.pas
deleted file mode 100644
index 166ec811..00000000
--- a/src/lib/JEDI-SDL/OpenGL/Pas/geometry.pas
+++ /dev/null
@@ -1,1994 +0,0 @@
-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/src/lib/JEDI-SDL/OpenGL/Pas/gl.pas b/src/lib/JEDI-SDL/OpenGL/Pas/gl.pas
deleted file mode 100644
index d1231cdd..00000000
--- a/src/lib/JEDI-SDL/OpenGL/Pas/gl.pas
+++ /dev/null
@@ -1,2301 +0,0 @@
-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.1';
-{$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/src/lib/JEDI-SDL/OpenGL/Pas/glext.pas b/src/lib/JEDI-SDL/OpenGL/Pas/glext.pas
deleted file mode 100644
index 871247a9..00000000
--- a/src/lib/JEDI-SDL/OpenGL/Pas/glext.pas
+++ /dev/null
@@ -1,9579 +0,0 @@
-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 := where + Length(extension);
- if (where = start) or ((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/src/lib/JEDI-SDL/OpenGL/Pas/glu.pas b/src/lib/JEDI-SDL/OpenGL/Pas/glu.pas
deleted file mode 100644
index 876270ff..00000000
--- a/src/lib/JEDI-SDL/OpenGL/Pas/glu.pas
+++ /dev/null
@@ -1,582 +0,0 @@
-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.1';
-{$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/src/lib/JEDI-SDL/OpenGL/Pas/glut.pas b/src/lib/JEDI-SDL/OpenGL/Pas/glut.pas
deleted file mode 100644
index 04f69267..00000000
--- a/src/lib/JEDI-SDL/OpenGL/Pas/glut.pas
+++ /dev/null
@@ -1,688 +0,0 @@
-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/src/lib/JEDI-SDL/OpenGL/Pas/glx.pas b/src/lib/JEDI-SDL/OpenGL/Pas/glx.pas
deleted file mode 100644
index 9f36d2b5..00000000
--- a/src/lib/JEDI-SDL/OpenGL/Pas/glx.pas
+++ /dev/null
@@ -1,279 +0,0 @@
-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.1') or
- InitGLXFromLibrary('libMesaGL.so') or
- InitGLXFromLibrary('libMesaGL.so.3');
-end;
-
-
-initialization
- InitGLX;
-finalization
- UnloadModule(libGLX);
-end.
diff --git a/src/lib/JEDI-SDL/SDL/Pas/libxmlparser.pas b/src/lib/JEDI-SDL/SDL/Pas/libxmlparser.pas
deleted file mode 100644
index 63e7b7fb..00000000
--- a/src/lib/JEDI-SDL/SDL/Pas/libxmlparser.pas
+++ /dev/null
@@ -1,2688 +0,0 @@
-(**
-===============================================================================================
-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;&#252;"
- 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/src/lib/JEDI-SDL/SDL/Pas/logger.pas b/src/lib/JEDI-SDL/SDL/Pas/logger.pas
deleted file mode 100644
index ad9b24e6..00000000
--- a/src/lib/JEDI-SDL/SDL/Pas/logger.pas
+++ /dev/null
@@ -1,189 +0,0 @@
-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/src/lib/JEDI-SDL/SDL/Pas/moduleloader.pas b/src/lib/JEDI-SDL/SDL/Pas/moduleloader.pas
deleted file mode 100644
index ea4f220c..00000000
--- a/src/lib/JEDI-SDL/SDL/Pas/moduleloader.pas
+++ /dev/null
@@ -1,320 +0,0 @@
-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 FPC}
- dl,
- Types,
- Baseunix,
- Unix;
-{$else}
- Types,
- Libc;
-{$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/src/lib/JEDI-SDL/SDL/Pas/registryuserpreferences.pas b/src/lib/JEDI-SDL/SDL/Pas/registryuserpreferences.pas
deleted file mode 100644
index 4a5d55f0..00000000
--- a/src/lib/JEDI-SDL/SDL/Pas/registryuserpreferences.pas
+++ /dev/null
@@ -1,229 +0,0 @@
-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/src/lib/JEDI-SDL/SDL/Pas/sdl.pas b/src/lib/JEDI-SDL/SDL/Pas/sdl.pas
deleted file mode 100644
index 0d7e46af..00000000
--- a/src/lib/JEDI-SDL/SDL/Pas/sdl.pas
+++ /dev/null
@@ -1,4332 +0,0 @@
-unit sdl;
-{
- $Id: sdl.pas,v 1.38 2008/01/26 10:09:32 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-2004 Sam Lantinga }
-{ 5635-34 Springhouse Dr. }
-{ Pleasanton, CA 94588 (USA) }
-{ }
-{ All Rights Reserved. }
-{ }
-{ The original files are : SDL.h }
-{ SDL_main.h }
-{ SDL_types.h }
-{ SDL_rwops.h }
-{ SDL_timer.h }
-{ SDL_audio.h }
-{ SDL_cdrom.h }
-{ SDL_joystick.h }
-{ SDL_mouse.h }
-{ SDL_keyboard.h }
-{ SDL_events.h }
-{ SDL_video.h }
-{ SDL_byteorder.h }
-{ SDL_version.h }
-{ SDL_active.h }
-{ SDL_thread.h }
-{ SDL_mutex .h }
-{ SDL_getenv.h }
-{ SDL_loadso.h }
-{ }
-{ The initial developer of this Pascal code was : }
-{ Dominique Louis <Dominique@SavageSoftware.com.au> }
-{ }
-{ Portions created by Dominique Louis are }
-{ Copyright (C) 2000 - 2004 Dominique Louis. }
-{ }
-{ }
-{ Contributor(s) }
-{ -------------- }
-{ Tom Jones <tigertomjones@gmx.de> His Project inspired this conversion }
-{ Matthias Thoma <ma.thoma@gmx.de> }
-{ }
-{ 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 }
-{ ---------------- }
-{ May 08 2001 - DL : Added Keyboard State Array ( See demos for how to }
-{ use ) }
-{ PKeyStateArr = ^TKeyStateArr; }
-{ TKeyStateArr = array[0..65000] of UInt8; }
-{ As most games will need it. }
-{ }
-{ April 02 2001 - DL : Added SDL_getenv.h definitions and tested version }
-{ 1.2.0 compatability. }
-{ }
-{ March 13 2001 - MT : Added Linux compatibility. }
-{ }
-{ March 10 2001 - MT : Added externalsyms for DEFINES }
-{ Changed the license header }
-{ }
-{ March 09 2001 - MT : Added Kylix Ifdefs/Deleted the uses mmsystem }
-{ }
-{ March 01 2001 - DL : Update conversion of version 1.1.8 }
-{ }
-{ July 22 2001 - DL : Added TUInt8Array and PUIntArray after suggestions }
-{ from Matthias Thoma and Eric Grange. }
-{ }
-{ October 12 2001 - DL : Various changes as suggested by Matthias Thoma and }
-{ David Acklam }
-{ }
-{ October 24 2001 - DL : Added FreePascal support as per suggestions from }
-{ Dean Ellis. }
-{ }
-{ October 27 2001 - DL : Added SDL_BUTTON macro }
-{ }
-{ November 08 2001 - DL : Bug fix as pointed out by Puthoon. }
-{ }
-{ November 29 2001 - DL : Bug fix of SDL_SetGammaRamp as pointed out by Simon}
-{ Rushton. }
-{ }
-{ November 30 2001 - DL : SDL_NOFRAME added as pointed out by Simon Rushton. }
-{ }
-{ December 11 2001 - DL : Added $WEAKPACKAGEUNIT ON to facilitate useage in }
-{ Components }
-{ }
-{ January 05 2002 - DL : Added SDL_Swap32 function as suggested by Matthias }
-{ Thoma and also made sure the _getenv from }
-{ MSVCRT.DLL uses the right calling convention }
-{ }
-{ January 25 2002 - DL : Updated conversion of SDL_AddTimer & }
-{ SDL_RemoveTimer as per suggestions from Matthias }
-{ Thoma. }
-{ }
-{ January 27 2002 - DL : Commented out exported function putenv and getenv }
-{ So that developers get used to using SDL_putenv }
-{ SDL_getenv, as they are more portable }
-{ }
-{ March 05 2002 - DL : Added FreeAnNil procedure for Delphi 4 users. }
-{ }
-{ October 23 2002 - DL : Added Delphi 3 Define of Win32. }
-{ If you intend to you Delphi 3... }
-{ ( which is officially unsupported ) make sure you }
-{ remove references to $EXTERNALSYM in this and other}
-{ SDL files. }
-{ }
-{ November 29 2002 - DL : Fixed bug in Declaration of SDL_GetRGBA that was }
-{ pointed out by Todd Lang }
-{ }
-{ 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.pas,v $
- Revision 1.38 2008/01/26 10:09:32 savage
- Added SDL_BUTTON_X1 and SDL_BUTTON_X2 constants for extended mouse buttons. Now makes SDL v1.2.13 compliant.
-
- Revision 1.37 2007/12/20 22:36:56 savage
- Added SKYOS support, thanks to Sebastian-Torsten Tillmann
-
- Revision 1.36 2007/12/05 22:52:04 savage
- Better Mac OS X support for Frameworks.
-
- Revision 1.35 2007/12/02 22:41:13 savage
- Change for Mac OS X to link to SDL Framework
-
- Revision 1.34 2007/08/26 23:50:53 savage
- Jonas supplied another fix.
-
- Revision 1.33 2007/08/26 15:59:46 savage
- Mac OS changes as suggested by Jonas Maebe
-
- Revision 1.32 2007/08/22 21:18:43 savage
- Thanks to Dean for his MouseDelta patch.
-
- Revision 1.31 2007/05/29 21:30:48 savage
- Changes as suggested by Almindor for 64bit compatibility.
-
- Revision 1.30 2007/05/29 19:31:03 savage
- Fix to TSDL_Overlay structure - thanks David Pethes (aka imcold)
-
- Revision 1.29 2007/05/20 20:29:11 savage
- Initial Changes to Handle 64 Bits
-
- Revision 1.26 2007/02/11 13:38:04 savage
- Added Nintendo DS support - Thanks Dean.
-
- Revision 1.25 2006/12/02 00:12:52 savage
- Updated to latest version
-
- Revision 1.24 2006/05/18 21:10:04 savage
- Added 1.2.10 Changes
-
- Revision 1.23 2005/12/04 23:17:52 drellis
- Added declaration of SInt8 and PSInt8
-
- Revision 1.22 2005/05/24 21:59:03 savage
- Re-arranged uses clause to work on Win32 and Linux, Thanks again Michalis.
-
- Revision 1.21 2005/05/22 18:42:31 savage
- Changes as suggested by Michalis Kamburelis. Thanks again.
-
- Revision 1.20 2005/04/10 11:48:33 savage
- Changes as suggested by Michalis, thanks.
-
- Revision 1.19 2005/01/05 01:47:06 savage
- Changed LibName to reflect what MacOS X should have. ie libSDL*-1.2.0.dylib respectively.
-
- Revision 1.18 2005/01/04 23:14:41 savage
- Changed LibName to reflect what most Linux distros will have. ie libSDL*-1.2.so.0 respectively.
-
- Revision 1.17 2005/01/03 18:40:59 savage
- Updated Version number to reflect latest one
-
- Revision 1.16 2005/01/01 02:02:06 savage
- Updated to v1.2.8
-
- Revision 1.15 2004/12/24 18:57:11 savage
- forgot to apply Michalis Kamburelis' patch to the implementation section. now fixed
-
- Revision 1.14 2004/12/23 23:42:18 savage
- Applied Patches supplied by Michalis Kamburelis ( THANKS! ), for greater FreePascal compatability.
-
- Revision 1.13 2004/09/30 22:31:59 savage
- Updated with slightly different header comments
-
- Revision 1.12 2004/09/12 21:52:58 savage
- Slight changes to fix some issues with the sdl classes.
-
- Revision 1.11 2004/08/14 22:54:30 savage
- Updated so that Library name defines are correctly defined for MacOS X.
-
- Revision 1.10 2004/07/20 23:57:33 savage
- Thanks to Paul Toth for spotting an error in the SDL Audio Convertion structures.
- In TSDL_AudioCVT the filters variable should point to and array of pointers and not what I had there previously.
-
- Revision 1.9 2004/07/03 22:07:22 savage
- Added Bitwise Manipulation Functions for TSDL_VideoInfo struct.
-
- Revision 1.8 2004/05/10 14:10:03 savage
- Initial MacOS X support. Fixed defines for MACOS ( Classic ) and DARWIN ( MacOS X ).
-
- Revision 1.7 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.6 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.5 2004/02/22 15:32:10 savage
- SDL_GetEnv Fix so it also works on FPC/Linux. Thanks to Rodrigo for pointing this out.
-
- Revision 1.4 2004/02/21 23:24:29 savage
- SDL_GetEnv Fix so that it is not define twice for FPC. Thanks to Rene Hugentobler for pointing out this bug,
-
- Revision 1.3 2004/02/18 22:35:51 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.
-
- Revision 1.2 2004/02/17 21:37:12 savage
- Tidying up of units
-
- Revision 1.1 2004/02/05 00:08:20 savage
- Module 1.0 release
-
-}
-{******************************************************************************}
-
-{$I jedi-sdl.inc}
-
-interface
-
-uses
-{$IFDEF __GPC__}
- system,
- {$IFDEF WINDOWS}
- wintypes,
- {$ELSE}
- {$ENDIF}
- gpc;
-{$ENDIF}
-
-{$IFDEF HAS_TYPES}
- Types{$IFNDEF NDS},{$ELSE};{$ENDIF}
-{$ENDIF}
-
-{$IFDEF WINDOWS}
- Windows;
-{$ENDIF}
-
-{$IFDEF UNIX}
- {$IFDEF FPC}
- {$IFNDEF SKYOS}
- pthreads,
- {$ENDIF}
- baseunix,
- {$IFNDEF GP2X}
- {$IFNDEF DARWIN}
- {$IFNDEF SKYOS}
- unix,
- {$ELSE}
- unix;
- {$ENDIF}
- {$ELSE}
- unix;
- {$ENDIF}
- {$ELSE}
- unix;
- {$ENDIF}
- {$IFNDEF GP2X}
- {$IFNDEF DARWIN}
- {$IFNDEF SKYOS}
- x,
- xlib;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ELSE}
- Libc,
- Xlib;
- {$ENDIF}
-{$ENDIF}
-
-{$IFDEF __MACH__}
- GPCMacOSAll;
-{$ENDIF}
-
-{$ifndef FPC}
-type
- PtrInt = LongInt;
- PtrUInt = LongWord;
-{$endif}
-
-const
-{$IFDEF WINDOWS}
- SDLLibName = 'SDL.dll';
-{$ENDIF}
-
-{$IFDEF UNIX}
-{$IFDEF DARWIN}
- SDLLibName = 'libSDL-1.2.0.dylib';
- {$linklib libSDL-1.2.0}
- {$linklib gcc}
- {$linklib SDLmain}
- {$linkframework Cocoa}
- {$PASCALMAINNAME SDL_main}
-{$ELSE}
- {$IFDEF FPC}
- SDLLibName = 'libSDL.so';
- {$ELSE}
- SDLLibName = 'libSDL-1.2.so.0';
- {$ENDIF}
-{$ENDIF}
-{$ENDIF}
-
-{$IFDEF MACOS}
- SDLLibName = 'SDL';
- {$linklib libSDL}
-{$ENDIF}
-
-{$IFDEF NDS}
- SDLLibName = 'libSDL.a';
- {$linklib libSDL.a}
- {$linklib libnds9.a}
- {$linklib libc.a}
- {$linklib libgcc.a}
- {$linklib libsysbase.a}
-{$ENDIF}
-
- // SDL_verion.h constants
- // Printable format: "%d.%d.%d", MAJOR, MINOR, PATCHLEVEL
- SDL_MAJOR_VERSION = 1;
-{$EXTERNALSYM SDL_MAJOR_VERSION}
- SDL_MINOR_VERSION = 2;
-{$EXTERNALSYM SDL_MINOR_VERSION}
- SDL_PATCHLEVEL = 13;
-{$EXTERNALSYM SDL_PATCHLEVEL}
-
- // SDL.h constants
- SDL_INIT_TIMER = $00000001;
-{$EXTERNALSYM SDL_INIT_TIMER}
- SDL_INIT_AUDIO = $00000010;
-{$EXTERNALSYM SDL_INIT_AUDIO}
- SDL_INIT_VIDEO = $00000020;
-{$EXTERNALSYM SDL_INIT_VIDEO}
- SDL_INIT_CDROM = $00000100;
-{$EXTERNALSYM SDL_INIT_CDROM}
- SDL_INIT_JOYSTICK = $00000200;
-{$EXTERNALSYM SDL_INIT_JOYSTICK}
- SDL_INIT_NOPARACHUTE = $00100000; // Don't catch fatal signals
-{$EXTERNALSYM SDL_INIT_NOPARACHUTE}
- SDL_INIT_EVENTTHREAD = $01000000; // Not supported on all OS's
-{$EXTERNALSYM SDL_INIT_EVENTTHREAD}
- SDL_INIT_EVERYTHING = $0000FFFF;
-{$EXTERNALSYM SDL_INIT_EVERYTHING}
-
- // SDL_error.h constants
- ERR_MAX_STRLEN = 128;
-{$EXTERNALSYM ERR_MAX_STRLEN}
- ERR_MAX_ARGS = 5;
-{$EXTERNALSYM ERR_MAX_ARGS}
-
- // SDL_types.h constants
- SDL_PRESSED = $01;
-{$EXTERNALSYM SDL_PRESSED}
- SDL_RELEASED = $00;
-{$EXTERNALSYM SDL_RELEASED}
-
- // SDL_timer.h constants
- // This is the OS scheduler timeslice, in milliseconds
- SDL_TIMESLICE = 10;
-{$EXTERNALSYM SDL_TIMESLICE}
- // This is the maximum resolution of the SDL timer on all platforms
- TIMER_RESOLUTION = 10; // Experimentally determined
-{$EXTERNALSYM TIMER_RESOLUTION}
-
- // SDL_audio.h constants
- AUDIO_U8 = $0008; // Unsigned 8-bit samples
-{$EXTERNALSYM AUDIO_U8}
- AUDIO_S8 = $8008; // Signed 8-bit samples
-{$EXTERNALSYM AUDIO_S8}
- AUDIO_U16LSB = $0010; // Unsigned 16-bit samples
-{$EXTERNALSYM AUDIO_U16LSB}
- AUDIO_S16LSB = $8010; // Signed 16-bit samples
-{$EXTERNALSYM AUDIO_S16LSB}
- AUDIO_U16MSB = $1010; // As above, but big-endian byte order
-{$EXTERNALSYM AUDIO_U16MSB}
- AUDIO_S16MSB = $9010; // As above, but big-endian byte order
-{$EXTERNALSYM AUDIO_S16MSB}
- AUDIO_U16 = AUDIO_U16LSB;
-{$EXTERNALSYM AUDIO_U16}
- AUDIO_S16 = AUDIO_S16LSB;
-{$EXTERNALSYM AUDIO_S16}
-
-
- // SDL_cdrom.h constants
- // The maximum number of CD-ROM tracks on a disk
- SDL_MAX_TRACKS = 99;
-{$EXTERNALSYM SDL_MAX_TRACKS}
- // The types of CD-ROM track possible
- SDL_AUDIO_TRACK = $00;
-{$EXTERNALSYM SDL_AUDIO_TRACK}
- SDL_DATA_TRACK = $04;
-{$EXTERNALSYM SDL_DATA_TRACK}
-
- // Conversion functions from frames to Minute/Second/Frames and vice versa
- CD_FPS = 75;
-{$EXTERNALSYM CD_FPS}
- // SDL_byteorder.h constants
- // The two types of endianness
- SDL_LIL_ENDIAN = 1234;
-{$EXTERNALSYM SDL_LIL_ENDIAN}
- SDL_BIG_ENDIAN = 4321;
-{$EXTERNALSYM SDL_BIG_ENDIAN}
-
-{$IFDEF IA32}
-
- SDL_BYTEORDER = SDL_LIL_ENDIAN;
-{$EXTERNALSYM SDL_BYTEORDER}
- // Native audio byte ordering
- AUDIO_U16SYS = AUDIO_U16LSB;
-{$EXTERNALSYM AUDIO_U16SYS}
- AUDIO_S16SYS = AUDIO_S16LSB;
-{$EXTERNALSYM AUDIO_S16SYS}
-
-{$ELSE}
-
- SDL_BYTEORDER = SDL_BIG_ENDIAN;
-{$EXTERNALSYM SDL_BYTEORDER}
- // Native audio byte ordering
- AUDIO_U16SYS = AUDIO_U16MSB;
-{$EXTERNALSYM AUDIO_U16SYS}
- AUDIO_S16SYS = AUDIO_S16MSB;
-{$EXTERNALSYM AUDIO_S16SYS}
-
-{$ENDIF}
-
-
- SDL_MIX_MAXVOLUME = 128;
-{$EXTERNALSYM SDL_MIX_MAXVOLUME}
-
- // SDL_joystick.h constants
- MAX_JOYSTICKS = 2; // only 2 are supported in the multimedia API
-{$EXTERNALSYM MAX_JOYSTICKS}
- MAX_AXES = 6; // each joystick can have up to 6 axes
-{$EXTERNALSYM MAX_AXES}
- MAX_BUTTONS = 32; // and 32 buttons
-{$EXTERNALSYM MAX_BUTTONS}
- AXIS_MIN = -32768; // minimum value for axis coordinate
-{$EXTERNALSYM AXIS_MIN}
- AXIS_MAX = 32767; // maximum value for axis coordinate
-{$EXTERNALSYM AXIS_MAX}
- JOY_AXIS_THRESHOLD = (((AXIS_MAX) - (AXIS_MIN)) / 100); // 1% motion
-{$EXTERNALSYM JOY_AXIS_THRESHOLD}
- //JOY_BUTTON_FLAG(n) (1<<n)
- // array to hold joystick ID values
- //static UInt SYS_JoystickID[MAX_JOYSTICKS];
- //static JOYCAPS SYS_Joystick[MAX_JOYSTICKS];
-
- { Get the current state of a POV hat on a joystick
- The return value is one of the following positions: }
- SDL_HAT_CENTERED = $00;
-{$EXTERNALSYM SDL_HAT_CENTERED}
- SDL_HAT_UP = $01;
-{$EXTERNALSYM SDL_HAT_UP}
- SDL_HAT_RIGHT = $02;
-{$EXTERNALSYM SDL_HAT_RIGHT}
- SDL_HAT_DOWN = $04;
-{$EXTERNALSYM SDL_HAT_DOWN}
- SDL_HAT_LEFT = $08;
-{$EXTERNALSYM SDL_HAT_LEFT}
- SDL_HAT_RIGHTUP = SDL_HAT_RIGHT or SDL_HAT_UP;
-{$EXTERNALSYM SDL_HAT_RIGHTUP}
- SDL_HAT_RIGHTDOWN = SDL_HAT_RIGHT or SDL_HAT_DOWN;
-{$EXTERNALSYM SDL_HAT_RIGHTDOWN}
- SDL_HAT_LEFTUP = SDL_HAT_LEFT or SDL_HAT_UP;
-{$EXTERNALSYM SDL_HAT_LEFTUP}
- SDL_HAT_LEFTDOWN = SDL_HAT_LEFT or SDL_HAT_DOWN;
-{$EXTERNALSYM SDL_HAT_LEFTDOWN}
-
- // SDL_events.h constants
- SDL_NOEVENT = 0; // Unused (do not remove)
-{$EXTERNALSYM SDL_NOEVENT}
- SDL_ACTIVEEVENT = 1; // Application loses/gains visibility
-{$EXTERNALSYM SDL_ACTIVEEVENT}
- SDL_KEYDOWN = 2; // Keys pressed
-{$EXTERNALSYM SDL_KEYDOWN}
- SDL_KEYUP = 3; // Keys released
-{$EXTERNALSYM SDL_KEYUP}
- SDL_MOUSEMOTION = 4; // Mouse moved
-{$EXTERNALSYM SDL_MOUSEMOTION}
- SDL_MOUSEBUTTONDOWN = 5; // Mouse button pressed
-{$EXTERNALSYM SDL_MOUSEBUTTONDOWN}
- SDL_MOUSEBUTTONUP = 6; // Mouse button released
-{$EXTERNALSYM SDL_MOUSEBUTTONUP}
- SDL_JOYAXISMOTION = 7; // Joystick axis motion
-{$EXTERNALSYM SDL_JOYAXISMOTION}
- SDL_JOYBALLMOTION = 8; // Joystick trackball motion
-{$EXTERNALSYM SDL_JOYBALLMOTION}
- SDL_JOYHATMOTION = 9; // Joystick hat position change
-{$EXTERNALSYM SDL_JOYHATMOTION}
- SDL_JOYBUTTONDOWN = 10; // Joystick button pressed
-{$EXTERNALSYM SDL_JOYBUTTONDOWN}
- SDL_JOYBUTTONUP = 11; // Joystick button released
-{$EXTERNALSYM SDL_JOYBUTTONUP}
- SDL_QUITEV = 12; // User-requested quit ( Changed due to procedure conflict )
-{$EXTERNALSYM SDL_QUIT}
- SDL_SYSWMEVENT = 13; // System specific event
-{$EXTERNALSYM SDL_SYSWMEVENT}
- SDL_EVENT_RESERVEDA = 14; // Reserved for future use..
-{$EXTERNALSYM SDL_EVENT_RESERVEDA}
- SDL_EVENT_RESERVED = 15; // Reserved for future use..
-{$EXTERNALSYM SDL_EVENT_RESERVED}
- SDL_VIDEORESIZE = 16; // User resized video mode
-{$EXTERNALSYM SDL_VIDEORESIZE}
- SDL_VIDEOEXPOSE = 17; // Screen needs to be redrawn
-{$EXTERNALSYM SDL_VIDEOEXPOSE}
- SDL_EVENT_RESERVED2 = 18; // Reserved for future use..
-{$EXTERNALSYM SDL_EVENT_RESERVED2}
- SDL_EVENT_RESERVED3 = 19; // Reserved for future use..
-{$EXTERNALSYM SDL_EVENT_RESERVED3}
- SDL_EVENT_RESERVED4 = 20; // Reserved for future use..
-{$EXTERNALSYM SDL_EVENT_RESERVED4}
- SDL_EVENT_RESERVED5 = 21; // Reserved for future use..
-{$EXTERNALSYM SDL_EVENT_RESERVED5}
- SDL_EVENT_RESERVED6 = 22; // Reserved for future use..
-{$EXTERNALSYM SDL_EVENT_RESERVED6}
- SDL_EVENT_RESERVED7 = 23; // Reserved for future use..
-{$EXTERNALSYM SDL_EVENT_RESERVED7}
- // Events SDL_USEREVENT through SDL_MAXEVENTS-1 are for your use
- SDL_USEREVENT = 24;
-{$EXTERNALSYM SDL_USEREVENT}
- // This last event is only for bounding internal arrays
- // It is the number of bits in the event mask datatype -- UInt32
- SDL_NUMEVENTS = 32;
-{$EXTERNALSYM SDL_NUMEVENTS}
-
- SDL_ALLEVENTS = $FFFFFFFF;
-{$EXTERNALSYM SDL_ALLEVENTS}
-
- SDL_ACTIVEEVENTMASK = 1 shl SDL_ACTIVEEVENT;
-{$EXTERNALSYM SDL_ACTIVEEVENTMASK}
- SDL_KEYDOWNMASK = 1 shl SDL_KEYDOWN;
-{$EXTERNALSYM SDL_KEYDOWNMASK}
- SDL_KEYUPMASK = 1 shl SDL_KEYUP;
-{$EXTERNALSYM SDL_KEYUPMASK}
- SDL_MOUSEMOTIONMASK = 1 shl SDL_MOUSEMOTION;
-{$EXTERNALSYM SDL_MOUSEMOTIONMASK}
- SDL_MOUSEBUTTONDOWNMASK = 1 shl SDL_MOUSEBUTTONDOWN;
-{$EXTERNALSYM SDL_MOUSEBUTTONDOWNMASK}
- SDL_MOUSEBUTTONUPMASK = 1 shl SDL_MOUSEBUTTONUP;
-{$EXTERNALSYM SDL_MOUSEBUTTONUPMASK}
- SDL_MOUSEEVENTMASK = 1 shl SDL_MOUSEMOTION or
- 1 shl SDL_MOUSEBUTTONDOWN or
- 1 shl SDL_MOUSEBUTTONUP;
-{$EXTERNALSYM SDL_MOUSEEVENTMASK}
- SDL_JOYAXISMOTIONMASK = 1 shl SDL_JOYAXISMOTION;
-{$EXTERNALSYM SDL_JOYAXISMOTIONMASK}
- SDL_JOYBALLMOTIONMASK = 1 shl SDL_JOYBALLMOTION;
-{$EXTERNALSYM SDL_JOYBALLMOTIONMASK}
- SDL_JOYHATMOTIONMASK = 1 shl SDL_JOYHATMOTION;
-{$EXTERNALSYM SDL_JOYHATMOTIONMASK}
- SDL_JOYBUTTONDOWNMASK = 1 shl SDL_JOYBUTTONDOWN;
-{$EXTERNALSYM SDL_JOYBUTTONDOWNMASK}
- SDL_JOYBUTTONUPMASK = 1 shl SDL_JOYBUTTONUP;
-{$EXTERNALSYM SDL_JOYBUTTONUPMASK}
- SDL_JOYEVENTMASK = 1 shl SDL_JOYAXISMOTION or
- 1 shl SDL_JOYBALLMOTION or
- 1 shl SDL_JOYHATMOTION or
- 1 shl SDL_JOYBUTTONDOWN or
- 1 shl SDL_JOYBUTTONUP;
-{$EXTERNALSYM SDL_JOYEVENTMASK}
- SDL_VIDEORESIZEMASK = 1 shl SDL_VIDEORESIZE;
-{$EXTERNALSYM SDL_VIDEORESIZEMASK}
- SDL_QUITMASK = 1 shl SDL_QUITEV;
-{$EXTERNALSYM SDL_QUITMASK}
- SDL_SYSWMEVENTMASK = 1 shl SDL_SYSWMEVENT;
-{$EXTERNALSYM SDL_SYSWMEVENTMASK}
-
- { This function allows you to set the state of processing certain events.
- If 'state' is set to SDL_IGNORE, that event will be automatically dropped
- from the event queue and will not event be filtered.
- If 'state' is set to SDL_ENABLE, that event will be processed normally.
- If 'state' is set to SDL_QUERY, SDL_EventState() will return the
- current processing state of the specified event. }
-
- SDL_QUERY = -1;
-{$EXTERNALSYM SDL_QUERY}
- SDL_IGNORE = 0;
-{$EXTERNALSYM SDL_IGNORE}
- SDL_DISABLE = 0;
-{$EXTERNALSYM SDL_DISABLE}
- SDL_ENABLE = 1;
-{$EXTERNALSYM SDL_ENABLE}
-
- //SDL_keyboard.h constants
- // This is the mask which refers to all hotkey bindings
- SDL_ALL_HOTKEYS = $FFFFFFFF;
-{$EXTERNALSYM SDL_ALL_HOTKEYS}
-
-{ Enable/Disable keyboard repeat. Keyboard repeat defaults to off.
- 'delay' is the initial delay in ms between the time when a key is
- pressed, and keyboard repeat begins.
- 'interval' is the time in ms between keyboard repeat events. }
-
- SDL_DEFAULT_REPEAT_DELAY = 500;
-{$EXTERNALSYM SDL_DEFAULT_REPEAT_DELAY}
- SDL_DEFAULT_REPEAT_INTERVAL = 30;
-{$EXTERNALSYM SDL_DEFAULT_REPEAT_INTERVAL}
-
- // The keyboard syms have been cleverly chosen to map to ASCII
- SDLK_UNKNOWN = 0;
-{$EXTERNALSYM SDLK_UNKNOWN}
- SDLK_FIRST = 0;
-{$EXTERNALSYM SDLK_FIRST}
- SDLK_BACKSPACE = 8;
-{$EXTERNALSYM SDLK_BACKSPACE}
- SDLK_TAB = 9;
-{$EXTERNALSYM SDLK_TAB}
- SDLK_CLEAR = 12;
-{$EXTERNALSYM SDLK_CLEAR}
- SDLK_RETURN = 13;
-{$EXTERNALSYM SDLK_RETURN}
- SDLK_PAUSE = 19;
-{$EXTERNALSYM SDLK_PAUSE}
- SDLK_ESCAPE = 27;
-{$EXTERNALSYM SDLK_ESCAPE}
- SDLK_SPACE = 32;
-{$EXTERNALSYM SDLK_SPACE}
- SDLK_EXCLAIM = 33;
-{$EXTERNALSYM SDLK_EXCLAIM}
- SDLK_QUOTEDBL = 34;
-{$EXTERNALSYM SDLK_QUOTEDBL}
- SDLK_HASH = 35;
-{$EXTERNALSYM SDLK_HASH}
- SDLK_DOLLAR = 36;
-{$EXTERNALSYM SDLK_DOLLAR}
- SDLK_AMPERSAND = 38;
-{$EXTERNALSYM SDLK_AMPERSAND}
- SDLK_QUOTE = 39;
-{$EXTERNALSYM SDLK_QUOTE}
- SDLK_LEFTPAREN = 40;
-{$EXTERNALSYM SDLK_LEFTPAREN}
- SDLK_RIGHTPAREN = 41;
-{$EXTERNALSYM SDLK_RIGHTPAREN}
- SDLK_ASTERISK = 42;
-{$EXTERNALSYM SDLK_ASTERISK}
- SDLK_PLUS = 43;
-{$EXTERNALSYM SDLK_PLUS}
- SDLK_COMMA = 44;
-{$EXTERNALSYM SDLK_COMMA}
- SDLK_MINUS = 45;
-{$EXTERNALSYM SDLK_MINUS}
- SDLK_PERIOD = 46;
-{$EXTERNALSYM SDLK_PERIOD}
- SDLK_SLASH = 47;
-{$EXTERNALSYM SDLK_SLASH}
- SDLK_0 = 48;
-{$EXTERNALSYM SDLK_0}
- SDLK_1 = 49;
-{$EXTERNALSYM SDLK_1}
- SDLK_2 = 50;
-{$EXTERNALSYM SDLK_2}
- SDLK_3 = 51;
-{$EXTERNALSYM SDLK_3}
- SDLK_4 = 52;
-{$EXTERNALSYM SDLK_4}
- SDLK_5 = 53;
-{$EXTERNALSYM SDLK_5}
- SDLK_6 = 54;
-{$EXTERNALSYM SDLK_6}
- SDLK_7 = 55;
-{$EXTERNALSYM SDLK_7}
- SDLK_8 = 56;
-{$EXTERNALSYM SDLK_8}
- SDLK_9 = 57;
-{$EXTERNALSYM SDLK_9}
- SDLK_COLON = 58;
-{$EXTERNALSYM SDLK_COLON}
- SDLK_SEMICOLON = 59;
-{$EXTERNALSYM SDLK_SEMICOLON}
- SDLK_LESS = 60;
-{$EXTERNALSYM SDLK_LESS}
- SDLK_EQUALS = 61;
-{$EXTERNALSYM SDLK_EQUALS}
- SDLK_GREATER = 62;
-{$EXTERNALSYM SDLK_GREATER}
- SDLK_QUESTION = 63;
-{$EXTERNALSYM SDLK_QUESTION}
- SDLK_AT = 64;
-{$EXTERNALSYM SDLK_AT}
-
- { Skip uppercase letters }
-
- SDLK_LEFTBRACKET = 91;
-{$EXTERNALSYM SDLK_LEFTBRACKET}
- SDLK_BACKSLASH = 92;
-{$EXTERNALSYM SDLK_BACKSLASH}
- SDLK_RIGHTBRACKET = 93;
-{$EXTERNALSYM SDLK_RIGHTBRACKET}
- SDLK_CARET = 94;
-{$EXTERNALSYM SDLK_CARET}
- SDLK_UNDERSCORE = 95;
-{$EXTERNALSYM SDLK_UNDERSCORE}
- SDLK_BACKQUOTE = 96;
-{$EXTERNALSYM SDLK_BACKQUOTE}
- SDLK_a = 97;
-{$EXTERNALSYM SDLK_a}
- SDLK_b = 98;
-{$EXTERNALSYM SDLK_b}
- SDLK_c = 99;
-{$EXTERNALSYM SDLK_c}
- SDLK_d = 100;
-{$EXTERNALSYM SDLK_d}
- SDLK_e = 101;
-{$EXTERNALSYM SDLK_e}
- SDLK_f = 102;
-{$EXTERNALSYM SDLK_f}
- SDLK_g = 103;
-{$EXTERNALSYM SDLK_g}
- SDLK_h = 104;
-{$EXTERNALSYM SDLK_h}
- SDLK_i = 105;
-{$EXTERNALSYM SDLK_i}
- SDLK_j = 106;
-{$EXTERNALSYM SDLK_j}
- SDLK_k = 107;
-{$EXTERNALSYM SDLK_k}
- SDLK_l = 108;
-{$EXTERNALSYM SDLK_l}
- SDLK_m = 109;
-{$EXTERNALSYM SDLK_m}
- SDLK_n = 110;
-{$EXTERNALSYM SDLK_n}
- SDLK_o = 111;
-{$EXTERNALSYM SDLK_o}
- SDLK_p = 112;
-{$EXTERNALSYM SDLK_p}
- SDLK_q = 113;
-{$EXTERNALSYM SDLK_q}
- SDLK_r = 114;
-{$EXTERNALSYM SDLK_r}
- SDLK_s = 115;
-{$EXTERNALSYM SDLK_s}
- SDLK_t = 116;
-{$EXTERNALSYM SDLK_t}
- SDLK_u = 117;
-{$EXTERNALSYM SDLK_u}
- SDLK_v = 118;
-{$EXTERNALSYM SDLK_v}
- SDLK_w = 119;
-{$EXTERNALSYM SDLK_w}
- SDLK_x = 120;
-{$EXTERNALSYM SDLK_x}
- SDLK_y = 121;
-{$EXTERNALSYM SDLK_y}
- SDLK_z = 122;
-{$EXTERNALSYM SDLK_z}
- SDLK_DELETE = 127;
-{$EXTERNALSYM SDLK_DELETE}
- // End of ASCII mapped keysyms
-
- // International keyboard syms
- SDLK_WORLD_0 = 160; // 0xA0
-{$EXTERNALSYM SDLK_WORLD_0}
- SDLK_WORLD_1 = 161;
-{$EXTERNALSYM SDLK_WORLD_1}
- SDLK_WORLD_2 = 162;
-{$EXTERNALSYM SDLK_WORLD_2}
- SDLK_WORLD_3 = 163;
-{$EXTERNALSYM SDLK_WORLD_3}
- SDLK_WORLD_4 = 164;
-{$EXTERNALSYM SDLK_WORLD_4}
- SDLK_WORLD_5 = 165;
-{$EXTERNALSYM SDLK_WORLD_5}
- SDLK_WORLD_6 = 166;
-{$EXTERNALSYM SDLK_WORLD_6}
- SDLK_WORLD_7 = 167;
-{$EXTERNALSYM SDLK_WORLD_7}
- SDLK_WORLD_8 = 168;
-{$EXTERNALSYM SDLK_WORLD_8}
- SDLK_WORLD_9 = 169;
-{$EXTERNALSYM SDLK_WORLD_9}
- SDLK_WORLD_10 = 170;
-{$EXTERNALSYM SDLK_WORLD_10}
- SDLK_WORLD_11 = 171;
-{$EXTERNALSYM SDLK_WORLD_11}
- SDLK_WORLD_12 = 172;
-{$EXTERNALSYM SDLK_WORLD_12}
- SDLK_WORLD_13 = 173;
-{$EXTERNALSYM SDLK_WORLD_13}
- SDLK_WORLD_14 = 174;
-{$EXTERNALSYM SDLK_WORLD_14}
- SDLK_WORLD_15 = 175;
-{$EXTERNALSYM SDLK_WORLD_15}
- SDLK_WORLD_16 = 176;
-{$EXTERNALSYM SDLK_WORLD_16}
- SDLK_WORLD_17 = 177;
-{$EXTERNALSYM SDLK_WORLD_17}
- SDLK_WORLD_18 = 178;
-{$EXTERNALSYM SDLK_WORLD_18}
- SDLK_WORLD_19 = 179;
-{$EXTERNALSYM SDLK_WORLD_19}
- SDLK_WORLD_20 = 180;
-{$EXTERNALSYM SDLK_WORLD_20}
- SDLK_WORLD_21 = 181;
-{$EXTERNALSYM SDLK_WORLD_21}
- SDLK_WORLD_22 = 182;
-{$EXTERNALSYM SDLK_WORLD_22}
- SDLK_WORLD_23 = 183;
-{$EXTERNALSYM SDLK_WORLD_23}
- SDLK_WORLD_24 = 184;
-{$EXTERNALSYM SDLK_WORLD_24}
- SDLK_WORLD_25 = 185;
-{$EXTERNALSYM SDLK_WORLD_25}
- SDLK_WORLD_26 = 186;
-{$EXTERNALSYM SDLK_WORLD_26}
- SDLK_WORLD_27 = 187;
-{$EXTERNALSYM SDLK_WORLD_27}
- SDLK_WORLD_28 = 188;
-{$EXTERNALSYM SDLK_WORLD_28}
- SDLK_WORLD_29 = 189;
-{$EXTERNALSYM SDLK_WORLD_29}
- SDLK_WORLD_30 = 190;
-{$EXTERNALSYM SDLK_WORLD_30}
- SDLK_WORLD_31 = 191;
-{$EXTERNALSYM SDLK_WORLD_31}
- SDLK_WORLD_32 = 192;
-{$EXTERNALSYM SDLK_WORLD_32}
- SDLK_WORLD_33 = 193;
-{$EXTERNALSYM SDLK_WORLD_33}
- SDLK_WORLD_34 = 194;
-{$EXTERNALSYM SDLK_WORLD_34}
- SDLK_WORLD_35 = 195;
-{$EXTERNALSYM SDLK_WORLD_35}
- SDLK_WORLD_36 = 196;
-{$EXTERNALSYM SDLK_WORLD_36}
- SDLK_WORLD_37 = 197;
-{$EXTERNALSYM SDLK_WORLD_37}
- SDLK_WORLD_38 = 198;
-{$EXTERNALSYM SDLK_WORLD_38}
- SDLK_WORLD_39 = 199;
-{$EXTERNALSYM SDLK_WORLD_39}
- SDLK_WORLD_40 = 200;
-{$EXTERNALSYM SDLK_WORLD_40}
- SDLK_WORLD_41 = 201;
-{$EXTERNALSYM SDLK_WORLD_41}
- SDLK_WORLD_42 = 202;
-{$EXTERNALSYM SDLK_WORLD_42}
- SDLK_WORLD_43 = 203;
-{$EXTERNALSYM SDLK_WORLD_43}
- SDLK_WORLD_44 = 204;
-{$EXTERNALSYM SDLK_WORLD_44}
- SDLK_WORLD_45 = 205;
-{$EXTERNALSYM SDLK_WORLD_45}
- SDLK_WORLD_46 = 206;
-{$EXTERNALSYM SDLK_WORLD_46}
- SDLK_WORLD_47 = 207;
-{$EXTERNALSYM SDLK_WORLD_47}
- SDLK_WORLD_48 = 208;
-{$EXTERNALSYM SDLK_WORLD_48}
- SDLK_WORLD_49 = 209;
-{$EXTERNALSYM SDLK_WORLD_49}
- SDLK_WORLD_50 = 210;
-{$EXTERNALSYM SDLK_WORLD_50}
- SDLK_WORLD_51 = 211;
-{$EXTERNALSYM SDLK_WORLD_51}
- SDLK_WORLD_52 = 212;
-{$EXTERNALSYM SDLK_WORLD_52}
- SDLK_WORLD_53 = 213;
-{$EXTERNALSYM SDLK_WORLD_53}
- SDLK_WORLD_54 = 214;
-{$EXTERNALSYM SDLK_WORLD_54}
- SDLK_WORLD_55 = 215;
-{$EXTERNALSYM SDLK_WORLD_55}
- SDLK_WORLD_56 = 216;
-{$EXTERNALSYM SDLK_WORLD_56}
- SDLK_WORLD_57 = 217;
-{$EXTERNALSYM SDLK_WORLD_57}
- SDLK_WORLD_58 = 218;
-{$EXTERNALSYM SDLK_WORLD_58}
- SDLK_WORLD_59 = 219;
-{$EXTERNALSYM SDLK_WORLD_59}
- SDLK_WORLD_60 = 220;
-{$EXTERNALSYM SDLK_WORLD_60}
- SDLK_WORLD_61 = 221;
-{$EXTERNALSYM SDLK_WORLD_61}
- SDLK_WORLD_62 = 222;
-{$EXTERNALSYM SDLK_WORLD_62}
- SDLK_WORLD_63 = 223;
-{$EXTERNALSYM SDLK_WORLD_63}
- SDLK_WORLD_64 = 224;
-{$EXTERNALSYM SDLK_WORLD_64}
- SDLK_WORLD_65 = 225;
-{$EXTERNALSYM SDLK_WORLD_65}
- SDLK_WORLD_66 = 226;
-{$EXTERNALSYM SDLK_WORLD_66}
- SDLK_WORLD_67 = 227;
-{$EXTERNALSYM SDLK_WORLD_67}
- SDLK_WORLD_68 = 228;
-{$EXTERNALSYM SDLK_WORLD_68}
- SDLK_WORLD_69 = 229;
-{$EXTERNALSYM SDLK_WORLD_69}
- SDLK_WORLD_70 = 230;
-{$EXTERNALSYM SDLK_WORLD_70}
- SDLK_WORLD_71 = 231;
-{$EXTERNALSYM SDLK_WORLD_71}
- SDLK_WORLD_72 = 232;
-{$EXTERNALSYM SDLK_WORLD_72}
- SDLK_WORLD_73 = 233;
-{$EXTERNALSYM SDLK_WORLD_73}
- SDLK_WORLD_74 = 234;
-{$EXTERNALSYM SDLK_WORLD_74}
- SDLK_WORLD_75 = 235;
-{$EXTERNALSYM SDLK_WORLD_75}
- SDLK_WORLD_76 = 236;
-{$EXTERNALSYM SDLK_WORLD_76}
- SDLK_WORLD_77 = 237;
-{$EXTERNALSYM SDLK_WORLD_77}
- SDLK_WORLD_78 = 238;
-{$EXTERNALSYM SDLK_WORLD_78}
- SDLK_WORLD_79 = 239;
-{$EXTERNALSYM SDLK_WORLD_79}
- SDLK_WORLD_80 = 240;
-{$EXTERNALSYM SDLK_WORLD_80}
- SDLK_WORLD_81 = 241;
-{$EXTERNALSYM SDLK_WORLD_81}
- SDLK_WORLD_82 = 242;
-{$EXTERNALSYM SDLK_WORLD_82}
- SDLK_WORLD_83 = 243;
-{$EXTERNALSYM SDLK_WORLD_83}
- SDLK_WORLD_84 = 244;
-{$EXTERNALSYM SDLK_WORLD_84}
- SDLK_WORLD_85 = 245;
-{$EXTERNALSYM SDLK_WORLD_85}
- SDLK_WORLD_86 = 246;
-{$EXTERNALSYM SDLK_WORLD_86}
- SDLK_WORLD_87 = 247;
-{$EXTERNALSYM SDLK_WORLD_87}
- SDLK_WORLD_88 = 248;
-{$EXTERNALSYM SDLK_WORLD_88}
- SDLK_WORLD_89 = 249;
-{$EXTERNALSYM SDLK_WORLD_89}
- SDLK_WORLD_90 = 250;
-{$EXTERNALSYM SDLK_WORLD_90}
- SDLK_WORLD_91 = 251;
-{$EXTERNALSYM SDLK_WORLD_91}
- SDLK_WORLD_92 = 252;
-{$EXTERNALSYM SDLK_WORLD_92}
- SDLK_WORLD_93 = 253;
-{$EXTERNALSYM SDLK_WORLD_93}
- SDLK_WORLD_94 = 254;
-{$EXTERNALSYM SDLK_WORLD_94}
- SDLK_WORLD_95 = 255; // 0xFF
-{$EXTERNALSYM SDLK_WORLD_95}
-
- // Numeric keypad
- SDLK_KP0 = 256;
-{$EXTERNALSYM SDLK_KP0}
- SDLK_KP1 = 257;
-{$EXTERNALSYM SDLK_KP1}
- SDLK_KP2 = 258;
-{$EXTERNALSYM SDLK_KP2}
- SDLK_KP3 = 259;
-{$EXTERNALSYM SDLK_KP3}
- SDLK_KP4 = 260;
-{$EXTERNALSYM SDLK_KP4}
- SDLK_KP5 = 261;
-{$EXTERNALSYM SDLK_KP5}
- SDLK_KP6 = 262;
-{$EXTERNALSYM SDLK_KP6}
- SDLK_KP7 = 263;
-{$EXTERNALSYM SDLK_KP7}
- SDLK_KP8 = 264;
-{$EXTERNALSYM SDLK_KP8}
- SDLK_KP9 = 265;
-{$EXTERNALSYM SDLK_KP9}
- SDLK_KP_PERIOD = 266;
-{$EXTERNALSYM SDLK_KP_PERIOD}
- SDLK_KP_DIVIDE = 267;
-{$EXTERNALSYM SDLK_KP_DIVIDE}
- SDLK_KP_MULTIPLY = 268;
-{$EXTERNALSYM SDLK_KP_MULTIPLY}
- SDLK_KP_MINUS = 269;
-{$EXTERNALSYM SDLK_KP_MINUS}
- SDLK_KP_PLUS = 270;
-{$EXTERNALSYM SDLK_KP_PLUS}
- SDLK_KP_ENTER = 271;
-{$EXTERNALSYM SDLK_KP_ENTER}
- SDLK_KP_EQUALS = 272;
-{$EXTERNALSYM SDLK_KP_EQUALS}
-
- // Arrows + Home/End pad
- SDLK_UP = 273;
-{$EXTERNALSYM SDLK_UP}
- SDLK_DOWN = 274;
-{$EXTERNALSYM SDLK_DOWN}
- SDLK_RIGHT = 275;
-{$EXTERNALSYM SDLK_RIGHT}
- SDLK_LEFT = 276;
-{$EXTERNALSYM SDLK_LEFT}
- SDLK_INSERT = 277;
-{$EXTERNALSYM SDLK_INSERT}
- SDLK_HOME = 278;
-{$EXTERNALSYM SDLK_HOME}
- SDLK_END = 279;
-{$EXTERNALSYM SDLK_END}
- SDLK_PAGEUP = 280;
-{$EXTERNALSYM SDLK_PAGEUP}
- SDLK_PAGEDOWN = 281;
-{$EXTERNALSYM SDLK_PAGEDOWN}
-
- // Function keys
- SDLK_F1 = 282;
-{$EXTERNALSYM SDLK_F1}
- SDLK_F2 = 283;
-{$EXTERNALSYM SDLK_F2}
- SDLK_F3 = 284;
-{$EXTERNALSYM SDLK_F3}
- SDLK_F4 = 285;
-{$EXTERNALSYM SDLK_F4}
- SDLK_F5 = 286;
-{$EXTERNALSYM SDLK_F5}
- SDLK_F6 = 287;
-{$EXTERNALSYM SDLK_F6}
- SDLK_F7 = 288;
-{$EXTERNALSYM SDLK_F7}
- SDLK_F8 = 289;
-{$EXTERNALSYM SDLK_F8}
- SDLK_F9 = 290;
-{$EXTERNALSYM SDLK_F9}
- SDLK_F10 = 291;
-{$EXTERNALSYM SDLK_F10}
- SDLK_F11 = 292;
-{$EXTERNALSYM SDLK_F11}
- SDLK_F12 = 293;
-{$EXTERNALSYM SDLK_F12}
- SDLK_F13 = 294;
-{$EXTERNALSYM SDLK_F13}
- SDLK_F14 = 295;
-{$EXTERNALSYM SDLK_F14}
- SDLK_F15 = 296;
-{$EXTERNALSYM SDLK_F15}
-
- // Key state modifier keys
- SDLK_NUMLOCK = 300;
-{$EXTERNALSYM SDLK_NUMLOCK}
- SDLK_CAPSLOCK = 301;
-{$EXTERNALSYM SDLK_CAPSLOCK}
- SDLK_SCROLLOCK = 302;
-{$EXTERNALSYM SDLK_SCROLLOCK}
- SDLK_RSHIFT = 303;
-{$EXTERNALSYM SDLK_RSHIFT}
- SDLK_LSHIFT = 304;
-{$EXTERNALSYM SDLK_LSHIFT}
- SDLK_RCTRL = 305;
-{$EXTERNALSYM SDLK_RCTRL}
- SDLK_LCTRL = 306;
-{$EXTERNALSYM SDLK_LCTRL}
- SDLK_RALT = 307;
-{$EXTERNALSYM SDLK_RALT}
- SDLK_LALT = 308;
-{$EXTERNALSYM SDLK_LALT}
- SDLK_RMETA = 309;
-{$EXTERNALSYM SDLK_RMETA}
- SDLK_LMETA = 310;
-{$EXTERNALSYM SDLK_LMETA}
- SDLK_LSUPER = 311; // Left "Windows" key
-{$EXTERNALSYM SDLK_LSUPER}
- SDLK_RSUPER = 312; // Right "Windows" key
-{$EXTERNALSYM SDLK_RSUPER}
- SDLK_MODE = 313; // "Alt Gr" key
-{$EXTERNALSYM SDLK_MODE}
- SDLK_COMPOSE = 314; // Multi-key compose key
-{$EXTERNALSYM SDLK_COMPOSE}
-
- // Miscellaneous function keys
- SDLK_HELP = 315;
-{$EXTERNALSYM SDLK_HELP}
- SDLK_PRINT = 316;
-{$EXTERNALSYM SDLK_PRINT}
- SDLK_SYSREQ = 317;
-{$EXTERNALSYM SDLK_SYSREQ}
- SDLK_BREAK = 318;
-{$EXTERNALSYM SDLK_BREAK}
- SDLK_MENU = 319;
-{$EXTERNALSYM SDLK_MENU}
- SDLK_POWER = 320; // Power Macintosh power key
-{$EXTERNALSYM SDLK_POWER}
- SDLK_EURO = 321; // Some european keyboards
-{$EXTERNALSYM SDLK_EURO}
-
-{$IFDEF GP2X}
-SDLK_GP2X_UP = 0;
-{$EXTERNALSYM SDLK_GP2X_UP}
-SDLK_GP2X_UPLEFT = 1;
-{$EXTERNALSYM SDLK_GP2X_UPLEFT}
-SDLK_GP2X_LEFT = 2;
-{$EXTERNALSYM SDLK_GP2X_LEFT}
-SDLK_GP2X_DOWNLEFT = 3;
-{$EXTERNALSYM SDLK_GP2X_DOWNLEFT}
-SDLK_GP2X_DOWN = 4;
-{$EXTERNALSYM SDLK_GP2X_DOWN}
-SDLK_GP2X_DOWNRIGHT = 5;
-{$EXTERNALSYM SDLK_GP2X_DOWNRIGHT}
-SDLK_GP2X_RIGHT = 6;
-{$EXTERNALSYM SDLK_GP2X_RIGHT}
-SDLK_GP2X_UPRIGHT = 7;
-{$EXTERNALSYM SDLK_GP2X_UPRIGHT}
-SDLK_GP2X_START = 8;
-{$EXTERNALSYM SDLK_GP2X_START}
-SDLK_GP2X_SELECT = 9;
-{$EXTERNALSYM SDLK_GP2X_SELECT}
-SDLK_GP2X_L = 10;
-{$EXTERNALSYM SDLK_GP2X_L}
-SDLK_GP2X_R = 11;
-{$EXTERNALSYM SDLK_GP2X_R}
-SDLK_GP2X_A = 12;
-{$EXTERNALSYM SDLK_GP2X_A}
-SDLK_GP2X_B = 13;
-{$EXTERNALSYM SDLK_GP2X_B}
-SDLK_GP2X_Y = 14;
-{$EXTERNALSYM SDLK_GP2X_Y}
-SDLK_GP2X_X = 15;
-{$EXTERNALSYM SDLK_GP2X_X}
-SDLK_GP2X_VOLUP = 16;
-{$EXTERNALSYM SDLK_GP2X_VOLUP}
-SDLK_GP2X_VOLDOWN = 17;
-{$EXTERNALSYM SDLK_GP2X_VOLDOWN}
-SDLK_GP2X_CLICK = 18;
-{$EXTERNALSYM SDLK_GP2X_CLICK}
-{$ENDIF}
-
- // Enumeration of valid key mods (possibly OR'd together)
- KMOD_NONE = $0000;
-{$EXTERNALSYM KMOD_NONE}
- KMOD_LSHIFT = $0001;
-{$EXTERNALSYM KMOD_LSHIFT}
- KMOD_RSHIFT = $0002;
-{$EXTERNALSYM KMOD_RSHIFT}
- KMOD_LCTRL = $0040;
-{$EXTERNALSYM KMOD_LCTRL}
- KMOD_RCTRL = $0080;
-{$EXTERNALSYM KMOD_RCTRL}
- KMOD_LALT = $0100;
-{$EXTERNALSYM KMOD_LALT}
- KMOD_RALT = $0200;
-{$EXTERNALSYM KMOD_RALT}
- KMOD_LMETA = $0400;
-{$EXTERNALSYM KMOD_LMETA}
- KMOD_RMETA = $0800;
-{$EXTERNALSYM KMOD_RMETA}
- KMOD_NUM = $1000;
-{$EXTERNALSYM KMOD_NUM}
- KMOD_CAPS = $2000;
-{$EXTERNALSYM KMOD_CAPS}
- KMOD_MODE = 44000;
-{$EXTERNALSYM KMOD_MODE}
- KMOD_RESERVED = $8000;
-{$EXTERNALSYM KMOD_RESERVED}
-
- KMOD_CTRL = (KMOD_LCTRL or KMOD_RCTRL);
-{$EXTERNALSYM KMOD_CTRL}
- KMOD_SHIFT = (KMOD_LSHIFT or KMOD_RSHIFT);
-{$EXTERNALSYM KMOD_SHIFT}
- KMOD_ALT = (KMOD_LALT or KMOD_RALT);
-{$EXTERNALSYM KMOD_ALT}
- KMOD_META = (KMOD_LMETA or KMOD_RMETA);
-{$EXTERNALSYM KMOD_META}
-
- //SDL_video.h constants
- // Transparency definitions: These define alpha as the opacity of a surface */
- SDL_ALPHA_OPAQUE = 255;
-{$EXTERNALSYM SDL_ALPHA_OPAQUE}
- SDL_ALPHA_TRANSPARENT = 0;
-{$EXTERNALSYM SDL_ALPHA_TRANSPARENT}
-
- // These are the currently supported flags for the SDL_surface
- // Available for SDL_CreateRGBSurface() or SDL_SetVideoMode()
- SDL_SWSURFACE = $00000000; // Surface is in system memory
-{$EXTERNALSYM SDL_SWSURFACE}
- SDL_HWSURFACE = $00000001; // Surface is in video memory
-{$EXTERNALSYM SDL_HWSURFACE}
- SDL_ASYNCBLIT = $00000004; // Use asynchronous blits if possible
-{$EXTERNALSYM SDL_ASYNCBLIT}
- // Available for SDL_SetVideoMode()
- SDL_ANYFORMAT = $10000000; // Allow any video depth/pixel-format
-{$EXTERNALSYM SDL_ANYFORMAT}
- SDL_HWPALETTE = $20000000; // Surface has exclusive palette
-{$EXTERNALSYM SDL_HWPALETTE}
- SDL_DOUBLEBUF = $40000000; // Set up double-buffered video mode
-{$EXTERNALSYM SDL_DOUBLEBUF}
- SDL_FULLSCREEN = $80000000; // Surface is a full screen display
-{$EXTERNALSYM SDL_FULLSCREEN}
- SDL_OPENGL = $00000002; // Create an OpenGL rendering context
-{$EXTERNALSYM SDL_OPENGL}
- SDL_OPENGLBLIT = $00000002; // Create an OpenGL rendering context
-{$EXTERNALSYM SDL_OPENGLBLIT}
- SDL_RESIZABLE = $00000010; // This video mode may be resized
-{$EXTERNALSYM SDL_RESIZABLE}
- SDL_NOFRAME = $00000020; // No window caption or edge frame
-{$EXTERNALSYM SDL_NOFRAME}
- // Used internally (read-only)
- SDL_HWACCEL = $00000100; // Blit uses hardware acceleration
-{$EXTERNALSYM SDL_HWACCEL}
- SDL_SRCCOLORKEY = $00001000; // Blit uses a source color key
-{$EXTERNALSYM SDL_SRCCOLORKEY}
- SDL_RLEACCELOK = $00002000; // Private flag
-{$EXTERNALSYM SDL_RLEACCELOK}
- SDL_RLEACCEL = $00004000; // Colorkey blit is RLE accelerated
-{$EXTERNALSYM SDL_RLEACCEL}
- SDL_SRCALPHA = $00010000; // Blit uses source alpha blending
-{$EXTERNALSYM SDL_SRCALPHA}
- SDL_SRCCLIPPING = $00100000; // Blit uses source clipping
-{$EXTERNALSYM SDL_SRCCLIPPING}
- SDL_PREALLOC = $01000000; // Surface uses preallocated memory
-{$EXTERNALSYM SDL_PREALLOC}
-
- { The most common video overlay formats.
- For an explanation of these pixel formats, see:
- http://www.webartz.com/fourcc/indexyuv.htm
-
- For information on the relationship between color spaces, see:
- http://www.neuro.sfc.keio.ac.jp/~aly/polygon/info/color-space-faq.html }
-
- SDL_YV12_OVERLAY = $32315659; // Planar mode: Y + V + U (3 planes)
-{$EXTERNALSYM SDL_YV12_OVERLAY}
- SDL_IYUV_OVERLAY = $56555949; // Planar mode: Y + U + V (3 planes)
-{$EXTERNALSYM SDL_IYUV_OVERLAY}
- SDL_YUY2_OVERLAY = $32595559; // Packed mode: Y0+U0+Y1+V0 (1 plane)
-{$EXTERNALSYM SDL_YUY2_OVERLAY}
- SDL_UYVY_OVERLAY = $59565955; // Packed mode: U0+Y0+V0+Y1 (1 plane)
-{$EXTERNALSYM SDL_UYVY_OVERLAY}
- SDL_YVYU_OVERLAY = $55595659; // Packed mode: Y0+V0+Y1+U0 (1 plane)
-{$EXTERNALSYM SDL_YVYU_OVERLAY}
-
- // flags for SDL_SetPalette()
- SDL_LOGPAL = $01;
-{$EXTERNALSYM SDL_LOGPAL}
- SDL_PHYSPAL = $02;
-{$EXTERNALSYM SDL_PHYSPAL}
-
- //SDL_mouse.h constants
- { Used as a mask when testing buttons in buttonstate
- Button 1: Left mouse button
- Button 2: Middle mouse button
- Button 3: Right mouse button
- Button 4: Mouse Wheel Up (may also be a real button)
- Button 5: Mouse Wheel Down (may also be a real button)
- Button 6: Mouse X1 (may also be a real button)
- Button 7: Mouse X2 (may also be a real button)
- }
- SDL_BUTTON_LEFT = 1;
-{$EXTERNALSYM SDL_BUTTON_LEFT}
- SDL_BUTTON_MIDDLE = 2;
-{$EXTERNALSYM SDL_BUTTON_MIDDLE}
- SDL_BUTTON_RIGHT = 3;
-{$EXTERNALSYM SDL_BUTTON_RIGHT}
- SDL_BUTTON_WHEELUP = 4;
-{$EXTERNALSYM SDL_BUTTON_WHEELUP}
- SDL_BUTTON_WHEELDOWN = 5;
-{$EXTERNALSYM SDL_BUTTON_WHEELDOWN}
- SDL_BUTTON_X1 = 6;
-{$EXTERNALSYM SDL_BUTTON_X1}
- SDL_BUTTON_X2 = 7;
-{$EXTERNALSYM SDL_BUTTON_X2}
-
- SDL_BUTTON_LMASK = SDL_PRESSED shl (SDL_BUTTON_LEFT - 1);
-{$EXTERNALSYM SDL_BUTTON_LMASK}
- SDL_BUTTON_MMASK = SDL_PRESSED shl (SDL_BUTTON_MIDDLE - 1);
-{$EXTERNALSYM SDL_BUTTON_MMASK}
- SDL_BUTTON_RMASK = SDL_PRESSED shl (SDL_BUTTON_RIGHT - 1);
-{$EXTERNALSYM SDL_BUTTON_RMASK}
- SDL_BUTTON_X1MASK = SDL_PRESSED shl (SDL_BUTTON_X1 - 1);
-{$EXTERNALSYM SDL_BUTTON_X1MASK}
- SDL_BUTTON_X2MASK = SDL_PRESSED shl (SDL_BUTTON_X2 - 1);
-{$EXTERNALSYM SDL_BUTTON_X2MASK}
-
- // SDL_active.h constants
- // The available application states
- SDL_APPMOUSEFOCUS = $01; // The app has mouse coverage
-{$EXTERNALSYM SDL_APPMOUSEFOCUS}
- SDL_APPINPUTFOCUS = $02; // The app has input focus
-{$EXTERNALSYM SDL_APPINPUTFOCUS}
- SDL_APPACTIVE = $04; // The application is active
-{$EXTERNALSYM SDL_APPACTIVE}
-
- // SDL_mutex.h constants
- // Synchronization functions which can time out return this value
- // they time out.
-
- SDL_MUTEX_TIMEDOUT = 1;
-{$EXTERNALSYM SDL_MUTEX_TIMEDOUT}
-
- // This is the timeout value which corresponds to never time out
- SDL_MUTEX_MAXWAIT = not Cardinal(0);
-{$EXTERNALSYM SDL_MUTEX_MAXWAIT}
-
- {TSDL_GrabMode = (
- SDL_GRAB_QUERY,
- SDL_GRAB_OFF,
- SDL_GRAB_ON,
- SDL_GRAB_FULLSCREEN ); // Used internally}
- SDL_GRAB_QUERY = -1;
- SDL_GRAB_OFF = 0;
- SDL_GRAB_ON = 1;
- //SDL_GRAB_FULLSCREEN // Used internally
-
-type
- THandle = Cardinal;
- //SDL_types.h types
- // Basic data types
-
- SDL_Bool = (SDL_FALSE, SDL_TRUE);
- TSDL_Bool = SDL_Bool;
-
- PUInt8Array = ^TUInt8Array;
- PUInt8 = ^UInt8;
- PPUInt8 = ^PUInt8;
- UInt8 = Byte;
-{$EXTERNALSYM UInt8}
- TUInt8Array = array [0..MAXINT shr 1] of UInt8;
-
- PUInt16 = ^UInt16;
- UInt16 = word;
-{$EXTERNALSYM UInt16}
-
- PSInt8 = ^SInt8;
- SInt8 = Shortint;
-{$EXTERNALSYM SInt8}
-
- PSInt16 = ^SInt16;
- SInt16 = smallint;
-{$EXTERNALSYM SInt16}
-
- PUInt32 = ^UInt32;
- UInt32 = Cardinal;
-{$EXTERNALSYM UInt32}
-
- SInt32 = Integer;
-{$EXTERNALSYM SInt32}
-
- PInt = ^Integer;
-
- PShortInt = ^ShortInt;
-
- PUInt64 = ^UInt64;
- UInt64 = record
- hi: UInt32;
- lo: UInt32;
- end;
-{$EXTERNALSYM UInt64}
-
- PSInt64 = ^SInt64;
- SInt64 = record
- hi: UInt32;
- lo: UInt32;
- end;
-{$EXTERNALSYM SInt64}
-
- TSDL_GrabMode = Integer;
-
- // SDL_error.h types
- TSDL_errorcode = (
- SDL_ENOMEM,
- SDL_EFREAD,
- SDL_EFWRITE,
- SDL_EFSEEK,
- SDL_LASTERROR);
-
- SDL_errorcode = TSDL_errorcode;
-{$EXTERNALSYM SDL_errorcode}
-
- TArg = record
- case Byte of
- 0: (value_ptr: Pointer);
- (* #if 0 means: never
- 1 : ( value_c : Byte );
- *)
- 2: (value_i: Integer);
- 3: (value_f: double);
- 4: (buf: array[0..ERR_MAX_STRLEN - 1] of Byte);
- end;
-
- PSDL_error = ^TSDL_error;
- TSDL_error = record
- { This is a numeric value corresponding to the current error }
- error: Integer;
-
- { This is a key used to index into a language hashtable containing
- internationalized versions of the SDL error messages. If the key
- is not in the hashtable, or no hashtable is available, the key is
- used directly as an error message format string. }
- key: array[0..ERR_MAX_STRLEN - 1] of Byte;
-
- { These are the arguments for the error functions }
- argc: Integer;
- args: array[0..ERR_MAX_ARGS - 1] of TArg;
- end;
-
- // SDL_rwops.h types
- // This is the read/write operation structure -- very basic
- // some helper types to handle the unions
- // "packed" is only guessed
-
- TStdio = record
- autoclose: Integer;
- // FILE * is only defined in Kylix so we use a simple Pointer
- fp: Pointer;
- end;
-
- TMem = record
- base: PUInt8;
- here: PUInt8;
- stop: PUInt8;
- end;
-
- TUnknown = record
- data1: Pointer;
- end;
-
- // first declare the pointer type
- PSDL_RWops = ^TSDL_RWops;
- // now the pointer to function types
- {$IFNDEF __GPC__}
- TSeek = function( context: PSDL_RWops; offset: Integer; whence: Integer ): Integer; cdecl;
- TRead = function( context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer ): Integer; cdecl;
- TWrite = function( context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer ): Integer; cdecl;
- TClose = function( context: PSDL_RWops ): Integer; cdecl;
- {$ELSE}
- TSeek = function( context: PSDL_RWops; offset: Integer; whence: Integer ): Integer;
- TRead = function( context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer ): Integer;
- TWrite = function( context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer ): Integer;
- TClose = function( context: PSDL_RWops ): Integer;
- {$ENDIF}
- // the variant record itself
- TSDL_RWops = record
- seek: TSeek;
- read: TRead;
- write: TWrite;
- close: TClose;
- // a keyword as name is not allowed
- type_: UInt32;
- // be warned! structure alignment may arise at this point
- case Integer of
- 0: (stdio: TStdio);
- 1: (mem: TMem);
- 2: (unknown: TUnknown);
- end;
-
- SDL_RWops = TSDL_RWops;
-{$EXTERNALSYM SDL_RWops}
-
-
- // SDL_timer.h types
- // Function prototype for the timer callback function
- {$IFNDEF __GPC__}
- TSDL_TimerCallback = function( interval: UInt32 ): UInt32; cdecl;
- {$ELSE}
- TSDL_TimerCallback = function( interval: UInt32 ): UInt32;
- {$ENDIF}
-
- { New timer API, supports multiple timers
- Written by Stephane Peter <megastep@lokigames.com> }
-
- { Function prototype for the new timer callback function.
- The callback function is passed the current timer interval and returns
- the next timer interval. If the returned value is the same as the one
- passed in, the periodic alarm continues, otherwise a new alarm is
- scheduled. If the callback returns 0, the periodic alarm is cancelled. }
- {$IFNDEF __GPC__}
- TSDL_NewTimerCallback = function( interval: UInt32; param: Pointer ): UInt32; cdecl;
- {$ELSE}
- TSDL_NewTimerCallback = function( interval: UInt32; param: Pointer ): UInt32;
- {$ENDIF}
-
- // Definition of the timer ID type
- PSDL_TimerID = ^TSDL_TimerID;
- TSDL_TimerID = record
- interval: UInt32;
- callback: TSDL_NewTimerCallback;
- param: Pointer;
- last_alarm: UInt32;
- next: PSDL_TimerID;
- end;
-
- {$IFNDEF __GPC__}
- TSDL_AudioSpecCallback = procedure( userdata: Pointer; stream: PUInt8; len: Integer ); cdecl;
- {$ELSE}
- TSDL_AudioSpecCallback = procedure( userdata: Pointer; stream: PUInt8; len: Integer );
- {$ENDIF}
-
- // SDL_audio.h types
- // The calculated values in this structure are calculated by SDL_OpenAudio()
- PSDL_AudioSpec = ^TSDL_AudioSpec;
- TSDL_AudioSpec = record
- freq: Integer; // DSP frequency -- samples per second
- format: UInt16; // Audio data format
- channels: UInt8; // Number of channels: 1 mono, 2 stereo
- silence: UInt8; // Audio buffer silence value (calculated)
- samples: UInt16; // Audio buffer size in samples
- padding: UInt16; // Necessary for some compile environments
- size: UInt32; // Audio buffer size in bytes (calculated)
- { This function is called when the audio device needs more data.
- 'stream' is a pointer to the audio data buffer
- 'len' is the length of that buffer in bytes.
- Once the callback returns, the buffer will no longer be valid.
- Stereo samples are stored in a LRLRLR ordering.}
- callback: TSDL_AudioSpecCallback;
- userdata: Pointer;
- end;
-
- // A structure to hold a set of audio conversion filters and buffers
- PSDL_AudioCVT = ^TSDL_AudioCVT;
-
- PSDL_AudioCVTFilter = ^TSDL_AudioCVTFilter;
- TSDL_AudioCVTFilter = record
- cvt: PSDL_AudioCVT;
- format: UInt16;
- end;
-
- PSDL_AudioCVTFilterArray = ^TSDL_AudioCVTFilterArray;
- TSDL_AudioCVTFilterArray = array[0..9] of PSDL_AudioCVTFilter;
-
- TSDL_AudioCVT = record
- needed: Integer; // Set to 1 if conversion possible
- src_format: UInt16; // Source audio format
- dst_format: UInt16; // Target audio format
- rate_incr: double; // Rate conversion increment
- buf: PUInt8; // Buffer to hold entire audio data
- len: Integer; // Length of original audio buffer
- len_cvt: Integer; // Length of converted audio buffer
- len_mult: Integer; // buffer must be len*len_mult big
- len_ratio: double; // Given len, final size is len*len_ratio
- filters: TSDL_AudioCVTFilterArray;
- filter_index: Integer; // Current audio conversion function
- end;
-
- TSDL_Audiostatus = (
- SDL_AUDIO_STOPPED,
- SDL_AUDIO_PLAYING,
- SDL_AUDIO_PAUSED
- );
-
- // SDL_cdrom.h types
- TSDL_CDStatus = (
- CD_ERROR,
- CD_TRAYEMPTY,
- CD_STOPPED,
- CD_PLAYING,
- CD_PAUSED );
-
- PSDL_CDTrack = ^TSDL_CDTrack;
- TSDL_CDTrack = record
- id: UInt8; // Track number
- type_: UInt8; // Data or audio track
- unused: UInt16;
- length: UInt32; // Length, in frames, of this track
- offset: UInt32; // Offset, in frames, from start of disk
- end;
-
- // This structure is only current as of the last call to SDL_CDStatus()
- PSDL_CD = ^TSDL_CD;
- TSDL_CD = record
- id: Integer; // Private drive identifier
- status: TSDL_CDStatus; // Current drive status
-
- // The rest of this structure is only valid if there's a CD in drive
- numtracks: Integer; // Number of tracks on disk
- cur_track: Integer; // Current track position
- cur_frame: Integer; // Current frame offset within current track
- track: array[0..SDL_MAX_TRACKS] of TSDL_CDTrack;
- end;
-
- //SDL_joystick.h types
- PTransAxis = ^TTransAxis;
- TTransAxis = record
- offset: Integer;
- scale: single;
- end;
-
- // The private structure used to keep track of a joystick
- PJoystick_hwdata = ^TJoystick_hwdata;
- TJoystick_hwdata = record
- // joystick ID
- id: Integer;
- // values used to translate device-specific coordinates into SDL-standard ranges
- transaxis: array[0..5] of TTransAxis;
- end;
-
- PBallDelta = ^TBallDelta;
- TBallDelta = record
- dx: Integer;
- dy: Integer;
- end; // Current ball motion deltas
-
- // The SDL joystick structure
- PSDL_Joystick = ^TSDL_Joystick;
- TSDL_Joystick = record
- index: UInt8; // Device index
- name: PChar; // Joystick name - system dependent
-
- naxes: Integer; // Number of axis controls on the joystick
- axes: PUInt16; // Current axis states
-
- nhats: Integer; // Number of hats on the joystick
- hats: PUInt8; // Current hat states
-
- nballs: Integer; // Number of trackballs on the joystick
- balls: PBallDelta; // Current ball motion deltas
-
- nbuttons: Integer; // Number of buttons on the joystick
- buttons: PUInt8; // Current button states
-
- hwdata: PJoystick_hwdata; // Driver dependent information
-
- ref_count: Integer; // Reference count for multiple opens
- end;
-
- // SDL_verion.h types
- PSDL_version = ^TSDL_version;
- TSDL_version = record
- major: UInt8;
- minor: UInt8;
- patch: UInt8;
- end;
-
- // SDL_keyboard.h types
- TSDLKey = LongWord;
-
- TSDLMod = LongWord;
-
- PSDL_KeySym = ^TSDL_KeySym;
- TSDL_KeySym = record
- scancode: UInt8; // hardware specific scancode
- sym: TSDLKey; // SDL virtual keysym
- modifier: TSDLMod; // current key modifiers
- unicode: UInt16; // translated character
- end;
-
- // SDL_events.h types
- {Checks the event queue for messages and optionally returns them.
- If 'action' is SDL_ADDEVENT, up to 'numevents' events will be added to
- the back of the event queue.
- If 'action' is SDL_PEEKEVENT, up to 'numevents' events at the front
- of the event queue, matching 'mask', will be returned and will not
- be removed from the queue.
- If 'action' is SDL_GETEVENT, up to 'numevents' events at the front
- of the event queue, matching 'mask', will be returned and will be
- removed from the queue.
- This function returns the number of events actually stored, or -1
- if there was an error. This function is thread-safe. }
-
- TSDL_EventAction = (SDL_ADDEVENT, SDL_PEEKEVENT, SDL_GETEVENT);
-
- // Application visibility event structure
- TSDL_ActiveEvent = record
- type_: UInt8; // SDL_ACTIVEEVENT
- gain: UInt8; // Whether given states were gained or lost (1/0)
- state: UInt8; // A mask of the focus states
- end;
-
- // Keyboard event structure
- TSDL_KeyboardEvent = record
- type_: UInt8; // SDL_KEYDOWN or SDL_KEYUP
- which: UInt8; // The keyboard device index
- state: UInt8; // SDL_PRESSED or SDL_RELEASED
- keysym: TSDL_KeySym;
- end;
-
- // Mouse motion event structure
- TSDL_MouseMotionEvent = record
- type_: UInt8; // SDL_MOUSEMOTION
- which: UInt8; // The mouse device index
- state: UInt8; // The current button state
- x, y: UInt16; // The X/Y coordinates of the mouse
- xrel: SInt16; // The relative motion in the X direction
- yrel: SInt16; // The relative motion in the Y direction
- end;
-
- // Mouse button event structure
- TSDL_MouseButtonEvent = record
- type_: UInt8; // SDL_MOUSEBUTTONDOWN or SDL_MOUSEBUTTONUP
- which: UInt8; // The mouse device index
- button: UInt8; // The mouse button index
- state: UInt8; // SDL_PRESSED or SDL_RELEASED
- x: UInt16; // The X coordinates of the mouse at press time
- y: UInt16; // The Y coordinates of the mouse at press time
- end;
-
- // Joystick axis motion event structure
- TSDL_JoyAxisEvent = record
- type_: UInt8; // SDL_JOYAXISMOTION
- which: UInt8; // The joystick device index
- axis: UInt8; // The joystick axis index
- value: SInt16; // The axis value (range: -32768 to 32767)
- end;
-
- // Joystick trackball motion event structure
- TSDL_JoyBallEvent = record
- type_: UInt8; // SDL_JOYAVBALLMOTION
- which: UInt8; // The joystick device index
- ball: UInt8; // The joystick trackball index
- xrel: SInt16; // The relative motion in the X direction
- yrel: SInt16; // The relative motion in the Y direction
- end;
-
- // Joystick hat position change event structure
- TSDL_JoyHatEvent = record
- type_: UInt8; // SDL_JOYHATMOTION */
- which: UInt8; // The joystick device index */
- hat: UInt8; // The joystick hat index */
- value: UInt8; { The hat position value:
- 8 1 2
- 7 0 3
- 6 5 4
-
- Note that zero means the POV is centered. }
-
- end;
-
- // Joystick button event structure
- TSDL_JoyButtonEvent = record
- type_: UInt8; // SDL_JOYBUTTONDOWN or SDL_JOYBUTTONUP
- which: UInt8; // The joystick device index
- button: UInt8; // The joystick button index
- state: UInt8; // SDL_PRESSED or SDL_RELEASED
- end;
-
- { The "window resized" event
- When you get this event, you are responsible for setting a new video
- mode with the new width and height. }
- TSDL_ResizeEvent = record
- type_: UInt8; // SDL_VIDEORESIZE
- w: Integer; // New width
- h: Integer; // New height
- end;
-
- // The "quit requested" event
- PSDL_QuitEvent = ^TSDL_QuitEvent;
- TSDL_QuitEvent = record
- type_: UInt8;
- end;
-
- // A user-defined event type
- PSDL_UserEvent = ^TSDL_UserEvent;
- TSDL_UserEvent = record
- type_: UInt8; // SDL_USEREVENT through SDL_NUMEVENTS-1
- code: Integer; // User defined event code */
- data1: Pointer; // User defined data pointer */
- data2: Pointer; // User defined data pointer */
- end;
-
- // The "screen redraw" event
- PSDL_ExposeEvent = ^TSDL_ExposeEvent;
- TSDL_ExposeEvent = record
- type_ : Uint8; // SDL_VIDEOEXPOSE
- end;
-
- {$IFDEF Unix}
- //These are the various supported subsystems under UNIX
- TSDL_SysWm = ( SDL_SYSWM_X11 ) ;
- {$ENDIF}
-
-// The windows custom event structure
-{$IFDEF WINDOWS}
- PSDL_SysWMmsg = ^TSDL_SysWMmsg;
- TSDL_SysWMmsg = record
- version: TSDL_version;
- h_wnd: HWND; // The window for the message
- msg: UInt; // The type of message
- w_Param: WPARAM; // WORD message parameter
- lParam: LPARAM; // LONG message parameter
- end;
-{$ELSE}
-
-{$IFDEF Unix}
-{ The Linux custom event structure }
- PSDL_SysWMmsg = ^TSDL_SysWMmsg;
- TSDL_SysWMmsg = record
- version : TSDL_version;
- subsystem : TSDL_SysWm;
- {$IFDEF FPC}
- {$IFNDEF GP2X}
- {$IFNDEF DARWIN}
- {$IFNDEF SKYOS}
- event : TXEvent;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ELSE}
- event : XEvent;
- {$ENDIF}
- end;
-{$ELSE}
-{ The generic custom event structure }
- PSDL_SysWMmsg = ^TSDL_SysWMmsg;
- TSDL_SysWMmsg = record
- version: TSDL_version;
- data: Integer;
- end;
-{$ENDIF}
-
-{$ENDIF}
-
-// The Windows custom window manager information structure
-{$IFDEF WINDOWS}
- PSDL_SysWMinfo = ^TSDL_SysWMinfo;
- TSDL_SysWMinfo = record
- version : TSDL_version;
- window : HWnd; // The display window
- end;
-{$ELSE}
-
-// The Linux custom window manager information structure
-{$IFDEF Unix}
- {$IFNDEF GP2X}
- {$IFNDEF DARWIN}
- {$IFNDEF SKYOS}
- TX11 = record
- display : PDisplay; // The X11 display
- window : TWindow ; // The X11 display window */
- {* These locking functions should be called around
- any X11 functions using the display variable.
- They lock the event thread, so should not be
- called around event functions or from event filters.
- *}
- lock_func : Pointer;
- unlock_func : Pointer;
-
- // Introduced in SDL 1.0.2
- fswindow : TWindow ; // The X11 fullscreen window */
- wmwindow : TWindow ; // The X11 managed input window */
- end;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
-
- PSDL_SysWMinfo = ^TSDL_SysWMinfo;
- TSDL_SysWMinfo = record
- version : TSDL_version ;
- subsystem : TSDL_SysWm;
- {$IFNDEF GP2X}
- {$IFNDEF DARWIN}
- {$IFNDEF SKYOS}
- X11 : TX11;
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- end;
-{$ELSE}
- // The generic custom window manager information structure
- PSDL_SysWMinfo = ^TSDL_SysWMinfo;
- TSDL_SysWMinfo = record
- version : TSDL_version ;
- data : integer;
- end;
-{$ENDIF}
-
-{$ENDIF}
-
- PSDL_SysWMEvent = ^TSDL_SysWMEvent;
- TSDL_SysWMEvent = record
- type_: UInt8;
- msg: PSDL_SysWMmsg;
- end;
-
- PSDL_Event = ^TSDL_Event;
- TSDL_Event = record
- case UInt8 of
- SDL_NOEVENT: (type_: byte);
- SDL_ACTIVEEVENT: (active: TSDL_ActiveEvent);
- SDL_KEYDOWN, SDL_KEYUP: (key: TSDL_KeyboardEvent);
- SDL_MOUSEMOTION: (motion: TSDL_MouseMotionEvent);
- SDL_MOUSEBUTTONDOWN, SDL_MOUSEBUTTONUP: (button: TSDL_MouseButtonEvent );
- SDL_JOYAXISMOTION: (jaxis: TSDL_JoyAxisEvent );
- SDL_JOYBALLMOTION: (jball: TSDL_JoyBallEvent );
- SDL_JOYHATMOTION: (jhat: TSDL_JoyHatEvent );
- SDL_JOYBUTTONDOWN, SDL_JOYBUTTONUP: (jbutton: TSDL_JoyButtonEvent );
- SDL_VIDEORESIZE: (resize: TSDL_ResizeEvent );
- SDL_QUITEV: (quit: TSDL_QuitEvent );
- SDL_USEREVENT : ( user : TSDL_UserEvent );
- SDL_SYSWMEVENT: (syswm: TSDL_SysWMEvent );
- end;
-
-
-{ This function sets up a filter to process all events before they
- change internal state and are posted to the internal event queue.
-
- The filter is protypted as: }
- {$IFNDEF __GPC__}
- TSDL_EventFilter = function( event : PSDL_Event ): Integer; cdecl;
- {$ELSE}
- TSDL_EventFilter = function( event : PSDL_Event ): Integer;
- {$ENDIF}
-
- // SDL_video.h types
- // Useful data types
- PPSDL_Rect = ^PSDL_Rect;
- PSDL_Rect = ^TSDL_Rect;
- TSDL_Rect = record
- x, y: SInt16;
- w, h: UInt16;
- end;
-
- SDL_Rect = TSDL_Rect;
-{$EXTERNALSYM SDL_Rect}
-
- PSDL_Color = ^TSDL_Color;
- TSDL_Color = record
- r: UInt8;
- g: UInt8;
- b: UInt8;
- unused: UInt8;
- end;
-
- PSDL_ColorArray = ^TSDL_ColorArray;
- TSDL_ColorArray = array[0..65000] of TSDL_Color;
-
- PSDL_Palette = ^TSDL_Palette;
- TSDL_Palette = record
- ncolors: Integer;
- colors: PSDL_ColorArray;
- end;
-
- // Everything in the pixel format structure is read-only
- PSDL_PixelFormat = ^TSDL_PixelFormat;
- TSDL_PixelFormat = record
- palette: PSDL_Palette;
- BitsPerPixel: UInt8;
- BytesPerPixel: UInt8;
- Rloss: UInt8;
- Gloss: UInt8;
- Bloss: UInt8;
- Aloss: UInt8;
- Rshift: UInt8;
- Gshift: UInt8;
- Bshift: UInt8;
- Ashift: UInt8;
- RMask: UInt32;
- GMask: UInt32;
- BMask: UInt32;
- AMask: UInt32;
- colorkey: UInt32; // RGB color key information
- alpha: UInt8; // Alpha value information (per-surface alpha)
- end;
-
-{$IFDEF WINDOWS}
- {PPrivate_hwdata = ^TPrivate_hwdata;
- TPrivate_hwdata = record
- dd_surface : IDIRECTDRAWSURFACE3;
- dd_writebuf : IDIRECTDRAWSURFACE3;
- end;}
- {ELSE}
-{$ENDIF}
-
- // The structure passed to the low level blit functions
- PSDL_BlitInfo = ^TSDL_BlitInfo;
- TSDL_BlitInfo = record
- s_pixels: PUInt8;
- s_width: Integer;
- s_height: Integer;
- s_skip: Integer;
- d_pixels: PUInt8;
- d_width: Integer;
- d_height: Integer;
- d_skip: Integer;
- aux_data: Pointer;
- src: PSDL_PixelFormat;
- table: PUInt8;
- dst: PSDL_PixelFormat;
- end;
-
- // typedef for private surface blitting functions
- PSDL_Surface = ^TSDL_Surface;
-
- {$IFNDEF __GPC__}
- TSDL_Blit = function( src: PSDL_Surface; srcrect: PSDL_Rect; dst: PSDL_Surface; dstrect: PSDL_Rect ): Integer; cdecl;
- {$ELSE}
- TSDL_Blit = function( src: PSDL_Surface; srcrect: PSDL_Rect; dst: PSDL_Surface; dstrect: PSDL_Rect ): Integer;
- {$ENDIF}
-
- // The type definition for the low level blit functions
- //TSDL_LoBlit = procedure( info : PSDL_BlitInfo ); cdecl;
-
- // This is the private info structure for software accelerated blits
- {PPrivate_swaccel = ^TPrivate_swaccel;
- TPrivate_swaccel = record
- blit : TSDL_LoBlit;
- aux_data : Pointer;
- end;}
-
- // Blit mapping definition
- {PSDL_BlitMap = ^TSDL_BlitMap;
- TSDL_BlitMap = record
- dst : PSDL_Surface;
- identity : Integer;
- table : PUInt8;
- hw_blit : TSDL_Blit;
- sw_blit : TSDL_Blit;
- hw_data : PPrivate_hwaccel;
- sw_data : PPrivate_swaccel;
-
- // the version count matches the destination; mismatch indicates an invalid mapping
- format_version : Cardinal;
- end;}
-
- TSDL_Surface = record
- flags: UInt32; // Read-only
- format: PSDL_PixelFormat; // Read-only
- w, h: Integer; // Read-only
- pitch: UInt16; // Read-only
- pixels: Pointer; // Read-write
- offset: Integer; // Private
- hwdata: Pointer; //TPrivate_hwdata; Hardware-specific surface info
-
- // clipping information:
- clip_rect: TSDL_Rect; // Read-only
- unused1: UInt32; // for binary compatibility
- // Allow recursive locks
- locked: UInt32; // Private
- // info for fast blit mapping to other surfaces
- Blitmap: Pointer; // PSDL_BlitMap; // Private
- // format version, bumped at every change to invalidate blit maps
- format_version: Cardinal; // Private
- refcount: Integer;
- end;
-
- // Useful for determining the video hardware capabilities
- PSDL_VideoInfo = ^TSDL_VideoInfo;
- TSDL_VideoInfo = record
- hw_available: UInt8; // Hardware and WindowManager flags in first 2 bits ( see below )
- {hw_available: 1; // Can you create hardware surfaces
- wm_available: 1; // Can you talk to a window manager?
- UnusedBits1: 6;}
- blit_hw: UInt8; // Blit Hardware flags. See below for which bits do what
- {UnusedBits2: 1;
- blit_hw: 1; // Flag:UInt32 Accelerated blits HW --> HW
- blit_hw_CC: 1; // Flag:UInt32 Accelerated blits with Colorkey
- blit_hw_A: 1; // Flag:UInt32 Accelerated blits with Alpha
- blit_sw: 1; // Flag:UInt32 Accelerated blits SW --> HW
- blit_sw_CC: 1; // Flag:UInt32 Accelerated blits with Colorkey
- blit_sw_A: 1; // Flag:UInt32 Accelerated blits with Alpha
- blit_fill: 1; // Flag:UInt32 Accelerated color fill}
- UnusedBits3: UInt8; // Unused at this point
- video_mem: UInt32; // The total amount of video memory (in K)
- vfmt: PSDL_PixelFormat; // Value: The format of the video surface
- current_w : SInt32; // Value: The current video mode width
- current_h : SInt32; // Value: The current video mode height
- end;
-
- // The YUV hardware video overlay
- PSDL_Overlay = ^TSDL_Overlay;
- TSDL_Overlay = record
- format: UInt32; // Overlay format
- w, h: Integer; // Width and height of overlay
- planes: Integer; // Number of planes in the overlay. Usually either 1 or 3
- pitches: PUInt16;
- // An array of pitches, one for each plane. Pitch is the length of a row in bytes.
- pixels: PPUInt8;
- // An array of pointers to the data of each plane. The overlay should be locked before these pointers are used.
- hw_overlay: UInt32;
- // This will be set to 1 if the overlay is hardware accelerated.
- end;
-
- // Public enumeration for setting the OpenGL window attributes.
- TSDL_GLAttr = (
- SDL_GL_RED_SIZE,
- SDL_GL_GREEN_SIZE,
- SDL_GL_BLUE_SIZE,
- SDL_GL_ALPHA_SIZE,
- SDL_GL_BUFFER_SIZE,
- SDL_GL_DOUBLEBUFFER,
- SDL_GL_DEPTH_SIZE,
- SDL_GL_STENCIL_SIZE,
- SDL_GL_ACCUM_RED_SIZE,
- SDL_GL_ACCUM_GREEN_SIZE,
- SDL_GL_ACCUM_BLUE_SIZE,
- SDL_GL_ACCUM_ALPHA_SIZE,
- SDL_GL_STEREO,
- SDL_GL_MULTISAMPLEBUFFERS,
- SDL_GL_MULTISAMPLESAMPLES,
- SDL_GL_ACCELERATED_VISUAL,
- SDL_GL_SWAP_CONTROL);
-
-
-
- PSDL_Cursor = ^TSDL_Cursor;
- TSDL_Cursor = record
- area: TSDL_Rect; // The area of the mouse cursor
- hot_x, hot_y: SInt16; // The "tip" of the cursor
- data: PUInt8; // B/W cursor data
- mask: PUInt8; // B/W cursor mask
- save: array[1..2] of PUInt8; // Place to save cursor area
- wm_cursor: Pointer; // Window-manager cursor
- end;
-
-// SDL_mutex.h types
-
-{$IFDEF WINDOWS}
- PSDL_Mutex = ^TSDL_Mutex;
- TSDL_Mutex = record
- id: THANDLE;
- end;
-{$ENDIF}
-
-{$IFDEF Unix}
- PSDL_Mutex = ^TSDL_Mutex;
- TSDL_mutex = record
- id: pthread_mutex_t;
-{$IFDEF PTHREAD_NO_RECURSIVE_MUTEX}
- recursive: Integer;
- owner: pthread_t;
-{$ENDIF}
- end;
-{$ENDIF}
-
-{$IFDEF NDS}
- PSDL_mutex = ^TSDL_Mutex;
- TSDL_Mutex = record
- recursive: Integer;
- Owner: UInt32;
- sem: PSDL_sem;
- end;
-{$ENDIF}
-
-{$IFDEF __MACH__}
- {$define USE_NAMED_SEMAPHORES}
- // Broken sem_getvalue() in MacOS X Public Beta */
- {$define BROKEN_SEMGETVALUE}
-{$ENDIF}
-
-PSDL_semaphore = ^TSDL_semaphore;
-{$IFDEF WINDOWS}
- // WINDOWS or Machintosh
- TSDL_semaphore = record
- id: THANDLE;
- count: UInt32;
- end;
-{$ELSE}
- {$IFDEF FPC}
- // This should be semaphore.h
- __sem_lock_t = {packed} record { Not in header file - anonymous }
- status: Longint;
- spinlock: Integer;
- end;
-
- sem_t = {packed} record
- __sem_lock: __sem_lock_t;
- __sem_value: Integer;
- __sem_waiting: longint ; {_pthread_queue;}
- end;
- {$ENDIF}
-
- TSDL_semaphore = record
- sem: Pointer; //PSem_t;
- {$IFNDEF USE_NAMED_SEMAPHORES}
- sem_data: Sem_t;
- {$ENDIF}
-
- {$IFDEF BROKEN_SEMGETVALUE}
- { This is a little hack for MacOS X -
- It's not thread-safe, but it's better than nothing }
- sem_value: Integer;
- {$ENDIF}
- end;
-{$ENDIF}
-
- PSDL_Sem = ^TSDL_Sem;
- TSDL_Sem = TSDL_Semaphore;
-
- PSDL_Cond = ^TSDL_Cond;
- TSDL_Cond = record
-{$IFDEF Unix}
- cond: pthread_cond_t;
-{$ELSE}
- // Generic Cond structure
- lock: PSDL_mutex;
- waiting: Integer;
- signals: Integer;
- wait_sem: PSDL_Sem;
- wait_done: PSDL_Sem;
-{$ENDIF}
- end;
-
- // SDL_thread.h types
-{$IFDEF WINDOWS}
- TSYS_ThreadHandle = THandle;
-{$ENDIF}
-
-{$IFDEF Unix}
- TSYS_ThreadHandle = pthread_t;
-{$ENDIF}
-
-{$IFDEF NDS}
- TSYS_ThreadHandle = Integer;
-{$ENDIF}
-
- { This is the system-independent thread info structure }
- PSDL_Thread = ^TSDL_Thread;
- TSDL_Thread = record
- threadid: UInt32;
- handle: TSYS_ThreadHandle;
- status: Integer;
- errbuf: TSDL_Error;
- data: Pointer;
- end;
-
- // Helper Types
-
- // Keyboard State Array ( See demos for how to use )
- PKeyStateArr = ^TKeyStateArr;
- TKeyStateArr = array[0..65000] of UInt8;
-
- // Types required so we don't need to use Windows.pas
- PInteger = ^Integer;
- PByte = ^Byte;
- PWord = ^Word;
- PLongWord = ^Longword;
-
- // General arrays
- PByteArray = ^TByteArray;
- TByteArray = array[0..32767] of Byte;
-
- PWordArray = ^TWordArray;
- TWordArray = array[0..16383] of Word;
-
- PPoint = ^TPoint;
- {$IFDEF HAS_TYPES}
- TPoint = Types.TPoint;
- {$ELSE}
- {$IFDEF WINDOWS}
- {$IFDEF __GPC__}
- TPoint = wintypes.TPoint;
- {$ELSE}
- TPoint = Windows.TPoint;
- {$ENDIF}
- {$ELSE}
- //Can't define TPoint : neither Types nor Windows unit available.
- {$ENDIF}
- {$ENDIF}
-
- PRect = ^TRect;
- {$IFDEF HAS_TYPES}
- TRect = Types.TRect;
- {$ELSE}
- {$IFDEF WINDOWS}
- {$IFDEF __GPC__}
- TRect = wintypes.TRect;
- {$ELSE}
- TRect = Windows.TRect;
- {$ENDIF}
- {$ELSE}
- //Can't define TRect: neither Types nor Windows unit available.
- {$ENDIF}
- {$ENDIF}
-
- { Generic procedure pointer }
- TProcedure = procedure;
-
-{------------------------------------------------------------------------------}
-{ initialization }
-{------------------------------------------------------------------------------}
-
-{ This function loads the SDL dynamically linked library and initializes
- the subsystems specified by 'flags' (and those satisfying dependencies)
- Unless the SDL_INIT_NOPARACHUTE flag is set, it will install cleanup
- signal handlers for some commonly ignored fatal signals (like SIGSEGV) }
-
-function SDL_Init( flags : UInt32 ) : Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_Init'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_Init}
-
-// This function initializes specific SDL subsystems
-function SDL_InitSubSystem( flags : UInt32 ) : Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_InitSubSystem'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_InitSubSystem}
-
-// This function cleans up specific SDL subsystems
-procedure SDL_QuitSubSystem( flags : UInt32 );
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_QuitSubSystem'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_QuitSubSystem}
-
-{ This function returns mask of the specified subsystems which have
- been initialized.
- If 'flags' is 0, it returns a mask of all initialized subsystems. }
-
-function SDL_WasInit( flags : UInt32 ): UInt32;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WasInit'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_WasInit}
-
-{ This function cleans up all initialized subsystems and unloads the
- dynamically linked library. You should call it upon all exit conditions. }
-procedure SDL_Quit;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_Quit'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_Quit}
-
-{$IFDEF WINDOWS}
-// This should be called from your WinMain() function, if any
-function SDL_RegisterApp(name: PChar; style: UInt32; h_Inst: Pointer): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_RegisterApp'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_RegisterApp}
-{$ENDIF}
-
-{$IFDEF __MACH__}
-// This should be called from your main() function, if any
-procedure SDL_InitQuickDraw( the_qd: QDGlobals );
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_InitQuickDraw'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_InitQuickDraw}
-{$ENDIF}
-
-
-{------------------------------------------------------------------------------}
-{ types }
-{------------------------------------------------------------------------------}
-// The number of elements in a table
-function SDL_TableSize( table: PChar ): Integer;
-{$EXTERNALSYM SDL_TABLESIZE}
-
-
-{------------------------------------------------------------------------------}
-{ error-handling }
-{------------------------------------------------------------------------------}
-// Public functions
-function SDL_GetError: PChar;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetError'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GetError}
-procedure SDL_SetError(fmt: PChar);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetError'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_SetError}
-procedure SDL_ClearError;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_ClearError'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_ClearError}
-
-{$IFNDEF WINDOWS}
-procedure SDL_Error(Code: TSDL_errorcode);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_Error'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_Error}
-{$ENDIF}
-
-// Private error message function - used internally
-procedure SDL_OutOfMemory;
-
-{------------------------------------------------------------------------------}
-{ io handling }
-{------------------------------------------------------------------------------}
-// Functions to create SDL_RWops structures from various data sources
-
-function SDL_RWFromFile(filename, mode: PChar): PSDL_RWops;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_RWFromFile'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_RWFromFile}
-procedure SDL_FreeRW(area: PSDL_RWops);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_FreeRW'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_FreeRW}
-
-//fp is FILE *fp ???
-function SDL_RWFromFP(fp: Pointer; autoclose: Integer): PSDL_RWops;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_RWFromFP'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_RWFromFP}
-function SDL_RWFromMem(mem: Pointer; size: Integer): PSDL_RWops;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_RWFromMem'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_RWFromMem}
-function SDL_RWFromConstMem(const mem: Pointer; size: Integer) : PSDL_RWops;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_RWFromConstMem'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_RWFromConstMem}
-function SDL_AllocRW: PSDL_RWops;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_AllocRW'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_AllocRW}
-
-function SDL_RWSeek(context: PSDL_RWops; offset: Integer; whence: Integer) : Integer;
-{$EXTERNALSYM SDL_RWSeek}
-function SDL_RWTell(context: PSDL_RWops): Integer;
-{$EXTERNALSYM SDL_RWTell}
-function SDL_RWRead(context: PSDL_RWops; ptr: Pointer; size: Integer; n : Integer): Integer;
-{$EXTERNALSYM SDL_RWRead}
-function SDL_RWWrite(context: PSDL_RWops; ptr: Pointer; size: Integer; n : Integer): Integer;
-{$EXTERNALSYM SDL_RWWrite}
-function SDL_RWClose(context: PSDL_RWops): Integer;
-{$EXTERNALSYM SDL_RWClose}
-
-{------------------------------------------------------------------------------}
-{ time-handling }
-{------------------------------------------------------------------------------}
-
-{ Get the number of milliseconds since the SDL library initialization. }
-{ Note that this value wraps if the program runs for more than ~49 days. }
-function SDL_GetTicks: UInt32;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetTicks'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GetTicks}
-
-// Wait a specified number of milliseconds before returning
-procedure SDL_Delay(msec: UInt32);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_Delay'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_Delay}
-
-{ Add a new timer to the pool of timers already running. }
-{ Returns a timer ID, or NULL when an error occurs. }
-function SDL_AddTimer(interval: UInt32; callback: TSDL_NewTimerCallback; param : Pointer): PSDL_TimerID;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_AddTimer'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_AddTimer}
-
-{ Remove one of the multiple timers knowing its ID. }
-{ Returns a boolean value indicating success. }
-function SDL_RemoveTimer(t: PSDL_TimerID): TSDL_Bool;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_RemoveTimer'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_RemoveTimer}
-
-function SDL_SetTimer(interval: UInt32; callback: TSDL_TimerCallback): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetTimer'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_SetTimer}
-
-{------------------------------------------------------------------------------}
-{ audio-routines }
-{------------------------------------------------------------------------------}
-
-{ These functions are used internally, and should not be used unless you
- have a specific need to specify the audio driver you want to use.
- You should normally use SDL_Init() or SDL_InitSubSystem(). }
-
-function SDL_AudioInit(driver_name: PChar): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_AudioInit'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_AudioInit}
-procedure SDL_AudioQuit;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_AudioQuit'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_AudioQuit}
-
-{ This function fills the given character buffer with the name of the
- current audio driver, and returns a Pointer to it if the audio driver has
- been initialized. It returns NULL if no driver has been initialized. }
-
-function SDL_AudioDriverName(namebuf: PChar; maxlen: Integer): PChar;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_AudioDriverName'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_AudioDriverName}
-
-{ This function opens the audio device with the desired parameters, and
- returns 0 if successful, placing the actual hardware parameters in the
- structure pointed to by 'obtained'. If 'obtained' is NULL, the audio
- data passed to the callback function will be guaranteed to be in the
- requested format, and will be automatically converted to the hardware
- audio format if necessary. This function returns -1 if it failed
- to open the audio device, or couldn't set up the audio thread.
-
- When filling in the desired audio spec structure,
- 'desired->freq' should be the desired audio frequency in samples-per-second.
- 'desired->format' should be the desired audio format.
- 'desired->samples' is the desired size of the audio buffer, in samples.
- This number should be a power of two, and may be adjusted by the audio
- driver to a value more suitable for the hardware. Good values seem to
- range between 512 and 8096 inclusive, depending on the application and
- CPU speed. Smaller values yield faster response time, but can lead
- to underflow if the application is doing heavy processing and cannot
- fill the audio buffer in time. A stereo sample consists of both right
- and left channels in LR ordering.
- Note that the number of samples is directly related to time by the
- following formula: ms = (samples*1000)/freq
- 'desired->size' is the size in bytes of the audio buffer, and is
- calculated by SDL_OpenAudio().
- 'desired->silence' is the value used to set the buffer to silence,
- and is calculated by SDL_OpenAudio().
- 'desired->callback' should be set to a function that will be called
- when the audio device is ready for more data. It is passed a pointer
- to the audio buffer, and the length in bytes of the audio buffer.
- This function usually runs in a separate thread, and so you should
- protect data structures that it accesses by calling SDL_LockAudio()
- and SDL_UnlockAudio() in your code.
- 'desired->userdata' is passed as the first parameter to your callback
- function.
-
- The audio device starts out playing silence when it's opened, and should
- be enabled for playing by calling SDL_PauseAudio(0) when you are ready
- for your audio callback function to be called. Since the audio driver
- may modify the requested size of the audio buffer, you should allocate
- any local mixing buffers after you open the audio device. }
-
-function SDL_OpenAudio(desired, obtained: PSDL_AudioSpec): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_OpenAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_OpenAudio}
-
-{ Get the current audio state: }
-function SDL_GetAudioStatus: TSDL_Audiostatus;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetAudioStatus'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GetAudioStatus}
-
-{ This function pauses and unpauses the audio callback processing.
- It should be called with a parameter of 0 after opening the audio
- device to start playing sound. This is so you can safely initialize
- data for your callback function after opening the audio device.
- Silence will be written to the audio device during the pause. }
-
-procedure SDL_PauseAudio(pause_on: Integer);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_PauseAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_PauseAudio}
-
-{ This function loads a WAVE from the data source, automatically freeing
- that source if 'freesrc' is non-zero. For example, to load a WAVE file,
- you could do:
- SDL_LoadWAV_RW(SDL_RWFromFile("sample.wav", "rb"), 1, ...);
-
- If this function succeeds, it returns the given SDL_AudioSpec,
- filled with the audio data format of the wave data, and sets
- 'audio_buf' to a malloc()'d buffer containing the audio data,
- and sets 'audio_len' to the length of that audio buffer, in bytes.
- You need to free the audio buffer with SDL_FreeWAV() when you are
- done with it.
-
- This function returns NULL and sets the SDL error message if the
- wave file cannot be opened, uses an unknown data format, or is
- corrupt. Currently raw and MS-ADPCM WAVE files are supported. }
-
-function SDL_LoadWAV_RW(src: PSDL_RWops; freesrc: Integer; spec:
- PSDL_AudioSpec; audio_buf: PUInt8; audiolen: PUInt32): PSDL_AudioSpec;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_LoadWAV_RW'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_LoadWAV_RW}
-
-// Compatibility convenience function -- loads a WAV from a file
-function SDL_LoadWAV(filename: PChar; spec: PSDL_AudioSpec; audio_buf:
- PUInt8; audiolen: PUInt32): PSDL_AudioSpec;
-{$EXTERNALSYM SDL_LoadWAV}
-
-{ This function frees data previously allocated with SDL_LoadWAV_RW() }
-
-procedure SDL_FreeWAV(audio_buf: PUInt8);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_FreeWAV'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_FreeWAV}
-
-{ This function takes a source format and rate and a destination format
- and rate, and initializes the 'cvt' structure with information needed
- by SDL_ConvertAudio() to convert a buffer of audio data from one format
- to the other.
- This function returns 0, or -1 if there was an error. }
-function SDL_BuildAudioCVT(cvt: PSDL_AudioCVT; src_format: UInt16;
- src_channels: UInt8; src_rate: Integer; dst_format: UInt16; dst_channels: UInt8;
- dst_rate: Integer): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_BuildAudioCVT'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_BuildAudioCVT}
-
-{ Once you have initialized the 'cvt' structure using SDL_BuildAudioCVT(),
- created an audio buffer cvt->buf, and filled it with cvt->len bytes of
- audio data in the source format, this function will convert it in-place
- to the desired format.
- The data conversion may expand the size of the audio data, so the buffer
- cvt->buf should be allocated after the cvt structure is initialized by
- SDL_BuildAudioCVT(), and should be cvt->len*cvt->len_mult bytes long. }
-function SDL_ConvertAudio(cvt: PSDL_AudioCVT): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_ConvertAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_ConvertAudio}
-
-{ This takes two audio buffers of the playing audio format and mixes
- them, performing addition, volume adjustment, and overflow clipping.
- The volume ranges from 0 - 128, and should be set to SDL_MIX_MAXVOLUME
- for full audio volume. Note this does not change hardware volume.
- This is provided for convenience -- you can mix your own audio data. }
-
-procedure SDL_MixAudio(dst, src: PUInt8; len: UInt32; volume: Integer);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_MixAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_MixAudio}
-
-{ The lock manipulated by these functions protects the callback function.
- During a LockAudio/UnlockAudio pair, you can be guaranteed that the
- callback function is not running. Do not call these from the callback
- function or you will cause deadlock. }
-procedure SDL_LockAudio;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_LockAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_LockAudio}
-procedure SDL_UnlockAudio;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_UnlockAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_UnlockAudio}
-
-{ This function shuts down audio processing and closes the audio device. }
-
-procedure SDL_CloseAudio;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CloseAudio'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_CloseAudio}
-
-{------------------------------------------------------------------------------}
-{ CD-routines }
-{------------------------------------------------------------------------------}
-
-{ Returns the number of CD-ROM drives on the system, or -1 if
- SDL_Init() has not been called with the SDL_INIT_CDROM flag. }
-
-function SDL_CDNumDrives: Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDNumDrives'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_CDNumDrives}
-
-{ Returns a human-readable, system-dependent identifier for the CD-ROM.
- Example:
- "/dev/cdrom"
- "E:"
- "/dev/disk/ide/1/master" }
-
-function SDL_CDName(drive: Integer): PChar;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDName'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_CDName}
-
-{ Opens a CD-ROM drive for access. It returns a drive handle on success,
- or NULL if the drive was invalid or busy. This newly opened CD-ROM
- becomes the default CD used when other CD functions are passed a NULL
- CD-ROM handle.
- Drives are numbered starting with 0. Drive 0 is the system default CD-ROM. }
-
-function SDL_CDOpen(drive: Integer): PSDL_CD;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDOpen'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_CDOpen}
-
-{ This function returns the current status of the given drive.
- If the drive has a CD in it, the table of contents of the CD and current
- play position of the CD will be stored in the SDL_CD structure. }
-
-function SDL_CDStatus(cdrom: PSDL_CD): TSDL_CDStatus;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDStatus'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_CDStatus}
-
-{ Play the given CD starting at 'start_track' and 'start_frame' for 'ntracks'
- tracks and 'nframes' frames. If both 'ntrack' and 'nframe' are 0, play
- until the end of the CD. This function will skip data tracks.
- This function should only be called after calling SDL_CDStatus() to
- get track information about the CD.
-
- For example:
- // Play entire CD:
- if ( CD_INDRIVE(SDL_CDStatus(cdrom)) ) then
- SDL_CDPlayTracks(cdrom, 0, 0, 0, 0);
- // Play last track:
- if ( CD_INDRIVE(SDL_CDStatus(cdrom)) ) then
- begin
- SDL_CDPlayTracks(cdrom, cdrom->numtracks-1, 0, 0, 0);
- end;
-
- // Play first and second track and 10 seconds of third track:
- if ( CD_INDRIVE(SDL_CDStatus(cdrom)) )
- SDL_CDPlayTracks(cdrom, 0, 0, 2, 10);
-
- This function returns 0, or -1 if there was an error. }
-
-function SDL_CDPlayTracks(cdrom: PSDL_CD; start_track: Integer; start_frame:
- Integer; ntracks: Integer; nframes: Integer): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDPlayTracks'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_CDPlayTracks}
-
-
-{ Play the given CD starting at 'start' frame for 'length' frames.
- It returns 0, or -1 if there was an error. }
-
-function SDL_CDPlay(cdrom: PSDL_CD; start: Integer; length: Integer): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDPlay'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_CDPlay}
-
-// Pause play -- returns 0, or -1 on error
-function SDL_CDPause(cdrom: PSDL_CD): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDPause'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_CDPause}
-
-// Resume play -- returns 0, or -1 on error
-function SDL_CDResume(cdrom: PSDL_CD): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDResume'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_CDResume}
-
-// Stop play -- returns 0, or -1 on error
-function SDL_CDStop(cdrom: PSDL_CD): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDStop'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_CDStop}
-
-// Eject CD-ROM -- returns 0, or -1 on error
-function SDL_CDEject(cdrom: PSDL_CD): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDEject'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_CDEject}
-
-// Closes the handle for the CD-ROM drive
-procedure SDL_CDClose(cdrom: PSDL_CD);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CDClose'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_CDClose}
-
-// Given a status, returns true if there's a disk in the drive
-function SDL_CDInDrive( status : TSDL_CDStatus ) : LongBool;
-{$EXTERNALSYM SDL_CDInDrive}
-
-// Conversion functions from frames to Minute/Second/Frames and vice versa
-procedure FRAMES_TO_MSF(frames: Integer; var M: Integer; var S: Integer; var
- F: Integer);
-{$EXTERNALSYM FRAMES_TO_MSF}
-function MSF_TO_FRAMES(M: Integer; S: Integer; F: Integer): Integer;
-{$EXTERNALSYM MSF_TO_FRAMES}
-
-{------------------------------------------------------------------------------}
-{ JoyStick-routines }
-{------------------------------------------------------------------------------}
-
-{ Count the number of joysticks attached to the system }
-function SDL_NumJoysticks: Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_NumJoysticks'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_NumJoysticks}
-
-{ Get the implementation dependent name of a joystick.
- This can be called before any joysticks are opened.
- If no name can be found, this function returns NULL. }
-function SDL_JoystickName(index: Integer): PChar;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickName'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_JoystickName}
-
-{ Open a joystick for use - the index passed as an argument refers to
- the N'th joystick on the system. This index is the value which will
- identify this joystick in future joystick events.
-
- This function returns a joystick identifier, or NULL if an error occurred. }
-function SDL_JoystickOpen(index: Integer): PSDL_Joystick;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickOpen'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_JoystickOpen}
-
-{ Returns 1 if the joystick has been opened, or 0 if it has not. }
-function SDL_JoystickOpened(index: Integer): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickOpened'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_JoystickOpened}
-
-{ Get the device index of an opened joystick. }
-function SDL_JoystickIndex(joystick: PSDL_Joystick): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickIndex'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_JoystickIndex}
-
-{ Get the number of general axis controls on a joystick }
-function SDL_JoystickNumAxes(joystick: PSDL_Joystick): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickNumAxes'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_JoystickNumAxes}
-
-{ Get the number of trackballs on a joystick
- Joystick trackballs have only relative motion events associated
- with them and their state cannot be polled. }
-function SDL_JoystickNumBalls(joystick: PSDL_Joystick): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickNumBalls'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_JoystickNumBalls}
-
-
-{ Get the number of POV hats on a joystick }
-function SDL_JoystickNumHats(joystick: PSDL_Joystick): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickNumHats'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_JoystickNumHats}
-
-{ Get the number of buttons on a joystick }
-function SDL_JoystickNumButtons(joystick: PSDL_Joystick): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickNumButtons'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_JoystickNumButtons}
-
-{ Update the current state of the open joysticks.
- This is called automatically by the event loop if any joystick
- events are enabled. }
-
-procedure SDL_JoystickUpdate;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickUpdate'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_JoystickUpdate;}
-
-{ Enable/disable joystick event polling.
- If joystick events are disabled, you must call SDL_JoystickUpdate()
- yourself and check the state of the joystick when you want joystick
- information.
- The state can be one of SDL_QUERY, SDL_ENABLE or SDL_IGNORE. }
-
-function SDL_JoystickEventState(state: Integer): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickEventState'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_JoystickEventState}
-
-{ Get the current state of an axis control on a joystick
- The state is a value ranging from -32768 to 32767.
- The axis indices start at index 0. }
-
-function SDL_JoystickGetAxis(joystick: PSDL_Joystick; axis: Integer) : SInt16;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickGetAxis'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_JoystickGetAxis}
-
-{ The hat indices start at index 0. }
-
-function SDL_JoystickGetHat(joystick: PSDL_Joystick; hat: Integer): UInt8;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickGetHat'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_JoystickGetHat}
-
-{ Get the ball axis change since the last poll
- This returns 0, or -1 if you passed it invalid parameters.
- The ball indices start at index 0. }
-
-function SDL_JoystickGetBall(joystick: PSDL_Joystick; ball: Integer; var dx: Integer; var dy: Integer): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickGetBall'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_JoystickGetBall}
-
-{ Get the current state of a button on a joystick
- The button indices start at index 0. }
-function SDL_JoystickGetButton( joystick: PSDL_Joystick; Button: Integer): UInt8;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickGetButton'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_JoystickGetButton}
-
-{ Close a joystick previously opened with SDL_JoystickOpen() }
-procedure SDL_JoystickClose(joystick: PSDL_Joystick);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_JoystickClose'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_JoystickClose}
-
-{------------------------------------------------------------------------------}
-{ event-handling }
-{------------------------------------------------------------------------------}
-
-{ Pumps the event loop, gathering events from the input devices.
- This function updates the event queue and internal input device state.
- This should only be run in the thread that sets the video mode. }
-
-procedure SDL_PumpEvents;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_PumpEvents'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_PumpEvents;}
-
-{ Checks the event queue for messages and optionally returns them.
- If 'action' is SDL_ADDEVENT, up to 'numevents' events will be added to
- the back of the event queue.
- If 'action' is SDL_PEEKEVENT, up to 'numevents' events at the front
- of the event queue, matching 'mask', will be returned and will not
- be removed from the queue.
- If 'action' is SDL_GETEVENT, up to 'numevents' events at the front
- of the event queue, matching 'mask', will be returned and will be
- removed from the queue.
- This function returns the number of events actually stored, or -1
- if there was an error. This function is thread-safe. }
-
-function SDL_PeepEvents(events: PSDL_Event; numevents: Integer; action: TSDL_eventaction; mask: UInt32): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_PeepEvents'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_PeepEvents}
-
-{ Polls for currently pending events, and returns 1 if there are any pending
- events, or 0 if there are none available. If 'event' is not NULL, the next
- event is removed from the queue and stored in that area. }
-
-function SDL_PollEvent(event: PSDL_Event): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_PollEvent'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_PollEvent}
-
-{ Waits indefinitely for the next available event, returning 1, or 0 if there
- was an error while waiting for events. If 'event' is not NULL, the next
- event is removed from the queue and stored in that area. }
-
-function SDL_WaitEvent(event: PSDL_Event): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WaitEvent'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_WaitEvent}
-
-function SDL_PushEvent( event : PSDL_Event ) : Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_PushEvent'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_PushEvent}
-
-{ If the filter returns 1, then the event will be added to the internal queue.
- If it returns 0, then the event will be dropped from the queue, but the
- internal state will still be updated. This allows selective filtering of
- dynamically arriving events.
-
- WARNING: Be very careful of what you do in the event filter function, as
- it may run in a different thread!
-
- There is one caveat when dealing with the SDL_QUITEVENT event type. The
- event filter is only called when the window manager desires to close the
- application window. If the event filter returns 1, then the window will
- be closed, otherwise the window will remain open if possible.
- If the quit event is generated by an interrupt signal, it will bypass the
- internal queue and be delivered to the application at the next event poll. }
-procedure SDL_SetEventFilter( filter : TSDL_EventFilter );
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetEventFilter'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_SetEventFilter}
-
-{ Return the current event filter - can be used to "chain" filters.
- If there is no event filter set, this function returns NULL. }
-
-function SDL_GetEventFilter: TSDL_EventFilter;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetEventFilter'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GetEventFilter}
-
-{ This function allows you to set the state of processing certain events.
- If 'state' is set to SDL_IGNORE, that event will be automatically dropped
- from the event queue and will not event be filtered.
- If 'state' is set to SDL_ENABLE, that event will be processed normally.
- If 'state' is set to SDL_QUERY, SDL_EventState() will return the
- current processing state of the specified event. }
-
-function SDL_EventState(type_: UInt8; state: Integer): UInt8;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_EventState'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_EventState}
-
-{------------------------------------------------------------------------------}
-{ Version Routines }
-{------------------------------------------------------------------------------}
-
-{ This macro can be used to fill a version structure with the compile-time
- version of the SDL library. }
-procedure SDL_VERSION(var X: TSDL_Version);
-{$EXTERNALSYM SDL_VERSION}
-
-{ This macro turns the version numbers into a numeric value:
- (1,2,3) -> (1203)
- This assumes that there will never be more than 100 patchlevels }
-
-function SDL_VERSIONNUM(X, Y, Z: Integer): Integer;
-{$EXTERNALSYM SDL_VERSIONNUM}
-
-// This is the version number macro for the current SDL version
-function SDL_COMPILEDVERSION: Integer;
-{$EXTERNALSYM SDL_COMPILEDVERSION}
-
-// This macro will evaluate to true if compiled with SDL at least X.Y.Z
-function SDL_VERSION_ATLEAST(X: Integer; Y: Integer; Z: Integer) : LongBool;
-{$EXTERNALSYM SDL_VERSION_ATLEAST}
-
-{ This function gets the version of the dynamically linked SDL library.
- it should NOT be used to fill a version structure, instead you should
- use the SDL_Version() macro. }
-
-function SDL_Linked_Version: PSDL_version;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_Linked_Version'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_Linked_Version}
-
-{------------------------------------------------------------------------------}
-{ video }
-{------------------------------------------------------------------------------}
-
-{ These functions are used internally, and should not be used unless you
- have a specific need to specify the video driver you want to use.
- You should normally use SDL_Init() or SDL_InitSubSystem().
-
- SDL_VideoInit() initializes the video subsystem -- sets up a connection
- to the window manager, etc, and determines the current video mode and
- pixel format, but does not initialize a window or graphics mode.
- Note that event handling is activated by this routine.
-
- If you use both sound and video in your application, you need to call
- SDL_Init() before opening the sound device, otherwise under Win32 DirectX,
- you won't be able to set full-screen display modes. }
-
-function SDL_VideoInit(driver_name: PChar; flags: UInt32): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_VideoInit'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_VideoInit}
-procedure SDL_VideoQuit;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_VideoQuit'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_VideoQuit}
-
-{ This function fills the given character buffer with the name of the
- video driver, and returns a pointer to it if the video driver has
- been initialized. It returns NULL if no driver has been initialized. }
-
-function SDL_VideoDriverName(namebuf: PChar; maxlen: Integer): PChar;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_VideoDriverName'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_VideoDriverName}
-
-{ This function returns a pointer to the current display surface.
- If SDL is doing format conversion on the display surface, this
- function returns the publicly visible surface, not the real video
- surface. }
-
-function SDL_GetVideoSurface: PSDL_Surface;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetVideoSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GetVideoSurface}
-
-{ This function returns a read-only pointer to information about the
- video hardware. If this is called before SDL_SetVideoMode(), the 'vfmt'
- member of the returned structure will contain the pixel format of the
- "best" video mode. }
-function SDL_GetVideoInfo: PSDL_VideoInfo;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetVideoInfo'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GetVideoInfo}
-
-{ Check to see if a particular video mode is supported.
- It returns 0 if the requested mode is not supported under any bit depth,
- or returns the bits-per-pixel of the closest available mode with the
- given width and height. If this bits-per-pixel is different from the
- one used when setting the video mode, SDL_SetVideoMode() will succeed,
- but will emulate the requested bits-per-pixel with a shadow surface.
-
- The arguments to SDL_VideoModeOK() are the same ones you would pass to
- SDL_SetVideoMode() }
-
-function SDL_VideoModeOK(width, height, bpp: Integer; flags: UInt32): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_VideoModeOK'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_VideoModeOK}
-
-{ Return a pointer to an array of available screen dimensions for the
- given format and video flags, sorted largest to smallest. Returns
- NULL if there are no dimensions available for a particular format,
- or (SDL_Rect **)-1 if any dimension is okay for the given format.
-
- if 'format' is NULL, the mode list will be for the format given
- by SDL_GetVideoInfo( ) - > vfmt }
-
-function SDL_ListModes(format: PSDL_PixelFormat; flags: UInt32): PPSDL_Rect;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_ListModes'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_ListModes}
-
-
-{ Set up a video mode with the specified width, height and bits-per-pixel.
-
- If 'bpp' is 0, it is treated as the current display bits per pixel.
-
- If SDL_ANYFORMAT is set in 'flags', the SDL library will try to set the
- requested bits-per-pixel, but will return whatever video pixel format is
- available. The default is to emulate the requested pixel format if it
- is not natively available.
-
- If SDL_HWSURFACE is set in 'flags', the video surface will be placed in
- video memory, if possible, and you may have to call SDL_LockSurface()
- in order to access the raw framebuffer. Otherwise, the video surface
- will be created in system memory.
-
- If SDL_ASYNCBLIT is set in 'flags', SDL will try to perform rectangle
- updates asynchronously, but you must always lock before accessing pixels.
- SDL will wait for updates to complete before returning from the lock.
-
- If SDL_HWPALETTE is set in 'flags', the SDL library will guarantee
- that the colors set by SDL_SetColors() will be the colors you get.
- Otherwise, in 8-bit mode, SDL_SetColors() may not be able to set all
- of the colors exactly the way they are requested, and you should look
- at the video surface structure to determine the actual palette.
- If SDL cannot guarantee that the colors you request can be set,
- i.e. if the colormap is shared, then the video surface may be created
- under emulation in system memory, overriding the SDL_HWSURFACE flag.
-
- If SDL_FULLSCREEN is set in 'flags', the SDL library will try to set
- a fullscreen video mode. The default is to create a windowed mode
- if the current graphics system has a window manager.
- If the SDL library is able to set a fullscreen video mode, this flag
- will be set in the surface that is returned.
-
- If SDL_DOUBLEBUF is set in 'flags', the SDL library will try to set up
- two surfaces in video memory and swap between them when you call
- SDL_Flip(). This is usually slower than the normal single-buffering
- scheme, but prevents "tearing" artifacts caused by modifying video
- memory while the monitor is refreshing. It should only be used by
- applications that redraw the entire screen on every update.
-
- This function returns the video framebuffer surface, or NULL if it fails. }
-
-function SDL_SetVideoMode(width, height, bpp: Integer; flags: UInt32): PSDL_Surface;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetVideoMode'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_SetVideoMode}
-
-
-{ Makes sure the given list of rectangles is updated on the given screen.
- If 'x', 'y', 'w' and 'h' are all 0, SDL_UpdateRect will update the entire
- screen.
- These functions should not be called while 'screen' is locked. }
-
-procedure SDL_UpdateRects(screen: PSDL_Surface; numrects: Integer; rects: PSDL_Rect);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_UpdateRects'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_UpdateRects}
-procedure SDL_UpdateRect(screen: PSDL_Surface; x, y: SInt32; w, h: UInt32);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_UpdateRect'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_UpdateRect}
-
-
-{ On hardware that supports double-buffering, this function sets up a flip
- and returns. The hardware will wait for vertical retrace, and then swap
- video buffers before the next video surface blit or lock will return.
- On hardware that doesn not support double-buffering, this is equivalent
- to calling SDL_UpdateRect(screen, 0, 0, 0, 0);
- The SDL_DOUBLEBUF flag must have been passed to SDL_SetVideoMode() when
- setting the video mode for this function to perform hardware flipping.
- This function returns 0 if successful, or -1 if there was an error.}
-
-function SDL_Flip(screen: PSDL_Surface): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_Flip'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_Flip}
-
-{ Set the gamma correction for each of the color channels.
- The gamma values range (approximately) between 0.1 and 10.0
-
- If this function isn't supported directly by the hardware, it will
- be emulated using gamma ramps, if available. If successful, this
- function returns 0, otherwise it returns -1. }
-
-function SDL_SetGamma(redgamma: single; greengamma: single; bluegamma: single ): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetGamma'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_SetGamma}
-
-{ Set the gamma translation table for the red, green, and blue channels
- of the video hardware. Each table is an array of 256 16-bit quantities,
- representing a mapping between the input and output for that channel.
- The input is the index into the array, and the output is the 16-bit
- gamma value at that index, scaled to the output color precision.
-
- You may pass NULL for any of the channels to leave it unchanged.
- If the call succeeds, it will return 0. If the display driver or
- hardware does not support gamma translation, or otherwise fails,
- this function will return -1. }
-
-function SDL_SetGammaRamp( redtable: PUInt16; greentable: PUInt16; bluetable: PUInt16): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetGammaRamp'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_SetGammaRamp}
-
-{ Retrieve the current values of the gamma translation tables.
-
- You must pass in valid pointers to arrays of 256 16-bit quantities.
- Any of the pointers may be NULL to ignore that channel.
- If the call succeeds, it will return 0. If the display driver or
- hardware does not support gamma translation, or otherwise fails,
- this function will return -1. }
-
-function SDL_GetGammaRamp( redtable: PUInt16; greentable: PUInt16; bluetable: PUInt16): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetGammaRamp'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GetGammaRamp}
-
-{ Sets a portion of the colormap for the given 8-bit surface. If 'surface'
- is not a palettized surface, this function does nothing, returning 0.
- If all of the colors were set as passed to SDL_SetColors(), it will
- return 1. If not all the color entries were set exactly as given,
- it will return 0, and you should look at the surface palette to
- determine the actual color palette.
-
- When 'surface' is the surface associated with the current display, the
- display colormap will be updated with the requested colors. If
- SDL_HWPALETTE was set in SDL_SetVideoMode() flags, SDL_SetColors()
- will always return 1, and the palette is guaranteed to be set the way
- you desire, even if the window colormap has to be warped or run under
- emulation. }
-
-
-function SDL_SetColors(surface: PSDL_Surface; colors: PSDL_Color; firstcolor : Integer; ncolors: Integer) : Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetColors'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_SetColors}
-
-{ Sets a portion of the colormap for a given 8-bit surface.
- 'flags' is one or both of:
- SDL_LOGPAL -- set logical palette, which controls how blits are mapped
- to/from the surface,
- SDL_PHYSPAL -- set physical palette, which controls how pixels look on
- the screen
- Only screens have physical palettes. Separate change of physical/logical
- palettes is only possible if the screen has SDL_HWPALETTE set.
-
- The return value is 1 if all colours could be set as requested, and 0
- otherwise.
-
- SDL_SetColors() is equivalent to calling this function with
- flags = (SDL_LOGPAL or SDL_PHYSPAL). }
-
-function SDL_SetPalette(surface: PSDL_Surface; flags: Integer; colors: PSDL_Color; firstcolor: Integer; ncolors: Integer): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetPalette'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_SetPalette}
-
-{ Maps an RGB triple to an opaque pixel value for a given pixel format }
-function SDL_MapRGB(format: PSDL_PixelFormat; r: UInt8; g: UInt8; b: UInt8) : UInt32;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_MapRGB'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_MapRGB}
-
-{ Maps an RGBA quadruple to a pixel value for a given pixel format }
-function SDL_MapRGBA(format: PSDL_PixelFormat; r: UInt8; g: UInt8; b: UInt8; a: UInt8): UInt32;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_MapRGBA'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_MapRGBA}
-
-{ Maps a pixel value into the RGB components for a given pixel format }
-procedure SDL_GetRGB(pixel: UInt32; fmt: PSDL_PixelFormat; r: PUInt8; g: PUInt8; b: PUInt8);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetRGB'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GetRGB}
-
-{ Maps a pixel value into the RGBA components for a given pixel format }
-procedure SDL_GetRGBA(pixel: UInt32; fmt: PSDL_PixelFormat; r: PUInt8; g: PUInt8; b: PUInt8; a: PUInt8);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetRGBA'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GetRGBA}
-
-{ Allocate and free an RGB surface (must be called after SDL_SetVideoMode)
- If the depth is 4 or 8 bits, an empty palette is allocated for the surface.
- If the depth is greater than 8 bits, the pixel format is set using the
- flags '[RGB]mask'.
- If the function runs out of memory, it will return NULL.
-
- The 'flags' tell what kind of surface to create.
- SDL_SWSURFACE means that the surface should be created in system memory.
- SDL_HWSURFACE means that the surface should be created in video memory,
- with the same format as the display surface. This is useful for surfaces
- that will not change much, to take advantage of hardware acceleration
- when being blitted to the display surface.
- SDL_ASYNCBLIT means that SDL will try to perform asynchronous blits with
- this surface, but you must always lock it before accessing the pixels.
- SDL will wait for current blits to finish before returning from the lock.
- SDL_SRCCOLORKEY indicates that the surface will be used for colorkey blits.
- If the hardware supports acceleration of colorkey blits between
- two surfaces in video memory, SDL will try to place the surface in
- video memory. If this isn't possible or if there is no hardware
- acceleration available, the surface will be placed in system memory.
- SDL_SRCALPHA means that the surface will be used for alpha blits and
- if the hardware supports hardware acceleration of alpha blits between
- two surfaces in video memory, to place the surface in video memory
- if possible, otherwise it will be placed in system memory.
- If the surface is created in video memory, blits will be _much_ faster,
- but the surface format must be identical to the video surface format,
- and the only way to access the pixels member of the surface is to use
- the SDL_LockSurface() and SDL_UnlockSurface() calls.
- If the requested surface actually resides in video memory, SDL_HWSURFACE
- will be set in the flags member of the returned surface. If for some
- reason the surface could not be placed in video memory, it will not have
- the SDL_HWSURFACE flag set, and will be created in system memory instead. }
-
-function SDL_AllocSurface(flags: UInt32; width, height, depth: Integer;
- RMask, GMask, BMask, AMask: UInt32): PSDL_Surface;
-{$EXTERNALSYM SDL_AllocSurface}
-
-function SDL_CreateRGBSurface(flags: UInt32; width, height, depth: Integer; RMask, GMask, BMask, AMask: UInt32): PSDL_Surface;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CreateRGBSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_CreateRGBSurface}
-
-function SDL_CreateRGBSurfaceFrom(pixels: Pointer; width, height, depth, pitch
- : Integer; RMask, GMask, BMask, AMask: UInt32): PSDL_Surface;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CreateRGBSurfaceFrom'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_CreateRGBSurfaceFrom}
-
-procedure SDL_FreeSurface(surface: PSDL_Surface);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_FreeSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_FreeSurface}
-
-function SDL_MustLock(Surface: PSDL_Surface): Boolean;
-{$EXTERNALSYM SDL_MustLock}
-{ SDL_LockSurface() sets up a surface for directly accessing the pixels.
- Between calls to SDL_LockSurface()/SDL_UnlockSurface(), you can write
- to and read from 'surface->pixels', using the pixel format stored in
- 'surface->format'. Once you are done accessing the surface, you should
- use SDL_UnlockSurface() to release it.
-
- Not all surfaces require locking. If SDL_MUSTLOCK(surface) evaluates
- to 0, then you can read and write to the surface at any time, and the
- pixel format of the surface will not change. In particular, if the
- SDL_HWSURFACE flag is not given when calling SDL_SetVideoMode(), you
- will not need to lock the display surface before accessing it.
-
- No operating system or library calls should be made between lock/unlock
- pairs, as critical system locks may be held during this time.
-
- SDL_LockSurface() returns 0, or -1 if the surface couldn't be locked. }
-function SDL_LockSurface(surface: PSDL_Surface): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_LockSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_LockSurface}
-
-procedure SDL_UnlockSurface(surface: PSDL_Surface);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_UnlockSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_UnlockSurface}
-
-{ Load a surface from a seekable SDL data source (memory or file.)
- If 'freesrc' is non-zero, the source will be closed after being read.
- Returns the new surface, or NULL if there was an error.
- The new surface should be freed with SDL_FreeSurface(). }
-function SDL_LoadBMP_RW(src: PSDL_RWops; freesrc: Integer): PSDL_Surface;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_LoadBMP_RW'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_LoadBMP_RW}
-
-// Convenience macro -- load a surface from a file
-function SDL_LoadBMP(filename: PChar): PSDL_Surface;
-{$EXTERNALSYM SDL_LoadBMP}
-
-{ Save a surface to a seekable SDL data source (memory or file.)
- If 'freedst' is non-zero, the source will be closed after being written.
- Returns 0 if successful or -1 if there was an error. }
-
-function SDL_SaveBMP_RW(surface: PSDL_Surface; dst: PSDL_RWops; freedst: Integer): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SaveBMP_RW'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_SaveBMP_RW}
-
-// Convenience macro -- save a surface to a file
-function SDL_SaveBMP(surface: PSDL_Surface; filename: PChar): Integer;
-{$EXTERNALSYM SDL_SaveBMP}
-
-{ Sets the color key (transparent pixel) in a blittable surface.
- If 'flag' is SDL_SRCCOLORKEY (optionally OR'd with SDL_RLEACCEL),
- 'key' will be the transparent pixel in the source image of a blit.
- SDL_RLEACCEL requests RLE acceleration for the surface if present,
- and removes RLE acceleration if absent.
- If 'flag' is 0, this function clears any current color key.
- This function returns 0, or -1 if there was an error. }
-
-function SDL_SetColorKey(surface: PSDL_Surface; flag, key: UInt32) : Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetColorKey'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_SetColorKey}
-
-{ This function sets the alpha value for the entire surface, as opposed to
- using the alpha component of each pixel. This value measures the range
- of transparency of the surface, 0 being completely transparent to 255
- being completely opaque. An 'alpha' value of 255 causes blits to be
- opaque, the source pixels copied to the destination (the default). Note
- that per-surface alpha can be combined with colorkey transparency.
-
- If 'flag' is 0, alpha blending is disabled for the surface.
- If 'flag' is SDL_SRCALPHA, alpha blending is enabled for the surface.
- OR:ing the flag with SDL_RLEACCEL requests RLE acceleration for the
- surface; if SDL_RLEACCEL is not specified, the RLE accel will be removed. }
-
-
-function SDL_SetAlpha(surface: PSDL_Surface; flag: UInt32; alpha: UInt8): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetAlpha'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_SetAlpha}
-
-{ Sets the clipping rectangle for the destination surface in a blit.
-
- If the clip rectangle is NULL, clipping will be disabled.
- If the clip rectangle doesn't intersect the surface, the function will
- return SDL_FALSE and blits will be completely clipped. Otherwise the
- function returns SDL_TRUE and blits to the surface will be clipped to
- the intersection of the surface area and the clipping rectangle.
-
- Note that blits are automatically clipped to the edges of the source
- and destination surfaces. }
-procedure SDL_SetClipRect(surface: PSDL_Surface; rect: PSDL_Rect); cdecl;
-external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetClipRect'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_SetClipRect}
-
-{ Gets the clipping rectangle for the destination surface in a blit.
- 'rect' must be a pointer to a valid rectangle which will be filled
- with the correct values. }
-procedure SDL_GetClipRect(surface: PSDL_Surface; rect: PSDL_Rect); cdecl;
-external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetClipRect'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GetClipRect}
-
-{ Creates a new surface of the specified format, and then copies and maps
- the given surface to it so the blit of the converted surface will be as
- fast as possible. If this function fails, it returns NULL.
-
- The 'flags' parameter is passed to SDL_CreateRGBSurface() and has those
- semantics. You can also pass SDL_RLEACCEL in the flags parameter and
- SDL will try to RLE accelerate colorkey and alpha blits in the resulting
- surface.
-
- This function is used internally by SDL_DisplayFormat(). }
-
-function SDL_ConvertSurface(src: PSDL_Surface; fmt: PSDL_PixelFormat; flags: UInt32): PSDL_Surface;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_ConvertSurface'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_ConvertSurface}
-
-{
- This performs a fast blit from the source surface to the destination
- surface. It assumes that the source and destination rectangles are
- the same size. If either 'srcrect' or 'dstrect' are NULL, the entire
- surface (src or dst) is copied. The final blit rectangles are saved
- in 'srcrect' and 'dstrect' after all clipping is performed.
- If the blit is successful, it returns 0, otherwise it returns -1.
-
- The blit function should not be called on a locked surface.
-
- The blit semantics for surfaces with and without alpha and colorkey
- are defined as follows:
-
- RGBA->RGB:
- SDL_SRCALPHA set:
- alpha-blend (using alpha-channel).
- SDL_SRCCOLORKEY ignored.
- SDL_SRCALPHA not set:
- copy RGB.
- if SDL_SRCCOLORKEY set, only copy the pixels matching the
- RGB values of the source colour key, ignoring alpha in the
- comparison.
-
- RGB->RGBA:
- SDL_SRCALPHA set:
- alpha-blend (using the source per-surface alpha value);
- set destination alpha to opaque.
- SDL_SRCALPHA not set:
- copy RGB, set destination alpha to opaque.
- both:
- if SDL_SRCCOLORKEY set, only copy the pixels matching the
- source colour key.
-
- RGBA->RGBA:
- SDL_SRCALPHA set:
- alpha-blend (using the source alpha channel) the RGB values;
- leave destination alpha untouched. [Note: is this correct?]
- SDL_SRCCOLORKEY ignored.
- SDL_SRCALPHA not set:
- copy all of RGBA to the destination.
- if SDL_SRCCOLORKEY set, only copy the pixels matching the
- RGB values of the source colour key, ignoring alpha in the
- comparison.
-
- RGB->RGB:
- SDL_SRCALPHA set:
- alpha-blend (using the source per-surface alpha value).
- SDL_SRCALPHA not set:
- copy RGB.
- both:
- if SDL_SRCCOLORKEY set, only copy the pixels matching the
- source colour key.
-
- If either of the surfaces were in video memory, and the blit returns -2,
- the video memory was lost, so it should be reloaded with artwork and
- re-blitted:
- while ( SDL_BlitSurface(image, imgrect, screen, dstrect) = -2 ) do
- begin
- while ( SDL_LockSurface(image) < 0 ) do
- Sleep(10);
- -- Write image pixels to image->pixels --
- SDL_UnlockSurface(image);
- end;
-
- This happens under DirectX 5.0 when the system switches away from your
- fullscreen application. The lock will also fail until you have access
- to the video memory again. }
-
-{ You should call SDL_BlitSurface() unless you know exactly how SDL
- blitting works internally and how to use the other blit functions. }
-
-function SDL_BlitSurface(src: PSDL_Surface; srcrect: PSDL_Rect; dst: PSDL_Surface; dstrect: PSDL_Rect): Integer;
-{$EXTERNALSYM SDL_BlitSurface}
-
-{ This is the public blit function, SDL_BlitSurface(), and it performs
- rectangle validation and clipping before passing it to SDL_LowerBlit() }
-function SDL_UpperBlit(src: PSDL_Surface; srcrect: PSDL_Rect; dst: PSDL_Surface; dstrect: PSDL_Rect): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_UpperBlit'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_UpperBlit}
-
-{ This is a semi-private blit function and it performs low-level surface
- blitting only. }
-function SDL_LowerBlit(src: PSDL_Surface; srcrect: PSDL_Rect; dst: PSDL_Surface; dstrect: PSDL_Rect): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_LowerBlit'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_LowerBlit}
-
-{ This function performs a fast fill of the given rectangle with 'color'
- The given rectangle is clipped to the destination surface clip area
- and the final fill rectangle is saved in the passed in pointer.
- If 'dstrect' is NULL, the whole surface will be filled with 'color'
- The color should be a pixel of the format used by the surface, and
- can be generated by the SDL_MapRGB() function.
- This function returns 0 on success, or -1 on error. }
-
-function SDL_FillRect(dst: PSDL_Surface; dstrect: PSDL_Rect; color: UInt32) : Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_FillRect'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_FillRect}
-
-{ This function takes a surface and copies it to a new surface of the
- pixel format and colors of the video framebuffer, suitable for fast
- blitting onto the display surface. It calls SDL_ConvertSurface()
-
- If you want to take advantage of hardware colorkey or alpha blit
- acceleration, you should set the colorkey and alpha value before
- calling this function.
-
- If the conversion fails or runs out of memory, it returns NULL }
-
-function SDL_DisplayFormat(surface: PSDL_Surface): PSDL_Surface; cdecl;
-external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_DisplayFormat'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_DisplayFormat}
-
-{ This function takes a surface and copies it to a new surface of the
- pixel format and colors of the video framebuffer (if possible),
- suitable for fast alpha blitting onto the display surface.
- The new surface will always have an alpha channel.
-
- If you want to take advantage of hardware colorkey or alpha blit
- acceleration, you should set the colorkey and alpha value before
- calling this function.
-
- If the conversion fails or runs out of memory, it returns NULL }
-
-
-function SDL_DisplayFormatAlpha(surface: PSDL_Surface): PSDL_Surface; cdecl;
-external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_DisplayFormatAlpha'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_DisplayFormatAlpha}
-
-//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
-//* YUV video surface overlay functions */
-//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
-
-{ This function creates a video output overlay
- Calling the returned surface an overlay is something of a misnomer because
- the contents of the display surface underneath the area where the overlay
- is shown is undefined - it may be overwritten with the converted YUV data. }
-
-function SDL_CreateYUVOverlay(width: Integer; height: Integer; format: UInt32; display: PSDL_Surface): PSDL_Overlay;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CreateYUVOverlay'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_CreateYUVOverlay}
-
-// Lock an overlay for direct access, and unlock it when you are done
-function SDL_LockYUVOverlay(Overlay: PSDL_Overlay): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_LockYUVOverlay'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_LockYUVOverlay}
-
-procedure SDL_UnlockYUVOverlay(Overlay: PSDL_Overlay); cdecl;
-external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_UnlockYUVOverlay'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_UnlockYUVOverlay}
-
-
-{ Blit a video overlay to the display surface.
- The contents of the video surface underneath the blit destination are
- not defined.
- The width and height of the destination rectangle may be different from
- that of the overlay, but currently only 2x scaling is supported. }
-
-function SDL_DisplayYUVOverlay(Overlay: PSDL_Overlay; dstrect: PSDL_Rect) : Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_DisplayYUVOverlay'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_DisplayYUVOverlay}
-
-// Free a video overlay
-procedure SDL_FreeYUVOverlay(Overlay: PSDL_Overlay);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_FreeYUVOverlay'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_FreeYUVOverlay}
-
-{------------------------------------------------------------------------------}
-{ OpenGL Routines }
-{------------------------------------------------------------------------------}
-
-{ Dynamically load a GL driver, if SDL is built with dynamic GL.
-
- SDL links normally with the OpenGL library on your system by default,
- but you can compile it to dynamically load the GL driver at runtime.
- If you do this, you need to retrieve all of the GL functions used in
- your program from the dynamic library using SDL_GL_GetProcAddress().
-
- This is disabled in default builds of SDL. }
-
-
-function SDL_GL_LoadLibrary(filename: PChar): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GL_LoadLibrary'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GL_LoadLibrary}
-
-{ Get the address of a GL function (for extension functions) }
-function SDL_GL_GetProcAddress(procname: PChar) : Pointer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GL_GetProcAddress'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GL_GetProcAddress}
-
-{ Set an attribute of the OpenGL subsystem before intialization. }
-function SDL_GL_SetAttribute(attr: TSDL_GLAttr; value: Integer) : Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GL_SetAttribute'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GL_SetAttribute}
-
-{ Get an attribute of the OpenGL subsystem from the windowing
- interface, such as glX. This is of course different from getting
- the values from SDL's internal OpenGL subsystem, which only
- stores the values you request before initialization.
-
- Developers should track the values they pass into SDL_GL_SetAttribute
- themselves if they want to retrieve these values. }
-
-function SDL_GL_GetAttribute(attr: TSDL_GLAttr; var value: Integer): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GL_GetAttribute'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GL_GetAttribute}
-
-{ Swap the OpenGL buffers, if double-buffering is supported. }
-
-procedure SDL_GL_SwapBuffers;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GL_SwapBuffers'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GL_SwapBuffers;}
-
-{ Internal functions that should not be called unless you have read
- and understood the source code for these functions. }
-
-procedure SDL_GL_UpdateRects(numrects: Integer; rects: PSDL_Rect);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GL_UpdateRects'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GL_UpdateRects}
-procedure SDL_GL_Lock;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GL_Lock'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GL_Lock;}
-procedure SDL_GL_Unlock;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GL_Unlock'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GL_Unlock;}
-
-{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
-{* These functions allow interaction with the window manager, if any. *}
-{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
-
-{ Sets/Gets the title and icon text of the display window }
-procedure SDL_WM_GetCaption(var title : PChar; var icon : PChar);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WM_GetCaption'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_WM_GetCaption}
-procedure SDL_WM_SetCaption( const title : PChar; const icon : PChar);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WM_SetCaption'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_WM_SetCaption}
-
-{ Sets the icon for the display window.
- This function must be called before the first call to SDL_SetVideoMode().
- It takes an icon surface, and a mask in MSB format.
- If 'mask' is NULL, the entire icon surface will be used as the icon. }
-procedure SDL_WM_SetIcon(icon: PSDL_Surface; mask: PUInt8);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WM_SetIcon'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_WM_SetIcon}
-
-{ This function iconifies the window, and returns 1 if it succeeded.
- If the function succeeds, it generates an SDL_APPACTIVE loss event.
- This function is a noop and returns 0 in non-windowed environments. }
-
-function SDL_WM_IconifyWindow: Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WM_IconifyWindow'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_WM_IconifyWindow}
-
-{ Toggle fullscreen mode without changing the contents of the screen.
- If the display surface does not require locking before accessing
- the pixel information, then the memory pointers will not change.
-
- If this function was able to toggle fullscreen mode (change from
- running in a window to fullscreen, or vice-versa), it will return 1.
- If it is not implemented, or fails, it returns 0.
-
- The next call to SDL_SetVideoMode() will set the mode fullscreen
- attribute based on the flags parameter - if SDL_FULLSCREEN is not
- set, then the display will be windowed by default where supported.
-
- This is currently only implemented in the X11 video driver. }
-
-function SDL_WM_ToggleFullScreen(surface: PSDL_Surface): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WM_ToggleFullScreen'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_WM_ToggleFullScreen}
-
-{ Grabbing means that the mouse is confined to the application window,
- and nearly all keyboard input is passed directly to the application,
- and not interpreted by a window manager, if any. }
-
-function SDL_WM_GrabInput(mode: TSDL_GrabMode): TSDL_GrabMode;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WM_GrabInput'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_WM_GrabInput}
-
-{------------------------------------------------------------------------------}
-{ mouse-routines }
-{------------------------------------------------------------------------------}
-
-{ Retrieve the current state of the mouse.
- The current button state is returned as a button bitmask, which can
- be tested using the SDL_BUTTON(X) macros, and x and y are set to the
- current mouse cursor position. You can pass NULL for either x or y. }
-
-function SDL_GetMouseState(var x: Integer; var y: Integer): UInt8;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetMouseState'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GetMouseState}
-
-{ Retrieve the current state of the mouse.
- The current button state is returned as a button bitmask, which can
- be tested using the SDL_BUTTON(X) macros, and x and y are set to the
- mouse deltas since the last call to SDL_GetRelativeMouseState(). }
-function SDL_GetRelativeMouseState(var x: Integer; var y: Integer): UInt8;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetRelativeMouseState'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GetRelativeMouseState}
-
-{ Set the position of the mouse cursor (generates a mouse motion event) }
-procedure SDL_WarpMouse(x, y: UInt16);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WarpMouse'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_WarpMouse}
-
-{ Create a cursor using the specified data and mask (in MSB format).
- The cursor width must be a multiple of 8 bits.
-
- The cursor is created in black and white according to the following:
- data mask resulting pixel on screen
- 0 1 White
- 1 1 Black
- 0 0 Transparent
- 1 0 Inverted color if possible, black if not.
-
- Cursors created with this function must be freed with SDL_FreeCursor(). }
-function SDL_CreateCursor(data, mask: PUInt8; w, h, hot_x, hot_y: Integer): PSDL_Cursor;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CreateCursor'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_CreateCursor}
-
-{ Set the currently active cursor to the specified one.
- If the cursor is currently visible, the change will be immediately
- represented on the display. }
-procedure SDL_SetCursor(cursor: PSDL_Cursor);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetCursor'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_SetCursor}
-
-{ Returns the currently active cursor. }
-function SDL_GetCursor: PSDL_Cursor;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetCursor'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GetCursor}
-
-{ Deallocates a cursor created with SDL_CreateCursor(). }
-procedure SDL_FreeCursor(cursor: PSDL_Cursor);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_FreeCursor'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_FreeCursor}
-
-{ Toggle whether or not the cursor is shown on the screen.
- The cursor start off displayed, but can be turned off.
- SDL_ShowCursor() returns 1 if the cursor was being displayed
- before the call, or 0 if it was not. You can query the current
- state by passing a 'toggle' value of -1. }
-function SDL_ShowCursor(toggle: Integer): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_ShowCursor'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_ShowCursor}
-
-function SDL_BUTTON( Button : Integer ) : Integer;
-
-{------------------------------------------------------------------------------}
-{ Keyboard-routines }
-{------------------------------------------------------------------------------}
-
-{ Enable/Disable UNICODE translation of keyboard input.
- This translation has some overhead, so translation defaults off.
- If 'enable' is 1, translation is enabled.
- If 'enable' is 0, translation is disabled.
- If 'enable' is -1, the translation state is not changed.
- It returns the previous state of keyboard translation. }
-function SDL_EnableUNICODE(enable: Integer): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_EnableUNICODE'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_EnableUNICODE}
-
-{ If 'delay' is set to 0, keyboard repeat is disabled. }
-function SDL_EnableKeyRepeat(delay: Integer; interval: Integer): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_EnableKeyRepeat'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_EnableKeyRepeat}
-
-procedure SDL_GetKeyRepeat(delay : PInteger; interval: PInteger);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetKeyRepeat'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GetKeyRepeat}
-
-{ Get a snapshot of the current state of the keyboard.
- Returns an array of keystates, indexed by the SDLK_* syms.
- Used:
-
- UInt8 *keystate = SDL_GetKeyState(NULL);
- if ( keystate[SDLK_RETURN] ) ... <RETURN> is pressed }
-
-function SDL_GetKeyState(numkeys: PInt): PUInt8;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetKeyState'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GetKeyState}
-
-{ Get the current key modifier state }
-function SDL_GetModState: TSDLMod;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetModState'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GetModState}
-
-{ Set the current key modifier state
- This does not change the keyboard state, only the key modifier flags. }
-procedure SDL_SetModState(modstate: TSDLMod);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SetModState'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_SetModState}
-
-{ Get the name of an SDL virtual keysym }
-function SDL_GetKeyName(key: TSDLKey): PChar;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetKeyName'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GetKeyName}
-
-{------------------------------------------------------------------------------}
-{ Active Routines }
-{------------------------------------------------------------------------------}
-
-{ This function returns the current state of the application, which is a
- bitwise combination of SDL_APPMOUSEFOCUS, SDL_APPINPUTFOCUS, and
- SDL_APPACTIVE. If SDL_APPACTIVE is set, then the user is able to
- see your application, otherwise it has been iconified or disabled. }
-
-function SDL_GetAppState: UInt8;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetAppState'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GetAppState}
-
-
-{ Mutex functions }
-
-{ Create a mutex, initialized unlocked }
-
-function SDL_CreateMutex: PSDL_Mutex;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CreateMutex'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_CreateMutex}
-
-{ Lock the mutex (Returns 0, or -1 on error) }
-
- function SDL_mutexP(mutex: PSDL_mutex): Integer;
- cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_mutexP'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{ $ EXTERNALSYM SDL_mutexP}
-
-function SDL_LockMutex(mutex: PSDL_mutex): Integer;
-{$EXTERNALSYM SDL_LockMutex}
-
-{ Unlock the mutex (Returns 0, or -1 on error) }
-function SDL_mutexV(mutex: PSDL_mutex): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_mutexV'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_mutexV}
-
-function SDL_UnlockMutex(mutex: PSDL_mutex): Integer;
-{$EXTERNALSYM SDL_UnlockMutex}
-
-{ Destroy a mutex }
-procedure SDL_DestroyMutex(mutex: PSDL_mutex);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_DestroyMutex'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_DestroyMutex}
-
-{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }
-{ Semaphore functions }
-{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }
-{ Create a semaphore, initialized with value, returns NULL on failure. }
-function SDL_CreateSemaphore(initial_value: UInt32): PSDL_Sem;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CreateSemaphore'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_CreateSemaphore}
-
-
-{ Destroy a semaphore }
-procedure SDL_DestroySemaphore(sem: PSDL_sem);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_DestroySemaphore'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_DestroySemaphore}
-
-{ This function suspends the calling thread until the semaphore pointed
- to by sem has a positive count. It then atomically decreases the semaphore
- count. }
-
-function SDL_SemWait(sem: PSDL_sem): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SemWait'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_SemWait}
-
-{ Non-blocking variant of SDL_SemWait(), returns 0 if the wait succeeds,
- SDL_MUTEX_TIMEDOUT if the wait would block, and -1 on error. }
-
-function SDL_SemTryWait(sem: PSDL_sem): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SemTryWait'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_SemTryWait}
-
-{ Variant of SDL_SemWait() with a timeout in milliseconds, returns 0 if
- the wait succeeds, SDL_MUTEX_TIMEDOUT if the wait does not succeed in
- the allotted time, and -1 on error.
- On some platforms this function is implemented by looping with a delay
- of 1 ms, and so should be avoided if possible. }
-
-function SDL_SemWaitTimeout(sem: PSDL_sem; ms: UInt32): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SemWaitTimeout'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_SemTryWait}
-
-{ Atomically increases the semaphore's count (not blocking), returns 0,
- or -1 on error. }
-
-function SDL_SemPost(sem: PSDL_sem): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SemPost'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_SemTryWait}
-
-{ Returns the current count of the semaphore }
-
-function SDL_SemValue(sem: PSDL_sem): UInt32;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_SemValue'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_SemValue}
-
-{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }
-{ Condition variable functions }
-{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }
-{ Create a condition variable }
-function SDL_CreateCond: PSDL_Cond;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CreateCond'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_CreateCond}
-
-{ Destroy a condition variable }
-procedure SDL_DestroyCond(cond: PSDL_Cond);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_DestroyCond'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_DestroyCond}
-
-{ Restart one of the threads that are waiting on the condition variable,
- returns 0 or -1 on error. }
-
-function SDL_CondSignal(cond: PSDL_cond): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CondSignal'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_CondSignal}
-
-{ Restart all threads that are waiting on the condition variable,
- returns 0 or -1 on error. }
-
-function SDL_CondBroadcast(cond: PSDL_cond): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CondBroadcast'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_CondBroadcast}
-
-
-{ Wait on the condition variable, unlocking the provided mutex.
- The mutex must be locked before entering this function!
- Returns 0 when it is signaled, or -1 on error. }
-
-function SDL_CondWait(cond: PSDL_cond; mut: PSDL_mutex): Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CondWait'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_CondWait}
-
-{ Waits for at most 'ms' milliseconds, and returns 0 if the condition
- variable is signaled, SDL_MUTEX_TIMEDOUT if the condition is not
- signaled in the allotted time, and -1 on error.
- On some platforms this function is implemented by looping with a delay
- of 1 ms, and so should be avoided if possible. }
-
-function SDL_CondWaitTimeout(cond: PSDL_cond; mut: PSDL_mutex; ms: UInt32) : Integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CondWaitTimeout'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_CondWaitTimeout}
-
-{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }
-{ Condition variable functions }
-{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }
-
-{ Create a thread }
-function SDL_CreateThread(fn: PInt; data: Pointer): PSDL_Thread;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_CreateThread'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_CreateThread}
-
-{ Get the 32-bit thread identifier for the current thread }
-function SDL_ThreadID: UInt32;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_ThreadID'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_ThreadID}
-
-{ Get the 32-bit thread identifier for the specified thread,
- equivalent to SDL_ThreadID() if the specified thread is NULL. }
-function SDL_GetThreadID(thread: PSDL_Thread): UInt32;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetThreadID'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GetThreadID}
-
-{ Wait for a thread to finish.
- The return code for the thread function is placed in the area
- pointed to by 'status', if 'status' is not NULL. }
-
-procedure SDL_WaitThread(thread: PSDL_Thread; var status: Integer);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_WaitThread'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_WaitThread}
-
-{ Forcefully kill a thread without worrying about its state }
-procedure SDL_KillThread(thread: PSDL_Thread);
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_KillThread'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_KillThread}
-
-{------------------------------------------------------------------------------}
-{ Get Environment Routines }
-{------------------------------------------------------------------------------}
-{$IFDEF WINDOWS}
-function _putenv( const variable : Pchar ): integer;
-cdecl;
-{$ENDIF}
-
-{$IFDEF Unix}
-{$IFDEF FPC}
-function _putenv( const variable : Pchar ): integer;
-cdecl; external 'libc.so' name 'putenv';
-{$ENDIF}
-{$ENDIF}
-
-{ Put a variable of the form "name=value" into the environment }
-//function SDL_putenv(const variable: PChar): integer; cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_Init'{$ELSE} SDLLibName{$ENDIF __GPC__}SDLLibName name '';
-function SDL_putenv(const variable: PChar): integer;
-{$EXTERNALSYM SDL_putenv}
-
-// The following function has been commented out to encourage developers to use
-// SDL_putenv as it it more portable
-//function putenv(const variable: PChar): integer;
-//{$EXTERNALSYM putenv}
-
-{$IFDEF WINDOWS}
-{$IFNDEF __GPC__}
-function getenv( const name : Pchar ): PChar; cdecl;
-{$ENDIF}
-{$ENDIF}
-
-{* Retrieve a variable named "name" from the environment }
-//function SDL_getenv(const name: PChar): PChar; cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_Init'{$ELSE} SDLLibName{$ENDIF __GPC__}SDLLibName name '';
-function SDL_getenv(const name: PChar): PChar;
-{$EXTERNALSYM SDL_getenv}
-
-// The following function has been commented out to encourage developers to use
-// SDL_getenv as it it more portable
-//function getenv(const name: PChar): PChar;
-//{$EXTERNALSYM getenv}
-
-{*
- * This function gives you custom hooks into the window manager information.
- * It fills the structure pointed to by 'info' with custom information and
- * returns 1 if the function is implemented. If it's not implemented, or
- * the version member of the 'info' structure is invalid, it returns 0.
- *}
-function SDL_GetWMInfo(info : PSDL_SysWMinfo) : integer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_GetWMInfo'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_GetWMInfo}
-
-{------------------------------------------------------------------------------}
-
-//SDL_loadso.h
-{* This function dynamically loads a shared object and returns a pointer
- * to the object handle (or NULL if there was an error).
- * The 'sofile' parameter is a system dependent name of the object file.
- *}
-function SDL_LoadObject( const sofile : PChar ) : Pointer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_LoadObject'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_LoadObject}
-
-{* Given an object handle, this function looks up the address of the
- * named function in the shared object and returns it. This address
- * is no longer valid after calling SDL_UnloadObject().
- *}
-function SDL_LoadFunction( handle : Pointer; const name : PChar ) : Pointer;
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_LoadFunction'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_LoadFunction}
-
-{* Unload a shared object from memory *}
-procedure SDL_UnloadObject( handle : Pointer );
-cdecl; external {$IFNDEF NDS}{$IFDEF __GPC__}name 'SDL_UnloadObject'{$ELSE} SDLLibName{$ENDIF __GPC__}{$ENDIF};
-{$EXTERNALSYM SDL_UnloadObject}
-
-
-
-{------------------------------------------------------------------------------}
-
-function SDL_Swap32(D: Uint32): Uint32;
-{$EXTERNALSYM SDL_Swap32}
-
-{ FreeAndNil frees the given TObject instance and sets the variable reference
- to nil. Be careful to only pass TObjects to this routine. }
-procedure FreeAndNil(var Obj);
-
-{ Exit procedure handling }
-
-{ AddExitProc adds the given procedure to the run-time library's exit
- procedure list. When an application terminates, its exit procedures are
- executed in reverse order of definition, i.e. the last procedure passed
- to AddExitProc is the first one to get executed upon termination. }
-procedure AddExitProc(Proc: TProcedure);
-
-// Bitwise Checking functions
-function IsBitOn( value : integer; bit : Byte ) : boolean;
-
-function TurnBitOn( value : integer; bit : Byte ) : integer;
-
-function TurnBitOff( value : integer; bit : Byte ) : integer;
-
-implementation
-
-{$IFDEF __GPC__}
- {$L 'sdl'} { link sdl.dll.a or libsdl.so or libsdl.a }
-{$ENDIF}
-
-function SDL_TABLESIZE(table: PChar): Integer;
-begin
- Result := SizeOf(table) div SizeOf(table[0]);
-end;
-
-procedure SDL_OutOfMemory;
-begin
- {$IFNDEF WINDOWS}
- SDL_Error(SDL_ENOMEM);
- {$ENDIF}
-end;
-
-function SDL_RWSeek(context: PSDL_RWops; offset: Integer; whence: Integer) : Integer;
-begin
- Result := context^.seek(context, offset, whence);
-end;
-
-function SDL_RWTell(context: PSDL_RWops): Integer;
-begin
- Result := context^.seek(context, 0, 1);
-end;
-
-function SDL_RWRead(context: PSDL_RWops; ptr: Pointer; size: Integer; n: Integer): Integer;
-begin
- Result := context^.read(context, ptr, size, n);
-end;
-
-function SDL_RWWrite(context: PSDL_RWops; ptr: Pointer; size: Integer; n: Integer): Integer;
-begin
- Result := context^.write(context, ptr, size, n);
-end;
-
-function SDL_RWClose(context: PSDL_RWops): Integer;
-begin
- Result := context^.close(context);
-end;
-
-function SDL_LoadWAV(filename: PChar; spec: PSDL_AudioSpec; audio_buf: PUInt8; audiolen: PUInt32): PSDL_AudioSpec;
-begin
- Result := SDL_LoadWAV_RW(SDL_RWFromFile(filename, 'rb'), 1, spec, audio_buf, audiolen);
-end;
-
-function SDL_CDInDrive( status : TSDL_CDStatus ): LongBool;
-begin
- Result := ord( status ) > ord( CD_ERROR );
-end;
-
-procedure FRAMES_TO_MSF(frames: Integer; var M: Integer; var S: Integer; var
- F: Integer);
-var
- value: Integer;
-begin
- value := frames;
- F := value mod CD_FPS;
- value := value div CD_FPS;
- S := value mod 60;
- value := value div 60;
- M := value;
-end;
-
-function MSF_TO_FRAMES(M: Integer; S: Integer; F: Integer): Integer;
-begin
- Result := M * 60 * CD_FPS + S * CD_FPS + F;
-end;
-
-procedure SDL_VERSION(var X: TSDL_Version);
-begin
- X.major := SDL_MAJOR_VERSION;
- X.minor := SDL_MINOR_VERSION;
- X.patch := SDL_PATCHLEVEL;
-end;
-
-function SDL_VERSIONNUM(X, Y, Z: Integer): Integer;
-begin
- Result := X * 1000 + Y * 100 + Z;
-end;
-
-function SDL_COMPILEDVERSION: Integer;
-begin
- Result := SDL_VERSIONNUM(SDL_MAJOR_VERSION, SDL_MINOR_VERSION, SDL_PATCHLEVEL
- );
-end;
-
-function SDL_VERSION_ATLEAST(X, Y, Z: Integer): LongBool;
-begin
- Result := (SDL_COMPILEDVERSION >= SDL_VERSIONNUM(X, Y, Z));
-end;
-
-function SDL_LoadBMP(filename: PChar): PSDL_Surface;
-begin
- Result := SDL_LoadBMP_RW(SDL_RWFromFile(filename, 'rb'), 1);
-end;
-
-function SDL_SaveBMP(surface: PSDL_Surface; filename: PChar): Integer;
-begin
- Result := SDL_SaveBMP_RW(surface, SDL_RWFromFile(filename, 'wb'), 1);
-end;
-
-function SDL_BlitSurface(src: PSDL_Surface; srcrect: PSDL_Rect; dst:
- PSDL_Surface;
- dstrect: PSDL_Rect): Integer;
-begin
- Result := SDL_UpperBlit(src, srcrect, dst, dstrect);
-end;
-
-function SDL_AllocSurface(flags: UInt32; width, height, depth: Integer;
- RMask, GMask, BMask, AMask: UInt32): PSDL_Surface;
-begin
- Result := SDL_CreateRGBSurface(flags, width, height, depth, RMask, GMask,
- BMask, AMask);
-end;
-
-function SDL_MustLock(Surface: PSDL_Surface): Boolean;
-begin
- Result := ( ( surface^.offset <> 0 ) or
- ( ( surface^.flags and ( SDL_HWSURFACE or SDL_ASYNCBLIT or SDL_RLEACCEL ) ) <> 0 ) );
-end;
-
-function SDL_LockMutex(mutex: PSDL_mutex): Integer;
-begin
- Result := SDL_mutexP(mutex);
-end;
-
-function SDL_UnlockMutex(mutex: PSDL_mutex): Integer;
-begin
- Result := SDL_mutexV(mutex);
-end;
-
-{$IFDEF WINDOWS}
-function _putenv( const variable : Pchar ): Integer;
-cdecl; external {$IFDEF __GPC__}name '_putenv'{$ELSE} 'MSVCRT.DLL'{$ENDIF __GPC__};
-{$ENDIF}
-
-
-function SDL_putenv(const variable: PChar): Integer;
-begin
- {$IFDEF WINDOWS}
- Result := _putenv(variable);
- {$ENDIF}
-
- {$IFDEF UNIX}
- {$IFDEF FPC}
- Result := _putenv(variable);
- {$ELSE}
- Result := libc.putenv(variable);
- {$ENDIF}
- {$ENDIF}
-end;
-
-{$IFDEF WINDOWS}
-{$IFNDEF __GPC__}
-function getenv( const name : Pchar ): PChar;
-cdecl; external {$IFDEF __GPC__}name 'getenv'{$ELSE} 'MSVCRT.DLL'{$ENDIF};
-{$ENDIF}
-{$ENDIF}
-
-function SDL_getenv(const name: PChar): PChar;
-begin
- {$IFDEF WINDOWS}
-
- {$IFDEF __GPC__}
- Result := getenv( string( name ) );
- {$ELSE}
- Result := getenv( name );
- {$ENDIF}
-
- {$ELSE}
-
- {$IFDEF UNIX}
-
- {$IFDEF FPC}
- Result := fpgetenv(name);
- {$ELSE}
- Result := libc.getenv(name);
- {$ENDIF}
-
- {$ENDIF}
-
- {$ENDIF}
-end;
-
-function SDL_BUTTON( Button : Integer ) : Integer;
-begin
- Result := SDL_PRESSED shl ( Button - 1 );
-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;
-
-procedure FreeAndNil(var Obj);
-{$IFNDEF __GPC__}
-{$IFNDEF __TMT__}
-var
- Temp: TObject;
-{$ENDIF}
-{$ENDIF}
-begin
-{$IFNDEF __GPC__}
-{$IFNDEF __TMT__}
- Temp := TObject(Obj);
- Pointer(Obj) := nil;
- Temp.Free;
-{$ENDIF}
-{$ENDIF}
-end;
-
-{ Exit procedure handling }
-type
- PExitProcInfo = ^TExitProcInfo;
- TExitProcInfo = record
- Next: PExitProcInfo;
- SaveExit: Pointer;
- Proc: TProcedure;
- end;
-
-var
- ExitProcList: PExitProcInfo = nil;
-
-procedure DoExitProc;
-var
- P: PExitProcInfo;
- Proc: TProcedure;
-begin
- P := ExitProcList;
- ExitProcList := P^.Next;
- ExitProc := P^.SaveExit;
- Proc := P^.Proc;
- Dispose(P);
- Proc;
-end;
-
-procedure AddExitProc(Proc: TProcedure);
-var
- P: PExitProcInfo;
-begin
- New(P);
- P^.Next := ExitProcList;
- P^.SaveExit := ExitProc;
- P^.Proc := Proc;
- ExitProcList := P;
- ExitProc := @DoExitProc;
-end;
-
-function IsBitOn( value : integer; bit : Byte ) : boolean;
-begin
- result := ( ( value and ( 1 shl bit ) ) <> 0 );
-end;
-
-function TurnBitOn( value : integer; bit : Byte ) : integer;
-begin
- result := ( value or ( 1 shl bit ) );
-end;
-
-function TurnBitOff( value : integer; bit : Byte ) : integer;
-begin
- result := ( value and not ( 1 shl bit ) );
-end;
-
-end.
-
-
diff --git a/src/lib/JEDI-SDL/SDL/Pas/sdl_cpuinfo.pas b/src/lib/JEDI-SDL/SDL/Pas/sdl_cpuinfo.pas
deleted file mode 100644
index b09f19f9..00000000
--- a/src/lib/JEDI-SDL/SDL/Pas/sdl_cpuinfo.pas
+++ /dev/null
@@ -1,155 +0,0 @@
-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/src/lib/JEDI-SDL/SDL/Pas/sdlgameinterface.pas b/src/lib/JEDI-SDL/SDL/Pas/sdlgameinterface.pas
deleted file mode 100644
index 9a58ff40..00000000
--- a/src/lib/JEDI-SDL/SDL/Pas/sdlgameinterface.pas
+++ /dev/null
@@ -1,202 +0,0 @@
-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/src/lib/JEDI-SDL/SDL/Pas/sdli386utils.pas b/src/lib/JEDI-SDL/SDL/Pas/sdli386utils.pas
deleted file mode 100644
index 4de4ebee..00000000
--- a/src/lib/JEDI-SDL/SDL/Pas/sdli386utils.pas
+++ /dev/null
@@ -1,5236 +0,0 @@
-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/src/lib/JEDI-SDL/SDL/Pas/sdlinput.pas b/src/lib/JEDI-SDL/SDL/Pas/sdlinput.pas
deleted file mode 100644
index 094f4e0f..00000000
--- a/src/lib/JEDI-SDL/SDL/Pas/sdlinput.pas
+++ /dev/null
@@ -1,923 +0,0 @@
-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/src/lib/JEDI-SDL/SDL/Pas/sdlstreams.pas b/src/lib/JEDI-SDL/SDL/Pas/sdlstreams.pas
deleted file mode 100644
index 8ba3946f..00000000
--- a/src/lib/JEDI-SDL/SDL/Pas/sdlstreams.pas
+++ /dev/null
@@ -1,216 +0,0 @@
-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/src/lib/JEDI-SDL/SDL/Pas/sdlticks.pas b/src/lib/JEDI-SDL/SDL/Pas/sdlticks.pas
deleted file mode 100644
index a479b493..00000000
--- a/src/lib/JEDI-SDL/SDL/Pas/sdlticks.pas
+++ /dev/null
@@ -1,197 +0,0 @@
-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/src/lib/JEDI-SDL/SDL/Pas/sdlutils.pas b/src/lib/JEDI-SDL/SDL/Pas/sdlutils.pas
deleted file mode 100644
index e01f3cdb..00000000
--- a/src/lib/JEDI-SDL/SDL/Pas/sdlutils.pas
+++ /dev/null
@@ -1,4363 +0,0 @@
-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/src/lib/JEDI-SDL/SDL/Pas/sdlwindow.pas b/src/lib/JEDI-SDL/SDL/Pas/sdlwindow.pas
deleted file mode 100644
index 99eea304..00000000
--- a/src/lib/JEDI-SDL/SDL/Pas/sdlwindow.pas
+++ /dev/null
@@ -1,566 +0,0 @@
-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/src/lib/JEDI-SDL/SDL/Pas/userpreferences.pas b/src/lib/JEDI-SDL/SDL/Pas/userpreferences.pas
deleted file mode 100644
index aed326d1..00000000
--- a/src/lib/JEDI-SDL/SDL/Pas/userpreferences.pas
+++ /dev/null
@@ -1,159 +0,0 @@
-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/src/lib/JEDI-SDL/SDL_Image/Pas/sdl_image.pas b/src/lib/JEDI-SDL/SDL_Image/Pas/sdl_image.pas
deleted file mode 100644
index 4468f036..00000000
--- a/src/lib/JEDI-SDL/SDL_Image/Pas/sdl_image.pas
+++ /dev/null
@@ -1,350 +0,0 @@
-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/src/lib/SQLite/SQLite3.pas b/src/lib/SQLite/SQLite3.pas
deleted file mode 100644
index 7b7207c4..00000000
--- a/src/lib/SQLite/SQLite3.pas
+++ /dev/null
@@ -1,253 +0,0 @@
-unit SQLite3;
-
-{
- Simplified interface for SQLite.
- Updated for Sqlite 3 by Tim Anderson (tim@itwriting.com)
- Note: NOT COMPLETE for version 3, just minimal functionality
- Adapted from file created by Pablo Pissanetzky (pablo@myhtpc.net)
- which was based on SQLite.pas by Ben Hochstrasser (bhoc@surfeu.ch)
-}
-
-{$IFDEF FPC}
- {$MODE DELPHI}
- {$H+} (* use long strings *)
- {$PACKENUM 4} (* use 4-byte enums *)
- {$PACKRECORDS C} (* C/C++-compatible record packing *)
-{$ELSE}
- {$MINENUMSIZE 4} (* use 4-byte enums *)
-{$ENDIF}
-
-interface
-
-const
-{$IF Defined(MSWINDOWS)}
- SQLiteDLL = 'sqlite3.dll';
-{$ELSEIF Defined(DARWIN)}
- SQLiteDLL = 'libsqlite3.dylib';
- {$linklib libsqlite3}
-{$ELSEIF Defined(UNIX)}
- SQLiteDLL = 'sqlite3.so';
-{$IFEND}
-
-// Return values for sqlite3_exec() and sqlite3_step()
-
-const
- SQLITE_OK = 0; // Successful result
- (* beginning-of-error-codes *)
- SQLITE_ERROR = 1; // SQL error or missing database
- SQLITE_INTERNAL = 2; // An internal logic error in SQLite
- SQLITE_PERM = 3; // Access permission denied
- SQLITE_ABORT = 4; // Callback routine requested an abort
- SQLITE_BUSY = 5; // The database file is locked
- SQLITE_LOCKED = 6; // A table in the database is locked
- SQLITE_NOMEM = 7; // A malloc() failed
- SQLITE_READONLY = 8; // Attempt to write a readonly database
- SQLITE_INTERRUPT = 9; // Operation terminated by sqlite3_interrupt()
- SQLITE_IOERR = 10; // Some kind of disk I/O error occurred
- SQLITE_CORRUPT = 11; // The database disk image is malformed
- SQLITE_NOTFOUND = 12; // (Internal Only) Table or record not found
- SQLITE_FULL = 13; // Insertion failed because database is full
- SQLITE_CANTOPEN = 14; // Unable to open the database file
- SQLITE_PROTOCOL = 15; // Database lock protocol error
- SQLITE_EMPTY = 16; // Database is empty
- SQLITE_SCHEMA = 17; // The database schema changed
- SQLITE_TOOBIG = 18; // Too much data for one row of a table
- SQLITE_CONSTRAINT = 19; // Abort due to contraint violation
- SQLITE_MISMATCH = 20; // Data type mismatch
- SQLITE_MISUSE = 21; // Library used incorrectly
- SQLITE_NOLFS = 22; // Uses OS features not supported on host
- SQLITE_AUTH = 23; // Authorization denied
- SQLITE_FORMAT = 24; // Auxiliary database format error
- SQLITE_RANGE = 25; // 2nd parameter to sqlite3_bind out of range
- SQLITE_NOTADB = 26; // File opened that is not a database file
- SQLITE_ROW = 100; // sqlite3_step() has another row ready
- SQLITE_DONE = 101; // sqlite3_step() has finished executing
-
- SQLITE_INTEGER = 1;
- SQLITE_FLOAT = 2;
- SQLITE_TEXT = 3;
- SQLITE_BLOB = 4;
- SQLITE_NULL = 5;
-
- SQLITE_UTF8 = 1;
- SQLITE_UTF16 = 2;
- SQLITE_UTF16BE = 3;
- SQLITE_UTF16LE = 4;
- SQLITE_ANY = 5;
-
- SQLITE_STATIC {: TSQLite3Destructor} = Pointer(0);
- SQLITE_TRANSIENT {: TSQLite3Destructor} = Pointer(-1);
-
-type
- TSQLiteDB = Pointer;
- TSQLiteResult = ^PAnsiChar;
- TSQLiteStmt = Pointer;
-
-type
- PPAnsiCharArray = ^TPAnsiCharArray;
- TPAnsiCharArray = array[0 .. (MaxInt div SizeOf(PAnsiChar))-1] of PAnsiChar;
-
-type
- TSQLiteExecCallback = function(UserData: Pointer; NumCols: integer; ColValues:
- PPAnsiCharArray; ColNames: PPAnsiCharArray): integer; cdecl;
- TSQLiteBusyHandlerCallback = function(UserData: Pointer; P2: integer): integer; cdecl;
-
- //function prototype for define own collate
- TCollateXCompare = function(UserData: pointer; Buf1Len: integer; Buf1: pointer;
- Buf2Len: integer; Buf2: pointer): integer; cdecl;
-
-
-function SQLite3_Open(filename: PAnsiChar; out db: TSQLiteDB): integer; cdecl; external SQLiteDLL name 'sqlite3_open';
-function SQLite3_Close(db: TSQLiteDB): integer; cdecl; external SQLiteDLL name 'sqlite3_close';
-function SQLite3_Exec(db: TSQLiteDB; SQLStatement: PAnsiChar; CallbackPtr: TSQLiteExecCallback; UserData: Pointer; var ErrMsg: PAnsiChar): integer; cdecl; external SQLiteDLL name 'sqlite3_exec';
-function SQLite3_Version(): PAnsiChar; cdecl; external SQLiteDLL name 'sqlite3_libversion';
-function SQLite3_ErrMsg(db: TSQLiteDB): PAnsiChar; cdecl; external SQLiteDLL name 'sqlite3_errmsg';
-function SQLite3_ErrCode(db: TSQLiteDB): integer; cdecl; external SQLiteDLL name 'sqlite3_errcode';
-procedure SQlite3_Free(P: PAnsiChar); cdecl; external SQLiteDLL name 'sqlite3_free';
-function SQLite3_GetTable(db: TSQLiteDB; SQLStatement: PAnsiChar; var ResultPtr: TSQLiteResult; var RowCount: Cardinal; var ColCount: Cardinal; var ErrMsg: PAnsiChar): integer; cdecl; external SQLiteDLL name 'sqlite3_get_table';
-procedure SQLite3_FreeTable(Table: TSQLiteResult); cdecl; external SQLiteDLL name 'sqlite3_free_table';
-function SQLite3_Complete(P: PAnsiChar): boolean; cdecl; external SQLiteDLL name 'sqlite3_complete';
-function SQLite3_LastInsertRowID(db: TSQLiteDB): int64; cdecl; external SQLiteDLL name 'sqlite3_last_insert_rowid';
-procedure SQLite3_Interrupt(db: TSQLiteDB); cdecl; external SQLiteDLL name 'sqlite3_interrupt';
-procedure SQLite3_BusyHandler(db: TSQLiteDB; CallbackPtr: TSQLiteBusyHandlerCallback; UserData: Pointer); cdecl; external SQLiteDLL name 'sqlite3_busy_handler';
-procedure SQLite3_BusyTimeout(db: TSQLiteDB; TimeOut: integer); cdecl; external SQLiteDLL name 'sqlite3_busy_timeout';
-function SQLite3_Changes(db: TSQLiteDB): integer; cdecl; external SQLiteDLL name 'sqlite3_changes';
-function SQLite3_TotalChanges(db: TSQLiteDB): integer; cdecl; external SQLiteDLL name 'sqlite3_total_changes';
-function SQLite3_Prepare(db: TSQLiteDB; SQLStatement: PAnsiChar; nBytes: integer; out hStmt: TSqliteStmt; out pzTail: PAnsiChar): integer; cdecl; external SQLiteDLL name 'sqlite3_prepare';
-function SQLite3_Prepare_v2(db: TSQLiteDB; SQLStatement: PAnsiChar; nBytes: integer; out hStmt: TSqliteStmt; out pzTail: PAnsiChar): integer; cdecl; external SQLiteDLL name 'sqlite3_prepare_v2';
-function SQLite3_ColumnCount(hStmt: TSqliteStmt): integer; cdecl; external SQLiteDLL name 'sqlite3_column_count';
-function SQLite3_ColumnName(hStmt: TSqliteStmt; ColNum: integer): PAnsiChar; cdecl; external SQLiteDLL name 'sqlite3_column_name';
-function SQLite3_ColumnDeclType(hStmt: TSqliteStmt; ColNum: integer): PAnsiChar; cdecl; external SQLiteDLL name 'sqlite3_column_decltype';
-function SQLite3_Step(hStmt: TSqliteStmt): integer; cdecl; external SQLiteDLL name 'sqlite3_step';
-function SQLite3_DataCount(hStmt: TSqliteStmt): integer; cdecl; external SQLiteDLL name 'sqlite3_data_count';
-
-function SQLite3_ColumnBlob(hStmt: TSqliteStmt; ColNum: integer): pointer; cdecl; external SQLiteDLL name 'sqlite3_column_blob';
-function SQLite3_ColumnBytes(hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external SQLiteDLL name 'sqlite3_column_bytes';
-function SQLite3_ColumnDouble(hStmt: TSqliteStmt; ColNum: integer): double; cdecl; external SQLiteDLL name 'sqlite3_column_double';
-function SQLite3_ColumnInt(hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external SQLiteDLL name 'sqlite3_column_int';
-function SQLite3_ColumnText(hStmt: TSqliteStmt; ColNum: integer): PAnsiChar; cdecl; external SQLiteDLL name 'sqlite3_column_text';
-function SQLite3_ColumnType(hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external SQLiteDLL name 'sqlite3_column_type';
-function SQLite3_ColumnInt64(hStmt: TSqliteStmt; ColNum: integer): Int64; cdecl; external SQLiteDLL name 'sqlite3_column_int64';
-function SQLite3_Finalize(hStmt: TSqliteStmt): integer; cdecl; external SQLiteDLL name 'sqlite3_finalize';
-function SQLite3_Reset(hStmt: TSqliteStmt): integer; cdecl; external SQLiteDLL name 'sqlite3_reset';
-
-//
-// In the SQL strings input to sqlite3_prepare() and sqlite3_prepare16(),
-// one or more literals can be replace by a wildcard "?" or ":N:" where
-// N is an integer. These value of these wildcard literals can be set
-// using the routines listed below.
-//
-// In every case, the first parameter is a pointer to the sqlite3_stmt
-// structure returned from sqlite3_prepare(). The second parameter is the
-// index of the wildcard. The first "?" has an index of 1. ":N:" wildcards
-// use the index N.
-//
-// The fifth parameter to sqlite3_bind_blob(), sqlite3_bind_text(), and
-//sqlite3_bind_text16() is a destructor used to dispose of the BLOB or
-//text after SQLite has finished with it. If the fifth argument is the
-// special value SQLITE_STATIC, then the library assumes that the information
-// is in static, unmanaged space and does not need to be freed. If the
-// fifth argument has the value SQLITE_TRANSIENT, then SQLite makes its
-// own private copy of the data.
-//
-// The sqlite3_bind_* routine must be called before sqlite3_step() after
-// an sqlite3_prepare() or sqlite3_reset(). Unbound wildcards are interpreted
-// as NULL.
-//
-
-type
- TSQLite3Destructor = procedure(Ptr: Pointer); cdecl;
-
-function sqlite3_bind_blob(hStmt: TSqliteStmt; ParamNum: integer;
- ptrData: pointer; numBytes: integer; ptrDestructor: TSQLite3Destructor): integer;
-cdecl; external SQLiteDLL name 'sqlite3_bind_blob';
-function sqlite3_bind_text(hStmt: TSqliteStmt; ParamNum: integer;
- Text: PAnsiChar; numBytes: integer; ptrDestructor: TSQLite3Destructor): integer;
-cdecl; external SQLiteDLL name 'sqlite3_bind_text';
-function sqlite3_bind_double(hStmt: TSqliteStmt; ParamNum: integer; Data: Double): integer;
- cdecl; external SQLiteDLL name 'sqlite3_bind_double';
-function sqlite3_bind_int(hStmt: TSqLiteStmt; ParamNum: integer; Data: integer): integer;
- cdecl; external SQLiteDLL name 'sqlite3_bind_int';
-function sqlite3_bind_int64(hStmt: TSqliteStmt; ParamNum: integer; Data: int64): integer;
- cdecl; external SQLiteDLL name 'sqlite3_bind_int64';
-function sqlite3_bind_null(hStmt: TSqliteStmt; ParamNum: integer): integer;
- cdecl; external SQLiteDLL name 'sqlite3_bind_null';
-
-function sqlite3_bind_parameter_index(hStmt: TSqliteStmt; zName: PAnsiChar): integer;
- cdecl; external SQLiteDLL name 'sqlite3_bind_parameter_index';
-
-function sqlite3_enable_shared_cache(Value: integer): integer; cdecl; external SQLiteDLL name 'sqlite3_enable_shared_cache';
-
-//user collate definiton
-function SQLite3_create_collation(db: TSQLiteDB; Name: PAnsiChar; eTextRep: integer;
- UserData: pointer; xCompare: TCollateXCompare): integer; cdecl; external SQLiteDLL name 'sqlite3_create_collation';
-
-function SQLiteFieldType(SQLiteFieldTypeCode: Integer): AnsiString;
-function SQLiteErrorStr(SQLiteErrorCode: Integer): AnsiString;
-
-implementation
-
-uses
- SysUtils;
-
-function SQLiteFieldType(SQLiteFieldTypeCode: Integer): AnsiString;
-begin
- case SQLiteFieldTypeCode of
- SQLITE_INTEGER: Result := 'Integer';
- SQLITE_FLOAT: Result := 'Float';
- SQLITE_TEXT: Result := 'Text';
- SQLITE_BLOB: Result := 'Blob';
- SQLITE_NULL: Result := 'Null';
- else
- Result := 'Unknown SQLite Field Type Code "' + IntToStr(SQLiteFieldTypeCode) + '"';
- end;
-end;
-
-function SQLiteErrorStr(SQLiteErrorCode: Integer): AnsiString;
-begin
- case SQLiteErrorCode of
- SQLITE_OK: Result := 'Successful result';
- SQLITE_ERROR: Result := 'SQL error or missing database';
- SQLITE_INTERNAL: Result := 'An internal logic error in SQLite';
- SQLITE_PERM: Result := 'Access permission denied';
- SQLITE_ABORT: Result := 'Callback routine requested an abort';
- SQLITE_BUSY: Result := 'The database file is locked';
- SQLITE_LOCKED: Result := 'A table in the database is locked';
- SQLITE_NOMEM: Result := 'A malloc() failed';
- SQLITE_READONLY: Result := 'Attempt to write a readonly database';
- SQLITE_INTERRUPT: Result := 'Operation terminated by sqlite3_interrupt()';
- SQLITE_IOERR: Result := 'Some kind of disk I/O error occurred';
- SQLITE_CORRUPT: Result := 'The database disk image is malformed';
- SQLITE_NOTFOUND: Result := '(Internal Only) Table or record not found';
- SQLITE_FULL: Result := 'Insertion failed because database is full';
- SQLITE_CANTOPEN: Result := 'Unable to open the database file';
- SQLITE_PROTOCOL: Result := 'Database lock protocol error';
- SQLITE_EMPTY: Result := 'Database is empty';
- SQLITE_SCHEMA: Result := 'The database schema changed';
- SQLITE_TOOBIG: Result := 'Too much data for one row of a table';
- SQLITE_CONSTRAINT: Result := 'Abort due to contraint violation';
- SQLITE_MISMATCH: Result := 'Data type mismatch';
- SQLITE_MISUSE: Result := 'Library used incorrectly';
- SQLITE_NOLFS: Result := 'Uses OS features not supported on host';
- SQLITE_AUTH: Result := 'Authorization denied';
- SQLITE_FORMAT: Result := 'Auxiliary database format error';
- SQLITE_RANGE: Result := '2nd parameter to sqlite3_bind out of range';
- SQLITE_NOTADB: Result := 'File opened that is not a database file';
- SQLITE_ROW: Result := 'sqlite3_step() has another row ready';
- SQLITE_DONE: Result := 'sqlite3_step() has finished executing';
- else
- Result := 'Unknown SQLite Error Code "' + IntToStr(SQLiteErrorCode) + '"';
- end;
-end;
-
-function ColValueToStr(Value: PAnsiChar): AnsiString;
-begin
- if (Value = nil) then
- Result := 'NULL'
- else
- Result := Value;
-end;
-
-
-end.
-
diff --git a/src/lib/SQLite/SQLiteTable3.pas b/src/lib/SQLite/SQLiteTable3.pas
deleted file mode 100644
index 3aed54a4..00000000
--- a/src/lib/SQLite/SQLiteTable3.pas
+++ /dev/null
@@ -1,1500 +0,0 @@
-unit SQLiteTable3;
-
-{
- Simple classes for using SQLite's exec and get_table.
-
- TSQLiteDatabase wraps the calls to open and close an SQLite database.
- It also wraps SQLite_exec for queries that do not return a result set
-
- TSQLiteTable wraps execution of SQL query.
- It run query and read all returned rows to internal buffer.
- It allows accessing fields by name as well as index and can move through a
- result set forward and backwards, or randomly to any row.
-
- TSQLiteUniTable wraps execution of SQL query.
- It run query as TSQLiteTable, but reading just first row only!
- You can step to next row (until not EOF) by 'Next' method.
- You cannot step backwards! (So, it is called as UniDirectional result set.)
- It not using any internal buffering, this class is very close to Sqlite API.
- It allows accessing fields by name as well as index on actual row only.
- Very good and fast for sequentional scanning of large result sets with minimal
- memory footprint.
-
- Warning! Do not close TSQLiteDatabase before any TSQLiteUniTable,
- because query is closed on TSQLiteUniTable destructor and database connection
- is used during TSQLiteUniTable live!
-
- SQL parameter usage:
- You can add named parameter values by call set of AddParam* methods.
- Parameters will be used for first next SQL statement only.
- Parameter name must be prefixed by ':', '$' or '@' and same prefix must be
- used in SQL statement!
- Sample:
- table.AddParamText(':str', 'some value');
- s := table.GetTableString('SELECT value FROM sometable WHERE id=:str');
-
- Notes from Andrew Retmanski on prepared queries
- The changes are as follows:
-
- SQLiteTable3.pas
- - Added new boolean property Synchronised (this controls the SYNCHRONOUS pragma as I found that turning this OFF increased the write performance in my application)
- - Added new type TSQLiteQuery (this is just a simple record wrapper around the SQL string and a TSQLiteStmt pointer)
- - Added PrepareSQL method to prepare SQL query - returns TSQLiteQuery
- - Added ReleaseSQL method to release previously prepared query
- - Added overloaded BindSQL methods for Integer and String types - these set new values for the prepared query parameters
- - Added overloaded ExecSQL method to execute a prepared TSQLiteQuery
-
- Usage of the new methods should be self explanatory but the process is in essence:
-
- 1. Call PrepareSQL to return TSQLiteQuery 2. Call BindSQL for each parameter in the prepared query 3. Call ExecSQL to run the prepared query 4. Repeat steps 2 & 3 as required 5. Call ReleaseSQL to free SQLite resources
-
- One other point - the Synchronised property throws an error if used inside a transaction.
-
- Acknowledments
- Adapted by Tim Anderson (tim@itwriting.com)
- Originally created by Pablo Pissanetzky (pablo@myhtpc.net)
- Modified and enhanced by Lukas Gebauer
- Modified and enhanced by Tobias Gunkel
-}
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}{$H+}
-{$ENDIF}
-
-uses
- {$IFDEF MSWINDOWS}
- Windows,
- {$ENDIF}
- SQLite3, Classes, SysUtils;
-
-const
-
- dtInt = 1;
- dtNumeric = 2;
- dtStr = 3;
- dtBlob = 4;
- dtNull = 5;
-
-type
-
- ESQLiteException = class(Exception)
- end;
-
- TSQliteParam = class
- public
- name: string;
- valuetype: integer;
- valueinteger: int64;
- valuefloat: double;
- valuedata: string;
- end;
-
- THookQuery = procedure(Sender: TObject; SQL: String) of object;
-
- TSQLiteQuery = record
- SQL: String;
- Statement: TSQLiteStmt;
- end;
-
- TSQLiteTable = class;
- TSQLiteUniTable = class;
-
- TSQLiteDatabase = class
- private
- fDB: TSQLiteDB;
- fInTrans: boolean;
- fSync: boolean;
- fParams: TList;
- FOnQuery: THookQuery;
- procedure RaiseError(s: string; SQL: string);
- procedure SetParams(Stmt: TSQLiteStmt);
- procedure BindData(Stmt: TSQLiteStmt; const Bindings: array of const);
- function GetRowsChanged: integer;
- protected
- procedure SetSynchronised(Value: boolean);
- procedure DoQuery(value: string);
- public
- constructor Create(const FileName: string);
- destructor Destroy; override;
- function GetTable(const SQL: Ansistring): TSQLiteTable; overload;
- function GetTable(const SQL: Ansistring; const Bindings: array of const): TSQLiteTable; overload;
- procedure ExecSQL(const SQL: Ansistring); overload;
- procedure ExecSQL(const SQL: Ansistring; const Bindings: array of const); overload;
- procedure ExecSQL(Query: TSQLiteQuery); overload;
- function PrepareSQL(const SQL: Ansistring): TSQLiteQuery;
- procedure BindSQL(Query: TSQLiteQuery; const Index: Integer; const Value: Integer); overload;
- procedure BindSQL(Query: TSQLiteQuery; const Index: Integer; const Value: String); overload;
- procedure ReleaseSQL(Query: TSQLiteQuery);
- function GetUniTable(const SQL: Ansistring): TSQLiteUniTable; overload;
- function GetUniTable(const SQL: Ansistring; const Bindings: array of const): TSQLiteUniTable; overload;
- function GetTableValue(const SQL: Ansistring): int64; overload;
- function GetTableValue(const SQL: Ansistring; const Bindings: array of const): int64; overload;
- function GetTableString(const SQL: Ansistring): string; overload;
- function GetTableString(const SQL: Ansistring; const Bindings: array of const): string; overload;
- procedure GetTableStrings(const SQL: Ansistring; const Value: TStrings);
- procedure UpdateBlob(const SQL: Ansistring; BlobData: TStream);
- procedure BeginTransaction;
- procedure Commit;
- procedure Rollback;
- function TableExists(TableName: string): boolean;
- function ContainsColumn(Table: String; Column: String) : boolean;
- function GetLastInsertRowID: int64;
- function GetLastChangedRows: int64;
- procedure SetTimeout(Value: integer);
- function Version: string;
- procedure AddCustomCollate(name: string; xCompare: TCollateXCompare);
- //adds collate named SYSTEM for correct data sorting by user's locale
- Procedure AddSystemCollate;
- procedure ParamsClear;
- procedure AddParamInt(name: string; value: int64);
- procedure AddParamFloat(name: string; value: double);
- procedure AddParamText(name: string; value: string);
- procedure AddParamNull(name: string);
- property DB: TSQLiteDB read fDB;
- published
- property IsTransactionOpen: boolean read fInTrans;
- //database rows that were changed (or inserted or deleted) by the most recent SQL statement
- property RowsChanged : integer read getRowsChanged;
- property Synchronised: boolean read FSync write SetSynchronised;
- property OnQuery: THookQuery read FOnQuery write FOnQuery;
- end;
-
- TSQLiteTable = class
- private
- fResults: TList;
- fRowCount: cardinal;
- fColCount: cardinal;
- fCols: TStringList;
- fColTypes: TList;
- fRow: cardinal;
- function GetFields(I: cardinal): string;
- function GetEOF: boolean;
- function GetBOF: boolean;
- function GetColumns(I: integer): string;
- function GetFieldByName(FieldName: string): string;
- function GetFieldIndex(FieldName: string): integer;
- function GetCount: integer;
- function GetCountResult: integer;
- public
- constructor Create(DB: TSQLiteDatabase; const SQL: Ansistring); overload;
- constructor Create(DB: TSQLiteDatabase; const SQL: Ansistring; const Bindings: array of const); overload;
- destructor Destroy; override;
- function FieldAsInteger(I: cardinal): int64;
- function FieldAsBlob(I: cardinal): TMemoryStream;
- function FieldAsBlobText(I: cardinal): string;
- function FieldIsNull(I: cardinal): boolean;
- function FieldAsString(I: cardinal): string;
- function FieldAsDouble(I: cardinal): double;
- function Next: boolean;
- function Previous: boolean;
- property EOF: boolean read GetEOF;
- property BOF: boolean read GetBOF;
- property Fields[I: cardinal]: string read GetFields;
- property FieldByName[FieldName: string]: string read GetFieldByName;
- property FieldIndex[FieldName: string]: integer read GetFieldIndex;
- property Columns[I: integer]: string read GetColumns;
- property ColCount: cardinal read fColCount;
- property RowCount: cardinal read fRowCount;
- property Row: cardinal read fRow;
- function MoveFirst: boolean;
- function MoveLast: boolean;
- function MoveTo(position: cardinal): boolean;
- property Count: integer read GetCount;
- // The property CountResult is used when you execute count(*) queries.
- // It returns 0 if the result set is empty or the value of the
- // first field as an integer.
- property CountResult: integer read GetCountResult;
- end;
-
- TSQLiteUniTable = class
- private
- fColCount: cardinal;
- fCols: TStringList;
- fRow: cardinal;
- fEOF: boolean;
- fStmt: TSQLiteStmt;
- fDB: TSQLiteDatabase;
- fSQL: string;
- function GetFields(I: cardinal): string;
- function GetColumns(I: integer): string;
- function GetFieldByName(FieldName: string): string;
- function GetFieldIndex(FieldName: string): integer;
- public
- constructor Create(DB: TSQLiteDatabase; const SQL: Ansistring); overload;
- constructor Create(DB: TSQLiteDatabase; const SQL: Ansistring; const Bindings: array of const); overload;
- destructor Destroy; override;
- function FieldAsInteger(I: cardinal): int64;
- function FieldAsBlob(I: cardinal): TMemoryStream;
- function FieldAsBlobPtr(I: cardinal; out iNumBytes: integer): Pointer;
- function FieldAsBlobText(I: cardinal): string;
- function FieldIsNull(I: cardinal): boolean;
- function FieldAsString(I: cardinal): string;
- function FieldAsDouble(I: cardinal): double;
- function Next: boolean;
- property EOF: boolean read FEOF;
- property Fields[I: cardinal]: string read GetFields;
- property FieldByName[FieldName: string]: string read GetFieldByName;
- property FieldIndex[FieldName: string]: integer read GetFieldIndex;
- property Columns[I: integer]: string read GetColumns;
- property ColCount: cardinal read fColCount;
- property Row: cardinal read fRow;
- end;
-
-procedure DisposePointer(ptr: pointer); cdecl;
-
-{$IFDEF MSWINDOWS}
-function SystemCollate(Userdta: pointer; Buf1Len: integer; Buf1: pointer;
- Buf2Len: integer; Buf2: pointer): integer; cdecl;
-{$ENDIF}
-
-implementation
-
-procedure DisposePointer(ptr: pointer); cdecl;
-begin
- if assigned(ptr) then
- freemem(ptr);
-end;
-
-{$IFDEF MSWINDOWS}
-function SystemCollate(Userdta: pointer; Buf1Len: integer; Buf1: pointer;
- Buf2Len: integer; Buf2: pointer): integer; cdecl;
-begin
- Result := CompareStringW(LOCALE_USER_DEFAULT, 0, PWideChar(Buf1), Buf1Len,
- PWideChar(Buf2), Buf2Len) - 2;
-end;
-{$ENDIF}
-
-//------------------------------------------------------------------------------
-// TSQLiteDatabase
-//------------------------------------------------------------------------------
-
-constructor TSQLiteDatabase.Create(const FileName: string);
-var
- Msg: PAnsiChar;
- iResult: integer;
- utf8FileName: UTF8string;
-begin
- inherited Create;
- fParams := TList.Create;
-
- self.fInTrans := False;
-
- Msg := nil;
- try
- utf8FileName := UTF8String(FileName);
- iResult := SQLite3_Open(PAnsiChar(utf8FileName), Fdb);
-
- if iResult <> SQLITE_OK then
- if Assigned(Fdb) then
- begin
- Msg := Sqlite3_ErrMsg(Fdb);
- raise ESqliteException.CreateFmt('Failed to open database "%s" : %s',
- [FileName, Msg]);
- end
- else
- raise ESqliteException.CreateFmt('Failed to open database "%s" : unknown error',
- [FileName]);
-
-//set a few configs
-//L.G. Do not call it here. Because busy handler is not setted here,
-// any share violation causing exception!
-
-// self.ExecSQL('PRAGMA SYNCHRONOUS=NORMAL;');
-// self.ExecSQL('PRAGMA temp_store = MEMORY;');
-
- finally
- if Assigned(Msg) then
- SQLite3_Free(Msg);
- end;
-
-end;
-
-//..............................................................................
-
-destructor TSQLiteDatabase.Destroy;
-begin
- if self.fInTrans then
- self.Rollback; //assume rollback
- if Assigned(fDB) then
- SQLite3_Close(fDB);
- ParamsClear;
- fParams.Free;
- inherited;
-end;
-
-function TSQLiteDatabase.GetLastInsertRowID: int64;
-begin
- Result := Sqlite3_LastInsertRowID(self.fDB);
-end;
-
-function TSQLiteDatabase.GetLastChangedRows: int64;
-begin
- Result := SQLite3_TotalChanges(self.fDB);
-end;
-
-//..............................................................................
-
-procedure TSQLiteDatabase.RaiseError(s: string; SQL: string);
-//look up last error and raise an exception with an appropriate message
-var
- Msg: PAnsiChar;
- ret : integer;
-begin
-
- Msg := nil;
-
- ret := sqlite3_errcode(self.fDB);
- if ret <> SQLITE_OK then
- Msg := sqlite3_errmsg(self.fDB);
-
- if Msg <> nil then
- raise ESqliteException.CreateFmt(s +'.'#13'Error [%d]: %s.'#13'"%s": %s', [ret, SQLiteErrorStr(ret),SQL, Msg])
- else
- raise ESqliteException.CreateFmt(s, [SQL, 'No message']);
-
-end;
-
-procedure TSQLiteDatabase.SetSynchronised(Value: boolean);
-begin
- if Value <> fSync then
- begin
- if Value then
- ExecSQL('PRAGMA synchronous = ON;')
- else
- ExecSQL('PRAGMA synchronous = OFF;');
- fSync := Value;
- end;
-end;
-
-procedure TSQLiteDatabase.BindData(Stmt: TSQLiteStmt; const Bindings: array of const);
-var
- BlobMemStream: TCustomMemoryStream;
- BlobStdStream: TStream;
- DataPtr: Pointer;
- DataSize: integer;
- AnsiStr: AnsiString;
- AnsiStrPtr: PAnsiString;
- I: integer;
-begin
- for I := 0 to High(Bindings) do
- begin
- case Bindings[I].VType of
- vtString,
- vtAnsiString, vtPChar,
- vtWideString, vtPWideChar,
- vtChar, vtWideChar:
- begin
- case Bindings[I].VType of
- vtString: begin // ShortString
- AnsiStr := Bindings[I].VString^;
- DataPtr := PAnsiChar(AnsiStr);
- DataSize := Length(AnsiStr)+1;
- end;
- vtPChar: begin
- DataPtr := Bindings[I].VPChar;
- DataSize := -1;
- end;
- vtAnsiString: begin
- AnsiStrPtr := PAnsiString(@Bindings[I].VAnsiString);
- DataPtr := PAnsiChar(AnsiStrPtr^);
- DataSize := Length(AnsiStrPtr^)+1;
- end;
- vtPWideChar: begin
- AnsiStr := UTF8Encode(WideString(Bindings[I].VPWideChar));
- DataPtr := PAnsiChar(AnsiStr);
- DataSize := -1;
- end;
- vtWideString: begin
- AnsiStr := UTF8Encode(PWideString(@Bindings[I].VWideString)^);
- DataPtr := PAnsiChar(AnsiStr);
- DataSize := -1;
- end;
- vtChar: begin
- AnsiStr := AnsiString(Bindings[I].VChar);
- DataPtr := PAnsiChar(AnsiStr);
- DataSize := 2;
- end;
- vtWideChar: begin
- AnsiStr := UTF8Encode(WideString(Bindings[I].VWideChar));
- DataPtr := PAnsiChar(AnsiStr);
- DataSize := -1;
- end;
- else
- raise ESqliteException.Create('Unknown string-type');
- end;
- if (sqlite3_bind_text(Stmt, I+1, DataPtr, DataSize, SQLITE_STATIC) <> SQLITE_OK) then
- RaiseError('Could not bind text', 'BindData');
- end;
- vtInteger:
- if (sqlite3_bind_int(Stmt, I+1, Bindings[I].VInteger) <> SQLITE_OK) then
- RaiseError('Could not bind integer', 'BindData');
- vtInt64:
- if (sqlite3_bind_int64(Stmt, I+1, Bindings[I].VInt64^) <> SQLITE_OK) then
- RaiseError('Could not bind int64', 'BindData');
- vtExtended:
- if (sqlite3_bind_double(Stmt, I+1, Bindings[I].VExtended^) <> SQLITE_OK) then
- RaiseError('Could not bind extended', 'BindData');
- vtBoolean:
- if (sqlite3_bind_int(Stmt, I+1, Integer(Bindings[I].VBoolean)) <> SQLITE_OK) then
- RaiseError('Could not bind boolean', 'BindData');
- vtPointer:
- begin
- if (Bindings[I].VPointer = nil) then
- begin
- if (sqlite3_bind_null(Stmt, I+1) <> SQLITE_OK) then
- RaiseError('Could not bind null', 'BindData');
- end
- else
- raise ESqliteException.Create('Unhandled pointer (<> nil)');
- end;
- vtObject:
- begin
- if (Bindings[I].VObject is TCustomMemoryStream) then
- begin
- BlobMemStream := TCustomMemoryStream(Bindings[I].VObject);
- if (sqlite3_bind_blob(Stmt, I+1, @PAnsiChar(BlobMemStream.Memory)[BlobMemStream.Position],
- BlobMemStream.Size-BlobMemStream.Position, SQLITE_STATIC) <> SQLITE_OK) then
- begin
- RaiseError('Could not bind BLOB', 'BindData');
- end;
- end
- else if (Bindings[I].VObject is TStream) then
- begin
- BlobStdStream := TStream(Bindings[I].VObject);
- DataSize := BlobStdStream.Size;
-
- GetMem(DataPtr, DataSize);
- if (DataPtr = nil) then
- raise ESqliteException.Create('Error getting memory to save blob');
-
- BlobStdStream.Position := 0;
- BlobStdStream.Read(DataPtr^, DataSize);
-
- if (sqlite3_bind_blob(stmt, I+1, DataPtr, DataSize, @DisposePointer) <> SQLITE_OK) then
- RaiseError('Could not bind BLOB', 'BindData');
- end
- else
- raise ESqliteException.Create('Unhandled object-type in binding');
- end
- else
- begin
- raise ESqliteException.Create('Unhandled binding');
- end;
- end;
- end;
-end;
-
-procedure TSQLiteDatabase.ExecSQL(const SQL: Ansistring);
-begin
- ExecSQL(SQL, []);
-end;
-
-procedure TSQLiteDatabase.ExecSQL(const SQL: Ansistring; const Bindings: array of const);
-var
- Stmt: TSQLiteStmt;
- NextSQLStatement: PAnsiChar;
- iStepResult: integer;
-begin
- try
- if Sqlite3_Prepare_v2(self.fDB, PAnsiChar(SQL), -1, Stmt, NextSQLStatement) <>
- SQLITE_OK then
- RaiseError('Error executing SQL', SQL);
- if (Stmt = nil) then
- RaiseError('Could not prepare SQL statement', SQL);
- DoQuery(SQL);
- SetParams(Stmt);
- BindData(Stmt, Bindings);
-
- iStepResult := Sqlite3_step(Stmt);
- if (iStepResult <> SQLITE_DONE) then
- begin
- SQLite3_reset(stmt);
- RaiseError('Error executing SQL statement', SQL);
- end;
- finally
- if Assigned(Stmt) then
- Sqlite3_Finalize(stmt);
- end;
-end;
-
-procedure TSQLiteDatabase.ExecSQL(Query: TSQLiteQuery);
-var
- iStepResult: integer;
-begin
- if Assigned(Query.Statement) then
- begin
- iStepResult := Sqlite3_step(Query.Statement);
-
- if (iStepResult <> SQLITE_DONE) then
- begin
- SQLite3_reset(Query.Statement);
- RaiseError('Error executing prepared SQL statement', Query.SQL);
- end;
- Sqlite3_Reset(Query.Statement);
- end;
-end;
-
-function TSQLiteDatabase.PrepareSQL(const SQL: Ansistring): TSQLiteQuery;
-var
- Stmt: TSQLiteStmt;
- NextSQLStatement: PAnsiChar;
-begin
- Result.SQL := SQL;
- Result.Statement := nil;
-
- if Sqlite3_Prepare(self.fDB, PAnsiChar(SQL), -1, Stmt, NextSQLStatement) <>
- SQLITE_OK then
- RaiseError('Error executing SQL', SQL)
- else
- Result.Statement := Stmt;
-
- if (Result.Statement = nil) then
- RaiseError('Could not prepare SQL statement', SQL);
- DoQuery(SQL);
-end;
-
-procedure TSQLiteDatabase.BindSQL(Query: TSQLiteQuery; const Index: Integer; const Value: Integer);
-begin
- if Assigned(Query.Statement) then
- sqlite3_Bind_Int(Query.Statement, Index, Value)
- else
- RaiseError('Could not bind integer to prepared SQL statement', Query.SQL);
-end;
-
-procedure TSQLiteDatabase.BindSQL(Query: TSQLiteQuery; const Index: Integer; const Value: String);
-begin
- if Assigned(Query.Statement) then
- Sqlite3_Bind_Text(Query.Statement, Index, PAnsiChar(Value), Length(Value), Pointer(SQLITE_STATIC))
- else
- RaiseError('Could not bind string to prepared SQL statement', Query.SQL);
-end;
-
-procedure TSQLiteDatabase.ReleaseSQL(Query: TSQLiteQuery);
-begin
- if Assigned(Query.Statement) then
- begin
- Sqlite3_Finalize(Query.Statement);
- Query.Statement := nil;
- end
- else
- RaiseError('Could not release prepared SQL statement', Query.SQL);
-end;
-
-procedure TSQLiteDatabase.UpdateBlob(const SQL: Ansistring; BlobData: TStream);
-var
- iSize: integer;
- ptr: pointer;
- Stmt: TSQLiteStmt;
- Msg: PAnsiChar;
- NextSQLStatement: PAnsiChar;
- iStepResult: integer;
- iBindResult: integer;
-begin
- //expects SQL of the form 'UPDATE MYTABLE SET MYFIELD = ? WHERE MYKEY = 1'
- if pos('?', SQL) = 0 then
- RaiseError('SQL must include a ? parameter', SQL);
-
- Msg := nil;
- try
-
- if Sqlite3_Prepare_v2(self.fDB, PAnsiChar(SQL), -1, Stmt, NextSQLStatement) <>
- SQLITE_OK then
- RaiseError('Could not prepare SQL statement', SQL);
-
- if (Stmt = nil) then
- RaiseError('Could not prepare SQL statement', SQL);
- DoQuery(SQL);
-
- //now bind the blob data
- iSize := BlobData.size;
-
- GetMem(ptr, iSize);
-
- if (ptr = nil) then
- raise ESqliteException.CreateFmt('Error getting memory to save blob',
- [SQL, 'Error']);
-
- BlobData.position := 0;
- BlobData.Read(ptr^, iSize);
-
- iBindResult := SQLite3_Bind_Blob(stmt, 1, ptr, iSize, @DisposePointer);
-
- if iBindResult <> SQLITE_OK then
- RaiseError('Error binding blob to database', SQL);
-
- iStepResult := Sqlite3_step(Stmt);
-
- if (iStepResult <> SQLITE_DONE) then
- begin
- SQLite3_reset(stmt);
- RaiseError('Error executing SQL statement', SQL);
- end;
-
- finally
-
- if Assigned(Stmt) then
- Sqlite3_Finalize(stmt);
-
- if Assigned(Msg) then
- SQLite3_Free(Msg);
- end;
-
-end;
-
-//..............................................................................
-
-function TSQLiteDatabase.GetTable(const SQL: Ansistring): TSQLiteTable;
-begin
- Result := TSQLiteTable.Create(Self, SQL);
-end;
-
-function TSQLiteDatabase.GetTable(const SQL: Ansistring; const Bindings: array of const): TSQLiteTable;
-begin
- Result := TSQLiteTable.Create(Self, SQL, Bindings);
-end;
-
-function TSQLiteDatabase.GetUniTable(const SQL: Ansistring): TSQLiteUniTable;
-begin
- Result := TSQLiteUniTable.Create(Self, SQL);
-end;
-
-function TSQLiteDatabase.GetUniTable(const SQL: Ansistring; const Bindings: array of const): TSQLiteUniTable;
-begin
- Result := TSQLiteUniTable.Create(Self, SQL, Bindings);
-end;
-
-function TSQLiteDatabase.GetTableValue(const SQL: Ansistring): int64;
-begin
- Result := GetTableValue(SQL, []);
-end;
-
-function TSQLiteDatabase.GetTableValue(const SQL: Ansistring; const Bindings: array of const): int64;
-var
- Table: TSQLiteUniTable;
-begin
- Result := 0;
- Table := self.GetUniTable(SQL, Bindings);
- try
- if not Table.EOF then
- Result := Table.FieldAsInteger(0);
- finally
- Table.Free;
- end;
-end;
-
-function TSQLiteDatabase.GetTableString(const SQL: Ansistring): String;
-begin
- Result := GetTableString(SQL, []);
-end;
-
-function TSQLiteDatabase.GetTableString(const SQL: Ansistring; const Bindings: array of const): String;
-var
- Table: TSQLiteUniTable;
-begin
- Result := '';
- Table := self.GetUniTable(SQL, Bindings);
- try
- if not Table.EOF then
- Result := Table.FieldAsString(0);
- finally
- Table.Free;
- end;
-end;
-
-procedure TSQLiteDatabase.GetTableStrings(const SQL: Ansistring;
- const Value: TStrings);
-var
- Table: TSQLiteUniTable;
-begin
- Value.Clear;
- Table := self.GetUniTable(SQL);
- try
- while not table.EOF do
- begin
- Value.Add(Table.FieldAsString(0));
- table.Next;
- end;
- finally
- Table.Free;
- end;
-end;
-
-procedure TSQLiteDatabase.BeginTransaction;
-begin
- if not self.fInTrans then
- begin
- self.ExecSQL('BEGIN TRANSACTION');
- self.fInTrans := True;
- end
- else
- raise ESqliteException.Create('Transaction already open');
-end;
-
-procedure TSQLiteDatabase.Commit;
-begin
- self.ExecSQL('COMMIT');
- self.fInTrans := False;
-end;
-
-procedure TSQLiteDatabase.Rollback;
-begin
- self.ExecSQL('ROLLBACK');
- self.fInTrans := False;
-end;
-
-function TSQLiteDatabase.TableExists(TableName: string): boolean;
-var
- sql: string;
- ds: TSqliteTable;
-begin
- //returns true if table exists in the database
- sql := 'select [sql] from sqlite_master where [type] = ''table'' and lower(name) = ''' +
- lowercase(TableName) + ''' ';
- ds := self.GetTable(sql);
- try
- Result := (ds.Count > 0);
- finally
- ds.Free;
- end;
-end;
-
-function TSQLiteDatabase.ContainsColumn(Table: String; Column: String) : boolean;
-var
- sql: string;
- ds: TSqliteTable;
- i : integer;
-begin
- sql := 'PRAGMA TABLE_INFO('+Table+');';
- ds := self.GetTable(sql);
- try
- Result := false;
- while (ds.Next() and not Result and not ds.EOF) do
- begin
- if ds.FieldAsString(1) = Column then
- Result := true;
- end;
- finally
- ds.Free;
- end;
-end;
-
-procedure TSQLiteDatabase.SetTimeout(Value: integer);
-begin
- SQLite3_BusyTimeout(self.fDB, Value);
-end;
-
-function TSQLiteDatabase.Version: string;
-begin
- Result := SQLite3_Version;
-end;
-
-procedure TSQLiteDatabase.AddCustomCollate(name: string;
- xCompare: TCollateXCompare);
-begin
- sqlite3_create_collation(fdb, PAnsiChar(name), SQLITE_UTF8, nil, xCompare);
-end;
-
-procedure TSQLiteDatabase.AddSystemCollate;
-begin
- {$IFDEF MSWINDOWS}
- sqlite3_create_collation(fdb, 'SYSTEM', SQLITE_UTF16LE, nil, @SystemCollate);
- {$ENDIF}
-end;
-
-procedure TSQLiteDatabase.ParamsClear;
-var
- n: integer;
-begin
- for n := fParams.Count - 1 downto 0 do
- TSQliteParam(fparams[n]).free;
- fParams.Clear;
-end;
-
-procedure TSQLiteDatabase.AddParamInt(name: string; value: int64);
-var
- par: TSQliteParam;
-begin
- par := TSQliteParam.Create;
- par.name := name;
- par.valuetype := SQLITE_INTEGER;
- par.valueinteger := value;
- fParams.Add(par);
-end;
-
-procedure TSQLiteDatabase.AddParamFloat(name: string; value: double);
-var
- par: TSQliteParam;
-begin
- par := TSQliteParam.Create;
- par.name := name;
- par.valuetype := SQLITE_FLOAT;
- par.valuefloat := value;
- fParams.Add(par);
-end;
-
-procedure TSQLiteDatabase.AddParamText(name: string; value: string);
-var
- par: TSQliteParam;
-begin
- par := TSQliteParam.Create;
- par.name := name;
- par.valuetype := SQLITE_TEXT;
- par.valuedata := value;
- fParams.Add(par);
-end;
-
-procedure TSQLiteDatabase.AddParamNull(name: string);
-var
- par: TSQliteParam;
-begin
- par := TSQliteParam.Create;
- par.name := name;
- par.valuetype := SQLITE_NULL;
- fParams.Add(par);
-end;
-
-procedure TSQLiteDatabase.SetParams(Stmt: TSQLiteStmt);
-var
- n: integer;
- i: integer;
- par: TSQliteParam;
-begin
- try
- for n := 0 to fParams.Count - 1 do
- begin
- par := TSQliteParam(fParams[n]);
- i := sqlite3_bind_parameter_index(Stmt, PAnsiChar(par.name));
- if i > 0 then
- begin
- case par.valuetype of
- SQLITE_INTEGER:
- sqlite3_bind_int64(Stmt, i, par.valueinteger);
- SQLITE_FLOAT:
- sqlite3_bind_double(Stmt, i, par.valuefloat);
- SQLITE_TEXT:
- sqlite3_bind_text(Stmt, i, PAnsiChar(par.valuedata),
- length(par.valuedata), SQLITE_TRANSIENT);
- SQLITE_NULL:
- sqlite3_bind_null(Stmt, i);
- end;
- end;
- end;
- finally
- ParamsClear;
- end;
-end;
-
-//database rows that were changed (or inserted or deleted) by the most recent SQL statement
-function TSQLiteDatabase.GetRowsChanged: integer;
-begin
- Result := SQLite3_Changes(self.fDB);
-end;
-
-procedure TSQLiteDatabase.DoQuery(value: string);
-begin
- if assigned(OnQuery) then
- OnQuery(Self, Value);
-end;
-
-//------------------------------------------------------------------------------
-// TSQLiteTable
-//------------------------------------------------------------------------------
-
-constructor TSQLiteTable.Create(DB: TSQLiteDatabase; const SQL: Ansistring);
-begin
- Create(DB, SQL, []);
-end;
-
-constructor TSQLiteTable.Create(DB: TSQLiteDatabase; const SQL: Ansistring; const Bindings: array of const);
-var
- Stmt: TSQLiteStmt;
- NextSQLStatement: PAnsiChar;
- iStepResult: integer;
- ptr: pointer;
- iNumBytes: integer;
- thisBlobValue: TMemoryStream;
- thisStringValue: pstring;
- thisDoubleValue: pDouble;
- thisIntValue: pInt64;
- thisColType: pInteger;
- i: integer;
- DeclaredColType: PAnsiChar;
- ActualColType: integer;
- ptrValue: PAnsiChar;
-begin
- inherited create;
- try
- self.fRowCount := 0;
- self.fColCount := 0;
- //if there are several SQL statements in SQL, NextSQLStatment points to the
- //beginning of the next one. Prepare only prepares the first SQL statement.
- if Sqlite3_Prepare_v2(DB.fDB, PAnsiChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then
- DB.RaiseError('Error executing SQL', SQL);
- if (Stmt = nil) then
- DB.RaiseError('Could not prepare SQL statement', SQL);
- DB.DoQuery(SQL);
- DB.SetParams(Stmt);
- DB.BindData(Stmt, Bindings);
-
- iStepResult := Sqlite3_step(Stmt);
- while (iStepResult <> SQLITE_DONE) do
- begin
- case iStepResult of
- SQLITE_ROW:
- begin
- Inc(fRowCount);
- if (fRowCount = 1) then
- begin
- //get data types
- fCols := TStringList.Create;
- fColTypes := TList.Create;
- fColCount := SQLite3_ColumnCount(stmt);
- for i := 0 to Pred(fColCount) do
- fCols.Add(AnsiUpperCase(Sqlite3_ColumnName(stmt, i)));
- for i := 0 to Pred(fColCount) do
- begin
- new(thisColType);
- DeclaredColType := Sqlite3_ColumnDeclType(stmt, i);
- if DeclaredColType = nil then
- thisColType^ := Sqlite3_ColumnType(stmt, i) //use the actual column type instead
- //seems to be needed for last_insert_rowid
- else
- if (DeclaredColType = 'INTEGER') or (DeclaredColType = 'BOOLEAN') then
- thisColType^ := dtInt
- else
- if (DeclaredColType = 'NUMERIC') or
- (DeclaredColType = 'FLOAT') or
- (DeclaredColType = 'DOUBLE') or
- (DeclaredColType = 'REAL') then
- thisColType^ := dtNumeric
- else
- if DeclaredColType = 'BLOB' then
- thisColType^ := dtBlob
- else
- thisColType^ := dtStr;
- fColTypes.Add(thiscoltype);
- end;
- fResults := TList.Create;
- end;
-
- //get column values
- for i := 0 to Pred(ColCount) do
- begin
- ActualColType := Sqlite3_ColumnType(stmt, i);
- if (ActualColType = SQLITE_NULL) then
- fResults.Add(nil)
- else
- if pInteger(fColTypes[i])^ = dtInt then
- begin
- new(thisintvalue);
- thisintvalue^ := Sqlite3_ColumnInt64(stmt, i);
- fResults.Add(thisintvalue);
- end
- else
- if pInteger(fColTypes[i])^ = dtNumeric then
- begin
- new(thisdoublevalue);
- thisdoublevalue^ := Sqlite3_ColumnDouble(stmt, i);
- fResults.Add(thisdoublevalue);
- end
- else
- if pInteger(fColTypes[i])^ = dtBlob then
- begin
- iNumBytes := Sqlite3_ColumnBytes(stmt, i);
- if iNumBytes = 0 then
- thisblobvalue := nil
- else
- begin
- thisblobvalue := TMemoryStream.Create;
- thisblobvalue.position := 0;
- ptr := Sqlite3_ColumnBlob(stmt, i);
- thisblobvalue.writebuffer(ptr^, iNumBytes);
- end;
- fResults.Add(thisblobvalue);
- end
- else
- begin
- new(thisstringvalue);
- ptrValue := Sqlite3_ColumnText(stmt, i);
- setstring(thisstringvalue^, ptrvalue, strlen(ptrvalue));
- fResults.Add(thisstringvalue);
- end;
- end;
- end;
- SQLITE_BUSY:
- raise ESqliteException.CreateFmt('Could not prepare SQL statement',
- [SQL, 'SQLite is Busy']);
- else
- begin
- SQLite3_reset(stmt);
- DB.RaiseError('Could not retrieve data', SQL);
- end;
- end;
- iStepResult := Sqlite3_step(Stmt);
- end;
- fRow := 0;
- finally
- if Assigned(Stmt) then
- Sqlite3_Finalize(stmt);
- end;
-end;
-
-//..............................................................................
-
-destructor TSQLiteTable.Destroy;
-var
- i: cardinal;
- iColNo: integer;
-begin
- if Assigned(fResults) then
- begin
- for i := 0 to fResults.Count - 1 do
- begin
- //check for blob type
- iColNo := (i mod fColCount);
- case pInteger(self.fColTypes[iColNo])^ of
- dtBlob:
- TMemoryStream(fResults[i]).Free;
- dtStr:
- if fResults[i] <> nil then
- begin
- setstring(string(fResults[i]^), nil, 0);
- dispose(fResults[i]);
- end;
- else
- dispose(fResults[i]);
- end;
- end;
- fResults.Free;
- end;
- if Assigned(fCols) then
- fCols.Free;
- if Assigned(fColTypes) then
- for i := 0 to fColTypes.Count - 1 do
- dispose(fColTypes[i]);
- fColTypes.Free;
- inherited;
-end;
-
-//..............................................................................
-
-function TSQLiteTable.GetColumns(I: integer): string;
-begin
- Result := fCols[I];
-end;
-
-//..............................................................................
-
-function TSQLiteTable.GetCountResult: integer;
-begin
- if not EOF then
- Result := StrToInt(Fields[0])
- else
- Result := 0;
-end;
-
-function TSQLiteTable.GetCount: integer;
-begin
- Result := FRowCount;
-end;
-
-//..............................................................................
-
-function TSQLiteTable.GetEOF: boolean;
-begin
- Result := fRow >= fRowCount;
-end;
-
-function TSQLiteTable.GetBOF: boolean;
-begin
- Result := fRow <= 0;
-end;
-
-//..............................................................................
-
-function TSQLiteTable.GetFieldByName(FieldName: string): string;
-begin
- Result := GetFields(self.GetFieldIndex(FieldName));
-end;
-
-function TSQLiteTable.GetFieldIndex(FieldName: string): integer;
-begin
- if (fCols = nil) then
- begin
- raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset');
- exit;
- end;
-
- if (fCols.count = 0) then
- begin
- raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset');
- exit;
- end;
-
- Result := fCols.IndexOf(AnsiUpperCase(FieldName));
-
- if (result < 0) then
- begin
- raise ESqliteException.Create('Field not found in dataset: ' + fieldname)
- end;
-end;
-
-//..............................................................................
-
-function TSQLiteTable.GetFields(I: cardinal): string;
-var
- thisvalue: pstring;
- thistype: integer;
-begin
- Result := '';
- if EOF then
- raise ESqliteException.Create('Table is at End of File');
- //integer types are not stored in the resultset
- //as strings, so they should be retrieved using the type-specific
- //methods
- thistype := pInteger(self.fColTypes[I])^;
-
- case thistype of
- dtStr:
- begin
- thisvalue := self.fResults[(self.frow * self.fColCount) + I];
- if (thisvalue <> nil) then
- Result := thisvalue^
- else
- Result := '';
- end;
- dtInt:
- Result := IntToStr(self.FieldAsInteger(I));
- dtNumeric:
- Result := FloatToStr(self.FieldAsDouble(I));
- dtBlob:
- Result := self.FieldAsBlobText(I);
- else
- Result := '';
- end;
-end;
-
-function TSqliteTable.FieldAsBlob(I: cardinal): TMemoryStream;
-begin
- if EOF then
- raise ESqliteException.Create('Table is at End of File');
- if (self.fResults[(self.frow * self.fColCount) + I] = nil) then
- Result := nil
- else
- if pInteger(self.fColTypes[I])^ = dtBlob then
- Result := TMemoryStream(self.fResults[(self.frow * self.fColCount) + I])
- else
- raise ESqliteException.Create('Not a Blob field');
-end;
-
-function TSqliteTable.FieldAsBlobText(I: cardinal): string;
-var
- MemStream: TMemoryStream;
- Buffer: PAnsiChar;
-begin
- Result := '';
- MemStream := self.FieldAsBlob(I);
- if MemStream <> nil then
- if MemStream.Size > 0 then
- begin
- MemStream.position := 0;
- {$IFDEF UNICODE}
- Buffer := AnsiStralloc(MemStream.Size + 1);
- {$ELSE}
- Buffer := Stralloc(MemStream.Size + 1);
- {$ENDIF}
- MemStream.readbuffer(Buffer[0], MemStream.Size);
- (Buffer + MemStream.Size)^ := chr(0);
- SetString(Result, Buffer, MemStream.size);
- strdispose(Buffer);
- end;
- //do not free the TMemoryStream here; it is freed when
- //TSqliteTable is destroyed
-
-end;
-
-
-function TSqliteTable.FieldAsInteger(I: cardinal): int64;
-begin
- if EOF then
- raise ESqliteException.Create('Table is at End of File');
- if (self.fResults[(self.frow * self.fColCount) + I] = nil) then
- Result := 0
- else
- if pInteger(self.fColTypes[I])^ = dtInt then
- Result := pInt64(self.fResults[(self.frow * self.fColCount) + I])^
- else
- if pInteger(self.fColTypes[I])^ = dtNumeric then
- Result := trunc(strtofloat(pString(self.fResults[(self.frow * self.fColCount) + I])^))
- else
- raise ESqliteException.Create('Not an integer or numeric field');
-end;
-
-function TSqliteTable.FieldAsDouble(I: cardinal): double;
-begin
- if EOF then
- raise ESqliteException.Create('Table is at End of File');
- if (self.fResults[(self.frow * self.fColCount) + I] = nil) then
- Result := 0
- else
- if pInteger(self.fColTypes[I])^ = dtInt then
- Result := pInt64(self.fResults[(self.frow * self.fColCount) + I])^
- else
- if pInteger(self.fColTypes[I])^ = dtNumeric then
- Result := pDouble(self.fResults[(self.frow * self.fColCount) + I])^
- else
- raise ESqliteException.Create('Not an integer or numeric field');
-end;
-
-function TSqliteTable.FieldAsString(I: cardinal): string;
-begin
- if EOF then
- raise ESqliteException.Create('Table is at End of File');
- if (self.fResults[(self.frow * self.fColCount) + I] = nil) then
- Result := ''
- else
- Result := self.GetFields(I);
-end;
-
-function TSqliteTable.FieldIsNull(I: cardinal): boolean;
-var
- thisvalue: pointer;
-begin
- if EOF then
- raise ESqliteException.Create('Table is at End of File');
- thisvalue := self.fResults[(self.frow * self.fColCount) + I];
- Result := (thisvalue = nil);
-end;
-
-//..............................................................................
-
-function TSQLiteTable.Next: boolean;
-begin
- Result := False;
- if not EOF then
- begin
- Inc(fRow);
- Result := True;
- end;
-end;
-
-function TSQLiteTable.Previous: boolean;
-begin
- Result := False;
- if not BOF then
- begin
- Dec(fRow);
- Result := True;
- end;
-end;
-
-function TSQLiteTable.MoveFirst: boolean;
-begin
- Result := False;
- if self.fRowCount > 0 then
- begin
- fRow := 0;
- Result := True;
- end;
-end;
-
-function TSQLiteTable.MoveLast: boolean;
-begin
- Result := False;
- if self.fRowCount > 0 then
- begin
- fRow := fRowCount - 1;
- Result := True;
- end;
-end;
-
-function TSQLiteTable.MoveTo(position: cardinal): boolean;
-begin
- Result := False;
- if (self.fRowCount > 0) and (self.fRowCount > position) then
- begin
- fRow := position;
- Result := True;
- end;
-end;
-
-
-
-{ TSQLiteUniTable }
-
-constructor TSQLiteUniTable.Create(DB: TSQLiteDatabase; const SQL: Ansistring);
-begin
- Create(DB, SQL, []);
-end;
-
-constructor TSQLiteUniTable.Create(DB: TSQLiteDatabase; const SQL: Ansistring; const Bindings: array of const);
-var
- NextSQLStatement: PAnsiChar;
- i: integer;
-begin
- inherited create;
- self.fDB := db;
- self.fEOF := false;
- self.fRow := 0;
- self.fColCount := 0;
- self.fSQL := SQL;
- if Sqlite3_Prepare_v2(DB.fDB, PAnsiChar(SQL), -1, fStmt, NextSQLStatement) <> SQLITE_OK then
- DB.RaiseError('Error executing SQL', SQL);
- if (fStmt = nil) then
- DB.RaiseError('Could not prepare SQL statement', SQL);
- DB.DoQuery(SQL);
- DB.SetParams(fStmt);
- DB.BindData(fStmt, Bindings);
-
- //get data types
- fCols := TStringList.Create;
- fColCount := SQLite3_ColumnCount(fstmt);
- for i := 0 to Pred(fColCount) do
- fCols.Add(AnsiUpperCase(Sqlite3_ColumnName(fstmt, i)));
-
- Next;
-end;
-
-destructor TSQLiteUniTable.Destroy;
-begin
- if Assigned(fStmt) then
- Sqlite3_Finalize(fstmt);
- if Assigned(fCols) then
- fCols.Free;
- inherited;
-end;
-
-function TSQLiteUniTable.FieldAsBlob(I: cardinal): TMemoryStream;
-var
- iNumBytes: integer;
- ptr: pointer;
-begin
- Result := TMemoryStream.Create;
- iNumBytes := Sqlite3_ColumnBytes(fstmt, i);
- if iNumBytes > 0 then
- begin
- ptr := Sqlite3_ColumnBlob(fstmt, i);
- Result.writebuffer(ptr^, iNumBytes);
- Result.Position := 0;
- end;
-end;
-
-function TSQLiteUniTable.FieldAsBlobPtr(I: cardinal; out iNumBytes: integer): Pointer;
-begin
- iNumBytes := Sqlite3_ColumnBytes(fstmt, i);
- Result := Sqlite3_ColumnBlob(fstmt, i);
-end;
-
-function TSQLiteUniTable.FieldAsBlobText(I: cardinal): string;
-var
- MemStream: TMemoryStream;
- Buffer: PAnsiChar;
-begin
- Result := '';
- MemStream := self.FieldAsBlob(I);
- if MemStream <> nil then
- try
- if MemStream.Size > 0 then
- begin
- MemStream.position := 0;
- {$IFDEF UNICODE}
- Buffer := AnsiStralloc(MemStream.Size + 1);
- {$ELSE}
- Buffer := Stralloc(MemStream.Size + 1);
- {$ENDIF}
- MemStream.readbuffer(Buffer[0], MemStream.Size);
- (Buffer + MemStream.Size)^ := chr(0);
- SetString(Result, Buffer, MemStream.size);
- strdispose(Buffer);
- end;
- finally
- MemStream.Free;
- end;
-end;
-
-function TSQLiteUniTable.FieldAsDouble(I: cardinal): double;
-begin
- Result := Sqlite3_ColumnDouble(fstmt, i);
-end;
-
-function TSQLiteUniTable.FieldAsInteger(I: cardinal): int64;
-begin
- Result := Sqlite3_ColumnInt64(fstmt, i);
-end;
-
-function TSQLiteUniTable.FieldAsString(I: cardinal): string;
-begin
- Result := self.GetFields(I);
-end;
-
-function TSQLiteUniTable.FieldIsNull(I: cardinal): boolean;
-begin
- Result := Sqlite3_ColumnText(fstmt, i) = nil;
-end;
-
-function TSQLiteUniTable.GetColumns(I: integer): string;
-begin
- Result := fCols[I];
-end;
-
-function TSQLiteUniTable.GetFieldByName(FieldName: string): string;
-begin
- Result := GetFields(self.GetFieldIndex(FieldName));
-end;
-
-function TSQLiteUniTable.GetFieldIndex(FieldName: string): integer;
-begin
- if (fCols = nil) then
- begin
- raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset');
- exit;
- end;
-
- if (fCols.count = 0) then
- begin
- raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset');
- exit;
- end;
-
- Result := fCols.IndexOf(AnsiUpperCase(FieldName));
-
- if (result < 0) then
- begin
- raise ESqliteException.Create('Field not found in dataset: ' + fieldname)
- end;
-end;
-
-function TSQLiteUniTable.GetFields(I: cardinal): string;
-begin
- Result := Sqlite3_ColumnText(fstmt, i);
-end;
-
-function TSQLiteUniTable.Next: boolean;
-var
- iStepResult: integer;
-begin
- fEOF := true;
- iStepResult := Sqlite3_step(fStmt);
- case iStepResult of
- SQLITE_ROW:
- begin
- fEOF := false;
- inc(fRow);
- end;
- SQLITE_DONE:
- // we are on the end of dataset
- // return EOF=true only
- ;
- else
- begin
- SQLite3_reset(fStmt);
- fDB.RaiseError('Could not retrieve data', fSQL);
- end;
- end;
- Result := not fEOF;
-end;
-
-end.
-
diff --git a/src/lib/SQLite/example/uTestSqlite.pas b/src/lib/SQLite/example/uTestSqlite.pas
deleted file mode 100644
index 484be71c..00000000
--- a/src/lib/SQLite/example/uTestSqlite.pas
+++ /dev/null
@@ -1,233 +0,0 @@
-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/src/lib/TntUnicodeControls/TntClasses.pas b/src/lib/TntUnicodeControls/TntClasses.pas
deleted file mode 100644
index be043421..00000000
--- a/src/lib/TntUnicodeControls/TntClasses.pas
+++ /dev/null
@@ -1,1799 +0,0 @@
-
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntClasses;
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-{ TODO: Consider: TTntRegIniFile, TTntMemIniFile (consider if UTF8 fits into this solution). }
-
-{***********************************************}
-{ WideChar-streaming implemented by Maël Hörz }
-{***********************************************}
-
-uses
- Classes, SysUtils, Windows,
- {$IFNDEF COMPILER_10_UP}
- TntWideStrings,
- {$ELSE}
- WideStrings,
- {$ENDIF}
- ActiveX, Contnrs;
-
-// ......... introduced .........
-type
- TTntStreamCharSet = (csAnsi, csUnicode, csUnicodeSwapped, csUtf8);
-
-function AutoDetectCharacterSet(Stream: TStream): TTntStreamCharSet;
-
-//---------------------------------------------------------------------------------------------
-// Tnt - Classes
-//---------------------------------------------------------------------------------------------
-
-{TNT-WARN ExtractStrings}
-{TNT-WARN LineStart}
-{TNT-WARN TStringStream} // TODO: Implement a TWideStringStream
-
-// A potential implementation of TWideStringStream can be found at:
-// http://kdsxml.cvs.sourceforge.net/kdsxml/Global/KDSClasses.pas?revision=1.10&view=markup
-
-procedure TntPersistent_AfterInherited_DefineProperties(Filer: TFiler; Instance: TPersistent);
-
-type
-{TNT-WARN TFileStream}
- TTntFileStream = class(THandleStream)
- public
- constructor Create(const FileName: WideString; Mode: Word);
- destructor Destroy; override;
- end;
-
-{TNT-WARN TMemoryStream}
- TTntMemoryStream = class(TMemoryStream{TNT-ALLOW TMemoryStream})
- public
- procedure LoadFromFile(const FileName: WideString);
- procedure SaveToFile(const FileName: WideString);
- end;
-
-{TNT-WARN TResourceStream}
- TTntResourceStream = class(TCustomMemoryStream)
- private
- HResInfo: HRSRC;
- HGlobal: THandle;
- procedure Initialize(Instance: THandle; Name, ResType: PWideChar);
- public
- constructor Create(Instance: THandle; const ResName: WideString; ResType: PWideChar);
- constructor CreateFromID(Instance: THandle; ResID: Word; ResType: PWideChar);
- destructor Destroy; override;
- function Write(const Buffer; Count: Longint): Longint; override;
- procedure SaveToFile(const FileName: WideString);
- end;
-
- TTntStrings = class;
-
-{TNT-WARN TAnsiStrings}
- TAnsiStrings{TNT-ALLOW TAnsiStrings} = class(TStrings{TNT-ALLOW TStrings})
- public
- procedure LoadFromFile(const FileName: WideString); reintroduce;
- procedure SaveToFile(const FileName: WideString); reintroduce;
- procedure LoadFromFileEx(const FileName: WideString; CodePage: Cardinal);
- procedure SaveToFileEx(const FileName: WideString; CodePage: Cardinal);
- procedure LoadFromStreamEx(Stream: TStream; CodePage: Cardinal); virtual; abstract;
- procedure SaveToStreamEx(Stream: TStream; CodePage: Cardinal); virtual; abstract;
- end;
-
- TAnsiStringsForWideStringsAdapter = class(TAnsiStrings{TNT-ALLOW TAnsiStrings})
- private
- FWideStrings: TTntStrings;
- FAdapterCodePage: Cardinal;
- protected
- function Get(Index: Integer): AnsiString; override;
- procedure Put(Index: Integer; const S: AnsiString); override;
- function GetCount: Integer; override;
- function GetObject(Index: Integer): TObject; override;
- procedure PutObject(Index: Integer; AObject: TObject); override;
- procedure SetUpdateState(Updating: Boolean); override;
- function AdapterCodePage: Cardinal; dynamic;
- public
- constructor Create(AWideStrings: TTntStrings; _AdapterCodePage: Cardinal = 0);
- procedure Clear; override;
- procedure Delete(Index: Integer); override;
- procedure Insert(Index: Integer; const S: AnsiString); override;
- procedure LoadFromStreamEx(Stream: TStream; CodePage: Cardinal); override;
- procedure SaveToStreamEx(Stream: TStream; CodePage: Cardinal); override;
- end;
-
-{TNT-WARN TStrings}
- TTntStrings = class(TWideStrings)
- private
- FLastFileCharSet: TTntStreamCharSet;
- FAnsiStrings: TAnsiStrings{TNT-ALLOW TAnsiStrings};
- procedure SetAnsiStrings(const Value: TAnsiStrings{TNT-ALLOW TAnsiStrings});
- procedure ReadData(Reader: TReader);
- procedure ReadDataUTF7(Reader: TReader);
- procedure ReadDataUTF8(Reader: TReader);
- procedure WriteDataUTF7(Writer: TWriter);
- protected
- procedure DefineProperties(Filer: TFiler); override;
- public
- constructor Create;
- destructor Destroy; override;
-
- procedure LoadFromFile(const FileName: WideString); override;
- procedure LoadFromStream(Stream: TStream); override;
- procedure LoadFromStream_BOM(Stream: TStream; WithBOM: Boolean); virtual;
-
- procedure SaveToFile(const FileName: WideString); override;
- procedure SaveToStream(Stream: TStream); override;
- procedure SaveToStream_BOM(Stream: TStream; WithBOM: Boolean); virtual;
-
- property LastFileCharSet: TTntStreamCharSet read FLastFileCharSet;
- published
- property AnsiStrings: TAnsiStrings{TNT-ALLOW TAnsiStrings} read FAnsiStrings write SetAnsiStrings stored False;
- end;
-
-{ TTntStringList class }
-
- TTntStringList = class;
- TWideStringListSortCompare = function(List: TTntStringList; Index1, Index2: Integer): Integer;
-
-{TNT-WARN TStringList}
- TTntStringList = class(TTntStrings)
- private
- FUpdating: Boolean;
- FList: PWideStringItemList;
- FCount: Integer;
- FCapacity: Integer;
- FSorted: Boolean;
- FDuplicates: TDuplicates;
- FCaseSensitive: Boolean;
- FOnChange: TNotifyEvent;
- FOnChanging: TNotifyEvent;
- procedure ExchangeItems(Index1, Index2: Integer);
- procedure Grow;
- procedure QuickSort(L, R: Integer; SCompare: TWideStringListSortCompare);
- procedure SetSorted(Value: Boolean);
- procedure SetCaseSensitive(const Value: Boolean);
- protected
- procedure Changed; virtual;
- procedure Changing; virtual;
- function Get(Index: Integer): WideString; override;
- function GetCapacity: Integer; override;
- function GetCount: Integer; override;
- function GetObject(Index: Integer): TObject; override;
- procedure Put(Index: Integer; const S: WideString); override;
- procedure PutObject(Index: Integer; AObject: TObject); override;
- procedure SetCapacity(NewCapacity: Integer); override;
- procedure SetUpdateState(Updating: Boolean); override;
- function CompareStrings(const S1, S2: WideString): Integer; override;
- procedure InsertItem(Index: Integer; const S: WideString; AObject: TObject); virtual;
- public
- destructor Destroy; override;
- function Add(const S: WideString): Integer; override;
- function AddObject(const S: WideString; AObject: TObject): Integer; override;
- procedure Clear; override;
- procedure Delete(Index: Integer); override;
- procedure Exchange(Index1, Index2: Integer); override;
- function Find(const S: WideString; var Index: Integer): Boolean; virtual;
- function IndexOf(const S: WideString): Integer; override;
- function IndexOfName(const Name: WideString): Integer; override;
- procedure Insert(Index: Integer; const S: WideString); override;
- procedure InsertObject(Index: Integer; const S: WideString;
- AObject: TObject); override;
- procedure Sort; virtual;
- procedure CustomSort(Compare: TWideStringListSortCompare); virtual;
- property Duplicates: TDuplicates read FDuplicates write FDuplicates;
- property Sorted: Boolean read FSorted write SetSorted;
- property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive;
- property OnChange: TNotifyEvent read FOnChange write FOnChange;
- property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
- end;
-
-// ......... introduced .........
-type
- TListTargetCompare = function (Item, Target: Pointer): Integer;
-
-function FindSortedListByTarget(List: TList; TargetCompare: TListTargetCompare;
- Target: Pointer; var Index: Integer): Boolean;
-
-function ClassIsRegistered(const clsid: TCLSID): Boolean;
-
-var
- RuntimeUTFStreaming: Boolean;
-
-type
- TBufferedAnsiString = class(TObject)
- private
- FStringBuffer: AnsiString;
- LastWriteIndex: Integer;
- public
- procedure Clear;
- procedure AddChar(const wc: AnsiChar);
- procedure AddString(const s: AnsiString);
- procedure AddBuffer(Buff: PAnsiChar; Chars: Integer);
- function Value: AnsiString;
- function BuffPtr: PAnsiChar;
- end;
-
- TBufferedWideString = class(TObject)
- private
- FStringBuffer: WideString;
- LastWriteIndex: Integer;
- public
- procedure Clear;
- procedure AddChar(const wc: WideChar);
- procedure AddString(const s: WideString);
- procedure AddBuffer(Buff: PWideChar; Chars: Integer);
- function Value: WideString;
- function BuffPtr: PWideChar;
- end;
-
- TBufferedStreamReader = class(TStream)
- private
- FStream: TStream;
- FStreamSize: Integer;
- FBuffer: array of Byte;
- FBufferSize: Integer;
- FBufferStartPosition: Integer;
- FVirtualPosition: Integer;
- procedure UpdateBufferFromPosition(StartPos: Integer);
- public
- constructor Create(Stream: TStream; BufferSize: Integer = 1024);
- function Read(var Buffer; Count: Longint): Longint; override;
- function Write(const Buffer; Count: Longint): Longint; override;
- function Seek(Offset: Longint; Origin: Word): Longint; override;
- end;
-
-// "synced" wide string
-type TSetAnsiStrEvent = procedure(const Value: AnsiString) of object;
-function GetSyncedWideString(var WideStr: WideString; const AnsiStr: AnsiString): WideString;
-procedure SetSyncedWideString(const Value: WideString; var WideStr: WideString;
- const AnsiStr: AnsiString; SetAnsiStr: TSetAnsiStrEvent);
-
-type
- TWideComponentHelper = class(TComponent)
- private
- FComponent: TComponent;
- protected
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- public
- constructor Create(AOwner: TComponent); override;
- constructor CreateHelper(AOwner: TComponent; ComponentHelperList: TComponentList);
- end;
-
-function FindWideComponentHelper(ComponentHelperList: TComponentList; Component: TComponent): TWideComponentHelper;
-
-implementation
-
-uses
- RTLConsts, ComObj, Math,
- Registry, TypInfo, TntSystem, TntSysUtils;
-
-{ TntPersistent }
-
-//===========================================================================
-// The Delphi 5 Classes.pas never supported the streaming of WideStrings.
-// The Delphi 6 Classes.pas supports WideString streaming. But it's too bad that
-// the Delphi 6 IDE doesn't use the updated Classes.pas. Switching between Form/Text
-// mode corrupts extended characters in WideStrings even under Delphi 6.
-// Delphi 7 seems to finally get right. But let's keep the UTF7 support at design time
-// to enable sharing source code with previous versions of Delphi.
-//
-// The purpose of this solution is to store WideString properties which contain
-// non-ASCII chars in the form of UTF7 under the old property name + '_UTF7'.
-//
-// Special thanks go to Francisco Leong for helping to develop this solution.
-//
-
-{ TTntWideStringPropertyFiler }
-type
- TTntWideStringPropertyFiler = class
- private
- FInstance: TPersistent;
- FPropInfo: PPropInfo;
- procedure ReadDataUTF8(Reader: TReader);
- procedure ReadDataUTF7(Reader: TReader);
- procedure WriteDataUTF7(Writer: TWriter);
- public
- procedure DefineProperties(Filer: TFiler; Instance: TPersistent; PropName: AnsiString);
- end;
-
-function ReaderNeedsUtfHelp(Reader: TReader): Boolean;
-begin
- if Reader.Owner = nil then
- Result := False { designtime - visual form inheritance ancestor }
- else if csDesigning in Reader.Owner.ComponentState then
- {$IFDEF COMPILER_7_UP}
- Result := False { Delphi 7+: designtime - doesn't need UTF help. }
- {$ELSE}
- Result := True { Delphi 6: designtime - always needs UTF help. }
- {$ENDIF}
- else
- Result := RuntimeUTFStreaming; { runtime }
-end;
-
-procedure TTntWideStringPropertyFiler.ReadDataUTF8(Reader: TReader);
-begin
- if ReaderNeedsUtfHelp(Reader) then
- SetWideStrProp(FInstance, FPropInfo, UTF8ToWideString(Reader.ReadString))
- else
- Reader.ReadString; { do nothing with Result }
-end;
-
-procedure TTntWideStringPropertyFiler.ReadDataUTF7(Reader: TReader);
-begin
- if ReaderNeedsUtfHelp(Reader) then
- SetWideStrProp(FInstance, FPropInfo, UTF7ToWideString(Reader.ReadString))
- else
- Reader.ReadString; { do nothing with Result }
-end;
-
-procedure TTntWideStringPropertyFiler.WriteDataUTF7(Writer: TWriter);
-begin
- Writer.WriteString(WideStringToUTF7(GetWideStrProp(FInstance, FPropInfo)));
-end;
-
-procedure TTntWideStringPropertyFiler.DefineProperties(Filer: TFiler; Instance: TPersistent;
- PropName: AnsiString);
-
- {$IFNDEF COMPILER_7_UP}
- function HasData: Boolean;
- var
- CurrPropValue: WideString;
- begin
- // must be stored
- Result := IsStoredProp(Instance, FPropInfo);
- if Result
- and (Filer.Ancestor <> nil)
- and (GetPropInfo(Filer.Ancestor, PropName, [tkWString]) <> nil) then
- begin
- // must be different than ancestor
- CurrPropValue := GetWideStrProp(Instance, FPropInfo);
- Result := CurrPropValue <> GetWideStrProp(Filer.Ancestor, GetPropInfo(Filer.Ancestor, PropName));
- end;
- if Result then begin
- // must be non-blank and different than UTF8 (implies all ASCII <= 127)
- CurrPropValue := GetWideStrProp(Instance, FPropInfo);
- Result := (CurrPropValue <> '') and (WideStringToUTF8(CurrPropValue) <> CurrPropValue);
- end;
- end;
- {$ENDIF}
-
-begin
- FInstance := Instance;
- FPropInfo := GetPropInfo(Instance, PropName, [tkWString]);
- if FPropInfo <> nil then begin
- // must be published (and of type WideString)
- Filer.DefineProperty(PropName + 'W', ReadDataUTF8, nil, False);
- {$IFDEF COMPILER_7_UP}
- Filer.DefineProperty(PropName + '_UTF7', ReadDataUTF7, WriteDataUTF7, False);
- {$ELSE}
- Filer.DefineProperty(PropName + '_UTF7', ReadDataUTF7, WriteDataUTF7, HasData);
- {$ENDIF}
- end;
- FInstance := nil;
- FPropInfo := nil;
-end;
-
-{ TTntWideCharPropertyFiler }
-type
- TTntWideCharPropertyFiler = class
- private
- FInstance: TPersistent;
- FPropInfo: PPropInfo;
- {$IFNDEF COMPILER_9_UP}
- FWriter: TWriter;
- procedure GetLookupInfo(var Ancestor: TPersistent;
- var Root, LookupRoot, RootAncestor: TComponent);
- {$ENDIF}
- procedure ReadData_W(Reader: TReader);
- procedure ReadDataUTF7(Reader: TReader);
- procedure WriteData_W(Writer: TWriter);
- function ReadChar(Reader: TReader): WideChar;
- public
- procedure DefineProperties(Filer: TFiler; Instance: TPersistent; PropName: AnsiString);
- end;
-
-{$IFNDEF COMPILER_9_UP}
-type
- TGetLookupInfoEvent = procedure(var Ancestor: TPersistent;
- var Root, LookupRoot, RootAncestor: TComponent) of object;
-
-function AncestorIsValid(Ancestor: TPersistent; Root, RootAncestor: TComponent): Boolean;
-begin
- Result := (Ancestor <> nil) and (RootAncestor <> nil) and
- Root.InheritsFrom(RootAncestor.ClassType);
-end;
-
-function IsDefaultOrdPropertyValue(Instance: TObject; PropInfo: PPropInfo;
- OnGetLookupInfo: TGetLookupInfoEvent): Boolean;
-var
- Ancestor: TPersistent;
- LookupRoot: TComponent;
- RootAncestor: TComponent;
- Root: TComponent;
- AncestorValid: Boolean;
- Value: Longint;
- Default: LongInt;
-begin
- Ancestor := nil;
- Root := nil;
- LookupRoot := nil;
- RootAncestor := nil;
-
- if Assigned(OnGetLookupInfo) then
- OnGetLookupInfo(Ancestor, Root, LookupRoot, RootAncestor);
-
- AncestorValid := AncestorIsValid(Ancestor, Root, RootAncestor);
-
- Result := True;
- if (PropInfo^.GetProc <> nil) and (PropInfo^.SetProc <> nil) then
- begin
- Value := GetOrdProp(Instance, PropInfo);
- if AncestorValid then
- Result := Value = GetOrdProp(Ancestor, PropInfo)
- else
- begin
- Default := PPropInfo(PropInfo)^.Default;
- Result := (Default <> LongInt($80000000)) and (Value = Default);
- end;
- end;
-end;
-
-procedure TTntWideCharPropertyFiler.GetLookupInfo(var Ancestor: TPersistent;
- var Root, LookupRoot, RootAncestor: TComponent);
-begin
- Ancestor := FWriter.Ancestor;
- Root := FWriter.Root;
- LookupRoot := FWriter.LookupRoot;
- RootAncestor := FWriter.RootAncestor;
-end;
-{$ENDIF}
-
-function TTntWideCharPropertyFiler.ReadChar(Reader: TReader): WideChar;
-var
- Temp: WideString;
-begin
- case Reader.NextValue of
- vaWString:
- Temp := Reader.ReadWideString;
- vaString:
- Temp := Reader.ReadString;
- else
- raise EReadError.Create(SInvalidPropertyValue);
- end;
-
- if Length(Temp) > 1 then
- raise EReadError.Create(SInvalidPropertyValue);
- Result := Temp[1];
-end;
-
-procedure TTntWideCharPropertyFiler.ReadData_W(Reader: TReader);
-begin
- SetOrdProp(FInstance, FPropInfo, Ord(ReadChar(Reader)));
-end;
-
-procedure TTntWideCharPropertyFiler.ReadDataUTF7(Reader: TReader);
-var
- S: WideString;
-begin
- S := UTF7ToWideString(Reader.ReadString);
- if S = '' then
- SetOrdProp(FInstance, FPropInfo, 0)
- else
- SetOrdProp(FInstance, FPropInfo, Ord(S[1]))
-end;
-
-type TAccessWriter = class(TWriter);
-
-procedure TTntWideCharPropertyFiler.WriteData_W(Writer: TWriter);
-var
- L: Integer;
- Temp: WideString;
-begin
- Temp := WideChar(GetOrdProp(FInstance, FPropInfo));
-
- {$IFNDEF FPC}
- TAccessWriter(Writer).WriteValue(vaWString);
- {$ELSE}
- TAccessWriter(Writer).Write(vaWString, SizeOf(vaWString));
- {$ENDIF}
- L := Length(Temp);
- Writer.Write(L, SizeOf(Integer));
- Writer.Write(Pointer(@Temp[1])^, L * 2);
-end;
-
-procedure TTntWideCharPropertyFiler.DefineProperties(Filer: TFiler;
- Instance: TPersistent; PropName: AnsiString);
-
- {$IFNDEF COMPILER_9_UP}
- function HasData: Boolean;
- var
- CurrPropValue: Integer;
- begin
- // must be stored
- Result := IsStoredProp(Instance, FPropInfo);
- if Result and (Filer.Ancestor <> nil) and
- (GetPropInfo(Filer.Ancestor, PropName, [tkWChar]) <> nil) then
- begin
- // must be different than ancestor
- CurrPropValue := GetOrdProp(Instance, FPropInfo);
- Result := CurrPropValue <> GetOrdProp(Filer.Ancestor, GetPropInfo(Filer.Ancestor, PropName));
- end;
- if Result and (Filer is TWriter) then
- begin
- FWriter := TWriter(Filer);
- Result := not IsDefaultOrdPropertyValue(Instance, FPropInfo, GetLookupInfo);
- end;
- end;
- {$ENDIF}
-
-begin
- FInstance := Instance;
- FPropInfo := GetPropInfo(Instance, PropName, [tkWChar]);
- if FPropInfo <> nil then
- begin
- // must be published (and of type WideChar)
- {$IFDEF COMPILER_9_UP}
- Filer.DefineProperty(PropName + 'W', ReadData_W, WriteData_W, False);
- {$ELSE}
- Filer.DefineProperty(PropName + 'W', ReadData_W, WriteData_W, HasData);
- {$ENDIF}
- Filer.DefineProperty(PropName + '_UTF7', ReadDataUTF7, nil, False);
- end;
- FInstance := nil;
- FPropInfo := nil;
-end;
-
-procedure TntPersistent_AfterInherited_DefineProperties(Filer: TFiler; Instance: TPersistent);
-var
- I, Count: Integer;
- PropInfo: PPropInfo;
- PropList: PPropList;
- WideStringFiler: TTntWideStringPropertyFiler;
- WideCharFiler: TTntWideCharPropertyFiler;
-begin
- Count := GetTypeData(Instance.ClassInfo)^.PropCount;
- if Count > 0 then
- begin
- WideStringFiler := TTntWideStringPropertyFiler.Create;
- try
- WideCharFiler := TTntWideCharPropertyFiler.Create;
- try
- GetMem(PropList, Count * SizeOf(Pointer));
- try
- GetPropInfos(Instance.ClassInfo, PropList);
- for I := 0 to Count - 1 do
- begin
- PropInfo := PropList^[I];
- if (PropInfo = nil) then
- break;
- if (PropInfo.PropType^.Kind = tkWString) then
- WideStringFiler.DefineProperties(Filer, Instance, PropInfo.Name)
- else if (PropInfo.PropType^.Kind = tkWChar) then
- WideCharFiler.DefineProperties(Filer, Instance, PropInfo.Name)
- end;
- finally
- FreeMem(PropList, Count * SizeOf(Pointer));
- end;
- finally
- WideCharFiler.Free;
- end;
- finally
- WideStringFiler.Free;
- end;
- end;
-end;
-
-{ TTntFileStream }
-
-{$IFDEF FPC}
- {$DEFINE HAS_SFCREATEERROREX}
-{$ENDIF}
-{$IFDEF DELPHI_7_UP}
- {$DEFINE HAS_SFCREATEERROREX}
-{$ENDIF}
-
-constructor TTntFileStream.Create(const FileName: WideString; Mode: Word);
-var
- CreateHandle: Integer;
- {$IFDEF HAS_SFCREATEERROREX}
- ErrorMessage: WideString;
- {$ENDIF}
-begin
- if Mode = fmCreate then
- begin
- CreateHandle := WideFileCreate(FileName);
- if CreateHandle < 0 then begin
- {$IFDEF HAS_SFCREATEERROREX}
- ErrorMessage := WideSysErrorMessage(GetLastError);
- raise EFCreateError.CreateFmt(SFCreateErrorEx, [WideExpandFileName(FileName), ErrorMessage]);
- {$ELSE}
- raise EFCreateError.CreateFmt(SFCreateError, [WideExpandFileName(FileName)]);
- {$ENDIF}
- end;
- end else
- begin
- CreateHandle := WideFileOpen(FileName, Mode);
- if CreateHandle < 0 then begin
- {$IFDEF HAS_SFCREATEERROREX}
- ErrorMessage := WideSysErrorMessage(GetLastError);
- raise EFOpenError.CreateFmt(SFOpenErrorEx, [WideExpandFileName(FileName), ErrorMessage]);
- {$ELSE}
- raise EFOpenError.CreateFmt(SFOpenError, [WideExpandFileName(FileName)]);
- {$ENDIF}
- end;
- end;
- inherited Create(CreateHandle);
-end;
-
-destructor TTntFileStream.Destroy;
-begin
- if Handle >= 0 then FileClose(Handle);
-end;
-
-{ TTntMemoryStream }
-
-procedure TTntMemoryStream.LoadFromFile(const FileName: WideString);
-var
- Stream: TStream;
-begin
- Stream := TTntFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
- try
- LoadFromStream(Stream);
- finally
- Stream.Free;
- end;
-end;
-
-procedure TTntMemoryStream.SaveToFile(const FileName: WideString);
-var
- Stream: TStream;
-begin
- Stream := TTntFileStream.Create(FileName, fmCreate);
- try
- SaveToStream(Stream);
- finally
- Stream.Free;
- end;
-end;
-
-{ TTntResourceStream }
-
-constructor TTntResourceStream.Create(Instance: THandle; const ResName: WideString;
- ResType: PWideChar);
-begin
- inherited Create;
- Initialize(Instance, PWideChar(ResName), ResType);
-end;
-
-constructor TTntResourceStream.CreateFromID(Instance: THandle; ResID: Word;
- ResType: PWideChar);
-begin
- inherited Create;
- Initialize(Instance, PWideChar(ResID), ResType);
-end;
-
-procedure TTntResourceStream.Initialize(Instance: THandle; Name, ResType: PWideChar);
-
- procedure Error;
- begin
- raise EResNotFound.CreateFmt(SResNotFound, [Name]);
- end;
-
-begin
- HResInfo := FindResourceW(Instance, Name, ResType);
- if HResInfo = 0 then Error;
- HGlobal := LoadResource(Instance, HResInfo);
- if HGlobal = 0 then Error;
- SetPointer(LockResource(HGlobal), SizeOfResource(Instance, HResInfo));
-end;
-
-destructor TTntResourceStream.Destroy;
-begin
- UnlockResource(HGlobal);
- FreeResource(HGlobal); { Technically this is not necessary (MS KB #193678) }
- inherited Destroy;
-end;
-
-function TTntResourceStream.Write(const Buffer; Count: Longint): Longint;
-begin
- raise EStreamError.CreateRes(PResStringRec(@SCantWriteResourceStreamError));
-end;
-
-procedure TTntResourceStream.SaveToFile(const FileName: WideString);
-var
- Stream: TStream;
-begin
- Stream := TTntFileStream.Create(FileName, fmCreate);
- try
- SaveToStream(Stream);
- finally
- Stream.Free;
- end;
-end;
-
-{ TAnsiStrings }
-
-procedure TAnsiStrings{TNT-ALLOW TAnsiStrings}.LoadFromFile(const FileName: WideString);
-var
- Stream: TStream;
-begin
- Stream := TTntFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
- try
- LoadFromStream(Stream);
- finally
- Stream.Free;
- end;
-end;
-
-procedure TAnsiStrings{TNT-ALLOW TAnsiStrings}.SaveToFile(const FileName: WideString);
-var
- Stream: TStream;
-begin
- Stream := TTntFileStream.Create(FileName, fmCreate);
- try
- SaveToStream(Stream);
- finally
- Stream.Free;
- end;
-end;
-
-procedure TAnsiStrings{TNT-ALLOW TAnsiStrings}.LoadFromFileEx(const FileName: WideString; CodePage: Cardinal);
-var
- Stream: TStream;
-begin
- Stream := TTntFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
- try
- LoadFromStreamEx(Stream, CodePage);
- finally
- Stream.Free;
- end;
-end;
-
-procedure TAnsiStrings{TNT-ALLOW TAnsiStrings}.SaveToFileEx(const FileName: WideString; CodePage: Cardinal);
-var
- Stream: TStream;
- Utf8BomPtr: PAnsiChar;
-begin
- Stream := TTntFileStream.Create(FileName, fmCreate);
- try
- if (CodePage = CP_UTF8) then
- begin
- Utf8BomPtr := PAnsiChar(UTF8_BOM);
- Stream.WriteBuffer(Utf8BomPtr^, Length(UTF8_BOM));
- end;
- SaveToStreamEx(Stream, CodePage);
- finally
- Stream.Free;
- end;
-end;
-
-{ TAnsiStringsForWideStringsAdapter }
-
-constructor TAnsiStringsForWideStringsAdapter.Create(AWideStrings: TTntStrings; _AdapterCodePage: Cardinal);
-begin
- inherited Create;
- FWideStrings := AWideStrings;
- FAdapterCodePage := _AdapterCodePage;
-end;
-
-function TAnsiStringsForWideStringsAdapter.AdapterCodePage: Cardinal;
-begin
- if FAdapterCodePage = 0 then
- Result := TntSystem.DefaultSystemCodePage
- else
- Result := FAdapterCodePage;
-end;
-
-procedure TAnsiStringsForWideStringsAdapter.Clear;
-begin
- FWideStrings.Clear;
-end;
-
-procedure TAnsiStringsForWideStringsAdapter.Delete(Index: Integer);
-begin
- FWideStrings.Delete(Index);
-end;
-
-function TAnsiStringsForWideStringsAdapter.Get(Index: Integer): AnsiString;
-begin
- Result := WideStringToStringEx(FWideStrings.Get(Index), AdapterCodePage);
-end;
-
-procedure TAnsiStringsForWideStringsAdapter.Put(Index: Integer; const S: AnsiString);
-begin
- FWideStrings.Put(Index, StringToWideStringEx(S, AdapterCodePage));
-end;
-
-function TAnsiStringsForWideStringsAdapter.GetCount: Integer;
-begin
- Result := FWideStrings.GetCount;
-end;
-
-procedure TAnsiStringsForWideStringsAdapter.Insert(Index: Integer; const S: AnsiString);
-begin
- FWideStrings.Insert(Index, StringToWideStringEx(S, AdapterCodePage));
-end;
-
-function TAnsiStringsForWideStringsAdapter.GetObject(Index: Integer): TObject;
-begin
- Result := FWideStrings.GetObject(Index);
-end;
-
-procedure TAnsiStringsForWideStringsAdapter.PutObject(Index: Integer; AObject: TObject);
-begin
- FWideStrings.PutObject(Index, AObject);
-end;
-
-procedure TAnsiStringsForWideStringsAdapter.SetUpdateState(Updating: Boolean);
-begin
- FWideStrings.SetUpdateState(Updating);
-end;
-
-procedure TAnsiStringsForWideStringsAdapter.LoadFromStreamEx(Stream: TStream; CodePage: Cardinal);
-var
- Size: Integer;
- S: AnsiString;
-begin
- BeginUpdate;
- try
- Size := Stream.Size - Stream.Position;
- SetString(S, nil, Size);
- Stream.Read(Pointer(S)^, Size);
- FWideStrings.SetTextStr(StringToWideStringEx(S, CodePage));
- finally
- EndUpdate;
- end;
-end;
-
-procedure TAnsiStringsForWideStringsAdapter.SaveToStreamEx(Stream: TStream; CodePage: Cardinal);
-var
- S: AnsiString;
-begin
- S := WideStringToStringEx(FWideStrings.GetTextStr, CodePage);
- Stream.WriteBuffer(Pointer(S)^, Length(S));
-end;
-
-{ TTntStrings }
-
-constructor TTntStrings.Create;
-begin
- inherited;
- FAnsiStrings := TAnsiStringsForWideStringsAdapter.Create(Self);
- FLastFileCharSet := csUnicode;
-end;
-
-destructor TTntStrings.Destroy;
-begin
- FreeAndNil(FAnsiStrings);
- inherited;
-end;
-
-procedure TTntStrings.SetAnsiStrings(const Value: TAnsiStrings{TNT-ALLOW TAnsiStrings});
-begin
- FAnsiStrings.Assign(Value);
-end;
-
-procedure TTntStrings.DefineProperties(Filer: TFiler);
-
- {$IFNDEF COMPILER_7_UP}
- function DoWrite: Boolean;
- begin
- if Filer.Ancestor <> nil then
- begin
- Result := True;
- if Filer.Ancestor is TWideStrings then
- Result := not Equals(TWideStrings(Filer.Ancestor))
- end
- else Result := Count > 0;
- end;
-
- function DoWriteAsUTF7: Boolean;
- var
- i: integer;
- begin
- Result := False;
- for i := 0 to Count - 1 do begin
- if (Strings[i] <> '') and (WideStringToUTF8(Strings[i]) <> Strings[i]) then begin
- Result := True;
- break; { found a string with non-ASCII chars (> 127) }
- end;
- end;
- end;
- {$ENDIF}
-
-begin
- inherited DefineProperties(Filer); { Handles main 'Strings' property.' }
- Filer.DefineProperty('WideStrings', ReadData, nil, False);
- Filer.DefineProperty('WideStringsW', ReadDataUTF8, nil, False);
- {$IFDEF COMPILER_7_UP}
- Filer.DefineProperty('WideStrings_UTF7', ReadDataUTF7, WriteDataUTF7, False);
- {$ELSE}
- Filer.DefineProperty('WideStrings_UTF7', ReadDataUTF7, WriteDataUTF7, DoWrite and DoWriteAsUTF7);
- {$ENDIF}
-end;
-
-procedure TTntStrings.LoadFromFile(const FileName: WideString);
-var
- Stream: TStream;
-begin
- Stream := TTntFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
- try
- FLastFileCharSet := AutoDetectCharacterSet(Stream);
- Stream.Position := 0;
- LoadFromStream(Stream);
- finally
- Stream.Free;
- end;
-end;
-
-procedure TTntStrings.LoadFromStream(Stream: TStream);
-begin
- LoadFromStream_BOM(Stream, True);
-end;
-
-procedure TTntStrings.LoadFromStream_BOM(Stream: TStream; WithBOM: Boolean);
-var
- DataLeft: Integer;
- StreamCharSet: TTntStreamCharSet;
- SW: WideString;
- SA: AnsiString;
-begin
- BeginUpdate;
- try
- if WithBOM then
- StreamCharSet := AutoDetectCharacterSet(Stream)
- else
- StreamCharSet := csUnicode;
- DataLeft := Stream.Size - Stream.Position;
- if (StreamCharSet in [csUnicode, csUnicodeSwapped]) then
- begin
- // BOM indicates Unicode text stream
- if DataLeft < SizeOf(WideChar) then
- SW := ''
- else begin
- SetLength(SW, DataLeft div SizeOf(WideChar));
- Stream.Read(PWideChar(SW)^, DataLeft);
- if StreamCharSet = csUnicodeSwapped then
- StrSwapByteOrder(PWideChar(SW));
- end;
- SetTextStr(SW);
- end
- else if StreamCharSet = csUtf8 then
- begin
- // BOM indicates UTF-8 text stream
- SetLength(SA, DataLeft div SizeOf(AnsiChar));
- Stream.Read(PAnsiChar(SA)^, DataLeft);
- SetTextStr(UTF8ToWideString(SA));
- end
- else
- begin
- // without byte order mark it is assumed that we are loading ANSI text
- SetLength(SA, DataLeft div SizeOf(AnsiChar));
- Stream.Read(PAnsiChar(SA)^, DataLeft);
- SetTextStr(SA);
- end;
- finally
- EndUpdate;
- end;
-end;
-
-procedure TTntStrings.ReadData(Reader: TReader);
-begin
- if Reader.NextValue in [vaString, vaLString] then
- SetTextStr(Reader.ReadString) {JCL compatiblity}
- else if Reader.NextValue = vaWString then
- SetTextStr(Reader.ReadWideString) {JCL compatiblity}
- else begin
- BeginUpdate;
- try
- Clear;
- Reader.ReadListBegin;
- while not Reader.EndOfList do
- if Reader.NextValue in [vaString, vaLString] then
- Add(Reader.ReadString) {TStrings compatiblity}
- else
- Add(Reader.ReadWideString);
- Reader.ReadListEnd;
- finally
- EndUpdate;
- end;
- end;
-end;
-
-procedure TTntStrings.ReadDataUTF7(Reader: TReader);
-begin
- Reader.ReadListBegin;
- if ReaderNeedsUtfHelp(Reader) then
- begin
- BeginUpdate;
- try
- Clear;
- while not Reader.EndOfList do
- Add(UTF7ToWideString(Reader.ReadString))
- finally
- EndUpdate;
- end;
- end else begin
- while not Reader.EndOfList do
- Reader.ReadString; { do nothing with Result }
- end;
- Reader.ReadListEnd;
-end;
-
-procedure TTntStrings.ReadDataUTF8(Reader: TReader);
-begin
- Reader.ReadListBegin;
- if ReaderNeedsUtfHelp(Reader)
- or (Count = 0){ Legacy support where 'WideStrings' was never written in lieu of WideStringsW }
- then begin
- BeginUpdate;
- try
- Clear;
- while not Reader.EndOfList do
- Add(UTF8ToWideString(Reader.ReadString))
- finally
- EndUpdate;
- end;
- end else begin
- while not Reader.EndOfList do
- Reader.ReadString; { do nothing with Result }
- end;
- Reader.ReadListEnd;
-end;
-
-procedure TTntStrings.SaveToFile(const FileName: WideString);
-var
- Stream: TStream;
-begin
- Stream := TTntFileStream.Create(FileName, fmCreate);
- try
- SaveToStream(Stream);
- finally
- Stream.Free;
- end;
-end;
-
-procedure TTntStrings.SaveToStream(Stream: TStream);
-begin
- SaveToStream_BOM(Stream, True);
-end;
-
-procedure TTntStrings.SaveToStream_BOM(Stream: TStream; WithBOM: Boolean);
-// Saves the currently loaded text into the given stream.
-// WithBOM determines whether to write a byte order mark or not.
-var
- SW: WideString;
- BOM: WideChar;
-begin
- if WithBOM then begin
- BOM := UNICODE_BOM;
- Stream.WriteBuffer(BOM, SizeOf(WideChar));
- end;
- SW := GetTextStr;
- Stream.WriteBuffer(PWideChar(SW)^, Length(SW) * SizeOf(WideChar));
-end;
-
-procedure TTntStrings.WriteDataUTF7(Writer: TWriter);
-var
- I: Integer;
-begin
- Writer.WriteListBegin;
- for I := 0 to Count-1 do
- Writer.WriteString(WideStringToUTF7(Get(I)));
- Writer.WriteListEnd;
-end;
-
-{ TTntStringList }
-
-destructor TTntStringList.Destroy;
-begin
- FOnChange := nil;
- FOnChanging := nil;
- inherited Destroy;
- if FCount <> 0 then Finalize(FList^[0], FCount);
- FCount := 0;
- SetCapacity(0);
-end;
-
-function TTntStringList.Add(const S: WideString): Integer;
-begin
- Result := AddObject(S, nil);
-end;
-
-function TTntStringList.AddObject(const S: WideString; AObject: TObject): Integer;
-begin
- if not Sorted then
- Result := FCount
- else
- if Find(S, Result) then
- case Duplicates of
- dupIgnore: Exit;
- dupError: Error(PResStringRec(@SDuplicateString), 0);
- end;
- InsertItem(Result, S, AObject);
-end;
-
-procedure TTntStringList.Changed;
-begin
- if (not FUpdating) and Assigned(FOnChange) then
- FOnChange(Self);
-end;
-
-procedure TTntStringList.Changing;
-begin
- if (not FUpdating) and Assigned(FOnChanging) then
- FOnChanging(Self);
-end;
-
-procedure TTntStringList.Clear;
-begin
- if FCount <> 0 then
- begin
- Changing;
- Finalize(FList^[0], FCount);
- FCount := 0;
- SetCapacity(0);
- Changed;
- end;
-end;
-
-procedure TTntStringList.Delete(Index: Integer);
-begin
- if (Index < 0) or (Index >= FCount) then Error(PResStringRec(@SListIndexError), Index);
- Changing;
- Finalize(FList^[Index]);
- Dec(FCount);
- if Index < FCount then
- System.Move(FList^[Index + 1], FList^[Index],
- (FCount - Index) * SizeOf(TWideStringItem));
- Changed;
-end;
-
-procedure TTntStringList.Exchange(Index1, Index2: Integer);
-begin
- if (Index1 < 0) or (Index1 >= FCount) then Error(PResStringRec(@SListIndexError), Index1);
- if (Index2 < 0) or (Index2 >= FCount) then Error(PResStringRec(@SListIndexError), Index2);
- Changing;
- ExchangeItems(Index1, Index2);
- Changed;
-end;
-
-procedure TTntStringList.ExchangeItems(Index1, Index2: Integer);
-var
- Temp: Integer;
- Item1, Item2: PWideStringItem;
-begin
- Item1 := @FList^[Index1];
- Item2 := @FList^[Index2];
- Temp := Integer(Item1^.FString);
- Integer(Item1^.FString) := Integer(Item2^.FString);
- Integer(Item2^.FString) := Temp;
- Temp := Integer(Item1^.FObject);
- Integer(Item1^.FObject) := Integer(Item2^.FObject);
- Integer(Item2^.FObject) := Temp;
-end;
-
-function TTntStringList.Find(const S: WideString; var Index: Integer): Boolean;
-var
- L, H, I, C: Integer;
-begin
- Result := False;
- L := 0;
- H := FCount - 1;
- while L <= H do
- begin
- I := (L + H) shr 1;
- C := CompareStrings(FList^[I].FString, S);
- if C < 0 then L := I + 1 else
- begin
- H := I - 1;
- if C = 0 then
- begin
- Result := True;
- if Duplicates <> dupAccept then L := I;
- end;
- end;
- end;
- Index := L;
-end;
-
-function TTntStringList.Get(Index: Integer): WideString;
-begin
- if (Index < 0) or (Index >= FCount) then Error(PResStringRec(@SListIndexError), Index);
- Result := FList^[Index].FString;
-end;
-
-function TTntStringList.GetCapacity: Integer;
-begin
- Result := FCapacity;
-end;
-
-function TTntStringList.GetCount: Integer;
-begin
- Result := FCount;
-end;
-
-function TTntStringList.GetObject(Index: Integer): TObject;
-begin
- if (Index < 0) or (Index >= FCount) then Error(PResStringRec(@SListIndexError), Index);
- Result := FList^[Index].FObject;
-end;
-
-procedure TTntStringList.Grow;
-var
- Delta: Integer;
-begin
- if FCapacity > 64 then Delta := FCapacity div 4 else
- if FCapacity > 8 then Delta := 16 else
- Delta := 4;
- SetCapacity(FCapacity + Delta);
-end;
-
-function TTntStringList.IndexOf(const S: WideString): Integer;
-begin
- if not Sorted then Result := inherited IndexOf(S) else
- if not Find(S, Result) then Result := -1;
-end;
-
-function TTntStringList.IndexOfName(const Name: WideString): Integer;
-var
- NameKey: WideString;
-begin
- if not Sorted then
- Result := inherited IndexOfName(Name)
- else begin
- // use sort to find index more quickly
- NameKey := Name + NameValueSeparator;
- Find(NameKey, Result);
- if (Result < 0) or (Result > Count - 1) then
- Result := -1
- else if CompareStrings(NameKey, Copy(Strings[Result], 1, Length(NameKey))) <> 0 then
- Result := -1
- end;
-end;
-
-procedure TTntStringList.Insert(Index: Integer; const S: WideString);
-begin
- InsertObject(Index, S, nil);
-end;
-
-procedure TTntStringList.InsertObject(Index: Integer; const S: WideString;
- AObject: TObject);
-begin
- if Sorted then Error(PResStringRec(@SSortedListError), 0);
- if (Index < 0) or (Index > FCount) then Error(PResStringRec(@SListIndexError), Index);
- InsertItem(Index, S, AObject);
-end;
-
-procedure TTntStringList.InsertItem(Index: Integer; const S: WideString; AObject: TObject);
-begin
- Changing;
- if FCount = FCapacity then Grow;
- if Index < FCount then
- System.Move(FList^[Index], FList^[Index + 1],
- (FCount - Index) * SizeOf(TWideStringItem));
- with FList^[Index] do
- begin
- Pointer(FString) := nil;
- FObject := AObject;
- FString := S;
- end;
- Inc(FCount);
- Changed;
-end;
-
-procedure TTntStringList.Put(Index: Integer; const S: WideString);
-begin
- if Sorted then Error(PResStringRec(@SSortedListError), 0);
- if (Index < 0) or (Index >= FCount) then Error(PResStringRec(@SListIndexError), Index);
- Changing;
- FList^[Index].FString := S;
- Changed;
-end;
-
-procedure TTntStringList.PutObject(Index: Integer; AObject: TObject);
-begin
- if (Index < 0) or (Index >= FCount) then Error(PResStringRec(@SListIndexError), Index);
- Changing;
- FList^[Index].FObject := AObject;
- Changed;
-end;
-
-procedure TTntStringList.QuickSort(L, R: Integer; SCompare: TWideStringListSortCompare);
-var
- I, J, P: Integer;
-begin
- repeat
- I := L;
- J := R;
- P := (L + R) shr 1;
- repeat
- while SCompare(Self, I, P) < 0 do Inc(I);
- while SCompare(Self, J, P) > 0 do Dec(J);
- if I <= J then
- begin
- ExchangeItems(I, J);
- if P = I then
- P := J
- else if P = J then
- P := I;
- Inc(I);
- Dec(J);
- end;
- until I > J;
- if L < J then QuickSort(L, J, SCompare);
- L := I;
- until I >= R;
-end;
-
-procedure TTntStringList.SetCapacity(NewCapacity: Integer);
-begin
- ReallocMem(FList, NewCapacity * SizeOf(TWideStringItem));
- FCapacity := NewCapacity;
-end;
-
-procedure TTntStringList.SetSorted(Value: Boolean);
-begin
- if FSorted <> Value then
- begin
- if Value then Sort;
- FSorted := Value;
- end;
-end;
-
-procedure TTntStringList.SetUpdateState(Updating: Boolean);
-begin
- FUpdating := Updating;
- if Updating then Changing else Changed;
-end;
-
-function WideStringListCompareStrings(List: TTntStringList; Index1, Index2: Integer): Integer;
-begin
- Result := List.CompareStrings(List.FList^[Index1].FString,
- List.FList^[Index2].FString);
-end;
-
-procedure TTntStringList.Sort;
-begin
- CustomSort(WideStringListCompareStrings);
-end;
-
-procedure TTntStringList.CustomSort(Compare: TWideStringListSortCompare);
-begin
- if not Sorted and (FCount > 1) then
- begin
- Changing;
- QuickSort(0, FCount - 1, Compare);
- Changed;
- end;
-end;
-
-function TTntStringList.CompareStrings(const S1, S2: WideString): Integer;
-begin
- if CaseSensitive then
- Result := WideCompareStr(S1, S2)
- else
- Result := WideCompareText(S1, S2);
-end;
-
-procedure TTntStringList.SetCaseSensitive(const Value: Boolean);
-begin
- if Value <> FCaseSensitive then
- begin
- FCaseSensitive := Value;
- if Sorted then Sort;
- end;
-end;
-
-//------------------------- TntClasses introduced procs ----------------------------------
-
-function AutoDetectCharacterSet(Stream: TStream): TTntStreamCharSet;
-var
- ByteOrderMark: WideChar;
- BytesRead: Integer;
- Utf8Test: array[0..2] of AnsiChar;
-begin
- // Byte Order Mark
- ByteOrderMark := #0;
- if (Stream.Size - Stream.Position) >= SizeOf(ByteOrderMark) then begin
- BytesRead := Stream.Read(ByteOrderMark, SizeOf(ByteOrderMark));
- if (ByteOrderMark <> UNICODE_BOM) and (ByteOrderMark <> UNICODE_BOM_SWAPPED) then begin
- ByteOrderMark := #0;
- Stream.Seek(-BytesRead, soFromCurrent);
- if (Stream.Size - Stream.Position) >= Length(Utf8Test) * SizeOf(AnsiChar) then begin
- BytesRead := Stream.Read(Utf8Test[0], Length(Utf8Test) * SizeOf(AnsiChar));
- if Utf8Test <> UTF8_BOM then
- Stream.Seek(-BytesRead, soFromCurrent);
- end;
- end;
- end;
- // Test Byte Order Mark
- if ByteOrderMark = UNICODE_BOM then
- Result := csUnicode
- else if ByteOrderMark = UNICODE_BOM_SWAPPED then
- Result := csUnicodeSwapped
- else if Utf8Test = UTF8_BOM then
- Result := csUtf8
- else
- Result := csAnsi;
-end;
-
-function FindSortedListByTarget(List: TList; TargetCompare: TListTargetCompare;
- Target: Pointer; var Index: Integer): Boolean;
-var
- L, H, I, C: Integer;
-begin
- Result := False;
- L := 0;
- H := List.Count - 1;
- while L <= H do
- begin
- I := (L + H) shr 1;
- C := TargetCompare(List[i], Target);
- if C < 0 then L := I + 1 else
- begin
- H := I - 1;
- if C = 0 then
- begin
- Result := True;
- L := I;
- end;
- end;
- end;
- Index := L;
-end;
-
-function ClassIsRegistered(const clsid: TCLSID): Boolean;
-var
- OleStr: POleStr;
- Reg: TRegIniFile;
- Key, Filename: WideString;
-begin
- // First, check to see if there is a ProgID. This will tell if the
- // control is registered on the machine. No ProgID, control won't run
- Result := ProgIDFromCLSID(clsid, OleStr) = S_OK;
- if not Result then Exit; //Bail as soon as anything goes wrong.
-
- // Next, make sure that the file is actually there by rooting it out
- // of the registry
- Key := WideFormat('\SOFTWARE\Classes\CLSID\%s', [GUIDToString(clsid)]);
- Reg := TRegIniFile.Create;
- try
- Reg.RootKey := HKEY_LOCAL_MACHINE;
- Result := Reg.OpenKeyReadOnly(Key);
- if not Result then Exit; // Bail as soon as anything goes wrong.
-
- FileName := Reg.ReadString('InProcServer32', '', EmptyStr);
- if (Filename = EmptyStr) then // try another key for the file name
- begin
- FileName := Reg.ReadString('InProcServer', '', EmptyStr);
- end;
- Result := Filename <> EmptyStr;
- if not Result then Exit;
- Result := WideFileExists(Filename);
- finally
- Reg.Free;
- end;
-end;
-
-{ TBufferedAnsiString }
-
-procedure TBufferedAnsiString.Clear;
-begin
- LastWriteIndex := 0;
- if Length(FStringBuffer) > 0 then
- FillChar(FStringBuffer[1], Length(FStringBuffer) * SizeOf(AnsiChar), 0);
-end;
-
-procedure TBufferedAnsiString.AddChar(const wc: AnsiChar);
-const
- MIN_GROW_SIZE = 32;
- MAX_GROW_SIZE = 256;
-var
- GrowSize: Integer;
-begin
- Inc(LastWriteIndex);
- if LastWriteIndex > Length(FStringBuffer) then begin
- GrowSize := Max(MIN_GROW_SIZE, Length(FStringBuffer));
- GrowSize := Min(GrowSize, MAX_GROW_SIZE);
- SetLength(FStringBuffer, Length(FStringBuffer) + GrowSize);
- FillChar(FStringBuffer[LastWriteIndex], GrowSize * SizeOf(AnsiChar), 0);
- end;
- FStringBuffer[LastWriteIndex] := wc;
-end;
-
-procedure TBufferedAnsiString.AddString(const s: AnsiString);
-var
- LenS: Integer;
- BlockSize: Integer;
- AllocSize: Integer;
-begin
- LenS := Length(s);
- if LenS > 0 then begin
- Inc(LastWriteIndex);
- if LastWriteIndex + LenS - 1 > Length(FStringBuffer) then begin
- // determine optimum new allocation size
- BlockSize := Length(FStringBuffer) div 2;
- if BlockSize < 8 then
- BlockSize := 8;
- AllocSize := ((LenS div BlockSize) + 1) * BlockSize;
- // realloc buffer
- SetLength(FStringBuffer, Length(FStringBuffer) + AllocSize);
- FillChar(FStringBuffer[Length(FStringBuffer) - AllocSize + 1], AllocSize * SizeOf(AnsiChar), 0);
- end;
- CopyMemory(@FStringBuffer[LastWriteIndex], @s[1], LenS * SizeOf(AnsiChar));
- Inc(LastWriteIndex, LenS - 1);
- end;
-end;
-
-procedure TBufferedAnsiString.AddBuffer(Buff: PAnsiChar; Chars: Integer);
-var
- i: integer;
-begin
- for i := 1 to Chars do begin
- if Buff^ = #0 then
- break;
- AddChar(Buff^);
- Inc(Buff);
- end;
-end;
-
-function TBufferedAnsiString.Value: AnsiString;
-begin
- Result := PAnsiChar(FStringBuffer);
-end;
-
-function TBufferedAnsiString.BuffPtr: PAnsiChar;
-begin
- Result := PAnsiChar(FStringBuffer);
-end;
-
-{ TBufferedWideString }
-
-procedure TBufferedWideString.Clear;
-begin
- LastWriteIndex := 0;
- if Length(FStringBuffer) > 0 then
- FillChar(FStringBuffer[1], Length(FStringBuffer) * SizeOf(WideChar), 0);
-end;
-
-procedure TBufferedWideString.AddChar(const wc: WideChar);
-const
- MIN_GROW_SIZE = 32;
- MAX_GROW_SIZE = 256;
-var
- GrowSize: Integer;
-begin
- Inc(LastWriteIndex);
- if LastWriteIndex > Length(FStringBuffer) then begin
- GrowSize := Max(MIN_GROW_SIZE, Length(FStringBuffer));
- GrowSize := Min(GrowSize, MAX_GROW_SIZE);
- SetLength(FStringBuffer, Length(FStringBuffer) + GrowSize);
- FillChar(FStringBuffer[LastWriteIndex], GrowSize * SizeOf(WideChar), 0);
- end;
- FStringBuffer[LastWriteIndex] := wc;
-end;
-
-procedure TBufferedWideString.AddString(const s: WideString);
-var
- i: integer;
-begin
- for i := 1 to Length(s) do
- AddChar(s[i]);
-end;
-
-procedure TBufferedWideString.AddBuffer(Buff: PWideChar; Chars: Integer);
-var
- i: integer;
-begin
- for i := 1 to Chars do begin
- if Buff^ = #0 then
- break;
- AddChar(Buff^);
- Inc(Buff);
- end;
-end;
-
-function TBufferedWideString.Value: WideString;
-begin
- Result := PWideChar(FStringBuffer);
-end;
-
-function TBufferedWideString.BuffPtr: PWideChar;
-begin
- Result := PWideChar(FStringBuffer);
-end;
-
-{ TBufferedStreamReader }
-
-constructor TBufferedStreamReader.Create(Stream: TStream; BufferSize: Integer = 1024);
-begin
- // init stream
- FStream := Stream;
- FStreamSize := Stream.Size;
- // init buffer
- FBufferSize := BufferSize;
- SetLength(FBuffer, BufferSize);
- FBufferStartPosition := -FBufferSize; { out of any useful range }
- // init virtual position
- FVirtualPosition := 0;
-end;
-
-function TBufferedStreamReader.Seek(Offset: Integer; Origin: Word): Longint;
-begin
- case Origin of
- soFromBeginning: FVirtualPosition := Offset;
- soFromCurrent: Inc(FVirtualPosition, Offset);
- soFromEnd: FVirtualPosition := FStreamSize + Offset;
- end;
- Result := FVirtualPosition;
-end;
-
-procedure TBufferedStreamReader.UpdateBufferFromPosition(StartPos: Integer);
-begin
- try
- FStream.Position := StartPos;
- FStream.Read(FBuffer[0], FBufferSize);
- FBufferStartPosition := StartPos;
- except
- FBufferStartPosition := -FBufferSize; { out of any useful range }
- raise;
- end;
-end;
-
-function TBufferedStreamReader.Read(var Buffer; Count: Integer): Longint;
-var
- BytesLeft: Integer;
- FirstBufferRead: Integer;
- StreamDirectRead: Integer;
- Buf: PAnsiChar;
-begin
- if (FVirtualPosition >= 0) and (Count >= 0) then
- begin
- Result := FStreamSize - FVirtualPosition;
- if Result > 0 then
- begin
- if Result > Count then
- Result := Count;
-
- Buf := @Buffer;
- BytesLeft := Result;
-
- // try to read what is left in buffer
- FirstBufferRead := FBufferStartPosition + FBufferSize - FVirtualPosition;
- if (FirstBufferRead < 0) or (FirstBufferRead > FBufferSize) then
- FirstBufferRead := 0;
- FirstBufferRead := Min(FirstBufferRead, Result);
- if FirstBufferRead > 0 then begin
- Move(FBuffer[FVirtualPosition - FBufferStartPosition], Buf[0], FirstBufferRead);
- Dec(BytesLeft, FirstBufferRead);
- end;
-
- if BytesLeft > 0 then begin
- // The first read in buffer was not enough
- StreamDirectRead := (BytesLeft div FBufferSize) * FBufferSize;
- FStream.Position := FVirtualPosition + FirstBufferRead;
- FStream.Read(Buf[FirstBufferRead], StreamDirectRead);
- Dec(BytesLeft, StreamDirectRead);
-
- if BytesLeft > 0 then begin
- // update buffer, and read what is left
- UpdateBufferFromPosition(FStream.Position);
- Move(FBuffer[0], Buf[FirstBufferRead + StreamDirectRead], BytesLeft);
- end;
- end;
-
- Inc(FVirtualPosition, Result);
- Exit;
- end;
- end;
- Result := 0;
-end;
-
-function TBufferedStreamReader.Write(const Buffer; Count: Integer): Longint;
-begin
- raise ETntInternalError.Create('Internal Error: class can not write.');
- Result := 0;
-end;
-
-//-------- synced wide string -----------------
-
-function GetSyncedWideString(var WideStr: WideString; const AnsiStr: AnsiString): WideString;
-begin
- if AnsiString(WideStr) <> (AnsiStr) then begin
- WideStr := AnsiStr; {AnsiStr changed. Keep WideStr in sync.}
- end;
- Result := WideStr;
-end;
-
-procedure SetSyncedWideString(const Value: WideString; var WideStr: WideString;
- const AnsiStr: AnsiString; SetAnsiStr: TSetAnsiStrEvent);
-begin
- if Value <> GetSyncedWideString(WideStr, AnsiStr) then
- begin
- if (not WideSameStr(Value, AnsiString(Value))) {unicode chars lost in conversion}
- and (AnsiStr = AnsiString(Value)) {AnsiStr is not going to change}
- then begin
- SetAnsiStr(''); {force the change}
- end;
- WideStr := Value;
- SetAnsiStr(Value);
- end;
-end;
-
-{ TWideComponentHelper }
-
-function CompareComponentHelperToTarget(Item, Target: Pointer): Integer;
-begin
- if PtrUInt(TWideComponentHelper(Item).FComponent) < PtrUInt(Target) then
- Result := -1
- else if PtrUInt(TWideComponentHelper(Item).FComponent) > PtrUInt(Target) then
- Result := 1
- else
- Result := 0;
-end;
-
-function FindWideComponentHelperIndex(ComponentHelperList: TComponentList; Component: TComponent; var Index: Integer): Boolean;
-begin
- // find Component in sorted wide caption list (list is sorted by TWideComponentHelper.FComponent)
- Result := FindSortedListByTarget(ComponentHelperList, CompareComponentHelperToTarget, Component, Index);
-end;
-
-constructor TWideComponentHelper.Create(AOwner: TComponent);
-begin
- raise ETntInternalError.Create('TNT Internal Error: TWideComponentHelper.Create should never be encountered.');
-end;
-
-constructor TWideComponentHelper.CreateHelper(AOwner: TComponent; ComponentHelperList: TComponentList);
-var
- Index: Integer;
-begin
- // don't use direct ownership for memory management
- inherited Create(nil);
- FComponent := AOwner;
- FComponent.FreeNotification(Self);
-
- // insert into list according to sort
- FindWideComponentHelperIndex(ComponentHelperList, FComponent, Index);
- ComponentHelperList.Insert(Index, Self);
-end;
-
-procedure TWideComponentHelper.Notification(AComponent: TComponent; Operation: TOperation);
-begin
- inherited;
- if (AComponent = FComponent) and (Operation = opRemove) then begin
- FComponent := nil;
- Free;
- end;
-end;
-
-function FindWideComponentHelper(ComponentHelperList: TComponentList; Component: TComponent): TWideComponentHelper;
-var
- Index: integer;
-begin
- if FindWideComponentHelperIndex(ComponentHelperList, Component, Index) then begin
- Result := TWideComponentHelper(ComponentHelperList[Index]);
- Assert(Result.FComponent = Component, 'TNT Internal Error: FindWideComponentHelperIndex failed.');
- end else
- Result := nil;
-end;
-
-initialization
- RuntimeUTFStreaming := False; { Delphi 6 and higher don't need UTF help at runtime. }
-
-end.
diff --git a/src/lib/TntUnicodeControls/TntFormatStrUtils.pas b/src/lib/TntUnicodeControls/TntFormatStrUtils.pas
deleted file mode 100644
index c6b65082..00000000
--- a/src/lib/TntUnicodeControls/TntFormatStrUtils.pas
+++ /dev/null
@@ -1,521 +0,0 @@
-
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntFormatStrUtils;
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-// this unit provides functions to work with format strings
-
-uses
- TntSysUtils;
-
-function GetCanonicalFormatStr(const _FormatString: WideString): WideString;
-
-{$IFNDEF FPC}
-{$IFNDEF COMPILER_9_UP}
-function ReplaceFloatingArgumentsInFormatString(const _FormatString: WideString;
- const Args: array of const
- {$IFDEF COMPILER_7_UP}; FormatSettings: PFormatSettings{$ENDIF}): WideString;
-{$ENDIF}
-{$ENDIF}
-procedure CompareFormatStrings(FormatStr1, FormatStr2: WideString);
-function FormatStringsAreCompatible(FormatStr1, FormatStr2: WideString): Boolean;
-
-type
- EFormatSpecError = class(ETntGeneralError);
-
-implementation
-
-uses
- SysUtils, Math, TntClasses;
-
-resourcestring
- SInvalidFormatSpecifier = 'Invalid Format Specifier: %s';
- SMismatchedArgumentTypes = 'Argument types for index %d do not match. (%s <> %s)';
- SMismatchedArgumentCounts = 'Number of format specifiers do not match.';
-
-type
- TFormatSpecifierType = (fstInteger, fstFloating, fstPointer, fstString);
-
-function GetFormatSpecifierType(const FormatSpecifier: WideString): TFormatSpecifierType;
-var
- LastChar: WideChar;
-begin
- LastChar := TntWideLastChar(FormatSpecifier);
- case LastChar of
- 'd', 'D', 'u', 'U', 'x', 'X':
- result := fstInteger;
- 'e', 'E', 'f', 'F', 'g', 'G', 'n', 'N', 'm', 'M':
- result := fstFloating;
- 'p', 'P':
- result := fstPointer;
- 's', 'S':
- result := fstString
- else
- raise ETntInternalError.CreateFmt('Internal Error: Unexpected format type (%s)', [LastChar]);
- end;
-end;
-
-type
- TFormatStrParser = class(TObject)
- private
- ParsedString: TBufferedWideString;
- PFormatString: PWideChar;
- LastIndex: Integer;
- ExplicitCount: Integer;
- ImplicitCount: Integer;
- procedure RaiseInvalidFormatSpecifier;
- function ParseChar(c: WideChar): Boolean;
- procedure ForceParseChar(c: WideChar);
- function ParseDigit: Boolean;
- function ParseInteger: Boolean;
- procedure ForceParseType;
- function PeekDigit: Boolean;
- function PeekIndexSpecifier(out Index: Integer): Boolean;
- public
- constructor Create(const _FormatString: WideString);
- destructor Destroy; override;
- function ParseFormatSpecifier: Boolean;
- end;
-
-constructor TFormatStrParser.Create(const _FormatString: WideString);
-begin
- inherited Create;
- PFormatString := PWideChar(_FormatString);
- ExplicitCount := 0;
- ImplicitCount := 0;
- LastIndex := -1;
- ParsedString := TBufferedWideString.Create;
-end;
-
-destructor TFormatStrParser.Destroy;
-begin
- FreeAndNil(ParsedString);
- inherited;
-end;
-
-procedure TFormatStrParser.RaiseInvalidFormatSpecifier;
-begin
- raise EFormatSpecError.CreateFmt(SInvalidFormatSpecifier, [ParsedString.Value + PFormatString]);
-end;
-
-function TFormatStrParser.ParseChar(c: WideChar): Boolean;
-begin
- result := False;
- if PFormatString^ = c then begin
- result := True;
- ParsedString.AddChar(c);
- Inc(PFormatString);
- end;
-end;
-
-procedure TFormatStrParser.ForceParseChar(c: WideChar);
-begin
- if not ParseChar(c) then
- RaiseInvalidFormatSpecifier;
-end;
-
-function TFormatStrParser.PeekDigit: Boolean;
-begin
- result := False;
- if (PFormatString^ <> #0)
- and (PFormatString^ >= '0')
- and (PFormatString^ <= '9') then
- result := True;
-end;
-
-function TFormatStrParser.ParseDigit: Boolean;
-begin
- result := False;
- if PeekDigit then begin
- result := True;
- ForceParseChar(PFormatString^);
- end;
-end;
-
-function TFormatStrParser.ParseInteger: Boolean;
-const
- MAX_INT_DIGITS = 6;
-var
- digitcount: integer;
-begin
- digitcount := 0;
- While ParseDigit do begin
- inc(digitcount);
- end;
- result := (digitcount > 0);
- if digitcount > MAX_INT_DIGITS then
- RaiseInvalidFormatSpecifier;
-end;
-
-procedure TFormatStrParser.ForceParseType;
-begin
- if PFormatString^ = #0 then
- RaiseInvalidFormatSpecifier;
-
- case PFormatString^ of
- 'd', 'u', 'x', 'e', 'f', 'g', 'n', 'm', 'p', 's',
- 'D', 'U', 'X', 'E', 'F', 'G', 'N', 'M', 'P', 'S':
- begin
- // do nothing
- end
- else
- RaiseInvalidFormatSpecifier;
- end;
- ForceParseChar(PFormatString^);
-end;
-
-function TFormatStrParser.PeekIndexSpecifier(out Index: Integer): Boolean;
-var
- SaveParsedString: WideString;
- SaveFormatString: PWideChar;
-begin
- SaveParsedString := ParsedString.Value;
- SaveFormatString := PFormatString;
- try
- ParsedString.Clear;
- Result := False;
- Index := -1;
- if ParseInteger then begin
- Index := StrToInt(ParsedString.Value);
- if ParseChar(':') then
- Result := True;
- end;
- finally
- ParsedString.Clear;
- ParsedString.AddString(SaveParsedString);
- PFormatString := SaveFormatString;
- end;
-end;
-
-function TFormatStrParser.ParseFormatSpecifier: Boolean;
-var
- ExplicitIndex: Integer;
-begin
- Result := False;
- // Parse entire format specifier
- ForceParseChar('%');
- if (PFormatString^ <> #0)
- and (not ParseChar(' '))
- and (not ParseChar('%')) then begin
- if PeekIndexSpecifier(ExplicitIndex) then begin
- Inc(ExplicitCount);
- LastIndex := Max(LastIndex, ExplicitIndex);
- end else begin
- Inc(ImplicitCount);
- Inc(LastIndex);
- ParsedString.AddString(IntToStr(LastIndex));
- ParsedString.AddChar(':');
- end;
- if ParseChar('*') then
- begin
- Inc(ImplicitCount);
- Inc(LastIndex);
- ParseChar(':');
- end else if ParseInteger then
- ParseChar(':');
- ParseChar('-');
- if ParseChar('*') then begin
- Inc(ImplicitCount);
- Inc(LastIndex);
- end else
- ParseInteger;
- if ParseChar('.') then begin
- if not ParseChar('*') then
- ParseInteger;
- end;
- ForceParseType;
- Result := True;
- end;
-end;
-
-//-----------------------------------
-
-function GetCanonicalFormatStr(const _FormatString: WideString): WideString;
-var
- PosSpec: Integer;
-begin
- with TFormatStrParser.Create(_FormatString) do
- try
- // loop until no more '%'
- PosSpec := Pos('%', PFormatString);
- While PosSpec <> 0 do begin
- try
- // delete everything up until '%'
- ParsedString.AddBuffer(PFormatString, PosSpec - 1);
- Inc(PFormatString, PosSpec - 1);
- // parse format specifier
- ParseFormatSpecifier;
- finally
- PosSpec := Pos('%', PFormatString);
- end;
- end;
- if ((ExplicitCount = 0) and (ImplicitCount = 1)) {simple expression}
- or ((ExplicitCount > 0) and (ImplicitCount = 0)) {nothing converted} then
- result := _FormatString {original}
- else
- result := ParsedString.Value + PFormatString;
- finally
- Free;
- end;
-end;
-
-{$IFNDEF FPC}
-{$IFNDEF COMPILER_9_UP}
-function ReplaceFloatingArgumentsInFormatString(const _FormatString: WideString;
- const Args: array of const
- {$IFDEF COMPILER_7_UP}; FormatSettings: PFormatSettings{$ENDIF}): WideString;
-{ This function replaces floating point format specifiers with their actual formatted values.
- It also adds index specifiers so that the other format specifiers don't lose their place.
- The reason for this is that WideFormat doesn't correctly format floating point specifiers.
- See QC#4254. }
-var
- Parser: TFormatStrParser;
- PosSpec: Integer;
- Output: TBufferedWideString;
-begin
- Output := TBufferedWideString.Create;
- try
- Parser := TFormatStrParser.Create(_FormatString);
- with Parser do
- try
- // loop until no more '%'
- PosSpec := Pos('%', PFormatString);
- While PosSpec <> 0 do begin
- try
- // delete everything up until '%'
- Output.AddBuffer(PFormatString, PosSpec - 1);
- Inc(PFormatString, PosSpec - 1);
- // parse format specifier
- ParsedString.Clear;
- if (not ParseFormatSpecifier)
- or (GetFormatSpecifierType(ParsedString.Value) <> fstFloating) then
- Output.AddBuffer(ParsedString.BuffPtr, MaxInt)
- {$IFDEF COMPILER_7_UP}
- else if Assigned(FormatSettings) then
- Output.AddString(Format{TNT-ALLOW Format}(ParsedString.Value, Args, FormatSettings^))
- {$ENDIF}
- else
- Output.AddString(Format{TNT-ALLOW Format}(ParsedString.Value, Args));
- finally
- PosSpec := Pos('%', PFormatString);
- end;
- end;
- Output.AddString(PFormatString);
- finally
- Free;
- end;
- Result := Output.Value;
- finally
- Output.Free;
- end;
-end;
-{$ENDIF}
-{$ENDIF}
-
-procedure GetFormatArgs(const _FormatString: WideString; FormatArgs: TTntStrings);
-var
- PosSpec: Integer;
-begin
- with TFormatStrParser.Create(_FormatString) do
- try
- FormatArgs.Clear;
- // loop until no more '%'
- PosSpec := Pos('%', PFormatString);
- While PosSpec <> 0 do begin
- try
- // delete everything up until '%'
- Inc(PFormatString, PosSpec - 1);
- // add format specifier to list
- ParsedString.Clear;
- if ParseFormatSpecifier then
- FormatArgs.Add(ParsedString.Value);
- finally
- PosSpec := Pos('%', PFormatString);
- end;
- end;
- finally
- Free;
- end;
-end;
-
-function GetExplicitIndex(const FormatSpecifier: WideString): Integer;
-var
- IndexStr: WideString;
- PosColon: Integer;
-begin
- result := -1;
- PosColon := Pos(':', FormatSpecifier);
- if PosColon <> 0 then begin
- IndexStr := Copy(FormatSpecifier, 2, PosColon - 2);
- result := StrToInt(IndexStr);
- end;
-end;
-
-function GetMaxIndex(FormatArgs: TTntStrings): Integer;
-var
- i: integer;
- RunningIndex: Integer;
- ExplicitIndex: Integer;
-begin
- result := -1;
- RunningIndex := -1;
- for i := 0 to FormatArgs.Count - 1 do begin
- ExplicitIndex := GetExplicitIndex(FormatArgs[i]);
- if ExplicitIndex <> -1 then
- RunningIndex := ExplicitIndex
- else
- inc(RunningIndex);
- result := Max(result, RunningIndex);
- end;
-end;
-
-function FormatSpecToObject(SpecType: TFormatSpecifierType): TObject;
-begin
- {$IFNDEF FPC}
- Result := TObject(SpecType);
- {$ELSE}
- Result := Pointer(SpecType);
- {$ENDIF}
-end;
-
-procedure UpdateTypeList(FormatArgs, TypeList: TTntStrings);
-var
- i: integer;
- f: WideString;
- SpecType: TFormatSpecifierType;
- ExplicitIndex: Integer;
- MaxIndex: Integer;
- RunningIndex: Integer;
-begin
- // set count of TypeList to accomodate maximum index
- MaxIndex := GetMaxIndex(FormatArgs);
- TypeList.Clear;
- for i := 0 to MaxIndex do
- TypeList.Add('');
-
- // for each arg...
- RunningIndex := -1;
- for i := 0 to FormatArgs.Count - 1 do begin
- f := FormatArgs[i];
- ExplicitIndex := GetExplicitIndex(f);
- SpecType := GetFormatSpecifierType(f);
-
- // determine running arg index
- if ExplicitIndex <> -1 then
- RunningIndex := ExplicitIndex
- else
- inc(RunningIndex);
-
- if TypeList[RunningIndex] <> '' then begin
- // already exists in list, check for compatibility
- if TypeList.Objects[RunningIndex] <> FormatSpecToObject(SpecType) then
- raise EFormatSpecError.CreateFmt(SMismatchedArgumentTypes,
- [RunningIndex, TypeList[RunningIndex], f]);
- end else begin
- // not in list so update it
- TypeList[RunningIndex] := f;
- TypeList.Objects[RunningIndex] := FormatSpecToObject(SpecType);
- end;
- end;
-end;
-
-procedure CompareFormatStrings(FormatStr1, FormatStr2: WideString);
-var
- ArgList1: TTntStringList;
- ArgList2: TTntStringList;
- TypeList1: TTntStringList;
- TypeList2: TTntStringList;
- i: integer;
-begin
- ArgList1 := nil;
- ArgList2 := nil;
- TypeList1 := nil;
- TypeList2 := nil;
- try
- ArgList1 := TTntStringList.Create;
- ArgList2 := TTntStringList.Create;
- TypeList1 := TTntStringList.Create;
- TypeList2 := TTntStringList.Create;
-
- GetFormatArgs(FormatStr1, ArgList1);
- UpdateTypeList(ArgList1, TypeList1);
-
- GetFormatArgs(FormatStr2, ArgList2);
- UpdateTypeList(ArgList2, TypeList2);
-
- if TypeList1.Count <> TypeList2.Count then
- raise EFormatSpecError.Create(SMismatchedArgumentCounts + CRLF + CRLF + '> ' + FormatStr1 + CRLF + '> ' + FormatStr2);
-
- for i := 0 to TypeList1.Count - 1 do begin
- if TypeList1.Objects[i] <> TypeList2.Objects[i] then begin
- raise EFormatSpecError.CreateFmt(SMismatchedArgumentTypes,
- [i, TypeList1[i], TypeList2[i]]);
- end;
- end;
-
- finally
- ArgList1.Free;
- ArgList2.Free;
- TypeList1.Free;
- TypeList2.Free;
- end;
-end;
-
-function FormatStringsAreCompatible(FormatStr1, FormatStr2: WideString): Boolean;
-var
- ArgList1: TTntStringList;
- ArgList2: TTntStringList;
- TypeList1: TTntStringList;
- TypeList2: TTntStringList;
- i: integer;
-begin
- ArgList1 := nil;
- ArgList2 := nil;
- TypeList1 := nil;
- TypeList2 := nil;
- try
- ArgList1 := TTntStringList.Create;
- ArgList2 := TTntStringList.Create;
- TypeList1 := TTntStringList.Create;
- TypeList2 := TTntStringList.Create;
-
- GetFormatArgs(FormatStr1, ArgList1);
- UpdateTypeList(ArgList1, TypeList1);
-
- GetFormatArgs(FormatStr2, ArgList2);
- UpdateTypeList(ArgList2, TypeList2);
-
- Result := (TypeList1.Count = TypeList2.Count);
- if Result then begin
- for i := 0 to TypeList1.Count - 1 do begin
- if TypeList1.Objects[i] <> TypeList2.Objects[i] then begin
- Result := False;
- break;
- end;
- end;
- end;
- finally
- ArgList1.Free;
- ArgList2.Free;
- TypeList1.Free;
- TypeList2.Free;
- end;
-end;
-
-end.
diff --git a/src/lib/TntUnicodeControls/TntSysUtils.pas b/src/lib/TntUnicodeControls/TntSysUtils.pas
deleted file mode 100644
index b7cf2467..00000000
--- a/src/lib/TntUnicodeControls/TntSysUtils.pas
+++ /dev/null
@@ -1,1753 +0,0 @@
-
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntSysUtils;
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-{ TODO: Consider: more filename functions from SysUtils }
-{ TODO: Consider: string functions from StrUtils. }
-
-uses
- Types, SysUtils, Windows, TntWindows;
-
-//---------------------------------------------------------------------------------------------
-// Tnt - Types
-//---------------------------------------------------------------------------------------------
-
-// ......... introduced .........
-type
- // The user of the application did something plainly wrong.
- ETntUserError = class(Exception);
- // A general error occured. (ie. file didn't exist, server didn't return data, etc.)
- ETntGeneralError = class(Exception);
- // Like Assert(). An error occured that should never have happened, send me a bug report now!
- ETntInternalError = class(Exception);
-
-{$IFNDEF FPC}
-type
- PtrInt = LongInt;
- PtrUInt = LongWord;
-{$ENDIF}
-
-//---------------------------------------------------------------------------------------------
-// Tnt - SysUtils
-//---------------------------------------------------------------------------------------------
-
-// ......... SBCS and MBCS functions with WideString replacements in SysUtils.pas .........
-
-{TNT-WARN CompareStr} {TNT-WARN AnsiCompareStr}
-{TNT-WARN SameStr} {TNT-WARN AnsiSameStr}
-{TNT-WARN SameText} {TNT-WARN AnsiSameText}
-{TNT-WARN CompareText} {TNT-WARN AnsiCompareText}
-{TNT-WARN UpperCase} {TNT-WARN AnsiUpperCase}
-{TNT-WARN LowerCase} {TNT-WARN AnsiLowerCase}
-
-{TNT-WARN AnsiPos} { --> Pos() supports WideString. }
-{TNT-WARN FmtStr}
-{TNT-WARN Format}
-{TNT-WARN FormatBuf}
-
-// ......... MBCS Byte Type Procs .........
-
-{TNT-WARN ByteType}
-{TNT-WARN StrByteType}
-{TNT-WARN ByteToCharIndex}
-{TNT-WARN ByteToCharLen}
-{TNT-WARN CharToByteIndex}
-{TNT-WARN CharToByteLen}
-
-// ........ null-terminated string functions .........
-
-{TNT-WARN StrEnd}
-{TNT-WARN StrLen}
-{TNT-WARN StrLCopy}
-{TNT-WARN StrCopy}
-{TNT-WARN StrECopy}
-{TNT-WARN StrPLCopy}
-{TNT-WARN StrPCopy}
-{TNT-WARN StrLComp}
-{TNT-WARN AnsiStrLComp}
-{TNT-WARN StrComp}
-{TNT-WARN AnsiStrComp}
-{TNT-WARN StrLIComp}
-{TNT-WARN AnsiStrLIComp}
-{TNT-WARN StrIComp}
-{TNT-WARN AnsiStrIComp}
-{TNT-WARN StrLower}
-{TNT-WARN AnsiStrLower}
-{TNT-WARN StrUpper}
-{TNT-WARN AnsiStrUpper}
-{TNT-WARN StrPos}
-{TNT-WARN AnsiStrPos}
-{TNT-WARN StrScan}
-{TNT-WARN AnsiStrScan}
-{TNT-WARN StrRScan}
-{TNT-WARN AnsiStrRScan}
-{TNT-WARN StrLCat}
-{TNT-WARN StrCat}
-{TNT-WARN StrMove}
-{TNT-WARN StrPas}
-{TNT-WARN StrAlloc}
-{TNT-WARN StrBufSize}
-{TNT-WARN StrNew}
-{TNT-WARN StrDispose}
-
-{TNT-WARN AnsiExtractQuotedStr}
-{TNT-WARN AnsiLastChar}
-{TNT-WARN AnsiStrLastChar}
-{TNT-WARN QuotedStr}
-{TNT-WARN AnsiQuotedStr}
-{TNT-WARN AnsiDequotedStr}
-
-// ........ string functions .........
-
-{$IFNDEF FPC}
-{$IFNDEF COMPILER_9_UP}
- //
- // pre-Delphi 9 issues w/ WideFormatBuf, WideFmtStr and WideFormat
- //
-
- {$IFDEF COMPILER_7_UP}
- type
- PFormatSettings = ^TFormatSettings;
- {$ENDIF}
-
- // SysUtils.WideFormatBuf doesn't correctly handle numeric specifiers.
- function Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
- FmtLen: Cardinal; const Args: array of const): Cardinal; {$IFDEF COMPILER_7_UP} overload; {$ENDIF}
-
- {$IFDEF COMPILER_7_UP}
- function Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
- FmtLen: Cardinal; const Args: array of const;
- const FormatSettings: TFormatSettings): Cardinal; overload;
- {$ENDIF}
-
- // SysUtils.WideFmtStr doesn't handle string lengths > 4096.
- procedure Tnt_WideFmtStr(var Result: WideString; const FormatStr: WideString;
- const Args: array of const); {$IFDEF COMPILER_7_UP} overload; {$ENDIF}
-
- {$IFDEF COMPILER_7_UP}
- procedure Tnt_WideFmtStr(var Result: WideString; const FormatStr: WideString;
- const Args: array of const; const FormatSettings: TFormatSettings); overload;
- {$ENDIF}
-
- {----------------------------------------------------------------------------------------
- Without the FormatSettings parameter, Tnt_WideFormat is *NOT* necessary...
- TntSystem.InstallTntSystemUpdates([tsFixWideFormat]);
- will fix WideFormat as well as WideFmtStr.
- ----------------------------------------------------------------------------------------}
- function Tnt_WideFormat(const FormatStr: WideString; const Args: array of const): WideString; {$IFDEF COMPILER_7_UP} overload; {$ENDIF}
-
- {$IFDEF COMPILER_7_UP}
- function Tnt_WideFormat(const FormatStr: WideString; const Args: array of const;
- const FormatSettings: TFormatSettings): WideString; overload;
- {$ENDIF}
-
-{$ENDIF}
-{$ENDIF}
-
-{TNT-WARN WideUpperCase} // SysUtils.WideUpperCase is broken on Win9x for D6, D7, D9.
-function Tnt_WideUpperCase(const S: WideString): WideString;
-{TNT-WARN WideLowerCase} // SysUtils.WideLowerCase is broken on Win9x for D6, D7, D9.
-function Tnt_WideLowerCase(const S: WideString): WideString;
-
-function TntWideLastChar(const S: WideString): WideChar;
-
-{TNT-WARN StringReplace}
-{TNT-WARN WideStringReplace} // <-- WideStrUtils.WideStringReplace uses SysUtils.WideUpperCase which is broken on Win9x.
-function Tnt_WideStringReplace(const S, OldPattern, NewPattern: WideString;
- Flags: TReplaceFlags; WholeWord: Boolean = False): WideString;
-
-{TNT-WARN AdjustLineBreaks}
-type TTntTextLineBreakStyle = (tlbsLF, tlbsCRLF, tlbsCR);
-function TntAdjustLineBreaksLength(const S: WideString; Style: TTntTextLineBreakStyle = tlbsCRLF): Integer;
-function TntAdjustLineBreaks(const S: WideString; Style: TTntTextLineBreakStyle = tlbsCRLF): WideString;
-
-{TNT-WARN WrapText}
-function WideWrapText(const Line, BreakStr: WideString; const BreakChars: TSysCharSet;
- MaxCol: Integer): WideString; overload;
-function WideWrapText(const Line: WideString; MaxCol: Integer): WideString; overload;
-
-// ........ filename manipulation .........
-
-{TNT-WARN SameFileName} // doesn't apply to Unicode filenames, use WideSameText
-{TNT-WARN AnsiCompareFileName} // doesn't apply to Unicode filenames, use WideCompareText
-{TNT-WARN AnsiLowerCaseFileName} // doesn't apply to Unicode filenames, use WideLowerCase
-{TNT-WARN AnsiUpperCaseFileName} // doesn't apply to Unicode filenames, use WideUpperCase
-
-{TNT-WARN IncludeTrailingBackslash}
-function WideIncludeTrailingBackslash(const S: WideString): WideString;
-{TNT-WARN IncludeTrailingPathDelimiter}
-function WideIncludeTrailingPathDelimiter(const S: WideString): WideString;
-{TNT-WARN ExcludeTrailingBackslash}
-function WideExcludeTrailingBackslash(const S: WideString): WideString;
-{TNT-WARN ExcludeTrailingPathDelimiter}
-function WideExcludeTrailingPathDelimiter(const S: WideString): WideString;
-{TNT-WARN IsDelimiter}
-function WideIsDelimiter(const Delimiters, S: WideString; Index: Integer): Boolean;
-{TNT-WARN IsPathDelimiter}
-function WideIsPathDelimiter(const S: WideString; Index: Integer): Boolean;
-{TNT-WARN LastDelimiter}
-function WideLastDelimiter(const Delimiters, S: WideString): Integer;
-{TNT-WARN ChangeFileExt}
-function WideChangeFileExt(const FileName, Extension: WideString): WideString;
-{TNT-WARN ExtractFilePath}
-function WideExtractFilePath(const FileName: WideString): WideString;
-{TNT-WARN ExtractFileDir}
-function WideExtractFileDir(const FileName: WideString): WideString;
-{TNT-WARN ExtractFileDrive}
-function WideExtractFileDrive(const FileName: WideString): WideString;
-{TNT-WARN ExtractFileName}
-function WideExtractFileName(const FileName: WideString): WideString;
-{TNT-WARN ExtractFileExt}
-function WideExtractFileExt(const FileName: WideString): WideString;
-{TNT-WARN ExtractRelativePath}
-function WideExtractRelativePath(const BaseName, DestName: WideString): WideString;
-
-// ........ file management routines .........
-
-{TNT-WARN ExpandFileName}
-function WideExpandFileName(const FileName: WideString): WideString;
-{TNT-WARN ExtractShortPathName}
-function WideExtractShortPathName(const FileName: WideString): WideString;
-{TNT-WARN FileCreate}
-function WideFileCreate(const FileName: WideString): Integer;
-{TNT-WARN FileOpen}
-function WideFileOpen(const FileName: WideString; Mode: LongWord): Integer;
-{TNT-WARN FileAge}
-function WideFileAge(const FileName: WideString): Integer; overload;
-function WideFileAge(const FileName: WideString; out FileDateTime: TDateTime): Boolean; overload;
-{TNT-WARN DirectoryExists}
-function WideDirectoryExists(const Name: WideString): Boolean;
-{TNT-WARN FileExists}
-function WideFileExists(const Name: WideString): Boolean;
-{TNT-WARN FileGetAttr}
-function WideFileGetAttr(const FileName: WideString): Cardinal;
-{TNT-WARN FileSetAttr}
-function WideFileSetAttr(const FileName: WideString; Attr: Integer): Boolean;
-{TNT-WARN FileIsReadOnly}
-function WideFileIsReadOnly(const FileName: WideString): Boolean;
-{TNT-WARN FileSetReadOnly}
-function WideFileSetReadOnly(const FileName: WideString; ReadOnly: Boolean): Boolean;
-{TNT-WARN ForceDirectories}
-function WideForceDirectories(Dir: WideString): Boolean;
-{TNT-WARN FileSearch}
-function WideFileSearch(const Name, DirList: WideString): WideString;
-{TNT-WARN RenameFile}
-function WideRenameFile(const OldName, NewName: WideString): Boolean;
-{TNT-WARN DeleteFile}
-function WideDeleteFile(const FileName: WideString): Boolean;
-{TNT-WARN CopyFile}
-function WideCopyFile(const FromFile, ToFile: WideString; FailIfExists: Boolean): Boolean;
-
-
-{TNT-WARN TFileName}
-type
- TWideFileName = type WideString;
-
-{TNT-WARN TSearchRec} // <-- FindFile - warning on TSearchRec is all that is necessary
-type
- TSearchRecW = record
- Time: Integer;
- Size: Int64;
- Attr: Integer;
- Name: TWideFileName;
- ExcludeAttr: Integer;
- FindHandle: THandle;
- FindData: TWin32FindDataW;
- end;
-function WideFindFirst(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer;
-function WideFindNext(var F: TSearchRecW): Integer;
-procedure WideFindClose(var F: TSearchRecW);
-
-{TNT-WARN CreateDir}
-function WideCreateDir(const Dir: WideString): Boolean;
-{TNT-WARN RemoveDir}
-function WideRemoveDir(const Dir: WideString): Boolean;
-{TNT-WARN GetCurrentDir}
-function WideGetCurrentDir: WideString;
-{TNT-WARN SetCurrentDir}
-function WideSetCurrentDir(const Dir: WideString): Boolean;
-
-
-// ........ date/time functions .........
-
-{TNT-WARN TryStrToDateTime}
-function TntTryStrToDateTime(Str: WideString; out DateTime: TDateTime): Boolean;
-{TNT-WARN TryStrToDate}
-function TntTryStrToDate(Str: WideString; out DateTime: TDateTime): Boolean;
-{TNT-WARN TryStrToTime}
-function TntTryStrToTime(Str: WideString; out DateTime: TDateTime): Boolean;
-
-{ introduced }
-function ValidDateTimeStr(Str: WideString): Boolean;
-function ValidDateStr(Str: WideString): Boolean;
-function ValidTimeStr(Str: WideString): Boolean;
-
-{TNT-WARN StrToDateTime}
-function TntStrToDateTime(Str: WideString): TDateTime;
-{TNT-WARN StrToDate}
-function TntStrToDate(Str: WideString): TDateTime;
-{TNT-WARN StrToTime}
-function TntStrToTime(Str: WideString): TDateTime;
-{TNT-WARN StrToDateTimeDef}
-function TntStrToDateTimeDef(Str: WideString; Default: TDateTime): TDateTime;
-{TNT-WARN StrToDateDef}
-function TntStrToDateDef(Str: WideString; Default: TDateTime): TDateTime;
-{TNT-WARN StrToTimeDef}
-function TntStrToTimeDef(Str: WideString; Default: TDateTime): TDateTime;
-
-{TNT-WARN CurrToStr}
-{TNT-WARN CurrToStrF}
-function TntCurrToStr(Value: Currency; lpFormat: PCurrencyFmtW = nil): WideString;
-{TNT-WARN StrToCurr}
-function TntStrToCurr(const S: WideString): Currency;
-{TNT-WARN StrToCurrDef}
-function ValidCurrencyStr(const S: WideString): Boolean;
-function TntStrToCurrDef(const S: WideString; const Default: Currency): Currency;
-function GetDefaultCurrencyFmt: TCurrencyFmtW;
-
-// ........ misc functions .........
-
-{TNT-WARN GetLocaleStr}
-function WideGetLocaleStr(LocaleID: LCID; LocaleType: Integer; const Default: WideString): WideString;
-{TNT-WARN SysErrorMessage}
-function WideSysErrorMessage(ErrorCode: Integer): WideString;
-
-// ......... introduced .........
-
-function WideLibraryErrorMessage(const LibName: WideString; Dll: THandle; ErrorCode: Integer): WideString;
-
-const
- CR = WideChar(#13);
- LF = WideChar(#10);
- CRLF = WideString(#13#10);
- WideLineSeparator = WideChar($2028);
-
-var
- Win32PlatformIsUnicode: Boolean;
- Win32PlatformIsXP: Boolean;
- Win32PlatformIs2003: Boolean;
- Win32PlatformIsVista: Boolean;
-
-{$IFNDEF FPC}
-{$IFNDEF COMPILER_7_UP}
-function CheckWin32Version(AMajor: Integer; AMinor: Integer = 0): Boolean;
-{$ENDIF}
-{$ENDIF}
-function WinCheckH(RetVal: Cardinal): Cardinal;
-function WinCheckFileH(RetVal: Cardinal): Cardinal;
-function WinCheckP(RetVal: Pointer): Pointer;
-
-function WideGetModuleFileName(Instance: HModule): WideString;
-function WideSafeLoadLibrary(const Filename: Widestring;
- ErrorMode: UINT = SEM_NOOPENFILEERRORBOX): HMODULE;
-{$IFNDEF FPC}
-function WideLoadPackage(const Name: Widestring): HMODULE;
-{$ENDIF}
-
-function IsWideCharUpper(WC: WideChar): Boolean;
-function IsWideCharLower(WC: WideChar): Boolean;
-function IsWideCharDigit(WC: WideChar): Boolean;
-function IsWideCharSpace(WC: WideChar): Boolean;
-function IsWideCharPunct(WC: WideChar): Boolean;
-function IsWideCharCntrl(WC: WideChar): Boolean;
-function IsWideCharBlank(WC: WideChar): Boolean;
-function IsWideCharXDigit(WC: WideChar): Boolean;
-function IsWideCharAlpha(WC: WideChar): Boolean;
-function IsWideCharAlphaNumeric(WC: WideChar): Boolean;
-
-function WideTextPos(const SubStr, S: WideString): Integer;
-
-function ExtractStringArrayStr(P: PWideChar): WideString;
-function ExtractStringFromStringArray(var P: PWideChar; Separator: WideChar = #0): WideString;
-function ExtractStringsFromStringArray(P: PWideChar; Separator: WideChar = #0): TWideStringDynArray;
-
-function IsWideCharMappableToAnsi(const WC: WideChar): Boolean;
-function IsWideStringMappableToAnsi(const WS: WideString): Boolean;
-function IsRTF(const Value: WideString): Boolean;
-
-function ENG_US_FloatToStr(Value: Extended): WideString;
-function ENG_US_StrToFloat(const S: WideString): Extended;
-
-//---------------------------------------------------------------------------------------------
-// Tnt - Variants
-//---------------------------------------------------------------------------------------------
-
-// ........ Variants.pas has WideString versions of these functions .........
-{TNT-WARN VarToStr}
-{TNT-WARN VarToStrDef}
-
-var
- _SettingChangeTime: Cardinal;
-
-implementation
-
-uses
- ActiveX, ComObj, SysConst,
- {$IFDEF COMPILER_9_UP} WideStrUtils, {$ENDIF} TntWideStrUtils,
- TntSystem, TntFormatStrUtils;
-
-//---------------------------------------------------------------------------------------------
-// Tnt - SysUtils
-//---------------------------------------------------------------------------------------------
-
-{$IFNDEF FPC}
-{$IFNDEF COMPILER_9_UP}
-
- function _Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
- FmtLen: Cardinal; const Args: array of const
- {$IFDEF COMPILER_7_UP}; const FormatSettings: PFormatSettings {$ENDIF}): Cardinal;
- var
- OldFormat: WideString;
- NewFormat: WideString;
- begin
- SetString(OldFormat, PWideChar(@FormatStr), FmtLen);
- { The reason for this is that WideFormat doesn't correctly format floating point specifiers.
- See QC#4254. }
- NewFormat := ReplaceFloatingArgumentsInFormatString(OldFormat, Args{$IFDEF COMPILER_7_UP}, FormatSettings{$ENDIF});
- {$IFDEF COMPILER_7_UP}
- if FormatSettings <> nil then
- Result := WideFormatBuf(Buffer, BufLen, Pointer(NewFormat)^,
- Length(NewFormat), Args, FormatSettings^)
- else
- {$ENDIF}
- Result := WideFormatBuf(Buffer, BufLen, Pointer(NewFormat)^,
- Length(NewFormat), Args);
- end;
-
- function Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
- FmtLen: Cardinal; const Args: array of const): Cardinal;
- begin
- Result := _Tnt_WideFormatBuf(Buffer, BufLen, FormatStr, FmtLen, Args{$IFDEF COMPILER_7_UP}, nil{$ENDIF});
- end;
-
- {$IFDEF COMPILER_7_UP}
- function Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
- FmtLen: Cardinal; const Args: array of const; const FormatSettings: TFormatSettings): Cardinal;
- begin
- Result := _Tnt_WideFormatBuf(Buffer, BufLen, FormatStr, FmtLen, Args, @FormatSettings);
- end;
- {$ENDIF}
-
- procedure _Tnt_WideFmtStr(var Result: WideString; const FormatStr: WideString;
- const Args: array of const{$IFDEF COMPILER_7_UP}; const FormatSettings: PFormatSettings{$ENDIF});
- var
- Len, BufLen: Integer;
- Buffer: array[0..4095] of WideChar;
- begin
- BufLen := Length(Buffer); // Fixes buffer overwrite issue. (See QC #4703, #4744)
- if Length(FormatStr) < (Length(Buffer) - (Length(Buffer) div 4)) then
- Len := _Tnt_WideFormatBuf(Buffer, Length(Buffer) - 1, Pointer(FormatStr)^,
- Length(FormatStr), Args{$IFDEF COMPILER_7_UP}, FormatSettings{$ENDIF})
- else
- begin
- BufLen := Length(FormatStr);
- Len := BufLen;
- end;
- if Len >= BufLen - 1 then
- begin
- while Len >= BufLen - 1 do
- begin
- Inc(BufLen, BufLen);
- Result := ''; // prevent copying of existing data, for speed
- SetLength(Result, BufLen);
- Len := _Tnt_WideFormatBuf(Pointer(Result)^, BufLen - 1, Pointer(FormatStr)^,
- Length(FormatStr), Args{$IFDEF COMPILER_7_UP}, FormatSettings{$ENDIF});
- end;
- SetLength(Result, Len);
- end
- else
- SetString(Result, Buffer, Len);
- end;
-
- procedure Tnt_WideFmtStr(var Result: WideString; const FormatStr: WideString;
- const Args: array of const);
- begin
- _Tnt_WideFmtStr(Result, FormatStr, Args{$IFDEF COMPILER_7_UP}, nil{$ENDIF});
- end;
-
- {$IFDEF COMPILER_7_UP}
- procedure Tnt_WideFmtStr(var Result: WideString; const FormatStr: WideString;
- const Args: array of const; const FormatSettings: TFormatSettings);
- begin
- _Tnt_WideFmtStr(Result, FormatStr, Args, @FormatSettings);
- end;
- {$ENDIF}
-
- {----------------------------------------------------------------------------------------
- Without the FormatSettings parameter, Tnt_WideFormat is *NOT* necessary...
- TntSystem.InstallTntSystemUpdates([tsFixWideFormat]);
- will fix WideFormat as well as WideFmtStr.
- ----------------------------------------------------------------------------------------}
- function Tnt_WideFormat(const FormatStr: WideString; const Args: array of const): WideString;
- begin
- Tnt_WideFmtStr(Result, FormatStr, Args);
- end;
-
- {$IFDEF COMPILER_7_UP}
- function Tnt_WideFormat(const FormatStr: WideString; const Args: array of const;
- const FormatSettings: TFormatSettings): WideString;
- begin
- Tnt_WideFmtStr(Result, FormatStr, Args, FormatSettings);
- end;
- {$ENDIF}
-
-{$ENDIF}
-{$ENDIF FPC}
-
-function Tnt_WideUpperCase(const S: WideString): WideString;
-begin
- {$IFNDEF FPC}
- {$IFNDEF COMPILER_10_UP}
- {$DEFINE WIDEUPPERCASE_BROKEN}
- {$ENDIF}
- {$ENDIF}
- {$IFDEF WIDEUPPERCASE_BROKEN}
- { SysUtils.WideUpperCase is broken for Win9x. }
- Result := S;
- if Length(Result) > 0 then
- Tnt_CharUpperBuffW(PWideChar(Result), Length(Result));
- {$ELSE}
- Result := SysUtils.WideUpperCase{TNT-ALLOW WideUpperCase}(S);
- {$ENDIF}
-end;
-
-function Tnt_WideLowerCase(const S: WideString): WideString;
-begin
- {$IFNDEF FPC}
- {$IFNDEF COMPILER_10_UP}
- {$DEFINE WIDELOWERCASE_BROKEN}
- {$ENDIF}
- {$ENDIF}
- {$IFDEF WIDELOWERCASE_BROKEN}
- { SysUtils.WideLowerCase is broken for Win9x. }
- Result := S;
- if Length(Result) > 0 then
- Tnt_CharLowerBuffW(PWideChar(Result), Length(Result));
- {$ELSE}
- Result := SysUtils.WideLowerCase{TNT-ALLOW WideLowerCase}(S);
- {$ENDIF}
-end;
-
-function TntWideLastChar(const S: WideString): WideChar;
-var
- P: PWideChar;
-begin
- P := WideLastChar(S);
- if P = nil then
- Result := #0
- else
- Result := P^;
-end;
-
-function Tnt_WideStringReplace(const S, OldPattern, NewPattern: WideString;
- Flags: TReplaceFlags; WholeWord: Boolean = False): WideString;
-
- function IsWordSeparator(WC: WideChar): Boolean;
- begin
- Result := (WC = WideChar(#0))
- or IsWideCharSpace(WC)
- or IsWideCharPunct(WC);
- end;
-
-var
- SearchStr, Patt, NewStr: WideString;
- Offset: Integer;
- PrevChar, NextChar: WideChar;
-begin
- if rfIgnoreCase in Flags then
- begin
- SearchStr := Tnt_WideUpperCase(S);
- Patt := Tnt_WideUpperCase(OldPattern);
- end else
- begin
- SearchStr := S;
- Patt := OldPattern;
- end;
- NewStr := S;
- Result := '';
- while SearchStr <> '' do
- begin
- Offset := Pos(Patt, SearchStr);
- if Offset = 0 then
- begin
- Result := Result + NewStr;
- Break;
- end; // done
-
- if (WholeWord) then
- begin
- if (Offset = 1) then
- PrevChar := TntWideLastChar(Result)
- else
- PrevChar := NewStr[Offset - 1];
-
- if Offset + Length(OldPattern) <= Length(NewStr) then
- NextChar := NewStr[Offset + Length(OldPattern)]
- else
- NextChar := WideChar(#0);
-
- if (not IsWordSeparator(PrevChar))
- or (not IsWordSeparator(NextChar)) then
- begin
- Result := Result + Copy(NewStr, 1, Offset + Length(OldPattern) - 1);
- NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
- SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
- continue;
- end;
- end;
-
- Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern;
- NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
- if not (rfReplaceAll in Flags) then
- begin
- Result := Result + NewStr;
- Break;
- end;
- SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
- end;
-end;
-
-function TntAdjustLineBreaksLength(const S: WideString; Style: TTntTextLineBreakStyle = tlbsCRLF): Integer;
-var
- Source, SourceEnd: PWideChar;
-begin
- Source := Pointer(S);
- SourceEnd := Source + Length(S);
- Result := Length(S);
- while Source < SourceEnd do
- begin
- case Source^ of
- #10, WideLineSeparator:
- if Style = tlbsCRLF then
- Inc(Result);
- #13:
- if Style = tlbsCRLF then
- if Source[1] = #10 then
- Inc(Source)
- else
- Inc(Result)
- else
- if Source[1] = #10 then
- Dec(Result);
- end;
- Inc(Source);
- end;
-end;
-
-function TntAdjustLineBreaks(const S: WideString; Style: TTntTextLineBreakStyle = tlbsCRLF): WideString;
-var
- Source, SourceEnd, Dest: PWideChar;
- DestLen: Integer;
-begin
- Source := Pointer(S);
- SourceEnd := Source + Length(S);
- DestLen := TntAdjustLineBreaksLength(S, Style);
- SetString(Result, nil, DestLen);
- Dest := Pointer(Result);
- while Source < SourceEnd do begin
- case Source^ of
- #10, WideLineSeparator:
- begin
- if Style in [tlbsCRLF, tlbsCR] then
- begin
- Dest^ := #13;
- Inc(Dest);
- end;
- if Style in [tlbsCRLF, tlbsLF] then
- begin
- Dest^ := #10;
- Inc(Dest);
- end;
- Inc(Source);
- end;
- #13:
- begin
- if Style in [tlbsCRLF, tlbsCR] then
- begin
- Dest^ := #13;
- Inc(Dest);
- end;
- if Style in [tlbsCRLF, tlbsLF] then
- begin
- Dest^ := #10;
- Inc(Dest);
- end;
- Inc(Source);
- if Source^ = #10 then Inc(Source);
- end;
- else
- Dest^ := Source^;
- Inc(Dest);
- Inc(Source);
- end;
- end;
-end;
-
-function WideWrapText(const Line, BreakStr: WideString; const BreakChars: TSysCharSet;
- MaxCol: Integer): WideString;
-
- function WideCharIn(C: WideChar; SysCharSet: TSysCharSet): Boolean;
- begin
- Result := (C <= High(AnsiChar)) and (AnsiChar(C) in SysCharSet);
- end;
-
-const
- QuoteChars = ['''', '"'];
-var
- Col, Pos: Integer;
- LinePos, LineLen: Integer;
- BreakLen, BreakPos: Integer;
- QuoteChar, CurChar: WideChar;
- ExistingBreak: Boolean;
-begin
- Col := 1;
- Pos := 1;
- LinePos := 1;
- BreakPos := 0;
- QuoteChar := ' ';
- ExistingBreak := False;
- LineLen := Length(Line);
- BreakLen := Length(BreakStr);
- Result := '';
- while Pos <= LineLen do
- begin
- CurChar := Line[Pos];
- if CurChar = BreakStr[1] then
- begin
- if QuoteChar = ' ' then
- begin
- ExistingBreak := WideSameText(BreakStr, Copy(Line, Pos, BreakLen));
- if ExistingBreak then
- begin
- Inc(Pos, BreakLen-1);
- BreakPos := Pos;
- end;
- end
- end
- else if WideCharIn(CurChar, BreakChars) then
- begin
- if QuoteChar = ' ' then BreakPos := Pos
- end
- else if WideCharIn(CurChar, QuoteChars) then
- begin
- if CurChar = QuoteChar then
- QuoteChar := ' '
- else if QuoteChar = ' ' then
- QuoteChar := CurChar;
- end;
- Inc(Pos);
- Inc(Col);
- if not (WideCharIn(QuoteChar, QuoteChars)) and (ExistingBreak or
- ((Col > MaxCol) and (BreakPos > LinePos))) then
- begin
- Col := Pos - BreakPos;
- Result := Result + Copy(Line, LinePos, BreakPos - LinePos + 1);
- if not (WideCharIn(CurChar, QuoteChars)) then
- while Pos <= LineLen do
- begin
- if WideCharIn(Line[Pos], BreakChars) then
- Inc(Pos)
- else if Copy(Line, Pos, Length(sLineBreak)) = sLineBreak then
- Inc(Pos, Length(sLineBreak))
- else
- break;
- end;
- if not ExistingBreak and (Pos < LineLen) then
- Result := Result + BreakStr;
- Inc(BreakPos);
- LinePos := BreakPos;
- ExistingBreak := False;
- end;
- end;
- Result := Result + Copy(Line, LinePos, MaxInt);
-end;
-
-function WideWrapText(const Line: WideString; MaxCol: Integer): WideString;
-begin
- Result := WideWrapText(Line, sLineBreak, [' ', '-', #9], MaxCol); { do not localize }
-end;
-
-function WideIncludeTrailingBackslash(const S: WideString): WideString;
-begin
- Result := WideIncludeTrailingPathDelimiter(S);
-end;
-
-function WideIncludeTrailingPathDelimiter(const S: WideString): WideString;
-begin
- Result := S;
- if not WideIsPathDelimiter(Result, Length(Result)) then Result := Result + PathDelim;
-end;
-
-function WideExcludeTrailingBackslash(const S: WideString): WideString;
-begin
- Result := WideExcludeTrailingPathDelimiter(S);
-end;
-
-function WideExcludeTrailingPathDelimiter(const S: WideString): WideString;
-begin
- Result := S;
- if WideIsPathDelimiter(Result, Length(Result)) then
- SetLength(Result, Length(Result)-1);
-end;
-
-function WideIsDelimiter(const Delimiters, S: WideString; Index: Integer): Boolean;
-begin
- Result := False;
- if (Index <= 0) or (Index > Length(S)) then exit;
- Result := WStrScan(PWideChar(Delimiters), S[Index]) <> nil;
-end;
-
-function WideIsPathDelimiter(const S: WideString; Index: Integer): Boolean;
-begin
- Result := (Index > 0) and (Index <= Length(S)) and (S[Index] = PathDelim);
-end;
-
-function WideLastDelimiter(const Delimiters, S: WideString): Integer;
-var
- P: PWideChar;
-begin
- Result := Length(S);
- P := PWideChar(Delimiters);
- while Result > 0 do
- begin
- if (S[Result] <> #0) and (WStrScan(P, S[Result]) <> nil) then
- Exit;
- Dec(Result);
- end;
-end;
-
-function WideChangeFileExt(const FileName, Extension: WideString): WideString;
-var
- I: Integer;
-begin
- I := WideLastDelimiter('.\:',Filename);
- if (I = 0) or (FileName[I] <> '.') then I := MaxInt;
- Result := Copy(FileName, 1, I - 1) + Extension;
-end;
-
-function WideExtractFilePath(const FileName: WideString): WideString;
-var
- I: Integer;
-begin
- I := WideLastDelimiter('\:', FileName);
- Result := Copy(FileName, 1, I);
-end;
-
-function WideExtractFileDir(const FileName: WideString): WideString;
-var
- I: Integer;
-begin
- I := WideLastDelimiter(DriveDelim + PathDelim,Filename);
- if (I > 1) and (FileName[I] = PathDelim) and
- (not (FileName[I - 1] in [WideChar(PathDelim), WideChar(DriveDelim)])) then Dec(I);
- Result := Copy(FileName, 1, I);
-end;
-
-function WideExtractFileDrive(const FileName: WideString): WideString;
-var
- I, J: Integer;
-begin
- if (Length(FileName) >= 2) and (FileName[2] = DriveDelim) then
- Result := Copy(FileName, 1, 2)
- else if (Length(FileName) >= 2) and (FileName[1] = PathDelim) and
- (FileName[2] = PathDelim) then
- begin
- J := 0;
- I := 3;
- While (I < Length(FileName)) and (J < 2) do
- begin
- if FileName[I] = PathDelim then Inc(J);
- if J < 2 then Inc(I);
- end;
- if FileName[I] = PathDelim then Dec(I);
- Result := Copy(FileName, 1, I);
- end else Result := '';
-end;
-
-function WideExtractFileName(const FileName: WideString): WideString;
-var
- I: Integer;
-begin
- I := WideLastDelimiter('\:', FileName);
- Result := Copy(FileName, I + 1, MaxInt);
-end;
-
-function WideExtractFileExt(const FileName: WideString): WideString;
-var
- I: Integer;
-begin
- I := WideLastDelimiter('.\:', FileName);
- if (I > 0) and (FileName[I] = '.') then
- Result := Copy(FileName, I, MaxInt) else
- Result := '';
-end;
-
-function WideExtractRelativePath(const BaseName, DestName: WideString): WideString;
-var
- BasePath, DestPath: WideString;
- BaseLead, DestLead: PWideChar;
- BasePtr, DestPtr: PWideChar;
-
- function WideExtractFilePathNoDrive(const FileName: WideString): WideString;
- begin
- Result := WideExtractFilePath(FileName);
- Delete(Result, 1, Length(WideExtractFileDrive(FileName)));
- end;
-
- function Next(var Lead: PWideChar): PWideChar;
- begin
- Result := Lead;
- if Result = nil then Exit;
- Lead := WStrScan(Lead, PathDelim);
- if Lead <> nil then
- begin
- Lead^ := #0;
- Inc(Lead);
- end;
- end;
-
-begin
- if WideSameText(WideExtractFileDrive(BaseName), WideExtractFileDrive(DestName)) then
- begin
- BasePath := WideExtractFilePathNoDrive(BaseName);
- DestPath := WideExtractFilePathNoDrive(DestName);
- BaseLead := Pointer(BasePath);
- BasePtr := Next(BaseLead);
- DestLead := Pointer(DestPath);
- DestPtr := Next(DestLead);
- while (BasePtr <> nil) and (DestPtr <> nil) and WideSameText(BasePtr, DestPtr) do
- begin
- BasePtr := Next(BaseLead);
- DestPtr := Next(DestLead);
- end;
- Result := '';
- while BaseLead <> nil do
- begin
- Result := Result + '..' + PathDelim; { Do not localize }
- Next(BaseLead);
- end;
- if (DestPtr <> nil) and (DestPtr^ <> #0) then
- Result := Result + DestPtr + PathDelim;
- if DestLead <> nil then
- Result := Result + DestLead; // destlead already has a trailing backslash
- Result := Result + WideExtractFileName(DestName);
- end
- else
- Result := DestName;
-end;
-
-function WideExpandFileName(const FileName: WideString): WideString;
-var
- FName: PWideChar;
- Buffer: array[0..MAX_PATH - 1] of WideChar;
-begin
- SetString(Result, Buffer, Tnt_GetFullPathNameW(PWideChar(FileName), MAX_PATH, Buffer, FName));
-end;
-
-function WideExtractShortPathName(const FileName: WideString): WideString;
-var
- Buffer: array[0..MAX_PATH - 1] of WideChar;
-begin
- SetString(Result, Buffer, Tnt_GetShortPathNameW(PWideChar(FileName), Buffer, MAX_PATH));
-end;
-
-function WideFileCreate(const FileName: WideString): Integer;
-begin
- Result := Integer(Tnt_CreateFileW(PWideChar(FileName), GENERIC_READ or GENERIC_WRITE,
- 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0))
-end;
-
-function WideFileOpen(const FileName: WideString; Mode: LongWord): Integer;
-const
- AccessMode: array[0..2] of LongWord = (
- GENERIC_READ,
- GENERIC_WRITE,
- GENERIC_READ or GENERIC_WRITE);
- ShareMode: array[0..4] of LongWord = (
- 0,
- 0,
- FILE_SHARE_READ,
- FILE_SHARE_WRITE,
- FILE_SHARE_READ or FILE_SHARE_WRITE);
-begin
- Result := Integer(Tnt_CreateFileW(PWideChar(FileName), AccessMode[Mode and 3],
- ShareMode[(Mode and $F0) shr 4], nil, OPEN_EXISTING,
- FILE_ATTRIBUTE_NORMAL, 0));
-end;
-
-function WideFileAge(const FileName: WideString): Integer;
-var
- Handle: THandle;
- FindData: TWin32FindDataW;
- LocalFileTime: TFileTime;
-begin
- Handle := Tnt_FindFirstFileW(PWideChar(FileName), FindData);
- if Handle <> INVALID_HANDLE_VALUE then
- begin
- Windows.FindClose(Handle);
- if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
- begin
- FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
- if FileTimeToDosDateTime(LocalFileTime, LongRec(Result).Hi, LongRec(Result).Lo) then
- Exit
- end;
- end;
- Result := -1;
-end;
-
-function WideFileAge(const FileName: WideString; out FileDateTime: TDateTime): Boolean;
-var
- Handle: THandle;
- FindData: TWin32FindDataW;
- LSystemTime: TSystemTime;
- LocalFileTime: TFileTime;
-begin
- Result := False;
- Handle := Tnt_FindFirstFileW(PWideChar(FileName), FindData);
- if Handle <> INVALID_HANDLE_VALUE then
- begin
- Windows.FindClose(Handle);
- if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
- begin
- Result := True;
- FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
- FileTimeToSystemTime(LocalFileTime, LSystemTime);
- with LSystemTime do
- FileDateTime := EncodeDate(wYear, wMonth, wDay) +
- EncodeTime(wHour, wMinute, wSecond, wMilliSeconds);
- end;
- end;
-end;
-
-function WideDirectoryExists(const Name: WideString): Boolean;
-var
- Code: Cardinal;
-begin
- Code := WideFileGetAttr(Name);
- Result := (Code <> INVALID_FILE_ATTRIBUTES) and ((FILE_ATTRIBUTE_DIRECTORY and Code) <> 0);
-end;
-
-function WideFileExists(const Name: WideString): Boolean;
-var
- Code: Cardinal;
-begin
- Code := WideFileGetAttr(Name);
- Result := (Code <> INVALID_FILE_ATTRIBUTES) and ((FILE_ATTRIBUTE_DIRECTORY and Code) = 0);
-end;
-
-function WideFileGetAttr(const FileName: WideString): Cardinal;
-begin
- Result := Tnt_GetFileAttributesW(PWideChar(FileName));
-end;
-
-function WideFileSetAttr(const FileName: WideString; Attr: Integer): Boolean;
-begin
- Result := Tnt_SetFileAttributesW(PWideChar(FileName), Attr)
-end;
-
-function WideFileIsReadOnly(const FileName: WideString): Boolean;
-begin
- Result := (Tnt_GetFileAttributesW(PWideChar(FileName)) and faReadOnly) <> 0;
-end;
-
-function WideFileSetReadOnly(const FileName: WideString; ReadOnly: Boolean): Boolean;
-var
- Flags: Integer;
-begin
- Result := False;
- Flags := Tnt_GetFileAttributesW(PWideChar(FileName));
- if Flags = -1 then Exit;
- if ReadOnly then
- Flags := Flags or faReadOnly
- else
- Flags := Flags and not faReadOnly;
- Result := Tnt_SetFileAttributesW(PWideChar(FileName), Flags);
-end;
-
-function WideForceDirectories(Dir: WideString): Boolean;
-begin
- Result := True;
- if Length(Dir) = 0 then
- raise ETntGeneralError.Create(
- {$IFNDEF FPC} SCannotCreateDir {$ELSE} SCannotCreateEmptyDir {$ENDIF});
- Dir := WideExcludeTrailingBackslash(Dir);
- if (Length(Dir) < 3) or WideDirectoryExists(Dir)
- or (WideExtractFilePath(Dir) = Dir) then Exit; // avoid 'xyz:\' problem.
- Result := WideForceDirectories(WideExtractFilePath(Dir));
- if Result then
- Result := Tnt_CreateDirectoryW(PWideChar(Dir), nil)
-end;
-
-function WideFileSearch(const Name, DirList: WideString): WideString;
-var
- I, P, L: Integer;
- C: WideChar;
-begin
- Result := Name;
- P := 1;
- L := Length(DirList);
- while True do
- begin
- if WideFileExists(Result) then Exit;
- while (P <= L) and (DirList[P] = PathSep) do Inc(P);
- if P > L then Break;
- I := P;
- while (P <= L) and (DirList[P] <> PathSep) do
- Inc(P);
- Result := Copy(DirList, I, P - I);
- C := TntWideLastChar(Result);
- if (C <> DriveDelim) and (C <> PathDelim) then
- Result := Result + PathDelim;
- Result := Result + Name;
- end;
- Result := '';
-end;
-
-function WideRenameFile(const OldName, NewName: WideString): Boolean;
-begin
- Result := Tnt_MoveFileW(PWideChar(OldName), PWideChar(NewName))
-end;
-
-function WideDeleteFile(const FileName: WideString): Boolean;
-begin
- Result := Tnt_DeleteFileW(PWideChar(FileName))
-end;
-
-function WideCopyFile(const FromFile, ToFile: WideString; FailIfExists: Boolean): Boolean;
-begin
- Result := Tnt_CopyFileW(PWideChar(FromFile), PWideChar(ToFile), FailIfExists)
-end;
-
-function _WideFindMatchingFile(var F: TSearchRecW): Integer;
-var
- LocalFileTime: TFileTime;
-begin
- with F do
- begin
- while FindData.dwFileAttributes and ExcludeAttr <> 0 do
- if not Tnt_FindNextFileW(FindHandle, FindData) then
- begin
- Result := GetLastError;
- Exit;
- end;
- FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
- FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi, LongRec(Time).Lo);
- Size := (Int64(FindData.nFileSizeHigh) shl 32) + FindData.nFileSizeLow;
- Attr := FindData.dwFileAttributes;
- Name := FindData.cFileName;
- end;
- Result := 0;
-end;
-
-function WideFindFirst(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer;
-const
- faSpecial = faHidden or faSysFile {$IFNDEF COMPILER_9_UP} or faVolumeID {$ENDIF} or faDirectory;
-begin
- F.ExcludeAttr := not Attr and faSpecial;
- F.FindHandle := Tnt_FindFirstFileW(PWideChar(Path), F.FindData);
- if F.FindHandle <> INVALID_HANDLE_VALUE then
- begin
- Result := _WideFindMatchingFile(F);
- if Result <> 0 then WideFindClose(F);
- end else
- Result := GetLastError;
-end;
-
-function WideFindNext(var F: TSearchRecW): Integer;
-begin
- if Tnt_FindNextFileW(F.FindHandle, F.FindData) then
- Result := _WideFindMatchingFile(F) else
- Result := GetLastError;
-end;
-
-procedure WideFindClose(var F: TSearchRecW);
-begin
- if F.FindHandle <> INVALID_HANDLE_VALUE then
- begin
- Windows.FindClose(F.FindHandle);
- F.FindHandle := INVALID_HANDLE_VALUE;
- end;
-end;
-
-function WideCreateDir(const Dir: WideString): Boolean;
-begin
- Result := Tnt_CreateDirectoryW(PWideChar(Dir), nil);
-end;
-
-function WideRemoveDir(const Dir: WideString): Boolean;
-begin
- Result := Tnt_RemoveDirectoryW(PWideChar(Dir));
-end;
-
-function WideGetCurrentDir: WideString;
-begin
- SetLength(Result, MAX_PATH);
- Tnt_GetCurrentDirectoryW(MAX_PATH, PWideChar(Result));
- Result := PWideChar(Result);
-end;
-
-function WideSetCurrentDir(const Dir: WideString): Boolean;
-begin
- Result := Tnt_SetCurrentDirectoryW(PWideChar(Dir));
-end;
-
-//=============================================================================================
-//== DATE/TIME STRING PARSING ================================================================
-//=============================================================================================
-
-{$IFDEF FPC}
-const
- VAR_TIMEVALUEONLY = 1;
- VAR_DATEVALUEONLY = 2;
-{$ENDIF}
-
-function _IntTryStrToDateTime(Str: WideString; Flags: Integer; out DateTime: TDateTime): HResult;
-begin
- Result := VarDateFromStr(
- {$IFDEF FPC} POLECHAR(Str) {$ELSE} Str {$ENDIF},
- GetThreadLocale, Flags, Double(DateTime));
- if (not Succeeded(Result)) then begin
- if (Flags = VAR_TIMEVALUEONLY)
- and SysUtils.TryStrToTime{TNT-ALLOW TryStrToTime}(Str, DateTime) then
- Result := S_OK // SysUtils seems confident (works for date = "dd.MM.yy" and time = "H.mm.ss")
- else if (Flags = VAR_DATEVALUEONLY)
- and SysUtils.TryStrToDate{TNT-ALLOW TryStrToDate}(Str, DateTime) then
- Result := S_OK // SysUtils seems confident
- else if (Flags = 0)
- and SysUtils.TryStrToDateTime{TNT-ALLOW TryStrToDateTime}(Str, DateTime) then
- Result := S_OK // SysUtils seems confident
- end;
-end;
-
-function TntTryStrToDateTime(Str: WideString; out DateTime: TDateTime): Boolean;
-begin
- Result := Succeeded(_IntTryStrToDateTime(Str, 0, DateTime));
-end;
-
-function TntTryStrToDate(Str: WideString; out DateTime: TDateTime): Boolean;
-begin
- Result := Succeeded(_IntTryStrToDateTime(Str, VAR_DATEVALUEONLY, DateTime));
-end;
-
-function TntTryStrToTime(Str: WideString; out DateTime: TDateTime): Boolean;
-begin
- Result := Succeeded(_IntTryStrToDateTime(Str, VAR_TIMEVALUEONLY, DateTime));
-end;
-
-function ValidDateTimeStr(Str: WideString): Boolean;
-var
- Temp: TDateTime;
-begin
- Result := Succeeded(_IntTryStrToDateTime(Str, 0, Temp));
-end;
-
-function ValidDateStr(Str: WideString): Boolean;
-var
- Temp: TDateTime;
-begin
- Result := Succeeded(_IntTryStrToDateTime(Str, VAR_DATEVALUEONLY, Temp));
-end;
-
-function ValidTimeStr(Str: WideString): Boolean;
-var
- Temp: TDateTime;
-begin
- Result := Succeeded(_IntTryStrToDateTime(Str, VAR_TIMEVALUEONLY, Temp));
-end;
-
-function TntStrToDateTimeDef(Str: WideString; Default: TDateTime): TDateTime;
-begin
- if not TntTryStrToDateTime(Str, Result) then
- Result := Default;
-end;
-
-function TntStrToDateDef(Str: WideString; Default: TDateTime): TDateTime;
-begin
- if not TntTryStrToDate(Str, Result) then
- Result := Default;
-end;
-
-function TntStrToTimeDef(Str: WideString; Default: TDateTime): TDateTime;
-begin
- if not TntTryStrToTime(Str, Result) then
- Result := Default;
-end;
-
-function _IntStrToDateTime(Str: WideString; Flags: Integer; ErrorFormatStr: WideString): TDateTime;
-begin
- try
- OleCheck(_IntTryStrToDateTime(Str, Flags, Result));
- except
- on E: Exception do begin
- E.Message := E.Message + CRLF + WideFormat(ErrorFormatStr, [Str]);
- raise EConvertError.Create(E.Message);
- end;
- end;
-end;
-
-function TntStrToDateTime(Str: WideString): TDateTime;
-begin
- Result := _IntStrToDateTime(Str, 0, SInvalidDateTime);
-end;
-
-function TntStrToDate(Str: WideString): TDateTime;
-begin
- Result := _IntStrToDateTime(Str, VAR_DATEVALUEONLY,
- {$IFNDEF FPC} SInvalidDate {$ELSE} SInvalidDateTime {$ENDIF});
-end;
-
-function TntStrToTime(Str: WideString): TDateTime;
-begin
- Result := _IntStrToDateTime(Str, VAR_TIMEVALUEONLY,
- {$IFNDEF FPC} SInvalidTime {$ELSE} SInvalidDateTime {$ENDIF});
-end;
-
-//=============================================================================================
-//== CURRENCY STRING PARSING =================================================================
-//=============================================================================================
-
-function TntCurrToStr(Value: Currency; lpFormat: PCurrencyFmtW = nil): WideString;
-const
- MAX_BUFF_SIZE = 64; // can a currency string actually be larger?
-var
- ValueStr: WideString;
-begin
- // format lpValue using ENG-US settings
- ValueStr := ENG_US_FloatToStr(Value);
- // get currency format
- SetLength(Result, MAX_BUFF_SIZE);
- if 0 = Tnt_GetCurrencyFormatW(GetThreadLocale, 0, PWideChar(ValueStr),
- lpFormat, PWideChar(Result), Length(Result))
- then begin
- RaiseLastOSError;
- end;
- Result := PWideChar(Result);
-end;
-
-function TntStrToCurr(const S: WideString): Currency;
-begin
- try
- OleCheck(VarCyFromStr(
- {$IFDEF FPC} POLECHAR(S) {$ELSE} S {$ENDIF},
- GetThreadLocale, 0, Result));
- except
- on E: Exception do begin
- E.Message := E.Message + CRLF + WideFormat(SInvalidCurrency, [S]);
- raise EConvertError.Create(E.Message);
- end;
- end;
-end;
-
-function ValidCurrencyStr(const S: WideString): Boolean;
-var
- Dummy: Currency;
-begin
- Result := Succeeded(VarCyFromStr(
- {$IFDEF FPC} POLECHAR(S) {$ELSE} S {$ENDIF},
- GetThreadLocale, 0, Dummy));
-end;
-
-function TntStrToCurrDef(const S: WideString; const Default: Currency): Currency;
-begin
- if not Succeeded(VarCyFromStr(
- {$IFDEF FPC} POLECHAR(S) {$ELSE} S {$ENDIF},
- GetThreadLocale, 0, Result)) then
- Result := Default;
-end;
-
-threadvar
- Currency_DecimalSep: WideString;
- Currency_ThousandSep: WideString;
- Currency_CurrencySymbol: WideString;
-
-function GetDefaultCurrencyFmt: TCurrencyFmtW;
-begin
- ZeroMemory(@Result, SizeOf(Result));
- Result.NumDigits := StrToIntDef(WideGetLocaleStr(GetThreadLocale, LOCALE_ICURRDIGITS, '2'), 2);
- Result.LeadingZero := StrToIntDef(WideGetLocaleStr(GetThreadLocale, LOCALE_ILZERO, '1'), 1);
- Result.Grouping := StrToIntDef(Copy(WideGetLocaleStr(GetThreadLocale, LOCALE_SMONGROUPING, '3;0'), 1, 1), 3);
- Currency_DecimalSep := WideGetLocaleStr(GetThreadLocale, LOCALE_SMONDECIMALSEP, '.');
- Result.lpDecimalSep := {$IFNDEF FPC} PWideChar(Currency_DecimalSep)
- {$ELSE} LPTSTR(PWideChar(Currency_DecimalSep)) {$ENDIF};
- Currency_ThousandSep := WideGetLocaleStr(GetThreadLocale, LOCALE_SMONTHOUSANDSEP, ',');
- Result.lpThousandSep := {$IFNDEF FPC} PWideChar(Currency_ThousandSep)
- {$ELSE} LPTSTR(PWideChar(Currency_ThousandSep)) {$ENDIF};
- Result.NegativeOrder := StrToIntDef(WideGetLocaleStr(GetThreadLocale, LOCALE_INEGCURR, '0'), 0);
- Result.PositiveOrder := StrToIntDef(WideGetLocaleStr(GetThreadLocale, LOCALE_ICURRENCY, '0'), 0);
- Currency_CurrencySymbol := WideGetLocaleStr(GetThreadLocale, LOCALE_SCURRENCY, '');
- Result.lpCurrencySymbol := {$IFNDEF FPC} PWideChar(Currency_CurrencySymbol)
- {$ELSE} LPTSTR(PWideChar(Currency_CurrencySymbol)) {$ENDIF};
-end;
-
-//=============================================================================================
-
-{$IFDEF FPC}
-function GetLocaleStr(Locale, LocaleType: Integer; const Default: string): string;
-var
- L: Integer;
- Buffer: array[0..255] of Char;
-begin
- L := GetLocaleInfo(Locale, LocaleType, Buffer, SizeOf(Buffer));
- if L > 0 then SetString(Result, Buffer, L - 1) else Result := Default;
-end;
-{$ENDIF}
-
-function WideGetLocaleStr(LocaleID: LCID; LocaleType: Integer; const Default: WideString): WideString;
-var
- L: Integer;
-begin
- if (not Win32PlatformIsUnicode) then
- Result := GetLocaleStr{TNT-ALLOW GetLocaleStr}(LocaleID, LocaleType, Default)
- else begin
- SetLength(Result, 255);
- L := GetLocaleInfoW(LocaleID, LocaleType, PWideChar(Result), Length(Result));
- if L > 0 then
- SetLength(Result, L - 1)
- else
- Result := Default;
- end;
-end;
-
-function WideSysErrorMessage(ErrorCode: Integer): WideString;
-begin
- Result := WideLibraryErrorMessage('system', 0, ErrorCode);
-end;
-
-function WideLibraryErrorMessage(const LibName: WideString; Dll: THandle; ErrorCode: Integer): WideString;
-var
- Len: Integer;
- AnsiResult: AnsiString;
- Flags: Cardinal;
-begin
- Flags := FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_IGNORE_INSERTS or FORMAT_MESSAGE_ARGUMENT_ARRAY;
- if Dll <> 0 then
- Flags := Flags or FORMAT_MESSAGE_FROM_HMODULE;
- if Win32PlatformIsUnicode then begin
- SetLength(Result, 256);
- Len := FormatMessageW(Flags, Pointer(Dll), ErrorCode, 0, PWideChar(Result), Length(Result), nil);
- SetLength(Result, Len);
- end else begin
- SetLength(AnsiResult, 256);
- Len := FormatMessageA(Flags, Pointer(Dll), ErrorCode, 0, PAnsiChar(AnsiResult), Length(AnsiResult), nil);
- SetLength(AnsiResult, Len);
- Result := AnsiResult;
- end;
- if Trim(Result) = '' then
- Result := WideFormat('Unspecified error (%d) from %s.', [ErrorCode, LibName]);
-end;
-
-{$IFNDEF COMPILER_7_UP}
-function CheckWin32Version(AMajor: Integer; AMinor: Integer = 0): Boolean;
-begin
- Result := (Win32MajorVersion > AMajor) or
- ((Win32MajorVersion = AMajor) and
- (Win32MinorVersion >= AMinor));
-end;
-{$ENDIF}
-
-function WinCheckH(RetVal: Cardinal): Cardinal;
-begin
- if RetVal = 0 then RaiseLastOSError;
- Result := RetVal;
-end;
-
-function WinCheckFileH(RetVal: Cardinal): Cardinal;
-begin
- if RetVal = INVALID_HANDLE_VALUE then RaiseLastOSError;
- Result := RetVal;
-end;
-
-function WinCheckP(RetVal: Pointer): Pointer;
-begin
- if RetVal = nil then RaiseLastOSError;
- Result := RetVal;
-end;
-
-function WideGetModuleFileName(Instance: HModule): WideString;
-begin
- SetLength(Result, MAX_PATH);
- WinCheckH(Tnt_GetModuleFileNameW(Instance, PWideChar(Result), Length(Result)));
- Result := PWideChar(Result)
-end;
-
-function WideSafeLoadLibrary(const Filename: Widestring; ErrorMode: UINT): HMODULE;
-var
- OldMode: UINT;
- FPUControlWord: Word;
-begin
- OldMode := SetErrorMode(ErrorMode);
- try
- asm
- FNSTCW FPUControlWord
- end;
- try
- Result := Tnt_LoadLibraryW(PWideChar(Filename));
- finally
- asm
- FNCLEX
- FLDCW FPUControlWord
- end;
- end;
- finally
- SetErrorMode(OldMode);
- end;
-end;
-
-{$IFNDEF FPC}
-function WideLoadPackage(const Name: Widestring): HMODULE;
-begin
- Result := WideSafeLoadLibrary(Name);
- if Result = 0 then
- begin
- raise EPackageError.CreateFmt(sErrorLoadingPackage, [Name, WideSysErrorMessage(GetLastError)]);
- end;
- try
- InitializePackage(Result);
- except
- FreeLibrary(Result);
- raise;
- end;
-end;
-{$ENDIF}
-
-function _WideCharType(WC: WideChar; dwInfoType: Cardinal): Word;
-begin
- Win32Check(Tnt_GetStringTypeExW(GetThreadLocale, dwInfoType, PWideChar(@WC), 1, Result))
-end;
-
-function IsWideCharUpper(WC: WideChar): Boolean;
-begin
- Result := (_WideCharType(WC, CT_CTYPE1) and C1_UPPER) <> 0;
-end;
-
-function IsWideCharLower(WC: WideChar): Boolean;
-begin
- Result := (_WideCharType(WC, CT_CTYPE1) and C1_LOWER) <> 0;
-end;
-
-function IsWideCharDigit(WC: WideChar): Boolean;
-begin
- Result := (_WideCharType(WC, CT_CTYPE1) and C1_DIGIT) <> 0;
-end;
-
-function IsWideCharSpace(WC: WideChar): Boolean;
-begin
- Result := (_WideCharType(WC, CT_CTYPE1) and C1_SPACE) <> 0;
-end;
-
-function IsWideCharPunct(WC: WideChar): Boolean;
-begin
- Result := (_WideCharType(WC, CT_CTYPE1) and C1_PUNCT) <> 0;
-end;
-
-function IsWideCharCntrl(WC: WideChar): Boolean;
-begin
- Result := (_WideCharType(WC, CT_CTYPE1) and C1_CNTRL) <> 0;
-end;
-
-function IsWideCharBlank(WC: WideChar): Boolean;
-begin
- Result := (_WideCharType(WC, CT_CTYPE1) and C1_BLANK) <> 0;
-end;
-
-function IsWideCharXDigit(WC: WideChar): Boolean;
-begin
- Result := (_WideCharType(WC, CT_CTYPE1) and C1_XDIGIT) <> 0;
-end;
-
-function IsWideCharAlpha(WC: WideChar): Boolean;
-begin
- Result := (_WideCharType(WC, CT_CTYPE1) and C1_ALPHA) <> 0;
-end;
-
-function IsWideCharAlphaNumeric(WC: WideChar): Boolean;
-begin
- Result := (_WideCharType(WC, CT_CTYPE1) and (C1_ALPHA + C1_DIGIT)) <> 0;
-end;
-
-function WideTextPos(const SubStr, S: WideString): Integer;
-begin
- Result := Pos(Tnt_WideUpperCase(SubStr), Tnt_WideUpperCase(S));
-end;
-
-function FindDoubleTerminator(P: PWideChar): PWideChar;
-begin
- Result := P;
- while True do begin
- Result := WStrScan(Result, #0);
- Inc(Result);
- if Result^ = #0 then begin
- Dec(Result);
- break;
- end;
- end;
-end;
-
-function ExtractStringArrayStr(P: PWideChar): WideString;
-var
- PEnd: PWideChar;
-begin
- PEnd := FindDoubleTerminator(P);
- Inc(PEnd, 2); // move past #0#0
- SetString(Result, P, PEnd - P);
-end;
-
-function ExtractStringFromStringArray(var P: PWideChar; Separator: WideChar = #0): WideString;
-var
- Start: PWideChar;
-begin
- Start := P;
- P := WStrScan(Start, Separator);
- if P = nil then begin
- Result := Start;
- P := WStrEnd(Start);
- end else begin
- SetString(Result, Start, P - Start);
- Inc(P);
- end;
-end;
-
-function ExtractStringsFromStringArray(P: PWideChar; Separator: WideChar = #0): TWideStringDynArray;
-const
- GROW_COUNT = 256;
-var
- Count: Integer;
- Item: WideString;
-begin
- Count := 0;
- SetLength(Result, GROW_COUNT);
- Item := ExtractStringFromStringArray(P, Separator);
- While Item <> '' do begin
- if Count > High(Result) then
- SetLength(Result, Length(Result) + GROW_COUNT);
- Result[Count] := Item;
- Inc(Count);
- Item := ExtractStringFromStringArray(P, Separator);
- end;
- SetLength(Result, Count);
-end;
-
-function IsWideCharMappableToAnsi(const WC: WideChar): Boolean;
-var
- UsedDefaultChar: BOOL;
-begin
- WideCharToMultiByte(DefaultSystemCodePage, 0, PWideChar(@WC), 1, nil, 0, nil, @UsedDefaultChar);
- Result := not UsedDefaultChar;
-end;
-
-function IsWideStringMappableToAnsi(const WS: WideString): Boolean;
-var
- UsedDefaultChar: BOOL;
-begin
- WideCharToMultiByte(DefaultSystemCodePage, 0, PWideChar(WS), Length(WS), nil, 0, nil, @UsedDefaultChar);
- Result := not UsedDefaultChar;
-end;
-
-function IsRTF(const Value: WideString): Boolean;
-const
- RTF_BEGIN_1 = WideString('{\RTF');
- RTF_BEGIN_2 = WideString('{URTF');
-begin
- Result := (WideTextPos(RTF_BEGIN_1, Value) = 1)
- or (WideTextPos(RTF_BEGIN_2, Value) = 1);
-end;
-
-{$IFDEF COMPILER_7_UP}
-var
- Cached_ENG_US_FormatSettings: TFormatSettings;
- Cached_ENG_US_FormatSettings_Time: Cardinal;
-
-function ENG_US_FormatSettings: TFormatSettings;
-begin
- if Cached_ENG_US_FormatSettings_Time = _SettingChangeTime then
- Result := Cached_ENG_US_FormatSettings
- else begin
- GetLocaleFormatSettings(MAKELCID(MAKELANGID(LANG_ENGLISH, SUBLANG_ENGLISH_US)), Result);
- Result.DecimalSeparator := '.'; // ignore overrides
- Cached_ENG_US_FormatSettings := Result;
- Cached_ENG_US_FormatSettings_Time := _SettingChangeTime;
- end;
- end;
-
-function ENG_US_FloatToStr(Value: Extended): WideString;
-begin
- Result := FloatToStr(Value, ENG_US_FormatSettings);
-end;
-
-function ENG_US_StrToFloat(const S: WideString): Extended;
-begin
- if not TextToFloat(PAnsiChar(AnsiString(S)), Result, fvExtended, ENG_US_FormatSettings) then
- Result := StrToFloat(S); // try using native format
-end;
-
-{$ELSE}
-
-function ENG_US_FloatToStr(Value: Extended): WideString;
-var
- SaveDecimalSep: AnsiChar;
-begin
- SaveDecimalSep := SysUtils.DecimalSeparator;
- try
- SysUtils.DecimalSeparator := '.';
- Result := FloatToStr(Value);
- finally
- SysUtils.DecimalSeparator := SaveDecimalSep;
- end;
-end;
-
-function ENG_US_StrToFloat(const S: WideString): Extended;
-var
- SaveDecimalSep: AnsiChar;
-begin
- try
- SaveDecimalSep := SysUtils.DecimalSeparator;
- try
- SysUtils.DecimalSeparator := '.';
- Result := StrToFloat(S);
- finally
- SysUtils.DecimalSeparator := SaveDecimalSep;
- end;
- except
- if SysUtils.DecimalSeparator <> '.' then
- Result := StrToFloat(S) // try using native format
- else
- raise;
- end;
-end;
-{$ENDIF}
-
-//---------------------------------------------------------------------------------------------
-// Tnt - Variants
-//---------------------------------------------------------------------------------------------
-
-initialization
- Win32PlatformIsUnicode := (Win32Platform = VER_PLATFORM_WIN32_NT);
- Win32PlatformIsXP := ((Win32MajorVersion = 5) and (Win32MinorVersion >= 1))
- or (Win32MajorVersion > 5);
- Win32PlatformIs2003 := ((Win32MajorVersion = 5) and (Win32MinorVersion >= 2))
- or (Win32MajorVersion > 5);
- Win32PlatformIsVista := (Win32MajorVersion >= 6);
-
-finalization
- Currency_DecimalSep := ''; {make memory sleuth happy}
- Currency_ThousandSep := ''; {make memory sleuth happy}
- Currency_CurrencySymbol := ''; {make memory sleuth happy}
-
-end.
diff --git a/src/lib/TntUnicodeControls/TntSystem.pas b/src/lib/TntUnicodeControls/TntSystem.pas
deleted file mode 100644
index e613ce0c..00000000
--- a/src/lib/TntUnicodeControls/TntSystem.pas
+++ /dev/null
@@ -1,1427 +0,0 @@
-
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntSystem;
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$INCLUDE TntCompilers.inc}
-
-{*****************************************************************************}
-{ Special thanks go to Francisco Leong for originating the design for }
-{ WideString-enabled resourcestrings. }
-{*****************************************************************************}
-
-interface
-
-uses
- Windows;
-
-// These functions should not be used by Delphi code since conversions are implicit.
-{TNT-WARN WideCharToString}
-{TNT-WARN WideCharLenToString}
-{TNT-WARN WideCharToStrVar}
-{TNT-WARN WideCharLenToStrVar}
-{TNT-WARN StringToWideChar}
-
-// ................ ANSI TYPES ................
-{TNT-WARN Char}
-{TNT-WARN PChar}
-{TNT-WARN String}
-
-{TNT-WARN CP_ACP} // <-- use DefaultSystemCodePage
-function DefaultSystemCodePage: Cardinal; // implicitly used when converting AnsiString <--> WideString.
-
-{$IFNDEF FPC}
-var
- WideCustomLoadResString: function(ResStringRec: PResStringRec; var Value: WideString): Boolean;
-{$ENDIF}
-
-{TNT-WARN LoadResString}
-function WideLoadResString(ResStringRec: PResStringRec): WideString;
-{TNT-WARN ParamCount}
-function WideParamCount: Integer;
-{TNT-WARN ParamStr}
-function WideParamStr(Index: Integer): WideString;
-
-// ......... introduced .........
-
-const
- { Each Unicode stream should begin with the code U+FEFF, }
- { which the standard defines as the *byte order mark*. }
- UNICODE_BOM = WideChar($FEFF);
- UNICODE_BOM_SWAPPED = WideChar($FFFE);
- UTF8_BOM = AnsiString(#$EF#$BB#$BF);
-
-function WideStringToUTF8(const S: WideString): AnsiString;
-function UTF8ToWideString(const S: AnsiString): WideString;
-
-function WideStringToUTF7(const W: WideString): AnsiString;
-function UTF7ToWideString(const S: AnsiString): WideString;
-
-function StringToWideStringEx(const S: AnsiString; CodePage: Cardinal): WideString;
-function WideStringToStringEx(const WS: WideString; CodePage: Cardinal): AnsiString;
-
-function UCS2ToWideString(const Value: AnsiString): WideString;
-function WideStringToUCS2(const Value: WideString): AnsiString;
-
-function CharSetToCodePage(ciCharset: UINT): Cardinal;
-function LCIDToCodePage(ALcid: LCID): Cardinal;
-function KeyboardCodePage: Cardinal;
-function KeyUnicode(CharCode: Word): WideChar;
-
-procedure StrSwapByteOrder(Str: PWideChar);
-
-{$IFDEF USE_SYSTEM_OVERRIDES}
-
-type
- TTntSystemUpdate =
- (tsWideResourceStrings
- {$IFNDEF COMPILER_9_UP}, tsFixImplicitCodePage, tsFixWideStrConcat, tsFixWideFormat {$ENDIF}
- );
- TTntSystemUpdateSet = set of TTntSystemUpdate;
-
-const
- AllTntSystemUpdates = [Low(TTntSystemUpdate)..High(TTntSystemUpdate)];
-
-procedure InstallTntSystemUpdates(Updates: TTntSystemUpdateSet = AllTntSystemUpdates);
-
-{$ENDIF USE_SYSTEM_OVERRIDES}
-
-implementation
-
-uses
- SysUtils, Variants, TntWindows, TntSysUtils;
-
-var
- GDefaultSystemCodePage: Cardinal;
-
-function DefaultSystemCodePage: Cardinal;
-begin
- Result := GDefaultSystemCodePage;
-end;
-
-{$IFDEF USE_SYSTEM_OVERRIDES}
-var
- IsDebugging: Boolean;
-{$ENDIF USE_SYSTEM_OVERRIDES}
-
-function WideLoadResStringDetect(ResStringRec: PResStringRec): WideString;
-var
- PCustom: PAnsiChar;
-begin
- // custom string pointer
- PCustom := PAnsiChar(ResStringRec); { I would like to use PWideChar, but this would break legacy code. }
- if (StrLen{TNT-ALLOW StrLen}(PCustom) > Cardinal(Length(UTF8_BOM)))
- and CompareMem(PCustom, PAnsiChar(UTF8_BOM), Length(UTF8_BOM)) then
- // detected UTF8
- Result := UTF8ToWideString(PAnsiChar(PCustom + Length(UTF8_BOM)))
- else
- // normal
- Result := PCustom;
-end;
-
-{$IFNDEF FPC}
-
-function WideLoadResString(ResStringRec: PResStringRec): WideString;
-const
- MAX_RES_STRING_SIZE = 4097; { MSDN documents this as the maximum size of a string in table. }
-var
- Buffer: array [0..MAX_RES_STRING_SIZE] of WideChar; { Buffer leaves room for null terminator. }
-begin
- if Assigned(WideCustomLoadResString) and WideCustomLoadResString(ResStringRec, Result) then
- exit; { a custom resourcestring has been loaded. }
-
- if ResStringRec = nil then
- Result := ''
- else if ResStringRec.Identifier < 64*1024 then
- SetString(Result, Buffer,
- Tnt_LoadStringW(FindResourceHInstance(ResStringRec.Module^),
- ResStringRec.Identifier, Buffer, MAX_RES_STRING_SIZE))
- else begin
- Result := WideLoadResStringDetect(ResStringRec);
- end;
-end;
-
-{$ELSE}
-
-function WideLoadResString(ResStringRec: PResStringRec): WideString;
-begin
- Result := WideLoadResStringDetect(ResStringRec);
-end;
-
-{$ENDIF}
-
-function WideGetParamStr(P: PWideChar; var Param: WideString): PWideChar;
-var
- i, Len: Integer;
- Start, S, Q: PWideChar;
-begin
- while True do
- begin
- while (P[0] <> #0) and (P[0] <= ' ') do
- Inc(P);
- if (P[0] = '"') and (P[1] = '"') then Inc(P, 2) else Break;
- end;
- Len := 0;
- Start := P;
- while P[0] > ' ' do
- begin
- if P[0] = '"' then
- begin
- Inc(P);
- while (P[0] <> #0) and (P[0] <> '"') do
- begin
- Q := P + 1;
- Inc(Len, Q - P);
- P := Q;
- end;
- if P[0] <> #0 then
- Inc(P);
- end
- else
- begin
- Q := P + 1;
- Inc(Len, Q - P);
- P := Q;
- end;
- end;
-
- SetLength(Param, Len);
-
- P := Start;
- S := PWideChar(Param);
- i := 0;
- while P[0] > ' ' do
- begin
- if P[0] = '"' then
- begin
- Inc(P);
- while (P[0] <> #0) and (P[0] <> '"') do
- begin
- Q := P + 1;
- while P < Q do
- begin
- S[i] := P^;
- Inc(P);
- Inc(i);
- end;
- end;
- if P[0] <> #0 then Inc(P);
- end
- else
- begin
- Q := P + 1;
- while P < Q do
- begin
- S[i] := P^;
- Inc(P);
- Inc(i);
- end;
- end;
- end;
-
- Result := P;
-end;
-
-function WideParamCount: Integer;
-var
- P: PWideChar;
- S: WideString;
-begin
- P := WideGetParamStr(GetCommandLineW, S);
- Result := 0;
- while True do
- begin
- P := WideGetParamStr(P, S);
- if S = '' then Break;
- Inc(Result);
- end;
-end;
-
-function WideParamStr(Index: Integer): WideString;
-var
- P: PWideChar;
-begin
- if Index = 0 then
- Result := WideGetModuleFileName(0)
- else
- begin
- P := GetCommandLineW;
- while True do
- begin
- P := WideGetParamStr(P, Result);
- if (Index = 0) or (Result = '') then Break;
- Dec(Index);
- end;
- end;
-end;
-
-function WideStringToUTF8(const S: WideString): AnsiString;
-begin
- Result := UTF8Encode(S);
-end;
-
-function UTF8ToWideString(const S: AnsiString): WideString;
-begin
- Result := UTF8Decode(S);
-end;
-
- { ======================================================================= }
- { Original File: ConvertUTF7.c }
- { Author: David B. Goldsmith }
- { Copyright (C) 1994, 1996 Taligent, Inc. All rights reserved. }
- { }
- { This code is copyrighted. Under the copyright laws, this code may not }
- { be copied, in whole or part, without prior written consent of Taligent. }
- { }
- { Taligent grants the right to use this code as long as this ENTIRE }
- { copyright notice is reproduced in the code. The code is provided }
- { AS-IS, AND TALIGENT DISCLAIMS ALL WARRANTIES, EITHER EXPRESS OR }
- { IMPLIED, INCLUDING, BUT NOT LIMITED TO IMPLIED WARRANTIES OF }
- { MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN NO EVENT }
- { WILL TALIGENT BE LIABLE FOR ANY DAMAGES WHATSOEVER (INCLUDING, }
- { WITHOUT LIMITATION, DAMAGES FOR LOSS OF BUSINESS PROFITS, BUSINESS }
- { INTERRUPTION, LOSS OF BUSINESS INFORMATION, OR OTHER PECUNIARY }
- { LOSS) ARISING OUT OF THE USE OR INABILITY TO USE THIS CODE, EVEN }
- { IF TALIGENT HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. }
- { BECAUSE SOME STATES DO NOT ALLOW THE EXCLUSION OR LIMITATION OF }
- { LIABILITY FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES, THE ABOVE }
- { LIMITATION MAY NOT APPLY TO YOU. }
- { }
- { RESTRICTED RIGHTS LEGEND: Use, duplication, or disclosure by the }
- { government is subject to restrictions as set forth in subparagraph }
- { (c)(l)(ii) of the Rights in Technical Data and Computer Software }
- { clause at DFARS 252.227-7013 and FAR 52.227-19. }
- { }
- { This code may be protected by one or more U.S. and International }
- { Patents. }
- { }
- { TRADEMARKS: Taligent and the Taligent Design Mark are registered }
- { trademarks of Taligent, Inc. }
- { ======================================================================= }
-
-type UCS2 = Word;
-
-const
- _base64: AnsiString = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
- _direct: AnsiString = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789''(),-./:?';
- _optional: AnsiString = '!"#$%&*;<=>@[]^_`{|}';
- _spaces: AnsiString = #9#13#10#32;
-
-var
- base64: PAnsiChar;
- invbase64: array[0..127] of SmallInt;
- direct: PAnsiChar;
- optional: PAnsiChar;
- spaces: PAnsiChar;
- mustshiftsafe: array[0..127] of AnsiChar;
- mustshiftopt: array[0..127] of AnsiChar;
-
-var
- needtables: Boolean = True;
-
-procedure Initialize_UTF7_Data;
-begin
- base64 := PAnsiChar(_base64);
- direct := PAnsiChar(_direct);
- optional := PAnsiChar(_optional);
- spaces := PAnsiChar(_spaces);
-end;
-
-procedure tabinit;
-var
- i: Integer;
- limit: Integer;
-begin
- i := 0;
- while (i < 128) do
- begin
- mustshiftopt[i] := #1;
- mustshiftsafe[i] := #1;
- invbase64[i] := -1;
- Inc(i);
- end { For };
- limit := Length(_Direct);
- i := 0;
- while (i < limit) do
- begin
- mustshiftopt[Integer(direct[i])] := #0;
- mustshiftsafe[Integer(direct[i])] := #0;
- Inc(i);
- end { For };
- limit := Length(_Spaces);
- i := 0;
- while (i < limit) do
- begin
- mustshiftopt[Integer(spaces[i])] := #0;
- mustshiftsafe[Integer(spaces[i])] := #0;
- Inc(i);
- end { For };
- limit := Length(_Optional);
- i := 0;
- while (i < limit) do
- begin
- mustshiftopt[Integer(optional[i])] := #0;
- Inc(i);
- end { For };
- limit := Length(_Base64);
- i := 0;
- while (i < limit) do
- begin
- invbase64[Integer(base64[i])] := i;
- Inc(i);
- end { For };
- needtables := False;
-end; { tabinit }
-
-function WRITE_N_BITS(x: UCS2; n: Integer; var BITbuffer: Cardinal; var bufferbits: Integer): Integer;
-begin
- BITbuffer := BITbuffer or (x and (not (-1 shl n))) shl (32 - n - bufferbits);
- bufferbits := bufferbits + n;
- Result := bufferbits;
-end; { WRITE_N_BITS }
-
-function READ_N_BITS(n: Integer; var BITbuffer: Cardinal; var bufferbits: Integer): UCS2;
-var
- buffertemp: Cardinal;
-begin
- buffertemp := BITbuffer shr (32 - n);
- BITbuffer := BITbuffer shl n;
- bufferbits := bufferbits - n;
- Result := UCS2(buffertemp);
-end; { READ_N_BITS }
-
-function ConvertUCS2toUTF7(var sourceStart: PWideChar; sourceEnd: PWideChar;
- var targetStart: PAnsiChar; targetEnd: PAnsiChar; optional: Boolean;
- verbose: Boolean): Integer;
-var
- r: UCS2;
- target: PAnsiChar;
- source: PWideChar;
- BITbuffer: Cardinal;
- bufferbits: Integer;
- shifted: Boolean;
- needshift: Boolean;
- done: Boolean;
- mustshift: PAnsiChar;
-begin
- Initialize_UTF7_Data;
- Result := 0;
- BITbuffer := 0;
- bufferbits := 0;
- shifted := False;
- source := sourceStart;
- target := targetStart;
- r := 0;
- if needtables then
- tabinit;
- if optional then
- mustshift := @mustshiftopt[0]
- else
- mustshift := @mustshiftsafe[0];
- repeat
- done := source >= sourceEnd;
- if not Done then
- begin
- r := Word(source^);
- Inc(Source);
- end { If };
- needshift := (not done) and ((r > $7F) or (mustshift[r] <> #0));
- if needshift and (not shifted) then
- begin
- if (Target >= TargetEnd) then
- begin
- Result := 2;
- break;
- end { If };
- target^ := '+';
- Inc(target);
- { Special case handling of the SHIFT_IN character }
- if (r = UCS2('+')) then
- begin
- if (target >= targetEnd) then
- begin
- Result := 2;
- break;
- end;
- target^ := '-';
- Inc(target);
- end
- else
- shifted := True;
- end { If };
- if shifted then
- begin
- { Either write the character to the bit buffer, or pad }
- { the bit buffer out to a full base64 character. }
- { }
- if needshift then
- WRITE_N_BITS(r, 16, BITbuffer, bufferbits)
- else
- WRITE_N_BITS(0, (6 - (bufferbits mod 6)) mod 6, BITbuffer,
- bufferbits);
- { Flush out as many full base64 characters as possible }
- { from the bit buffer. }
- { }
- while (target < targetEnd) and (bufferbits >= 6) do
- begin
- Target^ := base64[READ_N_BITS(6, BITbuffer, bufferbits)];
- Inc(Target);
- end { While };
- if (bufferbits >= 6) then
- begin
- if (target >= targetEnd) then
- begin
- Result := 2;
- break;
- end { If };
- end { If };
- if (not needshift) then
- begin
- { Write the explicit shift out character if }
- { 1) The caller has requested we always do it, or }
- { 2) The directly encoded character is in the }
- { base64 set, or }
- { 3) The directly encoded character is SHIFT_OUT. }
- { }
- if verbose or ((not done) and ((invbase64[r] >= 0) or (r =
- Integer('-')))) then
- begin
- if (target >= targetEnd) then
- begin
- Result := 2;
- Break;
- end { If };
- Target^ := '-';
- Inc(Target);
- end { If };
- shifted := False;
- end { If };
- { The character can be directly encoded as ASCII. }
- end { If };
- if (not needshift) and (not done) then
- begin
- if (target >= targetEnd) then
- begin
- Result := 2;
- break;
- end { If };
- Target^ := AnsiChar(r);
- Inc(Target);
- end { If };
- until (done);
- sourceStart := source;
- targetStart := target;
-end; { ConvertUCS2toUTF7 }
-
-function ConvertUTF7toUCS2(var sourceStart: PAnsiChar; sourceEnd: PAnsiChar;
- var targetStart: PWideChar; targetEnd: PWideChar): Integer;
-var
- target: PWideChar { Register };
- source: PAnsiChar { Register };
- BITbuffer: Cardinal { & "Address Of" Used };
- bufferbits: Integer { & "Address Of" Used };
- shifted: Boolean { Used In Boolean Context };
- first: Boolean { Used In Boolean Context };
- wroteone: Boolean;
- base64EOF: Boolean;
- base64value: Integer;
- done: Boolean;
- c: UCS2;
- prevc: UCS2;
- junk: UCS2 { Used In Boolean Context };
-begin
- Initialize_UTF7_Data;
- Result := 0;
- BITbuffer := 0;
- bufferbits := 0;
- shifted := False;
- first := False;
- wroteone := False;
- source := sourceStart;
- target := targetStart;
- c := 0;
- if needtables then
- tabinit;
- repeat
- { read an ASCII character c }
- done := Source >= SourceEnd;
- if (not done) then
- begin
- c := Word(Source^);
- Inc(Source);
- end { If };
- if shifted then
- begin
- { We're done with a base64 string if we hit EOF, it's not a valid }
- { ASCII character, or it's not in the base64 set. }
- { }
- base64value := invbase64[c];
- base64EOF := (done or (c > $7F)) or (base64value < 0);
- if base64EOF then
- begin
- shifted := False;
- { If the character causing us to drop out was SHIFT_IN or }
- { SHIFT_OUT, it may be a special escape for SHIFT_IN. The }
- { test for SHIFT_IN is not necessary, but allows an alternate }
- { form of UTF-7 where SHIFT_IN is escaped by SHIFT_IN. This }
- { only works for some values of SHIFT_IN. }
- { }
- if ((not done) and ((c = Integer('+')) or (c = Integer('-')))) then
- begin
- { get another character c }
- prevc := c;
- Done := Source >= SourceEnd;
- if (not Done) then
- begin
- c := Word(Source^);
- Inc(Source);
- { If no base64 characters were encountered, and the }
- { character terminating the shift sequence was }
- { SHIFT_OUT, then it's a special escape for SHIFT_IN. }
- { }
- end;
- if first and (prevc = Integer('-')) then
- begin
- { write SHIFT_IN unicode }
- if (target >= targetEnd) then
- begin
- Result := 2;
- break;
- end { If };
- Target^ := WideChar('+');
- Inc(Target);
- end
- else
- begin
- if (not wroteone) then
- begin
- Result := 1;
- end { If };
- end { Else };
- ;
- end { If }
- else
- begin
- if (not wroteone) then
- begin
- Result := 1;
- end { If };
- end { Else };
- end { If }
- else
- begin
- { Add another 6 bits of base64 to the bit buffer. }
- WRITE_N_BITS(base64value, 6, BITbuffer,
- bufferbits);
- first := False;
- end { Else };
- { Extract as many full 16 bit characters as possible from the }
- { bit buffer. }
- { }
- while (bufferbits >= 16) and (target < targetEnd) do
- begin
- { write a unicode }
- Target^ := WideChar(READ_N_BITS(16, BITbuffer, bufferbits));
- Inc(Target);
- wroteone := True;
- end { While };
- if (bufferbits >= 16) then
- begin
- if (target >= targetEnd) then
- begin
- Result := 2;
- Break;
- end;
- end { If };
- if (base64EOF) then
- begin
- junk := READ_N_BITS(bufferbits, BITbuffer, bufferbits);
- if (junk <> 0) then
- begin
- Result := 1;
- end { If };
- end { If };
- end { If };
- if (not shifted) and (not done) then
- begin
- if (c = Integer('+')) then
- begin
- shifted := True;
- first := True;
- wroteone := False;
- end { If }
- else
- begin
- { It must be a directly encoded character. }
- if (c > $7F) then
- begin
- Result := 1;
- end { If };
- if (target >= targetEnd) then
- begin
- Result := 2;
- break;
- end { If };
- Target^ := WideChar(c);
- Inc(Target);
- end { Else };
- end { If };
- until (done);
- sourceStart := source;
- targetStart := target;
-end; { ConvertUTF7toUCS2 }
-
- {*****************************************************************************}
- { Thanks to Francisco Leong for providing the Pascal conversion of }
- { ConvertUTF7.c (by David B. Goldsmith) }
- {*****************************************************************************}
-
-resourcestring
- SBufferOverflow = 'Buffer overflow';
- SInvalidUTF7 = 'Invalid UTF7';
-
-function WideStringToUTF7(const W: WideString): AnsiString;
-var
- SourceStart, SourceEnd: PWideChar;
- TargetStart, TargetEnd: PAnsiChar;
-begin
- if W = '' then
- Result := ''
- else
- begin
- SetLength(Result, Length(W) * 7); // Assume worst case
- SourceStart := PWideChar(@W[1]);
- SourceEnd := PWideChar(@W[Length(W)]) + 1;
- TargetStart := PAnsiChar(@Result[1]);
- TargetEnd := PAnsiChar(@Result[Length(Result)]) + 1;
- if ConvertUCS2toUTF7(SourceStart, SourceEnd, TargetStart,
- TargetEnd, True, False) <> 0
- then
- raise ETntInternalError.Create(SBufferOverflow);
- SetLength(Result, TargetStart - PAnsiChar(@Result[1]));
- end;
-end;
-
-function UTF7ToWideString(const S: AnsiString): WideString;
-var
- SourceStart, SourceEnd: PAnsiChar;
- TargetStart, TargetEnd: PWideChar;
-begin
- if (S = '') then
- Result := ''
- else
- begin
- SetLength(Result, Length(S)); // Assume Worst case
- SourceStart := PAnsiChar(@S[1]);
- SourceEnd := PAnsiChar(@S[Length(S)]) + 1;
- TargetStart := PWideChar(@Result[1]);
- TargetEnd := PWideChar(@Result[Length(Result)]) + 1;
- case ConvertUTF7toUCS2(SourceStart, SourceEnd, TargetStart,
- TargetEnd) of
- 1: raise ETntGeneralError.Create(SInvalidUTF7);
- 2: raise ETntInternalError.Create(SBufferOverflow);
- end;
- SetLength(Result, TargetStart - PWideChar(@Result[1]));
- end;
-end;
-
-function StringToWideStringEx(const S: AnsiString; CodePage: Cardinal): WideString;
-var
- InputLength,
- OutputLength: Integer;
-begin
- if CodePage = CP_UTF7 then
- Result := UTF7ToWideString(S) // CP_UTF7 not supported on Windows 95
- else if CodePage = CP_UTF8 then
- Result := UTF8ToWideString(S) // CP_UTF8 not supported on Windows 95
- else begin
- InputLength := Length(S);
- OutputLength := MultiByteToWideChar(CodePage, 0, PAnsiChar(S), InputLength, nil, 0);
- SetLength(Result, OutputLength);
- MultiByteToWideChar(CodePage, 0, PAnsiChar(S), InputLength, PWideChar(Result), OutputLength);
- end;
-end;
-
-function WideStringToStringEx(const WS: WideString; CodePage: Cardinal): AnsiString;
-var
- InputLength,
- OutputLength: Integer;
-begin
- if CodePage = CP_UTF7 then
- Result := WideStringToUTF7(WS) // CP_UTF7 not supported on Windows 95
- else if CodePage = CP_UTF8 then
- Result := WideStringToUTF8(WS) // CP_UTF8 not supported on Windows 95
- else begin
- InputLength := Length(WS);
- OutputLength := WideCharToMultiByte(CodePage, 0, PWideChar(WS), InputLength, nil, 0, nil, nil);
- SetLength(Result, OutputLength);
- WideCharToMultiByte(CodePage, 0, PWideChar(WS), InputLength, PAnsiChar(Result), OutputLength, nil, nil);
- end;
-end;
-
-function UCS2ToWideString(const Value: AnsiString): WideString;
-begin
- if Length(Value) = 0 then
- Result := ''
- else
- SetString(Result, PWideChar(@Value[1]), Length(Value) div SizeOf(WideChar))
-end;
-
-function WideStringToUCS2(const Value: WideString): AnsiString;
-begin
- if Length(Value) = 0 then
- Result := ''
- else
- SetString(Result, PAnsiChar(@Value[1]), Length(Value) * SizeOf(WideChar))
-end;
-
-{ Windows.pas doesn't declare TranslateCharsetInfo() correctly. }
-function TranslateCharsetInfo(lpSrc: PDWORD; var lpCs: TCharsetInfo; dwFlags: DWORD): BOOL; stdcall; external gdi32 name 'TranslateCharsetInfo';
-
-function CharSetToCodePage(ciCharset: UINT): Cardinal;
-var
- C: TCharsetInfo;
-begin
- Win32Check(TranslateCharsetInfo(PDWORD(ciCharset), C, TCI_SRCCHARSET));
- Result := C.ciACP
-end;
-
-function LCIDToCodePage(ALcid: LCID): Cardinal;
-var
- Buf: array[0..6] of AnsiChar;
-begin
- GetLocaleInfo(ALcid, LOCALE_IDefaultAnsiCodePage, Buf, 6);
- Result := StrToIntDef(Buf, GetACP);
-end;
-
-function KeyboardCodePage: Cardinal;
-begin
- Result := LCIDToCodePage(GetKeyboardLayout(0) and $FFFF);
-end;
-
-function KeyUnicode(CharCode: Word): WideChar;
-var
- AChar: AnsiChar;
-begin
- // converts the given character (as it comes with a WM_CHAR message) into its
- // corresponding Unicode character depending on the active keyboard layout
- if CharCode <= Word(High(AnsiChar)) then begin
- AChar := AnsiChar(CharCode);
- MultiByteToWideChar(KeyboardCodePage, MB_USEGLYPHCHARS, @AChar, 1, @Result, 1);
- end else
- Result := WideChar(CharCode);
-end;
-
-procedure StrSwapByteOrder(Str: PWideChar);
-var
- P: PWord;
-begin
- P := PWord(Str);
- While (P^ <> 0) do begin
- P^ := MakeWord(HiByte(P^), LoByte(P^));
- Inc(P);
- end;
-end;
-
-{$IFDEF USE_SYSTEM_OVERRIDES}
-
-//--------------------------------------------------------------------
-// LoadResString()
-//
-// This system function is used to retrieve a resourcestring and
-// return the result as an AnsiString. If we believe that the result
-// is only a temporary value, and that it will be immediately
-// assigned to a WideString or a Variant, then we will save the
-// Unicode result as well as a reference to the original Ansi string.
-// WStrFromPCharLen() or VarFromLStr() will return this saved
-// Unicode string if it appears to receive the most recent result
-// of LoadResString.
-//--------------------------------------------------------------------
-
-
- //===========================================================================================
- //
- // function CodeMatchesPatternForUnicode(...);
- //
- // GIVEN: SomeWideString := SSomeResString; { WideString := resourcestring }
- //
- // Delphi will compile this statement into the following:
- // -------------------------------------------------
- // TempAnsiString := LoadResString(@SSomeResString);
- // LINE 1: lea edx,[SomeTempAnsiString]
- // LINE 2: mov eax,[@SomeResString]
- // LINE 3: call LoadResString
- //
- // WStrFromLStr(SomeWideString, TempAnsiString); { SomeWideString := TempAnsiString }
- // LINE 4: mov edx,[SomeTempAnsiString]
- // LINE 5: mov/lea eax [@SomeWideString]
- // LINE 6: call @WStrFromLStr
- // -------------------------------------------------
- //
- // The order in which the parameters are prepared for WStrFromLStr (ie LINE 4 & 5) is
- // reversed when assigning a non-temporary AnsiString to a WideString.
- //
- // This code, for example, results in LINE 4 and LINE 5 being swapped.
- //
- // SomeAnsiString := SSomeResString;
- // SomeWideString := SomeAnsiString;
- //
- // Since we know the "signature" used by the compiler, we can detect this pattern.
- // If we believe it is only temporary, we can save the Unicode results for later
- // retrieval from WStrFromLStr.
- //
- // One final note: When assigning a resourcestring to a Variant, the same patterns exist.
- //===========================================================================================
-
-function CodeMatchesPatternForUnicode(PLine4: PAnsiChar): Boolean;
-const
- SIZEOF_OPCODE = 1 {byte};
- MOV_16_OPCODE = AnsiChar($8B); { we'll assume operand size is 16 bits }
- MOV_32_OPCODE = AnsiChar($B8); { we'll assume operand size is 32 bits }
- LEA_OPCODE = AnsiChar($8D); { operand size can be 16 or 40 bits }
- CALL_OPCODE = AnsiChar($E8); { assumed operand size is 32 bits }
- BREAK_OPCODE = AnsiChar($CC); {in a breakpoint}
-var
- PLine1: PAnsiChar;
- PLine2: PAnsiChar;
- PLine3: PAnsiChar;
- DataSize: Integer; // bytes in first LEA operand
-begin
- Result := False;
-
- PLine3 := PLine4 - SizeOf(CALL_OPCODE) - 4;
- PLine2 := PLine3 - SizeOf(MOV_32_OPCODE) - 4;
-
- // figure PLine1 and operand size
- DataSize := 2; { try 16 bit operand for line 1 }
- PLine1 := PLine2 - DataSize - SizeOf(LEA_OPCODE);
- if (PLine1^ <> LEA_OPCODE) and (not (IsDebugging and (PLine1^ = BREAK_OPCODE))) then
- begin
- DataSize := 5; { try 40 bit operand for line 1 }
- PLine1 := PLine2 - DataSize - SizeOf(LEA_OPCODE);
- end;
- if (PLine1^ = LEA_OPCODE) or (IsDebugging and (PLine1^ = BREAK_OPCODE)) then
- begin
- if CompareMem(PLine1 + SIZEOF_OPCODE, PLine4 + SIZEOF_OPCODE, DataSize) then
- begin
- // After this check, it seems to match the WideString <- (temp) AnsiString pattern
- Result := True; // It is probably OK. (The side effects of being wrong aren't very bad.)
- end;
- end;
-end;
-
-threadvar
- PLastResString: PAnsiChar;
- LastResStringValue: AnsiString;
- LastWideResString: WideString;
-
-procedure FreeTntSystemThreadVars;
-begin
- LastResStringValue := '';
- LastWideResString := '';
-end;
-
-procedure Custom_System_EndThread(ExitCode: Integer);
-begin
- FreeTntSystemThreadVars;
- {$IFDEF COMPILER_10_UP}
- if Assigned(SystemThreadEndProc) then
- SystemThreadEndProc(ExitCode);
- {$ENDIF}
- ExitThread(ExitCode);
-end;
-
-function Custom_System_LoadResString(ResStringRec: PResStringRec): AnsiString;
-var
- ReturnAddr: Pointer;
-begin
- // get return address
- asm
- PUSH ECX
- MOV ECX, [EBP + 4]
- MOV ReturnAddr, ECX
- POP ECX
- end;
- // check calling code pattern
- if CodeMatchesPatternForUnicode(ReturnAddr) then begin
- // result will probably be assigned to an intermediate AnsiString
- // on its way to either a WideString or Variant.
- LastWideResString := WideLoadResString(ResStringRec);
- Result := LastWideResString;
- LastResStringValue := Result;
- if Result = '' then
- PLastResString := nil
- else
- PLastResString := PAnsiChar(Result);
- end else begin
- // result will probably be assigned to an actual AnsiString variable.
- PLastResString := nil;
- Result := WideLoadResString(ResStringRec);
- end;
-end;
-
-//--------------------------------------------------------------------
-// WStrFromPCharLen()
-//
-// This system function is used to assign an AnsiString to a WideString.
-// It has been modified to assign Unicode results from LoadResString.
-// Another purpose of this function is to specify the code page.
-//--------------------------------------------------------------------
-
-procedure Custom_System_WStrFromPCharLen(var Dest: WideString; Source: PAnsiChar; Length: Integer);
-var
- DestLen: Integer;
- Buffer: array[0..2047] of WideChar;
- Local_PLastResString: Pointer;
-begin
- Local_PLastResString := PLastResString;
- if (Local_PLastResString <> nil)
- and (Local_PLastResString = Source)
- and (System.Length(LastResStringValue) = Length)
- and (LastResStringValue = Source) then begin
- // use last unicode resource string
- PLastResString := nil; { clear for further use }
- Dest := LastWideResString;
- end else begin
- if Local_PLastResString <> nil then
- PLastResString := nil; { clear for further use }
- if Length <= 0 then
- begin
- Dest := '';
- Exit;
- end;
- if Length + 1 < High(Buffer) then
- begin
- DestLen := MultiByteToWideChar(DefaultSystemCodePage, 0, Source, Length, Buffer,
- High(Buffer));
- if DestLen > 0 then
- begin
- SetLength(Dest, DestLen);
- Move(Pointer(@Buffer[0])^, Pointer(Dest)^, DestLen * SizeOf(WideChar));
- Exit;
- end;
- end;
- DestLen := (Length + 1);
- SetLength(Dest, DestLen); // overallocate, trim later
- DestLen := MultiByteToWideChar(DefaultSystemCodePage, 0, Source, Length, Pointer(Dest),
- DestLen);
- if DestLen < 0 then
- DestLen := 0;
- SetLength(Dest, DestLen);
- end;
-end;
-
-{$IFNDEF COMPILER_9_UP}
-
-//--------------------------------------------------------------------
-// LStrFromPWCharLen()
-//
-// This system function is used to assign an WideString to an AnsiString.
-// It has not been modified from its original purpose other than to specify the code page.
-//--------------------------------------------------------------------
-
-procedure Custom_System_LStrFromPWCharLen(var Dest: AnsiString; Source: PWideChar; Length: Integer);
-var
- DestLen: Integer;
- Buffer: array[0..4095] of AnsiChar;
-begin
- if Length <= 0 then
- begin
- Dest := '';
- Exit;
- end;
- if Length + 1 < (High(Buffer) div sizeof(WideChar)) then
- begin
- DestLen := WideCharToMultiByte(DefaultSystemCodePage, 0, Source,
- Length, Buffer, High(Buffer),
- nil, nil);
- if DestLen >= 0 then
- begin
- SetLength(Dest, DestLen);
- Move(Pointer(@Buffer[0])^, PAnsiChar(Dest)^, DestLen);
- Exit;
- end;
- end;
-
- DestLen := (Length + 1) * sizeof(WideChar);
- SetLength(Dest, DestLen); // overallocate, trim later
- DestLen := WideCharToMultiByte(DefaultSystemCodePage, 0, Source, Length, Pointer(Dest), DestLen,
- nil, nil);
- if DestLen < 0 then
- DestLen := 0;
- SetLength(Dest, DestLen);
-end;
-
-//--------------------------------------------------------------------
-// WStrToString()
-//
-// This system function is used to assign an WideString to an short string.
-// It has not been modified from its original purpose other than to specify the code page.
-//--------------------------------------------------------------------
-
-procedure Custom_System_WStrToString(Dest: PShortString; const Source: WideString; MaxLen: Integer);
-var
- SourceLen, DestLen: Integer;
- Buffer: array[0..511] of AnsiChar;
-begin
- if MaxLen > 255 then MaxLen := 255;
- SourceLen := Length(Source);
- if SourceLen >= MaxLen then SourceLen := MaxLen;
- if SourceLen = 0 then
- DestLen := 0
- else begin
- DestLen := WideCharToMultiByte(DefaultSystemCodePage, 0, Pointer(Source), SourceLen,
- Buffer, SizeOf(Buffer), nil, nil);
- if DestLen > MaxLen then DestLen := MaxLen;
- end;
- Dest^[0] := Chr(DestLen);
- if DestLen > 0 then Move(Buffer, Dest^[1], DestLen);
-end;
-
-{$ENDIF}
-
-//--------------------------------------------------------------------
-// VarFromLStr()
-//
-// This system function is used to assign an AnsiString to a Variant.
-// It has been modified to assign Unicode results from LoadResString.
-//--------------------------------------------------------------------
-
-procedure Custom_System_VarFromLStr(var V: TVarData; const Value: AnsiString);
-const
- varDeepData = $BFE8;
-var
- Local_PLastResString: Pointer;
-begin
- if (V.VType and varDeepData) <> 0 then
- VarClear(PVariant(@V)^);
-
- Local_PLastResString := PLastResString;
- if (Local_PLastResString <> nil)
- and (Local_PLastResString = PAnsiChar(Value))
- and (LastResStringValue = Value) then begin
- // use last unicode resource string
- PLastResString := nil; { clear for further use }
- V.VOleStr := nil;
- V.VType := varOleStr;
- WideString(Pointer(V.VOleStr)) := Copy(LastWideResString, 1, MaxInt);
- end else begin
- if Local_PLastResString <> nil then
- PLastResString := nil; { clear for further use }
- V.VString := nil;
- V.VType := varString;
- AnsiString(V.VString) := Value;
- end;
-end;
-
-{$IFNDEF COMPILER_9_UP}
-
-//--------------------------------------------------------------------
-// WStrCat3() A := B + C;
-//
-// This system function is used to concatenate two strings into one result.
-// This function is added because A := '' + '' doesn't necessarily result in A = '';
-//--------------------------------------------------------------------
-
-procedure Custom_System_WStrCat3(var Dest: WideString; const Source1, Source2: WideString);
-
- function NewWideString(CharLength: Longint): Pointer;
- var
- _NewWideString: function(CharLength: Longint): Pointer;
- begin
- asm
- PUSH ECX
- MOV ECX, offset System.@NewWideString;
- MOV _NewWideString, ECX
- POP ECX
- end;
- Result := _NewWideString(CharLength);
- end;
-
- procedure WStrSet(var S: WideString; P: PWideChar);
- var
- Temp: Pointer;
- begin
- Temp := Pointer(InterlockedExchange(Integer(S), Integer(P)));
- if Temp <> nil then
- WideString(Temp) := '';
- end;
-
-var
- Source1Len, Source2Len: Integer;
- NewStr: PWideChar;
-begin
- Source1Len := Length(Source1);
- Source2Len := Length(Source2);
- if (Source1Len <> 0) or (Source2Len <> 0) then
- begin
- NewStr := NewWideString(Source1Len + Source2Len);
- Move(Pointer(Source1)^, Pointer(NewStr)^, Source1Len * sizeof(WideChar));
- Move(Pointer(Source2)^, NewStr[Source1Len], Source2Len * sizeof(WideChar));
- WStrSet(Dest, NewStr);
- end else
- Dest := '';
-end;
-
-{$ENDIF}
-
-//--------------------------------------------------------------------
-// System proc replacements
-//--------------------------------------------------------------------
-
-type
- POverwrittenData = ^TOverwrittenData;
- TOverwrittenData = record
- Location: Pointer;
- OldCode: array[0..6] of Byte;
- end;
-
-procedure OverwriteProcedure(OldProcedure, NewProcedure: pointer; Data: POverwrittenData = nil);
-{ OverwriteProcedure originally from Igor Siticov }
-{ Modified by Jacques Garcia Vazquez }
-var
- x: PAnsiChar;
- y: integer;
- ov2, ov: cardinal;
- p: pointer;
-begin
- if Assigned(Data) and (Data.Location <> nil) then
- exit; { procedure already overwritten }
-
- // need six bytes in place of 5
- x := PAnsiChar(OldProcedure);
- if not VirtualProtect(Pointer(x), 6, PAGE_EXECUTE_READWRITE, @ov) then
- RaiseLastOSError;
-
- // if a jump is present then a redirect is found
- // $FF25 = jmp dword ptr [xxx]
- // This redirect is normally present in bpl files, but not in exe files
- p := OldProcedure;
-
- if Word(p^) = $25FF then
- begin
- Inc(Integer(p), 2); // skip the jump
- // get the jump address p^ and dereference it p^^
- p := Pointer(Pointer(p^)^);
-
- // release the memory
- if not VirtualProtect(Pointer(x), 6, ov, @ov2) then
- RaiseLastOSError;
-
- // re protect the correct one
- x := PAnsiChar(p);
- if not VirtualProtect(Pointer(x), 6, PAGE_EXECUTE_READWRITE, @ov) then
- RaiseLastOSError;
- end;
-
- if Assigned(Data) then
- begin
- Move(x^, Data.OldCode, 6);
- { Assign Location last so that Location <> nil only if OldCode is properly initialized. }
- Data.Location := x;
- end;
-
- x[0] := AnsiChar($E9);
- y := integer(NewProcedure) - integer(p) - 5;
- x[1] := AnsiChar(y and 255);
- x[2] := AnsiChar((y shr 8) and 255);
- x[3] := AnsiChar((y shr 16) and 255);
- x[4] := AnsiChar((y shr 24) and 255);
-
- if not VirtualProtect(Pointer(x), 6, ov, @ov2) then
- RaiseLastOSError;
-end;
-
-procedure RestoreProcedure(OriginalProc: Pointer; Data: TOverwrittenData);
-var
- ov, ov2: Cardinal;
-begin
- if Data.Location <> nil then begin
- if not VirtualProtect(Data.Location, 6, PAGE_EXECUTE_READWRITE, @ov) then
- RaiseLastOSError;
- Move(Data.OldCode, Data.Location^, 6);
- if not VirtualProtect(Data.Location, 6, ov, @ov2) then
- RaiseLastOSError;
- end;
-end;
-
-function Addr_System_EndThread: Pointer;
-begin
- Result := @System.EndThread;
-end;
-
-function Addr_System_LoadResString: Pointer;
-begin
- Result := @System.LoadResString{TNT-ALLOW LoadResString};
-end;
-
-function Addr_System_WStrFromPCharLen: Pointer;
-asm
- mov eax, offset System.@WStrFromPCharLen;
-end;
-
-{$IFNDEF COMPILER_9_UP}
-function Addr_System_LStrFromPWCharLen: Pointer;
-asm
- mov eax, offset System.@LStrFromPWCharLen;
-end;
-
-function Addr_System_WStrToString: Pointer;
-asm
- mov eax, offset System.@WStrToString;
-end;
-{$ENDIF}
-
-function Addr_System_VarFromLStr: Pointer;
-asm
- mov eax, offset System.@VarFromLStr;
-end;
-
-function Addr_System_WStrCat3: Pointer;
-asm
- mov eax, offset System.@WStrCat3;
-end;
-
-var
- System_EndThread_Code,
- System_LoadResString_Code,
- System_WStrFromPCharLen_Code,
- {$IFNDEF COMPILER_9_UP}
- System_LStrFromPWCharLen_Code,
- System_WStrToString_Code,
- {$ENDIF}
- System_VarFromLStr_Code
- {$IFNDEF COMPILER_9_UP}
- ,
- System_WStrCat3_Code,
- SysUtils_WideFmtStr_Code
- {$ENDIF}
- : TOverwrittenData;
-
-procedure InstallEndThreadOverride;
-begin
- OverwriteProcedure(Addr_System_EndThread, @Custom_System_EndThread, @System_EndThread_Code);
-end;
-
-procedure InstallStringConversionOverrides;
-begin
- OverwriteProcedure(Addr_System_WStrFromPCharLen, @Custom_System_WStrFromPCharLen, @System_WStrFromPCharLen_Code);
- {$IFNDEF COMPILER_9_UP}
- OverwriteProcedure(Addr_System_LStrFromPWCharLen, @Custom_System_LStrFromPWCharLen, @System_LStrFromPWCharLen_Code);
- OverwriteProcedure(Addr_System_WStrToString, @Custom_System_WStrToString, @System_WStrToString_Code);
- {$ENDIF}
-end;
-
-procedure InstallWideResourceStrings;
-begin
- OverwriteProcedure(Addr_System_LoadResString, @Custom_System_LoadResString, @System_LoadResString_Code);
- OverwriteProcedure(Addr_System_VarFromLStr, @Custom_System_VarFromLStr, @System_VarFromLStr_Code);
-end;
-
-{$IFNDEF COMPILER_9_UP}
-procedure InstallWideStringConcatenationFix;
-begin
- OverwriteProcedure(Addr_System_WStrCat3, @Custom_System_WStrCat3, @System_WStrCat3_Code);
-end;
-
-procedure InstallWideFormatFixes;
-begin
- OverwriteProcedure(@SysUtils.WideFmtStr, @TntSysUtils.Tnt_WideFmtStr, @SysUtils_WideFmtStr_Code);
-end;
-{$ENDIF}
-
-procedure InstallTntSystemUpdates(Updates: TTntSystemUpdateSet = AllTntSystemUpdates);
-begin
- InstallEndThreadOverride;
- if tsWideResourceStrings in Updates then begin
- InstallStringConversionOverrides;
- InstallWideResourceStrings;
- end;
- {$IFNDEF COMPILER_9_UP}
- if tsFixImplicitCodePage in Updates then begin
- InstallStringConversionOverrides;
- { CP_ACP is the code page used by the non-Unicode Windows API. }
- GDefaultSystemCodePage := CP_ACP{TNT-ALLOW CP_ACP};
- end;
- if tsFixWideStrConcat in Updates then begin
- InstallWideStringConcatenationFix;
- end;
- if tsFixWideFormat in Updates then begin
- InstallWideFormatFixes;
- end;
- {$ENDIF}
-end;
-
-{$IFNDEF COMPILER_9_UP}
-var
- StartupDefaultUserCodePage: Cardinal;
-{$ENDIF}
-
-procedure UninstallSystemOverrides;
-begin
- RestoreProcedure(Addr_System_EndThread, System_EndThread_Code);
- // String Conversion
- RestoreProcedure(Addr_System_WStrFromPCharLen, System_WStrFromPCharLen_Code);
- {$IFNDEF COMPILER_9_UP}
- RestoreProcedure(Addr_System_LStrFromPWCharLen, System_LStrFromPWCharLen_Code);
- RestoreProcedure(Addr_System_WStrToString, System_WStrToString_Code);
- GDefaultSystemCodePage := StartupDefaultUserCodePage;
- {$ENDIF}
- // Wide resourcestring
- RestoreProcedure(Addr_System_LoadResString, System_LoadResString_Code);
- RestoreProcedure(Addr_System_VarFromLStr, System_VarFromLStr_Code);
- {$IFNDEF COMPILER_9_UP}
- // WideString concat fix
- RestoreProcedure(Addr_System_WStrCat3, System_WStrCat3_Code);
- // WideFormat fixes
- RestoreProcedure(@SysUtils.WideFmtStr, SysUtils_WideFmtStr_Code);
- {$ENDIF}
-end;
-
-{$ENDIF USE_SYSTEM_OVERRIDES}
-
-initialization
- {$IFDEF COMPILER_9_UP}
- {$DEFINE USE_GETACP}
- {$ENDIF}
- {$IFDEF FPC}
- {$DEFINE USE_GETACP}
- {$ENDIF}
- {$IFDEF USE_GETACP}
- GDefaultSystemCodePage := GetACP;
- {$ELSE}
- {$IFDEF COMPILER_7_UP}
- if (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion >= 5) then
- GDefaultSystemCodePage := CP_THREAD_ACP // Win 2K/XP/...
- else
- GDefaultSystemCodePage := LCIDToCodePage(GetThreadLocale); // Win NT4/95/98/ME
- {$ELSE}
- GDefaultSystemCodePage := CP_ACP{TNT-ALLOW CP_ACP};
- {$ENDIF}
- {$ENDIF}
- {$IFDEF USE_SYSTEM_OVERRIDES}
- {$IFNDEF COMPILER_9_UP}
- StartupDefaultUserCodePage := DefaultSystemCodePage;
- {$ENDIF}
- IsDebugging := DebugHook > 0;
- {$ENDIF USE_SYSTEM_OVERRIDES}
-
-finalization
- {$IFDEF USE_SYSTEM_OVERRIDES}
- UninstallSystemOverrides;
- FreeTntSystemThreadVars; { Make MemorySleuth happy. }
- {$ENDIF USE_SYSTEM_OVERRIDES}
-
-end.
diff --git a/src/lib/TntUnicodeControls/TntWideStrUtils.pas b/src/lib/TntUnicodeControls/TntWideStrUtils.pas
deleted file mode 100644
index 99f63aea..00000000
--- a/src/lib/TntUnicodeControls/TntWideStrUtils.pas
+++ /dev/null
@@ -1,455 +0,0 @@
-
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntWideStrUtils;
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-{ Wide string manipulation functions }
-
-{$IFNDEF COMPILER_9_UP}
-function WStrAlloc(Size: Cardinal): PWideChar;
-function WStrBufSize(const Str: PWideChar): Cardinal;
-{$ENDIF}
-{$IFNDEF COMPILER_10_UP}
-function WStrMove(Dest: PWideChar; const Source: PWideChar; Count: Cardinal): PWideChar;
-{$ENDIF}
-{$IFNDEF COMPILER_9_UP}
-function WStrNew(const Str: PWideChar): PWideChar;
-procedure WStrDispose(Str: PWideChar);
-{$ENDIF}
-//---------------------------------------------------------------------------------------------
-{$IFNDEF COMPILER_9_UP}
-function WStrLen(Str: PWideChar): Cardinal;
-function WStrEnd(Str: PWideChar): PWideChar;
-{$ENDIF}
-{$IFNDEF COMPILER_10_UP}
-function WStrCat(Dest: PWideChar; const Source: PWideChar): PWideChar;
-{$ENDIF}
-{$IFNDEF COMPILER_9_UP}
-function WStrCopy(Dest, Source: PWideChar): PWideChar;
-function WStrLCopy(Dest, Source: PWideChar; MaxLen: Cardinal): PWideChar;
-function WStrPCopy(Dest: PWideChar; const Source: WideString): PWideChar;
-function WStrPLCopy(Dest: PWideChar; const Source: WideString; MaxLen: Cardinal): PWideChar;
-{$ENDIF}
-{$IFNDEF COMPILER_10_UP}
-function WStrScan(const Str: PWideChar; Chr: WideChar): PWideChar;
-// WStrComp and WStrPos were introduced as broken in Delphi 2006, but fixed in Delphi 2006 Update 2
-function WStrComp(Str1, Str2: PWideChar): Integer;
-function WStrPos(Str, SubStr: PWideChar): PWideChar;
-{$ENDIF}
-function Tnt_WStrComp(Str1, Str2: PWideChar): Integer; deprecated;
-function Tnt_WStrPos(Str, SubStr: PWideChar): PWideChar; deprecated;
-
-{ ------------ introduced --------------- }
-function WStrECopy(Dest, Source: PWideChar): PWideChar;
-function WStrLComp(Str1, Str2: PWideChar; MaxLen: Cardinal): Integer;
-function WStrLIComp(Str1, Str2: PWideChar; MaxLen: Cardinal): Integer;
-function WStrIComp(Str1, Str2: PWideChar): Integer;
-function WStrLower(Str: PWideChar): PWideChar;
-function WStrUpper(Str: PWideChar): PWideChar;
-function WStrRScan(const Str: PWideChar; Chr: WideChar): PWideChar;
-function WStrLCat(Dest: PWideChar; const Source: PWideChar; MaxLen: Cardinal): PWideChar;
-function WStrPas(const Str: PWideChar): WideString;
-
-{ SysUtils.pas } //-------------------------------------------------------------------------
-
-{$IFNDEF COMPILER_10_UP}
-function WideLastChar(const S: WideString): PWideChar;
-function WideQuotedStr(const S: WideString; Quote: WideChar): WideString;
-{$ENDIF}
-{$IFNDEF COMPILER_9_UP}
-function WideExtractQuotedStr(var Src: PWideChar; Quote: WideChar): Widestring;
-{$ENDIF}
-{$IFNDEF COMPILER_10_UP}
-function WideDequotedStr(const S: WideString; AQuote: WideChar): WideString;
-{$ENDIF}
-
-implementation
-
-uses
- {$IFDEF COMPILER_9_UP} WideStrUtils, {$ENDIF} Math, Windows, TntWindows;
-
-{$IFNDEF COMPILER_9_UP}
-function WStrAlloc(Size: Cardinal): PWideChar;
-begin
- Size := SizeOf(Cardinal) + (Size * SizeOf(WideChar));
- GetMem(Result, Size);
- PCardinal(Result)^ := Size;
- Inc(PAnsiChar(Result), SizeOf(Cardinal));
-end;
-
-function WStrBufSize(const Str: PWideChar): Cardinal;
-var
- P: PWideChar;
-begin
- P := Str;
- Dec(PAnsiChar(P), SizeOf(Cardinal));
- Result := PCardinal(P)^ - SizeOf(Cardinal);
- Result := Result div SizeOf(WideChar);
-end;
-{$ENDIF}
-
-{$IFNDEF COMPILER_10_UP}
-function WStrMove(Dest: PWideChar; const Source: PWideChar; Count: Cardinal): PWideChar;
-var
- Length: Integer;
-begin
- Result := Dest;
- Length := Count * SizeOf(WideChar);
- Move(Source^, Dest^, Length);
-end;
-{$ENDIF}
-
-{$IFNDEF COMPILER_9_UP}
-function WStrNew(const Str: PWideChar): PWideChar;
-var
- Size: Cardinal;
-begin
- if Str = nil then Result := nil else
- begin
- Size := WStrLen(Str) + 1;
- Result := WStrMove(WStrAlloc(Size), Str, Size);
- end;
-end;
-
-procedure WStrDispose(Str: PWideChar);
-begin
- if Str <> nil then
- begin
- Dec(PAnsiChar(Str), SizeOf(Cardinal));
- FreeMem(Str, Cardinal(Pointer(Str)^));
- end;
-end;
-{$ENDIF}
-
-//---------------------------------------------------------------------------------------------
-
-{$IFNDEF COMPILER_9_UP}
-function WStrLen(Str: PWideChar): Cardinal;
-begin
- Result := WStrEnd(Str) - Str;
-end;
-
-function WStrEnd(Str: PWideChar): PWideChar;
-begin
- // returns a pointer to the end of a null terminated string
- Result := Str;
- While Result^ <> #0 do
- Inc(Result);
-end;
-{$ENDIF}
-
-{$IFNDEF COMPILER_10_UP}
-function WStrCat(Dest: PWideChar; const Source: PWideChar): PWideChar;
-begin
- Result := Dest;
- WStrCopy(WStrEnd(Dest), Source);
-end;
-{$ENDIF}
-
-{$IFNDEF COMPILER_9_UP}
-function WStrCopy(Dest, Source: PWideChar): PWideChar;
-begin
- Result := WStrLCopy(Dest, Source, MaxInt);
-end;
-
-function WStrLCopy(Dest, Source: PWideChar; MaxLen: Cardinal): PWideChar;
-var
- Count: Cardinal;
-begin
- // copies a specified maximum number of characters from Source to Dest
- Result := Dest;
- Count := 0;
- While (Count < MaxLen) and (Source^ <> #0) do begin
- Dest^ := Source^;
- Inc(Source);
- Inc(Dest);
- Inc(Count);
- end;
- Dest^ := #0;
-end;
-
-function WStrPCopy(Dest: PWideChar; const Source: WideString): PWideChar;
-begin
- Result := WStrLCopy(Dest, PWideChar(Source), Length(Source));
-end;
-
-function WStrPLCopy(Dest: PWideChar; const Source: WideString; MaxLen: Cardinal): PWideChar;
-begin
- Result := WStrLCopy(Dest, PWideChar(Source), MaxLen);
-end;
-{$ENDIF}
-
-{$IFNDEF COMPILER_10_UP}
-function WStrScan(const Str: PWideChar; Chr: WideChar): PWideChar;
-begin
- Result := Str;
- while Result^ <> Chr do
- begin
- if Result^ = #0 then
- begin
- Result := nil;
- Exit;
- end;
- Inc(Result);
- end;
-end;
-
-function WStrComp(Str1, Str2: PWideChar): Integer;
-begin
- Result := WStrLComp(Str1, Str2, MaxInt);
-end;
-
-function WStrPos(Str, SubStr: PWideChar): PWideChar;
-var
- PSave: PWideChar;
- P: PWideChar;
- PSub: PWideChar;
-begin
- // returns a pointer to the first occurance of SubStr in Str
- Result := nil;
- if (Str <> nil) and (Str^ <> #0) and (SubStr <> nil) and (SubStr^ <> #0) then begin
- P := Str;
- While P^ <> #0 do begin
- if P^ = SubStr^ then begin
- // investigate possibility here
- PSave := P;
- PSub := SubStr;
- While (P^ = PSub^) do begin
- Inc(P);
- Inc(PSub);
- if (PSub^ = #0) then begin
- Result := PSave;
- exit; // found a match
- end;
- if (P^ = #0) then
- exit; // no match, hit end of string
- end;
- P := PSave;
- end;
- Inc(P);
- end;
- end;
-end;
-{$ENDIF}
-
-function Tnt_WStrComp(Str1, Str2: PWideChar): Integer; deprecated;
-begin
- Result := WStrComp(Str1, Str2);
-end;
-
-function Tnt_WStrPos(Str, SubStr: PWideChar): PWideChar; deprecated;
-begin
- Result := WStrPos(Str, SubStr);
-end;
-
-//------------------------------------------------------------------------------
-
-function WStrECopy(Dest, Source: PWideChar): PWideChar;
-begin
- Result := WStrEnd(WStrCopy(Dest, Source));
-end;
-
-function WStrComp_EX(Str1, Str2: PWideChar; MaxLen: Cardinal; dwCmpFlags: Cardinal): Integer;
-var
- Len1, Len2: Integer;
-begin
- if MaxLen = Cardinal(MaxInt) then begin
- Len1 := -1;
- Len2 := -1;
- end else begin
- Len1 := Min(WStrLen(Str1), MaxLen);
- Len2 := Min(WStrLen(Str2), MaxLen);
- end;
- Result := Tnt_CompareStringW(GetThreadLocale, dwCmpFlags, Str1, Len1, Str2, Len2) - 2;
-end;
-
-function WStrLComp(Str1, Str2: PWideChar; MaxLen: Cardinal): Integer;
-begin
- Result := WStrComp_EX(Str1, Str2, MaxLen, 0);
-end;
-
-function WStrLIComp(Str1, Str2: PWideChar; MaxLen: Cardinal): Integer;
-begin
- Result := WStrComp_EX(Str1, Str2, MaxLen, NORM_IGNORECASE);
-end;
-
-function WStrIComp(Str1, Str2: PWideChar): Integer;
-begin
- Result := WStrLIComp(Str1, Str2, MaxInt);
-end;
-
-function WStrLower(Str: PWideChar): PWideChar;
-begin
- Result := Str;
- Tnt_CharLowerBuffW(Str, WStrLen(Str))
-end;
-
-function WStrUpper(Str: PWideChar): PWideChar;
-begin
- Result := Str;
- Tnt_CharUpperBuffW(Str, WStrLen(Str))
-end;
-
-function WStrRScan(const Str: PWideChar; Chr: WideChar): PWideChar;
-var
- MostRecentFound: PWideChar;
-begin
- if Chr = #0 then
- Result := WStrEnd(Str)
- else
- begin
- Result := nil;
- MostRecentFound := Str;
- while True do
- begin
- while MostRecentFound^ <> Chr do
- begin
- if MostRecentFound^ = #0 then
- Exit;
- Inc(MostRecentFound);
- end;
- Result := MostRecentFound;
- Inc(MostRecentFound);
- end;
- end;
-end;
-
-function WStrLCat(Dest: PWideChar; const Source: PWideChar; MaxLen: Cardinal): PWideChar;
-begin
- Result := Dest;
- WStrLCopy(WStrEnd(Dest), Source, MaxLen - WStrLen(Dest));
-end;
-
-function WStrPas(const Str: PWideChar): WideString;
-begin
- Result := Str;
-end;
-
-//---------------------------------------------------------------------------------------------
-
-{$IFNDEF COMPILER_10_UP}
-function WideLastChar(const S: WideString): PWideChar;
-begin
- if S = '' then
- Result := nil
- else
- Result := @S[Length(S)];
-end;
-
-function WideQuotedStr(const S: WideString; Quote: WideChar): WideString;
-var
- P, Src,
- Dest: PWideChar;
- AddCount: Integer;
-begin
- AddCount := 0;
- P := WStrScan(PWideChar(S), Quote);
- while (P <> nil) do
- begin
- Inc(P);
- Inc(AddCount);
- P := WStrScan(P, Quote);
- end;
-
- if AddCount = 0 then
- Result := Quote + S + Quote
- else
- begin
- SetLength(Result, Length(S) + AddCount + 2);
- Dest := PWideChar(Result);
- Dest^ := Quote;
- Inc(Dest);
- Src := PWideChar(S);
- P := WStrScan(Src, Quote);
- repeat
- Inc(P);
- Move(Src^, Dest^, 2 * (P - Src));
- Inc(Dest, P - Src);
- Dest^ := Quote;
- Inc(Dest);
- Src := P;
- P := WStrScan(Src, Quote);
- until P = nil;
- P := WStrEnd(Src);
- Move(Src^, Dest^, 2 * (P - Src));
- Inc(Dest, P - Src);
- Dest^ := Quote;
- end;
-end;
-{$ENDIF}
-
-{$IFNDEF COMPILER_9_UP}
-function WideExtractQuotedStr(var Src: PWideChar; Quote: WideChar): Widestring;
-var
- P, Dest: PWideChar;
- DropCount: Integer;
-begin
- Result := '';
- if (Src = nil) or (Src^ <> Quote) then Exit;
- Inc(Src);
- DropCount := 1;
- P := Src;
- Src := WStrScan(Src, Quote);
- while Src <> nil do // count adjacent pairs of quote chars
- begin
- Inc(Src);
- if Src^ <> Quote then Break;
- Inc(Src);
- Inc(DropCount);
- Src := WStrScan(Src, Quote);
- end;
- if Src = nil then Src := WStrEnd(P);
- if ((Src - P) <= 1) then Exit;
- if DropCount = 1 then
- SetString(Result, P, Src - P - 1)
- else
- begin
- SetLength(Result, Src - P - DropCount);
- Dest := PWideChar(Result);
- Src := WStrScan(P, Quote);
- while Src <> nil do
- begin
- Inc(Src);
- if Src^ <> Quote then Break;
- Move(P^, Dest^, (Src - P) * SizeOf(WideChar));
- Inc(Dest, Src - P);
- Inc(Src);
- P := Src;
- Src := WStrScan(Src, Quote);
- end;
- if Src = nil then Src := WStrEnd(P);
- Move(P^, Dest^, (Src - P - 1) * SizeOf(WideChar));
- end;
-end;
-{$ENDIF}
-
-{$IFNDEF COMPILER_10_UP}
-function WideDequotedStr(const S: WideString; AQuote: WideChar): WideString;
-var
- LText : PWideChar;
-begin
- LText := PWideChar(S);
- Result := WideExtractQuotedStr(LText, AQuote);
- if Result = '' then
- Result := S;
-end;
-{$ENDIF}
-
-
-end.
diff --git a/src/lib/TntUnicodeControls/TntWideStrings.pas b/src/lib/TntUnicodeControls/TntWideStrings.pas
deleted file mode 100644
index 75132d22..00000000
--- a/src/lib/TntUnicodeControls/TntWideStrings.pas
+++ /dev/null
@@ -1,846 +0,0 @@
-
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntWideStrings;
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-{$IFDEF COMPILER_10_UP}
- {$MESSAGE FATAL 'Do not refer to TntWideStrings.pas. It works correctly in Delphi 2006.'}
-{$ENDIF}
-
-uses
- Classes;
-
-{******************************************************************************}
-{ }
-{ Delphi 2005 introduced TWideStrings in WideStrings.pas. }
-{ Unfortunately, it was not ready for prime time. }
-{ Setting CommaText is not consistent, and it relies on CharNextW }
-{ Which is only available on Windows NT+. }
-{ }
-{******************************************************************************}
-
-type
- TWideStrings = class;
-
-{ IWideStringsAdapter interface }
-{ Maintains link between TWideStrings and IWideStrings implementations }
-
- IWideStringsAdapter = interface
- ['{25FE0E3B-66CB-48AA-B23B-BCFA67E8F5DA}']
- procedure ReferenceStrings(S: TWideStrings);
- procedure ReleaseStrings;
- end;
-
- TWideStringsEnumerator = class
- private
- FIndex: Integer;
- FStrings: TWideStrings;
- public
- constructor Create(AStrings: TWideStrings);
- function GetCurrent: WideString;
- function MoveNext: Boolean;
- property Current: WideString read GetCurrent;
- end;
-
-{$IFDEF FPC}
- TStringsDefined = set of (
- sdDelimiter, sdQuoteChar, sdNameValueSeparator, sdLineBreak,
- sdStrictDelimiter);
-{$ENDIF}
-
-{$DEFINE NAMEVALUESEPARATOR_RW}
-{$IFNDEF COMPILER_7_UP}
- {$UNDEF NAMEVALUESEPARATOR_RW}
-{$ENDIF}
-
-{ TWideStrings class }
-
- TWideStrings = class(TPersistent)
- private
- FDefined: TStringsDefined;
- FDelimiter: WideChar;
- FQuoteChar: WideChar;
- {$IFDEF NAMEVALUESEPARATOR_RW}
- FNameValueSeparator: WideChar;
- {$ENDIF}
- FUpdateCount: Integer;
- FAdapter: IWideStringsAdapter;
- function GetCommaText: WideString;
- function GetDelimitedText: WideString;
- function GetName(Index: Integer): WideString;
- function GetValue(const Name: WideString): WideString;
- procedure ReadData(Reader: TReader);
- procedure SetCommaText(const Value: WideString);
- procedure SetDelimitedText(const Value: WideString);
- procedure SetStringsAdapter(const Value: IWideStringsAdapter);
- procedure SetValue(const Name, Value: WideString);
- procedure WriteData(Writer: TWriter);
- function GetDelimiter: WideChar;
- procedure SetDelimiter(const Value: WideChar);
- function GetQuoteChar: WideChar;
- procedure SetQuoteChar(const Value: WideChar);
- function GetNameValueSeparator: WideChar;
- {$IFDEF NAMEVALUESEPARATOR_RW}
- procedure SetNameValueSeparator(const Value: WideChar);
- {$ENDIF}
- function GetValueFromIndex(Index: Integer): WideString;
- procedure SetValueFromIndex(Index: Integer; const Value: WideString);
- protected
- procedure AssignTo(Dest: TPersistent); override;
- procedure DefineProperties(Filer: TFiler); override;
- procedure Error(const Msg: WideString; Data: Integer); overload;
- procedure Error(Msg: PResStringRec; Data: Integer); overload;
- function ExtractName(const S: WideString): WideString;
- function Get(Index: Integer): WideString; virtual; abstract;
- function GetCapacity: Integer; virtual;
- function GetCount: Integer; virtual; abstract;
- function GetObject(Index: Integer): TObject; virtual;
- function GetTextStr: WideString; virtual;
- procedure Put(Index: Integer; const S: WideString); virtual;
- procedure PutObject(Index: Integer; AObject: TObject); virtual;
- procedure SetCapacity(NewCapacity: Integer); virtual;
- procedure SetTextStr(const Value: WideString); virtual;
- procedure SetUpdateState(Updating: Boolean); virtual;
- property UpdateCount: Integer read FUpdateCount;
- function CompareStrings(const S1, S2: WideString): Integer; virtual;
- public
- destructor Destroy; override;
- function Add(const S: WideString): Integer; virtual;
- function AddObject(const S: WideString; AObject: TObject): Integer; virtual;
- procedure Append(const S: WideString);
- procedure AddStrings(Strings: TStrings{TNT-ALLOW TStrings}); overload; virtual;
- procedure AddStrings(Strings: TWideStrings); overload; virtual;
- procedure Assign(Source: TPersistent); override;
- procedure BeginUpdate;
- procedure Clear; virtual; abstract;
- procedure Delete(Index: Integer); virtual; abstract;
- procedure EndUpdate;
- function Equals(Strings: TWideStrings): Boolean;
- procedure Exchange(Index1, Index2: Integer); virtual;
- function GetEnumerator: TWideStringsEnumerator;
- function GetTextW: PWideChar; virtual;
- function IndexOf(const S: WideString): Integer; virtual;
- function IndexOfName(const Name: WideString): Integer; virtual;
- function IndexOfObject(AObject: TObject): Integer; virtual;
- procedure Insert(Index: Integer; const S: WideString); virtual; abstract;
- procedure InsertObject(Index: Integer; const S: WideString;
- AObject: TObject); virtual;
- procedure LoadFromFile(const FileName: WideString); virtual;
- procedure LoadFromStream(Stream: TStream); virtual;
- procedure Move(CurIndex, NewIndex: Integer); virtual;
- procedure SaveToFile(const FileName: WideString); virtual;
- procedure SaveToStream(Stream: TStream); virtual;
- procedure SetTextW(const Text: PWideChar); virtual;
- property Capacity: Integer read GetCapacity write SetCapacity;
- property CommaText: WideString read GetCommaText write SetCommaText;
- property Count: Integer read GetCount;
- property Delimiter: WideChar read GetDelimiter write SetDelimiter;
- property DelimitedText: WideString read GetDelimitedText write SetDelimitedText;
- property Names[Index: Integer]: WideString read GetName;
- property Objects[Index: Integer]: TObject read GetObject write PutObject;
- property QuoteChar: WideChar read GetQuoteChar write SetQuoteChar;
- property Values[const Name: WideString]: WideString read GetValue write SetValue;
- property ValueFromIndex[Index: Integer]: WideString read GetValueFromIndex write SetValueFromIndex;
- property NameValueSeparator: WideChar read GetNameValueSeparator {$IFDEF NAMEVALUESEPARATOR_RW} write SetNameValueSeparator {$ENDIF};
- property Strings[Index: Integer]: WideString read Get write Put; default;
- property Text: WideString read GetTextStr write SetTextStr;
- property StringsAdapter: IWideStringsAdapter read FAdapter write SetStringsAdapter;
- end;
-
- PWideStringItem = ^TWideStringItem;
- TWideStringItem = record
- FString: WideString;
- FObject: TObject;
- end;
-
- PWideStringItemList = ^TWideStringItemList;
- TWideStringItemList = array[0..MaxListSize] of TWideStringItem;
-
-implementation
-
-uses
- Windows, SysUtils, TntSystem, {$IFDEF COMPILER_9_UP} WideStrUtils, {$ELSE} TntWideStrUtils, {$ENDIF}
- TntSysUtils, TntClasses;
-
-{ TWideStringsEnumerator }
-
-constructor TWideStringsEnumerator.Create(AStrings: TWideStrings);
-begin
- inherited Create;
- FIndex := -1;
- FStrings := AStrings;
-end;
-
-function TWideStringsEnumerator.GetCurrent: WideString;
-begin
- Result := FStrings[FIndex];
-end;
-
-function TWideStringsEnumerator.MoveNext: Boolean;
-begin
- Result := FIndex < FStrings.Count - 1;
- if Result then
- Inc(FIndex);
-end;
-
-{ TWideStrings }
-
-destructor TWideStrings.Destroy;
-begin
- StringsAdapter := nil;
- inherited;
-end;
-
-function TWideStrings.Add(const S: WideString): Integer;
-begin
- Result := GetCount;
- Insert(Result, S);
-end;
-
-function TWideStrings.AddObject(const S: WideString; AObject: TObject): Integer;
-begin
- Result := Add(S);
- PutObject(Result, AObject);
-end;
-
-procedure TWideStrings.Append(const S: WideString);
-begin
- Add(S);
-end;
-
-procedure TWideStrings.AddStrings(Strings: TStrings{TNT-ALLOW TStrings});
-var
- I: Integer;
-begin
- BeginUpdate;
- try
- for I := 0 to Strings.Count - 1 do
- AddObject(Strings[I], Strings.Objects[I]);
- finally
- EndUpdate;
- end;
-end;
-
-procedure TWideStrings.AddStrings(Strings: TWideStrings);
-var
- I: Integer;
-begin
- BeginUpdate;
- try
- for I := 0 to Strings.Count - 1 do
- AddObject(Strings[I], Strings.Objects[I]);
- finally
- EndUpdate;
- end;
-end;
-
-procedure TWideStrings.Assign(Source: TPersistent);
-begin
- if Source is TWideStrings then
- begin
- BeginUpdate;
- try
- Clear;
- FDefined := TWideStrings(Source).FDefined;
- {$IFDEF NAMEVALUESEPARATOR_RW}
- FNameValueSeparator := TWideStrings(Source).FNameValueSeparator;
- {$ENDIF}
- FQuoteChar := TWideStrings(Source).FQuoteChar;
- FDelimiter := TWideStrings(Source).FDelimiter;
- AddStrings(TWideStrings(Source));
- finally
- EndUpdate;
- end;
- end
- else if Source is TStrings{TNT-ALLOW TStrings} then
- begin
- BeginUpdate;
- try
- Clear;
- {$IFDEF NAMEVALUESEPARATOR_RW}
- FNameValueSeparator := WideChar(TStrings{TNT-ALLOW TStrings}(Source).NameValueSeparator);
- {$ENDIF}
- FQuoteChar := WideChar(TStrings{TNT-ALLOW TStrings}(Source).QuoteChar);
- FDelimiter := WideChar(TStrings{TNT-ALLOW TStrings}(Source).Delimiter);
- AddStrings(TStrings{TNT-ALLOW TStrings}(Source));
- finally
- EndUpdate;
- end;
- end
- else
- inherited Assign(Source);
-end;
-
-procedure TWideStrings.AssignTo(Dest: TPersistent);
-var
- I: Integer;
-begin
- if Dest is TWideStrings then Dest.Assign(Self)
- else if Dest is TStrings{TNT-ALLOW TStrings} then
- begin
- TStrings{TNT-ALLOW TStrings}(Dest).BeginUpdate;
- try
- TStrings{TNT-ALLOW TStrings}(Dest).Clear;
- {$IFDEF NAMEVALUESEPARATOR_RW}
- TStrings{TNT-ALLOW TStrings}(Dest).NameValueSeparator := AnsiChar(NameValueSeparator);
- {$ENDIF}
- TStrings{TNT-ALLOW TStrings}(Dest).QuoteChar := AnsiChar(QuoteChar);
- TStrings{TNT-ALLOW TStrings}(Dest).Delimiter := AnsiChar(Delimiter);
- for I := 0 to Count - 1 do
- TStrings{TNT-ALLOW TStrings}(Dest).AddObject(Strings[I], Objects[I]);
- finally
- TStrings{TNT-ALLOW TStrings}(Dest).EndUpdate;
- end;
- end
- else
- inherited AssignTo(Dest);
-end;
-
-procedure TWideStrings.BeginUpdate;
-begin
- if FUpdateCount = 0 then SetUpdateState(True);
- Inc(FUpdateCount);
-end;
-
-procedure TWideStrings.DefineProperties(Filer: TFiler);
-
- function DoWrite: Boolean;
- begin
- if Filer.Ancestor <> nil then
- begin
- Result := True;
- if Filer.Ancestor is TWideStrings then
- Result := not Equals(TWideStrings(Filer.Ancestor))
- end
- else Result := Count > 0;
- end;
-
-begin
- Filer.DefineProperty('Strings', ReadData, WriteData, DoWrite);
-end;
-
-procedure TWideStrings.EndUpdate;
-begin
- Dec(FUpdateCount);
- if FUpdateCount = 0 then SetUpdateState(False);
-end;
-
-function TWideStrings.Equals(Strings: TWideStrings): Boolean;
-var
- I, Count: Integer;
-begin
- Result := False;
- Count := GetCount;
- if Count <> Strings.GetCount then Exit;
- for I := 0 to Count - 1 do if Get(I) <> Strings.Get(I) then Exit;
- Result := True;
-end;
-
-procedure TWideStrings.Error(const Msg: WideString; Data: Integer);
-
- function ReturnAddr: Pointer;
- asm
- MOV EAX,[EBP+4]
- end;
-
-begin
- raise EStringListError.CreateFmt(Msg, [Data]) at ReturnAddr;
-end;
-
-procedure TWideStrings.Error(Msg: PResStringRec; Data: Integer);
-begin
- Error(WideLoadResString(Msg), Data);
-end;
-
-procedure TWideStrings.Exchange(Index1, Index2: Integer);
-var
- TempObject: TObject;
- TempString: WideString;
-begin
- BeginUpdate;
- try
- TempString := Strings[Index1];
- TempObject := Objects[Index1];
- Strings[Index1] := Strings[Index2];
- Objects[Index1] := Objects[Index2];
- Strings[Index2] := TempString;
- Objects[Index2] := TempObject;
- finally
- EndUpdate;
- end;
-end;
-
-function TWideStrings.ExtractName(const S: WideString): WideString;
-var
- P: Integer;
-begin
- Result := S;
- P := Pos(NameValueSeparator, Result);
- if P <> 0 then
- SetLength(Result, P-1) else
- SetLength(Result, 0);
-end;
-
-function TWideStrings.GetCapacity: Integer;
-begin // descendents may optionally override/replace this default implementation
- Result := Count;
-end;
-
-function TWideStrings.GetCommaText: WideString;
-var
- LOldDefined: TStringsDefined;
- LOldDelimiter: WideChar;
- LOldQuoteChar: WideChar;
-begin
- LOldDefined := FDefined;
- LOldDelimiter := FDelimiter;
- LOldQuoteChar := FQuoteChar;
- Delimiter := ',';
- QuoteChar := '"';
- try
- Result := GetDelimitedText;
- finally
- FDelimiter := LOldDelimiter;
- FQuoteChar := LOldQuoteChar;
- FDefined := LOldDefined;
- end;
-end;
-
-function TWideStrings.GetDelimitedText: WideString;
-var
- S: WideString;
- P: PWideChar;
- I, Count: Integer;
-begin
- Count := GetCount;
- if (Count = 1) and (Get(0) = '') then
- Result := WideString(QuoteChar) + QuoteChar
- else
- begin
- Result := '';
- for I := 0 to Count - 1 do
- begin
- S := Get(I);
- P := PWideChar(S);
- while not ((P^ in [WideChar(#0)..WideChar(' ')]) or (P^ = QuoteChar) or (P^ = Delimiter)) do
- Inc(P);
- if (P^ <> #0) then S := WideQuotedStr(S, QuoteChar);
- Result := Result + S + Delimiter;
- end;
- System.Delete(Result, Length(Result), 1);
- end;
-end;
-
-function TWideStrings.GetName(Index: Integer): WideString;
-begin
- Result := ExtractName(Get(Index));
-end;
-
-function TWideStrings.GetObject(Index: Integer): TObject;
-begin
- Result := nil;
-end;
-
-function TWideStrings.GetEnumerator: TWideStringsEnumerator;
-begin
- Result := TWideStringsEnumerator.Create(Self);
-end;
-
-function TWideStrings.GetTextW: PWideChar;
-begin
- Result := WStrNew(PWideChar(GetTextStr));
-end;
-
-function TWideStrings.GetTextStr: WideString;
-var
- I, L, Size, Count: Integer;
- P: PWideChar;
- S, LB: WideString;
-begin
- Count := GetCount;
- Size := 0;
- LB := sLineBreak;
- for I := 0 to Count - 1 do Inc(Size, Length(Get(I)) + Length(LB));
- SetString(Result, nil, Size);
- P := Pointer(Result);
- for I := 0 to Count - 1 do
- begin
- S := Get(I);
- L := Length(S);
- if L <> 0 then
- begin
- System.Move(Pointer(S)^, P^, L * SizeOf(WideChar));
- Inc(P, L);
- end;
- L := Length(LB);
- if L <> 0 then
- begin
- System.Move(Pointer(LB)^, P^, L * SizeOf(WideChar));
- Inc(P, L);
- end;
- end;
-end;
-
-function TWideStrings.GetValue(const Name: WideString): WideString;
-var
- I: Integer;
-begin
- I := IndexOfName(Name);
- if I >= 0 then
- Result := Copy(Get(I), Length(Name) + 2, MaxInt) else
- Result := '';
-end;
-
-function TWideStrings.IndexOf(const S: WideString): Integer;
-begin
- for Result := 0 to GetCount - 1 do
- if CompareStrings(Get(Result), S) = 0 then Exit;
- Result := -1;
-end;
-
-function TWideStrings.IndexOfName(const Name: WideString): Integer;
-var
- P: Integer;
- S: WideString;
-begin
- for Result := 0 to GetCount - 1 do
- begin
- S := Get(Result);
- P := Pos(NameValueSeparator, S);
- if (P <> 0) and (CompareStrings(Copy(S, 1, P - 1), Name) = 0) then Exit;
- end;
- Result := -1;
-end;
-
-function TWideStrings.IndexOfObject(AObject: TObject): Integer;
-begin
- for Result := 0 to GetCount - 1 do
- if GetObject(Result) = AObject then Exit;
- Result := -1;
-end;
-
-procedure TWideStrings.InsertObject(Index: Integer; const S: WideString;
- AObject: TObject);
-begin
- Insert(Index, S);
- PutObject(Index, AObject);
-end;
-
-procedure TWideStrings.LoadFromFile(const FileName: WideString);
-var
- Stream: TStream;
-begin
- Stream := TTntFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
- try
- LoadFromStream(Stream);
- finally
- Stream.Free;
- end;
-end;
-
-procedure TWideStrings.LoadFromStream(Stream: TStream);
-var
- Size: Integer;
- S: WideString;
-begin
- BeginUpdate;
- try
- Size := Stream.Size - Stream.Position;
- SetString(S, nil, Size div SizeOf(WideChar));
- Stream.Read(Pointer(S)^, Length(S) * SizeOf(WideChar));
- SetTextStr(S);
- finally
- EndUpdate;
- end;
-end;
-
-procedure TWideStrings.Move(CurIndex, NewIndex: Integer);
-var
- TempObject: TObject;
- TempString: WideString;
-begin
- if CurIndex <> NewIndex then
- begin
- BeginUpdate;
- try
- TempString := Get(CurIndex);
- TempObject := GetObject(CurIndex);
- Delete(CurIndex);
- InsertObject(NewIndex, TempString, TempObject);
- finally
- EndUpdate;
- end;
- end;
-end;
-
-procedure TWideStrings.Put(Index: Integer; const S: WideString);
-var
- TempObject: TObject;
-begin
- TempObject := GetObject(Index);
- Delete(Index);
- InsertObject(Index, S, TempObject);
-end;
-
-procedure TWideStrings.PutObject(Index: Integer; AObject: TObject);
-begin
-end;
-
-procedure TWideStrings.ReadData(Reader: TReader);
-begin
- if Reader.NextValue in [vaString, vaLString] then
- SetTextStr(Reader.ReadString) {JCL compatiblity}
- else if Reader.NextValue = vaWString then
- SetTextStr(Reader.ReadWideString) {JCL compatiblity}
- else begin
- BeginUpdate;
- try
- Clear;
- Reader.ReadListBegin;
- while not Reader.EndOfList do
- if Reader.NextValue in [vaString, vaLString] then
- Add(Reader.ReadString) {TStrings compatiblity}
- else
- Add(Reader.ReadWideString);
- Reader.ReadListEnd;
- finally
- EndUpdate;
- end;
- end;
-end;
-
-procedure TWideStrings.SaveToFile(const FileName: WideString);
-var
- Stream: TStream;
-begin
- Stream := TTntFileStream.Create(FileName, fmCreate);
- try
- SaveToStream(Stream);
- finally
- Stream.Free;
- end;
-end;
-
-procedure TWideStrings.SaveToStream(Stream: TStream);
-var
- SW: WideString;
-begin
- SW := GetTextStr;
- Stream.WriteBuffer(PWideChar(SW)^, Length(SW) * SizeOf(WideChar));
-end;
-
-procedure TWideStrings.SetCapacity(NewCapacity: Integer);
-begin
- // do nothing - descendents may optionally implement this method
-end;
-
-procedure TWideStrings.SetCommaText(const Value: WideString);
-begin
- Delimiter := ',';
- QuoteChar := '"';
- SetDelimitedText(Value);
-end;
-
-procedure TWideStrings.SetStringsAdapter(const Value: IWideStringsAdapter);
-begin
- if FAdapter <> nil then FAdapter.ReleaseStrings;
- FAdapter := Value;
- if FAdapter <> nil then FAdapter.ReferenceStrings(Self);
-end;
-
-procedure TWideStrings.SetTextW(const Text: PWideChar);
-begin
- SetTextStr(Text);
-end;
-
-procedure TWideStrings.SetTextStr(const Value: WideString);
-var
- P, Start: PWideChar;
- S: WideString;
-begin
- BeginUpdate;
- try
- Clear;
- P := Pointer(Value);
- if P <> nil then
- while P^ <> #0 do
- begin
- Start := P;
- while not (P^ in [WideChar(#0), WideChar(#10), WideChar(#13)]) and (P^ <> WideLineSeparator) do
- Inc(P);
- SetString(S, Start, P - Start);
- Add(S);
- if P^ = #13 then Inc(P);
- if P^ = #10 then Inc(P);
- if P^ = WideLineSeparator then Inc(P);
- end;
- finally
- EndUpdate;
- end;
-end;
-
-procedure TWideStrings.SetUpdateState(Updating: Boolean);
-begin
-end;
-
-procedure TWideStrings.SetValue(const Name, Value: WideString);
-var
- I: Integer;
-begin
- I := IndexOfName(Name);
- if Value <> '' then
- begin
- if I < 0 then I := Add('');
- Put(I, Name + NameValueSeparator + Value);
- end else
- begin
- if I >= 0 then Delete(I);
- end;
-end;
-
-procedure TWideStrings.WriteData(Writer: TWriter);
-var
- I: Integer;
-begin
- Writer.WriteListBegin;
- for I := 0 to Count-1 do begin
- Writer.WriteWideString(Get(I));
- end;
- Writer.WriteListEnd;
-end;
-
-procedure TWideStrings.SetDelimitedText(const Value: WideString);
-var
- P, P1: PWideChar;
- S: WideString;
-begin
- BeginUpdate;
- try
- Clear;
- P := PWideChar(Value);
- while P^ in [WideChar(#1)..WideChar(' ')] do
- Inc(P);
- while P^ <> #0 do
- begin
- if P^ = QuoteChar then
- S := WideExtractQuotedStr(P, QuoteChar)
- else
- begin
- P1 := P;
- while (P^ > ' ') and (P^ <> Delimiter) do
- Inc(P);
- SetString(S, P1, P - P1);
- end;
- Add(S);
- while P^ in [WideChar(#1)..WideChar(' ')] do
- Inc(P);
- if P^ = Delimiter then
- begin
- P1 := P;
- Inc(P1);
- if P1^ = #0 then
- Add('');
- repeat
- Inc(P);
- until not (P^ in [WideChar(#1)..WideChar(' ')]);
- end;
- end;
- finally
- EndUpdate;
- end;
-end;
-
-function TWideStrings.GetDelimiter: WideChar;
-begin
- if not (sdDelimiter in FDefined) then
- Delimiter := ',';
- Result := FDelimiter;
-end;
-
-function TWideStrings.GetQuoteChar: WideChar;
-begin
- if not (sdQuoteChar in FDefined) then
- QuoteChar := '"';
- Result := FQuoteChar;
-end;
-
-procedure TWideStrings.SetDelimiter(const Value: WideChar);
-begin
- if (FDelimiter <> Value) or not (sdDelimiter in FDefined) then
- begin
- Include(FDefined, sdDelimiter);
- FDelimiter := Value;
- end
-end;
-
-procedure TWideStrings.SetQuoteChar(const Value: WideChar);
-begin
- if (FQuoteChar <> Value) or not (sdQuoteChar in FDefined) then
- begin
- Include(FDefined, sdQuoteChar);
- FQuoteChar := Value;
- end
-end;
-
-function TWideStrings.CompareStrings(const S1, S2: WideString): Integer;
-begin
- Result := WideCompareText(S1, S2);
-end;
-
-function TWideStrings.GetNameValueSeparator: WideChar;
-begin
- {$IFDEF NAMEVALUESEPARATOR_RW}
- if not (sdNameValueSeparator in FDefined) then
- NameValueSeparator := '=';
- Result := FNameValueSeparator;
- {$ELSE}
- Result := '=';
- {$ENDIF}
-end;
-
-{$IFDEF NAMEVALUESEPARATOR_RW}
-procedure TWideStrings.SetNameValueSeparator(const Value: WideChar);
-begin
- if (FNameValueSeparator <> Value) or not (sdNameValueSeparator in FDefined) then
- begin
- Include(FDefined, sdNameValueSeparator);
- FNameValueSeparator := Value;
- end
-end;
-{$ENDIF}
-
-function TWideStrings.GetValueFromIndex(Index: Integer): WideString;
-begin
- if Index >= 0 then
- Result := Copy(Get(Index), Length(Names[Index]) + 2, MaxInt) else
- Result := '';
-end;
-
-procedure TWideStrings.SetValueFromIndex(Index: Integer; const Value: WideString);
-begin
- if Value <> '' then
- begin
- if Index < 0 then Index := Add('');
- Put(Index, Names[Index] + NameValueSeparator + Value);
- end
- else
- if Index >= 0 then Delete(Index);
-end;
-
-end.
diff --git a/src/lib/TntUnicodeControls/TntWindows.pas b/src/lib/TntUnicodeControls/TntWindows.pas
deleted file mode 100644
index 8fd7ec88..00000000
--- a/src/lib/TntUnicodeControls/TntWindows.pas
+++ /dev/null
@@ -1,1501 +0,0 @@
-
-{*****************************************************************************}
-{ }
-{ Tnt Delphi Unicode Controls }
-{ http://www.tntware.com/delphicontrols/unicode/ }
-{ Version: 2.3.0 }
-{ }
-{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
-{ }
-{*****************************************************************************}
-
-unit TntWindows;
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-uses
- Windows, ShellApi, ShlObj;
-
-// ......... compatibility
-
-const
- DT_NOFULLWIDTHCHARBREAK = $00080000;
-
-const
- INVALID_FILE_ATTRIBUTES = DWORD(-1);
-
-// ................ ANSI TYPES ................
-{TNT-WARN LPSTR}
-{TNT-WARN PLPSTR}
-{TNT-WARN LPCSTR}
-{TNT-WARN LPCTSTR}
-{TNT-WARN LPTSTR}
-
-// ........ EnumResourceTypesW, EnumResourceNamesW and EnumResourceLanguagesW are supposed ....
-// ........ to work on Win95/98/ME but have caused access violations in testing on Win95 ......
-// .. TNT--WARN EnumResourceTypes ..
-// .. TNT--WARN EnumResourceTypesA ..
-// .. TNT--WARN EnumResourceNames ..
-// .. TNT--WARN EnumResourceNamesA ..
-// .. TNT--WARN EnumResourceLanguages ..
-// .. TNT--WARN EnumResourceLanguagesA ..
-
-//------------------------------------------------------------------------------------------
-
-// ......... The Unicode form of these functions are supported on Windows 95/98/ME .........
-{TNT-WARN ExtTextOut}
-{TNT-WARN ExtTextOutA}
-{TNT-WARN Tnt_ExtTextOutW}
-
-{TNT-WARN FindResource}
-{TNT-WARN FindResourceA}
-{TNT-WARN Tnt_FindResourceW}
-
-{TNT-WARN FindResourceEx}
-{TNT-WARN FindResourceExA}
-{TNT-WARN Tnt_FindResourceExW}
-
-{TNT-WARN GetCharWidth}
-{TNT-WARN GetCharWidthA}
-{TNT-WARN Tnt_GetCharWidthW}
-
-{TNT-WARN GetCommandLine}
-{TNT-WARN GetCommandLineA}
-{TNT-WARN Tnt_GetCommandLineW}
-
-{TNT-WARN GetTextExtentPoint}
-{TNT-WARN GetTextExtentPointA}
-{TNT-WARN Tnt_GetTextExtentPointW}
-
-{TNT-WARN GetTextExtentPoint32}
-{TNT-WARN GetTextExtentPoint32A}
-{TNT-WARN Tnt_GetTextExtentPoint32W}
-
-{TNT-WARN lstrcat}
-{TNT-WARN lstrcatA}
-{TNT-WARN Tnt_lstrcatW}
-
-{TNT-WARN lstrcpy}
-{TNT-WARN lstrcpyA}
-{TNT-WARN Tnt_lstrcpyW}
-
-{TNT-WARN lstrlen}
-{TNT-WARN lstrlenA}
-{TNT-WARN Tnt_lstrlenW}
-
-{TNT-WARN MessageBox}
-{TNT-WARN MessageBoxA}
-{TNT-WARN Tnt_MessageBoxW}
-
-{TNT-WARN MessageBoxEx}
-{TNT-WARN MessageBoxExA}
-{TNT-WARN Tnt_MessageBoxExA}
-
-{TNT-WARN TextOut}
-{TNT-WARN TextOutA}
-{TNT-WARN Tnt_TextOutW}
-
-//------------------------------------------------------------------------------------------
-
-{TNT-WARN LOCALE_USER_DEFAULT} // <-- use GetThreadLocale
-{TNT-WARN LOCALE_SYSTEM_DEFAULT} // <-- use GetThreadLocale
-
-//------------------------------------------------------------------------------------------
-// compatiblity
-//------------------------------------------------------------------------------------------
-{$IFNDEF COMPILER_9_UP}
-type
- {$IFDEF FPC}
- TStartupInfoA = STARTUPINFO;
- TStartupInfoW = STARTUPINFO;
- {$ELSE}
- TStartupInfoA = _STARTUPINFOA;
- TStartupInfoW = record
- cb: DWORD;
- lpReserved: PWideChar;
- lpDesktop: PWideChar;
- lpTitle: PWideChar;
- dwX: DWORD;
- dwY: DWORD;
- dwXSize: DWORD;
- dwYSize: DWORD;
- dwXCountChars: DWORD;
- dwYCountChars: DWORD;
- dwFillAttribute: DWORD;
- dwFlags: DWORD;
- wShowWindow: Word;
- cbReserved2: Word;
- lpReserved2: PByte;
- hStdInput: THandle;
- hStdOutput: THandle;
- hStdError: THandle;
- end;
- {$ENDIF}
-
-function CreateProcessW{TNT-ALLOW CreateProcessW}(lpApplicationName: PWideChar; lpCommandLine: PWideChar;
- lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
- bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
- lpCurrentDirectory: PWideChar; const lpStartupInfo: TStartupInfoW;
- var lpProcessInformation: TProcessInformation): BOOL; stdcall; external kernel32 name 'CreateProcessW';
-
-{$ENDIF}
-
-{$IFDEF FPC}
-type
- TCurrencyFmtA = CURRENCYFMT;
- TCurrencyFmtW = CURRENCYFMT;
- PCurrencyFmtA = ^TCurrencyFmtA;
- PCurrencyFmtW = ^TCurrencyFmtW;
-{$ENDIF}
-
-//------------------------------------------------------------------------------------------
-
-{TNT-WARN SetWindowText}
-{TNT-WARN SetWindowTextA}
-{TNT-WARN SetWindowTextW}
-function Tnt_SetWindowTextW(hWnd: HWND; lpString: PWideChar): BOOL;
-
-{TNT-WARN RemoveDirectory}
-{TNT-WARN RemoveDirectoryA}
-{TNT-WARN RemoveDirectoryW}
-function Tnt_RemoveDirectoryW(lpPathName: PWideChar): BOOL;
-
-{TNT-WARN GetShortPathName}
-{TNT-WARN GetShortPathNameA}
-{TNT-WARN GetShortPathNameW}
-function Tnt_GetShortPathNameW(lpszLongPath: PWideChar; lpszShortPath: PWideChar;
- cchBuffer: DWORD): DWORD;
-
-{TNT-WARN GetFullPathName}
-{TNT-WARN GetFullPathNameA}
-{TNT-WARN GetFullPathNameW}
-function Tnt_GetFullPathNameW(lpFileName: PWideChar; nBufferLength: DWORD;
- lpBuffer: PWideChar; var lpFilePart: PWideChar): DWORD;
-
-{TNT-WARN CreateFile}
-{TNT-WARN CreateFileA}
-{TNT-WARN CreateFileW}
-function Tnt_CreateFileW(lpFileName: PWideChar; dwDesiredAccess, dwShareMode: DWORD;
- lpSecurityAttributes: PSecurityAttributes; dwCreationDisposition, dwFlagsAndAttributes: DWORD;
- hTemplateFile: THandle): THandle;
-
-{TNT-WARN FindFirstFile}
-{TNT-WARN FindFirstFileA}
-{TNT-WARN FindFirstFileW}
-function Tnt_FindFirstFileW(lpFileName: PWideChar; var lpFindFileData: TWIN32FindDataW): THandle;
-
-{TNT-WARN FindNextFile}
-{TNT-WARN FindNextFileA}
-{TNT-WARN FindNextFileW}
-function Tnt_FindNextFileW(hFindFile: THandle; var lpFindFileData: TWIN32FindDataW): BOOL;
-
-{TNT-WARN GetFileAttributes}
-{TNT-WARN GetFileAttributesA}
-{TNT-WARN GetFileAttributesW}
-function Tnt_GetFileAttributesW(lpFileName: PWideChar): DWORD;
-
-{TNT-WARN SetFileAttributes}
-{TNT-WARN SetFileAttributesA}
-{TNT-WARN SetFileAttributesW}
-function Tnt_SetFileAttributesW(lpFileName: PWideChar; dwFileAttributes: DWORD): BOOL;
-
-{TNT-WARN CreateDirectory}
-{TNT-WARN CreateDirectoryA}
-{TNT-WARN CreateDirectoryW}
-function Tnt_CreateDirectoryW(lpPathName: PWideChar;
- lpSecurityAttributes: PSecurityAttributes): BOOL;
-
-{TNT-WARN MoveFile}
-{TNT-WARN MoveFileA}
-{TNT-WARN MoveFileW}
-function Tnt_MoveFileW(lpExistingFileName, lpNewFileName: PWideChar): BOOL;
-
-{TNT-WARN CopyFile}
-{TNT-WARN CopyFileA}
-{TNT-WARN CopyFileW}
-function Tnt_CopyFileW(lpExistingFileName, lpNewFileName: PWideChar; bFailIfExists: BOOL): BOOL;
-
-{TNT-WARN DeleteFile}
-{TNT-WARN DeleteFileA}
-{TNT-WARN DeleteFileW}
-function Tnt_DeleteFileW(lpFileName: PWideChar): BOOL;
-
-{TNT-WARN DrawText}
-{TNT-WARN DrawTextA}
-{TNT-WARN DrawTextW}
-function Tnt_DrawTextW(hDC: HDC; lpString: PWideChar; nCount: Integer;
- var lpRect: TRect; uFormat: UINT): Integer;
-
-{TNT-WARN GetDiskFreeSpace}
-{TNT-WARN GetDiskFreeSpaceA}
-{TNT-WARN GetDiskFreeSpaceW}
-function Tnt_GetDiskFreeSpaceW(lpRootPathName: PWideChar; var lpSectorsPerCluster,
- lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters: DWORD): BOOL;
-
-{TNT-WARN GetVolumeInformation}
-{TNT-WARN GetVolumeInformationA}
-{TNT-WARN GetVolumeInformationW}
-function Tnt_GetVolumeInformationW(lpRootPathName: PWideChar; lpVolumeNameBuffer: PWideChar;
- nVolumeNameSize: DWORD; lpVolumeSerialNumber: PDWORD;
- var lpMaximumComponentLength, lpFileSystemFlags: DWORD; lpFileSystemNameBuffer: PWideChar;
- nFileSystemNameSize: DWORD): BOOL;
-
-{TNT-WARN GetModuleFileName}
-{TNT-WARN GetModuleFileNameA}
-{TNT-WARN GetModuleFileNameW}
-function Tnt_GetModuleFileNameW(hModule: HINST; lpFilename: PWideChar; nSize: DWORD): DWORD;
-
-{TNT-WARN GetTempPath}
-{TNT-WARN GetTempPathA}
-{TNT-WARN GetTempPathW}
-function Tnt_GetTempPathW(nBufferLength: DWORD; lpBuffer: PWideChar): DWORD;
-
-{TNT-WARN GetTempFileName}
-{TNT-WARN GetTempFileNameA}
-{TNT-WARN GetTempFileNameW}
-function Tnt_GetTempFileNameW(lpPathName, lpPrefixString: PWideChar; uUnique: UINT;
- lpTempFileName: PWideChar): UINT;
-
-{TNT-WARN GetWindowsDirectory}
-{TNT-WARN GetWindowsDirectoryA}
-{TNT-WARN GetWindowsDirectoryW}
-function Tnt_GetWindowsDirectoryW(lpBuffer: PWideChar; uSize: UINT): UINT;
-
-{TNT-WARN GetSystemDirectory}
-{TNT-WARN GetSystemDirectoryA}
-{TNT-WARN GetSystemDirectoryW}
-function Tnt_GetSystemDirectoryW(lpBuffer: PWideChar; uSize: UINT): UINT;
-
-{TNT-WARN GetCurrentDirectory}
-{TNT-WARN GetCurrentDirectoryA}
-{TNT-WARN GetCurrentDirectoryW}
-function Tnt_GetCurrentDirectoryW(nBufferLength: DWORD; lpBuffer: PWideChar): DWORD;
-
-{TNT-WARN SetCurrentDirectory}
-{TNT-WARN SetCurrentDirectoryA}
-{TNT-WARN SetCurrentDirectoryW}
-function Tnt_SetCurrentDirectoryW(lpPathName: PWideChar): BOOL;
-
-{TNT-WARN GetComputerName}
-{TNT-WARN GetComputerNameA}
-{TNT-WARN GetComputerNameW}
-function Tnt_GetComputerNameW(lpBuffer: PWideChar; var nSize: DWORD): BOOL;
-
-{TNT-WARN GetUserName}
-{TNT-WARN GetUserNameA}
-{TNT-WARN GetUserNameW}
-function Tnt_GetUserNameW(lpBuffer: PWideChar; var nSize: DWORD): BOOL;
-
-{TNT-WARN ShellExecute}
-{TNT-WARN ShellExecuteA}
-{TNT-WARN ShellExecuteW}
-function Tnt_ShellExecuteW(hWnd: HWND; Operation, FileName, Parameters,
- Directory: PWideChar; ShowCmd: Integer): HINST;
-
-{TNT-WARN LoadLibrary}
-{TNT-WARN LoadLibraryA}
-{TNT-WARN LoadLibraryW}
-function Tnt_LoadLibraryW(lpLibFileName: PWideChar): HMODULE;
-
-{TNT-WARN LoadLibraryEx}
-{TNT-WARN LoadLibraryExA}
-{TNT-WARN LoadLibraryExW}
-function Tnt_LoadLibraryExW(lpLibFileName: PWideChar; hFile: THandle; dwFlags: DWORD): HMODULE;
-
-{TNT-WARN CreateProcess}
-{TNT-WARN CreateProcessA}
-{TNT-WARN CreateProcessW}
-function Tnt_CreateProcessW(lpApplicationName: PWideChar; lpCommandLine: PWideChar;
- lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
- bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
- lpCurrentDirectory: PWideChar; const lpStartupInfo: TStartupInfoW;
- var lpProcessInformation: TProcessInformation): BOOL;
-
-{TNT-WARN GetCurrencyFormat}
-{TNT-WARN GetCurrencyFormatA}
-{TNT-WARN GetCurrencyFormatW}
-function Tnt_GetCurrencyFormatW(Locale: LCID; dwFlags: DWORD; lpValue: PWideChar;
- lpFormat: PCurrencyFmtW; lpCurrencyStr: PWideChar; cchCurrency: Integer): Integer;
-
-{TNT-WARN CompareString}
-{TNT-WARN CompareStringA}
-{TNT-WARN CompareStringW}
-function Tnt_CompareStringW(Locale: LCID; dwCmpFlags: DWORD; lpString1: PWideChar;
- cchCount1: Integer; lpString2: PWideChar; cchCount2: Integer): Integer;
-
-{TNT-WARN CharUpper}
-{TNT-WARN CharUpperA}
-{TNT-WARN CharUpperW}
-function Tnt_CharUpperW(lpsz: PWideChar): PWideChar;
-
-{TNT-WARN CharUpperBuff}
-{TNT-WARN CharUpperBuffA}
-{TNT-WARN CharUpperBuffW}
-function Tnt_CharUpperBuffW(lpsz: PWideChar; cchLength: DWORD): DWORD;
-
-{TNT-WARN CharLower}
-{TNT-WARN CharLowerA}
-{TNT-WARN CharLowerW}
-function Tnt_CharLowerW(lpsz: PWideChar): PWideChar;
-
-{TNT-WARN CharLowerBuff}
-{TNT-WARN CharLowerBuffA}
-{TNT-WARN CharLowerBuffW}
-function Tnt_CharLowerBuffW(lpsz: PWideChar; cchLength: DWORD): DWORD;
-
-{TNT-WARN GetStringTypeEx}
-{TNT-WARN GetStringTypeExA}
-{TNT-WARN GetStringTypeExW}
-function Tnt_GetStringTypeExW(Locale: LCID; dwInfoType: DWORD;
- lpSrcStr: PWideChar; cchSrc: Integer; var lpCharType): BOOL;
-
-{TNT-WARN LoadString}
-{TNT-WARN LoadStringA}
-{TNT-WARN LoadStringW}
-function Tnt_LoadStringW(hInstance: HINST; uID: UINT; lpBuffer: PWideChar; nBufferMax: Integer): Integer;
-
-{$IFDEF FPC}
-type
- TMenuItemInfoW = TMENUITEMINFO;
- tagMenuItemINFOW = tagMENUITEMINFO;
-{$ENDIF}
-
-{TNT-WARN InsertMenuItem}
-{TNT-WARN InsertMenuItemA}
-{TNT-WARN InsertMenuItemW}
-function Tnt_InsertMenuItemW(hMenu: HMENU; uItem: DWORD; fByPosition: BOOL; lpmii: tagMenuItemINFOW): BOOL;
-
-{TNT-WARN ExtractIconEx}
-{TNT-WARN ExtractIconExA}
-{TNT-WARN ExtractIconExW}
-function Tnt_ExtractIconExW(lpszFile: PWideChar; nIconIndex: Integer;
- var phiconLarge, phiconSmall: HICON; nIcons: UINT): UINT;
-
-{TNT-WARN ExtractAssociatedIcon}
-{TNT-WARN ExtractAssociatedIconA}
-{TNT-WARN ExtractAssociatedIconW}
-function Tnt_ExtractAssociatedIconW(hInst: HINST; lpIconPath: PWideChar;
- var lpiIcon: Word): HICON;
-
-{TNT-WARN GetFileVersionInfoSize}
-{TNT-WARN GetFileVersionInfoSizeA}
-{TNT-WARN GetFileVersionInfoSizeW}
-function Tnt_GetFileVersionInfoSizeW(lptstrFilename: PWideChar; var lpdwHandle: DWORD): DWORD;
-
-{TNT-WARN GetFileVersionInfo}
-{TNT-WARN GetFileVersionInfoA}
-{TNT-WARN GetFileVersionInfoW}
-function Tnt_GetFileVersionInfoW(lptstrFilename: PWideChar; dwHandle, dwLen: DWORD;
- lpData: Pointer): BOOL;
-
-const
- VQV_FIXEDFILEINFO = '\';
- VQV_VARFILEINFO_TRANSLATION = '\VarFileInfo\Translation';
- VQV_STRINGFILEINFO = '\StringFileInfo';
-
- VER_COMMENTS = 'Comments';
- VER_INTERNALNAME = 'InternalName';
- VER_PRODUCTNAME = 'ProductName';
- VER_COMPANYNAME = 'CompanyName';
- VER_LEGALCOPYRIGHT = 'LegalCopyright';
- VER_PRODUCTVERSION = 'ProductVersion';
- VER_FILEDESCRIPTION = 'FileDescription';
- VER_LEGALTRADEMARKS = 'LegalTrademarks';
- VER_PRIVATEBUILD = 'PrivateBuild';
- VER_FILEVERSION = 'FileVersion';
- VER_ORIGINALFILENAME = 'OriginalFilename';
- VER_SPECIALBUILD = 'SpecialBuild';
-
-{TNT-WARN VerQueryValue}
-{TNT-WARN VerQueryValueA}
-{TNT-WARN VerQueryValueW}
-function Tnt_VerQueryValueW(pBlock: Pointer; lpSubBlock: PWideChar;
- var lplpBuffer: Pointer; var puLen: UINT): BOOL;
-
-type
-{$IFDEF FPC}
- PSHNAMEMAPPINGA = ^SHNAMEMAPPINGA;
- SHNAMEMAPPINGA = record
- pszOldPath : LPSTR;
- pszNewPath : LPSTR;
- cchOldPath : longint;
- cchNewPath : longint;
- end;
-
- PSHNAMEMAPPINGW = ^SHNAMEMAPPINGW;
- SHNAMEMAPPINGW = record
- pszOldPath : LPWSTR;
- pszNewPath : LPWSTR;
- cchOldPath : longint;
- cchNewPath : longint;
- end;
-{$ENDIF}
-
- TSHNameMappingHeaderA = record
- cNumOfMappings: Cardinal;
- lpNM: PSHNAMEMAPPINGA;
- end;
- PSHNameMappingHeaderA = ^TSHNameMappingHeaderA;
-
- TSHNameMappingHeaderW = record
- cNumOfMappings: Cardinal;
- lpNM: PSHNAMEMAPPINGW;
- end;
- PSHNameMappingHeaderW = ^TSHNameMappingHeaderW;
-
-{TNT-WARN SHFileOperation}
-{TNT-WARN SHFileOperationA}
-{TNT-WARN SHFileOperationW} // <-- no stub on early Windows 95
-function Tnt_SHFileOperationW(var lpFileOp: TSHFileOpStructW): Integer;
-
-{TNT-WARN SHFreeNameMappings}
-procedure Tnt_SHFreeNameMappings(hNameMappings: THandle);
-
-{TNT-WARN SHBrowseForFolder}
-{TNT-WARN SHBrowseForFolderA}
-{TNT-WARN SHBrowseForFolderW} // <-- no stub on early Windows 95
-function Tnt_SHBrowseForFolderW(var lpbi: TBrowseInfoW): PItemIDList;
-
-{TNT-WARN SHGetPathFromIDList}
-{TNT-WARN SHGetPathFromIDListA}
-{TNT-WARN SHGetPathFromIDListW} // <-- no stub on early Windows 95
-function Tnt_SHGetPathFromIDListW(pidl: PItemIDList; pszPath: PWideChar): BOOL;
-
-{TNT-WARN SHGetFileInfo}
-{TNT-WARN SHGetFileInfoA}
-{TNT-WARN SHGetFileInfoW} // <-- no stub on early Windows 95
-function Tnt_SHGetFileInfoW(pszPath: PWideChar; dwFileAttributes: DWORD;
- var psfi: TSHFileInfoW; cbFileInfo, uFlags: UINT): DWORD;
-
-// ......... introduced .........
-function Tnt_Is_IntResource(ResStr: LPCWSTR): Boolean;
-
-function LANGIDFROMLCID(lcid: LCID): WORD;
-function MAKELANGID(usPrimaryLanguage, usSubLanguage: WORD): WORD;
-function MAKELCID(wLanguageID: WORD; wSortID: WORD = SORT_DEFAULT): LCID;
-function PRIMARYLANGID(lgid: WORD): WORD;
-function SORTIDFROMLCID(lcid: LCID): WORD;
-function SUBLANGID(lgid: WORD): WORD;
-
-implementation
-
-uses
- SysUtils, Math, TntSysUtils,
- {$IFDEF COMPILER_9_UP} WideStrUtils, {$ENDIF} TntWideStrUtils;
-
-function _PAnsiCharWithNil(const S: AnsiString): PAnsiChar;
-begin
- if S = '' then
- Result := nil {Win9x needs nil for some parameters instead of empty strings}
- else
- Result := PAnsiChar(S);
-end;
-
-function _PWideCharWithNil(const S: WideString): PWideChar;
-begin
- if S = '' then
- Result := nil {Win9x needs nil for some parameters instead of empty strings}
- else
- Result := PWideChar(S);
-end;
-
-function _WStr(lpString: PWideChar; cchCount: Integer): WideString;
-begin
- if cchCount = -1 then
- Result := lpString
- else
- Result := Copy(WideString(lpString), 1, cchCount);
-end;
-
-procedure _MakeWideWin32FindData(var WideFindData: TWIN32FindDataW; AnsiFindData: TWIN32FindDataA);
-begin
- CopyMemory(@WideFindData, @AnsiFindData,
- PtrUInt(@WideFindData.cFileName) - PtrUInt(@WideFindData));
- WStrPCopy(WideFindData.cFileName, AnsiFindData.cFileName);
- WStrPCopy(WideFindData.cAlternateFileName, AnsiFindData.cAlternateFileName);
-end;
-
-function Tnt_SetWindowTextW(hWnd: HWND; lpString: PWideChar): BOOL;
-begin
- if Win32PlatformIsUnicode then
- Result := SetWindowTextW{TNT-ALLOW SetWindowTextW}(hWnd, lpString)
- else
- Result := SetWindowTextA{TNT-ALLOW SetWindowTextA}(hWnd, PAnsiChar(AnsiString(lpString)));
-end;
-
-//-----------------------------
-
-type
- TPathLengthResultOption = (poAllowDirectoryMode, poZeroSmallBuff, poExactCopy, poExactCopySubPaths);
- TPathLengthResultOptions = set of TPathLengthResultOption;
-
-procedure _ExactStrCopyW(pDest, pSource: PWideChar; Count: Integer);
-var
- i: integer;
-begin
- for i := 1 to Count do begin
- pDest^ := pSource^;
- Inc(PSource);
- Inc(pDest);
- end;
-end;
-
-procedure _ExactCopySubPaths(pDest, pSource: PWideChar; Count: Integer);
-var
- i: integer;
- OriginalSource: PWideChar;
- PNextSlash: PWideChar;
-begin
- if Count >= 4 then begin
- OriginalSource := pSource;
- PNextSlash := WStrScan(pSource, '\');
- for i := 1 to Count - 1 do begin
- // determine next path delimiter
- if pSource > pNextSlash then begin
- PNextSlash := WStrScan(pSource, '\');
- end;
- // leave if no more sub paths
- if (PNextSlash = nil)
- or ((pNextSlash - OriginalSource) >= Count) then begin
- exit;
- end;
- // copy char
- pDest^ := pSource^;
- Inc(PSource);
- Inc(pDest);
- end;
- end;
-end;
-
-function _HandlePathLengthResult(nBufferLength: DWORD; lpBuffer: PWideChar; const AnsiBuff: AnsiString; Options: TPathLengthResultOptions): Integer;
-var
- WideBuff: WideString;
-begin
- WideBuff := AnsiBuff;
- if nBufferLength > Cardinal(Length(WideBuff)) then begin
- // normal
- Result := Length(WideBuff);
- WStrLCopy(lpBuffer, PWideChar(WideBuff), nBufferLength);
- end else if (poExactCopy in Options) then begin
- // exact
- Result := nBufferLength;
- _ExactStrCopyW(lpBuffer, PWideChar(WideBuff), nBufferLength);
- end else begin
- // other
- if (poAllowDirectoryMode in Options)
- and (nBufferLength = Cardinal(Length(WideBuff))) then begin
- Result := Length(WideBuff) + 1;
- WStrLCopy(lpBuffer, PWideChar(WideBuff), nBufferLength - 1);
- end else begin
- Result := Length(WideBuff) + 1;
- if (nBufferLength > 0) then begin
- if (poZeroSmallBuff in Options) then
- lpBuffer^ := #0
- else if (poExactCopySubPaths in Options) then
- _ExactCopySubPaths(lpBuffer, PWideChar(WideBuff), nBufferLength);
- end;
- end;
- end;
-end;
-
-function _HandleStringLengthResult(nBufferLength: DWORD; lpBuffer: PWideChar; const AnsiBuff: AnsiString; Options: TPathLengthResultOptions): Integer;
-var
- WideBuff: WideString;
-begin
- WideBuff := AnsiBuff;
- if nBufferLength >= Cardinal(Length(WideBuff)) then begin
- // normal
- Result := Length(WideBuff);
- WStrLCopy(lpBuffer, PWideChar(WideBuff), nBufferLength);
- end else if nBufferLength = 0 then
- Result := Length(WideBuff)
- else
- Result := 0;
-end;
-
-//-------------------------------------------
-
-function Tnt_RemoveDirectoryW(lpPathName: PWideChar): BOOL;
-begin
- if Win32PlatformIsUnicode then
- Result := RemoveDirectoryW{TNT-ALLOW RemoveDirectoryW}(PWideChar(lpPathName))
- else
- Result := RemoveDirectoryA{TNT-ALLOW RemoveDirectoryA}(PAnsiChar(AnsiString(lpPathName)));
-end;
-
-function Tnt_GetShortPathNameW(lpszLongPath: PWideChar; lpszShortPath: PWideChar;
- cchBuffer: DWORD): DWORD;
-var
- AnsiBuff: AnsiString;
-begin
- if Win32PlatformIsUnicode then
- Result := GetShortPathNameW{TNT-ALLOW GetShortPathNameW}(lpszLongPath, lpszShortPath, cchBuffer)
- else begin
- SetLength(AnsiBuff, MAX_PATH * 2);
- SetLength(AnsiBuff, GetShortPathNameA{TNT-ALLOW GetShortPathNameA}(PAnsiChar(AnsiString(lpszLongPath)),
- PAnsiChar(AnsiBuff), Length(AnsiBuff)));
- Result := _HandlePathLengthResult(cchBuffer, lpszShortPath, AnsiBuff, [poExactCopySubPaths]);
- end;
-end;
-
-function Tnt_GetFullPathNameW(lpFileName: PWideChar; nBufferLength: DWORD;
- lpBuffer: PWideChar; var lpFilePart: PWideChar): DWORD;
-var
- AnsiBuff: AnsiString;
- AnsiFilePart: PAnsiChar;
- AnsiLeadingChars: Integer;
- WideLeadingChars: Integer;
-begin
- if Win32PlatformIsUnicode then
- Result := GetFullPathNameW{TNT-ALLOW GetFullPathNameW}(lpFileName, nBufferLength, lpBuffer, lpFilePart)
- else begin
- SetLength(AnsiBuff, MAX_PATH * 2);
- SetLength(AnsiBuff, GetFullPathNameA{TNT-ALLOW GetFullPathNameA}(PAnsiChar(AnsiString(lpFileName)),
- Length(AnsiBuff), PAnsiChar(AnsiBuff), AnsiFilePart));
- Result := _HandlePathLengthResult(nBufferLength, lpBuffer, AnsiBuff, [poZeroSmallBuff]);
- // deal w/ lpFilePart
- if (AnsiFilePart = nil) or (nBufferLength < Result) then
- lpFilePart := nil
- else begin
- AnsiLeadingChars := AnsiFilePart - PAnsiChar(AnsiBuff);
- WideLeadingChars := Length(WideString(Copy(AnsiBuff, 1, AnsiLeadingChars)));
- lpFilePart := lpBuffer + WideLeadingChars;
- end;
- end;
-end;
-
-function Tnt_CreateFileW(lpFileName: PWideChar; dwDesiredAccess, dwShareMode: DWORD;
- lpSecurityAttributes: PSecurityAttributes; dwCreationDisposition, dwFlagsAndAttributes: DWORD;
- hTemplateFile: THandle): THandle;
-begin
- if Win32PlatformIsUnicode then
- Result := CreateFileW{TNT-ALLOW CreateFileW}(lpFileName, dwDesiredAccess, dwShareMode,
- lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile)
- else
- Result := CreateFileA{TNT-ALLOW CreateFileA}(PAnsiChar(AnsiString(lpFileName)), dwDesiredAccess, dwShareMode,
- lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile)
-end;
-
-function Tnt_FindFirstFileW(lpFileName: PWideChar; var lpFindFileData: TWIN32FindDataW): THandle;
-var
- Ansi_lpFindFileData: TWIN32FindDataA;
-begin
- if Win32PlatformIsUnicode then
- Result := FindFirstFileW{TNT-ALLOW FindFirstFileW}(lpFileName, lpFindFileData)
- else begin
- Result := FindFirstFileA{TNT-ALLOW FindFirstFileA}(PAnsiChar(AnsiString(lpFileName)),
- Ansi_lpFindFileData);
- if Result <> INVALID_HANDLE_VALUE then
- _MakeWideWin32FindData(lpFindFileData, Ansi_lpFindFileData);
- end;
-end;
-
-function Tnt_FindNextFileW(hFindFile: THandle; var lpFindFileData: TWIN32FindDataW): BOOL;
-var
- Ansi_lpFindFileData: TWIN32FindDataA;
-begin
- if Win32PlatformIsUnicode then
- Result := FindNextFileW{TNT-ALLOW FindNextFileW}(hFindFile, lpFindFileData)
- else begin
- Result := FindNextFileA{TNT-ALLOW FindNextFileA}(hFindFile, Ansi_lpFindFileData);
- if Result then
- _MakeWideWin32FindData(lpFindFileData, Ansi_lpFindFileData);
- end;
-end;
-
-function Tnt_GetFileAttributesW(lpFileName: PWideChar): DWORD;
-begin
- if Win32PlatformIsUnicode then
- Result := GetFileAttributesW{TNT-ALLOW GetFileAttributesW}(lpFileName)
- else
- Result := GetFileAttributesA{TNT-ALLOW GetFileAttributesA}(PAnsiChar(AnsiString(lpFileName)));
-end;
-
-function Tnt_SetFileAttributesW(lpFileName: PWideChar; dwFileAttributes: DWORD): BOOL;
-begin
- if Win32PlatformIsUnicode then
- Result := SetFileAttributesW{TNT-ALLOW SetFileAttributesW}(lpFileName, dwFileAttributes)
- else
- Result := SetFileAttributesA{TNT-ALLOW SetFileAttributesA}(PAnsiChar(AnsiString(lpFileName)), dwFileAttributes);
-end;
-
-function Tnt_CreateDirectoryW(lpPathName: PWideChar;
- lpSecurityAttributes: PSecurityAttributes): BOOL;
-begin
- if Win32PlatformIsUnicode then
- Result := CreateDirectoryW{TNT-ALLOW CreateDirectoryW}(lpPathName, lpSecurityAttributes)
- else
- Result := CreateDirectoryA{TNT-ALLOW CreateDirectoryA}(PAnsiChar(AnsiString(lpPathName)), lpSecurityAttributes);
-end;
-
-function Tnt_MoveFileW(lpExistingFileName, lpNewFileName: PWideChar): BOOL;
-begin
- if Win32PlatformIsUnicode then
- Result := MoveFileW{TNT-ALLOW MoveFileW}(lpExistingFileName, lpNewFileName)
- else
- Result := MoveFileA{TNT-ALLOW MoveFileA}(PAnsiChar(AnsiString(lpExistingFileName)), PAnsiChar(AnsiString(lpNewFileName)));
-end;
-
-function Tnt_CopyFileW(lpExistingFileName, lpNewFileName: PWideChar; bFailIfExists: BOOL): BOOL;
-begin
- if Win32PlatformIsUnicode then
- Result := CopyFileW{TNT-ALLOW CopyFileW}(lpExistingFileName, lpNewFileName, bFailIfExists)
- else
- Result := CopyFileA{TNT-ALLOW CopyFileA}(PAnsiChar(AnsiString(lpExistingFileName)),
- PAnsiChar(AnsiString(lpNewFileName)), bFailIfExists);
-end;
-
-function Tnt_DeleteFileW(lpFileName: PWideChar): BOOL;
-begin
- if Win32PlatformIsUnicode then
- Result := DeleteFileW{TNT-ALLOW DeleteFileW}(lpFileName)
- else
- Result := DeleteFileA{TNT-ALLOW DeleteFileA}(PAnsiChar(AnsiString(lpFileName)));
-end;
-
-function Tnt_DrawTextW(hDC: HDC; lpString: PWideChar; nCount: Integer;
- var lpRect: TRect; uFormat: UINT): Integer;
-begin
- if Win32PlatformIsUnicode then
- Result := DrawTextW{TNT-ALLOW DrawTextW}(hDC, lpString, nCount, lpRect, uFormat)
- else
- Result := DrawTextA{TNT-ALLOW DrawTextA}(hDC,
- PAnsiChar(AnsiString(_WStr(lpString, nCount))), -1, lpRect, uFormat);
-end;
-
-function Tnt_GetDiskFreeSpaceW(lpRootPathName: PWideChar; var lpSectorsPerCluster,
- lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters: DWORD): BOOL;
-begin
- if Win32PlatformIsUnicode then
- Result := GetDiskFreeSpaceW{TNT-ALLOW GetDiskFreeSpaceW}(lpRootPathName,
- lpSectorsPerCluster, lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters)
- else
- Result := GetDiskFreeSpaceA{TNT-ALLOW GetDiskFreeSpaceA}(PAnsiChar(AnsiString(lpRootPathName)),
- lpSectorsPerCluster, lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters)
-end;
-
-function Tnt_GetVolumeInformationW(lpRootPathName: PWideChar; lpVolumeNameBuffer: PWideChar;
- nVolumeNameSize: DWORD; lpVolumeSerialNumber: PDWORD;
- var lpMaximumComponentLength, lpFileSystemFlags: DWORD; lpFileSystemNameBuffer: PWideChar;
- nFileSystemNameSize: DWORD): BOOL;
-var
- AnsiFileSystemNameBuffer: AnsiString;
- AnsiVolumeNameBuffer: AnsiString;
- AnsiBuffLen: DWORD;
-begin
- if Win32PlatformIsUnicode then
- Result := GetVolumeInformationW{TNT-ALLOW GetVolumeInformationW}(lpRootPathName, lpVolumeNameBuffer, nVolumeNameSize, lpVolumeSerialNumber, lpMaximumComponentLength, lpFileSystemFlags, lpFileSystemNameBuffer, nFileSystemNameSize)
- else begin
- SetLength(AnsiVolumeNameBuffer, MAX_COMPUTERNAME_LENGTH + 1);
- SetLength(AnsiFileSystemNameBuffer, MAX_COMPUTERNAME_LENGTH + 1);
- AnsiBuffLen := Length(AnsiFileSystemNameBuffer);
- Result := GetVolumeInformationA{TNT-ALLOW GetVolumeInformationA}(PAnsiChar(AnsiString(lpRootPathName)), PAnsiChar(AnsiVolumeNameBuffer), AnsiBuffLen, lpVolumeSerialNumber, lpMaximumComponentLength, lpFileSystemFlags, PAnsiChar(AnsiFileSystemNameBuffer), AnsiBuffLen);
- if Result then begin
- SetLength(AnsiFileSystemNameBuffer, AnsiBuffLen);
- if (nFileSystemNameSize <= AnsiBuffLen) or (Length(AnsiFileSystemNameBuffer) = 0) then
- Result := False
- else begin
- WStrPLCopy(lpFileSystemNameBuffer, AnsiFileSystemNameBuffer, nFileSystemNameSize);
- WStrPLCopy(lpVolumeNameBuffer, AnsiVolumeNameBuffer, nVolumeNameSize);
- end;
- end;
- end;
-end;
-
-function Tnt_GetModuleFileNameW(hModule: HINST; lpFilename: PWideChar; nSize: DWORD): DWORD;
-var
- AnsiBuff: AnsiString;
-begin
- if Win32PlatformIsUnicode then
- Result := GetModuleFileNameW{TNT-ALLOW GetModuleFileNameW}(hModule, lpFilename, nSize)
- else begin
- SetLength(AnsiBuff, MAX_PATH);
- SetLength(AnsiBuff, GetModuleFileNameA{TNT-ALLOW GetModuleFileNameA}(hModule, PAnsiChar(AnsiBuff), Length(AnsiBuff)));
- Result := _HandlePathLengthResult(nSize, lpFilename, AnsiBuff, [poExactCopy]);
- end;
-end;
-
-function Tnt_GetTempPathW(nBufferLength: DWORD; lpBuffer: PWideChar): DWORD;
-var
- AnsiBuff: AnsiString;
-begin
- if Win32PlatformIsUnicode then
- Result := GetTempPathW{TNT-ALLOW GetTempPathW}(nBufferLength, lpBuffer)
- else begin
- SetLength(AnsiBuff, MAX_PATH);
- SetLength(AnsiBuff, GetTempPathA{TNT-ALLOW GetTempPathA}(Length(AnsiBuff), PAnsiChar(AnsiBuff)));
- Result := _HandlePathLengthResult(nBufferLength, lpBuffer, AnsiBuff, [poAllowDirectoryMode, poZeroSmallBuff]);
- end;
-end;
-
-function Tnt_GetTempFileNameW(lpPathName, lpPrefixString: PWideChar; uUnique: UINT;
- lpTempFileName: PWideChar): UINT;
-var
- AnsiBuff: AnsiString;
-begin
- if Win32PlatformIsUnicode then
- Result := GetTempFileNameW{TNT-ALLOW GetTempFileNameW}(lpPathName, lpPrefixString, uUnique, lpTempFileName)
- else begin
- SetLength(AnsiBuff, MAX_PATH);
- Result := GetTempFileNameA{TNT-ALLOW GetTempFileNameA}(PAnsiChar(AnsiString(lpPathName)), PAnsiChar(lpPrefixString), uUnique, PAnsiChar(AnsiBuff));
- AnsiBuff := PAnsiChar(AnsiBuff);
- _HandlePathLengthResult(MAX_PATH, lpTempFileName, AnsiBuff, [poZeroSmallBuff]);
- end;
-end;
-
-function Tnt_GetWindowsDirectoryW(lpBuffer: PWideChar; uSize: UINT): UINT;
-var
- AnsiBuff: AnsiString;
-begin
- if Win32PlatformIsUnicode then
- Result := GetWindowsDirectoryW{TNT-ALLOW GetWindowsDirectoryW}(lpBuffer, uSize)
- else begin
- SetLength(AnsiBuff, MAX_PATH);
- SetLength(AnsiBuff, GetWindowsDirectoryA{TNT-ALLOW GetWindowsDirectoryA}(PAnsiChar(AnsiBuff), Length(AnsiBuff)));
- Result := _HandlePathLengthResult(uSize, lpBuffer, AnsiBuff, []);
- end;
-end;
-
-function Tnt_GetSystemDirectoryW(lpBuffer: PWideChar; uSize: UINT): UINT;
-var
- AnsiBuff: AnsiString;
-begin
- if Win32PlatformIsUnicode then
- Result := GetSystemDirectoryW{TNT-ALLOW GetSystemDirectoryW}(lpBuffer, uSize)
- else begin
- SetLength(AnsiBuff, MAX_PATH);
- SetLength(AnsiBuff, GetSystemDirectoryA{TNT-ALLOW GetSystemDirectoryA}(PAnsiChar(AnsiBuff), Length(AnsiBuff)));
- Result := _HandlePathLengthResult(uSize, lpBuffer, AnsiBuff, []);
- end;
-end;
-
-function Tnt_GetCurrentDirectoryW(nBufferLength: DWORD; lpBuffer: PWideChar): DWORD;
-var
- AnsiBuff: AnsiString;
-begin
- if Win32PlatformIsUnicode then
- Result := GetCurrentDirectoryW{TNT-ALLOW GetCurrentDirectoryW}(nBufferLength, lpBuffer)
- else begin
- SetLength(AnsiBuff, MAX_PATH);
- SetLength(AnsiBuff, GetCurrentDirectoryA{TNT-ALLOW GetCurrentDirectoryA}(Length(AnsiBuff), PAnsiChar(AnsiBuff)));
- Result := _HandlePathLengthResult(nBufferLength, lpBuffer, AnsiBuff, [poAllowDirectoryMode, poZeroSmallBuff]);
- end;
-end;
-
-function Tnt_SetCurrentDirectoryW(lpPathName: PWideChar): BOOL;
-begin
- if Win32PlatformIsUnicode then
- Result := SetCurrentDirectoryW{TNT-ALLOW SetCurrentDirectoryW}(lpPathName)
- else
- Result := SetCurrentDirectoryA{TNT-ALLOW SetCurrentDirectoryA}(PAnsiChar(AnsiString(lpPathName)));
-end;
-
-function Tnt_GetComputerNameW(lpBuffer: PWideChar; var nSize: DWORD): BOOL;
-var
- AnsiBuff: AnsiString;
- AnsiBuffLen: DWORD;
-begin
- if Win32PlatformIsUnicode then
- Result := GetComputerNameW{TNT-ALLOW GetComputerNameW}(lpBuffer, nSize)
- else begin
- SetLength(AnsiBuff, MAX_COMPUTERNAME_LENGTH + 1);
- AnsiBuffLen := Length(AnsiBuff);
- Result := GetComputerNameA{TNT-ALLOW GetComputerNameA}(PAnsiChar(AnsiBuff), AnsiBuffLen);
- if Result then begin
- SetLength(AnsiBuff, AnsiBuffLen);
- if (nSize <= AnsiBuffLen) or (Length(AnsiBuff) = 0) then begin
- nSize := AnsiBuffLen + 1;
- Result := False;
- end else begin
- WStrPLCopy(lpBuffer, AnsiBuff, nSize);
- nSize := WStrLen(lpBuffer);
- end;
- end;
- end;
-end;
-
-function Tnt_GetUserNameW(lpBuffer: PWideChar; var nSize: DWORD): BOOL;
-var
- AnsiBuff: AnsiString;
- AnsiBuffLen: DWORD;
-begin
- if Win32PlatformIsUnicode then
- Result := GetUserNameW{TNT-ALLOW GetUserNameW}(lpBuffer, nSize)
- else begin
- SetLength(AnsiBuff, 255);
- AnsiBuffLen := Length(AnsiBuff);
- Result := GetUserNameA{TNT-ALLOW GetUserNameA}(PAnsiChar(AnsiBuff), AnsiBuffLen);
- if Result then begin
- SetLength(AnsiBuff, AnsiBuffLen);
- if (nSize <= AnsiBuffLen) or (Length(AnsiBuff) = 0) then begin
- nSize := AnsiBuffLen + 1;
- Result := False;
- end else begin
- WStrPLCopy(lpBuffer, AnsiBuff, nSize);
- nSize := WStrLen(lpBuffer);
- end;
- end;
- end;
-end;
-
-function Tnt_ShellExecuteW(hWnd: HWND; Operation, FileName, Parameters,
- Directory: PWideChar; ShowCmd: Integer): HINST;
-begin
- if Win32PlatformIsUnicode then
- Result := ShellExecuteW{TNT-ALLOW ShellExecuteW}(hWnd, _PWideCharWithNil(WideString(Operation)),
- FileName, Parameters,
- Directory, ShowCmd)
- else begin
- Result := ShellExecuteA{TNT-ALLOW ShellExecuteA}(hWnd, _PAnsiCharWithNil(AnsiString(Operation)),
- _PAnsiCharWithNil(AnsiString(FileName)), _PAnsiCharWithNil(AnsiString(Parameters)),
- _PAnsiCharWithNil(AnsiString(Directory)), ShowCmd)
- end;
-end;
-
-function Tnt_LoadLibraryW(lpLibFileName: PWideChar): HMODULE;
-begin
- if Win32PlatformIsUnicode then
- Result := LoadLibraryW{TNT-ALLOW LoadLibraryW}(lpLibFileName)
- else
- Result := LoadLibraryA{TNT-ALLOW LoadLibraryA}(PAnsiChar(AnsiString(lpLibFileName)));
-end;
-
-function Tnt_LoadLibraryExW(lpLibFileName: PWideChar; hFile: THandle; dwFlags: DWORD): HMODULE;
-begin
- if Win32PlatformIsUnicode then
- Result := LoadLibraryExW{TNT-ALLOW LoadLibraryExW}(lpLibFileName, hFile, dwFlags)
- else
- Result := LoadLibraryExA{TNT-ALLOW LoadLibraryExA}(PAnsiChar(AnsiString(lpLibFileName)), hFile, dwFlags);
-end;
-
-function Tnt_CreateProcessW(lpApplicationName: PWideChar; lpCommandLine: PWideChar;
- lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
- bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
- lpCurrentDirectory: PWideChar; const lpStartupInfo: TStartupInfoW;
- var lpProcessInformation: TProcessInformation): BOOL;
-var
- AnsiStartupInfo: TStartupInfoA;
-begin
- if Win32PlatformIsUnicode then begin
- Result := CreateProcessW{TNT-ALLOW CreateProcessW}(lpApplicationName, lpCommandLine,
- lpProcessAttributes, lpThreadAttributes, bInheritHandles, dwCreationFlags, lpEnvironment,
- lpCurrentDirectory, lpStartupInfo, lpProcessInformation)
- end else begin
- CopyMemory(@AnsiStartupInfo, @lpStartupInfo, SizeOf(TStartupInfo));
- AnsiStartupInfo.lpReserved := _PAnsiCharWithNil(AnsiString(lpStartupInfo.lpReserved));
- AnsiStartupInfo.lpDesktop := _PAnsiCharWithNil(AnsiString(lpStartupInfo.lpDesktop));
- AnsiStartupInfo.lpTitle := _PAnsiCharWithNil(AnsiString(lpStartupInfo.lpTitle));
- Result := CreateProcessA{TNT-ALLOW CreateProcessA}(_PAnsiCharWithNil(AnsiString(lpApplicationName)),
- _PAnsiCharWithNil(AnsiString(lpCommandLine)),
- lpProcessAttributes, lpThreadAttributes, bInheritHandles, dwCreationFlags, lpEnvironment,
- _PAnsiCharWithNil(AnsiString(lpCurrentDirectory)), AnsiStartupInfo, lpProcessInformation);
- end;
-end;
-
-function Tnt_GetCurrencyFormatW(Locale: LCID; dwFlags: DWORD; lpValue: PWideChar;
- lpFormat: PCurrencyFmtW; lpCurrencyStr: PWideChar; cchCurrency: Integer): Integer;
-const
- MAX_ANSI_BUFF_SIZE = 64; // can a currency string actually be larger?
-var
- AnsiFormat: TCurrencyFmtA;
- PAnsiFormat: PCurrencyFmtA;
- AnsiBuff: AnsiString;
-begin
- if Win32PlatformIsUnicode then
- Result := GetCurrencyFormatW{TNT-ALLOW GetCurrencyFormatW}(Locale, dwFlags, lpValue,
- {$IFNDEF FPC} lpFormat {$ELSE} PCurrencyFmt(lpFormat) {$ENDIF},
- lpCurrencyStr, cchCurrency)
- else begin
- if lpFormat = nil then
- PAnsiFormat := nil
- else begin
- ZeroMemory(@AnsiFormat, SizeOf(AnsiFormat));
- AnsiFormat.NumDigits := lpFormat.NumDigits;
- AnsiFormat.LeadingZero := lpFormat.LeadingZero;
- AnsiFormat.Grouping := lpFormat.Grouping;
- AnsiFormat.lpDecimalSep := PAnsiChar(AnsiString(lpFormat.lpDecimalSep));
- AnsiFormat.lpThousandSep := PAnsiChar(AnsiString(lpFormat.lpThousandSep));
- AnsiFormat.NegativeOrder := lpFormat.NegativeOrder;
- AnsiFormat.PositiveOrder := lpFormat.PositiveOrder;
- AnsiFormat.lpCurrencySymbol := PAnsiChar(AnsiString(lpFormat.lpCurrencySymbol));
- PAnsiFormat := @AnsiFormat;
- end;
- SetLength(AnsiBuff, MAX_ANSI_BUFF_SIZE);
- SetLength(AnsiBuff, GetCurrencyFormatA{TNT-ALLOW GetCurrencyFormatA}(Locale, dwFlags,
- PAnsiChar(AnsiString(lpValue)), PAnsiFormat, PAnsiChar(AnsiBuff), MAX_ANSI_BUFF_SIZE));
- Result := _HandleStringLengthResult(cchCurrency, lpCurrencyStr, AnsiBuff, []);
- end;
-end;
-
-function Tnt_CompareStringW(Locale: LCID; dwCmpFlags: DWORD; lpString1: PWideChar;
- cchCount1: Integer; lpString2: PWideChar; cchCount2: Integer): Integer;
-var
- WideStr1, WideStr2: WideString;
- AnsiStr1, AnsiStr2: AnsiString;
-begin
- if Win32PlatformIsUnicode then
- Result := CompareStringW{TNT-ALLOW CompareStringW}(Locale, dwCmpFlags, lpString1, cchCount1, lpString2, cchCount2)
- else begin
- WideStr1 := _WStr(lpString1, cchCount1);
- WideStr2 := _WStr(lpString2, cchCount2);
- if (dwCmpFlags = 0) then begin
- // binary comparison
- if WideStr1 < WideStr2 then
- Result := 1
- else if WideStr1 = WideStr2 then
- Result := 2
- else
- Result := 3;
- end else begin
- AnsiStr1 := WideStr1;
- AnsiStr2 := WideStr2;
- Result := CompareStringA{TNT-ALLOW CompareStringA}(Locale, dwCmpFlags,
- PAnsiChar(AnsiStr1), -1, PAnsiChar(AnsiStr2), -1);
- end;
- end;
-end;
-
-function Tnt_CharUpperW(lpsz: PWideChar): PWideChar;
-var
- AStr: AnsiString;
- WStr: WideString;
-begin
- if Win32PlatformIsUnicode then
- Result := CharUpperW{TNT-ALLOW CharUpperW}(lpsz)
- else begin
- if HiWord(Cardinal(lpsz)) = 0 then begin
- // literal char mode
- Result := lpsz;
- if IsWideCharMappableToAnsi(WideChar(lpsz)) then begin
- AStr := WideChar(lpsz); // single character may be more than one byte
- CharUpperA{TNT-ALLOW CharUpperA}(PAnsiChar(AStr));
- WStr := AStr; // should always be single wide char
- if Length(WStr) = 1 then
- Result := PWideChar(WStr[1]);
- end
- end else begin
- // null-terminated string mode
- Result := lpsz;
- while lpsz^ <> #0 do begin
- lpsz^ := WideChar(Tnt_CharUpperW(PWideChar(lpsz^)));
- Inc(lpsz);
- end;
- end;
- end;
-end;
-
-function Tnt_CharUpperBuffW(lpsz: PWideChar; cchLength: DWORD): DWORD;
-var
- i: integer;
-begin
- if Win32PlatformIsUnicode then
- Result := CharUpperBuffW{TNT-ALLOW CharUpperBuffW}(lpsz, cchLength)
- else begin
- Result := cchLength;
- for i := 1 to cchLength do begin
- lpsz^ := WideChar(Tnt_CharUpperW(PWideChar(lpsz^)));
- Inc(lpsz);
- end;
- end;
-end;
-
-function Tnt_CharLowerW(lpsz: PWideChar): PWideChar;
-var
- AStr: AnsiString;
- WStr: WideString;
-begin
- if Win32PlatformIsUnicode then
- Result := CharLowerW{TNT-ALLOW CharLowerW}(lpsz)
- else begin
- if HiWord(Cardinal(lpsz)) = 0 then begin
- // literal char mode
- Result := lpsz;
- if IsWideCharMappableToAnsi(WideChar(lpsz)) then begin
- AStr := WideChar(lpsz); // single character may be more than one byte
- CharLowerA{TNT-ALLOW CharLowerA}(PAnsiChar(AStr));
- WStr := AStr; // should always be single wide char
- if Length(WStr) = 1 then
- Result := PWideChar(WStr[1]);
- end
- end else begin
- // null-terminated string mode
- Result := lpsz;
- while lpsz^ <> #0 do begin
- lpsz^ := WideChar(Tnt_CharLowerW(PWideChar(lpsz^)));
- Inc(lpsz);
- end;
- end;
- end;
-end;
-
-function Tnt_CharLowerBuffW(lpsz: PWideChar; cchLength: DWORD): DWORD;
-var
- i: integer;
-begin
- if Win32PlatformIsUnicode then
- Result := CharLowerBuffW{TNT-ALLOW CharLowerBuffW}(lpsz, cchLength)
- else begin
- Result := cchLength;
- for i := 1 to cchLength do begin
- lpsz^ := WideChar(Tnt_CharLowerW(PWideChar(lpsz^)));
- Inc(lpsz);
- end;
- end;
-end;
-
-function Tnt_GetStringTypeExW(Locale: LCID; dwInfoType: DWORD;
- lpSrcStr: PWideChar; cchSrc: Integer; var lpCharType): BOOL;
-var
- AStr: AnsiString;
-begin
- if Win32PlatformIsUnicode then
- Result := GetStringTypeExW{TNT-ALLOW GetStringTypeExW}(Locale, dwInfoType, lpSrcStr, cchSrc, lpCharType)
- else begin
- AStr := _WStr(lpSrcStr, cchSrc);
- Result := GetStringTypeExA{TNT-ALLOW GetStringTypeExA}(Locale, dwInfoType,
- PAnsiChar(AStr), -1, lpCharType);
- end;
-end;
-
-function Win9x_LoadStringW(hInstance: HINST; uID: UINT; lpBuffer: PWideChar; nBufferMax: Integer): Integer;
-// This function originated by the WINE Project.
-// It was translated to Pascal by Francisco Leong.
-// It was further modified by Troy Wolbrink.
-var
- hmem: HGLOBAL;
- hrsrc: THandle;
- p: PWideChar;
- string_num, i: Integer;
- block: Integer;
-begin
- Result := 0;
- // Netscape v3 fix...
- if (HIWORD(uID) = $FFFF) then begin
- uID := UINT(-(Integer(uID)));
- end;
- // figure block, string_num
- block := ((uID shr 4) and $FFFF) + 1; // bits 4 - 19, mask out bits 20 - 31, inc by 1
- string_num := uID and $000F;
- // get handle & pointer to string block
- hrsrc := FindResource{TNT-ALLOW FindResource}(hInstance, MAKEINTRESOURCE(block), RT_STRING);
- if (hrsrc <> 0) then
- begin
- hmem := LoadResource(hInstance, hrsrc);
- if (hmem <> 0) then
- begin
- p := LockResource(hmem);
- // walk the block to the requested string
- for i := 0 to string_num - 1 do begin
- p := p + Integer(p^) + 1;
- end;
- Result := Integer(p^); { p points to the length of string }
- Inc(p); { p now points to the actual string }
- if (lpBuffer <> nil) and (nBufferMax > 0) then
- begin
- Result := min(nBufferMax - 1, Result); { max length to copy }
- if (Result > 0) then begin
- CopyMemory(lpBuffer, p, Result * sizeof(WideChar));
- end;
- lpBuffer[Result] := WideChar(0); { null terminate }
- end;
- end;
- end;
-end;
-
-function Tnt_LoadStringW(hInstance: HINST; uID: UINT; lpBuffer: PWideChar; nBufferMax: Integer): Integer;
-begin
- if Win32PlatformIsUnicode then
- Result := Windows.LoadStringW{TNT-ALLOW LoadStringW}(hInstance, uID, lpBuffer, nBufferMax)
- else
- Result := Win9x_LoadStringW(hInstance, uID, lpBuffer, nBufferMax);
-end;
-
-function Tnt_InsertMenuItemW(hMenu: HMENU; uItem: DWORD; fByPosition: BOOL; lpmii: TMenuItemInfoW): BOOL;
-begin
- if Win32PlatformIsUnicode then
- Result := InsertMenuItemW{TNT-ALLOW InsertMenuItemW}(hMenu, uItem, fByPosition,
- {$IFDEF FPC}@{$ENDIF}lpmii)
- else begin
- TMenuItemInfoA(lpmii).dwTypeData := PAnsiChar(AnsiString(lpmii.dwTypeData));
- Result := InsertMenuItemA{TNT-ALLOW InsertMenuItemA}(hMenu, uItem, fByPosition,
- {$IFDEF FPC}@{$ENDIF}TMenuItemInfoA(lpmii));
- end;
-end;
-
-function Tnt_ExtractIconExW(lpszFile: PWideChar; nIconIndex: Integer;
- var phiconLarge, phiconSmall: HICON; nIcons: UINT): UINT;
-begin
- if Win32PlatformIsUnicode then
- Result := ExtractIconExW{TNT-ALLOW ExtractIconExW}(lpszFile,
- nIconIndex, phiconLarge, phiconSmall, nIcons)
- else
- Result := ExtractIconExA{TNT-ALLOW ExtractIconExA}(PAnsiChar(AnsiString(lpszFile)),
- nIconIndex, phiconLarge, phiconSmall, nIcons);
-end;
-
-function Tnt_ExtractAssociatedIconW(hInst: HINST; lpIconPath: PWideChar;
- var lpiIcon: Word): HICON;
-begin
- if Win32PlatformIsUnicode then
- Result := ExtractAssociatedIconW{TNT-ALLOW ExtractAssociatedIconW}(hInst,
- lpIconPath, {$IFDEF FPC}@{$ENDIF}lpiIcon)
- else
- Result := ExtractAssociatedIconA{TNT-ALLOW ExtractAssociatedIconA}(hInst,
- PAnsiChar(AnsiString(lpIconPath)), {$IFDEF FPC}@{$ENDIF}lpiIcon)
-end;
-
-function Tnt_GetFileVersionInfoSizeW(lptstrFilename: PWideChar; var lpdwHandle: DWORD): DWORD;
-begin
- if Win32PlatformIsUnicode then
- Result := GetFileVersionInfoSizeW{TNT-ALLOW GetFileVersionInfoSizeW}(lptstrFilename, lpdwHandle)
- else
- Result := GetFileVersionInfoSizeA{TNT-ALLOW GetFileVersionInfoSizeA}(PAnsiChar(AnsiString(lptstrFilename)), lpdwHandle);
-end;
-
-function Tnt_GetFileVersionInfoW(lptstrFilename: PWideChar; dwHandle, dwLen: DWORD;
- lpData: Pointer): BOOL;
-begin
- if Win32PlatformIsUnicode then
- Result := GetFileVersionInfoW{TNT-ALLOW GetFileVersionInfoW}(lptstrFilename, dwHandle, dwLen, lpData)
- else
- Result := GetFileVersionInfoA{TNT-ALLOW GetFileVersionInfoA}(PAnsiChar(AnsiString(lptstrFilename)), dwHandle, dwLen, lpData);
-end;
-
-var
- Last_VerQueryValue_String: WideString;
-
-function Tnt_VerQueryValueW(pBlock: Pointer; lpSubBlock: PWideChar;
- var lplpBuffer: Pointer; var puLen: UINT): BOOL;
-var
- AnsiBuff: AnsiString;
-begin
- if Win32PlatformIsUnicode then
- Result := VerQueryValueW{TNT-ALLOW VerQueryValueW}(pBlock, lpSubBlock, lplpBuffer, puLen)
- else begin
- Result := VerQueryValueA{TNT-ALLOW VerQueryValueA}(pBlock, PAnsiChar(AnsiString(lpSubBlock)), lplpBuffer, puLen);
- if WideTextPos(VQV_STRINGFILEINFO, lpSubBlock) <> 1 then
- else begin
- { /StringFileInfo, convert ansi result to unicode }
- SetString(AnsiBuff, PAnsiChar(lplpBuffer), puLen);
- Last_VerQueryValue_String := AnsiBuff;
- lplpBuffer := PWideChar(Last_VerQueryValue_String);
- puLen := Length(Last_VerQueryValue_String);
- end;
- end;
-end;
-
-//---------------------------------------------------------------------------------------
-// Wide functions from Shell32.dll should be loaded dynamically (no stub on early Win95)
-//---------------------------------------------------------------------------------------
-
-type
- TSHFileOperationW = function(var lpFileOp: TSHFileOpStructW): Integer; stdcall;
- TSHBrowseForFolderW = function(var lpbi: TBrowseInfoW): PItemIDList; stdcall;
- TSHGetPathFromIDListW = function(pidl: PItemIDList; pszPath: PWideChar): BOOL; stdcall;
- TSHGetFileInfoW = function(pszPath: PWideChar; dwFileAttributes: DWORD;
- var psfi: TSHFileInfoW; cbFileInfo, uFlags: UINT): DWORD; stdcall;
-
-var
- Safe_SHFileOperationW: TSHFileOperationW = nil;
- Safe_SHBrowseForFolderW: TSHBrowseForFolderW = nil;
- Safe_SHGetPathFromIDListW: TSHGetPathFromIDListW = nil;
- Safe_SHGetFileInfoW: TSHGetFileInfoW = nil;
-
-var Shell32DLL: HModule = 0;
-
-procedure LoadWideShell32Procs;
-begin
- if Shell32DLL = 0 then begin
- Shell32DLL := WinCheckH(Tnt_LoadLibraryW('shell32.dll'));
- Safe_SHFileOperationW := WinCheckP(GetProcAddress(Shell32DLL, 'SHFileOperationW'));
- Safe_SHBrowseForFolderW := WinCheckP(GetProcAddress(Shell32DLL, 'SHBrowseForFolderW'));
- Safe_SHGetPathFromIDListW := WinCheckP(GetProcAddress(Shell32DLL, 'SHGetPathFromIDListW'));
- Safe_SHGetFileInfoW := WinCheckP(GetProcAddress(Shell32DLL, 'SHGetFileInfoW'));
- end;
-end;
-
-function Tnt_SHFileOperationW(var lpFileOp: TSHFileOpStructW): Integer;
-var
- AnsiFileOp: TSHFileOpStructA;
- MapCount: Integer;
- PAnsiMap: PSHNameMappingA;
- PWideMap: PSHNameMappingW;
- OldPath: WideString;
- NewPath: WideString;
- i: integer;
-begin
- if Win32PlatformIsUnicode then begin
- LoadWideShell32Procs;
- Result := Safe_SHFileOperationW(lpFileOp);
- end else begin
- AnsiFileOp := TSHFileOpStructA(lpFileOp);
- // convert PChar -> PWideChar
- if lpFileOp.pFrom = nil then
- AnsiFileOp.pFrom := nil
- else
- AnsiFileOp.pFrom := PAnsiChar(AnsiString(ExtractStringArrayStr(lpFileOp.pFrom)));
- if lpFileOp.pTo = nil then
- AnsiFileOp.pTo := nil
- else
- AnsiFileOp.pTo := PAnsiChar(AnsiString(ExtractStringArrayStr(lpFileOp.pTo)));
- AnsiFileOp.lpszProgressTitle := PAnsiChar(AnsiString(lpFileOp.lpszProgressTitle));
- Result := SHFileOperationA{TNT-ALLOW SHFileOperationA}(
- {$IFDEF FPC}@{$ENDIF}AnsiFileOp);
- // return struct results
- lpFileOp.fAnyOperationsAborted := AnsiFileOp.fAnyOperationsAborted;
- lpFileOp.hNameMappings := nil;
- if (AnsiFileOp.hNameMappings <> nil)
- and ((FOF_WANTMAPPINGHANDLE and AnsiFileOp.fFlags) <> 0) then begin
- // alloc mem
- MapCount := PSHNameMappingHeaderA(AnsiFileOp.hNameMappings).cNumOfMappings;
- lpFileOp.hNameMappings :=
- AllocMem(SizeOf({hNameMappings}Cardinal) + SizeOf(TSHNameMappingW) * MapCount);
- PSHNameMappingHeaderW(lpFileOp.hNameMappings).cNumOfMappings := MapCount;
- // init pointers
- PAnsiMap := PSHNameMappingHeaderA(AnsiFileOp.hNameMappings).lpNM;
- PWideMap := PSHNameMappingHeaderW(lpFileOp.hNameMappings).lpNM;
- for i := 1 to MapCount do begin
- // old path
- OldPath := Copy(PAnsiMap.pszOldPath, 1, PAnsiMap.cchOldPath);
- PWideMap.pszOldPath := WStrNew(PWideChar(OldPath));
- PWideMap.cchOldPath := WStrLen(PWideMap.pszOldPath);
- // new path
- NewPath := Copy(PAnsiMap.pszNewPath, 1, PAnsiMap.cchNewPath);
- PWideMap.pszNewPath := WStrNew(PWideChar(NewPath));
- PWideMap.cchNewPath := WStrLen(PWideMap.pszNewPath);
- // next record
- Inc(PAnsiMap);
- Inc(PWideMap);
- end;
- end;
- end;
-end;
-
-procedure Tnt_SHFreeNameMappings(hNameMappings: THandle);
-var
- i: integer;
- MapCount: Integer;
- PWideMap: PSHNameMappingW;
-begin
- if Win32PlatformIsUnicode then
- SHFreeNameMappings{TNT-ALLOW SHFreeNameMappings}(hNameMappings)
- else begin
- // free strings
- MapCount := PSHNameMappingHeaderW(hNameMappings).cNumOfMappings;
- PWideMap := PSHNameMappingHeaderW(hNameMappings).lpNM;
- for i := 1 to MapCount do begin
- WStrDispose(PWideMap.pszOldPath);
- WStrDispose(PWideMap.pszNewPath);
- Inc(PWideMap);
- end;
- // free struct
- FreeMem(Pointer(hNameMappings));
- end;
-end;
-
-function Tnt_SHBrowseForFolderW(var lpbi: TBrowseInfoW): PItemIDList;
-var
- AnsiInfo: TBrowseInfoA;
- AnsiBuffer: array[0..MAX_PATH] of AnsiChar;
-begin
- if Win32PlatformIsUnicode then begin
- LoadWideShell32Procs;
- Result := Safe_SHBrowseForFolderW(lpbi);
- end else begin
- AnsiInfo := TBrowseInfoA(lpbi);
- AnsiInfo.lpszTitle := PAnsiChar(AnsiString(lpbi.lpszTitle));
- if lpbi.pszDisplayName <> nil then
- AnsiInfo.pszDisplayName := AnsiBuffer;
- Result := SHBrowseForFolderA{TNT-ALLOW SHBrowseForFolderA}(
- {$IFDEF FPC}@{$ENDIF}AnsiInfo);
- if lpbi.pszDisplayName <> nil then
- WStrPCopy(lpbi.pszDisplayName, AnsiInfo.pszDisplayName);
- lpbi.iImage := AnsiInfo.iImage;
- end;
-end;
-
-function Tnt_SHGetPathFromIDListW(pidl: PItemIDList; pszPath: PWideChar): BOOL;
-var
- AnsiPath: AnsiString;
-begin
- if Win32PlatformIsUnicode then begin
- LoadWideShell32Procs;
- Result := Safe_SHGetPathFromIDListW(pidl, pszPath);
- end else begin
- SetLength(AnsiPath, MAX_PATH);
- Result := SHGetPathFromIDListA{TNT-ALLOW SHGetPathFromIDListA}(pidl, PAnsiChar(AnsiPath));
- if Result then
- WStrPCopy(pszPath, PAnsiChar(AnsiPath))
- end;
-end;
-
-function Tnt_SHGetFileInfoW(pszPath: PWideChar; dwFileAttributes: DWORD;
- var psfi: TSHFileInfoW; cbFileInfo, uFlags: UINT): DWORD;
-var
- SHFileInfoA: TSHFileInfoA;
-begin
- if Win32PlatformIsUnicode then begin
- LoadWideShell32Procs;
- Result := Safe_SHGetFileInfoW(pszPath, dwFileAttributes, psfi, cbFileInfo, uFlags)
- end else begin
- Result := SHGetFileInfoA{TNT-ALLOW SHGetFileInfoA}(PAnsiChar(AnsiString(pszPath)),
- dwFileAttributes, SHFileInfoA, SizeOf(TSHFileInfoA), uFlags);
- // update pfsi...
- ZeroMemory(@psfi, SizeOf(TSHFileInfoW));
- psfi.hIcon := SHFileInfoA.hIcon;
- psfi.iIcon := SHFileInfoA.iIcon;
- psfi.dwAttributes := SHFileInfoA.dwAttributes;
- WStrPLCopy(psfi.szDisplayName, SHFileInfoA.szDisplayName, MAX_PATH);
- WStrPLCopy(psfi.szTypeName, SHFileInfoA.szTypeName, 80);
- end;
-end;
-
-
-function Tnt_Is_IntResource(ResStr: LPCWSTR): Boolean;
-begin
- Result := HiWord(Cardinal(ResStr)) = 0;
-end;
-
-function LANGIDFROMLCID(lcid: LCID): WORD;
-begin
- Result := LoWord(lcid);
-end;
-
-function MAKELANGID(usPrimaryLanguage, usSubLanguage: WORD): WORD;
-begin
- Result := (usSubLanguage shl 10) or usPrimaryLanguage;
-end;
-
-function MAKELCID(wLanguageID: WORD; wSortID: WORD = SORT_DEFAULT): LCID;
-begin
- Result := MakeLong(wLanguageID, wSortID);
-end;
-
-function PRIMARYLANGID(lgid: WORD): WORD;
-begin
- Result := lgid and $03FF;
-end;
-
-function SORTIDFROMLCID(lcid: LCID): WORD;
-begin
- Result := HiWord(lcid);
-end;
-
-function SUBLANGID(lgid: WORD): WORD;
-begin
- Result := lgid shr 10;
-end;
-
-initialization
-
-finalization
- if Shell32DLL <> 0 then
- FreeLibrary(Shell32DLL);
-
-end.
diff --git a/src/lib/bass/delphi/bass.pas b/src/lib/bass/delphi/bass.pas
deleted file mode 100644
index 85d10355..00000000
--- a/src/lib/bass/delphi/bass.pas
+++ /dev/null
@@ -1,900 +0,0 @@
-{
- BASS 2.4 Delphi unit
- Copyright (c) 1999-2008 Un4seen Developments Ltd.
-
- See the BASS.CHM file for more detailed documentation
-
- How to install
- --------------
- Copy BASS.PAS to the \LIB subdirectory of your Delphi path or your project dir
-}
-
-unit Bass;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
- {$PACKRECORDS C}
-{$ENDIF}
-
-{$IFDEF MSWINDOWS}
- {$DEFINE DLL_STDCALL}
-{$ELSE}
- {$DEFINE DLL_CDECL}
-{$ENDIF}
-
-// IMPORTANT: define BASS_242 when switching to 2.4.2(.1) as
-// BASS_RECORDINFO.driver was removed.
-// Otherwise BASS_RECORDINFO.freq will point to a wrong location.
-{$UNDEF BASS_242}
-
-
-{$IFDEF MSWINDOWS}
-uses
- Windows;
-{$ENDIF}
-
-const
- BASSVERSION = $204; // API version
- BASSVERSIONTEXT = '2.4';
-
- // Use these to test for error from functions that return a DWORD or QWORD
- DW_ERROR = Cardinal(-1); // -1 (DWORD)
- QW_ERROR = Int64(-1); // -1 (QWORD)
-
- // Error codes returned by BASS_ErrorGetCode()
- BASS_OK = 0; // all is OK
- BASS_ERROR_MEM = 1; // memory error
- BASS_ERROR_FILEOPEN = 2; // can't open the file
- BASS_ERROR_DRIVER = 3; // can't find a free sound driver
- BASS_ERROR_BUFLOST = 4; // the sample buffer was lost
- BASS_ERROR_HANDLE = 5; // invalid handle
- BASS_ERROR_FORMAT = 6; // unsupported sample format
- BASS_ERROR_POSITION = 7; // invalid position
- BASS_ERROR_INIT = 8; // BASS_Init has not been successfully called
- BASS_ERROR_START = 9; // BASS_Start has not been successfully called
- BASS_ERROR_ALREADY = 14; // already initialized/paused/whatever
- BASS_ERROR_NOCHAN = 18; // can't get a free channel
- BASS_ERROR_ILLTYPE = 19; // an illegal type was specified
- BASS_ERROR_ILLPARAM = 20; // an illegal parameter was specified
- BASS_ERROR_NO3D = 21; // no 3D support
- BASS_ERROR_NOEAX = 22; // no EAX support
- BASS_ERROR_DEVICE = 23; // illegal device number
- BASS_ERROR_NOPLAY = 24; // not playing
- BASS_ERROR_FREQ = 25; // illegal sample rate
- BASS_ERROR_NOTFILE = 27; // the stream is not a file stream
- BASS_ERROR_NOHW = 29; // no hardware voices available
- BASS_ERROR_EMPTY = 31; // the MOD music has no sequence data
- BASS_ERROR_NONET = 32; // no internet connection could be opened
- BASS_ERROR_CREATE = 33; // couldn't create the file
- BASS_ERROR_NOFX = 34; // effects are not enabled
- BASS_ERROR_NOTAVAIL = 37; // requested data is not available
- BASS_ERROR_DECODE = 38; // the channel is a "decoding channel"
- BASS_ERROR_DX = 39; // a sufficient DirectX version is not installed
- BASS_ERROR_TIMEOUT = 40; // connection timedout
- BASS_ERROR_FILEFORM = 41; // unsupported file format
- BASS_ERROR_SPEAKER = 42; // unavailable speaker
- BASS_ERROR_VERSION = 43; // invalid BASS version (used by add-ons)
- BASS_ERROR_CODEC = 44; // codec is not available/supported
- BASS_ERROR_ENDED = 45; // the channel/file has ended
- BASS_ERROR_UNKNOWN = -1; // some other mystery problem
-
- // BASS_SetConfig options
- BASS_CONFIG_BUFFER = 0;
- BASS_CONFIG_UPDATEPERIOD = 1;
- BASS_CONFIG_GVOL_SAMPLE = 4;
- BASS_CONFIG_GVOL_STREAM = 5;
- BASS_CONFIG_GVOL_MUSIC = 6;
- BASS_CONFIG_CURVE_VOL = 7;
- BASS_CONFIG_CURVE_PAN = 8;
- BASS_CONFIG_FLOATDSP = 9;
- BASS_CONFIG_3DALGORITHM = 10;
- BASS_CONFIG_NET_TIMEOUT = 11;
- BASS_CONFIG_NET_BUFFER = 12;
- BASS_CONFIG_PAUSE_NOPLAY = 13;
- BASS_CONFIG_NET_PREBUF = 15;
- BASS_CONFIG_NET_PASSIVE = 18;
- BASS_CONFIG_REC_BUFFER = 19;
- BASS_CONFIG_NET_PLAYLIST = 21;
- BASS_CONFIG_MUSIC_VIRTUAL = 22;
- BASS_CONFIG_VERIFY = 23;
- BASS_CONFIG_UPDATETHREADS = 24;
-
- // BASS_SetConfigPtr options
- BASS_CONFIG_NET_AGENT = 16;
- BASS_CONFIG_NET_PROXY = 17;
-
- // Initialization flags
- BASS_DEVICE_8BITS = 1; // use 8 bit resolution, else 16 bit
- BASS_DEVICE_MONO = 2; // use mono, else stereo
- BASS_DEVICE_3D = 4; // enable 3D functionality
- BASS_DEVICE_LATENCY = 256; // calculate device latency (BASS_INFO struct)
- BASS_DEVICE_CPSPEAKERS = 1024; // detect speakers via Windows control panel
- BASS_DEVICE_SPEAKERS = 2048; // force enabling of speaker assignment
- BASS_DEVICE_NOSPEAKER = 4096; // ignore speaker arrangement
-
- // DirectSound interfaces (for use with BASS_GetDSoundObject)
- BASS_OBJECT_DS = 1; // IDirectSound
- BASS_OBJECT_DS3DL = 2; // IDirectSound3DListener
-
- // BASS_DEVICEINFO flags
- BASS_DEVICE_ENABLED = 1;
- BASS_DEVICE_DEFAULT = 2;
- BASS_DEVICE_INIT = 4;
-
- // BASS_INFO flags (from DSOUND.H)
- DSCAPS_CONTINUOUSRATE = $00000010; // supports all sample rates between min/maxrate
- DSCAPS_EMULDRIVER = $00000020; // device does NOT have hardware DirectSound support
- DSCAPS_CERTIFIED = $00000040; // device driver has been certified by Microsoft
- DSCAPS_SECONDARYMONO = $00000100; // mono
- DSCAPS_SECONDARYSTEREO = $00000200; // stereo
- DSCAPS_SECONDARY8BIT = $00000400; // 8 bit
- DSCAPS_SECONDARY16BIT = $00000800; // 16 bit
-
- // BASS_RECORDINFO flags (from DSOUND.H)
- DSCCAPS_EMULDRIVER = DSCAPS_EMULDRIVER; // device does NOT have hardware DirectSound recording support
- DSCCAPS_CERTIFIED = DSCAPS_CERTIFIED; // device driver has been certified by Microsoft
-
- // defines for formats field of BASS_RECORDINFO (from MMSYSTEM.H)
- WAVE_FORMAT_1M08 = $00000001; // 11.025 kHz, Mono, 8-bit
- WAVE_FORMAT_1S08 = $00000002; // 11.025 kHz, Stereo, 8-bit
- WAVE_FORMAT_1M16 = $00000004; // 11.025 kHz, Mono, 16-bit
- WAVE_FORMAT_1S16 = $00000008; // 11.025 kHz, Stereo, 16-bit
- WAVE_FORMAT_2M08 = $00000010; // 22.05 kHz, Mono, 8-bit
- WAVE_FORMAT_2S08 = $00000020; // 22.05 kHz, Stereo, 8-bit
- WAVE_FORMAT_2M16 = $00000040; // 22.05 kHz, Mono, 16-bit
- WAVE_FORMAT_2S16 = $00000080; // 22.05 kHz, Stereo, 16-bit
- WAVE_FORMAT_4M08 = $00000100; // 44.1 kHz, Mono, 8-bit
- WAVE_FORMAT_4S08 = $00000200; // 44.1 kHz, Stereo, 8-bit
- WAVE_FORMAT_4M16 = $00000400; // 44.1 kHz, Mono, 16-bit
- WAVE_FORMAT_4S16 = $00000800; // 44.1 kHz, Stereo, 16-bit
-
- BASS_SAMPLE_8BITS = 1; // 8 bit
- BASS_SAMPLE_FLOAT = 256; // 32-bit floating-point
- BASS_SAMPLE_MONO = 2; // mono
- BASS_SAMPLE_LOOP = 4; // looped
- BASS_SAMPLE_3D = 8; // 3D functionality
- BASS_SAMPLE_SOFTWARE = 16; // not using hardware mixing
- BASS_SAMPLE_MUTEMAX = 32; // mute at max distance (3D only)
- BASS_SAMPLE_VAM = 64; // DX7 voice allocation & management
- BASS_SAMPLE_FX = 128; // old implementation of DX8 effects
- BASS_SAMPLE_OVER_VOL = $10000; // override lowest volume
- BASS_SAMPLE_OVER_POS = $20000; // override longest playing
- BASS_SAMPLE_OVER_DIST = $30000; // override furthest from listener (3D only)
-
- BASS_STREAM_PRESCAN = $20000; // enable pin-point seeking/length (MP3/MP2/MP1)
- BASS_MP3_SETPOS = BASS_STREAM_PRESCAN;
- BASS_STREAM_AUTOFREE = $40000; // automatically free the stream when it stop/ends
- BASS_STREAM_RESTRATE = $80000; // restrict the download rate of internet file streams
- BASS_STREAM_BLOCK = $100000;// download/play internet file stream in small blocks
- BASS_STREAM_DECODE = $200000;// don't play the stream, only decode (BASS_ChannelGetData)
- BASS_STREAM_STATUS = $800000;// give server status info (HTTP/ICY tags) in DOWNLOADPROC
-
- BASS_MUSIC_FLOAT = BASS_SAMPLE_FLOAT;
- BASS_MUSIC_MONO = BASS_SAMPLE_MONO;
- BASS_MUSIC_LOOP = BASS_SAMPLE_LOOP;
- BASS_MUSIC_3D = BASS_SAMPLE_3D;
- BASS_MUSIC_FX = BASS_SAMPLE_FX;
- BASS_MUSIC_AUTOFREE = BASS_STREAM_AUTOFREE;
- BASS_MUSIC_DECODE = BASS_STREAM_DECODE;
- BASS_MUSIC_PRESCAN = BASS_STREAM_PRESCAN; // calculate playback length
- BASS_MUSIC_CALCLEN = BASS_MUSIC_PRESCAN;
- BASS_MUSIC_RAMP = $200; // normal ramping
- BASS_MUSIC_RAMPS = $400; // sensitive ramping
- BASS_MUSIC_SURROUND = $800; // surround sound
- BASS_MUSIC_SURROUND2 = $1000; // surround sound (mode 2)
- BASS_MUSIC_FT2MOD = $2000; // play .MOD as FastTracker 2 does
- BASS_MUSIC_PT1MOD = $4000; // play .MOD as ProTracker 1 does
- BASS_MUSIC_NONINTER = $10000; // non-interpolated sample mixing
- BASS_MUSIC_SINCINTER = $800000; // sinc interpolated sample mixing
- BASS_MUSIC_POSRESET = $8000; // stop all notes when moving position
- BASS_MUSIC_POSRESETEX = $400000; // stop all notes and reset bmp/etc when moving position
- BASS_MUSIC_STOPBACK = $80000; // stop the music on a backwards jump effect
- BASS_MUSIC_NOSAMPLE = $100000; // don't load the samples
-
- // Speaker assignment flags
- BASS_SPEAKER_FRONT = $1000000; // front speakers
- BASS_SPEAKER_REAR = $2000000; // rear/side speakers
- BASS_SPEAKER_CENLFE = $3000000; // center & LFE speakers (5.1)
- BASS_SPEAKER_REAR2 = $4000000; // rear center speakers (7.1)
- BASS_SPEAKER_LEFT = $10000000; // modifier: left
- BASS_SPEAKER_RIGHT = $20000000; // modifier: right
- BASS_SPEAKER_FRONTLEFT = BASS_SPEAKER_FRONT or BASS_SPEAKER_LEFT;
- BASS_SPEAKER_FRONTRIGHT = BASS_SPEAKER_FRONT or BASS_SPEAKER_RIGHT;
- BASS_SPEAKER_REARLEFT = BASS_SPEAKER_REAR or BASS_SPEAKER_LEFT;
- BASS_SPEAKER_REARRIGHT = BASS_SPEAKER_REAR or BASS_SPEAKER_RIGHT;
- BASS_SPEAKER_CENTER = BASS_SPEAKER_CENLFE or BASS_SPEAKER_LEFT;
- BASS_SPEAKER_LFE = BASS_SPEAKER_CENLFE or BASS_SPEAKER_RIGHT;
- BASS_SPEAKER_REAR2LEFT = BASS_SPEAKER_REAR2 or BASS_SPEAKER_LEFT;
- BASS_SPEAKER_REAR2RIGHT = BASS_SPEAKER_REAR2 or BASS_SPEAKER_RIGHT;
-
- BASS_UNICODE = $80000000;
-
- BASS_RECORD_PAUSE = $8000; // start recording paused
-
- // DX7 voice allocation & management flags
- BASS_VAM_HARDWARE = 1;
- BASS_VAM_SOFTWARE = 2;
- BASS_VAM_TERM_TIME = 4;
- BASS_VAM_TERM_DIST = 8;
- BASS_VAM_TERM_PRIO = 16;
-
- // BASS_CHANNELINFO types
- BASS_CTYPE_SAMPLE = 1;
- BASS_CTYPE_RECORD = 2;
- BASS_CTYPE_STREAM = $10000;
- BASS_CTYPE_STREAM_OGG = $10002;
- BASS_CTYPE_STREAM_MP1 = $10003;
- BASS_CTYPE_STREAM_MP2 = $10004;
- BASS_CTYPE_STREAM_MP3 = $10005;
- BASS_CTYPE_STREAM_AIFF = $10006;
- BASS_CTYPE_STREAM_WAV = $40000; // WAVE flag, LOWORD=codec
- BASS_CTYPE_STREAM_WAV_PCM = $50001;
- BASS_CTYPE_STREAM_WAV_FLOAT = $50003;
- BASS_CTYPE_MUSIC_MOD = $20000;
- BASS_CTYPE_MUSIC_MTM = $20001;
- BASS_CTYPE_MUSIC_S3M = $20002;
- BASS_CTYPE_MUSIC_XM = $20003;
- BASS_CTYPE_MUSIC_IT = $20004;
- BASS_CTYPE_MUSIC_MO3 = $00100; // MO3 flag
-
- // 3D channel modes
- BASS_3DMODE_NORMAL = 0; // normal 3D processing
- BASS_3DMODE_RELATIVE = 1; // position is relative to the listener
- BASS_3DMODE_OFF = 2; // no 3D processing
-
- // software 3D mixing algorithms (used with BASS_CONFIG_3DALGORITHM)
- BASS_3DALG_DEFAULT = 0;
- BASS_3DALG_OFF = 1;
- BASS_3DALG_FULL = 2;
- BASS_3DALG_LIGHT = 3;
-
-{$IFDEF MSWINDOWS}
- // EAX environments, use with BASS_SetEAXParameters
- EAX_ENVIRONMENT_GENERIC = 0;
- EAX_ENVIRONMENT_PADDEDCELL = 1;
- EAX_ENVIRONMENT_ROOM = 2;
- EAX_ENVIRONMENT_BATHROOM = 3;
- EAX_ENVIRONMENT_LIVINGROOM = 4;
- EAX_ENVIRONMENT_STONEROOM = 5;
- EAX_ENVIRONMENT_AUDITORIUM = 6;
- EAX_ENVIRONMENT_CONCERTHALL = 7;
- EAX_ENVIRONMENT_CAVE = 8;
- EAX_ENVIRONMENT_ARENA = 9;
- EAX_ENVIRONMENT_HANGAR = 10;
- EAX_ENVIRONMENT_CARPETEDHALLWAY = 11;
- EAX_ENVIRONMENT_HALLWAY = 12;
- EAX_ENVIRONMENT_STONECORRIDOR = 13;
- EAX_ENVIRONMENT_ALLEY = 14;
- EAX_ENVIRONMENT_FOREST = 15;
- EAX_ENVIRONMENT_CITY = 16;
- EAX_ENVIRONMENT_MOUNTAINS = 17;
- EAX_ENVIRONMENT_QUARRY = 18;
- EAX_ENVIRONMENT_PLAIN = 19;
- EAX_ENVIRONMENT_PARKINGLOT = 20;
- EAX_ENVIRONMENT_SEWERPIPE = 21;
- EAX_ENVIRONMENT_UNDERWATER = 22;
- EAX_ENVIRONMENT_DRUGGED = 23;
- EAX_ENVIRONMENT_DIZZY = 24;
- EAX_ENVIRONMENT_PSYCHOTIC = 25;
- // total number of environments
- EAX_ENVIRONMENT_COUNT = 26;
-{$ENDIF}
-
- BASS_STREAMPROC_END = $80000000; // end of user stream flag
-
-
- // BASS_StreamCreateFileUser file systems
- STREAMFILE_NOBUFFER = 0;
- STREAMFILE_BUFFER = 1;
- STREAMFILE_BUFFERPUSH = 2;
-
- // BASS_StreamPutFileData options
- BASS_FILEDATA_END = 0; // end & close the file
-
- // BASS_StreamGetFilePosition modes
- BASS_FILEPOS_CURRENT = 0;
- BASS_FILEPOS_DECODE = BASS_FILEPOS_CURRENT;
- BASS_FILEPOS_DOWNLOAD = 1;
- BASS_FILEPOS_END = 2;
- BASS_FILEPOS_START = 3;
- BASS_FILEPOS_CONNECTED = 4;
- BASS_FILEPOS_BUFFER = 5;
-
- // BASS_ChannelSetSync types
- BASS_SYNC_POS = 0;
- BASS_SYNC_END = 2;
- BASS_SYNC_META = 4;
- BASS_SYNC_SLIDE = 5;
- BASS_SYNC_STALL = 6;
- BASS_SYNC_DOWNLOAD = 7;
- BASS_SYNC_FREE = 8;
- BASS_SYNC_SETPOS = 11;
- BASS_SYNC_MUSICPOS = 10;
- BASS_SYNC_MUSICINST = 1;
- BASS_SYNC_MUSICFX = 3;
- BASS_SYNC_OGG_CHANGE = 12;
- BASS_SYNC_MIXTIME = $40000000; // FLAG: sync at mixtime, else at playtime
- BASS_SYNC_ONETIME = $80000000; // FLAG: sync only once, else continuously
-
- // BASS_ChannelIsActive return values
- BASS_ACTIVE_STOPPED = 0;
- BASS_ACTIVE_PLAYING = 1;
- BASS_ACTIVE_STALLED = 2;
- BASS_ACTIVE_PAUSED = 3;
-
- // Channel attributes
- BASS_ATTRIB_FREQ = 1;
- BASS_ATTRIB_VOL = 2;
- BASS_ATTRIB_PAN = 3;
- BASS_ATTRIB_EAXMIX = 4;
- BASS_ATTRIB_MUSIC_AMPLIFY = $100;
- BASS_ATTRIB_MUSIC_PANSEP = $101;
- BASS_ATTRIB_MUSIC_PSCALER = $102;
- BASS_ATTRIB_MUSIC_BPM = $103;
- BASS_ATTRIB_MUSIC_SPEED = $104;
- BASS_ATTRIB_MUSIC_VOL_GLOBAL = $105;
- BASS_ATTRIB_MUSIC_VOL_CHAN = $200; // + channel #
- BASS_ATTRIB_MUSIC_VOL_INST = $300; // + instrument #
-
- // BASS_ChannelGetData flags
- BASS_DATA_AVAILABLE = 0; // query how much data is buffered
- BASS_DATA_FLOAT = $40000000; // flag: return floating-point sample data
- BASS_DATA_FFT256 = $80000000; // 256 sample FFT
- BASS_DATA_FFT512 = $80000001; // 512 FFT
- BASS_DATA_FFT1024 = $80000002; // 1024 FFT
- BASS_DATA_FFT2048 = $80000003; // 2048 FFT
- BASS_DATA_FFT4096 = $80000004; // 4096 FFT
- BASS_DATA_FFT8192 = $80000005; // 8192 FFT
- BASS_DATA_FFT_INDIVIDUAL = $10; // FFT flag: FFT for each channel, else all combined
- BASS_DATA_FFT_NOWINDOW = $20; // FFT flag: no Hanning window
-
- // BASS_ChannelGetTags types : what's returned
- BASS_TAG_ID3 = 0; // ID3v1 tags : TAG_ID3 structure
- BASS_TAG_ID3V2 = 1; // ID3v2 tags : variable length block
- BASS_TAG_OGG = 2; // OGG comments : series of null-terminated UTF-8 strings
- BASS_TAG_HTTP = 3; // HTTP headers : series of null-terminated ANSI strings
- BASS_TAG_ICY = 4; // ICY headers : series of null-terminated ANSI strings
- BASS_TAG_META = 5; // ICY metadata : ANSI string
- BASS_TAG_VENDOR = 9; // OGG encoder : UTF-8 string
- BASS_TAG_LYRICS3 = 10; // Lyric3v2 tag : ASCII string
- BASS_TAG_RIFF_INFO = $100; // RIFF "INFO" tags : series of null-terminated ANSI strings
- BASS_TAG_RIFF_BEXT = $101; // RIFF/BWF Broadcast Audio Extension tags : TAG_BEXT structure
- BASS_TAG_MUSIC_NAME = $10000; // MOD music name : ANSI string
- BASS_TAG_MUSIC_MESSAGE = $10001; // MOD message : ANSI string
- BASS_TAG_MUSIC_INST = $10100; // + instrument #, MOD instrument name : ANSI string
- BASS_TAG_MUSIC_SAMPLE = $10300; // + sample #, MOD sample name : ANSI string
-
- // BASS_ChannelGetLength/GetPosition/SetPosition modes
- BASS_POS_BYTE = 0; // byte position
- BASS_POS_MUSIC_ORDER = 1; // order.row position, MAKELONG(order,row)
-
- // BASS_RecordSetInput flags
- BASS_INPUT_OFF = $10000;
- BASS_INPUT_ON = $20000;
-
- BASS_INPUT_TYPE_MASK = $FF000000;
- BASS_INPUT_TYPE_UNDEF = $00000000;
- BASS_INPUT_TYPE_DIGITAL = $01000000;
- BASS_INPUT_TYPE_LINE = $02000000;
- BASS_INPUT_TYPE_MIC = $03000000;
- BASS_INPUT_TYPE_SYNTH = $04000000;
- BASS_INPUT_TYPE_CD = $05000000;
- BASS_INPUT_TYPE_PHONE = $06000000;
- BASS_INPUT_TYPE_SPEAKER = $07000000;
- BASS_INPUT_TYPE_WAVE = $08000000;
- BASS_INPUT_TYPE_AUX = $09000000;
- BASS_INPUT_TYPE_ANALOG = $0A000000;
-
- BASS_FX_DX8_CHORUS = 0;
- BASS_FX_DX8_COMPRESSOR = 1;
- BASS_FX_DX8_DISTORTION = 2;
- BASS_FX_DX8_ECHO = 3;
- BASS_FX_DX8_FLANGER = 4;
- BASS_FX_DX8_GARGLE = 5;
- BASS_FX_DX8_I3DL2REVERB = 6;
- BASS_FX_DX8_PARAMEQ = 7;
- BASS_FX_DX8_REVERB = 8;
-
- BASS_DX8_PHASE_NEG_180 = 0;
- BASS_DX8_PHASE_NEG_90 = 1;
- BASS_DX8_PHASE_ZERO = 2;
- BASS_DX8_PHASE_90 = 3;
- BASS_DX8_PHASE_180 = 4;
-
-type
- DWORD = cardinal;
- BOOL = LongBool;
- FLOAT = Single;
- QWORD = int64; // 64-bit (replace "int64" with "comp" if using Delphi 3)
-
- HMUSIC = DWORD; // MOD music handle
- HSAMPLE = DWORD; // sample handle
- HCHANNEL = DWORD; // playing sample's channel handle
- HSTREAM = DWORD; // sample stream handle
- HRECORD = DWORD; // recording handle
- HSYNC = DWORD; // synchronizer handle
- HDSP = DWORD; // DSP handle
- HFX = DWORD; // DX8 effect handle
- HPLUGIN = DWORD; // Plugin handle
-
- // Device info structure
- BASS_DEVICEINFO = record
- name: PAnsiChar; // description
- driver: PAnsiChar; // driver
- flags: DWORD;
- end;
-
- BASS_INFO = record
- flags: DWORD; // device capabilities (DSCAPS_xxx flags)
- hwsize: DWORD; // size of total device hardware memory
- hwfree: DWORD; // size of free device hardware memory
- freesam: DWORD; // number of free sample slots in the hardware
- free3d: DWORD; // number of free 3D sample slots in the hardware
- minrate: DWORD; // min sample rate supported by the hardware
- maxrate: DWORD; // max sample rate supported by the hardware
- eax: BOOL; // device supports EAX? (always FALSE if BASS_DEVICE_3D was not used)
- minbuf: DWORD; // recommended minimum buffer length in ms (requires BASS_DEVICE_LATENCY)
- dsver: DWORD; // DirectSound version
- latency: DWORD; // delay (in ms) before start of playback (requires BASS_DEVICE_LATENCY)
- initflags: DWORD; // BASS_Init "flags" parameter
- speakers: DWORD; // number of speakers available
- freq: DWORD; // current output rate (OSX only)
- end;
-
- // Recording device info structure
- BASS_RECORDINFO = record
- flags: DWORD; // device capabilities (DSCCAPS_xxx flags)
- formats: DWORD; // supported standard formats (WAVE_FORMAT_xxx flags)
- inputs: DWORD; // number of inputs
- singlein: BOOL; // only 1 input can be set at a time
- {$IFNDEF BASS_242}
- driver: PChar; // driver
- {$ENDIF}
- freq: DWORD; // current input rate (OSX only)
- end;
-
- // Sample info structure
- BASS_SAMPLE = record
- freq: DWORD; // default playback rate
- volume: FLOAT; // default volume (0-100)
- pan: FLOAT; // default pan (-100=left, 0=middle, 100=right)
- flags: DWORD; // BASS_SAMPLE_xxx flags
- length: DWORD; // length (in samples, not bytes)
- max: DWORD; // maximum simultaneous playbacks
- origres: DWORD; // original resolution
- chans: DWORD; // number of channels
- mingap: DWORD; // minimum gap (ms) between creating channels
- mode3d: DWORD; // BASS_3DMODE_xxx mode
- mindist: FLOAT; // minimum distance
- maxdist: FLOAT; // maximum distance
- iangle: DWORD; // angle of inside projection cone
- oangle: DWORD; // angle of outside projection cone
- outvol: FLOAT; // delta-volume outside the projection cone
- vam: DWORD; // voice allocation/management flags (BASS_VAM_xxx)
- priority: DWORD; // priority (0=lowest, $ffffffff=highest)
- end;
-
- // Channel info structure
- BASS_CHANNELINFO = record
- freq: DWORD; // default playback rate
- chans: DWORD; // channels
- flags: DWORD; // BASS_SAMPLE/STREAM/MUSIC/SPEAKER flags
- ctype: DWORD; // type of channel
- origres: DWORD; // original resolution
- plugin: HPLUGIN; // plugin
- sample: HSAMPLE; // sample
- filename: PAnsiChar; // filename
- end;
-
- BASS_PLUGINFORM = record
- ctype: DWORD; // channel type
- name: PAnsiChar; // format description
- exts: PAnsiChar; // file extension filter (*.ext1;*.ext2;etc...)
- end;
- PBASS_PLUGINFORMS = ^TBASS_PLUGINFORMS;
- TBASS_PLUGINFORMS = array[0..maxInt div sizeOf(BASS_PLUGINFORM) - 1] of BASS_PLUGINFORM;
-
- BASS_PLUGININFO = record
- version: DWORD; // version (same form as BASS_GetVersion)
- formatc: DWORD; // number of formats
- formats: PBASS_PLUGINFORMS; // the array of formats
- end;
- PBASS_PLUGININFO = ^BASS_PLUGININFO;
-
- // 3D vector (for 3D positions/velocities/orientations)
- BASS_3DVECTOR = record
- x: FLOAT; // +=right, -=left
- y: FLOAT; // +=up, -=down
- z: FLOAT; // +=front, -=behind
- end;
-
- // User file stream callback functions
- FILECLOSEPROC = procedure(user: Pointer); {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF}
- FILELENPROC = function(user: Pointer): QWORD; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF}
- FILEREADPROC = function(buffer: Pointer; length: DWORD; user: Pointer): DWORD; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF}
- FILESEEKPROC = function(offset: QWORD; user: Pointer): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF}
-
- BASS_FILEPROCS = record
- close: FILECLOSEPROC;
- length: FILELENPROC;
- read: FILEREADPROC;
- seek: FILESEEKPROC;
- end;
-
- // ID3v1 tag structure
- TAG_ID3 = record
- id: Array[0..2] of AnsiChar;
- title: Array[0..29] of AnsiChar;
- artist: Array[0..29] of AnsiChar;
- album: Array[0..29] of AnsiChar;
- year: Array[0..3] of AnsiChar;
- comment: Array[0..29] of AnsiChar;
- genre: Byte;
- end;
-
- // BWF Broadcast Audio Extension tag structure
- TAG_BEXT = record
- Description: Array[0..255] of AnsiChar; // description
- Originator: Array[0..31] of AnsiChar; // name of the originator
- OriginatorReference: Array[0..31] of AnsiChar; // reference of the originator
- OriginationDate: Array[0..9] of AnsiChar; // date of creation (yyyy-mm-dd)
- OriginationTime: Array[0..7] of AnsiChar; // time of creation (hh-mm-ss)
- TimeReference: QWORD; // first sample count since midnight (little-endian)
- Version: Word; // BWF version (little-endian)
- UMID: Array[0..63] of Byte; // SMPTE UMID
- Reserved: Array[0..189] of Byte;
- CodingHistory: Array of AnsiChar; // history
- end;
-
- BASS_DX8_CHORUS = record
- fWetDryMix: FLOAT;
- fDepth: FLOAT;
- fFeedback: FLOAT;
- fFrequency: FLOAT;
- lWaveform: DWORD; // 0=triangle, 1=sine
- fDelay: FLOAT;
- lPhase: DWORD; // BASS_DX8_PHASE_xxx
- end;
-
- BASS_DX8_COMPRESSOR = record
- fGain: FLOAT;
- fAttack: FLOAT;
- fRelease: FLOAT;
- fThreshold: FLOAT;
- fRatio: FLOAT;
- fPredelay: FLOAT;
- end;
-
- BASS_DX8_DISTORTION = record
- fGain: FLOAT;
- fEdge: FLOAT;
- fPostEQCenterFrequency: FLOAT;
- fPostEQBandwidth: FLOAT;
- fPreLowpassCutoff: FLOAT;
- end;
-
- BASS_DX8_ECHO = record
- fWetDryMix: FLOAT;
- fFeedback: FLOAT;
- fLeftDelay: FLOAT;
- fRightDelay: FLOAT;
- lPanDelay: BOOL;
- end;
-
- BASS_DX8_FLANGER = record
- fWetDryMix: FLOAT;
- fDepth: FLOAT;
- fFeedback: FLOAT;
- fFrequency: FLOAT;
- lWaveform: DWORD; // 0=triangle, 1=sine
- fDelay: FLOAT;
- lPhase: DWORD; // BASS_DX8_PHASE_xxx
- end;
-
- BASS_DX8_GARGLE = record
- dwRateHz: DWORD; // Rate of modulation in hz
- dwWaveShape: DWORD; // 0=triangle, 1=square
- end;
-
- BASS_DX8_I3DL2REVERB = record
- lRoom: Longint; // [-10000, 0] default: -1000 mB
- lRoomHF: Longint; // [-10000, 0] default: 0 mB
- flRoomRolloffFactor: FLOAT; // [0.0, 10.0] default: 0.0
- flDecayTime: FLOAT; // [0.1, 20.0] default: 1.49s
- flDecayHFRatio: FLOAT; // [0.1, 2.0] default: 0.83
- lReflections: Longint; // [-10000, 1000] default: -2602 mB
- flReflectionsDelay: FLOAT; // [0.0, 0.3] default: 0.007 s
- lReverb: Longint; // [-10000, 2000] default: 200 mB
- flReverbDelay: FLOAT; // [0.0, 0.1] default: 0.011 s
- flDiffusion: FLOAT; // [0.0, 100.0] default: 100.0 %
- flDensity: FLOAT; // [0.0, 100.0] default: 100.0 %
- flHFReference: FLOAT; // [20.0, 20000.0] default: 5000.0 Hz
- end;
-
- BASS_DX8_PARAMEQ = record
- fCenter: FLOAT;
- fBandwidth: FLOAT;
- fGain: FLOAT;
- end;
-
- BASS_DX8_REVERB = record
- fInGain: FLOAT; // [-96.0,0.0] default: 0.0 dB
- fReverbMix: FLOAT; // [-96.0,0.0] default: 0.0 db
- fReverbTime: FLOAT; // [0.001,3000.0] default: 1000.0 ms
- fHighFreqRTRatio: FLOAT; // [0.001,0.999] default: 0.001
- end;
-
- // callback function types
- STREAMPROC = function(handle: HSTREAM; buffer: Pointer; length: DWORD; user: Pointer): DWORD; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF}
- {
- User stream callback function. NOTE: A stream function should obviously be as
- quick as possible, other streams (and MOD musics) can't be mixed until
- it's finished.
- handle : The stream that needs writing
- buffer : Buffer to write the samples in
- length : Number of bytes to write
- user : The 'user' parameter value given when calling BASS_StreamCreate
- RETURN : Number of bytes written. Set the BASS_STREAMPROC_END flag to end
- the stream.
- }
-
-const
- // special STREAMPROCs
- STREAMPROC_DUMMY {: STREAMPROC} = Pointer(0); // "dummy" stream
- STREAMPROC_PUSH {: STREAMPROC} = Pointer(-1); // push stream
-
-type
-
- DOWNLOADPROC = procedure(buffer: Pointer; length: DWORD; user: Pointer); {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF}
- {
- Internet stream download callback function.
- buffer : Buffer containing the downloaded data... NULL=end of download
- length : Number of bytes in the buffer
- user : The 'user' parameter value given when calling BASS_StreamCreateURL
- }
-
- SYNCPROC = procedure(handle: HSYNC; channel, data: DWORD; user: Pointer); {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF}
- {
- Sync callback function. NOTE: a sync callback function should be very
- quick as other syncs cannot be processed until it has finished. If the
- sync is a "mixtime" sync, then other streams and MOD musics can not be
- mixed until it's finished either.
- handle : The sync that has occured
- channel: Channel that the sync occured in
- data : Additional data associated with the sync's occurance
- user : The 'user' parameter given when calling BASS_ChannelSetSync
- }
-
- DSPPROC = procedure(handle: HDSP; channel: DWORD; buffer: Pointer; length: DWORD; user: Pointer); {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF}
- {
- DSP callback function. NOTE: A DSP function should obviously be as quick
- as possible... other DSP functions, streams and MOD musics can not be
- processed until it's finished.
- handle : The DSP handle
- channel: Channel that the DSP is being applied to
- buffer : Buffer to apply the DSP to
- length : Number of bytes in the buffer
- user : The 'user' parameter given when calling BASS_ChannelSetDSP
- }
-
- RECORDPROC = function(handle: HRECORD; buffer: Pointer; length: DWORD; user: Pointer): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF}
- {
- Recording callback function.
- handle : The recording handle
- buffer : Buffer containing the recorded sample data
- length : Number of bytes
- user : The 'user' parameter value given when calling BASS_RecordStart
- RETURN : TRUE = continue recording, FALSE = stop
- }
-
-
-// Functions
-const
-{$IFDEF MSWINDOWS}
- bassdll = 'bass.dll';
-{$ENDIF}
-{$IFDEF DARWIN}
- bassdll = 'libbass.dylib';
- {$linklib libbass}
-{$ENDIF}
-
-function BASS_SetConfig(option, value: DWORD): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_GetConfig(option: DWORD): DWORD; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_SetConfigPtr(option: DWORD; value: Pointer): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_GetConfigPtr(option: DWORD): Pointer; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_GetVersion: DWORD; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ErrorGetCode: Integer; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_GetDeviceInfo(device: DWORD; var info: BASS_DEVICEINFO): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-{$IFDEF MSWINDOWS}
-function BASS_Init(device: Integer; freq, flags: DWORD; win: HWND; clsid: PGUID): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-{$ELSE}
-function BASS_Init(device: Integer; freq, flags: DWORD; win: Pointer; clsid: Pointer): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-{$ENDIF}
-function BASS_SetDevice(device: DWORD): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_GetDevice: DWORD; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_Free: BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-{$IFDEF MSWINDOWS}
-function BASS_GetDSoundObject(obj: DWORD): Pointer; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-{$ENDIF}
-function BASS_GetInfo(var info: BASS_INFO): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_Update(length: DWORD): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_GetCPU: FLOAT; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_Start: BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_Stop: BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_Pause: BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_SetVolume(volume: FLOAT): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_GetVolume: FLOAT; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-
-function BASS_PluginLoad(filename: PAnsiChar; flags: DWORD): HPLUGIN; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_PluginFree(handle: HPLUGIN): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_PluginGetInfo(handle: HPLUGIN): PBASS_PLUGININFO; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-
-function BASS_Set3DFactors(distf, rollf, doppf: FLOAT): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_Get3DFactors(var distf, rollf, doppf: FLOAT): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_Set3DPosition(var pos, vel, front, top: BASS_3DVECTOR): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_Get3DPosition(var pos, vel, front, top: BASS_3DVECTOR): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-procedure BASS_Apply3D; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-{$IFDEF MSWINDOWS}
-function BASS_SetEAXParameters(env: Integer; vol, decay, damp: FLOAT): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_GetEAXParameters(var env: DWORD; var vol, decay, damp: FLOAT): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-{$ENDIF}
-
-function BASS_MusicLoad(mem: BOOL; f: Pointer; offset: QWORD; length, flags, freq: DWORD): HMUSIC; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_MusicFree(handle: HMUSIC): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-
-function BASS_SampleLoad(mem: BOOL; f: Pointer; offset: QWORD; length, max, flags: DWORD): HSAMPLE; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_SampleCreate(length, freq, chans, max, flags: DWORD): HSAMPLE; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_SampleFree(handle: HSAMPLE): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_SampleSetData(handle: HSAMPLE; buffer: Pointer): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_SampleGetData(handle: HSAMPLE; buffer: Pointer): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_SampleGetInfo(handle: HSAMPLE; var info: BASS_SAMPLE): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_SampleSetInfo(handle: HSAMPLE; var info: BASS_SAMPLE): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_SampleGetChannel(handle: HSAMPLE; onlynew: BOOL): HCHANNEL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_SampleGetChannels(handle: HSAMPLE; channels: Pointer): DWORD; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_SampleStop(handle: HSAMPLE): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-
-function BASS_StreamCreate(freq, chans, flags: DWORD; proc: STREAMPROC; user: Pointer): HSTREAM; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_StreamCreateFile(mem: BOOL; f: Pointer; offset, length: QWORD; flags: DWORD): HSTREAM; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_StreamCreateURL(url: PAnsiChar; offset: DWORD; flags: DWORD; proc: DOWNLOADPROC; user: Pointer):HSTREAM; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_StreamCreateFileUser(system, flags: DWORD; var procs: BASS_FILEPROCS; user: Pointer): HSTREAM; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_StreamFree(handle: HSTREAM): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_StreamGetFilePosition(handle: HSTREAM; mode: DWORD): QWORD; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_StreamPutData(handle: HSTREAM; buffer: Pointer; length: DWORD): DWORD; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_StreamPutFileData(handle: HSTREAM; buffer: Pointer; length: DWORD): DWORD; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-
-function BASS_RecordGetDeviceInfo(device: DWORD; var info: BASS_DEVICEINFO): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_RecordInit(device: Integer):BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_RecordSetDevice(device: DWORD): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_RecordGetDevice: DWORD; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_RecordFree: BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_RecordGetInfo(var info: BASS_RECORDINFO): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_RecordGetInputName(input: Integer): PAnsiChar; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_RecordSetInput(input: Integer; flags: DWORD; volume: FLOAT): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_RecordGetInput(input: Integer; var volume: FLOAT): DWORD; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_RecordStart(freq, chans, flags: DWORD; proc: RECORDPROC; user: Pointer): HRECORD; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-
-function BASS_ChannelBytes2Seconds(handle: DWORD; pos: QWORD): Double; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF}external bassdll;
-function BASS_ChannelSeconds2Bytes(handle: DWORD; pos: Double): QWORD; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF}external bassdll;
-function BASS_ChannelGetDevice(handle: DWORD): DWORD; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelSetDevice(handle, device: DWORD): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelIsActive(handle: DWORD): DWORD; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF}external bassdll;
-function BASS_ChannelGetInfo(handle: DWORD; var info: BASS_CHANNELINFO):BOOL;{$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF}external bassdll;
-function BASS_ChannelGetTags(handle: HSTREAM; tags: DWORD): PAnsiChar; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelFlags(handle, flags, mask: DWORD): DWORD; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelUpdate(handle, length: DWORD): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelLock(handle: DWORD; lock: BOOL): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelPlay(handle: DWORD; restart: BOOL): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelStop(handle: DWORD): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelPause(handle: DWORD): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelSetAttribute(handle, attrib: DWORD; value: FLOAT): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelGetAttribute(handle, attrib: DWORD; var value: FLOAT): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelSlideAttribute(handle, attrib: DWORD; value: FLOAT; time: DWORD): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelIsSliding(handle, attrib: DWORD): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF}external bassdll;
-function BASS_ChannelSet3DAttributes(handle: DWORD; mode: Integer; min, max: FLOAT; iangle, oangle, outvol: Integer): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelGet3DAttributes(handle: DWORD; var mode: DWORD; var min, max: FLOAT; var iangle, oangle, outvol: DWORD): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelSet3DPosition(handle: DWORD; var pos, orient, vel: BASS_3DVECTOR): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelGet3DPosition(handle: DWORD; var pos, orient, vel: BASS_3DVECTOR): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelGetLength(handle, mode: DWORD): QWORD; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelSetPosition(handle: DWORD; pos: QWORD; mode: DWORD): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelGetPosition(handle, mode: DWORD): QWORD; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelGetLevel(handle: DWORD): DWORD; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelGetData(handle: DWORD; buffer: Pointer; length: DWORD): DWORD; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelSetSync(handle: DWORD; type_: DWORD; param: QWORD; proc: SYNCPROC; user: Pointer): HSYNC; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelRemoveSync(handle: DWORD; sync: HSYNC): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelSetDSP(handle: DWORD; proc: DSPPROC; user: Pointer; priority: Integer): HDSP; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelRemoveDSP(handle: DWORD; dsp: HDSP): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelSetLink(handle, chan: DWORD): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelRemoveLink(handle, chan: DWORD): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelSetFX(handle, type_: DWORD; priority: Integer): HFX; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_ChannelRemoveFX(handle: DWORD; fx: HFX): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-
-function BASS_FXSetParameters(handle: HFX; par: Pointer): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_FXGetParameters(handle: HFX; par: Pointer): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-function BASS_FXReset(handle: HFX): BOOL; {$IFDEF DLL_STDCALL}stdcall;{$ENDIF}{$IFDEF DLL_CDECL}cdecl;{$ENDIF} external bassdll;
-
-
-function BASS_SPEAKER_N(n: DWORD): DWORD;
-{$IFDEF MSWINDOWS}
-function BASS_SetEAXPreset(env: Integer): BOOL;
-{
- This function is defined in the implementation part of this unit.
- It is not part of BASS.DLL but an extra function which makes it easier
- to set the predefined EAX environments.
- env : a EAX_ENVIRONMENT_xxx constant
-}
-{$ENDIF}
-
-implementation
-
-function BASS_SPEAKER_N(n: DWORD): DWORD;
-begin
- Result := n shl 24;
-end;
-
-{$IFDEF MSWINDOWS}
-function BASS_SetEAXPreset(env: Integer): BOOL;
-begin
- case (env) of
- EAX_ENVIRONMENT_GENERIC:
- Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_GENERIC, 0.5, 1.493, 0.5);
- EAX_ENVIRONMENT_PADDEDCELL:
- Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_PADDEDCELL, 0.25, 0.1, 0);
- EAX_ENVIRONMENT_ROOM:
- Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_ROOM, 0.417, 0.4, 0.666);
- EAX_ENVIRONMENT_BATHROOM:
- Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_BATHROOM, 0.653, 1.499, 0.166);
- EAX_ENVIRONMENT_LIVINGROOM:
- Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_LIVINGROOM, 0.208, 0.478, 0);
- EAX_ENVIRONMENT_STONEROOM:
- Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_STONEROOM, 0.5, 2.309, 0.888);
- EAX_ENVIRONMENT_AUDITORIUM:
- Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_AUDITORIUM, 0.403, 4.279, 0.5);
- EAX_ENVIRONMENT_CONCERTHALL:
- Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_CONCERTHALL, 0.5, 3.961, 0.5);
- EAX_ENVIRONMENT_CAVE:
- Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_CAVE, 0.5, 2.886, 1.304);
- EAX_ENVIRONMENT_ARENA:
- Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_ARENA, 0.361, 7.284, 0.332);
- EAX_ENVIRONMENT_HANGAR:
- Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_HANGAR, 0.5, 10.0, 0.3);
- EAX_ENVIRONMENT_CARPETEDHALLWAY:
- Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_CARPETEDHALLWAY, 0.153, 0.259, 2.0);
- EAX_ENVIRONMENT_HALLWAY:
- Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_HALLWAY, 0.361, 1.493, 0);
- EAX_ENVIRONMENT_STONECORRIDOR:
- Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_STONECORRIDOR, 0.444, 2.697, 0.638);
- EAX_ENVIRONMENT_ALLEY:
- Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_ALLEY, 0.25, 1.752, 0.776);
- EAX_ENVIRONMENT_FOREST:
- Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_FOREST, 0.111, 3.145, 0.472);
- EAX_ENVIRONMENT_CITY:
- Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_CITY, 0.111, 2.767, 0.224);
- EAX_ENVIRONMENT_MOUNTAINS:
- Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_MOUNTAINS, 0.194, 7.841, 0.472);
- EAX_ENVIRONMENT_QUARRY:
- Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_QUARRY, 1, 1.499, 0.5);
- EAX_ENVIRONMENT_PLAIN:
- Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_PLAIN, 0.097, 2.767, 0.224);
- EAX_ENVIRONMENT_PARKINGLOT:
- Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_PARKINGLOT, 0.208, 1.652, 1.5);
- EAX_ENVIRONMENT_SEWERPIPE:
- Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_SEWERPIPE, 0.652, 2.886, 0.25);
- EAX_ENVIRONMENT_UNDERWATER:
- Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_UNDERWATER, 1, 1.499, 0);
- EAX_ENVIRONMENT_DRUGGED:
- Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_DRUGGED, 0.875, 8.392, 1.388);
- EAX_ENVIRONMENT_DIZZY:
- Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_DIZZY, 0.139, 17.234, 0.666);
- EAX_ENVIRONMENT_PSYCHOTIC:
- Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_PSYCHOTIC, 0.486, 7.563, 0.806);
- else
- Result := FALSE;
- end;
-end;
-{$ENDIF}
-
-end.
-// END OF FILE /////////////////////////////////////////////////////////////////
-
diff --git a/src/lib/collections/CollArray.pas b/src/lib/collections/CollArray.pas
deleted file mode 100644
index a10ba905..00000000
--- a/src/lib/collections/CollArray.pas
+++ /dev/null
@@ -1,183 +0,0 @@
-unit CollArray;
-
-(*****************************************************************************
- * Copyright 2003 by Matthew Greet
- * 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.1 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. (http://opensource.org/licenses/lgpl-license.php)
- *
- * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
- *
- * $Version: v1.0.3 $
- * $Revision: 1.2 $
- * $Log: D:\QVCS Repositories\Delphi Collections\CollArray.qbt $
- *
- * Colllection implementations based on arrays.
- *
- * Revision 1.2 by: Matthew Greet Rev date: 12/06/04 20:02:16
- * Capacity property.
- *
- * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:30:36
- * Size property dropped.
- * Unused abstract functions still implemented.
- *
- * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02
- * Initial revision.
- *
- * FPC compatibility fixes by: UltraStar Deluxe Team
- *
- * $Endlog$
- *****************************************************************************)
-
-{$IFDEF FPC}
- {$MODE Delphi}{$H+}
-{$ENDIF}
-
-interface
-
-uses
- Collections;
-
-type
- TArray = class(TAbstractList)
- private
- FArray: array of ICollectable;
- protected
- function TrueGetItem(Index: Integer): ICollectable; override;
- procedure TrueSetItem(Index: Integer; const Value: ICollectable); override;
- procedure TrueAppend(const Item: ICollectable); override;
- procedure TrueClear; override;
- function TrueDelete(Index: Integer): ICollectable; override;
- procedure TrueInsert(Index: Integer; const Item: ICollectable); override;
- public
- constructor Create(NaturalItemsOnly: Boolean); override;
- constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean = false); override;
- constructor Create(Size: Integer; NaturalItemsOnly: Boolean = false); overload; virtual;
- constructor Create(const Collection: ICollection); override;
- destructor Destroy; override;
- function GetCapacity: Integer; override;
- procedure SetCapacity(Value: Integer); override;
- function GetFixedSize: Boolean; override;
- function GetSize: Integer; override;
- end;
-
-implementation
-
-constructor TArray.Create(NaturalItemsOnly: Boolean);
-begin
- Create(0, NaturalItemsOnly);
-end;
-
-constructor TArray.Create(Size: Integer; NaturalItemsOnly: Boolean = false);
-begin
- inherited Create(NaturalItemsOnly);
- SetLength(FArray, Size);
-end;
-
-constructor TArray.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
-var
- Item: ICollectable;
- ItemError: TCollectionError;
- I: Integer;
-begin
- inherited Create(ItemArray, NaturalItemsOnly);
- SetLength(FArray, Length(ItemArray));
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- Item := ItemArray[I];
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- end
- else
- Items[I] := Item;
- end;
-end;
-
-constructor TArray.Create(const Collection: ICollection);
-var
- Iterator: IIterator;
- I: Integer;
-begin
- inherited Create(Collection);
- SetLength(FArray, Collection.GetSize);
- Iterator := Collection.GetIterator;
- I := 0;
- while not Iterator.EOF do
- begin
- Items[I] := Iterator.CurrentItem;
- Inc(I);
- Iterator.Next;
- end;
-end;
-
-destructor TArray.Destroy;
-var
- I: Integer;
-begin
- // Delete interface references to all items
- for I := Low(FArray) to High(FArray) do
- begin
- FArray[I] := nil;
- end;
- inherited Destroy;
-end;
-
-function TArray.TrueGetItem(Index: Integer): ICollectable;
-begin
- Result := FArray[Index];
-end;
-
-procedure TArray.TrueSetItem(Index: Integer; const Value: ICollectable);
-begin
- FArray[Index] := Value;
-end;
-
-procedure TArray.TrueAppend(const Item: ICollectable);
-begin
- // Ignored as collection is fixed size
-end;
-
-procedure TArray.TrueClear;
-begin
- // Ignored as collection is fixed size
-end;
-
-function TArray.TrueDelete(Index: Integer): ICollectable;
-begin
- // Ignored as collection is fixed size
-end;
-
-procedure TArray.TrueInsert(Index: Integer; const Item: ICollectable);
-begin
- // Ignored as collection is fixed size
-end;
-
-function TArray.GetCapacity: Integer;
-begin
- Result := Size;
-end;
-
-procedure TArray.SetCapacity(Value: Integer);
-begin
- // Ignored
-end;
-
-function TArray.GetFixedSize: Boolean;
-begin
- Result := true;
-end;
-
-function TArray.GetSize: Integer;
-begin
- Result := Length(FArray);
-end;
-
-end.
diff --git a/src/lib/collections/CollHash.pas b/src/lib/collections/CollHash.pas
deleted file mode 100644
index 796fc740..00000000
--- a/src/lib/collections/CollHash.pas
+++ /dev/null
@@ -1,1497 +0,0 @@
-unit CollHash;
-
-(*****************************************************************************
- * Copyright 2003 by Matthew Greet
- * 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.1 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. (http://opensource.org/licenses/lgpl-license.php)
- *
- * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
- *
- * $Version: v1.0.3 $
- * $Revision: 1.1.1.2 $
- * $Log: D:\QVCS Repositories\Delphi Collections\CollHash.qbt $
- *
- * Collection implementations based on hash tables.
- *
- * Revision 1.1.1.2 by: Matthew Greet Rev date: 12/06/04 20:04:30
- * Capacity property.
- *
- * Revision 1.1.1.1 by: Matthew Greet Rev date: 24/10/03 16:48:16
- * v1.0 branch.
- *
- * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:40:16
- * Added integer map and string map versions.
- * THashSet uses its own implementation, not THashMap.
- * DefaulMaxLoadFactor changed.
- *
- * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02
- * Initial revision.
- *
- * FPC compatibility fixes by: UltraStar Deluxe Team
- *
- * $Endlog$
- *****************************************************************************)
-
-{$IFDEF FPC}
- {$MODE Delphi}{$H+}
-{$ENDIF}
-
-interface
-
-uses
- Classes, Math,
- Collections;
-
-const
- DefaultTableSize = 100;
- MaxLoadFactorMin = 0.01; // Minimum allowed value for MaxLoadFactor property.
- DefaultMaxLoadFactor = 5.0;
-
-type
- THashMap = class(TAbstractMap)
- private
- FArray: TListArray;
- FCapacity: Integer;
- FMaxLoadFactor: Double;
- FSize: Integer;
- FTableSize: Integer;
- protected
- function GetAssociationIterator: IMapIterator; override;
- procedure SetMaxLoadFactor(Value: Double); virtual;
- procedure SetTableSize(Value: Integer); virtual;
- procedure ChangeCapacity(Value: TListArray); virtual;
- procedure CheckLoadFactor(AlwaysChangeCapacity: Boolean); virtual;
- function GetHash(const Key: ICollectable): Integer; virtual;
- function GetKeyPosition(const Key: ICollectable): TCollectionPosition; override;
- procedure Rehash;
- procedure TrueClear; override;
- function TrueGet(Position: TCollectionPosition): IAssociation; override;
- function TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation; override;
- function TrueRemove2(Position: TCollectionPosition): IAssociation; override;
- public
- constructor Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); override;
- destructor Destroy; override;
- class function GetAlwaysNaturalKeys: Boolean; override;
- function GetCapacity: Integer; override;
- procedure SetCapacity(Value: Integer); override;
- function GetNaturalKeyIID: TGUID; override;
- function GetSize: Integer; override;
- property MaxLoadFactor: Double read FMaxLoadFactor write SetMaxLoadFactor;
- property TableSize: Integer read FTableSize write SetTableSize;
- end;
-
- THashSet = class(TAbstractSet)
- private
- FArray: TListArray;
- FCapacity: Integer;
- FMaxLoadFactor: Double;
- FSize: Integer;
- FTableSize: Integer;
- protected
- procedure SetMaxLoadFactor(Value: Double); virtual;
- procedure SetTableSize(Value: Integer); virtual;
- procedure ChangeCapacity(Value: TListArray); virtual;
- procedure CheckLoadFactor(AlwaysChangeCapacity: Boolean); virtual;
- function GetHash(const Item: ICollectable): Integer; virtual;
- function GetPosition(const Item: ICollectable): TCollectionPosition; override;
- procedure Rehash;
- procedure TrueAdd2(Position: TCollectionPosition; const Item: ICollectable); override;
- procedure TrueClear; override;
- function TrueGet(Position: TCollectionPosition): ICollectable; override;
- procedure TrueRemove2(Position: TCollectionPosition); override;
- public
- constructor Create(NaturalItemsOnly: Boolean); override;
- destructor Destroy; override;
- class function GetAlwaysNaturalItems: Boolean; override;
- function GetCapacity: Integer; override;
- procedure SetCapacity(Value: Integer); override;
- function GetIterator: IIterator; override;
- function GetNaturalItemIID: TGUID; override;
- function GetSize: Integer; override;
- property MaxLoadFactor: Double read FMaxLoadFactor write SetMaxLoadFactor;
- property TableSize: Integer read FTableSize write SetTableSize;
- end;
-
- THashIntegerMap = class(TAbstractIntegerMap)
- private
- FArray: TListArray;
- FCapacity: Integer;
- FMaxLoadFactor: Double;
- FSize: Integer;
- FTableSize: Integer;
- protected
- function GetAssociationIterator: IIntegerMapIterator; override;
- procedure SetMaxLoadFactor(Value: Double); virtual;
- procedure SetTableSize(Value: Integer); virtual;
- procedure ChangeCapacity(Value: TListArray); virtual;
- procedure CheckLoadFactor(AlwaysChangeCapacity: Boolean); virtual;
- function GetHash(const Key: Integer): Integer; virtual;
- function GetKeyPosition(const Key: Integer): TCollectionPosition; override;
- procedure Rehash;
- procedure TrueClear; override;
- function TrueGet(Position: TCollectionPosition): IIntegerAssociation; override;
- function TruePut(Position: TCollectionPosition; const Association: IIntegerAssociation): IIntegerAssociation; override;
- function TrueRemove2(Position: TCollectionPosition): IIntegerAssociation; override;
- public
- constructor Create; override;
- constructor Create(NaturalItemsOnly: Boolean); override;
- constructor Create(NaturalItemsOnly: Boolean; TableSize: Integer; MaxLoadFactor: Double = DefaultMaxLoadFactor); overload; virtual;
- destructor Destroy; override;
- function GetCapacity: Integer; override;
- procedure SetCapacity(Value: Integer); override;
- function GetSize: Integer; override;
- property MaxLoadFactor: Double read FMaxLoadFactor write SetMaxLoadFactor;
- property TableSize: Integer read FTableSize write SetTableSize;
- end;
-
- THashStringMap = class(TAbstractStringMap)
- private
- FArray: TListArray;
- FCapacity: Integer;
- FMaxLoadFactor: Double;
- FSize: Integer;
- FTableSize: Integer;
- protected
- function GetAssociationIterator: IStringMapIterator; override;
- procedure SetMaxLoadFactor(Value: Double); virtual;
- procedure SetTableSize(Value: Integer); virtual;
- procedure ChangeCapacity(Value: TListArray); virtual;
- procedure CheckLoadFactor(AlwaysChangeCapacity: Boolean); virtual;
- function GetHash(const Key: String): Integer; virtual;
- function GetKeyPosition(const Key: String): TCollectionPosition; override;
- procedure Rehash;
- procedure TrueClear; override;
- function TrueGet(Position: TCollectionPosition): IStringAssociation; override;
- function TruePut(Position: TCollectionPosition; const Association: IStringAssociation): IStringAssociation; override;
- function TrueRemove2(Position: TCollectionPosition): IStringAssociation; override;
- public
- constructor Create; override;
- constructor Create(NaturalItemsOnly: Boolean); override;
- constructor Create(NaturalItemsOnly: Boolean; TableSize: Integer; MaxLoadFactor: Double = DefaultMaxLoadFactor); overload; virtual;
- destructor Destroy; override;
- function GetCapacity: Integer; override;
- procedure SetCapacity(Value: Integer); override;
- function GetSize: Integer; override;
- property MaxLoadFactor: Double read FMaxLoadFactor write SetMaxLoadFactor;
- property TableSize: Integer read FTableSize write SetTableSize;
- end;
-
-implementation
-
-const
- (* (sqrt(5) - 1)/2
- See Introduction to Algorithms in Pascal, 1995, by Thomas W. Parsons,
- published by John Wiley & Sons, Inc, ISBN 0-471-11600-9
- *)
- HashFactor = 0.618033988749894848204586834365638;
-
-type
- THashIterator = class(TAbstractIterator)
- private
- FHashSet: THashSet;
- FHash: Integer;
- FChainIndex: Integer;
- protected
- constructor Create(HashSet: THashSet);
- function TrueFirst: ICollectable; override;
- function TrueNext: ICollectable; override;
- procedure TrueRemove; override;
- end;
-
- THashAssociationIterator = class(TAbstractAssociationIterator)
- private
- FHashMap: THashMap;
- FHash: Integer;
- FChainIndex: Integer;
- protected
- constructor Create(HashMap: THashMap);
- function TrueFirst: IAssociation; override;
- function TrueNext: IAssociation; override;
- procedure TrueRemove; override;
- end;
-
- THashIntegerIterator = class(TAbstractIntegerAssociationIterator)
- private
- FHashIntegerMap: THashIntegerMap;
- FHash: Integer;
- FChainIndex: Integer;
- protected
- constructor Create(HashIntegerMap: THashIntegerMap);
- function TrueFirst: IIntegerAssociation; override;
- function TrueNext: IIntegerAssociation; override;
- procedure TrueRemove; override;
- end;
-
- THashStringIterator = class(TAbstractStringAssociationIterator)
- private
- FHashStringMap: THashStringMap;
- FHash: Integer;
- FChainIndex: Integer;
- protected
- constructor Create(HashStringMap: THashStringMap);
- function TrueFirst: IStringAssociation; override;
- function TrueNext: IStringAssociation; override;
- procedure TrueRemove; override;
- end;
-
- THashPosition = class(TCollectionPosition)
- private
- FChain: TList;
- FIndex: Integer;
- public
- constructor Create(Found: Boolean; Chain: TList; Index: Integer);
- property Chain: TList read FChain;
- property Index: Integer read FIndex;
- end;
-
-{ THashMap }
-constructor THashMap.Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean);
-var
- I: Integer;
-begin
- // Force use of natural keys
- inherited Create(NaturalItemsOnly, true);
- FTableSize := DefaultTableSize;
- FMaxLoadFactor := DefaultMaxLoadFactor;
- SetLength(FArray, FTableSize);
- for I := Low(FArray) to High(FArray) do
- FArray[I] := TList.Create;
- FCapacity := 0;
- FSize := 0;
- ChangeCapacity(FArray);
-end;
-
-destructor THashMap.Destroy;
-var
- I: Integer;
-begin
- for I := Low(FArray) to High(FArray) do
- FArray[I].Free;
- FArray := nil;
- inherited Destroy;
-end;
-
-class function THashMap.GetAlwaysNaturalKeys: Boolean;
-begin
- Result := true;
-end;
-
-function THashMap.GetNaturalKeyIID: TGUID;
-begin
- Result := HashableIID;
-end;
-
-function THashMap.GetAssociationIterator: IMapIterator;
-begin
- Result := THashAssociationIterator.Create(Self);
-end;
-
-procedure THashMap.SetTableSize(Value: Integer);
-begin
- if (FTableSize <> Value) and (Value >= 1) then
- begin
- FTableSize := Value;
- Rehash;
- end;
-end;
-
-procedure THashMap.SetMaxLoadFactor(Value: Double);
-begin
- if (FMaxLoadFactor <> Value) and (Value >= MaxLoadFactorMin) then
- begin
- FMaxLoadFactor := Value;
- CheckLoadFactor(false);
- end;
-end;
-
-procedure THashMap.ChangeCapacity(Value: TListArray);
-var
- Chain: TList;
- I, Total, ChainCapacity: Integer;
-begin
- if FCapacity mod FTableSize = 0 then
- ChainCapacity := Trunc(FCapacity / FTableSize)
- else
- ChainCapacity := Trunc(FCapacity / FTableSize) + 1;
- Total := 0;
- for I := Low(Value) to High(Value) do
- begin
- Chain := Value[I];
- Chain.Capacity := ChainCapacity;
- Total := Total + Chain.Capacity;
- end;
- FCapacity := Total;
-end;
-
-procedure THashMap.CheckLoadFactor(AlwaysChangeCapacity: Boolean);
-var
- LoadFactor: Double;
-begin
- LoadFactor := Capacity / TableSize;
- if LoadFactor > MaxLoadFactor then
- TableSize := Trunc(Capacity / Max(MaxLoadFactor, MaxLoadFactorMin))
- else if AlwaysChangeCapacity then
- ChangeCapacity(FArray);
-end;
-
-function THashMap.GetHash(const Key: ICollectable): Integer;
-var
- Hashable: IHashable;
- HashCode: Cardinal;
-begin
- Key.QueryInterface(IHashable, Hashable);
- HashCode := Hashable.HashCode;
- Result := Trunc(Frac(HashCode * HashFactor) * TableSize);
-end;
-
-function THashMap.GetKeyPosition(const Key: ICollectable): TCollectionPosition;
-var
- Chain: TList;
- I: Integer;
- Success: Boolean;
-begin
- Chain := FArray[GetHash(Key)];
- Success := false;
- for I := 0 to Chain.Count - 1 do
- begin
- Success := KeyComparator.Equals(Key, IAssociation(Chain[I]).GetKey);
- if Success then
- Break;
- end;
- Result := THashPosition.Create(Success, Chain, I);
-end;
-
-procedure THashMap.Rehash;
-var
- NewArray: TListArray;
- OldChain, NewChain: TList;
- Association: IAssociation;
- Total: Integer;
- I, J: Integer;
- Hash: Integer;
-begin
- // Create new chains
- SetLength(NewArray, TableSize);
- for I := Low(NewArray) to High(NewArray) do
- begin
- NewChain := TList.Create;
- NewArray[I] := NewChain;
- end;
- ChangeCapacity(NewArray);
-
- // Transfer from old chains to new and drop old
- for I := Low(FArray) to High(FArray) do
- begin
- OldChain := FArray[I];
- for J := 0 to OldChain.Count - 1 do
- begin
- Association := IAssociation(OldChain[J]);
- Hash := GetHash(Association.GetKey);
- NewArray[Hash].Add(Pointer(Association));
- end;
- OldChain.Free;
- end;
- FArray := NewArray;
-
- // Find actual, new capacity
- Total := 0;
- for I := Low(FArray) to High(FArray) do
- begin
- NewChain := FArray[I];
- Total := Total + NewChain.Capacity;
- end;
- FCapacity := Total;
-end;
-
-procedure THashMap.TrueClear;
-var
- Association: IAssociation;
- Chain: TList;
- I, J: Integer;
-begin
- for I := Low(FArray) to High(FArray) do
- begin
- Chain := FArray[I];
- for J := 0 to Chain.Count - 1 do
- begin
- Association := IAssociation(Chain[J]);
- Chain[J] := nil;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._Release;
- end;
- Chain.Clear;
- end;
- FSize := 0;
-end;
-
-function THashMap.TrueGet(Position: TCollectionPosition): IAssociation;
-var
- HashPosition: THashPosition;
-begin
- HashPosition := THashPosition(Position);
- Result := IAssociation(HashPosition.Chain.Items[HashPosition.Index]);
-end;
-
-function THashMap.TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation;
-var
- HashPosition: THashPosition;
- OldAssociation: IAssociation;
-begin
- HashPosition := THashPosition(Position);
- if HashPosition.Found then
- begin
- OldAssociation := IAssociation(HashPosition.Chain.Items[HashPosition.Index]);
- HashPosition.Chain.Items[HashPosition.Index] := Pointer(Association);
- Result := OldAssociation;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._AddRef;
- OldAssociation._Release;
- end
- else
- begin
- HashPosition.Chain.Add(Pointer(Association));
- Inc(FSize);
- Result := nil;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._AddRef;
- end;
-end;
-
-function THashMap.TrueRemove2(Position: TCollectionPosition): IAssociation;
-var
- Association: IAssociation;
- HashPosition: THashPosition;
-begin
- HashPosition := THashPosition(Position);
- Association := IAssociation(TrueGet(Position));
- HashPosition.Chain.Delete(HashPosition.Index);
- Dec(FSize);
- Result := Association;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._Release;
-end;
-
-function THashMap.GetCapacity;
-begin
- Result := FCapacity;
-end;
-
-procedure THashMap.SetCapacity(Value: Integer);
-begin
- FCapacity := Value;
- CheckLoadFactor(true);
-end;
-
-function THashMap.GetSize: Integer;
-begin
- Result := FSize;
-end;
-
-{ THashSet }
-constructor THashSet.Create(NaturalItemsOnly: Boolean);
-var
- I: Integer;
-begin
- // Force use of natural items
- inherited Create(true);
- FTableSize := DefaultTableSize;
- FMaxLoadFactor := DefaultMaxLoadFactor;
- SetLength(FArray, FTableSize);
- for I := Low(FArray) to High(FArray) do
- FArray[I] := TList.Create;
- FSize := 0;
-end;
-
-destructor THashSet.Destroy;
-var
- I: Integer;
-begin
- for I := Low(FArray) to High(FArray) do
- FArray[I].Free;
- FArray := nil;
- inherited Destroy;
-end;
-
-procedure THashSet.SetTableSize(Value: Integer);
-begin
- if (FTableSize <> Value) and (Value >= 1) then
- begin
- FTableSize := Value;
- Rehash;
- end;
-end;
-
-procedure THashSet.SetMaxLoadFactor(Value: Double);
-begin
- if (FMaxLoadFactor <> Value) and (Value >= MaxLoadFactorMin) then
- begin
- FMaxLoadFactor := Value;
- CheckLoadFactor(false);
- end;
-end;
-
-procedure THashSet.ChangeCapacity(Value: TListArray);
-var
- Chain: TList;
- I, Total, ChainCapacity: Integer;
-begin
- if FCapacity mod FTableSize = 0 then
- ChainCapacity := Trunc(FCapacity / FTableSize)
- else
- ChainCapacity := Trunc(FCapacity / FTableSize) + 1;
- Total := 0;
- for I := Low(Value) to High(Value) do
- begin
- Chain := Value[I];
- Chain.Capacity := ChainCapacity;
- Total := Total + Chain.Capacity;
- end;
- FCapacity := Total;
-end;
-
-procedure THashSet.CheckLoadFactor(AlwaysChangeCapacity: Boolean);
-var
- LoadFactor: Double;
-begin
- LoadFactor := Capacity / TableSize;
- if LoadFactor > MaxLoadFactor then
- TableSize := Trunc(Capacity / Max(MaxLoadFactor, MaxLoadFactorMin))
- else if AlwaysChangeCapacity then
- ChangeCapacity(FArray);
-end;
-
-function THashSet.GetHash(const Item: ICollectable): Integer;
-var
- Hashable: IHashable;
- HashCode: Cardinal;
-begin
- Item.QueryInterface(IHashable, Hashable);
- HashCode := Hashable.HashCode;
- Result := Trunc(Frac(HashCode * HashFactor) * TableSize);
-end;
-
-function THashSet.GetPosition(const Item: ICollectable): TCollectionPosition;
-var
- Chain: TList;
- I: Integer;
- Success: Boolean;
-begin
- Chain := FArray[GetHash(Item)];
- Success := false;
- for I := 0 to Chain.Count - 1 do
- begin
- Success := Comparator.Equals(Item, ICollectable(Chain[I]));
- if Success then
- Break;
- end;
- Result := THashPosition.Create(Success, Chain, I);
-end;
-
-procedure THashSet.Rehash;
-var
- NewArray: TListArray;
- OldChain, NewChain: TList;
- Item: ICollectable;
- Total: Integer;
- I, J: Integer;
- Hash: Integer;
-begin
- // Create new chains
- SetLength(NewArray, TableSize);
- for I := Low(NewArray) to High(NewArray) do
- begin
- NewChain := TList.Create;
- NewArray[I] := NewChain;
- end;
- ChangeCapacity(NewArray);
-
- // Transfer from old chains to new and drop old
- for I := Low(FArray) to High(FArray) do
- begin
- OldChain := FArray[I];
- for J := 0 to OldChain.Count - 1 do
- begin
- Item := ICollectable(OldChain[J]);
- Hash := GetHash(Item);
- NewArray[Hash].Add(Pointer(Item));
- end;
- OldChain.Free;
- end;
- FArray := NewArray;
-
- // Find actual, new capacity
- Total := 0;
- for I := Low(FArray) to High(FArray) do
- begin
- NewChain := FArray[I];
- Total := Total + NewChain.Capacity;
- end;
- FCapacity := Total;
-end;
-
-procedure THashSet.TrueAdd2(Position: TCollectionPosition; const Item: ICollectable);
-var
- HashPosition: THashPosition;
-begin
- HashPosition := THashPosition(Position);
- HashPosition.Chain.Add(Pointer(Item));
- Inc(FSize);
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Item._AddRef;
-end;
-
-procedure THashSet.TrueClear;
-var
- Item: ICollectable;
- Chain: TList;
- I, J: Integer;
-begin
- for I := Low(FArray) to High(FArray) do
- begin
- Chain := FArray[I];
- for J := 0 to Chain.Count - 1 do
- begin
- Item := ICollectable(Chain[J]);
- Chain[J] := nil;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Item._Release;
- end;
- Chain.Clear;
- end;
- FSize := 0;
-end;
-
-function THashSet.TrueGet(Position: TCollectionPosition): ICollectable;
-var
- HashPosition: THashPosition;
-begin
- HashPosition := THashPosition(Position);
- Result := ICollectable(HashPosition.Chain.Items[HashPosition.Index]);
-end;
-
-procedure THashSet.TrueRemove2(Position: TCollectionPosition);
-var
- Item: ICollectable;
- HashPosition: THashPosition;
-begin
- HashPosition := THashPosition(Position);
- Item := TrueGet(Position);
- HashPosition.Chain.Delete(HashPosition.Index);
- Dec(FSize);
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Item._Release;
-end;
-
-class function THashSet.GetAlwaysNaturalItems: Boolean;
-begin
- Result := true;
-end;
-
-function THashSet.GetIterator: IIterator;
-begin
- Result := THashIterator.Create(Self);
-end;
-
-function THashSet.GetNaturalItemIID: TGUID;
-begin
- Result := HashableIID;
-end;
-
-function THashSet.GetCapacity;
-begin
- Result := FCapacity;
-end;
-
-procedure THashSet.SetCapacity(Value: Integer);
-begin
- FCapacity := Value;
- CheckLoadFactor(true);
-end;
-
-function THashSet.GetSize: Integer;
-begin
- Result := FSize;
-end;
-
-{ THashIntegerMap }
-constructor THashIntegerMap.Create;
-begin
- Create(false, DefaultTableSize, DefaultMaxLoadFactor);
-end;
-
-constructor THashIntegerMap.Create(NaturalItemsOnly: Boolean);
-begin
- Create(NaturalItemsOnly, DefaultTableSize, DefaultMaxLoadFactor);
-end;
-
-constructor THashIntegerMap.Create(NaturalItemsOnly: Boolean; TableSize: Integer; MaxLoadFactor: Double = DefaultMaxLoadFactor);
-var
- I: Integer;
-begin
- inherited Create(NaturalItemsOnly);
- SetLength(FArray, TableSize);
- for I := Low(FArray) to High(FArray) do
- FArray[I] := TList.Create;
- FTableSize := TableSize;
- FMaxLoadFactor := MaxLoadFactor;
- FSize := 0;
-end;
-
-destructor THashIntegerMap.Destroy;
-var
- I: Integer;
-begin
- for I := Low(FArray) to High(FArray) do
- FArray[I].Free;
- FArray := nil;
- inherited Destroy;
-end;
-
-function THashIntegerMap.GetAssociationIterator: IIntegerMapIterator;
-begin
- Result := THashIntegerIterator.Create(Self);
-end;
-
-procedure THashIntegerMap.SetTableSize(Value: Integer);
-begin
- if (FTableSize <> Value) and (Value >= 1) then
- begin
- FTableSize := Value;
- Rehash;
- end;
-end;
-
-procedure THashIntegerMap.SetMaxLoadFactor(Value: Double);
-begin
- if (FMaxLoadFactor <> Value) and (Value >= MaxLoadFactorMin) then
- begin
- FMaxLoadFactor := Value;
- CheckLoadFactor(false);
- end;
-end;
-
-procedure THashIntegerMap.ChangeCapacity;
-var
- Chain: TList;
- I, Total, ChainCapacity: Integer;
-begin
- if FCapacity mod FTableSize = 0 then
- ChainCapacity := Trunc(FCapacity / FTableSize)
- else
- ChainCapacity := Trunc(FCapacity / FTableSize) + 1;
- Total := 0;
- for I := Low(Value) to High(Value) do
- begin
- Chain := Value[I];
- Chain.Capacity := ChainCapacity;
- Total := Total + Chain.Capacity;
- end;
- FCapacity := Total;
-end;
-
-procedure THashIntegerMap.CheckLoadFactor(AlwaysChangeCapacity: Boolean);
-var
- LoadFactor: Double;
-begin
- LoadFactor := Capacity / TableSize;
- if LoadFactor > MaxLoadFactor then
- TableSize := Trunc(Capacity / Max(MaxLoadFactor, MaxLoadFactorMin))
- else if AlwaysChangeCapacity then
- ChangeCapacity(FArray);
-end;
-
-function THashIntegerMap.GetHash(const Key: Integer): Integer;
-begin
- Result := Trunc(Frac(Cardinal(Key) * HashFactor) * TableSize);
-end;
-
-function THashIntegerMap.GetKeyPosition(const Key: Integer): TCollectionPosition;
-var
- Chain: TList;
- I: Integer;
- Success: Boolean;
-begin
- Chain := FArray[GetHash(Key)];
- Success := false;
- for I := 0 to Chain.Count - 1 do
- begin
- Success := (Key = IIntegerAssociation(Chain[I]).GetKey);
- if Success then
- Break;
- end;
- Result := THashPosition.Create(Success, Chain, I);
-end;
-
-procedure THashIntegerMap.Rehash;
-var
- NewArray: TListArray;
- OldChain, NewChain: TList;
- Association: IIntegerAssociation;
- Total: Integer;
- I, J: Integer;
- Hash: Integer;
-begin
- // Create new chains
- SetLength(NewArray, TableSize);
- for I := Low(NewArray) to High(NewArray) do
- begin
- NewChain := TList.Create;
- NewArray[I] := NewChain;
- end;
- ChangeCapacity(NewArray);
-
- // Transfer from old chains to new and drop old
- for I := Low(FArray) to High(FArray) do
- begin
- OldChain := FArray[I];
- for J := 0 to OldChain.Count - 1 do
- begin
- Association := IIntegerAssociation(OldChain[J]);
- Hash := GetHash(Association.GetKey);
- NewArray[Hash].Add(Pointer(Association));
- end;
- OldChain.Free;
- end;
- FArray := NewArray;
-
- // Find actual, new capacity
- Total := 0;
- for I := Low(FArray) to High(FArray) do
- begin
- NewChain := FArray[I];
- Total := Total + NewChain.Capacity;
- end;
- FCapacity := Total;
-end;
-
-procedure THashIntegerMap.TrueClear;
-var
- Association: IIntegerAssociation;
- Chain: TList;
- I, J: Integer;
-begin
- for I := Low(FArray) to High(FArray) do
- begin
- Chain := FArray[I];
- for J := 0 to Chain.Count - 1 do
- begin
- Association := IIntegerAssociation(Chain[J]);
- Chain[J] := nil;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._Release;
- end;
- Chain.Clear;
- end;
- FSize := 0;
-end;
-
-function THashIntegerMap.TrueGet(Position: TCollectionPosition): IIntegerAssociation;
-var
- HashPosition: THashPosition;
-begin
- HashPosition := THashPosition(Position);
- Result := IIntegerAssociation(HashPosition.Chain.Items[HashPosition.Index]);
-end;
-
-function THashIntegerMap.TruePut(Position: TCollectionPosition; const Association: IIntegerAssociation): IIntegerAssociation;
-var
- HashPosition: THashPosition;
- OldAssociation: IIntegerAssociation;
-begin
- HashPosition := THashPosition(Position);
- if HashPosition.Found then
- begin
- OldAssociation := IIntegerAssociation(HashPosition.Chain.Items[HashPosition.Index]);
- HashPosition.Chain.Items[HashPosition.Index] := Pointer(Association);
- Result := OldAssociation;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._AddRef;
- OldAssociation._Release;
- end
- else
- begin
- HashPosition.Chain.Add(Pointer(Association));
- Inc(FSize);
- Result := nil;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._AddRef;
- end;
-end;
-
-function THashIntegerMap.TrueRemove2(Position: TCollectionPosition): IIntegerAssociation;
-var
- Association: IIntegerAssociation;
- HashPosition: THashPosition;
-begin
- HashPosition := THashPosition(Position);
- Association := IIntegerAssociation(TrueGet(Position));
- HashPosition.Chain.Delete(HashPosition.Index);
- Dec(FSize);
- Result := Association;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._Release;
-end;
-
-function THashIntegerMap.GetCapacity;
-begin
- Result := FCapacity;
-end;
-
-procedure THashIntegerMap.SetCapacity(Value: Integer);
-begin
- FCapacity := Value;
- CheckLoadFactor(true);
-end;
-
-function THashIntegerMap.GetSize: Integer;
-begin
- Result := FSize;
-end;
-
-{ THashStringMap }
-constructor THashStringMap.Create;
-begin
- Create(false, DefaultTableSize, DefaultMaxLoadFactor);
-end;
-
-constructor THashStringMap.Create(NaturalItemsOnly: Boolean);
-begin
- Create(NaturalItemsOnly, DefaultTableSize, DefaultMaxLoadFactor);
-end;
-
-constructor THashStringMap.Create(NaturalItemsOnly: Boolean; TableSize: Integer; MaxLoadFactor: Double = DefaultMaxLoadFactor);
-var
- I: Integer;
-begin
- inherited Create(NaturalItemsOnly);
- SetLength(FArray, TableSize);
- for I := Low(FArray) to High(FArray) do
- FArray[I] := TList.Create;
- FTableSize := TableSize;
- FMaxLoadFactor := MaxLoadFactor;
- FSize := 0;
-end;
-
-destructor THashStringMap.Destroy;
-var
- I: Integer;
-begin
- for I := Low(FArray) to High(FArray) do
- FArray[I].Free;
- FArray := nil;
- inherited Destroy;
-end;
-
-function THashStringMap.GetAssociationIterator: IStringMapIterator;
-begin
- Result := THashStringIterator.Create(Self);
-end;
-
-procedure THashStringMap.SetTableSize(Value: Integer);
-begin
- if (FTableSize <> Value) and (Value >= 1) then
- begin
- FTableSize := Value;
- Rehash;
- end;
-end;
-
-procedure THashStringMap.SetMaxLoadFactor(Value: Double);
-begin
- if (FMaxLoadFactor <> Value) and (Value >= MaxLoadFactorMin) then
- begin
- FMaxLoadFactor := Value;
- CheckLoadFactor(false);
- end;
-end;
-
-procedure THashStringMap.ChangeCapacity;
-var
- Chain: TList;
- I, Total, ChainCapacity: Integer;
-begin
- if FCapacity mod FTableSize = 0 then
- ChainCapacity := Trunc(FCapacity / FTableSize)
- else
- ChainCapacity := Trunc(FCapacity / FTableSize) + 1;
- Total := 0;
- for I := Low(Value) to High(Value) do
- begin
- Chain := Value[I];
- Chain.Capacity := ChainCapacity;
- Total := Total + Chain.Capacity;
- end;
- FCapacity := Total;
-end;
-
-procedure THashStringMap.CheckLoadFactor(AlwaysChangeCapacity: Boolean);
-var
- LoadFactor: Double;
-begin
- LoadFactor := Capacity / TableSize;
- if LoadFactor > MaxLoadFactor then
- TableSize := Trunc(Capacity / Max(MaxLoadFactor, MaxLoadFactorMin))
- else if AlwaysChangeCapacity then
- ChangeCapacity(FArray);
-end;
-
-function THashStringMap.GetHash(const Key: String): Integer;
-var
- HashCode: Cardinal;
- I: Integer;
-begin
- HashCode := 0;
- for I := 1 to Length(Key) do
- HashCode := (HashCode shl 1) xor Ord(Key[I]);
- Result := Trunc(Frac(HashCode * HashFactor) * TableSize);
-end;
-
-function THashStringMap.GetKeyPosition(const Key: String): TCollectionPosition;
-var
- Chain: TList;
- I: Integer;
- Success: Boolean;
-begin
- Chain := FArray[GetHash(Key)];
- Success := false;
- for I := 0 to Chain.Count - 1 do
- begin
- Success := (Key = IStringAssociation(Chain[I]).GetKey);
- if Success then
- Break;
- end;
- Result := THashPosition.Create(Success, Chain, I);
-end;
-
-procedure THashStringMap.Rehash;
-var
- NewArray: TListArray;
- OldChain, NewChain: TList;
- Association: IStringAssociation;
- Total: Integer;
- I, J: Integer;
- Hash: Integer;
-begin
- // Create new chains
- SetLength(NewArray, TableSize);
- for I := Low(NewArray) to High(NewArray) do
- begin
- NewChain := TList.Create;
- NewArray[I] := NewChain;
- end;
- ChangeCapacity(NewArray);
-
- // Transfer from old chains to new and drop old
- for I := Low(FArray) to High(FArray) do
- begin
- OldChain := FArray[I];
- for J := 0 to OldChain.Count - 1 do
- begin
- Association := IStringAssociation(OldChain[J]);
- Hash := GetHash(Association.GetKey);
- NewArray[Hash].Add(Pointer(Association));
- end;
- OldChain.Free;
- end;
- FArray := NewArray;
-
- // Find actual, new capacity
- Total := 0;
- for I := Low(FArray) to High(FArray) do
- begin
- NewChain := FArray[I];
- Total := Total + NewChain.Capacity;
- end;
- FCapacity := Total;
-end;
-
-procedure THashStringMap.TrueClear;
-var
- Association: IStringAssociation;
- Chain: TList;
- I, J: Integer;
-begin
- for I := Low(FArray) to High(FArray) do
- begin
- Chain := FArray[I];
- for J := 0 to Chain.Count - 1 do
- begin
- Association := IStringAssociation(Chain[J]);
- Chain[J] := nil;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._Release;
- end;
- Chain.Clear;
- end;
- FSize := 0;
-end;
-
-function THashStringMap.TrueGet(Position: TCollectionPosition): IStringAssociation;
-var
- HashPosition: THashPosition;
-begin
- HashPosition := THashPosition(Position);
- Result := IStringAssociation(HashPosition.Chain.Items[HashPosition.Index]);
-end;
-
-function THashStringMap.TruePut(Position: TCollectionPosition; const Association: IStringAssociation): IStringAssociation;
-var
- HashPosition: THashPosition;
- OldAssociation: IStringAssociation;
-begin
- HashPosition := THashPosition(Position);
- if HashPosition.Found then
- begin
- OldAssociation := IStringAssociation(HashPosition.Chain.Items[HashPosition.Index]);
- HashPosition.Chain.Items[HashPosition.Index] := Pointer(Association);
- Result := OldAssociation;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._AddRef;
- OldAssociation._Release;
- end
- else
- begin
- HashPosition.Chain.Add(Pointer(Association));
- Inc(FSize);
- Result := nil;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._AddRef;
- end;
-end;
-
-function THashStringMap.TrueRemove2(Position: TCollectionPosition): IStringAssociation;
-var
- Association: IStringAssociation;
- HashPosition: THashPosition;
-begin
- HashPosition := THashPosition(Position);
- Association := IStringAssociation(TrueGet(Position));
- HashPosition.Chain.Delete(HashPosition.Index);
- Dec(FSize);
- Result := Association;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._Release;
-end;
-
-function THashStringMap.GetCapacity;
-begin
- Result := FCapacity;
-end;
-
-procedure THashStringMap.SetCapacity(Value: Integer);
-begin
- FCapacity := Value;
- CheckLoadFactor(true);
-end;
-
-function THashStringMap.GetSize: Integer;
-begin
- Result := FSize;
-end;
-
-{ THashPosition }
-constructor THashPosition.Create(Found: Boolean; Chain: TList; Index: Integer);
-begin
- inherited Create(Found);
- FChain := Chain;
- FIndex := Index;
-end;
-
-{ THashIterator }
-constructor THashIterator.Create(HashSet: THashSet);
-begin
- inherited Create(true);
- FHashSet := HashSet;
- First;
-end;
-
-function THashIterator.TrueFirst: ICollectable;
-var
- Chain: TList;
- Success: Boolean;
-begin
- FHash := 0;
- FChainIndex := 0;
- Success := false;
- while FHash < FHashSet.TableSize do
- begin
- Chain := FHashSet.FArray[FHash];
- Success := Chain.Count > 0;
- if Success then
- Break;
- Inc(FHash);
- end;
- if Success then
- Result := ICollectable(FHashSet.FArray[FHash].Items[FChainIndex])
- else
- Result := nil;
-end;
-
-function THashIterator.TrueNext: ICollectable;
-var
- Chain: TList;
- Success: Boolean;
-begin
- Success := false;
- Chain := FHashSet.FArray[FHash];
- repeat
- Inc(FChainIndex);
- if FChainIndex >= Chain.Count then
- begin
- Inc(FHash);
- FChainIndex := -1;
- if FHash < FHashSet.TableSize then
- Chain := FHashSet.FArray[FHash];
- end
- else
- Success := true;
- until Success or (FHash >= FHashSet.TableSize);
- if Success then
- Result := ICollectable(FHashSet.FArray[FHash].Items[FChainIndex])
- else
- Result := nil;
-end;
-
-procedure THashIterator.TrueRemove;
-var
- Item: ICollectable;
-begin
- Item := ICollectable(FHashSet.FArray[FHash].Items[FChainIndex]);
- FHashSet.FArray[FHash].Delete(FChainIndex);
- Dec(FChainIndex);
- Dec(FHashSet.FSize);
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Item._Release;
-end;
-
-
-{ THashAssociationIterator }
-constructor THashAssociationIterator.Create(HashMap: THashMap);
-begin
- inherited Create(true);
- FHashMap := HashMap;
- First;
-end;
-
-function THashAssociationIterator.TrueFirst: IAssociation;
-var
- Chain: TList;
- Success: Boolean;
-begin
- FHash := 0;
- FChainIndex := 0;
- Success := false;
- while FHash < FHashMap.TableSize do
- begin
- Chain := FHashMap.FArray[FHash];
- Success := Chain.Count > 0;
- if Success then
- Break;
- Inc(FHash);
- end;
- if Success then
- Result := IAssociation(FHashMap.FArray[FHash].Items[FChainIndex])
- else
- Result := nil;
-end;
-
-function THashAssociationIterator.TrueNext: IAssociation;
-var
- Chain: TList;
- Success: Boolean;
-begin
- Success := false;
- Chain := FHashMap.FArray[FHash];
- repeat
- Inc(FChainIndex);
- if FChainIndex >= Chain.Count then
- begin
- Inc(FHash);
- FChainIndex := -1;
- if FHash < FHashMap.TableSize then
- Chain := FHashMap.FArray[FHash];
- end
- else
- Success := true;
- until Success or (FHash >= FHashMap.TableSize);
- if Success then
- Result := IAssociation(FHashMap.FArray[FHash].Items[FChainIndex])
- else
- Result := nil;
-end;
-
-procedure THashAssociationIterator.TrueRemove;
-var
- Association: IAssociation;
-begin
- Association := IAssociation(FHashMap.FArray[FHash].Items[FChainIndex]);
- FHashMap.FArray[FHash].Delete(FChainIndex);
- Dec(FChainIndex);
- Dec(FHashMap.FSize);
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._Release;
-end;
-
-
-{ THashIntegerIterator }
-constructor THashIntegerIterator.Create(HashIntegerMap: THashIntegerMap);
-begin
- inherited Create(true);
- FHashIntegerMap := HashIntegerMap;
- First;
-end;
-
-function THashIntegerIterator.TrueFirst: IIntegerAssociation;
-var
- Chain: TList;
- Success: Boolean;
-begin
- FHash := 0;
- FChainIndex := 0;
- Success := false;
- while FHash < FHashIntegerMap.TableSize do
- begin
- Chain := FHashIntegerMap.FArray[FHash];
- Success := Chain.Count > 0;
- if Success then
- Break;
- Inc(FHash);
- end;
- if Success then
- Result := IIntegerAssociation(FHashIntegerMap.FArray[FHash].Items[FChainIndex])
- else
- Result := nil;
-end;
-
-function THashIntegerIterator.TrueNext: IIntegerAssociation;
-var
- Chain: TList;
- Success: Boolean;
-begin
- Success := false;
- Chain := FHashIntegerMap.FArray[FHash];
- repeat
- Inc(FChainIndex);
- if FChainIndex >= Chain.Count then
- begin
- Inc(FHash);
- FChainIndex := -1;
- if FHash < FHashIntegerMap.TableSize then
- Chain := FHashIntegerMap.FArray[FHash];
- end
- else
- Success := true;
- until Success or (FHash >= FHashIntegerMap.TableSize);
- if Success then
- Result := IIntegerAssociation(FHashIntegerMap.FArray[FHash].Items[FChainIndex])
- else
- Result := nil;
-end;
-
-procedure THashIntegerIterator.TrueRemove;
-var
- Association: IIntegerAssociation;
-begin
- Association := IIntegerAssociation(FHashIntegerMap.FArray[FHash].Items[FChainIndex]);
- FHashIntegerMap.FArray[FHash].Delete(FChainIndex);
- Dec(FChainIndex);
- Dec(FHashIntegerMap.FSize);
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._Release;
-end;
-
-{ THashStringIterator }
-constructor THashStringIterator.Create(HashStringMap: THashStringMap);
-begin
- inherited Create(true);
- FHashStringMap := HashStringMap;
- First;
-end;
-
-function THashStringIterator.TrueFirst: IStringAssociation;
-var
- Chain: TList;
- Success: Boolean;
-begin
- FHash := 0;
- FChainIndex := 0;
- Success := false;
- while FHash < FHashStringMap.TableSize do
- begin
- Chain := FHashStringMap.FArray[FHash];
- Success := Chain.Count > 0;
- if Success then
- Break;
- Inc(FHash);
- end;
- if Success then
- Result := IStringAssociation(FHashStringMap.FArray[FHash].Items[FChainIndex])
- else
- Result := nil;
-end;
-
-function THashStringIterator.TrueNext: IStringAssociation;
-var
- Chain: TList;
- Success: Boolean;
-begin
- Success := false;
- Chain := FHashStringMap.FArray[FHash];
- repeat
- Inc(FChainIndex);
- if FChainIndex >= Chain.Count then
- begin
- Inc(FHash);
- FChainIndex := -1;
- if FHash < FHashStringMap.TableSize then
- Chain := FHashStringMap.FArray[FHash];
- end
- else
- Success := true;
- until Success or (FHash >= FHashStringMap.TableSize);
- if Success then
- Result := IStringAssociation(FHashStringMap.FArray[FHash].Items[FChainIndex])
- else
- Result := nil;
-end;
-
-procedure THashStringIterator.TrueRemove;
-var
- Association: IStringAssociation;
-begin
- Association := IStringAssociation(FHashStringMap.FArray[FHash].Items[FChainIndex]);
- FHashStringMap.FArray[FHash].Delete(FChainIndex);
- Dec(FChainIndex);
- Dec(FHashStringMap.FSize);
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._Release;
-end;
-
-
-end.
diff --git a/src/lib/collections/CollLibrary.pas b/src/lib/collections/CollLibrary.pas
deleted file mode 100644
index b7e3d268..00000000
--- a/src/lib/collections/CollLibrary.pas
+++ /dev/null
@@ -1,131 +0,0 @@
-unit CollLibrary;
-
-(*****************************************************************************
- * Copyright 2003 by Matthew Greet
- * 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.1 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. (http://opensource.org/licenses/lgpl-license.php)
- *
- * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
- *
- * $Version: v1.0.3 $
- * $Revision: 1.0.1.1 $
- * $Log: D:\QVCS Repositories\Delphi Collections\CollLibrary.qbt $
- *
- * Initial version.
- *
- * Revision 1.0.1.1 by: Matthew Greet Rev date: 24/10/03 16:48:16
- * v1.0 branch.
- *
- * Revision 1.0 by: Matthew Greet Rev date: 06/04/03 10:40:32
- * Initial revision.
- *
- * FPC compatibility fixes by: UltraStar Deluxe Team
- *
- * $Endlog$
- *****************************************************************************)
-
-{$IFDEF FPC}
- {$MODE Delphi}{$H+}
-{$ENDIF}
-
-interface
-
-uses
- Collections, CollArray, CollHash, CollList, CollPArray, CollWrappers;
-
-type
- TMiscCollectionLibrary = class
- public
- class function ClassNameToClassType(ClassName: String): TAbstractCollectionClass;
- class function EqualIID(const IID1, IID2: TGUID): Boolean;
- class function HashCode(Value: String): Integer;
- class procedure ShuffleArray(var ItemArray: array of ICollectable);
- class procedure ShuffleList(const List: IList);
- end;
-
-implementation
-
-{ TMiscCollectionLibrary }
-class function TMiscCollectionLibrary.ClassNameToClassType(ClassName: String): TAbstractCollectionClass;
-begin
- if ClassName = 'TArray' then
- Result := TArray
- else if ClassName = 'THashSet' then
- Result := THashSet
- else if ClassName = 'THashMap' then
- Result := THashMap
- else if ClassName = 'THashIntegerMap' then
- Result := THashIntegerMap
- else if ClassName = 'THashStringMap' then
- Result := THashStringMap
- else if ClassName = 'TListSet' then
- Result := TListSet
- else if ClassName = 'TListMap' then
- Result := TListMap
- else if ClassName = 'TPArrayBag' then
- Result := TPArrayBag
- else if ClassName = 'TPArraySet' then
- Result := TPArraySet
- else if ClassName = 'TPArrayList' then
- Result := TPArrayList
- else if ClassName = 'TPArrayMap' then
- Result := TPArrayMap
- else
- Result := nil;
-end;
-
-class function TMiscCollectionLibrary.EqualIID(const IID1, IID2: TGUID): Boolean;
-begin
- Result := (IID1.D1 = IID2.D1) and (IID1.D2 = IID2.D2) and (IID1.D3 = IID2.D3) and
- (IID1.D4[0] = IID2.D4[0]) and (IID1.D4[1] = IID2.D4[1]) and
- (IID1.D4[2] = IID2.D4[2]) and (IID1.D4[3] = IID2.D4[3]) and
- (IID1.D4[4] = IID2.D4[4]) and (IID1.D4[5] = IID2.D4[5]) and
- (IID1.D4[6] = IID2.D4[6]) and (IID1.D4[7] = IID2.D4[7]);
-end;
-
-class function TMiscCollectionLibrary.HashCode(Value: String): Integer;
-var
- I: Integer;
-begin
- Result := 0;
- for I := 1 to Length(Value) do
- Result := (Result shl 1) xor Ord(Value[I]);
-end;
-
-class procedure TMiscCollectionLibrary.ShuffleArray(var ItemArray: array of ICollectable);
-var
- Item: ICollectable;
- ArraySize, I, Index: Integer;
-begin
- Randomize;
- ArraySize := Length(ItemArray);
- for I := 0 to ArraySize - 1 do
- begin
- Index := (I + Random(ArraySize - 1) + 1) mod ArraySize;
- Item := ItemArray[I];
- ItemArray[I] := ItemArray[Index];
- ItemArray[Index] := Item;
- end;
-end;
-
-class procedure TMiscCollectionLibrary.ShuffleList(const List: IList);
-var
- ListSize, I: Integer;
-begin
- Randomize;
- ListSize := List.GetSize;
- for I := 0 to ListSize - 1 do
- begin
- List.Exchange(I, (I + Random(ListSize - 1) + 1) mod ListSize);
- end;
-end;
-
-
-end.
diff --git a/src/lib/collections/CollList.pas b/src/lib/collections/CollList.pas
deleted file mode 100644
index 68aa0d66..00000000
--- a/src/lib/collections/CollList.pas
+++ /dev/null
@@ -1,270 +0,0 @@
-unit CollList;
-
-(*****************************************************************************
- * Copyright 2003 by Matthew Greet
- * 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.1 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. (http://opensource.org/licenses/lgpl-license.php)
- *
- * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
- *
- * $Version: v1.0.3 $
- * $Revision: 1.1.1.2 $
- * $Log: D:\QVCS Repositories\Delphi Collections\CollList.qbt $
- *
- * Collection implementations based on sorted TPArrayList instances.
- *
- * Revision 1.1.1.2 by: Matthew Greet Rev date: 12/06/04 20:05:54
- * Capacity property.
- *
- * Revision 1.1.1.1 by: Matthew Greet Rev date: 14/02/04 17:45:38
- * v1.0 branch.
- *
- * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:41:52
- * Uses TExposedPArrayList to improve performance.
- *
- * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02
- * Initial revision.
- *
- * FPC compatibility fixes by: UltraStar Deluxe Team
- *
- * $Endlog$
- *****************************************************************************)
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}{$H+}
-{$ENDIF}
-
-uses
- Collections, CollPArray;
-
-type
- TListSet = class(TAbstractSet)
- private
- FList: TExposedPArrayList;
- protected
- function GetPosition(const Item: ICollectable): TCollectionPosition; override;
- procedure TrueAdd2(Position: TCollectionPosition; const Item: ICollectable); override;
- procedure TrueClear; override;
- function TrueGet(Position: TCollectionPosition): ICollectable; override;
- procedure TrueRemove2(Position: TCollectionPosition); override;
- public
- constructor Create(NaturalItemsOnly: Boolean); override;
- destructor Destroy; override;
- function GetCapacity: Integer; override;
- procedure SetCapacity(Value: Integer); override;
- function GetIterator: IIterator; override;
- function GetNaturalItemIID: TGUID; override;
- function GetSize: Integer; override;
- end;
-
- TListMap = class(TAbstractMap)
- private
- FList: TExposedPArrayList;
- protected
- function GetAssociationIterator: IMapIterator; override;
- function GetKeyPosition(const Key: ICollectable): TCollectionPosition; override;
- procedure TrueClear; override;
- function TrueGet(Position: TCollectionPosition): IAssociation; override;
- function TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation; override;
- function TrueRemove2(Position: TCollectionPosition): IAssociation; override;
- public
- constructor Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); override;
- destructor Destroy; override;
- function GetCapacity: Integer; override;
- procedure SetCapacity(Value: Integer); override;
- procedure SetKeyComparator(const Value: IComparator); override;
- function GetNaturalKeyIID: TGUID; override;
- function GetSize: Integer; override;
- end;
-
-implementation
-
-type
- TListPosition = class(TCollectionPosition)
- private
- FSearchResult: TSearchResult;
- public
- constructor Create(Found: Boolean; SearchResult: TSearchResult);
- property SearchResult: TSearchResult read FSearchResult;
- end;
-
-constructor TListSet.Create(NaturalItemsOnly: Boolean);
-begin
- inherited Create(NaturalItemsOnly);
- FList := TExposedPArrayList.Create(NaturalItemsOnly);
- FList.Comparator := Comparator;
- FList.Sort;
-end;
-
-destructor TListSet.Destroy;
-begin
- FList.Free;
- inherited Destroy;
-end;
-
-function TListSet.GetPosition(const Item: ICollectable): TCollectionPosition;
-var
- SearchResult: TSearchResult;
-begin
- SearchResult := FList.Search(Item);
- Result := TListPosition.Create((SearchResult.ResultType = srFoundAtIndex), SearchResult);
-end;
-
-procedure TListSet.TrueAdd2(Position: TCollectionPosition; const Item: ICollectable);
-var
- SearchResult: TSearchResult;
- Index: Integer;
-begin
- SearchResult := TListPosition(Position).SearchResult;
- Index := SearchResult.Index;
- if SearchResult.ResultType = srBeforeIndex then
- FList.TrueInsert(Index, Item)
- else
- FList.TrueAppend(Item);
-end;
-
-procedure TListSet.TrueClear;
-begin
- FList.Clear;
-end;
-
-function TListSet.TrueGet(Position: TCollectionPosition): ICollectable;
-begin
- Result := FList.Items[TListPosition(Position).SearchResult.Index];
-end;
-
-procedure TListSet.TrueRemove2(Position: TCollectionPosition);
-begin
- FList.Delete(TListPosition(Position).SearchResult.Index);
-end;
-
-function TListSet.GetCapacity: Integer;
-begin
- Result := FList.Capacity;
-end;
-
-procedure TListSet.SetCapacity(Value: Integer);
-begin
- FList.Capacity := Value;
-end;
-
-function TListSet.GetIterator: IIterator;
-begin
- Result := FList.GetIterator;
-end;
-
-function TListSet.GetNaturalItemIID: TGUID;
-begin
- Result := ComparableIID;
-end;
-
-function TListSet.GetSize: Integer;
-begin
- Result := FList.Size;
-end;
-
-constructor TListMap.Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean);
-begin
- inherited Create(NaturalItemsOnly, NaturalKeysOnly);
- FList := TExposedPArrayList.Create(false);
- FList.Comparator := AssociationComparator;
- FList.Sort;
-end;
-
-destructor TListMap.Destroy;
-begin
- FList.Free;
- inherited Destroy;
-end;
-
-function TListMap.GetAssociationIterator: IMapIterator;
-begin
- Result := TAssociationIterator.Create(FList.GetIterator);
-end;
-
-function TListMap.GetKeyPosition(const Key: ICollectable): TCollectionPosition;
-var
- Association: IAssociation;
- SearchResult: TSearchResult;
-begin
- Association := TAssociation.Create(Key, nil);
- SearchResult := FList.Search(Association);
- Result := TListPosition.Create((SearchResult.ResultType = srFoundAtIndex), SearchResult);
-end;
-
-procedure TListMap.TrueClear;
-begin
- FList.Clear;
-end;
-
-function TListMap.TrueGet(Position: TCollectionPosition): IAssociation;
-begin
- Result := (FList.Items[TListPosition(Position).SearchResult.Index]) as IAssociation;
-end;
-
-function TListMap.TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation;
-var
- SearchResult: TSearchResult;
- Index: Integer;
-begin
- SearchResult := TListPosition(Position).SearchResult;
- Index := SearchResult.Index;
- if SearchResult.ResultType = srFoundAtIndex then
- begin
- Result := (FList.Items[Index]) as IAssociation;
- FList.Items[Index] := Association;
- end
- else if SearchResult.ResultType = srBeforeIndex then
- FList.TrueInsert(Index, Association)
- else
- FList.TrueAppend(Association);
-end;
-
-function TListMap.TrueRemove2(Position: TCollectionPosition): IAssociation;
-begin
- Result := (FList.Items[TListPosition(Position).SearchResult.Index]) as IAssociation;
- FList.Delete(TListPosition(Position).SearchResult.Index);
-end;
-
-procedure TListMap.SetKeyComparator(const Value: IComparator);
-begin
- inherited SetKeyComparator(Value);
- FList.Sort;
-end;
-
-function TListMap.GetCapacity: Integer;
-begin
- Result := FList.Capacity;
-end;
-
-procedure TListMap.SetCapacity(Value: Integer);
-begin
- FList.Capacity := Value;
-end;
-
-function TListMap.GetNaturalKeyIID: TGUID;
-begin
- Result := ComparableIID;
-end;
-
-function TListMap.GetSize: Integer;
-begin
- Result := FList.Size;
-end;
-
-constructor TListPosition.Create(Found: Boolean; SearchResult: TSearchResult);
-begin
- inherited Create(Found);
- FSearchResult := SearchResult;
-end;
-
-end.
diff --git a/src/lib/collections/CollPArray.pas b/src/lib/collections/CollPArray.pas
deleted file mode 100644
index 5ebd534b..00000000
--- a/src/lib/collections/CollPArray.pas
+++ /dev/null
@@ -1,689 +0,0 @@
-unit CollPArray;
-
-(*****************************************************************************
- * Copyright 2003 by Matthew Greet
- * 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.1 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. (http://opensource.org/licenses/lgpl-license.php)
- *
- * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
- *
- * $Version: v1.0.3 $
- * $Revision: 1.2.1.2 $
- * $Log: D:\QVCS Repositories\Delphi Collections\CollPArray.qbt $
- *
- * Collection implementations based on TList.
- *
- * Revision 1.2.1.2 by: Matthew Greet Rev date: 12/06/04 20:08:30
- * Capacity property.
- *
- * Revision 1.2.1.1 by: Matthew Greet Rev date: 14/02/04 17:46:10
- * v1.0 branch.
- *
- * Revision 1.2 by: Matthew Greet Rev date: 28/04/03 15:07:14
- * Correctly handles nil items.
- *
- * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:43:16
- * Added TPArrayMap and TExposedPArrayList.
- *
- * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02
- * Initial revision.
- *
- * FPC compatibility fixes by: UltraStar Deluxe Team
- *
- * $Endlog$
- *****************************************************************************)
-
-{$IFDEF FPC}
- {$MODE Delphi}{$H+}
-{$ENDIF}
-
-interface
-
-uses
- Classes,
- Collections;
-
-type
- TPArrayBag = class(TAbstractBag)
- private
- FList: TList;
- protected
- function TrueAdd(const Item: ICollectable): Boolean; override;
- procedure TrueClear; override;
- function TrueRemove(const Item: ICollectable): ICollectable; override;
- function TrueRemoveAll(const Item: ICollectable): ICollection; override;
- public
- constructor Create(NaturalItemsOnly: Boolean); override;
- destructor Destroy; override;
- function GetCapacity: Integer; override;
- procedure SetCapacity(Value: Integer); override;
- function GetIterator: IIterator; override;
- function GetSize: Integer; override;
- function TrueContains(const Item: ICollectable): Boolean; override;
- end;
-
- TPArraySet = class(TAbstractSet)
- private
- FList: TList;
- protected
- function GetPosition(const Item: ICollectable): TCollectionPosition; override;
- procedure TrueAdd2(Position: TCollectionPosition; const Item: ICollectable); override;
- procedure TrueClear; override;
- function TrueGet(Position: TCollectionPosition): ICollectable; override;
- procedure TrueRemove2(Position: TCollectionPosition); override;
- public
- constructor Create(NaturalItemsOnly: Boolean); override;
- destructor Destroy; override;
- function GetCapacity: Integer; override;
- procedure SetCapacity(Value: Integer); override;
- function GetIterator: IIterator; override;
- function GetSize: Integer; override;
- end;
-
- TPArrayList = class(TAbstractList)
- private
- FList: TList;
- protected
- function TrueGetItem(Index: Integer): ICollectable; override;
- procedure TrueSetItem(Index: Integer; const Item: ICollectable); override;
- procedure TrueAppend(const Item: ICollectable); override;
- procedure TrueClear; override;
- function TrueDelete(Index: Integer): ICollectable; override;
- procedure TrueInsert(Index: Integer; const Item: ICollectable); override;
- public
- constructor Create(NaturalItemsOnly: Boolean); override;
- destructor Destroy; override;
- function GetCapacity: Integer; override;
- procedure SetCapacity(Value: Integer); override;
- function GetIterator: IIterator; override;
- function GetSize: Integer; override;
- end;
-
- TPArrayMap = class(TAbstractMap)
- private
- FList: TList;
- protected
- function GetAssociationIterator: IMapIterator; override;
- function GetKeyPosition(const Key: ICollectable): TCollectionPosition; override;
- procedure TrueClear; override;
- function TrueGet(Position: TCollectionPosition): IAssociation; override;
- function TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation; override;
- function TrueRemove2(Position: TCollectionPosition): IAssociation; override;
- public
- constructor Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); override;
- destructor Destroy; override;
- function GetCapacity: Integer; override;
- procedure SetCapacity(Value: Integer); override;
- function GetSize: Integer; override;
- end;
-
- // Same as TPArrayList but raises method visibilities so items can be manually
- // appended or inserted without resetting sort flag.
- TExposedPArrayList = class(TPArrayList)
- public
- procedure TrueAppend(const Item: ICollectable); override;
- procedure TrueInsert(Index: Integer; const Item: ICollectable); override;
- end;
-
-
-implementation
-
-type
- TPArrayIterator = class(TAbstractIterator)
- private
- FList: TList;
- FIndex: Integer;
- protected
- constructor Create(List: TList; AllowRemove: Boolean);
- function TrueFirst: ICollectable; override;
- function TrueNext: ICollectable; override;
- procedure TrueRemove; override;
- end;
-
- TPArrayAssociationIterator = class(TAbstractAssociationIterator)
- private
- FList: TList;
- FIndex: Integer;
- protected
- constructor Create(List: TList; AllowRemove: Boolean);
- function TrueFirst: IAssociation; override;
- function TrueNext: IAssociation; override;
- procedure TrueRemove; override;
- end;
-
- TPArrayPosition = class(TCollectionPosition)
- private
- FIndex: Integer;
- public
- constructor Create(Found: Boolean; Index: Integer);
- property Index: Integer read FIndex;
- end;
-
-constructor TPArrayBag.Create(NaturalItemsOnly: Boolean);
-begin
- inherited Create(NaturalItemsOnly);
- FList := TList.Create;
-end;
-
-destructor TPArrayBag.Destroy;
-begin
- FList.Free;
- inherited Destroy;
-end;
-
-function TPArrayBag.TrueAdd(const Item: ICollectable): Boolean;
-begin
- FList.Add(Pointer(Item));
- Result := true;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- if Item <> nil then
- Item._AddRef;
-end;
-
-procedure TPArrayBag.TrueClear;
-var
- Item: ICollectable;
- I: Integer;
-begin
- // Delete all interface references
- for I := 0 to FList.Count - 1 do
- begin
- Item := ICollectable(FList[I]);
- FList[I] := nil;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- if Item <> nil then
- Item._Release;
- end;
- FList.Clear;
-end;
-
-function TPArrayBag.TrueContains(const Item: ICollectable): Boolean;
-var
- I: Integer;
- Success: Boolean;
-begin
- // Sequential search
- I := 0;
- Success := false;
- while (I < FList.Count) and not Success do
- begin
- Success := Comparator.Equals(Item, ICollectable(FList[I]));
- Inc(I);
- end;
- Result := Success;
-end;
-
-function TPArrayBag.TrueRemove(const Item: ICollectable): ICollectable;
-var
- Item2: ICollectable;
- I: Integer;
- Found: Boolean;
-begin
- // Sequential search
- I := 0;
- Found := false;
- Result := nil;
- while (I < FList.Count) and not Found do
- begin
- Item2 := ICollectable(FList[I]);
- if Comparator.Equals(Item, Item2) then
- begin
- Found := true;
- Result := Item2;
- FList.Delete(I);
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- if Item2 <> nil then
- Item2._Release;
- end
- else
- Inc(I);
- end;
-end;
-
-function TPArrayBag.TrueRemoveAll(const Item: ICollectable): ICollection;
-var
- ResultCollection: TPArrayBag;
- Item2: ICollectable;
- I: Integer;
-begin
- // Sequential search
- I := 0;
- ResultCollection := TPArrayBag.Create;
- while I < FList.Count do
- begin
- Item2 := ICollectable(FList[I]);
- if Comparator.Equals(Item, Item2) then
- begin
- ResultCollection.Add(Item2);
- FList.Delete(I);
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- if Item <> nil then
- Item._Release;
- end
- else
- Inc(I);
- end;
- Result := ResultCollection;
-end;
-
-function TPArrayBag.GetCapacity: Integer;
-begin
- Result := FList.Capacity;
-end;
-
-procedure TPArrayBag.SetCapacity(Value: Integer);
-begin
- FList.Capacity := Value;
-end;
-
-function TPArrayBag.GetIterator: IIterator;
-begin
- Result := TPArrayIterator.Create(FList, true);
-end;
-
-function TPArrayBag.GetSize: Integer;
-begin
- Result := FList.Count;
-end;
-
-constructor TPArraySet.Create(NaturalItemsOnly: Boolean);
-begin
- inherited Create(NaturalItemsOnly);
- FList := TList.Create;
-end;
-
-destructor TPArraySet.Destroy;
-begin
- FList.Free;
- inherited Destroy;
-end;
-
-function TPArraySet.GetPosition(const Item: ICollectable): TCollectionPosition;
-var
- I: Integer;
- Success: Boolean;
-begin
- // Sequential search
- I := 0;
- Success := false;
- while (I < FList.Count) do
- begin
- Success := Comparator.Equals(Item, ICollectable(FList[I]));
- if Success then
- break;
- Inc(I);
- end;
- Result := TPArrayPosition.Create(Success, I);
-end;
-
-procedure TPArraySet.TrueAdd2(Position: TCollectionPosition; const Item: ICollectable);
-begin
- FList.Add(Pointer(Item));
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Item._AddRef;
-end;
-
-procedure TPArraySet.TrueClear;
-var
- Item: ICollectable;
- I: Integer;
-begin
- // Delete all interface references
- for I := 0 to FList.Count - 1 do
- begin
- Item := ICollectable(FList[I]);
- FList[I] := nil;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Item._Release;
- end;
- FList.Clear;
-end;
-
-function TPArraySet.TrueGet(Position: TCollectionPosition): ICollectable;
-begin
- Result := ICollectable(FList.Items[TPArrayPosition(Position).Index]);
-end;
-
-procedure TPArraySet.TrueRemove2(Position: TCollectionPosition);
-var
- Item: ICollectable;
-begin
- Item := ICollectable(FList[TPArrayPosition(Position).Index]);
- FList.Delete(TPArrayPosition(Position).Index);
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Item._Release;
-end;
-
-function TPArraySet.GetCapacity: Integer;
-begin
- Result := FList.Capacity;
-end;
-
-procedure TPArraySet.SetCapacity(Value: Integer);
-begin
- FList.Capacity := Value;
-end;
-
-function TPArraySet.GetIterator: IIterator;
-begin
- Result := TPArrayIterator.Create(FList, true);
-end;
-
-function TPArraySet.GetSize: Integer;
-begin
- Result := FList.Count;
-end;
-
-constructor TPArrayList.Create(NaturalItemsOnly: Boolean);
-begin
- inherited Create(NaturalItemsOnly);
- FList := TList.Create;
-end;
-
-destructor TPArrayList.Destroy;
-begin
- FList.Free;
- inherited Destroy;
-end;
-
-function TPArrayList.TrueGetItem(Index: Integer): ICollectable;
-begin
- Result := ICollectable(FList.Items[Index]);
-end;
-
-procedure TPArrayList.TrueSetItem(Index: Integer; const Item: ICollectable);
-var
- OldItem: ICollectable;
-begin
- OldItem := ICollectable(FList[Index]);
- FList[Index] := Pointer(Item);
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- if Item <> nil then
- Item._AddRef;
- if OldItem <> nil then
- OldItem._Release;
-end;
-
-procedure TPArrayList.TrueAppend(const Item: ICollectable);
-begin
- FList.Add(Pointer(Item));
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- if Item <> nil then
- Item._AddRef;
-end;
-
-procedure TPArrayList.TrueClear;
-var
- Item: ICollectable;
- I: Integer;
-begin
- // Delete all interface references
- for I := 0 to FList.Count - 1 do
- begin
- Item := ICollectable(FList[I]);
- FList[I] := nil;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- if Item <> nil then
- Item._Release;
- end;
- FList.Clear;
-end;
-
-function TPArrayList.TrueDelete(Index: Integer): ICollectable;
-begin
- Result := ICollectable(FList[Index]);
- FList.Delete(Index);
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- if Result <> nil then
- Result._Release;
-end;
-
-procedure TPArrayList.TrueInsert(Index: Integer; const Item: ICollectable);
-begin
- FList.Insert(Index, Pointer(Item));
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- if Item <> nil then
- Item._AddRef;
-end;
-
-function TPArrayList.GetCapacity: Integer;
-begin
- Result := FList.Capacity;
-end;
-
-procedure TPArrayList.SetCapacity(Value: Integer);
-begin
- FList.Capacity := Value;
-end;
-
-function TPArrayList.GetIterator: IIterator;
-begin
- Result := TPArrayIterator.Create(FList, true);
-end;
-
-function TPArrayList.GetSize: Integer;
-begin
- Result := FList.Count;
-end;
-
-constructor TPArrayMap.Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean);
-begin
- inherited Create(NaturalItemsOnly, NaturalKeysOnly);
- FList := TList.Create;
-end;
-
-destructor TPArrayMap.Destroy;
-begin
- FList.Free;
- inherited Destroy;
-end;
-
-function TPArrayMap.GetAssociationIterator: IMapIterator;
-begin
- Result := TPArrayAssociationIterator.Create(FList, true);
-end;
-
-function TPArrayMap.GetKeyPosition(const Key: ICollectable): TCollectionPosition;
-var
- I: Integer;
- Success: Boolean;
-begin
- // Sequential search
- I := 0;
- Success := false;
- while (I < FList.Count) do
- begin
- Success := KeyComparator.Equals(Key, IAssociation(FList[I]).GetKey);
- if Success then
- break;
- Inc(I);
- end;
- Result := TPArrayPosition.Create(Success, I);
-end;
-
-procedure TPArrayMap.TrueClear;
-var
- Association: IAssociation;
- I: Integer;
-begin
- // Delete all interface references
- for I := 0 to FList.Count - 1 do
- begin
- Association := IAssociation(FList[I]);
- FList[I] := nil;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._Release;
- end;
- FList.Clear;
-end;
-
-function TPArrayMap.TrueGet(Position: TCollectionPosition): IAssociation;
-begin
- Result := IAssociation(FList.Items[TPArrayPosition(Position).Index]);
-end;
-
-function TPArrayMap.TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation;
-var
- OldAssociation: IAssociation;
- Index: Integer;
-begin
- if Position.Found then
- begin
- Index := (Position as TPArrayPosition).Index;
- OldAssociation := IAssociation(FList[Index]);
- FList[Index] := Pointer(Association);
- end
- else
- begin
- OldAssociation := nil;
- FList.Add(Pointer(Association));
- end;
- Result := OldAssociation;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._AddRef;
- if OldAssociation <> nil then
- OldAssociation._Release;
-end;
-
-function TPArrayMap.TrueRemove2(Position: TCollectionPosition): IAssociation;
-var
- OldAssociation: IAssociation;
-begin
- OldAssociation := IAssociation(FList[TPArrayPosition(Position).Index]);
- FList.Delete(TPArrayPosition(Position).Index);
- Result := OldAssociation;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- OldAssociation._Release;
-end;
-
-function TPArrayMap.GetCapacity: Integer;
-begin
- Result := FList.Capacity;
-end;
-
-procedure TPArrayMap.SetCapacity(Value: Integer);
-begin
- FList.Capacity := Value;
-end;
-
-function TPArrayMap.GetSize: Integer;
-begin
- Result := FList.Count;
-end;
-
-procedure TExposedPArrayList.TrueAppend(const Item: ICollectable);
-begin
- inherited TrueAppend(Item);
-end;
-
-procedure TExposedPArrayList.TrueInsert(Index: Integer; const Item: ICollectable);
-begin
- inherited TrueInsert(Index, Item);
-end;
-
-{ TPArrayIterator }
-constructor TPArrayIterator.Create(List: TList; AllowRemove: Boolean);
-begin
- inherited Create(AllowRemove);
- FList := List;
- FIndex := -1;
-end;
-
-function TPArrayIterator.TrueFirst: ICollectable;
-begin
- FIndex := 0;
- if FIndex < FList.Count then
- Result := ICollectable(FList[FIndex])
- else
- Result := nil;
-end;
-
-function TPArrayIterator.TrueNext: ICollectable;
-begin
- Inc(FIndex);
- if FIndex < FList.Count then
- Result := ICollectable(FList[FIndex])
- else
- Result := nil;
-end;
-
-procedure TPArrayIterator.TrueRemove;
-var
- Item: ICollectable;
-begin
- Item := ICollectable(FList[FIndex]);
- FList.Delete(FIndex);
- Dec(FIndex);
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Item._Release;
-end;
-
-{ TPArrayAssociationIterator }
-constructor TPArrayAssociationIterator.Create(List: TList; AllowRemove: Boolean);
-begin
- inherited Create(AllowRemove);
- FList := List;
- FIndex := -1;
-end;
-
-function TPArrayAssociationIterator.TrueFirst: IAssociation;
-begin
- FIndex := 0;
- if FIndex < FList.Count then
- Result := IAssociation(FList[FIndex])
- else
- Result := nil;
-end;
-
-function TPArrayAssociationIterator.TrueNext: IAssociation;
-begin
- Inc(FIndex);
- if FIndex < FList.Count then
- Result := IAssociation(FList[FIndex])
- else
- Result := nil;
-end;
-
-procedure TPArrayAssociationIterator.TrueRemove;
-var
- Association: IAssociation;
-begin
- Association := IAssociation(FList[FIndex]);
- FList.Delete(FIndex);
- Dec(FIndex);
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._Release;
-end;
-
-{ TPArrayPosition }
-constructor TPArrayPosition.Create(Found: Boolean; Index: Integer);
-begin
- inherited Create(Found);
- FIndex := Index;
-end;
-
-end.
diff --git a/src/lib/collections/CollWrappers.pas b/src/lib/collections/CollWrappers.pas
deleted file mode 100644
index 513103a2..00000000
--- a/src/lib/collections/CollWrappers.pas
+++ /dev/null
@@ -1,876 +0,0 @@
-unit CollWrappers;
-
-(*****************************************************************************
- * Copyright 2003 by Matthew Greet
- * 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.1 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. (http://opensource.org/licenses/lgpl-license.php)
- *
- * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
- *
- * $Version: v1.0.3 $
- * $Revision: 1.1.1.1 $
- * $Log: D:\QVCS Repositories\Delphi Collections\CollWrappers.qbt $
- *
- * Various primitive type wrappers, adapters and abstract base classes for
- * natural items.
- *
- * Revision 1.1.1.1 by: Matthew Greet Rev date: 24/10/03 16:48:16
- * v1.0 branch.
- *
- * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:51:04
- * Primitive type wrapper interfaces added.
- * Abstract, template classes added.
- * All classes implement reference counting by descending from
- * TInterfacedObject.
- *
- *
- * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02
- * Initial revision.
- *
- * FPC compatibility fixes by: UltraStar Deluxe Team
- *
- * $Endlog$
- *****************************************************************************)
-
-{$IFDEF FPC}
- {$MODE Delphi}{$H+}
-{$ENDIF}
-
-interface
-
-uses
- SysUtils,
- Collections;
-
-type
- IAssociationWrapper = interface
- ['{54DF42E0-64F2-11D7-8120-0002E3165EF8}']
- function GetAutoDestroy: Boolean;
- procedure SetAutoDestroy(Value: Boolean);
- function GetKey: ICollectable;
- function GetValue: TObject;
- property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy;
- property Key: ICollectable read GetKey;
- property Value: TObject read GetValue;
- end;
-
- IBoolean = interface
- ['{62D1D160-64F2-11D7-8120-0002E3165EF8}']
- function GetValue: Boolean;
- property Value: Boolean read GetValue;
- end;
-
- ICardinal = interface
- ['{6AF7B1C0-64F2-11D7-8120-0002E3165EF8}']
- function GetValue: Cardinal;
- property Value: Cardinal read GetValue;
- end;
-
- IChar = interface
- ['{73AD00E0-64F2-11D7-8120-0002E3165EF8}']
- function GetValue: Char;
- property Value: Char read GetValue;
- end;
-
- IClass = interface
- ['{7A84B660-64F2-11D7-8120-0002E3165EF8}']
- function GetValue: TClass;
- property Value: TClass read GetValue;
- end;
-
- IDouble = interface
- ['{815C6BE0-64F2-11D7-8120-0002E3165EF8}']
- function GetValue: Double;
- property Value: Double read GetValue;
- end;
-
- IInteger = interface
- ['{88ECC300-64F2-11D7-8120-0002E3165EF8}']
- function GetValue: Integer;
- property Value: Integer read GetValue;
- end;
-
- IIntegerAssociationWrapper = interface
- ['{8F582220-64F2-11D7-8120-0002E3165EF8}']
- function GetAutoDestroy: Boolean;
- procedure SetAutoDestroy(Value: Boolean);
- function GetKey: Integer;
- function GetValue: TObject;
- property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy;
- property Key: Integer read GetKey;
- property Value: TObject read GetValue;
- end;
-
- IInterfaceWrapper = interface
- ['{962E5100-64F2-11D7-8120-0002E3165EF8}']
- function GetValue: IUnknown;
- property Value: IUnknown read GetValue;
- end;
-
- IObject = interface
- ['{9C675580-64F2-11D7-8120-0002E3165EF8}']
- function GetAutoDestroy: Boolean;
- procedure SetAutoDestroy(Value: Boolean);
- function GetValue: TObject;
- property Value: TObject read GetValue;
- end;
-
- IString = interface
- ['{A420DF80-64F2-11D7-8120-0002E3165EF8}']
- function GetValue: String;
- property Value: String read GetValue;
- end;
-
- IStringAssociationWrapper = interface
- ['{AB98CCA0-64F2-11D7-8120-0002E3165EF8}']
- function GetAutoDestroy: Boolean;
- procedure SetAutoDestroy(Value: Boolean);
- function GetKey: String;
- function GetValue: TObject;
- property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy;
- property Key: String read GetKey;
- property Value: TObject read GetValue;
- end;
-
- TAbstractItem = class(TInterfacedObject, ICollectable)
- public
- function GetInstance: TObject; virtual;
- end;
-
- TAbstractIntegerMappable = class(TAbstractItem, IEquatable, IIntegerMappable)
- private
- FKey: Integer;
- protected
- function MakeKey: Integer; virtual; abstract;
- public
- procedure AfterConstruction; override;
- function Equals(const Item: ICollectable): Boolean; virtual;
- function GetKey: Integer; virtual;
- end;
-
- TAbstractMappable = class(TAbstractItem, IEquatable, IMappable)
- private
- FKey: ICollectable;
- protected
- function MakeKey: ICollectable; virtual; abstract;
- public
- destructor Destroy; override;
- procedure AfterConstruction; override;
- function Equals(const Item: ICollectable): Boolean; virtual;
- function GetKey: ICollectable; virtual;
- end;
-
- TAbstractStringMappable = class(TAbstractItem, IEquatable, IStringMappable)
- private
- FKey: String;
- protected
- function MakeKey: String; virtual; abstract;
- public
- procedure AfterConstruction; override;
- function Equals(const Item: ICollectable): Boolean; virtual;
- function GetKey: String; virtual;
- end;
-
- TAssociationWrapper = class(TAbstractItem, IEquatable, IMappable, IAssociationWrapper)
- private
- FAutoDestroy: Boolean;
- FKey: ICollectable;
- FValue: TObject;
- public
- constructor Create(const Key: ICollectable; Value: TObject); overload;
- constructor Create(Key: Integer; Value: TObject); overload;
- constructor Create(Key: String; Value: TObject); overload;
- constructor Create(Key, Value: TObject; AutoDestroyKey: Boolean = true); overload;
- destructor Destroy; override;
- function GetAutoDestroy: Boolean;
- procedure SetAutoDestroy(Value: Boolean);
- function GetKey: ICollectable;
- function GetValue: TObject;
- function Equals(const Item: ICollectable): Boolean;
- property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy;
- property Key: ICollectable read GetKey;
- property Value: TObject read GetValue;
- end;
-
- TBooleanWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IBoolean)
- private
- FValue: Boolean;
- public
- constructor Create(Value: Boolean);
- function GetValue: Boolean;
- function CompareTo(const Item: ICollectable): Integer;
- function Equals(const Item: ICollectable): Boolean;
- function HashCode: Integer;
- property Value: Boolean read GetValue;
- end;
-
- TCardinalWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, ICardinal)
- private
- FValue: Cardinal;
- public
- constructor Create(Value: Cardinal);
- function GetValue: Cardinal;
- function Equals(const Item: ICollectable): Boolean;
- function HashCode: Integer;
- function CompareTo(const Item: ICollectable): Integer;
- property Value: Cardinal read GetValue;
- end;
-
- TCharWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IChar)
- private
- FValue: Char;
- public
- constructor Create(Value: Char);
- function GetValue: Char;
- function Equals(const Item: ICollectable): Boolean;
- function HashCode: Integer;
- function CompareTo(const Item: ICollectable): Integer;
- property Value: Char read GetValue;
- end;
-
- TClassWrapper = class(TAbstractItem, IEquatable, IHashable, IClass)
- private
- FValue: TClass;
- public
- constructor Create(Value: TClass);
- function GetValue: TClass;
- function Equals(const Item: ICollectable): Boolean;
- function HashCode: Integer;
- property Value: TClass read GetValue;
- end;
-
- TDoubleWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IDouble)
- private
- FValue: Double;
- public
- constructor Create(Value: Double);
- function GetValue: Double;
- function Equals(const Item: ICollectable): Boolean;
- function HashCode: Integer;
- function CompareTo(const Item: ICollectable): Integer;
- property Value: Double read GetValue;
- end;
-
- TIntegerWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IInteger)
- private
- FValue: Integer;
- public
- constructor Create(Value: Integer);
- function GetValue: Integer;
- function Equals(const Item: ICollectable): Boolean;
- function HashCode: Integer;
- function CompareTo(const Item: ICollectable): Integer;
- property Value: Integer read GetValue;
- end;
-
- TIntegerAssociationWrapper = class(TAbstractItem, IEquatable, IIntegerMappable, IIntegerAssociationWrapper)
- private
- FAutoDestroy: Boolean;
- FKey: Integer;
- FValue: TObject;
- public
- constructor Create(const Key: Integer; Value: TObject); overload;
- destructor Destroy; override;
- function Equals(const Item: ICollectable): Boolean;
- function GetAutoDestroy: Boolean;
- procedure SetAutoDestroy(Value: Boolean);
- function GetKey: Integer;
- function GetValue: TObject;
- property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy;
- property Key: Integer read GetKey;
- property Value: TObject read GetValue;
- end;
-
- TInterfaceWrapper = class(TAbstractItem, IHashable, IEquatable, IInterfaceWrapper)
- private
- FValue: IUnknown;
- public
- constructor Create(const Value: IUnknown);
- destructor Destroy; override;
- function GetValue: IUnknown;
- function Equals(const Item: ICollectable): Boolean;
- function HashCode: Integer;
- property Value: IUnknown read GetValue;
- end;
-
- TObjectWrapper = class(TAbstractItem, IEquatable, IComparable, IHashable, IObject)
- private
- FAutoDestroy: Boolean;
- FValue: TObject;
- public
- constructor Create(Value: TObject); overload;
- destructor Destroy; override;
- function GetAutoDestroy: Boolean;
- procedure SetAutoDestroy(Value: Boolean);
- function GetValue: TObject;
- function CompareTo(const Item: ICollectable): Integer;
- function Equals(const Item: ICollectable): Boolean;
- function HashCode: Integer;
- property AutoDestroy: Boolean read FAutoDestroy write FAutoDestroy;
- property Value: TObject read GetValue;
- end;
-
- TStringWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IString)
- private
- FValue: String;
- public
- constructor Create(Value: String);
- function GetValue: String;
- function Equals(const Item: ICollectable): Boolean;
- function HashCode: Integer;
- function CompareTo(const Item: ICollectable): Integer;
- property Value: String read FValue;
- end;
-
- TStringAssociationWrapper = class(TAbstractItem, IEquatable, IStringMappable, IStringAssociationWrapper)
- private
- FAutoDestroy: Boolean;
- FKey: String;
- FValue: TObject;
- public
- constructor Create(const Key: String; Value: TObject); overload;
- destructor Destroy; override;
- function GetAutoDestroy: Boolean;
- procedure SetAutoDestroy(Value: Boolean);
- function GetKey: String;
- function GetValue: TObject;
- function Equals(const Item: ICollectable): Boolean;
- property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy;
- property Key: String read GetKey;
- property Value: TObject read GetValue;
- end;
-
-implementation
-
-{ TAbstractItem }
-function TAbstractItem.GetInstance: TObject;
-begin
- Result := Self;
-end;
-
-
-{ TAbstractIntegerMappable }
-procedure TAbstractIntegerMappable.AfterConstruction;
-begin
- inherited AfterConstruction;
- FKey := MakeKey;
-end;
-
-function TAbstractIntegerMappable.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self = Item.GetInstance);
-end;
-
-function TAbstractIntegerMappable.GetKey: Integer;
-begin
- Result := FKey;
-end;
-
-{ TAbstractMappable }
-destructor TAbstractMappable.Destroy;
-begin
- FKey := nil;
- inherited Destroy;
-end;
-
-procedure TAbstractMappable.AfterConstruction;
-begin
- inherited AfterConstruction;
- FKey := MakeKey;
-end;
-
-function TAbstractMappable.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self = Item.GetInstance);
-end;
-
-function TAbstractMappable.GetKey: ICollectable;
-begin
- Result := FKey;
-end;
-
-{ TAbstractStringMappable }
-procedure TAbstractStringMappable.AfterConstruction;
-begin
- inherited AfterConstruction;
- FKey := MakeKey;
-end;
-
-function TAbstractStringMappable.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self = Item.GetInstance);
-end;
-
-function TAbstractStringMappable.GetKey: String;
-begin
- Result := FKey;
-end;
-
-{ TAssociationWrapper }
-constructor TAssociationWrapper.Create(const Key: ICollectable; Value: TObject);
-begin
- inherited Create;
- FAutoDestroy := true;
- FKey := Key;
- FValue := Value;
-end;
-
-constructor TAssociationWrapper.Create(Key: Integer; Value: TObject);
-begin
- Create(TIntegerWrapper.Create(Key) as ICollectable, Value);
-end;
-
-constructor TAssociationWrapper.Create(Key: String; Value: TObject);
-begin
- Create(TStringWrapper.Create(Key) as ICollectable, Value);
-end;
-
-constructor TAssociationWrapper.Create(Key, Value: TObject; AutoDestroyKey: Boolean);
-var
- KeyWrapper: TObjectWrapper;
-begin
- KeyWrapper := TObjectWrapper.Create(Key);
- KeyWrapper.AutoDestroy := AutoDestroyKey;
- Create(KeyWrapper as ICollectable, Value);
-end;
-
-destructor TAssociationWrapper.Destroy;
-begin
- if FAutoDestroy then
- FValue.Free;
- FKey := nil;
- inherited Destroy;
-end;
-
-function TAssociationWrapper.GetAutoDestroy: Boolean;
-begin
- Result := FAutoDestroy;
-end;
-
-procedure TAssociationWrapper.SetAutoDestroy(Value: Boolean);
-begin
- FAutoDestroy := Value;
-end;
-
-function TAssociationWrapper.GetKey: ICollectable;
-begin
- Result := FKey;
-end;
-
-function TAssociationWrapper.GetValue: TObject;
-begin
- Result := FValue;
-end;
-
-function TAssociationWrapper.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self.Value = (Item.GetInstance as TAssociationWrapper).Value)
-end;
-
-{ TCardinalWrapper }
-constructor TCardinalWrapper.Create(Value: Cardinal);
-begin
- inherited Create;
- FValue := Value;
-end;
-
-function TCardinalWrapper.GetValue: Cardinal;
-begin
- Result := FValue;
-end;
-
-function TCardinalWrapper.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self.Value = (Item.GetInstance as TCardinalWrapper).Value)
-end;
-
-function TCardinalWrapper.HashCode: Integer;
-begin
- Result := FValue;
-end;
-
-function TCardinalWrapper.CompareTo(const Item: ICollectable): Integer;
-var
- Value2: Cardinal;
-begin
- Value2 := (Item.GetInstance as TCardinalWrapper).Value;
- if Value < Value2 then
- Result := -1
- else if Value > Value2 then
- Result := 1
- else
- Result := 0;
-end;
-
-{ TBooleanWrapper }
-constructor TBooleanWrapper.Create(Value: Boolean);
-begin
- inherited Create;
- FValue := Value;
-end;
-
-function TBooleanWrapper.GetValue: Boolean;
-begin
- Result := FValue;
-end;
-
-function TBooleanWrapper.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self.Value = (Item.GetInstance as TBooleanWrapper).Value)
-end;
-
-function TBooleanWrapper.HashCode: Integer;
-begin
- Result := Ord(FValue);
-end;
-
-function TBooleanWrapper.CompareTo(const Item: ICollectable): Integer;
-var
- Value2: Boolean;
-begin
- Value2 := (Item.GetInstance as TBooleanWrapper).Value;
- if not Value and Value2 then
- Result := -1
- else if Value and not Value2 then
- Result := 1
- else
- Result := 0;
-end;
-
-{ TCharWrapper }
-constructor TCharWrapper.Create(Value: Char);
-begin
- inherited Create;
- FValue := Value;
-end;
-
-function TCharWrapper.GetValue: Char;
-begin
- Result := FValue;
-end;
-
-function TCharWrapper.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self.Value = (Item.GetInstance as TCharWrapper).Value)
-end;
-
-function TCharWrapper.HashCode: Integer;
-begin
- Result := Integer(FValue);
-end;
-
-function TCharWrapper.CompareTo(const Item: ICollectable): Integer;
-var
- Value2: Char;
-begin
- Value2 := (Item.GetInstance as TCharWrapper).Value;
- if Value < Value2 then
- Result := -1
- else if Value > Value2 then
- Result := 1
- else
- Result := 0;
-end;
-
-{ TClassWrapper }
-constructor TClassWrapper.Create(Value: TClass);
-begin
- inherited Create;
- FValue := Value;
-end;
-
-function TClassWrapper.GetValue: TClass;
-begin
- Result := FValue;
-end;
-
-function TClassWrapper.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self.Value = (Item.GetInstance as TClassWrapper).Value)
-end;
-
-function TClassWrapper.HashCode: Integer;
-begin
- Result := Integer(FValue.ClassInfo);
-end;
-
-{ TDoubleWrapper }
-constructor TDoubleWrapper.Create(Value: Double);
-begin
- inherited Create;
- FValue := Value;
-end;
-
-function TDoubleWrapper.GetValue: Double;
-begin
- Result := FValue;
-end;
-
-function TDoubleWrapper.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self.Value = (Item.GetInstance as TDoubleWrapper).Value)
-end;
-
-function TDoubleWrapper.HashCode: Integer;
-var
- DblAsInt: array[0..1] of Integer;
-begin
- Double(DblAsInt) := Value;
- Result := DblAsInt[0] xor DblAsInt[1];
-end;
-
-function TDoubleWrapper.CompareTo(const Item: ICollectable): Integer;
-var
- Value2: Double;
-begin
- Value2 := (Item.GetInstance as TDoubleWrapper).Value;
- if Value < Value2 then
- Result := -1
- else if Value > Value2 then
- Result := 1
- else
- Result := 0;
-end;
-
-{ TIntegerWrapper }
-constructor TIntegerWrapper.Create(Value: Integer);
-begin
- inherited Create;
- FValue := Value;
-end;
-
-function TIntegerWrapper.GetValue: Integer;
-begin
- Result := FValue;
-end;
-
-function TIntegerWrapper.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self.Value = (Item.GetInstance as TIntegerWrapper).Value)
-end;
-
-function TIntegerWrapper.HashCode: Integer;
-begin
- Result := FValue;
-end;
-
-function TIntegerWrapper.CompareTo(const Item: ICollectable): Integer;
-var
- Value2: Integer;
-begin
- Value2 := (Item.GetInstance as TIntegerWrapper).Value;
- if Value < Value2 then
- Result := -1
- else if Value > Value2 then
- Result := 1
- else
- Result := 0;
-end;
-
-{ TIntegerAssociationWrapper }
-constructor TIntegerAssociationWrapper.Create(const Key: Integer; Value: TObject);
-begin
- inherited Create;
- FAutoDestroy := true;
- FKey := Key;
- FValue := Value;
-end;
-
-destructor TIntegerAssociationWrapper.Destroy;
-begin
- if FAutoDestroy then
- FValue.Free;
- inherited Destroy;
-end;
-
-function TIntegerAssociationWrapper.GetAutoDestroy: Boolean;
-begin
- Result := FAutoDestroy;
-end;
-
-procedure TIntegerAssociationWrapper.SetAutoDestroy(Value: Boolean);
-begin
- FAutoDestroy := Value;
-end;
-
-function TIntegerAssociationWrapper.GetValue: TObject;
-begin
- Result := FValue;
-end;
-
-function TIntegerAssociationWrapper.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self.Value = (Item.GetInstance as TIntegerAssociationWrapper).Value)
-end;
-
-function TIntegerAssociationWrapper.GetKey: Integer;
-begin
- Result := FKey;
-end;
-
-{ TStringAssociationWrapper }
-constructor TStringAssociationWrapper.Create(const Key: String; Value: TObject);
-begin
- inherited Create;
- FAutoDestroy := true;
- FKey := Key;
- FValue := Value;
-end;
-
-destructor TStringAssociationWrapper.Destroy;
-begin
- if FAutoDestroy then
- FValue.Free;
- inherited Destroy;
-end;
-
-function TStringAssociationWrapper.GetAutoDestroy: Boolean;
-begin
- Result := FAutoDestroy;
-end;
-
-procedure TStringAssociationWrapper.SetAutoDestroy(Value: Boolean);
-begin
- FAutoDestroy := Value;
-end;
-
-function TStringAssociationWrapper.GetValue: TObject;
-begin
- Result := FValue;
-end;
-
-function TStringAssociationWrapper.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self.Value = (Item.GetInstance as TStringAssociationWrapper).Value)
-end;
-
-function TStringAssociationWrapper.GetKey: String;
-begin
- Result := FKey;
-end;
-
-{ TInterfaceWrapper }
-constructor TInterfaceWrapper.Create(const Value: IUnknown);
-begin
- inherited Create;
- FValue := Value;
-end;
-
-destructor TInterfaceWrapper.Destroy;
-begin
- FValue := nil;
- inherited Destroy;
-end;
-
-function TInterfaceWrapper.GetValue: IUnknown;
-begin
- Result := FValue;
-end;
-
-function TInterfaceWrapper.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self.Value = (Item.GetInstance as TInterfaceWrapper).Value)
-end;
-
-function TInterfaceWrapper.HashCode: Integer;
-begin
- Result := Integer(Pointer(FValue));
-end;
-
-{ TObjectWrapper }
-constructor TObjectWrapper.Create(Value: TObject);
-begin
- inherited Create;
- FAutoDestroy := true;
- FValue := Value;
-end;
-
-destructor TObjectWrapper.Destroy;
-begin
- if FAutoDestroy then
- FValue.Free;
- inherited Destroy;
-end;
-
-function TObjectWrapper.GetAutoDestroy: Boolean;
-begin
- Result := FAutoDestroy;
-end;
-
-procedure TObjectWrapper.SetAutoDestroy(Value: Boolean);
-begin
- FAutoDestroy := Value;
-end;
-
-function TObjectWrapper.GetValue: TObject;
-begin
- Result := FValue;
-end;
-
-function TObjectWrapper.CompareTo(const Item: ICollectable): Integer;
-var
- Value1, Value2: Integer;
-begin
- Value1 := Integer(Pointer(Self));
- if Item <> nil then
- Value2 := Integer(Pointer(Item))
- else
- Value2 := Low(Integer);
- if (Value1 < Value2) then
- Result := -1
- else if (Value1 > Value2) then
- Result := 1
- else
- Result := 0;
-end;
-
-function TObjectWrapper.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self.Value = (Item.GetInstance as TObjectWrapper).Value)
-end;
-
-function TObjectWrapper.HashCode: Integer;
-begin
- Result := Integer(Pointer(FValue));
-end;
-
-{ TStringWrapper }
-constructor TStringWrapper.Create(Value: String);
-begin
- inherited Create;
- FValue := Value;
-end;
-
-function TStringWrapper.GetValue: String;
-begin
- Result := FValue;
-end;
-
-function TStringWrapper.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self.Value = (Item.GetInstance as TStringWrapper).Value)
-end;
-
-function TStringWrapper.HashCode: Integer;
-var
- I: Integer;
-begin
- Result := 0;
- for I := 1 to Length(FValue) do
- Result := (Result shl 1) xor Ord(FValue[I]);
-end;
-
-function TStringWrapper.CompareTo(const Item: ICollectable): Integer;
-begin
- Result := CompareStr(Self.Value, (Item.GetInstance as TStringWrapper).Value)
-end;
-
-
-end.
diff --git a/src/lib/collections/Collections.pas b/src/lib/collections/Collections.pas
deleted file mode 100644
index 0c94173d..00000000
--- a/src/lib/collections/Collections.pas
+++ /dev/null
@@ -1,5318 +0,0 @@
-unit Collections;
-(*****************************************************************************
- * Copyright 2003 by Matthew Greet
- * 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.1 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. (http://opensource.org/licenses/lgpl-license.php)
- *
- * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
- *
- * $Version: v1.0 $
- * $Revision: 1.1.1.4 $
- * $Log: D:\QVCS Repositories\Delphi Collections\Collections.qbt $
- *
- * Main unit containing all interface and abstract class definitions.
- *
- * Revision 1.1.1.4 by: Matthew Greet Rev date: 14/03/05 23:26:32
- * Fixed RemoveAll for TAbstractList for sorted lists.
- *
- * Revision 1.1.1.3 by: Matthew Greet Rev date: 14/10/04 16:31:18
- * Fixed memory lean in ContainsKey of TAbstractStringMap and
- * TAbstractIntegerMap.
- *
- * Revision 1.1.1.2 by: Matthew Greet Rev date: 12/06/04 20:03:26
- * Capacity property.
- * Memory leak fixed.
- *
- * Revision 1.1.1.1 by: Matthew Greet Rev date: 13/02/04 16:12:10
- * v1.0 branch.
- *
- * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:36:30
- * Added integer map and string map collection types with supporting
- * classes.
- * Add clone and filter functions with supporting classes.
- * Added nil not allowed collection error.
- * Properties appear in collection interfaces as well as abstract
- * classes.
- *
- * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02
- * Initial revision.
- *
- * FPC compatibility fixes by: UltraStar Deluxe Team
- *
- * $Endlog$
- *****************************************************************************)
-
-{$IFDEF FPC}
- {$MODE Delphi}{$H+}
-{$ENDIF}
-
-interface
-
-uses
- Classes, SysUtils;
-
-const
- EquatableIID: TGUID = '{EAC823A7-0B90-11D7-8120-0002E3165EF8}';
- HashableIID: TGUID = '{98998440-4C3E-11D7-8120-0002E3165EF8}';
- ComparableIID: TGUID = '{9F4C96C0-0CF0-11D7-8120-0002E3165EF8}';
- MappableIID: TGUID = '{DAEC8CA0-0DBB-11D7-8120-0002E3165EF8}';
- StringMappableIID: TGUID = '{3CC61F40-5F92-11D7-8120-0002E3165EF8}';
- IntegerMappableIID: TGUID = '{774FC760-5F92-11D7-8120-0002E3165EF8}';
-
-type
- TDefaultComparator = class;
- TNaturalComparator = class;
- ICollectable = interface;
-
- TCollectableArray = array of ICollectable;
- TIntegerArray = array of Integer;
- TStringArray = array of String;
- TListArray = array of TList;
-
- TCollectionError = (ceOK, ceDuplicate, ceDuplicateKey, ceFixedSize, ceNilNotAllowed, ceNotNaturalItem, ceOutOfRange);
- TCollectionErrors = set of TCollectionError;
-
- TSearchResultType = (srNotFound, srFoundAtIndex, srBeforeIndex, srAfterEnd);
-
- TCollectionType = (ctBag, ctSet, ctList, ctMap, ctIntegerMap, ctStringMap);
-
- TCollectionFilterFunc = function (const Item: ICollectable): Boolean of object;
- TCollectionCompareFunc = function (const Item1, Item2: ICollectable): Integer of object;
-
- TSearchResult = record
- ResultType: TSearchResultType;
- Index: Integer;
- end;
-
- ICollectable = interface
- ['{98998441-4C3E-11D7-8120-0002E3165EF8}']
- function GetInstance: TObject;
- end;
-
- IEquatable = interface
- ['{EAC823A7-0B90-11D7-8120-0002E3165EF8}']
- function GetInstance: TObject;
- function Equals(const Item: ICollectable): Boolean;
- end;
-
- IHashable = interface(IEquatable)
- ['{98998440-4C3E-11D7-8120-0002E3165EF8}']
- function HashCode: Integer;
- end;
-
- IComparable = interface(IEquatable)
- ['{9F4C96C0-0CF0-11D7-8120-0002E3165EF8}']
- function CompareTo(const Item: ICollectable): Integer;
- end;
-
- IMappable = interface(IEquatable)
- ['{DAEC8CA0-0DBB-11D7-8120-0002E3165EF8}']
- function GetKey: ICollectable;
- end;
-
- IStringMappable = interface(IEquatable)
- ['{3CC61F40-5F92-11D7-8120-0002E3165EF8}']
- function GetKey: String;
- end;
-
- IIntegerMappable = interface(IEquatable)
- ['{774FC760-5F92-11D7-8120-0002E3165EF8}']
- function GetKey: Integer;
- end;
-
- IComparator = interface
- ['{1F20CD60-10FE-11D7-8120-0002E3165EF8}']
- function GetInstance: TObject;
- function Compare(const Item1, Item2: ICollectable): Integer;
- function Equals(const Item1, Item2: ICollectable): Boolean; overload;
- function Equals(const Comparator: IComparator): Boolean; overload;
- end;
-
- IFilter = interface
- ['{27FE44C0-638E-11D7-8120-0002E3165EF8}']
- function Accept(const Item: ICollectable): Boolean;
- end;
-
- IIterator = interface
- ['{F6930500-1113-11D7-8120-0002E3165EF8}']
- function GetAllowRemoval: Boolean;
- function CurrentItem: ICollectable;
- function EOF: Boolean;
- function First: ICollectable;
- function Next: ICollectable;
- function Remove: Boolean;
- end;
-
- IMapIterator = interface(IIterator)
- ['{848CC0E0-2A31-11D7-8120-0002E3165EF8}']
- function CurrentKey: ICollectable;
- end;
-
- IIntegerMapIterator = interface(IIterator)
- ['{C7169780-606C-11D7-8120-0002E3165EF8}']
- function CurrentKey: Integer;
- end;
-
- IStringMapIterator = interface(IIterator)
- ['{1345ED20-5F93-11D7-8120-0002E3165EF8}']
- function CurrentKey: String;
- end;
-
- IAssociation = interface(ICollectable)
- ['{556CD700-4DB3-11D7-8120-0002E3165EF8}']
- function GetKey: ICollectable;
- function GetValue: ICollectable;
- end;
-
- IIntegerAssociation = interface(ICollectable)
- ['{ED954420-5F94-11D7-8120-0002E3165EF8}']
- function GetKey: Integer;
- function GetValue: ICollectable;
- end;
-
- IStringAssociation = interface(ICollectable)
- ['{FB87D2A0-5F94-11D7-8120-0002E3165EF8}']
- function GetKey: String;
- function GetValue: ICollectable;
- end;
-
- IAssociationComparator = interface(IComparator)
- ['{EA9BE6E0-A852-11D8-B93A-0002E3165EF8}']
- function GetKeyComparator: IComparator;
- procedure SetKeyComparator(Value: IComparator);
- property KeyComparator: IComparator read GetKeyComparator write SetKeyComparator;
- end;
-
- IIntegerAssociationComparator = interface(IComparator)
- ['{EA9BE6E1-A852-11D8-B93A-0002E3165EF8}']
- end;
-
- IStringAssociationComparator = interface(IComparator)
- ['{EA9BE6E2-A852-11D8-B93A-0002E3165EF8}']
- end;
-
- ICollection = interface
- ['{EAC823AC-0B90-11D7-8120-0002E3165EF8}']
- function GetAsArray: TCollectableArray;
- function GetCapacity: Integer;
- procedure SetCapacity(Value: Integer);
- function GetComparator: IComparator;
- procedure SetComparator(const Value: IComparator);
- function GetDuplicates: Boolean;
- function GetFixedSize: Boolean;
- function GetIgnoreErrors: TCollectionErrors;
- procedure SetIgnoreErrors(Value: TCollectionErrors);
- function GetInstance: TObject;
- function GetIterator: IIterator; overload;
- function GetIterator(const Filter: IFilter): IIterator; overload;
- function GetIterator(FilterFunc: TCollectionFilterFunc): IIterator; overload;
- function GetNaturalItemIID: TGUID;
- function GetNaturalItemsOnly: Boolean;
- function GetSize: Integer;
- function GetType: TCollectionType;
- function Add(const Item: ICollectable): Boolean; overload;
- function Add(const ItemArray: array of ICollectable): Integer; overload;
- function Add(const Collection: ICollection): Integer; overload;
- function Clear: Integer;
- function Clone: ICollection;
- function Contains(const Item: ICollectable): Boolean; overload;
- function Contains(const ItemArray: array of ICollectable): Boolean; overload;
- function Contains(const Collection: ICollection): Boolean; overload;
- function Equals(const Collection: ICollection): Boolean;
- function Find(const Filter: IFilter): ICollectable; overload;
- function Find(FilterFunc: TCollectionFilterFunc): ICollectable; overload;
- function FindAll(const Filter: IFilter = nil): ICollection; overload;
- function FindAll(FilterFunc: TCollectionFilterFunc): ICollection; overload;
- function IsEmpty: Boolean;
- function IsNaturalItem(const Item: ICollectable): Boolean;
- function IsNilAllowed: Boolean;
- function ItemAllowed(const Item: ICollectable): TCollectionError;
- function ItemCount(const Item: ICollectable): Integer; overload;
- function ItemCount(const ItemArray: array of ICollectable): Integer; overload;
- function ItemCount(const Collection: ICollection): Integer; overload;
- function Matching(const ItemArray: array of ICollectable): ICollection; overload;
- function Matching(const Collection: ICollection): ICollection; overload;
- function Remove(const Item: ICollectable): ICollectable; overload;
- function Remove(const ItemArray: array of ICollectable): ICollection; overload;
- function Remove(const Collection: ICollection): ICollection; overload;
- function RemoveAll(const Item: ICollectable): ICollection; overload;
- function RemoveAll(const ItemArray: array of ICollectable): ICollection; overload;
- function RemoveAll(const Collection: ICollection): ICollection; overload;
- function Retain(const ItemArray: array of ICollectable): ICollection; overload;
- function Retain(const Collection: ICollection): ICollection; overload;
- property AsArray: TCollectableArray read GetAsArray;
- property Capacity: Integer read GetCapacity write SetCapacity;
- property Comparator: IComparator read GetComparator write SetComparator;
- property FixedSize: Boolean read GetFixedSize;
- property IgnoreErrors: TCollectionErrors read GetIgnoreErrors write SetIgnoreErrors;
- property NaturalItemIID: TGUID read GetNaturalItemIID;
- property NaturalItemsOnly: Boolean read GetNaturalItemsOnly;
- property Size: Integer read GetSize;
- end;
-
- IBag = interface(ICollection)
- ['{C29C9560-2D59-11D7-8120-0002E3165EF8}']
- function CloneAsBag: IBag;
- end;
-
- ISet = interface(ICollection)
- ['{DD7888E2-0BB1-11D7-8120-0002E3165EF8}']
- function CloneAsSet: ISet;
- function Complement(const Universe: ISet): ISet;
- function Intersect(const Set2: ISet): ISet;
- function Union(const Set2: ISet): ISet;
- end;
-
- IList = interface(ICollection)
- ['{EE81AB60-0B9F-11D7-8120-0002E3165EF8}']
- function GetDuplicates: Boolean;
- procedure SetDuplicates(Value: Boolean);
- function GetItem(Index: Integer): ICollectable;
- procedure SetItem(Index: Integer; const Item: ICollectable);
- function GetSorted: Boolean;
- procedure SetSorted(Value: Boolean);
- function CloneAsList: IList;
- function Delete(Index: Integer): ICollectable;
- procedure Exchange(Index1, Index2: Integer);
- function First: ICollectable;
- function IndexOf(const Item: ICollectable): Integer;
- function Insert(Index: Integer; const Item: ICollectable): Boolean; overload;
- function Insert(Index: Integer; const ItemArray: array of ICollectable): Integer; overload;
- function Insert(Index: Integer; const Collection: ICollection): Integer; overload;
- function Last: ICollectable;
- procedure Sort(const Comparator: IComparator); overload;
- procedure Sort(CompareFunc: TCollectionCompareFunc); overload;
- property Duplicates: Boolean read GetDuplicates write SetDuplicates;
- property Items[Index: Integer]: ICollectable read GetItem write SetItem; default;
- property Sorted: Boolean read GetSorted write SetSorted;
- end;
-
- IMap = interface(ICollection)
- ['{AD458280-2A6B-11D7-8120-0002E3165EF8}']
- function GetItem(const Key: ICollectable): ICollectable;
- procedure SetItem(const Key, Item: ICollectable);
- function GetKeyComparator: IComparator;
- procedure SetKeyComparator(const Value: IComparator);
- function GetKeyIterator: IIterator;
- function GetKeys: ISet;
- function GetMapIterator: IMapIterator;
- function GetMapIteratorByKey(const Filter: IFilter): IMapIterator; overload;
- function GetMapIteratorByKey(FilterFunc: TCollectionFilterFunc): IMapIterator; overload;
- function GetNaturalKeyIID: TGUID;
- function GetNaturalKeysOnly: Boolean;
- function GetValues: ICollection;
- function CloneAsMap: IMap;
- function ContainsKey(const Key: ICollectable): Boolean; overload;
- function ContainsKey(const KeyArray: array of ICollectable): Boolean; overload;
- function ContainsKey(const Collection: ICollection): Boolean; overload;
- function Get(const Key: ICollectable): ICollectable;
- function IsNaturalKey(const Key: ICollectable): Boolean;
- function KeyAllowed(const Key: ICollectable): TCollectionError;
- function MatchingKey(const KeyArray: array of ICollectable): ICollection; overload;
- function MatchingKey(const Collection: ICollection): ICollection; overload;
- function Put(const Item: ICollectable): ICollectable; overload;
- function Put(const Key, Item: ICollectable): ICollectable; overload;
- function Put(const ItemArray: array of ICollectable): ICollection; overload;
- function Put(const Collection: ICollection): ICollection; overload;
- function Put(const Map: IMap): ICollection; overload;
- function RemoveKey(const Key: ICollectable): ICollectable; overload;
- function RemoveKey(const KeyArray: array of ICollectable): ICollection; overload;
- function RemoveKey(const Collection: ICollection): ICollection; overload;
- function RetainKey(const KeyArray: array of ICollectable): ICollection; overload;
- function RetainKey(const Collection: ICollection): ICollection; overload;
- property KeyComparator: IComparator read GetKeyComparator write SetKeyComparator;
- property Items[const Key: ICollectable]: ICollectable read GetItem write SetItem; default;
- property NaturalKeyIID: TGUID read GetNaturalKeyIID;
- property NaturalKeysOnly: Boolean read GetNaturalKeysOnly;
- end;
-
- IIntegerMap = interface(ICollection)
- ['{93DBA9A0-606C-11D7-8120-0002E3165EF8}']
- function GetItem(const Key: Integer): ICollectable;
- procedure SetItem(const Key: Integer; const Item: ICollectable);
- function GetKeys: ISet;
- function GetMapIterator: IIntegerMapIterator;
- function GetValues: ICollection;
- function CloneAsIntegerMap: IIntegerMap;
- function ContainsKey(const Key: Integer): Boolean; overload;
- function ContainsKey(const KeyArray: array of Integer): Boolean; overload;
- function Get(const Key: Integer): ICollectable;
- function Put(const Item: ICollectable): ICollectable; overload;
- function Put(const Key: Integer; const Item: ICollectable): ICollectable; overload;
- function Put(const ItemArray: array of ICollectable): ICollection; overload;
- function Put(const Collection: ICollection): ICollection; overload;
- function Put(const Map: IIntegerMap): ICollection; overload;
- function RemoveKey(const Key: Integer): ICollectable; overload;
- function RemoveKey(const KeyArray: array of Integer): ICollection; overload;
- function RetainKey(const KeyArray: array of Integer): ICollection; overload;
- property Items[const Key: Integer]: ICollectable read GetItem write SetItem; default;
- end;
-
- IStringMap = interface(ICollection)
- ['{20531A20-5F92-11D7-8120-0002E3165EF8}']
- function GetItem(const Key: String): ICollectable;
- procedure SetItem(const Key: String; const Item: ICollectable);
- function GetKeys: ISet;
- function GetMapIterator: IStringMapIterator;
- function GetValues: ICollection;
- function CloneAsStringMap: IStringMap;
- function ContainsKey(const Key: String): Boolean; overload;
- function ContainsKey(const KeyArray: array of String): Boolean; overload;
- function Get(const Key: String): ICollectable;
- function Put(const Item: ICollectable): ICollectable; overload;
- function Put(const Key: String; const Item: ICollectable): ICollectable; overload;
- function Put(const ItemArray: array of ICollectable): ICollection; overload;
- function Put(const Collection: ICollection): ICollection; overload;
- function Put(const Map: IStringMap): ICollection; overload;
- function RemoveKey(const Key: String): ICollectable; overload;
- function RemoveKey(const KeyArray: array of String): ICollection; overload;
- function RetainKey(const KeyArray: array of String): ICollection; overload;
- property Items[const Key: String]: ICollectable read GetItem write SetItem; default;
- end;
-
- TCollectionPosition = class
- private
- FFound: Boolean;
- public
- constructor Create(Found: Boolean);
- property Found: Boolean read FFound;
- end;
-
- TAbstractComparator = class(TInterfacedObject, IComparator)
- public
- class function GetDefaultComparator: IComparator;
- class function GetNaturalComparator: IComparator;
- class function GetReverseNaturalComparator: IComparator;
- function GetInstance: TObject;
- function Compare(const Item1, Item2: ICollectable): Integer; virtual; abstract;
- function Equals(const Item1, Item2: ICollectable): Boolean; overload; virtual; abstract;
- function Equals(const Comparator: IComparator): Boolean; overload; virtual;
- end;
-
- TDefaultComparator = class(TAbstractComparator)
- protected
- constructor Create;
- public
- function Compare(const Item1, Item2: ICollectable): Integer; override;
- function Equals(const Item1, Item2: ICollectable): Boolean; override;
- end;
-
- TNaturalComparator = class(TAbstractComparator)
- protected
- constructor Create;
- public
- function Compare(const Item1, Item2: ICollectable): Integer; override;
- function Equals(const Item1, Item2: ICollectable): Boolean; override;
- end;
-
- TReverseNaturalComparator = class(TAbstractComparator)
- protected
- constructor Create;
- public
- function Compare(const Item1, Item2: ICollectable): Integer; override;
- function Equals(const Item1, Item2: ICollectable): Boolean; override;
- end;
-
- TAssociation = class(TInterfacedObject, ICollectable, IAssociation)
- private
- FKey: ICollectable;
- FValue: ICollectable;
- public
- constructor Create(const Key, Value: ICollectable); virtual;
- destructor Destroy; override;
- function GetInstance: TObject; virtual;
- function GetKey: ICollectable;
- function GetValue: ICollectable;
- end;
-
- TIntegerAssociation = class(TInterfacedObject, ICollectable, IIntegerAssociation)
- private
- FKey: Integer;
- FValue: ICollectable;
- public
- constructor Create(const Key: Integer; const Value: ICollectable); virtual;
- destructor Destroy; override;
- function GetInstance: TObject; virtual;
- function GetKey: Integer;
- function GetValue: ICollectable;
- end;
-
- TStringAssociation = class(TInterfacedObject, ICollectable, IStringAssociation)
- private
- FKey: String;
- FValue: ICollectable;
- public
- constructor Create(const Key: String; const Value: ICollectable); virtual;
- destructor Destroy; override;
- function GetInstance: TObject; virtual;
- function GetKey: String;
- function GetValue: ICollectable;
- end;
-
- TAssociationComparator = class(TAbstractComparator, IAssociationComparator)
- private
- FKeyComparator: IComparator;
- public
- constructor Create(NaturalKeys: Boolean = false);
- destructor Destroy; override;
- function GetKeyComparator: IComparator;
- procedure SetKeyComparator(Value: IComparator);
- function Compare(const Item1, Item2: ICollectable): Integer; override;
- function Equals(const Item1, Item2: ICollectable): Boolean; override;
- property KeyComparator: IComparator read GetKeyComparator write SetKeyComparator;
- end;
-
- TIntegerAssociationComparator = class(TAbstractComparator, IIntegerAssociationComparator)
- public
- constructor Create;
- destructor Destroy; override;
- function Compare(const Item1, Item2: ICollectable): Integer; override;
- function Equals(const Item1, Item2: ICollectable): Boolean; override;
- end;
-
- TStringAssociationComparator = class(TAbstractComparator, IStringAssociationComparator)
- public
- constructor Create;
- destructor Destroy; override;
- function Compare(const Item1, Item2: ICollectable): Integer; override;
- function Equals(const Item1, Item2: ICollectable): Boolean; override;
- end;
-
-
-
- TAbstractCollection = class(TInterfacedObject, ICollection)
- private
- FCreated: Boolean; // Required to avoid passing destroyed object reference to exception
- FComparator: IComparator;
- FIgnoreErrors: TCollectionErrors;
- FNaturalItemsOnly: Boolean;
- protected
- procedure CollectionError(ErrorType: TCollectionError);
- procedure InitFrom(const Collection: ICollection); overload; virtual;
- function TrueAdd(const Item: ICollectable): Boolean; virtual; abstract;
- procedure TrueClear; virtual; abstract;
- function TrueContains(const Item: ICollectable): Boolean; virtual; abstract;
- function TrueItemCount(const Item: ICollectable): Integer; virtual;
- function TrueRemove(const Item: ICollectable): ICollectable; virtual; abstract;
- function TrueRemoveAll(const Item: ICollectable): ICollection; virtual; abstract;
- public
- constructor Create; overload; virtual;
- constructor Create(NaturalItemsOnly: Boolean); overload; virtual;
- constructor Create(const ItemArray: array of ICollectable); overload; virtual;
- constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; virtual;
- constructor Create(const Collection: ICollection); overload; virtual;
- destructor Destroy; override;
- class function GetAlwaysNaturalItems: Boolean; virtual;
- function GetAsArray: TCollectableArray; virtual;
- function GetCapacity: Integer; virtual; abstract;
- procedure SetCapacity(Value: Integer); virtual; abstract;
- function GetComparator: IComparator; virtual;
- procedure SetComparator(const Value: IComparator); virtual;
- function GetDuplicates: Boolean; virtual;
- function GetFixedSize: Boolean; virtual;
- function GetIgnoreErrors: TCollectionErrors;
- procedure SetIgnoreErrors(Value: TCollectionErrors);
- function GetInstance: TObject;
- function GetIterator: IIterator; overload; virtual; abstract;
- function GetIterator(const Filter: IFilter): IIterator; overload; virtual;
- function GetIterator(FilterFunc: TCollectionFilterFunc): IIterator; overload; virtual;
- function GetNaturalItemIID: TGUID; virtual; abstract;
- function GetNaturalItemsOnly: Boolean; virtual;
- function GetSize: Integer; virtual; abstract;
- function GetType: TCollectionType; virtual; abstract;
- function Add(const Item: ICollectable): Boolean; overload; virtual;
- function Add(const ItemArray: array of ICollectable): Integer; overload; virtual;
- function Add(const Collection: ICollection): Integer; overload; virtual;
- procedure AfterConstruction; override;
- procedure BeforeDestruction; override;
- function Clear: Integer; virtual;
- function Clone: ICollection; virtual;
- function Contains(const Item: ICollectable): Boolean; overload; virtual;
- function Contains(const ItemArray: array of ICollectable): Boolean; overload; virtual;
- function Contains(const Collection: ICollection): Boolean; overload; virtual;
- function Equals(const Collection: ICollection): Boolean; virtual;
- function Find(const Filter: IFilter): ICollectable; overload; virtual;
- function Find(FilterFunc: TCollectionFilterFunc): ICollectable; overload; virtual;
- function FindAll(const Filter: IFilter): ICollection; overload; virtual;
- function FindAll(FilterFunc: TCollectionFilterFunc): ICollection; overload; virtual;
- function IsEmpty: Boolean; virtual;
- function IsNaturalItem(const Item: ICollectable): Boolean; virtual;
- function IsNilAllowed: Boolean; virtual; abstract;
- function ItemAllowed(const Item: ICollectable): TCollectionError; virtual;
- function ItemCount(const Item: ICollectable): Integer; overload; virtual;
- function ItemCount(const ItemArray: array of ICollectable): Integer; overload; virtual;
- function ItemCount(const Collection: ICollection): Integer; overload; virtual;
- function Matching(const ItemArray: array of ICollectable): ICollection; overload; virtual;
- function Matching(const Collection: ICollection): ICollection; overload; virtual;
- function Remove(const Item: ICollectable): ICollectable; overload; virtual;
- function Remove(const ItemArray: array of ICollectable): ICollection; overload; virtual;
- function Remove(const Collection: ICollection): ICollection; overload; virtual;
- function RemoveAll(const Item: ICollectable): ICollection; overload; virtual;
- function RemoveAll(const ItemArray: array of ICollectable): ICollection; overload; virtual;
- function RemoveAll(const Collection: ICollection): ICollection; overload; virtual;
- function Retain(const ItemArray: array of ICollectable): ICollection; overload; virtual;
- function Retain(const Collection: ICollection): ICollection; overload; virtual;
- property AsArray: TCollectableArray read GetAsArray;
- property Capacity: Integer read GetCapacity write SetCapacity;
- property Comparator: IComparator read GetComparator write SetComparator;
- property FixedSize: Boolean read GetFixedSize;
- property IgnoreErrors: TCollectionErrors read GetIgnoreErrors write SetIgnoreErrors;
- property NaturalItemIID: TGUID read GetNaturalItemIID;
- property NaturalItemsOnly: Boolean read GetNaturalItemsOnly;
- property Size: Integer read GetSize;
- end;
-
- TAbstractBag = class(TAbstractCollection, IBag)
- public
- function CloneAsBag: IBag; virtual;
- function GetNaturalItemIID: TGUID; override;
- function GetType: TCollectionType; override;
- function IsNilAllowed: Boolean; override;
- end;
-
- TAbstractSet = class (TAbstractCollection, ISet)
- protected
- function GetPosition(const Item: ICollectable): TCollectionPosition; virtual; abstract;
- function TrueAdd(const Item: ICollectable): Boolean; override;
- procedure TrueAdd2(Position: TCollectionPosition; const Item: ICollectable); virtual; abstract;
- function TrueContains(const Item: ICollectable): Boolean; override;
- function TrueGet(Position: TCollectionPosition): ICollectable; virtual; abstract;
- function TrueRemove(const Item: ICollectable): ICollectable; override;
- procedure TrueRemove2(Position: TCollectionPosition); virtual; abstract;
- function TrueRemoveAll(const Item: ICollectable): ICollection; override;
- public
- function GetDuplicates: Boolean; override;
- function GetNaturalItemIID: TGUID; override;
- function GetType: TCollectionType; override;
- function CloneAsSet: ISet; virtual;
- function Complement(const Universe: ISet): ISet; overload; virtual;
- function Intersect(const Set2: ISet): ISet; overload; virtual;
- function IsNilAllowed: Boolean; override;
- function Union(const Set2: ISet): ISet; overload; virtual;
- end;
-
- TAbstractList = class(TAbstractCollection, IList)
- private
- FDuplicates: Boolean;
- FSorted: Boolean;
- protected
- function BinarySearch(const Item: ICollectable): TSearchResult; virtual;
- procedure InitFrom(const Collection: ICollection); override;
- procedure QuickSort(Lo, Hi: Integer; const Comparator: IComparator); overload; virtual;
- procedure QuickSort(Lo, Hi: Integer; CompareFunc: TCollectionCompareFunc); overload; virtual;
- function SequentialSearch(const Item: ICollectable; const SearchComparator: IComparator = nil): TSearchResult; virtual;
- function TrueContains(const Item: ICollectable): Boolean; override;
- function TrueGetItem(Index: Integer): ICollectable; virtual; abstract;
- procedure TrueSetItem(Index: Integer; const Item: ICollectable); virtual; abstract;
- function TrueAdd(const Item: ICollectable): Boolean; override;
- procedure TrueAppend(const Item: ICollectable); virtual; abstract;
- function TrueDelete(Index: Integer): ICollectable; virtual; abstract;
- procedure TrueInsert(Index: Integer; const Item: ICollectable); virtual; abstract;
- function TrueItemCount(const Item: ICollectable): Integer; override;
- function TrueRemove(const Item: ICollectable): ICollectable; override;
- function TrueRemoveAll(const Item: ICollectable): ICollection; override;
- public
- constructor Create(NaturalItemsOnly: Boolean); override;
- function GetDuplicates: Boolean; override;
- procedure SetDuplicates(Value: Boolean); virtual;
- function GetItem(Index: Integer): ICollectable; virtual;
- procedure SetItem(Index: Integer; const Item: ICollectable); virtual;
- function GetIterator: IIterator; override;
- function GetNaturalItemIID: TGUID; override;
- function GetSorted: Boolean; virtual;
- procedure SetSorted(Value: Boolean); virtual;
- function GetType: TCollectionType; override;
- function CloneAsList: IList; virtual;
- function Delete(Index: Integer): ICollectable; virtual;
- procedure Exchange(Index1, Index2: Integer); virtual;
- function First: ICollectable; virtual;
- function IndexOf(const Item: ICollectable): Integer; virtual;
- function Insert(Index: Integer; const Item: ICollectable): Boolean; overload; virtual;
- function Insert(Index: Integer; const ItemArray: array of ICollectable): Integer; overload; virtual;
- function Insert(Index: Integer; const Collection: ICollection): Integer; overload; virtual;
- function IsNilAllowed: Boolean; override;
- function Last: ICollectable; virtual;
- function Search(const Item: ICollectable; const SearchComparator: IComparator = nil): TSearchResult; virtual;
- procedure Sort(const SortComparator: IComparator = nil); overload; virtual;
- procedure Sort(CompareFunc: TCollectionCompareFunc); overload; virtual;
- property Duplicates: Boolean read GetDuplicates write SetDuplicates;
- property Items[Index: Integer]: ICollectable read GetItem write SetItem; default;
- property Sorted: Boolean read GetSorted write SetSorted;
- end;
-
- TAbstractMap = class(TAbstractCollection, IMap)
- private
- FAssociationComparator: IAssociationComparator;
- FKeyComparator: IComparator;
- FNaturalKeysOnly: Boolean;
- protected
- function GetAssociationIterator: IMapIterator; virtual; abstract;
- function GetKeyPosition(const Key: ICollectable): TCollectionPosition; virtual; abstract;
- procedure InitFrom(const Collection: ICollection); override;
- function TrueAdd(const Item: ICollectable): Boolean; override;
- function TrueContains(const Item: ICollectable): Boolean; override;
- function TrueGet(Position: TCollectionPosition): IAssociation; virtual; abstract;
- function TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation; virtual; abstract;
- function TrueRemove(const Item: ICollectable): ICollectable; override;
- function TrueRemove2(Position: TCollectionPosition): IAssociation; virtual; abstract;
- function TrueRemoveAll(const Item: ICollectable): ICollection; override;
- property AssociationComparator: IAssociationComparator read FAssociationComparator;
- public
- constructor Create; override;
- constructor Create(NaturalItemsOnly: Boolean); override;
- constructor Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); overload; virtual;
- constructor Create(const ItemArray: array of ICollectable); overload; override;
- constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; override;
- constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); overload; virtual;
- constructor Create(const KeyArray, ItemArray: array of ICollectable); overload; virtual;
- constructor Create(const KeyArray, ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; virtual;
- constructor Create(const KeyArray, ItemArray: array of ICollectable; NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); overload; virtual;
-// Don't use this parameter signature as it hits a compiler bug in D5.
-// constructor Create(const KeyArray, ItemArray: TCollectableArray; NaturalItemsOnly: Boolean = false; NaturalKeysOnly: Boolean = true); overload; virtual;
- constructor Create(const Map: IMap); overload; virtual;
- destructor Destroy; override;
- class function GetAlwaysNaturalKeys: Boolean; virtual;
- function GetItem(const Key: ICollectable): ICollectable; virtual;
- procedure SetItem(const Key, Item: ICollectable); virtual;
- function GetIterator: IIterator; override;
- function GetKeyComparator: IComparator; virtual;
- procedure SetKeyComparator(const Value: IComparator); virtual;
- function GetKeyIterator: IIterator; virtual;
- function GetKeys: ISet; virtual;
- function GetMapIterator: IMapIterator; virtual;
- function GetMapIteratorByKey(const Filter: IFilter): IMapIterator; overload; virtual;
- function GetMapIteratorByKey(FilterFunc: TCollectionFilterFunc): IMapIterator; overload; virtual;
- function GetNaturalItemIID: TGUID; override;
- function GetNaturalKeyIID: TGUID; virtual;
- function GetNaturalKeysOnly: Boolean; virtual;
- function GetType: TCollectionType; override;
- function GetValues: ICollection; virtual;
- function Clone: ICollection; override;
- function CloneAsMap: IMap; virtual;
- function ContainsKey(const Key: ICollectable): Boolean; overload; virtual;
- function ContainsKey(const KeyArray: array of ICollectable): Boolean; overload; virtual;
- function ContainsKey(const Collection: ICollection): Boolean; overload; virtual;
- function Get(const Key: ICollectable): ICollectable; virtual;
- function KeyAllowed(const Key: ICollectable): TCollectionError; virtual;
- function IsNaturalKey(const Key: ICollectable): Boolean; virtual;
- function IsNilAllowed: Boolean; override;
- function MatchingKey(const KeyArray: array of ICollectable): ICollection; overload; virtual;
- function MatchingKey(const Collection: ICollection): ICollection; overload; virtual;
- function Put(const Item: ICollectable): ICollectable; overload; virtual;
- function Put(const Key, Item: ICollectable): ICollectable; overload; virtual;
- function Put(const ItemArray: array of ICollectable): ICollection; overload; virtual;
- function Put(const Collection: ICollection): ICollection; overload; virtual;
- function Put(const Map: IMap): ICollection; overload; virtual;
- function RemoveKey(const Key: ICollectable): ICollectable; overload; virtual;
- function RemoveKey(const KeyArray: array of ICollectable): ICollection; overload; virtual;
- function RemoveKey(const Collection: ICollection): ICollection; overload; virtual;
- function RetainKey(const KeyArray: array of ICollectable): ICollection; overload; virtual;
- function RetainKey(const Collection: ICollection): ICollection; overload; virtual;
- property KeyComparator: IComparator read GetKeyComparator write SetKeyComparator;
- property Items[const Key: ICollectable]: ICollectable read GetItem write SetItem; default;
- property NaturalKeyIID: TGUID read GetNaturalKeyIID;
- property NaturalKeysOnly: Boolean read GetNaturalKeysOnly;
- end;
-
- TAbstractIntegerMap = class(TAbstractCollection, IIntegerMap)
- private
- FAssociationComparator: IIntegerAssociationComparator;
- protected
- function GetAssociationIterator: IIntegerMapIterator; virtual; abstract;
- function GetKeyPosition(const Key: Integer): TCollectionPosition; virtual; abstract;
- function TrueAdd(const Item: ICollectable): Boolean; override;
- function TrueContains(const Item: ICollectable): Boolean; override;
- function TrueGet(Position: TCollectionPosition): IIntegerAssociation; virtual; abstract;
- function TruePut(Position: TCollectionPosition; const Association: IIntegerAssociation): IIntegerAssociation; virtual; abstract;
- function TrueRemove(const Item: ICollectable): ICollectable; override;
- function TrueRemove2(Position: TCollectionPosition): IIntegerAssociation; virtual; abstract;
- function TrueRemoveAll(const Item: ICollectable): ICollection; override;
- property AssociationComparator: IIntegerAssociationComparator read FAssociationComparator;
- public
- constructor Create(NaturalItemsOnly: Boolean); override;
- constructor Create(const ItemArray: array of ICollectable); overload; override;
- constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; override;
- constructor Create(const KeyArray: array of Integer; const ItemArray: array of ICollectable); overload; virtual;
- constructor Create(const KeyArray: array of Integer; const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; virtual;
- constructor Create(const Map: IIntegerMap); overload; virtual;
- destructor Destroy; override;
- function GetItem(const Key: Integer): ICollectable; virtual;
- procedure SetItem(const Key: Integer; const Item: ICollectable); virtual;
- function GetIterator: IIterator; override;
- function GetKeys: ISet; virtual;
- function GetMapIterator: IIntegerMapIterator; virtual;
- function GetNaturalItemIID: TGUID; override;
- function GetType: TCollectionType; override;
- function GetValues: ICollection; virtual;
- function Clone: ICollection; override;
- function CloneAsIntegerMap: IIntegerMap; virtual;
- function ContainsKey(const Key: Integer): Boolean; overload; virtual;
- function ContainsKey(const KeyArray: array of Integer): Boolean; overload; virtual;
- function Get(const Key: Integer): ICollectable; virtual;
- function IsNilAllowed: Boolean; override;
- function Put(const Item: ICollectable): ICollectable; overload; virtual;
- function Put(const Key: Integer; const Item: ICollectable): ICollectable; overload; virtual;
- function Put(const ItemArray: array of ICollectable): ICollection; overload; virtual;
- function Put(const Collection: ICollection): ICollection; overload; virtual;
- function Put(const Map: IIntegerMap): ICollection; overload; virtual;
- function RemoveKey(const Key: Integer): ICollectable; overload; virtual;
- function RemoveKey(const KeyArray: array of Integer): ICollection; overload; virtual;
- function RetainKey(const KeyArray: array of Integer): ICollection; overload; virtual;
- property Items[const Key: Integer]: ICollectable read GetItem write SetItem; default;
- end;
-
- TAbstractStringMap = class(TAbstractCollection, IStringMap)
- private
- FAssociationComparator: IStringAssociationComparator;
- protected
- function GetAssociationIterator: IStringMapIterator; virtual; abstract;
- function GetKeyPosition(const Key: String): TCollectionPosition; virtual; abstract;
- function TrueAdd(const Item: ICollectable): Boolean; override;
- function TrueContains(const Item: ICollectable): Boolean; override;
- function TrueGet(Position: TCollectionPosition): IStringAssociation; virtual; abstract;
- function TruePut(Position: TCollectionPosition; const Association: IStringAssociation): IStringAssociation; virtual; abstract;
- function TrueRemove(const Item: ICollectable): ICollectable; override;
- function TrueRemove2(Position: TCollectionPosition): IStringAssociation; virtual; abstract;
- function TrueRemoveAll(const Item: ICollectable): ICollection; override;
- property AssociationComparator: IStringAssociationComparator read FAssociationComparator;
- public
- constructor Create(NaturalItemsOnly: Boolean); override;
- constructor Create(const ItemArray: array of ICollectable); overload; override;
- constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; override;
- constructor Create(const KeyArray: array of String; const ItemArray: array of ICollectable); overload; virtual;
- constructor Create(const KeyArray: array of String; const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; virtual;
- constructor Create(const Map: IStringMap); overload; virtual;
- destructor Destroy; override;
- function GetItem(const Key: String): ICollectable; virtual;
- procedure SetItem(const Key: String; const Item: ICollectable); virtual;
- function GetIterator: IIterator; override;
- function GetKeys: ISet; virtual;
- function GetMapIterator: IStringMapIterator; virtual;
- function GetNaturalItemIID: TGUID; override;
- function GetType: TCollectionType; override;
- function GetValues: ICollection; virtual;
- function Clone: ICollection; override;
- function CloneAsStringMap: IStringMap; virtual;
- function ContainsKey(const Key: String): Boolean; overload; virtual;
- function ContainsKey(const KeyArray: array of String): Boolean; overload; virtual;
- function Get(const Key: String): ICollectable; virtual;
- function IsNilAllowed: Boolean; override;
- function Put(const Item: ICollectable): ICollectable; overload; virtual;
- function Put(const Key: String; const Item: ICollectable): ICollectable; overload; virtual;
- function Put(const ItemArray: array of ICollectable): ICollection; overload; virtual;
- function Put(const Collection: ICollection): ICollection; overload; virtual;
- function Put(const Map: IStringMap): ICollection; overload; virtual;
- function RemoveKey(const Key: String): ICollectable; overload; virtual;
- function RemoveKey(const KeyArray: array of String): ICollection; overload; virtual;
- function RetainKey(const KeyArray: array of String): ICollection; overload; virtual;
- property Items[const Key: String]: ICollectable read GetItem write SetItem; default;
- end;
-
- TAbstractCollectionClass = class of TAbstractCollection;
- TAbstractBagClass = class of TAbstractBag;
- TAbstractSetClass = class of TAbstractSet;
- TAbstractListClass = class of TAbstractList;
- TAbstractMapClass = class of TAbstractMap;
- TAbstractIntegerMapClass = class of TAbstractIntegerMap;
- TAbstractStringMapClass = class of TAbstractStringMap;
-
- TAbstractIterator = class(TInterfacedObject, IIterator)
- private
- FAllowRemoval: Boolean;
- FEOF: Boolean;
- FItem: ICollectable;
- protected
- constructor Create(AllowRemoval: Boolean = true);
- function TrueFirst: ICollectable; virtual; abstract;
- function TrueNext: ICollectable; virtual; abstract;
- procedure TrueRemove; virtual; abstract;
- public
- procedure AfterConstruction; override;
- function GetAllowRemoval: Boolean; virtual;
- function CurrentItem: ICollectable; virtual;
- function EOF: Boolean; virtual;
- function First: ICollectable; virtual;
- function Next: ICollectable; virtual;
- function Remove: Boolean; virtual;
- property AllowRemoval: Boolean read GetAllowRemoval;
- end;
-
- TAbstractListIterator = class(TAbstractIterator)
- private
- FCollection: TAbstractList;
- FIndex: Integer;
- protected
- constructor Create(Collection: TAbstractList);
- function TrueFirst: ICollectable; override;
- function TrueNext: ICollectable; override;
- procedure TrueRemove; override;
- end;
-
- TAbstractMapIterator = class(TAbstractIterator, IMapIterator)
- public
- function CurrentKey: ICollectable; virtual; abstract;
- end;
-
- TAbstractAssociationIterator = class(TInterfacedObject, IIterator, IMapIterator)
- private
- FAllowRemoval: Boolean;
- FEOF: Boolean;
- FAssociation: IAssociation;
- protected
- constructor Create(AllowRemoval: Boolean = true);
- function TrueFirst: IAssociation; virtual; abstract;
- function TrueNext: IAssociation; virtual; abstract;
- procedure TrueRemove; virtual; abstract;
- public
- procedure AfterConstruction; override;
- function GetAllowRemoval: Boolean; virtual;
- function CurrentKey: ICollectable; virtual;
- function CurrentItem: ICollectable; virtual;
- function EOF: Boolean; virtual;
- function First: ICollectable; virtual;
- function Next: ICollectable; virtual;
- function Remove: Boolean; virtual;
- property AllowRemoval: Boolean read GetAllowRemoval;
- end;
-
- TAbstractIntegerAssociationIterator = class(TInterfacedObject, IIterator, IIntegerMapIterator)
- private
- FAllowRemoval: Boolean;
- FEOF: Boolean;
- FAssociation: IIntegerAssociation;
- protected
- constructor Create(AllowRemoval: Boolean = true);
- function TrueFirst: IIntegerAssociation; virtual; abstract;
- function TrueNext: IIntegerAssociation; virtual; abstract;
- procedure TrueRemove; virtual; abstract;
- public
- procedure AfterConstruction; override;
- function GetAllowRemoval: Boolean; virtual;
- function CurrentKey: Integer; virtual;
- function CurrentItem: ICollectable; virtual;
- function EOF: Boolean; virtual;
- function First: ICollectable; virtual;
- function Next: ICollectable; virtual;
- function Remove: Boolean; virtual;
- property AllowRemoval: Boolean read GetAllowRemoval;
- end;
-
- TAbstractStringAssociationIterator = class(TInterfacedObject, IIterator, IStringMapIterator)
- private
- FAllowRemoval: Boolean;
- FEOF: Boolean;
- FAssociation: IStringAssociation;
- protected
- constructor Create(AllowRemoval: Boolean = true);
- function TrueFirst: IStringAssociation; virtual; abstract;
- function TrueNext: IStringAssociation; virtual; abstract;
- procedure TrueRemove; virtual; abstract;
- public
- procedure AfterConstruction; override;
- function GetAllowRemoval: Boolean; virtual;
- function CurrentKey: String; virtual;
- function CurrentItem: ICollectable; virtual;
- function EOF: Boolean; virtual;
- function First: ICollectable; virtual;
- function Next: ICollectable; virtual;
- function Remove: Boolean; virtual;
- property AllowRemoval: Boolean read GetAllowRemoval;
- end;
-
- TAssociationIterator = class(TAbstractIterator, IMapIterator)
- private
- FIterator: IIterator;
- protected
- function TrueFirst: ICollectable; override;
- function TrueNext: ICollectable; override;
- procedure TrueRemove; override;
- public
- constructor Create(const Iterator: IIterator);
- destructor Destroy; override;
- function CurrentItem: ICollectable; override;
- function CurrentKey: ICollectable; virtual;
- end;
-
- TAssociationKeyIterator = class(TAbstractIterator)
- private
- FIterator: IMapIterator;
- protected
- function TrueFirst: ICollectable; override;
- function TrueNext: ICollectable; override;
- procedure TrueRemove; override;
- public
- constructor Create(const Iterator: IMapIterator);
- destructor Destroy; override;
- end;
-
- TAbstractFilter = class(TInterfacedObject, IFilter)
- public
- function Accept(const Item: ICollectable): Boolean; virtual; abstract;
- end;
-
- TFilterIterator = class(TAbstractIterator)
- private
- FIterator: IIterator;
- FFilter: IFilter;
- protected
- function TrueFirst: ICollectable; override;
- function TrueNext: ICollectable; override;
- procedure TrueRemove; override;
- public
- constructor Create(const Iterator: IIterator; const Filter: IFilter; AllowRemoval: Boolean = true); virtual;
- destructor Destroy; override;
- end;
-
- TFilterFuncIterator = class(TAbstractIterator)
- private
- FIterator: IIterator;
- FFilterFunc: TCollectionFilterFunc;
- protected
- function TrueFirst: ICollectable; override;
- function TrueNext: ICollectable; override;
- procedure TrueRemove; override;
- public
- constructor Create(const Iterator: IIterator; FilterFunc: TCollectionFilterFunc; AllowRemoval: Boolean = true); virtual;
- destructor Destroy; override;
- end;
-
- TKeyFilterMapIterator = class(TAbstractMapIterator)
- private
- FIterator: IMapIterator;
- FFilter: IFilter;
- protected
- function TrueFirst: ICollectable; override;
- function TrueNext: ICollectable; override;
- procedure TrueRemove; override;
- public
- constructor Create(const Iterator: IMapIterator; const Filter: IFilter; AllowRemoval: Boolean = true); virtual;
- destructor Destroy; override;
- function CurrentKey: ICollectable; override;
- end;
-
- TKeyFilterFuncMapIterator = class(TAbstractMapIterator)
- private
- FIterator: IMapIterator;
- FFilterFunc: TCollectionFilterFunc;
- protected
- function TrueFirst: ICollectable; override;
- function TrueNext: ICollectable; override;
- procedure TrueRemove; override;
- public
- constructor Create(const Iterator: IMapIterator; FilterFunc: TCollectionFilterFunc; AllowRemoval: Boolean = true); virtual;
- destructor Destroy; override;
- function CurrentKey: ICollectable; override;
- end;
-
-
- ECollectionError = class(Exception)
- private
- FCollection: ICollection;
- FErrorType: TCollectionError;
- public
- constructor Create(const Msg: String; const Collection: ICollection; ErrorType: TCollectionError);
- property Collection: ICollection read FCollection;
- property ErrorType: TCollectionError read FErrorType;
- end;
-
-implementation
-
-uses
- Math,
- CollArray, CollHash, CollList, CollPArray, CollWrappers;
-
-var
- FDefaultComparator: IComparator;
- FNaturalComparator: IComparator;
- FReverseNaturalComparator: IComparator;
-
-{ TCollectionPosition }
-constructor TCollectionPosition.Create(Found: Boolean);
-begin
- FFound := Found;
-end;
-
-{ TAbstractComparator }
-class function TAbstractComparator.GetDefaultComparator: IComparator;
-begin
- if FDefaultComparator = nil then
- FDefaultComparator := TDefaultComparator.Create;
- Result := FDefaultComparator;
-end;
-
-class function TAbstractComparator.GetNaturalComparator: IComparator;
-begin
- if FNaturalComparator = nil then
- FNaturalComparator := TNaturalComparator.Create;
- Result := FNaturalComparator;
-end;
-
-class function TAbstractComparator.GetReverseNaturalComparator: IComparator;
-begin
- if FReverseNaturalComparator = nil then
- FReverseNaturalComparator := TReverseNaturalComparator.Create;
- Result := FReverseNaturalComparator;
-end;
-
-function TAbstractComparator.GetInstance: TObject;
-begin
- Result := Self;
-end;
-
-function TAbstractComparator.Equals(const Comparator: IComparator): Boolean;
-begin
- Result := (Self = Comparator.GetInstance);
-end;
-
-{ TDefaultComparator }
-constructor TDefaultComparator.Create;
-begin
- // Empty
-end;
-
-function TDefaultComparator.Compare(const Item1, Item2: ICollectable): Integer;
-var
- Value1, Value2: Integer;
-begin
- if Item1 <> nil then
- Value1 := Integer(Pointer(Item1))
- else
- Value1 := Low(Integer);
- if Item2 <> nil then
- Value2 := Integer(Pointer(Item2))
- else
- Value2 := Low(Integer);
- if (Value1 < Value2) then
- Result := -1
- else if (Value1 > Value2) then
- Result := 1
- else
- Result := 0;
-end;
-
-function TDefaultComparator.Equals(const Item1, Item2: ICollectable): Boolean;
-begin
- Result := (Item1 = Item2);
-end;
-
-{ TNaturalComparator }
-constructor TNaturalComparator.Create;
-begin
- // Empty
-end;
-
-function TNaturalComparator.Compare(const Item1, Item2: ICollectable): Integer;
-begin
- if (Item1 = nil) and (Item2 <> nil) then
- Result := -1
- else if (Item1 <> nil) and (Item2 = nil) then
- Result := 1
- else if (Item1 = nil) and (Item2 = nil) then
- Result := 0
- else
- Result := (Item1 as IComparable).CompareTo(Item2);
-end;
-
-function TNaturalComparator.Equals(const Item1, Item2: ICollectable): Boolean;
-begin
- if (Item1 = nil) or (Item2 = nil) then
- Result := (Item1 = Item2)
- else
- begin
- Result := (Item1 as IEquatable).Equals(Item2);
- end;
-end;
-
-{ TReverseNaturalComparator }
-constructor TReverseNaturalComparator.Create;
-begin
- // Empty
-end;
-
-function TReverseNaturalComparator.Compare(const Item1, Item2: ICollectable): Integer;
-begin
- if (Item1 = nil) and (Item2 <> nil) then
- Result := 1
- else if (Item1 <> nil) and (Item2 = nil) then
- Result := -1
- else if (Item1 = nil) and (Item2 = nil) then
- Result := 0
- else
- Result := -(Item1 as IComparable).CompareTo(Item2);
-end;
-
-function TReverseNaturalComparator.Equals(const Item1, Item2: ICollectable): Boolean;
-begin
- if (Item1 = nil) or (Item2 = nil) then
- Result := (Item1 = Item2)
- else
- Result := (Item1 as IEquatable).Equals(Item2);
-end;
-
-{ TAssociation }
-constructor TAssociation.Create(const Key, Value: ICollectable);
-begin
- FKey := Key;
- FValue := Value;
-end;
-
-destructor TAssociation.Destroy;
-begin
- FKey := nil;
- FValue := nil;
- inherited Destroy;
-end;
-
-function TAssociation.GetInstance: TObject;
-begin
- Result := Self;
-end;
-
-function TAssociation.GetKey: ICollectable;
-begin
- Result := FKey;
-end;
-
-function TAssociation.GetValue: ICollectable;
-begin
- Result := FValue;
-end;
-
-
-{ TIntegerAssociation }
-constructor TIntegerAssociation.Create(const Key: Integer; const Value: ICollectable);
-begin
- FKey := Key;
- FValue := Value;
-end;
-
-destructor TIntegerAssociation.Destroy;
-begin
- FValue := nil;
- inherited Destroy;
-end;
-
-function TIntegerAssociation.GetInstance: TObject;
-begin
- Result := Self;
-end;
-
-function TIntegerAssociation.GetKey: Integer;
-begin
- Result := FKey;
-end;
-
-function TIntegerAssociation.GetValue: ICollectable;
-begin
- Result := FValue;
-end;
-
-
-{ TStringAssociation }
-constructor TStringAssociation.Create(const Key: String; const Value: ICollectable);
-begin
- FKey := Key;
- FValue := Value;
-end;
-
-destructor TStringAssociation.Destroy;
-begin
- FValue := nil;
- inherited Destroy;
-end;
-
-function TStringAssociation.GetInstance: TObject;
-begin
- Result := Self;
-end;
-
-function TStringAssociation.GetKey: String;
-begin
- Result := FKey;
-end;
-
-function TStringAssociation.GetValue: ICollectable;
-begin
- Result := FValue;
-end;
-
-
-{ TAbstractIterator }
-constructor TAbstractIterator.Create(AllowRemoval: Boolean);
-begin
- inherited Create;
- FAllowRemoval := AllowRemoval;
- FEOF := true;
- FItem := nil;
-end;
-
-procedure TAbstractIterator.AfterConstruction;
-begin
- inherited AfterConstruction;
- First;
-end;
-
-function TAbstractIterator.GetAllowRemoval: Boolean;
-begin
- Result := FAllowRemoval;
-end;
-
-function TAbstractIterator.CurrentItem: ICollectable;
-begin
- Result := FItem;
-end;
-
-function TAbstractIterator.EOF: Boolean;
-begin
- Result := FEOF;
-end;
-
-function TAbstractIterator.First: ICollectable;
-begin
- FEOF := false;
- FItem := TrueFirst;
- if FItem = nil then
- FEOF := true;
- Result := FItem;
-end;
-
-function TAbstractIterator.Next: ICollectable;
-begin
- if not FEOF then
- begin
- FItem := TrueNext;
- if FItem = nil then
- FEOF := true;
- end;
- Result := FItem;
-end;
-
-function TAbstractIterator.Remove: Boolean;
-begin
- if (FItem <> nil) and FAllowRemoval then
- begin
- TrueRemove;
- FItem := nil;
- Result := true;
- end
- else
- Result := false;
-end;
-
-{ TAbstractAssociationIterator }
-constructor TAbstractAssociationIterator.Create(AllowRemoval: Boolean);
-begin
- inherited Create;
- FAllowRemoval := AllowRemoval;
- FEOF := true;
- FAssociation := nil;
-end;
-
-procedure TAbstractAssociationIterator.AfterConstruction;
-begin
- inherited AfterConstruction;
- First;
-end;
-
-function TAbstractAssociationIterator.GetAllowRemoval: Boolean;
-begin
- Result := FAllowRemoval;
-end;
-
-function TAbstractAssociationIterator.CurrentKey: ICollectable;
-begin
- if FAssociation <> nil then
- Result := FAssociation.GetKey
- else
- Result := nil;
-end;
-
-function TAbstractAssociationIterator.CurrentItem: ICollectable;
-begin
- if FAssociation <> nil then
- Result := FAssociation.GetValue
- else
- Result := nil;
-end;
-
-function TAbstractAssociationIterator.EOF: Boolean;
-begin
- Result := FEOF;
-end;
-
-function TAbstractAssociationIterator.First: ICollectable;
-begin
- FAssociation := TrueFirst;
- if FAssociation <> nil then
- begin
- Result := FAssociation.GetValue;
- FEOF := false;
- end
- else
- begin
- Result := nil;
- FEOF := true;
- end;
-end;
-
-function TAbstractAssociationIterator.Next: ICollectable;
-begin
- if not FEOF then
- begin
- FAssociation := TrueNext;
- if FAssociation <> nil then
- Result := FAssociation.GetValue
- else
- begin
- Result := nil;
- FEOF := true;
- end;
- end;
-end;
-
-function TAbstractAssociationIterator.Remove: Boolean;
-begin
- if (FAssociation <> nil) and FAllowRemoval then
- begin
- TrueRemove;
- FAssociation := nil;
- Result := true;
- end
- else
- Result := false;
-end;
-
-{ TAbstractIntegerAssociationIterator }
-constructor TAbstractIntegerAssociationIterator.Create(AllowRemoval: Boolean);
-begin
- inherited Create;
- FAllowRemoval := AllowRemoval;
- FEOF := true;
- FAssociation := nil;
-end;
-
-procedure TAbstractIntegerAssociationIterator.AfterConstruction;
-begin
- inherited AfterConstruction;
- First;
-end;
-
-function TAbstractIntegerAssociationIterator.GetAllowRemoval: Boolean;
-begin
- Result := FAllowRemoval;
-end;
-
-function TAbstractIntegerAssociationIterator.CurrentKey: Integer;
-begin
- if FAssociation <> nil then
- Result := FAssociation.GetKey
- else
- Result := 0;
-end;
-
-function TAbstractIntegerAssociationIterator.CurrentItem: ICollectable;
-begin
- if FAssociation <> nil then
- Result := FAssociation.GetValue
- else
- Result := nil;
-end;
-
-function TAbstractIntegerAssociationIterator.EOF: Boolean;
-begin
- Result := FEOF;
-end;
-
-function TAbstractIntegerAssociationIterator.First: ICollectable;
-begin
- FAssociation := TrueFirst;
- if FAssociation <> nil then
- begin
- Result := FAssociation.GetValue;
- FEOF := false;
- end
- else
- begin
- Result := nil;
- FEOF := true;
- end;
-end;
-
-function TAbstractIntegerAssociationIterator.Next: ICollectable;
-begin
- if not FEOF then
- begin
- FAssociation := TrueNext;
- if FAssociation <> nil then
- Result := FAssociation.GetValue
- else
- begin
- Result := nil;
- FEOF := true;
- end;
- end;
-end;
-
-function TAbstractIntegerAssociationIterator.Remove: Boolean;
-begin
- if (FAssociation <> nil) and FAllowRemoval then
- begin
- TrueRemove;
- FAssociation := nil;
- Result := true;
- end
- else
- Result := false;
-end;
-
-{ TAbstractStringAssociationIterator }
-constructor TAbstractStringAssociationIterator.Create(AllowRemoval: Boolean);
-begin
- inherited Create;
- FAllowRemoval := AllowRemoval;
- FEOF := true;
- FAssociation := nil;
-end;
-
-procedure TAbstractStringAssociationIterator.AfterConstruction;
-begin
- inherited AfterConstruction;
- First;
-end;
-
-function TAbstractStringAssociationIterator.GetAllowRemoval: Boolean;
-begin
- Result := FAllowRemoval;
-end;
-
-function TAbstractStringAssociationIterator.CurrentKey: String;
-begin
- if FAssociation <> nil then
- Result := FAssociation.GetKey
- else
- Result := '';
-end;
-
-function TAbstractStringAssociationIterator.CurrentItem: ICollectable;
-begin
- if FAssociation <> nil then
- Result := FAssociation.GetValue
- else
- Result := nil;
-end;
-
-function TAbstractStringAssociationIterator.EOF: Boolean;
-begin
- Result := FEOF;
-end;
-
-function TAbstractStringAssociationIterator.First: ICollectable;
-begin
- FAssociation := TrueFirst;
- if FAssociation <> nil then
- begin
- Result := FAssociation.GetValue;
- FEOF := false;
- end
- else
- begin
- Result := nil;
- FEOF := true;
- end;
-end;
-
-function TAbstractStringAssociationIterator.Next: ICollectable;
-begin
- if not FEOF then
- begin
- FAssociation := TrueNext;
- if FAssociation <> nil then
- Result := FAssociation.GetValue
- else
- begin
- Result := nil;
- FEOF := true;
- end;
- end;
-end;
-
-function TAbstractStringAssociationIterator.Remove: Boolean;
-begin
- if (FAssociation <> nil) and FAllowRemoval then
- begin
- TrueRemove;
- FAssociation := nil;
- Result := true;
- end
- else
- Result := false;
-end;
-
-{ TAssociationIterator }
-constructor TAssociationIterator.Create(const Iterator: IIterator);
-begin
- inherited Create(Iterator.GetAllowRemoval);
- FIterator := Iterator;
-end;
-
-destructor TAssociationIterator.Destroy;
-begin
- FIterator := nil;
- inherited Destroy;
-end;
-
-function TAssociationIterator.TrueFirst: ICollectable;
-var
- Association: IAssociation;
-begin
- Association := FIterator.First as IAssociation;
- if Association <> nil then
- Result := Association.GetValue
- else
- Result := nil;
-end;
-
-function TAssociationIterator.TrueNext: ICollectable;
-var
- Association: IAssociation;
-begin
- Association := (FIterator.Next as IAssociation);
- if Association <> nil then
- Result := Association.GetValue
- else
- Result := nil;
-end;
-
-procedure TAssociationIterator.TrueRemove;
-begin
- FIterator.Remove;
-end;
-
-function TAssociationIterator.CurrentItem: ICollectable;
-var
- Association: IAssociation;
-begin
- Association := FIterator.CurrentItem as IAssociation;
- if Association <> nil then
- Result := Association.GetValue
- else
- Result := nil;
-end;
-
-function TAssociationIterator.CurrentKey: ICollectable;
-var
- Association: IAssociation;
-begin
- Association := FIterator.CurrentItem as IAssociation;
- if Association <> nil then
- Result := Association.GetKey
- else
- Result := nil;
-end;
-
-{ TAssociationComparator }
-constructor TAssociationComparator.Create(NaturalKeys: Boolean);
-begin
- inherited Create;
- if NaturalKeys then
- FKeyComparator := TAbstractComparator.GetNaturalComparator
- else
- FKeyComparator := TAbstractComparator.GetDefaultComparator;
-end;
-
-destructor TAssociationComparator.Destroy;
-begin
- FKeyComparator := nil;
- inherited Destroy;
-end;
-
-function TAssociationComparator.GetKeyComparator: IComparator;
-begin
- Result := FKeyComparator;
-end;
-
-procedure TAssociationComparator.SetKeyComparator(Value: IComparator);
-begin
- FKeyComparator := Value;
-end;
-
-function TAssociationComparator.Compare(const Item1, Item2: ICollectable): Integer;
-begin
- Result := KeyComparator.Compare((Item1 as IAssociation).GetKey, (Item2 as IAssociation).GetKey);
-end;
-
-function TAssociationComparator.Equals(const Item1, Item2: ICollectable): Boolean;
-begin
- Result := KeyComparator.Equals((Item1 as IAssociation).GetKey, (Item2 as IAssociation).GetKey);
-end;
-
-{ TIntegerAssociationComparator }
-constructor TIntegerAssociationComparator.Create;
-begin
- inherited Create;
-end;
-
-destructor TIntegerAssociationComparator.Destroy;
-begin
- inherited Destroy;
-end;
-
-function TIntegerAssociationComparator.Compare(const Item1, Item2: ICollectable): Integer;
-var
- Key1, Key2: Integer;
-begin
- Key1 := (Item1 as IIntegerAssociation).GetKey;
- Key2 := (Item2 as IIntegerAssociation).GetKey;
- if Key1 < Key2 then
- Result := -1
- else if Key1 > Key2 then
- Result := 1
- else
- Result := 0;
-end;
-
-function TIntegerAssociationComparator.Equals(const Item1, Item2: ICollectable): Boolean;
-begin
- Result := ((Item1 as IIntegerAssociation).GetKey = (Item2 as IIntegerAssociation).GetKey);
-end;
-
-{ TStringAssociationComparator }
-constructor TStringAssociationComparator.Create;
-begin
- inherited Create;
-end;
-
-destructor TStringAssociationComparator.Destroy;
-begin
- inherited Destroy;
-end;
-
-function TStringAssociationComparator.Compare(const Item1, Item2: ICollectable): Integer;
-var
- Key1, Key2: String;
-begin
- Key1 := (Item1 as IStringAssociation).GetKey;
- Key2 := (Item2 as IStringAssociation).GetKey;
- if Key1 < Key2 then
- Result := -1
- else if Key1 > Key2 then
- Result := 1
- else
- Result := 0;
-end;
-
-function TStringAssociationComparator.Equals(const Item1, Item2: ICollectable): Boolean;
-begin
- Result := ((Item1 as IStringAssociation).GetKey = (Item2 as IStringAssociation).GetKey);
-end;
-
-{ TAssociationKeyIterator }
-constructor TAssociationKeyIterator.Create(const Iterator: IMapIterator);
-begin
- inherited Create(Iterator.GetAllowRemoval);
- FIterator := Iterator;
-end;
-
-destructor TAssociationKeyIterator.Destroy;
-begin
- FIterator := nil;
- inherited Destroy;
-end;
-
-function TAssociationKeyIterator.TrueFirst: ICollectable;
-begin
- FIterator.First;
- Result := FIterator.CurrentKey;
-end;
-
-function TAssociationKeyIterator.TrueNext: ICollectable;
-begin
- FIterator.Next;
- Result := FIterator.CurrentKey;
-end;
-
-procedure TAssociationKeyIterator.TrueRemove;
-begin
- FIterator.Remove;
-end;
-
-{ TFilterIterator }
-constructor TFilterIterator.Create(const Iterator: IIterator; const Filter: IFilter; AllowRemoval: Boolean = true);
-begin
- FIterator := Iterator;
- FFilter := Filter;
-end;
-
-destructor TFilterIterator.Destroy;
-begin
- FIterator := nil;
- FFilter := nil;
-end;
-
-function TFilterIterator.TrueFirst: ICollectable;
-var
- Item: ICollectable;
-begin
- Item := FIterator.First;
- while not FIterator.EOF do
- begin
- if FFilter.Accept(Item) then
- break
- else
- Item := FIterator.Next;
- end;
- Result := Item;
-end;
-
-function TFilterIterator.TrueNext: ICollectable;
-var
- Item: ICollectable;
-begin
- Item := FIterator.Next;
- while not FIterator.EOF do
- begin
- if FFilter.Accept(Item) then
- break
- else
- Item := FIterator.Next;
- end;
- Result := Item;
-end;
-
-procedure TFilterIterator.TrueRemove;
-begin
- FIterator.Remove;
-end;
-
-{ TFilterFuncIterator }
-constructor TFilterFuncIterator.Create(const Iterator: IIterator; FilterFunc: TCollectionFilterFunc; AllowRemoval: Boolean = true);
-begin
- FIterator := Iterator;
- FFilterFunc := FilterFunc;
-end;
-
-destructor TFilterFuncIterator.Destroy;
-begin
- FIterator := nil;
- FFilterFunc := nil;
-end;
-
-function TFilterFuncIterator.TrueFirst: ICollectable;
-var
- Item: ICollectable;
-begin
- Item := FIterator.First;
- while not FIterator.EOF do
- begin
- if FFilterFunc(Item) then
- break
- else
- Item := FIterator.Next;
- end;
- Result := Item;
-end;
-
-function TFilterFuncIterator.TrueNext: ICollectable;
-var
- Item: ICollectable;
-begin
- Item := FIterator.Next;
- while not FIterator.EOF do
- begin
- if FFilterFunc(Item) then
- break
- else
- Item := FIterator.Next;
- end;
- Result := Item;
-end;
-
-procedure TFilterFuncIterator.TrueRemove;
-begin
- FIterator.Remove;
-end;
-
-{ TKeyFilterMapIterator }
-constructor TKeyFilterMapIterator.Create(const Iterator: IMapIterator; const Filter: IFilter; AllowRemoval: Boolean = true);
-begin
- FIterator := Iterator;
- FFilter := Filter;
-end;
-
-destructor TKeyFilterMapIterator.Destroy;
-begin
- FIterator := nil;
- FFilter := nil;
-end;
-
-function TKeyFilterMapIterator.TrueFirst: ICollectable;
-var
- Key, Item: ICollectable;
-begin
- Item := FIterator.First;
- while not FIterator.EOF do
- begin
- Key := FIterator.CurrentKey;
- if FFilter.Accept(Key) then
- break
- else
- Item := FIterator.Next;
- end;
- Result := Item;
-end;
-
-function TKeyFilterMapIterator.TrueNext: ICollectable;
-var
- Key, Item: ICollectable;
-begin
- Item := FIterator.Next;
- while not FIterator.EOF do
- begin
- Key := FIterator.CurrentKey;
- if FFilter.Accept(Key) then
- break
- else
- Item := FIterator.Next;
- end;
- Result := Item;
-end;
-
-procedure TKeyFilterMapIterator.TrueRemove;
-begin
- FIterator.Remove;
-end;
-
-function TKeyFilterMapIterator.CurrentKey: ICollectable;
-begin
- Result := FIterator.CurrentKey;
-end;
-
-{ TKeyFilterFuncMapIterator }
-constructor TKeyFilterFuncMapIterator.Create(const Iterator: IMapIterator; FilterFunc: TCollectionFilterFunc; AllowRemoval: Boolean = true);
-begin
- FIterator := Iterator;
- FFilterFunc := FilterFunc;
-end;
-
-destructor TKeyFilterFuncMapIterator.Destroy;
-begin
- FIterator := nil;
- FFilterFunc := nil;
-end;
-
-function TKeyFilterFuncMapIterator.TrueFirst: ICollectable;
-var
- Key, Item: ICollectable;
-begin
- Item := FIterator.First;
- while not FIterator.EOF do
- begin
- Key := FIterator.CurrentKey;
- if FFilterFunc(Key) then
- break
- else
- Item := FIterator.Next;
- end;
- Result := Item;
-end;
-
-function TKeyFilterFuncMapIterator.TrueNext: ICollectable;
-var
- Key, Item: ICollectable;
-begin
- Item := FIterator.Next;
- while not FIterator.EOF do
- begin
- Key := FIterator.CurrentKey;
- if FFilterFunc(Key) then
- break
- else
- Item := FIterator.Next;
- end;
- Result := Item;
-end;
-
-procedure TKeyFilterFuncMapIterator.TrueRemove;
-begin
- FIterator.Remove;
-end;
-
-function TKeyFilterFuncMapIterator.CurrentKey: ICollectable;
-begin
- Result := FIterator.CurrentKey;
-end;
-
-
-{ TAbstractCollection }
-constructor TAbstractCollection.Create;
-begin
- Create(false);
-end;
-
-constructor TAbstractCollection.Create(NaturalItemsOnly: Boolean);
-begin
- FCreated := false;
- inherited Create;
- FNaturalItemsOnly := NaturalItemsOnly or GetAlwaysNaturalItems;
- if FNaturalItemsOnly then
- FComparator := TAbstractComparator.GetNaturalComparator
- else
- FComparator := TAbstractComparator.GetDefaultComparator;
- FIgnoreErrors := [ceDuplicate];
-end;
-
-constructor TAbstractCollection.Create(const ItemArray: array of ICollectable);
-begin
- Create(ItemArray, false);
-end;
-
-// Fixed size collections must override this.
-constructor TAbstractCollection.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
-var
- I: Integer;
-begin
- Create(NaturalItemsOnly);
- if not FixedSize then
- begin
- Capacity := Length(ItemArray);
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- Add(ItemArray[I]);
- end;
- end;
-end;
-
-// Fixed size collections must override this.
-constructor TAbstractCollection.Create(const Collection: ICollection);
-var
- Iterator: IIterator;
-begin
- Create(Collection.GetNaturalItemsOnly);
- InitFrom(Collection);
- if not FixedSize then
- begin
- Capacity := Collection.GetSize;
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- Add(Iterator.CurrentItem);
- Iterator.Next;
- end;
- end;
-end;
-
-destructor TAbstractCollection.Destroy;
-begin
- FCreated := false;
- FComparator := nil;
- inherited Destroy;
-end;
-
-procedure TAbstractCollection.CollectionError(ErrorType: TCollectionError);
-var
- Msg: String;
-begin
- if not (ErrorType in FIgnoreErrors) then
- begin
- case ErrorType of
- ceDuplicate: Msg := 'Collection does not allow duplicates.';
- ceDuplicateKey: Msg := 'Collection does not allow duplicate keys.';
- ceFixedSize: Msg := 'Collection has fixed size.';
- ceNilNotAllowed: Msg := 'Collection does not allow nil.';
- ceNotNaturalItem: Msg := 'Collection only accepts natural items.';
- ceOutOfRange: Msg := 'Index out of collection range.';
- end;
- // If exception is thrown during construction, collection cannot be
- // passed to it as destructor is automatically called and this leaves an
- // interface reference to a destroyed object and crashes.
- if FCreated then
- raise ECollectionError.Create(Msg, Self, ErrorType)
- else
- raise ECollectionError.Create(Msg, nil, ErrorType);
- end;
-end;
-
-procedure TAbstractCollection.InitFrom(const Collection: ICollection);
-begin
- Comparator := Collection.GetComparator;
- IgnoreErrors := Collection.GetIgnoreErrors;
-end;
-
-// Implementations should override this if possible
-function TAbstractCollection.TrueItemCount(const Item: ICollectable): Integer;
-var
- Iterator: IIterator;
- Total: Integer;
-begin
- Total := 0;
- Iterator := GetIterator;
- while not Iterator.EOF do
- begin
- if FComparator.Equals(Item, Iterator.CurrentItem) then
- Inc(Total);
- Iterator.Next;
- end;
- Result := Total;
-end;
-
-class function TAbstractCollection.GetAlwaysNaturalItems: Boolean;
-begin
- Result := false;
-end;
-
-function TAbstractCollection.GetAsArray: TCollectableArray;
-var
- Iterator: IIterator;
- Working: TCollectableArray;
- I: Integer;
-begin
- SetLength(Working, Size);
- I := 0;
- Iterator := GetIterator;
- while not Iterator.EOF do
- begin
- Working[I] := Iterator.CurrentItem;
- Inc(I);
- Iterator.Next;
- end;
- Result := Working;
-end;
-
-function TAbstractCollection.GetComparator: IComparator;
-begin
- Result := FComparator;
-end;
-
-function TAbstractCollection.GetDuplicates: Boolean;
-begin
- Result := true; // Sets and lists override this.
-end;
-
-procedure TAbstractCollection.SetComparator(const Value: IComparator);
-begin
- if Value = nil then
- begin
- if NaturalItemsOnly then
- FComparator := TAbstractComparator.GetNaturalComparator
- else
- FComparator := TAbstractComparator.GetDefaultComparator;
- end
- else
- FComparator := Value;
-end;
-
-function TAbstractCollection.GetFixedSize: Boolean;
-begin
- Result := false;
-end;
-
-function TAbstractCollection.GetIgnoreErrors: TCollectionErrors;
-begin
- Result := FIgnoreErrors;
-end;
-
-procedure TAbstractCollection.SetIgnoreErrors(Value: TCollectionErrors);
-begin
- FIgnoreErrors := Value;
-end;
-
-function TAbstractCollection.GetInstance: TObject;
-begin
- Result := Self;
-end;
-
-function TAbstractCollection.GetIterator(const Filter: IFilter): IIterator;
-var
- Iterator: IIterator;
-begin
- Iterator := GetIterator;
- Result := TFilterIterator.Create(Iterator, Filter, Iterator.GetAllowRemoval);
-end;
-
-function TAbstractCollection.GetIterator(FilterFunc: TCollectionFilterFunc): IIterator;
-var
- Iterator: IIterator;
-begin
- Iterator := GetIterator;
- Result := TFilterFuncIterator.Create(Iterator, FilterFunc, Iterator.GetAllowRemoval);
-end;
-
-function TAbstractCollection.GetNaturalItemsOnly: Boolean;
-begin
- Result := FNaturalItemsOnly;
-end;
-
-function TAbstractCollection.Add(const Item: ICollectable): Boolean;
-var
- ItemError: TCollectionError;
- Success: Boolean;
-begin
- ItemError := ItemAllowed(Item); // Can be natural items only error or nil not allowed error
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- Success := false;
- end
- else if FixedSize then
- begin
- CollectionError(ceFixedSize);
- Success := false;
- end
- else
- begin
- Success := TrueAdd(Item);
- end;
- Result := Success;
-end;
-
-function TAbstractCollection.Add(const ItemArray: array of ICollectable): Integer;
-var
- Item: ICollectable;
- ItemError: TCollectionError;
- I, Count: Integer;
- Success: Boolean;
-begin
- Count := 0;
- if FixedSize then
- begin
- CollectionError(ceFixedSize);
- end
- else
- begin
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- Item := ItemArray[I];
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- Success := false;
- end
- else
- begin
- Success := TrueAdd(Item);
- end;
- if Success then
- Inc(Count);
- end;
- end;
- Result := Count;
-end;
-
-function TAbstractCollection.Add(const Collection: ICollection): Integer;
-var
- Iterator: IIterator;
- Item: ICollectable;
- ItemError: TCollectionError;
- Count: Integer;
- Success: Boolean;
-begin
- Count := 0;
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- Item := Iterator.CurrentItem;
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- Success := false;
- end
- else if FixedSize then
- begin
- CollectionError(ceFixedSize);
- Success := false;
- end
- else
- begin
- Success := TrueAdd(Item);
- end;
- if Success then
- Inc(Count);
- Iterator.Next;
- end;
- Result := Count;
-end;
-
-procedure TAbstractCollection.AfterConstruction;
-begin
- inherited AfterConstruction;
- FCreated := true;
-end;
-
-procedure TAbstractCollection.BeforeDestruction;
-begin
- if not FixedSize then
- TrueClear;
- inherited BeforeDestruction;
-end;
-
-function TAbstractCollection.Clear: Integer;
-begin
- if not FixedSize then
- begin
- Result := Size;
- TrueClear;
- end
- else
- begin
- CollectionError(ceFixedSize);
- Result := 0;
- end;
-end;
-
-function TAbstractCollection.Clone: ICollection;
-begin
- Result := (TAbstractCollectionClass(ClassType)).Create(Self);
-end;
-
-function TAbstractCollection.Contains(const Item: ICollectable): Boolean;
-var
- ItemError: TCollectionError;
- Success: Boolean;
-begin
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- Success := false;
- end
- else
- begin
- Success := TrueContains(Item);
- end;
- Result := Success;
-end;
-
-function TAbstractCollection.Contains(const ItemArray: array of ICollectable): Boolean;
-var
- I: Integer;
- Success: Boolean;
-begin
- Success := true;
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- Success := Success and Contains(ItemArray[I]);
- if not Success then
- break;
- end;
- Result := Success;
-end;
-
-function TAbstractCollection.Contains(const Collection: ICollection): Boolean;
-var
- Iterator: IIterator;
- Success: Boolean;
-begin
- Success := true;
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- Success := Success and Contains(Iterator.CurrentItem);
- if not Success then
- break;
- Iterator.Next;
- end;
- Result := Success;
-end;
-
-function TAbstractCollection.Equals(const Collection: ICollection): Boolean;
-var
- Iterator: IIterator;
- Success: Boolean;
-begin
- if Collection.GetType <> GetType then
- Result := false
- else if Collection.Size <> Size then
- Result := false
- else if not Collection.Comparator.Equals(Comparator) then
- Result := false
- else if not Collection.GetDuplicates and not GetDuplicates then
- begin
- // Not equal if any item not found in parameter collection
- Success := true;
- Iterator := GetIterator;
- while not Iterator.EOF and Success do
- begin
- Success := Collection.Contains(Iterator.CurrentItem);
- Iterator.Next;
- end;
- Result := Success;
- end
- else
- begin
- // Not equal if any item count not equal to item count in parameter collection
- Success := true;
- Iterator := GetIterator;
- while not Iterator.EOF and Success do
- begin
- Success := (ItemCount(Iterator.CurrentItem) = Collection.ItemCount(Iterator.CurrentItem));
- Iterator.Next;
- end;
- Result := Success;
- end;
-end;
-
-function TAbstractCollection.Find(const Filter: IFilter): ICollectable;
-begin
- Result := GetIterator(Filter).First;
-end;
-
-function TAbstractCollection.Find(FilterFunc: TCollectionFilterFunc): ICollectable;
-begin
- Result := GetIterator(FilterFunc).First;
-end;
-
-function TAbstractCollection.FindAll(const Filter: IFilter): ICollection;
-var
- ResultCollection: ICollection;
- Iterator: IIterator;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := Self.GetIterator(Filter);
- while not Iterator.EOF do
- begin
- ResultCollection.Add(Iterator.CurrentItem);
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractCollection.FindAll(FilterFunc: TCollectionFilterFunc): ICollection;
-var
- ResultCollection: ICollection;
- Iterator: IIterator;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := Self.GetIterator(FilterFunc);
- while not Iterator.EOF do
- begin
- ResultCollection.Add(Iterator.CurrentItem);
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractCollection.IsEmpty: Boolean;
-begin
- Result := (Size = 0);
-end;
-
-function TAbstractCollection.IsNaturalItem(const Item: ICollectable): Boolean;
-var
- Temp: IUnknown;
-begin
- if Item <> nil then
- Result := (Item.QueryInterface(NaturalItemIID, Temp) <> E_NOINTERFACE)
- else
- Result := false;
-end;
-
-function TAbstractCollection.ItemAllowed(const Item: ICollectable): TCollectionError;
-begin
- if NaturalItemsOnly and not IsNaturalItem(Item) then
- Result := ceNotNaturalItem
- else if not IsNilAllowed and (Item = nil) then
- Result := ceNilNotAllowed
- else
- Result := ceOK;
-end;
-
-function TAbstractCollection.ItemCount(const Item: ICollectable): Integer;
-var
- ItemError: TCollectionError;
-begin
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- Result := 0;
- end
- else if GetDuplicates then
- begin
- Result := TrueItemCount(Item);
- end
- else
- begin
- // Where duplicates are not allowed, TrueContains will be faster than TrueItemCount.
- if TrueContains(Item) then
- Result := 1
- else
- Result := 0;
- end;
-end;
-
-function TAbstractCollection.ItemCount(const ItemArray: array of ICollectable): Integer;
-var
- I: Integer;
- Total: Integer;
-begin
- Total := 0;
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- Total := Total + ItemCount(ItemArray[I]);
- end;
- Result := Total;
-end;
-
-function TAbstractCollection.ItemCount(const Collection: ICollection): Integer;
-var
- Iterator: IIterator;
- Total: Integer;
-begin
- Total := 0;
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- Total := Total + ItemCount(Iterator.CurrentItem);
- Iterator.Next;
- end;
- Result := Total;
-end;
-
-function TAbstractCollection.Matching(const ItemArray: array of ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- I: Integer;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- if Contains(ItemArray[I]) then
- ResultCollection.Add(ItemArray[I]);
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractCollection.Matching(const Collection: ICollection): ICollection;
-var
- ResultCollection: ICollection;
- Iterator: IIterator;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- if Contains(Iterator.CurrentItem) then
- ResultCollection.Add(Iterator.CurrentItem);
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractCollection.Remove(const Item: ICollectable): ICollectable;
-var
- ItemError: TCollectionError;
-begin
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- Result := nil;
- end
- else if FixedSize then
- begin
- CollectionError(ceFixedSize);
- Result := nil;
- end
- else
- begin
- Result := TrueRemove(Item);
- end;
-end;
-
-function TAbstractCollection.Remove(const ItemArray: array of ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- I: Integer;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- ResultCollection.Add(Remove(ItemArray[I]));
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractCollection.Remove(const Collection: ICollection): ICollection;
-var
- ResultCollection: ICollection;
- Iterator: IIterator;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- ResultCollection.Add(Remove(Iterator.CurrentItem));
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractCollection.RemoveAll(const Item: ICollectable): ICollection;
-var
- ItemError: TCollectionError;
-begin
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- Result := nil;
- end
- else if FixedSize then
- begin
- CollectionError(ceFixedSize);
- Result := nil;
- end
- else
- begin
- Result := TrueRemoveAll(Item);
- end;
-end;
-
-function TAbstractCollection.RemoveAll(const ItemArray: array of ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- I: Integer;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- ResultCollection.Add(RemoveAll(ItemArray[I]));
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractCollection.RemoveAll(const Collection: ICollection): ICollection;
-var
- ResultCollection: ICollection;
- Iterator: IIterator;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- ResultCollection.Add(RemoveAll(Iterator.CurrentItem));
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractCollection.Retain(const ItemArray: array of ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- Iterator: IIterator;
- Item: ICollectable;
- I: Integer;
- Found, Success: Boolean;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := GetIterator;
- while not Iterator.EOF do
- begin
- // Converting the array to a map would be faster but I don't want to
- // couple base class code to a complex collection.
- Found := false;
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- Item := Iterator.CurrentItem;
- Found := Comparator.Equals(Item, ItemArray[I]);
- if Found then
- break;
- end;
- if not Found then
- begin
- Success := Iterator.Remove;
- if Success then
- ResultCollection.Add(Item);
- end;
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractCollection.Retain(const Collection: ICollection): ICollection;
-var
- ResultCollection: ICollection;
- Iterator: IIterator;
- Item: ICollectable;
- Success: Boolean;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := GetIterator;
- while not Iterator.EOF do
- begin
- Item := Iterator.CurrentItem;
- if not Collection.Contains(Item) then
- begin
- Success := Iterator.Remove;
- if Success then
- ResultCollection.Add(Item);
- end;
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-{ TAbstractBag }
-function TAbstractBag.CloneAsBag: IBag;
-begin
- Result := (TAbstractBagClass(ClassType)).Create(Self);
-end;
-
-function TAbstractBag.GetNaturalItemIID: TGUID;
-begin
- Result := EquatableIID;
-end;
-
-function TAbstractBag.GetType: TCollectionType;
-begin
- Result := ctBag;
-end;
-
-function TAbstractBag.IsNilAllowed: Boolean;
-begin
- Result := true;
-end;
-
-{ TAbstractSet }
-function TAbstractSet.TrueAdd(const Item: ICollectable): Boolean;
-var
- Position: TCollectionPosition;
-begin
- // Adds if not already present otherwise fails
- Position := GetPosition(Item);
- try
- if Position.Found then
- begin
- CollectionError(ceDuplicate);
- Result := false;
- end
- else
- begin
- TrueAdd2(Position, Item);
- Result := true;
- end;
- finally
- Position.Free;
- end;
-end;
-
-function TAbstractSet.TrueContains(const Item: ICollectable): Boolean;
-var
- Position: TCollectionPosition;
-begin
- Position := GetPosition(Item);
- try
- Result := Position.Found;
- finally
- Position.Free;
- end;
-end;
-
-function TAbstractSet.TrueRemove(const Item: ICollectable): ICollectable;
-var
- Position: TCollectionPosition;
-begin
- Position := GetPosition(Item);
- try
- if Position.Found then
- begin
- Result := TrueGet(Position);
- TrueRemove2(Position);
- end
- else
- Result := nil;
- finally
- Position.Free;
- end;
-end;
-
-function TAbstractSet.TrueRemoveAll(const Item: ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- RemovedItem: ICollectable;
-begin
- ResultCollection := TPArrayBag.Create;
- RemovedItem := TrueRemove(Item);
- if RemovedItem <> nil then
- ResultCollection.Add(RemovedItem);
- Result := ResultCollection;
-end;
-
-function TAbstractSet.GetDuplicates: Boolean;
-begin
- Result := false;
-end;
-
-function TAbstractSet.GetNaturalItemIID: TGUID;
-begin
- Result := EquatableIID;
-end;
-
-function TAbstractSet.GetType: TCollectionType;
-begin
- Result := ctSet;
-end;
-
-function TAbstractSet.CloneAsSet: ISet;
-begin
- Result := (TAbstractSetClass(ClassType)).Create(Self);
-end;
-
-function TAbstractSet.Complement(const Universe: ISet): ISet;
-var
- ResultSet: ISet;
- Iterator: IIterator;
- Item: ICollectable;
-begin
- // Return items in universe not found in self.
- ResultSet := TAbstractSetClass(ClassType).Create(NaturalItemsOnly);
- Iterator := Universe.GetIterator;
- while not Iterator.EOF do
- begin
- Item := Iterator.CurrentItem;
- if not Contains(Item) then
- ResultSet.Add(Item);
- Iterator.Next;
- end;
- Result := ResultSet;
-end;
-
-function TAbstractSet.Intersect(const Set2: ISet): ISet;
-var
- ResultSet: ISet;
- Iterator: IIterator;
- Item: ICollectable;
-begin
- // Return items found in self and parameter.
- ResultSet := TAbstractSetClass(ClassType).Create(NaturalItemsOnly);
- Iterator := GetIterator;
- while not Iterator.EOF do
- begin
- Item := Iterator.CurrentItem;
- if Contains(Item) and Set2.Contains(Item) then
- ResultSet.Add(Iterator.CurrentItem);
- Iterator.Next;
- end;
- Result := ResultSet;
-end;
-
-function TAbstractSet.IsNilAllowed: Boolean;
-begin
- Result := false;
-end;
-
-function TAbstractSet.Union(const Set2: ISet): ISet;
-var
- ResultSet: ISet;
- Iterator: IIterator;
- Item: ICollectable;
-begin
- // Return items found in self or parameter.
- ResultSet := CloneAsSet;
- Iterator := Set2.GetIterator;
- while not Iterator.EOF do
- begin
- Item := Iterator.CurrentItem;
- if not Contains(Item) and Set2.Contains(Item) then
- ResultSet.Add(Iterator.CurrentItem);
- Iterator.Next;
- end;
- Result := ResultSet;
-end;
-
-{ TAbstractList }
-constructor TAbstractList.Create(NaturalItemsOnly: Boolean);
-begin
- inherited Create(NaturalItemsOnly);
- FDuplicates := true;
- FSorted := false;
-end;
-
-procedure TAbstractList.InitFrom(const Collection: ICollection);
-var
- List: IList;
-begin
- inherited InitFrom(Collection);
- if Collection.QueryInterface(IList, List) = S_OK then
- begin
- FDuplicates := List.GetDuplicates;
- FSorted := List.GetSorted;
- end;
-end;
-
-function TAbstractList.TrueAdd(const Item: ICollectable): Boolean;
-var
- SearchResult: TSearchResult;
-begin
- Result := True;
- if Sorted then
- begin
- // Insert in appropriate place to maintain sort order, unless duplicate
- // not allowed.
- SearchResult := BinarySearch(Item);
- case SearchResult.ResultType of
- srBeforeIndex: TrueInsert(SearchResult.Index, Item);
- srFoundAtIndex: begin
- if Duplicates then
- TrueInsert(SearchResult.Index, Item)
- else
- begin
- CollectionError(ceDuplicate);
- Result := false;
- end;
- end;
- srAfterEnd: TrueAppend(Item);
- end;
- end
- else
- begin
- // Add to end, unless duplicate not allowed.
- if not Duplicates and (SequentialSearch(Item, Comparator).ResultType = srFoundAtIndex) then
- begin
- CollectionError(ceDuplicate);
- Result := false;
- end
- else
- TrueAppend(Item);
- end;
-end;
-
-function TAbstractList.TrueContains(const Item: ICollectable): Boolean;
-begin
- if Sorted then
- Result := BinarySearch(Item).ResultType = srFoundAtIndex
- else
- Result := SequentialSearch(Item, Comparator).ResultType = srFoundAtIndex
-end;
-
-function TAbstractList.TrueItemCount(const Item: ICollectable): Integer;
-var
- SearchResult: TSearchResult;
- Count: Integer;
-begin
- if Sorted then
- begin
- // If sorted, use binary search.
- Count := 0;
- SearchResult := BinarySearch(Item);
- if SearchResult.ResultType = srFoundAtIndex then
- begin
- repeat
- Inc(Count);
- until not Comparator.Equals(Item, Items[SearchResult.Index]);
- end;
- Result := Count;
- end
- else
- // Resort to sequential search for unsorted
- Result := inherited TrueItemCount(Item);
-end;
-
-function TAbstractList.TrueRemove(const Item: ICollectable): ICollectable;
-var
- SearchResult: TSearchResult;
-begin
- Result := nil;
- if Sorted then
- begin
- SearchResult := BinarySearch(Item);
- if SearchResult.ResultType = srFoundAtIndex then
- begin
- Result := TrueDelete(SearchResult.Index);
- end;
- end
- else
- begin
- SearchResult := SequentialSearch(Item);
- if SearchResult.ResultType = srFoundAtIndex then
- Result := TrueDelete(SearchResult.Index);
- end;
-end;
-
-function TAbstractList.TrueRemoveAll(const Item: ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- SearchResult: TSearchResult;
- I: Integer;
-begin
- ResultCollection := TPArrayBag.Create;
- if Sorted then
- begin
- SearchResult := BinarySearch(Item);
- if SearchResult.ResultType = srFoundAtIndex then
- begin
- repeat
- ResultCollection.Add(TrueDelete(SearchResult.Index));
- until not Comparator.Equals(Item, Items[SearchResult.Index]);
- end;
- end
- else
- begin
- I := 0;
- while I < Size do
- begin
- if Comparator.Equals(Item, Items[I]) then
- begin
- ResultCollection.Add(TrueDelete(I));
- end
- else
- Inc(I);
- end;
- end;
- Result := ResultCollection;
-end;
-
-procedure TAbstractList.QuickSort(Lo, Hi: Integer; const Comparator: IComparator);
-var
- I, J, Mid: Integer;
-begin
- repeat
- I := Lo;
- J := Hi;
- Mid := (Lo + Hi) div 2;
- repeat
- while Comparator.Compare(Items[I], Items[Mid]) < 0 do
- Inc(I);
- while Comparator.Compare(Items[J], Items[Mid]) > 0 do
- Dec(J);
- if I <= J then
- begin
- Exchange(I, J);
- if Mid = I then
- Mid := J
- else if Mid = J then
- Mid := I;
- Inc(I);
- Dec(J);
- end;
- until I > J;
- if Lo < J then
- QuickSort(Lo, J, Comparator);
- Lo := I;
- until I >= Hi;
-end;
-
-procedure TAbstractList.QuickSort(Lo, Hi: Integer; CompareFunc: TCollectionCompareFunc);
-var
- I, J, Mid: Integer;
-begin
- repeat
- I := Lo;
- J := Hi;
- Mid := (Lo + Hi) div 2;
- repeat
- while CompareFunc(Items[I], Items[Mid]) < 0 do
- Inc(I);
- while CompareFunc(Items[J], Items[Mid]) > 0 do
- Dec(J);
- if I <= J then
- begin
- Exchange(I, J);
- if Mid = I then
- Mid := J
- else if Mid = J then
- Mid := I;
- Inc(I);
- Dec(J);
- end;
- until I > J;
- if Lo < J then
- QuickSort(Lo, J, CompareFunc);
- Lo := I;
- until I >= Hi;
-end;
-
-function TAbstractList.GetDuplicates: Boolean;
-begin
- Result := FDuplicates;
-end;
-
-procedure TAbstractList.SetDuplicates(Value: Boolean);
-var
- Iterator: IIterator;
- Failed: Boolean;
-begin
- Failed := false;
- // If trying to set no duplicates, check there are no existing duplicates.
- if not Value then
- begin
- Iterator := GetIterator;
- while not Iterator.EOF and not Failed do
- begin
- Failed := (ItemCount(Iterator.CurrentItem) > 1);
- Iterator.Next;
- end;
- if Failed then
- CollectionError(ceDuplicate);
- end;
- if not Failed then
- FDuplicates := Value;
-end;
-
-function TAbstractList.GetItem(Index: Integer): ICollectable;
-begin
- if (Index < 0) or (Index >= Size) then
- begin
- CollectionError(ceOutOfRange);
- Result := nil;
- end
- else
- Result := TrueGetItem(Index);
-end;
-
-procedure TAbstractList.SetItem(Index: Integer; const Item: ICollectable);
-var
- SearchResult: TSearchResult;
-begin
- if (Index < 0) or (Index >= Size) then
- begin
- CollectionError(ceOutOfRange)
- end
- else if not Duplicates then
- begin
- // Find any duplicates
- if Sorted then
- begin
- SearchResult := BinarySearch(Item);
- case SearchResult.ResultType of
- srBeforeIndex, srAfterEnd: begin // If item is not present
- FSorted := false;
- TrueSetItem(Index, Item);
- end;
- srFoundAtIndex: begin // If item is already present
- CollectionError(ceDuplicate);
- end;
- end;
- end
- else
- begin
- // If item is already present
- if SequentialSearch(Item, Comparator).ResultType = srFoundAtIndex then
- begin
- CollectionError(ceDuplicate);
- end
- else
- begin
- TrueSetItem(Index, Item);
- end;
- end;
- end
- else
- begin
- FSorted := false;
- TrueSetItem(Index, Item);
- end;
-end;
-
-function TAbstractList.GetIterator: IIterator;
-begin
- Result := TAbstractListIterator.Create(Self);
-end;
-
-function TAbstractList.GetNaturalItemIID: TGUID;
-begin
- Result := ComparableIID;
-end;
-
-function TAbstractList.GetSorted: Boolean;
-begin
- Result := FSorted;
-end;
-
-procedure TAbstractList.SetSorted(Value: Boolean);
-begin
- if Value then
- Sort;
-end;
-
-function TAbstractList.GetType: TCollectionType;
-begin
- Result := ctList;
-end;
-
-function TAbstractList.BinarySearch(const Item: ICollectable): TSearchResult;
-var
- Lo, Hi, Mid: Integer;
- CompareResult: Integer;
- Success: Boolean;
-begin
- if Size = 0 then
- begin
- Result.ResultType := srAfterEnd;
- Exit;
- end;
- Lo := 0;
- Hi := Size - 1;
- Success := false;
- repeat
- Mid := (Lo + Hi) div 2;
- CompareResult := Comparator.Compare(Item, Items[Mid]);
- if CompareResult = 0 then
- Success := true
- else if CompareResult > 0 then
- Lo := Mid + 1
- else
- Hi := Mid - 1;
- until (Lo > Hi) or Success;
- if Success then
- begin
- // Move index back if in cluster of duplicates
- while (Mid > 0) and Comparator.Equals(Item, Items[Mid - 1]) do
- Dec(Mid);
- Result.ResultType := srFoundAtIndex;
- Result.Index := Mid;
- end
- else if CompareResult < 0 then
- begin
- Result.ResultType := srBeforeIndex;
- Result.Index := Mid;
- end
- else if Hi < Size - 1 then
- begin
- Result.ResultType := srBeforeIndex;
- Result.Index := Mid + 1;
- end
- else
- Result.ResultType := srAfterEnd;
-end;
-
-function TAbstractList.CloneAsList: IList;
-begin
- Result := (TAbstractListClass(ClassType)).Create(Self);
-end;
-
-function TAbstractList.Delete(Index: Integer): ICollectable;
-begin
- if FixedSize then
- begin
- CollectionError(ceFixedSize);
- Result := nil;
- end
- else if (Index < 0) or (Index >= Size) then
- begin
- CollectionError(ceOutOfRange);
- Result := nil;
- end
- else
- begin
- Result := TrueDelete(Index);
- end;
-end;
-
-procedure TAbstractList.Exchange(Index1, Index2: Integer);
-var
- Item: ICollectable;
-begin
- if (Index1 < 0) or (Index1 >= Size) then
- CollectionError(ceOutOfRange);
- if (Index2 < 0) or (Index2 >= Size) then
- CollectionError(ceOutOfRange);
- FSorted := false;
- Item := ICollectable(Items[Index1]);
- Items[Index1] := Items[Index2];
- Items[Index2] := Item;
-end;
-
-function TAbstractList.First: ICollectable;
-begin
- if Size > 0 then
- Result := Items[0]
- else
- Result := nil;
-end;
-
-function TAbstractList.IndexOf(const Item: ICollectable): Integer;
-var
- SearchResult: TSearchResult;
-begin
- if Sorted then
- SearchResult := BinarySearch(Item)
- else
- SearchResult := SequentialSearch(Item, Comparator);
- if SearchResult.ResultType = srFoundAtIndex then
- Result := SearchResult.Index
- else
- Result := -1;
-end;
-
-function TAbstractList.Insert(Index: Integer; const Item: ICollectable): Boolean;
-var
- ItemError: TCollectionError;
-begin
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- Result := false;
- end
- else if FixedSize then
- begin
- CollectionError(ceFixedSize);
- Result := false;
- end
- else if (Index < 0) or (Index > Size) then
- begin
- CollectionError(ceOutOfRange);
- Result := false;
- end
- else
- begin
- FSorted := false;
- if Index = Size then
- TrueAdd(Item)
- else
- TrueInsert(Index, Item);
- Result := true;
- end;
-end;
-
-function TAbstractList.Insert(Index: Integer; const ItemArray: array of ICollectable): Integer;
-var
- Item: ICollectable;
- ItemError: TCollectionError;
- I, NewIndex, Count: Integer;
- Success: Boolean;
-begin
- Count := 0;
- if FixedSize then
- begin
- CollectionError(ceFixedSize);
- end
- else if (Index < 0) or (Index > Size) then
- begin
- CollectionError(ceOutOfRange);
- end
- else
- begin
- // Insert entire array in place in correct order
- NewIndex := Index;
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- Item := ItemArray[I];
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- end
- else
- begin
- Success := Insert(NewIndex, Item);
- if Success then
- begin
- Inc(NewIndex);
- Inc(Count);
- end;
- end;
- end;
- end;
- Result := Count;
-end;
-
-function TAbstractList.Insert(Index: Integer; const Collection: ICollection): Integer;
-var
- Iterator: IIterator;
- Item: ICollectable;
- ItemError: TCollectionError;
- NewIndex, Count: Integer;
- Success: Boolean;
-begin
- Count := 0;
- if FixedSize then
- begin
- CollectionError(ceFixedSize);
- end
- else if (Index < 0) or (Index > Size) then
- begin
- CollectionError(ceOutOfRange);
- end
- else
- begin
- // Insert entire collection in place in correct order
- NewIndex := Index;
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- Item := Iterator.CurrentItem;
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- end
- else
- begin
- Success := Insert(NewIndex, Item);
- if Success then
- begin
- Inc(NewIndex);
- Inc(Count);
- end;
- end;
- Iterator.Next;
- end;
- end;
- Result := Count;
-end;
-
-function TAbstractList.IsNilAllowed: Boolean;
-begin
- Result := true;
-end;
-
-function TAbstractList.Last: ICollectable;
-begin
- if Size > 0 then
- Result := Items[Size - 1]
- else
- Result := nil;
-end;
-
-function TAbstractList.Search(const Item: ICollectable; const SearchComparator: IComparator = nil): TSearchResult;
-begin
- if Sorted and (SearchComparator = nil) then
- Result := BinarySearch(Item)
- else
- Result := SequentialSearch(Item, SearchComparator);
-end;
-
-function TAbstractList.SequentialSearch(const Item: ICollectable; const SearchComparator: IComparator): TSearchResult;
-var
- WorkingComparator: IComparator;
- I: Integer;
- Success: Boolean;
-begin
- if SearchComparator = nil then
- WorkingComparator := Comparator
- else
- WorkingComparator := SearchComparator;
- Result.ResultType := srNotFound;
- I := 0;
- Success := false;
- while (I < Size) and not Success do
- begin
- if WorkingComparator.Equals(Item, Items[I]) then
- begin
- Result.ResultType := srFoundAtIndex;
- Result.Index := I;
- Success := true;
- end
- else
- Inc(I);
- end;
-end;
-
-procedure TAbstractList.Sort(const SortComparator: IComparator);
-begin
- if SortComparator = nil then
- begin
- if Size > 0 then
- QuickSort(0, Size - 1, Comparator);
- FSorted := true;
- end
- else
- begin
- if Size > 0 then
- QuickSort(0, Size - 1, SortComparator);
- FSorted := false;
- end;
-end;
-
-procedure TAbstractList.Sort(CompareFunc: TCollectionCompareFunc);
-begin
- if Size > 0 then
- QuickSort(0, Size - 1, CompareFunc);
- FSorted := false;
-end;
-
-{ TAbstractMap }
-constructor TAbstractMap.Create;
-begin
- Create(false, true);
-end;
-
-constructor TAbstractMap.Create(NaturalItemsOnly: Boolean);
-begin
- Create(NaturalItemsOnly, true);
-end;
-
-constructor TAbstractMap.Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean);
-begin
- inherited Create(NaturalItemsOnly);
- FNaturalKeysOnly := NaturalKeysOnly or GetAlwaysNaturalKeys;
- FAssociationComparator := TAssociationComparator.Create(FNaturalKeysOnly);
- if FNaturalKeysOnly then
- FKeyComparator := TAbstractComparator.GetNaturalComparator
- else
- FKeyComparator := TAbstractComparator.GetDefaultComparator;
-end;
-
-constructor TAbstractMap.Create(const ItemArray: array of ICollectable);
-begin
- Create(ItemArray, true, true);
-end;
-
-constructor TAbstractMap.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
-begin
- Create(ItemArray, true, true);
-end;
-
-constructor TAbstractMap.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean);
-var
- I: Integer;
-begin
- Create(true, NaturalKeysOnly);
- if not FixedSize then
- begin
- Capacity := Length(ItemArray);
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- Add(ItemArray[I]);
- end;
- end;
-end;
-
-constructor TAbstractMap.Create(const KeyArray, ItemArray: array of ICollectable);
-begin
- Create(KeyArray, ItemArray, false, true);
-end;
-
-constructor TAbstractMap.Create(const KeyArray, ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
-begin
- Create(KeyArray, ItemArray, NaturalItemsOnly, true);
-end;
-
-constructor TAbstractMap.Create(const KeyArray, ItemArray: array of ICollectable; NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean);
-var
- I, Lo, Hi: Integer;
-begin
- Create(NaturalItemsOnly, NaturalKeysOnly);
- if not FixedSize then
- begin
- Capacity := Min(Length(KeyArray), Length(ItemArray));
- Lo := Max(Low(KeyArray), Low(ItemArray));
- Hi := Min(High(KeyArray), High(ItemArray));
- for I := Lo to Hi do
- begin
- Put(KeyArray[I], ItemArray[I]);
- end;
- end;
-end;
-
-constructor TAbstractMap.Create(const Map: IMap);
-var
- MapIterator: IMapIterator;
-begin
- Create(Map.GetNaturalItemsOnly, Map.GetNaturalKeysOnly);
- InitFrom(Map);
- if not FixedSize then
- begin
- Capacity := Map.GetSize;
- MapIterator := Map.GetMapIterator;
- while not MapIterator.EOF do
- begin
- Put(MapIterator.CurrentKey, MapIterator.CurrentItem);
- MapIterator.Next;
- end;
- end;
-end;
-
-destructor TAbstractMap.Destroy;
-begin
- FKeyComparator := nil;
- FAssociationComparator := nil;
- inherited Destroy;
-end;
-
-procedure TAbstractMap.InitFrom(const Collection: ICollection);
-var
- Map: IMap;
-begin
- inherited InitFrom(Collection);
- if Collection.QueryInterface(IMap, Map) = S_OK then
- begin
- FNaturalKeysOnly := Map.GetNaturalKeysOnly or GetAlwaysNaturalKeys;
- KeyComparator := Map.GetKeyComparator;
- end;
-end;
-
-function TAbstractMap.TrueAdd(const Item: ICollectable): Boolean;
-var
- Position: TCollectionPosition;
- Mappable: IMappable;
-begin
- if IsNaturalItem(Item) then
- begin
- Mappable := Item as IMappable;
- Position := GetKeyPosition(Mappable.GetKey);
- try
- if Position.Found then
- begin
- CollectionError(ceDuplicateKey);
- Result := false;
- end
- else
- begin
- TruePut(Position, TAssociation.Create(Mappable.GetKey, Item));
- Result := true;
- end;
- finally
- Position.Free;
- end;
- end
- else
- begin
- CollectionError(ceNotNaturalItem);
- Result := false;
- end;
-end;
-
-function TAbstractMap.TrueContains(const Item: ICollectable): Boolean;
-var
- Item2: ICollectable;
- Success: Boolean;
- Iterator: IIterator;
-begin
- Iterator := GetIterator;
- Success := false;
- while not Iterator.EOF and not Success do
- begin
- Item2 := Iterator.CurrentItem;
- if Comparator.Equals(Item, Item2) then
- Success := true;
- Iterator.Next;
- end;
- Result := Success;
-end;
-
-function TAbstractMap.TrueRemove(const Item: ICollectable): ICollectable;
-var
- Item2: ICollectable;
- Iterator: IMapIterator;
- Found: Boolean;
-begin
- // Sequential search
- Found := false;
- Result := nil;
- Iterator := GetAssociationIterator;
- while not Iterator.EOF and not Found do
- begin
- Item2 := Iterator.CurrentItem;
- if Comparator.Equals(Item, Item2) then
- begin
- Result := Item2;
- Iterator.Remove;
- Found := true;
- end;
- Iterator.Next;
- end;
-end;
-
-function TAbstractMap.TrueRemoveAll(const Item: ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- Item2: ICollectable;
- Iterator: IMapIterator;
-begin
- // Sequential search
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := GetAssociationIterator;
- while not Iterator.EOF do
- begin
- Item2 := Iterator.CurrentItem;
- if Comparator.Equals(Item, Item2) then
- begin
- ResultCollection.Add(Item2);
- Iterator.Remove;
- end;
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-class function TAbstractMap.GetAlwaysNaturalKeys: Boolean;
-begin
- Result := false;
-end;
-
-function TAbstractMap.GetItem(const Key: ICollectable): ICollectable;
-begin
- Result := Get(Key);
-end;
-
-procedure TAbstractMap.SetItem(const Key, Item: ICollectable);
-begin
- Put(Key, Item);
-end;
-
-function TAbstractMap.GetIterator: IIterator;
-begin
- Result := GetAssociationIterator;
-end;
-
-function TAbstractMap.GetKeyComparator: IComparator;
-begin
- Result := FKeyComparator;
-end;
-
-procedure TAbstractMap.SetKeyComparator(const Value: IComparator);
-begin
- FKeyComparator := Value;
- FAssociationComparator.KeyComparator := Value;
-end;
-
-function TAbstractMap.GetKeyIterator: IIterator;
-begin
- Result := TAssociationKeyIterator.Create(GetAssociationIterator);
-end;
-
-function TAbstractMap.GetKeys: ISet;
-var
- ResultCollection: TPArraySet;
- KeyIterator: IIterator;
-begin
- ResultCollection := TPArraySet.Create(NaturalKeysOnly);
- ResultCollection.SetComparator(GetKeyComparator);
- KeyIterator := GetKeyIterator;
- while not KeyIterator.EOF do
- begin
- ResultCollection.Add(KeyIterator.CurrentItem);
- KeyIterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractMap.GetMapIterator: IMapIterator;
-begin
- Result := GetAssociationIterator;
-end;
-
-function TAbstractMap.GetMapIteratorByKey(const Filter: IFilter): IMapIterator;
-var
- Iterator: IMapIterator;
-begin
- Iterator := GetMapIterator;
- Result := TKeyFilterMapIterator.Create(Iterator, Filter, Iterator.GetAllowRemoval);
-end;
-
-function TAbstractMap.GetMapIteratorByKey(FilterFunc: TCollectionFilterFunc): IMapIterator;
-var
- Iterator: IMapIterator;
-begin
- Iterator := GetMapIterator;
- Result := TKeyFilterFuncMapIterator.Create(Iterator, FilterFunc, Iterator.GetAllowRemoval);
-end;
-
-function TAbstractMap.GetNaturalItemIID: TGUID;
-begin
- Result := MappableIID;
-end;
-
-function TAbstractMap.GetNaturalKeyIID: TGUID;
-begin
- Result := EquatableIID;
-end;
-
-function TAbstractMap.GetNaturalKeysOnly: Boolean;
-begin
- Result := FNaturalKeysOnly;
-end;
-
-function TAbstractMap.GetType: TCollectionType;
-begin
- Result := ctMap;
-end;
-
-function TAbstractMap.GetValues: ICollection;
-var
- ResultCollection: ICollection;
- ValueIterator: IIterator;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- ValueIterator := GetIterator;
- while not ValueIterator.EOF do
- begin
- ResultCollection.Add(ValueIterator.CurrentItem);
- ValueIterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-// Overrides TAbstractCollection function, otherwise Create(ICollection) is
-// called, which cannot access keys.
-function TAbstractMap.Clone: ICollection;
-begin
- Result := (TAbstractMapClass(ClassType)).Create(Self);
-end;
-
-function TAbstractMap.CloneAsMap: IMap;
-begin
- Result := (TAbstractMapClass(ClassType)).Create(Self);
-end;
-
-function TAbstractMap.ContainsKey(const Key: ICollectable): Boolean;
-var
- Position: TCollectionPosition;
-begin
- Position := GetKeyPosition(Key);
- try
- Result := Position.Found;
- finally
- Position.Free;
- end;
-end;
-
-function TAbstractMap.ContainsKey(const KeyArray: array of ICollectable): Boolean;
-var
- I: Integer;
- Success: Boolean;
-begin
- Success := true;
- for I := Low(KeyArray) to High(KeyArray) do
- begin
- Success := Success and ContainsKey(KeyArray[I]);
- if not Success then
- break;
- end;
- Result := Success;
-end;
-
-function TAbstractMap.ContainsKey(const Collection: ICollection): Boolean;
-var
- Iterator: IIterator;
- Success: Boolean;
-begin
- Success := true;
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- Success := Success and ContainsKey(Iterator.CurrentItem);
- if not Success then
- break;
- Iterator.Next;
- end;
- Result := Success;
-end;
-
-function TAbstractMap.Get(const Key: ICollectable): ICollectable;
-var
- KeyError: TCollectionError;
- Position: TCollectionPosition;
-begin
- KeyError := KeyAllowed(Key);
- if KeyError <> ceOK then
- begin
- CollectionError(KeyError);
- Result := nil;
- end
- else
- begin
- Position := GetKeyPosition(Key);
- try
- if Position.Found then
- Result := TrueGet(Position).GetValue
- else
- Result := nil;
- finally
- Position.Free;
- end;
- end;
-end;
-
-function TAbstractMap.KeyAllowed(const Key: ICollectable): TCollectionError;
-begin
- if NaturalKeysOnly and not IsNaturalKey(Key) then
- Result := ceNotNaturalItem
- else if Key = nil then
- Result := ceNilNotAllowed
- else
- Result := ceOK;
-end;
-
-function TAbstractMap.IsNaturalKey(const Key: ICollectable): Boolean;
-var
- Temp: IUnknown;
-begin
- if Key.QueryInterface(NaturalKeyIID, Temp) <> E_NOINTERFACE then
- Result := true
- else
- Result := false;
-end;
-
-function TAbstractMap.IsNilAllowed: Boolean;
-begin
- Result := true;
-end;
-
-function TAbstractMap.MatchingKey(const KeyArray: array of ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- I: Integer;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- for I := Low(KeyArray) to High(KeyArray) do
- begin
- if ContainsKey(KeyArray[I]) then
- ResultCollection.Add(KeyArray[I]);
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractMap.MatchingKey(const Collection: ICollection): ICollection;
-var
- ResultCollection: ICollection;
- Iterator: IIterator;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- if ContainsKey(Iterator.CurrentItem) then
- ResultCollection.Add(Iterator.CurrentItem);
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractMap.Put(const Item: ICollectable): ICollectable;
-var
- Mappable: IMappable;
- OldAssociation, NewAssociation: IAssociation;
- Position: TCollectionPosition;
-begin
- if not IsNaturalItem(Item) then
- begin
- CollectionError(ceNotNaturalItem);
- Result := nil;
- end
- else
- begin
- Item.QueryInterface(IMappable, Mappable);
- Position := GetKeyPosition(Mappable.GetKey);
- try
- NewAssociation := TAssociation.Create(Mappable.GetKey, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- Result := OldAssociation.GetValue
- else
- Result := nil;
- finally
- Position.Free;
- end;
- end;
-end;
-
-function TAbstractMap.Put(const Key, Item: ICollectable): ICollectable;
-var
- OldAssociation, NewAssociation: IAssociation;
- ItemError, KeyError: TCollectionError;
- Position: TCollectionPosition;
-begin
- ItemError := ItemAllowed(Item);
- KeyError := KeyAllowed(Key);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- Result := nil;
- end
- else if KeyError <> ceOK then
- begin
- CollectionError(KeyError);
- Result := nil;
- end
- else
- begin
- // Find appropriate place, then place key-item association there
- Position := GetKeyPosition(Key);
- try
- NewAssociation := TAssociation.Create(Key, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- Result := OldAssociation.GetValue
- else
- Result := nil;
- finally
- Position.Free;
- end;
- end;
-end;
-
-function TAbstractMap.Put(const ItemArray: array of ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- Mappable: IMappable;
- OldAssociation, NewAssociation: IAssociation;
- Position: TCollectionPosition;
- Item: ICollectable;
- I: Integer;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- Item := ItemArray[I];
- if not IsNaturalItem(Item) then
- begin
- CollectionError(ceNotNaturalItem);
- end
- else
- begin
- // Find appropriate place, then place key-item association there
- Item.QueryInterface(IMappable, Mappable);
- Position := GetKeyPosition(Mappable.GetKey);
- try
- NewAssociation := TAssociation.Create(Mappable.GetKey, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- ResultCollection.Add(OldAssociation.GetValue);
- finally
- Position.Free;
- end;
- end;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractMap.Put(const Collection: ICollection): ICollection;
-var
- ResultCollection: ICollection;
- Mappable: IMappable;
- OldAssociation, NewAssociation: IAssociation;
- Position: TCollectionPosition;
- Iterator: IIterator;
- Item: ICollectable;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- Item := Iterator.CurrentItem;;
- if not IsNaturalItem(Item) then
- begin
- CollectionError(ceNotNaturalItem);
- end
- else
- begin
- // Find appropriate place, then place key-item association there
- Item.QueryInterface(IMappable, Mappable);
- Position := GetKeyPosition(Mappable.GetKey);
- try
- NewAssociation := TAssociation.Create(Mappable.GetKey, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- ResultCollection.Add(OldAssociation.GetValue);
- finally
- Position.Free;
- end;
- end;
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractMap.Put(const Map: IMap): ICollection;
-var
- ResultCollection: ICollection;
- OldAssociation, NewAssociation: IAssociation;
- ItemError, KeyError: TCollectionError;
- Position: TCollectionPosition;
- MapIterator: IMapIterator;
- Key, Item: ICollectable;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- MapIterator := Map.GetMapIterator;
- while not MapIterator.EOF do
- begin
- Key := MapIterator.CurrentKey;
- Item := MapIterator.CurrentItem;
-
- ItemError := ItemAllowed(Item);
- KeyError := KeyAllowed(Key);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- end
- else if KeyError <> ceOK then
- begin
- CollectionError(KeyError);
- end
- else
- begin
- // Find appropriate place, then place key-item association there
- Position := GetKeyPosition(Key);
- try
- NewAssociation := TAssociation.Create(Key, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- ResultCollection.Add(OldAssociation.GetValue);
- finally
- Position.Free;
- end;
- end;
- MapIterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractMap.RemoveKey(const Key: ICollectable): ICollectable;
-var
- KeyError: TCollectionError;
- Position: TCollectionPosition;
- OldAssociation: IAssociation;
-begin
- KeyError := KeyAllowed(Key);
- if KeyError <> ceOK then
- begin
- CollectionError(KeyError);
- Result := nil;
- end
- else
- begin
- Position := GetKeyPosition(Key);
- try
- if Position.Found then
- begin
- OldAssociation := TrueRemove2(Position);
- Result := OldAssociation.GetValue
- end
- else
- Result := nil;
- finally
- Position.Free;
- end;
- end;
-end;
-
-function TAbstractMap.RemoveKey(const KeyArray: array of ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- OldAssociation: IAssociation;
- KeyError: TCollectionError;
- Position: TCollectionPosition;
- Key: ICollectable;
- I: Integer;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- for I := Low(KeyArray) to High(KeyArray) do
- begin
- Key := KeyArray[I];
- KeyError := KeyAllowed(Key);
- if KeyError <> ceOK then
- begin
- CollectionError(KeyError);
- end
- else
- begin
- Position := GetKeyPosition(Key);
- try
- if Position.Found then
- begin
- OldAssociation := TrueRemove2(Position);
- ResultCollection.Add(OldAssociation.GetValue);
- end;
- finally
- Position.Free;
- end;
- end;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractMap.RemoveKey(const Collection: ICollection): ICollection;
-var
- ResultCollection: ICollection;
- OldAssociation: IAssociation;
- KeyError: TCollectionError;
- Position: TCollectionPosition;
- Key: ICollectable;
- Iterator: IIterator;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- Key := Iterator.CurrentItem;
- KeyError := KeyAllowed(Key);
- if KeyError <> ceOK then
- begin
- CollectionError(KeyError);
- end
- else
- begin
- Position := GetKeyPosition(Key);
- try
- if Position.Found then
- begin
- OldAssociation := TrueRemove2(Position);
- ResultCollection.Add(OldAssociation.GetValue);
- end;
- finally
- Position.Free;
- end;
- end;
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractMap.RetainKey(const KeyArray: array of ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- MapIterator: IMapIterator;
- I: Integer;
- Found: Boolean;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- if FixedSize then
- begin
- CollectionError(ceFixedSize);
- end
- else
- begin
- MapIterator := GetMapIterator;
- while not MapIterator.EOF do
- begin
- // Converting the array to a map would be faster but I don't want to
- // couple base class code to a complex collection.
- Found := false;
- for I := Low(KeyArray) to High(KeyArray) do
- begin
- Found := KeyComparator.Equals(MapIterator.CurrentKey, KeyArray[I]);
- if Found then
- break;
- end;
- if not Found then
- begin
- ResultCollection.Add(MapIterator.CurrentItem);
- MapIterator.Remove;
- end;
- MapIterator.Next;
- end;
- Result := ResultCollection;
- end;
-end;
-
-function TAbstractMap.RetainKey(const Collection: ICollection): ICollection;
-var
- ResultCollection: ICollection;
- MapIterator: IMapIterator;
- Key: ICollectable;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- if FixedSize then
- begin
- CollectionError(ceFixedSize);
- end
- else
- begin
- MapIterator := GetMapIterator;
- while not MapIterator.EOF do
- begin
- Key := MapIterator.CurrentKey;
- if not Collection.Contains(Key) then
- begin
- ResultCollection.Add(MapIterator.CurrentItem);
- MapIterator.Remove;
- end;
- MapIterator.Next;
- end;
- end;
- Result := ResultCollection;
-end;
-
-
-{ TAbstractIntegerMap }
-constructor TAbstractIntegerMap.Create(NaturalItemsOnly: Boolean);
-begin
- inherited Create(NaturalItemsOnly);
- FAssociationComparator := TIntegerAssociationComparator.Create;
-end;
-
-constructor TAbstractIntegerMap.Create(const ItemArray: array of ICollectable);
-begin
- Create(ItemArray, true);
-end;
-
-constructor TAbstractIntegerMap.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
-begin
- inherited Create(ItemArray, true);
-end;
-
-constructor TAbstractIntegerMap.Create(const KeyArray: array of Integer; const ItemArray: array of ICollectable);
-begin
- Create(KeyArray, ItemArray, false);
-end;
-
-constructor TAbstractIntegerMap.Create(const KeyArray: array of Integer; const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
-var
- I, Lo, Hi: Integer;
-begin
- Create(NaturalItemsOnly);
- Capacity := Min(Length(KeyArray), Length(ItemArray));
- if not FixedSize then
- begin
- Lo := Max(Low(KeyArray), Low(ItemArray));
- Hi := Min(High(KeyArray), High(ItemArray));
- for I := Lo to Hi do
- begin
- Put(KeyArray[I], ItemArray[I]);
- end;
- end;
-end;
-
-constructor TAbstractIntegerMap.Create(const Map: IIntegerMap);
-var
- MapIterator: IIntegerMapIterator;
-begin
- Create(Map.GetNaturalItemsOnly);
- InitFrom(Map);
- Capacity := Map.GetSize;
- if not FixedSize then
- begin
- MapIterator := Map.GetMapIterator;
- while not MapIterator.EOF do
- begin
- Put(MapIterator.CurrentKey, MapIterator.CurrentItem);
- MapIterator.Next;
- end;
- end;
-end;
-
-destructor TAbstractIntegerMap.Destroy;
-begin
- FAssociationComparator := nil;
- inherited Destroy;
-end;
-
-function TAbstractIntegerMap.TrueAdd(const Item: ICollectable): Boolean;
-var
- Position: TCollectionPosition;
- Mappable: IIntegerMappable;
-begin
- if IsNaturalItem(Item) then
- begin
- Mappable := Item as IIntegerMappable;
- Position := GetKeyPosition(Mappable.GetKey);
- try
- if Position.Found then
- begin
- CollectionError(ceDuplicateKey);
- Result := false;
- end
- else
- begin
- TruePut(Position, TIntegerAssociation.Create(Mappable.GetKey, Item));
- Result := true;
- end;
- finally
- Position.Free;
- end;
- end
- else
- begin
- CollectionError(ceNotNaturalItem);
- Result := false;
- end;
-end;
-
-function TAbstractIntegerMap.TrueContains(const Item: ICollectable): Boolean;
-var
- Item2: ICollectable;
- Success: Boolean;
- Iterator: IIterator;
-begin
- Iterator := GetIterator;
- Success := false;
- while not Iterator.EOF and not Success do
- begin
- Item2 := Iterator.CurrentItem;
- if Comparator.Equals(Item, Item2) then
- Success := true;
- Iterator.Next;
- end;
- Result := Success;
-end;
-
-function TAbstractIntegerMap.TrueRemove(const Item: ICollectable): ICollectable;
-var
- Item2: ICollectable;
- Iterator: IIntegerMapIterator;
- Found: Boolean;
-begin
- // Sequential search
- Found := false;
- Result := nil;
- Iterator := GetAssociationIterator;
- while not Iterator.EOF and not Found do
- begin
- Item2 := Iterator.CurrentItem;
- if Comparator.Equals(Item, Item2) then
- begin
- Result := Item2;
- Iterator.Remove;
- Found := true;
- end;
- Iterator.Next;
- end;
-end;
-
-function TAbstractIntegerMap.TrueRemoveAll(const Item: ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- Item2: ICollectable;
- Iterator: IIntegerMapIterator;
-begin
- // Sequential search
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := GetAssociationIterator;
- while not Iterator.EOF do
- begin
- Item2 := Iterator.CurrentItem;
- if Comparator.Equals(Item, Item2) then
- begin
- ResultCollection.Add(Item2);
- Iterator.Remove;
- end;
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractIntegerMap.GetItem(const Key: Integer): ICollectable;
-begin
- Result := Get(Key);
-end;
-
-procedure TAbstractIntegerMap.SetItem(const Key: Integer; const Item: ICollectable);
-begin
- Put(Key, Item);
-end;
-
-function TAbstractIntegerMap.GetIterator: IIterator;
-begin
- Result := GetAssociationIterator;
-end;
-
-function TAbstractIntegerMap.GetKeys: ISet;
-var
- ResultCollection: TPArraySet;
- MapIterator: IIntegerMapIterator;
-begin
- ResultCollection := TPArraySet.Create(true);
- MapIterator := GetMapIterator;
- while not MapIterator.EOF do
- begin
- ResultCollection.Add(TIntegerWrapper.Create(MapIterator.CurrentKey) as ICollectable);
- MapIterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractIntegerMap.GetMapIterator: IIntegerMapIterator;
-begin
- Result := GetAssociationIterator;
-end;
-
-function TAbstractIntegerMap.GetNaturalItemIID: TGUID;
-begin
- Result := IntegerMappableIID;
-end;
-
-function TAbstractIntegerMap.GetType: TCollectionType;
-begin
- Result := ctIntegerMap;
-end;
-
-function TAbstractIntegerMap.GetValues: ICollection;
-var
- ResultCollection: ICollection;
- ValueIterator: IIterator;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- ValueIterator := GetIterator;
- while not ValueIterator.EOF do
- begin
- ResultCollection.Add(ValueIterator.CurrentItem);
- ValueIterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-// Overrides TAbstractCollection function, otherwise Create(ICollection) is
-// called, which cannot access keys.
-function TAbstractIntegerMap.Clone: ICollection;
-begin
- Result := (TAbstractIntegerMapClass(ClassType)).Create(Self);
-end;
-
-function TAbstractIntegerMap.CloneAsIntegerMap: IIntegerMap;
-begin
- Result := (TAbstractIntegerMapClass(ClassType)).Create(Self);
-end;
-
-function TAbstractIntegerMap.ContainsKey(const Key: Integer): Boolean;
-var
- Position: TCollectionPosition;
-begin
- Position := GetKeyPosition(Key);
- try
- Result := Position.Found;
- finally
- Position.Free;
- end;
-end;
-
-function TAbstractIntegerMap.ContainsKey(const KeyArray: array of Integer): Boolean;
-var
- I: Integer;
- Success: Boolean;
-begin
- Success := true;
- for I := Low(KeyArray) to High(KeyArray) do
- begin
- Success := Success and ContainsKey(KeyArray[I]);
- if not Success then
- break;
- end;
- Result := Success;
-end;
-
-function TAbstractIntegerMap.Get(const Key: Integer): ICollectable;
-var
- Position: TCollectionPosition;
-begin
- Position := GetKeyPosition(Key);
- try
- if Position.Found then
- Result := TrueGet(Position).GetValue
- else
- Result := nil;
- finally
- Position.Free;
- end;
-end;
-
-function TAbstractIntegerMap.IsNilAllowed: Boolean;
-begin
- Result := true;
-end;
-
-function TAbstractIntegerMap.Put(const Item: ICollectable): ICollectable;
-var
- Mappable: IIntegerMappable;
- OldAssociation, NewAssociation: IIntegerAssociation;
- Position: TCollectionPosition;
-begin
- if not IsNaturalItem(Item) then
- begin
- CollectionError(ceNotNaturalItem);
- Result := nil;
- end
- else
- begin
- Item.QueryInterface(IIntegerMappable, Mappable);
- Position := GetKeyPosition(Mappable.GetKey);
- try
- NewAssociation := TIntegerAssociation.Create(Mappable.GetKey, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- Result := OldAssociation.GetValue
- else
- Result := nil;
- finally
- Position.Free;
- end;
- end;
-end;
-
-function TAbstractIntegerMap.Put(const Key: Integer; const Item: ICollectable): ICollectable;
-var
- OldAssociation, NewAssociation: IIntegerAssociation;
- ItemError: TCollectionError;
- Position: TCollectionPosition;
-begin
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- Result := nil;
- end
- else
- begin
- Position := GetKeyPosition(Key);
- try
- NewAssociation := TIntegerAssociation.Create(Key, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- Result := OldAssociation.GetValue
- else
- Result := nil;
- finally
- Position.Free;
- end;
- end;
-end;
-
-function TAbstractIntegerMap.Put(const ItemArray: array of ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- Mappable: IIntegerMappable;
- OldAssociation, NewAssociation: IIntegerAssociation;
- Position: TCollectionPosition;
- Item: ICollectable;
- I: Integer;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- Item := ItemArray[I];
- if not IsNaturalItem(Item) then
- begin
- CollectionError(ceNotNaturalItem);
- end
- else
- begin
- Item.QueryInterface(IIntegerMappable, Mappable);
- Position := GetKeyPosition(Mappable.GetKey);
- try
- NewAssociation := TIntegerAssociation.Create(Mappable.GetKey, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- ResultCollection.Add(OldAssociation.GetValue);
- finally
- Position.Free;
- end;
- end;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractIntegerMap.Put(const Collection: ICollection): ICollection;
-var
- ResultCollection: ICollection;
- Mappable: IIntegerMappable;
- OldAssociation, NewAssociation: IIntegerAssociation;
- Position: TCollectionPosition;
- Iterator: IIterator;
- Item: ICollectable;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- Item := Iterator.CurrentItem;;
- if not IsNaturalItem(Item) then
- begin
- CollectionError(ceNotNaturalItem);
- end
- else
- begin
- Item.QueryInterface(IIntegerMappable, Mappable);
- Position := GetKeyPosition(Mappable.GetKey);
- try
- NewAssociation := TIntegerAssociation.Create(Mappable.GetKey, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- ResultCollection.Add(OldAssociation.GetValue);
- finally
- Position.Free;
- end;
- end;
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractIntegerMap.Put(const Map: IIntegerMap): ICollection;
-var
- ResultCollection: ICollection;
- OldAssociation, NewAssociation: IIntegerAssociation;
- ItemError: TCollectionError;
- Position: TCollectionPosition;
- MapIterator: IIntegerMapIterator;
- Item: ICollectable;
- Key: Integer;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- MapIterator := Map.GetMapIterator;
- while not MapIterator.EOF do
- begin
- Key := MapIterator.CurrentKey;
- Item := MapIterator.CurrentItem;
-
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- end
- else
- begin
- Position := GetKeyPosition(Key);
- try
- NewAssociation := TIntegerAssociation.Create(Key, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- ResultCollection.Add(OldAssociation.GetValue);
- finally
- Position.Free;
- end;
- end;
- MapIterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractIntegerMap.RemoveKey(const Key: Integer): ICollectable;
-var
- Position: TCollectionPosition;
- OldAssociation: IIntegerAssociation;
-begin
- Position := GetKeyPosition(Key);
- try
- if Position.Found then
- begin
- OldAssociation := TrueRemove2(Position);
- Result := OldAssociation.GetValue
- end
- else
- Result := nil;
- finally
- Position.Free;
- end;
-end;
-
-function TAbstractIntegerMap.RemoveKey(const KeyArray: array of Integer): ICollection;
-var
- ResultCollection: ICollection;
- OldAssociation: IIntegerAssociation;
- Position: TCollectionPosition;
- Key: Integer;
- I: Integer;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- for I := Low(KeyArray) to High(KeyArray) do
- begin
- Key := KeyArray[I];
- Position := GetKeyPosition(Key);
- try
- if Position.Found then
- begin
- OldAssociation := TrueRemove2(Position);
- ResultCollection.Add(OldAssociation.GetValue);
- end;
- finally
- Position.Free;
- end;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractIntegerMap.RetainKey(const KeyArray: array of Integer): ICollection;
-var
- ResultCollection: ICollection;
- MapIterator: IIntegerMapIterator;
- I: Integer;
- Found: Boolean;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- if FixedSize then
- begin
- CollectionError(ceFixedSize);
- end
- else
- begin
- MapIterator := GetMapIterator;
- while not MapIterator.EOF do
- begin
- // Converting the array to a map would be faster but I don't want to
- // couple base class code to a complex collection.
- Found := false;
- for I := Low(KeyArray) to High(KeyArray) do
- begin
- Found := (MapIterator.CurrentKey = KeyArray[I]);
- if Found then
- break;
- end;
- if not Found then
- begin
- ResultCollection.Add(MapIterator.CurrentItem);
- MapIterator.Remove;
- end;
- MapIterator.Next;
- end;
- Result := ResultCollection;
- end;
-end;
-
-
-{ TAbstractStringMap }
-constructor TAbstractStringMap.Create(NaturalItemsOnly: Boolean);
-begin
- inherited Create(NaturalItemsOnly);
- FAssociationComparator := TStringAssociationComparator.Create;
-end;
-
-constructor TAbstractStringMap.Create(const ItemArray: array of ICollectable);
-begin
- Create(ItemArray, true);
-end;
-
-constructor TAbstractStringMap.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
-begin
- inherited Create(ItemArray, true);
-end;
-
-constructor TAbstractStringMap.Create(const KeyArray: array of String; const ItemArray: array of ICollectable);
-begin
- Create(KeyArray, ItemArray, false);
-end;
-
-constructor TAbstractStringMap.Create(const KeyArray: array of String; const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
-var
- I, Lo, Hi: Integer;
-begin
- Create(NaturalItemsOnly);
- Capacity := Min(Length(KeyArray), Length(ItemArray));
- if not FixedSize then
- begin
- Lo := Max(Low(KeyArray), Low(ItemArray));
- Hi := Min(High(KeyArray), High(ItemArray));
- for I := Lo to Hi do
- begin
- Put(KeyArray[I], ItemArray[I]);
- end;
- end;
-end;
-
-constructor TAbstractStringMap.Create(const Map: IStringMap);
-var
- MapIterator: IStringMapIterator;
-begin
- Create(Map.GetNaturalItemsOnly);
- InitFrom(Map);
- Capacity := Map.GetSize;
- if not FixedSize then
- begin
- MapIterator := Map.GetMapIterator;
- while not MapIterator.EOF do
- begin
- Put(MapIterator.CurrentKey, MapIterator.CurrentItem);
- MapIterator.Next;
- end;
- end;
-end;
-
-destructor TAbstractStringMap.Destroy;
-begin
- FAssociationComparator := nil;
- inherited Destroy;
-end;
-
-function TAbstractStringMap.TrueAdd(const Item: ICollectable): Boolean;
-var
- Position: TCollectionPosition;
- Mappable: IStringMappable;
-begin
- if IsNaturalItem(Item) then
- begin
- Mappable := Item as IStringMappable;
- Position := GetKeyPosition(Mappable.GetKey);
- try
- if Position.Found then
- begin
- CollectionError(ceDuplicateKey);
- Result := false;
- end
- else
- begin
- TruePut(Position, TStringAssociation.Create(Mappable.GetKey, Item));
- Result := true;
- end;
- finally
- Position.Free;
- end;
- end
- else
- begin
- CollectionError(ceNotNaturalItem);
- Result := false;
- end;
-end;
-
-function TAbstractStringMap.TrueContains(const Item: ICollectable): Boolean;
-var
- Item2: ICollectable;
- Success: Boolean;
- Iterator: IIterator;
-begin
- Iterator := GetIterator;
- Success := false;
- while not Iterator.EOF and not Success do
- begin
- Item2 := Iterator.CurrentItem;
- if Comparator.Equals(Item, Item2) then
- Success := true;
- Iterator.Next;
- end;
- Result := Success;
-end;
-
-function TAbstractStringMap.TrueRemove(const Item: ICollectable): ICollectable;
-var
- Item2: ICollectable;
- Iterator: IStringMapIterator;
- Found: Boolean;
-begin
- // Sequential search
- Found := false;
- Result := nil;
- Iterator := GetAssociationIterator;
- while not Iterator.EOF and not Found do
- begin
- Item2 := Iterator.CurrentItem;
- if Comparator.Equals(Item, Item2) then
- begin
- Result := Item2;
- Iterator.Remove;
- Found := true;
- end;
- Iterator.Next;
- end;
-end;
-
-function TAbstractStringMap.TrueRemoveAll(const Item: ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- Item2: ICollectable;
- Iterator: IIterator;
-begin
- // Sequential search
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := GetAssociationIterator;
- while not Iterator.EOF do
- begin
- Item2 := Iterator.CurrentItem;
- if Comparator.Equals(Item, Item2) then
- begin
- ResultCollection.Add(Item2);
- Iterator.Remove;
- end;
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractStringMap.GetItem(const Key: String): ICollectable;
-begin
- Result := Get(Key);
-end;
-
-procedure TAbstractStringMap.SetItem(const Key: String; const Item: ICollectable);
-begin
- Put(Key, Item);
-end;
-
-function TAbstractStringMap.GetIterator: IIterator;
-begin
- Result := GetAssociationIterator;
-end;
-
-function TAbstractStringMap.GetKeys: ISet;
-var
- ResultCollection: TPArraySet;
- MapIterator: IStringMapIterator;
-begin
- ResultCollection := TPArraySet.Create(true);
- MapIterator := GetMapIterator;
- while not MapIterator.EOF do
- begin
- ResultCollection.Add(TStringWrapper.Create(MapIterator.CurrentKey) as ICollectable);
- MapIterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractStringMap.GetMapIterator: IStringMapIterator;
-begin
- Result := GetAssociationIterator;
-end;
-
-function TAbstractStringMap.GetNaturalItemIID: TGUID;
-begin
- Result := StringMappableIID;
-end;
-
-function TAbstractStringMap.GetType: TCollectionType;
-begin
- Result := ctStringMap;
-end;
-
-function TAbstractStringMap.GetValues: ICollection;
-var
- ResultCollection: ICollection;
- ValueIterator: IIterator;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- ValueIterator := GetIterator;
- while not ValueIterator.EOF do
- begin
- ResultCollection.Add(ValueIterator.CurrentItem);
- ValueIterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-// Overrides TAbstractCollection function, otherwise Create(ICollection) is
-// called, which cannot access keys.
-function TAbstractStringMap.Clone: ICollection;
-begin
- Result := (TAbstractStringMapClass(ClassType)).Create(Self);
-end;
-
-function TAbstractStringMap.CloneAsStringMap: IStringMap;
-begin
- Result := (TAbstractStringMapClass(ClassType)).Create(Self);
-end;
-
-function TAbstractStringMap.ContainsKey(const Key: String): Boolean;
-var
- Position: TCollectionPosition;
-begin
- Position := GetKeyPosition(Key);
- try
- Result := Position.Found;
- finally
- Position.Free;
- end;
-end;
-
-function TAbstractStringMap.ContainsKey(const KeyArray: array of String): Boolean;
-var
- I: Integer;
- Success: Boolean;
-begin
- Success := true;
- for I := Low(KeyArray) to High(KeyArray) do
- begin
- Success := Success and ContainsKey(KeyArray[I]);
- if not Success then
- break;
- end;
- Result := Success;
-end;
-
-function TAbstractStringMap.Get(const Key: String): ICollectable;
-var
- Position: TCollectionPosition;
-begin
- Position := GetKeyPosition(Key);
- try
- if Position.Found then
- Result := TrueGet(Position).GetValue
- else
- Result := nil;
- finally
- Position.Free;
- end;
-end;
-
-function TAbstractStringMap.IsNilAllowed: Boolean;
-begin
- Result := true;
-end;
-
-function TAbstractStringMap.Put(const Item: ICollectable): ICollectable;
-var
- Mappable: IStringMappable;
- OldAssociation, NewAssociation: IStringAssociation;
- Position: TCollectionPosition;
-begin
- if not IsNaturalItem(Item) then
- begin
- CollectionError(ceNotNaturalItem);
- Result := nil;
- end
- else
- begin
- Item.QueryInterface(IStringMappable, Mappable);
- Position := GetKeyPosition(Mappable.GetKey);
- try
- NewAssociation := TStringAssociation.Create(Mappable.GetKey, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- Result := OldAssociation.GetValue
- else
- Result := nil;
- finally
- Position.Free;
- end;
- end;
-end;
-
-function TAbstractStringMap.Put(const Key: String; const Item: ICollectable): ICollectable;
-var
- OldAssociation, NewAssociation: IStringAssociation;
- ItemError: TCollectionError;
- Position: TCollectionPosition;
-begin
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- Result := nil;
- end
- else
- begin
- Position := GetKeyPosition(Key);
- try
- NewAssociation := TStringAssociation.Create(Key, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- Result := OldAssociation.GetValue
- else
- Result := nil;
- finally
- Position.Free;
- end;
- end;
-end;
-
-function TAbstractStringMap.Put(const ItemArray: array of ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- Mappable: IStringMappable;
- OldAssociation, NewAssociation: IStringAssociation;
- Position: TCollectionPosition;
- Item: ICollectable;
- I: Integer;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- Item := ItemArray[I];
- if not IsNaturalItem(Item) then
- begin
- CollectionError(ceNotNaturalItem);
- end
- else
- begin
- Item.QueryInterface(IStringMappable, Mappable);
- Position := GetKeyPosition(Mappable.GetKey);
- try
- NewAssociation := TStringAssociation.Create(Mappable.GetKey, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- ResultCollection.Add(OldAssociation.GetValue);
- finally
- Position.Free;
- end;
- end;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractStringMap.Put(const Collection: ICollection): ICollection;
-var
- ResultCollection: ICollection;
- Mappable: IStringMappable;
- OldAssociation, NewAssociation: IStringAssociation;
- Position: TCollectionPosition;
- Iterator: IIterator;
- Item: ICollectable;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- Item := Iterator.CurrentItem;;
- if not IsNaturalItem(Item) then
- begin
- CollectionError(ceNotNaturalItem);
- end
- else
- begin
- Item.QueryInterface(IStringMappable, Mappable);
- Position := GetKeyPosition(Mappable.GetKey);
- try
- NewAssociation := TStringAssociation.Create(Mappable.GetKey, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- ResultCollection.Add(OldAssociation.GetValue);
- finally
- Position.Free;
- end;
- end;
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractStringMap.Put(const Map: IStringMap): ICollection;
-var
- ResultCollection: ICollection;
- OldAssociation, NewAssociation: IStringAssociation;
- ItemError: TCollectionError;
- Position: TCollectionPosition;
- MapIterator: IStringMapIterator;
- Item: ICollectable;
- Key: String;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- MapIterator := Map.GetMapIterator;
- while not MapIterator.EOF do
- begin
- Key := MapIterator.CurrentKey;
- Item := MapIterator.CurrentItem;
-
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- end
- else
- begin
- Position := GetKeyPosition(Key);
- try
- NewAssociation := TStringAssociation.Create(Key, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- ResultCollection.Add(OldAssociation.GetValue);
- finally
- Position.Free;
- end;
- end;
- MapIterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractStringMap.RemoveKey(const Key: String): ICollectable;
-var
- Position: TCollectionPosition;
- OldAssociation: IStringAssociation;
-begin
- Position := GetKeyPosition(Key);
- try
- if Position.Found then
- begin
- OldAssociation := TrueRemove2(Position);
- Result := OldAssociation.GetValue
- end
- else
- Result := nil;
- finally
- Position.Free;
- end;
-end;
-
-function TAbstractStringMap.RemoveKey(const KeyArray: array of String): ICollection;
-var
- ResultCollection: ICollection;
- OldAssociation: IStringAssociation;
- Position: TCollectionPosition;
- Key: String;
- I: Integer;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- for I := Low(KeyArray) to High(KeyArray) do
- begin
- Key := KeyArray[I];
- Position := GetKeyPosition(Key);
- try
- if Position.Found then
- begin
- OldAssociation := TrueRemove2(Position);
- ResultCollection.Add(OldAssociation.GetValue);
- end;
- finally
- Position.Free;
- end;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractStringMap.RetainKey(const KeyArray: array of String): ICollection;
-var
- ResultCollection: ICollection;
- MapIterator: IStringMapIterator;
- I: Integer;
- Found: Boolean;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- if FixedSize then
- begin
- CollectionError(ceFixedSize);
- end
- else
- begin
- MapIterator := GetMapIterator;
- while not MapIterator.EOF do
- begin
- // Converting the array to a map would be faster but I don't want to
- // couple base class code to a complex collection.
- Found := false;
- for I := Low(KeyArray) to High(KeyArray) do
- begin
- Found := (MapIterator.CurrentKey = KeyArray[I]);
- if Found then
- break;
- end;
- if not Found then
- begin
- ResultCollection.Add(MapIterator.CurrentItem);
- MapIterator.Remove;
- end;
- MapIterator.Next;
- end;
- Result := ResultCollection;
- end;
-end;
-
-
-{ ECollectionError }
-constructor ECollectionError.Create(const Msg: String; const Collection: ICollection; ErrorType: TCollectionError);
-begin
- inherited Create(Msg);
- FCollection := Collection;
- FErrorType := ErrorType;
-end;
-
-{ TAbstractListIterator }
-constructor TAbstractListIterator.Create(Collection: TAbstractList);
-begin
- inherited Create(true);
- FCollection := Collection;
- First;
-end;
-
-function TAbstractListIterator.TrueFirst: ICollectable;
-begin
- FIndex := 0;
- if FIndex < FCollection.GetSize then
- Result := FCollection.GetItem(FIndex)
- else
- Result := nil;
-end;
-
-function TAbstractListIterator.TrueNext: ICollectable;
-begin
- Inc(FIndex);
- if FIndex < FCollection.GetSize then
- Result := FCollection.GetItem(FIndex)
- else
- Result := nil;
-end;
-
-procedure TAbstractListIterator.TrueRemove;
-begin
- FCollection.Delete(FIndex);
- Dec(FIndex);
-end;
-
-end.
diff --git a/src/lib/ctypes/ctypes.pas b/src/lib/ctypes/ctypes.pas
deleted file mode 100644
index 694552dc..00000000
--- a/src/lib/ctypes/ctypes.pas
+++ /dev/null
@@ -1,72 +0,0 @@
-{
- This file is part of the Free Pascal run time library.
- Copyright (c) 2004 by Marco van de Voort, member of the
- Free Pascal development team
-
- Implements C types for in header conversions
-
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
-
- 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.
-
-
- **********************************************************************}
-
-unit ctypes;
-
-interface
-
-type
- qword = int64; // Keep h2pas "uses ctypes" headers working with delphi.
-
- { the following type definitions are compiler dependant }
- { and system dependant }
-
- cint8 = shortint; pcint8 = ^cint8;
- cuint8 = byte; pcuint8 = ^cuint8;
- cchar = cint8; pcchar = ^cchar;
- cschar = cint8; pcschar = ^cschar;
- cuchar = cuint8; pcuchar = ^cuchar;
-
- cint16 = smallint; pcint16 = ^cint16;
- cuint16 = word; pcuint16 = ^cuint16;
- cshort = cint16; pcshort = ^cshort;
- csshort = cint16; pcsshort = ^csshort;
- cushort = cuint16; pcushort = ^cushort;
-
- cint32 = longint; pcint32 = ^cint32;
- cuint32 = longword; pcuint32 = ^cuint32;
- cint = cint32; pcint = ^cint; { minimum range is : 32-bit }
- csint = cint32; pcsint = ^csint; { minimum range is : 32-bit }
- cuint = cuint32; pcuint = ^cuint; { minimum range is : 32-bit }
- csigned = cint; pcsigned = ^csigned;
- cunsigned = cuint; pcunsigned = ^cunsigned;
-
- cint64 = int64; pcint64 = ^cint64;
- cuint64 = qword; pcuint64 = ^cuint64;
- clonglong = cint64; pclonglong = ^clonglong;
- cslonglong = cint64; pcslonglong = ^cslonglong;
- culonglong = cuint64; pculonglong = ^culonglong;
-
- cbool = longbool; pcbool = ^cbool;
-
-{$if defined(cpu64) and not(defined(win64) and defined(cpux86_64))}
- clong = int64; pclong = ^clong;
- cslong = int64; pcslong = ^cslong;
- culong = qword; pculong = ^culong;
-{$else}
- clong = longint; pclong = ^clong;
- cslong = longint; pcslong = ^cslong;
- culong = cardinal; pculong = ^culong;
-{$ifend}
-
- cfloat = single; pcfloat = ^cfloat;
- cdouble = double; pcdouble = ^cdouble;
- clongdouble = extended; pclongdouble = ^clongdouble;
-
-implementation
-
-end.
diff --git a/src/lib/ffmpeg/avcodec.pas b/src/lib/ffmpeg/avcodec.pas
deleted file mode 100644
index 72cbee93..00000000
--- a/src/lib/ffmpeg/avcodec.pas
+++ /dev/null
@@ -1,4533 +0,0 @@
-(*
- * 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.
- * - Changes and updates by the UltraStar Deluxe Team
- *)
-
-(*
- * Conversion of libavcodec/avcodec.h
- * Min. version: 51.16.0, revision 6577, Sat Oct 7 15:30:46 2006 UTC
- * Max. version: 52.11.0, revision 16912, Sun Feb 1 02:00:19 2009 UTC
- *)
-{
- * update to
- * Max. version: 52.42.0, Sun Dec 6 19:20:00 2009 CET
- * MiSchi
-}
-
-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
- ctypes,
- avutil,
- rational,
- opt,
- SysUtils,
- {$IFDEF UNIX}
- BaseUnix,
- {$ENDIF}
- UConfig;
-
-const
- (* Max. supported version by this header *)
- LIBAVCODEC_MAX_VERSION_MAJOR = 52;
- LIBAVCODEC_MAX_VERSION_MINOR = 42;
- 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);
-
- (* Min. supported version by this header *)
- LIBAVCODEC_MIN_VERSION_MAJOR = 51;
- LIBAVCODEC_MIN_VERSION_MINOR = 16;
- LIBAVCODEC_MIN_VERSION_RELEASE = 0;
- LIBAVCODEC_MIN_VERSION = (LIBAVCODEC_MIN_VERSION_MAJOR * VERSION_MAJOR) +
- (LIBAVCODEC_MIN_VERSION_MINOR * VERSION_MINOR) +
- (LIBAVCODEC_MIN_VERSION_RELEASE * VERSION_RELEASE);
-
-(* Check if linked versions are supported *)
-{$IF (LIBAVCODEC_VERSION < LIBAVCODEC_MIN_VERSION)}
- {$MESSAGE Error 'Linked version of libavcodec is too old!'}
-{$IFEND}
-
-(* Check if linked version is supported *)
-{$IF (LIBAVCODEC_VERSION > LIBAVCODEC_MAX_VERSION)}
- {$MESSAGE Error 'Linked version of libavcodec is not yet supported!'}
-{$IFEND}
-
-const
- AV_NOPTS_VALUE: cint64 = $8000000000000000;
- AV_TIME_BASE = 1000000;
- AV_TIME_BASE_Q: TAVRational = (num: 1; den: AV_TIME_BASE);
-
-(**
- * 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,
- CODEC_ID_CMV,
- CODEC_ID_MOTIONPIXELS,
- CODEC_ID_TGV,
- CODEC_ID_TGQ,
-{$IF LIBAVCODEC_VERSION >= 52012000} // >= 52.12.0
- CODEC_ID_TQI,
-{$IFEND}
-{$IF LIBAVCODEC_VERSION >= 52022002} // >= 52.22.2
- CODEC_ID_AURA,
- CODEC_ID_AURA2,
-{$IFEND}
-{$IF LIBAVCODEC_VERSION >= 52027000} // >= 52.27.0
- CODEC_ID_V210X,
-{$IFEND}
-{$IF LIBAVCODEC_VERSION >= 52028000} // >= 52.28.0
- CODEC_ID_TMV,
-{$IFEND}
-{$IF LIBAVCODEC_VERSION >= 52029000} // >= 52.29.0
- CODEC_ID_V210,
-{$IFEND}
-{$IF LIBAVCODEC_VERSION >= 52030002} // >= 52.30.2
- CODEC_ID_DPX,
-{$IFEND}
-{$IF LIBAVCODEC_VERSION >= 52031002} // >= 52.31.2
- CODEC_ID_MAD,
-{$IFEND}
-{$IF LIBAVCODEC_VERSION >= 52037000} // >= 52.37.0
- CODEC_ID_FRWU,
-{$IFEND}
-{$IF LIBAVCODEC_VERSION >= 52041000} // >= 52.41.0
- CODEC_ID_FLASHSV2,
-{$IFEND}
-
- //* 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,
- CODEC_ID_PCM_DVD,
- CODEC_ID_PCM_F32BE,
- CODEC_ID_PCM_F32LE,
- CODEC_ID_PCM_F64BE,
- CODEC_ID_PCM_F64LE,
-{$IF LIBAVCODEC_VERSION >= 52034000} // >= 52.34.0
- CODEC_ID_PCM_BLURAY,
-{$IFEND}
-
- //* 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,
- CODEC_ID_ADPCM_IMA_ISS,
-
- //* 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,
- CODEC_ID_ATRAC3P,
- CODEC_ID_EAC3,
- CODEC_ID_SIPR,
- CODEC_ID_MP1,
-{$IF LIBAVCODEC_VERSION >= 52020000} // >= 52.20.0
- CODEC_ID_TWINVQ,
-{$IFEND}
-{$IF LIBAVCODEC_VERSION >= 52022000} // >= 52.22.0
- CODEC_ID_TRUEHD,
-{$IFEND}
-{$IF LIBAVCODEC_VERSION >= 52026000} // >= 52.26.0
- CODEC_ID_MP4ALS,
-{$IFEND}
-{$IF LIBAVCODEC_VERSION >= 52035000} // >= 52.35.0
- CODEC_ID_ATRAC1,
-{$IFEND}
-
- //* 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,
-{$IF LIBAVCODEC_VERSION >= 52033000} // >= 52.33.0
- CODEC_ID_HDMV_PGS_SUBTITLE,
-{$IFEND}
-{$IF LIBAVCODEC_VERSION >= 52037001} // >= 52.37.1
- CODEC_ID_DVB_TELETEXT,
-{$IFEND}
-
- (* other specific kind of codecs (generally used for attachments) *)
- CODEC_ID_TTF= $18000,
-
- CODEC_ID_PROBE= $19000, ///< codec_id is not known (like CODEC_ID_NONE) but lavf should attempt to identify it
-
- 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
- );
-
-{**
- * all in native endian
- *}
-type
- TSampleFormat = (
- SAMPLE_FMT_NONE = -1,
- SAMPLE_FMT_U8, ///< unsigned 8 bits
- SAMPLE_FMT_S16, ///< signed 16 bits
- SAMPLE_FMT_S32, ///< signed 32 bits
- SAMPLE_FMT_FLT, ///< float
- SAMPLE_FMT_DBL, ///< double
- SAMPLE_FMT_NB ///< Number of sample formats. DO NOT USE if dynamically linking to libavcodec
- );
- _TSampleFormatArray = array [0 .. MaxInt div SizeOf(TSampleFormat)-1] of TSampleFormat;
- PSampleFormatArray = ^_TSampleFormatArray;
-
-const
- {* Audio channel masks *}
- CH_FRONT_LEFT = $00000001;
- CH_FRONT_RIGHT = $00000002;
- CH_FRONT_CENTER = $00000004;
- CH_LOW_FREQUENCY = $00000008;
- CH_BACK_LEFT = $00000010;
- CH_BACK_RIGHT = $00000020;
- CH_FRONT_LEFT_OF_CENTER = $00000040;
- CH_FRONT_RIGHT_OF_CENTER = $00000080;
- CH_BACK_CENTER = $00000100;
- CH_SIDE_LEFT = $00000200;
- CH_SIDE_RIGHT = $00000400;
- CH_TOP_CENTER = $00000800;
- CH_TOP_FRONT_LEFT = $00001000;
- CH_TOP_FRONT_CENTER = $00002000;
- CH_TOP_FRONT_RIGHT = $00004000;
- CH_TOP_BACK_LEFT = $00008000;
- CH_TOP_BACK_CENTER = $00010000;
- CH_TOP_BACK_RIGHT = $00020000;
- CH_STEREO_LEFT = $20000000; ///< Stereo downmix.
- CH_STEREO_RIGHT = $40000000; ///< See CH_STEREO_LEFT.
-{** Channel mask value used for AVCodecContext.request_channel_layout
- * to indicate that the user requests the channel order of the decoder output
- * to be the native codec channel order.
- *}
-{$IF LIBAVCODEC_VERSION >= 52038001} // >= 52.38.1
- CH_LAYOUT_NATIVE = $8000000000000000;
-{$IFEND}
- {* Audio channel convenience macros *}
- CH_LAYOUT_MONO = (CH_FRONT_CENTER);
- CH_LAYOUT_STEREO = (CH_FRONT_LEFT or CH_FRONT_RIGHT);
- CH_LAYOUT_SURROUND = (CH_LAYOUT_STEREO or CH_FRONT_CENTER);
-{$IF LIBAVCODEC_VERSION >= 52027000} // >= 52.27.0
- CH_LAYOUT_2_1 = (CH_LAYOUT_STEREO or CH_BACK_CENTER);
- CH_LAYOUT_4POINT0 = (CH_LAYOUT_SURROUND or CH_BACK_CENTER);
- CH_LAYOUT_2_2 = (CH_LAYOUT_STEREO or CH_SIDE_LEFT or CH_SIDE_RIGHT);
-{$IFEND}
- CH_LAYOUT_QUAD = (CH_LAYOUT_STEREO or CH_BACK_LEFT or CH_BACK_RIGHT);
- CH_LAYOUT_5POINT0 = (CH_LAYOUT_SURROUND or CH_SIDE_LEFT or CH_SIDE_RIGHT);
- CH_LAYOUT_5POINT1 = (CH_LAYOUT_5POINT0 or CH_LOW_FREQUENCY);
-{$IF LIBAVCODEC_VERSION >= 52025000} // >= 52.25.0
- CH_LAYOUT_5POINT0_BACK = (CH_LAYOUT_SURROUND or CH_BACK_LEFT or
- CH_BACK_RIGHT);
- CH_LAYOUT_5POINT1_BACK = (CH_LAYOUT_5POINT0_BACK or CH_LOW_FREQUENCY);
-{$IFEND}
-{$IF LIBAVCODEC_VERSION >= 52034000} // >= 52.34.0
- CH_LAYOUT_7POINT0 = (CH_LAYOUT_5POINT0 or CH_BACK_LEFT or CH_BACK_RIGHT);
-{$IFEND}
- CH_LAYOUT_7POINT1 = (CH_LAYOUT_5POINT1 or CH_BACK_LEFT or CH_BACK_RIGHT);
-{$IF LIBAVCODEC_VERSION < 52025000} // < 52.25.0
- CH_LAYOUT_7POINT1_WIDE = (CH_LAYOUT_SURROUND or CH_LOW_FREQUENCY or
- CH_BACK_LEFT or CH_BACK_RIGHT or
-{$ELSE}
- CH_LAYOUT_7POINT1_WIDE = (CH_LAYOUT_5POINT1_BACK or
-{$IFEND}
- CH_FRONT_LEFT_OF_CENTER or
- CH_FRONT_RIGHT_OF_CENTER);
- CH_LAYOUT_STEREO_DOWNMIX = (CH_STEREO_LEFT or CH_STEREO_RIGHT);
-
-
-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
- ME_TESA ///< transformed exhaustive search algorithm
- );
-
- 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
- );
-
-{$IF LIBAVCODEC_VERSION >= 52028000} // >= 52.28.0
- TAVColorPrimaries = (
- AVCOL_PRI_BT709 = 1, ///< also ITU-R BT1361 / IEC 61966-2-4 / SMPTE RP177 Annex B
- AVCOL_PRI_UNSPECIFIED = 2,
- AVCOL_PRI_BT470M = 4,
- AVCOL_PRI_BT470BG = 5, ///< also ITU-R BT601-6 625 / ITU-R BT1358 625 / ITU-R BT1700 625 PAL & SECAM
- AVCOL_PRI_SMPTE170M = 6, ///< also ITU-R BT601-6 525 / ITU-R BT1358 525 / ITU-R BT1700 NTSC
- AVCOL_PRI_SMPTE240M = 7, ///< functionally identical to above
- AVCOL_PRI_FILM = 8,
- AVCOL_PRI_NB ///< Not part of ABI
- );
-
- TAVColorTransferCharacteristic = (
- AVCOL_TRC_BT709 = 1, ///< also ITU-R BT1361
- AVCOL_TRC_UNSPECIFIED = 2,
- AVCOL_TRC_GAMMA22 = 4, ///< also ITU-R BT470M / ITU-R BT1700 625 PAL & SECAM
- AVCOL_TRC_GAMMA28 = 5, ///< also ITU-R BT470BG
- AVCOL_TRC_NB ///< Not part of ABI
- );
-
- TAVColorSpace = (
- AVCOL_SPC_RGB = 0,
- AVCOL_SPC_BT709 = 1, ///< also ITU-R BT1361 / IEC 61966-2-4 xvYCC709 / SMPTE RP177 Annex B
- AVCOL_SPC_UNSPECIFIED = 2,
- AVCOL_SPC_FCC = 4,
- AVCOL_SPC_BT470BG = 5, ///< also ITU-R BT601-6 625 / ITU-R BT1358 625 / ITU-R BT1700 625 PAL & SECAM / IEC 61966-2-4 xvYCC601
- AVCOL_SPC_SMPTE170M = 6, ///< also ITU-R BT601-6 525 / ITU-R BT1358 525 / ITU-R BT1700 NTSC / functionally identical to above
- AVCOL_SPC_SMPTE240M = 7,
- AVCOL_SPC_NB ///< Not part of ABI
- );
-
- TAVColorRange = (
- AVCOL_RANGE_UNSPECIFIED = 0,
- AVCOL_RANGE_MPEG = 1, ///< the normal 219*2^(n-8) "MPEG" YUV ranges
- AVCOL_RANGE_JPEG = 2, ///< the normal 2^n-1 "JPEG" YUV ranges
- AVCOL_RANGE_NB ///< Not part of ABI
- );
-
-(**
- * X X 3 4 X X are luma samples,
- * 1 2 1-6 are possible chroma positions
- * X X 5 6 X 0 is undefined/unknown position
- *)
- TAVChromaLocation = (
- AVCHROMA_LOC_UNSPECIFIED = 0,
- AVCHROMA_LOC_LEFT = 1, ///< mpeg2/4, h264 default
- AVCHROMA_LOC_CENTER = 2, ///< mpeg1, jpeg, h263
- AVCHROMA_LOC_TOPLEFT = 3, ///< DV
- AVCHROMA_LOC_TOP = 4,
- AVCHROMA_LOC_BOTTOMLEFT = 5,
- AVCHROMA_LOC_BOTTOM = 6,
- AVCHROMA_LOC_NB ///< Not part of ABI
- );
-{$IFEND}
-
- PRcOverride = ^TRcOverride;
- TRcOverride = record {16}
- start_frame: cint;
- end_frame: cint;
- qscale: cint; // if this is 0 then quality_factor will be used instead
- quality_factor: cfloat;
- 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
- {$IF LIBAVCODEC_VERSION < 52000000} // < 52.0.0
- CODEC_FLAG_TRELLIS_QUANT = $00200000; ///< use trellis quantization
- {$IFEND}
- 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;
-
- (**
- * Codec can export data for HW decoding (VDPAU).
- *)
- CODEC_CAP_HWACCEL_VDPAU = $0080;
-
- {$IF LIBAVCODEC_VERSION >= 52035000} // >= 52.35.0
- (**
- * Codec can output multiple frames per AVPacket
- *)
- CODEC_CAP_SUBFRAMES = $0100;
- {$IFEND}
-
- //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: cint;
-
- (*** width and height in 1/16 pel
- * - encoding: set by user.
- * - decoding: set by libavcodec. *)
- width: cint;
- height: cint;
-
- (*** 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)
-
-const
- {$IF LIBAVCODEC_VERSION < 52000000} // < 52.0.0
- DEFAULT_FRAME_RATE_BASE = 1001000;
- {$IFEND}
-
- 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_IDCT_EA = 21;
- FF_IDCT_SIMPLENEON = 22;
- FF_IDCT_SIMPLEALPHA = 23;
-
- 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
- {$IF LIBAVCODEC_MAX_VERSION_MAJOR < 53}
- FF_MM_MMXEXT = $0002; ///< SSE integer functions or AMD MMX ext
- {$IFEND}
- {$IF LIBAVCODEC_VERSION >= 52024000} // >= 52.24.0
- FF_MM_MMX2 = $0002; ///< SSE integer functions or AMD MMX ext
- {$IFEND}
- 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
- {$IF LIBAVCODEC_VERSION >= 52022003} // >= 52.22.3
- FF_MM_SSE4 = $0100; ///< Penryn SSE4.1 functions
- FF_MM_SSE42 = $0200; ///< Nehalem SSE4.2 functions
- {$IFEND}
- FF_MM_IWMMXT = $0100; ///< XScale IWMMXT
- FF_MM_ALTIVEC = $0001; ///< standard AltiVec
-
- 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_BUFFERS = $00008000;
-
- 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;
-
-{$IF LIBAVCODEC_MAX_VERSION_MAJOR < 53}
-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: cint;
-
- (* 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 cuint;
- end; {deprecated;}
-{$IFEND}
-
-{$IF LIBAVCODEC_VERSION >= 52023000} // >= 52.23.0
-type
- PAVPacket = ^TAVPacket;
- TAVPacket = record
-(*
- * Presentation timestamp in AVStream->time_base units; the time at which
- * the decompressed packet will be presented to the user.
- * Can be AV_NOPTS_VALUE if it is not stored in the file.
- * pts MUST be larger or equal to dts as presentation cannot happen before
- * decompression, unless one wants to view hex dumps. Some formats misuse
- * the terms dts and pts/cts to mean something different. Such timestamps
- * must be converted to true pts/dts before they are stored in AVPacket.
- *)
- pts: cint64;
-(*
- * Decompression timestamp in AVStream->time_base units; the time at which
- * the packet is decompressed.
- * Can be AV_NOPTS_VALUE if it is not stored in the file.
- *)
- dts: cint64;
- data: PByteArray;
- size: cint;
- stream_index: cint;
- flags: cint;
-(*
- * Duration of this packet in AVStream->time_base units, 0 if unknown.
- * Equals next_pts - this_pts in presentation order.
- *)
- duration: cint;
- destruct: procedure (para1: PAVPacket); cdecl;
- priv: pointer;
- pos: cint64; // byte position in stream, -1 if unknown
-
-(*
- * Time difference in AVStream->time_base units from the pts of this
- * packet to the point at which the output from the decoder has converged
- * independent from the availability of previous frames. That is, the
- * frames are virtually identical no matter if decoding started from
- * the very first frame or from this keyframe.
- * Is AV_NOPTS_VALUE if unknown.
- * This field is not the display duration of the current packet.
- *
- * The purpose of this field is to allow seeking in streams that have no
- * keyframes in the conventional sense. It corresponds to the
- * recovery point SEI in H.264 and match_time_delta in NUT. It is also
- * essential for some types of subtitle streams to ensure that all
- * subtitles are correctly displayed after seeking.
- *)
- convergence_duration: cint64;
- end;
-
-const
- {$IF LIBAVCODEC_VERSION >= 52030002} // >= 52.30.2
- PKT_FLAG_KEY = $0001;
- {$ELSE}
- AV_PKT_FLAG_KEY = $0001;
- {$IF LIBAVCODEC_VERSION_MAJOR < 53}
- PKT_FLAG_KEY = AV_PKT_FLAG_KEY;
- {$IFEND}
- {$IFEND}
-{$IFEND}
-
-type
- PAVClass = ^TAVClass; {const}
- PAVCodecContext = ^TAVCodecContext;
-
- PAVCodec = ^TAVCodec;
-
-{$IF LIBAVCODEC_VERSION >= 52018000} // >= 52.18.0
- PAVHWAccel = ^TAVHWAccel;
-{$IFEND}
-
- // int[4]
- PQuadIntArray = ^TQuadIntArray;
- TQuadIntArray = array[0..3] of cint;
- // int (*func)(struct AVCodecContext *c2, void *arg)
- TExecuteFunc = function(c2: PAVCodecContext; arg: Pointer): cint; cdecl;
-{$IF LIBAVCODEC_VERSION >= 52037000} // >= 52.37.0
- // int (*func)(struct AVCodecContext *c2, void *arg, int jobnr, int threadnr)
- TExecute2Func = function(c2: PAVCodecContext; arg: Pointer; jobnr: cint; threadnr: cint): cint; cdecl;
-{$IFEND}
-
- TAVClass = record
- class_name: PAnsiChar;
- (* 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(): PAnsiChar; cdecl;
- option: PAVOption;
- end;
-
- {**
- * 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 cint;
- (**
- * 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: cint;
- (**
- * 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: cint;
- (**
- * 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: cint64;
- (**
- * picture number in bitstream order
- * - encoding: set by
- * - decoding: Set by libavcodec.
- *)
- coded_picture_number: cint;
- (**
- * picture number in display order
- * - encoding: set by
- * - decoding: Set by libavcodec.
- *)
- display_picture_number: cint;
- (**
- * 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: cint;
- (**
- * 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: cint;
- (**
- * 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.
- * Set to 4 for delayed, non-reference frames.
- * - encoding: unused
- * - decoding: Set by libavcodec. (before get_buffer() call)).
- *)
- reference: cint;
- (**
- * QP table
- * - encoding: unused
- * - decoding: Set by libavcodec.
- *)
- qscale_table: PShortint;
- (**
- * QP store stride
- * - encoding: unused
- * - decoding: Set by libavcodec.
- *)
- qstride: cint;
- (**
- * 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: PCuint;
- (**
- * 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 cuint64;
- (**
- * 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_: cint;
- (**
- * 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: cint;
- (**
- *
- *)
- qscale_type: cint;
- (**
- * The content of the picture is interlaced.
- * - encoding: Set by user.
- * - decoding: Set by libavcodec. (default 0)
- *)
- interlaced_frame: cint;
- (**
- * If the content is interlaced, is top field displayed first.
- * - encoding: Set by user.
- * - decoding: Set by libavcodec.
- *)
- top_field_first: cint;
- (**
- * 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: cint;
- (**
- * codec suggestion on buffer type if != 0
- * - encoding: unused
- * - decoding: Set by libavcodec. (before get_buffer() call)).
- *)
- buffer_hints: cint;
- (**
- * 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;
-
- {$IF LIBAVCODEC_VERSION >= 51068000} // >= 51.68.0
- (**
- * reordered opaque 64bit number (generally a PTS) from AVCodecContext.reordered_opaque
- * output in AVFrame.reordered_opaque
- * - encoding: unused
- * - decoding: Read by user.
- *)
- reordered_opaque: cint64;
- {$IFEND}
-
- {$IF LIBAVCODEC_VERSION = 52021000} // = 52.21.0
- (**
- * hardware accelerator private data (FFmpeg allocated)
- * - encoding: unused
- * - decoding: Set by libavcodec
- *)
- hwaccel_data_private: pointer;
- {$IFEND}
- {$IF LIBAVCODEC_VERSION >= 52022000} // >= 52.22.0
- hwaccel_picture_private: pointer;
- {$IFEND}
-
- {$IF LIBAVCODEC_VERSION >= 51070000} // >= 51.70.0
- (**
- * Bits per sample/pixel of internal libavcodec pixel/sample format.
- * This field is applicable only when sample_fmt is SAMPLE_FMT_S32.
- * - encoding: set by user.
- * - decoding: set by libavcodec.
- *)
- bits_per_raw_sample: cint;
- {$IFEND}
-
- {$IF LIBAVCODEC_VERSION >= 52002000} // >= 52.2.0
- (**
- * Audio channel layout.
- * - encoding: set by user.
- * - decoding: set by libavcodec.
- *)
- channel_layout: cint64;
-
- (**
- * Request decoder to use this channel layout if it can (0 for default)
- * - encoding: unused
- * - decoding: Set by user.
- *)
- request_channel_layout: cint64;
- {$IFEND}
-
- {$IF LIBAVCODEC_VERSION >= 52004000} // >= 52.4.0
- (**
- * Ratecontrol attempt to use, at maximum, <value> of what can be used without an underflow.
- * - encoding: Set by user.
- * - decoding: unused.
- *)
- rc_max_available_vbv_use: cfloat;
-
- (**
- * Ratecontrol attempt to use, at least, <value> times the amount needed to prevent a vbv overflow.
- * - encoding: Set by user.
- * - decoding: unused.
- *)
- rc_min_vbv_overflow_use: cfloat;
- {$IFEND}
- {$IF LIBAVCODEC_VERSION >= 52018000} // >= 52.18.0
- (**
- * Hardware accelerator in use
- * - encoding: unused.
- * - decoding: Set by libavcodec
- *)
- hwaccel: PAVHWAccel;
- {$IFEND}
- {$IF LIBAVCODEC_VERSION >= 52020000} // >= 52.20.0
- (**
- * For some codecs, the time base is closer to the field rate than the frame rate.
- * Most notably, H.264 and MPEG-2 specify time_base as half of frame duration
- * if no telecine is used ...
- *
- * Set to time_base ticks per frame. Default 1, e.g., H.264/MPEG-2 set it to 2.
- *)
- ticks_per_frame: cint;
- {$IFEND}
- {$IF LIBAVCODEC_VERSION >= 52021000} // >= 52.21.0
- (**
- * Hardware accelerator context.
- * For some hardware accelerators, a global context needs to be
- * provided by the user. In that case, this holds display-dependent
- * data FFmpeg cannot instantiate itself. Please refer to the
- * FFmpeg HW accelerator documentation to know how to fill this
- * is. e.g. for VA API, this is a struct vaapi_context.
- * - encoding: unused
- * - decoding: Set by user
- *)
- hwaccel_context: pointer;
- {$IFEND}
- {$IF LIBAVCODEC_VERSION >= 52028000} // >= 52.28.0
- (**
- * Chromaticity coordinates of the source primaries.
- * - encoding: Set by user
- * - decoding: Set by libavcodec
- *)
- color_primaries: TAVColorPrimaries;
-
- (**
- * Color Transfer Characteristic.
- * - encoding: Set by user
- * - decoding: Set by libavcodec
- *)
- color_trc: TAVColorTransferCharacteristic;
-
- (**
- * YUV colorspace type.
- * - encoding: Set by user
- * - decoding: Set by libavcodec
- *)
- colorspace: TAVColorSpace;
-
- (**
- * MPEG vs JPEG YUV range.
- * - encoding: Set by user
- * - decoding: Set by libavcodec
- *)
- color_range: TAVColorRange;
-
- (**
- * This defines the location of chroma samples.
- * - encoding: Set by user
- * - decoding: Set by libavcodec
- *)
- chroma_sample_location: TAVChromaLocation;
- {$IFEND}
- 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: cint;
-
- (**
- * 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: cint;
-
- (**
- * CODEC_FLAG_*.
- * - encoding: Set by user.
- * - decoding: Set by user.
- *)
- flags: cint;
-
- (**
- * 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: cint;
-
- (**
- * 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), 10 (tesa) [7, 8, 10 are x264 specific, 9 is snow specific]
- * - encoding: MUST be set by user.
- * - decoding: unused
- *)
- me_method: cint;
-
- (**
- * 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: cint;
-
- (**
- * 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: cint;
-
- (**
- * the number of pictures in a group of pictures, or 0 for intra_only
- * - encoding: Set by user.
- * - decoding: unused
- *)
- gop_size: cint;
-
- (**
- * 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: cint;
-
- (**
- * 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.
- * The function is also used by hardware acceleration APIs.
- * It is called at least once during frame decoding to pass
- * the data needed for hardware render.
- * In that mode instead of pixel data, AVFrame points to
- * a structure specific to the acceleration API. The application
- * reads the structure and can change some fields to indicate progress
- * or mark state.
- * - 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;
- src: {const} PAVFrame; offset: PQuadIntArray;
- y: cint; type_: cint; height: cint); cdecl;
-
- (* audio only *)
- sample_rate: cint; ///< samples per second
- channels: cint; ///< number of audio channels
-
- (**
- * audio sample format
- * - encoding: Set by user.
- * - decoding: Set by libavcodec.
- *)
- sample_fmt: TSampleFormat; ///< sample format
-
- (* The following data should not be initialized. *)
- (**
- * Samples per packet, initialized when calling 'init'.
- *)
- frame_size: cint;
- frame_number: cint; ///< audio or video frame number
-{$IF LIBAVCODEC_MAX_VERSION_MAJOR < 53}
- real_pict_num: cint; ///< returns the real picture number of previous encoded frame
-{$IFEND}
-
- (**
- * Number of frames the decoded output will be delayed relative to
- * the encoded input.
- * - encoding: Set by libavcodec.
- * - decoding: unused
- *)
- delay: cint;
-
- (* - encoding parameters *)
- qcompress: cfloat; ///< amount of qscale change between easy & hard scenes (0.0-1.0)
- qblur: cfloat; ///< amount of qscale smoothing over time (0.0-1.0)
-
- (**
- * minimum quantizer
- * - encoding: Set by user.
- * - decoding: unused
- *)
- qmin: cint;
-
- (**
- * maximum quantizer
- * - encoding: Set by user.
- * - decoding: unused
- *)
- qmax: cint;
-
- (**
- * maximum quantizer difference between frames
- * - encoding: Set by user.
- * - decoding: unused
- *)
- max_qdiff: cint;
-
- (**
- * 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: cint;
-
- (**
- * qscale factor 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_factor: cfloat;
-
- (** obsolete FIXME remove *)
- rc_strategy: cint;
-
- b_frame_strategy: cint;
-
- (**
- * 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: cint;
-
- codec: PAVCodec;
-
- priv_data: pointer;
-
- {$IF LIBAVCODEC_VERSION < 52000000} // 52.0.0
- (* unused, FIXME remove*)
- rtp_mode: cint;
- {$IFEND}
-
- rtp_payload_size: cint; (* 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: cint; mb_nb: cint); cdecl;
-
- (* statistics, used for 2-pass encoding *)
- mv_bits: cint;
- header_bits: cint;
- i_tex_bits: cint;
- p_tex_bits: cint;
- i_count: cint;
- p_count: cint;
- skip_count: cint;
- misc_bits: cint;
-
- (**
- * number of bits used for the previously encoded frame
- * - encoding: Set by libavcodec.
- * - decoding: unused
- *)
- frame_bits: cint;
-
- (**
- * 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 AnsiChar;
- 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: cuint;
-
- (**
- * Work around bugs in encoders which sometimes cannot be detected automatically.
- * - encoding: Set by user
- * - decoding: Set by user
- *)
- workaround_bugs: cint;
-
- (**
- * luma single coefficient elimination threshold
- * - encoding: Set by user.
- * - decoding: unused
- *)
- luma_elim_threshold: cint;
-
- (**
- * chroma single coeff elimination threshold
- * - encoding: Set by user.
- * - decoding: unused
- *)
- chroma_elim_threshold: cint;
-
- (**
- * strictly follow the standard (MPEG4, ...).
- * - encoding: Set by user.
- * - decoding: Set by user.
- * Setting this to STRICT or higher means the encoder and decoder will
- * generally do stupid things. While setting it to inofficial or lower
- * will mean the encoder might use things that are not supported by all
- * spec compliant decoders. Decoders make no difference between normal,
- * inofficial and experimental, that is they always try to decode things
- * when they can unless they are explicitly asked to behave stupid
- * (=strictly conform to the specs)
- *)
- strict_std_compliance: cint;
-
- (**
- * qscale offset between IP and B-frames
- * - encoding: Set by user.
- * - decoding: unused
- *)
- b_quant_offset: cfloat;
-
- (**
- * Error recognization; higher values will detect more errors but may
- * misdetect some more or less valid parts as errors.
- * - encoding: unused
- * - decoding: Set by user.
- *)
- error_recognition: cint;
-
- (**
- * 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.
- * if CODEC_CAP_DR1 is not set then get_buffer() must call
- * avcodec_default_get_buffer() instead of providing buffers allocated by
- * some other means.
- * - encoding: unused
- * - decoding: Set by libavcodec., user can override.
- *)
- get_buffer: function (c: PAVCodecContext; pic: PAVFrame): cint; 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;
-
- (**
- * Size of the frame reordering buffer in the decoder.
- * For MPEG-2 it is 1 IPB or 0 low delay IP.
- * - encoding: Set by libavcodec.
- * - decoding: Set by libavcodec.
- *)
- has_b_frames: cint;
-
- (**
- * number of bytes per packet if constant and known or 0
- * Used by some WAV based audio codecs.
- *)
- block_align: cint;
-
- parse_only: cint; (* - 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: cint;
-
- (**
- * pass1 encoding statistics output buffer
- * - encoding: Set by libavcodec.
- * - decoding: unused
- *)
- stats_out: PByteArray;
-
- (**
- * 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: PByteArray;
-
- (**
- * 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: cfloat;
-
- rc_qmod_amp: cfloat;
- rc_qmod_freq: cint;
-
- (**
- * ratecontrol override, see RcOverride
- * - encoding: Allocated/set/freed by user.
- * - decoding: unused
- *)
- rc_override: PRcOverride;
- rc_override_count: cint;
-
- (**
- * rate control equation
- * - encoding: Set by user
- * - decoding: unused
- *)
- rc_eq: {const} PByteArray;
-
- (**
- * maximum bitrate
- * - encoding: Set by user.
- * - decoding: unused
- *)
- rc_max_rate: cint;
-
- (**
- * minimum bitrate
- * - encoding: Set by user.
- * - decoding: unused
- *)
- rc_min_rate: cint;
-
- (**
- * decoder bitstream buffer size
- * - encoding: Set by user.
- * - decoding: unused
- *)
- rc_buffer_size: cint;
- rc_buffer_aggressivity: cfloat;
-
- (**
- * 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: cfloat;
-
- (**
- * qscale offset between P and I-frames
- * - encoding: Set by user.
- * - decoding: unused
- *)
- i_quant_offset: cfloat;
-
- (**
- * initial complexity for pass1 ratecontrol
- * - encoding: Set by user.
- * - decoding: unused
- *)
- rc_initial_cplx: cfloat;
-
- (**
- * DCT algorithm, see FF_DCT_* below
- * - encoding: Set by user.
- * - decoding: unused
- *)
- dct_algo: cint;
-
- (**
- * luminance masking (0-> disabled)
- * - encoding: Set by user.
- * - decoding: unused
- *)
- lumi_masking: cfloat;
-
- (**
- * temporary complexity masking (0-> disabled)
- * - encoding: Set by user.
- * - decoding: unused
- *)
- temporal_cplx_masking: cfloat;
-
- (**
- * spatial complexity masking (0-> disabled)
- * - encoding: Set by user.
- * - decoding: unused
- *)
- spatial_cplx_masking: cfloat;
-
- (**
- * p block masking (0-> disabled)
- * - encoding: Set by user.
- * - decoding: unused
- *)
- p_masking: cfloat;
-
- (**
- * darkness masking (0-> disabled)
- * - encoding: Set by user.
- * - decoding: unused
- *)
- dark_masking: cfloat;
-
- {$IF LIBAVCODEC_VERSION < 52000000} // 52.0.0
- (* for binary compatibility *)
- unused: cint;
- {$IFEND}
-
- (**
- * IDCT algorithm, see FF_IDCT_* below.
- * - encoding: Set by user.
- * - decoding: Set by user.
- *)
- idct_algo: cint;
-
- (**
- * slice count
- * - encoding: Set by libavcodec.
- * - decoding: Set by user (or 0).
- *)
- slice_count: cint;
-
- (**
- * slice offsets in the frame in bytes
- * - encoding: Set/allocated by libavcodec.
- * - decoding: Set/allocated by user (or NULL).
- *)
- slice_offset: PCint;
-
- (**
- * error concealment flags
- * - encoding: unused
- * - decoding: Set by user.
- *)
- error_concealment: cint;
-
- (**
- * 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: cuint;
-
- (**
- * bits per sample/pixel from the demuxer (needed for huffyuv).
- * - encoding: Set by libavcodec.
- * - decoding: Set by user.
- *)
- bits_per_coded_sample: cint;
-
- (**
- * prediction method (needed for huffyuv)
- * - encoding: Set by user.
- * - decoding: unused
- *)
- prediction_method: cint;
-
- (**
- * sample aspect ratio (0 if unknown)
- * That is the width of a pixel divided by the height of the pixel.
- * 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: cint;
-
- (**
- * debug
- * - encoding: Set by user.
- * - decoding: Set by user.
- *)
- debug_mv: cint;
-
- (**
- * error
- * - encoding: Set by libavcodec if flags&CODEC_FLAG_PSNR.
- * - decoding: unused
- *)
- error: array [0..3] of cuint64;
-
- (**
- * minimum MB quantizer
- * - encoding: unused
- * - decoding: unused
- *)
- mb_qmin: cint;
-
- (**
- * maximum MB quantizer
- * - encoding: unused
- * - decoding: unused
- *)
- mb_qmax: cint;
-
- (**
- * motion estimation comparison function
- * - encoding: Set by user.
- * - decoding: unused
- *)
- me_cmp: cint;
-
- (**
- * subpixel motion estimation comparison function
- * - encoding: Set by user.
- * - decoding: unused
- *)
- me_sub_cmp: cint;
- (**
- * macroblock comparison function (not supported yet)
- * - encoding: Set by user.
- * - decoding: unused
- *)
- mb_cmp: cint;
- (**
- * interlaced DCT comparison function
- * - encoding: Set by user.
- * - decoding: unused
- *)
- ildct_cmp: cint;
-
- (**
- * ME diamond size & shape
- * - encoding: Set by user.
- * - decoding: unused
- *)
- dia_size: cint;
-
- (**
- * amount of previous MV predictors (2a+1 x 2a+1 square)
- * - encoding: Set by user.
- * - decoding: unused
- *)
- last_predictor_count: cint;
-
- (**
- * prepass for motion estimation
- * - encoding: Set by user.
- * - decoding: unused
- *)
- pre_me: cint;
-
- (**
- * motion estimation prepass comparison function
- * - encoding: Set by user.
- * - decoding: unused
- *)
- me_pre_cmp: cint;
-
- (**
- * ME prepass diamond size & shape
- * - encoding: Set by user.
- * - decoding: unused
- *)
- pre_dia_size: cint;
-
- (**
- * subpel ME quality
- * - encoding: Set by user.
- * - decoding: unused
- *)
- me_subpel_quality: cint;
-
- (**
- * 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; fmt: {const} 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: cint;
-
- (**
- * maximum motion estimation search range in subpel units
- * If 0 then no limit.
- *
- * - encoding: Set by user.
- * - decoding: unused
- *)
- me_range: cint;
-
- (**
- * intra quantizer bias
- * - encoding: Set by user.
- * - decoding: unused
- *)
- intra_quant_bias: cint;
-
- (**
- * inter quantizer bias
- * - encoding: Set by user.
- * - decoding: unused
- *)
- inter_quant_bias: cint;
-
- (**
- * 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: cint;
-
- (**
- * internal_buffer count
- * Don't touch, used by libavcodec default_get_buffer().
- *)
- internal_buffer_count: cint;
-
- (**
- * 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: cint;
-
- (**
- * coder type
- * - encoding: Set by user.
- * - decoding: unused
- *)
- coder_type: cint;
-
- (**
- * context model
- * - encoding: Set by user.
- * - decoding: unused
- *)
- context_model: cint;
-
- {
- (**
- *
- * - encoding: unused
- * - decoding: Set by user.
- *)
- realloc: function (s: PAVCodecContext; buf: Pbyte; buf_size: cint): Pbyte; cdecl;
- }
-
- (**
- * slice flags
- * - encoding: unused
- * - decoding: Set by user.
- *)
- slice_flags: cint;
-
- (**
- * XVideo Motion Acceleration
- * - encoding: forbidden
- * - decoding: set by decoder
- *)
- xvmc_acceleration: cint;
-
- (**
- * macroblock decision mode
- * - encoding: Set by user.
- * - decoding: unused
- *)
- mb_decision: cint;
-
- (**
- * 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 AnsiChar; //cuint;
-
- (**
- * scene change detection threshold
- * 0 is default, larger means fewer detected scene changes.
- * - encoding: Set by user.
- * - decoding: unused
- *)
- scenechange_threshold: cint;
-
- (**
- * minimum Lagrange multipler
- * - encoding: Set by user.
- * - decoding: unused
- *)
- lmin: cint;
-
- (**
- * maximum Lagrange multipler
- * - encoding: Set by user.
- * - decoding: unused
- *)
- lmax: cint;
-
- (**
- * 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: cint;
-
- (**
- * 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().
- * if CODEC_CAP_DR1 is not set then reget_buffer() must call
- * avcodec_default_reget_buffer() instead of providing buffers allocated by
- * some other means.
- * - encoding: unused
- * - decoding: Set by libavcodec., user can override
- *)
- reget_buffer: function (c: PAVCodecContext; pic: PAVFrame): cint; 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: cint;
-
- (**
- *
- * - encoding: Set by user.
- * - decoding: unused
- *)
- inter_threshold: cint;
-
- (**
- * CODEC_FLAG2_*
- * - encoding: Set by user.
- * - decoding: Set by user.
- *)
- flags2: cint;
-
- (**
- * Simulates errors in the bitstream to test error concealment.
- * - encoding: Set by user.
- * - decoding: unused
- *)
- error_rate: cint;
-
- (**
- * MP3 antialias algorithm, see FF_AA_* below.
- * - encoding: unused
- * - decoding: Set by user.
- *)
- antialias_algo: cint;
-
- (**
- * quantizer noise shaping
- * - encoding: Set by user.
- * - decoding: unused
- *)
- quantizer_noise_shaping: cint;
-
- (**
- * 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: cint;
-
- (**
- * 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.
- *)
- {$IF LIBAVCODEC_VERSION < 52004000} // < 52.4.0
- execute: function (c: PAVCodecContext; func: TExecuteFunc; arg: PPointer; ret: PCint; count: cint): cint; cdecl;
- {$ELSE}
- execute: function (c: PAVCodecContext; func: TExecuteFunc; arg: Pointer; ret: PCint; count: cint; size: cint): cint; cdecl;
- {$IFEND}
-
- (**
- * 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: cint;
-
- (**
- * Macroblock threshold below which the user specified macroblock types will be used.
- * - encoding: Set by user.
- * - decoding: unused
- *)
- mb_threshold: cint;
-
- (**
- * precision of the intra DC coefficient - 8
- * - encoding: Set by user.
- * - decoding: unused
- *)
- intra_dc_precision: cint;
-
- (**
- * noise vs. sse weight for the nsse comparsion function
- * - encoding: Set by user.
- * - decoding: unused
- *)
- nsse_weight: cint;
-
- (**
- * Number of macroblock rows at the top which are skipped.
- * - encoding: unused
- * - decoding: Set by user.
- *)
- skip_top: cint;
-
- (**
- * Number of macroblock rows at the bottom which are skipped.
- * - encoding: unused
- * - decoding: Set by user.
- *)
- skip_bottom: cint;
-
- (**
- * profile
- * - encoding: Set by user.
- * - decoding: Set by libavcodec.
- *)
- profile: cint;
-
- (**
- * level
- * - encoding: Set by user.
- * - decoding: Set by libavcodec.
- *)
- level: cint;
-
- (**
- * low resolution decoding, 1-> 1/2 size, 2->1/4 size
- * - encoding: unused
- * - decoding: Set by user.
- *)
- lowres: cint;
-
- (**
- * 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: cint;
-
- (**
- * frame skip threshold
- * - encoding: Set by user.
- * - decoding: unused
- *)
- frame_skip_threshold: cint;
-
- (**
- * frame skip factor
- * - encoding: Set by user.
- * - decoding: unused
- *)
- frame_skip_factor: cint;
-
- (**
- * frame skip exponent
- * - encoding: Set by user.
- * - decoding: unused
- *)
- frame_skip_exp: cint;
-
- (**
- * frame skip comparison function
- * - encoding: Set by user.
- * - decoding: unused
- *)
- frame_skip_cmp: cint;
-
- (**
- * Border processing masking, raises the quantizer for mbs on the borders
- * of the picture.
- * - encoding: Set by user.
- * - decoding: unused
- *)
- border_masking: cfloat;
-
- (**
- * minimum MB lagrange multipler
- * - encoding: Set by user.
- * - decoding: unused
- *)
- mb_lmin: cint;
-
- (**
- * maximum MB lagrange multipler
- * - encoding: Set by user.
- * - decoding: unused
- *)
- mb_lmax: cint;
-
- (**
- *
- * - encoding: Set by user.
- * - decoding: unused
- *)
- me_penalty_compensation: cint;
-
- (**
- *
- * - 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: cint;
-
- (**
- *
- * - encoding: Set by user.
- * - decoding: unused
- *)
- brd_scale: cint;
-
- (**
- * constant rate factor - quality-based VBR - values ~correspond to qps
- * - encoding: Set by user.
- * - decoding: unused
- *)
- {$IF LIBAVCODEC_VERSION >= 51021000} // 51.21.0
- crf: cfloat;
- {$ELSE}
- crf: cint;
- {$IFEND}
-
- (**
- * constant quantization parameter rate control method
- * - encoding: Set by user.
- * - decoding: unused
- *)
- cqp: cint;
-
- (**
- * minimum GOP size
- * - encoding: Set by user.
- * - decoding: unused
- *)
- keyint_min: cint;
-
- (**
- * number of reference frames
- * - encoding: Set by user.
- * - decoding: Set by lavc.
- *)
- refs: cint;
-
- (**
- * chroma qp offset from luma
- * - encoding: Set by user.
- * - decoding: unused
- *)
- chromaoffset: cint;
-
- (**
- * Influences how often B-frames are used.
- * - encoding: Set by user.
- * - decoding: unused
- *)
- bframebias: cint;
-
- (**
- * trellis RD quantization
- * - encoding: Set by user.
- * - decoding: unused
- *)
- trellis: cint;
-
- (**
- * Reduce fluctuations in qp (before curve compression).
- * - encoding: Set by user.
- * - decoding: unused
- *)
- complexityblur: cfloat;
-
- (**
- * in-loop deblocking filter alphac0 parameter
- * alpha is in the range -6...6
- * - encoding: Set by user.
- * - decoding: unused
- *)
- deblockalpha: cint;
-
- (**
- * in-loop deblocking filter beta parameter
- * beta is in the range -6...6
- * - encoding: Set by user.
- * - decoding: unused
- *)
- deblockbeta: cint;
-
- (**
- * macroblock subpartition sizes to consider - p8x8, p4x4, b8x8, i8x8, i4x4
- * - encoding: Set by user.
- * - decoding: unused
- *)
- partitions: cint;
-
- (**
- * direct MV prediction mode - 0 (none), 1 (spatial), 2 (temporal), 3 (auto)
- * - encoding: Set by user.
- * - decoding: unused
- *)
- directpred: cint;
-
- (**
- * Audio cutoff bandwidth (0 means "automatic")
- * - encoding: Set by user.
- * - decoding: unused
- *)
- cutoff: cint;
-
- (**
- * Multiplied by qscale for each frame and added to scene_change_score.
- * - encoding: Set by user.
- * - decoding: unused
- *)
- scenechange_factor: cint;
-
- (**
- *
- * Note: Value depends upon the compare function used for fullpel ME.
- * - encoding: Set by user.
- * - decoding: unused
- *)
- mv0_threshold: cint;
-
- (**
- * Adjusts sensitivity of b_frame_strategy 1.
- * - encoding: Set by user.
- * - decoding: unused
- *)
- b_sensitivity: cint;
-
- (**
- * - encoding: Set by user.
- * - decoding: unused
- *)
- compression_level: cint;
-
- (**
- * Sets whether to use LPC mode - used by FLAC encoder.
- * - encoding: Set by user.
- * - decoding: unused
- *)
- use_lpc: cint;
-
- (**
- * LPC coefficient precision - used by FLAC encoder
- * - encoding: Set by user.
- * - decoding: unused
- *)
- lpc_coeff_precision: cint;
-
- (**
- * - encoding: Set by user.
- * - decoding: unused
- *)
- min_prediction_order: cint;
-
- (**
- * - encoding: Set by user.
- * - decoding: unused
- *)
- max_prediction_order: cint;
-
- (**
- * search method for selecting prediction order
- * - encoding: Set by user.
- * - decoding: unused
- *)
- prediction_order_method: cint;
-
- (**
- * - encoding: Set by user.
- * - decoding: unused
- *)
- min_partition_order: cint;
-
- (**
- * - encoding: Set by user.
- * - decoding: unused
- *)
- max_partition_order: cint;
-
- {$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: cint64;
- {$IFEND}
-
- {$IF LIBAVCODEC_VERSION >= 51042000} // 51.42.0
- {$IF LIBAVCODEC_MAX_VERSION_MAJOR < 53}
- (**
- * Decoder should decode to this many channels if it can (0 for default)
- * - encoding: unused
- * - decoding: Set by user.
- * @deprecated Deprecated in favor of request_channel_layout.
- *)
- request_channels: cint;
- {$IFEND}
- {$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: cfloat;
- {$IFEND}
-
- {$IF LIBAVCODEC_VERSION >= 51068000} // 51.68.0
- (**
- * opaque 64bit number (generally a PTS) that will be reordered and
- * output in AVFrame.reordered_opaque
- * - encoding: unused
- * - decoding: Set by user.
- *)
- reordered_opaque: cint64;
- {$IFEND}
-
- {$IF LIBAVCODEC_VERSION >= 52028000} // 52.28.0
- (**
- * This defines the location of chroma samples.
- * - encoding: Set by user
- * - decoding: Set by libavcodec
- *)
- chroma_sample_location: TAVChromaLocation;
- {$IFEND}
- {$IF LIBAVCODEC_VERSION >= 52037000} // >= 52.37.0
- (**
- * 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.
- * Also see avcodec_thread_init and e.g. the --enable-pthread configure option.
- * @param c context passed also to func
- * @param count the number of things to execute
- * @param arg2 argument passed unchanged to func
- * @param ret return values of executed functions, must have space for "count" values. May be NULL.
- * @param func function that will be called count times, with jobnr from 0 to count-1.
- * threadnr will be in the range 0 to c->thread_count-1 < MAX_THREADS and so that no
- * two instances of func executing at the same time will have the same threadnr.
- * @return always 0 currently, but code should handle a future improvement where when any call to func
- * returns < 0 no further calls to func may be done and < 0 is returned.
- * - encoding: Set by libavcodec, user can override.
- * - decoding: Set by libavcodec, user can override.
- *)
- execute2: function (c: PAVCodecContext; func: TExecute2Func; arg2: Pointer; ret: Pcint; count: cint): cint; cdecl;
- {$IFEND}
- {$IF LIBAVCODEC_VERSION >= 52042000} // >= 52.42.0
- (**
- * explicit P-frame weighted prediction analysis method
- * 0: off
- * 1: fast blind weighting (one reference duplicate with -1 offset)
- * 2: smart weighting (full fade detection analysis)
- * - encoding: Set by user.
- * - decoding: unused
- *)
- weighted_p_pred: cint;
- {$IFEND}
- end;
-
-(**
- * AVCodec.
- *)
- TAVCodec = record
- name: PAnsiChar;
- type_: TCodecType;
- id: TCodecID;
- priv_data_size: cint;
- init: function (avctx: PAVCodecContext): cint; cdecl; (* typo corretion by the Creative CAT *)
- encode: function (avctx: PAVCodecContext; buf: PByteArray; buf_size: cint; data: pointer): cint; cdecl;
- close: function (avctx: PAVCodecContext): cint; cdecl;
- decode: function (avctx: PAVCodecContext; outdata: pointer; var outdata_size: cint;
- {$IF LIBAVCODEC_VERSION < 52025000} // 52.25.0
- buf: {const} PByteArray; buf_size: cint): cint; cdecl;
- {$ELSE}
- avpkt: PAVPacket): cint; cdecl;
- {$IFEND}
- (**
- * Codec capabilities.
- * see CODEC_CAP_*
- *)
- capabilities: cint;
- next: PAVCodec;
- (**
- * Flush buffers.
- * Will be called when seeking
- *)
- flush: procedure (avctx: PAVCodecContext); cdecl;
- supported_framerates: {const} PAVRational; ///< array of supported framerates, or NULL if any, array is terminated by {0,0}
- pix_fmts: {const} PAVPixelFormat; ///< array of supported pixel formats, or NULL if unknown, array is terminated by -1
- {$IF LIBAVCODEC_VERSION >= 51055000} // 51.55.0
- (**
- * Descriptive name for the codec, meant to be more human readable than name.
- * You should use the NULL_IF_CONFIG_SMALL() macro to define it.
- *)
- long_name: {const} PAnsiChar;
- {$IFEND}
- {$IF LIBAVCODEC_VERSION >= 51056000} // 51.56.0
- supported_samplerates: {const} PCint; ///< array of supported audio samplerates, or NULL if unknown, array is terminated by 0
- {$IFEND}
- {$IF LIBAVCODEC_VERSION >= 51062000} // 51.62.0
- sample_fmts: {const} PSampleFormatArray; ///< array of supported sample formats, or NULL if unknown, array is terminated by -1
- {$IFEND}
- {$IF LIBAVCODEC_VERSION >= 52002000} // 52.2.0
- channel_layouts: {const} PCint64; ///< array of support channel layouts, or NULL if unknown. array is terminated by 0
- {$IFEND}
- end;
-
-{$IF LIBAVCODEC_VERSION >= 52018000} // 52.18.0
-(**
- * AVHWAccel.
- *)
- TAVHWAccel = record
- (**
- * Name of the hardware accelerated codec.
- * The name is globally unique among encoders and among decoders (but an
- * encoder and a decoder can share the same name).
- *)
- name: PAnsiChar;
-
- (**
- * Type of codec implemented by the hardware accelerator.
- *
- * See CODEC_TYPE_xxx
- *)
- type_: TCodecType;
-
- (**
- * Codec implemented by the hardware accelerator.
- *
- * See CODEC_ID_xxx
- *)
- id: TCodecID;
-
- (**
- * Supported pixel format.
- *
- * Only hardware accelerated formats are supported here.
- *)
- pix_fmt: {const} PAVPixelFormat;
-
- (**
- * Hardware accelerated codec capabilities.
- * see FF_HWACCEL_CODEC_CAP_*
- *)
- capabilities: cint;
-
- next: PAVCodec;
-
- (**
- * Called at the beginning of each frame or field picture.
- *
- * Meaningful frame information (codec specific) is guaranteed to
- * be parsed at this point. This function is mandatory.
- *
- * Note that buf can be NULL along with buf_size set to 0.
- * Otherwise, this means the whole frame is available at this point.
- *
- * @param avctx the codec context
- * @param buf the frame data buffer base
- * @param buf_size the size of the frame in bytes
- * @return zero if successful, a negative value otherwise
- *)
- start_frame: function (avctx: PAVCodecContext;
- buf: PByteArray;
- buf_size: cint): cint; cdecl;
-
- (**
- * Callback for each slice.
- *
- * Meaningful slice information (codec specific) is guaranteed to
- * be parsed at this point. This function is mandatory.
- *
- * @param avctx the codec context
- * @param buf the slice data buffer base
- * @param buf_size the size of the slice in bytes
- * @return zero if successful, a negative value otherwise
- *)
- decode_slice: function (avctx: PAVCodecContext;
- buf: PByteArray;
- buf_size: cint): cint; cdecl;
-
- (**
- * Called at the end of each frame or field picture.
- *
- * The whole picture is parsed at this point and can now be sent
- * to the hardware accelerator. This function is mandatory.
- *
- * @param avctx the codec context
- * @return zero if successful, a negative value otherwise
- *)
- end_frame: function (avctx: PAVCodecContext): cint; cdecl;
-
-{$IF LIBAVCODEC_VERSION >= 52021000} // >= 52.21.0
- (**
- * Size of HW accelerator private data.
- *
- * Private data is allocated with av_mallocz() before
- * AVCodecContext.get_buffer() and deallocated after
- * AVCodecContext.release_buffer().
- *)
- priv_data_size: cint;
-{$IFEND}
-
- end;
-{$IFEND}
-
-(**
- * four components are given, that's all.
- * the last component is alpha
- *)
- PAVPicture = ^TAVPicture;
- TAVPicture = record
- data: array [0..3] of PByteArray;
- linesize: array [0..3] of cint; ///< number of bytes per line
- end;
-
-type
- TAVSubtitleType = (
- SUBTITLE_NONE,
-
- SUBTITLE_BITMAP, ///< A bitmap, pict will be set
-
- (**
- * Plain text, the text field must be set by the decoder and is
- * authoritative. ass and pict fields may contain approximations.
- *)
- SUBTITLE_TEXT,
-
- (**
- * Formatted text, the ass field must be set by the decoder and is
- * authoritative. pict and text fields may contain approximations.
- *)
- SUBTITLE_ASS
- );
-
-type
- PPAVSubtitleRect = ^PAVSubtitleRect;
- PAVSubtitleRect = ^TAVSubtitleRect;
- {$IF LIBAVCODEC_VERSION < 52010000} // < 52.10.0
- TAVSubtitleRect = record
- x: cuint16;
- y: cuint16;
- w: cuint16;
- h: cuint16;
- nb_colors: cuint16;
- linesize: cint;
- rgba_palette: PCuint32;
- bitmap: PCuint8;
- end;
- {$ELSE}
- TAVSubtitleRect = record
- x: cint; ///< top left corner of pict, undefined when pict is not set
- y: cint; ///< top left corner of pict, undefined when pict is not set
- w: cint; ///< width of pict, undefined when pict is not set
- h: cint; ///< height of pict, undefined when pict is not set
- nb_colors: cint; ///< number of colors in pict, undefined when pict is not set
-
- (**
- * data+linesize for the bitmap of this subtitle.
- * can be set for text/ass as well once they where rendered
- *)
- pict: TAVPicture;
- type_: TAVSubtitleType;
-
- text: PAnsiChar; ///< 0 terminated plain UTF-8 text
-
- (**
- * 0 terminated ASS/SSA compatible event line.
- * The pressentation of this is unaffected by the other values in this
- * struct.
- *)
- ass: PByteArray;
- end;
- {$IFEND}
-
- PPAVSubtitle = ^PAVSubtitle;
- PAVSubtitle = ^TAVSubtitle;
- TAVSubtitle = record
- format: cuint16; (* 0 = graphics *)
- start_display_time: cuint32; (* relative to packet pts, in ms *)
- end_display_time: cuint32; (* relative to packet pts, in ms *)
- num_rects: cuint;
- {$IF LIBAVCODEC_VERSION < 52010000} // < 52.10.0
- rects: PAVSubtitleRect;
- {$ELSE}
- rects: PPAVSubtitleRect;
- {$IFEND}
- {$IF LIBAVCODEC_VERSION >= 52032000} // >= 52.32.0
- pts: cint64; ///< Same as packet pts, in AV_TIME_BASE
- {$IFEND}
- end;
-
-{$IF LIBAVCODEC_VERSION >= 52025000} // 52.25.0
-{ packet functions }
-
-(**
- * @deprecated use NULL instead
- *)
-procedure av_destruct_packet_nofree(pkt: PAVPacket);
- cdecl; external av__codec;
-
-(*
- * Default packet destructor.
- *)
-procedure av_destruct_packet(pkt: PAVPacket);
- cdecl; external av__codec;
-
-(*
- * Initialize optional fields of a packet with default values.
- *
- * @param pkt packet
- *)
-procedure av_init_packet(var pkt: TAVPacket);
- cdecl; external av__codec;
-
-(*
- * Allocate the payload of a packet and initialize its fields with
- * default values.
- *
- * @param pkt packet
- * @param size wanted payload size
- * @return 0 if OK, AVERROR_xxx otherwise
- *)
-function av_new_packet(pkt: PAVPacket; size: cint): cint;
- cdecl; external av__codec;
-
-(*
- * Reduce packet size, correctly zeroing padding
- *
- * @param pkt packet
- * @param size new size
- *)
-procedure av_shrink_packet(pkt: PAVPacket; size: cint);
- cdecl; external av__codec;
-
-(*
- * @warning This is a hack - the packet memory allocation stuff is broken. The
- * packet is allocated if it was not really allocated.
- *)
-function av_dup_packet(pkt: PAVPacket): cint;
- cdecl; external av__codec;
-
-(*
- * Free a packet.
- *
- * @param pkt packet to free
- *)
-procedure av_free_packet(pkt: PAVPacket);
-{$IF LIBAVCODEC_VERSION >= 52028000} // 52.28.0
- cdecl; external av__codec;
-{$IFEND}
-{$IFEND}
-
-(* resample.c *)
-type
- PReSampleContext = pointer;
- PAVResampleContext = pointer;
- PImgReSampleContext = pointer;
-
-function audio_resample_init (output_channels: cint; input_channels: cint;
- output_rate: cint; input_rate: cint): PReSampleContext;
- cdecl; external av__codec;
-
-function audio_resample (s: PReSampleContext; output: PSmallint; input: PSmallint; nb_samples: cint): cint;
- cdecl; external av__codec;
-
-procedure audio_resample_close (s: PReSampleContext);
- cdecl; external av__codec;
-
-(**
- * Initializes an audio resampler.
- * Note, if either rate is not an integer then simply scale both rates up so they are.
- * @param filter_length length of each FIR filter in the filterbank relative to the cutoff freq
- * @param log2_phase_count log2 of the number of entries in the polyphase filterbank
- * @param linear If 1 then the used FIR filter will be linearly interpolated
- between the 2 closest, if 0 the closest will be used
- * @param cutoff cutoff frequency, 1.0 corresponds to half the output sampling rate
- *)
-function av_resample_init (out_rate: cint; in_rate: cint; filter_length: cint;
- log2_phase_count: cint; linear: cint; cutoff: cdouble): PAVResampleContext;
- cdecl; external av__codec;
-
-(**
- * resamples.
- * @param src an array of unconsumed samples
- * @param consumed the number of samples of src which have been consumed are returned here
- * @param src_size the number of unconsumed samples available
- * @param dst_size the amount of space in samples available in dst
- * @param update_ctx If this is 0 then the context will not be modified, that way several channels can be resampled with the same context.
- * @return the number of samples written in dst or -1 if an error occurred
- *)
-function av_resample (c: PAVResampleContext; dst: PSmallint; src: PSmallint; var consumed: cint;
- src_size: cint; dst_size: cint; update_ctx: cint): cint;
- cdecl; external av__codec;
-
-(**
- * Compensates samplerate/timestamp drift. The compensation is done by changing
- * the resampler parameters, so no audible clicks or similar distortions occur
- * @param compensation_distance distance in output samples over which the compensation should be performed
- * @param sample_delta number of output samples which should be output less
- *
- * example: av_resample_compensate(c, 10, 500)
- * here instead of 510 samples only 500 samples would be output
- *
- * note, due to rounding the actual compensation might be slightly different,
- * especially if the compensation_distance is large and the in_rate used during init is small
- *)
-procedure av_resample_compensate (c: PAVResampleContext; sample_delta: cint;
- compensation_distance: cint);
- 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: cint; output_height: cint;
- input_width: cint; input_height: cint): PImgReSampleContext;
- cdecl; external av__codec; deprecated;
-
-(**
- * @deprecated Use the software scaler (swscale) instead.
- *)
-function img_resample_full_init (owidth: cint; oheight: cint;
- iwidth: cint; iheight: cint;
- topBand: cint; bottomBand: cint;
- leftBand: cint; rightBand: cint;
- padtop: cint; padbottom: cint;
- padleft: cint; padright: cint): PImgReSampleContext;
- cdecl; external av__codec; deprecated;
-
-(**
- * @deprecated Use the software scaler (swscale) instead.
- *)
-procedure img_resample (s: PImgReSampleContext; output: PAVPicture; input: {const} 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: cint; height: cint): cint;
- 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.
- * Call with ptr == NULL to get the required size for the ptr buffer.
- *
- * @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: cint; height: cint): cint;
- cdecl; external av__codec;
-
-function avpicture_layout (src: {const} PAVPicture; pix_fmt: TAVPixelFormat;
- width: cint; height: cint;
- dest: PByteArray; dest_size: cint): cint;
- 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.
- * Note that this returns the size of a compact representation as generated
- * by avpicture_layout, which can be smaller than the size required for e.g.
- * avpicture_fill.
- *
- * @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 or -1 on error (e.g. too large dimensions).
- *)
-function avpicture_get_size (pix_fmt: TAVPixelFormat; width: cint; height: cint): cint;
- cdecl; external av__codec;
-
-procedure avcodec_get_chroma_sub_sample (pix_fmt: TAVPixelFormat; var h_shift: cint; var v_shift: cint);
- cdecl; external av__codec;
-
-(**
- * Returns the pixel format corresponding to the name \p name.
- *
- * If there is no pixel format with name \p name, then looks for a
- * pixel format with the name corresponding to the native endian
- * format of \p name.
- * For example in a little-endian system, first looks for "gray16",
- * then for "gray16le".
- *
- * Finally if no pixel format has been found, returns \c PIX_FMT_NONE.
- *)
-function avcodec_get_pix_fmt_name(pix_fmt: TAVPixelFormat): PAnsiChar;
- cdecl; external av__codec;
-
-procedure avcodec_set_dimensions(s: PAVCodecContext; width: cint; height: cint);
- cdecl; external av__codec;
-
-(**
- * Returns the pixel format corresponding to the name name.
- *
- * If there is no pixel format with name name, then looks for a
- * pixel format with the name corresponding to the native endian
- * format of name.
- * For example in a little-endian system, first looks for "gray16",
- * then for "gray16le".
- *
- * Finally if no pixel format has been found, returns PIX_FMT_NONE.
- *)
-function avcodec_get_pix_fmt(name: {const} PAnsiChar): TAVPixelFormat;
- cdecl; external av__codec;
-
-function avcodec_pix_fmt_to_codec_tag(p: TAVPixelFormat): cuint;
- 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: cint): cint;
- 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
- * 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.
- *)
-{$IF LIBAVCODEC_VERSION >= 52000000} // 52.0.0
-function avcodec_find_best_pix_fmt(pix_fmt_mask: cint64; src_pix_fmt: TAVPixelFormat;
- has_alpha: cint; loss_ptr: PCint): cint;
- cdecl; external av__codec;
-{$ELSEIF LIBAVCODEC_VERSION < 52022001}
-function avcodec_find_best_pix_fmt(pix_fmt_mask: cint; src_pix_fmt: TAVPixelFormat;
- has_alpha: cint; loss_ptr: PCint): cint;
- cdecl; external av__codec;
-{$ELSE}
-function avcodec_find_best_pix_fmt(pix_fmt_mask: cint; src_pix_fmt: TAVPixelFormat;
- has_alpha: cint; loss_ptr: PCint): TAVPixelFormat;
- cdecl; external av__codec;
-{$IFEND}
-
-{$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.
- *)
-{$IF LIBAVCODEC_VERSION < 52022001} // 52.22.1
-procedure avcodec_pix_fmt_string (buf: PAnsiChar; buf_size: cint; pix_fmt: cint);
- cdecl; external av__codec;
-{$ELSE}
-procedure avcodec_pix_fmt_string (buf: PAnsiChar; buf_size: cint; pix_fmt: TAVPixelFormat);
- cdecl; external av__codec;
-{$IFEND}
-{$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 (src: {const} PAVPicture;
- pix_fmt: TAVPixelFormat;
- width: cint;
- height: cint): cint;
- 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;
- src: {const} PAVPicture; pix_fmt: TAVPixelFormat;
- width: cint; height: cint): cint;
- cdecl; external av__codec; deprecated;
-{$IFEND}
-
-(* deinterlace a picture *)
-(* deinterlace - if not supported return -1 *)
-function avpicture_deinterlace (dst: PAVPicture;
- src: {const} PAVPicture;
- pix_fmt: TAVPixelFormat;
- width: cint;
- height: cint): cint;
- 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
-(**
- * If c is NULL, returns the first registered codec,
- * if c is non-NULL, returns the next registered codec after c,
- * or NULL if c is the last one.
- *)
-function av_codec_next(c: PAVCodec): PAVCodec;
- cdecl; external av__codec;
-{$IFEND}
-
-(**
- * Returns the LIBAVCODEC_VERSION_INT constant.
- *)
-function avcodec_version(): cuint;
- cdecl; external av__codec;
-
-{$IF LIBAVCODEC_VERSION < 52008000} // 52.8.0
-(* returns LIBAVCODEC_BUILD constant *)
-function avcodec_build(): cuint;
- cdecl; external av__codec; deprecated;
-{$IFEND}
-
-{$IF LIBAVCODEC_VERSION >= 52041000} // 52.41.0
-(**
- * Returns the libavcodec build-time configuration.
- *)
-function avcodec_configuration(): PAnsiChar;
- cdecl; external av__codec;
-
-(**
- * Returns the libavcodec license.
- *)
-function avcodec_license(): PAnsiChar;
- cdecl; external av__codec;
-{$IFEND}
-
-(**
- * Initializes libavcodec.
- *
- * @warning This function must be called before any other libavcodec
- * function.
- *)
-procedure avcodec_init();
- cdecl; external av__codec;
-
-(**
- * Register the codec codec and initialize libavcodec.
- *
- * @see avcodec_init()
- *)
-{$IF LIBAVCODEC_VERSION >= 52014000} // 52.14.0
-procedure avcodec_register(codec: PAVCodec);
- cdecl; external av__codec;
-// Deprecated in favor of avcodec_register.
-procedure register_avcodec(codec: PAVCodec);
- cdecl; external av__codec; deprecated;
-{$ELSEIF LIBAVCODEC_VERSION_MAJOR < 53}
-procedure register_avcodec(codec: PAVCodec);
- cdecl; external av__codec;
-{$IFEND}
-(**
- * 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: PAnsiChar): 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: PAnsiChar): PAVCodec;
- cdecl; external av__codec;
-procedure avcodec_string(buf: PAnsiChar; buf_size: cint; enc: PAVCodecContext; encode: cint);
- 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): cint;
- 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): cint;
- cdecl; external av__codec;
-procedure avcodec_align_dimensions(s: PAVCodecContext; width: PCint; height: PCint);
- 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: cuint; h: cuint): cint;
- cdecl; external av__codec;
-function avcodec_default_get_format(s: PAVCodecContext; fmt: {const} PAVPixelFormat): TAVPixelFormat;
- cdecl; external av__codec;
-
-function avcodec_thread_init(s: PAVCodecContext; thread_count: cint): cint;
- cdecl; external av__codec;
-procedure avcodec_thread_free(s: PAVCodecContext);
- cdecl; external av__codec;
-
-
-{$IF LIBAVCODEC_VERSION < 52004000} // < 52.4.0
-function avcodec_thread_execute(s: PAVCodecContext; func: TExecuteFunc; arg: PPointer; var ret: cint; count: cint): cint;
- cdecl; external av__codec;
-{$ELSE}
-function avcodec_thread_execute(s: PAVCodecContext; func: TExecuteFunc; arg: Pointer; var ret: cint; count: cint; size: cint): cint;
- cdecl; external av__codec;
-{$IFEND}
-
-{$IF LIBAVCODEC_VERSION < 52004000} // < 52.4.0
-function avcodec_default_execute(s: PAVCodecContext; func: TExecuteFunc; arg: PPointer; var ret: cint; count: cint): cint;
- cdecl; external av__codec;
-{$ELSE}
-function avcodec_default_execute(s: PAVCodecContext; func: TExecuteFunc; arg: Pointer; var ret: cint; count: cint; size: cint): cint;
- cdecl; external av__codec;
-{$IFEND}
-{$IF LIBAVCODEC_VERSION >= 52037000} // >= 52.37.0
-function avcodec_default_execute2(s: PAVCodecContext; func: TExecuteFunc; arg: Pointer; var ret: cint; count: cint): cint;
- cdecl; external av__codec;
-{$IFEND}
-//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): cint;
- cdecl; external av__codec;
-
-{$IF LIBAVCODEC_VERSION < 52000000} // < 52.0.0
-(**
- * @deprecated Use avcodec_decode_audio2 instead.
- *)
-function avcodec_decode_audio(avctx: PAVCodecContext; samples: PSmallint;
- var frame_size_ptr: cint;
- buf: {const} PByteArray; buf_size: cint): cint;
- cdecl; external av__codec; {deprecated;}
-{$IFEND}
-
-{$IF LIBAVCODEC_MAX_VERSION_MAJOR < 53}
-{$IF LIBAVCODEC_VERSION >= 51030000} // 51.30.0
-(**
- * Decodes an audio frame from buf into samples.
- * Wrapper function which calls avcodec_decode_audio3.
- *
- * @deprecated Use avcodec_decode_audio3 instead.
- * @param avctx the codec context
- * @param[out] samples the output buffer, sample type in avctx->sample_fmt
- * @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: cint;
- buf: {const} PByteArray; buf_size: cint): cint;
- cdecl; external av__codec; {deprecated;}
-{$IFEND}
-{$IFEND}
-
-{$IF LIBAVCODEC_VERSION >= 52025000} // 52.25.0
-(**
- * Decodes the audio frame of size avpkt->size from avpkt->data into samples.
- * Some decoders may support multiple frames in a single AVPacket, such
- * decoders would then just decode the first frame. In this case,
- * avcodec_decode_audio3 has to be called again with an AVPacket that contains
- * the remaining data in order to decode the second frame etc.
- * If no frame
- * could be outputted, frame_size_ptr is zero. Otherwise, it is the
- * decompressed frame size in bytes.
- *
- * @warning You must set frame_size_ptr to the allocated size of the
- * output buffer before calling avcodec_decode_audio3().
- *
- * @warning The input buffer must be 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 avpkt->data should be set to 0 to ensure that
- * no overreading happens for damaged MPEG streams.
- *
- * @note You might have to align the input buffer avpkt->data and output buffer
- * 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, avpkt->data should have 4 byte alignment at minimum and
- * samples should be 16 byte aligned unless the CPU doesn't need it
- * (AltiVec and SSE do).
- *
- * @note Some codecs have a delay between input and output, these need to be
- * feeded with avpkt->data=NULL, avpkt->size=0 at the end to return the remaining frames.
- *
- * @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] avpkt The input AVPacket containing the input buffer.
- * You can create such packet with av_init_packet() and by then setting
- * data and size, some decoders might in addition need other fields.
- * All decoders are designed to use the least fields possible though.
- * @return On error a negative value is returned, otherwise the number of bytes
- * used or zero if no frame data was decompressed (used) from the input AVPacket.
- *)
-function avcodec_decode_audio3(avctx: PAVCodecContext; samples: PSmallint;
- var frame_size_ptr: cint;
- avpkt: PAVPacket): cint;
- cdecl; external av__codec;
-{$IFEND}
-
-{$IF LIBAVCODEC_MAX_VERSION_MAJOR < 53}
-(**
- * Decodes a video frame from buf into picture.
- * Wrapper function which calls avcodec_decode_video2.
- *
- * @deprecated Use avcodec_decode_video2 instead.
- * @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: cint;
- buf: {const} PByteArray; buf_size: cint): cint;
- cdecl; external av__codec; {deprecated;}
-{$IFEND}
-
-{$IF LIBAVCODEC_VERSION >= 52025000} // 52.25.0
-(**
- * Decodes the video frame of size avpkt->size from avpkt->data into picture.
- * Some decoders may support multiple frames in a single AVPacket, such
- * decoders would then just decode the first frame.
- *
- * @warning The input buffer must be 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 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 avpkt->data.
- * 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, avpkt->data should have 4 byte alignment at minimum.
- *
- * @param avctx the codec context
- * @param[out] picture The AVFrame in which the decoded video frame will be stored.
- * @param[in] avpkt The input AVpacket containing the input buffer.
- * You can create such packet with av_init_packet() and by then setting
- * data and size, some decoders might in addition need other fields like
- * flags&PKT_FLAG_KEY. All decoders are designed to use the least
- * fields possible.
- * @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_video2(avctx: PAVCodecContext; picture: PAVFrame;
- var got_picture_ptr: cint;
- avpkt: PAVPacket): cint;
- cdecl; external av__codec;
-{$IFEND}
-
-{$IF LIBAVCODEC_MAX_VERSION_MAJOR < 53}
-(* 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: cint;
- buf: {const} PByteArray; buf_size: cint): cint;
- cdecl; external av__codec;
-{$IFEND}
-
-{$IF LIBAVCODEC_VERSION >= 52025000} // 52.25.0
-(* Decodes a subtitle message.
- * Returns a negative value on error, otherwise returns the number of bytes used.
- * If no subtitle could be decompressed, got_sub_ptr is zero.
- * Otherwise, the subtitle is stored in sub.
- *
- * @param avctx the codec context
- * @param[out] sub The AVSubtitle in which the decoded subtitle will be stored.
- * @param[in,out] got_sub_ptr Zero if no subtitle could be decompressed, otherwise, it is nonzero.
- * @param[in] avpkt The input AVPacket containing the input buffer.
- *)
-function avcodec_decode_subtitle2(avctx: PAVCodecContext; sub: PAVSubtitle;
- var got_sub_ptr: cint;
- avpkt: PAVPacket): cint;
- cdecl; external av__codec;
-{$IFEND}
-
-function avcodec_parse_frame(avctx: PAVCodecContext; pdata: PPointer;
- data_size_ptr: PCint;
- buf: PByteArray; buf_size: cint): cint;
- cdecl; external av__codec;
-
-(**
- * Encodes an audio frame from samples into buf.
- *
- * @note The output buffer should be at least FF_MIN_BUFFER_SIZE bytes large.
- * However, for PCM audio the user will know how much space is needed
- * because it depends on the value passed in buf_size as described
- * below. In that case a lower value can be used.
- *
- * @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 avctx.
- * For PCM audio the number of samples read from samples is equal to
- * buf_size * input_sample_size / output_sample_size.
- * @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: cint; samples: {const} PSmallint): cint;
- cdecl; external av__codec;
-
-(**
- * Encodes a video frame from pict into buf.
- * The input picture should be
- * stored using a specific format, namely 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 output buffer.
- *)
-function avcodec_encode_video(avctx: PAVCodecContext; buf: PByte;
- buf_size: cint; pict: PAVFrame): cint;
- cdecl; external av__codec;
-function avcodec_encode_subtitle(avctx: PAVCodecContext; buf: PByteArray;
- buf_size: cint; sub: {const} PAVSubtitle): cint;
- cdecl; external av__codec;
-
-function avcodec_close(avctx: PAVCodecContext): cint;
- cdecl; external av__codec;
-
-(**
- * Register all the codecs, parsers and bitstream filters which were enabled at
- * configuration time. If you do not call this function you can select exactly
- * which formats you want to support, by using the individual registration
- * functions.
- *
- * @see register_avcodec
- * @see avcodec_register
- * @see av_register_codec_parser
- * @see av_register_bitstream_filter
- *)
-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 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: cint): AnsiChar;
- 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): cint;
- 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): cint;
- 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: cint64; (* offset of the current frame *)
- cur_offset: cint64; (* current offset (incremented by each av_parser_parse()) *)
- next_frame_offset: cint64; (* offset of the next frame *)
- (* video info *)
- pict_type: cint; (* XXX: put it back in AVCodecContext *)
- (**
- * This field is used for proper frame duration computation in lavf.
- * It signals, how much longer the frame duration of the current frame
- * is compared to normal frame duration.
- *
- * frame_duration = (1 + repeat_pict) * time_base
- *
- * It is used by codecs like H.264 to display telecined material.
- *)
- repeat_pict: cint; (* XXX: put it back in AVCodecContext *)
- pts: cint64; (* pts of the current frame *)
- dts: cint64; (* dts of the current frame *)
-
- (* private data *)
- last_pts: cint64;
- last_dts: cint64;
- fetch_timestamp: cint;
-
- cur_frame_start_index: cint;
- cur_frame_offset: array [0..AV_PARSER_PTS_NB - 1] of cint64;
- cur_frame_pts: array [0..AV_PARSER_PTS_NB - 1] of cint64;
- cur_frame_dts: array [0..AV_PARSER_PTS_NB - 1] of cint64;
-
- flags: cint;
-
- {$IF LIBAVCODEC_VERSION >= 51040003} // 51.40.3
- offset: cint64; ///< byte offset from starting packet start
- {$IFEND}
- {$IF LIBAVCODEC_VERSION >= 51057001} // 51.57.1
- cur_frame_end: array [0..AV_PARSER_PTS_NB - 1] of cint64;
- {$IFEND}
- {$IF LIBAVCODEC_VERSION >= 52016000} // 52.16.0
- (*!
- * Set by parser to 1 for key frames and 0 for non-key frames.
- * It is initialized to -1, so if the parser doesn't set this flag,
- * old-style fallback using FF_I_TYPE picture type as key frames
- * will be used.
- *)
- key_frame: cint;
- {$IFEND}
- {$IF LIBAVCODEC_VERSION >= 52018000} // 52.18.0
- (**
- * Time difference in stream time base units from the pts of this
- * packet to the point at which the output from the decoder has converged
- * independent from the availability of previous frames. That is, the
- * frames are virtually identical no matter if decoding started from
- * the very first frame or from this keyframe.
- * Is AV_NOPTS_VALUE if unknown.
- * This field is not the display duration of the current frame.
- *
- * The purpose of this field is to allow seeking in streams that have no
- * keyframes in the conventional sense. It corresponds to the
- * recovery point SEI in H.264 and match_time_delta in NUT. It is also
- * essential for some types of subtitle streams to ensure that all
- * subtitles are correctly displayed after seeking.
- *)
- convergence_duration: cint64;
- {$IFEND}
- {$IF LIBAVCODEC_VERSION >= 52019000} // 52.19.0
- // Timestamp generation support:
- (**
- * Synchronization point for start of timestamp generation.
- *
- * Set to >0 for sync point, 0 for no sync point and <0 for undefined
- * (default).
- *
- * For example, this corresponds to presence of H.264 buffering period
- * SEI message.
- *)
- dts_sync_point: cint;
-
- (**
- * Offset of the current timestamp against last timestamp sync point in
- * units of AVCodecContext.time_base.
- *
- * Set to INT_MIN when dts_sync_point unused. Otherwise, it must
- * contain a valid timestamp offset.
- *
- * Note that the timestamp of sync point has usually a nonzero
- * dts_ref_dts_delta, which refers to the previous sync point. Offset of
- * the next frame after timestamp sync point will be usually 1.
- *
- * For example, this corresponds to H.264 cpb_removal_delay.
- *)
- dts_ref_dts_delta: cint;
-
- (**
- * Presentation delay of current frame in units of AVCodecContext.time_base.
- *
- * Set to INT_MIN when dts_sync_point unused. Otherwise, it must
- * contain valid non-negative timestamp delta (presentation time of a frame
- * must not lie in the past).
- *
- * This delay represents the difference between decoding and presentation
- * time of the frame.
- *
- * For example, this corresponds to H.264 dpb_output_delay.
- *)
- pts_dts_delta: cint;
- {$IFEND}
-
- {$IF LIBAVCODEC_VERSION >= 52021000} // 52.21.0
- (**
- * Position of the packet in file.
- *
- * Analogous to cur_frame_pts/dts
- *)
- cur_frame_pos: array [0..AV_PARSER_PTS_NB - 1] of cint64;
-
- (**
- * Byte position of currently parsed frame in stream.
- *)
- pos: cint64;
-
- (**
- * Previous frame byte position.
- *)
- last_pos: cint64;
- {$IFEND}
- end;
-
- TAVCodecParser = record
- codec_ids: array [0..4] of cint; (* several codec IDs are permitted *)
- priv_data_size: cint;
- parser_init: function(s: PAVCodecParserContext): cint; cdecl;
- parser_parse: function(s: PAVCodecParserContext; avctx: PAVCodecContext;
- poutbuf: {const} PPointer; poutbuf_size: PCint;
- buf: {const} PByteArray; buf_size: cint): cint; cdecl;
- parser_close: procedure(s: PAVCodecParserContext); cdecl;
- split: function(avctx: PAVCodecContext; buf: {const} PByteArray;
- buf_size: cint): cint; 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: cint): PAVCodecParserContext;
- cdecl; external av__codec;
-
-{$IF LIBAVCODEC_MAX_VERSION_MAJOR < 53}
-function av_parser_parse(s: PAVCodecParserContext;
- avctx: PAVCodecContext;
- poutbuf: PPointer;
- poutbuf_size: PCint;
- buf: {const} PByteArray;
- buf_size: cint;
- pts: cint64;
- dts: cint64): cint;
- cdecl; external av__codec; deprecated;
-{$IFEND}
-
-{$IF LIBAVCODEC_VERSION >= 52021000} // 52.21.0
-(**
- * Parse a packet.
- *
- * @param s parser context.
- * @param avctx codec context.
- * @param poutbuf set to pointer to parsed buffer or NULL if not yet finished.
- * @param poutbuf_size set to size of parsed buffer or zero if not yet finished.
- * @param buf input buffer.
- * @param buf_size input length, to signal EOF, this should be 0 (so that the last frame can be output).
- * @param pts input presentation timestamp.
- * @param dts input decoding timestamp.
- * @param pos input byte position in stream.
- * @return the number of bytes of the input bitstream used.
- *
- * Example:
- * @code
- * while (in_len) do
- * begin
- * len := av_parser_parse2(myparser, AVCodecContext, data, size,
- * in_data, in_len,
- * pts, dts, pos);
- * in_data := in_data + len;
- * in_len := in_len - len;
- *
- * if (size) then
- * decode_frame(data, size);
- * end;
- * @endcode
- *)
-function av_parser_parse2(s: PAVCodecParserContext;
- avctx: PAVCodecContext;
- poutbuf: PPointer;
- poutbuf_size: PCint;
- buf: {const} PByteArray;
- buf_size: cint;
- pts: cint64;
- dts: cint64;
- pos: cint64): cint;
- cdecl; external av__codec;
-{$IFEND}
-
-function av_parser_change(s: PAVCodecParserContext;
- avctx: PAVCodecContext;
- poutbuf: PPointer; poutbuf_size: PCint;
- buf: {const} PByteArray; buf_size: cint; keyframe: cint): cint;
- 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: PAnsiChar;
- priv_data_size: cint;
- filter: function(bsfc: PAVBitStreamFilterContext;
- avctx: PAVCodecContext; args: PByteArray;
- poutbuf: PPointer; poutbuf_size: PCint;
- buf: PByte; buf_size: cint; keyframe: cint): cint; 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: PAnsiChar): PAVBitStreamFilterContext;
- cdecl; external av__codec;
-
-function av_bitstream_filter_filter(bsfc: PAVBitStreamFilterContext;
- avctx: PAVCodecContext; args: PByteArray;
- poutbuf: PPointer; poutbuf_size: PCint;
- buf: PByte; buf_size: cint; keyframe: cint): cint;
- 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: PCuint; min_size: cuint);
- cdecl; external av__codec;
-
-{$IF LIBAVCODEC_VERSION >= 52025000} // >= 52.25.0
-(**
- * Allocates a buffer, reusing the given one if large enough.
- *
- * Contrary to av_fast_realloc the current buffer contents might not be
- * preserved and on error the old buffer is freed, thus no special
- * handling to avoid memleaks is necessary.
- *
- * @param ptr pointer to pointer to already allocated buffer, overwritten with pointer to new buffer
- * @param size size of the buffer *ptr points to
- * @param min_size minimum size of *ptr buffer after returning, *ptr will be NULL and
- * *size 0 if an error occurred.
- *)
-procedure av_fast_malloc(ptr: pointer; size: PCuint; min_size: cuint);
- cdecl; external av__codec;
-{$IFEND}
-
-{$IF LIBAVCODEC_VERSION < 51057000} // 51.57.0
-(* 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: cuint);
- cdecl; external av__codec; deprecated; {av_malloc_attrib av_alloc_size(1)}
-{$IFEND}
-
-{$IF LIBAVCODEC_VERSION < 51035000} // 51.35.0
-procedure av_realloc_static(ptr: pointer; size: cuint);
- cdecl; external av__codec;
-{$IFEND}
-
-{$IF LIBAVCODEC_VERSION >= 51039000} // 51.39.0
-(**
- * Copy image 'src' to 'dst'.
- *)
-procedure av_picture_copy(dst: PAVPicture;
- src: {const} PAVPicture;
-{$IF LIBAVCODEC_VERSION < 52022001} // 52.22.1
- pix_fmt: cint;
-{$ELSE}
- pix_fmt: TAVPixelFormat;
-{$IFEND}
- width: cint;
- height: cint);
- cdecl; external av__codec;
-
-(**
- * Crop image top and left side.
- *)
-function av_picture_crop(dst: PAVPicture;
- src: {const} PAVPicture;
-{$IF LIBAVCODEC_VERSION < 52022001} // 52.22.1
- pix_fmt: cint;
-{$ELSE}
- pix_fmt: TAVPixelFormat;
-{$IFEND}
- top_band: cint;
- left_band: cint): cint;
- cdecl; external av__codec;
-
-(**
- * Pad image.
- *)
-function av_picture_pad(dst: PAVPicture;
- src: {const} PAVPicture;
- height: cint;
- width: cint;
-{$IF LIBAVCODEC_VERSION < 52022001} // 52.22.1
- pix_fmt: cint;
-{$ELSE}
- pix_fmt: TAVPixelFormat;
-{$IFEND}
- padtop: cint;
- padbottom: cint;
- padleft: cint;
- padright:
- cint;
- color: PCint): cint;
- cdecl; external av__codec;
-{$IFEND}
-
-{$IF LIBAVCODEC_VERSION < 52000000} // 52.0.0
-(**
- * @deprecated Use the software scaler (swscale) instead.
- *)
-procedure img_copy(dst: PAVPicture; src: {const} PAVPicture;
- pix_fmt: TAVPixelFormat; width: cint; height: cint);
- cdecl; external av__codec; deprecated;
-
-(**
- * @deprecated Use the software scaler (swscale) instead.
- *)
-function img_crop(dst: PAVPicture; src: {const} PAVPicture;
- pix_fmt: TAVPixelFormat; top_band, left_band: cint): cint;
- cdecl; external av__codec; deprecated;
-
-(**
- * @deprecated Use the software scaler (swscale) instead.
- *)
-function img_pad(dst: PAVPicture; src: {const} PAVPicture; height, width: cint;
- pix_fmt: TAVPixelFormat; padtop, padbottom, padleft, padright: cint;
- color: PCint): cint;
- cdecl; external av__codec; deprecated;
-{$IFEND}
-
-function av_xiphlacing(s: PByte; v: cuint): cuint;
- cdecl; external av__codec;
-
-{$IF LIBAVCODEC_VERSION >= 51041000} // 51.41.0
-(**
- * Parses str and put in width_ptr and 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: PCint; height_ptr: PCint; str: {const} PAnsiChar): cint;
- cdecl; external av__codec;
-
-(**
- * Parses str and put in 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_num>/<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; str: {const} PAnsiChar): cint;
- cdecl; external av__codec;
-{$IFEND}
-
-{* error handling *}
-
-const
-{$IFDEF UNIX}
- ENOENT = ESysENOENT;
- EIO = ESysEIO;
- ENOMEM = ESysENOMEM;
- EINVAL = ESysEINVAL;
- EDOM = ESysEDOM;
- ENOSYS = ESysENOSYS;
- EILSEQ = ESysEILSEQ;
- EPIPE = ESysEPIPE;
-{$ELSE}
- ENOENT = 2;
- EIO = 5;
- ENOMEM = 12;
- EINVAL = 22;
- EPIPE = 32; // just an assumption. needs to be checked.
- 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. *)
-{$IF LIBAVCODEC_VERSION >= 52017000} // 52.17.0
- AVERROR_EOF = AVERROR_SIGN * EPIPE; (**< End of file. *)
-{$IFEND}
- // 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));
-
-{$IF LIBAVCODEC_VERSION >= 52032000} // >= 52.32.0
-(**
- * Logs a generic warning message about a missing feature. This function is
- * intended to be used internally by FFmpeg (libavcodec, libavformat, etc.)
- * only, and would normally not be used by applications.
- * @param[in] avc a pointer to an arbitrary struct of which the first field is
- * a pointer to an AVClass struct
- * @param[in] feature string containing the name of the missing feature
- * @param[in] want_sample indicates if samples are wanted which exhibit this feature.
- * If want_sample is non-zero, additional verbage will be added to the log
- * message which tells the user how to report samples to the development
- * mailing list.
- *)
-procedure av_log_missing_feature(avc: Pointer; feature: {const} Pchar; want_sample: cint);
- cdecl; external av__codec;
-
-(**
- * Logs a generic warning message asking for a sample. This function is
- * intended to be used internally by FFmpeg (libavcodec, libavformat, etc.)
- * only, and would normally not be used by applications.
- * @param[in] avc a pointer to an arbitrary struct of which the first field is
- * a pointer to an AVClass struct
- * @param[in] msg string containing an optional message, or NULL if no message
- *)
-procedure av_log_ask_for_sample(avc: Pointer; msg: {const} Pchar);
- cdecl; external av__codec;
-{$IFEND}
-
-{$IF LIBAVCODEC_VERSION >= 52018000} // 52.18.0
-(**
- * Registers the hardware accelerator hwaccel.
- *)
-procedure av_register_hwaccel (hwaccel: PAVHWAccel)
- cdecl; external av__codec;
-
-(**
- * If hwaccel is NULL, returns the first registered hardware accelerator,
- * if hwaccel is non-NULL, returns the next registered hardware accelerator
- * after hwaccel, or NULL if hwaccel is the last one.
- *)
-function av_hwaccel_next (hwaccel: PAVHWAccel): PAVHWAccel;
- cdecl; external av__codec;
-{$IFEND}
-
-{$IF LIBAVCODEC_VERSION >= 52030000} // 52.30.0
-(**
- * Lock operation used by lockmgr
- *)
-type
- TAVLockOp = (
- AV_LOCK_CREATE, ///< Create a mutex
- AV_LOCK_OBTAIN, ///< Lock the mutex
- AV_LOCK_RELEASE, ///< Unlock the mutex
- AV_LOCK_DESTROY ///< Free mutex resources
- );
-
-(**
- * Register a user provided lock manager supporting the operations
- * specified by AVLockOp. mutex points to a (void) where the
- * lockmgr should store/get a pointer to a user allocated mutex. It's
- * NULL upon AV_LOCK_CREATE and != NULL for all other ops.
- *
- * @param cb User defined callback. Note: FFmpeg may invoke calls to this
- * callback during the call to av_lockmgr_register().
- * Thus, the application must be prepared to handle that.
- * If cb is set to NULL the lockmgr will be unregistered.
- * Also note that during unregistration the previously registered
- * lockmgr callback may also be invoked.
- *)
-// ToDo: Implement and test this
-//function av_lockmgr_register(cb: function (mutex: pointer; op: TAVLockOp)): cint;
-// cdecl; external av__codec;
-{$IFEND}
-
-implementation
-
-{$IF (LIBAVCODEC_VERSION >= 52025000) and (LIBAVCODEC_VERSION <= 52027000)} // 52.25.0 - 52.27.0
-procedure av_free_packet(pkt: PAVPacket);{$IFDEF HASINLINE} inline; {$ENDIF}
-begin
- if assigned(pkt) then
- begin
- if assigned(pkt^.destruct) then
- pkt^.destruct(pkt);
- pkt^.data := NIL;
- pkt^.size := 0;
- end;
-end;
-{$IFEND}
-
-end.
diff --git a/src/lib/ffmpeg/avformat.pas b/src/lib/ffmpeg/avformat.pas
deleted file mode 100644
index 9c5170f5..00000000
--- a/src/lib/ffmpeg/avformat.pas
+++ /dev/null
@@ -1,1750 +0,0 @@
-(*
- * copyright (c) 2001 Fabrice Bellard
- *
- * FFmpeg 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.1 of the License, or (at your option) any later version.
- *
- * FFmpeg 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 FFmpeg; 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.
- * - Changes and updates by the UltraStar Deluxe Team
- *)
-
-(*
- * Conversion of libavformat/avformat.h
- * Min. version: 50.5.0 , revision 6577, Sat Oct 7 15:30:46 2006 UTC
- * Max. version: 52.25.0, revision 16986, Wed Feb 4 05:56:39 2009 UTC
- *)
-{
- * update to
- * Max. version: 52.41.0, Sun Dec 6 20:15:00 2009 CET
- * MiSchi
-}
-
-unit avformat;
-
-{$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}
-
-{$I switches.inc} (* for the HasInline define *)
-
-{$IFDEF DARWIN}
- {$linklib libavformat}
-{$ENDIF}
-
-interface
-
-uses
- ctypes,
- avcodec,
- avutil,
- avio,
- rational,
- SysUtils,
- UConfig;
-
-const
- (* Max. supported version by this header *)
- LIBAVFORMAT_MAX_VERSION_MAJOR = 52;
- LIBAVFORMAT_MAX_VERSION_MINOR = 41;
- LIBAVFORMAT_MAX_VERSION_RELEASE = 0;
- LIBAVFORMAT_MAX_VERSION = (LIBAVFORMAT_MAX_VERSION_MAJOR * VERSION_MAJOR) +
- (LIBAVFORMAT_MAX_VERSION_MINOR * VERSION_MINOR) +
- (LIBAVFORMAT_MAX_VERSION_RELEASE * VERSION_RELEASE);
-
- (* Min. supported version by this header *)
- LIBAVFORMAT_MIN_VERSION_MAJOR = 50;
- LIBAVFORMAT_MIN_VERSION_MINOR = 5;
- LIBAVFORMAT_MIN_VERSION_RELEASE = 0;
- LIBAVFORMAT_MIN_VERSION = (LIBAVFORMAT_MIN_VERSION_MAJOR * VERSION_MAJOR) +
- (LIBAVFORMAT_MIN_VERSION_MINOR * VERSION_MINOR) +
- (LIBAVFORMAT_MIN_VERSION_RELEASE * VERSION_RELEASE);
-
-(* Check if linked versions are supported *)
-{$IF (LIBAVFORMAT_VERSION < LIBAVFORMAT_MIN_VERSION)}
- {$MESSAGE Error 'Linked version of libavformat is too old!'}
-{$IFEND}
-
-(* Check if linked versions are supported *)
-{$IF (LIBAVFORMAT_VERSION > LIBAVFORMAT_MAX_VERSION)}
- {$MESSAGE Error 'Linked version of libavformat is not yet supported!'}
-{$IFEND}
-
-{$IF LIBAVFORMAT_VERSION >= 52020000} // 52.20.0
-(**
- * Returns the LIBAVFORMAT_VERSION_INT constant.
- *)
-function avformat_version(): cuint;
- cdecl; external av__format;
-{$IFEND}
-
-{$IF LIBAVFORMAT_VERSION >= 52039002} // 52.39.2
-(**
- * Returns the libavformat build-time configuration.
- *)
-function avformat_configuration(): {const} PansiChar;
- cdecl; external av__format;
-
-(**
- * Returns the libavformat license.
- *)
-function avformat_license(): {const} PansiChar;
- cdecl; external av__format;
-{$IFEND}
-
-type
- PAVFile = Pointer;
-
-(*
- * Public Metadata API.
- * The metadata API allows libavformat to export metadata tags to a client
- * application using a sequence of key/value pairs.
- * Important concepts to keep in mind:
- * 1. Keys are unique; there can never be 2 tags with the same key. This is
- * also meant semantically, i.e., a demuxer should not knowingly produce
- * several keys that are literally different but semantically identical.
- * E.g., key=Author5, key=Author6. In this example, all authors must be
- * placed in the same tag.
- * 2. Metadata is flat, not hierarchical; there are no subtags. If you
- * want to store, e.g., the email address of the child of producer Alice
- * and actor Bob, that could have key=alice_and_bobs_childs_email_address.
- * 3. A tag whose value is localized for a particular language is appended
- * with a dash character ('-') and the ISO 639-2/B 3-letter language code.
- * For example: Author-ger=Michael, Author-eng=Mike
- * The original/default language is in the unqualified "Author" tag.
- * A demuxer should set a default if it sets any translated tag.
- *)
-const
- AV_METADATA_MATCH_CASE = 1;
- AV_METADATA_IGNORE_SUFFIX = 2;
-
-type
- PAVMetadataTag = ^TAVMetadataTag;
- TAVMetadataTag = record
- key: PAnsiChar;
- value: PAnsiChar;
- end;
-
- PAVMetadata = Pointer;
-
-{$IF LIBAVFORMAT_VERSION > 52024001} // > 52.24.1
-(**
- * Gets a metadata element with matching key.
- * @param prev Set to the previous matching element to find the next.
- * @param flags Allows case as well as suffix-insensitive comparisons.
- * @return Found tag or NULL, changing key or value leads to undefined behavior.
- *)
-function av_metadata_get(m: PAVMetadata; key: {const} PAnsiChar;
- prev: {const} PAVMetadataTag ; flags: cint): PAVMetadataTag;
- cdecl; external av__format;
-
-(**
- * Sets the given tag in m, overwriting an existing tag.
- * @param key tag key to add to m (will be av_strduped)
- * @param value tag value to add to m (will be av_strduped)
- * @return >= 0 on success otherwise an error code <0
- *)
-function av_metadata_set(var pm: PAVMetadata; key: {const} PAnsiChar; value: {const} PAnsiChar): cint;
- cdecl; external av__format;
-
-(**
- * Frees all the memory allocated for an AVMetadata struct.
- *)
-procedure av_metadata_free(var m: PAVMetadata);
- cdecl; external av__format;
-{$IFEND}
-
-(* packet functions *)
-
-{$IF LIBAVCODEC_VERSION < 52032000} // < 52.32.0
-type
- PAVPacket = ^TAVPacket;
- TAVPacket = record
- (**
- * Presentation timestamp in time_base units; the time at which the
- * decompressed packet will be presented to the user.
- * Can be AV_NOPTS_VALUE if it is not stored in the file.
- * pts MUST be larger or equal to dts as presentation can not happen before
- * decompression, unless one wants to view hex dumps. Some formats misuse
- * the terms dts and pts/cts to mean something different. Such timestamps
- * must be converted to true pts/dts before they are stored in AVPacket.
- *)
- pts: cint64;
- (**
- * Decompression timestamp in time_base units; the time at which the
- * packet is decompressed.
- * Can be AV_NOPTS_VALUE if it is not stored in the file.
- *)
- dts: cint64;
- data: PByteArray;
- size: cint;
- stream_index: cint;
- flags: cint;
- (**
- * Duration of this packet in time_base units, 0 if unknown.
- * Equals next_pts - this_pts in presentation order.
- *)
- duration: cint;
- destruct: procedure (p: PAVPacket); cdecl;
- priv: pointer;
- pos: cint64; ///< byte position in stream, -1 if unknown
-
- {$IF LIBAVFORMAT_VERSION >= 52022000} // 52.22.0
- (**
- * Time difference in stream time base units from the pts of this
- * packet to the point at which the output from the decoder has converged
- * independent from the availability of previous frames. That is, the
- * frames are virtually identical no matter if decoding started from
- * the very first frame or from this keyframe.
- * Is AV_NOPTS_VALUE if unknown.
- * This field is not the display duration of the current packet.
- *
- * The purpose of this field is to allow seeking in streams that have no
- * keyframes in the conventional sense. It corresponds to the
- * recovery point SEI in H.264 and match_time_delta in NUT. It is also
- * essential for some types of subtitle streams to ensure that all
- * subtitles are correctly displayed after seeking.
- *)
- convergence_duration: cint64;
- {$IFEND}
- end;
-
-const
- PKT_FLAG_KEY = $0001;
-
-procedure av_destruct_packet_nofree(var pkt: TAVPacket);
- cdecl; external av__format;
-
-(**
- * Default packet destructor.
- *)
-procedure av_destruct_packet(var pkt: TAVPacket);
- cdecl; external av__format;
-
-(**
- * Initialize optional fields of a packet with default values.
- *
- * @param pkt packet
- *)
-procedure av_init_packet(var pkt: TAVPacket);
-{$IF LIBAVFORMAT_VERSION >= 51012002} // 51.12.2
- cdecl; external av__format;
-{$IFEND}
-
-(**
- * Allocate the payload of a packet and initialize its fields with
- * default values.
- *
- * @param pkt packet
- * @param size wanted payload size
- * @return 0 if OK, AVERROR_xxx otherwise
- *)
-function av_new_packet(var pkt: TAVPacket; size: cint): cint;
- cdecl; external av__format;
-{$IFEND}
-
-(**
- * Allocate and read the payload of a packet and initialize its fields with
- * default values.
- *
- * @param pkt packet
- * @param size desired payload size
- * @return >0 (read size) if OK, AVERROR_xxx otherwise
- *)
-function av_get_packet(s: PByteIOContext; var pkt: TAVPacket; size: cint): cint;
- cdecl; external av__format;
-
-{$IF LIBAVCODEC_VERSION < 52032000} // < 52.32.0
-(**
- * @warning This is a hack - the packet memory allocation stuff is broken. The
- * packet is allocated if it was not really allocated.
- *)
-function av_dup_packet(pkt: PAVPacket): cint;
- cdecl; external av__format;
-
-(**
- * Free a packet.
- *
- * @param pkt packet to free
- *)
-procedure av_free_packet(pkt: PAVPacket); {$IFDEF HasInline}inline;{$ENDIF}
-{$IFEND}
-
-(*************************************************)
-(* fractional numbers for exact pts handling *)
-
-type
- (**
- * The exact value of the fractional number is: 'val + num / den'.
- * num is assumed to be 0 <= num < den.
- *)
- PAVFrac = ^TAVFrac;
- TAVFrac = record
- val, num, den: cint64;
- end;
-
-(*************************************************)
-(* input/output formats *)
-
-type
- (** This structure contains the data a format has to probe a file. *)
- TAVProbeData = record
- filename: PAnsiChar;
- buf: PByteArray; (**< Buffer must have AVPROBE_PADDING_SIZE of extra allocated bytes filled with zero. *)
- buf_size: cint; (**< Size of buf except extra allocated bytes *)
- end;
-
-const
- AVPROBE_SCORE_MAX = 100; ///< Maximum score, half of that is used for file-extension-based detection
- AVPROBE_PADDING_SIZE = 32; ///< extra allocated bytes at the end of the probe buffer
-
- //! Demuxer will use url_fopen, no opened file should be provided by the caller.
- AVFMT_NOFILE = $0001;
- AVFMT_NEEDNUMBER = $0002; (**< Needs '%d' in filename. *)
- AVFMT_SHOW_IDS = $0008; (**< Show format stream IDs numbers. *)
- AVFMT_RAWPICTURE = $0020; (**< Format wants AVPicture structure for
- raw picture data. *)
- AVFMT_GLOBALHEADER = $0040; (**< Format wants global header. *)
- AVFMT_NOTIMESTAMPS = $0080; (**< Format does not need / have any timestamps. *)
- AVFMT_GENERIC_INDEX = $0100; (**< Use generic index building code. *)
- AVFMT_TS_DISCONT = $0200; (**< Format allows timestamp discontinuities. *)
- {$IF LIBAVFORMAT_VERSION >= 52029002} // 52.29.2
- AVFMT_VARIABLE_FPS = $0400; (**< Format allows variable fps. *)
- {$IFEND}
-
- // used by AVIndexEntry
- AVINDEX_KEYFRAME = $0001;
-
- AVFMTCTX_NOHEADER = $0001; (**< signal that no header is present
- (streams are added dynamically) *)
- MAX_STREAMS = 20;
-
- AVFMT_NOOUTPUTLOOP = -1;
- AVFMT_INFINITEOUTPUTLOOP = 0;
- AVFMT_FLAG_GENPTS = $0001; ///< Generate missing pts even if it requires parsing future frames.
- AVFMT_FLAG_IGNIDX = $0002; ///< Ignore index.
- AVFMT_FLAG_NONBLOCK = $0004; ///< Do not block when reading packets from input.
-
- // used by AVStream
- MAX_REORDER_DELAY = 16;
-
- // used by TAVProgram
- AV_PROGRAM_RUNNING = 1;
-
-
- AV_DISPOSITION_DEFAULT = $0001;
- AV_DISPOSITION_DUB = $0002;
- AV_DISPOSITION_ORIGINAL = $0004;
- AV_DISPOSITION_COMMENT = $0008;
- AV_DISPOSITION_LYRICS = $0010;
- AV_DISPOSITION_KARAOKE = $0020;
-
- // used by TAVFormatContext.debug
- FF_FDEBUG_TS = 0001;
-
- {$IF LIBAVFORMAT_VERSION >= 52034000} // >= 52.34.0
- {$IF LIBAVFORMAT_VERSION < 52039000} // < 52.39.0
- MAX_PROBE_PACKETS = 100;
- {$ELSE}
- MAX_PROBE_PACKETS = 2500;
- {$IFEND}
- {$IFEND}
-
- {$IF LIBAVFORMAT_VERSION >= 52035000} // >= 52.35.0
- {$IF LIBAVFORMAT_VERSION < 52039000} // < 52.39.0
- RAW_PACKET_BUFFER_SIZE = 32000;
- {$ELSE}
- RAW_PACKET_BUFFER_SIZE = 2500000;
- {$IFEND}
- {$IFEND}
-
-type
- PPAVCodecTag = ^PAVCodecTag;
- PAVCodecTag = Pointer;
-
- PPAVFormatContext = ^PAVFormatContext;
- PAVFormatContext = ^TAVFormatContext;
-
- PAVFormatParameters = ^TAVFormatParameters;
-
- PAVOutputFormat = ^TAVOutputFormat;
- PAVProbeData = ^TAVProbeData;
-
- PAVInputFormat = ^TAVInputFormat;
- PAVIndexEntry = ^TAVIndexEntry;
-
- PAVStream = ^TAVStream;
- PAVPacketList = ^TAVPacketList;
-
- PPAVProgram = ^PAVProgram;
- PAVProgram = ^TAVProgram;
-
- {$IF LIBAVFORMAT_VERSION < 51006000} // 51.6.0
- PAVImageFormat = ^TAVImageFormat;
- PAVImageInfo = ^TAVImageInfo;
- {$IFEND}
-
-{$IF LIBAVFORMAT_VERSION >= 52030001} // >= 52.30.1
-(**
- * Convert all the metadata sets from ctx according to the source and
- * destination conversion tables.
- * @param d_conv destination tags format conversion table
- * @param s_conv source tags format conversion table
- *)
- PAVMetadataConv = ^TAVMetadataConv;
- TAVMetadataConv = record
- ctx: PAVFormatContext;
- d_conv: {const} PAVMetadataConv;
- s_conv: {const} PAVMetadataConv;
- end;
-{$IFEND}
-
- PAVChapter = ^TAVChapter;
- TAVChapter = record
- id: cint; ///< unique ID to identify the chapter
- time_base: TAVRational; ///< time base in which the start/end timestamps are specified
- start, end_: cint64; ///< chapter start/end time in time_base units
- {$IF LIBAVFORMAT_VERSION < 53000000} // 53.00.0
- title: PAnsiChar; ///< chapter title
- {$IFEND}
- {$IF LIBAVFORMAT_VERSION >= 52024001} // 52.24.1
- metadata: PAVMetadata;
- {$IFEND}
- end;
- TAVChapterArray = array[0..(MaxInt div SizeOf(TAVChapter))-1] of TAVChapter;
- PAVChapterArray = ^TAVChapterArray;
-
- TAVFormatParameters = record
- time_base: TAVRational;
- sample_rate: cint;
- channels: cint;
- width: cint;
- height: cint;
- pix_fmt: TAVPixelFormat;
- {$IF LIBAVFORMAT_VERSION < 51006000} // 51.6.0
- image_format: PAVImageFormat;
- {$IFEND}
- channel: cint; (**< Used to select DV channel. *)
- {$IF LIBAVFORMAT_VERSION_MAJOR < 52}
- device: PAnsiChar; (* video, audio or DV device, if LIBAVFORMAT_VERSION_INT < (52<<16) *)
- {$IFEND}
- standard: PAnsiChar; (**< TV standard, NTSC, PAL, SECAM *)
- { Delphi does not support bit fields -> use bf_flags instead
- unsigned int mpeg2ts_raw:1; (**< Force raw MPEG-2 transport stream output, if possible. *)
- unsigned int mpeg2ts_compute_pcr:1; (**< Compute exact PCR for each transport
- stream packet (only meaningful if
- mpeg2ts_raw is TRUE). *)
- unsigned int initial_pause:1; (**< Do not begin to play the stream
- immediately (RTSP only). *)
- unsigned int prealloced_context:1;
- }
- bf_flags: byte; // 0:mpeg2ts_raw/1:mpeg2ts_compute_pcr/2:initial_pause/3:prealloced_context
- {$IF LIBAVFORMAT_VERSION_MAJOR < 53}
- video_codec_id: TCodecID;
- audio_codec_id: TCodecID;
- {$IFEND}
- end;
-
- TAVOutputFormat = record
- name: PAnsiChar;
- (**
- * Descriptive name for the format, meant to be more human-readable
- * than name. You should use the NULL_IF_CONFIG_SMALL() macro
- * to define it.
- *)
- long_name: PAnsiChar;
- mime_type: PAnsiChar;
- extensions: PAnsiChar; (**< comma-separated filename extensions *)
- (** size of private data so that it can be allocated in the wrapper *)
- priv_data_size: cint;
- (* output support *)
- audio_codec: TCodecID; (**< default audio codec *)
- video_codec: TCodecID; (**< default video codec *)
- write_header: function (c: PAVFormatContext): cint; cdecl;
- write_packet: function (c: PAVFormatContext; pkt: PAVPacket): cint; cdecl;
- write_trailer: function (c: PAVFormatContext): cint; cdecl;
- (** can use flags: AVFMT_NOFILE, AVFMT_NEEDNUMBER, AVFMT_GLOBALHEADER *)
- flags: cint;
- (** Currently only used to set pixel format if not YUV420P. *)
- set_parameters: function (c: PAVFormatContext; f: PAVFormatParameters): cint; cdecl;
- interleave_packet: function (s: PAVFormatContext; out_: PAVPacket;
- in_: PAVPacket; flush: cint): cint; cdecl;
-
- {$IF LIBAVFORMAT_VERSION >= 51008000} // 51.8.0
- (**
- * List of supported codec_id-codec_tag pairs, ordered by "better
- * choice first". The arrays are all terminated by CODEC_ID_NONE.
- *)
- codec_tag: {const} PPAVCodecTag;
- {$IFEND}
-
- {$IF LIBAVFORMAT_VERSION >= 51012002} // 51.12.2
- subtitle_codec: TCodecID; (**< default subtitle codec *)
- {$IFEND}
-
- {$IF LIBAVFORMAT_VERSION >= 52030001} // 52.30.1
- {const} metadata_conv: PAVMetadataConv;
- {$IFEND}
-
- (* private fields *)
- next: PAVOutputFormat;
- end;
-
- TAVInputFormat = record
- name: PAnsiChar;
- (**
- * Descriptive name for the format, meant to be more human-readable
- * than name. You should use the NULL_IF_CONFIG_SMALL() macro
- * to define it.
- *)
- long_name: PAnsiChar;
- (** Size of private data so that it can be allocated in the wrapper. *)
- priv_data_size: cint;
- (**
- * Tell if a given file has a chance of being parsed as this format.
- * The buffer provided is guaranteed to be AVPROBE_PADDING_SIZE bytes
- * big so you do not have to check for that unless you need more.
- *)
- read_probe: function (p: PAVProbeData): cint; cdecl;
- (** Read the format header and initialize the AVFormatContext
- structure. Return 0 if OK. 'ap' if non-NULL contains
- additional parameters. Only used in raw format right
- now. 'av_new_stream' should be called to create new streams. *)
- read_header: function (c: PAVFormatContext; ap: PAVFormatParameters): cint; cdecl;
- (** Read one packet and put it in 'pkt'. pts and flags are also
- set. 'av_new_stream' can be called only if the flag
- AVFMTCTX_NOHEADER is used.
- @return 0 on success, < 0 on error.
- When returning an error, pkt must not have been allocated
- or must be freed before returning *)
- read_packet: function (c: PAVFormatContext; var pkt: TAVPacket): cint; cdecl;
- (** Close the stream. The AVFormatContext and AVStreams are not
- freed by this function *)
- read_close: function (c: PAVFormatContext): cint; cdecl;
-
-{$IF LIBAVFORMAT_VERSION_MAJOR < 53}
- (**
- * Seek to a given timestamp relative to the frames in
- * stream component stream_index.
- * @param stream_index Must not be -1.
- * @param flags Selects which direction should be preferred if no exact
- * match is available.
- * @return >= 0 on success (but not necessarily the new offset)
- *)
- read_seek: function (c: PAVFormatContext; stream_index: cint;
- timestamp: cint64; flags: cint): cint; cdecl;
-{$IFEND}
-
- (**
- * Gets the next timestamp in stream[stream_index].time_base units.
- * @return the timestamp or AV_NOPTS_VALUE if an error occurred
- *)
- read_timestamp: function (s: PAVFormatContext; stream_index: cint;
- pos: pint64; pos_limit: cint64): cint64; cdecl;
- (** Can use flags: AVFMT_NOFILE, AVFMT_NEEDNUMBER. *)
- flags: cint;
- (** If extensions are defined, then no probe is done. You should
- usually not use extension format guessing because it is not
- reliable enough *)
- extensions: PAnsiChar;
- (** General purpose read-only value that the format can use. *)
- value: cint;
-
- (** Starts/resumes playing - only meaningful if using a network-based format
- (RTSP). *)
- read_play: function (c: PAVFormatContext): cint; cdecl;
-
- (** Pauses playing - only meaningful if using a network-based format
- (RTSP). *)
- read_pause: function (c: PAVFormatContext): cint; cdecl;
-
- {$IF LIBAVFORMAT_VERSION >= 51008000} // 51.8.0
- codec_tag: {const} PPAVCodecTag;
- {$IFEND}
-
- {$IF LIBAVFORMAT_VERSION >= 52030000} // 52.30.0
- (**
- * Seeks to timestamp ts.
- * Seeking will be done so that the point from which all active streams
- * can be presented successfully will be closest to ts and within min/max_ts.
- * Active streams are all streams that have AVStream.discard < AVDISCARD_ALL.
- *)
- read_seek2: function (s: PAVFormatContext;
- stream_index: cint;
- min_ts: cint64;
- ts: cint64;
- max_ts: cint64;
- flags: cint): cint; cdecl;
- {$IFEND}
-
- {$IF LIBAVFORMAT_VERSION >= 52030001} // 52.30.1
- {const} metadata_conv: PAVMetadataConv;
- {$IFEND}
-
- (* private fields *)
- next: PAVInputFormat;
- end;
-
- TAVStreamParseType = (
- AVSTREAM_PARSE_NONE,
- AVSTREAM_PARSE_FULL, (**< full parsing and repack *)
- AVSTREAM_PARSE_HEADERS, (**< Only parse headers, do not repack. *)
- AVSTREAM_PARSE_TIMESTAMPS (**< full parsing and interpolation of timestamps for frames not starting on a packet boundary *)
- );
-
- TAVIndexEntry = record
- pos: cint64;
- timestamp: cint64;
- { Delphi doesn't support bitfields -> use flags_size instead
- int flags:2;
- int size:30; //Yeah, trying to keep the size of this small to reduce memory requirements (it is 24 vs. 32 bytes due to possible 8-byte alignment).
- }
- flags_size: cint; // 0..1: flags, 2..31: size
- min_distance: cint; (**< Minimum distance between this and the previous keyframe, used to avoid unneeded searching. *)
- end;
-
- (**
- * Stream 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(AVStream) must not be used outside libav*.
- *)
- TAVStream = record
- index: cint; (**< stream index in AVFormatContext *)
- id: cint; (**< format-specific stream ID *)
- codec: PAVCodecContext; (**< codec context *)
- (**
- * Real base framerate of the stream.
- * This is the lowest framerate with which all timestamps can be
- * represented accurately (it is the least common multiple of all
- * framerates in the stream). Note, this value is just a guess!
- * For example, if the time base is 1/90000 and all frames have either
- * approximately 3600 or 1800 timer ticks, then r_frame_rate will be 50/1.
- *)
- r_frame_rate: TAVRational;
- priv_data: pointer;
-
- (* internal data used in av_find_stream_info() *)
- first_dts: cint64;
- {$IF LIBAVFORMAT_VERSION_MAJOR < 52}
- codec_info_nb_frames: cint;
- {$IFEND}
-
- (** encoding: pts generation when outputting stream *)
- pts: TAVFrac;
- (**
- * This is the fundamental unit of time (in seconds) in terms
- * of which frame timestamps are represented. For fixed-fps content,
- * time base should be 1/framerate and timestamp increments should be 1.
- *)
- time_base: TAVRational;
- pts_wrap_bits: cint; (* number of bits in pts (used for wrapping control) *)
- (* ffmpeg.c private use *)
- stream_copy: cint; (**< If set, just copy stream. *)
- discard: TAVDiscard; ///< Selects which packets can be discarded at will and do not need to be demuxed.
- //FIXME move stuff to a flags field?
- (** Quality, as it has been removed from AVCodecContext and put in AVVideoFrame.
- * MN:dunno if thats the right place, for it *)
- quality: cfloat;
- (**
- * Decoding: pts of the first frame of the stream, in stream time base.
- * Only set this if you are absolutely 100% sure that the value you set
- * it to really is the pts of the first frame.
- * This may be undefined (AV_NOPTS_VALUE).
- * @note The ASF header does NOT contain a correct start_time the ASF
- * demuxer must NOT set this.
- *)
- start_time: cint64;
- (**
- * Decoding: duration of the stream, in stream time base.
- * If a source file does not specify a duration, but does specify
- * a bitrate, this value will be estimated from bitrate and file size.
- *)
- duration: cint64;
-
- {$IF LIBAVFORMAT_VERSION_MAJOR < 53}
- language: array [0..3] of PAnsiChar; (* ISO 639-2/B 3-letter language code (empty string if undefined) *)
- {$IFEND}
-
- (* av_read_frame() support *)
- need_parsing: TAVStreamParseType;
- parser: PAVCodecParserContext;
-
- cur_dts: cint64;
- last_IP_duration: cint;
- last_IP_pts: cint64;
- (* av_seek_frame() support *)
- index_entries: PAVIndexEntry; (**< Only used if the format does not
- support seeking natively. *)
- nb_index_entries: cint;
- index_entries_allocated_size: cuint;
-
- nb_frames: cint64; ///< number of frames in this stream if known or 0
-
- {$IF (LIBAVFORMAT_VERSION >= 50006000) and (LIBAVFORMAT_VERSION_MAJOR < 53)} // 50.6.0 - 53.0.0
- unused: array [0..4] of cint64;
- {$IFEND}
-
- {$IF (LIBAVFORMAT_VERSION >= 52006000) and (LIBAVFORMAT_VERSION_MAJOR < 53)} // 52.6.0 - 53.0.0
- filename: PAnsiChar; (**< source filename of the stream *)
- {$IFEND}
-
- {$IF LIBAVFORMAT_VERSION >= 52008000} // 52.8.0
- disposition: cint; (**< AV_DISPOSITION_* bitfield *)
- {$IFEND}
-
- {$IF LIBAVFORMAT_VERSION >= 52019000} // 52.19.0
- probe_data: TAVProbeData;
- {$IFEND}
-
- {$IF LIBAVFORMAT_VERSION >= 52021000} // 52.21.0
- pts_buffer: array [0..MAX_REORDER_DELAY] of cint64;
-
- (**
- * sample aspect ratio (0 if unknown)
- * - encoding: Set by user.
- * - decoding: Set by libavformat.
- *)
- sample_aspect_ratio: TAVRational;
- {$IFEND}
-
- {$IF LIBAVFORMAT_VERSION >= 52024001} // 52.24.1
- metadata: PAVMetadata;
- {$IFEND}
-
- {$IF LIBAVFORMAT_VERSION > 52024001} // > 52.24.1
- {* av_read_frame() support *}
- cur_ptr: {const} PCuint8;
- cur_len: cint;
- cur_pkt: TAVPacket;
- {$IFEND}
-
- {$IF LIBAVFORMAT_VERSION >= 52030000} // > 52.30.0
- // Timestamp generation support:
- (**
- * Timestamp corresponding to the last dts sync point.
- *
- * Initialized when AVCodecParserContext.dts_sync_point >= 0 and
- * a DTS is received from the underlying container. Otherwise set to
- * AV_NOPTS_VALUE by default.
- *)
- reference_dts: cint64;
- {$IFEND}
- {$IF LIBAVFORMAT_VERSION >= 52034000} // >= 52.34.0
- (**
- * Number of packets to buffer for codec probing
- * NOT PART OF PUBLIC API
- *)
- probe_packets: cint;
- {$IFEND}
- {$IF LIBAVFORMAT_VERSION >= 52038000} // >= 52.38.0
- (**
- * last packet in packet_buffer for this stream when muxing.
- * used internally, NOT PART OF PUBLIC API, dont read or write from outside of libav*
- *)
- last_in_packet_buffer: PAVPacketList;
- {$IFEND}
- end;
-
- (**
- * Format I/O context.
- * 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(AVFormatContext) must not be used outside libav*.
- *)
- TAVFormatContext = record
- av_class: PAVClass; (**< Set by avformat_alloc_context. *)
- (* Can only be iformat or oformat, not both at the same time. *)
- iformat: PAVInputFormat;
- oformat: PAVOutputFormat;
- priv_data: pointer;
-
- {$IF LIBAVFORMAT_VERSION_MAJOR >= 52}
- pb: PByteIOContext;
- {$ELSE}
- pb: TByteIOContext;
- {$IFEND}
-
- nb_streams: cuint;
- streams: array [0..MAX_STREAMS - 1] of PAVStream;
- filename: array [0..1023] of AnsiChar; (* input or output filename *)
- (* stream info *)
- timestamp: cint64;
- {$IF LIBAVFORMAT_VERSION < 53000000} // 53.00.0
- title: array [0..511] of AnsiChar;
- author: array [0..511] of AnsiChar;
- copyright: array [0..511] of AnsiChar;
- comment: array [0..511] of AnsiChar;
- album: array [0..511] of AnsiChar;
- year: cint; (**< ID3 year, 0 if none *)
- track: cint; (**< track number, 0 if none *)
- genre: array [0..31] of AnsiChar; (**< ID3 genre *)
- {$IFEND}
-
- ctx_flags: cint; (**< Format-specific flags, see AVFMTCTX_xx *)
- (* private data for pts handling (do not modify directly). *)
- (** This buffer is only needed when packets were already buffered but
- not decoded, for example to get the codec parameters in MPEG
- streams. *)
- packet_buffer: PAVPacketList;
-
- (** Decoding: position of the first frame of the component, in
- AV_TIME_BASE fractional seconds. NEVER set this value directly:
- It is deduced from the AVStream values. *)
- start_time: cint64;
- (** Decoding: duration of the stream, in AV_TIME_BASE fractional
- seconds. NEVER set this value directly: it is deduced from the
- AVStream values. *)
- duration: cint64;
- (** decoding: total file size, 0 if unknown *)
- file_size: cint64;
- (** Decoding: total stream bitrate in bit/s, 0 if not
- available. Never set it directly if the file_size and the
- duration are known as ffmpeg can compute it automatically. *)
- bit_rate: cint;
-
- (* av_read_frame() support *)
- cur_st: PAVStream;
- {$IF LIBAVFORMAT_VERSION_MAJOR < 53}
- cur_ptr_deprecated: pbyte;
- cur_len_deprecated: cint;
- cur_pkt_deprecated: TAVPacket;
- {$IFEND}
-
- (* av_seek_frame() support *)
- data_offset: cint64; (* offset of the first packet *)
- index_built: cint;
-
- mux_rate: cint;
- {$IF LIBAVFORMAT_VERSION < 52034001} // < 52.34.1
- packet_size: cint;
- {$ELSE}
- packet_size: cuint;
- {$IFEND}
- preload: cint;
- max_delay: cint;
-
- (* number of times to loop output in formats that support it *)
- loop_output: cint;
-
- flags: cint;
- loop_input: cint;
-
- {$IF LIBAVFORMAT_VERSION >= 50006000} // 50.6.0
- (** decoding: size of data to probe; encoding: unused. *)
- probesize: cuint;
- {$IFEND}
-
- {$IF LIBAVFORMAT_VERSION >= 51009000} // 51.9.0
- (**
- * Maximum time (in AV_TIME_BASE units) during which the input should
- * be analyzed in av_find_stream_info().
- *)
- max_analyze_duration: cint;
-
- key: pbyte;
- keylen : cint;
- {$IFEND}
-
- {$IF LIBAVFORMAT_VERSION >= 51014000} // 51.14.0
- nb_programs: cuint;
- programs: PPAVProgram;
- {$IFEND}
-
- {$IF LIBAVFORMAT_VERSION >= 52003000} // 52.3.0
- (**
- * Forced video codec_id.
- * Demuxing: Set by user.
- *)
- video_codec_id: TCodecID;
- (**
- * Forced audio codec_id.
- * Demuxing: Set by user.
- *)
- audio_codec_id: TCodecID;
- (**
- * Forced subtitle codec_id.
- * Demuxing: Set by user.
- *)
- subtitle_codec_id: TCodecID;
- {$IFEND}
-
- {$IF LIBAVFORMAT_VERSION >= 52004000} // 52.4.0
- (**
- * Maximum amount of memory in bytes to use for the index of each stream.
- * If the index exceeds this size, entries will be discarded as
- * needed to maintain a smaller size. This can lead to slower or less
- * accurate seeking (depends on demuxer).
- * Demuxers for which a full in-memory index is mandatory will ignore
- * this.
- * muxing : unused
- * demuxing: set by user
- *)
- max_index_size: cuint;
- {$IFEND}
-
- {$IF LIBAVFORMAT_VERSION >= 52009000} // 52.9.0
- (**
- * Maximum amount of memory in bytes to use for buffering frames
- * obtained from realtime capture devices.
- *)
- max_picture_buffer: cuint;
- {$IFEND}
-
- {$IF LIBAVFORMAT_VERSION >= 52014000} // 52.14.0
- nb_chapters: cuint;
- chapters: PAVChapterArray;
- {$IFEND}
-
- {$IF LIBAVFORMAT_VERSION >= 52016000} // 52.16.0
- (**
- * Flags to enable debugging.
- *)
- debug: cint;
- {$IFEND}
-
- {$IF LIBAVFORMAT_VERSION >= 52019000} // 52.19.0
- (**
- * Raw packets from the demuxer, prior to parsing and decoding.
- * This buffer is used for buffering packets until the codec can
- * be identified, as parsing cannot be done without knowing the
- * codec.
- *)
- raw_packet_buffer: PAVPacketList;
- raw_packet_buffer_end: PAVPacketList;
-
- packet_buffer_end: PAVPacketList;
- {$IFEND}
-
- {$IF LIBAVFORMAT_VERSION >= 52024001} // 52.24.1
- metadata: PAVMetadata;
- {$IFEND}
-
- {$IF LIBAVFORMAT_VERSION >= 52035000} // 52.35.0
- (**
- * Remaining size available for raw_packet_buffer, in bytes.
- * NOT PART OF PUBLIC API
- *)
- raw_packet_buffer_remaining_size: cint;
- {$IFEND}
-
- end;
-
- (**
- * 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(AVProgram) must not be used outside libav*.
- *)
- TAVProgram = record
- id : cint;
- {$IF LIBAVFORMAT_VERSION < 53000000} // 53.00.0
- provider_name : PAnsiChar; ///< network name for DVB streams
- name : PAnsiChar; ///< service name for DVB streams
- {$IFEND}
- flags : cint;
- discard : TAVDiscard; ///< selects which program to discard and which to feed to the caller
- {$IF LIBAVFORMAT_VERSION >= 51016000} // 51.16.0
- stream_index : PCardinal;
- nb_stream_indexes : PCardinal;
- {$IFEND}
- {$IF LIBAVFORMAT_VERSION >= 52024001} // 52.24.1
- metadata: PAVMetadata;
- {$IFEND}
- end;
-
- TAVPacketList = record
- pkt: TAVPacket;
- next: PAVPacketList;
- end;
-
-{$IF LIBAVFORMAT_VERSION < 51006000} // 51.6.0
- (* still image support *)
- PAVInputImageContext = pointer; {deprecated}
-
- (* still image support *)
- TAVImageInfo = record
- pix_fmt: TAVPixelFormat; (* requested pixel format *)
- width: cint; (* requested width *)
- height: cint; (* requested height *)
- interleaved: cint; (* image is interleaved (e.g. interleaved GIF) *)
- pict: TAVPicture; (* returned allocated image *)
- end; {deprecated}
-
- TAVImageFormat = record
- name: PAnsiChar;
- extensions: PAnsiChar;
- (* tell if a given file has a chance of being parsing by this format *)
- img_probe: function (d: PAVProbeData): cint; cdecl;
- (* read a whole image. 'alloc_cb' is called when the image size is
- known so that the caller can allocate the image. If 'allo_cb'
- returns non zero, then the parsing is aborted. Return '0' if
- OK. *)
- img_read: function (b: PByteIOContext; alloc_cb: pointer; ptr: pointer): cint; cdecl;
- (* write the image *)
- supported_pixel_formats: cint; (* mask of supported formats for output *)
- img_write: function (b: PByteIOContext; i: PAVImageInfo): cint; cdecl;
- flags: cint;
- next: PAVImageFormat;
- end; {deprecated}
-
-procedure av_register_image_format(img_fmt: PAVImageFormat);
- cdecl; external av__format; deprecated;
-
-function av_probe_image_format(pd: PAVProbeData): PAVImageFormat;
- cdecl; external av__format; deprecated;
-
-function guess_image_format(filename: PAnsiChar): PAVImageFormat;
- cdecl; external av__format; deprecated;
-
-function av_read_image(pb: PByteIOContext; filename: PAnsiChar;
- fmt: PAVImageFormat;
- alloc_cb: pointer; opaque: pointer): cint;
- cdecl; external av__format; deprecated;
-
-function av_write_image(pb: PByteIOContext; fmt: PAVImageFormat; img: PAVImageInfo): cint;
- cdecl; external av__format; deprecated;
-{$IFEND}
-
-{$IF LIBAVFORMAT_VERSION_MAJOR < 53}
-{
-var
- first_iformat: PAVInputFormat; external av__format;
- first_oformat: PAVOutputFormat; external av__format;
-}
-{$IFEND}
-
-{$IF LIBAVFORMAT_VERSION >= 52003000} // 52.3.0
-(**
- * If f is NULL, returns the first registered input format,
- * if f is non-NULL, returns the next registered input format after f
- * or NULL if f is the last one.
- *)
-function av_iformat_next(f: PAVInputFormat): PAVInputFormat;
- cdecl; external av__format;
-(**
- * If f is NULL, returns the first registered output format,
- * if f is non-NULL, returns the next registered input format after f
- * or NULL if f is the last one.
- *)
-function av_oformat_next(f: PAVOutputFormat): PAVOutputFormat;
- cdecl; external av__format;
-{$IFEND}
-
-function av_guess_image2_codec(filename: {const} PAnsiChar): TCodecID;
- cdecl; external av__format;
-
-(* XXX: Use automatic init with either ELF sections or C file parser *)
-(* modules. *)
-
-(* utils.c *)
-procedure av_register_input_format(format: PAVInputFormat);
- cdecl; external av__format;
-
-procedure av_register_output_format(format: PAVOutputFormat);
- cdecl; external av__format;
-
-function guess_stream_format(short_name: PAnsiChar;
- filename: PAnsiChar;
- mime_type: PAnsiChar): PAVOutputFormat;
- cdecl; external av__format;
-
-function guess_format(short_name: PAnsiChar;
- filename: PAnsiChar;
- mime_type: PAnsiChar): PAVOutputFormat;
- cdecl; external av__format;
-
-(**
- * Guesses the codec ID based upon muxer and filename.
- *)
-function av_guess_codec(fmt: PAVOutputFormat; short_name: PAnsiChar;
- filename: PAnsiChar; mime_type: PAnsiChar;
- type_: TCodecType): TCodecID;
- cdecl; external av__format;
-
-(**
- * Sends a nice hexadecimal dump of a buffer to the specified file stream.
- *
- * @param f The file stream pointer where the dump should be sent to.
- * @param buf buffer
- * @param size buffer size
- *
- * @see av_hex_dump_log, av_pkt_dump, av_pkt_dump_log
- *)
-procedure av_hex_dump(f: PAVFile; buf: PByteArray; size: cint);
- cdecl; external av__format;
-
-{$IF LIBAVFORMAT_VERSION >= 51011000} // 51.11.0
-(**
- * Sends a nice hexadecimal dump of a buffer to the log.
- *
- * @param avcl A pointer to an arbitrary struct of which the first field is a
- * pointer to an AVClass struct.
- * @param level The importance level of the message, lower values signifying
- * higher importance.
- * @param buf buffer
- * @param size buffer size
- *
- * @see av_hex_dump, av_pkt_dump, av_pkt_dump_log
- *)
-procedure av_hex_dump_log(avcl: Pointer; level: cint; buf: PByteArray; size: cint);
- cdecl; external av__format;
-{$IFEND}
-
-(**
- * Sends a nice dump of a packet to the specified file stream.
- *
- * @param f The file stream pointer where the dump should be sent to.
- * @param pkt packet to dump
- * @param dump_payload True if the payload must be displayed, too.
- *)
-procedure av_pkt_dump(f: PAVFile; pkt: PAVPacket; dump_payload: cint);
- cdecl; external av__format;
-
-{$IF LIBAVFORMAT_VERSION >= 51011000} // 51.11.0
-(**
- * Sends a nice dump of a packet to the log.
- *
- * @param avcl A pointer to an arbitrary struct of which the first field is a
- * pointer to an AVClass struct.
- * @param level The importance level of the message, lower values signifying
- * higher importance.
- * @param pkt packet to dump
- * @param dump_payload True if the payload must be displayed, too.
- *)
-procedure av_pkt_dump_log(avcl: Pointer; level: cint; pkt: PAVPacket; dump_payload: cint);
- cdecl; external av__format;
-{$IFEND}
-
-(**
- * Initializes libavformat and registers all the muxers, demuxers and
- * protocols. If you do not call this function, then you can select
- * exactly which formats you want to support.
- *
- * @see av_register_input_format()
- * @see av_register_output_format()
- * @see av_register_protocol()
- *)
-procedure av_register_all();
- cdecl; external av__format;
-
-{$IF LIBAVFORMAT_VERSION >= 51008000} // 51.8.0
-(** codec tag <-> codec id *)
-function av_codec_get_id(var tags: PAVCodecTag; tag: cuint): TCodecID;
- cdecl; external av__format;
-function av_codec_get_tag(var tags: PAVCodecTag; id: TCodecID): cuint;
- cdecl; external av__format;
-{$IFEND}
-
-(* media file input *)
-
-(**
- * Finds AVInputFormat based on the short name of the input format.
- *)
-function av_find_input_format(short_name: PAnsiChar): PAVInputFormat;
- cdecl; external av__format;
-
-(**
- * Guesses file format.
- *
- * @param is_opened Whether the file is already opened; determines whether
- * demuxers with or without AVFMT_NOFILE are probed.
- *)
-function av_probe_input_format(pd: PAVProbeData; is_opened: cint): PAVInputFormat;
- cdecl; external av__format;
-
-(**
- * Allocates all the structures needed to read an input stream.
- * This does not open the needed codecs for decoding the stream[s].
- *)
-function av_open_input_stream(var ic_ptr: PAVFormatContext;
- pb: PByteIOContext; filename: PAnsiChar;
- fmt: PAVInputFormat; ap: PAVFormatParameters): cint;
- cdecl; external av__format;
-
-(**
- * Opens a media file as input. The codecs are not opened. Only the file
- * header (if present) is read.
- *
- * @param ic_ptr The opened media file handle is put here.
- * @param filename filename to open
- * @param fmt If non-NULL, force the file format to use.
- * @param buf_size optional buffer size (zero if default is OK)
- * @param ap Additional parameters needed when opening the file
- * (NULL if default).
- * @return 0 if OK, AVERROR_xxx otherwise
- *)
-function av_open_input_file(var ic_ptr: PAVFormatContext; filename: PAnsiChar;
- fmt: PAVInputFormat; buf_size: cint;
- ap: PAVFormatParameters): cint;
- cdecl; external av__format;
-
-{$IF LIBAVFORMAT_VERSION >= 52026000} // 52.26.0
-(**
- * Allocates an AVFormatContext.
- * Can be freed with av_free() but do not forget to free everything you
- * explicitly allocated as well!
- *)
-function avformat_alloc_context(): PAVFormatContext;
- cdecl; external av__format;
-{$ELSE}
- {$IF LIBAVFORMAT_VERSION_MAJOR < 53}
-(**
- * @deprecated Use avformat_alloc_context() instead.
- *)
-function av_alloc_format_context(): PAVFormatContext;
- cdecl; external av__format;
- {$IFEND}
-{$IFEND}
-
-(**
- * Reads packets of a media file to get stream information. This
- * is useful for file formats with no headers such as MPEG. This
- * function also computes the real framerate in case of MPEG-2 repeat
- * frame mode.
- * The logical file position is not changed by this function;
- * examined packets may be buffered for later processing.
- *
- * @param ic media file handle
- * @return >=0 if OK, AVERROR_xxx on error
- * @todo Let the user decide somehow what information is needed so that
- * we do not waste time getting stuff the user does not need.
- *)
-function av_find_stream_info(ic: PAVFormatContext): cint;
- cdecl; external av__format;
-
-(**
- * Reads a transport packet from a media file.
- *
- * This function is obsolete and should never be used.
- * Use av_read_frame() instead.
- *
- * @param s media file handle
- * @param pkt is filled
- * @return 0 if OK, AVERROR_xxx on error
- *)
-function av_read_packet(s: PAVFormatContext; var pkt: TAVPacket): cint;
- cdecl; external av__format;
-
-(**
- * Returns the next frame of a stream.
- *
- * The returned packet is valid
- * until the next av_read_frame() or until av_close_input_file() and
- * must be freed with av_free_packet. For video, the packet contains
- * exactly one frame. For audio, it contains an cint number of
- * frames if each frame has a known fixed size (e.g. PCM or ADPCM
- * data). If the audio frames have a variable size (e.g. MPEG audio),
- * then it contains one frame.
- *
- * pkt->pts, pkt->dts and pkt->duration are always set to correct
- * values in AVStream.time_base units (and guessed if the format cannot
- * provide them). pkt->pts can be AV_NOPTS_VALUE if the video format
- * has B-frames, so it is better to rely on pkt->dts if you do not
- * decompress the payload.
- *
- * @return 0 if OK, < 0 on error or end of file
- *)
-function av_read_frame(s: PAVFormatContext; var pkt: TAVPacket): cint;
- cdecl; external av__format;
-
-(**
- * Seeks to the keyframe at timestamp.
- * 'timestamp' in 'stream_index'.
- * @param stream_index If stream_index is (-1), a default
- * stream is selected, and timestamp is automatically converted
- * from AV_TIME_BASE units to the stream specific time_base.
- * @param timestamp Timestamp in AVStream.time_base units
- * or, if no stream is specified, in AV_TIME_BASE units.
- * @param flags flags which select direction and seeking mode
- * @return >= 0 on success
- *)
-function av_seek_frame(s: PAVFormatContext; stream_index: cint; timestamp: cint64;
- flags: cint): cint;
- cdecl; external av__format;
-
-{$IF LIBAVFORMAT_VERSION >= 52026000} // 52.26.0
-(**
- * Seeks to timestamp ts.
- * Seeking will be done so that the point from which all active streams
- * can be presented successfully will be closest to ts and within min/max_ts.
- * Active streams are all streams that have AVStream.discard < AVDISCARD_ALL.
- *
- * If flags contain AVSEEK_FLAG_BYTE, then all timestamps are in byte and
- * are the file position (this may not be supported by all demuxers).
- * If flags contain AVSEEK_FLAG_FRAME then all timestamps are in frames
- * in the stream with stream_index (this may not be supported by all demuxers).
- * Otherwise all timestamps are in units of the stream selected by stream_index
- * or if stream_index is -1, in AV_TIME_BASE units.
- * If flags contain AVSEEK_FLAG_ANY, then non-keyframes are treated as
- * keyframes (this may not be supported by all demuxers).
- *
- * @param stream_index index of the stream which is used as time base reference.
- * @param min_ts smallest acceptable timestamp
- * @param ts target timestamp
- * @param max_ts largest acceptable timestamp
- * @param flags flags
- * @returns >=0 on success, error code otherwise
- *
- * @NOTE This is part of the new seek API which is still under construction.
- * Thus do not use this yet. It may change at any time, do not expect
- * ABI compatibility yet!
- *)
-function avformat_seek_file(s: PAVFormatContext;
- stream_index: cint;
- min_ts: cint64;
- ts: cint64;
- max_ts: cint64;
- flags: cint): cint;
- cdecl; external av__format;
-{$IFEND}
-
-(**
- * Starts playing a network-based stream (e.g. RTSP stream) at the
- * current position.
- *)
-function av_read_play(s: PAVFormatContext): cint;
- cdecl; external av__format;
-
-(**
- * Pauses a network-based stream (e.g. RTSP stream).
- *
- * Use av_read_play() to resume it.
- *)
-function av_read_pause(s: PAVFormatContext): cint;
- cdecl; external av__format;
-
-{$IF LIBAVFORMAT_VERSION >= 52003000} // 52.3.0
-(**
- * Frees a AVFormatContext allocated by av_open_input_stream.
- * @param s context to free
- *)
-procedure av_close_input_stream(s: PAVFormatContext);
- cdecl; external av__format;
-{$IFEND}
-
-(**
- * Closes a media file (but not its codecs).
- *
- * @param s media file handle
- *)
-procedure av_close_input_file(s: PAVFormatContext);
- cdecl; external av__format;
-
-(**
- * Adds a new stream to a media file.
- *
- * Can only be called in the read_header() function. If the flag
- * AVFMTCTX_NOHEADER is in the format context, then new streams
- * can be added in read_packet too.
- *
- * @param s media file handle
- * @param id file-format-dependent stream ID
- *)
-function av_new_stream(s: PAVFormatContext; id: cint): PAVStream;
- cdecl; external av__format;
-{$IF LIBAVFORMAT_VERSION >= 51014000} // 51.14.0
-function av_new_program(s: PAVFormatContext; id: cint): PAVProgram;
- cdecl; external av__format;
-{$IFEND}
-
-{$IF LIBAVFORMAT_VERSION >= 52014000} // 52.14.0
-(**
- * Adds a new chapter.
- * This function is NOT part of the public API
- * and should ONLY be used by demuxers.
- *
- * @param s media file handle
- * @param id unique ID for this chapter
- * @param start chapter start time in time_base units
- * @param end chapter end time in time_base units
- * @param title chapter title
- *
- * @return AVChapter or NULL on error
- *)
-function ff_new_chapter(s: PAVFormatContext; id: cint; time_base: TAVRational;
- start, end_: cint64; title: {const} PAnsiChar): PAVChapter;
- cdecl; external av__format;
-{$IFEND}
-
-(**
- * Sets the pts for a given stream.
- *
- * @param s stream
- * @param pts_wrap_bits number of bits effectively used by the pts
- * (used for wrap control, 33 is the value for MPEG)
- * @param pts_num numerator to convert to seconds (MPEG: 1)
- * @param pts_den denominator to convert to seconds (MPEG: 90000)
- *)
-procedure av_set_pts_info(s: PAVStream; pts_wrap_bits: cint;
-{$IF LIBAVFORMAT_VERSION < 52036000} // < 52.36.0
- pts_num: cint; pts_den: cint);
-{$ELSE}
- pts_num: cuint; pts_den: cuint);
-{$IFEND}
- cdecl; external av__format;
-
-const
- AVSEEK_FLAG_BACKWARD = 1; ///< seek backward
- AVSEEK_FLAG_BYTE = 2; ///< seeking based on position in bytes
- AVSEEK_FLAG_ANY = 4; ///< seek to any frame, even non-keyframes
-{$IF LIBAVFORMAT_VERSION >= 52037000} // >= 52.37.0
- AVSEEK_FLAG_FRAME = 8;
-{$IFEND}
-
-function av_find_default_stream_index(s: PAVFormatContext): cint;
- cdecl; external av__format;
-
-(**
- * Gets the index for a specific timestamp.
- * @param flags if AVSEEK_FLAG_BACKWARD then the returned index will correspond
- * to the timestamp which is <= the requested one, if backward
- * is 0, then it will be >=
- * if AVSEEK_FLAG_ANY seek to any frame, only keyframes otherwise
- * @return < 0 if no such timestamp could be found
- *)
-function av_index_search_timestamp(st: PAVStream; timestamp: cint64; flags: cint): cint;
- cdecl; external av__format;
-
-{$IF LIBAVFORMAT_VERSION >= 52004000} // 52.4.0
-(**
- * Ensures the index uses less memory than the maximum specified in
- * AVFormatContext.max_index_size by discarding entries if it grows
- * too large.
- * This function is not part of the public API and should only be called
- * by demuxers.
- *)
-procedure ff_reduce_index(s: PAVFormatContext; stream_index: cint);
- cdecl; external av__format;
-{$IFEND}
-
-(**
- * Adds an index entry into a sorted list. Updates the entry if the list
- * already contains it.
- *
- * @param timestamp timestamp in the timebase of the given stream
- *)
-function av_add_index_entry(st: PAVStream; pos: cint64; timestamp: cint64;
- size: cint; distance: cint; flags: cint): cint;
- cdecl; external av__format;
-
-(**
- * Does a binary search using av_index_search_timestamp() and
- * AVCodec.read_timestamp().
- * This is not supposed to be called directly by a user application,
- * but by demuxers.
- * @param target_ts target timestamp in the time base of the given stream
- * @param stream_index stream number
- *)
-function av_seek_frame_binary(s: PAVFormatContext; stream_index: cint;
- target_ts: cint64; flags: cint): cint;
- cdecl; external av__format;
-
-
-(**
- * Updates cur_dts of all streams based on the given timestamp and AVStream.
- *
- * Stream ref_st unchanged, others set cur_dts in their native time base.
- * Only needed for timestamp wrapping or if (dts not set and pts!=dts).
- * @param timestamp new dts expressed in time_base of param ref_st
- * @param ref_st reference stream giving time_base of param timestamp
- *)
-procedure av_update_cur_dts(s: PAVFormatContext; ref_st: PAVStream;
- timestamp: cint64);
- cdecl; external av__format;
-
-{$IF LIBAVFORMAT_VERSION >= 51007000} // 51.7.0
-type
- TReadTimestampFunc = function (pavfc: PAVFormatContext;
- arg2: cint; arg3: Pint64; arg4: cint64): cint64; cdecl;
-
-(**
- * Does a binary search using read_timestamp().
- * This is not supposed to be called directly by a user application,
- * but by demuxers.
- * @param target_ts target timestamp in the time base of the given stream
- * @param stream_index stream number
- *)
-function av_gen_search(s: PAVFormatContext; stream_index: cint;
- target_ts: cint64; pos_min: cint64;
- pos_max: cint64; pos_limit: cint64;
- ts_min: cint64; ts_max: cint64;
- flags: cint; ts_ret: Pint64;
- read_timestamp: TReadTimestampFunc): cint64;
- cdecl; external av__format;
-{$IFEND}
-
-(* media file output *)
-function av_set_parameters(s: PAVFormatContext; ap: PAVFormatParameters): cint;
- cdecl; external av__format;
-
-(**
- * Allocates the stream private data and writes the stream header to an
- * output media file.
- *
- * @param s media file handle
- * @return 0 if OK, AVERROR_xxx on error
- *)
-function av_write_header(s: PAVFormatContext): cint;
- cdecl; external av__format;
-
-(**
- * Writes a packet to an output media file.
- *
- * The packet shall contain one audio or video frame.
- * The packet must be correctly interleaved according to the container
- * specification, if not then av_interleaved_write_frame must be used.
- *
- * @param s media file handle
- * @param pkt The packet, which contains the stream_index, buf/buf_size,
- * dts/pts, ...
- * @return < 0 on error, = 0 if OK, 1 if end of stream wanted
- *)
-function av_write_frame(s: PAVFormatContext; var pkt: TAVPacket): cint;
- cdecl; external av__format;
-
-(**
- * Writes a packet to an output media file ensuring correct interleaving.
- *
- * The packet must contain one audio or video frame.
- * If the packets are already correctly interleaved, the application should
- * call av_write_frame() instead as it is slightly faster. It is also important
- * to keep in mind that completely non-interleaved input will need huge amounts
- * of memory to interleave with this, so it is preferable to interleave at the
- * demuxer level.
- *
- * @param s media file handle
- * @param pkt The packet, which contains the stream_index, buf/buf_size,
- * dts/pts, ...
- * @return < 0 on error, = 0 if OK, 1 if end of stream wanted
- *)
-function av_interleaved_write_frame(s: PAVFormatContext; var pkt: TAVPacket): cint;
- cdecl; external av__format;
-
-(**
- * Interleaves a packet per dts in an output media file.
- *
- * Packets with pkt->destruct == av_destruct_packet will be freed inside this
- * function, so they cannot be used after it. Note that calling av_free_packet()
- * on them is still safe.
- *
- * @param s media file handle
- * @param out the interleaved packet will be output here
- * @param in the input packet
- * @param flush 1 if no further packets are available as input and all
- * remaining packets should be output
- * @return 1 if a packet was output, 0 if no packet could be output,
- * < 0 if an error occurred
- *)
-function av_interleave_packet_per_dts(s: PAVFormatContext; _out: PAVPacket;
- pkt: PAVPacket; flush: cint): cint;
- cdecl; external av__format;
-
-{$IF LIBAVFORMAT_VERSION >= 52025000} // 52.25.0
-(**
- * Add packet to AVFormatContext->packet_buffer list, determining its
- * interleaved position using compare() function argument.
- *
- * This function is not part of the public API and should only be called
- * by muxers using their own interleave function.
- *)
-{
-procedure ff_interleave_add_packet(s: PAVFormatContext;
- pkt: PAVPacket;
- compare: function(para1: PAVFormatContext;
- para2: PAVPacket;
- para3: PAVPacket): cint);
- cdecl; external av__format;
-}
-{$IFEND}
-
-(**
- * Writes the stream trailer to an output media file and frees the
- * file private data.
- *
- * May only be called after a successful call to av_write_header.
- *
- * @param s media file handle
- * @return 0 if OK, AVERROR_xxx on error
- *)
-function av_write_trailer(s: pAVFormatContext): cint;
- cdecl; external av__format;
-
-procedure dump_format(ic: PAVFormatContext; index: cint; url: PAnsiChar;
- is_output: cint);
- cdecl; external av__format;
-
-(**
- * Parses width and height out of string str.
- * @deprecated Use av_parse_video_frame_size instead.
- *)
-function parse_image_size(width_ptr: PCint; height_ptr: PCint;
- str: PAnsiChar): cint;
- cdecl; external av__format; deprecated;
-
-{$IF LIBAVFORMAT_VERSION_MAJOR < 53}
-(**
- * Converts framerate from a string to a fraction.
- * @deprecated Use av_parse_video_frame_rate instead.
- *)
-function parse_frame_rate(frame_rate: PCint; frame_rate_base: PCint;
- arg: PByteArray): cint;
- cdecl; external av__format; deprecated;
-{$IFEND}
-
-(**
- * Parses datestr and returns a corresponding number of microseconds.
- * @param datestr String representing a date or a duration.
- * - If a date the syntax is:
- * @code
- * [{YYYY-MM-DD|YYYYMMDD}]{T| }{HH[:MM[:SS[.m...]]][Z]|HH[MM[SS[.m...]]][Z]}
- * @endcode
- * Time is localtime unless Z is appended, in which case it is
- * interpreted as UTC.
- * If the year-month-day part is not specified it takes the current
- * year-month-day.
- * Returns the number of microseconds since 1st of January, 1970 up to
- * the time of the parsed date or INT64_MIN if datestr cannot be
- * successfully parsed.
- * - If a duration the syntax is:
- * @code
- * [-]HH[:MM[:SS[.m...]]]
- * [-]S+[.m...]
- * @endcode
- * Returns the number of microseconds contained in a time interval
- * with the specified duration or INT64_MIN if datestr cannot be
- * successfully parsed.
- * @param duration Flag which tells how to interpret datestr, if
- * not zero datestr is interpreted as a duration, otherwise as a
- * date.
- *)
-function parse_date(datestr: PAnsiChar; duration: cint): cint64;
- cdecl; external av__format;
-
-(** Gets the current time in microseconds. *)
-function av_gettime(): cint64;
- cdecl; external av__format;
-
-(* ffm-specific for ffserver *)
-const
- FFM_PACKET_SIZE = 4096;
-
-function ffm_read_write_index(fd: cint): cint64;
- cdecl; external av__format;
-
-{$IF LIBAVFORMAT_VERSION < 52027000} // 52.27.0
-procedure ffm_write_write_index(fd: cint; pos: cint64);
-{$ELSE}
-function ffm_write_write_index(fd: cint; pos: cint64): cint;
-{$IFEND}
- cdecl; external av__format;
-
-procedure ffm_set_write_index(s: PAVFormatContext; pos: cint64; file_size: cint64);
- cdecl; external av__format;
-
-(**
- * Attempts to find a specific tag in a URL.
- *
- * syntax: '?tag1=val1&tag2=val2...'. Little URL decoding is done.
- * Return 1 if found.
- *)
-function find_info_tag(arg: PAnsiChar; arg_size: cint; tag1: PAnsiChar; info: PAnsiChar): cint;
- cdecl; external av__format;
-
-(**
- * Returns in 'buf' the path with '%d' replaced by a number.
- *
- * Also handles the '%0nd' format where 'n' is the total number
- * of digits and '%%'.
- *
- * @param buf destination buffer
- * @param buf_size destination buffer size
- * @param path numbered sequence string
- * @param number frame number
- * @return 0 if OK, -1 on format error
- *)
-function av_get_frame_filename(buf: PAnsiChar; buf_size: cint;
- path: PAnsiChar; number: cint): cint;
- cdecl; external av__format
- {$IF LIBAVFORMAT_VERSION <= 50006000} // 50.6.0
- name 'get_frame_filename'
- {$IFEND};
-
-(**
- * Checks whether filename actually is a numbered sequence generator.
- *
- * @param filename possible numbered sequence string
- * @return 1 if a valid numbered sequence string, 0 otherwise
- *)
-function av_filename_number_test(filename: PAnsiChar): cint;
- cdecl; external av__format
- {$IF LIBAVFORMAT_VERSION <= 50006000} // 50.6.0
- name 'filename_number_test'
- {$IFEND};
-
-{$IF LIBAVFORMAT_VERSION >= 51012002} // 51.12.2
-(**
- * Generates an SDP for an RTP session.
- *
- * @param ac array of AVFormatContexts describing the RTP streams. If the
- * array is composed by only one context, such context can contain
- * multiple AVStreams (one AVStream per RTP stream). Otherwise,
- * all the contexts in the array (an AVCodecContext per RTP stream)
- * must contain only one AVStream.
- * @param n_files number of AVCodecContexts contained in ac
- * @param buff buffer where the SDP will be stored (must be allocated by
- * the caller)
- * @param size the size of the buffer
- * @return 0 if OK, AVERROR_xxx on error
- *)
-function avf_sdp_create(ac: PPAVFormatContext; n_files: cint; buff: PByteArray; size: cint): cint;
- cdecl; external av__format;
-{$IFEND}
-
-implementation
-
-{$IF LIBAVFORMAT_VERSION < 51012002} // 51.12.2
-procedure av_init_packet(var pkt: TAVPacket);
-begin
- with pkt do begin
- pts := AV_NOPTS_VALUE;
- dts := AV_NOPTS_VALUE;
- pos := -1;
- duration := 0;
- flags := 0;
- stream_index := 0;
- destruct := @av_destruct_packet_nofree
- end
-end;
-{$IFEND}
-
-{$IF LIBAVCODEC_VERSION < 52032000} // < 52.32.0
-procedure av_free_packet(pkt: PAVPacket);
-begin
- if ((pkt <> nil) and (@pkt^.destruct <> nil)) then
- pkt^.destruct(pkt);
-end;
-{$IFEND}
-
-end.
diff --git a/src/lib/ffmpeg/avio.pas b/src/lib/ffmpeg/avio.pas
deleted file mode 100644
index 73c90b69..00000000
--- a/src/lib/ffmpeg/avio.pas
+++ /dev/null
@@ -1,590 +0,0 @@
-(*
- * unbuffered io for ffmpeg system
- * copyright (c) 2001 Fabrice Bellard
- *
- * FFmpeg 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.1 of the License, or (at your option) any later version.
- *
- * FFmpeg 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 FFmpeg; 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.
- * - Changes and updates by the UltraStar Deluxe Team
- *)
-
-(*
- * Conversion of libavformat/avio.h
- * unbuffered I/O operations
- * revision 16100, Sat Dec 13 13:39:13 2008 UTC
- * update Tue, Jun 10 01:00:00 2009 UTC
- *
- * @warning This file has to be considered an internal but installed
- * header, so it should not be directly included in your projects.
- *)
-
-{
- * update to
- * Max. avformat version: 52.41.0, Sun Dec 6 20:15:00 2009 CET
- * MiSchi
-}
-
-unit avio;
-
-{$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}
-
-{$I switches.inc}
-
-interface
-
-uses
- ctypes,
- avutil,
- avcodec,
- SysUtils,
- UConfig;
-
-(* unbuffered I/O *)
-
-const
- URL_RDONLY = 0;
- URL_WRONLY = 1;
- URL_RDWR = 2;
-
- (**
- * Passing this as the "whence" parameter to a seek function causes it to
- * return the filesize without seeking anywhere. Supporting this is optional.
- * If it is not supported then the seek function will return <0.
- *)
- AVSEEK_SIZE = $10000;
-
-type
- TURLInterruptCB = function (): cint; cdecl;
-
-type
- PURLProtocol = ^TURLProtocol;
-
- (**
- * URL Context.
- * 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(URLContext) must not be used outside libav*.
- *)
- PURLContext = ^TURLContext;
- TURLContext = record
- {$IF LIBAVFORMAT_VERSION_MAJOR >= 53}
- av_class: {const} PAVClass; ///< information for av_log(). Set by url_open().
- {$IFEND}
- prot: PURLProtocol;
- flags: cint;
- is_streamed: cint; (**< true if streamed (no seek possible), default = false *)
- max_packet_size: cint; (**< if non zero, the stream is packetized with this max packet size *)
- priv_data: pointer;
- filename: PAnsiChar; (**< specified filename *)
- end;
- PPURLContext = ^PURLContext;
-
- PURLPollEntry = ^TURLPollEntry;
- TURLPollEntry = record
- handle: PURLContext;
- events: cint;
- revents: cint;
- end;
-
- TURLProtocol = record
- name: PAnsiChar;
- url_open: function (h: PURLContext; filename: {const} PAnsiChar; flags: cint): cint; cdecl;
- url_read: function (h: PURLContext; buf: PByteArray; size: cint): cint; cdecl;
- {$IF LIBAVFORMAT_VERSION >= 52034001} // 52.34.1
- url_read_complete: function (h: PURLContext; buf: PByteArray; size: cint): cint; cdecl;
- {$IFEND}
- url_write: function (h: PURLContext; buf: PByteArray; size: cint): cint; cdecl;
- url_seek: function (h: PURLContext; pos: cint64; whence: cint): cint64; cdecl;
- url_close: function (h: PURLContext): cint; cdecl;
- next: PURLProtocol;
- {$IF (LIBAVFORMAT_VERSION >= 52001000) and (LIBAVFORMAT_VERSION < 52004000)} // 52.1.0 .. 52.4.0
- url_read_play: function (h: PURLContext): cint; cdecl;
- url_read_pause: function (h: PURLContext): cint; cdecl;
- {$IFEND}
- {$IF LIBAVFORMAT_VERSION >= 52004000} // 52.4.0
- url_read_pause: function (h: PURLContext; pause: cint): cint; cdecl;
- {$IFEND}
- {$IF LIBAVFORMAT_VERSION >= 52001000} // 52.1.0
- url_read_seek: function (h: PURLContext; stream_index: cint;
- timestamp: cint64; flags: cint): cint64; cdecl;
- {$IFEND}
- end;
-
- (**
- * Bytestream IO Context.
- * 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(ByteIOContext) must not be used outside libav*.
- *)
- PByteIOContext = ^TByteIOContext;
- TByteIOContext = record
- buffer: PByteArray;
- buffer_size: cint;
- buf_ptr: PByteArray;
- buf_end: PByteArray;
- opaque: pointer;
- read_packet: function (opaque: pointer; buf: PByteArray; buf_size: cint): cint; cdecl;
- write_packet: function (opaque: pointer; buf: PByteArray; buf_size: cint): cint; cdecl;
- seek: function (opaque: pointer; offset: cint64; whence: cint): cint64; cdecl;
- pos: cint64; (* position in the file of the current buffer *)
- must_flush: cint; (* true if the next seek should flush *)
- eof_reached: cint; (* true if eof reached *)
- write_flag: cint; (* true if open for writing *)
- is_streamed: cint;
- max_packet_size: cint;
- checksum: culong;
- checksum_ptr: PByteArray;
- update_checksum: function (checksum: culong; buf: {const} PByteArray; size: cuint): culong; cdecl;
- error: cint; ///< contains the error code or 0 if no error happened
- {$IF (LIBAVFORMAT_VERSION >= 52001000) and (LIBAVFORMAT_VERSION < 52004000)} // 52.1.0 .. 52.4.0
- read_play: function(opaque: Pointer): cint; cdecl;
- read_pause: function(opaque: Pointer): cint; cdecl;
- {$IFEND}
- {$IF LIBAVFORMAT_VERSION >= 52004000} // 52.4.0
- read_pause: function(opaque: Pointer; pause: cint): cint; cdecl;
- {$IFEND}
- {$IF LIBAVFORMAT_VERSION >= 52001000} // 52.1.0
- read_seek: function(opaque: Pointer; stream_index: cint;
- timestamp: cint64; flags: cint): cint64; cdecl;
- {$IFEND}
- end;
-
-
-{$IF LIBAVFORMAT_VERSION >= 52021000} // 52.21.0
-function url_open_protocol(puc: PPURLContext; up: PURLProtocol;
- filename: {const} PAnsiChar; flags: cint): cint;
- cdecl; external av__format;
-{$IFEND}
-function url_open(h: PPointer; filename: {const} PAnsiChar; flags: cint): cint;
- cdecl; external av__format;
-function url_read (h: PURLContext; buf: PByteArray; size: cint): cint;
- cdecl; external av__format;
-function url_write (h: PURLContext; buf: PByteArray; size: cint): cint;
- cdecl; external av__format;
-function url_seek (h: PURLContext; pos: cint64; whence: cint): cint64;
- cdecl; external av__format;
-function url_close (h: PURLContext): cint;
- cdecl; external av__format;
-function url_exist(filename: {const} PAnsiChar): cint;
- cdecl; external av__format;
-function url_filesize (h: PURLContext): cint64;
- cdecl; external av__format;
-{
- * Return the file descriptor associated with this URL. For RTP, this
- * will return only the RTP file descriptor, not the RTCP file descriptor.
- * To get both, use rtp_get_file_handles().
- *
- * @return the file descriptor associated with this URL, or <0 on error.
-}
-(* not implemented *)
-function url_get_file_handle(h: PURLContext): cint;
- cdecl; external av__format;
-
-(**
- * Return the maximum packet size associated to packetized file
- * handle. If the file is not packetized (stream like HTTP or file on
- * disk), then 0 is returned.
- *
- * @param h file handle
- * @return maximum packet size in bytes
- *)
-function url_get_max_packet_size(h: PURLContext): cint;
- cdecl; external av__format;
-procedure url_get_filename(h: PURLContext; buf: PAnsiChar; buf_size: cint);
- cdecl; external av__format;
-
-(**
- * The callback is called in blocking functions to test regulary if
- * asynchronous interruption is needed. AVERROR(EINTR) is returned
- * in this case by the interrupted function. 'NULL' means no interrupt
- * callback is given.
- *)
-procedure url_set_interrupt_cb (interrupt_cb: TURLInterruptCB);
- cdecl; external av__format;
-
-(* not implemented *)
-function url_poll(poll_table: PURLPollEntry; n: cint; timeout: cint): cint;
- cdecl; external av__format;
-
-{$IF LIBAVFORMAT_VERSION >= 52004000} // 52.4.0
-(**
- * Pause and resume playing - only meaningful if using a network streaming
- * protocol (e.g. MMS).
- * @param pause 1 for pause, 0 for resume
- *)
-function av_url_read_pause(h: PURLContext; pause: cint): cint;
- cdecl; external av__format;
-{$IFEND}
-
-{$IF LIBAVFORMAT_VERSION >= 52001000} // 52.1.0
-(**
- * Seek to a given timestamp relative to some component stream.
- * Only meaningful if using a network streaming protocol (e.g. MMS.).
- * @param stream_index The stream index that the timestamp is relative to.
- * If stream_index is (-1) the timestamp should be in AV_TIME_BASE
- * units from the beginning of the presentation.
- * If a stream_index >= 0 is used and the protocol does not support
- * seeking based on component streams, the call will fail with ENOTSUP.
- * @param timestamp timestamp in AVStream.time_base units
- * or if there is no stream specified then in AV_TIME_BASE units.
- * @param flags Optional combination of AVSEEK_FLAG_BACKWARD, AVSEEK_FLAG_BYTE
- * and AVSEEK_FLAG_ANY. The protocol may silently ignore
- * AVSEEK_FLAG_BACKWARD and AVSEEK_FLAG_ANY, but AVSEEK_FLAG_BYTE will
- * fail with ENOTSUP if used and not supported.
- * @return >= 0 on success
- * @see AVInputFormat::read_seek
- *)
-function av_url_read_seek(h: PURLContext; stream_index: cint;
- timestamp: cint64; flags: cint): cint64;
- cdecl; external av__format;
-{$IFEND}
-
-(**
-var
-{$IF LIBAVFORMAT_VERSION_MAJOR < 53}
- first_protocol: PURLProtocol; external av__format;
-{$IFEND}
- url_interrupt_cb: PURLInterruptCB; external av__format;
-**)
-
-{
-* If protocol is NULL, returns the first registered protocol,
-* if protocol is non-NULL, returns the next registered protocol after protocol,
-* or NULL if protocol is the last one.
-}
-{$IF LIBAVFORMAT_VERSION >= 52002000} // 52.2.0
-function av_protocol_next(p: PURLProtocol): PURLProtocol;
- cdecl; external av__format;
-{$IFEND}
-
-{$IF LIBAVFORMAT_VERSION <= 52028000} // 52.28.0
-(**
- * @deprecated Use av_register_protocol() instead.
- *)
-function register_protocol(protocol: PURLProtocol): cint;
- cdecl; external av__format;
-(** Alias for register_protocol() *)
-function av_register_protocol(protocol: PURLProtocol): cint;
- cdecl; external av__format name 'register_protocol';
-{$ELSE}
-function av_register_protocol(protocol: PURLProtocol): cint;
- cdecl; external av__format;
-{$IFEND}
-
-type
- TReadWriteFunc = function(opaque: Pointer; buf: PByteArray; buf_size: cint): cint; cdecl;
- TSeekFunc = function(opaque: Pointer; offset: cint64; whence: cint): cint64; cdecl;
-
-function init_put_byte(s: PByteIOContext;
- buffer: PByteArray;
- buffer_size: cint; write_flag: cint;
- opaque: pointer;
- read_packet: TReadWriteFunc;
- write_packet: TReadWriteFunc;
- seek: TSeekFunc): cint;
- cdecl; external av__format;
-{$IF LIBAVFORMAT_VERSION >= 52004000} // 52.4.0
-function av_alloc_put_byte(
- buffer: PByteArray;
- buffer_size: cint;
- write_flag: cint;
- opaque: Pointer;
- read_packet: TReadWriteFunc;
- write_packet: TReadWriteFunc;
- seek: TSeekFunc): PByteIOContext;
- cdecl; external av__format;
-{$IFEND}
-
-procedure put_byte(s: PByteIOContext; b: cint);
- cdecl; external av__format;
-procedure put_buffer (s: PByteIOContext; buf: {const} PByteArray; size: cint);
- cdecl; external av__format;
-procedure put_le64(s: PByteIOContext; val: cuint64);
- cdecl; external av__format;
-procedure put_be64(s: PByteIOContext; val: cuint64);
- cdecl; external av__format;
-procedure put_le32(s: PByteIOContext; val: cuint);
- cdecl; external av__format;
-procedure put_be32(s: PByteIOContext; val: cuint);
- cdecl; external av__format;
-procedure put_le24(s: PByteIOContext; val: cuint);
- cdecl; external av__format;
-procedure put_be24(s: PByteIOContext; val: cuint);
- cdecl; external av__format;
-procedure put_le16(s: PByteIOContext; val: cuint);
- cdecl; external av__format;
-procedure put_be16(s: PByteIOContext; val: cuint);
- cdecl; external av__format;
-procedure put_tag(s: PByteIOContext; tag: {const} PAnsiChar);
- cdecl; external av__format;
-
-procedure put_strz(s: PByteIOContext; buf: {const} PAnsiChar);
- cdecl; external av__format;
-
-(**
- * fseek() equivalent for ByteIOContext.
- * @return new position or AVERROR.
- *)
-function url_fseek(s: PByteIOContext; offset: cint64; whence: cint): cint64;
- cdecl; external av__format;
-
-(**
- * Skip given number of bytes forward.
- * @param offset number of bytes
- *)
-procedure url_fskip(s: PByteIOContext; offset: cint64);
- cdecl; external av__format;
-
-(**
- * ftell() equivalent for ByteIOContext.
- * @return position or AVERROR.
- *)
-function url_ftell(s: PByteIOContext): cint64;
- cdecl; external av__format;
-
-(**
- * Gets the filesize.
- * @return filesize or AVERROR
- *)
-function url_fsize(s: PByteIOContext): cint64;
- cdecl; external av__format;
-
-(**
- * feof() equivalent for ByteIOContext.
- * @return non zero if and only if end of file
- *)
-function url_feof(s: PByteIOContext): cint;
- cdecl; external av__format;
-
-function url_ferror(s: PByteIOContext): cint;
- cdecl; external av__format;
-
-{$IF LIBAVFORMAT_VERSION >= 52004000} // 52.4.0
-function av_url_read_fpause(h: PByteIOContext; pause: cint): cint;
- cdecl; external av__format;
-{$IFEND}
-{$IF LIBAVFORMAT_VERSION >= 52001000} // 52.1.0
-function av_url_read_fseek(h: PByteIOContext; stream_index: cint;
- timestamp: cint64; flags: cint): cint64;
- cdecl; external av__format;
-{$IFEND}
-
-const
- URL_EOF = -1;
-(** @note return URL_EOF (-1) if EOF *)
-function url_fgetc(s: PByteIOContext): cint;
- cdecl; external av__format;
-
-(** @warning currently size is limited *)
-function url_fprintf(s: PByteIOContext; fmt: {const} PAnsiChar; args: array of const): cint;
- cdecl; external av__format;
-
-(** @note unlike fgets, the EOL character is not returned and a whole
- line is parsed. return NULL if first char read was EOF *)
-function url_fgets(s: PByteIOContext; buf: PAnsiChar; buf_size: cint): PAnsiChar;
- cdecl; external av__format;
-
-procedure put_flush_packet (s: PByteIOContext);
- cdecl; external av__format;
-
-
-(**
- * Reads size bytes from ByteIOContext into buf.
- * @returns number of bytes read or AVERROR
- *)
-function get_buffer(s: PByteIOContext; buf: PByteArray; size: cint): cint;
- cdecl; external av__format;
-
-(**
- * Reads size bytes from ByteIOContext into buf.
- * This reads at most 1 packet. If that is not enough fewer bytes will be
- * returned.
- * @returns number of bytes read or AVERROR
- *)
-function get_partial_buffer(s: PByteIOContext; buf: PByteArray; size: cint): cint;
- cdecl; external av__format;
-
-(** @note return 0 if EOF, so you cannot use it if EOF handling is
- necessary *)
-function get_byte(s: PByteIOContext): cint;
- cdecl; external av__format;
-function get_le24(s: PByteIOContext): cuint;
- cdecl; external av__format;
-function get_le32(s: PByteIOContext): cuint;
- cdecl; external av__format;
-function get_le64(s: PByteIOContext): cuint64;
- cdecl; external av__format;
-function get_le16(s: PByteIOContext): cuint;
- cdecl; external av__format;
-
-function get_strz(s: PByteIOContext; buf: PAnsiChar; maxlen: cint): PAnsiChar;
- cdecl; external av__format;
-function get_be16(s: PByteIOContext): cuint;
- cdecl; external av__format;
-function get_be24(s: PByteIOContext): cuint;
- cdecl; external av__format;
-function get_be32(s: PByteIOContext): cuint;
- cdecl; external av__format;
-function get_be64(s: PByteIOContext): cuint64;
- cdecl; external av__format;
-
-{$IF LIBAVFORMAT_VERSION >= 51017001} // 51.17.1
-function ff_get_v(bc: PByteIOContext): cuint64;
- cdecl; external av__format;
-{$IFEND}
-
-function url_is_streamed(s: PByteIOContext): cint; {$IFDEF HasInline}inline;{$ENDIF}
-
-(** @note when opened as read/write, the buffers are only used for
- writing *)
-{$IF LIBAVFORMAT_VERSION >= 52000000} // 52.0.0
-function url_fdopen (var s: PByteIOContext; h: PURLContext): cint;
-{$ELSE}
-function url_fdopen (s: PByteIOContext; h: PURLContext): cint;
-{$IFEND}
- cdecl; external av__format;
-
-(** @warning must be called before any I/O *)
-function url_setbufsize (s: PByteIOContext; buf_size: cint): cint;
- cdecl; external av__format;
-
-{$IF LIBAVFORMAT_VERSION_MAJOR < 53}
-{$IF LIBAVFORMAT_VERSION >= 51015000} // 51.15.0
-(** Reset the buffer for reading or writing.
- * @note Will drop any data currently in the buffer without transmitting it.
- * @param flags URL_RDONLY to set up the buffer for reading, or URL_WRONLY
- * to set up the buffer for writing. *)
-function url_resetbuf(s: PByteIOContext; flags: cint): cint;
- cdecl; external av__format;
-{$IFEND}
-{$IFEND}
-
-(** @note when opened as read/write, the buffers are only used for
- writing *)
-{$IF LIBAVFORMAT_VERSION >= 52000000} // 52.0.0
-function url_fopen(var s: PByteIOContext; filename: {const} PAnsiChar; flags: cint): cint;
-{$ELSE}
-function url_fopen(s: PByteIOContext; filename: {const} PAnsiChar; flags: cint): cint;
-{$IFEND}
- cdecl; external av__format;
-function url_fclose(s: PByteIOContext): cint;
- cdecl; external av__format;
-function url_fileno(s: PByteIOContext): PURLContext;
- cdecl; external av__format;
-
-(**
- * Return the maximum packet size associated to packetized buffered file
- * handle. If the file is not packetized (stream like http or file on
- * disk), then 0 is returned.
- *
- * @param s buffered file handle
- * @return maximum packet size in bytes
- *)
-function url_fget_max_packet_size (s: PByteIOContext): cint;
- cdecl; external av__format;
-
-{$IF LIBAVFORMAT_VERSION >= 52000000} // 52.0.0
-function url_open_buf(var s: PByteIOContext; buf: PAnsiChar; buf_size: cint; flags: cint): cint;
-{$ELSE}
-function url_open_buf(s: PByteIOContext; buf: PAnsiChar; buf_size: cint; flags: cint): cint;
-{$IFEND}
- cdecl; external av__format;
-
-(** return the written or read size *)
-function url_close_buf(s: PByteIOContext): cint;
- cdecl; external av__format;
-
-(**
- * Open a write only memory stream.
- *
- * @param s new IO context
- * @return zero if no error.
- *)
-{$IF LIBAVFORMAT_VERSION >= 52000000} // 52.0.0
-function url_open_dyn_buf(var s: PByteIOContext): cint;
-{$ELSE}
-function url_open_dyn_buf(s: PByteIOContext): cint;
-{$IFEND}
- cdecl; external av__format;
-
-(**
- * Open a write only packetized memory stream with a maximum packet
- * size of 'max_packet_size'. The stream is stored in a memory buffer
- * with a big endian 4 byte header giving the packet size in bytes.
- *
- * @param s new IO context
- * @param max_packet_size maximum packet size (must be > 0)
- * @return zero if no error.
- *)
-{$IF LIBAVFORMAT_VERSION >= 52000000} // 52.0.0
-function url_open_dyn_packet_buf(var s: PByteIOContext; max_packet_size: cint): cint;
-{$ELSE}
-function url_open_dyn_packet_buf(s: PByteIOContext; max_packet_size: cint): cint;
-{$IFEND}
- cdecl; external av__format;
-
-(**
- * Return the written size and a pointer to the buffer. The buffer
- * must be freed with av_free().
- * @param s IO context
- * @param pbuffer pointer to a byte buffer
- * @return the length of the byte buffer
- *)
-function url_close_dyn_buf(s: PByteIOContext; pbuffer:PPointer): cint;
- cdecl; external av__format;
-
-{$IF LIBAVFORMAT_VERSION >= 51017001} // 51.17.1
-function ff_crc04C11DB7_update(checksum: culong; buf: {const} PByteArray;
- len: cuint): culong;
- cdecl; external av__format;
-{$IFEND}
-function get_checksum(s: PByteIOContext): culong;
- cdecl; external av__format;
-procedure init_gsum(s: PByteIOContext;
- update_checksum: pointer;
- checksum: culong);
- cdecl; external av__format;
-
-(* udp.c *)
-function udp_set_remote_url(h: PURLContext; uri: {const} PAnsiChar): cint;
- cdecl; external av__format;
-function udp_get_local_port(h: PURLContext): cint;
- cdecl; external av__format;
-{$IF LIBAVFORMAT_VERSION_MAJOR <= 52}
-function udp_get_file_handle(h: PURLContext): cint;
- cdecl; external av__format;
-{$IFEND}
-
-implementation
-
-function url_is_streamed(s: PByteIOContext): cint;
-begin
- Result := s^.is_streamed;
-end;
-
-end.
diff --git a/src/lib/ffmpeg/avutil.pas b/src/lib/ffmpeg/avutil.pas
deleted file mode 100644
index 55bab601..00000000
--- a/src/lib/ffmpeg/avutil.pas
+++ /dev/null
@@ -1,420 +0,0 @@
-(*
- * 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.
- * - Changes and updates by the UltraStar Deluxe Team
- *)
-
-(*
- * Conversions of
- *
- * libavutil/avutil.h:
- * Min. version: 49.0.1, revision 6577, Sat Oct 7 15:30:46 2006 UTC
- * Max. version: 49.14.0, revision 16912, Sun Feb 1 02:00:19 2009 UTC
- *
- * libavutil/mem.h:
- * revision 16590, Tue Jan 13 23:44:16 2009 UTC
- *
- * libavutil/log.h:
- * revision 16571, Tue Jan 13 00:14:43 2009 UTC
- *)
-{
- Update changes auf avutil.h, mem.h and log.h
- Max. version 50.05.1, Sun, Dec 6 24:00:00 2009 UTC
- include/keep pixfmt.h (change in revision 50.01.0)
- Maybe, the pixelformats are not needed, but it has not been checked.
- log.h is only partial.
-}
-
-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
- ctypes,
- mathematics,
- rational,
- UConfig;
-
-const
- (* Max. supported version by this header *)
- LIBAVUTIL_MAX_VERSION_MAJOR = 50;
- LIBAVUTIL_MAX_VERSION_MINOR = 5;
- LIBAVUTIL_MAX_VERSION_RELEASE = 1;
- LIBAVUTIL_MAX_VERSION = (LIBAVUTIL_MAX_VERSION_MAJOR * VERSION_MAJOR) +
- (LIBAVUTIL_MAX_VERSION_MINOR * VERSION_MINOR) +
- (LIBAVUTIL_MAX_VERSION_RELEASE * VERSION_RELEASE);
-
- (* Min. supported version by this header *)
- LIBAVUTIL_MIN_VERSION_MAJOR = 49;
- LIBAVUTIL_MIN_VERSION_MINOR = 0;
- LIBAVUTIL_MIN_VERSION_RELEASE = 1;
- LIBAVUTIL_MIN_VERSION = (LIBAVUTIL_MIN_VERSION_MAJOR * VERSION_MAJOR) +
- (LIBAVUTIL_MIN_VERSION_MINOR * VERSION_MINOR) +
- (LIBAVUTIL_MIN_VERSION_RELEASE * VERSION_RELEASE);
-
-(* Check if linked versions are supported *)
-{$IF (LIBAVUTIL_VERSION < LIBAVUTIL_MIN_VERSION)}
- {$MESSAGE Error 'Linked version of libavutil is too old!'}
-{$IFEND}
-
-{$IF (LIBAVUTIL_VERSION > LIBAVUTIL_MAX_VERSION)}
- {$MESSAGE Error 'Linked version of libavutil is not yet supported!'}
-{$IFEND}
-
-{$IF LIBAVUTIL_VERSION >= 49008000} // 49.8.0
-(**
- * Returns the LIBAVUTIL_VERSION_INT constant.
- *)
-function avutil_version(): cuint;
- cdecl; external av__format;
-{$IFEND}
-
-{$IF LIBAVUTIL_VERSION >= 50004000} // >= 50.4.0
-(**
- * Returns the libavutil build-time configuration.
- *)
-function avutil_configuration(): PAnsiChar;
- cdecl; external av__format;
-
-(**
- * Returns the libavutil license.
- *)
-function avutil_license(): PAnsiChar;
- cdecl; external av__format;
-{$IFEND}
-
-type
-(**
- * Pixel format. Notes:
- *
- * PIX_FMT_RGB32 is handled in an endian-specific manner. An 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], 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.
- *
- * For all the 8bit per pixel formats, an RGB32 palette is in data[1] like
- * for pal8. This palette is filled in automatically by the function
- * allocating the picture.
- *
- * Note, make sure that all newly added big endian formats have pix_fmt&1==1
- * and that all newly added little endian formats have pix_fmt&1==0
- * this allows simpler detection of big vs little endian.
- *)
-
- 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)
-{$IF LIBAVUTIL_VERSION <= 50001000} // 50.01.0
- PIX_FMT_RGB32, ///< packed RGB 8:8:8, 32bpp, (msb)8A 8R 8G 8B(lsb), in CPU endianness
-{$IFEND}
- 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)
-{$IF LIBAVUTIL_VERSION <= 50000000} // 50.00.0
- 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 0
-{$IFEND}
- 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
- 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
-{$IF LIBAVUTIL_VERSION <= 50001000} // 50.01.0
- PIX_FMT_BGR32, ///< packed RGB 8:8:8, 32bpp, (msb)8A 8B 8G 8R(lsb), in CPU endianness
-{$IFEND}
-{$IF LIBAVUTIL_VERSION <= 50000000} // 50.00.0
- 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
-{$IFEND}
- 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)1R 2G 1B(lsb)
- PIX_FMT_RGB4_BYTE, ///< packed RGB 1:2:1, 8bpp, (msb)1R 2G 1B(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
-{$IF LIBAVUTIL_VERSION <= 50001000} // 50.01.0
- 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
-{$ELSE} // 50.02.0
- PIX_FMT_ARGB, ///< packed ARGB 8:8:8:8, 32bpp, ARGBARGB...
- PIX_FMT_RGBA, ///< packed RGBA 8:8:8:8, 32bpp, RGBARGBA...
- PIX_FMT_ABGR, ///< packed ABGR 8:8:8:8, 32bpp, ABGRABGR...
- PIX_FMT_BGRA, ///< packed BGRA 8:8:8:8, 32bpp, BGRABGRA...
-{$IFEND}
- 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_VDPAU_H264,///< H.264 HW decoding with VDPAU, data[0] contains a vdpau_render_state struct which contains the bitstream of the slices as well as various fields extracted from headers
- PIX_FMT_VDPAU_MPEG1,///< MPEG-1 HW decoding with VDPAU, data[0] contains a vdpau_render_state struct which contains the bitstream of the slices as well as various fields extracted from headers
- PIX_FMT_VDPAU_MPEG2,///< MPEG-2 HW decoding with VDPAU, data[0] contains a vdpau_render_state struct which contains the bitstream of the slices as well as various fields extracted from headers
- PIX_FMT_VDPAU_WMV3,///< WMV3 HW decoding with VDPAU, data[0] contains a vdpau_render_state struct which contains the bitstream of the slices as well as various fields extracted from headers
- PIX_FMT_VDPAU_VC1, ///< VC-1 HW decoding with VDPAU, data[0] contains a vdpau_render_state struct which contains the bitstream of the slices as well as various fields extracted from headers
-{$IF LIBAVUTIL_VERSION >= 49015000} // 49.15.0
- PIX_FMT_RGB48BE, ///< packed RGB 16:16:16, 48bpp, 16R, 16G, 16B, big-endian
- PIX_FMT_RGB48LE, ///< packed RGB 16:16:16, 48bpp, 16R, 16G, 16B, little-endian
-{$IFEND}
-{$IF LIBAVUTIL_VERSION >= 50001000} // 50.01.0
- PIX_FMT_RGB565BE, ///< packed RGB 5:6:5, 16bpp, (msb) 5R 6G 5B(lsb), big-endian
- PIX_FMT_RGB565LE, ///< packed RGB 5:6:5, 16bpp, (msb) 5R 6G 5B(lsb), little-endian
- PIX_FMT_RGB555BE, ///< packed RGB 5:5:5, 16bpp, (msb)1A 5R 5G 5B(lsb), big-endian, most significant bit to 0
- PIX_FMT_RGB555LE, ///< packed RGB 5:5:5, 16bpp, (msb)1A 5R 5G 5B(lsb), little-endian, most significant bit to 0
-
- PIX_FMT_BGR565BE, ///< packed BGR 5:6:5, 16bpp, (msb) 5B 6G 5R(lsb), big-endian
- PIX_FMT_BGR565LE, ///< packed BGR 5:6:5, 16bpp, (msb) 5B 6G 5R(lsb), little-endian
- PIX_FMT_BGR555BE, ///< packed BGR 5:5:5, 16bpp, (msb)1A 5B 5G 5R(lsb), big-endian, most significant bit to 1
- PIX_FMT_BGR555LE, ///< packed BGR 5:5:5, 16bpp, (msb)1A 5B 5G 5R(lsb), little-endian, most significant bit to 1
-
- PIX_FMT_VAAPI_MOCO, ///< HW acceleration through VA API at motion compensation entry-point, Picture.data[3] contains a vaapi_render_state struct which contains macroblocks as well as various fields extracted from headers
- PIX_FMT_VAAPI_IDCT, ///< HW acceleration through VA API at IDCT entry-point, Picture.data[3] contains a vaapi_render_state struct which contains fields extracted from headers
- PIX_FMT_VAAPI_VLD, ///< HW decoding through VA API, Picture.data[3] contains a vaapi_render_state struct which contains the bitstream of the slices as well as various fields extracted from headers
-{$IFEND}
- 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}
- {$IF LIBAVUTIL_VERSION <= 50001000} // 50.01.0
- 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;
- {$ELSE} // 50.02.0
- PIX_FMT_RGB32 = PIX_FMT_ARGB;
- PIX_FMT_RGB32_1 = PIX_FMT_RGBA;
- PIX_FMT_BGR32 = PIX_FMT_ABGR;
- PIX_FMT_BGR32_1 = PIX_FMT_BGRA;
- {$IFEND}
- PIX_FMT_GRAY16 = PIX_FMT_GRAY16BE;
- {$IF LIBAVUTIL_VERSION >= 49015000} // 49.15.0
- PIX_FMT_RGB48 = PIX_FMT_RGB48BE;
- {$IFEND}
- {$IF LIBAVUTIL_VERSION >= 50001000} // 50.01.0
- PIX_FMT_RGB565 = PIX_FMT_RGB565BE;
- PIX_FMT_RGB555 = PIX_FMT_RGB555BE;
- PIX_FMT_BGR565 = PIX_FMT_BGR565BE;
- PIX_FMT_BGR555 = PIX_FMT_BGR555BE
- {$IFEND}
-{$else}
- {$IF LIBAVUTIL_VERSION <= 50001000} // 50.01.0
- 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;
- {$ELSE} // 50.02.0
- PIX_FMT_RGB32 = PIX_FMT_BGRA;
- PIX_FMT_RGB32_1 = PIX_FMT_ABGR;
- PIX_FMT_BGR32 = PIX_FMT_RGBA;
- PIX_FMT_BGR32_1 = PIX_FMT_ARGB;
- {$IFEND}
- PIX_FMT_GRAY16 = PIX_FMT_GRAY16LE;
- {$IF LIBAVUTIL_VERSION >= 49015000} // 49.15.0
- PIX_FMT_RGB48 = PIX_FMT_RGB48LE;
- {$IFEND}
- {$IF LIBAVUTIL_VERSION >= 50001000} // 50.01.0
- PIX_FMT_RGB565 = PIX_FMT_RGB565LE;
- PIX_FMT_RGB555 = PIX_FMT_RGB555LE;
- PIX_FMT_BGR565 = PIX_FMT_BGR565LE;
- PIX_FMT_BGR555 = PIX_FMT_BGR555LE;
- {$IFEND}
-{$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}
-
-(* libavutil/common.h *) // until now MKTAG is all from common.h KMS 9/6/2009
-
-function MKTAG(a, b, c, d: AnsiChar): integer;
-
-(* libavutil/mem.h *)
-(* memory handling functions *)
-
-(**
- * Allocates a block of 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 the block cannot
- * be allocated.
- * @see av_mallocz()
- *)
-function av_malloc(size: cuint): pointer;
- cdecl; external av__util; {av_malloc_attrib av_alloc_size(1)}
-
-(**
- * Allocates or reallocates a block of memory.
- * If ptr is NULL and size > 0, allocates a new block. If
- * size is zero, frees the memory block pointed to by 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 the block
- * cannot be allocated or the function is used to free the memory block.
- * @see av_fast_realloc()
- *)
-function av_realloc(ptr: pointer; size: cuint): pointer;
- cdecl; external av__util; {av_alloc_size(2)}
-
-(**
- * Frees 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;
-
-(**
- * Allocates a block of size bytes with alignment suitable for all
- * memory accesses (including vectors if available on the CPU) and
- * 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 be allocated.
- * @see av_malloc()
- *)
-function av_mallocz(size: cuint): pointer;
- cdecl; external av__util; {av_malloc_attrib av_alloc_size(1)}
-
-(**
- * Duplicates the string s.
- * @param s string to be duplicated.
- * @return Pointer to a newly allocated string containing a
- * copy of s or NULL if the string cannot be allocated.
- *)
-function av_strdup({const} s: PAnsiChar): PAnsiChar;
- cdecl; external av__util; {av_malloc_attrib}
-
-(**
- * Frees a memory block which has been allocated with av_malloc(z)() or
- * av_realloc() and set the pointer pointing to it to NULL.
- * @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;
-
-(* libavutil/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.
- * For example, no header was found for a format which depends
- * on headers or an illegal combination of parameters is used.
- *)
- AV_LOG_FATAL = 8;
-
-(**
- * Something went wrong and cannot losslessly be recovered.
- * However, not all future data is affected.
- *)
- AV_LOG_ERROR = 16;
-
-(**
- * Something somehow does not look correct. This may or may not
- * lead to problems. An example would be the 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(): cint;
- cdecl; external av__util;
-procedure av_log_set_level(level: cint);
- cdecl; external av__util;
-
-
-implementation
-
-(* libavutil/common.h *)
-
-function MKTAG(a, b, c, d: AnsiChar): 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/src/lib/ffmpeg/mathematics.pas b/src/lib/ffmpeg/mathematics.pas
deleted file mode 100644
index f3a307b6..00000000
--- a/src/lib/ffmpeg/mathematics.pas
+++ /dev/null
@@ -1,104 +0,0 @@
-(*
- * copyright (c) 2005 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.
- * - Changes and updates by the UltraStar Deluxe Team
- *)
-
-(*
- * Conversion of libavutil/mathematics.h
- * revision 16844, Wed Jan 28 08:50:10 2009 UTC
- *
- * update, MiSchi, no code change
- * Fri Jun 12 2009 21:50:00 UTC
- *)
-{
- * update to
- * avutil max. version 50.05.1, Sun, Dec 6 24:00:00 2009 UTC
- * MiSchi
-}
-
-unit mathematics;
-
-{$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}
-
-interface
-
-uses
- ctypes,
- rational,
- UConfig;
-
-const
- M_E = 2.7182818284590452354; // e
- M_LN2 = 0.69314718055994530942; // log_e 2
- M_LN10 = 2.30258509299404568402; // log_e 10
- M_PI = 3.14159265358979323846; // pi
- M_SQRT1_2 = 0.70710678118654752440; // 1/sqrt(2)
-{$IF LIBAVUTIL_VERSION >= 50005001} // >= 50.5.1
- NAN = 0.0/0.0;
- INFINITY = 1.0/0.0;
-{$IFEND}
-
-type
- TAVRounding = (
- AV_ROUND_ZERO = 0, ///< Round toward zero.
- AV_ROUND_INF = 1, ///< Round away from zero.
- AV_ROUND_DOWN = 2, ///< Round toward -infinity.
- AV_ROUND_UP = 3, ///< Round toward +infinity.
- AV_ROUND_NEAR_INF = 5 ///< Round to nearest and halfway cases away from zero.
- );
-
-{$IF LIBAVUTIL_VERSION >= 49013000} // 49.13.0
-function av_gcd(a: cint64; b: cint64): cint64;
- cdecl; external av__util; {av_const}
-{$IFEND}
-
-(**
- * Rescales a 64-bit integer with rounding to nearest.
- * A simple a*b/c isn't possible as it can overflow.
- *)
-function av_rescale (a, b, c: cint64): cint64;
- cdecl; external av__util; {av_const}
-
-(**
- * Rescales a 64-bit integer with specified rounding.
- * A simple a*b/c isn't possible as it can overflow.
- *)
-function av_rescale_rnd (a, b, c: cint64; enum: TAVRounding): cint64;
- cdecl; external av__util; {av_const}
-
-(**
- * Rescales a 64-bit integer by 2 rational numbers.
- *)
-function av_rescale_q (a: cint64; bq, cq: TAVRational): cint64;
- cdecl; external av__util; {av_const}
-
-implementation
-
-end.
diff --git a/src/lib/ffmpeg/opt.pas b/src/lib/ffmpeg/opt.pas
deleted file mode 100644
index 86144598..00000000
--- a/src/lib/ffmpeg/opt.pas
+++ /dev/null
@@ -1,272 +0,0 @@
-(*
- * AVOptions
- * copyright (c) 2005 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.
- * - Changes and updates by the UltraStar Deluxe Team
- *)
-
-(*
- * Conversion of libavcodec/opt.h
- * revision 16912, Sun Feb 1 02:00:19 2009 UTC
- *
- * update, MiSchi, no code change
- * Fri Jun 12 2009 21:50:00 UTC
- *)
-{
- * update to
- * Max. version: 52.42.0, Sun Dec 6 19:20:00 2009 CET
- * MiSchi
-}
-
-unit opt;
-
-{$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}
-
-interface
-
-uses
- ctypes,
- rational,
- UConfig;
-
-type
- TAVOptionType = (
- FF_OPT_TYPE_FLAGS,
- FF_OPT_TYPE_INT,
- FF_OPT_TYPE_INT64,
- FF_OPT_TYPE_DOUBLE,
- FF_OPT_TYPE_FLOAT,
- FF_OPT_TYPE_STRING,
- FF_OPT_TYPE_RATIONAL,
- FF_OPT_TYPE_BINARY, ///< offset must point to a pointer immediately followed by an int for the length
- FF_OPT_TYPE_CONST = 128
- );
-
-const
- AV_OPT_FLAG_ENCODING_PARAM = 1; ///< a generic parameter which can be set by the user for muxing or encoding
- AV_OPT_FLAG_DECODING_PARAM = 2; ///< a generic parameter which can be set by the user for demuxing or decoding
- AV_OPT_FLAG_METADATA = 4; ///< some data extracted or inserted into the file like title, comment, ...
- AV_OPT_FLAG_AUDIO_PARAM = 8;
- AV_OPT_FLAG_VIDEO_PARAM = 16;
- AV_OPT_FLAG_SUBTITLE_PARAM = 32;
-
-type
- (**
- * AVOption
- *)
- PAVOption = ^TAVOption;
- TAVOption = record
- name: {const} PAnsiChar;
-
- (**
- * short English help text
- * @todo What about other languages?
- *)
- help: {const} PAnsiChar;
-
- (**
- * The offset relative to the context structure where the option
- * value is stored. It should be 0 for named constants.
- *)
- offset: cint;
- type_: TAVOptionType;
-
- (**
- * the default value for scalar options
- *)
- default_val: cdouble;
- min: cdouble; ///< minimum valid value for the option
- max: cdouble; ///< maximum valid value for the option
-
- flags: cint;
-//FIXME think about enc-audio, ... style flags
-
- (**
- * The logical unit to which the option belongs. Non-constant
- * options and corresponding named constants share the same
- * unit. May be NULL.
- *)
- unit_: {const} PAnsiChar;
- end;
-
-{$IF LIBAVCODEC_VERSION >= 52042000} // >= 52.42.0
-(**
- * AVOption2.
- * THIS IS NOT PART OF THE API/ABI YET!
- * This is identical to AVOption except that default_val was replaced by
- * an union, it should be compatible with AVOption on normal platforms.
- *)
-type
- PAVOption2 = ^TAVOption2;
- TAVOption2 = record
- name : {const} PAnsiChar;
-
- (**
- * short English help text
- * @todo What about other languages?
- *)
- help : {const} PAnsiChar;
-
- (**
- * The offset relative to the context structure where the option
- * value is stored. It should be 0 for named constants.
- *)
- offset : cint;
- type_ : TAVOptionType;
-
- (**
- * the default value for scalar options
- *)
- default_val : record
- case cint of
- 0 : (dbl: cdouble);
- 1 : (str: PAnsiChar);
- end;
- min : cdouble;
- max : cdouble;
- flags : cint;
-//FIXME think about enc-audio, ... style flags
-
- (**
- * The logical unit to which the option belongs. Non-constant
- * options and corresponding named constants share the same
- * unit. May be NULL.
- *)
- unit_: {const} PAnsiChar;
- end;
-{$IFEND}
-
-{$IF LIBAVCODEC_VERSION >= 51039000} // 51.39.0
-(**
- * Looks for an option in obj. Looks only for the options which
- * have the flags set as specified in mask and flags (that is,
- * for which it is the case that opt->flags & mask == flags).
- *
- * @param[in] obj a pointer to a struct whose first element is a
- * pointer to an AVClass
- * @param[in] name the name of the option to look for
- * @param[in] unit the unit of the option to look for, or any if NULL
- * @return a pointer to the option found, or NULL if no option
- * has been found
- *)
-function av_find_opt(obj: Pointer; {const} name: {const} PAnsiChar; {const} unit_: PAnsiChar; mask: cint; flags: cint): {const} PAVOption;
- cdecl; external av__codec;
-{$IFEND}
-
-{$IF LIBAVCODEC_VERSION_MAJOR < 53}
-
-(**
- * @see av_set_string2()
- *)
-function av_set_string(obj: pointer; name: {const} PAnsiChar; val: {const} PAnsiChar): {const} PAVOption;
- cdecl; external av__codec; deprecated;
-
-{$IF LIBAVCODEC_VERSION >= 51059000} // 51.59.0
-(**
- * @return a pointer to the AVOption corresponding to the field set or
- * NULL if no matching AVOption exists, or if the value val is not
- * valid
- * @see av_set_string3()
- *)
-function av_set_string2(obj: Pointer; name: {const} PAnsiChar; val: {const} PAnsiChar; alloc: cint): {const} PAVOption;
- cdecl; external av__codec; deprecated;
-{$IFEND}
-
-{$IFEND}
-
-{$IF LIBAVCODEC_VERSION >= 52007000} // 52.7.0
-(**
- * Sets the field of obj with the given name to value.
- *
- * @param[in] obj A struct whose first element is a pointer to an
- * AVClass.
- * @param[in] name the name of the field to set
- * @param[in] val The value to set. If the field is not of a string
- * type, then the given string is parsed.
- * SI postfixes and some named scalars are supported.
- * If the field is of a numeric type, it has to be a numeric or named
- * scalar. Behavior with more than one scalar and +- infix operators
- * is undefined.
- * If the field is of a flags type, it has to be a sequence of numeric
- * scalars or named flags separated by '+' or '-'. Prefixing a flag
- * with '+' causes it to be set without affecting the other flags;
- * similarly, '-' unsets a flag.
- * @param[out] o_out if non-NULL put here a pointer to the AVOption
- * found
- * @param alloc when 1 then the old value will be av_freed() and the
- * new av_strduped()
- * when 0 then no av_free() nor av_strdup() will be used
- * @return 0 if the value has been set, or an AVERROR code in case of
- * error:
- * AVERROR(ENOENT) if no matching option exists
- * AVERROR(ERANGE) if the value is out of range
- * AVERROR(EINVAL) if the value is not valid
- *)
-function av_set_string3(obj: Pointer; name: {const} PAnsiChar; val: {const} PAnsiChar; alloc: cint; out o_out: {const} PAVOption): cint;
- cdecl; external av__codec;
-{$IFEND}
-
-function av_set_double(obj: pointer; name: {const} PAnsiChar; n: cdouble): PAVOption;
- cdecl; external av__codec;
-
-function av_set_q(obj: pointer; name: {const} PAnsiChar; n: TAVRational): PAVOption;
- cdecl; external av__codec;
-
-function av_set_int(obj: pointer; name: {const} PAnsiChar; n: cint64): PAVOption;
- cdecl; external av__codec;
-
-function av_get_double(obj: pointer; name: {const} PAnsiChar; var o_out: PAVOption): cdouble;
- cdecl; external av__codec;
-
-function av_get_q(obj: pointer; name: {const} PAnsiChar; var o_out: PAVOption): TAVRational;
- cdecl; external av__codec;
-
-function av_get_int(obj: pointer; name: {const} PAnsiChar; var o_out: {const} PAVOption): cint64;
- cdecl; external av__codec;
-
-function av_get_string(obj: pointer; name: {const} PAnsiChar; var o_out: {const} PAVOption; buf: PAnsiChar; buf_len: cint): PAnsiChar;
- cdecl; external av__codec;
-
-function av_next_option(obj: pointer; last: {const} PAVOption): PAVOption;
- cdecl; external av__codec;
-
-function av_opt_show(obj: pointer; av_log_obj: pointer): cint;
- cdecl; external av__codec;
-
-procedure av_opt_set_defaults(s: pointer);
- cdecl; external av__codec;
-
-{$IF LIBAVCODEC_VERSION >= 51039000} // 51.39.0
-procedure av_opt_set_defaults2(s: Pointer; mask: cint; flags: cint);
- cdecl; external av__codec;
-{$IFEND}
-
-implementation
-
-end.
diff --git a/src/lib/ffmpeg/rational.pas b/src/lib/ffmpeg/rational.pas
deleted file mode 100644
index 4b8a2dc8..00000000
--- a/src/lib/ffmpeg/rational.pas
+++ /dev/null
@@ -1,179 +0,0 @@
-(*
- * rational numbers
- * Copyright (c) 2003 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.
- * - Changes and updates by the UltraStar Deluxe Team
- *)
-
-(*
- * Conversion of libavutil/rational.h
- * revision 16912, Sun Feb 1 02:00:19 2009 UTC
- *
- * update, MiSchi, no code change
- * Fri Jun 12 2009 22:20:00 UTC
- *
- * update, MiSchi, no code change needed
- * Sun Dec 6 2009 22:20:00 UTC
- *)
-
-unit rational;
-
-{$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}
-
-{$I switches.inc}
-
-interface
-
-uses
- ctypes,
- UConfig;
-
-type
- (*
- * rational number numerator/denominator
- *)
- PAVRational = ^TAVRational;
- TAVRational = record
- num: cint; ///< numerator
- den: cint; ///< denominator
- end;
-
- TAVRationalArray = array[0 .. (MaxInt div SizeOf(TAVRational))-1] of TAVRational;
- PAVRationalArray = ^TAVRationalArray;
-
-(**
- * Compares two rationals.
- * @param a first rational
- * @param b second rational
- * @return 0 if a==b, 1 if a>b and -1 if a<b
- *)
-function av_cmp_q(a: TAVRational; b: TAVRational): cint; {$IFDEF HasInline}inline;{$ENDIF}
-
-(**
- * Converts rational to double.
- * @param a rational to convert
- * @return (double) a
- *)
-function av_q2d(a: TAVRational): cdouble; {$IFDEF HasInline}inline;{$ENDIF}
-
-(**
- * Reduces a fraction.
- * This is useful for framerate calculations.
- * @param dst_num destination numerator
- * @param dst_den destination denominator
- * @param num source numerator
- * @param den source denominator
- * @param max the maximum allowed for dst_num & dst_den
- * @return 1 if exact, 0 otherwise
- *)
-function av_reduce(dst_num: PCint; dst_den: PCint; num: cint64; den: cint64; max: cint64): cint;
- cdecl; external av__util;
-
-(**
- * Multiplies two rationals.
- * @param b first rational
- * @param c second rational
- * @return b*c
- *)
-function av_mul_q(b: TAVRational; c: TAVRational): TAVRational;
- cdecl; external av__util; {av_const}
-
-(**
- * Divides one rational by another.
- * @param b first rational
- * @param c second rational
- * @return b/c
- *)
-function av_div_q(b: TAVRational; c: TAVRational): TAVRational;
- cdecl; external av__util; {av_const}
-
-(**
- * Adds two rationals.
- * @param b first rational
- * @param c second rational
- * @return b+c
- *)
-function av_add_q(b: TAVRational; c: TAVRational): TAVRational;
- cdecl; external av__util; {av_const}
-
-(**
- * Subtracts one rational from another.
- * @param b first rational
- * @param c second rational
- * @return b-c
- *)
-function av_sub_q(b: TAVRational; c: TAVRational): TAVRational;
- cdecl; external av__util; {av_const}
-
-(**
- * Converts a double precision floating point number to a rational.
- * @param d double to convert
- * @param max the maximum allowed numerator and denominator
- * @return (AVRational) d
- *)
-function av_d2q(d: cdouble; max: cint): TAVRational;
- cdecl; external av__util; {av_const}
-
-{$IF LIBAVUTIL_VERSION >= 49011000} // 49.11.0
-(**
- * @return 1 if q1 is nearer to q than q2, -1 if q2 is nearer
- * than q1, 0 if they have the same distance.
- *)
-function av_nearer_q(q, q1, q2: TAVRational): cint;
- cdecl; external av__util;
-
-(**
- * Finds the nearest value in q_list to q.
- * @param q_list an array of rationals terminated by {0, 0}
- * @return the index of the nearest value found in the array
- *)
-function av_find_nearest_q_idx(q: TAVRational; q_list: {const} PAVRationalArray): cint;
- cdecl; external av__util;
-{$IFEND}
-
-implementation
-
-function av_cmp_q (a: TAVRational; b: TAVRational): cint;
-var
- tmp: cint64;
-begin
- tmp := a.num * cint64(b.den) - b.num * cint64(a.den);
-
- if (tmp <> 0) then
- Result := (tmp shr 63) or 1
- else
- Result := 0
-end;
-
-function av_q2d(a: TAVRational): cdouble;
-begin
- Result := a.num / a.den;
-end;
-
-end.
diff --git a/src/lib/ffmpeg/swscale.pas b/src/lib/ffmpeg/swscale.pas
deleted file mode 100644
index 595e16ba..00000000
--- a/src/lib/ffmpeg/swscale.pas
+++ /dev/null
@@ -1,355 +0,0 @@
-(*
- * Copyright (C) 2001-2003 Michael Niedermayer <michaelni@gmx.at>
- *
- * FFmpeg 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.1 of the License, or (at your option) any later version.
- *
- * FFmpeg 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 FFmpeg; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
- *)
-
-(*
- * FFmpeg Pascal port
- * - Ported by the UltraStar Deluxe Team
- *)
-
-(*
- * Conversion of libswscale/swscale.h
- * revision 27592, Fri Sep 12 21:46:53 2008 UTC
- *)
-{
- * update to
- * Max. version: 0.7.2, Sun Dec 6 22:20:00 2009 CET
- * MiSchi
-}
-
-unit swscale;
-
-{$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 libswscale}
-{$ENDIF}
-
-interface
-
-uses
- ctypes,
- avutil,
- avcodec,
- UConfig;
-
-const
- (* Max. supported version by this header *)
- LIBSWSCALE_MAX_VERSION_MAJOR = 0;
- LIBSWSCALE_MAX_VERSION_MINOR = 7;
- LIBSWSCALE_MAX_VERSION_RELEASE = 2;
- LIBSWSCALE_MAX_VERSION = (LIBSWSCALE_MAX_VERSION_MAJOR * VERSION_MAJOR) +
- (LIBSWSCALE_MAX_VERSION_MINOR * VERSION_MINOR) +
- (LIBSWSCALE_MAX_VERSION_RELEASE * VERSION_RELEASE);
-
-(* Check if linked versions are supported *)
-{$IF (LIBSWSCALE_VERSION > LIBSWSCALE_MAX_VERSION)}
- {$MESSAGE Error 'Linked version of libswscale is not yet supported!'}
-{$IFEND}
-
-type
- TQuadCintArray = array[0..3] of cint;
- PQuadCintArray = ^TQuadCintArray;
- TCintArray = array[0..0] of cint;
- PCintArray = ^TCintArray;
- TPCuint8Array = array[0..0] of PCuint8;
- PPCuint8Array = ^TPCuint8Array;
-
-{$IF LIBSWSCALE_VERSION >= 000006001} // 0.6.1
-(**
- * Returns the LIBSWSCALE_VERSION_INT constant.
- *)
-function swscale_version(): cuint;
- cdecl; external sw__scale;
-{$IFEND}
-
-{$IF LIBSWSCALE_VERSION >= 000007002} // 0.7.2
-(**
- * Returns the libswscale build-time configuration.
- *)
-function swscale_configuration(): PAnsiChar;
- cdecl; external sw__scale;
-
-(**
- * Returns the libswscale license.
- *)
-function swscale_license(): PAnsiChar;
- cdecl; external sw__scale;
-{$IFEND}
-
-const
- (* values for the flags, the stuff on the command line is different *)
- SWS_FAST_BILINEAR = 1;
- SWS_BILINEAR = 2;
- SWS_BICUBIC = 4;
- SWS_X = 8;
- SWS_POINT = $10;
- SWS_AREA = $20;
- SWS_BICUBLIN = $40;
- SWS_GAUSS = $80;
- SWS_SINC = $100;
- SWS_LANCZOS = $200;
- SWS_SPLINE = $400;
-
- SWS_SRC_V_CHR_DROP_MASK = $30000;
- SWS_SRC_V_CHR_DROP_SHIFT = 16;
-
- SWS_PARAM_DEFAULT = 123456;
-
- SWS_PRINT_INFO = $1000;
-
- // the following 3 flags are not completely implemented
- // internal chrominace subsampling info
- SWS_FULL_CHR_H_INT = $2000;
- // input subsampling info
- SWS_FULL_CHR_H_INP = $4000;
- SWS_DIRECT_BGR = $8000;
- SWS_ACCURATE_RND = $40000;
- SWS_BITEXACT = $80000;
-
- SWS_CPU_CAPS_MMX = $80000000;
- SWS_CPU_CAPS_MMX2 = $20000000;
- SWS_CPU_CAPS_3DNOW = $40000000;
- SWS_CPU_CAPS_ALTIVEC = $10000000;
- SWS_CPU_CAPS_BFIN = $01000000;
-
- SWS_MAX_REDUCE_CUTOFF = 0.002;
-
- SWS_CS_ITU709 = 1;
- SWS_CS_FCC = 4;
- SWS_CS_ITU601 = 5;
- SWS_CS_ITU624 = 5;
- SWS_CS_SMPTE170M = 5;
- SWS_CS_SMPTE240M = 7;
- SWS_CS_DEFAULT = 5;
-
-type
-
- // when used for filters they must have an odd number of elements
- // coeffs cannot be shared between vectors
- PSwsVector = ^TSwsVector;
- TSwsVector = record
- coeff: PCdouble; // pointer to the list of coefficients
- length: cint; // number of coefficients in the vector
- end;
-
- // vectors can be shared
- PSwsFilter = ^TSwsFilter;
- TSwsFilter = record
- lumH: PSwsVector;
- lumV: PSwsVector;
- chrH: PSwsVector;
- chrV: PSwsVector;
- end;
-
- PSwsContext = ^TSwsContext;
- TSwsContext = record
- {internal structure}
- end;
-
-(**
- * Frees the swscaler context swsContext.
- * If swsContext is NULL, then does nothing.
- *)
-procedure sws_freeContext(swsContext: PSwsContext);
- cdecl; external sw__scale;
-
-(**
- * Allocates and returns a SwsContext. You need it to perform
- * scaling/conversion operations using sws_scale().
- *
- * @param srcW the width of the source image
- * @param srcH the height of the source image
- * @param srcFormat the source image format
- * @param dstW the width of the destination image
- * @param dstH the height of the destination image
- * @param dstFormat the destination image format
- * @param flags specify which algorithm and options to use for rescaling
- * @return a pointer to an allocated context, or NULL in case of error
- *)
-function sws_getContext(srcW: cint; srcH: cint; srcFormat: TAVPixelFormat;
- dstW: cint; dstH: cint; dstFormat: TAVPixelFormat;
- flags: cint; srcFilter: PSwsFilter;
- dstFilter: PSwsFilter; param: PCdouble): PSwsContext;
- cdecl; external sw__scale;
-
-(**
- * Scales the image slice in srcSlice and puts the resulting scaled
- * slice in the image in dst. A slice is a sequence of consecutive
- * rows in an image.
- *
- * Slices have to be provided in sequential order, either in
- * top-bottom or bottom-top order. If slices are provided in
- * non-sequential order the behavior of the function is undefined.
- *
- * @param context the scaling context previously created with
- * sws_getContext()
- * @param srcSlice the array containing the pointers to the planes of
- * the source slice
- * @param srcStride the array containing the strides for each plane of
- * the source image
- * @param srcSliceY the position in the source image of the slice to
- * process, that is the number (counted starting from
- * zero) in the image of the first row of the slice
- * @param srcSliceH the height of the source slice, that is the number
- * of rows in the slice
- * @param dst the array containing the pointers to the planes of
- * the destination image
- * @param dstStride the array containing the strides for each plane of
- * the destination image
- * @return the height of the output slice
- *)
-function sws_scale(context: PSwsContext; srcSlice: PPCuint8Array; srcStride: PCintArray;
- srcSliceY: cint; srcSliceH: cint; dst: PPCuint8Array; dstStride: PCintArray): cint;
- cdecl; external sw__scale;
-
-{$IF LIBSWSCALE_VERSION_MAJOR < 1}
-// deprecated. Use sws_scale() instead.
-function sws_scale_ordered(context: PSwsContext; src: PPCuint8Array; srcStride: PCintArray;
- srcSliceY: cint; srcSliceH: cint; dst: PPCuint8Array; dstStride: PCintArray): cint;
- cdecl; external sw__scale; deprecated;
-{$IFEND}
-
-(**
- * @param inv_table the yuv2rgb coefficients, normally ff_yuv2rgb_coeffs[x]
- * @param fullRange if 1 then the luma range is 0..255 if 0 it is 16..235
- * @return -1 if not supported
- *)
-function sws_setColorspaceDetails(c: PSwsContext; inv_table: PQuadCintArray;
- srcRange: cint; table: PQuadCintArray; dstRange: cint;
- brightness: cint; contrast: cint; saturation: cint): cint;
- cdecl; external sw__scale;
-
-(**
- * @return -1 if not supported
- *)
-function sws_getColorspaceDetails(c: PSwsContext; var inv_table: PQuadCintArray;
- var srcRange: cint; var table: PQuadCintArray; var dstRange: cint;
- var brightness: cint; var contrast: cint; var saturation: cint): cint;
- cdecl; external sw__scale;
-
-(**
- * Returns a normalized Gaussian curve used to filter stuff
- * quality=3 is high quality, lower is lower quality.
- *)
-function sws_getGaussianVec(variance: cdouble; quality: cdouble): PSwsVector;
- cdecl; external sw__scale;
-
-(**
- * Allocates and returns a vector with length coefficients, all
- * with the same value c.
- *)
-function sws_getConstVec(c: cdouble; length: cint): PSwsVector;
- cdecl; external sw__scale;
-
-(**
- * Allocates and returns a vector with just one coefficient, with
- * value 1.0.
- *)
-function sws_getIdentityVec: PSwsVector;
- cdecl; external sw__scale;
-
-(**
- * Scales all the coefficients of a by the scalar value.
- *)
-procedure sws_scaleVec(a: PSwsVector; scalar: cdouble);
- cdecl; external sw__scale;
-
-(**
- * Scales all the coefficients of a so that their sum equals height.
- *)
-procedure sws_normalizeVec(a: PSwsVector; height: cdouble);
- cdecl; external sw__scale;
-
-procedure sws_convVec(a: PSwsVector; b: PSwsVector);
- cdecl; external sw__scale;
-
-procedure sws_addVec(a: PSwsVector; b: PSwsVector);
- cdecl; external sw__scale;
-
-procedure sws_subVec(a: PSwsVector; b: PSwsVector);
- cdecl; external sw__scale;
-
-procedure sws_shiftVec(a: PSwsVector; shift: cint);
- cdecl; external sw__scale;
-
-(**
- * Allocates and returns a clone of the vector a, that is a vector
- * with the same coefficients as a.
- *)
-function sws_cloneVec(a: PSwsVector): PSwsVector;
- cdecl; external sw__scale;
-
-{$IF LIBSWSCALE_VERSION_MAJOR < 1}
-// deprecated Use sws_printVec2() instead.
-
-procedure sws_printVec(a: PSwsVector);
- cdecl; external sw__scale; deprecated;
-{$IFEND}
-
-{$IF LIBSWSCALE_VERSION >= 000007000} // >= 0.7.0
-(**
- * Prints with av_log() a textual representation of the vector a
- * if log_level <= av_log_level.
- *)
-procedure sws_printVec2(a: PSwsVector;
- log_ctx: PAVClass; // PAVClass is declared in avcodec.pas
- log_level: cint);
- cdecl; external sw__scale;
-{$IFEND}
-
-procedure sws_freeVec(a: PSwsVector);
- cdecl; external sw__scale;
-
-function sws_getDefaultFilter(lumaGBlur: cfloat; chromaGBlur: cfloat;
- lumaSharpen: cfloat; chromaSharpen: cfloat;
- chromaHShift: cfloat; chromaVShift: cfloat;
- verbose: cint): PSwsFilter;
- cdecl; external sw__scale;
-
-procedure sws_freeFilter(filter: PSwsFilter);
- cdecl; external sw__scale;
-
-(**
- * Checks if context can be reused, otherwise reallocates a new
- * one.
- *
- * If context is NULL, just calls sws_getContext() to get a new
- * context. Otherwise, checks if the parameters are the ones already
- * saved in context. If that is the case, returns the current
- * context. Otherwise, frees context and gets a new context with
- * the new parameters.
- *
- * Be warned that srcFilter and dstFilter are not checked, they
- * are assumed to remain the same.
- *)
-function sws_getCachedContext(context: PSwsContext;
- srcW: cint; srcH: cint; srcFormat: TAVPixelFormat;
- dstW: cint; dstH: cint; dstFormat: TAVPixelFormat;
- flags: cint; srcFilter: PSwsFilter;
- dstFilter: PSwsFilter; param: PCdouble): PSwsContext;
- cdecl; external sw__scale;
-
-implementation
-
-end.
diff --git a/src/lib/fft/UFFT.pas b/src/lib/fft/UFFT.pas
deleted file mode 100644
index 5a056a8c..00000000
--- a/src/lib/fft/UFFT.pas
+++ /dev/null
@@ -1,602 +0,0 @@
-{**********************************************************************
-
- FFT.cpp
-
- Dominic Mazzoni
-
- September 2000
-
-***********************************************************************
-
-Fast Fourier Transform routines.
-
- This file contains a few FFT routines, including a real-FFT
- routine that is almost twice as fast as a normal complex FFT,
- and a power spectrum routine when you know you don't care
- about phase information.
-
- Some of this code was based on a free implementation of an FFT
- by Don Cross, available on the web at:
-
- http://www.intersrv.com/~dcross/fft.html
-
- The basic algorithm for his code was based on Numerican Recipes
- in Fortran. I optimized his code further by reducing array
- accesses, caching the bit reversal table, and eliminating
- float-to-double conversions, and I added the routines to
- calculate a real FFT and a real power spectrum.
-
-***********************************************************************
-
- Salvo Ventura - November 2006
- Added more window functions:
- * 4: Blackman
- * 5: Blackman-Harris
- * 6: Welch
- * 7: Gaussian(a=2.5)
- * 8: Gaussian(a=3.5)
- * 9: Gaussian(a=4.5)
-
-***********************************************************************
-
- This file is part of Audacity 1.3.4 beta (http://audacity.sourceforge.net/)
- Ported to Pascal by the UltraStar Deluxe Team
-}
-
-unit UFFT;
-
-{$IFDEF FPC}
- {$MODE Delphi}
- {$H+} // Use long strings
-{$ENDIF}
-
-interface
-type
- TSingleArray = array[0 .. (MaxInt div SizeOf(Single))-1] of Single;
- PSingleArray = ^TSingleArray;
-
- TFFTWindowFunc = (
- fwfRectangular,
- fwfBartlett,
- fwfHamming,
- fwfHanning,
- fwfBlackman,
- fwfBlackman_Harris,
- fwfWelch,
- fwfGaussian2_5,
- fwfGaussian3_5,
- fwfGaussian4_5
- );
-
-const
- FFTWindowName: array[TFFTWindowFunc] of string = (
- 'Rectangular',
- 'Bartlett',
- 'Hamming',
- 'Hanning',
- 'Blackman',
- 'Blackman-Harris',
- 'Welch',
- 'Gaussian(a=2.5)',
- 'Gaussian(a=3.5)',
- 'Gaussian(a=4.5)'
- );
-
-(*
- * This is the function you will use the most often.
- * Given an array of floats, this will compute the power
- * spectrum by doing a Real FFT and then computing the
- * sum of the squares of the real and imaginary parts.
- * Note that the output array is half the length of the
- * input array, and that NumSamples must be a power of two.
- *)
-procedure PowerSpectrum(NumSamples: Integer; In_, Out_: PSingleArray);
-
-(*
- * Computes an FFT when the input data is real but you still
- * want complex data as output. The output arrays are half
- * the length of the input, and NumSamples must be a power of
- * two.
- *)
-procedure RealFFT(NumSamples: integer;
- RealIn, RealOut, ImagOut: PSingleArray);
-
-(*
- * Computes a FFT of complex input and returns complex output.
- * Currently this is the only function here that supports the
- * inverse transform as well.
- *)
-procedure FFT(NumSamples: Integer;
- InverseTransform: boolean;
- RealIn, ImagIn, RealOut, ImagOut: PSingleArray);
-
-(*
- * Applies a windowing function to the data in place
- *
- * 0: Rectangular (no window)
- * 1: Bartlett (triangular)
- * 2: Hamming
- * 3: Hanning
- * 4: Blackman
- * 5: Blackman-Harris
- * 6: Welch
- * 7: Gaussian(a=2.5)
- * 8: Gaussian(a=3.5)
- * 9: Gaussian(a=4.5)
- *)
-procedure WindowFunc(whichFunction: TFFTWindowFunc; NumSamples: Integer; in_: PSingleArray);
-
-(*
- * Returns the name of the windowing function (for UI display)
- *)
-function WindowFuncName(whichFunction: TFFTWindowFunc): string;
-
-(*
- * Returns the number of windowing functions supported
- *)
-function NumWindowFuncs(): integer;
-
-
-implementation
-
-uses
- SysUtils;
-
-type TIntArray = array[0 .. (MaxInt div SizeOf(Integer))-1] of Integer;
-type PIntArray = ^TIntArray;
-type TIntIntArray = array[0 .. (MaxInt div SizeOf(PIntArray))-1] of PIntArray;
-type PIntIntArray = ^TIntIntArray;
-var gFFTBitTable: PIntIntArray;
-const MaxFastBits: Integer = 16;
-
-function IsPowerOfTwo(x: Integer): Boolean;
-begin
- if (x < 2) then
- result := false
- else if ((x and (x - 1)) <> 0) then { Thanks to 'byang' for this cute trick! }
- result := false
- else
- result := true;
-end;
-
-function NumberOfBitsNeeded(PowerOfTwo: Integer): Integer;
-var i: Integer;
-begin
- if (PowerOfTwo < 2) then begin
- Writeln(ErrOutput, Format('Error: FFT called with size %d\n', [PowerOfTwo]));
- Abort;
- end;
-
- i := 0;
- while(true) do begin
- if (PowerOfTwo and (1 shl i) <> 0) then begin
- result := i;
- Exit;
- end;
- Inc(i);
- end;
-end;
-
-function ReverseBits(index, NumBits: Integer): Integer;
-var
- i, rev: Integer;
-begin
- rev := 0;
- for i := 0 to NumBits-1 do begin
- rev := (rev shl 1) or (index and 1);
- index := index shr 1;
- end;
-
- result := rev;
-end;
-
-procedure InitFFT();
-var
- len: Integer;
- b, i: Integer;
-begin
- GetMem(gFFTBitTable, MaxFastBits * sizeof(PSingle));
-
- len := 2;
- for b := 1 to MaxFastBits do begin
- GetMem(gFFTBitTable[b - 1], len * sizeof(Single));
- for i := 0 to len-1 do
- gFFTBitTable[b - 1][i] := ReverseBits(i, b);
- len := len shl 1;
- end;
-end;
-
-function FastReverseBits(i, NumBits: Integer): Integer; {$IFDEF HasInline}inline;{$ENDIF}
-begin
- if (NumBits <= MaxFastBits) then
- result := gFFTBitTable[NumBits - 1][i]
- else
- result := ReverseBits(i, NumBits);
-end;
-
-{*
- * Complex Fast Fourier Transform
- *}
-procedure FFT(NumSamples: Integer;
- InverseTransform: boolean;
- RealIn, ImagIn, RealOut, ImagOut: PSingleArray);
-var
- NumBits: Integer; { Number of bits needed to store indices }
- i, j, k, n: Integer;
- BlockSize, BlockEnd: Integer;
- delta_angle: Double;
- angle_numerator: Double;
- tr, ti: Double; { temp real, temp imaginary }
- sm2, sm1, cm2, cm1: Double;
- w: Double;
- ar0, ar1, ar2, ai0, ai1, ai2: Double;
- denom: Single;
-begin
-
- angle_numerator := 2.0 * Pi;
-
- if (not IsPowerOfTwo(NumSamples)) then begin
- Writeln(ErrOutput, Format('%d is not a power of two', [NumSamples]));
- Abort;
- end;
-
- if (gFFTBitTable = nil) then
- InitFFT();
-
- if (InverseTransform) then
- angle_numerator := -angle_numerator;
-
- NumBits := NumberOfBitsNeeded(NumSamples);
-
- {
- ** Do simultaneous data copy and bit-reversal ordering into outputs...
- }
-
- for i := 0 to NumSamples-1 do begin
- j := FastReverseBits(i, NumBits);
- RealOut[j] := RealIn[i];
- if(ImagIn = nil) then
- ImagOut[j] := 0.0
- else
- ImagOut[j] := ImagIn[i];
- end;
-
- {
- ** Do the FFT itself...
- }
-
- BlockEnd := 1;
- BlockSize := 2;
- while(BlockSize <= NumSamples) do
- begin
-
- delta_angle := angle_numerator / BlockSize;
-
- sm2 := sin(-2 * delta_angle);
- sm1 := sin(-delta_angle);
- cm2 := cos(-2 * delta_angle);
- cm1 := cos(-delta_angle);
- w := 2 * cm1;
-
- i := 0;
- while(i < NumSamples) do
- begin
- ar2 := cm2;
- ar1 := cm1;
-
- ai2 := sm2;
- ai1 := sm1;
-
- j := i;
- for n := 0 to BlockEnd-1 do
- begin
- ar0 := w * ar1 - ar2;
- ar2 := ar1;
- ar1 := ar0;
-
- ai0 := w * ai1 - ai2;
- ai2 := ai1;
- ai1 := ai0;
-
- k := j + BlockEnd;
- tr := ar0 * RealOut[k] - ai0 * ImagOut[k];
- ti := ar0 * ImagOut[k] + ai0 * RealOut[k];
-
- RealOut[k] := RealOut[j] - tr;
- ImagOut[k] := ImagOut[j] - ti;
-
- RealOut[j] := RealOut[j] + tr;
- ImagOut[j] := ImagOut[j] + ti;
-
- Inc(j);
- end;
-
- Inc(i, BlockSize);
- end;
-
- BlockEnd := BlockSize;
- BlockSize := BlockSize shl 1;
- end;
-
- {
- ** Need to normalize if inverse transform...
- }
-
- if (InverseTransform) then begin
- denom := NumSamples;
-
- for i := 0 to NumSamples-1 do begin
- RealOut[i] := RealOut[i] / denom;
- ImagOut[i] := ImagOut[i] / denom;
- end;
- end;
-end;
-
-(*
- * Real Fast Fourier Transform
- *
- * This function was based on the code in Numerical Recipes in C.
- * In Num. Rec., the inner loop is based on a single 1-based array
- * of interleaved real and imaginary numbers. Because we have two
- * separate zero-based arrays, our indices are quite different.
- * Here is the correspondence between Num. Rec. indices and our indices:
- *
- * i1 <-> real[i]
- * i2 <-> imag[i]
- * i3 <-> real[n/2-i]
- * i4 <-> imag[n/2-i]
- *)
-procedure RealFFT(NumSamples: integer; RealIn, RealOut, ImagOut: PSingleArray);
-var
- Half: Integer;
- i: Integer;
- theta: Single;
- tmpReal, tmpImag: PSingleArray;
- wtemp: Single;
- wpr, wpi, wr, wi: Single;
- i3: Integer;
- h1r, h1i, h2r, h2i: Single;
-begin
- Half := NumSamples div 2;
-
- theta := Pi / Half;
-
- GetMem(tmpReal, Half * sizeof(Single));
- GetMem(tmpImag, Half * sizeof(Single));
-
- for i := 0 to Half-1 do
- begin
- tmpReal[i] := RealIn[2 * i];
- tmpImag[i] := RealIn[2 * i + 1];
- end;
-
- FFT(Half, false, tmpReal, tmpImag, RealOut, ImagOut);
-
- wtemp := sin(0.5 * theta);
-
- wpr := -2.0 * wtemp * wtemp;
- wpi := sin(theta);
- wr := 1.0 + wpr;
- wi := wpi;
-
- for i := 1 to (Half div 2)-1 do
- begin
- i3 := Half - i;
-
- h1r := 0.5 * (RealOut[i] + RealOut[i3]);
- h1i := 0.5 * (ImagOut[i] - ImagOut[i3]);
- h2r := 0.5 * (ImagOut[i] + ImagOut[i3]);
- h2i := -0.5 * (RealOut[i] - RealOut[i3]);
-
- RealOut[i] := h1r + wr * h2r - wi * h2i;
- ImagOut[i] := h1i + wr * h2i + wi * h2r;
- RealOut[i3] := h1r - wr * h2r + wi * h2i;
- ImagOut[i3] := -h1i + wr * h2i + wi * h2r;
-
- wtemp := wr;
- wr := wtemp * wpr - wi * wpi + wr;
- wi := wi * wpr + wtemp * wpi + wi;
- end;
-
- h1r := RealOut[0];
- RealOut[0] := h1r + ImagOut[0];
- ImagOut[0] := h1r - ImagOut[0];
-
- FreeMem(tmpReal);
- FreeMem(tmpImag);
-end;
-
-{*
- * PowerSpectrum
- *
- * This function computes the same as RealFFT, above, but
- * adds the squares of the real and imaginary part of each
- * coefficient, extracting the power and throwing away the
- * phase.
- *
- * For speed, it does not call RealFFT, but duplicates some
- * of its code.
- *}
-procedure PowerSpectrum(NumSamples: Integer; In_, Out_: PSingleArray);
-var
- Half: Integer;
- i: Integer;
- theta: Single;
- tmpReal, tmpImag, RealOut, ImagOut: PSingleArray;
- wtemp: Single;
- wpr, wpi, wr, wi: Single;
- i3: Integer;
- h1r, h1i, h2r, h2i, rt, it: Single;
-begin
- Half := NumSamples div 2;
-
- theta := Pi / Half;
-
- GetMem(tmpReal, Half * sizeof(Single));
- GetMem(tmpImag, Half * sizeof(Single));
- GetMem(RealOut, Half * sizeof(Single));
- GetMem(ImagOut, Half * sizeof(Single));
-
- for i := 0 to Half-1 do begin
- tmpReal[i] := In_[2 * i];
- tmpImag[i] := In_[2 * i + 1];
- end;
-
- FFT(Half, false, tmpReal, tmpImag, RealOut, ImagOut);
-
- wtemp := sin(0.5 * theta);
-
- wpr := -2.0 * wtemp * wtemp;
- wpi := sin(theta);
- wr := 1.0 + wpr;
- wi := wpi;
-
- for i := 1 to (Half div 2)-1 do
- begin
- i3 := Half - i;
-
- h1r := 0.5 * (RealOut[i] + RealOut[i3]);
- h1i := 0.5 * (ImagOut[i] - ImagOut[i3]);
- h2r := 0.5 * (ImagOut[i] + ImagOut[i3]);
- h2i := -0.5 * (RealOut[i] - RealOut[i3]);
-
- rt := h1r + wr * h2r - wi * h2i;
- it := h1i + wr * h2i + wi * h2r;
-
- Out_[i] := rt * rt + it * it;
-
- rt := h1r - wr * h2r + wi * h2i;
- it := -h1i + wr * h2i + wi * h2r;
-
- Out_[i3] := rt * rt + it * it;
-
- wtemp := wr;
- wr := wtemp * wpr - wi * wpi + wr;
- wi := wi * wpr + wtemp * wpi + wi;
- end;
-
- h1r := RealOut[0];
- rt := h1r + ImagOut[0];
- it := h1r - ImagOut[0];
- Out_[0] := rt * rt + it * it;
-
- rt := RealOut[Half div 2];
- it := ImagOut[Half div 2];
- Out_[Half div 2] := rt * rt + it * it;
-
- FreeMem(tmpReal);
- FreeMem(tmpImag);
- FreeMem(RealOut);
- FreeMem(ImagOut);
-end;
-
-(*
- * Windowing Functions
- *)
-function NumWindowFuncs(): integer;
-begin
- Result := Length(FFTWindowName);
-end;
-
-function WindowFuncName(whichFunction: TFFTWindowFunc): string;
-begin
- Result := FFTWindowName[whichFunction];
-end;
-
-procedure WindowFunc(whichFunction: TFFTWindowFunc; NumSamples: Integer; in_: PSingleArray);
-var
- i: Integer;
- A: Single;
-begin
- case whichFunction of
- fwfBartlett:
- begin
- // Bartlett (triangular) window
- for i := 0 to (NumSamples div 2)-1 do
- begin
- in_[i] := in_[i] * (i / (NumSamples / 2));
- in_[i + (NumSamples div 2)] :=
- in_[i + (NumSamples div 2)] *
- (1.0 - (i / (NumSamples / 2)));
- end;
- end;
- fwfHamming:
- begin
- // Hamming
- for i := 0 to NumSamples-1 do
- begin
- in_[i] := in_[i] * (0.54 - 0.46 * cos(2 * Pi * i / (NumSamples - 1)));
- end;
- end;
- fwfHanning:
- begin
- // Hanning
- for i := 0 to NumSamples-1 do
- begin
- in_[i] := in_[i] * (0.50 - 0.50 * cos(2 * Pi * i / (NumSamples - 1)));
- end;
- end;
- fwfBlackman:
- begin
- // Blackman
- for i := 0 to NumSamples-1 do
- begin
- in_[i] := in_[i] * (0.42 - 0.5 * cos (2 * Pi * i / (NumSamples - 1)) + 0.08 * cos (4 * Pi * i / (NumSamples - 1)));
- end;
- end;
- fwfBlackman_Harris:
- begin
- // Blackman-Harris
- for i := 0 to NumSamples-1 do
- begin
- in_[i] := in_[i] * (0.35875 - 0.48829 * cos(2 * Pi * i /(NumSamples-1)) + 0.14128 * cos(4 * Pi * i/(NumSamples-1)) - 0.01168 * cos(6 * Pi * i/(NumSamples-1)));
- end;
- end;
- fwfWelch:
- begin
- // Welch
- for i := 0 to NumSamples-1 do
- begin
- in_[i] := in_[i] * 4*i/NumSamples*(1-(i/NumSamples));
- end;
- end;
- fwfGaussian2_5:
- begin
- // Gaussian (a=2.5)
- // Precalculate some values, and simplify the fmla to try and reduce overhead
- A := -2*2.5*2.5;
-
- for i := 0 to NumSamples-1 do
- begin
- // full
- // in_[i] := in_[i] * exp(-0.5*(A*((i-NumSamples/2)/NumSamples/2))*(A*((i-NumSamples/2)/NumSamples/2)));
- // reduced
- //in_[i] := in_[i] * exp(A*(0.25 + ((i/NumSamples)*(i/NumSamples)) - (i/NumSamples)));
- end;
- end;
- fwfGaussian3_5:
- begin
- // Gaussian (a=3.5)
- A := -2*3.5*3.5;
-
- for i := 0 to NumSamples-1 do
- begin
- // reduced
- in_[i] := in_[i] * exp(A*(0.25 + ((i/NumSamples)*(i/NumSamples)) - (i/NumSamples)));
- end;
- end;
- fwfGaussian4_5:
- begin
- // Gaussian (a=4.5)
- A := -2*4.5*4.5;
-
- for i := 0 to NumSamples-1 do
- begin
- // reduced
- in_[i] := in_[i] * exp(A*(0.25 + ((i/NumSamples)*(i/NumSamples)) - (i/NumSamples)));
- end;
- end;
- end;
-end;
-
-end.
diff --git a/src/lib/freetype/demo/nehe/UFreeType.pas b/src/lib/freetype/demo/nehe/UFreeType.pas
deleted file mode 100644
index c1243aae..00000000
--- a/src/lib/freetype/demo/nehe/UFreeType.pas
+++ /dev/null
@@ -1,326 +0,0 @@
-unit UFreeType;
-
-{$IFDEF FPC}
- {$mode delphi}{$H+}
-{$ENDIF}
-
-interface
-
-uses
- FreeType,
- gl,
- glu,
- classes,
- sysutils;
-
-type
- // This holds all of the information related to any
- // freetype font that we want to create.
- TFontData = class
- h: single; ///< Holds the height of the font.
- textures: array of GLuint; ///< Holds the texture id's
- list_base: GLuint; ///< Holds the first display list id
-
- // The init function will create a font of
- // of the height h from the file fname.
- constructor Create(const fname: string; h: cardinal);
-
- // Free all the resources assosiated with the font.
- destructor Destroy(); override;
- end;
-
- TFreeType = class
- public
- // The flagship function of the library - this thing will print
- // out text at window coordinates x,y, using the font ft_font.
- // The current modelview matrix will also be applied to the text.
- class procedure print(ft_font: TFontData; x, y: single; const str: string);
- end;
-
-
-implementation
-
-
-// This function gets the first power of 2 >= the
-// int that we pass it.
-function next_p2 ( a: integer ): integer; inline;
-begin
- Result := 1;
- while (Result < a) do
- Result := Result shl 1;
-end;
-
-type
- PAGLuint = ^AGLuint;
- AGLuint = array[0..High(Word)] of GLuint;
-
-// Create a display list coresponding to the given character.
-procedure make_dlist ( face: FT_Face; ch: byte; list_base: GLuint; tex_base: PAGLuint );
-var
- i, j: integer;
- width, height: integer;
- glyph: FT_Glyph;
- bitmap_glyph: FT_BitmapGlyph;
- bitmap: PFT_Bitmap;
- expanded_data: array of GLubyte;
- x, y: single;
-begin
- // The first thing we do is get FreeType to render our character
- // into a bitmap. This actually requires a couple of FreeType commands:
-
- // Load the Glyph for our character.
- if (FT_Load_Glyph( face, FT_Get_Char_Index( face, ch ), FT_LOAD_DEFAULT ) <> 0) then
- raise Exception.create('FT_Load_Glyph failed');
-
- // Move the face's glyph into a Glyph object.
- if (FT_Get_Glyph( face^.glyph, glyph ) <> 0) then
- raise Exception.create('FT_Get_Glyph failed');
-
- // Convert the glyph to a bitmap.
- FT_Glyph_To_Bitmap( glyph, ft_render_mode_normal, nil, 1 );
- bitmap_glyph := FT_BitmapGlyph(glyph);
-
- // This reference will make accessing the bitmap easier
- bitmap := @bitmap_glyph^.bitmap;
-
- // Use our helper function to get the widths of
- // the bitmap data that we will need in order to create
- // our texture.
- width := next_p2( bitmap.width );
- height := next_p2( bitmap.rows );
-
- // Allocate memory for the texture data.
- SetLength(expanded_data, 2 * width * height);
-
- // Here we fill in the data for the expanded bitmap.
- // Notice that we are using two channel bitmap (one for
- // luminocity and one for alpha), but we assign
- // both luminocity and alpha to the value that we
- // find in the FreeType bitmap.
- // We use the ?: operator so that value which we use
- // will be 0 if we are in the padding zone, and whatever
- // is the the Freetype bitmap otherwise.
- for j := 0 to height-1 do
- begin
- for i := 0 to width-1 do
- begin
- if ((i >= bitmap.width) or (j >= bitmap.rows)) then
- expanded_data[2*(i+j*width)] := 0
- else
- expanded_data[2*(i+j*width)] := byte(bitmap.buffer[i + bitmap.width*j]);
- expanded_data[2*(i+j*width)+1] := expanded_data[2*(i+j*width)];
- end;
- end;
-
-
- // Now we just setup some texture paramaters.
- glBindTexture( GL_TEXTURE_2D, tex_base[integer(ch)]);
- glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MAG_FILTER,GL_LINEAR);
- glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MIN_FILTER,GL_LINEAR);
-
- // Here we actually create the texture itself, notice
- // that we are using GL_LUMINANCE_ALPHA to indicate that
- // we are using 2 channel data.
- glTexImage2D( GL_TEXTURE_2D, 0, GL_RGBA, width, height,
- 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @expanded_data[0] );
-
- //With the texture created, we don't need to expanded data anymore
- SetLength(expanded_data, 0);
-
- //So now we can create the display list
- glNewList(list_base+ch, GL_COMPILE);
-
- glBindTexture(GL_TEXTURE_2D, tex_base[ch]);
-
- glPushMatrix();
-
- //first we need to move over a little so that
- //the character has the right amount of space
- //between it and the one before it.
- glTranslatef(bitmap_glyph^.left, 0, 0);
-
- //Now we move down a little in the case that the
- //bitmap extends past the bottom of the line
- //(this is only true for characters like 'g' or 'y'.
- glTranslatef(0, bitmap_glyph^.top - bitmap.rows, 0);
-
- //Now we need to account for the fact that many of
- //our textures are filled with empty padding space.
- //We figure what portion of the texture is used by
- //the actual character and store that information in
- //the x and y variables, then when we draw the
- //quad, we will only reference the parts of the texture
- //that we contain the character itself.
- x := bitmap.width / width;
- y := bitmap.rows / height;
-
- //Here we draw the texturemaped quads.
- //The bitmap that we got from FreeType was not
- //oriented quite like we would like it to be,
- //so we need to link the texture to the quad
- //so that the result will be properly aligned.
- glBegin(GL_QUADS);
- glTexCoord2d(0, 0); glVertex2f(0, bitmap.rows);
- glTexCoord2d(0, y); glVertex2f(0, 0);
- glTexCoord2d(x, y); glVertex2f(bitmap.width, 0);
- glTexCoord2d(x, 0); glVertex2f(bitmap.width, bitmap.rows);
- glEnd();
-
- glPopMatrix();
- glTranslatef(face^.glyph^.advance.x shr 6, 0, 0);
-
- //increment the raster position as if we were a bitmap font.
- //(only needed if you want to calculate text length)
- //glBitmap(0,0,0,0,face->glyph->advance.x >> 6,0,NULL);
-
- //Finnish the display list
- glEndList();
-end;
-
-
-constructor TFontData.Create(const fname: string; h: cardinal);
-var
- library_: FT_Library;
- //The object in which Freetype holds information on a given
- //font is called a "face".
- face: FT_Face;
- i: byte;
-begin
- //Allocate some memory to store the texture ids.
- SetLength(textures, 128);
-
- Self.h := h;
-
- //Create and initilize a freetype font library.
- if (FT_Init_FreeType( library_ ) <> 0) then
- raise Exception.create('FT_Init_FreeType failed');
-
- //This is where we load in the font information from the file.
- //Of all the places where the code might die, this is the most likely,
- //as FT_New_Face will die if the font file does not exist or is somehow broken.
- if (FT_New_Face( library_, PChar(fname), 0, face ) <> 0) then
- raise Exception.create('FT_New_Face failed (there is probably a problem with your font file)');
-
- //For some twisted reason, Freetype measures font size
- //in terms of 1/64ths of pixels. Thus, to make a font
- //h pixels high, we need to request a size of h*64.
- //(h shl 6 is just a prettier way of writting h*64)
- FT_Set_Char_Size( face, h shl 6, h shl 6, 96, 96);
-
- //Here we ask opengl to allocate resources for
- //all the textures and displays lists which we
- //are about to create.
- list_base := glGenLists(128);
- glGenTextures( 128, @textures[0] );
-
- //This is where we actually create each of the fonts display lists.
- for i := 0 to 127 do
- make_dlist(face, i, list_base, @textures[0]);
-
- //We don't need the face information now that the display
- //lists have been created, so we free the assosiated resources.
- FT_Done_Face(face);
-
- //Ditto for the library.
- FT_Done_FreeType(library_);
-end;
-
-destructor TFontData.Destroy();
-begin
- glDeleteLists(list_base, 128);
- glDeleteTextures(128, @textures[0]);
- SetLength(textures, 0);
-end;
-
-/// A fairly straight forward function that pushes
-/// a projection matrix that will make object world
-/// coordinates identical to window coordinates.
-procedure pushScreenCoordinateMatrix(); inline;
-var
- viewport: array [0..3] of GLint;
-begin
- glPushAttrib(GL_TRANSFORM_BIT);
- glGetIntegerv(GL_VIEWPORT, @viewport);
- glMatrixMode(GL_PROJECTION);
- glPushMatrix();
- glLoadIdentity();
- gluOrtho2D(viewport[0], viewport[2], viewport[1], viewport[3]);
- glPopAttrib();
-end;
-
-/// Pops the projection matrix without changing the current
-/// MatrixMode.
-procedure pop_projection_matrix(); inline;
-begin
- glPushAttrib(GL_TRANSFORM_BIT);
- glMatrixMode(GL_PROJECTION);
- glPopMatrix();
- glPopAttrib();
-end;
-
-///Much like Nehe's glPrint function, but modified to work
-///with freetype fonts.
-class procedure TFreeType.print(ft_font: TFontData; x, y: single; const str: string);
-var
- font: GLuint;
- h: single;
- i: cardinal;
- lines: TStringList;
- modelview_matrix: array[0..15] of single;
-begin
- // We want a coordinate system where things coresponding to window pixels.
- pushScreenCoordinateMatrix();
-
- font := ft_font.list_base;
- h := ft_font.h / 0.63; //We make the height about 1.5* that of
-
- lines := TStringList.Create();
- ExtractStrings([#13], [], PChar(str), lines);
-
- glPushAttrib(GL_LIST_BIT or GL_CURRENT_BIT or GL_ENABLE_BIT or GL_TRANSFORM_BIT);
- glMatrixMode(GL_MODELVIEW);
- glDisable(GL_LIGHTING);
- glEnable(GL_TEXTURE_2D);
- glDisable(GL_DEPTH_TEST);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
-
- glListBase(font);
-
- glGetFloatv(GL_MODELVIEW_MATRIX, @modelview_matrix);
-
- //This is where the text display actually happens.
- //For each line of text we reset the modelview matrix
- //so that the line's text will start in the correct position.
- //Notice that we need to reset the matrix, rather than just translating
- //down by h. This is because when each character is
- //draw it modifies the current matrix so that the next character
- //will be drawn immediatly after it.
- for i := 0 to lines.Count-1 do
- begin
- glPushMatrix();
- glLoadIdentity();
- glTranslatef(x, y - h*i, 0);
- glMultMatrixf(@modelview_matrix);
-
- // The commented out raster position stuff can be useful if you need to
- // know the length of the text that you are creating.
- // If you decide to use it make sure to also uncomment the glBitmap command
- // in make_dlist().
- //glRasterPos2f(0,0);
- glCallLists(Length(lines[i]), GL_UNSIGNED_BYTE, PChar(lines[i]));
- //float rpos[4];
- //glGetFloatv(GL_CURRENT_RASTER_POSITION ,rpos);
- //float len=x-rpos[0];
-
- glPopMatrix();
- end;
-
- glPopAttrib();
-
- pop_projection_matrix();
-
- lines.Free();
-end;
-
-end.
diff --git a/src/lib/freetype/freetype.pas b/src/lib/freetype/freetype.pas
deleted file mode 100644
index 6aaa3b59..00000000
--- a/src/lib/freetype/freetype.pas
+++ /dev/null
@@ -1,1845 +0,0 @@
-(***************************************************************************)
-(* *)
-(* freetype.h *)
-(* *)
-(* FreeType high-level API and common types (specification only). *)
-(* *)
-(* Copyright 1996-2001, 2002, 2003, 2004, 2005, 2006, 2007 by *)
-(* David Turner, Robert Wilhelm, and Werner Lemberg. *)
-(* *)
-(* This file is part of the FreeType project, and may only be used, *)
-(* modified, and distributed under the terms of the FreeType project *)
-(* license, LICENSE.TXT. By continuing to use, modify, or distribute *)
-(* this file you indicate that you have read the license and *)
-(* understand and accept it fully. *)
-(* *)
-(***************************************************************************)
-
-(***************************************************************************)
-(* Initial Pascal port by *)
-(***************************************************************************)
-(* Anti-Grain Geometry - Version 2.4 (Public License) *)
-(* Copyright (C) 2002-2005 Maxim Shemanarev (http://www.antigrain.com) *)
-(* *)
-(* Anti-Grain Geometry - Version 2.4 Release Milano 3 (AggPas 2.4 RM3) *)
-(* Pascal Port By: Milan Marusinec alias Milano *)
-(* milan@marusinec.sk *)
-(* http://www.aggpas.org *)
-(* Copyright (c) 2005-2007 *)
-(* *)
-(* Permission to copy, use, modify, sell and distribute this software *)
-(* is granted provided this copyright notice appears in all copies. *)
-(* This software is provided "as is" without express or implied *)
-(* warranty, and with no claim as to its suitability for any purpose. *)
-(* *)
-(***************************************************************************)
-
-(***************************************************************************)
-(* Extended by the UltraStar Deluxe Team *)
-(***************************************************************************)
-
-unit freetype;
-
-interface
-
-{$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}
-
-uses
- ctypes;
-
-const
-{$IF Defined(MSWINDOWS)}
- ft_lib = 'freetype6.dll';
-{$ELSEIF Defined(DARWIN)}
- ft_lib = 'libfreetype.dylib';
- {$LINKLIB libfreetype}
-{$ELSEIF Defined(UNIX)}
- ft_lib = 'freetype.so';
-{$IFEND}
-
-type
- (*************************************************************************)
- (* *)
- (* <Type> *)
- (* FT_Library *)
- (* *)
- (* <Description> *)
- (* A handle to a FreeType library instance. Each `library' is *)
- (* completely independent from the others; it is the `root' of a set *)
- (* of objects like fonts, faces, sizes, etc. *)
- (* *)
- (* It also embeds a memory manager (see @FT_Memory), as well as a *)
- (* scan-line converter object (see @FT_Raster). *)
- (* *)
- (* <Note> *)
- (* Library objects are normally created by @FT_Init_FreeType, and *)
- (* destroyed with @FT_Done_FreeType. *)
- (* *)
- FT_Library = Pointer;
-
-
- (*************************************************************************)
- (* *)
- (* <Enum> *)
- (* FT_FACE_FLAG_XXX *)
- (* *)
- (* <Description> *)
- (* A list of bit flags used in the `face_flags' field of the *)
- (* @FT_FaceRec structure. They inform client applications of *)
- (* properties of the corresponding face. *)
- (* *)
- (* <Values> *)
- (* FT_FACE_FLAG_SCALABLE :: *)
- (* Indicates that the face provides vectorial outlines. This *)
- (* doesn't prevent embedded bitmaps, i.e., a face can have both *)
- (* this bit and @FT_FACE_FLAG_FIXED_SIZES set. *)
- (* *)
- (* FT_FACE_FLAG_FIXED_SIZES :: *)
- (* Indicates that the face contains `fixed sizes', i.e., bitmap *)
- (* strikes for some given pixel sizes. See the `num_fixed_sizes' *)
- (* and `available_sizes' fields of @FT_FaceRec. *)
- (* *)
- (* FT_FACE_FLAG_FIXED_WIDTH :: *)
- (* Indicates that the face contains fixed-width characters (like *)
- (* Courier, Lucido, MonoType, etc.). *)
- (* *)
- (* FT_FACE_FLAG_SFNT :: *)
- (* Indicates that the face uses the `sfnt' storage scheme. For *)
- (* now, this means TrueType and OpenType. *)
- (* *)
- (* FT_FACE_FLAG_HORIZONTAL :: *)
- (* Indicates that the face contains horizontal glyph metrics. This *)
- (* should be set for all common formats. *)
- (* *)
- (* FT_FACE_FLAG_VERTICAL :: *)
- (* Indicates that the face contains vertical glyph metrics. This *)
- (* is only available in some formats, not all of them. *)
- (* *)
- (* FT_FACE_FLAG_KERNING :: *)
- (* Indicates that the face contains kerning information. If set, *)
- (* the kerning distance can be retrieved through the function *)
- (* @FT_Get_Kerning. Note that if unset, this function will always *)
- (* return the vector (0,0). *)
- (* *)
- (* FT_FACE_FLAG_FAST_GLYPHS :: *)
- (* THIS FLAG IS DEPRECATED. DO NOT USE OR TEST IT. *)
- (* *)
- (* FT_FACE_FLAG_MULTIPLE_MASTERS :: *)
- (* Indicates that the font contains multiple masters and is capable *)
- (* of interpolating between them. See the multiple-masters *)
- (* specific API for details. *)
- (* *)
- (* FT_FACE_FLAG_GLYPH_NAMES :: *)
- (* Indicates that the font contains glyph names that can be *)
- (* retrieved through @FT_Get_Glyph_Name. Note that some TrueType *)
- (* fonts contain broken glyph name tables. Use the function *)
- (* @FT_Has_PS_Glyph_Names when needed. *)
- (* *)
- (* FT_FACE_FLAG_EXTERNAL_STREAM :: *)
- (* Used internally by FreeType to indicate that a face's stream was *)
- (* provided by the client application and should not be destroyed *)
- (* when @FT_Done_Face is called. Don't read or test this flag. *)
- (* *)
-const
- FT_FACE_FLAG_SCALABLE = 1 shl 0;
- FT_FACE_FLAG_KERNING = 1 shl 6;
-
- (*************************************************************************)
- (* *)
- (* <Enum> *)
- (* FT_Encoding *)
- (* *)
- (* <Description> *)
- (* An enumeration used to specify encodings supported by charmaps. *)
- (* Used in the @FT_Select_Charmap API function. *)
- (* *)
- (* <Note> *)
- (* Because of 32-bit charcodes defined in Unicode (i.e., surrogates), *)
- (* all character codes must be expressed as FT_Longs. *)
- (* *)
- (* The values of this type correspond to specific character *)
- (* repertories (i.e. charsets), and not to text encoding methods *)
- (* (like UTF-8, UTF-16, GB2312_EUC, etc.). *)
- (* *)
- (* Other encodings might be defined in the future. *)
- (* *)
- (* <Values> *)
- (* FT_ENCODING_NONE :: *)
- (* The encoding value 0 is reserved. *)
- (* *)
- (* FT_ENCODING_UNICODE :: *)
- (* Corresponds to the Unicode character set. This value covers *)
- (* all versions of the Unicode repertoire, including ASCII and *)
- (* Latin-1. Most fonts include a Unicode charmap, but not all *)
- (* of them. *)
- (* *)
- (* FT_ENCODING_MS_SYMBOL :: *)
- (* Corresponds to the Microsoft Symbol encoding, used to encode *)
- (* mathematical symbols in the 32..255 character code range. For *)
- (* more information, see `http://www.ceviz.net/symbol.htm'. *)
- (* *)
- (* FT_ENCODING_SJIS :: *)
- (* Corresponds to Japanese SJIS encoding. More info at *)
- (* at `http://langsupport.japanreference.com/encoding.shtml'. *)
- (* See note on multi-byte encodings below. *)
- (* *)
- (* FT_ENCODING_GB2312 :: *)
- (* Corresponds to an encoding system for Simplified Chinese as used *)
- (* used in mainland China. *)
- (* *)
- (* FT_ENCODING_BIG5 :: *)
- (* Corresponds to an encoding system for Traditional Chinese as used *)
- (* in Taiwan and Hong Kong. *)
- (* *)
- (* FT_ENCODING_WANSUNG :: *)
- (* Corresponds to the Korean encoding system known as Wansung. *)
- (* For more information see *)
- (* `http://www.microsoft.com/typography/unicode/949.txt'. *)
- (* *)
- (* FT_ENCODING_JOHAB :: *)
- (* The Korean standard character set (KS C-5601-1992), which *)
- (* corresponds to MS Windows code page 1361. This character set *)
- (* includes all possible Hangeul character combinations. *)
- (* *)
- (* FT_ENCODING_ADOBE_LATIN_1 :: *)
- (* Corresponds to a Latin-1 encoding as defined in a Type 1 *)
- (* Postscript font. It is limited to 256 character codes. *)
- (* *)
- (* FT_ENCODING_ADOBE_STANDARD :: *)
- (* Corresponds to the Adobe Standard encoding, as found in Type 1, *)
- (* CFF, and OpenType/CFF fonts. It is limited to 256 character *)
- (* codes. *)
- (* *)
- (* FT_ENCODING_ADOBE_EXPERT :: *)
- (* Corresponds to the Adobe Expert encoding, as found in Type 1, *)
- (* CFF, and OpenType/CFF fonts. It is limited to 256 character *)
- (* codes. *)
- (* *)
- (* FT_ENCODING_ADOBE_CUSTOM :: *)
- (* Corresponds to a custom encoding, as found in Type 1, CFF, and *)
- (* OpenType/CFF fonts. It is limited to 256 character codes. *)
- (* *)
- (* FT_ENCODING_APPLE_ROMAN :: *)
- (* Corresponds to the 8-bit Apple roman encoding. Many TrueType and *)
- (* OpenType fonts contain a charmap for this encoding, since older *)
- (* versions of Mac OS are able to use it. *)
- (* *)
- (* FT_ENCODING_OLD_LATIN_2 :: *)
- (* This value is deprecated and was never used nor reported by *)
- (* FreeType. Don't use or test for it. *)
- (* *)
- (* FT_ENCODING_MS_SJIS :: *)
- (* Same as FT_ENCODING_SJIS. Deprecated. *)
- (* *)
- (* FT_ENCODING_MS_GB2312 :: *)
- (* Same as FT_ENCODING_GB2312. Deprecated. *)
- (* *)
- (* FT_ENCODING_MS_BIG5 :: *)
- (* Same as FT_ENCODING_BIG5. Deprecated. *)
- (* *)
- (* FT_ENCODING_MS_WANSUNG :: *)
- (* Same as FT_ENCODING_WANSUNG. Deprecated. *)
- (* *)
- (* FT_ENCODING_MS_JOHAB :: *)
- (* Same as FT_ENCODING_JOHAB. Deprecated. *)
- (* *)
- (* <Note> *)
- (* By default, FreeType automatically synthetizes a Unicode charmap *)
- (* for Postscript fonts, using their glyph names dictionaries. *)
- (* However, it will also report the encodings defined explicitly in *)
- (* the font file, for the cases when they are needed, with the Adobe *)
- (* values as well. *)
- (* *)
- (* FT_ENCODING_NONE is set by the BDF and PCF drivers if the charmap *)
- (* is neither Unicode nor ISO-8859-1 (otherwise it is set to *)
- (* FT_ENCODING_UNICODE). Use `FT_Get_BDF_Charset_ID' to find out *)
- (* which encoding is really present. If, for example, the *)
- (* `cs_registry' field is `KOI8' and the `cs_encoding' field is `R', *)
- (* the font is encoded in KOI8-R. *)
- (* *)
- (* FT_ENCODING_NONE is always set (with a single exception) by the *)
- (* winfonts driver. Use `FT_Get_WinFNT_Header' and examine the *)
- (* `charset' field of the `FT_WinFNT_HeaderRec' structure to find out *)
- (* which encoding is really present. For example, FT_WinFNT_ID_CP1251 *)
- (* (204) means Windows code page 1251 (for Russian). *)
- (* *)
- (* FT_ENCODING_NONE is set if `platform_id' is `TT_PLATFORM_MACINTOSH' *)
- (* and `encoding_id' is not `TT_MAC_ID_ROMAN' (otherwise it is set to *)
- (* FT_ENCODING_APPLE_ROMAN). *)
- (* *)
- (* If `platform_id' is `TT_PLATFORM_MACINTOSH', use the function *)
- (* `FT_Get_CMap_Language_ID' to query the Mac language ID which may be *)
- (* needed to be able to distinguish Apple encoding variants. See *)
- (* *)
- (* http://www.unicode.org/Public/MAPPINGS/VENDORS/APPLE/README.TXT *)
- (* *)
- (* to get an idea how to do that. Basically, if the language ID is 0, *)
- (* dont use it, otherwise subtract 1 from the language ID. Then *)
- (* examine `encoding_id'. If, for example, `encoding_id' is *)
- (* `TT_MAC_ID_ROMAN' and the language ID (minus 1) is *)
- (* `TT_MAC_LANGID_GREEK', it is the Greek encoding, not Roman. *)
- (* `TT_MAC_ID_ARABIC' with `TT_MAC_LANGID_FARSI' means the Farsi *)
- (* variant the Arabic encoding. *)
- (* *)
-type
- PFT_Encoding = ^FT_Encoding;
- FT_Encoding = array[0..3] of char;
-const
- FT_ENCODING_NONE: FT_Encoding = (#0 ,#0 ,#0 ,#0 );
- FT_ENCODING_MS_SYMBOL: FT_Encoding = ('s', 'y', 'm', 'b' );
- FT_ENCODING_UNICODE: FT_Encoding = ('u', 'n', 'i', 'c' );
-
- FT_ENCODING_SJIS: FT_Encoding = ('s', 'j', 'i', 's');
- FT_ENCODING_GB2312: FT_Encoding = ('g', 'b', ' ', ' ');
- FT_ENCODING_BIG5: FT_Encoding = ('b', 'i', 'g', '5');
- FT_ENCODING_WANSUNG: FT_Encoding = ('w', 'a', 'n', 's');
- FT_ENCODING_JOHAB: FT_Encoding = ('j', 'o', 'h', 'a');
-
-
- (*************************************************************************)
- (* *)
- (* <Constant> *)
- (* FT_STYLE_FLAG_XXX *)
- (* *)
- (* <Description> *)
- (* A list of bit-flags used to indicate the style of a given face. *)
- (* These are used in the `style_flags' field of @FT_FaceRec. *)
- (* *)
- (* <Values> *)
- (* FT_STYLE_FLAG_ITALIC :: *)
- (* Indicates that a given face is italicized. *)
- (* *)
- (* FT_STYLE_FLAG_BOLD :: *)
- (* Indicates that a given face is bold. *)
- (* *)
-const
- FT_STYLE_FLAG_ITALIC = 1 shl 0;
- FT_STYLE_FLAG_BOLD = 1 shl 1;
-
-
- (***************************************************************************
- *
- * @enum:
- * FT_LOAD_XXX
- *
- * @description:
- * A list of bit-field constants, used with @FT_Load_Glyph to indicate
- * what kind of operations to perform during glyph loading.
- *
- * @values:
- * FT_LOAD_DEFAULT ::
- * Corresponding to 0, this value is used a default glyph load. In this
- * case, the following will happen:
- *
- * 1. FreeType looks for a bitmap for the glyph corresponding to the
- * face's current size. If one is found, the function returns. The
- * bitmap data can be accessed from the glyph slot (see note below).
- *
- * 2. If no embedded bitmap is searched or found, FreeType looks for a
- * scalable outline. If one is found, it is loaded from the font
- * file, scaled to device pixels, then "hinted" to the pixel grid in
- * order to optimize it. The outline data can be accessed from the
- * glyph slot (see note below).
- *
- * Note that by default, the glyph loader doesn't render outlines into
- * bitmaps. The following flags are used to modify this default
- * behaviour to more specific and useful cases.
- *
- * FT_LOAD_NO_SCALE ::
- * Don't scale the vector outline being loaded to 26.6 fractional
- * pixels, but kept in font units. Note that this also disables
- * hinting and the loading of embedded bitmaps. You should only use it
- * when you want to retrieve the original glyph outlines in font units.
- *
- * FT_LOAD_NO_HINTING ::
- * Don't hint glyph outlines after their scaling to device pixels.
- * This generally generates "blurrier" glyphs in anti-aliased modes.
- *
- * This flag is ignored if @FT_LOAD_NO_SCALE is set.
- *
- * FT_LOAD_RENDER ::
- * Render the glyph outline immediately into a bitmap before the glyph
- * loader returns. By default, the glyph is rendered for the
- * @FT_RENDER_MODE_NORMAL mode, which corresponds to 8-bit anti-aliased
- * bitmaps using 256 opacity levels. You can use either
- * @FT_LOAD_TARGET_MONO or @FT_LOAD_MONOCHROME to render 1-bit
- * monochrome bitmaps.
- *
- * This flag is ignored if @FT_LOAD_NO_SCALE is set.
- *
- * FT_LOAD_NO_BITMAP ::
- * Don't look for bitmaps when loading the glyph. Only scalable
- * outlines will be loaded when available, and scaled, hinted, or
- * rendered depending on other bit flags.
- *
- * This does not prevent you from rendering outlines to bitmaps
- * with @FT_LOAD_RENDER, however.
- *
- * FT_LOAD_VERTICAL_LAYOUT ::
- * Prepare the glyph image for vertical text layout. This basically
- * means that `face.glyph.advance' will correspond to the vertical
- * advance height (instead of the default horizontal advance width),
- * and that the glyph image will be translated to match the vertical
- * bearings positions.
- *
- * FT_LOAD_FORCE_AUTOHINT ::
- * Force the use of the FreeType auto-hinter when a glyph outline is
- * loaded. You shouldn't need this in a typical application, since it
- * is mostly used to experiment with its algorithm.
- *
- * FT_LOAD_CROP_BITMAP ::
- * Indicates that the glyph loader should try to crop the bitmap (i.e.,
- * remove all space around its black bits) when loading it. This is
- * only useful when loading embedded bitmaps in certain fonts, since
- * bitmaps rendered with @FT_LOAD_RENDER are always cropped by default.
- *
- * FT_LOAD_PEDANTIC ::
- * Indicates that the glyph loader should perform pedantic
- * verifications during glyph loading, rejecting invalid fonts. This
- * is mostly used to detect broken glyphs in fonts. By default,
- * FreeType tries to handle broken fonts also.
- *
- * FT_LOAD_IGNORE_GLOBAL_ADVANCE_WIDTH ::
- * Indicates that the glyph loader should ignore the global advance
- * width defined in the font. As far as we know, this is only used by
- * the X-TrueType font server, in order to deal correctly with the
- * incorrect metrics contained in DynaLab's TrueType CJK fonts.
- *
- * FT_LOAD_NO_RECURSE ::
- * This flag is only used internally. It merely indicates that the
- * glyph loader should not load composite glyphs recursively. Instead,
- * it should set the `num_subglyph' and `subglyphs' values of the glyph
- * slot accordingly, and set "glyph->format" to
- * @FT_GLYPH_FORMAT_COMPOSITE.
- *
- * The description of sub-glyphs is not available to client
- * applications for now.
- *
- * FT_LOAD_IGNORE_TRANSFORM ::
- * Indicates that the glyph loader should not try to transform the
- * loaded glyph image. This doesn't prevent scaling, hinting, or
- * rendering.
- *
- * FT_LOAD_MONOCHROME ::
- * This flag is used with @FT_LOAD_RENDER to indicate that you want
- * to render a 1-bit monochrome glyph bitmap from a vectorial outline.
- *
- * Note that this has no effect on the hinting algorithm used by the
- * glyph loader. You should better use @FT_LOAD_TARGET_MONO if you
- * want to render monochrome-optimized glyph images instead.
- *
- * FT_LOAD_LINEAR_DESIGN ::
- * Return the linearly scaled metrics expressed in original font units
- * instead of the default 16.16 pixel values.
- *
- * FT_LOAD_NO_AUTOHINT ::
- * Indicates that the auto-hinter should never be used to hint glyph
- * outlines. This doesn't prevent native format-specific hinters from
- * being used. This can be important for certain fonts where unhinted
- * output is better than auto-hinted one.
- *
- * FT_LOAD_TARGET_NORMAL ::
- * Use hinting for @FT_RENDER_MODE_NORMAL.
- *
- * FT_LOAD_TARGET_LIGHT ::
- * Use hinting for @FT_RENDER_MODE_LIGHT.
- *
- * FT_LOAD_TARGET_MONO ::
- * Use hinting for @FT_RENDER_MODE_MONO.
- *
- * FT_LOAD_TARGET_LCD ::
- * Use hinting for @FT_RENDER_MODE_LCD.
- *
- * FT_LOAD_TARGET_LCD_V ::
- * Use hinting for @FT_RENDER_MODE_LCD_V.
- *)
-const
- FT_LOAD_DEFAULT = $0000;
- FT_LOAD_NO_SCALE = $0001;
- FT_LOAD_NO_HINTING = $0002;
- FT_LOAD_RENDER = $0004;
- FT_LOAD_NO_BITMAP = $0008;
- FT_LOAD_VERTICAL_LAYOUT = $0010;
- FT_LOAD_FORCE_AUTOHINT = $0020;
- FT_LOAD_CROP_BITMAP = $0040;
- FT_LOAD_PEDANTIC = $0080;
- FT_LOAD_IGNORE_GLOBAL_ADVANCE_WIDTH = $0200;
- FT_LOAD_NO_RECURSE = $0400;
- FT_LOAD_IGNORE_TRANSFORM = $0800;
- FT_LOAD_MONOCHROME = $1000;
- FT_LOAD_LINEAR_DESIGN = $2000;
-
- (* temporary hack! *)
- FT_LOAD_SBITS_ONLY = $4000;
- FT_LOAD_NO_AUTOHINT = $8000;
-
- (*************************************************************************)
- (* *)
- (* <Enum> *)
- (* FT_Render_Mode *)
- (* *)
- (* <Description> *)
- (* An enumeration type that lists the render modes supported by *)
- (* FreeType 2. Each mode corresponds to a specific type of scanline *)
- (* conversion performed on the outline, as well as specific *)
- (* hinting optimizations. *)
- (* *)
- (* For bitmap fonts the `bitmap->pixel_mode' field in the *)
- (* @FT_GlyphSlotRec structure gives the format of the returned *)
- (* bitmap. *)
- (* *)
- (* <Values> *)
- (* FT_RENDER_MODE_NORMAL :: *)
- (* This is the default render mode; it corresponds to 8-bit *)
- (* anti-aliased bitmaps, using 256 levels of opacity. *)
- (* *)
- (* FT_RENDER_MODE_LIGHT :: *)
- (* This is similar to @FT_RENDER_MODE_NORMAL -- you have to use *)
- (* @FT_LOAD_TARGET_LIGHT in calls to @FT_Load_Glyph to get any *)
- (* effect since the rendering process no longer influences the *)
- (* positioning of glyph outlines. *)
- (* *)
- (* The resulting glyph shapes are more similar to the original, *)
- (* while being a bit more fuzzy (`better shapes' instead of `better *)
- (* contrast', so to say. *)
- (* *)
- (* FT_RENDER_MODE_MONO :: *)
- (* This mode corresponds to 1-bit bitmaps. *)
- (* *)
- (* FT_RENDER_MODE_LCD :: *)
- (* This mode corresponds to horizontal RGB/BGR sub-pixel displays, *)
- (* like LCD-screens. It produces 8-bit bitmaps that are 3 times *)
- (* the width of the original glyph outline in pixels, and which use *)
- (* the @FT_PIXEL_MODE_LCD mode. *)
- (* *)
- (* FT_RENDER_MODE_LCD_V :: *)
- (* This mode corresponds to vertical RGB/BGR sub-pixel displays *)
- (* (like PDA screens, rotated LCD displays, etc.). It produces *)
- (* 8-bit bitmaps that are 3 times the height of the original *)
- (* glyph outline in pixels and use the @FT_PIXEL_MODE_LCD_V mode. *)
- (* *)
- (* <Note> *)
- (* The LCD-optimized glyph bitmaps produced by FT_Render_Glyph are *)
- (* _not filtered_ to reduce color-fringes. It is up to the caller to *)
- (* perform this pass. *)
- (* *)
-type
- FT_Render_Mode = cint;
-const
- FT_RENDER_MODE_NORMAL = 0;
- FT_RENDER_MODE_LIGHT = FT_RENDER_MODE_NORMAL + 1;
- FT_RENDER_MODE_MONO = FT_RENDER_MODE_LIGHT + 1;
- FT_RENDER_MODE_LCD = FT_RENDER_MODE_MONO + 1;
- FT_RENDER_MODE_LCD_V = FT_RENDER_MODE_LCD + 1;
- FT_RENDER_MODE_MAX = FT_RENDER_MODE_LCD_V + 1;
-
-
- (*************************************************************************)
- (* *)
- (* <Type> *)
- (* FT_GlyphSlot *)
- (* *)
- (* <Description> *)
- (* A handle to a given `glyph slot'. A slot is a container where it *)
- (* is possible to load any one of the glyphs contained in its parent *)
- (* face. *)
- (* *)
- (* In other words, each time you call @FT_Load_Glyph or *)
- (* @FT_Load_Char, the slot's content is erased by the new glyph data, *)
- (* i.e. the glyph's metrics, its image (bitmap or outline), and *)
- (* other control information. *)
- (* *)
- (* <Also> *)
- (* @FT_GlyphSlotRec details the publicly accessible glyph fields. *)
- (* *)
-type
- FT_GlyphSlot = ^FT_GlyphSlotRec;
-
-
-{$DEFINE TYPE_DECL}
-{$I ftconfig.inc}
-{$I fttypes.inc}
-{$I ftimage.inc}
-{$I ftglyph.inc}
-{$I ftstroke.inc}
-{$I ftoutln.inc}
-{$UNDEF TYPE_DECL}
-
-
- (*************************************************************************)
- (* *)
- (* <Struct> *)
- (* FT_Glyph_Metrics *)
- (* *)
- (* <Description> *)
- (* A structure used to model the metrics of a single glyph. The *)
- (* values are expressed in 26.6 fractional pixel format; if the flag *)
- (* FT_LOAD_NO_SCALE is used, values are returned in font units *)
- (* instead. *)
- (* *)
- (* <Fields> *)
- (* width :: *)
- (* The glyph's width. *)
- (* *)
- (* height :: *)
- (* The glyph's height. *)
- (* *)
- (* horiBearingX :: *)
- (* Left side bearing for horizontal layout. *)
- (* *)
- (* horiBearingY :: *)
- (* Top side bearing for horizontal layout. *)
- (* *)
- (* horiAdvance :: *)
- (* Advance width for horizontal layout. *)
- (* *)
- (* vertBearingX :: *)
- (* Left side bearing for vertical layout. *)
- (* *)
- (* vertBearingY :: *)
- (* Top side bearing for vertical layout. *)
- (* *)
- (* vertAdvance :: *)
- (* Advance height for vertical layout. *)
- (* *)
- FT_Glyph_Metrics = record
- width ,
- height : FT_Pos;
-
- horiBearingX ,
- horiBearingY ,
- horiAdvance : FT_Pos;
-
- vertBearingX ,
- vertBearingY ,
- vertAdvance : FT_Pos;
- end;
-
-
- (*************************************************************************)
- (* *)
- (* <Struct> *)
- (* FT_Bitmap_Size *)
- (* *)
- (* <Description> *)
- (* This structure models the size of a bitmap strike (i.e., a bitmap *)
- (* instance of the font for a given resolution) in a fixed-size font *)
- (* face. It is used for the `available_sizes' field of the *)
- (* @FT_FaceRec structure. *)
- (* *)
- (* <Fields> *)
- (* height :: The (vertical) baseline-to-baseline distance in pixels. *)
- (* It makes most sense to define the height of a bitmap *)
- (* font in this way. *)
- (* *)
- (* width :: The average width of the font (in pixels). Since the *)
- (* algorithms to compute this value are different for the *)
- (* various bitmap formats, it can only give an additional *)
- (* hint if the `height' value isn't sufficient to select *)
- (* the proper font. For monospaced fonts the average width *)
- (* is the same as the maximum width. *)
- (* *)
- (* size :: The point size in 26.6 fractional format this font shall *)
- (* represent (for a given vertical resolution). *)
- (* *)
- (* x_ppem :: The horizontal ppem value (in 26.6 fractional format). *)
- (* *)
- (* y_ppem :: The vertical ppem value (in 26.6 fractional format). *)
- (* Usually, this is the `nominal' pixel height of the font. *)
- (* *)
- (* <Note> *)
- (* The values in this structure are taken from the bitmap font. If *)
- (* the font doesn't provide a parameter it is set to zero to indicate *)
- (* that the information is not available. *)
- (* *)
- (* The following formula converts from dpi to ppem: *)
- (* *)
- (* ppem = size * dpi / 72 *)
- (* *)
- (* where `size' is in points. *)
- (* *)
- (* Windows FNT: *)
- (* The `size' parameter is not reliable: There exist fonts (e.g., *)
- (* app850.fon) which have a wrong size for some subfonts; x_ppem *)
- (* and y_ppem are thus set equal to pixel width and height given in *)
- (* in the Windows FNT header. *)
- (* *)
- (* TrueType embedded bitmaps: *)
- (* `size', `width', and `height' values are not contained in the *)
- (* bitmap strike itself. They are computed from the global font *)
- (* parameters. *)
- (* *)
- PFT_Bitmap_Size = ^FT_Bitmap_Size;
- FT_Bitmap_Size = record
- height,
- width : FT_Short;
-
- size: FT_Pos;
-
- x_ppem: FT_Pos;
- y_ppem: FT_Pos;
- end;
-
- PAFT_Bitmap_Size = ^AFT_Bitmap_Size;
- AFT_Bitmap_Size = array[0..High(Word)] of FT_Bitmap_Size;
-
-
- (*************************************************************************)
- (* *)
- (* <Type> *)
- (* FT_Face *)
- (* *)
- (* <Description> *)
- (* A handle to a given typographic face object. A face object models *)
- (* a given typeface, in a given style. *)
- (* *)
- (* <Note> *)
- (* Each face object also owns a single @FT_GlyphSlot object, as well *)
- (* as one or more @FT_Size objects. *)
- (* *)
- (* Use @FT_New_Face or @FT_Open_Face to create a new face object from *)
- (* a given filepathname or a custom input stream. *)
- (* *)
- (* Use @FT_Done_Face to destroy it (along with its slot and sizes). *)
- (* *)
- (* <Also> *)
- (* The @FT_FaceRec details the publicly accessible fields of a given *)
- (* face object. *)
- (* *)
- FT_Face = ^FT_FaceRec;
-
- (*************************************************************************)
- (* *)
- (* <Type> *)
- (* FT_CharMap *)
- (* *)
- (* <Description> *)
- (* A handle to a given character map. A charmap is used to translate *)
- (* character codes in a given encoding into glyph indexes for its *)
- (* parent's face. Some font formats may provide several charmaps per *)
- (* font. *)
- (* *)
- (* Each face object owns zero or more charmaps, but only one of them *)
- (* can be "active" and used by @FT_Get_Char_Index or @FT_Load_Char. *)
- (* *)
- (* The list of available charmaps in a face is available through the *)
- (* "face->num_charmaps" and "face->charmaps" fields of @FT_FaceRec. *)
- (* *)
- (* The currently active charmap is available as "face->charmap". *)
- (* You should call @FT_Set_Charmap to change it. *)
- (* *)
- (* <Note> *)
- (* When a new face is created (either through @FT_New_Face or *)
- (* @FT_Open_Face), the library looks for a Unicode charmap within *)
- (* the list and automatically activates it. *)
- (* *)
- (* <Also> *)
- (* The @FT_CharMapRec details the publicly accessible fields of a *)
- (* given character map. *)
- (* *)
- PFT_CharMap = ^FT_CharMap;
- FT_CharMap = ^FT_CharMapRec;
-
- PAFT_CharMap = ^FT_CharMap;
- AFT_CharMap = array[0..High(Word)] of FT_CharMap;
-
-
-
-
-
-
-
- (*************************************************************************)
- (* *)
- (* <Struct> *)
- (* FT_SubGlyph *)
- (* *)
- (* <Description> *)
- (* The subglyph structure is an internal object used to describe *)
- (* subglyphs (for example, in the case of composites). *)
- (* *)
- (* <Note> *)
- (* The subglyph implementation is not part of the high-level API, *)
- (* hence the forward structure declaration. *)
- (* *)
- FT_SubGlyph = ^FT_SubGlyphRec;
- FT_SubGlyphRec = record // internal
- end;
-
-
- (*************************************************************************)
- (* *)
- (* <Struct> *)
- (* FT_GlyphSlotRec *)
- (* *)
- (* <Description> *)
- (* FreeType root glyph slot class structure. A glyph slot is a *)
- (* container where individual glyphs can be loaded, be they *)
- (* vectorial or bitmap/graymaps. *)
- (* *)
- (* <Fields> *)
- (* library :: A handle to the FreeType library instance *)
- (* this slot belongs to. *)
- (* *)
- (* face :: A handle to the parent face object. *)
- (* *)
- (* next :: In some cases (like some font tools), several *)
- (* glyph slots per face object can be a good *)
- (* thing. As this is rare, the glyph slots are *)
- (* listed through a direct, single-linked list *)
- (* using its `next' field. *)
- (* *)
- (* generic :: A typeless pointer which is unused by the *)
- (* FreeType library or any of its drivers. It *)
- (* can be used by client applications to link *)
- (* their own data to each glyph slot object. *)
- (* *)
- (* metrics :: The metrics of the last loaded glyph in the *)
- (* slot. The returned values depend on the last *)
- (* load flags (see the @FT_Load_Glyph API *)
- (* function) and can be expressed either in 26.6 *)
- (* fractional pixels or font units. *)
- (* *)
- (* Note that even when the glyph image is *)
- (* transformed, the metrics are not. *)
- (* *)
- (* linearHoriAdvance :: For scalable formats only, this field holds *)
- (* the linearly scaled horizontal advance width *)
- (* for the glyph (i.e. the scaled and unhinted *)
- (* value of the hori advance). This can be *)
- (* important to perform correct WYSIWYG layout. *)
- (* *)
- (* Note that this value is expressed by default *)
- (* in 16.16 pixels. However, when the glyph is *)
- (* loaded with the FT_LOAD_LINEAR_DESIGN flag, *)
- (* this field contains simply the value of the *)
- (* advance in original font units. *)
- (* *)
- (* linearVertAdvance :: For scalable formats only, this field holds *)
- (* the linearly scaled vertical advance height *)
- (* for the glyph. See linearHoriAdvance for *)
- (* comments. *)
- (* *)
- (* advance :: This is the transformed advance width for the *)
- (* glyph. *)
- (* *)
- (* format :: This field indicates the format of the image *)
- (* contained in the glyph slot. Typically *)
- (* FT_GLYPH_FORMAT_BITMAP, *)
- (* FT_GLYPH_FORMAT_OUTLINE, and *)
- (* FT_GLYPH_FORMAT_COMPOSITE, but others are *)
- (* possible. *)
- (* *)
- (* bitmap :: This field is used as a bitmap descriptor *)
- (* when the slot format is *)
- (* FT_GLYPH_FORMAT_BITMAP. Note that the *)
- (* address and content of the bitmap buffer can *)
- (* change between calls of @FT_Load_Glyph and a *)
- (* few other functions. *)
- (* *)
- (* bitmap_left :: This is the bitmap's left bearing expressed *)
- (* in integer pixels. Of course, this is only *)
- (* valid if the format is *)
- (* FT_GLYPH_FORMAT_BITMAP. *)
- (* *)
- (* bitmap_top :: This is the bitmap's top bearing expressed in *)
- (* integer pixels. Remember that this is the *)
- (* distance from the baseline to the top-most *)
- (* glyph scanline, upwards y-coordinates being *)
- (* *positive*. *)
- (* *)
- (* outline :: The outline descriptor for the current glyph *)
- (* image if its format is *)
- (* FT_GLYPH_FORMAT_OUTLINE. *)
- (* *)
- (* num_subglyphs :: The number of subglyphs in a composite glyph. *)
- (* This field is only valid for the composite *)
- (* glyph format that should normally only be *)
- (* loaded with the @FT_LOAD_NO_RECURSE flag. *)
- (* For now this is internal to FreeType. *)
- (* *)
- (* subglyphs :: An array of subglyph descriptors for *)
- (* composite glyphs. There are `num_subglyphs' *)
- (* elements in there. Currently internal to *)
- (* FreeType. *)
- (* *)
- (* control_data :: Certain font drivers can also return the *)
- (* control data for a given glyph image (e.g. *)
- (* TrueType bytecode, Type 1 charstrings, etc.). *)
- (* This field is a pointer to such data. *)
- (* *)
- (* control_len :: This is the length in bytes of the control *)
- (* data. *)
- (* *)
- (* other :: Really wicked formats can use this pointer to *)
- (* present their own glyph image to client apps. *)
- (* Note that the app will need to know about the *)
- (* image format. *)
- (* *)
- (* lsb_delta :: The difference between hinted and unhinted *)
- (* left side bearing while autohinting is *)
- (* active. Zero otherwise. *)
- (* *)
- (* rsb_delta :: The difference between hinted and unhinted *)
- (* right side bearing while autohinting is *)
- (* active. Zero otherwise. *)
- (* *)
- (* <Note> *)
- (* If @FT_Load_Glyph is called with default flags (see *)
- (* @FT_LOAD_DEFAULT) the glyph image is loaded in the glyph slot in *)
- (* its native format (e.g. a vectorial outline for TrueType and *)
- (* Type 1 formats). *)
- (* *)
- (* This image can later be converted into a bitmap by calling *)
- (* @FT_Render_Glyph. This function finds the current renderer for *)
- (* the native image's format then invokes it. *)
- (* *)
- (* The renderer is in charge of transforming the native image through *)
- (* the slot's face transformation fields, then convert it into a *)
- (* bitmap that is returned in `slot->bitmap'. *)
- (* *)
- (* Note that `slot->bitmap_left' and `slot->bitmap_top' are also used *)
- (* to specify the position of the bitmap relative to the current pen *)
- (* position (e.g. coordinates [0,0] on the baseline). Of course, *)
- (* `slot->format' is also changed to `FT_GLYPH_FORMAT_BITMAP' . *)
- (* *)
- (* <Note> *)
- (* Here a small pseudo code fragment which shows how to use *)
- (* `lsb_delta' and `rsb_delta': *)
- (* *)
- (* { *)
- (* FT_Pos origin_x = 0; *)
- (* FT_Pos prev_rsb_delta = 0; *)
- (* *)
- (* *)
- (* for all glyphs do *)
- (* <compute kern between current and previous glyph and add it to *)
- (* `origin_x'> *)
- (* *)
- (* <load glyph with `FT_Load_Glyph'> *)
- (* *)
- (* if ( prev_rsb_delta - face->glyph->lsb_delta >= 32 ) *)
- (* origin_x -= 64; *)
- (* else if ( prev_rsb_delta - face->glyph->lsb_delta < -32 ) *)
- (* origin_x += 64; *)
- (* *)
- (* prev_rsb_delta = face->glyph->rsb_delta; *)
- (* *)
- (* <save glyph image, or render glyph, or ...> *)
- (* *)
- (* origin_x += face->glyph->advance.x; *)
- (* endfor *)
- (* } *)
- (* *)
- FT_GlyphSlotRec = record
- alibrary : FT_Library;
-
- face : FT_Face;
- next : FT_GlyphSlot;
- flags : FT_UInt;
-
- generic : FT_Generic;
- metrics : FT_Glyph_Metrics;
-
- linearHoriAdvance ,
- linearVertAdvance : FT_Fixed;
-
- advance : FT_Vector;
- format : FT_Glyph_Format;
- bitmap : FT_Bitmap;
-
- bitmap_left ,
- bitmap_top : FT_Int;
-
- outline : FT_Outline;
-
- num_subglyphs : FT_UInt;
- subglyphs : FT_SubGlyph;
-
- control_data : pointer;
- control_len : clong;
-
- lsb_delta: FT_Pos;
- rsb_delta: FT_Pos;
-
- other : pointer;
-
- //internal: FT_Slot_Internal;
- end;
-
- (*************************************************************************)
- (* *)
- (* <Struct> *)
- (* FT_Size_Metrics *)
- (* *)
- (* <Description> *)
- (* The size metrics structure returned scaled important distances for *)
- (* a given size object. *)
- (* *)
- (* <Fields> *)
- (* x_ppem :: The character width, expressed in integer pixels. *)
- (* This is the width of the EM square expressed in *)
- (* pixels, hence the term `ppem' (pixels per EM). *)
- (* *)
- (* y_ppem :: The character height, expressed in integer pixels. *)
- (* This is the height of the EM square expressed in *)
- (* pixels, hence the term `ppem' (pixels per EM). *)
- (* *)
- (* x_scale :: A simple 16.16 fixed point format coefficient used *)
- (* to scale horizontal distances expressed in font *)
- (* units to fractional (26.6) pixel coordinates. *)
- (* *)
- (* y_scale :: A simple 16.16 fixed point format coefficient used *)
- (* to scale vertical distances expressed in font *)
- (* units to fractional (26.6) pixel coordinates. *)
- (* *)
- (* ascender :: The ascender, expressed in 26.6 fixed point *)
- (* pixels. Positive for ascenders above the *)
- (* baseline. *)
- (* *)
- (* descender :: The descender, expressed in 26.6 fixed point *)
- (* pixels. Negative for descenders below the *)
- (* baseline. *)
- (* *)
- (* height :: The text height, expressed in 26.6 fixed point *)
- (* pixels. Always positive. *)
- (* *)
- (* max_advance :: Maximum horizontal advance, expressed in 26.6 *)
- (* fixed point pixels. Always positive. *)
- (* *)
- (* <Note> *)
- (* For scalable fonts, the values of `ascender', `descender', and *)
- (* `height' are scaled versions of `face->ascender', *)
- (* `face->descender', and `face->height', respectively. *)
- (* *)
- (* Unfortunately, due to glyph hinting, these values might not be *)
- (* exact for certain fonts. They thus must be treated as unreliable *)
- (* with an error margin of at least one pixel! *)
- (* *)
- (* Indeed, the only way to get the exact pixel ascender and descender *)
- (* is to render _all_ glyphs. As this would be a definite *)
- (* performance hit, it is up to client applications to perform such *)
- (* computations. *)
- (* *)
- FT_Size_Metrics = record
- x_ppem, (* horizontal pixels per EM *)
- y_ppem: FT_UShort; (* vertical pixels per EM *)
- x_scale, (* scaling values used to convert font *)
- y_scale: FT_Fixed; (* units to 26.6 fractional pixels *)
-
- ascender, (* ascender in 26.6 frac. pixels *)
- descender: FT_Pos; (* descender in 26.6 frac. pixels *)
- height: FT_Pos; (* text height in 26.6 frac. pixels *)
- max_advance: FT_Pos; (* max horizontal advance, in 26.6 pixels *)
- end;
-
- (*************************************************************************)
- (* *)
- (* <Type> *)
- (* FT_Size *)
- (* *)
- (* <Description> *)
- (* A handle to a given size object. Such an object models the data *)
- (* that depends on the current _resolution_ and _character size_ in a *)
- (* given @FT_Face. *)
- (* *)
- (* <Note> *)
- (* Each face object owns one or more sizes. There is however a *)
- (* single _active_ size for the face at any time that will be used by *)
- (* functions like @FT_Load_Glyph, @FT_Get_Kerning, etc. *)
- (* *)
- (* You can use the @FT_Activate_Size API to change the current *)
- (* active size of any given face. *)
- (* *)
- (* <Also> *)
- (* The @FT_SizeRec structure details the publicly accessible fields *)
- (* of a given face object. *)
- (* *)
- FT_Size = ^FT_SizeRec;
-
- (*************************************************************************)
- (* *)
- (* <Struct> *)
- (* FT_SizeRec *)
- (* *)
- (* <Description> *)
- (* FreeType root size class structure. A size object models the *)
- (* resolution and pointsize dependent data of a given face. *)
- (* *)
- (* <Fields> *)
- (* face :: Handle to the parent face object. *)
- (* *)
- (* generic :: A typeless pointer, which is unused by the FreeType *)
- (* library or any of its drivers. It can be used by *)
- (* client applications to link their own data to each size *)
- (* object. *)
- (* *)
- (* metrics :: Metrics for this size object. This field is read-only. *)
- (* *)
- FT_SizeRec = record
- face : FT_Face;
- generic : FT_Generic;
- metrics : FT_Size_Metrics;
- //internal : FT_Size_Internal;
- end;
-
-
- (*************************************************************************)
- (* *)
- (* <Struct> *)
- (* FT_FaceRec *)
- (* *)
- (* <Description> *)
- (* FreeType root face class structure. A face object models the *)
- (* resolution and point-size independent data found in a font file. *)
- (* *)
- (* <Fields> *)
- (* num_faces :: In the case where the face is located in a *)
- (* collection (i.e., a file which embeds *)
- (* several faces), this is the total number of *)
- (* faces found in the resource. 1 by default. *)
- (* Accessing non-existent face indices causes *)
- (* an error. *)
- (* *)
- (* face_index :: The index of the face in its font file. *)
- (* Usually, this is 0 for all normal font *)
- (* formats. It can be > 0 in the case of *)
- (* collections (which embed several fonts in a *)
- (* single resource/file). *)
- (* *)
- (* face_flags :: A set of bit flags that give important *)
- (* information about the face; see the *)
- (* @FT_FACE_FLAG_XXX constants for details. *)
- (* *)
- (* style_flags :: A set of bit flags indicating the style of *)
- (* the face (i.e., italic, bold, underline, *)
- (* etc). See the @FT_STYLE_FLAG_XXX *)
- (* constants. *)
- (* *)
- (* num_glyphs :: The total number of glyphs in the face. *)
- (* *)
- (* family_name :: The face's family name. This is an ASCII *)
- (* string, usually in English, which describes *)
- (* the typeface's family (like `Times New *)
- (* Roman', `Bodoni', `Garamond', etc). This *)
- (* is a least common denominator used to list *)
- (* fonts. Some formats (TrueType & OpenType) *)
- (* provide localized and Unicode versions of *)
- (* this string. Applications should use the *)
- (* format specific interface to access them. *)
- (* *)
- (* style_name :: The face's style name. This is an ASCII *)
- (* string, usually in English, which describes *)
- (* the typeface's style (like `Italic', *)
- (* `Bold', `Condensed', etc). Not all font *)
- (* formats provide a style name, so this field *)
- (* is optional, and can be set to NULL. As *)
- (* for `family_name', some formats provide *)
- (* localized/Unicode versions of this string. *)
- (* Applications should use the format specific *)
- (* interface to access them. *)
- (* *)
- (* num_fixed_sizes :: The number of fixed sizes available in this *)
- (* face. This should be set to 0 for scalable *)
- (* fonts, unless its face includes a set of *)
- (* glyphs (called a `strike') for the *)
- (* specified sizes. *)
- (* *)
- (* available_sizes :: An array of sizes specifying the available *)
- (* bitmap/graymap sizes that are contained in *)
- (* in the font face. Should be set to NULL if *)
- (* the field `num_fixed_sizes' is set to 0. *)
- (* *)
- (* num_charmaps :: The total number of character maps in the *)
- (* face. *)
- (* *)
- (* charmaps :: A table of pointers to the face's charmaps. *)
- (* Used to scan the list of available charmaps *)
- (* -- this table might change after a call to *)
- (* @FT_Attach_File or @FT_Attach_Stream (e.g. *)
- (* if used to hook an additional encoding or *)
- (* CMap to the face object). *)
- (* *)
- (* generic :: A field reserved for client uses. See the *)
- (* @FT_Generic type description. *)
- (* *)
- (* bbox :: The font bounding box. Coordinates are *)
- (* expressed in font units (see units_per_EM). *)
- (* The box is large enough to contain any *)
- (* glyph from the font. Thus, bbox.yMax can *)
- (* be seen as the `maximal ascender', *)
- (* bbox.yMin as the `minimal descender', and *)
- (* the maximal glyph width is given by *)
- (* `bbox.xMax-bbox.xMin' (not to be confused *)
- (* with the maximal _advance_width_). Only *)
- (* relevant for scalable formats. *)
- (* *)
- (* units_per_EM :: The number of font units per EM square for *)
- (* this face. This is typically 2048 for *)
- (* TrueType fonts, 1000 for Type1 fonts, and *)
- (* should be set to the (unrealistic) value 1 *)
- (* for fixed-sizes fonts. Only relevant for *)
- (* scalable formats. *)
- (* *)
- (* ascender :: The face's ascender is the vertical *)
- (* distance from the baseline to the topmost *)
- (* point of any glyph in the face. This *)
- (* field's value is positive, expressed in *)
- (* font units. Some font designs use a value *)
- (* different from `bbox.yMax'. Only relevant *)
- (* for scalable formats. *)
- (* *)
- (* descender :: The face's descender is the vertical *)
- (* distance from the baseline to the *)
- (* bottommost point of any glyph in the face. *)
- (* This field's value is *negative* for values *)
- (* below the baseline. It is expressed in *)
- (* font units. Some font designs use a value *)
- (* different from `bbox.yMin'. Only relevant *)
- (* for scalable formats. *)
- (* *)
- (* height :: The face's height is the vertical distance *)
- (* from one baseline to the next when writing *)
- (* several lines of text. Its value is always *)
- (* positive, expressed in font units. The *)
- (* value can be computed as *)
- (* `ascender+descender+line_gap' where the *)
- (* value of `line_gap' is also called *)
- (* `external leading'. Only relevant for *)
- (* scalable formats. *)
- (* *)
- (* max_advance_width :: The maximal advance width, in font units, *)
- (* for all glyphs in this face. This can be *)
- (* used to make word wrapping computations *)
- (* faster. Only relevant for scalable *)
- (* formats. *)
- (* *)
- (* max_advance_height :: The maximal advance height, in font units, *)
- (* for all glyphs in this face. This is only *)
- (* relevant for vertical layouts, and should *)
- (* be set to the `height' for fonts that do *)
- (* not provide vertical metrics. Only *)
- (* relevant for scalable formats. *)
- (* *)
- (* underline_position :: The position, in font units, of the *)
- (* underline line for this face. It's the *)
- (* center of the underlining stem. Only *)
- (* relevant for scalable formats. *)
- (* *)
- (* underline_thickness :: The thickness, in font units, of the *)
- (* underline for this face. Only relevant for *)
- (* scalable formats. *)
- (* *)
- (* glyph :: The face's associated glyph slot(s). This *)
- (* object is created automatically with a new *)
- (* face object. However, certain kinds of *)
- (* applications (mainly tools like converters) *)
- (* can need more than one slot to ease their *)
- (* task. *)
- (* *)
- (* size :: The current active size for this face. *)
- (* *)
- (* charmap :: The current active charmap for this face. *)
- (* *)
- FT_FaceRec = record
- num_faces : FT_Long;
- face_index : FT_Long;
-
- face_flags : FT_Long;
- style_flags : FT_Long;
-
- num_glyphs : FT_Long;
-
- family_name : PFT_String;
- style_name : PFT_String;
-
- num_fixed_sizes : FT_Int;
- available_sizes : PAFT_Bitmap_Size; // is array
-
- num_charmaps : FT_Int;
- charmaps : PAFT_CharMap; // is array
-
- generic : FT_Generic;
-
- (*# the following are only relevant to scalable outlines *)
- bbox : FT_BBox;
-
- units_per_EM : FT_UShort;
- ascender : FT_Short;
- descender : FT_Short;
- height : FT_Short;
-
- max_advance_width : FT_Short;
- max_advance_height : FT_Short;
-
- underline_position : FT_Short;
- underline_thickness : FT_Short;
-
- glyph : FT_GlyphSlot;
- size : FT_Size;
- charmap : FT_CharMap;
- end;
-
-
- (*************************************************************************)
- (* *)
- (* <Struct> *)
- (* FT_CharMapRec *)
- (* *)
- (* <Description> *)
- (* The base charmap structure. *)
- (* *)
- (* <Fields> *)
- (* face :: A handle to the parent face object. *)
- (* *)
- (* encoding :: An @FT_Encoding tag identifying the charmap. Use *)
- (* this with @FT_Select_Charmap. *)
- (* *)
- (* platform_id :: An ID number describing the platform for the *)
- (* following encoding ID. This comes directly from *)
- (* the TrueType specification and should be emulated *)
- (* for other formats. *)
- (* *)
- (* encoding_id :: A platform specific encoding number. This also *)
- (* comes from the TrueType specification and should be *)
- (* emulated similarly. *)
- (* *)
- FT_CharMapRec = record
- face : FT_Face;
- encoding : FT_Encoding;
- platform_id : FT_UShort;
- encoding_id : FT_UShort;
- end;
-
-
-{$I ftconfig.inc}
-{$I fttypes.inc}
-{$I ftimage.inc}
-{$I ftglyph.inc}
-{$I ftstroke.inc}
-{$I ftoutln.inc}
-
-
-{ GLOBAL PROCEDURES }
-
- (*************************************************************************)
- (* *)
- (* @macro: *)
- (* FT_HAS_KERNING( face ) *)
- (* *)
- (* @description: *)
- (* A macro that returns true whenever a face object contains kerning *)
- (* data that can be accessed with @FT_Get_Kerning. *)
- (* *)
- function FT_HAS_KERNING(face : FT_Face ) : cbool;
-
-
- (*************************************************************************)
- (* *)
- (* @macro: *)
- (* FT_IS_SCALABLE( face ) *)
- (* *)
- (* @description: *)
- (* A macro that returns true whenever a face object contains a *)
- (* scalable font face (true for TrueType, Type 1, CID, and *)
- (* OpenType/CFF font formats. *)
- (* *)
- function FT_IS_SCALABLE(face : FT_Face ) : cbool;
-
-
- (*************************************************************************)
- (* *)
- (* <Function> *)
- (* FT_Init_FreeType *)
- (* *)
- (* <Description> *)
- (* Initializes a new FreeType library object. The set of modules *)
- (* that are registered by this function is determined at build time. *)
- (* *)
- (* <Output> *)
- (* alibrary :: A handle to a new library object. *)
- (* *)
- (* <Return> *)
- (* FreeType error code. 0 means success. *)
- (* *)
- function FT_Init_FreeType(out alibrary : FT_Library ) : FT_Error;
- cdecl; external ft_lib name 'FT_Init_FreeType';
-
- (*************************************************************************)
- (* *)
- (* <Function> *)
- (* FT_Done_FreeType *)
- (* *)
- (* <Description> *)
- (* Destroys a given FreeType library object and all of its childs, *)
- (* including resources, drivers, faces, sizes, etc. *)
- (* *)
- (* <Input> *)
- (* library :: A handle to the target library object. *)
- (* *)
- (* <Return> *)
- (* FreeType error code. 0 means success. *)
- (* *)
- function FT_Done_FreeType(alibrary : FT_Library ) : FT_Error;
- cdecl; external ft_lib name 'FT_Done_FreeType';
-
- (*************************************************************************)
- (* *)
- (* <Function> *)
- (* FT_Attach_File *)
- (* *)
- (* <Description> *)
- (* `Attaches' a given font file to an existing face. This is usually *)
- (* to read additional information for a single face object. For *)
- (* example, it is used to read the AFM files that come with Type 1 *)
- (* fonts in order to add kerning data and other metrics. *)
- (* *)
- (* <InOut> *)
- (* face :: The target face object. *)
- (* *)
- (* <Input> *)
- (* filepathname :: An 8-bit pathname naming the `metrics' file. *)
- (* *)
- (* <Return> *)
- (* FreeType error code. 0 means success. *)
- (* *)
- (* <Note> *)
- (* If your font file is in memory, or if you want to provide your *)
- (* own input stream object, use @FT_Attach_Stream. *)
- (* *)
- (* The meaning of the `attach' action (i.e., what really happens when *)
- (* the new file is read) is not fixed by FreeType itself. It really *)
- (* depends on the font format (and thus the font driver). *)
- (* *)
- (* Client applications are expected to know what they are doing *)
- (* when invoking this function. Most drivers simply do not implement *)
- (* file attachments. *)
- (* *)
- function FT_Attach_File(face : FT_Face; filepathname : PChar ) : FT_Error;
- cdecl; external ft_lib name 'FT_Attach_File';
-
- (*************************************************************************)
- (* *)
- (* <Function> *)
- (* FT_New_Memory_Face *)
- (* *)
- (* <Description> *)
- (* Creates a new face object from a given resource and typeface index *)
- (* using a font file already loaded into memory. *)
- (* *)
- (* <InOut> *)
- (* library :: A handle to the library resource. *)
- (* *)
- (* <Input> *)
- (* file_base :: A pointer to the beginning of the font data. *)
- (* *)
- (* file_size :: The size of the memory chunk used by the font data. *)
- (* *)
- (* face_index :: The index of the face within the resource. The *)
- (* first face has index 0. *)
- (* *)
- (* <Output> *)
- (* aface :: A handle to a new face object. *)
- (* *)
- (* <Return> *)
- (* FreeType error code. 0 means success. *)
- (* *)
- (* <Note> *)
- (* The font data bytes are used _directly_ by the @FT_Face object. *)
- (* This means that they are not copied, and that the client is *)
- (* responsible for releasing/destroying them _after_ the *)
- (* corresponding call to @FT_Done_Face . *)
- (* *)
- (* Unlike FreeType 1.x, this function automatically creates a glyph *)
- (* slot for the face object which can be accessed directly through *)
- (* `face->glyph'. *)
- (* *)
- (* @FT_New_Memory_Face can be used to determine and/or check the font *)
- (* format of a given font resource. If the `face_index' field is *)
- (* negative, the function will _not_ return any face handle in *)
- (* `aface'; the return value is 0 if the font format is recognized, *)
- (* or non-zero otherwise. *)
- (* *)
- function FT_New_Memory_Face(
- library_ : FT_Library;
- file_base : PFT_Byte;
- file_size ,
- face_index : FT_Long;
- out aface : FT_Face ) : FT_Error;
- cdecl; external ft_lib name 'FT_New_Memory_Face';
-
- (*************************************************************************)
- (* *)
- (* <Function> *)
- (* FT_New_Face *)
- (* *)
- (* <Description> *)
- (* Creates a new face object from a given resource and typeface index *)
- (* using a pathname to the font file. *)
- (* *)
- (* <InOut> *)
- (* library :: A handle to the library resource. *)
- (* *)
- (* <Input> *)
- (* pathname :: A path to the font file. *)
- (* *)
- (* face_index :: The index of the face within the resource. The *)
- (* first face has index 0. *)
- (* *)
- (* <Output> *)
- (* aface :: A handle to a new face object. *)
- (* *)
- (* <Return> *)
- (* FreeType error code. 0 means success. *)
- (* *)
- (* <Note> *)
- (* Unlike FreeType 1.x, this function automatically creates a glyph *)
- (* slot for the face object which can be accessed directly through *)
- (* `face->glyph'. *)
- (* *)
- (* @FT_New_Face can be used to determine and/or check the font format *)
- (* of a given font resource. If the `face_index' field is negative, *)
- (* the function will _not_ return any face handle in `aface'; the *)
- (* return value is 0 if the font format is recognized, or non-zero *)
- (* otherwise. *)
- (* *)
- (* Each new face object created with this function also owns a *)
- (* default @FT_Size object, accessible as `face->size'. *)
- (* *)
- function FT_New_Face(
- library_ : FT_Library;
- filepathname : PChar;
- face_index : FT_Long;
- out aface : FT_Face ) : FT_Error;
- cdecl; external ft_lib name 'FT_New_Face';
-
- (*************************************************************************)
- (* *)
- (* <Function> *)
- (* FT_Done_Face *)
- (* *)
- (* <Description> *)
- (* Discards a given face object, as well as all of its child slots *)
- (* and sizes. *)
- (* *)
- (* <Input> *)
- (* face :: A handle to a target face object. *)
- (* *)
- (* <Return> *)
- (* FreeType error code. 0 means success. *)
- (* *)
- function FT_Done_Face(face : FT_Face ) : FT_Error;
- cdecl; external ft_lib name 'FT_Done_Face';
-
- (*************************************************************************)
- (* *)
- (* <Function> *)
- (* FT_Select_Charmap *)
- (* *)
- (* <Description> *)
- (* Selects a given charmap by its encoding tag (as listed in *)
- (* `freetype.h'). *)
- (* *)
- (* <InOut> *)
- (* face :: A handle to the source face object. *)
- (* *)
- (* <Input> *)
- (* encoding :: A handle to the selected charmap. *)
- (* *)
- (* <Return> *)
- (* FreeType error code. 0 means success. *)
- (* *)
- (* <Note> *)
- (* This function will return an error if no charmap in the face *)
- (* corresponds to the encoding queried here. *)
- (* *)
- function FT_Select_Charmap(face : FT_Face; encoding : FT_Encoding ) : FT_Error;
- cdecl; external ft_lib name 'FT_Select_Charmap';
-
- (*************************************************************************)
- (* *)
- (* <Function> *)
- (* FT_Get_Char_Index *)
- (* *)
- (* <Description> *)
- (* Returns the glyph index of a given character code. This function *)
- (* uses a charmap object to do the translation. *)
- (* *)
- (* <Input> *)
- (* face :: A handle to the source face object. *)
- (* *)
- (* charcode :: The character code. *)
- (* *)
- (* <Return> *)
- (* The glyph index. 0 means `undefined character code'. *)
- (* *)
- (* <Note> *)
- (* FreeType computes its own glyph indices which are not necessarily *)
- (* the same as used in the font in case the font is based on glyph *)
- (* indices. Reason for this behaviour is to assure that index 0 is *)
- (* never used, representing the missing glyph. *)
- (* *)
- function FT_Get_Char_Index(face : FT_Face; charcode : FT_ULong ) : FT_UInt;
- cdecl; external ft_lib name 'FT_Get_Char_Index';
-
- (*************************************************************************)
- (* *)
- (* <Function> *)
- (* FT_Load_Glyph *)
- (* *)
- (* <Description> *)
- (* A function used to load a single glyph within a given glyph slot, *)
- (* for a given size. *)
- (* *)
- (* <InOut> *)
- (* face :: A handle to the target face object where the glyph *)
- (* will be loaded. *)
- (* *)
- (* <Input> *)
- (* glyph_index :: The index of the glyph in the font file. For *)
- (* CID-keyed fonts (either in PS or in CFF format) *)
- (* this argument specifies the CID value. *)
- (* *)
- (* load_flags :: A flag indicating what to load for this glyph. The *)
- (* @FT_LOAD_XXX constants can be used to control the *)
- (* glyph loading process (e.g., whether the outline *)
- (* should be scaled, whether to load bitmaps or not, *)
- (* whether to hint the outline, etc). *)
- (* *)
- (* <Return> *)
- (* FreeType error code. 0 means success. *)
- (* *)
- (* <Note> *)
- (* If the glyph image is not a bitmap, and if the bit flag *)
- (* FT_LOAD_IGNORE_TRANSFORM is unset, the glyph image will be *)
- (* transformed with the information passed to a previous call to *)
- (* @FT_Set_Transform. *)
- (* *)
- (* Note that this also transforms the `face.glyph.advance' field, but *)
- (* *not* the values in `face.glyph.metrics'. *)
- (* *)
- function FT_Load_Glyph(
- face : FT_Face;
- glyph_index : FT_UInt ;
- load_flags : FT_Int32 ) : FT_Error;
- cdecl; external ft_lib name 'FT_Load_Glyph';
-
-
- (*************************************************************************)
- (* *)
- (* <Function> *)
- (* FT_Render_Glyph *)
- (* *)
- (* <Description> *)
- (* Converts a given glyph image to a bitmap. It does so by *)
- (* inspecting the glyph image format, find the relevant renderer, and *)
- (* invoke it. *)
- (* *)
- (* <InOut> *)
- (* slot :: A handle to the glyph slot containing the image to *)
- (* convert. *)
- (* *)
- (* <Input> *)
- (* render_mode :: This is the render mode used to render the glyph *)
- (* image into a bitmap. See FT_Render_Mode for a list *)
- (* of possible values. *)
- (* *)
- (* <Return> *)
- (* FreeType error code. 0 means success. *)
- (* *)
- function FT_Render_Glyph(slot : FT_GlyphSlot; render_mode : FT_Render_Mode ) : FT_Error;
- cdecl; external ft_lib name 'FT_Render_Glyph';
-
- (*************************************************************************)
- (* *)
- (* <Enum> *)
- (* FT_Kerning_Mode *)
- (* *)
- (* <Description> *)
- (* An enumeration used to specify which kerning values to return in *)
- (* @FT_Get_Kerning. *)
- (* *)
- (* <Values> *)
- (* FT_KERNING_DEFAULT :: Return scaled and grid-fitted kerning *)
- (* distances (value is 0). *)
- (* *)
- (* FT_KERNING_UNFITTED :: Return scaled but un-grid-fitted kerning *)
- (* distances. *)
- (* *)
- (* FT_KERNING_UNSCALED :: Return the kerning vector in original font *)
- (* units. *)
- (* *)
-const
- FT_KERNING_DEFAULT = 0;
- FT_KERNING_UNFITTED = 1;
- FT_KERNING_UNSCALED = 2;
-
-
- (*************************************************************************)
- (* *)
- (* <Function> *)
- (* FT_Get_Kerning *)
- (* *)
- (* <Description> *)
- (* Returns the kerning vector between two glyphs of a same face. *)
- (* *)
- (* <Input> *)
- (* face :: A handle to a source face object. *)
- (* *)
- (* left_glyph :: The index of the left glyph in the kern pair. *)
- (* *)
- (* right_glyph :: The index of the right glyph in the kern pair. *)
- (* *)
- (* kern_mode :: See @FT_Kerning_Mode for more information. *)
- (* Determines the scale/dimension of the returned *)
- (* kerning vector. *)
- (* *)
- (* <Output> *)
- (* akerning :: The kerning vector. This is in font units for *)
- (* scalable formats, and in pixels for fixed-sizes *)
- (* formats. *)
- (* *)
- (* <Return> *)
- (* FreeType error code. 0 means success. *)
- (* *)
- (* <Note> *)
- (* Only horizontal layouts (left-to-right & right-to-left) are *)
- (* supported by this method. Other layouts, or more sophisticated *)
- (* kernings, are out of the scope of this API function -- they can be *)
- (* implemented through format-specific interfaces. *)
- (* *)
- function FT_Get_Kerning(
- face : FT_Face;
- left_glyph ,
- right_glyph ,
- kern_mode : FT_UInt;
- out akerning : FT_Vector ) : FT_Error;
- cdecl; external ft_lib name 'FT_Get_Kerning';
-
- (*************************************************************************)
- (* *)
- (* <Function> *)
- (* FT_Set_Char_Size *)
- (* *)
- (* <Description> *)
- (* Sets the character dimensions of a given face object. The *)
- (* `char_width' and `char_height' values are used for the width and *)
- (* height, respectively, expressed in 26.6 fractional points. *)
- (* *)
- (* If the horizontal or vertical resolution values are zero, a *)
- (* default value of 72dpi is used. Similarly, if one of the *)
- (* character dimensions is zero, its value is set equal to the other. *)
- (* *)
- (* <InOut> *)
- (* face :: A handle to a target face object. *)
- (* *)
- (* <Input> *)
- (* char_width :: The character width, in 26.6 fractional points. *)
- (* *)
- (* char_height :: The character height, in 26.6 fractional *)
- (* points. *)
- (* *)
- (* horz_resolution :: The horizontal resolution. *)
- (* *)
- (* vert_resolution :: The vertical resolution. *)
- (* *)
- (* <Return> *)
- (* FreeType error code. 0 means success. *)
- (* *)
- (* <Note> *)
- (* When dealing with fixed-size faces (i.e., non-scalable formats), *)
- (* @FT_Set_Pixel_Sizes provides a more convenient interface. *)
- (* *)
- function FT_Set_Char_Size(
- face : FT_Face;
- char_width ,
- char_height : FT_F26dot6;
- horz_res ,
- vert_res : FT_UInt) : FT_Error;
- cdecl; external ft_lib name 'FT_Set_Char_Size';
-
- (*************************************************************************)
- (* *)
- (* <Function> *)
- (* FT_Set_Pixel_Sizes *)
- (* *)
- (* <Description> *)
- (* Sets the character dimensions of a given face object. The width *)
- (* and height are expressed in integer pixels. *)
- (* *)
- (* If one of the character dimensions is zero, its value is set equal *)
- (* to the other. *)
- (* *)
- (* <InOut> *)
- (* face :: A handle to the target face object. *)
- (* *)
- (* <Input> *)
- (* pixel_width :: The character width, in integer pixels. *)
- (* *)
- (* pixel_height :: The character height, in integer pixels. *)
- (* *)
- (* <Return> *)
- (* FreeType error code. 0 means success. *)
- (* *)
- (* <Note> *)
- (* The values of `pixel_width' and `pixel_height' correspond to the *)
- (* pixel values of the _typographic_ character size, which are NOT *)
- (* necessarily the same as the dimensions of the glyph `bitmap *)
- (* cells'. *)
- (* *)
- (* The `character size' is really the size of an abstract square *)
- (* called the `EM', used to design the font. However, depending *)
- (* on the font design, glyphs will be smaller or greater than the *)
- (* EM. *)
- (* *)
- (* This means that setting the pixel size to, say, 8x8 doesn't *)
- (* guarantee in any way that you will get glyph bitmaps that all fit *)
- (* within an 8x8 cell (sometimes even far from it). *)
- (* *)
- (* For bitmap fonts, `pixel_height' usually is a reliable value for *)
- (* the height of the bitmap cell. Drivers for bitmap font formats *)
- (* which contain a single bitmap strike only (BDF, PCF, FNT) ignore *)
- (* `pixel_width'. *)
- (* *)
- function FT_Set_Pixel_Sizes(
- face : FT_Face;
- pixel_width ,
- pixel_height : FT_UInt ) : FT_Error;
- cdecl; external ft_lib name 'FT_Set_Pixel_Sizes';
-
-const
- FT_ANGLE_PI = 180 shl 16;
- FT_ANGLE_2PI = FT_ANGLE_PI * 2;
- FT_ANGLE_PI2 = FT_ANGLE_PI div 2;
- FT_ANGLE_PI4 = FT_ANGLE_PI div 4;
-
-
-implementation
-
-
-{ FT_CURVE_TAG }
-function FT_CURVE_TAG(flag: byte): byte;
-begin
- result := flag and 3;
-end;
-
-{ FT_HAS_KERNING }
-function FT_HAS_KERNING(face : FT_Face ) : cbool;
-begin
- result := cbool(face.face_flags and FT_FACE_FLAG_KERNING );
-end;
-
-{ FT_IS_SCALABLE }
-function FT_IS_SCALABLE(face : FT_Face ) : cbool;
-begin
- result := cbool(face.face_flags and FT_FACE_FLAG_SCALABLE );
-end;
-
-end.
-
diff --git a/src/lib/libpng/png.pas b/src/lib/libpng/png.pas
deleted file mode 100644
index 0092dde3..00000000
--- a/src/lib/libpng/png.pas
+++ /dev/null
@@ -1,974 +0,0 @@
-(*
- * libpng pascal headers
- * Version: 1.2.12
- *)
-
-{$IFDEF FPC}
- {$ifndef NO_SMART_LINK}
- {$smartlink on}
- {$endif}
-{$ENDIF}
-
-unit png;
-
-interface
-
-{$IFDEF FPC}
- {$MODE DELPHI}
- {$PACKRECORDS C}
-{$ENDIF}
-
-uses
- ctypes,
- {$IFDEF MSWINDOWS}
- Windows,
- {$ENDIF}
- {$IFDEF UNIX}
- baseunix,
- {$ENDIF}
- zlib;
-
-const
-{$IFDEF MSWINDOWS}
- // use libpng12-0 (Version 1.2.18), delivered wih SDL_Image
- LibPng = 'libpng12-0'; // 'libpng13';
- // matching lib version for libpng13.dll, needed for initialization
- PNG_LIBPNG_VER_STRING='1.2.12';
- // define the compiler that was used to built the DLL (necessary for jmp_buf)
- // SDL_Image was compiled with GCC
- //{$define MSVC_DLL} // MS Visual C++
- {$DEFINE GCC_DLL} // GCC
-{$ELSE}
- LibPng = 'png';
- // matching lib version for libpng, needed for initialization
- PNG_LIBPNG_VER_STRING='1.2.12';
- {$IFDEF DARWIN}
- {$linklib libpng}
- {$ENDIF}
-{$ENDIF}
-
-
-{$IFDEF MSWINDOWS}
-const
- // JB_LEN (#elements in jmp_buf) depends on the compiler used to compile the DLL
- // MSVC++: 16 (x86/AMD64), GCC: 52
- {$IF Defined(MSVC_DLL)}
- JB_LEN = 16;
- {$ELSEIF Defined(GCC_DLL)}
- JB_LEN = 52;
- {$ELSE}
- JB_LEN = 0;
- {$IFEND}
-{$ENDIF}
-
-type
- {$IFNDEF FPC}
- // defines for Delphi
- size_t = culong;
- {$ENDIF}
-
- {$ifdef MSWINDOWS}
- {$if JB_LEN > 0}
- jmp_buf = array[0..JB_LEN-1] of cint;
- // the png_struct cannot be accessed if the size of jmp_buf is unknown
- {$define UsePngStruct}
- {$ifend}
- // Do NOT use time_t on windows! It might be 32 or 64bit, depending on the compiler and system.
- // MSVS-2005 starts using 64bit for time_t on x86 by default, but GCC uses just 32bit.
- //time_t = clong;
- {$endif}
-
- z_stream = TZStream;
-
- png_uint_32 = cuint32;
- png_int_32 = cint32;
- png_uint_16 = cuint16;
- png_int_16 = cint16;
- png_byte = cuint8;
- ppng_uint_32 = ^png_uint_32;
- ppng_int_32 = ^png_int_32;
- ppng_uint_16 = ^png_uint_16;
- ppng_int_16 = ^png_int_16;
- ppng_byte = ^png_byte;
- pppng_uint_32 = ^ppng_uint_32;
- pppng_int_32 = ^ppng_int_32;
- pppng_uint_16 = ^ppng_uint_16;
- pppng_int_16 = ^ppng_int_16;
- pppng_byte = ^ppng_byte;
- png_size_t = size_t;
- png_fixed_point = png_int_32;
- ppng_fixed_point = ^png_fixed_point;
- pppng_fixed_point = ^ppng_fixed_point;
- png_voidp = pointer;
- png_bytep = Ppng_byte;
- ppng_bytep = ^png_bytep;
- png_uint_32p = Ppng_uint_32;
- png_int_32p = Ppng_int_32;
- png_uint_16p = Ppng_uint_16;
- ppng_uint_16p = ^png_uint_16p;
- png_int_16p = Ppng_int_16;
- png_const_charp = {const} Pchar;
- png_charp = Pchar;
- ppng_charp = ^png_charp;
- png_fixed_point_p = Ppng_fixed_point;
- png_FILE_p = Pointer;
- png_doublep = PCdouble;
- png_bytepp = PPpng_byte;
- png_uint_32pp = PPpng_uint_32;
- png_int_32pp = PPpng_int_32;
- png_uint_16pp = PPpng_uint_16;
- png_int_16pp = PPpng_int_16;
- png_const_charpp = {const} PPchar;
- png_charpp = PPchar;
- ppng_charpp = ^png_charpp;
- png_fixed_point_pp = PPpng_fixed_point;
- PPCdouble = ^PCdouble;
- png_doublepp = PPCdouble;
- PPPChar = ^PPChar;
- png_charppp = PPPChar;
- PCharf = PChar;
- PPCharf = ^PCharf;
- png_zcharp = PCharf;
- png_zcharpp = PPCharf;
- png_zstreamp = Pzstream;
-
-const
- (* Maximum positive integer used in PNG is (2^31)-1 *)
- PNG_UINT_31_MAX = (png_uint_32($7fffffff));
- PNG_UINT_32_MAX = (png_uint_32(-1));
- PNG_SIZE_MAX = (png_size_t(-1));
- {$if defined(PNG_1_0_X) or defined (PNG_1_2_X)}
- (* PNG_MAX_UINT is deprecated; use PNG_UINT_31_MAX instead. *)
- PNG_MAX_UINT = PNG_UINT_31_MAX;
- {$ifend}
-
- (* These describe the color_type field in png_info. *)
- (* color type masks *)
- PNG_COLOR_MASK_PALETTE = 1;
- PNG_COLOR_MASK_COLOR = 2;
- PNG_COLOR_MASK_ALPHA = 4;
-
- (* color types. Note that not all combinations are legal *)
- PNG_COLOR_TYPE_GRAY = 0;
- PNG_COLOR_TYPE_PALETTE = (PNG_COLOR_MASK_COLOR or PNG_COLOR_MASK_PALETTE);
- PNG_COLOR_TYPE_RGB = (PNG_COLOR_MASK_COLOR);
- PNG_COLOR_TYPE_RGB_ALPHA = (PNG_COLOR_MASK_COLOR or PNG_COLOR_MASK_ALPHA);
- PNG_COLOR_TYPE_GRAY_ALPHA = (PNG_COLOR_MASK_ALPHA);
- (* aliases *)
- PNG_COLOR_TYPE_RGBA = PNG_COLOR_TYPE_RGB_ALPHA;
- PNG_COLOR_TYPE_GA = PNG_COLOR_TYPE_GRAY_ALPHA;
-
- (* This is for compression type. PNG 1.0-1.2 only define the single type. *)
- PNG_COMPRESSION_TYPE_BASE = 0; (* Deflate method 8, 32K window *)
- PNG_COMPRESSION_TYPE_DEFAULT = PNG_COMPRESSION_TYPE_BASE;
-
- (* This is for filter type. PNG 1.0-1.2 only define the single type. *)
- PNG_FILTER_TYPE_BASE = 0; (* Single row per-byte filtering *)
- PNG_INTRAPIXEL_DIFFERENCING = 64; (* Used only in MNG datastreams *)
- PNG_FILTER_TYPE_DEFAULT = PNG_FILTER_TYPE_BASE;
-
- (* These are for the interlacing type. These values should NOT be changed. *)
- PNG_INTERLACE_NONE = 0; (* Non-interlaced image *)
- PNG_INTERLACE_ADAM7 = 1; (* Adam7 interlacing *)
- PNG_INTERLACE_LAST = 2; (* Not a valid value *)
-
- (* These are for the oFFs chunk. These values should NOT be changed. *)
- PNG_OFFSET_PIXEL = 0; (* Offset in pixels *)
- PNG_OFFSET_MICROMETER = 1; (* Offset in micrometers (1/10^6 meter) *)
- PNG_OFFSET_LAST = 2; (* Not a valid value *)
-
- (* These are for the pCAL chunk. These values should NOT be changed. *)
- PNG_EQUATION_LINEAR = 0; (* Linear transformation *)
- PNG_EQUATION_BASE_E = 1; (* Exponential base e transform *)
- PNG_EQUATION_ARBITRARY = 2; (* Arbitrary base exponential transform *)
- PNG_EQUATION_HYPERBOLIC = 3; (* Hyperbolic sine transformation *)
- PNG_EQUATION_LAST = 4; (* Not a valid value *)
-
- (* These are for the sCAL chunk. These values should NOT be changed. *)
- PNG_SCALE_UNKNOWN = 0; (* unknown unit (image scale) *)
- PNG_SCALE_METER = 1; (* meters per pixel *)
- PNG_SCALE_RADIAN = 2; (* radians per pixel *)
- PNG_SCALE_LAST = 3; (* Not a valid value *)
-
- (* These are for the pHYs chunk. These values should NOT be changed. *)
- PNG_RESOLUTION_UNKNOWN = 0; (* pixels/unknown unit (aspect ratio) *)
- PNG_RESOLUTION_METER = 1; (* pixels/meter *)
- PNG_RESOLUTION_LAST = 2; (* Not a valid value *)
-
- (* These are for the sRGB chunk. These values should NOT be changed. *)
- PNG_sRGB_INTENT_PERCEPTUAL = 0;
- PNG_sRGB_INTENT_RELATIVE = 1;
- PNG_sRGB_INTENT_SATURATION = 2;
- PNG_sRGB_INTENT_ABSOLUTE = 3;
- PNG_sRGB_INTENT_LAST = 4; (* Not a valid value *)
-
- (* This is for text chunks *)
- PNG_KEYWORD_MAX_LENGTH = 79;
-
- (* Maximum number of entries in PLTE/sPLT/tRNS arrays *)
- PNG_MAX_PALETTE_LENGTH = 256;
-
- (* These determine if an ancillary chunk's data has been successfully read
- * from the PNG header, or if the application has filled in the corresponding
- * data in the info_struct to be written into the output file. The values
- * of the PNG_INFO_<chunk> defines should NOT be changed.
- *)
- PNG_INFO_gAMA = $0001;
- PNG_INFO_sBIT = $0002;
- PNG_INFO_cHRM = $0004;
- PNG_INFO_PLTE = $0008;
- PNG_INFO_tRNS = $0010;
- PNG_INFO_bKGD = $0020;
- PNG_INFO_hIST = $0040;
- PNG_INFO_pHYs = $0080;
- PNG_INFO_oFFs = $0100;
- PNG_INFO_tIME = $0200;
- PNG_INFO_pCAL = $0400;
- PNG_INFO_sRGB = $0800; (* GR-P, 0.96a *)
- PNG_INFO_iCCP = $1000; (* ESR, 1.0.6 *)
- PNG_INFO_sPLT = $2000; (* ESR, 1.0.6 *)
- PNG_INFO_sCAL = $4000; (* ESR, 1.0.6 *)
- PNG_INFO_IDAT = $8000; (* ESR, 1.0.6 *)
-
-
-(*
-var
- png_libpng_ver : array[0..11] of char; external LibPng name 'png_libpng_ver';
- png_pass_start : array[0..6] of cint; external LibPng name 'png_pass_start';
- png_pass_inc : array[0..6] of cint; external LibPng name 'png_pass_inc';
- png_pass_ystart : array[0..6] of cint; external LibPng name 'png_pass_ystart';
- png_pass_yinc : array[0..6] of cint; external LibPng name 'png_pass_yinc';
- png_pass_mask : array[0..6] of cint; external LibPng name 'png_pass_mask';
- png_pass_dsp_mask : array[0..6] of cint; external LibPng name 'png_pass_dsp_mask';
-*)
-
-type
- (* Three color definitions. The order of the red, green, and blue, (and the
- * exact size) is not important, although the size of the fields need to
- * be png_byte or png_uint_16 (as defined below).
- *)
- png_color = record
- red : png_byte;
- green : png_byte;
- blue : png_byte;
- end;
- ppng_color = ^png_color;
- pppng_color = ^ppng_color;
- png_color_struct = png_color;
- png_colorp = Ppng_color;
- ppng_colorp = ^png_colorp;
- png_colorpp = PPpng_color;
-
- png_color_16 = record
- index : png_byte; (* used for palette files *)
- red : png_uint_16; (* for use in red green blue files *)
- green : png_uint_16;
- blue : png_uint_16;
- gray : png_uint_16; (* for use in grayscale files *)
- end;
- ppng_color_16 = ^png_color_16 ;
- pppng_color_16 = ^ppng_color_16 ;
- png_color_16_struct = png_color_16;
- png_color_16p = Ppng_color_16;
- ppng_color_16p = ^png_color_16p;
- png_color_16pp = PPpng_color_16;
-
- png_color_8 = record
- red : png_byte; (* for use in red green blue files *)
- green : png_byte;
- blue : png_byte;
- gray : png_byte; (* for use in grayscale files *)
- alpha : png_byte; (* for alpha channel files *)
- end;
- ppng_color_8 = ^png_color_8;
- pppng_color_8 = ^ppng_color_8;
- png_color_8_struct = png_color_8;
- png_color_8p = Ppng_color_8;
- ppng_color_8p = ^png_color_8p;
- png_color_8pp = PPpng_color_8;
-
- (*
- * The following two structures are used for the in-core representation
- * of sPLT chunks.
- *)
- png_sPLT_entry = record
- red : png_uint_16;
- green : png_uint_16;
- blue : png_uint_16;
- alpha : png_uint_16;
- frequency : png_uint_16;
- end;
- ppng_sPLT_entry = ^png_sPLT_entry;
- pppng_sPLT_entry = ^ppng_sPLT_entry;
- png_sPLT_entry_struct = png_sPLT_entry;
- png_sPLT_entryp = Ppng_sPLT_entry;
- png_sPLT_entrypp = PPpng_sPLT_entry;
-
- (* When the depth of the sPLT palette is 8 bits, the color and alpha samples
- * occupy the LSB of their respective members, and the MSB of each member
- * is zero-filled. The frequency member always occupies the full 16 bits.
- *)
-
- png_sPLT_t = record
- name : png_charp; (* palette name *)
- depth : png_byte; (* depth of palette samples *)
- entries : png_sPLT_entryp; (* palette entries *)
- nentries : png_int_32; (* number of palette entries *)
- end;
- ppng_sPLT_t = ^png_sPLT_t;
- pppng_sPLT_t = ^ppng_sPLT_t;
- png_sPLT_struct = png_sPLT_t;
- png_sPLT_tp = Ppng_sPLT_t;
- png_sPLT_tpp = PPpng_sPLT_t;
-
- (* png_text holds the contents of a text/ztxt/itxt chunk in a PNG file,
- * and whether that contents is compressed or not. The "key" field
- * points to a regular zero-terminated C string. The "text", "lang", and
- * "lang_key" fields can be regular C strings, empty strings, or NULL pointers.
- * However, the * structure returned by png_get_text() will always contain
- * regular zero-terminated C strings (possibly empty), never NULL pointers,
- * so they can be safely used in printf() and other string-handling functions.
- *)
- png_text = record
- compression : cint; (* compression value:
- -1: tEXt, none
- 0: zTXt, deflate
- 1: iTXt, none
- 2: iTXt, deflate *)
- key : png_charp; (* keyword, 1-79 character description of "text" *)
- text : png_charp; (* comment, may be an empty string (ie "")
- or a NULL pointer *)
- text_length : png_size_t; (* length of the text string *)
- end;
- ppng_text = ^png_text;
- pppng_text = ^ppng_text;
- png_text_struct = png_text;
- png_textp = Ppng_text;
- ppng_textp = ^png_textp;
- png_textpp = PPpng_text;
-
- (* png_time is a way to hold the time in an machine independent way.
- * Two conversions are provided, both from time_t and struct tm. There
- * is no portable way to convert to either of these structures, as far
- * as I know. If you know of a portable way, send it to me. As a side
- * note - PNG has always been Year 2000 compliant!
- *)
- png_time = record
- year : png_uint_16; (* full year, as in, 1995 *)
- month : png_byte; (* month of year, 1 - 12 *)
- day : png_byte; (* day of month, 1 - 31 *)
- hour : png_byte; (* hour of day, 0 - 23 *)
- minute : png_byte; (* minute of hour, 0 - 59 *)
- second : png_byte; (* second of minute, 0 - 60 (for leap seconds) *)
- end;
- ppng_time = ^png_time;
- pppng_time = ^ppng_time;
- png_time_struct = png_time;
- png_timep = Ppng_time;
- PPNG_TIMEP = ^PNG_TIMEP;
- png_timepp = PPpng_time;
-
-const
- PNG_CHUNK_NAME_LENGTH = 5;
-type
- (* png_unknown_chunk is a structure to hold queued chunks for which there is
- * no specific support. The idea is that we can use this to queue
- * up private chunks for output even though the library doesn't actually
- * know about their semantics.
- *)
- png_unknown_chunk = record
- name : array[0..PNG_CHUNK_NAME_LENGTH-1] of png_byte;
- data : Ppng_byte;
- size : png_size_t;
-
- (* libpng-using applications should NOT directly modify this byte. *)
- location : png_byte; (* mode of operation at read time *)
- end;
- ppng_unknown_chunk = ^png_unknown_chunk;
- pppng_unknown_chunk = ^ppng_unknown_chunk;
- png_unknown_chunk_t = png_unknown_chunk;
- png_unknown_chunkp = Ppng_unknown_chunk;
- png_unknown_chunkpp = PPpng_unknown_chunk;
-
- (* png_info is a structure that holds the information in a PNG file so
- * that the application can find out the characteristics of the image.
- * If you are reading the file, this structure will tell you what is
- * in the PNG file. If you are writing the file, fill in the information
- * you want to put into the PNG file, then call png_write_info().
- * The names chosen should be very close to the PNG specification, so
- * consult that document for information about the meaning of each field.
- *
- * With libpng < 0.95, it was only possible to directly set and read the
- * the values in the png_info_struct, which meant that the contents and
- * order of the values had to remain fixed. With libpng 0.95 and later,
- * however, there are now functions that abstract the contents of
- * png_info_struct from the application, so this makes it easier to use
- * libpng with dynamic libraries, and even makes it possible to use
- * libraries that don't have all of the libpng ancillary chunk-handing
- * functionality.
- *
- * In any case, the order of the parameters in png_info_struct should NOT
- * be changed for as long as possible to keep compatibility with applications
- * that use the old direct-access method with png_info_struct.
- *
- * The following members may have allocated storage attached that should be
- * cleaned up before the structure is discarded: palette, trans, text,
- * pcal_purpose, pcal_units, pcal_params, hist, iccp_name, iccp_profile,
- * splt_palettes, scal_unit, row_pointers, and unknowns. By default, these
- * are automatically freed when the info structure is deallocated, if they were
- * allocated internally by libpng. This behavior can be changed by means
- * of the png_data_freer() function.
- *
- * More allocation details: all the chunk-reading functions that
- * change these members go through the corresponding png_set_*
- * functions. A function to clear these members is available: see
- * png_free_data(). The png_set_* functions do not depend on being
- * able to point info structure members to any of the storage they are
- * passed (they make their own copies), EXCEPT that the png_set_text
- * functions use the same storage passed to them in the text_ptr or
- * itxt_ptr structure argument, and the png_set_rows and png_set_unknowns
- * functions do not make their own copies.
- *)
- png_info = record
- width : png_uint_32; (* width of image in pixels (from IHDR) *)
- height : png_uint_32; (* height of image in pixels (from IHDR) *)
- valid : png_uint_32; (* valid chunk data (see PNG_INFO_ below) *)
- rowbytes : png_uint_32; (* bytes needed to hold an untransformed row *)
- palette : png_colorp; (* array of color values (valid & PNG_INFO_PLTE) *)
- num_palette : png_uint_16; (* number of color entries in "palette" (PLTE) *)
- num_trans : png_uint_16; (* number of transparent palette color (tRNS) *)
- bit_depth : png_byte; (* 1, 2, 4, 8, or 16 bits/channel (from IHDR) *)
- color_type : png_byte; (* see PNG_COLOR_TYPE_ below (from IHDR) *)
- (* The following three should have been named *_method not *_type *)
- compression_type : png_byte; (* must be PNG_COMPRESSION_TYPE_BASE (IHDR) *)
- filter_type : png_byte; (* must be PNG_FILTER_TYPE_BASE (from IHDR) *)
- interlace_type : png_byte; (* One of PNG_INTERLACE_NONE, PNG_INTERLACE_ADAM7 *)
-
- (* The following is informational only on read, and not used on writes. *)
- channels : png_byte; (* number of data channels per pixel (1, 2, 3, 4) *)
- pixel_depth : png_byte; (* number of bits per pixel *)
- spare_byte : png_byte; (* to align the data, and for future use *)
- signature : array[0..7] of png_byte; (* magic bytes read by libpng from start of file *)
-
- (* The rest of the data is optional. If you are reading, check the
- * valid field to see if the information in these are valid. If you
- * are writing, set the valid field to those chunks you want written,
- * and initialize the appropriate fields below.
- *)
-
- gamma : cfloat;
- srgb_intent : png_byte;
- num_text : cint;
- max_text : cint;
- text : png_textp;
- mod_time : png_time;
- sig_bit : png_color_8;
- trans : png_bytep;
- trans_values : png_color_16;
- background : png_color_16;
- x_offset : png_int_32;
- y_offset : png_int_32;
- offset_unit_type : png_byte;
- x_pixels_per_unit : png_uint_32;
- y_pixels_per_unit : png_uint_32;
- phys_unit_type : png_byte;
- hist : png_uint_16p;
- x_white : cfloat;
- y_white : cfloat;
- x_red : cfloat;
- y_red : cfloat;
- x_green : cfloat;
- y_green : cfloat;
- x_blue : cfloat;
- y_blue : cfloat;
- pcal_purpose : png_charp;
- pcal_X0 : png_int_32;
- pcal_X1 : png_int_32;
- pcal_units : png_charp;
- pcal_params : png_charpp;
- pcal_type : png_byte;
- pcal_nparams : png_byte;
- free_me : png_uint_32;
- unknown_chunks : png_unknown_chunkp;
- unknown_chunks_num : png_size_t;
- iccp_name : png_charp;
- iccp_profile : png_charp;
- iccp_proflen : png_uint_32;
- iccp_compression : png_byte;
- splt_palettes : png_sPLT_tp;
- splt_palettes_num : png_uint_32;
- scal_unit : png_byte;
- scal_pixel_width : cdouble;
- scal_pixel_height : cdouble;
- scal_s_width : png_charp;
- scal_s_height : png_charp;
- row_pointers : png_bytepp;
- int_gamma : png_fixed_point;
- int_x_white : png_fixed_point;
- int_y_white : png_fixed_point;
- int_x_red : png_fixed_point;
- int_y_red : png_fixed_point;
- int_x_green : png_fixed_point;
- int_y_green : png_fixed_point;
- int_x_blue : png_fixed_point;
- int_y_blue : png_fixed_point;
- end;
- ppng_info = ^png_info;
- pppng_info = ^ppng_info;
- png_info_struct = png_info;
- png_infop = Ppng_info;
- png_infopp = PPpng_info;
-
- (* This is used for the transformation routines, as some of them
- * change these values for the row. It also should enable using
- * the routines for other purposes.
- *)
- png_row_info = record
- width : png_uint_32; (* width of row *)
- rowbytes : png_uint_32; (* number of bytes in row *)
- color_type : png_byte; (* color type of row *)
- bit_depth : png_byte; (* bit depth of row *)
- channels : png_byte; (* number of channels (1, 2, 3, or 4) *)
- pixel_depth : png_byte; (* bits per pixel (depth * channels) *)
- end;
- ppng_row_info = ^png_row_info;
- pppng_row_info = ^ppng_row_info;
- png_row_info_struct = png_row_info;
- png_row_infop = Ppng_row_info;
- png_row_infopp = PPpng_row_info;
- png_structp = ^png_struct;
-
-
- (* These are the function types for the I/O functions and for the functions
- * that allow the user to override the default I/O functions with his or her
- * own. The png_error_ptr type should match that of user-supplied warning
- * and error functions, while the png_rw_ptr type should match that of the
- * user read/write data functions.
- *)
- png_error_ptr = procedure(Arg1 : png_structp; Arg2 : png_const_charp); cdecl;
- png_rw_ptr = procedure(Arg1 : png_structp; Arg2 : png_bytep; Arg3 : png_size_t); cdecl;
- png_flush_ptr = procedure (Arg1 : png_structp); cdecl;
- png_read_status_ptr = procedure (Arg1 : png_structp; Arg2 : png_uint_32; Arg3: cint); cdecl;
- png_write_status_ptr = procedure (Arg1 : png_structp; Arg2:png_uint_32;Arg3 : cint); cdecl;
- png_progressive_info_ptr = procedure (Arg1 : png_structp; Arg2 : png_infop); cdecl;
- png_progressive_end_ptr = procedure (Arg1 : png_structp; Arg2 : png_infop); cdecl;
- png_progressive_row_ptr = procedure (Arg1 : png_structp; Arg2 : png_bytep; Arg3 : png_uint_32; Arg4 : cint); cdecl;
- png_user_transform_ptr = procedure (Arg1 : png_structp; Arg2 : png_row_infop; Arg3 : png_bytep); cdecl;
- png_user_chunk_ptr = function (Arg1 : png_structp; Arg2 : png_unknown_chunkp): cint; cdecl;
- png_unknown_chunk_ptr = procedure (Arg1 : png_structp); cdecl;
- png_malloc_ptr = function (Arg1 : png_structp; Arg2 : png_size_t) : png_voidp; cdecl;
- png_free_ptr = procedure (Arg1 : png_structp; Arg2 : png_voidp); cdecl;
-
- png_struct_def = record
- {$ifdef UsePngStruct}
- jmpbuf : jmp_buf; (* used in png_error *)
- error_fn : png_error_ptr; (* function for printing errors and aborting *)
- warning_fn : png_error_ptr; (* function for printing warnings *)
- error_ptr : png_voidp; (* user supplied struct for error functions *)
- write_data_fn : png_rw_ptr; (* function for writing output data *)
- read_data_fn : png_rw_ptr; (* function for reading input data *)
- io_ptr : png_voidp; (* ptr to application struct for I/O functions *)
-
- read_user_transform_fn : png_user_transform_ptr; (* user read transform *)
-
- write_user_transform_fn : png_user_transform_ptr; (* user write transform *)
-
- (* These were added in libpng-1.0.2 *)
- user_transform_ptr : png_voidp; (* user supplied struct for user transform *)
- user_transform_depth : png_byte; (* bit depth of user transformed pixels *)
- user_transform_channels : png_byte; (* channels in user transformed pixels *)
-
- mode : png_uint_32; (* tells us where we are in the PNG file *)
- flags : png_uint_32; (* flags indicating various things to libpng *)
- transformations : png_uint_32; (* which transformations to perform *)
-
- zstream : z_stream; (* pointer to decompression structure (below) *)
- zbuf : png_bytep; (* buffer for zlib *)
- zbuf_size : png_size_t; (* size of zbuf *)
- zlib_level : cint; (* holds zlib compression level *)
- zlib_method : cint; (* holds zlib compression method *)
- zlib_window_bits : cint; (* holds zlib compression window bits *)
- zlib_mem_level : cint; (* holds zlib compression memory level *)
- zlib_strategy : cint; (* holds zlib compression strategy *)
-
- width : png_uint_32; (* width of image in pixels *)
- height : png_uint_32; (* height of image in pixels *)
- num_rows : png_uint_32; (* number of rows in current pass *)
- usr_width : png_uint_32; (* width of row at start of write *)
- rowbytes : png_uint_32; (* size of row in bytes *)
- irowbytes : png_uint_32; (* size of current interlaced row in bytes *)
- iwidth : png_uint_32; (* width of current interlaced row in pixels *)
- row_number : png_uint_32; (* current row in interlace pass *)
- prev_row : png_bytep; (* buffer to save previous (unfiltered) row *)
- row_buf : png_bytep; (* buffer to save current (unfiltered) row *)
- sub_row : png_bytep; (* buffer to save "sub" row when filtering *)
- up_row : png_bytep; (* buffer to save "up" row when filtering *)
- avg_row : png_bytep; (* buffer to save "avg" row when filtering *)
- paeth_row : png_bytep; (* buffer to save "Paeth" row when filtering *)
- row_info : png_row_info; (* used for transformation routines *)
-
- idat_size : png_uint_32; (* current IDAT size for read *)
- crc : png_uint_32; (* current chunk CRC value *)
- palette : png_colorp; (* palette from the input file *)
- num_palette : png_uint_16; (* number of color entries in palette *)
- num_trans : png_uint_16; (* number of transparency values *)
- chunk_name : array[0..4] of png_byte; (* null-terminated name of current chunk *)
- compression : png_byte; (* file compression type (always 0) *)
- filter : png_byte; (* file filter type (always 0) *)
- interlaced : png_byte; (* PNG_INTERLACE_NONE, PNG_INTERLACE_ADAM7 *)
- pass : png_byte; (* current interlace pass (0 - 6) *)
- do_filter : png_byte; (* row filter flags (see PNG_FILTER_ below ) *)
- color_type : png_byte; (* color type of file *)
- bit_depth : png_byte; (* bit depth of file *)
- usr_bit_depth : png_byte; (* bit depth of users row *)
- pixel_depth : png_byte; (* number of bits per pixel *)
- channels : png_byte; (* number of channels in file *)
- usr_channels : png_byte; (* channels at start of write *)
- sig_bytes : png_byte; (* magic bytes read/written from start of file *)
-
- filler : png_uint_16;
-
- background_gamma_type : png_byte;
- background_gamma : cfloat;
- background : png_color_16;
- background_1 : png_color_16;
- output_flush_fn : png_flush_ptr;
- flush_dist : png_uint_32;
- flush_rows : png_uint_32;
- gamma_shift : cint;
- gamma : cfloat;
- screen_gamma : cfloat;
- gamma_table : png_bytep;
- gamma_from_1 : png_bytep;
- gamma_to_1 : png_bytep;
- gamma_16_table : png_uint_16pp;
- gamma_16_from_1 : png_uint_16pp;
- gamma_16_to_1 : png_uint_16pp;
- sig_bit : png_color_8;
- shift : png_color_8;
- trans : png_bytep;
- trans_values : png_color_16;
- read_row_fn : png_read_status_ptr;
- write_row_fn : png_write_status_ptr;
- info_fn : png_progressive_info_ptr;
- row_fn : png_progressive_row_ptr;
- end_fn : png_progressive_end_ptr;
- save_buffer_ptr : png_bytep;
- save_buffer : png_bytep;
- current_buffer_ptr : png_bytep;
- current_buffer : png_bytep;
- push_length : png_uint_32;
- skip_length : png_uint_32;
- save_buffer_size : png_size_t;
- save_buffer_max : png_size_t;
- buffer_size : png_size_t;
- current_buffer_size : png_size_t;
- process_mode : cint;
- cur_palette : cint;
- current_text_size : png_size_t;
- current_text_left : png_size_t;
- current_text : png_charp;
- current_text_ptr : png_charp;
- palette_lookup : png_bytep;
- dither_index : png_bytep;
- hist : png_uint_16p;
- heuristic_method : png_byte;
- num_prev_filters : png_byte;
- prev_filters : png_bytep;
- filter_weights : png_uint_16p;
- inv_filter_weights : png_uint_16p;
- filter_costs : png_uint_16p;
- inv_filter_costs : png_uint_16p;
- time_buffer : png_charp;
- free_me : png_uint_32;
- user_chunk_ptr : png_voidp;
- read_user_chunk_fn : png_user_chunk_ptr;
- num_chunk_list : cint;
- chunk_list : png_bytep;
- rgb_to_gray_status : png_byte;
- rgb_to_gray_red_coeff : png_uint_16;
- rgb_to_gray_green_coeff : png_uint_16;
- rgb_to_gray_blue_coeff : png_uint_16;
- empty_plte_permitted : png_byte;
- int_gamma : png_fixed_point;
- {$endif UsePngStruct}
- end;
- ppng_struct_def = ^png_struct_def;
- pppng_struct_def = ^ppng_struct_def;
- png_struct = png_struct_def;
- ppng_struct = ^png_struct;
- pppng_struct = ^ppng_struct;
-
- version_1_0_8 = png_structp;
- png_structpp = PPpng_struct;
-
-function png_access_version_number:png_uint_32; cdecl; external LibPng;
-
-procedure png_set_sig_bytes(png_ptr:png_structp; num_bytes:cint); cdecl; external LibPng;
-function png_sig_cmp(sig:png_bytep; start:png_size_t; num_to_check:png_size_t):cint; cdecl; external LibPng;
-function png_check_sig(sig:png_bytep; num:cint):cint; cdecl; external LibPng;
-
-(* Allocate and initialize png_ptr struct for reading, and any other memory. *)
-function png_create_read_struct(user_png_ver:png_const_charp; error_ptr:png_voidp; error_fn:png_error_ptr; warn_fn:png_error_ptr):png_structp; cdecl; external LibPng;
-
-(* Allocate and initialize png_ptr struct for writing, and any other memory *)
-function png_create_write_struct(user_png_ver:png_const_charp; error_ptr:png_voidp; error_fn:png_error_ptr; warn_fn:png_error_ptr):png_structp; cdecl; external LibPng;
-
-function png_get_compression_buffer_size(png_ptr:png_structp):png_uint_32; cdecl; external LibPng;
-procedure png_set_compression_buffer_size(png_ptr:png_structp; size:png_uint_32); cdecl; external LibPng;
-function png_reset_zstream(png_ptr:png_structp):cint; cdecl; external LibPng;
-
-procedure png_write_chunk(png_ptr:png_structp; chunk_name:png_bytep; data:png_bytep; length:png_size_t); cdecl; external LibPng;
-procedure png_write_chunk_start(png_ptr:png_structp; chunk_name:png_bytep; length:png_uint_32); cdecl; external LibPng;
-procedure png_write_chunk_data(png_ptr:png_structp; data:png_bytep; length:png_size_t); cdecl; external LibPng;
-procedure png_write_chunk_end(png_ptr:png_structp); cdecl; external LibPng;
-
-(* Allocate and initialize the info structure *)
-function png_create_info_struct(png_ptr:png_structp):png_infop; cdecl; external LibPng;
-
-(* Initialize the info structure (old interface - DEPRECATED) *)
-procedure png_info_init(info_ptr:png_infop); cdecl; external LibPng;
-
-(* Writes all the PNG information before the image. *)
-procedure png_write_info_before_PLTE(png_ptr:png_structp; info_ptr:png_infop); cdecl; external LibPng;
-procedure png_write_info(png_ptr:png_structp; info_ptr:png_infop); cdecl; external LibPng;
-
-(* read the information before the actual image data. *)
-procedure png_read_info(png_ptr:png_structp; info_ptr:png_infop); cdecl; external LibPng;
-
-function png_convert_to_rfc1123(png_ptr:png_structp; ptime:png_timep):png_charp; cdecl; external LibPng;
-procedure png_convert_from_struct_tm(ptime:png_timep; ttime:Pointer); cdecl; external LibPng;
-{$IFDEF UNIX}
-procedure png_convert_from_time_t(ptime:png_timep; ttime:time_t); cdecl; external LibPng;
-{$ENDIF}
-procedure png_set_expand(png_ptr:png_structp); cdecl; external LibPng;
-procedure png_set_gray_1_2_4_to_8(png_ptr:png_structp); cdecl; external LibPng;
-procedure png_set_palette_to_rgb(png_ptr:png_structp); cdecl; external LibPng;
-procedure png_set_tRNS_to_alpha(png_ptr:png_structp); cdecl; external LibPng;
-procedure png_set_bgr(png_ptr:png_structp); cdecl; external LibPng;
-procedure png_set_gray_to_rgb(png_ptr:png_structp); cdecl; external LibPng;
-procedure png_set_rgb_to_gray(png_ptr:png_structp; error_action:cint; red:cdouble; green:cdouble); cdecl; external LibPng;
-procedure png_set_rgb_to_gray_fixed(png_ptr:png_structp; error_action:cint; red:png_fixed_point; green:png_fixed_point); cdecl; external LibPng;
-function png_get_rgb_to_gray_status(png_ptr:png_structp):png_byte; cdecl; external LibPng;
-procedure png_build_grayscale_palette(bit_depth:cint; palette:png_colorp); cdecl; external LibPng;
-procedure png_set_strip_alpha(png_ptr:png_structp); cdecl; external LibPng;
-procedure png_set_swap_alpha(png_ptr:png_structp); cdecl; external LibPng;
-procedure png_set_invert_alpha(png_ptr:png_structp); cdecl; external LibPng;
-procedure png_set_filler(png_ptr:png_structp; filler:png_uint_32; flags:cint); cdecl; external LibPng;
-procedure png_set_swap(png_ptr:png_structp); cdecl; external LibPng;
-procedure png_set_packing(png_ptr:png_structp); cdecl; external LibPng;
-procedure png_set_packswap(png_ptr:png_structp); cdecl; external LibPng;
-procedure png_set_shift(png_ptr:png_structp; true_bits:png_color_8p); cdecl; external LibPng;
-function png_set_interlace_handling(png_ptr:png_structp):cint; cdecl; external LibPng;
-procedure png_set_invert_mono(png_ptr:png_structp); cdecl; external LibPng;
-procedure png_set_background(png_ptr:png_structp; background_color:png_color_16p; background_gamma_code:cint; need_expand:cint; background_gamma:cdouble); cdecl; external LibPng;
-procedure png_set_strip_16(png_ptr:png_structp); cdecl; external LibPng;
-procedure png_set_dither(png_ptr:png_structp; palette:png_colorp; num_palette:cint; maximum_colors:cint; histogram:png_uint_16p;
- full_dither:cint); cdecl; external LibPng;
-procedure png_set_gamma(png_ptr:png_structp; screen_gamma:cdouble; default_file_gamma:cdouble); cdecl; external LibPng;
-procedure png_permit_empty_plte(png_ptr:png_structp; empty_plte_permitted:cint); cdecl; external LibPng;
-procedure png_set_flush(png_ptr:png_structp; nrows:cint); cdecl; external LibPng;
-procedure png_write_flush(png_ptr:png_structp); cdecl; external LibPng;
-procedure png_start_read_image(png_ptr:png_structp); cdecl; external LibPng;
-procedure png_read_update_info(png_ptr:png_structp; info_ptr:png_infop); cdecl; external LibPng;
-
-(* read one or more rows of image data. *)
-procedure png_read_rows(png_ptr:png_structp; row:png_bytepp; display_row:png_bytepp; num_rows:png_uint_32); cdecl; external LibPng;
-
-(* read a row of data. *)
-procedure png_read_row(png_ptr:png_structp; row:png_bytep; display_row:png_bytep); cdecl; external LibPng;
-
-(* read the whole image into memory at once. *)
-procedure png_read_image(png_ptr:png_structp; image:png_bytepp); cdecl; external LibPng;
-
-(* write a row of image data *)
-procedure png_write_row(png_ptr:png_structp; row:png_bytep); cdecl; external LibPng;
-
-(* write a few rows of image data *)
-procedure png_write_rows(png_ptr:png_structp; row:png_bytepp; num_rows:png_uint_32); cdecl; external LibPng;
-
-(* write the image data *)
-procedure png_write_image(png_ptr:png_structp; image:png_bytepp); cdecl; external LibPng;
-
-(* writes the end of the PNG file. *)
-procedure png_write_end(png_ptr:png_structp; info_ptr:png_infop); cdecl; external LibPng;
-
-(* read the end of the PNG file. *)
-procedure png_read_end(png_ptr:png_structp; info_ptr:png_infop); cdecl; external LibPng;
-
-(* free any memory associated with the png_info_struct *)
-procedure png_destroy_info_struct(png_ptr:png_structp; info_ptr_ptr:png_infopp); cdecl; external LibPng;
-
-(* free any memory associated with the png_struct and the png_info_structs *)
-procedure png_destroy_read_struct(png_ptr_ptr:png_structpp; info_ptr_ptr:png_infopp; end_info_ptr_ptr:png_infopp); cdecl; external LibPng;
-
-(* free all memory used by the read (old method - NOT DLL EXPORTED) *)
-procedure png_read_destroy(png_ptr:png_structp; info_ptr:png_infop; end_info_ptr:png_infop); cdecl; external LibPng;
-
-(* free any memory associated with the png_struct and the png_info_structs *)
-procedure png_destroy_write_struct(png_ptr_ptr:png_structpp; info_ptr_ptr:png_infopp); cdecl; external LibPng;
-
-procedure png_write_destroy_info(info_ptr:png_infop); cdecl; external LibPng;
-procedure png_write_destroy(png_ptr:png_structp); cdecl; external LibPng;
-
-procedure png_set_crc_action(png_ptr:png_structp; crit_action:cint; ancil_action:cint); cdecl; external LibPng;
-
-procedure png_set_filter(png_ptr:png_structp; method:cint; filters:cint); cdecl; external LibPng;
-procedure png_set_filter_heuristics(png_ptr:png_structp; heuristic_method:cint; num_weights:cint; filter_weights:png_doublep; filter_costs:png_doublep); cdecl; external LibPng;
-
-procedure png_set_compression_level(png_ptr:png_structp; level:cint); cdecl; external LibPng;
-procedure png_set_compression_mem_level(png_ptr:png_structp; mem_level:cint); cdecl; external LibPng;
-procedure png_set_compression_strategy(png_ptr:png_structp; strategy:cint); cdecl; external LibPng;
-procedure png_set_compression_window_bits(png_ptr:png_structp; window_bits:cint); cdecl; external LibPng;
-procedure png_set_compression_method(png_ptr:png_structp; method:cint); cdecl; external LibPng;
-
-procedure png_init_io(png_ptr:png_structp; fp:png_FILE_p); cdecl; external LibPng;
-
-(* Replace the (error and abort), and warning functions with user
- * supplied functions. If no messages are to be printed you must still
- * write and use replacement functions. The replacement error_fn should
- * still do a longjmp to the last setjmp location if you are using this
- * method of error handling. If error_fn or warning_fn is NULL, the
- * default function will be used.
- *)
-procedure png_set_error_fn(png_ptr:png_structp; error_ptr:png_voidp; error_fn:png_error_ptr; warning_fn:png_error_ptr); cdecl; external LibPng;
-
-(* Return the user pointer associated with the error functions *)
-function png_get_error_ptr(png_ptr:png_structp):png_voidp; cdecl; external LibPng;
-
-(* Replace the default data output functions with a user supplied one(s).
- * If buffered output is not used, then output_flush_fn can be set to NULL.
- * If PNG_WRITE_FLUSH_SUPPORTED is not defined at libpng compile time
- * output_flush_fn will be ignored (and thus can be NULL).
- *)
-procedure png_set_write_fn(png_ptr:png_structp; io_ptr:png_voidp; write_data_fn:png_rw_ptr; output_flush_fn:png_flush_ptr); cdecl; external LibPng;
-
-(* Replace the default data input function with a user supplied one. *)
-procedure png_set_read_fn(png_ptr:png_structp; io_ptr:png_voidp; read_data_fn:png_rw_ptr); cdecl; external LibPng;
-
-(* Return the user pointer associated with the I/O functions *)
-function png_get_io_ptr(png_ptr:png_structp):png_voidp; cdecl; external LibPng;
-
-procedure png_set_read_status_fn(png_ptr:png_structp; read_row_fn:png_read_status_ptr); cdecl; external LibPng;
-procedure png_set_write_status_fn(png_ptr:png_structp; write_row_fn:png_write_status_ptr); cdecl; external LibPng;
-procedure png_set_read_user_transform_fn(png_ptr:png_structp; read_user_transform_fn:png_user_transform_ptr); cdecl; external LibPng;
-procedure png_set_write_user_transform_fn(png_ptr:png_structp; write_user_transform_fn:png_user_transform_ptr); cdecl; external LibPng;
-procedure png_set_user_transform_info(png_ptr:png_structp; user_transform_ptr:png_voidp; user_transform_depth:cint; user_transform_channels:cint); cdecl; external LibPng;
-function png_get_user_transform_ptr(png_ptr:png_structp):png_voidp; cdecl; external LibPng;
-procedure png_set_read_user_chunk_fn(png_ptr:png_structp; user_chunk_ptr:png_voidp; read_user_chunk_fn:png_user_chunk_ptr); cdecl; external LibPng;
-function png_get_user_chunk_ptr(png_ptr:png_structp):png_voidp; cdecl; external LibPng;
-procedure png_set_progressive_read_fn(png_ptr:png_structp; progressive_ptr:png_voidp; info_fn:png_progressive_info_ptr; row_fn:png_progressive_row_ptr; end_fn:png_progressive_end_ptr); cdecl; external LibPng;
-function png_get_progressive_ptr(png_ptr:png_structp):png_voidp; cdecl; external LibPng;
-procedure png_process_data(png_ptr:png_structp; info_ptr:png_infop; buffer:png_bytep; buffer_size:png_size_t); cdecl; external LibPng;
-procedure png_progressive_combine_row(png_ptr:png_structp; old_row:png_bytep; new_row:png_bytep); cdecl; external LibPng;
-function png_malloc(png_ptr:png_structp; size:png_uint_32):png_voidp; cdecl; external LibPng;
-procedure png_free(png_ptr:png_structp; ptr:png_voidp); cdecl; external LibPng;
-procedure png_free_data(png_ptr:png_structp; info_ptr:png_infop; free_me:png_uint_32; num:cint); cdecl; external LibPng;
-procedure png_data_freer(png_ptr:png_structp; info_ptr:png_infop; freer:cint; mask:png_uint_32); cdecl; external LibPng;
-function png_memcpy_check(png_ptr:png_structp; s1:png_voidp; s2:png_voidp; size:png_uint_32):png_voidp; cdecl; external LibPng;
-function png_memset_check(png_ptr:png_structp; s1:png_voidp; value:cint; size:png_uint_32):png_voidp; cdecl; external LibPng;
-procedure png_error(png_ptr:png_structp; error:png_const_charp); cdecl; external LibPng;
-procedure png_chunk_error(png_ptr:png_structp; error:png_const_charp); cdecl; external LibPng;
-procedure png_warning(png_ptr:png_structp; message:png_const_charp); cdecl; external LibPng;
-procedure png_chunk_warning(png_ptr:png_structp; message:png_const_charp); cdecl; external LibPng;
-function png_get_valid(png_ptr:png_structp; info_ptr:png_infop; flag:png_uint_32):png_uint_32; cdecl; external LibPng;
-function png_get_rowbytes(png_ptr:png_structp; info_ptr:png_infop):png_uint_32; cdecl; external LibPng;
-function png_get_rows(png_ptr:png_structp; info_ptr:png_infop):png_bytepp; cdecl; external LibPng;
-procedure png_set_rows(png_ptr:png_structp; info_ptr:png_infop; row_pointers:png_bytepp); cdecl; external LibPng;
-function png_get_channels(png_ptr:png_structp; info_ptr:png_infop):png_byte; cdecl; external LibPng;
-function png_get_image_width(png_ptr:png_structp; info_ptr:png_infop):png_uint_32; cdecl; external LibPng;
-function png_get_image_height(png_ptr:png_structp; info_ptr:png_infop):png_uint_32; cdecl; external LibPng;
-function png_get_bit_depth(png_ptr:png_structp; info_ptr:png_infop):png_byte; cdecl; external LibPng;
-function png_get_color_type(png_ptr:png_structp; info_ptr:png_infop):png_byte; cdecl; external LibPng;
-function png_get_filter_type(png_ptr:png_structp; info_ptr:png_infop):png_byte; cdecl; external LibPng;
-function png_get_interlace_type(png_ptr:png_structp; info_ptr:png_infop):png_byte; cdecl; external LibPng;
-function png_get_compression_type(png_ptr:png_structp; info_ptr:png_infop):png_byte; cdecl; external LibPng;
-function png_get_pixels_per_meter(png_ptr:png_structp; info_ptr:png_infop):png_uint_32; cdecl; external LibPng;
-function png_get_x_pixels_per_meter(png_ptr:png_structp; info_ptr:png_infop):png_uint_32; cdecl; external LibPng;
-function png_get_y_pixels_per_meter(png_ptr:png_structp; info_ptr:png_infop):png_uint_32; cdecl; external LibPng;
-function png_get_pixel_aspect_ratio(png_ptr:png_structp; info_ptr:png_infop):cfloat; cdecl; external LibPng;
-function png_get_x_offset_pixels(png_ptr:png_structp; info_ptr:png_infop):png_int_32; cdecl; external LibPng;
-function png_get_y_offset_pixels(png_ptr:png_structp; info_ptr:png_infop):png_int_32; cdecl; external LibPng;
-function png_get_x_offset_microns(png_ptr:png_structp; info_ptr:png_infop):png_int_32; cdecl; external LibPng;
-function png_get_y_offset_microns(png_ptr:png_structp; info_ptr:png_infop):png_int_32; cdecl; external LibPng;
-function png_get_signature(png_ptr:png_structp; info_ptr:png_infop):png_bytep; cdecl; external LibPng;
-
-function png_get_bKGD(png_ptr:png_structp; info_ptr:png_infop; background:Ppng_color_16p):png_uint_32; cdecl; external LibPng;
-procedure png_set_bKGD(png_ptr:png_structp; info_ptr:png_infop; background:png_color_16p); cdecl; external LibPng;
-function png_get_cHRM(png_ptr:png_structp; info_ptr:png_infop; white_x:PCdouble; white_y:PCdouble; red_x:PCdouble;
- red_y:PCdouble; green_x:PCdouble; green_y:PCdouble; blue_x:PCdouble; blue_y:PCdouble):png_uint_32; cdecl; external LibPng;
-function png_get_cHRM_fixed(png_ptr:png_structp; info_ptr:png_infop; int_white_x:Ppng_fixed_point; int_white_y:Ppng_fixed_point; int_red_x:Ppng_fixed_point;
- int_red_y:Ppng_fixed_point; int_green_x:Ppng_fixed_point; int_green_y:Ppng_fixed_point; int_blue_x:Ppng_fixed_point; int_blue_y:Ppng_fixed_point):png_uint_32; cdecl; external LibPng;
-procedure png_set_cHRM(png_ptr:png_structp; info_ptr:png_infop; white_x:cdouble; white_y:cdouble; red_x:cdouble;
- red_y:cdouble; green_x:cdouble; green_y:cdouble; blue_x:cdouble; blue_y:cdouble); cdecl; external LibPng;
-procedure png_set_cHRM_fixed(png_ptr:png_structp; info_ptr:png_infop; int_white_x:png_fixed_point; int_white_y:png_fixed_point; int_red_x:png_fixed_point;
- int_red_y:png_fixed_point; int_green_x:png_fixed_point; int_green_y:png_fixed_point; int_blue_x:png_fixed_point; int_blue_y:png_fixed_point); cdecl; external LibPng;
-function png_get_gAMA(png_ptr:png_structp; info_ptr:png_infop; file_gamma:PCdouble):png_uint_32; cdecl; external LibPng;
-function png_get_gAMA_fixed(png_ptr:png_structp; info_ptr:png_infop; int_file_gamma:Ppng_fixed_point):png_uint_32; cdecl; external LibPng;
-procedure png_set_gAMA(png_ptr:png_structp; info_ptr:png_infop; file_gamma:cdouble); cdecl; external LibPng;
-procedure png_set_gAMA_fixed(png_ptr:png_structp; info_ptr:png_infop; int_file_gamma:png_fixed_point); cdecl; external LibPng;
-function png_get_hIST(png_ptr:png_structp; info_ptr:png_infop; hist:Ppng_uint_16p):png_uint_32; cdecl; external LibPng;
-procedure png_set_hIST(png_ptr:png_structp; info_ptr:png_infop; hist:png_uint_16p); cdecl; external LibPng;
-function png_get_IHDR(png_ptr:png_structp; info_ptr:png_infop; width:Ppng_uint_32; height:Ppng_uint_32; bit_depth:PCint;
- color_type:PCint; interlace_type:PCint; compression_type:PCint; filter_type:PCint):png_uint_32; cdecl; external LibPng;
-procedure png_set_IHDR(png_ptr:png_structp; info_ptr:png_infop; width:png_uint_32; height:png_uint_32; bit_depth:cint;
- color_type:cint; interlace_type:cint; compression_type:cint; filter_type:cint); cdecl; external LibPng;
-function png_get_oFFs(png_ptr:png_structp; info_ptr:png_infop; offset_x:Ppng_int_32; offset_y:Ppng_int_32; unit_type:PCint):png_uint_32; cdecl; external LibPng;
-procedure png_set_oFFs(png_ptr:png_structp; info_ptr:png_infop; offset_x:png_int_32; offset_y:png_int_32; unit_type:cint); cdecl; external LibPng;
-function png_get_pCAL(png_ptr:png_structp; info_ptr:png_infop; purpose:Ppng_charp; X0:Ppng_int_32; X1:Ppng_int_32;
- atype:PCint; nparams:PCint; units:Ppng_charp; params:Ppng_charpp):png_uint_32; cdecl; external LibPng;
-procedure png_set_pCAL(png_ptr:png_structp; info_ptr:png_infop; purpose:png_charp; X0:png_int_32; X1:png_int_32;
- atype:cint; nparams:cint; units:png_charp; params:png_charpp); cdecl; external LibPng;
-function png_get_pHYs(png_ptr:png_structp; info_ptr:png_infop; res_x:Ppng_uint_32; res_y:Ppng_uint_32; unit_type:PCint):png_uint_32; cdecl; external LibPng;
-procedure png_set_pHYs(png_ptr:png_structp; info_ptr:png_infop; res_x:png_uint_32; res_y:png_uint_32; unit_type:cint); cdecl; external LibPng;
-function png_get_PLTE(png_ptr:png_structp; info_ptr:png_infop; palette:Ppng_colorp; num_palette:PCint):png_uint_32; cdecl; external LibPng;
-procedure png_set_PLTE(png_ptr:png_structp; info_ptr:png_infop; palette:png_colorp; num_palette:cint); cdecl; external LibPng;
-function png_get_sBIT(png_ptr:png_structp; info_ptr:png_infop; sig_bit:Ppng_color_8p):png_uint_32; cdecl; external LibPng;
-procedure png_set_sBIT(png_ptr:png_structp; info_ptr:png_infop; sig_bit:png_color_8p); cdecl; external LibPng;
-function png_get_sRGB(png_ptr:png_structp; info_ptr:png_infop; intent:PCint):png_uint_32; cdecl; external LibPng;
-procedure png_set_sRGB(png_ptr:png_structp; info_ptr:png_infop; intent:cint); cdecl; external LibPng;
-procedure png_set_sRGB_gAMA_and_cHRM(png_ptr:png_structp; info_ptr:png_infop; intent:cint); cdecl; external LibPng;
-function png_get_iCCP(png_ptr:png_structp; info_ptr:png_infop; name:png_charpp; compression_type:PCint; profile:png_charpp;
- proflen:Ppng_uint_32):png_uint_32; cdecl; external LibPng;
-procedure png_set_iCCP(png_ptr:png_structp; info_ptr:png_infop; name:png_charp; compression_type:cint; profile:png_charp;
- proflen:png_uint_32); cdecl; external LibPng;
-function png_get_sPLT(png_ptr:png_structp; info_ptr:png_infop; entries:png_sPLT_tpp):png_uint_32; cdecl; external LibPng;
-procedure png_set_sPLT(png_ptr:png_structp; info_ptr:png_infop; entries:png_sPLT_tp; nentries:cint); cdecl; external LibPng;
-
-(* png_get_text also returns the number of text chunks in *num_text *)
-function png_get_text(png_ptr:png_structp; info_ptr:png_infop; text_ptr:Ppng_textp; num_text:PCint):png_uint_32; cdecl; external LibPng;
-
-(*
- * Note while png_set_text() will accept a structure whose text,
- * language, and translated keywords are NULL pointers, the structure
- * returned by png_get_text will always contain regular
- * zero-terminated C strings. They might be empty strings but
- * they will never be NULL pointers.
- *)
-procedure png_set_text(png_ptr:png_structp; info_ptr:png_infop; text_ptr:png_textp; num_text:cint); cdecl; external LibPng;
-
-function png_get_tIME(png_ptr:png_structp; info_ptr:png_infop; mod_time:Ppng_timep):png_uint_32; cdecl; external LibPng;
-procedure png_set_tIME(png_ptr:png_structp; info_ptr:png_infop; mod_time:png_timep); cdecl; external LibPng;
-function png_get_tRNS(png_ptr:png_structp; info_ptr:png_infop; trans:Ppng_bytep; num_trans:PCint; trans_values:Ppng_color_16p):png_uint_32; cdecl; external LibPng;
-procedure png_set_tRNS(png_ptr:png_structp; info_ptr:png_infop; trans:png_bytep; num_trans:cint; trans_values:png_color_16p); cdecl; external LibPng;
-function png_get_sCAL(png_ptr:png_structp; info_ptr:png_infop; aunit:PCint; width:PCdouble; height:PCdouble):png_uint_32; cdecl; external LibPng;
-procedure png_set_sCAL(png_ptr:png_structp; info_ptr:png_infop; aunit:cint; width:cdouble; height:cdouble); cdecl; external LibPng;
-procedure png_set_sCAL_s(png_ptr:png_structp; info_ptr:png_infop; aunit:cint; swidth:png_charp; sheight:png_charp); cdecl; external LibPng;
-
-procedure png_set_keep_unknown_chunks(png_ptr:png_structp; keep:cint; chunk_list:png_bytep; num_chunks:cint); cdecl; external LibPng;
-procedure png_set_unknown_chunks(png_ptr:png_structp; info_ptr:png_infop; unknowns:png_unknown_chunkp; num_unknowns:cint); cdecl; external LibPng;
-procedure png_set_unknown_chunk_location(png_ptr:png_structp; info_ptr:png_infop; chunk:cint; location:cint); cdecl; external LibPng;
-function png_get_unknown_chunks(png_ptr:png_structp; info_ptr:png_infop; entries:png_unknown_chunkpp):png_uint_32; cdecl; external LibPng;
-
-procedure png_set_invalid(png_ptr:png_structp; info_ptr:png_infop; mask:cint); cdecl; external LibPng;
-
-procedure png_read_png(png_ptr:png_structp; info_ptr:png_infop; transforms:cint; params:png_voidp); cdecl; external LibPng;
-procedure png_write_png(png_ptr:png_structp; info_ptr:png_infop; transforms:cint; params:png_voidp); cdecl; external LibPng;
-
-function png_get_header_ver(png_ptr:png_structp):png_charp; cdecl; external LibPng;
-function png_get_header_version(png_ptr:png_structp):png_charp; cdecl; external LibPng;
-function png_get_libpng_ver(png_ptr:png_structp):png_charp; cdecl; external LibPng;
-
-implementation
-
-end.
diff --git a/src/lib/midi/MidiFile.pas b/src/lib/midi/MidiFile.pas
deleted file mode 100644
index acf44c04..00000000
--- a/src/lib/midi/MidiFile.pas
+++ /dev/null
@@ -1,968 +0,0 @@
-{
- 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 long strings
-{$ENDIF}
-
-uses
- Windows,
- Messages,
- Classes,
- {$IFDEF FPC}
- WinAllocation,
- {$ENDIF}
- SysUtils,
- UPath;
-
-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: TBinaryFileStream;
- 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: IPath;
-
- 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: IPath);
- 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: IPath 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: IPath);
-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;
-
-{$WARNINGS OFF}
-procedure TMidifile.MidiTimer(Sender: TObject);
-begin
- if playing then
- begin
- PlayToTime(GetTickCount - PlayStartTime);
- if assigned(FOnUpdateEvent) then FOnUpdateEvent(self);
- end;
-end;
-{$WARNINGS ON}
-
-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;
-
-{$WARNINGS OFF}
-procedure TMidifile.ContinuePlaying;
-begin
- PlayStartTime := GetTickCount - currentTime;
- playing := true;
-
- SetPriorityClass(MIDIFileHandle,REALTIME_PRIORITY_CLASS);
-
- SetMIDITimer;
-end;
-{$WARNINGS ON}
-
-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
- midiFile.Read(theByte[0], 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);
- midiFile.Read(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;
-
- midiFile := TBinaryFileStream.Create(FFilename, fmOpenRead);
- while (midiFile.Position < midiFile.Size) do
- ReadChunk;
- FreeAndNil(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/src/lib/midi/MidiScope.pas b/src/lib/midi/MidiScope.pas
deleted file mode 100644
index afc20b0f..00000000
--- a/src/lib/midi/MidiScope.pas
+++ /dev/null
@@ -1,198 +0,0 @@
-{
- 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 long strings
-{$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/src/lib/midi/Midicons.pas b/src/lib/midi/Midicons.pas
deleted file mode 100644
index 72259beb..00000000
--- a/src/lib/midi/Midicons.pas
+++ /dev/null
@@ -1,47 +0,0 @@
-{ $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 long strings
-{$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/src/lib/midi/Midiin.pas b/src/lib/midi/Midiin.pas
deleted file mode 100644
index 66e4f76d..00000000
--- a/src/lib/midi/Midiin.pas
+++ /dev/null
@@ -1,727 +0,0 @@
-{ $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 long strings
-{$ENDIF}
-
-uses
- Classes,
- SysUtils,
- Messages,
- Windows,
- MMSystem,
- {$IFDEF FPC}
- WinAllocation,
- {$ENDIF}
- 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/src/lib/midi/Midiout.pas b/src/lib/midi/Midiout.pas
deleted file mode 100644
index 98e6e3fb..00000000
--- a/src/lib/midi/Midiout.pas
+++ /dev/null
@@ -1,619 +0,0 @@
-{ $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 long strings
-{$ENDIF}
-
-uses
- SysUtils,
- Windows,
- Messages,
- Classes,
- MMSystem,
- {$IFDEF FPC}
- WinAllocation,
- {$ENDIF}
- 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/src/lib/midi/demo/MidiTest.pas b/src/lib/midi/demo/MidiTest.pas
deleted file mode 100644
index 793db730..00000000
--- a/src/lib/midi/demo/MidiTest.pas
+++ /dev/null
@@ -1,249 +0,0 @@
-// 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/src/lib/other/DirWatch.pas b/src/lib/other/DirWatch.pas
deleted file mode 100644
index 1e00ec5d..00000000
--- a/src/lib/other/DirWatch.pas
+++ /dev/null
@@ -1,345 +0,0 @@
-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 long strings
-{$ENDIF}
-
-uses
- Windows,
- Messages,
- Classes,
- {$IFDEF FPC}
- WinAllocation,
- {$ENDIF}
- SysUtils;
-
-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/src/lib/other/WinAllocation.pas b/src/lib/other/WinAllocation.pas
deleted file mode 100644
index ba1b0919..00000000
--- a/src/lib/other/WinAllocation.pas
+++ /dev/null
@@ -1,101 +0,0 @@
-unit WinAllocation;
-
-// FPC misses AllocateHWnd and DeallocateHWnd which is used by several
-// libraries such as Midi... or DirWatch.
-// Since FPC 2.2.2 there are dummies in Classes that just raise RunTime exceptions.
-// To avoid those exceptions, include this unit AFTER Classes.
-// Maybe the dummies will be replaced by functional routines in the future.WinAllocation
-//
-// THESE FUNCTIONS ARE ONLY FOR COMPATIBILITY WITH SOME EXTERNAL WIN32 LIBS.
-// DO NOT USE THEM IN USDX CODE.
-//
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-uses
- Classes,
- Windows;
-
-function AllocateHWnd(Method: TWndMethod): HWND;
-procedure DeallocateHWnd(hWnd: HWND);
-
-implementation
-
-function AllocateHWndCallback(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
-var
- Msg: TMessage;
- MethodPtr: ^TWndMethod;
-begin
- FillChar(Msg, SizeOf(Msg), 0);
- Msg.msg := uMsg;
- Msg.wParam := wParam;
- Msg.lParam := lParam;
-
- MethodPtr := Pointer(GetWindowLongPtr(hwnd, GWL_USERDATA));
- if Assigned(MethodPtr) then
- MethodPtr^(Msg);
-
- Result := DefWindowProc(hwnd, uMsg, wParam, lParam);
-end;
-
-function AllocateHWnd(Method: TWndMethod): HWND;
-var
- ClassExists: Boolean;
- WndClass, OldClass: TWndClass;
- MethodPtr: ^TMethod;
-begin
- Result := 0;
-
- // setup class-info
- FillChar(WndClass, SizeOf(TWndClass), 0);
- WndClass.hInstance := HInstance;
- // Important: do not enable AllocateHWndCallback before the msg-handler method is assigned,
- // otherwise race-conditions might occur
- WndClass.lpfnWndProc := @DefWindowProc;
- WndClass.lpszClassName:= 'USDXUtilWindowClass';
-
- // check if class is already registered
- ClassExists := GetClassInfo(HInstance, WndClass.lpszClassName, OldClass);
- // create window-class shared by all windows created by AllocateHWnd()
- if (not ClassExists) or (@OldClass.lpfnWndProc <> @DefWindowProc) then
- begin
- if ClassExists then
- UnregisterClass(WndClass.lpszClassName, HInstance);
- if (RegisterClass(WndClass) = 0) then
- Exit;
- end;
- // create window
- Result := CreateWindowEx(WS_EX_TOOLWINDOW, WndClass.lpszClassName, '',
- DWORD(WS_POPUP), 0, 0, 0, 0, 0, 0, HInstance, nil);
- if (Result = 0) then
- Exit;
- // assign individual callback procedure to the window
- if Assigned(Method) then
- begin
- // TMethod contains two pointers but we can pass just one as USERDATA
- GetMem(MethodPtr, SizeOf(TMethod));
- MethodPtr^ := TMethod(Method);
- SetWindowLongPtr(Result, GWL_USERDATA, LONG_PTR(MethodPtr));
- end;
- // now enable AllocateHWndCallback for this window
- SetWindowLongPtr(Result, GWL_WNDPROC, LONG_PTR(@AllocateHWndCallback));
-end;
-
-procedure DeallocateHWnd(hWnd: HWND);
-var
- MethodPtr: ^TMethod;
-begin
- if (hWnd <> 0) then
- begin
- MethodPtr := Pointer(GetWindowLongPtr(hWnd, GWL_USERDATA));
- DestroyWindow(hWnd);
- if Assigned(MethodPtr) then
- FreeMem(MethodPtr);
- end;
-end;
-
-end.
diff --git a/src/lib/pcre/pcre.pas b/src/lib/pcre/pcre.pas
deleted file mode 100644
index 50e3371a..00000000
--- a/src/lib/pcre/pcre.pas
+++ /dev/null
@@ -1,852 +0,0 @@
-{**************************************************************************************************}
-{ }
-{ Project JEDI Code Library (JCL) }
-{ }
-{ The contents of this file are 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/ }
-{ }
-{ 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. }
-{ }
-{ The Original Code is JclPRCE.pas. }
-{ }
-{ The Initial Developer of the Original Code is Peter Thornqvist. }
-{ Portions created by Peter Thornqvist are Copyright (C) of Peter Thornqvist. All rights reserved. }
-{ Portions created by University of Cambridge are }
-{ Copyright (C) 1997-2001 by University of Cambridge. }
-{ }
-{ Contributor(s): }
-{ Robert Rossmair (rrossmair) }
-{ Mario R. Carro }
-{ Florent Ouchet (outchy) }
-{ }
-{ The latest release of PCRE is always available from }
-{ ftp://ftp.csx.cam.ac.uk/pub/software/programming/pcre/pcre-xxx.tar.gz }
-{ }
-{**************************************************************************************************}
-{ }
-{ Header conversion of pcre.h }
-{ }
-{ }
-{**************************************************************************************************}
-{ }
-{ Last modified: $Date:: $ }
-{ Revision: $Rev:: $ }
-{ Author: $Author:: $ }
-{ }
-{**************************************************************************************************}
-
-unit pcre;
-
-interface
-
-(*************************************************
-* Perl-Compatible Regular Expressions *
-*************************************************)
-
-{$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}
-
-{$WEAKPACKAGEUNIT ON}
-
-(*$HPPEMIT '#include "pcre.h"'*)
-
-const
- MAX_PATTERN_LENGTH = $10003;
- {$EXTERNALSYM MAX_PATTERN_LENGTH}
- MAX_QUANTIFY_REPEAT = $10000;
- {$EXTERNALSYM MAX_QUANTIFY_REPEAT}
- MAX_CAPTURE_COUNT = $FFFF;
- {$EXTERNALSYM MAX_CAPTURE_COUNT}
- MAX_NESTING_DEPTH = 200;
- {$EXTERNALSYM MAX_NESTING_DEPTH}
-
-const
- (* Options *)
- PCRE_CASELESS = $00000001;
- {$EXTERNALSYM PCRE_CASELESS}
- PCRE_MULTILINE = $00000002;
- {$EXTERNALSYM PCRE_MULTILINE}
- PCRE_DOTALL = $00000004;
- {$EXTERNALSYM PCRE_DOTALL}
- PCRE_EXTENDED = $00000008;
- {$EXTERNALSYM PCRE_EXTENDED}
- PCRE_ANCHORED = $00000010;
- {$EXTERNALSYM PCRE_ANCHORED}
- PCRE_DOLLAR_ENDONLY = $00000020;
- {$EXTERNALSYM PCRE_DOLLAR_ENDONLY}
- PCRE_EXTRA = $00000040;
- {$EXTERNALSYM PCRE_EXTRA}
- PCRE_NOTBOL = $00000080;
- {$EXTERNALSYM PCRE_NOTBOL}
- PCRE_NOTEOL = $00000100;
- {$EXTERNALSYM PCRE_NOTEOL}
- PCRE_UNGREEDY = $00000200;
- {$EXTERNALSYM PCRE_UNGREEDY}
- PCRE_NOTEMPTY = $00000400;
- {$EXTERNALSYM PCRE_NOTEMPTY}
- PCRE_UTF8 = $00000800;
- {$EXTERNALSYM PCRE_UTF8}
- PCRE_NO_AUTO_CAPTURE = $00001000;
- {$EXTERNALSYM PCRE_NO_AUTO_CAPTURE}
- PCRE_NO_UTF8_CHECK = $00002000;
- {$EXTERNALSYM PCRE_NO_UTF8_CHECK}
- PCRE_AUTO_CALLOUT = $00004000;
- {$EXTERNALSYM PCRE_AUTO_CALLOUT}
- PCRE_PARTIAL_SOFT = $00008000;
- {$EXTERNALSYM PCRE_PARTIAL_SOFT}
- PCRE_PARTIAL = PCRE_PARTIAL_SOFT; // Backwards compatible synonym
- {$EXTERNALSYM PCRE_PARTIAL}
- PCRE_DFA_SHORTEST = $00010000;
- {$EXTERNALSYM PCRE_DFA_SHORTEST}
- PCRE_DFA_RESTART = $00020000;
- {$EXTERNALSYM PCRE_DFA_RESTART}
- PCRE_FIRSTLINE = $00040000;
- {$EXTERNALSYM PCRE_FIRSTLINE}
- PCRE_DUPNAMES = $00080000;
- {$EXTERNALSYM PCRE_DUPNAMES}
- PCRE_NEWLINE_CR = $00100000;
- {$EXTERNALSYM PCRE_NEWLINE_CR}
- PCRE_NEWLINE_LF = $00200000;
- {$EXTERNALSYM PCRE_NEWLINE_LF}
- PCRE_NEWLINE_CRLF = $00300000;
- {$EXTERNALSYM PCRE_NEWLINE_CRLF}
- PCRE_NEWLINE_ANY = $00400000;
- {$EXTERNALSYM PCRE_NEWLINE_ANY}
- PCRE_NEWLINE_ANYCRLF = $00500000;
- {$EXTERNALSYM PCRE_NEWLINE_ANYCRLF}
- PCRE_BSR_ANYCRLF = $00800000;
- {$EXTERNALSYM PCRE_BSR_ANYCRLF}
- PCRE_BSR_UNICODE = $01000000;
- {$EXTERNALSYM PCRE_BSR_UNICODE}
- PCRE_JAVASCRIPT_COMPAT = $02000000;
- {$EXTERNALSYM PCRE_JAVASCRIPT_COMPAT}
- PCRE_NO_START_OPTIMIZE = $04000000;
- {$EXTERNALSYM PCRE_NO_START_OPTIMIZE}
- PCRE_NO_START_OPTIMISE = $04000000;
- {$EXTERNALSYM PCRE_NO_START_OPTIMISE}
- PCRE_PARTIAL_HARD = $08000000;
- {$EXTERNALSYM PCRE_PARTIAL_HARD}
- PCRE_NOTEMPTY_ATSTART = $10000000;
- {$EXTERNALSYM PCRE_NOTEMPTY_ATSTART}
-
- (* Exec-time and get-time error codes *)
-
- PCRE_ERROR_NOMATCH = -1;
- {$EXTERNALSYM PCRE_ERROR_NOMATCH}
- PCRE_ERROR_NULL = -2;
- {$EXTERNALSYM PCRE_ERROR_NULL}
- PCRE_ERROR_BADOPTION = -3;
- {$EXTERNALSYM PCRE_ERROR_BADOPTION}
- PCRE_ERROR_BADMAGIC = -4;
- {$EXTERNALSYM PCRE_ERROR_BADMAGIC}
- PCRE_ERROR_UNKNOWN_NODE = -5;
- {$EXTERNALSYM PCRE_ERROR_UNKNOWN_NODE}
- PCRE_ERROR_NOMEMORY = -6;
- {$EXTERNALSYM PCRE_ERROR_NOMEMORY}
- PCRE_ERROR_NOSUBSTRING = -7;
- {$EXTERNALSYM PCRE_ERROR_NOSUBSTRING}
- PCRE_ERROR_MATCHLIMIT = -8;
- {$EXTERNALSYM PCRE_ERROR_MATCHLIMIT}
- PCRE_ERROR_CALLOUT = -9; (* Never used by PCRE itself *)
- {$EXTERNALSYM PCRE_ERROR_CALLOUT}
- PCRE_ERROR_BADUTF8 = -10;
- {$EXTERNALSYM PCRE_ERROR_BADUTF8}
- PCRE_ERROR_BADUTF8_OFFSET = -11;
- {$EXTERNALSYM PCRE_ERROR_BADUTF8_OFFSET}
- PCRE_ERROR_PARTIAL = -12;
- {$EXTERNALSYM PCRE_ERROR_PARTIAL}
- PCRE_ERROR_BADPARTIAL = -13;
- {$EXTERNALSYM PCRE_ERROR_BADPARTIAL}
- PCRE_ERROR_INTERNAL = -14;
- {$EXTERNALSYM PCRE_ERROR_INTERNAL}
- PCRE_ERROR_BADCOUNT = -15;
- {$EXTERNALSYM PCRE_ERROR_BADCOUNT}
- PCRE_ERROR_DFA_UITEM = -16;
- {$EXTERNALSYM PCRE_ERROR_DFA_UITEM}
- PCRE_ERROR_DFA_UCOND = -17;
- {$EXTERNALSYM PCRE_ERROR_DFA_UCOND}
- PCRE_ERROR_DFA_UMLIMIT = -18;
- {$EXTERNALSYM PCRE_ERROR_DFA_UMLIMIT}
- PCRE_ERROR_DFA_WSSIZE = -19;
- {$EXTERNALSYM PCRE_ERROR_DFA_WSSIZE}
- PCRE_ERROR_DFA_RECURSE = -20;
- {$EXTERNALSYM PCRE_ERROR_DFA_RECURSE}
- PCRE_ERROR_RECURSIONLIMIT = -21;
- {$EXTERNALSYM PCRE_ERROR_RECURSIONLIMIT}
- PCRE_ERROR_NULLWSLIMIT = -22; (* No longer actually used *)
- {$EXTERNALSYM PCRE_ERROR_NULLWSLIMIT}
- PCRE_ERROR_BADNEWLINE = -23;
- {$EXTERNALSYM PCRE_ERROR_BADNEWLINE}
-
- (* Request types for pcre_fullinfo() *)
-
- PCRE_INFO_OPTIONS = 0;
- {$EXTERNALSYM PCRE_INFO_OPTIONS}
- PCRE_INFO_SIZE = 1;
- {$EXTERNALSYM PCRE_INFO_SIZE}
- PCRE_INFO_CAPTURECOUNT = 2;
- {$EXTERNALSYM PCRE_INFO_CAPTURECOUNT}
- PCRE_INFO_BACKREFMAX = 3;
- {$EXTERNALSYM PCRE_INFO_BACKREFMAX}
- PCRE_INFO_FIRSTCHAR = 4;
- {$EXTERNALSYM PCRE_INFO_FIRSTCHAR}
- PCRE_INFO_FIRSTTABLE = 5;
- {$EXTERNALSYM PCRE_INFO_FIRSTTABLE}
- PCRE_INFO_LASTLITERAL = 6;
- {$EXTERNALSYM PCRE_INFO_LASTLITERAL}
- PCRE_INFO_NAMEENTRYSIZE = 7;
- {$EXTERNALSYM PCRE_INFO_NAMEENTRYSIZE}
- PCRE_INFO_NAMECOUNT = 8;
- {$EXTERNALSYM PCRE_INFO_NAMECOUNT}
- PCRE_INFO_NAMETABLE = 9;
- {$EXTERNALSYM PCRE_INFO_NAMETABLE}
- PCRE_INFO_STUDYSIZE = 10;
- {$EXTERNALSYM PCRE_INFO_STUDYSIZE}
- PCRE_INFO_DEFAULT_TABLES = 11;
- {$EXTERNALSYM PCRE_INFO_DEFAULT_TABLES}
- PCRE_INFO_OKPARTIAL = 12;
- {$EXTERNALSYM PCRE_INFO_OKPARTIAL}
- PCRE_INFO_JCHANGED = 13;
- {$EXTERNALSYM PCRE_INFO_JCHANGED}
- PCRE_INFO_HASCRORLF = 14;
- {$EXTERNALSYM PCRE_INFO_HASCRORLF}
- PCRE_INFO_MINLENGTH = 15;
- {$EXTERNALSYM PCRE_INFO_MINLENGTH}
-
- (* Request types for pcre_config() *)
- PCRE_CONFIG_UTF8 = 0;
- {$EXTERNALSYM PCRE_CONFIG_UTF8}
- PCRE_CONFIG_NEWLINE = 1;
- {$EXTERNALSYM PCRE_CONFIG_NEWLINE}
- PCRE_CONFIG_LINK_SIZE = 2;
- {$EXTERNALSYM PCRE_CONFIG_LINK_SIZE}
- PCRE_CONFIG_POSIX_MALLOC_THRESHOLD = 3;
- {$EXTERNALSYM PCRE_CONFIG_POSIX_MALLOC_THRESHOLD}
- PCRE_CONFIG_MATCH_LIMIT = 4;
- {$EXTERNALSYM PCRE_CONFIG_MATCH_LIMIT}
- PCRE_CONFIG_STACKRECURSE = 5;
- {$EXTERNALSYM PCRE_CONFIG_STACKRECURSE}
- PCRE_CONFIG_UNICODE_PROPERTIES = 6;
- {$EXTERNALSYM PCRE_CONFIG_UNICODE_PROPERTIES}
- PCRE_CONFIG_MATCH_LIMIT_RECURSION = 7;
- {$EXTERNALSYM PCRE_CONFIG_MATCH_LIMIT_RECURSION}
- PCRE_CONFIG_BSR = 8;
- {$EXTERNALSYM PCRE_CONFIG_BSR}
-
- (* Bit flags for the pcre_extra structure *)
-
- PCRE_EXTRA_STUDY_DATA = $0001;
- {$EXTERNALSYM PCRE_EXTRA_STUDY_DATA}
- PCRE_EXTRA_MATCH_LIMIT = $0002;
- {$EXTERNALSYM PCRE_EXTRA_MATCH_LIMIT}
- PCRE_EXTRA_CALLOUT_DATA = $0004;
- {$EXTERNALSYM PCRE_EXTRA_CALLOUT_DATA}
- PCRE_EXTRA_TABLES = $0008;
- {$EXTERNALSYM PCRE_EXTRA_TABLES}
- PCRE_EXTRA_MATCH_LIMIT_RECURSION = $0010;
- {$EXTERNALSYM PCRE_EXTRA_MATCH_LIMIT_RECURSION}
-
-type
- {$IFNDEF FPC}
- {$IFDEF CPU64}
- SizeInt = Int64;
- {$ELSE ~CPU64}
- SizeInt = Integer;
- {$ENDIF ~CPU64}
- PPAnsiChar = ^PAnsiChar;
- {$ENDIF ~FPC}
- PPPAnsiChar = ^PPAnsiChar;
-
- real_pcre = packed record
- {magic_number: Longword;
- size: Integer;
- tables: PAnsiChar;
- options: Longword;
- top_bracket: Word;
- top_backref: word;
- first_char: PAnsiChar;
- req_char: PAnsiChar;
- code: array [0..0] of AnsiChar;}
- end;
- TPCRE = real_pcre;
- PPCRE = ^TPCRE;
-
- real_pcre_extra = packed record
- {options: PAnsiChar;
- start_bits: array [0..31] of AnsiChar;}
- flags: Cardinal; (* Bits for which fields are set *)
- study_data: Pointer; (* Opaque data from pcre_study() *)
- match_limit: Cardinal; (* Maximum number of calls to match() *)
- callout_data: Pointer; (* Data passed back in callouts *)
- tables: PAnsiChar; (* Pointer to character tables *)
- match_limit_recursion: Cardinal; (* Max recursive calls to match() *)
- end;
- TPCREExtra = real_pcre_extra;
- PPCREExtra = ^TPCREExtra;
-
- pcre_callout_block = packed record
- version: Integer; (* Identifies version of block *)
- (* ------------------------ Version 0 ------------------------------- *)
- callout_number: Integer; (* Number compiled into pattern *)
- offset_vector: PInteger; (* The offset vector *)
- subject: PAnsiChar; (* The subject being matched *)
- subject_length: Integer; (* The length of the subject *)
- start_match: Integer; (* Offset to start of this match attempt *)
- current_position: Integer; (* Where we currently are in the subject *)
- capture_top: Integer; (* Max current capture *)
- capture_last: Integer; (* Most recently closed capture *)
- callout_data: Pointer; (* Data passed in with the call *)
- (* ------------------- Added for Version 1 -------------------------- *)
- pattern_position: Integer; (* Offset to next item in the pattern *)
- next_item_length: Integer; (* Length of next item in the pattern *)
- (* ------------------------------------------------------------------ *)
- end;
-
- pcre_malloc_callback = function(Size: SizeInt): Pointer; cdecl;
- {$EXTERNALSYM pcre_malloc_callback}
- pcre_free_callback = procedure(P: Pointer); cdecl;
- {$EXTERNALSYM pcre_free_callback}
- pcre_stack_malloc_callback = function(Size: SizeInt): Pointer; cdecl;
- {$EXTERNALSYM pcre_stack_malloc_callback}
- pcre_stack_free_callback = procedure(P: Pointer); cdecl;
- {$EXTERNALSYM pcre_stack_free_callback}
- pcre_callout_callback = function(var callout_block: pcre_callout_block): Integer; cdecl;
- {$EXTERNALSYM pcre_callout_callback}
-
-var
- // renamed from "pcre_X" to "pcre_X_func" to allow functions with name "pcre_X" to be
- // declared in implementation when static linked
- pcre_malloc_func: ^pcre_malloc_callback = nil;
- {$EXTERNALSYM pcre_malloc_func}
- pcre_free_func: ^pcre_free_callback = nil;
- {$EXTERNALSYM pcre_free_func}
- pcre_stack_malloc_func: ^pcre_stack_malloc_callback = nil;
- {$EXTERNALSYM pcre_stack_malloc_func}
- pcre_stack_free_func: ^pcre_stack_free_callback = nil;
- {$EXTERNALSYM pcre_stack_free_func}
- pcre_callout_func: ^pcre_callout_callback = nil;
- {$EXTERNALSYM pcre_callout_func}
-
-procedure SetPCREMallocCallback(const Value: pcre_malloc_callback);
-{$EXTERNALSYM SetPCREMallocCallback}
-function GetPCREMallocCallback: pcre_malloc_callback;
-{$EXTERNALSYM GetPCREMallocCallback}
-function CallPCREMalloc(Size: SizeInt): Pointer;
-{$EXTERNALSYM CallPCREMalloc}
-
-procedure SetPCREFreeCallback(const Value: pcre_free_callback);
-{$EXTERNALSYM SetPCREFreeCallback}
-function GetPCREFreeCallback: pcre_free_callback;
-{$EXTERNALSYM GetPCREFreeCallback}
-procedure CallPCREFree(P: Pointer);
-{$EXTERNALSYM CallPCREFree}
-
-procedure SetPCREStackMallocCallback(const Value: pcre_stack_malloc_callback);
-{$EXTERNALSYM SetPCREStackMallocCallback}
-function GetPCREStackMallocCallback: pcre_stack_malloc_callback;
-{$EXTERNALSYM GetPCREStackMallocCallback}
-function CallPCREStackMalloc(Size: SizeInt): Pointer;
-{$EXTERNALSYM CallPCREStackMalloc}
-
-procedure SetPCREStackFreeCallback(const Value: pcre_stack_free_callback);
-{$EXTERNALSYM SetPCREStackFreeCallback}
-function GetPCREStackFreeCallback: pcre_stack_free_callback;
-{$EXTERNALSYM GetPCREStackFreeCallback}
-procedure CallPCREStackFree(P: Pointer);
-{$EXTERNALSYM CallPCREStackFree}
-
-procedure SetPCRECalloutCallback(const Value: pcre_callout_callback);
-{$EXTERNALSYM SetPCRECalloutCallback}
-function GetPCRECalloutCallback: pcre_callout_callback;
-{$EXTERNALSYM GetPCRECalloutCallback}
-function CallPCRECallout(var callout_block: pcre_callout_block): Integer;
-{$EXTERNALSYM CallPCRECallout}
-
-type
- TPCRELibNotLoadedHandler = procedure; cdecl;
-
-var
- // Value to initialize function pointers below with, in case LoadPCRE fails
- // or UnloadPCRE is called. Typically the handler will raise an exception.
- LibNotLoadedHandler: TPCRELibNotLoadedHandler = nil;
-
-(* Functions *)
-
-// dynamic dll import
-type
- pcre_compile_func = function(const pattern: PAnsiChar; options: Integer;
- const errptr: PPAnsiChar; erroffset: PInteger; const tableptr: PAnsiChar): PPCRE;
- cdecl;
- {$EXTERNALSYM pcre_compile_func}
- pcre_compile2_func = function(const pattern: PAnsiChar; options: Integer;
- const errorcodeptr: PInteger; const errorptr: PPAnsiChar; erroroffset: PInteger;
- const tables: PAnsiChar): PPCRE; cdecl;
- {$EXTERNALSYM pcre_compile2_func}
- pcre_config_func = function(what: Integer; where: Pointer): Integer;
- cdecl;
- {$EXTERNALSYM pcre_config_func}
- pcre_copy_named_substring_func = function(const code: PPCRE; const subject: PAnsiChar;
- ovector: PInteger; stringcount: Integer; const stringname: PAnsiChar;
- buffer: PAnsiChar; size: Integer): Integer; cdecl;
- {$EXTERNALSYM pcre_copy_named_substring_func}
- pcre_copy_substring_func = function(const subject: PAnsiChar; ovector: PInteger;
- stringcount, stringnumber: Integer; buffer: PAnsiChar; buffersize: Integer): Integer;
- cdecl;
- {$EXTERNALSYM pcre_copy_substring_func}
- pcre_dfa_exec_func = function(const argument_re: PPCRE; const extra_data: PPCREExtra;
- const subject: PAnsiChar; length: Integer; start_offset: Integer;
- options: Integer; offsets: PInteger; offsetcount: Integer; workspace: PInteger;
- wscount: Integer): Integer; cdecl;
- {$EXTERNALSYM pcre_dfa_exec_func}
- pcre_exec_func = function(const code: PPCRE; const extra: PPCREExtra; const subject: PAnsiChar;
- length, startoffset, options: Integer; ovector: PInteger; ovecsize: Integer): Integer;
- cdecl;
- {$EXTERNALSYM pcre_exec_func}
- pcre_free_substring_func = procedure(stringptr: PAnsiChar);
- cdecl;
- {$EXTERNALSYM pcre_free_substring_func}
- pcre_free_substring_list_func = procedure(stringptr: PPAnsiChar);
- cdecl;
- {$EXTERNALSYM pcre_free_substring_list_func}
- pcre_fullinfo_func = function(const code: PPCRE; const extra: PPCREExtra;
- what: Integer; where: Pointer): Integer;
- cdecl;
- {$EXTERNALSYM pcre_fullinfo_func}
- pcre_get_named_substring_func = function(const code: PPCRE; const subject: PAnsiChar;
- ovector: PInteger; stringcount: Integer; const stringname: PAnsiChar;
- const stringptr: PPAnsiChar): Integer; cdecl;
- {$EXTERNALSYM pcre_get_named_substring_func}
- pcre_get_stringnumber_func = function(const code: PPCRE;
- const stringname: PAnsiChar): Integer; cdecl;
- {$EXTERNALSYM pcre_get_stringnumber_func}
- pcre_get_stringtable_entries_func = function(const code: PPCRE; const stringname: PAnsiChar;
- firstptr: PPAnsiChar; lastptr: PPAnsiChar): Integer;
- cdecl;
- {$EXTERNALSYM pcre_get_stringtable_entries_func}
- pcre_get_substring_func = function(const subject: PAnsiChar; ovector: PInteger;
- stringcount, stringnumber: Integer; const stringptr: PPAnsiChar): Integer;
- cdecl;
- {$EXTERNALSYM pcre_get_substring_func}
- pcre_get_substring_list_func = function(const subject: PAnsiChar; ovector: PInteger;
- stringcount: Integer; listptr: PPPAnsiChar): Integer;
- cdecl;
- {$EXTERNALSYM pcre_get_substring_list_func}
- pcre_info_func = function(const code: PPCRE; optptr, firstcharptr: PInteger): Integer;
- cdecl;
- {$EXTERNALSYM pcre_info_func}
- pcre_maketables_func = function: PAnsiChar; cdecl;
- {$EXTERNALSYM pcre_maketables_func}
- pcre_refcount_func = function(argument_re: PPCRE; adjust: Integer): Integer;
- cdecl;
- {$EXTERNALSYM pcre_refcount_func}
- pcre_study_func = function(const code: PPCRE; options: Integer; const errptr: PPAnsiChar): PPCREExtra;
- cdecl;
- {$EXTERNALSYM pcre_study_func}
- pcre_version_func = function: PAnsiChar; cdecl;
- {$EXTERNALSYM pcre_version_func}
-
-var
- pcre_compile: pcre_compile_func = nil;
- {$EXTERNALSYM pcre_compile}
- pcre_compile2: pcre_compile2_func = nil;
- {$EXTERNALSYM pcre_compile2}
- pcre_config: pcre_config_func = nil;
- {$EXTERNALSYM pcre_config}
- pcre_copy_named_substring: pcre_copy_named_substring_func = nil;
- {$EXTERNALSYM pcre_copy_named_substring}
- pcre_copy_substring: pcre_copy_substring_func = nil;
- {$EXTERNALSYM pcre_copy_substring}
- pcre_dfa_exec: pcre_dfa_exec_func = nil;
- {$EXTERNALSYM pcre_dfa_exec}
- pcre_exec: pcre_exec_func = nil;
- {$EXTERNALSYM pcre_exec}
- pcre_free_substring: pcre_free_substring_func = nil;
- {$EXTERNALSYM pcre_free_substring}
- pcre_free_substring_list: pcre_free_substring_list_func = nil;
- {$EXTERNALSYM pcre_free_substring_list}
- pcre_fullinfo: pcre_fullinfo_func = nil;
- {$EXTERNALSYM pcre_fullinfo}
- pcre_get_named_substring: pcre_get_named_substring_func = nil;
- {$EXTERNALSYM pcre_get_named_substring}
- pcre_get_stringnumber: pcre_get_stringnumber_func = nil;
- {$EXTERNALSYM pcre_get_stringnumber}
- pcre_get_stringtable_entries: pcre_get_stringtable_entries_func = nil;
- {$EXTERNALSYM pcre_get_stringtable_entries}
- pcre_get_substring: pcre_get_substring_func = nil;
- {$EXTERNALSYM pcre_get_substring}
- pcre_get_substring_list: pcre_get_substring_list_func = nil;
- {$EXTERNALSYM pcre_get_substring_list}
- pcre_info: pcre_info_func = nil;
- {$EXTERNALSYM pcre_info}
- pcre_maketables: pcre_maketables_func = nil;
- {$EXTERNALSYM pcre_maketables}
- pcre_refcount: pcre_refcount_func = nil;
- {$EXTERNALSYM pcre_refcount}
- pcre_study: pcre_study_func = nil;
- {$EXTERNALSYM pcre_study}
- pcre_version: pcre_version_func = nil;
- {$EXTERNALSYM pcre_version}
-
-function IsPCRELoaded: Boolean;
-function LoadPCRE: Boolean;
-procedure UnloadPCRE;
-
-implementation
-
-uses
- SysUtils,
- {$IFDEF MSWINDOWS}
- Windows;
- {$ENDIF MSWINDOWS}
- {$IFDEF UNIX}
- {$IFDEF HAS_UNIT_TYPES}
- Types,
- {$ENDIF HAS_UNIT_TYPES}
- {$IFDEF HAS_UNIT_LIBC}
- Libc;
- {$ELSE ~HAS_UNIT_LIBC}
- dl;
- {$ENDIF ~HAS_UNIT_LIBC}
- {$ENDIF UNIX}
-
-type
- {$IFDEF MSWINDOWS}
- TModuleHandle = HINST;
- {$ENDIF MSWINDOWS}
- {$IFDEF LINUX}
- TModuleHandle = Pointer;
- {$ENDIF LINUX}
- {$IFDEF DARWIN}
- TModuleHandle = Pointer;
- {$ENDIF DARWIN}
-
-const
- {$IFDEF MSWINDOWS}
- libpcremodulename = 'pcre3.dll';
- {$ENDIF MSWINDOWS}
- {$IFDEF LINUX}
- libpcremodulename = 'libpcre.so.0';
- {$ENDIF LINUX}
- {$IFDEF DARWIN}
- libpcremodulename = 'libpcre.dylib';
- {$ENDIF DARWIN}
- PCRECompileExportName = 'pcre_compile';
- PCRECompile2ExportName = 'pcre_compile2';
- PCREConfigExportName = 'pcre_config';
- PCRECopyNamedSubstringExportName = 'pcre_copy_named_substring';
- PCRECopySubStringExportName = 'pcre_copy_substring';
- PCREDfaExecExportName = 'pcre_dfa_exec';
- PCREExecExportName = 'pcre_exec';
- PCREFreeSubStringExportName = 'pcre_free_substring';
- PCREFreeSubStringListExportName = 'pcre_free_substring_list';
- PCREFullInfoExportName = 'pcre_fullinfo';
- PCREGetNamedSubstringExportName = 'pcre_get_named_substring';
- PCREGetStringNumberExportName = 'pcre_get_stringnumber';
- PCREGetStringTableEntriesExportName = 'pcre_get_stringtable_entries';
- PCREGetSubStringExportName = 'pcre_get_substring';
- PCREGetSubStringListExportName = 'pcre_get_substring_list';
- PCREInfoExportName = 'pcre_info';
- PCREMakeTablesExportName = 'pcre_maketables';
- PCRERefCountExportName = 'pcre_refcount';
- PCREStudyExportName = 'pcre_study';
- PCREVersionExportName = 'pcre_version';
- PCREMallocExportName = 'pcre_malloc';
- PCREFreeExportName = 'pcre_free';
- PCREStackMallocExportName = 'pcre_stack_malloc';
- PCREStackFreeExportName = 'pcre_stack_free';
- PCRECalloutExportName = 'pcre_callout';
- INVALID_MODULEHANDLE_VALUE = TModuleHandle(0);
-
-var
- PCRELib: TModuleHandle = INVALID_MODULEHANDLE_VALUE;
-
-procedure SetPCREMallocCallback(const Value: pcre_malloc_callback);
-begin
- if not Assigned(pcre_malloc_func) then
- LoadPCRE;
-
- if Assigned(pcre_malloc_func) then
- pcre_malloc_func^ := Value
- else if Assigned(LibNotLoadedHandler) then
- LibNotLoadedHandler;
-end;
-
-function GetPCREMallocCallback: pcre_malloc_callback;
-begin
- if not Assigned(pcre_malloc_func) then
- LoadPCRE;
-
- if not Assigned(pcre_malloc_func) then
- begin
- Result := nil;
- if Assigned(LibNotLoadedHandler) then
- LibNotLoadedHandler;
- end
- else
- Result := pcre_malloc_func^;
-end;
-
-function CallPCREMalloc(Size: SizeInt): Pointer;
-begin
- Result := pcre_malloc_func^(Size);
-end;
-
-procedure SetPCREFreeCallback(const Value: pcre_free_callback);
-begin
- if not Assigned(pcre_free_func) then
- LoadPCRE;
-
- if Assigned(pcre_free_func) then
- pcre_free_func^ := Value
- else if Assigned(LibNotLoadedHandler) then
- LibNotLoadedHandler;
-end;
-
-function GetPCREFreeCallback: pcre_free_callback;
-begin
- if not Assigned(pcre_free_func) then
- LoadPCRE;
-
- if not Assigned(pcre_free_func) then
- begin
- Result := nil;
- if Assigned(LibNotLoadedHandler) then
- LibNotLoadedHandler;
- end
- else
- Result := pcre_free_func^
-end;
-
-procedure CallPCREFree(P: Pointer);
-begin
- pcre_free_func^(P);
-end;
-
-procedure SetPCREStackMallocCallback(const Value: pcre_stack_malloc_callback);
-begin
- if not Assigned(pcre_stack_malloc_func) then
- LoadPCRE;
-
- if Assigned(pcre_stack_malloc_func) then
- pcre_stack_malloc_func^ := Value
- else if Assigned(LibNotLoadedHandler) then
- LibNotLoadedHandler;
-end;
-
-function GetPCREStackMallocCallback: pcre_stack_malloc_callback;
-begin
- if not Assigned(pcre_stack_malloc_func) then
- LoadPCRE;
-
- if not Assigned(pcre_stack_malloc_func) then
- begin
- Result := nil;
- if Assigned(LibNotLoadedHandler) then
- LibNotLoadedHandler;
- end
- else
- Result := pcre_stack_malloc_func^;
-end;
-
-function CallPCREStackMalloc(Size: SizeInt): Pointer;
-begin
- Result := pcre_stack_malloc_func^(Size);
-end;
-
-procedure SetPCREStackFreeCallback(const Value: pcre_stack_free_callback);
-begin
- if not Assigned(pcre_stack_free_func) then
- LoadPCRE;
-
- if Assigned(pcre_stack_free_func) then
- pcre_stack_free_func^ := Value
- else if Assigned(LibNotLoadedHandler) then
- LibNotLoadedHandler;
-end;
-
-function GetPCREStackFreeCallback: pcre_stack_free_callback;
-begin
- if not Assigned(pcre_stack_free_func) then
- LoadPCRE;
-
- if not Assigned(pcre_stack_free_func) then
- begin
- Result := nil;
- if Assigned(LibNotLoadedHandler) then
- LibNotLoadedHandler;
- end
- else
- Result := pcre_stack_free_func^;
-end;
-
-procedure CallPCREStackFree(P: Pointer);
-begin
- pcre_stack_free_func^(P);
-end;
-
-procedure SetPCRECalloutCallback(const Value: pcre_callout_callback);
-begin
- if not Assigned(pcre_callout_func) then
- LoadPCRE;
-
- if Assigned(pcre_callout_func) then
- pcre_callout_func^ := Value
- else if Assigned(LibNotLoadedHandler) then
- LibNotLoadedHandler;
-end;
-
-function GetPCRECalloutCallback: pcre_callout_callback;
-begin
- if not Assigned(pcre_callout_func) then
- LoadPCRE;
-
- if not Assigned(pcre_callout_func) then
- begin
- Result := nil;
- if Assigned(LibNotLoadedHandler) then
- LibNotLoadedHandler;
- end
- else
- Result := pcre_callout_func^;
-end;
-
-function CallPCRECallout(var callout_block: pcre_callout_block): Integer;
-begin
- Result := pcre_callout_func^(callout_block);
-end;
-
-procedure InitPCREFuncPtrs(const Value: Pointer);
-begin
- @pcre_compile := Value;
- @pcre_compile2 := Value;
- @pcre_config := Value;
- @pcre_copy_named_substring := Value;
- @pcre_copy_substring := Value;
- @pcre_dfa_exec := Value;
- @pcre_exec := Value;
- @pcre_free_substring := Value;
- @pcre_free_substring_list := Value;
- @pcre_fullinfo := Value;
- @pcre_get_named_substring := Value;
- @pcre_get_stringnumber := Value;
- @pcre_get_stringtable_entries := Value;
- @pcre_get_substring := Value;
- @pcre_get_substring_list := Value;
- @pcre_info := Value;
- @pcre_maketables := Value;
- @pcre_refcount := Value;
- @pcre_study := Value;
- @pcre_version := Value;
- pcre_malloc_func := nil;
- pcre_free_func := nil;
- pcre_stack_malloc_func := nil;
- pcre_stack_free_func := nil;
- pcre_callout_func := nil;
-end;
-
-function IsPCRELoaded: Boolean;
-begin
- Result := PCRELib <> INVALID_MODULEHANDLE_VALUE;
-end;
-
-function LoadPCRE: Boolean;
- function GetSymbol(SymbolName: PAnsiChar): Pointer;
- begin
- {$IFDEF MSWINDOWS}
- Result := GetProcAddress(PCRELib, SymbolName);
- {$ENDIF MSWINDOWS}
- {$IFDEF UNIX}
- Result := dlsym(PCRELib, SymbolName);
- {$ENDIF UNIX}
- end;
-
-begin
- Result := PCRELib <> INVALID_MODULEHANDLE_VALUE;
- if Result then
- Exit;
-
- if PCRELib = INVALID_MODULEHANDLE_VALUE then
- {$IFDEF MSWINDOWS}
- PCRELib := SafeLoadLibrary(libpcremodulename);
- {$ENDIF MSWINDOWS}
- {$IFDEF UNIX}
- PCRELib := dlopen(PAnsiChar(libpcremodulename), RTLD_NOW);
- {$ENDIF UNIX}
- Result := PCRELib <> INVALID_MODULEHANDLE_VALUE;
- if Result then
- begin
- @pcre_compile := GetSymbol(PCRECompileExportName);
- @pcre_compile2 := GetSymbol(PCRECompile2ExportName);
- @pcre_config := GetSymbol(PCREConfigExportName);
- @pcre_copy_named_substring := GetSymbol(PCRECopyNamedSubstringExportName);
- @pcre_copy_substring := GetSymbol(PCRECopySubStringExportName);
- @pcre_dfa_exec := GetSymbol(PCREDfaExecExportName);
- @pcre_exec := GetSymbol(PCREExecExportName);
- @pcre_free_substring := GetSymbol(PCREFreeSubStringExportName);
- @pcre_free_substring_list := GetSymbol(PCREFreeSubStringListExportName);
- @pcre_fullinfo := GetSymbol(PCREFullInfoExportName);
- @pcre_get_named_substring := GetSymbol(PCREGetNamedSubstringExportName);
- @pcre_get_stringnumber := GetSymbol(PCREGetStringNumberExportName);
- @pcre_get_stringtable_entries := GetSymbol(PCREGetStringTableEntriesExportName);
- @pcre_get_substring := GetSymbol(PCREGetSubStringExportName);
- @pcre_get_substring_list := GetSymbol(PCREGetSubStringListExportName);
- @pcre_info := GetSymbol(PCREInfoExportName);
- @pcre_maketables := GetSymbol(PCREMakeTablesExportName);
- @pcre_refcount := GetSymbol(PCRERefCountExportName);
- @pcre_study := GetSymbol(PCREStudyExportName);
- @pcre_version := GetSymbol(PCREVersionExportName);
- pcre_malloc_func := GetSymbol(PCREMallocExportName);
- pcre_free_func := GetSymbol(PCREFreeExportName);
- pcre_stack_malloc_func := GetSymbol(PCREStackMallocExportName);
- pcre_stack_free_func := GetSymbol(PCREStackFreeExportName);
- pcre_callout_func := GetSymbol(PCRECalloutExportName);
- end
- else
- InitPCREFuncPtrs(@LibNotLoadedHandler);
-end;
-
-procedure UnloadPCRE;
-begin
- if PCRELib <> INVALID_MODULEHANDLE_VALUE then
- {$IFDEF MSWINDOWS}
- FreeLibrary(PCRELib);
- {$ENDIF MSWINDOWS}
- {$IFDEF UNIX}
- dlclose(Pointer(PCRELib));
- {$ENDIF UNIX}
- PCRELib := INVALID_MODULEHANDLE_VALUE;
- InitPCREFuncPtrs(@LibNotLoadedHandler);
-end;
-
-(*
-function pcre_compile; external libpcremodulename name PCRECompileExportName;
-function pcre_compile2; external libpcremodulename name PCRECompile2ExportName;
-function pcre_config; external libpcremodulename name PCREConfigExportName;
-function pcre_copy_named_substring; external libpcremodulename name PCRECopyNamedSubStringExportName;
-function pcre_copy_substring; external libpcremodulename name PCRECopySubStringExportName;
-function pcre_dfa_exec; external libpcremodulename name PCREDfaExecExportName;
-function pcre_exec; external libpcremodulename name PCREExecExportName;
-procedure pcre_free_substring; external libpcremodulename name PCREFreeSubStringExportName;
-procedure pcre_free_substring_list; external libpcremodulename name PCREFreeSubStringListExportName;
-function pcre_fullinfo; external libpcremodulename name PCREFullInfoExportName;
-function pcre_get_named_substring; external libpcremodulename name PCREGetNamedSubStringExportName;
-function pcre_get_stringnumber; external libpcremodulename name PCREGetStringNumberExportName;
-function pcre_get_stringtable_entries; external libpcremodulename name PCREGetStringTableEntriesExportName;
-function pcre_get_substring; external libpcremodulename name PCREGetSubStringExportName;
-function pcre_get_substring_list; external libpcremodulename name PCREGetSubStringListExportName;
-function pcre_info; external libpcremodulename name PCREInfoExportName;
-function pcre_maketables; external libpcremodulename name PCREMakeTablesExportName;
-function pcre_refcount; external libpcremodulename name PCRERefCountExportName;
-function pcre_study; external libpcremodulename name PCREStudyExportName;
-function pcre_version; external libpcremodulename name PCREVersionExportName;
-*)
-
-end.
diff --git a/src/lib/portaudio/portaudio.pas b/src/lib/portaudio/portaudio.pas
deleted file mode 100644
index ea7d06b7..00000000
--- a/src/lib/portaudio/portaudio.pas
+++ /dev/null
@@ -1,1160 +0,0 @@
-{*
- * $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}
- {$PACKENUM 4} (* use 4-byte enums *)
- {$PACKRECORDS C} (* C/C++-compatible record packing *)
- {$MODE DELPHI }
-{$ELSE}
- {$MINENUMSIZE 4} (* use 4-byte enums *)
-{$ENDIF}
-
-interface
-
-uses
- ctypes;
-
-const
-{$IF Defined(MSWINDOWS)}
- LibName = 'portaudio_x86.dll';
-{$ELSEIF Defined(DARWIN)}
- // this is for portaudio version 19
- LibName = 'libportaudio.2.dylib';
- {$LINKLIB libportaudio.2}
-{$ELSEIF Defined(UNIX)}
- LibName = 'libportaudio.so';
-{$IFEND}
-
-{** Retrieve the release number of the currently running PortAudio build,
- eg 1900.
-*}
-function Pa_GetVersion(): cint; 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 = cint;
-type TPaErrorCode = {enum}cint; 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); // The notes below are from the
- paInvalidHostApi = (paNotInitialized+22); // original file portaudio.h
- 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 = cint;
-
-
-{** 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 = cint;
-
-{** 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}cint; 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: cint;
- {** 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: cint;
-
- {** 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: cint ): 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: clong; {**< 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 = cdouble;
-
-
-{** 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 = culong;
-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: cint; {* this is struct version 2 *}
- name: PChar;
- hostApi: TPaHostApiIndex; {* note this is a host API index, not a type id*}
-
- maxInputChannels: cint;
- maxOutputChannels: cint;
-
- {* 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: cdouble;
- 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: cint;
-
- {** 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: cdouble ): 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 = culong;
-
-{** @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 = culong;
-
-{** 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}cint; 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: culong;
- timeInfo: PPaStreamCallbackTimeInfo;
- statusFlags: TPaStreamCallbackFlags;
- userData: Pointer ): cint; 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: cdouble;
- framesPerBuffer: culong;
- 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: cint;
- numOutputChannels: cint;
- sampleFormat: TPaSampleFormat;
- sampleRate: cdouble;
- framesPerBuffer: culong;
- 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: cint;
-
- {** 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: cdouble;
- 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 ): cdouble; 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: culong ): 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: culong ): 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 ): cslong; 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 ): cslong; 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: clong ); cdecl; external LibName;
-
-implementation
-
-end.
diff --git a/src/lib/portmixer/portmixer.pas b/src/lib/portmixer/portmixer.pas
deleted file mode 100644
index b84e0cd6..00000000
--- a/src/lib/portmixer/portmixer.pas
+++ /dev/null
@@ -1,149 +0,0 @@
-{*
- * 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
- ctypes,
- portaudio;
-
-const
-{$IF Defined(MSWINDOWS)}
- LibName = 'portmixer.dll';
-{$ELSEIF Defined(DARWIN)}
-// LibName = 'libportmixer.dylib';
-// {$LINKLIB libportaudio}
-{$ELSEIF Defined(UNIX)}
- LibName = 'libportmixer.so';
-{$IFEND}
-
-type
- PPxMixer = Pointer;
- TPxVolume = cfloat; {* 0.0 (min) --> 1.0 (max) *}
- TPxBalance = cfloat; {* -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: cint ): 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 ): cint; cdecl; external LibName;
-function Px_GetMixerName( mixer: PPxMixer; i: cint ): 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 ): cint; cdecl; external LibName;
-
-{*
- All output volumes
-*}
-
-function Px_GetNumOutputVolumes( mixer: PPxMixer ): cint; cdecl; external LibName;
-function Px_GetOutputVolumeName( mixer: PPxMixer; i: cint ): PChar; cdecl; external LibName;
-function Px_GetOutputVolume( mixer: PPxMixer; i: cint ): TPxVolume; cdecl; external LibName;
-procedure Px_SetOutputVolume( mixer: PPxMixer; i: cint; volume: TPxVolume ); cdecl; external LibName;
-
-{*
- Input source
-*}
-
-function Px_GetNumInputSources( mixer: PPxMixer ): cint; cdecl; external LibName;
-function Px_GetInputSourceName( mixer: PPxMixer; i: cint): PChar; cdecl; external LibName;
-function Px_GetCurrentInputSource( mixer: PPxMixer ): cint; cdecl; external LibName; {* may return -1 == none *}
-procedure Px_SetCurrentInputSource( mixer: PPxMixer; i: cint ); 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 ): cint; 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 ): cint; 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/src/lib/projectM/projectM.pas b/src/lib/projectM/projectM.pas
deleted file mode 100644
index 533cb19b..00000000
--- a/src/lib/projectM/projectM.pas
+++ /dev/null
@@ -1,232 +0,0 @@
-unit projectM;
-
-{$IFDEF FPC}
- {$MODE DELPHI}
- {$H+} (* use long strings *)
- {$PACKENUM 4} (* use 4-byte enums *)
- {$PACKRECORDS C} (* C/C++-compatible record packing *)
-{$ELSE}
- {$MINENUMSIZE 4} (* use 4-byte enums *)
-{$ENDIF}
-
-interface
-
-uses
- SysUtils,
- ctypes,
- gl,
- UConfig;
-
-type
- // 16bit non-interleaved data
- TPCM16 = array[0..1, 0..511] of Smallint;
- PPCM16 = ^TPCM16;
- // 8bit non-interleaved data (512 samples)
- TPCM8_512 = array[0..1, 0..511] of byte;
- PPCM8_512 = ^TPCM8_512;
- // 8bit non-interleaved data (1024 samples)
- TPCM8_1024 = array[0..1, 0..1023] of byte;
- PPCM8_1024 = ^TPCM8_512;
-
-{ Event types }
-type
- TProjectMEvent = cint;
-const
- PROJECTM_KEYUP = 0;
- PROJECTM_KEYDOWN = 1;
- PROJECTM_VIDEORESIZE = 2;
- PROJECTM_VIDEOQUIT = 3;
- PROJECTM_NONE = 4;
-
-{ Keycodes }
-type
- TProjectMKeycode = cint;
-const
- PROJECTM_K_RETURN = 0;
- PROJECTM_K_RIGHT = 1;
- PROJECTM_K_LEFT = 2;
- PROJECTM_K_UP = 3;
- PROJECTM_K_DOWN = 4;
- PROJECTM_K_PAGEUP = 5;
- PROJECTM_K_PAGEDOWN = 6;
- PROJECTM_K_INSERT = 7;
- PROJECTM_K_DELETE = 8;
- PROJECTM_K_ESCAPE = 9;
- PROJECTM_K_LSHIFT = 10;
- PROJECTM_K_RSHIFT = 11;
- PROJECTM_K_CAPSLOCK = 12;
- PROJECTM_K_LCTRL = 13;
- PROJECTM_K_HOME = 14;
- PROJECTM_K_END = 15;
- PROJECTM_K_BACKSPACE = 16;
-
- PROJECTM_K_F1 = 17;
- PROJECTM_K_F2 = (PROJECTM_K_F1 + 1);
- PROJECTM_K_F3 = (PROJECTM_K_F1 + 2);
- PROJECTM_K_F4 = (PROJECTM_K_F1 + 3);
- PROJECTM_K_F5 = (PROJECTM_K_F1 + 4);
- PROJECTM_K_F6 = (PROJECTM_K_F1 + 5);
- PROJECTM_K_F7 = (PROJECTM_K_F1 + 6);
- PROJECTM_K_F8 = (PROJECTM_K_F1 + 7);
- PROJECTM_K_F9 = (PROJECTM_K_F1 + 8);
- PROJECTM_K_F10 = (PROJECTM_K_F1 + 9);
- PROJECTM_K_F11 = (PROJECTM_K_F1 + 10);
- PROJECTM_K_F12 = (PROJECTM_K_F1 + 11);
-
- PROJECTM_K_0 = 48;
- PROJECTM_K_1 = (PROJECTM_K_0 + 1);
- PROJECTM_K_2 = (PROJECTM_K_0 + 2);
- PROJECTM_K_3 = (PROJECTM_K_0 + 3);
- PROJECTM_K_4 = (PROJECTM_K_0 + 4);
- PROJECTM_K_5 = (PROJECTM_K_0 + 5);
- PROJECTM_K_6 = (PROJECTM_K_0 + 6);
- PROJECTM_K_7 = (PROJECTM_K_0 + 7);
- PROJECTM_K_8 = (PROJECTM_K_0 + 8);
- PROJECTM_K_9 = (PROJECTM_K_0 + 9);
-
- { Upper case }
- PROJECTM_K_A_UPPERCASE = 65;
- PROJECTM_K_B_UPPERCASE = (PROJECTM_K_A_UPPERCASE + 1);
- PROJECTM_K_C_UPPERCASE = (PROJECTM_K_A_UPPERCASE + 2);
- PROJECTM_K_D_UPPERCASE = (PROJECTM_K_A_UPPERCASE + 3);
- PROJECTM_K_E_UPPERCASE = (PROJECTM_K_A_UPPERCASE + 4);
- PROJECTM_K_F_UPPERCASE = (PROJECTM_K_A_UPPERCASE + 5);
- PROJECTM_K_G_UPPERCASE = (PROJECTM_K_A_UPPERCASE + 6);
- PROJECTM_K_H_UPPERCASE = (PROJECTM_K_A_UPPERCASE + 7);
- PROJECTM_K_I_UPPERCASE = (PROJECTM_K_A_UPPERCASE + 8);
- PROJECTM_K_J_UPPERCASE = (PROJECTM_K_A_UPPERCASE + 9);
- PROJECTM_K_K_UPPERCASE = (PROJECTM_K_A_UPPERCASE + 10);
- PROJECTM_K_L_UPPERCASE = (PROJECTM_K_A_UPPERCASE + 11);
- PROJECTM_K_M_UPPERCASE = (PROJECTM_K_A_UPPERCASE + 12);
- PROJECTM_K_N_UPPERCASE = (PROJECTM_K_A_UPPERCASE + 13);
- PROJECTM_K_O_UPPERCASE = (PROJECTM_K_A_UPPERCASE + 14);
- PROJECTM_K_P_UPPERCASE = (PROJECTM_K_A_UPPERCASE + 15);
- PROJECTM_K_Q_UPPERCASE = (PROJECTM_K_A_UPPERCASE + 16);
- PROJECTM_K_R_UPPERCASE = (PROJECTM_K_A_UPPERCASE + 17);
- PROJECTM_K_S_UPPERCASE = (PROJECTM_K_A_UPPERCASE + 18);
- PROJECTM_K_T_UPPERCASE = (PROJECTM_K_A_UPPERCASE + 19);
- PROJECTM_K_U_UPPERCASE = (PROJECTM_K_A_UPPERCASE + 20);
- PROJECTM_K_V_UPPERCASE = (PROJECTM_K_A_UPPERCASE + 21);
- PROJECTM_K_W_UPPERCASE = (PROJECTM_K_A_UPPERCASE + 22);
- PROJECTM_K_X_UPPERCASE = (PROJECTM_K_A_UPPERCASE + 23);
- PROJECTM_K_Y_UPPERCASE = (PROJECTM_K_A_UPPERCASE + 24);
- PROJECTM_K_Z_UPPERCASE = (PROJECTM_K_A_UPPERCASE + 25);
-
- { Lower case }
- PROJECTM_K_a_LOWERCASE = 97;
- PROJECTM_K_b_LOWERCASE = (PROJECTM_K_a_LOWERCASE + 1);
- PROJECTM_K_c_LOWERCASE = (PROJECTM_K_a_LOWERCASE + 2);
- PROJECTM_K_d_LOWERCASE = (PROJECTM_K_a_LOWERCASE + 3);
- PROJECTM_K_e_LOWERCASE = (PROJECTM_K_a_LOWERCASE + 4);
- PROJECTM_K_f_LOWERCASE = (PROJECTM_K_a_LOWERCASE + 5);
- PROJECTM_K_g_LOWERCASE = (PROJECTM_K_a_LOWERCASE + 6);
- PROJECTM_K_h_LOWERCASE = (PROJECTM_K_a_LOWERCASE + 7);
- PROJECTM_K_i_LOWERCASE = (PROJECTM_K_a_LOWERCASE + 8);
- PROJECTM_K_j_LOWERCASE = (PROJECTM_K_a_LOWERCASE + 9);
- PROJECTM_K_k_LOWERCASE = (PROJECTM_K_a_LOWERCASE + 10);
- PROJECTM_K_l_LOWERCASE = (PROJECTM_K_a_LOWERCASE + 11);
- PROJECTM_K_m_LOWERCASE = (PROJECTM_K_a_LOWERCASE + 12);
- PROJECTM_K_n_LOWERCASE = (PROJECTM_K_a_LOWERCASE + 13);
- PROJECTM_K_o_LOWERCASE = (PROJECTM_K_a_LOWERCASE + 14);
- PROJECTM_K_p_LOWERCASE = (PROJECTM_K_a_LOWERCASE + 15);
- PROJECTM_K_q_LOWERCASE = (PROJECTM_K_a_LOWERCASE + 16);
- PROJECTM_K_r_LOWERCASE = (PROJECTM_K_a_LOWERCASE + 17);
- PROJECTM_K_s_LOWERCASE = (PROJECTM_K_a_LOWERCASE + 18);
- PROJECTM_K_t_LOWERCASE = (PROJECTM_K_a_LOWERCASE + 19);
- PROJECTM_K_u_LOWERCASE = (PROJECTM_K_a_LOWERCASE + 20);
- PROJECTM_K_v_LOWERCASE = (PROJECTM_K_a_LOWERCASE + 21);
- PROJECTM_K_w_LOWERCASE = (PROJECTM_K_a_LOWERCASE + 22);
- PROJECTM_K_x_LOWERCASE = (PROJECTM_K_a_LOWERCASE + 23);
- PROJECTM_K_y_LOWERCASE = (PROJECTM_K_a_LOWERCASE + 24);
- PROJECTM_K_z_LOWERCASE = (PROJECTM_K_a_LOWERCASE + 25);
-
- PROJECTM_K_NONE = (PROJECTM_K_z_LOWERCASE + 1);
-
-{ Modifiers }
-type
- TProjectMModifier = cint;
-const
- PROJECTM_KMOD_LSHIFT = 0;
- PROJECTM_KMOD_RSHIFT = 1;
- PROJECTM_KMOD_CAPS = 2;
- PROJECTM_KMOD_LCTRL = 3;
- PROJECTM_KMOD_RCTRL = 4;
-
-type
- PSettings = ^TSettings;
- TSettings = record
- meshX: cint;
- meshY: cint;
- fps: cint;
- textureSize: cint;
- windowWidth: cint;
- windowHeight: cint;
- presetURL: PChar;
- titleFontURL: PChar;
- menuFontURL: PChar;
- smoothPresetDuration: cint;
- presetDuration: cint;
- beatSensitivity: cfloat;
- aspectCorrection: byte;
- easterEgg: cfloat;
- shuffleEnabled: byte;
- end;
-
-type
- PProjectM = ^TProjectM;
- TProjectM = class(TObject)
- private
- data: Pointer;
- public
- {$IF PROJECTM_VERSION < 1000000} // 0.9x
- constructor Create(gx, gy: integer; fps: integer;
- texsize: integer; width, height: integer;
- const presetsDir, fontsDir: string;
- const titleFont: string = 'Vera.ttf';
- const menuFont: string = 'Vera.ttf'); overload;
- {$IFEND}
- {$IF PROJECTM_VERSION >= 1000000}
- constructor Create(const configFile: string); overload;
- {$IFEND}
-
- procedure ResetGL(width, height: Integer);
- procedure SetTitle(const title: string);
- procedure RenderFrame();
-
- procedure AddPCMfloat(pcmData: PSingle; samples: integer);
- procedure AddPCM16(pcmData: PPCM16);
- procedure AddPCM16Data(pcmData: PSmallint; samples: Smallint);
- procedure AddPCM8_512(pcmData: PPCM8_512);
- {$IF PROJECTM_VERSION >= 1000000}
- procedure AddPCM8_1024(pcmData: PPCM8_1024);
- {$IFEND}
-
- procedure RandomPreset();
- procedure PreviousPreset();
- procedure NextPreset();
- procedure ToggleShowPresetNames();
-
- {$IF PROJECTM_VERSION >= 1000000}
- function InitRenderToTexture(): GLuint;
- {$IFEND}
-
- procedure KeyHandler(event: TProjectMEvent;
- keycode: TProjectMKeycode;
- modifier: TProjectMModifier);
-
- {$IF PROJECTM_VERSION > 1000000} // > 1.01
- procedure Settings(var settings: TSettings);
- {$IFEND}
-
- destructor Destroy(); override;
- end;
-
-implementation
-
-{$IF PROJECTM_VERSION >= 1000000}
- {$I projectM-1_0.inc}
-{$ELSE}
- {$I projectM-0_9.inc}
-{$IFEND}
-
-end.
diff --git a/src/lib/samplerate/samplerate.pas b/src/lib/samplerate/samplerate.pas
deleted file mode 100644
index 784b87da..00000000
--- a/src/lib/samplerate/samplerate.pas
+++ /dev/null
@@ -1,199 +0,0 @@
-{*
-** 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}
- {$MODE DELPHI}
- {$PACKENUM 4} (* use 4-byte enums *)
- {$PACKRECORDS C} (* GCC/Visual C/C++ compatible record packing *)
-{$ELSE}
- {$MINENUMSIZE 4} (* use 4-byte enums *)
-{$ENDIF}
-
-
-interface
-
-uses
- ctypes,
- UConfig;
-
-const
-{$IFDEF MSWINDOWS}
- LibName = 'libsamplerate-0.dll';
-{$ENDIF}
-{$IFDEF UNIX}
- LibName = 'samplerate';
- {$IFDEF DARWIN}
- {$LINKLIB libsamplerate}
- {$ENDIF}
-{$ENDIF}
-
-{ Opaque data type SRC_STATE. }
-type
- PSRC_STATE = ^SRC_STATE;
- SRC_STATE = record
- // opaque
- end;
-
-{ SRC_DATA is used to pass data to src_simple() and src_process(). }
-type
- PSRC_DATA = ^SRC_DATA;
- SRC_DATA = record
- data_in, data_out: PCfloat;
- input_frames, output_frames: clong;
- input_frames_used, output_frames_gen: clong;
- end_of_input: cint;
- src_ratio: cdouble;
- end;
-
-{ SRC_CB_DATA is used with callback based API. }
-type
- SRC_CB_DATA = record
- frames: clong;
- data_in: PCfloat;
- end;
-
-{*
-** 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; var data: PCfloat): clong; 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: cint; channels: cint; error: PCint): 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: cint; channels: cint;
- 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): cint; 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: cdouble;
- frames: clong; data: PCfloat): clong; 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: cint; channels: cint): cint; 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.
-*}
-function src_get_name(converter_type: cint): {const} Pchar; cdecl; external LibName;
-function src_get_description(converter_type: cint): {const} Pchar; cdecl; external LibName;
-function src_get_version(): {const} 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: cdouble): cint; 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): cint; cdecl; external LibName;
-
-{*
-** Return TRUE if ratio is a valid conversion ratio, FALSE
-** otherwise.
-*}
-function src_is_valid_ratio(ratio: cdouble): cint; cdecl; external LibName;
-
-{*
-** Return an error number.
-*}
-function src_error(state: PSRC_STATE): cint; cdecl; external LibName;
-
-{*
-** Convert the error number into a string.
-*}
-function src_strerror(error: cint): {const} Pchar; cdecl; external LibName;
-
-{*
-** The following enums can be used to set the interpolator type
-** using the function src_set_converter().
-*}
-const
- SRC_SINC_BEST_QUALITY = 0;
- SRC_SINC_MEDIUM_QUALITY = 1;
- SRC_SINC_FASTEST = 2;
- SRC_ZERO_ORDER_HOLD = 3;
- SRC_LINEAR = 4;
-
-{*
-** Extra helper functions for converting from short to float and
-** back again.
-*}
-procedure src_short_to_float_array(input: {const} PCshort; output: PCfloat; len: cint); cdecl; external LibName;
-procedure src_float_to_short_array(input: {const} PCfloat; output: PCshort; len: cint); cdecl; external LibName;
-
-{$IF LIBSAMPLERATE_VERSION >= 1003} // 0.1.3
-procedure src_int_to_float_array(input: {const} PCint; output: PCfloat; len: cint); cdecl; external LibName;
-procedure src_float_to_int_array(input: {const} PCfloat; output: PCint; len: cint); cdecl; external LibName;
-{$IFEND}
-
-implementation
-
-end.
diff --git a/src/lib/zlib/zlib.pas b/src/lib/zlib/zlib.pas
deleted file mode 100644
index 8d09313f..00000000
--- a/src/lib/zlib/zlib.pas
+++ /dev/null
@@ -1,215 +0,0 @@
-(*
- * 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 long strings
- {$PACKRECORDS C}
-{$endif}
-
-uses
- ctypes;
-
-const
- ZLIB_VERSION = '1.2.3';
-
-{$ifdef MSWINDOWS}
- libz = 'zlib1';
-{$else}
- libz = 'z';
- {$IFDEF DARWIN}
- {$linklib libz}
- {$ENDIF}
-{$endif}
-
-type
- { Compatible with paszlib }
- uInt = cuint;
- uLong = culong;
- uLongf = uLong; {FAR}
- PuLongf = ^uLongf;
- z_off_t = clong;
- pbyte = ^byte;
- bytef = byte; {FAR}
- 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: cint;
- 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.